Repatch (from linux) of OSX IRAF

3484 files changed, 319469 insertions, 0 deletions

diff --git a/sys/INDEX b/sys/INDEX
new file mode 100644
index 00000000..1ef83979
--- /dev/null
+++ b/sys/INDEX
@@ -0,0 +1,3884 @@
+VLIBINIT            1 ../unix/os/zshlib.c void VLIBINIT()
+ZARDBF              3 ../unix/os/zfiobf.c ZARDBF (chan, buf, maxbytes, offset)
+ZARDKS             14 ../unix/os/zfioks.c ZARDKS (chan, buf, totbytes, loffset)
+ZARDLP              3 ../unix/os/zfiolp.c ZARDLP (chan, buf, maxbytes, offset)
+ZARDND              9 ../unix/os/zfiond.c ZARDND (chan, buf, maxbytes, offset)
+ZARDPL              3 ../unix/os/zfiopl.c ZARDPL (chan, buf, maxbytes, offset)
+ZARDPR              4 ../unix/os/zfiopr.c ZARDPR (chan, buf, maxbytes, loffset)
+ZARDSF              2 ../unix/os/zfiosf.c ZARDSF (chan, buf, maxbytes, offset)
+ZAWRBF              3 ../unix/os/zfiobf.c ZAWRBF (chan, buf, nbytes, offset)
+ZAWRKS             15 ../unix/os/zfioks.c ZAWRKS (chan, buf, totbytes, loffset)
+ZAWRLP              4 ../unix/os/zfiolp.c ZAWRLP (chan, buf, nbytes, offset)
+ZAWRND             10 ../unix/os/zfiond.c ZAWRND (chan, buf, nbytes, offset)
+ZAWRPL              3 ../unix/os/zfiopl.c ZAWRPL (chan, buf, nbytes, offset)
+ZAWRPR              6 ../unix/os/zfiopr.c ZAWRPR (chan, buf, nbytes, loffset)
+ZAWRSF              2 ../unix/os/zfiosf.c ZAWRSF (chan, buf, nbytes, offset)
+ZAWSET              1 ../unix/os/zawset.c ZAWSET (best_size, new_size, old_size, max_size)
+ZAWTBF              4 ../unix/os/zfiobf.c ZAWTBF (fd, status)
+ZAWTKS             16 ../unix/os/zfioks.c ZAWTKS (chan, status)
+ZAWTLP              4 ../unix/os/zfiolp.c ZAWTLP (chan, status)
+ZAWTND             10 ../unix/os/zfiond.c ZAWTND (fd, status)
+ZAWTPL              4 ../unix/os/zfiopl.c ZAWTPL (chan, status)
+ZAWTPR              7 ../unix/os/zfiopr.c ZAWTPR (chan, status)
+ZAWTSF              2 ../unix/os/zfiosf.c ZAWTSF (fd, status)
+ZCALL0              1 ../unix/os/zcall.c ZCALL0 (proc)
+ZCALL1              1 ../unix/os/zcall.c ZCALL1 (proc, arg1)
+ZCALL2              1 ../unix/os/zcall.c ZCALL2 (proc, arg1, arg2)
+ZCALL3              1 ../unix/os/zcall.c ZCALL3 (proc, arg1, arg2, arg3)
+ZCALL4              1 ../unix/os/zcall.c ZCALL4 (proc, arg1, arg2, arg3, arg4)
+ZCALL5              1 ../unix/os/zcall.c ZCALL5 (proc, arg1, arg2, arg3, arg4, arg5)
+ZCALL6              1 ../unix/os/zcall.c ZCALL6 (proc, arg1, arg2, arg3, arg4, arg5, arg6)
+ZCALL7              2 ../unix/os/zcall.c ZCALL7 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZCALL8              2 ../unix/os/zcall.c ZCALL8 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZCALL9              2 ../unix/os/zcall.c ZCALL9 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZCALLA              2 ../unix/os/zcall.c ZCALLA (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZCLCPR              3 ../unix/os/zfiopr.c ZCLCPR (pid, exit_status)
+ZCLDIR              3 ../unix/os/zopdir.c ZCLDIR (chan, status)
+ZCLDPR              3 ../unix/os/zopdpr.c ZCLDPR (jobcode, killflag, exit_status)
+ZCLSBF              3 ../unix/os/zfiobf.c ZCLSBF (fd, status)
+ZCLSKS             13 ../unix/os/zfioks.c ZCLSKS (chan, status)
+ZCLSLP              2 ../unix/os/zfiolp.c ZCLSLP (chan, status)
+ZCLSND              8 ../unix/os/zfiond.c ZCLSND (fd, status)
+ZCLSPL              2 ../unix/os/zfiopl.c ZCLSPL (chan, status)
+ZCLSSF              1 ../unix/os/zfiosf.c ZCLSSF (fd, status)
+ZCLSTX              4 ../unix/os/zfiotx.c ZCLSTX (fd, status)
+ZCLSTY              1 ../unix/os/zfioty.c ZCLSTY (fd, status)
+ZDOJMP              1 ../unix/os/zdojmp.c ZDOJMP (jmpbuf, status)
+ZDVALL              1 ../unix/os/zalloc.c ZDVALL (aliases, allflg, status)
+ZDVOWN              2 ../unix/os/zalloc.c ZDVOWN (device, owner, maxch, status)
+ZFACSS              1 ../unix/os/zfacss.c ZFACSS (fname, mode, type, status)
+ZFALOC              1 ../unix/os/zfaloc.c ZFALOC (fname, nbytes, status)
+ZFCHDR              1 ../unix/os/zfchdr.c ZFCHDR (newdir, status)
+ZFDELE              1 ../unix/os/zfdele.c ZFDELE (fname, status)
+ZFGCWD              1 ../unix/os/zfgcwd.c ZFGCWD (outstr, maxch, status)
+ZFINFO              1 ../unix/os/zfinfo.c ZFINFO (fname, finfo_struct, status)
+ZFLSTX              5 ../unix/os/zfiotx.c ZFLSTX (fd, status)
+ZFLSTY              1 ../unix/os/zfioty.c ZFLSTY (fd, status)
+ZFMKCP              1 ../unix/os/zfmkcp.c ZFMKCP (osfn, new_osfn, status)
+ZFMKDR              1 ../unix/os/zfmkdr.c ZFMKDR (newdir, status)
+ZFNBRK              1 ../unix/os/zfnbrk.c ZFNBRK (vfn, uroot_offset, uextn_offset)
+ZFPATH              1 ../unix/os/zfpath.c ZFPATH (osfn, pathname, maxch, nchars)
+ZFPROT              1 ../unix/os/zfprot.c ZFPROT (fname, action, status)
+ZFRNAM              1 ../unix/os/zfrnam.c ZFRNAM (oldname, newname, status)
+ZFSUBD              1 ../unix/os/zfsubd.c ZFSUBD (osdir, maxch, subdir, nchars)
+ZFUNC0              1 ../unix/os/zfunc.c ZFUNC0 (proc)
+ZFUNC1              1 ../unix/os/zfunc.c ZFUNC1 (proc, arg1)
+ZFUNC2              1 ../unix/os/zfunc.c ZFUNC2 (proc, arg1, arg2)
+ZFUNC3              1 ../unix/os/zfunc.c ZFUNC3 (proc, arg1, arg2, arg3)
+ZFUNC4              1 ../unix/os/zfunc.c ZFUNC4 (proc, arg1, arg2, arg3, arg4)
+ZFUNC5              1 ../unix/os/zfunc.c ZFUNC5 (proc, arg1, arg2, arg3, arg4, arg5)
+ZFUNC6              2 ../unix/os/zfunc.c ZFUNC6 (proc, arg1, arg2, arg3, arg4, arg5, arg6)
+ZFUNC7              2 ../unix/os/zfunc.c ZFUNC7 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZFUNC8              2 ../unix/os/zfunc.c ZFUNC8 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZFUNC9              2 ../unix/os/zfunc.c ZFUNC9 (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZFUNCA              2 ../unix/os/zfunc.c ZFUNCA (proc, arg1, arg2, arg3, arg4, arg5, arg6, /
+ZFXDIR              1 ../unix/os/zfxdir.c ZFXDIR (osfn, osdir, maxch, nchars)
+ZGCMDL              1 ../unix/os/zgcmdl.c ZGCMDL (cmd, maxch, status)
+ZGETTX              5 ../unix/os/zfiotx.c ZGETTX (fd, buf, maxchars, status)
+ZGETTY              2 ../unix/os/zfioty.c ZGETTY (fd, buf, maxchars, status)
+ZGFDIR              3 ../unix/os/zopdir.c ZGFDIR (chan, outstr, maxch, status)
+ZGHOST              1 ../unix/os/zghost.c ZGHOST (outstr, maxch)
+ZGTENV              1 ../unix/os/zgtenv.c ZGTENV (envvar, outstr, maxch, status)
+ZGTIME              1 ../unix/os/zgtime.c ZGTIME (clock_time, cpu_time)
+ZGTPID              1 ../unix/os/zgtpid.c ZGTPID (pid)
+ZINTPR              1 ../unix/os/zintpr.c ZINTPR (pid, exception, status)
+ZLOCPR              1 ../unix/os/zlocpr.c ZLOCPR (proc, o_epa)
+ZLOCVA              1 ../unix/os/zlocva.c ZLOCVA (variable, location)
+ZMALOC              1 ../unix/os/zmaloc.c ZMALOC (buf, nbytes, status)
+ZMFREE              1 ../unix/os/zmfree.c ZMFREE (buf, status)
+ZNOTTX              8 ../unix/os/zfiotx.c ZNOTTX (fd, offset)
+ZNOTTY              2 ../unix/os/zfioty.c ZNOTTY (fd, offset)
+ZOPCPR              1 ../unix/os/zfiopr.c ZOPCPR (osfn, inchan, outchan, pid)
+ZOPDIR              1 ../unix/os/zopdir.c ZOPDIR (fname, chan)
+ZOPDPR              1 ../unix/os/zopdpr.c ZOPDPR (osfn, bkgfile, queue, jobcode)
+ZOPNBF              1 ../unix/os/zfiobf.c ZOPNBF (osfn, mode, chan)
+ZOPNKS              3 ../unix/os/zfioks.c ZOPNKS (x_server, mode, chan)
+ZOPNLP              2 ../unix/os/zfiolp.c ZOPNLP (printer, mode, chan)
+ZOPNND              2 ../unix/os/zfiond.c ZOPNND (pk_osfn, mode, chan)
+ZOPNPL              2 ../unix/os/zfiopl.c ZOPNPL (plotter, mode, chan)
+ZOPNSF              1 ../unix/os/zfiosf.c ZOPNSF (osfn, mode, chan)
+ZOPNTX              2 ../unix/os/zfiotx.c ZOPNTX (osfn, mode, chan)
+ZOPNTY              1 ../unix/os/zfioty.c ZOPNTY (osfn, mode, chan)
+ZOSCMD              1 ../unix/os/zoscmd.c ZOSCMD (oscmd, stdin_file, stdout_file, stderr_fil/
+ZPANIC              1 ../unix/os/zpanic.c ZPANIC (errcode, errmsg)
+ZPUTTX              8 ../unix/os/zfiotx.c ZPUTTX (fd, buf, nchars, status)
+ZPUTTY              2 ../unix/os/zfioty.c ZPUTTY (fd, buf, nchars, status)
+ZRALOC              1 ../unix/os/zraloc.c ZRALOC (buf, nbytes, status)
+ZSEKTX              9 ../unix/os/zfiotx.c ZSEKTX (fd, znottx_offset, status)
+ZSEKTY              2 ../unix/os/zfioty.c ZSEKTY (fd, znotty_offset, status)
+ZSTTBF              4 ../unix/os/zfiobf.c ZSTTBF (fd, param, lvalue)
+ZSTTKS             16 ../unix/os/zfioks.c ZSTTKS (chan, param, lvalue)
+ZSTTLP              4 ../unix/os/zfiolp.c ZSTTLP (chan, param, lvalue)
+ZSTTND             10 ../unix/os/zfiond.c ZSTTND (fd, param, lvalue)
+ZSTTPL              4 ../unix/os/zfiopl.c ZSTTPL (chan, param, lvalue)
+ZSTTPR              7 ../unix/os/zfiopr.c ZSTTPR (chan, param, lvalue)
+ZSTTSF              2 ../unix/os/zfiosf.c ZSTTSF (fd, param, lvalue)
+ZSTTTX             10 ../unix/os/zfiotx.c ZSTTTX (fd, param, value)
+ZSTTTY              2 ../unix/os/zfioty.c ZSTTTY (fd, param, value)
+ZWMSEC              1 ../unix/os/zwmsec.c ZWMSEC (msec)
+ZXGMES              6 ../unix/os/zxwhen.c ZXGMES (os_exception, errmsg, maxch)
+ZXWHEN              3 ../unix/os/zxwhen.c ZXWHEN (sig_code, epa, old_epa)
+ZZCLMT              8 ../unix/os/zfiomt.c ZZCLMT (chan, devpos, o_status)
+ZZOPMT              6 ../unix/os/zfiomt.c ZZOPMT (device, acmode, devcap, devpos, newfile, c/
+ZZRDMT             10 ../unix/os/zfiomt.c ZZRDMT (chan, buf, maxbytes, offset)
+ZZRWMT             14 ../unix/os/zfiomt.c ZZRWMT (device, devcap, o_status)
+ZZSETK              1 ../unix/os/zzsetk.c ZZSETK (ospn, osbfn, prtype, isatty, in, out)
+ZZSTMT             14 ../unix/os/zfiomt.c ZZSTMT (chan, param, lvalue)
+ZZSTOP              9 ../unix/os/zzstrt.c ZZSTOP()
+ZZSTRT              2 ../unix/os/zzstrt.c ZZSTRT()
+ZZWRMT             12 ../unix/os/zfiomt.c ZZWRMT (chan, buf, nbytes, offset)
+ZZWTMT             12 ../unix/os/zfiomt.c ZZWTMT (chan, devpos, o_status)
+_ev_loadcache       3 ../unix/os/zgtenv.c _ev_loadcache (fname)
+_ev_scaniraf        2 ../unix/os/zgtenv.c _ev_scaniraf (envvar)
+_ev_streq           4 ../unix/os/zgtenv.c _ev_streq (s1, s2, n)
+_getfile            4 ../unix/os/zopdir.c _getfile (dir, outstr, maxch)
+_u_fmode            5 ../unix/os/zfiobf.c _u_fmode (mode)
+aabs                5 ./vops/aabs.gx     procedure aabs$t (a, b, npix)
+aabsd               5 ./vops/ak/aabsd.x  procedure aabsd (a, b, npix)
+aabsi               5 ./vops/ak/aabsi.x  procedure aabsi (a, b, npix)
+aabsl               5 ./vops/ak/aabsl.x  procedure aabsl (a, b, npix)
+aabsr               5 ./vops/ak/aabsr.x  procedure aabsr (a, b, npix)
+aabss               5 ./vops/ak/aabss.x  procedure aabss (a, b, npix)
+aabsx               5 ./vops/ak/aabsx.x  procedure aabsx (a, b, npix)
+aadd                5 ./vops/aadd.gx     procedure aadd$t (a, b, c, npix)
+aaddd               5 ./vops/ak/aaddd.x  procedure aaddd (a, b, c, npix)
+aaddi               5 ./vops/ak/aaddi.x  procedure aaddi (a, b, c, npix)
+aaddk               5 ./vops/aaddk.gx    procedure aaddk$t (a, b, c, npix)
+aaddkd              5 ./vops/ak/aaddkd.x procedure aaddkd (a, b, c, npix)
+aaddki              5 ./vops/ak/aaddki.x procedure aaddki (a, b, c, npix)
+aaddkl              5 ./vops/ak/aaddkl.x procedure aaddkl (a, b, c, npix)
+aaddkr              5 ./vops/ak/aaddkr.x procedure aaddkr (a, b, c, npix)
+aaddks              5 ./vops/ak/aaddks.x procedure aaddks (a, b, c, npix)
+aaddkx              5 ./vops/ak/aaddkx.x procedure aaddkx (a, b, c, npix)
+aaddl               5 ./vops/ak/aaddl.x  procedure aaddl (a, b, c, npix)
+aaddr               5 ./vops/ak/aaddr.x  procedure aaddr (a, b, c, npix)
+aadds               5 ./vops/ak/aadds.x  procedure aadds (a, b, c, npix)
+aaddx               5 ./vops/ak/aaddx.x  procedure aaddx (a, b, c, npix)
+aand                5 ./vops/aand.gx     procedure aand$t (a, b, c, npix)
+aandi               5 ./vops/ak/aandi.x  procedure aandi (a, b, c, npix)
+aandk               6 ./vops/aandk.gx    procedure aandk$t (a, b, c, npix)
+aandki              6 ./vops/ak/aandki.x procedure aandki (a, b, c, npix)
+aandkl              6 ./vops/ak/aandkl.x procedure aandkl (a, b, c, npix)
+aandks              6 ./vops/ak/aandks.x procedure aandks (a, b, c, npix)
+aandl               5 ./vops/ak/aandl.x  procedure aandl (a, b, c, npix)
+aands               5 ./vops/ak/aands.x  procedure aands (a, b, c, npix)
+aavg                6 ./vops/aavg.gx     procedure aavg$t (a, npix, mean, sigma)
+aavgd               6 ./vops/ak/aavgd.x  procedure aavgd (a, npix, mean, sigma)
+aavgi               6 ./vops/ak/aavgi.x  procedure aavgi (a, npix, mean, sigma)
+aavgl               6 ./vops/ak/aavgl.x  procedure aavgl (a, npix, mean, sigma)
+aavgr               6 ./vops/ak/aavgr.x  procedure aavgr (a, npix, mean, sigma)
+aavgs               6 ./vops/ak/aavgs.x  procedure aavgs (a, npix, mean, sigma)
+aavgx               6 ./vops/ak/aavgx.x  procedure aavgx (a, npix, mean, sigma)
+abav                7 ./vops/abav.gx     procedure abav$t (a, b, nblocks, npix_per_block)
+abavd               7 ./vops/ak/abavd.x  procedure abavd (a, b, nblocks, npix_per_block)
+abavi               7 ./vops/ak/abavi.x  procedure abavi (a, b, nblocks, npix_per_block)
+abavl               7 ./vops/ak/abavl.x  procedure abavl (a, b, nblocks, npix_per_block)
+abavr               7 ./vops/ak/abavr.x  procedure abavr (a, b, nblocks, npix_per_block)
+abavs               7 ./vops/ak/abavs.x  procedure abavs (a, b, nblocks, npix_per_block)
+abavx               7 ./vops/ak/abavx.x  procedure abavx (a, b, nblocks, npix_per_block)
+abeq                6 ./vops/abeq.gx     procedure abeq$t (a, b, c, npix)
+abeqc               6 ./vops/ak/abeqc.x  procedure abeqc (a, b, c, npix)
+abeqd               6 ./vops/ak/abeqd.x  procedure abeqd (a, b, c, npix)
+abeqi               6 ./vops/ak/abeqi.x  procedure abeqi (a, b, c, npix)
+abeqk               6 ./vops/abeqk.gx    procedure abeqk$t (a, b, c, npix)
+abeqkc              6 ./vops/ak/abeqkc.x procedure abeqkc (a, b, c, npix)
+abeqkd              6 ./vops/ak/abeqkd.x procedure abeqkd (a, b, c, npix)
+abeqki              6 ./vops/ak/abeqki.x procedure abeqki (a, b, c, npix)
+abeqkl              6 ./vops/ak/abeqkl.x procedure abeqkl (a, b, c, npix)
+abeqkr              6 ./vops/ak/abeqkr.x procedure abeqkr (a, b, c, npix)
+abeqks              6 ./vops/ak/abeqks.x procedure abeqks (a, b, c, npix)
+abeqkx              6 ./vops/ak/abeqkx.x procedure abeqkx (a, b, c, npix)
+abeql               6 ./vops/ak/abeql.x  procedure abeql (a, b, c, npix)
+abeqr               6 ./vops/ak/abeqr.x  procedure abeqr (a, b, c, npix)
+abeqs               6 ./vops/ak/abeqs.x  procedure abeqs (a, b, c, npix)
+abeqx               6 ./vops/ak/abeqx.x  procedure abeqx (a, b, c, npix)
+abge                6 ./vops/abge.gx     procedure abge$t (a, b, c, npix)
+abgec               6 ./vops/ak/abgec.x  procedure abgec (a, b, c, npix)
+abged               6 ./vops/ak/abged.x  procedure abged (a, b, c, npix)
+abgei               6 ./vops/ak/abgei.x  procedure abgei (a, b, c, npix)
+abgek               6 ./vops/abgek.gx    procedure abgek$t (a, b, c, npix)
+abgekc              6 ./vops/ak/abgekc.x procedure abgekc (a, b, c, npix)
+abgekd              6 ./vops/ak/abgekd.x procedure abgekd (a, b, c, npix)
+abgeki              6 ./vops/ak/abgeki.x procedure abgeki (a, b, c, npix)
+abgekl              6 ./vops/ak/abgekl.x procedure abgekl (a, b, c, npix)
+abgekr              6 ./vops/ak/abgekr.x procedure abgekr (a, b, c, npix)
+abgeks              6 ./vops/ak/abgeks.x procedure abgeks (a, b, c, npix)
+abgekx              6 ./vops/ak/abgekx.x procedure abgekx (a, b, c, npix)
+abgel               6 ./vops/ak/abgel.x  procedure abgel (a, b, c, npix)
+abger               6 ./vops/ak/abger.x  procedure abger (a, b, c, npix)
+abges               6 ./vops/ak/abges.x  procedure abges (a, b, c, npix)
+abgex               6 ./vops/ak/abgex.x  procedure abgex (a, b, c, npix)
+abgt                6 ./vops/abgt.gx     procedure abgt$t (a, b, c, npix)
+abgtc               6 ./vops/ak/abgtc.x  procedure abgtc (a, b, c, npix)
+abgtd               6 ./vops/ak/abgtd.x  procedure abgtd (a, b, c, npix)
+abgti               6 ./vops/ak/abgti.x  procedure abgti (a, b, c, npix)
+abgtk               6 ./vops/abgtk.gx    procedure abgtk$t (a, b, c, npix)
+abgtkc              6 ./vops/ak/abgtkc.x procedure abgtkc (a, b, c, npix)
+abgtkd              6 ./vops/ak/abgtkd.x procedure abgtkd (a, b, c, npix)
+abgtki              6 ./vops/ak/abgtki.x procedure abgtki (a, b, c, npix)
+abgtkl              6 ./vops/ak/abgtkl.x procedure abgtkl (a, b, c, npix)
+abgtkr              6 ./vops/ak/abgtkr.x procedure abgtkr (a, b, c, npix)
+abgtks              6 ./vops/ak/abgtks.x procedure abgtks (a, b, c, npix)
+abgtkx              6 ./vops/ak/abgtkx.x procedure abgtkx (a, b, c, npix)
+abgtl               6 ./vops/ak/abgtl.x  procedure abgtl (a, b, c, npix)
+abgtr               6 ./vops/ak/abgtr.x  procedure abgtr (a, b, c, npix)
+abgts               6 ./vops/ak/abgts.x  procedure abgts (a, b, c, npix)
+abgtx               6 ./vops/ak/abgtx.x  procedure abgtx (a, b, c, npix)
+able                6 ./vops/able.gx     procedure able$t (a, b, c, npix)
+ablec               6 ./vops/ak/ablec.x  procedure ablec (a, b, c, npix)
+abled               6 ./vops/ak/abled.x  procedure abled (a, b, c, npix)
+ablei               6 ./vops/ak/ablei.x  procedure ablei (a, b, c, npix)
+ablek               6 ./vops/ablek.gx    procedure ablek$t (a, b, c, npix)
+ablekc              6 ./vops/ak/ablekc.x procedure ablekc (a, b, c, npix)
+ablekd              6 ./vops/ak/ablekd.x procedure ablekd (a, b, c, npix)
+ableki              6 ./vops/ak/ableki.x procedure ableki (a, b, c, npix)
+ablekl              6 ./vops/ak/ablekl.x procedure ablekl (a, b, c, npix)
+ablekr              6 ./vops/ak/ablekr.x procedure ablekr (a, b, c, npix)
+ableks              6 ./vops/ak/ableks.x procedure ableks (a, b, c, npix)
+ablekx              6 ./vops/ak/ablekx.x procedure ablekx (a, b, c, npix)
+ablel               6 ./vops/ak/ablel.x  procedure ablel (a, b, c, npix)
+abler               6 ./vops/ak/abler.x  procedure abler (a, b, c, npix)
+ables               6 ./vops/ak/ables.x  procedure ables (a, b, c, npix)
+ablex               6 ./vops/ak/ablex.x  procedure ablex (a, b, c, npix)
+ablt                6 ./vops/ablt.gx     procedure ablt$t (a, b, c, npix)
+abltc               6 ./vops/ak/abltc.x  procedure abltc (a, b, c, npix)
+abltd               6 ./vops/ak/abltd.x  procedure abltd (a, b, c, npix)
+ablti               6 ./vops/ak/ablti.x  procedure ablti (a, b, c, npix)
+abltk               6 ./vops/abltk.gx    procedure abltk$t (a, b, c, npix)
+abltkc              6 ./vops/ak/abltkc.x procedure abltkc (a, b, c, npix)
+abltkd              6 ./vops/ak/abltkd.x procedure abltkd (a, b, c, npix)
+abltki              6 ./vops/ak/abltki.x procedure abltki (a, b, c, npix)
+abltkl              6 ./vops/ak/abltkl.x procedure abltkl (a, b, c, npix)
+abltkr              6 ./vops/ak/abltkr.x procedure abltkr (a, b, c, npix)
+abltks              6 ./vops/ak/abltks.x procedure abltks (a, b, c, npix)
+abltkx              6 ./vops/ak/abltkx.x procedure abltkx (a, b, c, npix)
+abltl               6 ./vops/ak/abltl.x  procedure abltl (a, b, c, npix)
+abltr               6 ./vops/ak/abltr.x  procedure abltr (a, b, c, npix)
+ablts               6 ./vops/ak/ablts.x  procedure ablts (a, b, c, npix)
+abltx               6 ./vops/ak/abltx.x  procedure abltx (a, b, c, npix)
+abne                6 ./vops/abne.gx     procedure abne$t (a, b, c, npix)
+abnec               6 ./vops/ak/abnec.x  procedure abnec (a, b, c, npix)
+abned               6 ./vops/ak/abned.x  procedure abned (a, b, c, npix)
+abnei               6 ./vops/ak/abnei.x  procedure abnei (a, b, c, npix)
+abnek               6 ./vops/abnek.gx    procedure abnek$t (a, b, c, npix)
+abnekc              6 ./vops/ak/abnekc.x procedure abnekc (a, b, c, npix)
+abnekd              6 ./vops/ak/abnekd.x procedure abnekd (a, b, c, npix)
+abneki              6 ./vops/ak/abneki.x procedure abneki (a, b, c, npix)
+abnekl              6 ./vops/ak/abnekl.x procedure abnekl (a, b, c, npix)
+abnekr              6 ./vops/ak/abnekr.x procedure abnekr (a, b, c, npix)
+abneks              6 ./vops/ak/abneks.x procedure abneks (a, b, c, npix)
+abnekx              6 ./vops/ak/abnekx.x procedure abnekx (a, b, c, npix)
+abnel               6 ./vops/ak/abnel.x  procedure abnel (a, b, c, npix)
+abner               6 ./vops/ak/abner.x  procedure abner (a, b, c, npix)
+abnes               6 ./vops/ak/abnes.x  procedure abnes (a, b, c, npix)
+abnex               6 ./vops/ak/abnex.x  procedure abnex (a, b, c, npix)
+abor                5 ./vops/abor.gx     procedure abor$t (a, b, c, npix)
+abori               5 ./vops/ak/abori.x  procedure abori (a, b, c, npix)
+abork               6 ./vops/abork.gx    procedure abork$t (a, b, c, npix)
+aborki              6 ./vops/ak/aborki.x procedure aborki (a, b, c, npix)
+aborkl              6 ./vops/ak/aborkl.x procedure aborkl (a, b, c, npix)
+aborks              6 ./vops/ak/aborks.x procedure aborks (a, b, c, npix)
+aborl               5 ./vops/ak/aborl.x  procedure aborl (a, b, c, npix)
+abors               5 ./vops/ak/abors.x  procedure abors (a, b, c, npix)
+absu                7 ./vops/absu.gx     procedure absu$t (a, b, nblocks, npix_per_block)
+absud               7 ./vops/ak/absud.x  procedure absud (a, b, nblocks, npix_per_block)
+absui               7 ./vops/ak/absui.x  procedure absui (a, b, nblocks, npix_per_block)
+absul               7 ./vops/ak/absul.x  procedure absul (a, b, nblocks, npix_per_block)
+absur               7 ./vops/ak/absur.x  procedure absur (a, b, nblocks, npix_per_block)
+absus               7 ./vops/ak/absus.x  procedure absus (a, b, nblocks, npix_per_block)
+access             13 ./fio/access.x     int procedure access (fname, mode, type)
+acht                6 ./vops/achtgen/acht.x procedure acht (a, b, nelem, ty_a, ty_b)
+acht                7 ./vops/acht.gx     procedure acht$t$$t (a, b, npix)
+achtb               6 ./vops/achtgen/achtb.x procedure achtb (a, b, nelem, ty_b)
+achtc               6 ./vops/achtgen/achtc.x procedure achtc (a, b, nelem, ty_b)
+achtcc              7 ./vops/ak/achtcc.x procedure achtcc (a, b, npix)
+achtcd              7 ./vops/ak/achtcd.x procedure achtcd (a, b, npix)
+achtci              7 ./vops/ak/achtci.x procedure achtci (a, b, npix)
+achtcl              7 ./vops/ak/achtcl.x procedure achtcl (a, b, npix)
+achtcr              7 ./vops/ak/achtcr.x procedure achtcr (a, b, npix)
+achtcs              7 ./vops/ak/achtcs.x procedure achtcs (a, b, npix)
+achtcx              7 ./vops/ak/achtcx.x procedure achtcx (a, b, npix)
+achtd               6 ./vops/achtgen/achtd.x procedure achtd (a, b, nelem, ty_b)
+achtdc              7 ./vops/ak/achtdc.x procedure achtdc (a, b, npix)
+achtdd              7 ./vops/ak/achtdd.x procedure achtdd (a, b, npix)
+achtdi              7 ./vops/ak/achtdi.x procedure achtdi (a, b, npix)
+achtdl              7 ./vops/ak/achtdl.x procedure achtdl (a, b, npix)
+achtdr              7 ./vops/ak/achtdr.x procedure achtdr (a, b, npix)
+achtds              7 ./vops/ak/achtds.x procedure achtds (a, b, npix)
+achtdx              7 ./vops/ak/achtdx.x procedure achtdx (a, b, npix)
+achti               6 ./vops/achtgen/achti.x procedure achti (a, b, nelem, ty_b)
+achtic              7 ./vops/ak/achtic.x procedure achtic (a, b, npix)
+achtid              7 ./vops/ak/achtid.x procedure achtid (a, b, npix)
+achtii              7 ./vops/ak/achtii.x procedure achtii (a, b, npix)
+achtil              7 ./vops/ak/achtil.x procedure achtil (a, b, npix)
+achtir              7 ./vops/ak/achtir.x procedure achtir (a, b, npix)
+achtis              7 ./vops/ak/achtis.x procedure achtis (a, b, npix)
+achtix              7 ./vops/ak/achtix.x procedure achtix (a, b, npix)
+achtl               6 ./vops/achtgen/achtl.x procedure achtl (a, b, nelem, ty_b)
+achtlc              7 ./vops/ak/achtlc.x procedure achtlc (a, b, npix)
+achtld              7 ./vops/ak/achtld.x procedure achtld (a, b, npix)
+achtli              7 ./vops/ak/achtli.x procedure achtli (a, b, npix)
+achtll              7 ./vops/ak/achtll.x procedure achtll (a, b, npix)
+achtlr              7 ./vops/ak/achtlr.x procedure achtlr (a, b, npix)
+achtls              7 ./vops/ak/achtls.x procedure achtls (a, b, npix)
+achtlx              7 ./vops/ak/achtlx.x procedure achtlx (a, b, npix)
+achtr               6 ./vops/achtgen/achtr.x procedure achtr (a, b, nelem, ty_b)
+achtrc              7 ./vops/ak/achtrc.x procedure achtrc (a, b, npix)
+achtrd              7 ./vops/ak/achtrd.x procedure achtrd (a, b, npix)
+achtri              7 ./vops/ak/achtri.x procedure achtri (a, b, npix)
+achtrl              7 ./vops/ak/achtrl.x procedure achtrl (a, b, npix)
+achtrr              7 ./vops/ak/achtrr.x procedure achtrr (a, b, npix)
+achtrs              7 ./vops/ak/achtrs.x procedure achtrs (a, b, npix)
+achtrx              7 ./vops/ak/achtrx.x procedure achtrx (a, b, npix)
+achts               6 ./vops/achtgen/achts.x procedure achts (a, b, nelem, ty_b)
+achtsc              7 ./vops/ak/achtsc.x procedure achtsc (a, b, npix)
+achtsd              7 ./vops/ak/achtsd.x procedure achtsd (a, b, npix)
+achtsi              7 ./vops/ak/achtsi.x procedure achtsi (a, b, npix)
+achtsl              7 ./vops/ak/achtsl.x procedure achtsl (a, b, npix)
+achtsr              7 ./vops/ak/achtsr.x procedure achtsr (a, b, npix)
+achtss              7 ./vops/ak/achtss.x procedure achtss (a, b, npix)
+achtsx              7 ./vops/ak/achtsx.x procedure achtsx (a, b, npix)
+achtu               6 ./vops/achtgen/achtu.x procedure achtu (a, b, nelem, ty_b)
+achtx               6 ./vops/achtgen/achtx.x procedure achtx (a, b, nelem, ty_b)
+achtxc              7 ./vops/ak/achtxc.x procedure achtxc (a, b, npix)
+achtxd              7 ./vops/ak/achtxd.x procedure achtxd (a, b, npix)
+achtxi              7 ./vops/ak/achtxi.x procedure achtxi (a, b, npix)
+achtxl              7 ./vops/ak/achtxl.x procedure achtxl (a, b, npix)
+achtxr              7 ./vops/ak/achtxr.x procedure achtxr (a, b, npix)
+achtxs              7 ./vops/ak/achtxs.x procedure achtxs (a, b, npix)
+achtxx              7 ./vops/ak/achtxx.x procedure achtxx (a, b, npix)
+acjgx               5 ./vops/acjgx.x     procedure acjgx (a, b, npix)
+acjgx               5 ./vops/ak/acjgx.x  procedure acjgx (a, b, npix)
+aclr                5 ./vops/aclr.gx     procedure aclr$t (a, npix)
+aclrc               5 ./vops/ak/aclrc.x  procedure aclrc (a, npix)
+aclrd               5 ./vops/ak/aclrd.x  procedure aclrd (a, npix)
+aclri               5 ./vops/ak/aclri.x  procedure aclri (a, npix)
+aclrl               5 ./vops/ak/aclrl.x  procedure aclrl (a, npix)
+aclrr               5 ./vops/ak/aclrr.x  procedure aclrr (a, npix)
+aclrs               5 ./vops/ak/aclrs.x  procedure aclrs (a, npix)
+aclrx               5 ./vops/ak/aclrx.x  procedure aclrx (a, npix)
+acnv               18 ./vops/acnv.gx     procedure acnv$t (in, out, npix, kernel, knpix)
+acnvd              18 ./vops/ak/acnvd.x  procedure acnvd (in, out, npix, kernel, knpix)
+acnvi              18 ./vops/ak/acnvi.x  procedure acnvi (in, out, npix, kernel, knpix)
+acnvl              18 ./vops/ak/acnvl.x  procedure acnvl (in, out, npix, kernel, knpix)
+acnvr              18 ./vops/ak/acnvr.x  procedure acnvr (in, out, npix, kernel, knpix)
+acnvr              19 ./vops/acnvr.gx    procedure acnvr$t (in, out, npix, kernel, knpix)
+acnvrd             19 ./vops/ak/acnvrd.x procedure acnvrd (in, out, npix, kernel, knpix)
+acnvri             19 ./vops/ak/acnvri.x procedure acnvri (in, out, npix, kernel, knpix)
+acnvrl             19 ./vops/ak/acnvrl.x procedure acnvrl (in, out, npix, kernel, knpix)
+acnvrr             19 ./vops/ak/acnvrr.x procedure acnvrr (in, out, npix, kernel, knpix)
+acnvrs             19 ./vops/ak/acnvrs.x procedure acnvrs (in, out, npix, kernel, knpix)
+acnvs              18 ./vops/ak/acnvs.x  procedure acnvs (in, out, npix, kernel, knpix)
+adiv                6 ./vops/adiv.gx     procedure adiv$t (a, b, c, npix)
+adivd               6 ./vops/ak/adivd.x  procedure adivd (a, b, c, npix)
+adivi               6 ./vops/ak/adivi.x  procedure adivi (a, b, c, npix)
+adivk               6 ./vops/adivk.gx    procedure adivk$t (a, b, c, npix)
+adivkd              6 ./vops/ak/adivkd.x procedure adivkd (a, b, c, npix)
+adivki              6 ./vops/ak/adivki.x procedure adivki (a, b, c, npix)
+adivkl              6 ./vops/ak/adivkl.x procedure adivkl (a, b, c, npix)
+adivkr              6 ./vops/ak/adivkr.x procedure adivkr (a, b, c, npix)
+adivks              6 ./vops/ak/adivks.x procedure adivks (a, b, c, npix)
+adivkx              6 ./vops/ak/adivkx.x procedure adivkx (a, b, c, npix)
+adivl               6 ./vops/ak/adivl.x  procedure adivl (a, b, c, npix)
+adivr               6 ./vops/ak/adivr.x  procedure adivr (a, b, c, npix)
+adivs               6 ./vops/ak/adivs.x  procedure adivs (a, b, c, npix)
+adivx               6 ./vops/ak/adivx.x  procedure adivx (a, b, c, npix)
+adjust            347 ./gio/nsppkern/gktpcell.x procedure adjust ( lower, upper, res)
+adot                7 ./vops/adot.gx     double procedure adot$t (a, b, npix)
+adot                9 ./vops/adot.gx     real procedure adot$t (a, b, npix)
+adotd               6 ./vops/ak/adotd.x  double procedure adotd (a, b, npix)
+adoti               6 ./vops/ak/adoti.x  real procedure adoti (a, b, npix)
+adotl               6 ./vops/ak/adotl.x  double procedure adotl (a, b, npix)
+adotr               6 ./vops/ak/adotr.x  real procedure adotr (a, b, npix)
+adots               6 ./vops/ak/adots.x  real procedure adots (a, b, npix)
+adotx               6 ./vops/ak/adotx.x  real procedure adotx (a, b, npix)
+advz               13 ./vops/advz.gx     procedure advz$t (a, b, c, npix, errfcn)
+advzd              13 ./vops/ak/advzd.x  procedure advzd (a, b, c, npix, errfcn)
+advzi              13 ./vops/ak/advzi.x  procedure advzi (a, b, c, npix, errfcn)
+advzl              13 ./vops/ak/advzl.x  procedure advzl (a, b, c, npix, errfcn)
+advzr              13 ./vops/ak/advzr.x  procedure advzr (a, b, c, npix, errfcn)
+advzs              13 ./vops/ak/advzs.x  procedure advzs (a, b, c, npix, errfcn)
+advzx              13 ./vops/ak/advzx.x  procedure advzx (a, b, c, npix, errfcn)
+aelogd              5 ./gio/aelogd.x     double procedure aelogd (x)
+aelogr              5 ./gio/aelogr.x     real procedure aelogr (x)
+aexp                5 ./vops/aexp.gx     procedure aexp$t (a, b, c, npix)
+aexpd               5 ./vops/ak/aexpd.x  procedure aexpd (a, b, c, npix)
+aexpi               5 ./vops/ak/aexpi.x  procedure aexpi (a, b, c, npix)
+aexpk               5 ./vops/aexpk.gx    procedure aexpk$t (a, b, c, npix)
+aexpkd              5 ./vops/ak/aexpkd.x procedure aexpkd (a, b, c, npix)
+aexpki              5 ./vops/ak/aexpki.x procedure aexpki (a, b, c, npix)
+aexpkl              5 ./vops/ak/aexpkl.x procedure aexpkl (a, b, c, npix)
+aexpkr              5 ./vops/ak/aexpkr.x procedure aexpkr (a, b, c, npix)
+aexpks              5 ./vops/ak/aexpks.x procedure aexpks (a, b, c, npix)
+aexpkx              5 ./vops/ak/aexpkx.x procedure aexpkx (a, b, c, npix)
+aexpl               5 ./vops/ak/aexpl.x  procedure aexpl (a, b, c, npix)
+aexpr               5 ./vops/ak/aexpr.x  procedure aexpr (a, b, c, npix)
+aexps               5 ./vops/ak/aexps.x  procedure aexps (a, b, c, npix)
+aexpx               5 ./vops/ak/aexpx.x  procedure aexpx (a, b, c, npix)
+afftrr             10 ./vops/afftrr.x    procedure afftrr (sr, si, fr, fi, npix)
+afftrr             10 ./vops/ak/afftrr.x procedure afftrr (sr, si, fr, fi, npix)
+afftrx             18 ./vops/afftrx.x    procedure afftrx (a, b, npix)
+afftrx             18 ./vops/ak/afftrx.x procedure afftrx (a, b, npix)
+afftxr              9 ./vops/afftxr.x    procedure afftxr (sr, si, fr, fi, npix)
+afftxr              9 ./vops/ak/afftxr.x procedure afftxr (sr, si, fr, fi, npix)
+afftxx              9 ./vops/afftxx.x    procedure afftxx (a, b, npix)
+afftxx              9 ./vops/ak/afftxx.x procedure afftxx (a, b, npix)
+aglt                8 ./vops/aglt.gx     procedure aglt$t (a, b, npix, low, high, kmul, kadd, nrange)
+agltc               8 ./vops/ak/agltc.x  procedure agltc (a, b, npix, low, high, kmul, kadd, nrange)
+agltd               8 ./vops/ak/agltd.x  procedure agltd (a, b, npix, low, high, kmul, kadd, nrange)
+aglti               8 ./vops/ak/aglti.x  procedure aglti (a, b, npix, low, high, kmul, kadd, nrange)
+agltl               8 ./vops/ak/agltl.x  procedure agltl (a, b, npix, low, high, kmul, kadd, nrange)
+agltr               8 ./vops/ak/agltr.x  procedure agltr (a, b, npix, low, high, kmul, kadd, nrange)
+aglts               8 ./vops/ak/aglts.x  procedure aglts (a, b, npix, low, high, kmul, kadd, nrange)
+agltx               8 ./vops/ak/agltx.x  procedure agltx (a, b, npix, low, high, kmul, kadd, nrange)
+ahgm                8 ./vops/ahgm.gx     procedure ahgm$t (data, npix, hgm, nbins, z1, z2)
+ahgmc               8 ./vops/ak/ahgmc.x  procedure ahgmc (data, npix, hgm, nbins, z1, z2)
+ahgmd               8 ./vops/ak/ahgmd.x  procedure ahgmd (data, npix, hgm, nbins, z1, z2)
+ahgmi               8 ./vops/ak/ahgmi.x  procedure ahgmi (data, npix, hgm, nbins, z1, z2)
+ahgml               8 ./vops/ak/ahgml.x  procedure ahgml (data, npix, hgm, nbins, z1, z2)
+ahgmr               8 ./vops/ak/ahgmr.x  procedure ahgmr (data, npix, hgm, nbins, z1, z2)
+ahgms               8 ./vops/ak/ahgms.x  procedure ahgms (data, npix, hgm, nbins, z1, z2)
+ahiv                5 ./vops/ahiv.gx     PIXEL procedure ahiv$t (a, npix)
+ahivc               5 ./vops/ak/ahivc.x  char procedure ahivc (a, npix)
+ahivd               5 ./vops/ak/ahivd.x  double procedure ahivd (a, npix)
+ahivi               5 ./vops/ak/ahivi.x  int procedure ahivi (a, npix)
+ahivl               5 ./vops/ak/ahivl.x  long procedure ahivl (a, npix)
+ahivr               5 ./vops/ak/ahivr.x  real procedure ahivr (a, npix)
+ahivs               5 ./vops/ak/ahivs.x  short procedure ahivs (a, npix)
+ahivx               5 ./vops/ak/ahivx.x  complex procedure ahivx (a, npix)
+aiftrr             10 ./vops/aiftrr.x    procedure aiftrr (fr, fi, sr, si, npix)
+aiftrr             10 ./vops/ak/aiftrr.x procedure aiftrr (fr, fi, sr, si, npix)
+aiftrx             16 ./vops/aiftrx.x    procedure aiftrx (a, b, npix)
+aiftrx             16 ./vops/ak/aiftrx.x procedure aiftrx (a, b, npix)
+aiftxr              9 ./vops/aiftxr.x    procedure aiftxr (fr, fi, sr, si, npix)
+aiftxr              9 ./vops/ak/aiftxr.x procedure aiftxr (fr, fi, sr, si, npix)
+aiftxx             16 ./vops/aiftxx.x    procedure aiftxx (a, b, npix)
+aiftxx             16 ./vops/ak/aiftxx.x procedure aiftxx (a, b, npix)
+aimg                5 ./vops/aimg.gx     procedure aimg$t (a, b, npix)
+aimgd               5 ./vops/ak/aimgd.x  procedure aimgd (a, b, npix)
+aimgi               5 ./vops/ak/aimgi.x  procedure aimgi (a, b, npix)
+aimgl               5 ./vops/ak/aimgl.x  procedure aimgl (a, b, npix)
+aimgr               5 ./vops/ak/aimgr.x  procedure aimgr (a, b, npix)
+aimgs               5 ./vops/ak/aimgs.x  procedure aimgs (a, b, npix)
+alim                5 ./vops/alim.gx     procedure alim$t (a, npix, minval, maxval)
+alimc               5 ./vops/lz/alimc.x  procedure alimc (a, npix, minval, maxval)
+alimd               5 ./vops/lz/alimd.x  procedure alimd (a, npix, minval, maxval)
+alimi               5 ./vops/lz/alimi.x  procedure alimi (a, npix, minval, maxval)
+aliml               5 ./vops/lz/aliml.x  procedure aliml (a, npix, minval, maxval)
+alimr               5 ./vops/lz/alimr.x  procedure alimr (a, npix, minval, maxval)
+alims               5 ./vops/lz/alims.x  procedure alims (a, npix, minval, maxval)
+alimx               5 ./vops/lz/alimx.x  procedure alimx (a, npix, minval, maxval)
+alln                7 ./vops/alln.gx     procedure alln$t (a, b, npix, errfcn)
+allnd               7 ./vops/lz/allnd.x  procedure allnd (a, b, npix, errfcn)
+allni               7 ./vops/lz/allni.x  procedure allni (a, b, npix, errfcn)
+allnl               7 ./vops/lz/allnl.x  procedure allnl (a, b, npix, errfcn)
+allnr               7 ./vops/lz/allnr.x  procedure allnr (a, b, npix, errfcn)
+allns               7 ./vops/lz/allns.x  procedure allns (a, b, npix, errfcn)
+allnx               7 ./vops/lz/allnx.x  procedure allnx (a, b, npix, errfcn)
+alloc               2 ../unix/os/alloc.c alloc (argv, statonly)
+alog                7 ./vops/alog.gx     procedure alog$t (a, b, npix, errfcn)
+alogd               7 ./vops/lz/alogd.x  procedure alogd (a, b, npix, errfcn)
+alogi               7 ./vops/lz/alogi.x  procedure alogi (a, b, npix, errfcn)
+alogl               7 ./vops/lz/alogl.x  procedure alogl (a, b, npix, errfcn)
+alogr               7 ./vops/lz/alogr.x  procedure alogr (a, b, npix, errfcn)
+alogs               7 ./vops/lz/alogs.x  procedure alogs (a, b, npix, errfcn)
+alogx               7 ./vops/lz/alogx.x  procedure alogx (a, b, npix, errfcn)
+alov                5 ./vops/alov.gx     PIXEL procedure alov$t (a, npix)
+alovc               5 ./vops/lz/alovc.x  char procedure alovc (a, npix)
+alovd               5 ./vops/lz/alovd.x  double procedure alovd (a, npix)
+alovi               5 ./vops/lz/alovi.x  int procedure alovi (a, npix)
+alovl               5 ./vops/lz/alovl.x  long procedure alovl (a, npix)
+alovr               5 ./vops/lz/alovr.x  real procedure alovr (a, npix)
+alovs               5 ./vops/lz/alovs.x  short procedure alovs (a, npix)
+alovx               5 ./vops/lz/alovx.x  complex procedure alovx (a, npix)
+alta                6 ./vops/alta.gx     procedure alta$t (a, b, npix, k1, k2)
+altad               6 ./vops/lz/altad.x  procedure altad (a, b, npix, k1, k2)
+altai               6 ./vops/lz/altai.x  procedure altai (a, b, npix, k1, k2)
+altal               6 ./vops/lz/altal.x  procedure altal (a, b, npix, k1, k2)
+altar               6 ./vops/lz/altar.x  procedure altar (a, b, npix, k1, k2)
+altas               6 ./vops/lz/altas.x  procedure altas (a, b, npix, k1, k2)
+altax               6 ./vops/lz/altax.x  procedure altax (a, b, npix, k1, k2)
+altm                6 ./vops/altm.gx     procedure altm$t (a, b, npix, k1, k2)
+altmd               6 ./vops/lz/altmd.x  procedure altmd (a, b, npix, k1, k2)
+altmi               6 ./vops/lz/altmi.x  procedure altmi (a, b, npix, k1, k2)
+altml               6 ./vops/lz/altml.x  procedure altml (a, b, npix, k1, k2)
+altmr               6 ./vops/lz/altmr.x  procedure altmr (a, b, npix, k1, k2)
+altms               6 ./vops/lz/altms.x  procedure altms (a, b, npix, k1, k2)
+altmx               6 ./vops/lz/altmx.x  procedure altmx (a, b, npix, k1, k2)
+altr                7 ./vops/altr.gx     procedure altr$t (a, b, npix, k1, k2, k3)
+altrd               7 ./vops/lz/altrd.x  procedure altrd (a, b, npix, k1, k2, k3)
+altri               7 ./vops/lz/altri.x  procedure altri (a, b, npix, k1, k2, k3)
+altrl               7 ./vops/lz/altrl.x  procedure altrl (a, b, npix, k1, k2, k3)
+altrr               7 ./vops/lz/altrr.x  procedure altrr (a, b, npix, k1, k2, k3)
+altrs               7 ./vops/lz/altrs.x  procedure altrs (a, b, npix, k1, k2, k3)
+altrx               7 ./vops/lz/altrx.x  procedure altrx (a, b, npix, k1, k2, k3)
+alui               12 ./vops/alui.gx     procedure alui$t (a, b, x, npix)
+aluid              12 ./vops/lz/aluid.x  procedure aluid (a, b, x, npix)
+aluii              12 ./vops/lz/aluii.x  procedure aluii (a, b, x, npix)
+aluil              12 ./vops/lz/aluil.x  procedure aluil (a, b, x, npix)
+aluir              12 ./vops/lz/aluir.x  procedure aluir (a, b, x, npix)
+aluis              12 ./vops/lz/aluis.x  procedure aluis (a, b, x, npix)
+alut                7 ./vops/alut.gx     procedure alut$t (a, b, npix, lut)
+alutc               7 ./vops/lz/alutc.x  procedure alutc (a, b, npix, lut)
+alutd               7 ./vops/lz/alutd.x  procedure alutd (a, b, npix, lut)
+aluti               7 ./vops/lz/aluti.x  procedure aluti (a, b, npix, lut)
+alutl               7 ./vops/lz/alutl.x  procedure alutl (a, b, npix, lut)
+alutr               7 ./vops/lz/alutr.x  procedure alutr (a, b, npix, lut)
+aluts               7 ./vops/lz/aluts.x  procedure aluts (a, b, npix, lut)
+amag                5 ./vops/amag.gx     procedure amag$t (a, b, c, npix)
+amagd               5 ./vops/lz/amagd.x  procedure amagd (a, b, c, npix)
+amagi               5 ./vops/lz/amagi.x  procedure amagi (a, b, c, npix)
+amagl               5 ./vops/lz/amagl.x  procedure amagl (a, b, c, npix)
+amagr               5 ./vops/lz/amagr.x  procedure amagr (a, b, c, npix)
+amags               5 ./vops/lz/amags.x  procedure amags (a, b, c, npix)
+amagx               5 ./vops/lz/amagx.x  procedure amagx (a, b, c, npix)
+amap                7 ./vops/amap.gx     procedure amap$t (a, b, npix, a1, a2, b1, b2)
+amapd               7 ./vops/lz/amapd.x  procedure amapd (a, b, npix, a1, a2, b1, b2)
+amapi               7 ./vops/lz/amapi.x  procedure amapi (a, b, npix, a1, a2, b1, b2)
+amapl               7 ./vops/lz/amapl.x  procedure amapl (a, b, npix, a1, a2, b1, b2)
+amapr               7 ./vops/lz/amapr.x  procedure amapr (a, b, npix, a1, a2, b1, b2)
+amaps               7 ./vops/lz/amaps.x  procedure amaps (a, b, npix, a1, a2, b1, b2)
+amax                5 ./vops/amax.gx     procedure amax$t (a, b, c, npix)
+amaxc               5 ./vops/lz/amaxc.x  procedure amaxc (a, b, c, npix)
+amaxd               5 ./vops/lz/amaxd.x  procedure amaxd (a, b, c, npix)
+amaxi               5 ./vops/lz/amaxi.x  procedure amaxi (a, b, c, npix)
+amaxk               5 ./vops/amaxk.gx    procedure amaxk$t (a, b, c, npix)
+amaxkc              5 ./vops/lz/amaxkc.x procedure amaxkc (a, b, c, npix)
+amaxkd              5 ./vops/lz/amaxkd.x procedure amaxkd (a, b, c, npix)
+amaxki              5 ./vops/lz/amaxki.x procedure amaxki (a, b, c, npix)
+amaxkl              5 ./vops/lz/amaxkl.x procedure amaxkl (a, b, c, npix)
+amaxkr              5 ./vops/lz/amaxkr.x procedure amaxkr (a, b, c, npix)
+amaxks              5 ./vops/lz/amaxks.x procedure amaxks (a, b, c, npix)
+amaxkx              5 ./vops/lz/amaxkx.x procedure amaxkx (a, b, c, npix)
+amaxl               5 ./vops/lz/amaxl.x  procedure amaxl (a, b, c, npix)
+amaxr               5 ./vops/lz/amaxr.x  procedure amaxr (a, b, c, npix)
+amaxs               5 ./vops/lz/amaxs.x  procedure amaxs (a, b, c, npix)
+amaxx               5 ./vops/lz/amaxx.x  procedure amaxx (a, b, c, npix)
+amed                8 ./vops/amed.gx     PIXEL procedure amed$t (a, npix)
+amed3               6 ./vops/amed3.gx    procedure amed3$t (a, b, c, m, npix)
+amed3c              6 ./vops/lz/amed3c.x procedure amed3c (a, b, c, m, npix)
+amed3d              6 ./vops/lz/amed3d.x procedure amed3d (a, b, c, m, npix)
+amed3i              6 ./vops/lz/amed3i.x procedure amed3i (a, b, c, m, npix)
+amed3l              6 ./vops/lz/amed3l.x procedure amed3l (a, b, c, m, npix)
+amed3r              6 ./vops/lz/amed3r.x procedure amed3r (a, b, c, m, npix)
+amed3s              6 ./vops/lz/amed3s.x procedure amed3s (a, b, c, m, npix)
+amed4               8 ./vops/amed4.gx    procedure amed4$t (a, b, c, d, m, npix)
+amed4c              8 ./vops/lz/amed4c.x procedure amed4c (a, b, c, d, m, npix)
+amed4d              8 ./vops/lz/amed4d.x procedure amed4d (a, b, c, d, m, npix)
+amed4i              8 ./vops/lz/amed4i.x procedure amed4i (a, b, c, d, m, npix)
+amed4l              8 ./vops/lz/amed4l.x procedure amed4l (a, b, c, d, m, npix)
+amed4r              8 ./vops/lz/amed4r.x procedure amed4r (a, b, c, d, m, npix)
+amed4s              8 ./vops/lz/amed4s.x procedure amed4s (a, b, c, d, m, npix)
+amed5               7 ./vops/amed5.gx    procedure amed5$t (a, b, c, d, e, m, npix)
+amed5c              7 ./vops/lz/amed5c.x procedure amed5c (a, b, c, d, e, m, npix)
+amed5d              7 ./vops/lz/amed5d.x procedure amed5d (a, b, c, d, e, m, npix)
+amed5i              7 ./vops/lz/amed5i.x procedure amed5i (a, b, c, d, e, m, npix)
+amed5l              7 ./vops/lz/amed5l.x procedure amed5l (a, b, c, d, e, m, npix)
+amed5r              7 ./vops/lz/amed5r.x procedure amed5r (a, b, c, d, e, m, npix)
+amed5s              7 ./vops/lz/amed5s.x procedure amed5s (a, b, c, d, e, m, npix)
+amedc               8 ./vops/lz/amedc.x  char procedure amedc (a, npix)
+amedd               8 ./vops/lz/amedd.x  double procedure amedd (a, npix)
+amedi               8 ./vops/lz/amedi.x  int procedure amedi (a, npix)
+amedl               8 ./vops/lz/amedl.x  long procedure amedl (a, npix)
+amedr               8 ./vops/lz/amedr.x  real procedure amedr (a, npix)
+ameds               8 ./vops/lz/ameds.x  short procedure ameds (a, npix)
+amedx               8 ./vops/lz/amedx.x  complex procedure amedx (a, npix)
+amgs                5 ./vops/amgs.gx     procedure amgs$t (a, b, c, npix)
+amgsd               5 ./vops/lz/amgsd.x  procedure amgsd (a, b, c, npix)
+amgsi               5 ./vops/lz/amgsi.x  procedure amgsi (a, b, c, npix)
+amgsl               5 ./vops/lz/amgsl.x  procedure amgsl (a, b, c, npix)
+amgsr               5 ./vops/lz/amgsr.x  procedure amgsr (a, b, c, npix)
+amgss               5 ./vops/lz/amgss.x  procedure amgss (a, b, c, npix)
+amgsx               5 ./vops/lz/amgsx.x  procedure amgsx (a, b, c, npix)
+amin                5 ./vops/amin.gx     procedure amin$t (a, b, c, npix)
+aminc               5 ./vops/lz/aminc.x  procedure aminc (a, b, c, npix)
+amind               5 ./vops/lz/amind.x  procedure amind (a, b, c, npix)
+amini               5 ./vops/lz/amini.x  procedure amini (a, b, c, npix)
+amink               5 ./vops/amink.gx    procedure amink$t (a, b, c, npix)
+aminkc              5 ./vops/lz/aminkc.x procedure aminkc (a, b, c, npix)
+aminkd              5 ./vops/lz/aminkd.x procedure aminkd (a, b, c, npix)
+aminki              5 ./vops/lz/aminki.x procedure aminki (a, b, c, npix)
+aminkl              5 ./vops/lz/aminkl.x procedure aminkl (a, b, c, npix)
+aminkr              5 ./vops/lz/aminkr.x procedure aminkr (a, b, c, npix)
+aminks              5 ./vops/lz/aminks.x procedure aminks (a, b, c, npix)
+aminkx              5 ./vops/lz/aminkx.x procedure aminkx (a, b, c, npix)
+aminl               5 ./vops/lz/aminl.x  procedure aminl (a, b, c, npix)
+aminr               5 ./vops/lz/aminr.x  procedure aminr (a, b, c, npix)
+amins               5 ./vops/lz/amins.x  procedure amins (a, b, c, npix)
+aminx               5 ./vops/lz/aminx.x  procedure aminx (a, b, c, npix)
+amod                5 ./vops/amod.gx     procedure amod$t (a, b, c, npix)
+amodd               5 ./vops/lz/amodd.x  procedure amodd (a, b, c, npix)
+amodi               5 ./vops/lz/amodi.x  procedure amodi (a, b, c, npix)
+amodk               5 ./vops/amodk.gx    procedure amodk$t (a, b, c, npix)
+amodkd              5 ./vops/lz/amodkd.x procedure amodkd (a, b, c, npix)
+amodki              5 ./vops/lz/amodki.x procedure amodki (a, b, c, npix)
+amodkl              5 ./vops/lz/amodkl.x procedure amodkl (a, b, c, npix)
+amodkr              5 ./vops/lz/amodkr.x procedure amodkr (a, b, c, npix)
+amodks              5 ./vops/lz/amodks.x procedure amodks (a, b, c, npix)
+amodl               5 ./vops/lz/amodl.x  procedure amodl (a, b, c, npix)
+amodr               5 ./vops/lz/amodr.x  procedure amodr (a, b, c, npix)
+amods               5 ./vops/lz/amods.x  procedure amods (a, b, c, npix)
+amov                7 ./vops/amov.gx     procedure amov$t (a, b, npix)
+amovc               7 ./vops/lz/amovc.x  procedure amovc (a, b, npix)
+amovd               7 ./vops/lz/amovd.x  procedure amovd (a, b, npix)
+amovi               7 ./vops/lz/amovi.x  procedure amovi (a, b, npix)
+amovk               5 ./vops/amovk.gx    procedure amovk$t (a, b, npix)
+amovkc              5 ./vops/lz/amovkc.x procedure amovkc (a, b, npix)
+amovkd              5 ./vops/lz/amovkd.x procedure amovkd (a, b, npix)
+amovki              5 ./vops/lz/amovki.x procedure amovki (a, b, npix)
+amovkl              5 ./vops/lz/amovkl.x procedure amovkl (a, b, npix)
+amovkr              5 ./vops/lz/amovkr.x procedure amovkr (a, b, npix)
+amovks              5 ./vops/lz/amovks.x procedure amovks (a, b, npix)
+amovkx              5 ./vops/lz/amovkx.x procedure amovkx (a, b, npix)
+amovl               7 ./vops/lz/amovl.x  procedure amovl (a, b, npix)
+amovr               7 ./vops/lz/amovr.x  procedure amovr (a, b, npix)
+amovs               7 ./vops/lz/amovs.x  procedure amovs (a, b, npix)
+amovx               7 ./vops/lz/amovx.x  procedure amovx (a, b, npix)
+amul                5 ./vops/amul.gx     procedure amul$t (a, b, c, npix)
+amuld               5 ./vops/lz/amuld.x  procedure amuld (a, b, c, npix)
+amuli               5 ./vops/lz/amuli.x  procedure amuli (a, b, c, npix)
+amulk               5 ./vops/amulk.gx    procedure amulk$t (a, b, c, npix)
+amulkd              5 ./vops/lz/amulkd.x procedure amulkd (a, b, c, npix)
+amulki              5 ./vops/lz/amulki.x procedure amulki (a, b, c, npix)
+amulkl              5 ./vops/lz/amulkl.x procedure amulkl (a, b, c, npix)
+amulkr              5 ./vops/lz/amulkr.x procedure amulkr (a, b, c, npix)
+amulks              5 ./vops/lz/amulks.x procedure amulks (a, b, c, npix)
+amulkx              5 ./vops/lz/amulkx.x procedure amulkx (a, b, c, npix)
+amull               5 ./vops/lz/amull.x  procedure amull (a, b, c, npix)
+amulr               5 ./vops/lz/amulr.x  procedure amulr (a, b, c, npix)
+amuls               5 ./vops/lz/amuls.x  procedure amuls (a, b, c, npix)
+amulx               5 ./vops/lz/amulx.x  procedure amulx (a, b, c, npix)
+aneg                5 ./vops/aneg.gx     procedure aneg$t (a, b, npix)
+anegd               5 ./vops/lz/anegd.x  procedure anegd (a, b, npix)
+anegi               5 ./vops/lz/anegi.x  procedure anegi (a, b, npix)
+anegl               5 ./vops/lz/anegl.x  procedure anegl (a, b, npix)
+anegr               5 ./vops/lz/anegr.x  procedure anegr (a, b, npix)
+anegs               5 ./vops/lz/anegs.x  procedure anegs (a, b, npix)
+anegx               5 ./vops/lz/anegx.x  procedure anegx (a, b, npix)
+anot                5 ./vops/anot.gx     procedure anot$t (a, b, npix)
+anoti               5 ./vops/lz/anoti.x  procedure anoti (a, b, npix)
+anotl               5 ./vops/lz/anotl.x  procedure anotl (a, b, npix)
+anots               5 ./vops/lz/anots.x  procedure anots (a, b, npix)
+apkx                6 ./vops/apkx.gx     procedure apkx$t (a, b, c, npix)
+apkxd               6 ./vops/lz/apkxd.x  procedure apkxd (a, b, c, npix)
+apkxi               6 ./vops/lz/apkxi.x  procedure apkxi (a, b, c, npix)
+apkxl               6 ./vops/lz/apkxl.x  procedure apkxl (a, b, c, npix)
+apkxr               6 ./vops/lz/apkxr.x  procedure apkxr (a, b, c, npix)
+apkxs               6 ./vops/lz/apkxs.x  procedure apkxs (a, b, c, npix)
+apkxx               6 ./vops/lz/apkxx.x  procedure apkxx (a, b, c, npix)
+apol                6 ./vops/apol.gx     PIXEL procedure apol$t (x, coeff, ncoeff)
+apold               6 ./vops/lz/apold.x  double procedure apold (x, coeff, ncoeff)
+apolr               6 ./vops/lz/apolr.x  real procedure apolr (x, coeff, ncoeff)
+apow                5 ./vops/apow.gx     procedure apow$t (a, b, c, npix)
+apowd               5 ./vops/lz/apowd.x  procedure apowd (a, b, c, npix)
+apowi               5 ./vops/lz/apowi.x  procedure apowi (a, b, c, npix)
+apowk               5 ./vops/apowk.gx    procedure apowk$t (a, b, c, npix)
+apowkd              5 ./vops/lz/apowkd.x procedure apowkd (a, b, c, npix)
+apowki              5 ./vops/lz/apowki.x procedure apowki (a, b, c, npix)
+apowkl              5 ./vops/lz/apowkl.x procedure apowkl (a, b, c, npix)
+apowkr              5 ./vops/lz/apowkr.x procedure apowkr (a, b, c, npix)
+apowks              5 ./vops/lz/apowks.x procedure apowks (a, b, c, npix)
+apowkx              5 ./vops/lz/apowkx.x procedure apowkx (a, b, c, npix)
+apowl               5 ./vops/lz/apowl.x  procedure apowl (a, b, c, npix)
+apowr               5 ./vops/lz/apowr.x  procedure apowr (a, b, c, npix)
+apows               5 ./vops/lz/apows.x  procedure apows (a, b, c, npix)
+apowx               5 ./vops/lz/apowx.x  procedure apowx (a, b, c, npix)
+arav               12 ./vops/arav.gx     int procedure arav$t (a, npix, mean, sigma, ksig)
+aravd              12 ./vops/lz/aravd.x  int procedure aravd (a, npix, mean, sigma, ksig)
+aravi              12 ./vops/lz/aravi.x  int procedure aravi (a, npix, mean, sigma, ksig)
+aravl              12 ./vops/lz/aravl.x  int procedure aravl (a, npix, mean, sigma, ksig)
+aravr              12 ./vops/lz/aravr.x  int procedure aravr (a, npix, mean, sigma, ksig)
+aravs              12 ./vops/lz/aravs.x  int procedure aravs (a, npix, mean, sigma, ksig)
+aravx              12 ./vops/lz/aravx.x  int procedure aravx (a, npix, mean, sigma, ksig)
+arcp                6 ./vops/arcp.gx     procedure arcp$t (a, b, c, npix)
+arcpd               6 ./vops/lz/arcpd.x  procedure arcpd (a, b, c, npix)
+arcpi               6 ./vops/lz/arcpi.x  procedure arcpi (a, b, c, npix)
+arcpl               6 ./vops/lz/arcpl.x  procedure arcpl (a, b, c, npix)
+arcpr               6 ./vops/lz/arcpr.x  procedure arcpr (a, b, c, npix)
+arcps               6 ./vops/lz/arcps.x  procedure arcps (a, b, c, npix)
+arcpx               6 ./vops/lz/arcpx.x  procedure arcpx (a, b, c, npix)
+arcz               13 ./vops/arcz.gx     procedure arcz$t (a, b, c, npix, errfcn)
+arczd              13 ./vops/lz/arczd.x  procedure arczd (a, b, c, npix, errfcn)
+arczi              13 ./vops/lz/arczi.x  procedure arczi (a, b, c, npix, errfcn)
+arczl              13 ./vops/lz/arczl.x  procedure arczl (a, b, c, npix, errfcn)
+arczr              13 ./vops/lz/arczr.x  procedure arczr (a, b, c, npix, errfcn)
+arczs              13 ./vops/lz/arczs.x  procedure arczs (a, b, c, npix, errfcn)
+arczx              13 ./vops/lz/arczx.x  procedure arczx (a, b, c, npix, errfcn)
+aread               9 ./fio/aread.x      procedure aread (fd, buffer, maxchars, char_offset)
+areadb             12 ./fio/areadb.x     procedure areadb (fd, buffer, maxbytes, byte_offset)
+argt                6 ./vops/argt.gx     procedure argt$t (a, npix, ceil, newval)
+argtd               6 ./vops/lz/argtd.x  procedure argtd (a, npix, ceil, newval)
+argti               6 ./vops/lz/argti.x  procedure argti (a, npix, ceil, newval)
+argtl               6 ./vops/lz/argtl.x  procedure argtl (a, npix, ceil, newval)
+argtr               6 ./vops/lz/argtr.x  procedure argtr (a, npix, ceil, newval)
+argts               6 ./vops/lz/argts.x  procedure argts (a, npix, ceil, newval)
+argtx               6 ./vops/lz/argtx.x  procedure argtx (a, npix, ceil, newval)
+arlt                5 ./vops/arlt.gx     procedure arlt$t (a, npix, floor, newval)
+arltd               5 ./vops/lz/arltd.x  procedure arltd (a, npix, floor, newval)
+arlti               5 ./vops/lz/arlti.x  procedure arlti (a, npix, floor, newval)
+arltl               5 ./vops/lz/arltl.x  procedure arltl (a, npix, floor, newval)
+arltr               5 ./vops/lz/arltr.x  procedure arltr (a, npix, floor, newval)
+arlts               5 ./vops/lz/arlts.x  procedure arlts (a, npix, floor, newval)
+arltx               5 ./vops/lz/arltx.x  procedure arltx (a, npix, floor, newval)
+asel                8 ./vops/asel.gx     procedure asel$t (a, b, c, sel, npix)
+aselc               8 ./vops/lz/aselc.x  procedure aselc (a, b, c, sel, npix)
+aseld               8 ./vops/lz/aseld.x  procedure aseld (a, b, c, sel, npix)
+aseli               8 ./vops/lz/aseli.x  procedure aseli (a, b, c, sel, npix)
+aselk               8 ./vops/aselk.gx    procedure aselk$t (a, b, c, sel, npix)
+aselkc              8 ./vops/lz/aselkc.x procedure aselkc (a, b, c, sel, npix)
+aselkd              8 ./vops/lz/aselkd.x procedure aselkd (a, b, c, sel, npix)
+aselki              8 ./vops/lz/aselki.x procedure aselki (a, b, c, sel, npix)
+aselkl              8 ./vops/lz/aselkl.x procedure aselkl (a, b, c, sel, npix)
+aselkr              8 ./vops/lz/aselkr.x procedure aselkr (a, b, c, sel, npix)
+aselks              8 ./vops/lz/aselks.x procedure aselks (a, b, c, sel, npix)
+aselkx              8 ./vops/lz/aselkx.x procedure aselkx (a, b, c, sel, npix)
+asell               8 ./vops/lz/asell.x  procedure asell (a, b, c, sel, npix)
+aselr               8 ./vops/lz/aselr.x  procedure aselr (a, b, c, sel, npix)
+asels               8 ./vops/lz/asels.x  procedure asels (a, b, c, sel, npix)
+aselx               8 ./vops/lz/aselx.x  procedure aselx (a, b, c, sel, npix)
+asok               18 ./vops/asok.gx     PIXEL procedure asok$t (a, npix, ksel)
+asokc              18 ./vops/lz/asokc.x  char procedure asokc (a, npix, ksel)
+asokd              18 ./vops/lz/asokd.x  double procedure asokd (a, npix, ksel)
+asoki              18 ./vops/lz/asoki.x  int procedure asoki (a, npix, ksel)
+asokl              18 ./vops/lz/asokl.x  long procedure asokl (a, npix, ksel)
+asokr              18 ./vops/lz/asokr.x  real procedure asokr (a, npix, ksel)
+asoks              18 ./vops/lz/asoks.x  short procedure asoks (a, npix, ksel)
+asokx              18 ./vops/lz/asokx.x  complex procedure asokx (a, npix, ksel)
+asqr                6 ./vops/asqr.gx     procedure asqr$t (a, b, npix, errfcn)
+asqrd               6 ./vops/lz/asqrd.x  procedure asqrd (a, b, npix, errfcn)
+asqri               6 ./vops/lz/asqri.x  procedure asqri (a, b, npix, errfcn)
+asqrl               6 ./vops/lz/asqrl.x  procedure asqrl (a, b, npix, errfcn)
+asqrr               6 ./vops/lz/asqrr.x  procedure asqrr (a, b, npix, errfcn)
+asqrs               6 ./vops/lz/asqrs.x  procedure asqrs (a, b, npix, errfcn)
+asqrx               6 ./vops/lz/asqrx.x  procedure asqrx (a, b, npix, errfcn)
+asrt                8 ./vops/asrt.gx     procedure asrt$t (a, b, npix)
+asrtc               8 ./vops/lz/asrtc.x  procedure asrtc (a, b, npix)
+asrtd               8 ./vops/lz/asrtd.x  procedure asrtd (a, b, npix)
+asrti               8 ./vops/lz/asrti.x  procedure asrti (a, b, npix)
+asrtl               8 ./vops/lz/asrtl.x  procedure asrtl (a, b, npix)
+asrtr               8 ./vops/lz/asrtr.x  procedure asrtr (a, b, npix)
+asrts               8 ./vops/lz/asrts.x  procedure asrts (a, b, npix)
+asrtx               8 ./vops/lz/asrtx.x  procedure asrtx (a, b, npix)
+assq                6 ./vops/assq.gx     real procedure assq$t (a, npix)
+assq                9 ./vops/assq.gx     double procedure assq$t (a, npix)
+assq               12 ./vops/assq.gx     PIXEL procedure assq$t (a, npix)
+assqd               5 ./vops/lz/assqd.x  double procedure assqd (a, npix)
+assqi               5 ./vops/lz/assqi.x  real procedure assqi (a, npix)
+assql               5 ./vops/lz/assql.x  double procedure assql (a, npix)
+assqr               5 ./vops/lz/assqr.x  real procedure assqr (a, npix)
+assqs               5 ./vops/lz/assqs.x  real procedure assqs (a, npix)
+assqx               5 ./vops/lz/assqx.x  complex procedure assqx (a, npix)
+asub                5 ./vops/asub.gx     procedure asub$t (a, b, c, npix)
+asubd               5 ./vops/lz/asubd.x  procedure asubd (a, b, c, npix)
+asubi               5 ./vops/lz/asubi.x  procedure asubi (a, b, c, npix)
+asubk               5 ./vops/asubk.gx    procedure asubk$t (a, b, c, npix)
+asubkd              5 ./vops/lz/asubkd.x procedure asubkd (a, b, c, npix)
+asubki              5 ./vops/lz/asubki.x procedure asubki (a, b, c, npix)
+asubkl              5 ./vops/lz/asubkl.x procedure asubkl (a, b, c, npix)
+asubkr              5 ./vops/lz/asubkr.x procedure asubkr (a, b, c, npix)
+asubks              5 ./vops/lz/asubks.x procedure asubks (a, b, c, npix)
+asubkx              5 ./vops/lz/asubkx.x procedure asubkx (a, b, c, npix)
+asubl               5 ./vops/lz/asubl.x  procedure asubl (a, b, c, npix)
+asubr               5 ./vops/lz/asubr.x  procedure asubr (a, b, c, npix)
+asubs               5 ./vops/lz/asubs.x  procedure asubs (a, b, c, npix)
+asubx               5 ./vops/lz/asubx.x  procedure asubx (a, b, c, npix)
+asum                7 ./vops/asum.gx     real procedure asum$t (a, npix)
+asum                9 ./vops/asum.gx     double procedure asum$t (a, npix)
+asum               11 ./vops/asum.gx     PIXEL procedure asum$t (a, npix)
+asumd               6 ./vops/lz/asumd.x  double procedure asumd (a, npix)
+asumi               6 ./vops/lz/asumi.x  real procedure asumi (a, npix)
+asuml               6 ./vops/lz/asuml.x  double procedure asuml (a, npix)
+asumr               6 ./vops/lz/asumr.x  real procedure asumr (a, npix)
+asums               6 ./vops/lz/asums.x  real procedure asums (a, npix)
+asumx               6 ./vops/lz/asumx.x  complex procedure asumx (a, npix)
+atof                1 ./libc/atof.c      atof (str)
+atoi                1 ./libc/atoi.c      atoi (str)
+atol                1 ./libc/atol.c      atol (str)
+aupx                6 ./vops/aupx.gx     procedure aupx$t (a, b, c, npix)
+aupxd               6 ./vops/lz/aupxd.x  procedure aupxd (a, b, c, npix)
+aupxi               6 ./vops/lz/aupxi.x  procedure aupxi (a, b, c, npix)
+aupxl               6 ./vops/lz/aupxl.x  procedure aupxl (a, b, c, npix)
+aupxr               6 ./vops/lz/aupxr.x  procedure aupxr (a, b, c, npix)
+aupxs               6 ./vops/lz/aupxs.x  procedure aupxs (a, b, c, npix)
+aupxx               6 ./vops/lz/aupxx.x  procedure aupxx (a, b, c, npix)
+aveq                5 ./vops/aveq.gx     bool procedure aveq$t (a, b, npix)
+aveqc               5 ./vops/lz/aveqc.x  bool procedure aveqc (a, b, npix)
+aveqd               5 ./vops/lz/aveqd.x  bool procedure aveqd (a, b, npix)
+aveqi               5 ./vops/lz/aveqi.x  bool procedure aveqi (a, b, npix)
+aveql               5 ./vops/lz/aveql.x  bool procedure aveql (a, b, npix)
+aveqr               5 ./vops/lz/aveqr.x  bool procedure aveqr (a, b, npix)
+aveqs               5 ./vops/lz/aveqs.x  bool procedure aveqs (a, b, npix)
+aveqx               5 ./vops/lz/aveqx.x  bool procedure aveqx (a, b, npix)
+await              12 ./fio/await.x      int procedure await (fd)
+awaitb             11 ./fio/awaitb.x     int procedure awaitb (fd)
+awrite              9 ./fio/awrite.x     procedure awrite (fd, buffer, nchars, char_offset)
+awriteb            12 ./fio/awriteb.x    procedure awriteb (fd, buffer, nbytes, byte_offset)
+awsu                5 ./vops/awsu.gx     procedure awsu$t (a, b, c, npix, k1, k2)
+awsud               5 ./vops/lz/awsud.x  procedure awsud (a, b, c, npix, k1, k2)
+awsui               5 ./vops/lz/awsui.x  procedure awsui (a, b, c, npix, k1, k2)
+awsul               5 ./vops/lz/awsul.x  procedure awsul (a, b, c, npix, k1, k2)
+awsur               5 ./vops/lz/awsur.x  procedure awsur (a, b, c, npix, k1, k2)
+awsus               5 ./vops/lz/awsus.x  procedure awsus (a, b, c, npix, k1, k2)
+awsux               5 ./vops/lz/awsux.x  procedure awsux (a, b, c, npix, k1, k2)
+awvg                9 ./vops/awvg.gx     int procedure awvg$t (a, npix, mean, sigma, lcut, hcut)
+awvgd               9 ./vops/lz/awvgd.x  int procedure awvgd (a, npix, mean, sigma, lcut, hcut)
+awvgi               9 ./vops/lz/awvgi.x  int procedure awvgi (a, npix, mean, sigma, lcut, hcut)
+awvgl               9 ./vops/lz/awvgl.x  int procedure awvgl (a, npix, mean, sigma, lcut, hcut)
+awvgr               9 ./vops/lz/awvgr.x  int procedure awvgr (a, npix, mean, sigma, lcut, hcut)
+awvgs               9 ./vops/lz/awvgs.x  int procedure awvgs (a, npix, mean, sigma, lcut, hcut)
+awvgx               9 ./vops/lz/awvgx.x  int procedure awvgx (a, npix, mean, sigma, lcut, hcut)
+axor                5 ./vops/axor.gx     procedure axor$t (a, b, c, npix)
+axori               5 ./vops/lz/axori.x  procedure axori (a, b, c, npix)
+axork               5 ./vops/axork.gx    procedure axork$t (a, b, c, npix)
+axorki              5 ./vops/lz/axorki.x procedure axorki (a, b, c, npix)
+axorkl              5 ./vops/lz/axorkl.x procedure axorkl (a, b, c, npix)
+axorks              5 ./vops/lz/axorks.x procedure axorks (a, b, c, npix)
+axorl               5 ./vops/lz/axorl.x  procedure axorl (a, b, c, npix)
+axors               5 ./vops/lz/axors.x  procedure axors (a, b, c, npix)
+balls             243 ./gio/zzdebug.x    procedure balls()
+begmem             38 ./memdbg/begmem.x  int procedure begmem (best_size, old_size, max_size)
+begmem             38 ./memio/begmem.x   int procedure begmem (best_size, old_size, max_size)
+bfalcx            178 ./imfort/bfio.x    procedure bfalcx (fname, nchars, status)
+bfaloc             88 ./imfort/bfio.x    procedure bfaloc (fname, nchars, status)
+bfbsiz            194 ./imfort/bfio.x    int procedure bfbsiz (fp)
+bfchan            221 ./imfort/bfio.x    int procedure bfchan (fp)
+bfclos            157 ./imfort/bfio.x    procedure bfclos (fp, status)
+bffill            409 ./imfort/bfio.x    int procedure bffill (fp, offset, nchars, rwflag)
+bfflsh            453 ./imfort/bfio.x    int procedure bfflsh (fp)
+bffsiz            205 ./imfort/bfio.x    int procedure bffsiz (fp)
+bfmode            479 ./imfort/bfio.x    int procedure bfmode (acmode)
+bfopen             71 ./imfort/bfio.x    int procedure bfopen (fname, acmode, advice)
+bfopnx            105 ./imfort/bfio.x    pointer procedure bfopnx (fname, acmode, advice)
+bfread            233 ./imfort/bfio.x    int procedure bfread (fp, buf, nchars, offset)
+bfrseq            338 ./imfort/bfio.x    int procedure bfrseq (fp, buf, nchars)
+bfseek            381 ./imfort/bfio.x    int procedure bfseek (fp, offset)
+bfwrit            287 ./imfort/bfio.x    int procedure bfwrit (fp, buf, nchars, offset)
+bfwseq            359 ./imfort/bfio.x    int procedure bfwseq (fp, buf, nchars)
+bitmov              7 ./osb/bitmov.x     procedure bitmov (a, a_off, b, b_off, nbits)
+blockit           318 ./gio/nsppkern/gktpcell.x procedure blockit( from, to, count, factor)
+brktime            14 ./etc/brktime.x    procedure brktime (ltime, tm)
+btoi                5 ./etc/btoi.x       int procedure btoi (boolean_value)
+c_access            1 ./libc/caccess.c   c_access (fname, mode, type)
+c_allocate          1 ./libc/callocate.c c_allocate (device)
+c_clktime           1 ./libc/cclktime.c  c_clktime (reftime)
+c_close             1 ./libc/cclose.c    c_close (fd)
+c_cnvdate           1 ./libc/ccnvdate.c  c_cnvdate (clktime, outstr, maxch)
+c_cnvtime           1 ./libc/ccnvtime.c  c_cnvtime (clktime, outstr, maxch)
+c_cputime           1 ./libc/cclktime.c  c_cputime (reftime)
+c_deallocate        1 ./libc/callocate.c c_deallocate (device, rewind)
+c_delete            1 ./libc/cdelete.c   c_delete (fname)
+c_devowner          1 ./libc/callocate.c c_devowner (device, owner, maxch)
+c_devstatus         1 ./libc/callocate.c c_devstatus (device, out)
+c_envfind           2 ./libc/cenvget.c   c_envfind (var, outstr, maxch)
+c_envfree           1 ./libc/cenvmark.c  c_envfree (envp, userfcn)
+c_envgetb           2 ./libc/cenvget.c   c_envgetb (var)
+c_envgeti           2 ./libc/cenvget.c   c_envgeti (var)
+c_envgets           1 ./libc/cenvget.c   c_envgets (var, outstr, maxch)
+c_envlist           1 ./libc/cenvlist.c  c_envlist (fd, prefix, show_redefs)
+c_envmark           1 ./libc/cenvmark.c  c_envmark (envp)
+c_envputs           2 ./libc/cenvget.c   c_envputs (var, value)
+c_envreset          2 ./libc/cenvget.c   c_envreset (var, value)
+c_envscan           1 ./libc/cenvscan.c  c_envscan (input_source)
+c_erract            1 ./libc/cerract.c   c_erract (action)
+c_errcode           1 ./libc/cerrcode.c  c_errcode()
+c_errget            1 ./libc/cerrget.c   c_errget (outstr, maxch)
+c_error             1 ./libc/cerror.c    c_error (errcode, errmsg)
+c_fchdir            1 ./libc/cfchdir.c   c_fchdir (newdir)
+c_filbuf            1 ./libc/cfilbuf.c   c_filbuf (fp)
+c_finfo             1 ./libc/cfinfo.c    c_finfo (fname, fi)
+c_flsbuf            1 ./libc/cflsbuf.c   c_flsbuf (ch, fp)
+c_flush             1 ./libc/cflush.c    c_flush (fd)
+c_fmapfn            1 ./libc/cfmapfn.c   c_fmapfn (vfn, osfn, maxch)
+c_fmkdir            1 ./libc/cfmkdir.c   c_fmkdir (newdir)
+c_fnextn            1 ./libc/cfnextn.c   c_fnextn (vfn, extn, maxch)
+c_fnldir            1 ./libc/cfnldir.c   c_fnldir (vfn, ldir, maxch)
+c_fnroot            1 ./libc/cfnroot.c   c_fnroot (vfn, root, maxch)
+c_fpathname         1 ./libc/cfpath.c    c_fpathname (vfn, osfn, maxch)
+c_fprintf           1 ./libc/cprintf.c   c_fprintf (fd, format)
+c_fredir            1 ./libc/cfredir.c   c_fredir (fd, fname, mode, type)
+c_fseti             1 ./libc/cfseti.c    c_fseti (fd, param, value)
+c_fstati            1 ./libc/cfstati.c   c_fstati (fd, param)
+c_getpid            1 ./libc/cgetpid.c   c_getpid()
+c_getuid            1 ./libc/cgetuid.c   c_getuid (outstr, maxch)
+c_gflush            1 ./libc/cgflush.c   c_gflush (stream)
+c_imaccess          1 ./libc/cimaccess.c c_imaccess (imname, mode)
+c_imdrcur           1 ./libc/cimdrcur.c  c_imdrcur (device, x, y, wcs, key, strval, maxch, /
+c_kimapchan         1 ./libc/ckimapc.c   c_kimapchan (chan, nodename, maxch)
+c_lexnum            1 ./libc/clexnum.c   c_lexnum (str, toklen)
+c_mktemp            1 ./libc/cmktemp.c   c_mktemp (root, temp_filename, maxch)
+c_note              1 ./libc/cnote.c     c_note (fd)
+c_open              1 ./libc/copen.c     c_open (fname, mode, type)
+c_oscmd             1 ./libc/coscmd.c    c_oscmd (cmd, infile, outfile, errfile)
+c_pargb             1 ./libc/cprintf.c   c_pargb (ival)
+c_pargc             1 ./libc/cprintf.c   c_pargc (ival)
+c_pargd             1 ./libc/cprintf.c   c_pargd (dval)
+c_pargi             1 ./libc/cprintf.c   c_pargi (ival)
+c_pargl             1 ./libc/cprintf.c   c_pargl (lval)
+c_pargr             1 ./libc/cprintf.c   c_pargr (rval)
+c_pargs             1 ./libc/cprintf.c   c_pargs (sval)
+c_pargstr           1 ./libc/cprintf.c   c_pargstr (strval)
+c_prchdir           3 ./libc/cprcon.c    c_prchdir (pid, newdir)
+c_prcldpr           1 ./libc/cprdet.c    c_prcldpr (job)
+c_prclose           2 ./libc/cprcon.c    c_prclose (pid)
+c_prdone            2 ./libc/cprdet.c    c_prdone (job)
+c_prenvfree         1 ./libc/cenvmark.c  c_prenvfree (pid, envp)
+c_prenvset          3 ./libc/cprcon.c    c_prenvset (pid, envvar, value)
+c_printf            1 ./libc/cprintf.c   c_printf (format)
+c_prkill            2 ./libc/cprdet.c    c_prkill (job)
+c_propdpr           1 ./libc/cprdet.c    c_propdpr (process, bkgfile, bkgmsg)
+c_propen            1 ./libc/cprcon.c    c_propen (process, in, out)
+c_prredir           3 ./libc/cprcon.c    c_prredir (pid, stream, new_fd)
+c_prsignal          2 ./libc/cprcon.c    c_prsignal (pid, signal)
+c_prstati           2 ./libc/cprcon.c    c_prstati (pid, param)
+c_rcursor           1 ./libc/crcursor.c  c_rcursor (fd, outstr, maxch)
+c_rdukey            1 ./libc/crdukey.c   c_rdukey (obuf, maxch)
+c_read              1 ./libc/cread.c     c_read (fd, buf, maxbytes)
+c_rename            1 ./libc/crename.c   c_rename (old_fname, new_fname)
+c_salloc            1 ./libc/csalloc.c   c_salloc (nbytes)
+c_seek              1 ./libc/cseek.c     c_seek (fd, offset)
+c_sfree             2 ./libc/csalloc.c   c_sfree (sp)
+c_smark             1 ./libc/csalloc.c   c_smark (sp)
+c_sppstr            1 ./libc/csppstr.c   c_sppstr (str)
+c_stggetline        1 ./libc/stgio.c     c_stggetline (fd, buf)
+c_stgputline        1 ./libc/stgio.c     c_stgputline (fd, buf)
+c_stropen           1 ./libc/cstropen.c  c_stropen (obuf, maxch, mode)
+c_strpak            1 ./libc/cstrpak.c   c_strpak (sppstr, cstr, maxch)
+c_strupk            1 ./libc/cstrupk.c   c_strupk (str, outstr, maxch)
+c_sttyco            1 ./libc/cttset.c    c_sttyco (args, ttin, ttout, outfd)
+c_tsleep            1 ./libc/ctsleep.c   c_tsleep (nseconds)
+c_ttseti            1 ./libc/cttset.c    c_ttseti (fd, param, value)
+c_ttsets            1 ./libc/cttset.c    c_ttsets (fd, param, value)
+c_ttstati           1 ./libc/cttset.c    c_ttstati (fd, param)
+c_ttstats           1 ./libc/cttset.c    c_ttstats (fd, param, outstr, maxch)
+c_ttycdes           1 ./libc/cttycdes.c  c_ttycdes (tty)
+c_ttyclear          1 ./libc/cttyclear.c c_ttyclear (fd, tty)
+c_ttyclearln        1 ./libc/cttyclln.c  c_ttyclearln (fd, tty)
+c_ttyctrl           1 ./libc/cttyctrl.c  c_ttyctrl (fd, tty, cap, afflncnt)
+c_ttygetb           1 ./libc/cttygetb.c  c_ttygetb (tty, cap)
+c_ttygeti           1 ./libc/cttygeti.c  c_ttygeti (tty, cap)
+c_ttygetr           1 ./libc/cttygetr.c  c_ttygetr (tty, cap)
+c_ttygets           1 ./libc/cttygets.c  c_ttygets (tty, cap, outstr, maxch)
+c_ttygoto           1 ./libc/cttygoto.c  c_ttygoto (fd, tty, col, line)
+c_ttyinit           1 ./libc/cttyinit.c  c_ttyinit (fd, tty)
+c_ttyodes           2 ./libc/cttyodes.c  c_ttyodes (ttyname)
+c_ttyputline        1 ./libc/cttyputl.c  c_ttyputline (fd, tty, line, map_cc)
+c_ttyputs           1 ./libc/cttyputs.c  c_ttyputs (fd, tty, cap, afflncnt)
+c_ttyseti           1 ./libc/cttyseti.c  c_ttyseti (tty, param, value)
+c_ttyso             1 ./libc/cttyso.c    c_ttyso (fd, tty, onoff)
+c_ttystati          1 ./libc/cttystati.c c_ttystati (tty, param)
+c_ungetc            1 ./libc/cungetc.c   c_ungetc (fd, ch)
+c_ungetline         1 ./libc/cungetl.c   c_ungetline (fd, str)
+c_vfnbrk            1 ./libc/cvfnbrk.c   c_vfnbrk (vfn, root, extn)
+c_wmsec             1 ./libc/cwmsec.c    c_wmsec (msec)
+c_write             1 ./libc/cwrite.c    c_write (fd, buf, nbytes)
+c_xgmes             1 ./libc/cxgmes.c    c_xgmes (oscode, oserrmsg, maxch)
+c_xonerr            1 ./libc/cxonerr.c   c_xonerr (errcode)
+c_xttysize          1 ./libc/cxttysize.c c_xttysize (ncols, nlines)
+c_xwhen             1 ./libc/cxwhen.c    c_xwhen (exception, new_handler, old_handler)
+calcmarker        140 ./gio/calcomp/vttest.x procedure calcmarker (x, y, marktype, p, npts)
+calloc              1 ./libc/calloc.c    calloc (nelems, elsize)
+calloc              5 ./memdbg/calloc.x  procedure calloc (ubufp, buflen, dtype)
+calloc              5 ./memio/calloc.x   procedure calloc (ubufp, buflen, dtype)
+ccp_calcseg        14 ./gio/calcomp/ccpcseg.x procedure ccp_calcseg (p, npts, ltype, curpl_pt, segsize, xseg,yseg, nsegpts)
+ccp_clear          10 ./gio/calcomp/ccpclear.x procedure ccp_clear (dummy)
+ccp_close           7 ./gio/calcomp/ccpclose.x procedure ccp_close()
+ccp_closews         8 ./gio/calcomp/ccpclws.x procedure ccp_closews (devname, n)
+ccp_color          14 ./gio/calcomp/ccpcolor.x procedure ccp_color(index)
+ccp_drawchar       20 ./gio/calcomp/ccpdrawch.x procedure ccp_drawchar (ch, x, y, xsize, ysize, orien, font, quality)
+ccp_drawseg        15 ./gio/calcomp/ccpdseg.x procedure ccp_drawseg (xseg, yseg, nsegpts, lwidth)
+ccp_escape          9 ./gio/calcomp/ccpescape.x procedure ccp_escape (fn, instruction, nwords)
+ccp_faset           8 ./gio/calcomp/ccpfaset.x procedure ccp_faset (gki)
+ccp_fillarea        7 ./gio/calcomp/ccpfa.x procedure ccp_fillarea (p, npts)
+ccp_font           13 ./gio/calcomp/ccpfont.x procedure ccp_font (font)
+ccp_init           13 ./gio/calcomp/ccpinit.x procedure ccp_init (tty, devname)
+ccp_linetype        8 ./gio/calcomp/ccpltype.x procedure ccp_linetype (index)
+ccp_lwidth         13 ./gio/calcomp/ccplwidth.x procedure ccp_lwidth (index)
+ccp_open           11 ./gio/calcomp/ccpopen.x procedure ccp_open (devname, dd)
+ccp_openws         13 ./gio/calcomp/ccpopenws.x procedure ccp_openws (devname, n, mode)
+ccp_plset           9 ./gio/calcomp/ccpplset.x procedure ccp_plset (gki)
+ccp_pmset           8 ./gio/calcomp/ccppmset.x procedure ccp_pmset (gki)
+ccp_polyline       12 ./gio/calcomp/ccppl.x procedure ccp_polyline (p, npts)
+ccp_polymarker     12 ./gio/calcomp/ccppm.x procedure ccp_polymarker (p, npts)
+ccp_reset          12 ./gio/calcomp/ccpreset.x procedure ccp_reset()
+ccp_text           20 ./gio/calcomp/ccptx.x procedure ccp_text (xc, yc, text, n)
+ccp_txset           9 ./gio/calcomp/ccptxset.x procedure ccp_txset (gki)
+cctoc              18 ./fmtio/cctoc.x    int procedure cctoc (str, ip, cval)
+ccx_addsegpt      189 ./gio/calcomp/ccpcseg.x procedure ccx_addsegpt (x,y, xseg,yseg, cursegpt,segsize)
+ccx_dash           94 ./gio/calcomp/ccpcseg.x procedure ccx_dash (p, npts, curpl_pt, curseglen, cursegpt, segsize,
+ccx_gap           145 ./gio/calcomp/ccpcseg.x procedure ccx_gap (p, npts, curpl_pt, curseglen, matchlen, lastp_x,lastp_y)
+ccx_interpoly     121 ./gio/calcomp/ccpdrawch.x procedure ccx_interpoly (x, y, npts, quality)
+ccx_intersymbol   190 ./gio/calcomp/ccpdrawch.x procedure ccx_intersymbol (x,y, xsize,ysize, ch, orien)
+ccx_offsets       171 ./gio/calcomp/ccpdseg.x procedure ccx_offsets (p1x,p1y, p2x,p2y, p3x,p3y, delx,dely)
+ccx_parameters    283 ./gio/calcomp/ccptx.x procedure ccx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+ccx_segment       223 ./gio/calcomp/ccptx.x int procedure ccx_segment (text, n, out, start_font)
+chdeposit           6 ./fmtio/chdeposit.x procedure chdeposit (ch, str, maxch, op)
+checksum          421 ./fio/zzdebug.x    int procedure checksum (buf, nchars)
+chfetch             5 ./fmtio/chfetch.x  char procedure chfetch (str, ip, ch)
+chk_prot            2 ../unix/os/zfprot.c chk_prot (fname, link_name)
+chrlwr              7 ./fmtio/chrlwr.x   char procedure chrlwr (ch)
+chrupr              7 ./fmtio/chrupr.x   char procedure chrupr (ch)
+cl_initargs       156 ./imfort/clargs.x  procedure cl_initargs (ier)
+cl_psio_request   272 ./clio/zfiocl.x    int procedure cl_psio_request (cmd, arg1, arg2)
+clargc             36 ./imfort/clargs.x  procedure clargc (argno, outstr, ier)
+clargd            100 ./imfort/clargs.x  procedure clargd (argno, dval, ier)
+clargi             64 ./imfort/clargs.x  procedure clargi (argno, ival, ier)
+clargr             82 ./imfort/clargs.x  procedure clargr (argno, rval, ier)
+clc_compress      447 ./clio/clcache.x   procedure clc_compress ()
+clc_enter         152 ./clio/clcache.x   procedure clc_enter (param, value)
+clc_fetch         229 ./clio/clcache.x   int procedure clc_fetch (param, outstr, maxch)
+clc_find          265 ./clio/clcache.x   pointer procedure clc_find (param, outstr, maxch)
+clc_free          127 ./clio/clcache.x   procedure clc_free (marker)
+clc_init           72 ./clio/clcache.x   procedure clc_init()
+clc_list          383 ./clio/clcache.x   procedure clc_list (fd, pset, format)
+clc_mark          114 ./clio/clcache.x   procedure clc_mark (marker)
+clc_newtask        97 ./clio/clcache.x   procedure clc_newtask (taskname)
+clc_scan          333 ./clio/clcache.x   procedure clc_scan (cmd)
+clclose             8 ./clio/clclose.x   procedure clclose ()
+clcmd              16 ./clio/clcmd.x     procedure clcmd (cmd)
+clcmdw              8 ./clio/clcmdw.x    procedure clcmdw (cmd)
+clcpset             5 ./clio/clcpset.x   procedure clcpset (pp)
+clepset            10 ./clio/clepset.x   procedure clepset (pp)
+clgcur             22 ./clio/clgcur.x    int procedure clgcur (param, wx, wy, wcs, key, strval, maxch)
+clgetb              7 ./clio/clgetb.x    bool procedure clgetb (param)
+clgetc              7 ./clio/clgetc.x    char procedure clgetc (param)
+clgetd              7 ./clio/clgetd.x    double procedure clgetd (param)
+clgeti              5 ./clio/clgeti.x    int procedure clgeti (param)
+clgetl              5 ./clio/clgetl.x    long procedure clgetl (param)
+clgetr              5 ./clio/clgetr.x    real procedure clgetr (param)
+clgets              5 ./clio/clgets.x    short procedure clgets (param)
+clgetx              7 ./clio/clgetx.x    complex procedure clgetx (param)
+clgfil            113 ./clio/clgfil.x    int procedure clgfil (list, fname, maxch)
+clgkey              9 ./clio/clgkey.x    int procedure clgkey (param, key, strval, maxch)
+clglpb              7 ./clio/clglpb.x    int procedure clglpb (param, bval)
+clglpc              7 ./clio/clglpc.x    int procedure clglpc (param, cval)
+clglpd              8 ./clio/clglpd.x    int procedure clglpd (param, dval)
+clglpi              5 ./clio/clglpi.x    int procedure clglpi (param, ival)
+clglpl              5 ./clio/clglpl.x    int procedure clglpl (param, lval)
+clglpr              6 ./clio/clglpr.x    int procedure clglpr (param, rval)
+clglps              5 ./clio/clglps.x    int procedure clglps (param, sval)
+clglpx              7 ./clio/clglpx.x    int procedure clglpx (param, xval)
+clglstr             5 ./clio/clglstr.x   int procedure clglstr (param, outstr, maxch)
+clgpset             8 ./clio/clgpset.x   procedure clgpset (pp, pname, outstr, maxch)
+clgpseta            7 ./clio/clgpseta.x  procedure clgpseta (pp, pname, outstr, maxch)
+clgpsetb            7 ./clio/clgpsetb.x  bool procedure clgpsetb (pp, parname)
+clgpsetc            7 ./clio/clgpsetc.x  char procedure clgpsetc (pp, parname)
+clgpsetd            7 ./clio/clgpsetd.x  double procedure clgpsetd (pp, parname)
+clgpseti            7 ./clio/clgpseti.x  int procedure clgpseti (pp, parname)
+clgpsetl            7 ./clio/clgpsetl.x  long procedure clgpsetl (pp, parname)
+clgpsetr            7 ./clio/clgpsetr.x  real procedure clgpsetr (pp, parname)
+clgpsets            7 ./clio/clgpsets.x  short procedure clgpsets (pp, parname)
+clgpsetx            7 ./clio/clgpsetx.x  complex procedure clgpsetx (pp, parname)
+clgstr              7 ./clio/clgstr.x    procedure clgstr (param, outstr, maxch)
+clgwrd             11 ./clio/clgwrd.x    int procedure clgwrd (param, keyword, maxchar, dictionary)
+clktime             8 ./etc/clktime.x    long procedure clktime (old_time)
+cllpset             8 ./clio/cllpset.x   procedure cllpset (pp, fd, format)
+clnarg            133 ./imfort/clargs.x  procedure clnarg (nargs)
+clopen             15 ./clio/clopen.x    procedure clopen (stdin_chan, stdout_chan, stderr_chan, device, devtype)
+clopset             7 ./clio/clopset.x   pointer procedure clopset (pset)
+close              10 ./fio/close.x      procedure close (fd_arg)
+clpcls            127 ./clio/clgfil.x    procedure clpcls (list)
+clplen            101 ./clio/clgfil.x    int procedure clplen (list)
+clpopni            26 ./clio/clgfil.x    int procedure clpopni (param)
+clpopns            54 ./clio/clgfil.x    int procedure clpopns (param)
+clpopnu            78 ./clio/clgfil.x    int procedure clpopnu (param)
+clppset             8 ./clio/clppset.x   procedure clppset (pp, pname, sval)
+clppseta            7 ./clio/clppseta.x  procedure clppseta (pp, pname, sval)
+clppsetb            7 ./clio/clppsetb.x  procedure clppsetb (pp, parname, bval)
+clppsetc            7 ./clio/clppsetc.x  procedure clppsetc (pp, parname, cval)
+clppsetd            7 ./clio/clppsetd.x  procedure clppsetd (pp, parname, dval)
+clppseti            7 ./clio/clppseti.x  procedure clppseti (pp, parname, ival)
+clppsetl            7 ./clio/clppsetl.x  procedure clppsetl (pp, parname, lval)
+clppsetr            7 ./clio/clppsetr.x  procedure clppsetr (pp, parname, rval)
+clppsets            7 ./clio/clppsets.x  procedure clppsets (pp, parname, sval)
+clppsetx            7 ./clio/clppsetx.x  procedure clppsetx (pp, parname, xval)
+clprew            138 ./clio/clgfil.x    procedure clprew (list)
+clprintf            9 ./fmtio/clprintf.x procedure clprintf (param, format_string)
+clpset_parname      8 ./clio/clpsetnm.x  pointer procedure clpset_parname (pp, parname)
+clpstr              5 ./clio/clpstr.x    procedure clpstr (param, value)
+clputb              5 ./clio/clputb.x    procedure clputb (param, bval)
+clputc              7 ./clio/clputc.x    procedure clputc (param, cval)
+clputd              5 ./clio/clputd.x    procedure clputd (param, dval)
+clputi              5 ./clio/clputi.x    procedure clputi (param, value)
+clputl             39 ./clio/clputi.x    procedure clputl (param, lval)
+clputr              5 ./clio/clputr.x    procedure clputr (param, rval)
+clputs             22 ./clio/clputi.x    procedure clputs (param, value)
+clputx              5 ./clio/clputx.x    procedure clputx (param, xval)
+clrawc            210 ./imfort/clargs.x  procedure clrawc (outstr, ier)
+clreqpar            7 ./clio/clreqpar.x  procedure clreqpar (param)
+clscan              5 ./fmtio/clscan.x   int procedure clscan (param)
+clseti             10 ./clio/clseti.x    procedure clseti (parameter, value)
+clstati            11 ./clio/clstati.x   int procedure clstati (parameter)
+cnvdate            14 ./etc/cnvdate.x    procedure cnvdate (ltime, outstr, maxch)
+cnvtime            13 ./etc/cnvtime.x    procedure cnvtime (ltime, outstr, maxch)
+coerce              6 ./memdbg/coerce.x  pointer procedure coerce (ptr, type1, type2)
+coerce              6 ./memio/coerce.x   pointer procedure coerce (ptr, type1, type2)
+conv_test         1081 ./pmio/zzinterp.x  procedure conv_test (pm_1, pm_2, fd, opcode)
+conv_test         1333 ./plio/zzdebug.x   procedure conv_test (pl_1, pl_2, fd, opcode)
+cputime             6 ./etc/cputime.x    long procedure cputime (old_cputime)
+ctocc              17 ./fmtio/ctocc.x    int procedure ctocc (ch, outstr, maxch)
+ctod               44 ./fmtio/ctod.x     int procedure ctod (str, ip, dval)
+ctoi                7 ./fmtio/ctoi.x     int procedure ctoi (str, ip, ival)
+ctol                7 ./fmtio/ctol.x     int procedure ctol (str, ip, lval)
+ctor                9 ./fmtio/ctor.x     int procedure ctor (str, ip, rval)
+ctotok             90 ./fmtio/ctotok.x   int procedure ctotok (str, ip, outstr, maxch)
+ctowrd             11 ./fmtio/ctowrd.x   int procedure ctowrd (str, ip, outstr, maxch)
+ctox                9 ./fmtio/ctox.x     int procedure ctox (str, ip, xval)
+d_compar            4 ../unix/os/zopdir.c d_compar (a, b)
+d_qsort             5 ../unix/os/zopdir.c d_qsort (base, n, size, compar)
+d_qst               6 ../unix/os/zopdir.c d_qst (base, max)
+dbgmsg             20 ../unix/os/zfioks.c dbgmsg (msg)
+dbgmsg1            20 ../unix/os/zfioks.c dbgmsg1 (fmt, arg)
+dbgmsg2            20 ../unix/os/zfioks.c dbgmsg2 (fmt, arg1, arg2)
+dbgmsg3            20 ../unix/os/zfioks.c dbgmsg3 (fmt, arg1, arg2, arg3)
+dbgmsg4            21 ../unix/os/zfioks.c dbgmsg4 (fmt, arg1, arg2, arg3, arg4)
+dealloc             3 ../unix/os/alloc.c dealloc (argv)
+delete             16 ./fio/delete.x     procedure delete (fname)
+deletefg           12 ./fio/deletefg.x   procedure deletefg (fname, versions, subfiles)
+diropen            19 ./fio/diropen.x    int procedure diropen (fname, mode)
+dtcscl              6 ./fmtio/dtcscl.x   procedure dtcscl (v, e, sense)
+dtoc               10 ./fmtio/dtoc.x     int procedure dtoc (dval, outstr, maxch, decpl, a_fmt, width)
+dtoc3              36 ./fmtio/dtoc3.x    int procedure dtoc3 (val, out, maxch, decpl, a_fmt, width)
+dump_chars        151 ./tty/zzdebug.x    procedure dump_chars (fd, str)
+elogd              16 ./gio/elogd.x      double procedure elogd (x)
+elogr              16 ./gio/elogr.x      real procedure elogr (x)
+env_first           9 ./etc/envnext.x    pointer procedure env_first (valp)
+env_init            9 ./etc/envinit.x    procedure env_init()
+env_next           29 ./etc/envnext.x    pointer procedure env_next (last_el, valp, show_redefines)
+envdebug          141 ./etc/zzdebug.x    procedure envdebug (fd)
+envfind            69 ./etc/environ.x    int procedure envfind (key, value, maxch)
+envfree           241 ./etc/environ.x    int procedure envfree (old_top, userfcn)
+envget              1 ./libc/cenvget.c   envget (var)
+envgetb             8 ./etc/envgetb.x    bool procedure envgetb (varname)
+envgetd            10 ./etc/envgetd.x    double procedure envgetd (varname)
+envgeti            10 ./etc/envgeti.x    int procedure envgeti (varname)
+envgetr             7 ./etc/envgetr.x    real procedure envgetr (varname)
+envgets            13 ./etc/envgets.x    int procedure envgets (key, value, maxch)
+envindir            8 ./etc/envindir.x   procedure envindir (envvar, outstr, maxch)
+envlist            10 ./etc/envlist.x    procedure envlist (fd, prefix, print_redefined_variables)
+envmark           224 ./etc/environ.x    procedure envmark (old_top)
+envputs           132 ./etc/environ.x    int procedure envputs (key, value)
+envreset           16 ./etc/envreset.x   procedure envreset (key, value)
+envscan            20 ./etc/envscan.x    int procedure envscan (cmd)
+eprintf             1 ./libc/eprintf.c   eprintf (va_alist)
+eprintf             7 ./fmtio/eprintf.x  procedure eprintf (format_string)
+erract             36 ./etc/erract.x     procedure erract (severity)
+errcode            12 ./etc/errcode.x    int procedure errcode()
+errget             12 ./etc/errget.x     int procedure errget (outstr, maxch)
+error              10 ./etc/error.x      procedure error (error_code, message)
+evexpr             61 ./fmtio/evexpr.x   pointer procedure evexpr (expr, getop_epa, ufcn_epa)
+evvexpr           159 ./fmtio/evvexpr.x  pointer procedure evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+evvfree           218 ./fmtio/evvexpr.x  procedure evvfree (o)
+ex_handler          5 ../unix/os/zxwhen.c ex_handler (unix_signal, info, ucp)
+fakepc            295 ./gio/nsppkern/gktpcell.x procedure fakepc (indata, outdata, nx, scale)
+falloc             15 ./fio/falloc.x     procedure falloc (fname, file_size)
+fatal              32 ./etc/error.x      procedure fatal (error_code, message)
+fcanpb             11 ./fio/fcanpb.x     procedure fcanpb (fd)
+fchdir              8 ./fio/fchdir.x     procedure fchdir (newdir)
+fcldir            124 ./fio/diropen.x    procedure fcldir (channel, status)
+fclobber           12 ./fio/fclobber.x   procedure fclobber (fname)
+fclose              1 ./libc/fclose.c    fclose (fp)
+fcopy              15 ./fio/fcopy.x      procedure fcopy (oldfile, newfile)
+fcopyo             57 ./fio/fcopy.x      procedure fcopyo (in, out)
+fdebug              9 ./fio/fdebug.x     procedure fdebug (out, fd1_arg, fd2_arg)
+fdevbf             10 ./fio/fdevbf.x     procedure fdevbf (zard, zawr, zawt, zstt, zcls)
+fdevblk            10 ./fio/fdevblk.x    int procedure fdevblk (path)
+fdevtx             10 ./fio/fdevtx.x     procedure fdevtx (zget, zput, zfls, zstt, zcls, zsek, znot)
+fdirname           10 ./fio/fdirname.x   procedure fdirname (vfn, path, maxch)
+fdopen              1 ./libc/fdopen.c    fdopen (fd, mode)
+fencd              16 ./gio/ncarutil/sysint/fencode.x procedure fencd (nchars, f_format, spp_outstr, rval)
+fencd              16 ./gio/nspp/sysint/fencode.x procedure fencd (nchars, f_format, spp_outstr, rval)
+fexbuf             16 ./fio/fexbuf.x     procedure fexbuf (fd)
+ffault             14 ./fio/ffault.x     int procedure ffault (fd, file_offset, nreserve, rwflag)
+ffilbf              8 ./fio/ffilbf.x     procedure ffilbf (fd, bp, bufsize, buffer_offset)
+ffilsz             11 ./fio/ffilsz.x     long procedure ffilsz (fd)
+ffldir            224 ./fio/diropen.x    procedure ffldir (chan, status)
+fflsbf             10 ./fio/fflsbf.x     procedure fflsbf (fd, bp, maxchars, buffer_offset)
+fflush              1 ./libc/fflush.c    fflush (fp)
+fgdev0             65 ./fio/fgdevpar.x   long procedure fgdev0 (ffp, what)
+fgdev_param        33 ./fio/fgdevpar.x   procedure fgdev_param (fd)
+fgetc               1 ./libc/fgetc.c     fgetc (fp)
+fgetfd             11 ./fio/fgetfd.x     int procedure fgetfd (filename, mode, type)
+fgets               1 ./libc/fgets.c     fgets (buf, maxch, fp)
+fgtdir            153 ./fio/diropen.x    procedure fgtdir (chan, outline, maxch, status)
+filbuf             12 ./fio/filbuf.x     int procedure filbuf (fd)
+filerr              9 ./fio/filerr.x     procedure filerr (fname, errcode)
+filopn             21 ./fio/filopn.x     int procedure filopn (fname, mode, type, zopen_proc, device)
+findsfs             3 ../unix/os/alloc.c findsfs (argv)
+finfo              28 ./fio/finfo.x      int procedure finfo (fname, ostruct)
+finit              14 ./fio/finit.x      procedure finit()
+fio_cleanup        15 ./fio/fioclean.x   procedure fio_cleanup (status)
+fio_qflush        110 ./fio/fioclean.x   procedure fio_qflush (fd, status)
+fixmem             58 ./memdbg/begmem.x  procedure fixmem (old_size)
+fixmem             58 ./memio/begmem.x   procedure fixmem (old_size)
+flsbuf             17 ./fio/flsbuf.x     procedure flsbuf (fd, nreserve)
+flush               9 ./fio/flush.x      procedure flush (fd)
+fm_access           6 ./fmio/fmaccess.x  int procedure fm_access (dfname, mode)
+fm_close           10 ./fmio/fmclose.x   procedure fm_close (fm)
+fm_copy             9 ./fmio/fmcopy.x    procedure fm_copy (dfname, newname)
+fm_copyo           12 ./fmio/fmcopyo.x   procedure fm_copyo (old, new)
+fm_debug           15 ./fmio/fmdebug.x   procedure fm_debug (fm, out, what)
+fm_delete           5 ./fmio/fmdelete.x  procedure fm_delete (dfname)
+fm_fcdebug        268 ./fmio/fmfcache.x  procedure fm_fcdebug (fm, out, what)
+fm_fcfree         346 ./fmio/fmfcache.x  procedure fm_fcfree (fm)
+fm_fcinit         323 ./fmio/fmfcache.x  procedure fm_fcinit (fm, cachesize)
+fm_fcsync         376 ./fmio/fmfcache.x  procedure fm_fcsync (fm)
+fm_findlf         246 ./fmio/fmfcache.x  pointer procedure fm_findlf (fc, lfile)
+fm_fopen            6 ./fmio/fmfopen.x   int procedure fm_fopen (fm, lfile, mode, type)
+fm_getfd           53 ./fmio/fmfcache.x  int procedure fm_getfd (fm, lfile, mode, type)
+fm_lfaread         10 ./fmio/fmlfard.x   procedure fm_lfaread (lf, buf, maxbytes, offset)
+fm_lfawait          8 ./fmio/fmlfawt.x   procedure fm_lfawait (lf, status)
+fm_lfawrite        10 ./fmio/fmlfawr.x   procedure fm_lfawrite (lf, buf, nbytes, offset)
+fm_lfbinread       14 ./fmio/fmlfbrd.x   procedure fm_lfbinread (lf, buf, maxbytes, offset)
+fm_lfbinwait        8 ./fmio/fmlfbwt.x   procedure fm_lfbinwait (lf, status)
+fm_lfbinwrite      15 ./fmio/fmlfbwr.x   procedure fm_lfbinwrite (lf, buf, nbytes, offset)
+fm_lfclose          9 ./fmio/fmlfcls.x   procedure fm_lfclose (lf, status)
+fm_lfcopy          10 ./fmio/fmlfcopy.x  procedure fm_lfcopy (old, o_lfile, new, n_lfile)
+fm_lfdelete         8 ./fmio/fmlfdel.x   procedure fm_lfdelete (fm, lfile)
+fm_lfname          15 ./fmio/fmlfname.x  procedure fm_lfname (fm, lfile, type, lfname, maxch)
+fm_lfopen           9 ./fmio/fmlfopen.x  procedure fm_lfopen (pk_lfname, mode, chan)
+fm_lfparse         12 ./fmio/fmlfparse.x int procedure fm_lfparse (lfname, fm, lfile, type)
+fm_lfstat           8 ./fmio/fmlfstat.x  int procedure fm_lfstat (fm, lfile, statbuf)
+fm_lfstati         10 ./fmio/fmlfstt.x   procedure fm_lfstati (lf, param, lvalue)
+fm_lfundelete       8 ./fmio/fmlfundel.x procedure fm_lfundelete (fm, lfile)
+fm_locked         230 ./fmio/fmfcache.x  bool procedure fm_locked (fm, lfile)
+fm_lockout        178 ./fmio/fmfcache.x  procedure fm_lockout (fm, lfile)
+fm_nextlfile       10 ./fmio/fmnextlf.x  int procedure fm_nextlfile (fm)
+fm_open            12 ./fmio/fmopen.x    pointer procedure fm_open (fname, mode)
+fm_rebuild          8 ./fmio/fmrebuild.x procedure fm_rebuild (dfname)
+fm_rename           5 ./fmio/fmrename.x  procedure fm_rename (old, new)
+fm_retfd          149 ./fmio/fmfcache.x  procedure fm_retfd (fm, lfile)
+fm_seti             8 ./fmio/fmseti.x    procedure fm_seti (fm, param, value)
+fm_stati            8 ./fmio/fmstati.x   int procedure fm_stati (fm, param)
+fm_sync            13 ./fmio/fmsync.x    procedure fm_sync (fm)
+fm_unlock         214 ./fmio/fmfcache.x  procedure fm_unlock (fm, lfile)
+fmapfn             12 ./fio/fmapfn.x     procedure fmapfn (vfn, osfn, maxch)
+fmio_bind           9 ./fmio/fmiobind.x  procedure fmio_bind (fm)
+fmio_errchk         8 ./fmio/fmioerr.x   procedure fmio_errchk (fm)
+fmio_extend        13 ./fmio/fmioextnd.x int procedure fmio_extend (fm, lfile, npages)
+fmio_posterr        8 ./fmio/fmiopost.x  procedure fmio_posterr (fm, errcode, opstr)
+fmio_readheader    11 ./fmio/fmiorhdr.x  procedure fmio_readheader (fm)
+fmio_setbuf        12 ./fmio/fmiosbuf.x  procedure fmio_setbuf (fm)
+fmio_tick           8 ./fmio/fmiotick.x  procedure fmio_tick (fm)
+fmkbfs             10 ./fio/fmkbfs.x     procedure fmkbfs (fd)
+fmkcopy            17 ./fio/fmkcopy.x    procedure fmkcopy (oldfile, newfile)
+fmkdir             10 ./fio/fmkdir.x     procedure fmkdir (newdir)
+fmkpbbuf            9 ./fio/fmkpbbuf.x   procedure fmkpbbuf (fd)
+fmt_err             6 ./fmtio/fmterr.x   procedure fmt_err (preamble, format, index)
+fmt_init           10 ./fmtio/fmtinit.x  procedure fmt_init (ftype)
+fmt_read           10 ./fmtio/fmtread.x  procedure fmt_read()
+fmt_setcol         11 ./fmtio/fmtsetcol.x procedure fmt_setcol (ch, col)
+fmtstr             10 ./fmtio/fmtstr.x   procedure fmtstr (fd, str, col, fill_char, left_justify, maxch, width)
+fnextn              8 ./fio/fnextn.x     int procedure fnextn (vfn, outstr, maxch)
+fnldir             12 ./fio/fnldir.x     int procedure fnldir (vfn, outstr, maxch)
+fnroot              9 ./fio/fnroot.x     int procedure fnroot (vfn, outstr, maxch)
+fnt_edit          414 ./fio/fntgfn.x     int procedure fnt_edit (in, out, editp, nedit, patbuf)
+fnt_getpat        577 ./fio/fntgfn.x     int procedure fnt_getpat (template, ix, patp, npat, sbuf, maxch)
+fnt_mkpat         345 ./fio/fntgfn.x     procedure fnt_mkpat (pat, patstr, maxch, ep, nedit)
+fnt_open_list     851 ./fio/fntgfn.x     int procedure fnt_open_list (str, patstr, maxch, fname, ldir, ftype)
+fnt_read_template 746 ./fio/fntgfn.x     int procedure fnt_read_template (pp, outstr, maxch, token)
+fntcls            955 ./fio/fntgfn.x     procedure fntcls (pp)
+fntclsb           525 ./fio/fntgfn.x     procedure fntclsb (list)
+fntdir            280 ./fio/diropen.x    procedure fntdir (chan, offset)
+fntgfn            641 ./fio/fntgfn.x     int procedure fntgfn (pp, outstr, maxch)
+fntgfnb           469 ./fio/fntgfn.x     int procedure fntgfnb (list, fname, maxch)
+fntlenb           556 ./fio/fntgfn.x     int procedure fntlenb (list)
+fntopn            930 ./fio/fntgfn.x     pointer procedure fntopn (template)
+fntopnb           100 ./fio/fntgfn.x     int procedure fntopnb (template, sort)
+fntrewb           541 ./fio/fntgfn.x     procedure fntrewb (list)
+fntrfnb           499 ./fio/fntgfn.x     int procedure fntrfnb (list, index, fname, maxch)
+fnullfile           5 ./fio/fnullfile.x  bool procedure fnullfile (fname)
+fopdir             87 ./fio/diropen.x    procedure fopdir (osfn, mode, channel)
+fopen               1 ./libc/fopen.c     fopen (fname, modestr)
+fopnbf              6 ./fio/fopnbf.x     int procedure fopnbf (fname, mode, zopn, zard, zawr, zawa, zstt, zcls)
+fopntx              6 ./fio/fopntx.x     int procedure fopntx (fname,mode,zopn,zget,zput,zfls,zstt,zcls,zsek,znot)
+fowner              8 ./fio/fowner.x     procedure fowner (fname, owner, maxch)
+fp_equald          12 ./gio/fpequald.x   bool procedure fp_equald (x, y)
+fp_equalr          12 ./gio/fpequalr.x   bool procedure fp_equalr (x, y)
+fp_fixd            18 ./gio/fpfixd.x     double procedure fp_fixd (x)
+fp_fixr            18 ./gio/fpfixr.x     real procedure fp_fixr (x)
+fp_nondegenr        8 ./gio/fpndgr.x     bool procedure fp_nondegenr (x1, x2)
+fp_normd            8 ./gio/fpnormd.x    procedure fp_normd (x, normx, expon)
+fp_normr            8 ./gio/fpnormr.x    procedure fp_normr (x, normx, expon)
+fpathname          13 ./fio/fpathname.x  procedure fpathname (vfn, output_pathname, maxchars)
+fpradv             13 ./fmtio/fpradv.x   procedure fpradv()
+fprfmt             44 ./fmtio/fprfmt.x   int procedure fprfmt (ival)
+fprintf             1 ./libc/printf.c    fprintf (va_alist)
+fprintf             7 ./fmtio/fprintf.x  procedure fprintf (fd, format_string)
+fprntf              9 ./fmtio/fprntf.x   procedure fprntf (new_fd, format_string, file_type)
+fptdir            211 ./fio/diropen.x    procedure fptdir (chan, line, nchars, status)
+fputc               1 ./libc/fputc.c     fputc (ch, fp)
+fputs               1 ./libc/fputs.c     fputs (str, fp)
+fputtx              9 ./fio/fputtx.x     procedure fputtx (fd, buf, nchars, status)
+fread               1 ./libc/fread.c     fread (bp, szelem, nelem, fp)
+freadp             16 ./fio/freadp.x     pointer procedure freadp (fd, offset, nchars)
+fredir             18 ./fio/fredir.x     procedure fredir (fd, fname, mode, type)
+frediro            53 ./fio/fredir.x     procedure frediro (fd, newfd)
+free                1 ./libc/free.c      free (buf)
+frename            17 ./fio/frename.x    procedure frename (oldfname, newfname)
+freopen             1 ./libc/freopen.c   freopen (fname, modestr, fp)
+frmbfs              9 ./fio/frmbfs.x     procedure frmbfs (fd)
+frmtmp             63 ./fio/fsvtfn.x     procedure frmtmp()
+frtnfd              8 ./fio/frtnfd.x     procedure frtnfd (fd)
+fscan               5 ./fmtio/fscan.x    int procedure fscan (fd)
+fscanf              2 ./libc/scanf.c     fscanf (va_alist)
+fseek               1 ./libc/fseek.c     fseek (fp, offset, mode)
+fset_env          389 ./fio/fseti.x      procedure fset_env (envvar, value)
+fsetfd             33 ./fio/fgetfd.x     int procedure fsetfd (fd, filename, mode, type)
+fseti              20 ./fio/fseti.x      procedure fseti (fd, param, value)
+fsf_getfname       73 ./fio/fsfopen.x    procedure fsf_getfname (fname, fsf_file, maxch)
+fsfdelete          36 ./fio/fsfopen.x    procedure fsfdelete (fname)
+fsfopen            11 ./fio/fsfopen.x    int procedure fsfopen (fname, mode)
+fskdir            262 ./fio/diropen.x    procedure fskdir (chan, offset, status)
+fstati             12 ./fio/fstati.x     int procedure fstati (fd, what)
+fstatl             11 ./fio/fstatl.x     long procedure fstatl (fd, what)
+fstats             10 ./fio/fstats.x     procedure fstats (fd, what, outstr, maxch)
+fstdfile            6 ./fio/fstdfile.x   int procedure fstdfile (fname, ofd)
+fstdir            236 ./fio/diropen.x    procedure fstdir (chan, param, lvalue)
+fstrfp             11 ./fio/fstrfp.x     procedure fstrfp (newfp)
+fsvtfn             12 ./fio/fsvtfn.x     procedure fsvtfn (fname)
+fswapfd            20 ./fio/fswapfd.x    procedure fswapfd (fd1, fd2)
+ftell               1 ./libc/ftell.c     ftell (fp)
+fulib               7 ./gio/ncarutil/sysint/fulib.x procedure fulib (errcode, upkmsg, msglen)
+fulib               7 ./gio/nspp/sysint/fulib.x procedure fulib (errcode, upkmsg, msglen)
+fwatio             10 ./fio/fwatio.x     procedure fwatio (fd)
+fwrite              1 ./libc/fwrite.c    fwrite (bp, szelem, nelem, fp)
+fwritep            23 ./fio/fwritep.x    pointer procedure fwritep (fd, offset, nchars)
+fwtacc             19 ./fio/fwtacc.x     procedure fwtacc (fd, fname)
+fxf_access          9 ./imio/iki/fxf/fxfaccess.x procedure fxf_access (kernel, root, extn, acmode, status)
+fxf_accum_bufp    1062 ./imio/iki/fxf/fxfrfits.x procedure fxf_accum_bufp (line, tpt, nbkw, nbl)
+fxf_accum_buft    1101 ./imio/iki/fxf/fxfrfits.x procedure fxf_accum_buft (line, tst, nsb)
+fxf_addpar         11 ./imio/iki/fxf/fxfaddpar.x procedure fxf_addpar (im, pname, dtype, pval)
+fxf_akwb          219 ./imio/iki/fxf/fxfencode.x procedure fxf_akwb (keyword, value, comment, pn)
+fxf_akwc          200 ./imio/iki/fxf/fxfencode.x procedure fxf_akwc (keyword, value, len, comment, pn)
+fxf_akwd          292 ./imio/iki/fxf/fxfencode.x procedure fxf_akwd (keyword, value, comment, precision, pn)
+fxf_akwi          243 ./imio/iki/fxf/fxfencode.x procedure fxf_akwi (keyword, value, comment, pn)
+fxf_akwr          267 ./imio/iki/fxf/fxfencode.x procedure fxf_akwr (keyword, value, comment, precision, pn)
+fxf_alloc         322 ./imio/iki/fxf/fxfopen.x procedure fxf_alloc (fit)
+fxf_altmd          95 ./imio/iki/fxf/fxfupk.x procedure fxf_altmd (a, b, npix, bscale, bzero)
+fxf_altmr          78 ./imio/iki/fxf/fxfupk.x procedure fxf_altmr (a, b, npix, bscale, bzero)
+fxf_altmu         116 ./imio/iki/fxf/fxfupk.x procedure fxf_altmu (a, b, npix)
+fxf_blank_lines   1129 ./imio/iki/fxf/fxfrfits.x procedure fxf_blank_lines (nbl, po)
+fxf_byte_short    281 ./imio/iki/fxf/fxfopix.x procedure fxf_byte_short (im, fname)
+fxf_check_dup_extnv507 ./imio/iki/fxf/fxfopen.x int procedure fxf_check_dup_extnv (im, group)
+fxf_check_group   759 ./imio/iki/fxf/fxfopen.x procedure fxf_check_group (im, ksection, acmode, group, ksinh)
+fxf_check_old_name561 ./imio/iki/fxf/fxfopen.x procedure fxf_check_old_name (im)
+fxf_chk_ndim      784 ./imio/iki/fxf/fxfopix.x procedure fxf_chk_ndim(im)
+fxf_close          12 ./imio/iki/fxf/fxfclose.x procedure fxf_close (im, status)
+fxf_copy            8 ./imio/iki/fxf/fxfcopy.x procedure fxf_copy (kernel, oroot, oextn, nroot, nextn, status)
+fxf_ctype           9 ./imio/iki/fxf/fxfctype.x int procedure fxf_ctype (card, index)
+fxf_date2limtime  877 ./imio/iki/fxf/fxfrfits.x procedure fxf_date2limtime (str, limtime)
+fxf_delete         11 ./imio/iki/fxf/fxfdelete.x procedure fxf_delete (kernel, root, extn, status)
+fxf_discard_keyw  698 ./imio/iki/fxf/fxfopix.x procedure fxf_discard_keyw (im)
+fxf_dummy_header  446 ./imio/iki/fxf/fxfopen.x procedure fxf_dummy_header (im, status)
+fxf_encode_axis   127 ./imio/iki/fxf/fxfencode.x procedure fxf_encode_axis (root, keyword, axisno)
+fxf_encode_date   177 ./imio/iki/fxf/fxfencode.x procedure fxf_encode_date (datestr, szdate)
+fxf_encodeb        31 ./imio/iki/fxf/fxfencode.x procedure fxf_encodeb (keyword, param, card, comment)
+fxf_encodec       143 ./imio/iki/fxf/fxfencode.x procedure fxf_encodec (keyword, param, maxch, card, comment)
+fxf_encoded       108 ./imio/iki/fxf/fxfencode.x procedure fxf_encoded (keyword, param, card, comment, precision)
+fxf_encodei        55 ./imio/iki/fxf/fxfencode.x procedure fxf_encodei (keyword, param, card, comment)
+fxf_encodel        72 ./imio/iki/fxf/fxfencode.x procedure fxf_encodel (keyword, param, card, comment)
+fxf_encoder        89 ./imio/iki/fxf/fxfencode.x procedure fxf_encoder (keyword, param, card, comment, precision)
+fxf_extnv_error   455 ./imio/iki/fxf/fxfrfits.x int procedure fxf_extnv_error (fit, ig, extn, extv)
+fxf_falloc        754 ./imio/iki/fxf/fxfopix.x procedure fxf_falloc (fname, size)
+fxf_fclobber      659 ./imio/iki/fxf/fxfopen.x procedure fxf_fclobber (file)
+fxf_filter_keyw   729 ./imio/iki/fxf/fxfopix.x procedure fxf_filter_keyw (im, key)
+fxf_form_messg    1168 ./imio/iki/fxf/fxfrfits.x procedure fxf_form_messg (fit, messg)
+fxf_fpl_equald    156 ./imio/iki/fxf/fxfrdhdr.x bool procedure fxf_fpl_equald (x, y, it)
+fxf_gaccess       694 ./imio/iki/fxf/fxfopen.x procedure fxf_gaccess (im, fsec)
+fxf_getb           73 ./imio/iki/fxf/fxfget.x procedure fxf_getb (card, bval)
+fxf_getcmt        116 ./imio/iki/fxf/fxfget.x procedure fxf_getcmt (card, comment, maxch)
+fxf_getd           55 ./imio/iki/fxf/fxfget.x procedure fxf_getd (card, dval)
+fxf_gethdrextn     10 ./imio/iki/fxf/fxfhextn.x procedure fxf_gethdrextn (im, o_im, acmode, outstr, maxch)
+fxf_geti           19 ./imio/iki/fxf/fxfget.x procedure fxf_geti (card, ival)
+fxf_getr           37 ./imio/iki/fxf/fxfget.x procedure fxf_getr (card, rval)
+fxf_gltm          150 ./imio/iki/fxf/fxfget.x procedure fxf_gltm (time, date, limtime)
+fxf_gstr           92 ./imio/iki/fxf/fxfget.x procedure fxf_gstr (card, outstr, maxch)
+fxf_hdr_offset    255 ./imio/iki/fxf/fxfupdhdr.x int procedure fxf_hdr_offset (group, fit, pfd, acmode)
+fxf_header_diff   288 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_header_diff (im, group, acmode, hdr_off, diff, ualen)
+fxf_header_size   200 ./imio/iki/fxf/fxfopix.x int procedure fxf_header_size (im)
+fxf_init          344 ./imio/iki/fxf/fxfopen.x procedure fxf_init()
+fxf_is_blank      1150 ./imio/iki/fxf/fxfrfits.x bool procedure fxf_is_blank (line)
+fxf_ks_errors     410 ./imio/iki/fxf/fxfksection.x procedure fxf_ks_errors (fit, acmode)
+fxf_ks_gvalue     197 ./imio/iki/fxf/fxfksection.x procedure fxf_ks_gvalue (param, ksection, ip, fit)
+fxf_ks_lex        130 ./imio/iki/fxf/fxfksection.x int procedure fxf_ks_lex (outstr)
+fxf_ks_pm         375 ./imio/iki/fxf/fxfksection.x procedure fxf_ks_pm (pm, param, fit)
+fxf_ks_val        259 ./imio/iki/fxf/fxfksection.x procedure fxf_ks_val (outstr, param, fit)
+fxf_ksection       42 ./imio/iki/fxf/fxfksection.x procedure fxf_ksection (ksection, fit, group)
+fxf_ksinit        448 ./imio/iki/fxf/fxfksection.x procedure fxf_ksinit (fit)
+fxf_load_header   598 ./imio/iki/fxf/fxfrfits.x procedure fxf_load_header (in, fit, spool, nrec1440, datalen)
+fxf_make_adj_copy 793 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_make_adj_copy (in_fd, out_fd, hdr_off, pixoff, chars_ua)
+fxf_make_card       6 ./imio/iki/fxf/fxfmkcard.x procedure fxf_make_card (instr, ip, card, col_out, maxcols, delim)
+fxf_mandatory_cards461 ./imio/iki/fxf/fxfopix.x procedure fxf_mandatory_cards (im, nheader_cards)
+fxf_match_str     916 ./imio/iki/fxf/fxfrfits.x procedure fxf_match_str (pat, plines, str, slines, merge, po)
+fxf_merge_w_ua    754 ./imio/iki/fxf/fxfrfits.x procedure fxf_merge_w_ua (im, userh, fitslen)
+fxf_null            8 ./imio/iki/fxf/fxfnull.x procedure fxf_null()
+fxf_open           14 ./imio/iki/fxf/fxfopen.x procedure fxf_open (kernel, im, o_im, root, extn, ksection, group, gc_arg,
+fxf_opix           16 ./imio/iki/fxf/fxfopix.x procedure fxf_opix (im, status)
+fxf_over_delete   913 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_over_delete (im)
+fxf_overwrite_unit549 ./imio/iki/fxf/fxfopix.x procedure fxf_overwrite_unit (fit, im)
+fxf_pak_data       12 ./imio/iki/fxf/fxfpak.x procedure fxf_pak_data (ibuf, obuf, npix, pixtype)
+fxf_prhdr         370 ./imio/iki/fxf/fxfopen.x procedure fxf_prhdr (im, group)
+fxf_read_card       8 ./imio/iki/fxf/fxfrcard.x int procedure fxf_read_card (fd, ibuf, obuf, ncards)
+fxf_read_xtn      280 ./imio/iki/fxf/fxfrfits.x procedure fxf_read_xtn (im, cfit, igroup, hoff, poff, extn, extv)
+fxf_reblock       597 ./imio/iki/fxf/fxfopen.x procedure fxf_reblock (im)
+fxf_ren_tmp       889 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_ren_tmp (in, out)
+fxf_rename         10 ./imio/iki/fxf/fxfrename.x procedure fxf_rename (kernel, oroot, oextn, nroot, nextn, status)
+fxf_rfitshdr       25 ./imio/iki/fxf/fxfrfits.x procedure fxf_rfitshdr (im, group, poff)
+fxf_rheader        13 ./imio/iki/fxf/fxfrdhdr.x procedure fxf_rheader (im, group, acmode)
+fxf_set_cache_time844 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_set_cache_time (im)
+fxf_setbitpix     763 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_setbitpix (im, fit)
+fxf_skip_xtn      506 ./imio/iki/fxf/fxfrfits.x procedure fxf_skip_xtn (im, group, cfit, hoff, poff, extn, extv, spool)
+fxf_strcmp_lwr    849 ./imio/iki/fxf/fxfrfits.x int procedure fxf_strcmp_lwr (s1, s2)
+fxf_totpix        678 ./imio/iki/fxf/fxfopix.x int procedure fxf_totpix (im)
+fxf_ua_card       716 ./imio/iki/fxf/fxfupdhdr.x int procedure fxf_ua_card (fit, im, up, card)
+fxf_unpack_data    20 ./imio/iki/fxf/fxfupk.x procedure fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+fxf_update_extend 951 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_update_extend (im)
+fxf_updhdr         27 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_updhdr (im, status)
+fxf_write_blanks  421 ./imio/iki/fxf/fxfopix.x procedure fxf_write_blanks (fd, size)
+fxf_write_header  482 ./imio/iki/fxf/fxfupdhdr.x procedure fxf_write_header (im, fit, hdr_fd, diff)
+fxfzcl             62 ./imio/iki/fxf/zfiofxf.x procedure fxfzcl (chan, status)
+fxfzop             19 ./imio/iki/fxf/zfiofxf.x procedure fxfzop (pkfn, mode, status)
+fxfzrd             82 ./imio/iki/fxf/zfiofxf.x procedure fxfzrd (chan, obuf, nbytes, boffset)
+fxfzst            279 ./imio/iki/fxf/zfiofxf.x procedure fxfzst (chan, param, value)
+fxfzwr            168 ./imio/iki/fxf/zfiofxf.x procedure fxfzwr (chan, ibuf, nbytes, boffset)
+fxfzwt            264 ./imio/iki/fxf/zfiofxf.x procedure fxfzwt (chan, status)
+g_ttyload         159 ./tty/ttygdes.x    int procedure g_ttyload (fname, device, outstr, maxch)
+gactivate          12 ./gio/gactivate.x  procedure gactivate (gp, flags)
+gacwk               7 ./gio/gks/gacwk.x  procedure gacwk (wkid)
+gadraw             20 ./gio/gadraw.x     procedure gadraw (gp, wx, wy)
+gamove              9 ./gio/gamove.x     procedure gamove (gp, x, y)
+gargb               8 ./fmtio/gargb.x    procedure gargb (bval)
+gargc               5 ./fmtio/gargc.x    procedure gargc (cval)
+gargd               6 ./fmtio/gargd.x    procedure gargd (dval)
+gargi               7 ./fmtio/gargi.x    procedure gargi (ival)
+gargl               7 ./fmtio/gargl.x    procedure gargl (lval)
+gargr               6 ./fmtio/gargr.x    procedure gargr (rval)
+gargrad             6 ./fmtio/gargrad.x  procedure gargrad (lval, radix)
+gargs               7 ./fmtio/gargs.x    procedure gargs (sval)
+gargstr             5 ./fmtio/gargstr.x  procedure gargstr (outstr, maxch)
+gargtok             5 ./fmtio/gargtok.x  procedure gargtok (token, outstr, maxch)
+gargwrd             6 ./fmtio/gargwrd.x  procedure gargwrd (outstr, maxch)
+gargx               5 ./fmtio/gargx.x    procedure gargx (xval)
+gascale            11 ./gio/gascale.x    procedure gascale (gp, v, npts, axis)
+gax_draw          292 ./gio/cursor/grcaxes.x procedure gax_draw (wx, wy)
+gax_findticks     181 ./gio/cursor/grcaxes.x procedure gax_findticks (w, wx1,wx2,wy1,wy2, x1,dx,xt, y1,dy,yt)
+gax_flush         353 ./gio/cursor/grcaxes.x procedure gax_flush (stream)
+gax_ndc           249 ./gio/cursor/grcaxes.x procedure gax_ndc (wx, wy, sx, sy)
+gax_start         338 ./gio/cursor/grcaxes.x procedure gax_start (wx, wy)
+gax_text          368 ./gio/cursor/grcaxes.x procedure gax_text (stream, sx, sy, text, hjustify, vjustify)
+gax_tick          312 ./gio/cursor/grcaxes.x procedure gax_tick (dx, dy)
+gbytes             15 ./gio/ncarutil/sysint/gbytes.x procedure gbytes (bufin, bufout, index, size, skip, count)
+gca                 9 ./gio/gks/gca.x    procedure gca (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+gcancel            21 ./gio/gcancel.x    procedure gcancel (gp)
+gcas                9 ./gio/gks/gcas.x   procedure gcas (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+gclear             11 ./gio/gclear.x     procedure gclear (gp)
+gclks               5 ./gio/gks/gclks.x  procedure gclks ()
+gclose             10 ./gio/gclose.x     procedure gclose (gp)
+gclrwk              7 ./gio/gks/gclrwk.x procedure gclrwk (wkid, cofl)
+gclwk               7 ./gio/gks/gclwk.x  procedure gclwk (wkid)
+gctod              16 ./fmtio/gctod.x    int procedure gctod (str, ip, odval)
+gctol              22 ./fmtio/gctol.x    int procedure gctol (str, ip, lval, radix)
+gctox              16 ./fmtio/gctox.x    int procedure gctox (str, ip, oxval)
+gctran             14 ./gio/gctran.x     procedure gctran (gp, x1,y1, x2,y2, wcs_a, wcs_b)
+gcurpos            10 ./gio/gcurpos.x    procedure gcurpos (gp, x, y)
+gdawk               7 ./gio/gks/gdawk.x  procedure gdawk (wkid)
+gdeactivate        12 ./gio/gdeact.x     procedure gdeactivate (gp, flags)
+gdrwch            235 ./gio/nsppkern/zzdebug.x procedure gdrwch (gp, x, y, ch, xsize, ysize)
+gescape             9 ./gio/gescape.x    procedure gescape (gp, fn, instruction, nwords)
+get_processtable    1 ../unix/os/getproc.c get_processtable (kmem, o_nproc)
+get_timezone        1 ../unix/os/gmttolst.c get_timezone()
+getc                8 ./fio/getc.x       char procedure getc (fd, ch)
+getchar             5 ./fio/getchar.x    char procedure getchar (ch)
+getci               8 ./fio/getci.x      int procedure getci (fd, ch)
+gethost             5 ./etc/gethost.x    procedure gethost (outstr, maxch)
+getline            15 ./fio/getline.x    int procedure getline (fd, linebuf)
+getlline            9 ./fio/getlline.x   int procedure getlline (fd, obuf, maxch)
+getlongline        10 ./fio/glongline.x  int procedure getlongline (fd, obuf, maxch, linenum)
+getpid              5 ./etc/getpid.x     int procedure getpid()
+gets                1 ./libc/gets.c      gets (buf)
+getstr             11 ../unix/os/zfiond.c getstr (ipp, obuf, maxch)
+gettok              6 ../unix/os/tape.c  gettok()
+getuid              7 ./etc/getuid.x     procedure getuid (user_name, maxch)
+getw                1 ./libc/getw.c      getw (fp)
+gexfls             10 ./clio/gexfls.x    procedure gexfls()
+gexfls_clear       48 ./clio/gexfls.x    procedure gexfls_clear (stream)
+gexfls_set         28 ./clio/gexfls.x    procedure gexfls_set (stream, gp_value, epa_gflush)
+gfa                 9 ./gio/gks/gfa.x    procedure gfa (n, px, py)
+gfill               8 ./gio/gfill.x      procedure gfill (gp, x, y, npts, style)
+gflush             11 ./gio/gflush.x     procedure gflush (gp)
+gframe              9 ./gio/gframe.x     procedure gframe (gp)
+gfrinit             9 ./gio/gfrinit.x    procedure gfrinit (gp)
+ggcell             13 ./gio/ggcell.x     procedure ggcell (gp, m, nx, ny, x1, y1, x2, y2)
+ggcur              14 ./gio/ggcur.x      int procedure ggcur (gp, cn, key, sx, sy, raster, rx, ry)
+ggetb              10 ./gio/ggetb.x      bool procedure ggetb (gp, cap)
+ggeti               9 ./gio/ggeti.x      int procedure ggeti (gp, cap)
+ggetr               9 ./gio/ggetr.x      real procedure ggetr (gp, cap)
+ggets              12 ./gio/ggets.x      int procedure ggets (gp, cap, outstr, maxch)
+ggscale            10 ./gio/ggscale.x    procedure ggscale (gp, x, y, dx, dy)
+ggview              7 ./gio/ggview.x     procedure ggview (gp, x1, x2, y1, y2)
+ggwind              7 ./gio/ggwind.x     procedure ggwind (gp, x1, x2, y1, y2)
+gim_copyraster     10 ./gio/gim/gimcpras.x procedure gim_copyraster (gp, rop, src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+gim_createraster    7 ./gio/gim/gimcrras.x procedure gim_createraster (gp, raster, type, width, height, depth)
+gim_destroyraster   7 ./gio/gim/gimderas.x procedure gim_destroyraster (gp, raster)
+gim_disablemapping  9 ./gio/gim/gimdsmap.x procedure gim_disablemapping (gp, mapping, erase)
+gim_enablemapping   9 ./gio/gim/gimenmap.x procedure gim_enablemapping (gp, mapping, refresh)
+gim_freecolormap    7 ./gio/gim/gimfcmap.x procedure gim_freecolormap (gp, colormap)
+gim_freemapping     7 ./gio/gim/gimfmap.x procedure gim_freemapping (gp, mapping)
+gim_getmapping     14 ./gio/gim/gimgetmap.x int procedure gim_getmapping (gp, mapping, rop,
+gim_initmappings    7 ./gio/gim/gimimap.x procedure gim_initmappings (gp)
+gim_iomapread      10 ./gio/gim/gimriomap.x procedure gim_iomapread (gp, iomap, first, nelem)
+gim_iomapwrite     12 ./gio/gim/gimwiomap.x procedure gim_iomapwrite (gp, iomap, first, nelem)
+gim_loadcolormap   26 ./gio/gim/gimlcmap.x procedure gim_loadcolormap (gp, colormap, offset, slope)
+gim_queryraster    12 ./gio/gim/gimqras.x int procedure gim_queryraster (gp, raster, type, width, height, depth)
+gim_rasterinit      8 ./gio/gim/gimrasini.x procedure gim_rasterinit (gp)
+gim_readcolormap   12 ./gio/gim/gimrcmap.x int procedure gim_readcolormap (gp, colormap, first, maxelem, r, g, b)
+gim_readpixels     11 ./gio/gim/gimrpix.x procedure gim_readpixels (gp, raster, data, nbits, x1, y1, nx, ny)
+gim_refreshmapping  8 ./gio/gim/gimref.x procedure gim_refreshmapping (gp, mapping)
+gim_refreshpix     11 ./gio/gim/gimrefpix.x procedure gim_refreshpix (gp, raster, ct, x1, y1, width, height)
+gim_setmapping     20 ./gio/gim/gimsetmap.x procedure gim_setmapping (gp, mapping, rop,
+gim_setpix         10 ./gio/gim/gimsetpix.x procedure gim_setpix (gp, raster, ct, x1, y1, width, height, color, rop)
+gim_setraster      18 ./gio/gim/gimsetras.x procedure gim_setraster (gp, raster)
+gim_writecolormap   8 ./gio/gim/gimwcmap.x procedure gim_writecolormap (gp, colormap, first, nelem, r, g, b)
+gim_writepixels     9 ./gio/gim/gimwpix.x procedure gim_writepixels (gp, raster, data, nbits, x1, y1, nx, ny)
+giotr              23 ./gio/cursor/giotr.x procedure giotr (stream)
+giotr_onint       173 ./gio/cursor/giotr.x procedure giotr_onint (vex, next_handler)
+gki_cancel         12 ./gio/gki/gkicancel.x procedure gki_cancel (fd)
+gki_clear          12 ./gio/gki/gkiclear.x procedure gki_clear (fd)
+gki_closews        14 ./gio/gki/gkiclose.x procedure gki_closews (fd, device)
+gki_deactivatews   13 ./gio/gki/gkideact.x procedure gki_deactivatews (fd, flags)
+gki_eof            12 ./gio/gki/gkieof.x procedure gki_eof (fd)
+gki_escape         15 ./gio/gki/gkiesc.x procedure gki_escape (fd, fn, instruction, nwords)
+gki_execute        14 ./gio/gki/gkiexe.x procedure gki_execute (gki, dd)
+gki_faset          15 ./gio/gki/gkifaset.x procedure gki_faset (fd, ap)
+gki_fetch_next_instruction 22 ./gio/gki/gkifetch.x int procedure gki_fetch_next_instruction (fd, instruction)
+gki_fflush         11 ./gio/gki/gkifflush.x procedure gki_fflush (fd)
+gki_fillarea       14 ./gio/gki/gkifa.x  procedure gki_fillarea (fd, points, npts)
+gki_flush          13 ./gio/gki/gkiflush.x procedure gki_flush (fd)
+gki_getcellarray   19 ./gio/gki/gkigca.x procedure gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+gki_getcursor      42 ./gio/gki/gkigcur.x procedure gki_getcursor (fd, cursor, cn, key, sx, sy, raster, rx, ry)
+gki_getwcs         15 ./gio/gki/gkigetwcs.x procedure gki_getwcs (fd, wcs, len_wcs)
+gki_init           12 ./gio/gki/gkiinit.x procedure gki_init (stream)
+gki_inline_kernel  14 ./gio/gki/gkiinline.x procedure gki_inline_kernel (stream, dd)
+gki_mftitle        14 ./gio/gki/gkititle.x procedure gki_mftitle (fd, title)
+gki_openws         15 ./gio/gki/gkiopen.x procedure gki_openws (fd, device, mode)
+gki_plset          16 ./gio/gki/gkiplset.x procedure gki_plset (fd, ap)
+gki_pmset          16 ./gio/gki/gkipmset.x procedure gki_pmset (fd, ap)
+gki_polyline       14 ./gio/gki/gkipl.x  procedure gki_polyline (fd, points, npts)
+gki_polymarker     14 ./gio/gki/gkipm.x  procedure gki_polymarker (fd, points, npts)
+gki_putcellarray   17 ./gio/gki/gkipca.x procedure gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+gki_reactivatews   13 ./gio/gki/gkireact.x procedure gki_reactivatews (fd, flags)
+gki_redir          14 ./gio/gki/gkiredir.x procedure gki_redir (stream, fd, old_fd, old_type)
+gki_retcellarray   15 ./gio/gki/gkirca.x procedure gki_retcellarray (fd, m, np)
+gki_retcursorvalue 29 ./gio/gki/gkircval.x procedure gki_retcursorvalue (fd, cn, key, sx, sy, raster, rx, ry)
+gki_setcursor      14 ./gio/gki/gkiscur.x procedure gki_setcursor (fd, x, y, cursor)
+gki_setwcs         16 ./gio/gki/gkisetwcs.x procedure gki_setwcs (fd, wcs, len_wcs)
+gki_subkernel      19 ./gio/gki/gkikern.x procedure gki_subkernel (stream, pid, prpsio_epa)
+gki_text           15 ./gio/gki/gkitx.x  procedure gki_text (fd, x, y, text)
+gki_txset          24 ./gio/gki/gkitxset.x procedure gki_txset (fd, ap)
+gki_wescape        19 ./gio/gki/gkiwesc.x procedure gki_wescape (fd, fn, hdr, hdrlen, data, datalen)
+gki_write          12 ./gio/gki/gkiwrite.x procedure gki_write (fd, gki)
+gkp_cancel        283 ./gio/gki/gkiprint.x procedure gkp_cancel (dummy)
+gkp_clear         270 ./gio/gki/gkiprint.x procedure gkp_clear (dummy)
+gkp_close         133 ./gio/gki/gkiprint.x procedure gkp_close()
+gkp_closews       191 ./gio/gki/gkiprint.x procedure gkp_closews (devname, n)
+gkp_deactivatews  230 ./gio/gki/gkiprint.x procedure gkp_deactivatews (flags)
+gkp_dump          799 ./gio/gki/gkiprint.x procedure gkp_dump (fd, data, nwords)
+gkp_escape        597 ./gio/gki/gkiprint.x procedure gkp_escape (fn, instruction, nwords)
+gkp_faset         557 ./gio/gki/gkiprint.x procedure gkp_faset (gki)
+gkp_fillarea      341 ./gio/gki/gkiprint.x procedure gkp_fillarea (p, npts)
+gkp_flush         297 ./gio/gki/gkiprint.x procedure gkp_flush (dummy)
+gkp_getcellarray  429 ./gio/gki/gkiprint.x procedure gkp_getcellarray (nx, ny, x1,y1, x2,y2)
+gkp_getcursor     502 ./gio/gki/gkiprint.x procedure gkp_getcursor (cursor)
+gkp_getwcs        673 ./gio/gki/gkiprint.x procedure gkp_getwcs (wcs, nwords)
+gkp_grstream      142 ./gio/gki/gkiprint.x procedure gkp_grstream (graphics_stream)
+gkp_install        79 ./gio/gki/gkiprint.x procedure gkp_install (dd, out_fd, verbose_output, use_gkiunits)
+gkp_mftitle       246 ./gio/gki/gkiprint.x procedure gkp_mftitle (title, n)
+gkp_openws        155 ./gio/gki/gkiprint.x procedure gkp_openws (devname, n, mode)
+gkp_plset         525 ./gio/gki/gkiprint.x procedure gkp_plset (gki)
+gkp_pmset         541 ./gio/gki/gkiprint.x procedure gkp_pmset (gki)
+gkp_polyline      311 ./gio/gki/gkiprint.x procedure gkp_polyline (p, npts)
+gkp_polymarker    326 ./gio/gki/gkiprint.x procedure gkp_polymarker (p, npts)
+gkp_pstat         704 ./gio/gki/gkiprint.x procedure gkp_pstat (fd, p, npts, label, verbose, gkiunits)
+gkp_putcellarray  392 ./gio/gki/gkiprint.x procedure gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+gkp_reactivatews  216 ./gio/gki/gkiprint.x procedure gkp_reactivatews (flags)
+gkp_setcursor     478 ./gio/gki/gkiprint.x procedure gkp_setcursor (x, y, cursor)
+gkp_setwcs        618 ./gio/gki/gkiprint.x procedure gkp_setwcs (wcs, nwords)
+gkp_text          356 ./gio/gki/gkiprint.x procedure gkp_text (x, y, text, n)
+gkp_txparg          8 ./gio/gki/gkptxparg.x procedure gkp_txparg (code)
+gkp_txset         572 ./gio/gki/gkiprint.x procedure gkp_txset (gki)
+gkp_unknown       689 ./gio/gki/gkiprint.x procedure gkp_unknown (gki)
+gkt_cancel          8 ./gio/nsppkern/gktcancel.x procedure gkt_cancel (dummy)
+gkt_clear          10 ./gio/nsppkern/gktclear.x procedure gkt_clear (dummy)
+gkt_close           8 ./gio/nsppkern/gktclose.x procedure gkt_close()
+gkt_closews         9 ./gio/nsppkern/gktclws.x procedure gkt_closews (devname, n)
+gkt_color          15 ./gio/nsppkern/gktcolor.x procedure gkt_color(index)
+gkt_drawchar       15 ./gio/nsppkern/gktdrawch.x procedure gkt_drawchar (ch, x, y, xsize, ysize, orien, font)
+gkt_escape          6 ./gio/nsppkern/gktescape.x procedure gkt_escape (fn, instruction, nwords)
+gkt_faset           8 ./gio/nsppkern/gktfaset.x procedure gkt_faset (gki)
+gkt_fillarea        7 ./gio/nsppkern/gktfa.x procedure gkt_fillarea (p, npts)
+gkt_flush           7 ./gio/nsppkern/gktflush.x procedure gkt_flush (dummy)
+gkt_font           13 ./gio/nsppkern/gktfont.x procedure gkt_font (font)
+gkt_getcellarray    6 ./gio/nsppkern/gktgcell.x procedure gkt_getcellarray (nx, ny, x1,y1, x2,y2)
+gkt_gstring       151 ./gio/nsppkern/gktinit.x pointer procedure gkt_gstring (cap)
+gkt_init           13 ./gio/nsppkern/gktinit.x procedure gkt_init (tty, devname)
+gkt_linetype        8 ./gio/nsppkern/gktline.x procedure gkt_linetype (index)
+gkt_mfopen         16 ./gio/nsppkern/gktmfopen.x int procedure gkt_mfopen (tty, mode)
+gkt_open           12 ./gio/nsppkern/gktopen.x procedure gkt_open (devname, dd)
+gkt_openws         13 ./gio/nsppkern/gktopenws.x procedure gkt_openws (devname, n, mode)
+gkt_plset           9 ./gio/nsppkern/gktplset.x procedure gkt_plset (gki)
+gkt_pmset           8 ./gio/nsppkern/gktpmset.x procedure gkt_pmset (gki)
+gkt_polyline       11 ./gio/nsppkern/gktpl.x procedure gkt_polyline (p, npts)
+gkt_polymarker     13 ./gio/nsppkern/gktpm.x procedure gkt_polymarker (p, npts)
+gkt_putcellarray   14 ./gio/nsppkern/gktpcell.x procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+gkt_reset          12 ./gio/nsppkern/gktreset.x procedure gkt_reset()
+gkt_text           20 ./gio/nsppkern/gkttx.x procedure gkt_text (xc, yc, text, n)
+gkt_txset           9 ./gio/nsppkern/gkttxset.x procedure gkt_txset (gki)
+glabax             14 ./gio/glabax/glabax.x procedure glabax (gp, title, xlabel, ylabel)
+glb_drawgrid       11 ./gio/glabax/glbgrid.x procedure glb_drawgrid (gp, ax1, ax2)
+glb_encode         14 ./gio/glabax/glbencode.x procedure glb_encode (x, out, maxch, format, step)
+glb_eq            245 ./gio/glabax/glbgtick.x bool procedure glb_eq (a, b)
+glb_find_ticks     19 ./gio/glabax/glbfind.x procedure glb_find_ticks (gp, ap, ax1, ax2, angle)
+glb_gettick        50 ./gio/glabax/glbgtick.x int procedure glb_gettick (gp, ax, x, y, major_tick)
+glb_label_axis     15 ./gio/glabax/glblabel.x procedure glb_label_axis (gp, ax, xlabel, ylabel)
+glb_loglab         16 ./gio/glabax/glbloglab.x procedure glb_loglab (gp, sx, sy, val, fmt, scaling)
+glb_minorstep     307 ./gio/glabax/glbfind.x real procedure glb_minorstep (x1, x2, nminor)
+glb_plot_title     13 ./gio/glabax/glbtitle.x procedure glb_plot_title (gp, title, ntitlelines)
+glb_set_axes       10 ./gio/glabax/glbsetax.x procedure glb_set_axes (gp, ap, ax1, ax2, angle)
+glb_set_viewport   13 ./gio/glabax/glbsview.x procedure glb_set_viewport (gp, ntitlelines, xlabel, ylabel)
+glb_setup          10 ./gio/glabax/glbsetup.x procedure glb_setup (gp, axes, ntitlelines, xlabel, ylabel)
+glb_ticklen        16 ./gio/glabax/glbticlen.x real procedure glb_ticklen (gp, ax, ndc_length)
+glb_verify_log_scaling 13 ./gio/glabax/glbverify.x procedure glb_verify_log_scaling (gp)
+gline               5 ./gio/gline.x      procedure gline (gp, x1, y1, x2, y2)
+gltoc              14 ./fmtio/gltoc.x    int procedure gltoc (lval, outstr, maxch, base)
+gmark              16 ./gio/gmark.x      procedure gmark (gp, x, y, marktype, xsize, ysize)
+gmftitle            9 ./gio/gmftitle.x   procedure gmftitle (gp, mftitle)
+gmprintf            8 ./gio/gmprintf.x   procedure gmprintf (gp, object, format)
+gmsg               33 ./gio/gmsg.x       procedure gmsg (gp, object, message)
+gmsgb              73 ./gio/gmsg.x       procedure gmsgb (gp, object, value)
+gmsgc              89 ./gio/gmsg.x       procedure gmsgc (gp, object, value)
+gmsgd             196 ./gio/gmsg.x       procedure gmsgd (gp, object, value)
+gmsgi             129 ./gio/gmsg.x       procedure gmsgi (gp, object, value)
+gmsgl             152 ./gio/gmsg.x       procedure gmsgl (gp, object, value)
+gmsgr             173 ./gio/gmsg.x       procedure gmsgr (gp, object, value)
+gmsgs             106 ./gio/gmsg.x       procedure gmsgs (gp, object, value)
+gmsgx             217 ./gio/gmsg.x       procedure gmsgx (gp, object, value)
+gmt_to_lst          1 ../unix/os/gmttolst.c gmt_to_lst (gmt)
+gopen             177 ./gio/gopen.x      pointer procedure gopen (device, mode, fd)
+gopenui            19 ./gio/gopen.x      pointer procedure gopenui (device, mode, uifname, fd)
+gopks               9 ./gio/gks/gopks.x  procedure gopks (errfil)
+gopwk               7 ./gio/gks/gopwk.x  procedure gopwk (wkid, conid, wtype)
+gpagefile          11 ./gio/gpagefile.x  procedure gpagefile (gp, fname, prompt)
+gpatmake          313 ./fmtio/patmatch.x int procedure gpatmake (patstr, from, delim, patbuf, sz_pat)
+gpatmatch          64 ./fmtio/patmatch.x int procedure gpatmatch (str, pat, first_char, last_char)
+gpcell             35 ./gio/gpcell.x     procedure gpcell (gp, m, nx, ny, x1, y1, x2, y2)
+gpl                 7 ./gio/gks/gpl.x    procedure gpl (n, px, py)
+gpl_cache          11 ./gio/gplcache.x   procedure gpl_cache (gp)
+gpl_cancel          7 ./gio/gplcancel.x  procedure gpl_cancel()
+gpl_clipb         224 ./gio/gadraw.x     procedure gpl_clipb (pen, mx, my)
+gpl_clipl         168 ./gio/gadraw.x     procedure gpl_clipl (pen, mx, my)
+gpl_clipr         196 ./gio/gadraw.x     procedure gpl_clipr (pen, mx, my)
+gpl_clipt         256 ./gio/gadraw.x     procedure gpl_clipt (pen, mx, my)
+gpl_flush          11 ./gio/gplflush.x   procedure gpl_flush()
+gpl_reset          10 ./gio/gplreset.x   procedure gpl_reset()
+gpl_settype         8 ./gio/gplstype.x   procedure gpl_settype (gp, type)
+gpl_wcstogki       13 ./gio/wcstogki.x   procedure gpl_wcstogki (gp, wx, wy, mx, my)
+gpline              7 ./gio/gpline.x     procedure gpline (gp, x, y, npts)
+gploto              9 ./gio/gploto.x     procedure gploto (gp, v, npts, x1, x2, title)
+gplotv              7 ./gio/gplotv.x     procedure gplotv (v, npts, x1, x2, title)
+gpm                 9 ./gio/gks/gpm.x    procedure gpm (n, px, py)
+gpmark             10 ./gio/gpmark.x     procedure gpmark (gp, x, y, npts, marktype, xsize, ysize)
+gpt_clipb         380 ./gio/cursor/gtrwstran.x procedure gpt_clipb (pen, mx, my)
+gpt_clipl         320 ./gio/cursor/gtrwstran.x procedure gpt_clipl (pen, mx, my)
+gpt_clipr         350 ./gio/cursor/gtrwstran.x procedure gpt_clipr (pen, mx, my)
+gpt_clipt         414 ./gio/cursor/gtrwstran.x procedure gpt_clipt (pen, mx, my)
+gpt_firstpt       266 ./gio/cursor/gtrwstran.x int procedure gpt_firstpt (gki, ip, last_ip)
+gpt_flush         451 ./gio/cursor/gtrwstran.x procedure gpt_flush()
+gqasf               7 ./gio/gks/gqasf.x  procedure gqasf (ierror, lasf)
+gqchh               8 ./gio/gks/gqchh.x  procedure gqchh (ierror, chh)
+gqchup              8 ./gio/gks/gqchup.x procedure gqchup (ierror, chupx, chupy)
+gqclip              8 ./gio/gks/gqclip.x procedure gqclip (errind, iclip, iar)
+gqcntn              8 ./gio/gks/gqcntn.x procedure gqcntn (errind, cntr)
+gqmk                9 ./gio/gks/gqmk.x   procedure gqmk (ierr, mtype)
+gqnt               10 ./gio/gks/gqnt.x   procedure gqnt (ntnr, errind, window, vport)
+gqopwk             10 ./gio/gks/gqopwk.x procedure gqopwk (n, errind, ol, wkid)
+gqplci              8 ./gio/gks/gqplci.x procedure gqplci (errind, coli)
+gqpmci              8 ./gio/gks/gqpmci.x procedure gqpmci (errind, coli)
+gqpmi               8 ./gio/gks/gqpmi.x  procedure gqpmi (errind, index)
+gqsort             22 ./etc/gqsort.x     procedure gqsort (x, nelem, compare, arg)
+gqtxal              8 ./gio/gks/gqtxal.x procedure gqtxal (ierror, txalh, txalv)
+gqtxci              8 ./gio/gks/gqtxci.x procedure gqtxci (ierror, coli)
+gqtxp               8 ./gio/gks/gqtxp.x  procedure gqtxp (ierror, path)
+gqverify           10 ./gio/gqverify.x   int procedure gqverify()
+gqwks               8 ./gio/gks/gqwks.x  procedure gqwks (wkid, errind, state)
+grc_axes           20 ./gio/cursor/grcaxes.x procedure grc_axes (stream, sx, sy, raster, rx, ry)
+grc_boolval       369 ./gio/cursor/grccmd.x int procedure grc_boolval (opstr, ip)
+grc_close          14 ./gio/cursor/grcclose.x procedure grc_close (fd, rc)
+grc_command        45 ./gio/cursor/grccmd.x int procedure grc_command (rc, stream, sx, sy, raster, rx, ry, opstr)
+grc_cursor        443 ./gio/cursor/rcursor.x int procedure grc_cursor (rc, stream, key, x, y, raster, rx, ry, ppos)
+grc_init            9 ./gio/cursor/grcinit.x procedure grc_init (rc, stream)
+grc_keys          423 ./gio/cursor/grccmd.x procedure grc_keys (rc, opstr, ip, onoff)
+grc_mapkey        571 ./gio/cursor/rcursor.x int procedure grc_mapkey (rc, key, nukey)
+grc_message       649 ./gio/cursor/rcursor.x procedure grc_message (stream, message)
+grc_ndctoscr       35 ./gio/cursor/grcscr.x procedure grc_ndctoscr (mx, my, sx, sy)
+grc_ndctowcs      167 ./gio/cursor/grcwcs.x procedure grc_ndctowcs (ct, mx, my, wx, wy)
+grc_open           12 ./gio/cursor/grcopen.x pointer procedure grc_open (device, mode, stream, rc)
+grc_pcursor       662 ./gio/cursor/rcursor.x procedure grc_pcursor (stream, sx, sy, raster, rx, ry)
+grc_polyline       13 ./gio/cursor/grcpl.x procedure grc_polyline (stream, v, npts)
+grc_read           10 ./gio/cursor/grcread.x procedure grc_read (tr, stream, fname)
+grc_readtty       614 ./gio/cursor/rcursor.x int procedure grc_readtty (stream, prompt, obuf, maxch)
+grc_realval       398 ./gio/cursor/grccmd.x real procedure grc_realval (opstr, ip)
+grc_redraw          9 ./gio/cursor/grcredraw.x procedure grc_redraw (rc, stream, sx, sy, raster, rx, ry)
+grc_restorecurpos 597 ./gio/cursor/rcursor.x procedure grc_restorecurpos (stream, x, y)
+grc_scrtondc       15 ./gio/cursor/grcscr.x procedure grc_scrtondc (sx, sy, mx, my)
+grc_scrtowcs       14 ./gio/cursor/grcwcs.x procedure grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+grc_selectwcs     208 ./gio/cursor/grcwcs.x int procedure grc_selectwcs (tr, raster, mx, my)
+grc_settran        70 ./gio/cursor/grcwcs.x procedure grc_settran (w, ct)
+grc_status         11 ./gio/cursor/grcstatus.x procedure grc_status (fd, rc)
+grc_text           12 ./gio/cursor/grctext.x procedure grc_text (stream, x, y, text)
+grc_viewport      488 ./gio/cursor/grccmd.x procedure grc_viewport (tr, stream, sx, sy, raster, rx, ry, opstr, ip)
+grc_warn            6 ./gio/cursor/grcwarn.x procedure grc_warn (fd)
+grc_wcstondc      130 ./gio/cursor/grcwcs.x procedure grc_wcstondc (ct, wx, wy, mx, my)
+grc_word          343 ./gio/cursor/grccmd.x procedure grc_word (opstr, ip, outstr, maxch)
+grc_write          12 ./gio/cursor/grcwrite.x procedure grc_write (tr, stream, fname, clobber, fullframe)
+grdraw              8 ./gio/grdraw.x     procedure grdraw (gp, x, y)
+grdwcs             51 ./gio/grdwcs.x     int procedure grdwcs (devname, wcs, len_wcs)
+greactivate        10 ./gio/greact.x     procedure greactivate (gp, flags)
+greset             10 ./gio/greset.x     procedure greset (gp, flags)
+grmove              8 ./gio/grmove.x     procedure grmove (gp, x, y)
+grscale            11 ./gio/grscale.x    procedure grscale (gp, v, npts, axis)
+gsasf              21 ./gio/gks/gsasf.x  procedure gsasf (lasf)
+gsawi               8 ./gio/gks/gsaw.x   procedure gsawi (param, value)
+gsawr              24 ./gio/gks/gsaw.x   procedure gsawr (param, value)
+gscan               5 ./gio/gscan.x      procedure gscan (gp, command)
+gschh               8 ./gio/gks/gschh.x  procedure gschh (chh)
+gschup              7 ./gio/gks/gschup.x procedure gschup (chux, chuy)
+gsclip              7 ./gio/gks/gsclip.x procedure gsclip (iclip)
+gscr                8 ./gio/gks/gscr.x   procedure gscr (wkstation, color_index, rgb)
+gscur               8 ./gio/gscur.x      procedure gscur (gp, x, y)
+gselnt              7 ./gio/gks/gselnt.x procedure gselnt (wcs)
+gseti               7 ./gio/gseti.x      procedure gseti (gp, param, value)
+gsetr              11 ./gio/gsetr.x      procedure gsetr (gp, param, rval)
+gsets               9 ./gio/gsets.x      procedure gsets (gp, param, value)
+gsfaci              8 ./gio/gks/gsfaci.x procedure gsfaci (index)
+gsfais              9 ./gio/gks/gsfais.x procedure gsfais (ints)
+gslwsc              8 ./gio/gks/gslwsc.x procedure gslwsc (width)
+gsmk                9 ./gio/gks/gsmk.x   procedure gsmk (mtype)
+gsmksc              8 ./gio/gks/gsmksc.x procedure gsmksc (width)
+gsplci              8 ./gio/gks/gsplci.x procedure gsplci (coli)
+gspmci              8 ./gio/gks/gspmci.x procedure gspmci (coli)
+gspmi               8 ./gio/gks/gspmi.x  procedure gspmi (index)
+gst_set_attribute_i247 ./gio/gsetr.x      procedure gst_set_attribute_i (new_value, value, state)
+gst_set_attribute_r264 ./gio/gsetr.x      procedure gst_set_attribute_r (new_value, value, state)
+gstati              7 ./gio/gstati.x     int procedure gstati (gp, param)
+gstatr             11 ./gio/gstatr.x     real procedure gstatr (gp, param)
+gstats              9 ./gio/gstats.x     int procedure gstats (gp, param, outstr, maxch)
+gstrcat             5 ./fmtio/gstrcat.x  int procedure gstrcat (str, outstr, maxch)
+gstrcpy             5 ./fmtio/gstrcpy.x  int procedure gstrcpy (s1, s2, maxch)
+gstrmatch          40 ./fmtio/strmatch.x int procedure gstrmatch (str, pat, first_char, last_char)
+gstxal              8 ./gio/gks/gstxal.x procedure gstxal (txalh, txalv)
+gstxci              9 ./gio/gks/gstxci.x procedure gstxci (coli)
+gstxp               8 ./gio/gks/gstxp.x  procedure gstxp (txp)
+gsview              7 ./gio/gsview.x     procedure gsview (gp, x1, x2, y1, y2)
+gsvp                9 ./gio/gks/gsvp.x   procedure gsvp (wcs, x1, x2, y1, y2)
+gswind              7 ./gio/gswind.x     procedure gswind (gp, x1, x2, y1, y2)
+gswn                9 ./gio/gks/gswn.x   procedure gswn (wcs, x1, x2, y1, y2)
+gt_distance       163 ./gio/gtick.gx     PIXEL procedure gt_distance (x, step, nearest_tick)
+gt_distance       163 ./gio/gtickr.x     real procedure gt_distance (x, step, nearest_tick)
+gt_linearity      139 ./gio/gtick.gx     PIXEL procedure gt_linearity (x1, x2)
+gt_linearity      139 ./gio/gtickr.x     real procedure gt_linearity (x1, x2)
+gt_ndigits        115 ./gio/gtick.gx     int procedure gt_ndigits (x1, x2, step)
+gt_ndigits        115 ./gio/gtickr.x     int procedure gt_ndigits (x1, x2, step)
+gtext              13 ./gio/gtext.x      procedure gtext (gp, x, y, text, format)
+gtick              17 ./gio/gtick.gx     procedure gtick$t (x1, x2, rough_nticks, logflag, x_tick1, step)
+gtickr             17 ./gio/gtickr.x     procedure gtickr (x1, x2, rough_nticks, logflag, x_tick1, step)
+gtr_backup         12 ./gio/cursor/gtrbackup.x procedure gtr_backup (stream)
+gtr_cliptoplane    93 ./gio/cursor/gtrwsclip.x int procedure gtr_cliptoplane (p1, p2, npts, index, s, ref)
+gtr_connect        20 ./gio/cursor/gtrconn.x int procedure gtr_connect (kernfname, taskname, devname, stream, in, out)
+gtr_control        18 ./gio/cursor/gtrctrl.x procedure gtr_control (stream, gki, source_pid)
+gtr_ctran         118 ./gio/cursor/gtrwstran.x procedure gtr_ctran (mx, my, sx, sy)
+gtr_delete         10 ./gio/cursor/gtrdelete.x procedure gtr_delete (tr, gki)
+gtr_disconnect     14 ./gio/cursor/gtrdiscon.x procedure gtr_disconnect (pid, in, out, stream)
+gtr_fetch_next_instruction 14 ./gio/cursor/gtrfetch.x int procedure gtr_fetch_next_instruction (tr, gki)
+gtr_frame          14 ./gio/cursor/gtrframe.x procedure gtr_frame (tr, gki, stream)
+gtr_gflush         13 ./gio/cursor/gtrgflush.x procedure gtr_gflush (stream)
+gtr_gtran           9 ./gio/cursor/gtrgtran.x procedure gtr_gtran (fd, x1, x2, y1, y2)
+gtr_gtty            9 ./gio/cursor/gtrgtty.x pointer procedure gtr_gtty (stream)
+gtr_init           13 ./gio/cursor/gtrinit.x pointer procedure gtr_init (stream)
+gtr_memusage       42 ./gio/cursor/gtrstatus.x procedure gtr_memusage (fd, stream, name)
+gtr_openws         21 ./gio/cursor/gtropenws.x procedure gtr_openws (devspec, mode, stream, source_pid)
+gtr_page           12 ./gio/cursor/gtrpage.x procedure gtr_page (fd, stream)
+gtr_polyclip        9 ./gio/cursor/gtrwsclip.x int procedure gtr_polyclip (pv, npts, x1, x2, y1, y2)
+gtr_polytran      136 ./gio/cursor/gtrwstran.x procedure gtr_polytran (gki)
+gtr_ptran          12 ./gio/cursor/gtrptran.x procedure gtr_ptran (stream, x1, x2, y1, y2)
+gtr_readcursor     10 ./gio/cursor/gtrrcur.x int procedure gtr_readcursor (fd, key, sx, sy, raster, rx, ry)
+gtr_redraw          9 ./gio/cursor/gtrredraw.x procedure gtr_redraw (stream)
+gtr_reset          10 ./gio/cursor/gtrreset.x procedure gtr_reset (status)
+gtr_status         13 ./gio/cursor/gtrstatus.x procedure gtr_status (fd)
+gtr_truncate       13 ./gio/cursor/gtrtrunc.x procedure gtr_truncate (tr, gki)
+gtr_undo           11 ./gio/cursor/gtrundo.x procedure gtr_undo (stream)
+gtr_waitpage       14 ./gio/cursor/gtrwaitp.x procedure gtr_waitpage (fd, stream)
+gtr_writecursor     7 ./gio/cursor/gtrwcur.x procedure gtr_writecursor (fd, x, y)
+gtr_writep         21 ./gio/cursor/gtrwritep.x pointer procedure gtr_writep (fd, nchars)
+gtr_wstran         23 ./gio/cursor/gtrwstran.x procedure gtr_wstran (gki)
+gtrset             11 ./gio/cursor/gtrset.x procedure gtrset (fd, x1, x2, y1, y2)
+gtxset             12 ./gio/gtxset.x     procedure gtxset (tx, format, ip)
+gty_binsearch     119 ./gty/gtyindex.x   int procedure gty_binsearch (capcode, t_capcode, ncaps)
+gty_encode_capability161 ./gty/gtyindex.x   int procedure gty_encode_capability (cap)
+gty_extract_alias 282 ./gty/gtyopen.x    int procedure gty_extract_alias (str, ip, outstr, maxch)
+gty_fetch_entry   143 ./gty/gtyopen.x    procedure gty_fetch_entry (fd, device, tty)
+gty_find_capability 85 ./gty/gtyindex.x   int procedure gty_find_capability (tty, cap, ip)
+gty_index_caps     15 ./gty/gtyindex.x   procedure gty_index_caps (tty, t_capcode, t_capindex, ncaps)
+gty_scan_termcap_file 75 ./gty/gtyopen.x    procedure gty_scan_termcap_file (tty, termcap_file, devname)
+gtycaps             7 ./gty/gtycaps.x    pointer procedure gtycaps (gty)
+gtyclose            5 ./gty/gtyclose.x   procedure gtyclose (tty)
+gtygetb             6 ./gty/gtygetb.x    bool procedure gtygetb (tty, cap)
+gtygeti             7 ./gty/gtygeti.x    int procedure gtygeti (tty, cap)
+gtygetr             9 ./gty/gtygetr.x    real procedure gtygetr (tty, cap)
+gtygets            20 ./gty/gtygets.x    int procedure gtygets (tty, cap, outstr, maxch)
+gtyopen            14 ./gty/gtyopen.x    pointer procedure gtyopen (termcap_file, device, ufields)
+gumark             12 ./gio/gumark.x     procedure gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+gvline              6 ./gio/gvline.x     procedure gvline (gp, v, npts, x1, x2)
+gvmark             11 ./gio/gvmark.x     procedure gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+gwcs_mkfilename    84 ./gio/grdwcs.x     procedure gwcs_mkfilename (devname, fname, maxch)
+gwrwcs             21 ./gio/grdwcs.x     procedure gwrwcs (devname, wcs, len_wcs)
+gxgtx               9 ./gio/gks/gxgtx.x  procedure gxgtx (px, py, chars)
+iand               36 ./gio/ncarutil/sysint/ishift.x int procedure iand (a, b)
+iand               36 ./gio/nspp/sysint/ishift.x int procedure iand (a, b)
+idb_close         128 ./imio/db/idbcard.x procedure idb_close (idb)
+idb_filstr         12 ./imio/db/idbfstr.x int procedure idb_filstr (s1, s2, maxch)
+idb_findrecord     11 ./imfort/db/idbfind.x int procedure idb_findrecord (im, key, rp)
+idb_findrecord     11 ./imio/db/idbfind.x int procedure idb_findrecord (im, key, rp)
+idb_getstring      14 ./imfort/db/idbgstr.x int procedure idb_getstring (im, key, outstr, maxch)
+idb_getstring      14 ./imio/db/idbgstr.x int procedure idb_getstring (im, key, outstr, maxch)
+idb_kwlookup        9 ./imio/db/idbkwlu.x int procedure idb_kwlookup (key)
+idb_kwlookup       10 ./imfort/db/idbkwlu.x int procedure idb_kwlookup (key)
+idb_naxis           8 ./imfort/db/idbnaxis.x int procedure idb_naxis (keyw, axnum)
+idb_nextcard       87 ./imio/db/idbcard.x int procedure idb_nextcard (idb, recptr)
+idb_open           38 ./imio/db/idbcard.x pointer procedure idb_open (im, ualen)
+idb_putstring      15 ./imfort/db/idbpstr.x int procedure idb_putstring (im, key, strval)
+idb_putstring      15 ./imio/db/idbpstr.x int procedure idb_putstring (im, key, strval)
+idk_close         181 ./gio/imdkern/idk.x procedure idk_close (fd)
+idk_draw          315 ./gio/imdkern/idk.x procedure idk_draw (fd, a_x, a_y)
+idk_flush         203 ./gio/imdkern/idk.x procedure idk_flush (fd)
+idk_frame         218 ./gio/imdkern/idk.x procedure idk_frame (fd)
+idk_linewidth     491 ./gio/imdkern/idk.x procedure idk_linewidth (fd, width)
+idk_move          292 ./gio/imdkern/idk.x procedure idk_move (fd, x, y)
+idk_open           63 ./gio/imdkern/idk.x int procedure idk_open (a_frame, a_color, tty)
+idk_vector        393 ./gio/imdkern/idk.x procedure idk_vector (a_x1, a_y1, a_x2, a_y2)
+ieegmap           306 ./osb/ieee.gx      procedure ieegmap$t (inval, outval)
+ieegmapd          287 ./osb/ieeed.x      procedure ieegmapd (inval, outval)
+ieegmapr          287 ./osb/ieeer.x      procedure ieegmapr (inval, outval)
+ieegnan           246 ./osb/ieee.gx      procedure ieegnan$t (x)
+ieegnand          227 ./osb/ieeed.x      procedure ieegnand (x)
+ieegnanr          227 ./osb/ieeer.x      procedure ieegnanr (x)
+ieemap            293 ./osb/ieee.gx      procedure ieemap$t (inval, outval)
+ieemapd           274 ./osb/ieeed.x      procedure ieemapd (inval, outval)
+ieemapr           274 ./osb/ieeer.x      procedure ieemapr (inval, outval)
+ieepak            165 ./osb/ieee.gx      procedure ieepak$t (x)
+ieepakd           152 ./osb/ieeed.x      procedure ieepakd (x)
+ieepakr           152 ./osb/ieeer.x      procedure ieepakr (x)
+ieesmap           331 ./osb/ieee.gx      procedure ieesmap$t (inval, outval)
+ieesmapd          312 ./osb/ieeed.x      procedure ieesmapd (inval, outval)
+ieesmapr          312 ./osb/ieeer.x      procedure ieesmapr (inval, outval)
+ieesnan           229 ./osb/ieee.gx      procedure ieesnan$t (x)
+ieesnand          210 ./osb/ieeed.x      procedure ieesnand (x)
+ieesnanr          210 ./osb/ieeer.x      procedure ieesnanr (x)
+ieestat           262 ./osb/ieee.gx      procedure ieestat$t (o_nin, o_nout)
+ieestatd          243 ./osb/ieeed.x      procedure ieestatd (o_nin, o_nout)
+ieestatr          243 ./osb/ieeer.x      procedure ieestatr (o_nin, o_nout)
+ieeupk            186 ./osb/ieee.gx      procedure ieeupk$t (x)
+ieeupkd           173 ./osb/ieeed.x      procedure ieeupkd (x)
+ieeupkr           173 ./osb/ieeer.x      procedure ieeupkr (x)
+ieevpak            67 ./osb/ieee.gx      procedure ieevpak$t (native, ieee, nelem)
+ieevpakd           60 ./osb/ieeed.x      procedure ieevpakd (native, ieee, nelem)
+ieevpakr           60 ./osb/ieeer.x      procedure ieevpakr (native, ieee, nelem)
+ieevupk           102 ./osb/ieee.gx      procedure ieevupk$t (ieee, native, nelem)
+ieevupkd           95 ./osb/ieeed.x      procedure ieevupkd (ieee, native, nelem)
+ieevupkr           95 ./osb/ieeer.x      procedure ieevupkr (ieee, native, nelem)
+ieezstat          279 ./osb/ieee.gx      procedure ieezstat$t ()
+ieezstatd         260 ./osb/ieeed.x      procedure ieezstatd ()
+ieezstatr         260 ./osb/ieeer.x      procedure ieezstatr ()
+iki_access         14 ./imio/iki/ikiaccess.x int procedure iki_access (image, root, extn, acmode)
+iki_close          12 ./imio/iki/ikiclose.x procedure iki_close (im)
+iki_copy           11 ./imio/iki/ikicopy.x procedure iki_copy (old, new)
+iki_debug         331 ./imio/iki/ikiextn.x procedure iki_debug (str, fd, flags)
+iki_delete          8 ./imio/iki/ikidelete.x procedure iki_delete (image)
+iki_extninit       32 ./imio/iki/ikiextn.x int procedure iki_extninit (env_imtype, def_imtype, env_imextn, def_imextn)
+iki_getextn       244 ./imio/iki/ikiextn.x int procedure iki_getextn (kernel, index, extn, maxch)
+iki_getfield      291 ./imio/iki/ikiextn.x int procedure iki_getfield (ip, outstr, maxch, delim)
+iki_getpar        271 ./imio/iki/ikiextn.x int procedure iki_getpar (param)
+iki_init            9 ./imio/iki/ikiinit.x procedure iki_init()
+iki_lddriver       10 ./imio/iki/ikildd.x procedure iki_lddriver (kname, ex_open, ex_close, ex_opix, ex_updhdr,
+iki_mkfname         8 ./imio/iki/ikimkfn.x procedure iki_mkfname (root, extn, fname, maxch)
+iki_open           15 ./imio/iki/ikiopen.x procedure iki_open (n_im, image, ksection, cl_index, cl_size, acmode, o_im)
+iki_opix           12 ./imio/iki/ikiopix.x procedure iki_opix (im)
+iki_parse           9 ./imio/iki/ikiparse.x procedure iki_parse (image, root, extn)
+iki_rename          8 ./imio/iki/ikirename.x procedure iki_rename (old, new)
+iki_updhdr         10 ./imio/iki/ikiupdhdr.x procedure iki_updhdr (im)
+iki_validextn     219 ./imio/iki/ikiextn.x int procedure iki_validextn (kernel, extn)
+im_ctranset       126 ./imio/imisec.x    procedure im_ctranset (imdes, dim, x1_arg, x2_arg, step)
+im_decode_subscript161 ./imio/imisec.x    procedure im_decode_subscript (section, ip, x1, x2, step)
+im_init_newimage    8 ./imio/iminie.x    procedure im_init_newimage (im, len_imhdr)
+im_make_newcopy    13 ./imio/immaky.x    procedure im_make_newcopy (im, o_im)
+im_pmldhdr        157 ./imio/impmhdr.x   procedure im_pmldhdr (im, bp)
+im_pmlne1           8 ./imio/impmlne1.x  bool procedure im_pmlne1 (im)
+im_pmlne2           8 ./imio/impmlne2.x  bool procedure im_pmlne2 (im, lineno)
+im_pmlne3           8 ./imio/impmlne3.x  bool procedure im_pmlne3 (im, lineno, bandno)
+im_pmlnev           8 ./imio/impmlnev.x  bool procedure im_pmlnev (im, v)
+im_pmmap           17 ./imio/impmmap.x   pointer procedure im_pmmap (mask, mode, ref_im)
+im_pmmapo          14 ./imio/impmmapo.x  pointer procedure im_pmmapo (pl, ref_im)
+im_pmopen          16 ./imio/impmopen.x  pointer procedure im_pmopen (mask, mode, title, maxch, ref_im)
+im_pmsne1           7 ./imio/impmsne1.x  bool procedure im_pmsne1 (im, x1, x2)
+im_pmsne2           7 ./imio/impmsne2.x  bool procedure im_pmsne2 (im, x1, x2, y1, y2)
+im_pmsne3           7 ./imio/impmsne3.x  bool procedure im_pmsne3 (im, x1,x2, y1,y2, z1,z2)
+im_pmsnev           8 ./imio/impmsnev.x  bool procedure im_pmsnev (im, vs, ve, ndim)
+im_pmsvhdr         45 ./imio/impmhdr.x   int procedure im_pmsvhdr (im, bp, sz_buf)
+im_seterrim       151 ./imfort/imemsg.x  procedure im_seterrim (ier, im)
+im_seterrop       133 ./imfort/imemsg.x  procedure im_seterrop (ier, opname)
+imaccess            7 ./imio/imaccess.x  int procedure imaccess (image, acmode)
+imaccf              6 ./imfort/db/imaccf.x int procedure imaccf (im, key)
+imaccf              6 ./imio/db/imaccf.x int procedure imaccf (im, key)
+imacck              8 ./imfort/imacck.x  procedure imacck (im, key, ier)
+imaddb              6 ./imfort/db/imaddb.x procedure imaddb (im, key, value, comment)
+imaddb              6 ./imio/db/imaddb.x procedure imaddb (im, key, value)
+imaddd              6 ./imfort/db/imaddd.x procedure imaddd (im, key, value, comment)
+imaddd              6 ./imio/db/imaddd.x procedure imaddd (im, key, value)
+imaddf             11 ./imfort/db/imaddf.x procedure imaddf (im, key, datatype, comment)
+imaddf             12 ./imio/db/imaddf.x procedure imaddf (im, key, datatype)
+imaddi              6 ./imfort/db/imaddi.x procedure imaddi (im, key, value, comment)
+imaddi              6 ./imio/db/imaddi.x procedure imaddi (im, key, value)
+imaddk              7 ./imfort/imaddk.x  procedure imaddk (im, keyw, dtype, comm, ier)
+imaddl              6 ./imfort/db/imaddl.x procedure imaddl (im, key, value, comment)
+imaddl              6 ./imio/db/imaddl.x procedure imaddl (im, key, value)
+imaddr              6 ./imfort/db/imaddr.x procedure imaddr (im, key, value, comment)
+imaddr              6 ./imio/db/imaddr.x procedure imaddr (im, key, value)
+imadds              6 ./imfort/db/imadds.x procedure imadds (im, key, value, comment)
+imadds              6 ./imio/db/imadds.x procedure imadds (im, key, value)
+imaflp              7 ./imio/imaflp.x    procedure imaflp (a, npix, sz_pixel)
+imakwb              7 ./imfort/imakwb.x  procedure imakwb (im, keyw, bval, comm, ier)
+imakwc              7 ./imfort/imakwc.x  procedure imakwc (im, keyw, sval, comm, ier)
+imakwd              7 ./imfort/imakwd.x  procedure imakwd (im, keyw, dval, comm, ier)
+imakwi              7 ./imfort/imakwi.x  procedure imakwi (im, keyw, ival, comm, ier)
+imakwr              7 ./imfort/imakwr.x  procedure imakwr (im, keyw, rval, comm, ier)
+imalign           103 ./imio/imioff.x    procedure imalign (offset, blksize)
+imaplv              9 ./imio/imaplv.x    procedure imaplv (im, lv, pv, ndim)
+imastr              6 ./imfort/db/imastr.x procedure imastr (im, key, value, comment)
+imastr              6 ./imio/db/imastr.x procedure imastr (im, key, value)
+imbln1             10 ./imio/imbln1.x    procedure imbln1 (imdes, nx)
+imbln2             10 ./imio/imbln2.x    procedure imbln2 (imdes, nx, ny)
+imbln3             10 ./imio/imbln3.x    procedure imbln3 (imdes, nx, ny, nz)
+imbtran            11 ./imio/imbtran.x   procedure imbtran (im, v1, v2, ndim)
+imcfnl             85 ./imfort/db/imgnfn.x procedure imcfnl (fn)
+imcfnl             85 ./imio/db/imgnfn.x procedure imcfnl (fn)
+imckwl             88 ./imfort/imokwl.x  procedure imckwl (kwl, ier)
+imclos              9 ./imfort/imclos.x  procedure imclos (im, ier)
+imcopy              6 ./imio/imcopy.x    procedure imcopy (old, new)
+imcrea              6 ./imfort/imcrea.x  procedure imcrea (f77nam, axlen, naxis, pixtype, ier)
+imcrex             15 ./imfort/imcrex.x  procedure imcrex (image, axlen, naxis, pixtype, ier)
+imcssz             13 ./imio/imcssz.x    long procedure imcssz (im, vs, ve, ndim, dtype, npix, rwflag)
+imd_bcell          39 ./gio/imdkern/imdpcell.x procedure imd_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+imd_cancel          7 ./gio/imdkern/imdcancel.x procedure imd_cancel (dummy)
+imd_clear          10 ./gio/imdkern/imdclear.x procedure imd_clear (dummy)
+imd_close           8 ./gio/imdkern/imdclose.x procedure imd_close()
+imd_closews         9 ./gio/imdkern/imdclws.x procedure imd_closews (devname, n)
+imd_color           7 ./gio/imdkern/imdcolor.x procedure imd_color (index)
+imd_dashline       78 ./gio/imdkern/imdpl.x procedure imd_dashline (g_out, p, npts, ltype)
+imd_drawchar       15 ./gio/imdkern/imddrawch.x procedure imd_drawchar (ch, x, y, xsize, ysize, orien, font)
+imd_escape          6 ./gio/imdkern/imdescape.x procedure imd_escape (fn, instruction, nwords)
+imd_faset           8 ./gio/imdkern/imdfaset.x procedure imd_faset (gki)
+imd_fillarea        7 ./gio/imdkern/imdfa.x procedure imd_fillarea (p, npts)
+imd_flush           7 ./gio/imdkern/imdflush.x procedure imd_flush (dummy)
+imd_font           13 ./gio/imdkern/imdfont.x procedure imd_font (font)
+imd_getcellarray    6 ./gio/imdkern/imdgcell.x procedure imd_getcellarray (nx, ny, x1,y1, x2,y2)
+imd_getseg        149 ./gio/imdkern/imdpl.x int procedure imd_getseg (maxlen, penup, ltype)
+imd_gstring       141 ./gio/imdkern/imdinit.x pointer procedure imd_gstring (cap)
+imd_init           13 ./gio/imdkern/imdinit.x procedure imd_init (tty, devname)
+imd_linetype        8 ./gio/imdkern/imdline.x procedure imd_linetype (index)
+imd_mcell         122 ./gio/imdkern/imdpcell.x procedure imd_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+imd_opendev        12 ./gio/imdkern/imdopen.x procedure imd_opendev (devname, frame, color, dd)
+imd_openws         13 ./gio/imdkern/imdopenws.x procedure imd_openws (devname, n, mode)
+imd_plset           9 ./gio/imdkern/imdplset.x procedure imd_plset (gki)
+imd_pmset           8 ./gio/imdkern/imdpmset.x procedure imd_pmset (gki)
+imd_polyline       17 ./gio/imdkern/imdpl.x procedure imd_polyline (p, npts)
+imd_polymarker      9 ./gio/imdkern/imdpm.x procedure imd_polymarker (p, npts)
+imd_putcellarray   16 ./gio/imdkern/imdpcell.x procedure imd_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+imd_reset          12 ./gio/imdkern/imdreset.x procedure imd_reset()
+imd_text           20 ./gio/imdkern/imdtx.x procedure imd_text (xc, yc, text, n)
+imd_txset           9 ./gio/imdkern/imdtxset.x procedure imd_txset (gki)
+imdele              6 ./imfort/imdele.x  procedure imdele (image, ier)
+imdelete            5 ./imio/imdelete.x  procedure imdelete (image)
+imdelf             10 ./imfort/db/imdelf.x procedure imdelf (im, key)
+imdelf             10 ./imio/db/imdelf.x procedure imdelf (im, key)
+imdelk              7 ./imfort/imdelk.x  procedure imdelk (im, keyw, ier)
+imdelx             10 ./imfort/imdelx.x  procedure imdelx (image, ier)
+imdinit            82 ./imfort/imfdir.x  procedure imdinit()
+imdmap             16 ./imio/imdmap.x    pointer procedure imdmap (device, access_mode, imdopen)
+imemsg             11 ./imfort/imemsg.x  procedure imemsg (ier, errmsg)
+imerr               6 ./imio/imerr.x     procedure imerr (image_name, errcode)
+imf_align          80 ./imfort/imioff.x  procedure imf_align (offset, blksize)
+imf_gpixfname       7 ./imfort/imfgpfn.x procedure imf_gpixfname (pixfile, hdrfile, path, maxch)
+imf_initoffsets    12 ./imfort/imioff.x  procedure imf_initoffsets (im, dev_block_size)
+imf_mkpixfname     12 ./imfort/imfmkpfn.x procedure imf_mkpixfname (im, pixfile, maxch, ier)
+imf_parse           9 ./imfort/imfparse.x procedure imf_parse (image, root, extn)
+imf_trans          13 ./imfort/imftrans.x procedure imf_trans (fname, root, extn)
+imf_updhdr          9 ./imfort/imfupdhdr.x procedure imf_updhdr (im, status)
+imflpl             57 ./imio/imaflp.x    procedure imflpl (a, npix)
+imflps             39 ./imio/imaflp.x    procedure imflps (a, npix)
+imfls              10 ./imio/imfls.gx    procedure imfls$t (imdes)
+imflsd             10 ./imio/tf/imflsd.x procedure imflsd (imdes)
+imflsh              8 ./imfort/imflsh.x  procedure imflsh (im, ier)
+imflsh             14 ./imio/imflsh.x    procedure imflsh (im, bp, vs, ve, ndim)
+imflsi             10 ./imio/tf/imflsi.x procedure imflsi (imdes)
+imflsl             10 ./imio/tf/imflsl.x procedure imflsl (imdes)
+imflsr             10 ./imio/tf/imflsr.x procedure imflsr (imdes)
+imflss             10 ./imio/tf/imflss.x procedure imflss (imdes)
+imflsx             10 ./imio/tf/imflsx.x procedure imflsx (imdes)
+imflush            10 ./imio/imflush.x   procedure imflush (imdes)
+imfn_putkey       306 ./imfort/db/imgnfn.x procedure imfn_putkey (key, strp, nstr, nextch, sbuf)
+imfn_putkey       307 ./imio/db/imgnfn.x procedure imfn_putkey (key, strp, nstr, nextch, sbuf)
+imfn_stdkeys      247 ./imio/db/imgnfn.x procedure imfn_stdkeys (im, patcode, strp, nstr, nextch, sbuf)
+imfn_stdkeys      249 ./imfort/db/imgnfn.x procedure imfn_stdkeys (im, patcode, strp, nstr, nextch, sbuf)
+imgatr             11 ./imfort/db/imgatr.x procedure imgatr (im, key, dtype, comm, maxch)
+imgcluster          6 ./imio/imgclust.x  procedure imgcluster (imspec, cluster, maxch)
+imgdir             35 ./imfort/imfdir.x  procedure imgdir (dir)
+imgdirx            65 ./imfort/imfdir.x  int procedure imgdirx (dir, maxch)
+imgetb              8 ./imfort/db/imgetb.x bool procedure imgetb (im, key)
+imgetb              9 ./imio/db/imgetb.x bool procedure imgetb (im, key)
+imgetc              5 ./imfort/db/imgetc.x char procedure imgetc (im, key)
+imgetc              5 ./imio/db/imgetc.x char procedure imgetc (im, key)
+imgetd             10 ./imfort/db/imgetd.x double procedure imgetd (im, key)
+imgetd             10 ./imio/db/imgetd.x double procedure imgetd (im, key)
+imgeti              5 ./imfort/db/imgeti.x int procedure imgeti (im, key)
+imgeti              5 ./imio/db/imgeti.x int procedure imgeti (im, key)
+imgetl              5 ./imfort/db/imgetl.x long procedure imgetl (im, key)
+imgetl              5 ./imio/db/imgetl.x long procedure imgetl (im, key)
+imgetr              5 ./imfort/db/imgetr.x real procedure imgetr (im, key)
+imgetr              5 ./imio/db/imgetr.x real procedure imgetr (im, key)
+imgets              5 ./imfort/db/imgets.x short procedure imgets (im, key)
+imgets              5 ./imio/db/imgets.x short procedure imgets (im, key)
+imgftype           11 ./imfort/db/imgftype.x int procedure imgftype (im, key)
+imgftype           11 ./imio/db/imgftype.x int procedure imgftype (im, key)
+imggs               7 ./imio/imggs.gx    pointer procedure imggs$t (imdes, vs, ve, ndim)
+imggsc             15 ./imio/imggsc.x    pointer procedure imggsc (im, vs, ve, ndim, dtype, totpix)
+imggsd              7 ./imio/tf/imggsd.x pointer procedure imggsd (imdes, vs, ve, ndim)
+imggsi              7 ./imio/tf/imggsi.x pointer procedure imggsi (imdes, vs, ve, ndim)
+imggsl              7 ./imio/tf/imggsl.x pointer procedure imggsl (imdes, vs, ve, ndim)
+imggsr              7 ./imio/tf/imggsr.x pointer procedure imggsr (imdes, vs, ve, ndim)
+imggss              7 ./imio/tf/imggss.x pointer procedure imggss (imdes, vs, ve, ndim)
+imggsx              7 ./imio/tf/imggsx.x pointer procedure imggsx (imdes, vs, ve, ndim)
+imgibf              8 ./imio/imgibf.x    pointer procedure imgibf (im, vs, ve, ndim, dtype)
+imgimage            6 ./imio/imgimage.x  procedure imgimage (imspec, image, maxch)
+imgkwb              7 ./imfort/imgkwb.x  procedure imgkwb (im, keyw, bval, ier)
+imgkwc              8 ./imfort/imgkwc.x  procedure imgkwc (im, keyw, sval, ier)
+imgkwd              7 ./imfort/imgkwd.x  procedure imgkwd (im, keyw, dval, ier)
+imgkwi              7 ./imfort/imgkwi.x  procedure imgkwi (im, keyw, ival, ier)
+imgkwr              7 ./imfort/imgkwr.x  procedure imgkwr (im, keyw, rval, ier)
+imgl1              11 ./imio/imgl1.gx    pointer procedure imgl1$t (im)
+imgl1d             11 ./imio/tf/imgl1d.x pointer procedure imgl1d (im)
+imgl1i             11 ./imio/tf/imgl1i.x pointer procedure imgl1i (im)
+imgl1l             11 ./imio/tf/imgl1l.x pointer procedure imgl1l (im)
+imgl1r             10 ./imfort/imgl1r.x  procedure imgl1r (im, buf, ier)
+imgl1r             11 ./imio/tf/imgl1r.x pointer procedure imgl1r (im)
+imgl1s              9 ./imfort/imgl1s.x  procedure imgl1s (im, buf, ier)
+imgl1s             11 ./imio/tf/imgl1s.x pointer procedure imgl1s (im)
+imgl1x             11 ./imio/tf/imgl1x.x pointer procedure imgl1x (im)
+imgl2              12 ./imio/imgl2.gx    pointer procedure imgl2$t (im, linenum)
+imgl2d             12 ./imio/tf/imgl2d.x pointer procedure imgl2d (im, linenum)
+imgl2i             12 ./imio/tf/imgl2i.x pointer procedure imgl2i (im, linenum)
+imgl2l             12 ./imio/tf/imgl2l.x pointer procedure imgl2l (im, linenum)
+imgl2r             10 ./imfort/imgl2r.x  procedure imgl2r (im, buf, lineno, ier)
+imgl2r             12 ./imio/tf/imgl2r.x pointer procedure imgl2r (im, linenum)
+imgl2s              9 ./imfort/imgl2s.x  procedure imgl2s (im, buf, lineno, ier)
+imgl2s             12 ./imio/tf/imgl2s.x pointer procedure imgl2s (im, linenum)
+imgl2x             12 ./imio/tf/imgl2x.x pointer procedure imgl2x (im, linenum)
+imgl3              12 ./imio/imgl3.gx    pointer procedure imgl3$t (im, line, band)
+imgl3d             12 ./imio/tf/imgl3d.x pointer procedure imgl3d (im, line, band)
+imgl3i             12 ./imio/tf/imgl3i.x pointer procedure imgl3i (im, line, band)
+imgl3l             12 ./imio/tf/imgl3l.x pointer procedure imgl3l (im, line, band)
+imgl3r             10 ./imfort/imgl3r.x  procedure imgl3r (im, buf, lineno, bandno, ier)
+imgl3r             12 ./imio/tf/imgl3r.x pointer procedure imgl3r (im, line, band)
+imgl3s              9 ./imfort/imgl3s.x  procedure imgl3s (im, buf, lineno, bandno, ier)
+imgl3s             12 ./imio/tf/imgl3s.x pointer procedure imgl3s (im, line, band)
+imgl3x             12 ./imio/tf/imgl3x.x pointer procedure imgl3x (im, line, band)
+imgnfn             37 ./imfort/db/imgnfn.x int procedure imgnfn (fn, outstr, maxch)
+imgnfn             37 ./imio/db/imgnfn.x int procedure imgnfn (fn, outstr, maxch)
+imgnkw             54 ./imfort/imokwl.x  procedure imgnkw (kwl, outstr, ier)
+imgnl              11 ./imio/imgnl.gx    int procedure imgnl$t (imdes, lineptr, v)
+imgnld             11 ./imio/tf/imgnld.x int procedure imgnld (imdes, lineptr, v)
+imgnli             11 ./imio/tf/imgnli.x int procedure imgnli (imdes, lineptr, v)
+imgnll             11 ./imio/tf/imgnll.x int procedure imgnll (imdes, lineptr, v)
+imgnln             13 ./imio/imgnln.x    int procedure imgnln (im, lineptr, v, dtype)
+imgnlr             11 ./imio/tf/imgnlr.x int procedure imgnlr (imdes, lineptr, v)
+imgnls             11 ./imio/tf/imgnls.x int procedure imgnls (imdes, lineptr, v)
+imgnlx             11 ./imio/tf/imgnlx.x int procedure imgnlx (imdes, lineptr, v)
+imgobf              8 ./imio/imgobf.x    pointer procedure imgobf (im, vs, ve, ndim, dtype)
+imgs1               7 ./imio/imgs1.gx    pointer procedure imgs1$t (im, x1, x2)
+imgs1d              7 ./imio/tf/imgs1d.x pointer procedure imgs1d (im, x1, x2)
+imgs1i              7 ./imio/tf/imgs1i.x pointer procedure imgs1i (im, x1, x2)
+imgs1l              7 ./imio/tf/imgs1l.x pointer procedure imgs1l (im, x1, x2)
+imgs1r              7 ./imio/tf/imgs1r.x pointer procedure imgs1r (im, x1, x2)
+imgs1r             10 ./imfort/imgs1r.x  procedure imgs1r (im, buf, i1, i2, ier)
+imgs1s              7 ./imio/tf/imgs1s.x pointer procedure imgs1s (im, x1, x2)
+imgs1s             10 ./imfort/imgs1s.x  procedure imgs1s (im, buf, i1, i2, ier)
+imgs1x              7 ./imio/tf/imgs1x.x pointer procedure imgs1x (im, x1, x2)
+imgs2               7 ./imio/imgs2.gx    pointer procedure imgs2$t (im, x1, x2, y1, y2)
+imgs2d              7 ./imio/tf/imgs2d.x pointer procedure imgs2d (im, x1, x2, y1, y2)
+imgs2i              7 ./imio/tf/imgs2i.x pointer procedure imgs2i (im, x1, x2, y1, y2)
+imgs2l              7 ./imio/tf/imgs2l.x pointer procedure imgs2l (im, x1, x2, y1, y2)
+imgs2r              7 ./imio/tf/imgs2r.x pointer procedure imgs2r (im, x1, x2, y1, y2)
+imgs2r             10 ./imfort/imgs2r.x  procedure imgs2r (im, buf, i1, i2, j1, j2, ier)
+imgs2s              7 ./imio/tf/imgs2s.x pointer procedure imgs2s (im, x1, x2, y1, y2)
+imgs2s             10 ./imfort/imgs2s.x  procedure imgs2s (im, buf, i1, i2, j1, j2, ier)
+imgs2x              7 ./imio/tf/imgs2x.x pointer procedure imgs2x (im, x1, x2, y1, y2)
+imgs3               7 ./imio/imgs3.gx    pointer procedure imgs3$t (im, x1, x2, y1, y2, z1, z2)
+imgs3d              7 ./imio/tf/imgs3d.x pointer procedure imgs3d (im, x1, x2, y1, y2, z1, z2)
+imgs3i              7 ./imio/tf/imgs3i.x pointer procedure imgs3i (im, x1, x2, y1, y2, z1, z2)
+imgs3l              7 ./imio/tf/imgs3l.x pointer procedure imgs3l (im, x1, x2, y1, y2, z1, z2)
+imgs3r              7 ./imio/tf/imgs3r.x pointer procedure imgs3r (im, x1, x2, y1, y2, z1, z2)
+imgs3r             10 ./imfort/imgs3r.x  procedure imgs3r (im, buf, i1, i2, j1, j2, k1, k2, ier)
+imgs3s              7 ./imio/tf/imgs3s.x pointer procedure imgs3s (im, x1, x2, y1, y2, z1, z2)
+imgs3s             10 ./imfort/imgs3s.x  procedure imgs3s (im, buf, i1, i2, j1, j2, k1, k2, ier)
+imgs3x              7 ./imio/tf/imgs3x.x pointer procedure imgs3x (im, x1, x2, y1, y2, z1, z2)
+imgsection          5 ./imio/imgsect.x   procedure imgsection (imspec, section, maxch)
+imgsiz              8 ./imfort/imgsiz.x  procedure imgsiz (im, axlen, naxis, pixtype, ier)
+imgstr             11 ./imfort/db/imgstr.x procedure imgstr (im, key, outstr, maxch)
+imgstr             11 ./imio/db/imgstr.x procedure imgstr (im, key, outstr, maxch)
+imhcpy              9 ./imfort/imhcpy.x  procedure imhcpy (o_im, n_im, ier)
+imioff             12 ./imio/imioff.x    procedure imioff (im, pixoff, compress, devblksz)
+imisec             42 ./imio/imisec.x    procedure imisec (imdes, section)
+imloop              9 ./imio/imloop.x    int procedure imloop (v, vs, ve, vinc, ndim)
+immap               6 ./imio/immap.x     pointer procedure immap (imspec, acmode, hdr_arg)
+immapz             11 ./imio/immapz.x    pointer procedure immapz (imspec, acmode, hdr_arg)
+imnote              9 ./imio/imnote.x    long procedure imnote (im, v)
+imofnl             98 ./imfort/db/imgnfn.x pointer procedure imofnl (im, template, sort)
+imofnl             98 ./imio/db/imgnfn.x pointer procedure imofnl (im, template, sort)
+imofnls            58 ./imfort/db/imgnfn.x pointer procedure imofnls (im, template)
+imofnls            58 ./imio/db/imgnfn.x pointer procedure imofnls (im, template)
+imofnlu            71 ./imfort/db/imgnfn.x pointer procedure imofnlu (im, template)
+imofnlu            71 ./imio/db/imgnfn.x pointer procedure imofnlu (im, template)
+imokwl             21 ./imfort/imokwl.x  procedure imokwl (im, patstr, sortit, kwl, ier)
+imopen              5 ./imfort/imopen.x  procedure imopen (f77nam, acmode, im, ier)
+imopnc             11 ./imfort/imopnc.x  procedure imopnc (nimage, o_im, n_im, ier)
+imopnx             13 ./imfort/imopnx.x  procedure imopnx (image, acmode, im, ier)
+imopsf             15 ./imio/imopsf.x    procedure imopsf (im)
+impak               6 ./imio/impak.gx    procedure impak$t (a, b, npix, dtype)
+impakd              6 ./imio/tf/impakd.x procedure impakd (a, b, npix, dtype)
+impaki              6 ./imio/tf/impaki.x procedure impaki (a, b, npix, dtype)
+impakl              6 ./imio/tf/impakl.x procedure impakl (a, b, npix, dtype)
+impakr              6 ./imio/tf/impakr.x procedure impakr (a, b, npix, dtype)
+impaks              6 ./imio/tf/impaks.x procedure impaks (a, b, npix, dtype)
+impakx              6 ./imio/tf/impakx.x procedure impakx (a, b, npix, dtype)
+imparse            20 ./imio/imparse.x   procedure imparse (imspec, cluster, sz_cluster, ksection, sz_ksection,
+impgs               8 ./imio/impgs.gx    pointer procedure impgs$t (imdes, vs, ve, ndim)
+impgsd              8 ./imio/tf/impgsd.x pointer procedure impgsd (imdes, vs, ve, ndim)
+impgsi              8 ./imio/tf/impgsi.x pointer procedure impgsi (imdes, vs, ve, ndim)
+impgsl              8 ./imio/tf/impgsl.x pointer procedure impgsl (imdes, vs, ve, ndim)
+impgsr              8 ./imio/tf/impgsr.x pointer procedure impgsr (imdes, vs, ve, ndim)
+impgss              8 ./imio/tf/impgss.x pointer procedure impgss (imdes, vs, ve, ndim)
+impgsx              8 ./imio/tf/impgsx.x pointer procedure impgsx (imdes, vs, ve, ndim)
+impixf             19 ./imfort/impixf.x  procedure impixf (im, pixfd, pixfil, pixoff, szline, ier)
+impkwb              7 ./imfort/impkwb.x  procedure impkwb (im, keyw, bval, ier)
+impkwc              7 ./imfort/impkwc.x  procedure impkwc (im, keyw, sval, ier)
+impkwd              7 ./imfort/impkwd.x  procedure impkwd (im, keyw, dval, ier)
+impkwi              7 ./imfort/impkwi.x  procedure impkwi (im, keyw, ival, ier)
+impkwr              7 ./imfort/impkwr.x  procedure impkwr (im, keyw, rval, ier)
+impl1              11 ./imio/impl1.gx    pointer procedure impl1$t (im)
+impl1d             11 ./imio/tf/impl1d.x pointer procedure impl1d (im)
+impl1i             11 ./imio/tf/impl1i.x pointer procedure impl1i (im)
+impl1l             11 ./imio/tf/impl1l.x pointer procedure impl1l (im)
+impl1r             10 ./imfort/impl1r.x  procedure impl1r (im, buf, ier)
+impl1r             11 ./imio/tf/impl1r.x pointer procedure impl1r (im)
+impl1s             10 ./imfort/impl1s.x  procedure impl1s (im, buf, ier)
+impl1s             11 ./imio/tf/impl1s.x pointer procedure impl1s (im)
+impl1x             11 ./imio/tf/impl1x.x pointer procedure impl1x (im)
+impl2              12 ./imio/impl2.gx    pointer procedure impl2$t (im, linenum)
+impl2d             12 ./imio/tf/impl2d.x pointer procedure impl2d (im, linenum)
+impl2i             12 ./imio/tf/impl2i.x pointer procedure impl2i (im, linenum)
+impl2l             12 ./imio/tf/impl2l.x pointer procedure impl2l (im, linenum)
+impl2r             10 ./imfort/impl2r.x  procedure impl2r (im, buf, lineno, ier)
+impl2r             12 ./imio/tf/impl2r.x pointer procedure impl2r (im, linenum)
+impl2s             10 ./imfort/impl2s.x  procedure impl2s (im, buf, lineno, ier)
+impl2s             12 ./imio/tf/impl2s.x pointer procedure impl2s (im, linenum)
+impl2x             12 ./imio/tf/impl2x.x pointer procedure impl2x (im, linenum)
+impl3              12 ./imio/impl3.gx    pointer procedure impl3$t (im, line, band)
+impl3d             12 ./imio/tf/impl3d.x pointer procedure impl3d (im, line, band)
+impl3i             12 ./imio/tf/impl3i.x pointer procedure impl3i (im, line, band)
+impl3l             12 ./imio/tf/impl3l.x pointer procedure impl3l (im, line, band)
+impl3r             10 ./imfort/impl3r.x  procedure impl3r (im, buf, lineno, bandno, ier)
+impl3r             12 ./imio/tf/impl3r.x pointer procedure impl3r (im, line, band)
+impl3s             10 ./imfort/impl3s.x  procedure impl3s (im, buf, lineno, bandno, ier)
+impl3s             12 ./imio/tf/impl3s.x pointer procedure impl3s (im, line, band)
+impl3x             12 ./imio/tf/impl3x.x pointer procedure impl3x (im, line, band)
+impnl              12 ./imio/impnl.gx    int procedure impnl$t (imdes, lineptr, v)
+impnld             12 ./imio/tf/impnld.x int procedure impnld (imdes, lineptr, v)
+impnli             12 ./imio/tf/impnli.x int procedure impnli (imdes, lineptr, v)
+impnll             12 ./imio/tf/impnll.x int procedure impnll (imdes, lineptr, v)
+impnln             13 ./imio/impnln.x    int procedure impnln (im, lineptr, v, dtype)
+impnlr             12 ./imio/tf/impnlr.x int procedure impnlr (imdes, lineptr, v)
+impnls             12 ./imio/tf/impnls.x int procedure impnls (imdes, lineptr, v)
+impnlx             12 ./imio/tf/impnlx.x int procedure impnlx (imdes, lineptr, v)
+imps1               7 ./imio/imps1.gx    pointer procedure imps1$t (im, x1, x2)
+imps1d              7 ./imio/tf/imps1d.x pointer procedure imps1d (im, x1, x2)
+imps1i              7 ./imio/tf/imps1i.x pointer procedure imps1i (im, x1, x2)
+imps1l              7 ./imio/tf/imps1l.x pointer procedure imps1l (im, x1, x2)
+imps1r              7 ./imio/tf/imps1r.x pointer procedure imps1r (im, x1, x2)
+imps1r             10 ./imfort/imps1r.x  procedure imps1r (im, buf, i1, i2, ier)
+imps1s              7 ./imio/tf/imps1s.x pointer procedure imps1s (im, x1, x2)
+imps1s             10 ./imfort/imps1s.x  procedure imps1s (im, buf, i1, i2, ier)
+imps1x              7 ./imio/tf/imps1x.x pointer procedure imps1x (im, x1, x2)
+imps2               7 ./imio/imps2.gx    pointer procedure imps2$t (im, x1, x2, y1, y2)
+imps2d              7 ./imio/tf/imps2d.x pointer procedure imps2d (im, x1, x2, y1, y2)
+imps2i              7 ./imio/tf/imps2i.x pointer procedure imps2i (im, x1, x2, y1, y2)
+imps2l              7 ./imio/tf/imps2l.x pointer procedure imps2l (im, x1, x2, y1, y2)
+imps2r              7 ./imio/tf/imps2r.x pointer procedure imps2r (im, x1, x2, y1, y2)
+imps2r             10 ./imfort/imps2r.x  procedure imps2r (im, buf, i1, i2, j1, j2, ier)
+imps2s              7 ./imio/tf/imps2s.x pointer procedure imps2s (im, x1, x2, y1, y2)
+imps2s             10 ./imfort/imps2s.x  procedure imps2s (im, buf, i1, i2, j1, j2, ier)
+imps2x              7 ./imio/tf/imps2x.x pointer procedure imps2x (im, x1, x2, y1, y2)
+imps3               7 ./imio/imps3.gx    pointer procedure imps3$t (im, x1, x2, y1, y2, z1, z2)
+imps3d              7 ./imio/tf/imps3d.x pointer procedure imps3d (im, x1, x2, y1, y2, z1, z2)
+imps3i              7 ./imio/tf/imps3i.x pointer procedure imps3i (im, x1, x2, y1, y2, z1, z2)
+imps3l              7 ./imio/tf/imps3l.x pointer procedure imps3l (im, x1, x2, y1, y2, z1, z2)
+imps3r              7 ./imio/tf/imps3r.x pointer procedure imps3r (im, x1, x2, y1, y2, z1, z2)
+imps3r             10 ./imfort/imps3r.x  procedure imps3r (im, buf, i1, i2, j1, j2, k1, k2, ier)
+imps3s              7 ./imio/tf/imps3s.x pointer procedure imps3s (im, x1, x2, y1, y2, z1, z2)
+imps3s             10 ./imfort/imps3s.x  procedure imps3s (im, buf, i1, i2, j1, j2, k1, k2, ier)
+imps3x              7 ./imio/tf/imps3x.x pointer procedure imps3x (im, x1, x2, y1, y2, z1, z2)
+impstr             15 ./imfort/db/impstr.x procedure impstr (im, key, value)
+impstr             15 ./imio/db/impstr.x procedure impstr (im, key, value)
+imputb              5 ./imfort/db/imputb.x procedure imputb (im, key, bval)
+imputb              5 ./imio/db/imputb.x procedure imputb (im, key, bval)
+imputd              7 ./imfort/db/imputd.x procedure imputd (im, key, dval)
+imputd              7 ./imio/db/imputd.x procedure imputd (im, key, dval)
+imputh             19 ./imio/db/imputh.x procedure imputh (im, key, text)
+imputi              5 ./imfort/db/imputi.x procedure imputi (im, key, ival)
+imputi              5 ./imio/db/imputi.x procedure imputi (im, key, ival)
+imputl              5 ./imfort/db/imputl.x procedure imputl (im, key, lval)
+imputl              5 ./imio/db/imputl.x procedure imputl (im, key, lval)
+imputr              5 ./imfort/db/imputr.x procedure imputr (im, key, rval)
+imputr              7 ./imio/db/imputr.x procedure imputr (im, key, rval)
+imputs              5 ./imfort/db/imputs.x procedure imputs (im, key, sval)
+imputs              5 ./imio/db/imputs.x procedure imputs (im, key, value)
+imrbpx             16 ./imio/imrbpx.x    procedure imrbpx (im, obuf, totpix, v, vinc)
+imrdhdr            14 ./imfort/imrdhdr.x int procedure imrdhdr (fp, im, uchars, htype)
+imrdpx             15 ./imio/imrdpx.x    procedure imrdpx (im, obuf, npix, v, xstep)
+imrename            5 ./imio/imrename.x  procedure imrename (old, new)
+imrmbufs            7 ./imio/imrmbufs.x  procedure imrmbufs (im)
+imrnam             11 ./imfort/imrnam.x  procedure imrnam (oimage, nimage, ier)
+imsamp              5 ./imio/imsamp.x    procedure imsamp (a, b, npix, sz_pixel, step)
+imsdir             20 ./imfort/imfdir.x  procedure imsdir (dir)
+imsdirx            50 ./imfort/imfdir.x  procedure imsdirx (dir)
+imsetbuf           15 ./imio/imsetbuf.x  procedure imsetbuf (fd, im)
+imseti             14 ./imio/imseti.x    procedure imseti (im, param, value)
+imsetr             12 ./imio/imsetr.x    procedure imsetr (im, param, value)
+imsinb             10 ./imio/imsinb.x    int procedure imsinb (im, vs, ve, ndim)
+imsmpl             50 ./imio/imsamp.x    procedure imsmpl (a, b, npix, step)
+imsmps             34 ./imio/imsamp.x    procedure imsmps (a, b, npix, step)
+imsslv             11 ./imio/imsslv.x    procedure imsslv (im, vs, ve, v, vinc, npix)
+imstati            10 ./imio/imstati.x   int procedure imstati (im, option)
+imstatr             9 ./imio/imstatr.x   real procedure imstatr (im, param)
+imstats            10 ./imio/imstats.x   procedure imstats (im, option, outstr, maxch)
+imswap              9 ./imfort/imswap.x  procedure imswap (im, buf, nchars)
+imt_mapname       270 ./imio/imt.x       int procedure imt_mapname (fnt, outstr, maxch)
+imtclose          258 ./imio/imt.x       procedure imtclose (imt)
+imtgetim          175 ./imio/imt.x       int procedure imtgetim (imt, outstr, maxch)
+imtlen            235 ./imio/imt.x       int procedure imtlen (imt)
+imtopen            73 ./imio/imt.x       pointer procedure imtopen (template)
+imtopenp           46 ./imio/imt.x       pointer procedure imtopenp (param)
+imtrew            247 ./imio/imt.x       procedure imtrew (imt)
+imtrgetim         205 ./imio/imt.x       int procedure imtrgetim (imt, index, outstr, maxch)
+imtypk              7 ./imfort/imtypk.x  procedure imtypk (im, keyw, dtype, comm, ier)
+imunmap            10 ./imio/imunmap.x   procedure imunmap (im)
+imupk               6 ./imio/imupk.gx    procedure imupk$t (a, b, npix, dtype)
+imupkd              6 ./imio/tf/imupkd.x procedure imupkd (a, b, npix, dtype)
+imupki              6 ./imio/tf/imupki.x procedure imupki (a, b, npix, dtype)
+imupkl              6 ./imio/tf/imupkl.x procedure imupkl (a, b, npix, dtype)
+imupkr              6 ./imio/tf/imupkr.x procedure imupkr (a, b, npix, dtype)
+imupks              6 ./imio/tf/imupks.x procedure imupks (a, b, npix, dtype)
+imupkx              6 ./imio/tf/imupkx.x procedure imupkx (a, b, npix, dtype)
+imwbpx             15 ./imio/imwbpx.x    procedure imwbpx (im, ibuf, totpix, v, vinc)
+imwpix             11 ./imfort/imwpix.x  int procedure imwpix (im, buf, nchars, offset, inplace)
+imwrhdr            12 ./imfort/imwrhdr.x int procedure imwrhdr (fp, im, htype)
+imwrite            12 ./imio/imwrite.x   procedure imwrite (imdes, buf, nchars, offset)
+imwrpx             12 ./imio/imwrpx.x    procedure imwrpx (im, buf, npix, v, xstep)
+index               1 ./libc/index.c     index (str, ch)
+intr_disable       11 ./etc/intr.x       procedure intr_disable()
+intr_enable        28 ./etc/intr.x       procedure intr_enable()
+intr_reset         46 ./etc/intr.x       procedure intr_reset()
+intt               10 ./gio/nspp/sysint/intt.x bool procedure intt (value)
+ior                48 ./gio/ncarutil/sysint/ishift.x int procedure ior (a, b)
+ior                48 ./gio/nspp/sysint/ishift.x int procedure ior (a, b)
+iraf_main         126 ./etc/main.x       int procedure iraf_main (a_cmd, a_inchan, a_outchan, a_errchan,
+irafpath            1 ../unix/os/irafpath.c irafpath (fname)
+isatty              1 ./libc/isatty.c    isatty (fd)
+ishift              7 ./gio/ncarutil/sysint/ishift.x int procedure ishift (in_word, n)
+ishift              7 ./gio/nspp/sysint/ishift.x int procedure ishift (in_word, n)
+itob                5 ./etc/itob.x       bool procedure itob (integer_value)
+itoc                9 ./fmtio/itoc.x     int procedure itoc (ival, str, maxch)
+iw_cardtype        10 ./mwcs/iwctype.x   int procedure iw_cardtype (card, type, axis, index)
+iw_cfits            8 ./mwcs/iwcfits.x   procedure iw_cfits (iw)
+iw_enterwcs        15 ./mwcs/iwewcs.x    procedure iw_enterwcs (mw, iw, ndim)
+iw_findcard         9 ./mwcs/iwfind.x    pointer procedure iw_findcard (iw, type, axis, index)
+iw_gbigfits        15 ./mwcs/iwgbfits.x  pointer procedure iw_gbigfits (iw, ctype, axis)
+iw_putarray         9 ./mwcs/iwparray.x  procedure iw_putarray (iw, new, old, ndim, kw_format, kw_type, kw_index)
+iw_putstr           9 ./mwcs/iwpstr.x    procedure iw_putstr (fd, iw, axis, ctype, fmt1, fmt2, max_index)
+iw_rfits           18 ./mwcs/iwrfits.x   pointer procedure iw_rfits (mw, im, mode)
+iw_setaxmap        11 ./mwcs/iwsaxmap.x  procedure iw_setaxmap (mw, im)
+kardbf             52 ./ki/kfiobf.x      procedure kardbf (chan, buf, max_bytes, offset)
+kardgd             52 ./ki/kfiogd.x      procedure kardgd (chan, buf, max_bytes, offset)
+kardlp             52 ./ki/kfiolp.x      procedure kardlp (chan, buf, max_bytes, offset)
+kardpl             52 ./ki/kfiopl.x      procedure kardpl (chan, buf, max_bytes, offset)
+kardpr             48 ./ki/kfiopr.x      procedure kardpr (chan, buf, max_bytes, offset)
+kardsf             51 ./ki/kfiosf.x      procedure kardsf (chan, buf, max_bytes, offset)
+kawrbf             68 ./ki/kfiobf.x      procedure kawrbf (chan, buf, nbytes, offset)
+kawrgd             68 ./ki/kfiogd.x      procedure kawrgd (chan, buf, nbytes, offset)
+kawrlp             68 ./ki/kfiolp.x      procedure kawrlp (chan, buf, nbytes, offset)
+kawrpl             68 ./ki/kfiopl.x      procedure kawrpl (chan, buf, nbytes, offset)
+kawrpr             64 ./ki/kfiopr.x      procedure kawrpr (chan, buf, nbytes, offset)
+kawrsf             67 ./ki/kfiosf.x      procedure kawrsf (chan, buf, nbytes, offset)
+kawtbf             84 ./ki/kfiobf.x      procedure kawtbf (chan, status)
+kawtgd             84 ./ki/kfiogd.x      procedure kawtgd (chan, status)
+kawtlp             84 ./ki/kfiolp.x      procedure kawtlp (chan, status)
+kawtpl             84 ./ki/kfiopl.x      procedure kawtpl (chan, status)
+kawtpr             80 ./ki/kfiopr.x      procedure kawtpr (chan, status)
+kawtsf             83 ./ki/kfiosf.x      procedure kawtsf (chan, status)
+kb_zard            16 ./ki/kbzard.x      procedure kb_zard (device, chan, obuf, max_bytes, loffset)
+kb_zawr            10 ./ki/kbzawr.x      procedure kb_zawr (device, chan, ibuf, nbytes, loffset)
+kb_zawt            33 ./ki/kbzawt.x      procedure kb_zawt (device, chan, status)
+kb_zcls            10 ./ki/kbzcls.x      procedure kb_zcls (device, chan, status)
+kb_zopn             9 ./ki/kbzopn.x      procedure kb_zopn (device, osfn, mode, chan)
+kb_zstt            11 ./ki/kbzstt.x      procedure kb_zstt (device, chan, what, lvalue)
+kclcpr              9 ./ki/kclcpr.x      procedure kclcpr (pid, exit_status)
+kcldir              9 ./ki/kcldir.x      procedure kcldir (chan, status)
+kcldpr              9 ./ki/kcldpr.x      procedure kcldpr (jobcode, killflag, exit_status)
+kclsbf             31 ./ki/kfiobf.x      procedure kclsbf (chan, status)
+kclsgd             31 ./ki/kfiogd.x      procedure kclsgd (chan, status)
+kclslp             31 ./ki/kfiolp.x      procedure kclslp (chan, status)
+kclspl             31 ./ki/kfiopl.x      procedure kclspl (chan, status)
+kclssf             30 ./ki/kfiosf.x      procedure kclssf (chan, status)
+kclstx             33 ./ki/kfiotx.x      procedure kclstx (chan, status)
+kclsty             32 ./ki/kfioty.x      procedure kclsty (chan, status)
+kdvall              8 ./ki/kdvall.x      procedure kdvall (device, allflag, status)
+kdvown              9 ./ki/kdvown.x      procedure kdvown (device, owner, maxch, status)
+kernel_panic        2 ../unix/os/zpanic.c kernel_panic (errmsg)
+kfacss              8 ./ki/kfacss.x      procedure kfacss (osfn, mode, type, status)
+kfaloc              8 ./ki/kfaloc.x      procedure kfaloc (osfn, nbytes, status)
+kfchdr             11 ./ki/kfchdr.x      procedure kfchdr (dirname, status)
+kfdele              8 ./ki/kfdele.x      procedure kfdele (osfn, status)
+kfgcwd             10 ./ki/kfgcwd.x      procedure kfgcwd (outstr, maxch, nchars)
+kfinfo              9 ./ki/kfinfo.x      procedure kfinfo (osfn, fi, status)
+kflstx             84 ./ki/kfiotx.x      procedure kflstx (chan, status)
+kflsty             83 ./ki/kfioty.x      procedure kflsty (chan, status)
+kfmkcp             13 ./ki/kfmkcp.x      procedure kfmkcp (old_osfn, new_osfn, status)
+kfmkdr              8 ./ki/kfmkdr.x      procedure kfmkdr (osfn, status)
+kfpath              9 ./ki/kfpath.x      procedure kfpath (vfn, osfn, maxch, nchars)
+kfprot              8 ./ki/kfprot.x      procedure kfprot (osfn, protflag, status)
+kfrnam              9 ./ki/kfrnam.x      procedure kfrnam (old_osfn, new_osfn, status)
+kfsubd             13 ./ki/kfsubd.x      procedure kfsubd (osdir, maxch, subdir, nchars)
+kfxdir             18 ./ki/kfxdir.x      procedure kfxdir (vfn, osdir, maxch, nchars)
+kgettx             54 ./ki/kfiotx.x      procedure kgettx (chan, text, maxch, status)
+kgetty             53 ./ki/kfioty.x      procedure kgetty (chan, text, maxch, status)
+kgfdir             11 ./ki/kgfdir.x      procedure kgfdir (chan, osfn, maxch, status)
+ki_connect         23 ./ki/kiconnect.x   int procedure ki_connect (rname)
+ki_decode          35 ./ki/kiencode.x    long procedure ki_decode (str, nchars)
+ki_encode           6 ./ki/kiencode.x    procedure ki_encode (data, str, nchars)
+ki_envreset        10 ./ki/kienvreset.x  procedure ki_envreset (name, value)
+ki_error           22 ./ki/kierror.x     procedure ki_error (server)
+ki_extnode         15 ./ki/kiextnode.x   int procedure ki_extnode (resource, nodename, maxch, nchars)
+ki_findnode         8 ./ki/kifndnode.x   int procedure ki_findnode (alias)
+ki_flushtx         66 ./ki/ktzput.x      procedure ki_flushtx (device, chan, status)
+ki_fmapfn          15 ./ki/kifmapfn.x    procedure ki_fmapfn (vfn, pkosfn, maxch)
+ki_freechan        12 ./ki/kifchan.x     procedure ki_freechan (chan)
+ki_getchan         10 ./ki/kigchan.x     int procedure ki_getchan (server, oschan)
+ki_gethosts        11 ./ki/kighost.x     int procedure ki_gethosts()
+ki_gnode           14 ./ki/kignode.x     int procedure ki_gnode (rname, outstr, delim)
+ki_init            15 ./ki/kiinit.x      procedure ki_init (inchan, outchan, errchan, device, devtype)
+ki_localnode        7 ./ki/kilnode.x     int procedure ki_localnode (node)
+ki_mapchan         12 ./ki/kimapchan.x   int procedure ki_mapchan (chan, nodename, maxch)
+ki_mapname         19 ./ki/kimapname.x   int procedure ki_mapname (name, newname, maxch)
+ki_openks          13 ./ki/kiopenks.x    int procedure ki_openks (node)
+ki_receive         13 ./ki/kireceive.x   int procedure ki_receive (server, opcode, subcode)
+ki_send             9 ./ki/kisend.x      int procedure ki_send (server, opcode, subcode)
+ki_sendrcv          7 ./ki/kisendrcv.x   int procedure ki_sendrcv (server, opcode, subcode)
+ki_shownet          7 ./ki/kishownet.x   procedure ki_shownet (fd)
+ki_xnode           10 ./ki/kixnode.x     procedure ki_xnode (r1, r2, maxch)
+kintpr              9 ./ki/kintpr.x      procedure kintpr (pid, vex, status)
+kmalloc             8 ./memdbg/kmalloc.x int procedure kmalloc (ubufp, nelems, dtype)
+kmalloc             8 ./memio/kmalloc.x  int procedure kmalloc (ubufp, nelems, dtype)
+knottx            113 ./ki/kfiotx.x      procedure knottx (chan, loffset)
+knotty            112 ./ki/kfioty.x      procedure knotty (chan, loffset)
+kopcpr              9 ./ki/kopcpr.x      procedure kopcpr (process, inchan, outchan, pid)
+kopdir             10 ./ki/kopdir.x      procedure kopdir (osfn, chan)
+kopdpr              8 ./ki/kopdpr.x      procedure kopdpr (process, bkgfile, bkgmsg, jobcode)
+kopnbf              9 ./ki/kfiobf.x      procedure kopnbf (osfn, mode, chan)
+kopngd              9 ./ki/kfiogd.x      procedure kopngd (osfn, mode, chan)
+kopnlp              9 ./ki/kfiolp.x      procedure kopnlp (osfn, mode, chan)
+kopnpl              9 ./ki/kfiopl.x      procedure kopnpl (osfn, mode, chan)
+kopnsf             11 ./ki/kfiosf.x      procedure kopnsf (osfn, mode, chan)
+kopntx             10 ./ki/kfiotx.x      procedure kopntx (osfn, mode, chan)
+kopnty              9 ./ki/kfioty.x      procedure kopnty (osfn, mode, chan)
+koscmd             13 ./ki/koscmd.x      procedure koscmd (oscmd, stdin_file, stdout_file, stderr_file, status)
+kputtx             69 ./ki/kfiotx.x      procedure kputtx (chan, text, nchars, status)
+kputty             68 ./ki/kfioty.x      procedure kputty (chan, text, nchars, status)
+krealloc           26 ./memdbg/krealloc.x int procedure krealloc (ptr, a_nelems, a_dtype)
+krealloc           26 ./memio/krealloc.x int procedure krealloc (ptr, a_nelems, a_dtype)
+ks_aread            9 ./ki/ksaread.x     procedure ks_aread (server, buf, maxbytes)
+ks_await            9 ./ki/ksawait.x     procedure ks_await (server, status)
+ks_awrite           9 ./ki/ksawrite.x    procedure ks_awrite (server, buf, nbytes)
+ks_error          1229 ./ki/irafks.x      procedure ks_error (errcode, errmsg)
+ks_fmapfn         1413 ./ki/irafks.x      procedure ks_fmapfn (vfn, osfn, maxch)
+ks_geti            19 ../unix/os/zfioks.c ks_geti (fd)
+ks_getlogin        22 ../unix/os/zfioks.c ks_getlogin (hostname, loginname, password, ks)
+ks_getpass         30 ../unix/os/zfioks.c ks_getpass (user, host)
+ks_getresvport     17 ../unix/os/zfioks.c ks_getresvport (alport)
+ks_getword         28 ../unix/os/zfioks.c ks_getword (ipp, obuf)
+ks_loadbf         1251 ./ki/irafks.x      procedure ks_loadbf (bfdd)
+ks_loadtx         1316 ./ki/irafks.x      procedure ks_loadtx (txdd)
+ks_onsig           16 ../unix/os/zfioks.c ks_onsig (sig, arg1, arg2)
+ks_puti            18 ../unix/os/zfioks.c ks_puti (fd, ival)
+ks_receive        1384 ./ki/irafks.x      int procedure ks_receive (server)
+ks_rexecport       18 ../unix/os/zfioks.c ks_rexecport()
+ks_rhosts          25 ../unix/os/zfioks.c ks_rhosts (filename)
+ks_send           1351 ./ki/irafks.x      int procedure ks_send (server, opcode, subcode)
+ks_socket          17 ../unix/os/zfioks.c ks_socket (host, addr, port, mode)
+ks_sysname         25 ../unix/os/zfioks.c ks_sysname (filename, pathname)
+ks_username        25 ../unix/os/zfioks.c ks_username (filename, pathname, username)
+ks_whosts          28 ../unix/os/zfioks.c ks_whosts (hp, filename)
+ks_zfiobf         642 ./ki/irafks.x      procedure ks_zfiobf (in, out, iobuf, len_iobuf, bfdd)
+ks_zfiomt         1046 ./ki/irafks.x      procedure ks_zfiomt (in, out, iobuf, len_iobuf)
+ks_zfiotx         847 ./ki/irafks.x      procedure ks_zfiotx (in, out, iobuf, len_iobuf, txdd)
+ksektx             98 ./ki/kfiotx.x      procedure ksektx (chan, loffset, status)
+ksekty             97 ./ki/kfioty.x      procedure ksekty (chan, loffset, status)
+kserver           149 ./ki/irafks.x      procedure kserver (in, out, buflen)
+ksttbf             98 ./ki/kfiobf.x      procedure ksttbf (chan, what, lvalue)
+ksttgd             98 ./ki/kfiogd.x      procedure ksttgd (chan, what, lvalue)
+ksttlp             98 ./ki/kfiolp.x      procedure ksttlp (chan, what, lvalue)
+ksttpl             98 ./ki/kfiopl.x      procedure ksttpl (chan, what, lvalue)
+ksttpr             94 ./ki/kfiopr.x      procedure ksttpr (chan, what, lvalue)
+ksttsf             97 ./ki/kfiosf.x      procedure ksttsf (chan, what, lvalue)
+kstttx            127 ./ki/kfiotx.x      procedure kstttx (chan, what, lvalue)
+ksttty            126 ./ki/kfioty.x      procedure ksttty (chan, what, lvalue)
+kt_zcls            10 ./ki/ktzcls.x      procedure kt_zcls (device, chan, status)
+kt_zfls            10 ./ki/ktzfls.x      procedure kt_zfls (device, chan, status)
+kt_zget            10 ./ki/ktzget.x      procedure kt_zget (device, chan, obuf, maxch, status)
+kt_znot            10 ./ki/ktznot.x      procedure kt_znot (device, chan, loffset)
+kt_zopn            10 ./ki/ktzopn.x      procedure kt_zopn (device, osfn, mode, chan)
+kt_zput            11 ./ki/ktzput.x      procedure kt_zput (device, chan, ibuf, nchars, status)
+kt_zsek            10 ./ki/ktzsek.x      procedure kt_zsek (device, chan, loffset, status)
+kt_zstt            10 ./ki/ktzstt.x      procedure kt_zstt (device, chan, what, lvalue)
+kzclmt             10 ./ki/kzclmt.x      procedure kzclmt (chan, devpos, status)
+kzopmt             10 ./ki/kzopmt.x      procedure kzopmt (device, mode, devcap, devpos, newfile, chan)
+kzrdmt             10 ./ki/kzrdmt.x      procedure kzrdmt (chan, obuf, max_bytes, offset)
+kzrwmt             10 ./ki/kzrwmt.x      procedure kzrwmt (drive, devcap, status)
+kzstmt              8 ./ki/kzstmt.x      procedure kzstmt (chan, what, lvalue)
+kzwrmt              9 ./ki/kzwrmt.x      procedure kzwrmt (chan, buf, nbytes, offset)
+kzwtmt              9 ./ki/kzwtmt.x      procedure kzwtmt (chan, devpos, status)
+lexnum             64 ./fmtio/lexnum.x   int procedure lexnum (str, ip_start, nchars)
+lno_close          48 ./etc/lineoff.x    procedure lno_close (lp)
+lno_fetch          89 ./etc/lineoff.x    int procedure lno_fetch (lp, line, loffset, ltag)
+lno_open           26 ./etc/lineoff.x    pointer procedure lno_open (maxlines)
+lno_save           62 ./etc/lineoff.x    procedure lno_save (lp, line, loffset, ltag)
+loci               13 ./gio/nspp/sysint/loc.x int procedure loci (x)
+locpr               6 ./etc/locpr.x      int procedure locpr (proc)
+locva               5 ./etc/locva.x      int procedure locva (variable)
+loggedin            4 ../unix/os/alloc.c loggedin (uid)
+lp_zaread          53 ./etc/lpopen.x     procedure lp_zaread (chan, buf, maxbytes, offset)
+lp_zawait         109 ./etc/lpopen.x     procedure lp_zawait (chan, nbytes)
+lp_zawrite         83 ./etc/lpopen.x     procedure lp_zawrite (chan, buf, nbytes, offset)
+lpopen             19 ./etc/lpopen.x     int procedure lpopen (device, mode, type)
+ltoc                8 ./fmtio/ltoc.x     int procedure ltoc (lval, outstr, maxch)
+ma_ideh            12 ./etc/maideh.x     procedure ma_ideh()
+malloc              1 ./libc/malloc.c    malloc (nbytes)
+malloc             10 ./memdbg/malloc.x  procedure malloc (ubufp, nelems, dtype)
+malloc             10 ./memio/malloc.x   procedure malloc (ubufp, nelems, dtype)
+malloc1            58 ./memdbg/malloc1.x int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+malloc1            58 ./memio/malloc1.x  int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+mcswap              5 ./gio/nspp/sysint/mcswap.x procedure mcswap (a, npix)
+memchk            503 ./mwcs/zzdebug.x   procedure memchk()
+mfree              10 ./memdbg/mfree.x   procedure mfree (ptr, dtype)
+mfree              10 ./memio/mfree.x    procedure mfree (ptr, dtype)
+mgdptr              8 ./memdbg/mgdptr.x  pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+mgdptr              8 ./memio/mgdptr.x   pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+mgtfwa             11 ./memdbg/mgtfwa.x  int procedure mgtfwa (ptr, dtype)
+mgtfwa             11 ./memio/mgtfwa.x   int procedure mgtfwa (ptr, dtype)
+miilen             10 ./osb/miilen.x     int procedure miilen (nelems, mii_datatype)
+miinelem           10 ./osb/miinelem.x   int procedure miinelem (nchars, mii_type)
+miipak             36 ./osb/miipak.x     procedure miipak (spp, mii, nelems, spp_datatype, mii_datatype)
+miipak16            8 ./osb/miipak16.x   procedure miipak16 (spp, mii, nelems, spp_datatype)
+miipak32            8 ./osb/miipak32.x   procedure miipak32 (spp, mii, nelems, spp_datatype)
+miipak8             6 ./osb/miipak8.x    procedure miipak8 (spp, mii, nelems, spp_datatype)
+miipakd             8 ./osb/miipakd.x    procedure miipakd (spp, mii, nelems, spp_datatype)
+miipakr             8 ./osb/miipakr.x    procedure miipakr (spp, mii, nelems, spp_datatype)
+miipksize          10 ./osb/miipksize.x  int procedure miipksize (nelems, mii_type)
+miirdc            246 ./imfort/mii.x     int procedure miirdc (fp, spp, maxchars)
+miirdi             24 ./imfort/mii.x     int procedure miirdi (fp, spp, maxelem)
+miirdl             69 ./imfort/mii.x     int procedure miirdl (fp, spp, maxelem)
+miirdr            114 ./imfort/mii.x     int procedure miirdr (fp, spp, maxelem)
+miiread             8 ./etc/miiread.gx   int procedure miiread$t (fd, spp, maxelem)
+miireadc            8 ./etc/miireadc.x   int procedure miireadc (fd, spp, maxchars)
+miireadd            8 ./etc/gen/miireadd.x int procedure miireadd (fd, spp, maxelem)
+miireadi            8 ./etc/gen/miireadi.x int procedure miireadi (fd, spp, maxelem)
+miireadl            8 ./etc/gen/miireadl.x int procedure miireadl (fd, spp, maxelem)
+miireadr            8 ./etc/gen/miireadr.x int procedure miireadr (fd, spp, maxelem)
+miireads            8 ./etc/gen/miireads.x int procedure miireads (fd, spp, maxelem)
+miiupk              8 ./osb/miiupk.x     procedure miiupk (mii, spp, nelems, mii_datatype, spp_datatype)
+miiupk16            8 ./osb/miiupk16.x   procedure miiupk16 (mii, spp, nelems, spp_datatype)
+miiupk32            8 ./osb/miiupk32.x   procedure miiupk32 (mii, spp, nelems, spp_datatype)
+miiupk8             6 ./osb/miiupk8.x    procedure miiupk8 (mii, spp, nelems, spp_datatype)
+miiupkd             8 ./osb/miiupkd.x    procedure miiupkd (mii, spp, nelems, spp_datatype)
+miiupkr             8 ./osb/miiupkr.x    procedure miiupkr (mii, spp, nelems, spp_datatype)
+miiwrc            291 ./imfort/mii.x     int procedure miiwrc (fp, spp, nchars)
+miiwri            159 ./imfort/mii.x     int procedure miiwri (fp, spp, nelem)
+miiwrite            8 ./etc/miiwrite.gx  procedure miiwrite$t (fd, spp, nelem)
+miiwritec           8 ./etc/miiwritec.x  procedure miiwritec (fd, spp, nchars)
+miiwrited           8 ./etc/gen/miiwrited.x procedure miiwrited (fd, spp, nelem)
+miiwritei           8 ./etc/gen/miiwritei.x procedure miiwritei (fd, spp, nelem)
+miiwritel           8 ./etc/gen/miiwritel.x procedure miiwritel (fd, spp, nelem)
+miiwriter           8 ./etc/gen/miiwriter.x procedure miiwriter (fd, spp, nelem)
+miiwrites           8 ./etc/gen/miiwrites.x procedure miiwrites (fd, spp, nelem)
+miiwrl            188 ./imfort/mii.x     int procedure miiwrl (fp, spp, nelem)
+miiwrr            217 ./imfort/mii.x     int procedure miiwrr (fp, spp, nelem)
+mio_close           8 ./pmio/mioclose.x  procedure mio_close (mp)
+mio_glseg          21 ./pmio/miogl.gx    int procedure mio_glseg$t (mp, ptr, mval, v, npix)
+mio_glsegd         21 ./pmio/tf/miogld.x int procedure mio_glsegd (mp, ptr, mval, v, npix)
+mio_glsegi         21 ./pmio/tf/miogli.x int procedure mio_glsegi (mp, ptr, mval, v, npix)
+mio_glsegl         21 ./pmio/tf/miogll.x int procedure mio_glsegl (mp, ptr, mval, v, npix)
+mio_glsegr         21 ./pmio/tf/mioglr.x int procedure mio_glsegr (mp, ptr, mval, v, npix)
+mio_glsegs         21 ./pmio/tf/miogls.x int procedure mio_glsegs (mp, ptr, mval, v, npix)
+mio_glsegx         21 ./pmio/tf/mioglx.x int procedure mio_glsegx (mp, ptr, mval, v, npix)
+mio_open           10 ./pmio/mioopen.x   pointer procedure mio_open (mask, flags, im)
+mio_openo           9 ./pmio/mioopeno.x  pointer procedure mio_openo (pm, im)
+mio_plseg          21 ./pmio/miopl.gx    int procedure mio_plseg$t (mp, ptr, mval, v, npix)
+mio_plsegd         21 ./pmio/tf/miopld.x int procedure mio_plsegd (mp, ptr, mval, v, npix)
+mio_plsegi         21 ./pmio/tf/miopli.x int procedure mio_plsegi (mp, ptr, mval, v, npix)
+mio_plsegl         21 ./pmio/tf/miopll.x int procedure mio_plsegl (mp, ptr, mval, v, npix)
+mio_plsegr         21 ./pmio/tf/mioplr.x int procedure mio_plsegr (mp, ptr, mval, v, npix)
+mio_plsegs         21 ./pmio/tf/miopls.x int procedure mio_plsegs (mp, ptr, mval, v, npix)
+mio_plsegx         21 ./pmio/tf/mioplx.x int procedure mio_plsegx (mp, ptr, mval, v, npix)
+mio_seti            8 ./pmio/mioseti.x   procedure mio_seti (mp, param, value)
+mio_setrange        9 ./pmio/miosrange.x procedure mio_setrange (mp, vs, ve, ndim)
+mio_stati           8 ./pmio/miostati.x  int procedure mio_stati (mp, param)
+mktemp              1 ./libc/mktemp.c    mktemp (template)
+mktemp             17 ./fio/mktemp.x     procedure mktemp (seed, temp_file, maxchars)
+mp_getd           912 ./qpoe/zzdebug.x   double procedure mp_getd (buf, boffset, dtype)
+mp_geti           876 ./qpoe/zzdebug.x   int procedure mp_geti (buf, boffset, dtype)
+msvfwa              7 ./memdbg/msvfwa.x  pointer procedure msvfwa (fwa, dtype, sz_align, fwa_align)
+msvfwa              7 ./memio/msvfwa.x   pointer procedure msvfwa (fwa, dtype, sz_align, fwa_align)
+mt_clrcache       186 ./mtio/mtcache.x   procedure mt_clrcache()
+mt_devallocated    10 ./mtio/mtdevall.x  int procedure mt_devallocated (iodev)
+mt_examine        246 ./mtio/zzdebug.x   int procedure mt_examine (out, mtfile)
+mt_getpos          48 ./mtio/mtcache.x   procedure mt_getpos (mtname, mt)
+mt_glock           14 ./mtio/mtglock.x   procedure mt_glock (mtname, lockfile, maxch)
+mt_gtyopen         26 ./mtio/mtgtyopen.x pointer procedure mt_gtyopen (device, ufields)
+mt_lockname        16 ./mtio/mtlocknam.x procedure mt_lockname (device, lockfile, maxch)
+mt_putline        164 ./mtio/mtupdlock.x procedure mt_putline (fd, text)
+mt_read_lockfile   11 ./mtio/mtrdlock.x  procedure mt_read_lockfile (mtname, mt)
+mt_savekeyword    144 ./mtio/mtupdlock.x procedure mt_savekeyword (fd, keyword, value)
+mt_savepos         78 ./mtio/mtcache.x   procedure mt_savepos (mt)
+mt_skip_record      8 ./mtio/mtskip.x    int procedure mt_skip_record (fd, nrecords)
+mt_sync           133 ./mtio/mtcache.x   procedure mt_sync (status)
+mt_update_lockfile 14 ./mtio/mtupdlock.x procedure mt_update_lockfile (mt)
+mtallocate         12 ./mtio/mtalloc.x   procedure mtallocate (mtname)
+mtcap              10 ./mtio/mtcap.x     pointer procedure mtcap (mtname)
+mtclean            20 ./mtio/mtclean.x   procedure mtclean (level, stale, out)
+mtdeallocate       11 ./mtio/mtdealloc.x procedure mtdeallocate (mtname, rewind_tape)
+mtencode            7 ./mtio/mtencode.x  procedure mtencode (outstr, maxch, device, fileno, recno, attrl)
+mtfile              9 ./mtio/mtfile.x    int procedure mtfile (fname)
+mtfname             8 ./mtio/mtfname.x   procedure mtfname (mtname, fileno, outstr, maxch)
+mtneedfileno        8 ./mtio/mtneedf.x   int procedure mtneedfileno (mtname)
+mtop                6 ../unix/os/tape.c  mtop (op, count)
+mtopen             47 ./mtio/mtopen.x    int procedure mtopen (mtname, acmode, bufsize)
+mtparse            35 ./mtio/mtparse.x   procedure mtparse (mtname, device, sz_device, file, record, attrl, sz_attrl)
+mtposition          9 ./mtio/mtpos.x     procedure mtposition (mtname, file, record)
+mtrewind           13 ./mtio/mtrewind.x  procedure mtrewind (mtname, initcache)
+mtstatus            6 ./mtio/mtstatus.x  procedure mtstatus (out, mtname)
+mw_allocd          10 ./mwcs/mwallocd.x  int procedure mw_allocd (mw, nelem)
+mw_allocs          12 ./mwcs/mwallocs.x  int procedure mw_allocs (mw, nchars)
+mw_axtran          82 ./mwcs/mwtransd.x  procedure mw_axtran (o_ltm,o_ltv, n_ltm,n_ltv, pdim, ltm,ltv, ax, ndim)
+mw_c1tran           7 ./mwcs/mwc1tran.gx PIXEL procedure mw_c1tran$t (a_ct, x)
+mw_c1trand          5 ./mwcs/gen/mwc1trand.x double procedure mw_c1trand (a_ct, x)
+mw_c1tranr          5 ./mwcs/gen/mwc1tranr.x real procedure mw_c1tranr (a_ct, x)
+mw_c2tran           7 ./mwcs/mwc2tran.gx procedure mw_c2tran$t (a_ct, x1,y1, x2,y2)
+mw_c2trand          5 ./mwcs/gen/mwc2trand.x procedure mw_c2trand (a_ct, x1,y1, x2,y2)
+mw_c2tranr          5 ./mwcs/gen/mwc2tranr.x procedure mw_c2tranr (a_ct, x1,y1, x2,y2)
+mw_close           12 ./mwcs/mwclose.x   procedure mw_close (mw)
+mw_copyd           85 ./mwcs/mwnewcopy.x int procedure mw_copyd (mw, o_mw, o_off, nelem)
+mw_copys          112 ./mwcs/mwnewcopy.x int procedure mw_copys (mw, o_mw, o_off)
+mw_ctfree          10 ./mwcs/mwctfree.x  procedure mw_ctfree (ct)
+mw_ctran            8 ./mwcs/mwctran.gx  procedure mw_ctran$t (a_ct, p1, p2, ndim)
+mw_ctrand           6 ./mwcs/gen/mwctrand.x procedure mw_ctrand (a_ct, p1, p2, ndim)
+mw_ctranr           6 ./mwcs/gen/mwctranr.x procedure mw_ctranr (a_ct, p1, p2, ndim)
+mw_findsys          8 ./mwcs/mwfindsys.x pointer procedure mw_findsys (mw, system)
+mw_flookup         10 ./mwcs/mwflookup.x int procedure mw_flookup (mw, fnname)
+mw_gaxlist          9 ./mwcs/mwgaxlist.x procedure mw_gaxlist (mw, axbits, axis, naxes)
+mw_gaxmap          11 ./mwcs/mwgaxmap.x  procedure mw_gaxmap (mw, axno, axval, ndim)
+mw_gctran          17 ./mwcs/mwgctran.gx int procedure mw_gctran$t (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+mw_gctrand         17 ./mwcs/gen/mwgctrand.x int procedure mw_gctrand (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+mw_gctranr         17 ./mwcs/gen/mwgctranr.x int procedure mw_gctranr (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+mw_gltermd          8 ./mwcs/mwgltermd.x procedure mw_gltermd (mw, ltm, ltv, ndim)
+mw_gltermr          8 ./mwcs/mwgltermr.x procedure mw_gltermr (mw, ltm, ltv, ndim)
+mw_gsystem          7 ./mwcs/mwgsys.x    procedure mw_gsystem (mw, outstr, maxch)
+mw_gwattrs         10 ./mwcs/mwgwattrs.x procedure mw_gwattrs (mw, axis, attribute, valstr, maxch)
+mw_gwsampd          8 ./mwcs/mwgwsampd.x procedure mw_gwsampd (mw, axis, pv, wv, npts)
+mw_gwsampr          8 ./mwcs/mwgwsampr.x procedure mw_gwsampr (mw, axis, pv, wv, npts)
+mw_gwtermd         10 ./mwcs/mwgwtermd.x procedure mw_gwtermd (mw, r, w, cd, ndim)
+mw_gwtermr         10 ./mwcs/mwgwtermr.x procedure mw_gwtermr (mw, r, w, cd, ndim)
+mw_invertd          6 ./mwcs/mwinvertd.x procedure mw_invertd (o_ltm, n_ltm, ndim)
+mw_invertr          6 ./mwcs/mwinvertr.x procedure mw_invertr (o_ltm, n_ltm, ndim)
+mw_load            13 ./mwcs/mwload.x    procedure mw_load (mw, bp)
+mw_loadim          12 ./mwcs/mwloadim.x  procedure mw_loadim (mw, im)
+mw_ltran            6 ./mwcs/mwltran.gx  procedure mw_ltran$t (p1, p2, ltm, ltv, ndim)
+mw_ltrand           4 ./mwcs/gen/mwltrand.x procedure mw_ltrand (p1, p2, ltm, ltv, ndim)
+mw_ltranr           4 ./mwcs/gen/mwltranr.x procedure mw_ltranr (p1, p2, ltm, ltv, ndim)
+mw_lubacksub      105 ./mwcs/mwlu.x      procedure mw_lubacksub (a, ix, b, ndim)
+mw_ludecompose     18 ./mwcs/mwlu.x      procedure mw_ludecompose (a, ix, ndim)
+mw_mkidmd           5 ./mwcs/mwmkidmd.x  procedure mw_mkidmd (ltm, ndim)
+mw_mkidmr           5 ./mwcs/mwmkidmr.x  procedure mw_mkidmr (ltm, ndim)
+mw_mmul             5 ./mwcs/mwmmul.gx   procedure mw_mmul$t (a, b, c, ndim)
+mw_mmuld            3 ./mwcs/gen/mwmmuld.x procedure mw_mmuld (a, b, c, ndim)
+mw_mmulr            3 ./mwcs/gen/mwmmulr.x procedure mw_mmulr (a, b, c, ndim)
+mw_newcopy          9 ./mwcs/mwnewcopy.x pointer procedure mw_newcopy (o_mw)
+mw_newsystem       10 ./mwcs/mwnewsys.x  procedure mw_newsystem (mw, system, ndim)
+mw_open            11 ./mwcs/mwopen.x    pointer procedure mw_open (bufptr, ndim)
+mw_openim           9 ./mwcs/mwopenim.x  pointer procedure mw_openim (im)
+mw_refstr          11 ./mwcs/mwrefstr.x  int procedure mw_refstr (mw, str)
+mw_rotate          16 ./mwcs/mwrotate.x  procedure mw_rotate (mw, theta, center, axbits)
+mw_save            12 ./mwcs/mwsave.x    int procedure mw_save (o_mw, bp, buflen)
+mw_saveim          23 ./mwcs/mwsaveim.x  procedure mw_saveim (mw, im)
+mw_saxmap          12 ./mwcs/mwsaxmap.x  procedure mw_saxmap (mw, axno, axval, ndim)
+mw_scale            8 ./mwcs/mwscale.x   procedure mw_scale (mw, scale, axbits)
+mw_sctran          30 ./mwcs/mwsctran.x  pointer procedure mw_sctran (mw, system1, system2, axbits)
+mw_sdefwcs         10 ./mwcs/mwsdefwcs.x procedure mw_sdefwcs (mw)
+mw_seti             9 ./mwcs/mwseti.x    procedure mw_seti (mw, param, value)
+mw_shift            8 ./mwcs/mwshift.x   procedure mw_shift (mw, shift, axbits)
+mw_show             8 ./mwcs/mwshow.x    procedure mw_show (mw, fd, what)
+mw_sltermd          9 ./mwcs/mwsltermd.x procedure mw_sltermd (mw, ltm, ltv, ndim)
+mw_sltermr         13 ./mwcs/mwsltermr.x procedure mw_sltermr (mw, ltm, ltv, ndim)
+mw_ssystem          8 ./mwcs/mwssys.x    procedure mw_ssystem (mw, system)
+mw_stati           10 ./mwcs/mwstati.x   int procedure mw_stati (mw, param)
+mw_swattrs         10 ./mwcs/mwswattrs.x procedure mw_swattrs (mw, axis, attribute, valstr)
+mw_swsampd          8 ./mwcs/mwswsampd.x procedure mw_swsampd (mw, axis, pv, wv, npts)
+mw_swsampr          8 ./mwcs/mwswsampr.x procedure mw_swsampr (mw, axis, pv, wv, npts)
+mw_swtermd         10 ./mwcs/mwswtermd.x procedure mw_swtermd (mw, r, w, cd, ndim)
+mw_swtermr         10 ./mwcs/mwswtermr.x procedure mw_swtermr (mw, r, w, cd, ndim)
+mw_swtype          27 ./mwcs/mwswtype.x  procedure mw_swtype (mw, axis, naxes, wtype, wattr)
+mw_translated      19 ./mwcs/mwtransd.x  procedure mw_translated (mw, ltv_1, ltm, ltv_2, ndim)
+mw_translater       6 ./mwcs/mwtransr.x  procedure mw_translater (mw, ltv_1, ltm, ltv_2, ndim)
+mw_v1tran           7 ./mwcs/mwv1tran.gx procedure mw_v1tran$t (a_ct, x1, x2, npts)
+mw_v1trand          5 ./mwcs/gen/mwv1trand.x procedure mw_v1trand (a_ct, x1, x2, npts)
+mw_v1tranr          5 ./mwcs/gen/mwv1tranr.x procedure mw_v1tranr (a_ct, x1, x2, npts)
+mw_v2tran           7 ./mwcs/mwv2tran.gx procedure mw_v2tran$t (a_ct, x1,y1, x2,y2, npts)
+mw_v2trand          5 ./mwcs/gen/mwv2trand.x procedure mw_v2trand (a_ct, x1,y1, x2,y2, npts)
+mw_v2tranr          5 ./mwcs/gen/mwv2tranr.x procedure mw_v2tranr (a_ct, x1,y1, x2,y2, npts)
+mw_vmul             5 ./mwcs/mwvmul.gx   procedure mw_vmul$t (a, b, c, ndim)
+mw_vmuld            3 ./mwcs/gen/mwvmuld.x procedure mw_vmuld (a, b, c, ndim)
+mw_vmulr            3 ./mwcs/gen/mwvmulr.x procedure mw_vmulr (a, b, c, ndim)
+mw_vtran            6 ./mwcs/mwvtran.gx  procedure mw_vtran$t (ct, v1, v2, ndim, npts)
+mw_vtrand           4 ./mwcs/gen/mwvtrand.x procedure mw_vtrand (ct, v1, v2, ndim, npts)
+mw_vtranr           4 ./mwcs/gen/mwvtranr.x procedure mw_vtranr (ct, v1, v2, ndim, npts)
+napmsx              2 ../unix/os/zwmsec.c napmsx()
+ncgchr              6 ./gio/nspp/sysint/ncgchr.x procedure ncgchr (ichars, len_ichars, index, char_value)
+ncpchr              6 ./gio/nspp/sysint/ncpchr.x procedure ncpchr (ichars, len_ichars, index, char_value)
+ndopen             52 ./fio/ndopen.x     int procedure ndopen (fname, mode)
+newpen            358 ./gio/calcomp/vttest.x procedure newpen (whichpen)
+nextcmd             6 ../unix/os/tape.c  nextcmd (in)
+note               13 ./fio/note.x       long procedure note (fd)
+nowhite             8 ./fio/nowhite.x    int procedure nowhite (in, out, maxch)
+nscan               6 ./fmtio/nscan.x    int procedure nscan()
+oif_access          8 ./imio/iki/oif/oifaccess.x procedure oif_access (kernel, root, extn, acmode, status)
+oif_close          13 ./imio/iki/oif/oifclose.x procedure oif_close (im, status)
+oif_copy            8 ./imio/iki/oif/oifcopy.x procedure oif_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+oif_delete         10 ./imio/iki/oif/oifdelete.x procedure oif_delete (kernel, root, extn, status)
+oif_gpixfname       8 ./imio/iki/oif/oifgpfn.x procedure oif_gpixfname (pixfile, hdrfile, path, maxch)
+oif_mkpixfname     13 ./imio/iki/oif/oifmkpfn.x procedure oif_mkpixfname (im, pixfile, maxch)
+oif_open           12 ./imio/iki/oif/oifopen.x procedure oif_open (kernel, im, o_im, root, extn, ksection, cl_index, cl_size, acmode, status)
+oif_opix           24 ./imio/iki/oif/oifopix.x procedure oif_opix (im, status)
+oif_rdhdr          14 ./imio/iki/oif/oifrdhdr.x int procedure oif_rdhdr (fd, im, uchars, htype)
+oif_rename         11 ./imio/iki/oif/oifrename.x procedure oif_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+oif_trim          219 ./imio/iki/oif/oifwrhdr.x procedure oif_trim (s, nchars)
+oif_trim          245 ./imfort/imwrhdr.x procedure oif_trim (s, nchars)
+oif_updhdr         11 ./imio/iki/oif/oifupdhdr.x procedure oif_updhdr (im, status)
+oif_wrhdr          13 ./imio/iki/oif/oifwrhdr.x procedure oif_wrhdr (fd, im, htype)
+onentry            29 ./etc/onentry.x    int procedure onentry (prtype, bkgfile, cmd)
+onentry            61 ./ki/irafks.x      int procedure onentry (prtype, bkgfile, cmd)
+onerror            12 ./etc/onerror.x    procedure onerror (user_proc)
+onerror_remove     52 ./etc/onerror.x    procedure onerror_remove (user_proc)
+onexit             10 ./etc/onexit.x     procedure onexit (user_proc)
+onexit_remote      49 ./etc/onexit.x     procedure onexit_remote (user_proc)
+onint               2 ./libc/zztest.c    onint (code, old_handler)
+onint             1228 ./plio/zzdebug.x   procedure onint (signal, next_handler)
+open               11 ./fio/open.x       int procedure open (fname, mode, type)
+oscmd              13 ./etc/oscmd.x      int procedure oscmd (cmd, infile, outfile, errfile)
+osfn_initlock     273 ./fio/osfnlock.x   procedure osfn_initlock (osfn)
+osfn_lock          63 ./fio/osfnlock.x   long procedure osfn_lock (osfn)
+osfn_mkfnames     307 ./fio/osfnlock.x   procedure osfn_mkfnames (osfn, lockfile, timelock1, timelock2, maxch)
+osfn_pkfname      357 ./fio/osfnlock.x   procedure osfn_pkfname (spp_osfn, host_osfn, maxch)
+osfn_rmlock       240 ./fio/osfnlock.x   procedure osfn_rmlock (osfn)
+osfn_timeleft     155 ./fio/osfnlock.x   int procedure osfn_timeleft (osfn, time)
+osfn_unlock       204 ./fio/osfnlock.x   int procedure osfn_unlock (osfn, time)
+output              8 ../unix/os/tape.c  output (text)
+packum             11 ./gio/nspp/sysint/packum.x procedure packum (a, npix, bp)
+pagefile           93 ./etc/pagefiles.x  procedure pagefile (fname, prompt)
+pagefiles          69 ./etc/pagefiles.x  procedure pagefiles (files)
+pargb               7 ./fmtio/pargb.x    procedure pargb (bval)
+pargc              32 ./fmtio/parg.x     procedure pargc (cval)
+pargd              21 ./fmtio/parg.x     procedure pargd (dval)
+pargg             110 ./fmtio/parg.x     procedure pargg (value, dtype)
+pargi              61 ./fmtio/parg.x     procedure pargi (ival)
+pargl              77 ./fmtio/parg.x     procedure pargl (lval)
+pargr              93 ./fmtio/parg.x     procedure pargr (rval)
+pargs              45 ./fmtio/parg.x     procedure pargs (sval)
+pargstr             7 ./fmtio/pargstr.x  procedure pargstr (str)
+pargx              11 ./fmtio/pargx.x    procedure pargx (xval)
+parse_args        1250 ./plio/zzdebug.x   procedure parse_args (args, ip)
+parse_args        999 ./pmio/zzinterp.x  procedure parse_args (args, ip)
+pat_amatch        125 ./fmtio/patmatch.x int procedure pat_amatch (str, from, pat)
+pat_filset        514 ./fmtio/patmatch.x procedure pat_filset (delim, patstr, ip, patbuf, sz_pat, op)
+pat_getccl        448 ./fmtio/patmatch.x int procedure pat_getccl (patstr, patbuf, sz_pat, ip, op)
+pat_gsize         169 ./fmtio/patmatch.x int procedure pat_gsize (pat, n)
+pat_locate        277 ./fmtio/patmatch.x int procedure pat_locate (ch, pat, offset)
+pat_omatch        196 ./fmtio/patmatch.x int procedure pat_omatch (str, ip, pat, pp)
+pat_stclos        480 ./fmtio/patmatch.x int procedure pat_stclos (patbuf, sz_pat, op, last_op, last_closure)
+patindex          101 ./fmtio/patmatch.x int procedure patindex (pat, n)
+patmake           299 ./fmtio/patmatch.x int procedure patmake (str, pat, sz_pat)
+patmatch           46 ./fmtio/patmatch.x int procedure patmatch (str, pat)
+perror              1 ./libc/perror.c    perror (prefix)
+perror              5 ./gio/nspp/sysint/perror.x procedure perror()
+pg_getcmd         1009 ./etc/pagefiles.x  int procedure pg_getcmd (tty, fname, nchars, totchars, lineno, fileno, nfiles)
+pg_getline        979 ./etc/pagefiles.x  int procedure pg_getline (fd, lbuf)
+pg_getstr         1093 ./etc/pagefiles.x  procedure pg_getstr (strval, maxch)
+pg_pagefile       237 ./etc/pagefiles.x  int procedure pg_pagefile (tty, fname, newfname, u_prompt, clear_screen,
+pg_peekcmd        1129 ./etc/pagefiles.x  int procedure pg_peekcmd()
+pg_pushcmd        1109 ./etc/pagefiles.x  procedure pg_pushcmd (cmd)
+pg_setprompt      962 ./etc/pagefiles.x  procedure pg_setprompt (prompt, u_prompt, fname)
+phelp               8 ../unix/os/tape.c  phelp()
+pl_access          11 ./plio/placcess.x  int procedure pl_access (pl, v)
+pl_alloc            9 ./plio/plalloc.x   int procedure pl_alloc (pl, nwords)
+pl_asciidump       10 ./plio/plascii.x   procedure pl_asciidump (pl, vs, ve, outfd)
+pl_box             18 ./plio/plbox.x     procedure pl_box (pl, x1,y1, x2,y2, rop)
+pl_chkfree          8 ./plio/zzlib.x     procedure pl_chkfree (pl, msg)
+pl_circle          20 ./plio/plcircle.x  procedure pl_circle (pl, x, y, radius, rop)
+pl_clear            9 ./plio/plclear.x   procedure pl_clear (pl)
+pl_close           10 ./plio/plclose.x   procedure pl_close (pl)
+pl_compare         10 ./plio/plcompare.x int procedure pl_compare (pl_1, pl_2, outfd)
+pl_compress        10 ./plio/plcmpress.x procedure pl_compress (pl)
+pl_create           7 ./plio/plcreate.x  pointer procedure pl_create (naxes, axlen, depth)
+pl_debug           17 ./plio/pldebug.x   procedure pl_debug (pl, fd, width, what)
+pl_debugout         7 ./plio/pldbgout.x  procedure pl_debugout (fd, buf, col, firstcol, maxcol)
+pl_empty            7 ./plio/plempty.x   bool procedure pl_empty (pl)
+pl_getplane         8 ./plio/plgplane.x  procedure pl_getplane (pl, v)
+pl_glls             8 ./plio/plglls.x    procedure pl_glls (pl, v, ll_dst, ll_depth, npix, rop)
+pl_glp              8 ./plio/plglp.gx    procedure pl_glp$t (pl, v, px_dst, px_depth, npix, rop)
+pl_glpi             8 ./plio/tf/plglpi.x procedure pl_glpi (pl, v, px_dst, px_depth, npix, rop)
+pl_glpl             8 ./plio/tf/plglpl.x procedure pl_glpl (pl, v, px_dst, px_depth, npix, rop)
+pl_glps             8 ./plio/tf/plglps.x procedure pl_glps (pl, v, px_dst, px_depth, npix, rop)
+pl_glr              9 ./plio/plglr.gx    procedure pl_glr$t (pl, v, rl_dst, rl_depth, npix, rop)
+pl_glri             9 ./plio/tf/plglri.x procedure pl_glri (pl, v, rl_dst, rl_depth, npix, rop)
+pl_glrl             9 ./plio/tf/plglrl.x procedure pl_glrl (pl, v, rl_dst, rl_depth, npix, rop)
+pl_glrs             9 ./plio/tf/plglrs.x procedure pl_glrs (pl, v, rl_dst, rl_depth, npix, rop)
+pl_gsize            8 ./plio/plgsize.x   procedure pl_gsize (pl, naxes, axlen, depth)
+pl_l2p              8 ./plio/pll2p.gx    int procedure pl_l2p$t (ll_src, xs, px_dst, npix)
+pl_l2pi             8 ./plio/tf/pll2pi.x int procedure pl_l2pi (ll_src, xs, px_dst, npix)
+pl_l2pl             8 ./plio/tf/pll2pl.x int procedure pl_l2pl (ll_src, xs, px_dst, npix)
+pl_l2ps             8 ./plio/tf/pll2ps.x int procedure pl_l2ps (ll_src, xs, px_dst, npix)
+pl_l2r              9 ./plio/pll2r.gx    int procedure pl_l2r$t (ll_src, xs, rl, npix)
+pl_l2ri             9 ./plio/tf/pll2ri.x int procedure pl_l2ri (ll_src, xs, rl, npix)
+pl_l2rl             9 ./plio/tf/pll2rl.x int procedure pl_l2rl (ll_src, xs, rl, npix)
+pl_l2rs             9 ./plio/tf/pll2rs.x int procedure pl_l2rs (ll_src, xs, rl, npix)
+pl_line            12 ./plio/plline.x    procedure pl_line (pl, x1, y1, x2, y2, width, rop)
+pl_linenotempty     8 ./plio/pllinene.x  bool procedure pl_linenotempty (pl, v)
+pl_linerop         13 ./plio/pllrop.x    procedure pl_linerop (ll_src, xs, src_maxval,
+pl_linestencil     12 ./plio/pllsten.x   procedure pl_linestencil (ll_src,xs,src_maxval, ll_dst,ds,dst_maxval,
+pl_load            12 ./plio/plload.x    procedure pl_load (pl, bp)
+pl_loadf           11 ./plio/plloadf.x   procedure pl_loadf (pl, mask, title, maxch)
+pl_loadim          10 ./plio/plloadim.x  procedure pl_loadim (pl, imname)
+pl_newcopy          9 ./plio/plnewcopy.x pointer procedure pl_newcopy (old_pl)
+pl_open            10 ./plio/plopen.x    pointer procedure pl_open (smp)
+pl_p2l              8 ./plio/plp2l.gx    int procedure pl_p2l$t (px_src, xs, ll_dst, npix)
+pl_p2li             8 ./plio/tf/plp2li.x int procedure pl_p2li (px_src, xs, ll_dst, npix)
+pl_p2ll             8 ./plio/tf/plp2ll.x int procedure pl_p2ll (px_src, xs, ll_dst, npix)
+pl_p2ls             8 ./plio/tf/plp2ls.x int procedure pl_p2ls (px_src, xs, ll_dst, npix)
+pl_p2r              9 ./plio/plp2r.gx    int procedure pl_p2r$t (px_src, xs, rl, npix)
+pl_p2ri             9 ./plio/tf/plp2ri.x int procedure pl_p2ri (px_src, xs, rl, npix)
+pl_p2rl             9 ./plio/tf/plp2rl.x int procedure pl_p2rl (px_src, xs, rl, npix)
+pl_p2rs             9 ./plio/tf/plp2rs.x int procedure pl_p2rs (px_src, xs, rl, npix)
+pl_pixrop           8 ./plio/plprop.gx   procedure pl_pixrop$t (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+pl_pixrop           8 ./pmio/plprop.gx   procedure pl_pixrop$t (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+pl_pixropi          8 ./plio/tf/plpropi.x procedure pl_pixropi (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+pl_pixropl          8 ./plio/tf/plpropl.x procedure pl_pixropl (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+pl_pixrops          8 ./plio/tf/plprops.x procedure pl_pixrops (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+pl_plls             8 ./plio/plplls.x    procedure pl_plls (pl, v, ll_src, ll_depth, npix, rop)
+pl_plp              8 ./plio/plplp.gx    procedure pl_plp$t (pl, v, px_src, px_depth, npix, rop)
+pl_plpi             8 ./plio/tf/plplpi.x procedure pl_plpi (pl, v, px_src, px_depth, npix, rop)
+pl_plpl             8 ./plio/tf/plplpl.x procedure pl_plpl (pl, v, px_src, px_depth, npix, rop)
+pl_plps             8 ./plio/tf/plplps.x procedure pl_plps (pl, v, px_src, px_depth, npix, rop)
+pl_plr              8 ./plio/plplr.gx    procedure pl_plr$t (pl, v, rl_src, rl_depth, npix, rop)
+pl_plri             8 ./plio/tf/plplri.x procedure pl_plri (pl, v, rl_src, rl_depth, npix, rop)
+pl_plrl             8 ./plio/tf/plplrl.x procedure pl_plrl (pl, v, rl_src, rl_depth, npix, rop)
+pl_plrs             8 ./plio/tf/plplrs.x procedure pl_plrs (pl, v, rl_src, rl_depth, npix, rop)
+pl_point           11 ./plio/plpoint.x   procedure pl_point (pl, x, y, rop)
+pl_polygon         26 ./plio/plpolygon.x procedure pl_polygon (pl, x, y, npts, rop)
+pl_r2l              9 ./plio/plr2l.gx    int procedure pl_r2l$t (rl_src, xs, ll_dst, npix)
+pl_r2li             9 ./plio/tf/plr2li.x int procedure pl_r2li (rl_src, xs, ll_dst, npix)
+pl_r2ll             9 ./plio/tf/plr2ll.x int procedure pl_r2ll (rl_src, xs, ll_dst, npix)
+pl_r2ls             9 ./plio/tf/plr2ls.x int procedure pl_r2ls (rl_src, xs, ll_dst, npix)
+pl_r2p              9 ./plio/plr2p.gx    int procedure pl_r2p$t (rl_src, xs, px_dst, npix)
+pl_r2pi             9 ./plio/tf/plr2pi.x int procedure pl_r2pi (rl_src, xs, px_dst, npix)
+pl_r2pl             9 ./plio/tf/plr2pl.x int procedure pl_r2pl (rl_src, xs, px_dst, npix)
+pl_r2ps             9 ./plio/tf/plr2ps.x int procedure pl_r2ps (rl_src, xs, px_dst, npix)
+pl_rangerop        13 ./plio/plrrop.gx   procedure pl_rangerop$t (rl_src, xs, src_maxval,
+pl_rangeropi       13 ./plio/tf/plrropi.x procedure pl_rangeropi (rl_src, xs, src_maxval,
+pl_rangeropl       13 ./plio/tf/plrropl.x procedure pl_rangeropl (rl_src, xs, src_maxval,
+pl_rangerops       13 ./plio/tf/plrrops.x procedure pl_rangerops (rl_src, xs, src_maxval,
+pl_regionrop       24 ./plio/plregrop.x  procedure pl_regionrop (pl, ufcn, ufd, y1, y2, rop)
+pl_rop             20 ./plio/plrop.x     procedure pl_rop (pl_src, vs_src, pl_dst, vs_dst, vn, rop)
+pl_save            18 ./plio/plsave.x    int procedure pl_save (pl, bp, buflen, flags)
+pl_savef           10 ./plio/plsavef.x   procedure pl_savef (pl, fname, title, flags)
+pl_saveim          11 ./plio/plsaveim.x  procedure pl_saveim (pl, imname, flags)
+pl_sectnotconst    11 ./plio/plsectnc.x  bool procedure pl_sectnotconst (pl_src, v1, v2, ndim, mval)
+pl_sectnotempty     9 ./plio/plsectne.x  bool procedure pl_sectnotempty (pl_src, v1, v2, ndim)
+pl_seti             8 ./plio/plseti.x    procedure pl_seti (pl, param, value)
+pl_setplane         8 ./plio/plsplane.x  procedure pl_setplane (pl, v)
+pl_ssize            9 ./plio/plssize.x   procedure pl_ssize (pl, naxes, axlen, depth)
+pl_stati            8 ./plio/plstati.x   int procedure pl_stati (pl, param)
+pl_stencil         11 ./plio/plsten.x    procedure pl_stencil (pl_src, vs_src, pl_dst, vs_dst, pl_stn, vs_stn, vn, rop)
+pl_ubox            48 ./plio/plbox.x     bool procedure pl_ubox (ufd, y, rl_reg, xs, npix)
+pl_ucircle         54 ./plio/plcircle.x  bool procedure pl_ucircle (ufd, y, rl_reg, xs, npix)
+pl_update          36 ./plio/plupdate.x  procedure pl_update (pl, v, ll)
+pl_upolygon        90 ./plio/plpolygon.x bool procedure pl_upolygon (ufd, line, rl_reg, xs, npix)
+plf_access          8 ./imio/iki/plf/plfaccess.x procedure plf_access (kernel, root, extn, acmode, status)
+plf_close           9 ./imio/iki/plf/plfclose.x procedure plf_close (im, status)
+plf_copy            9 ./imio/iki/plf/plfcopy.x procedure plf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+plf_delete          7 ./imio/iki/plf/plfdelete.x procedure plf_delete (kernel, root, extn, status)
+plf_null            5 ./imio/iki/plf/plfnull.x procedure plf_null()
+plf_open           12 ./imio/iki/plf/plfopen.x procedure plf_open (kernel, im, o_im,
+plf_rename          8 ./imio/iki/plf/plfrename.x procedure plf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+plf_updhdr          9 ./imio/iki/plf/plfupdhdr.x procedure plf_updhdr (im, status)
+pll_const          75 ./plio/plsectnc.x  bool procedure pll_const (ll_src, xs, npix, mval)
+pll_empty          60 ./plio/plsectne.x  bool procedure pll_empty (ll_src, xs, npix)
+pll_equal           7 ./plio/plleq.x     bool procedure pll_equal (l1, l2)
+pll_nextseg         9 ./plio/pllnext.x   procedure pll_nextseg (ll, ld)
+pll_prints          7 ./plio/pllpr.x     procedure pll_prints (ll, fd, label, firstcol, maxcols)
+plloop              9 ./plio/plloop.x    int procedure plloop (v, vs, ve, ndim)
+plot              326 ./gio/calcomp/vttest.x procedure plot (x, y, pencode)
+plot1              12 ./gio/zzdebug.x    procedure plot1()
+plot2              39 ./gio/zzdebug.x    procedure plot2()
+plot3              85 ./gio/zzdebug.x    procedure plot3()
+plot4             118 ./gio/zzdebug.x    procedure plot4()
+plot5             151 ./gio/zzdebug.x    procedure plot5()
+plot6             180 ./gio/zzdebug.x    procedure plot6()
+plot7             209 ./gio/zzdebug.x    procedure plot7()
+plot8             336 ./gio/zzdebug.x    procedure plot8()
+plots             347 ./gio/calcomp/vttest.x procedure plots (dum1, dum2, ldev)
+plr_close         342 ./plio/plrio.x     procedure plr_close (plr)
+plr_equal           7 ./plio/plreq.gx    bool procedure plr_equal$t (r1, r2)
+plr_equali          7 ./plio/tf/plreqi.x bool procedure plr_equali (r1, r2)
+plr_equall          7 ./plio/tf/plreql.x bool procedure plr_equall (r1, r2)
+plr_equals          7 ./plio/tf/plreqs.x bool procedure plr_equals (r1, r2)
+plr_getlut        295 ./plio/plrio.x     procedure plr_getlut (plr, bufp, xsize,ysize, xblock,yblock)
+plr_getpix        249 ./plio/plrio.x     int procedure plr_getpix (plr, i, j)
+plr_open           69 ./plio/plrio.x     pointer procedure plr_open (pl, plane, buflimit)
+plr_print           8 ./plio/plrpr.gx    procedure plr_print$t (rl, fd, label, firstcol, maxcol)
+plr_printi          8 ./plio/tf/plrpri.x procedure plr_printi (rl, fd, label, firstcol, maxcol)
+plr_printl          8 ./plio/tf/plrprl.x procedure plr_printl (rl, fd, label, firstcol, maxcol)
+plr_prints          8 ./plio/tf/plrprs.x procedure plr_prints (rl, fd, label, firstcol, maxcol)
+plr_setrect       313 ./plio/plrio.x     procedure plr_setrect (plr, x1,y1, x2,y2)
+plsslv             10 ./plio/plsslv.x    procedure plsslv (pl, vs, vn, v, ve)
+plterm            177 ./mwcs/zzdebug.x   procedure plterm (mw, ltm, ltv, ndim)
+plvalid             8 ./plio/plvalid.x   procedure plvalid (pl)
+pm_access          10 ./pmio/pmaccess.x  int procedure pm_access (pl, v)
+pm_asciidump       10 ./pmio/pmascii.x   procedure pm_asciidump (pl, vs, ve, outfd)
+pm_box             10 ./pmio/pmbox.x     procedure pm_box (pl, x1,y1, x2,y2, rop)
+pm_circle          13 ./pmio/pmcircle.x  procedure pm_circle (pl, x, y, radius, rop)
+pm_clear           11 ./pmio/pmclear.x   procedure pm_clear (pl)
+pm_empty            9 ./pmio/pmempty.x   bool procedure pm_empty (pl)
+pm_glls            10 ./pmio/pmglls.x    procedure pm_glls (pl, v, ll_dst, ll_depth, npix, rop)
+pm_glp              9 ./pmio/pmglp.gx    procedure pm_glp$t (pl, v, px_dst, px_depth, npix, rop)
+pm_glpi             9 ./pmio/tf/pmglpi.x procedure pm_glpi (pl, v, px_dst, px_depth, npix, rop)
+pm_glpl             9 ./pmio/tf/pmglpl.x procedure pm_glpl (pl, v, px_dst, px_depth, npix, rop)
+pm_glps             9 ./pmio/tf/pmglps.x procedure pm_glps (pl, v, px_dst, px_depth, npix, rop)
+pm_glr             13 ./pmio/pmglr.gx    procedure pm_glr$t (pl, v, rl_dst, rl_depth, npix, rop)
+pm_glri            13 ./pmio/tf/pmglri.x procedure pm_glri (pl, v, rl_dst, rl_depth, npix, rop)
+pm_glrl            13 ./pmio/tf/pmglrl.x procedure pm_glrl (pl, v, rl_dst, rl_depth, npix, rop)
+pm_glrs            13 ./pmio/tf/pmglrs.x procedure pm_glrs (pl, v, rl_dst, rl_depth, npix, rop)
+pm_line            11 ./pmio/pmline.x    procedure pm_line (pl, x1, y1, x2, y2, width, rop)
+pm_linenotempty     9 ./pmio/pmlinene.x  bool procedure pm_linenotempty (pl, v)
+pm_newmask         11 ./pmio/pmnewmask.x pointer procedure pm_newmask (ref_im, depth)
+pm_plls             9 ./pmio/pmplls.x    procedure pm_plls (pl, v, ll_raw, ll_depth, npix, rop)
+pm_plp              9 ./pmio/pmplp.gx    procedure pm_plp$t (pl, v, px_src, px_depth, npix, rop)
+pm_plpi             9 ./pmio/tf/pmplpi.x procedure pm_plpi (pl, v, px_src, px_depth, npix, rop)
+pm_plpl             9 ./pmio/tf/pmplpl.x procedure pm_plpl (pl, v, px_src, px_depth, npix, rop)
+pm_plps             9 ./pmio/tf/pmplps.x procedure pm_plps (pl, v, px_src, px_depth, npix, rop)
+pm_plr              9 ./pmio/pmplr.gx    procedure pm_plr$t (pl, v, rl_src, rl_depth, npix, rop)
+pm_plri             9 ./pmio/tf/pmplri.x procedure pm_plri (pl, v, rl_src, rl_depth, npix, rop)
+pm_plrl             9 ./pmio/tf/pmplrl.x procedure pm_plrl (pl, v, rl_src, rl_depth, npix, rop)
+pm_plrs             9 ./pmio/tf/pmplrs.x procedure pm_plrs (pl, v, rl_src, rl_depth, npix, rop)
+pm_point           11 ./pmio/pmpoint.x   procedure pm_point (pl, x, y, rop)
+pm_polygon         11 ./pmio/pmpolygon.x procedure pm_polygon (pl, x, y, npts, rop)
+pm_rop             20 ./pmio/pmrop.x     procedure pm_rop (pm_src, vs_src, pm_dst, vs_dst, vn, rop)
+pm_sectnotconst    10 ./pmio/pmsectnc.x  bool procedure pm_sectnotconst (pl, vs, ve, ndim, mval)
+pm_sectnotempty     8 ./pmio/pmsectne.x  bool procedure pm_sectnotempty (pl, vs, ve, ndim)
+pm_seti             9 ./pmio/pmseti.x    procedure pm_seti (pl, param, value)
+pm_setplane         9 ./pmio/pmsplane.x  procedure pm_setplane (pl, v)
+pm_stencil         11 ./pmio/pmsten.x    procedure pm_stencil (pm_src, vs_src, pm_dst, vs_dst, pm_stn, vs_stn, vn, rop)
+pmr_close         122 ./pmio/pmrio.x     procedure pmr_close (pmr)
+pmr_getpix         71 ./pmio/pmrio.x     int procedure pmr_getpix (pmr, i, j)
+pmr_open           49 ./pmio/pmrio.x     pointer procedure pmr_open (pl, plane, buflimit)
+pmr_setrect        94 ./pmio/pmrio.x     procedure pmr_setrect (pmr, x1,y1, x2,y2)
+pow2              179 ./gio/nsppkern/gktinit.x int procedure pow2 (num)
+pr_dummy_open     116 ./etc/propcpr.x    procedure pr_dummy_open (osfn, mode, chan)
+pr_enter            1 ../unix/os/prwait.c pr_enter (pid, inchan, outchan)
+pr_findpid          3 ../unix/os/prwait.c pr_findpid (pid)
+pr_findproc         8 ./etc/prfindpr.x   int procedure pr_findproc (pid)
+pr_getipc           2 ../unix/os/prwait.c pr_getipc (pid, inchan, outchan)
+pr_getredir         7 ./etc/prgredir.x   int procedure pr_getredir (pid, stream)
+pr_onint            3 ../unix/os/zoscmd.c pr_onint (usig, hwcode, scp)
+pr_onipc          171 ./etc/propcpr.x    procedure pr_onipc (vex, next_handler)
+pr_psio            45 ./etc/prpsio.x     int procedure pr_psio (pid, fd, rwflag)
+pr_release          3 ../unix/os/prwait.c pr_release (pid)
+pr_wait             1 ../unix/os/prwait.c pr_wait (pid)
+pr_zclspr         140 ./etc/propcpr.x    procedure pr_zclspr (chan, status)
+prchdir             6 ./etc/prchdir.x    procedure prchdir (pid, newdir)
+prclcpr            12 ./etc/prclcpr.x    int procedure prclcpr (pid)
+prcldpr            16 ./etc/prcldpr.x    int procedure prcldpr (job)
+prclose            14 ./etc/prclose.x    int procedure prclose (pid)
+prdone             12 ./etc/prdone.x     int procedure prdone (job)
+preal               3 ./gio/ncarutil/tests/preal.x procedure preal (tval, rval)
+prenvfree           7 ./etc/prenvfree.x  int procedure prenvfree (pid, marker)
+prenvset            6 ./etc/prenvset.x   procedure prenvset (pid, envvar, valuestr)
+prfilbuf           11 ./etc/prfilbuf.x   int procedure prfilbuf (fd)
+prgetline          19 ./etc/prgline.x    int procedure prgetline (fd, lbuf)
+print_help        1095 ./pmio/zzinterp.x  procedure print_help (fd)
+print_help        1347 ./plio/zzdebug.x   procedure print_help (fd)
+printf              1 ./libc/printf.c    printf (va_alist)
+printf              7 ./fmtio/printf.x   procedure printf (format_string)
+prkill             15 ./etc/prkill.x     procedure prkill (job)
+prompt              7 ../unix/os/tape.c  prompt()
+propcpr            17 ./etc/propcpr.x    int procedure propcpr (process, in, out)
+propdpr            16 ./etc/propdpr.x    int procedure propdpr (process, bkgfile, bkgmsg)
+propen             18 ./etc/propen.x     int procedure propen (process, in, out)
+proscmd             8 ./etc/proscmd.x    procedure proscmd (pr, cmd)
+protect            13 ./fio/protect.x    int procedure protect (fname, action)
+prpsinit            6 ./gio/cursor/prpsinit.x procedure prpsinit()
+prpsload           11 ./etc/prpsload.x   procedure prpsload (giotr, control, gflush, writep, readtty, writetty)
+prredir            15 ./etc/prredir.x    procedure prredir (pid, stream, new_fd)
+prseti              9 ./etc/prseti.x     procedure prseti (pid, param, value)
+prsignal           10 ./etc/prsignal.x   procedure prsignal (pid, signal)
+prstati             9 ./etc/prstati.x    int procedure prstati (pid, param)
+prupdate           14 ./etc/prupdate.x   procedure prupdate (pid, message, flushout)
+prv_reset          26 ./etc/prenvfree.x  procedure prv_reset (name, value)
+psio_isxmit        19 ./etc/psioisxt.x   int procedure psio_isxmit (lbuf, pseudofile, nchars)
+psio_xfer          11 ./etc/psioxfer.x   procedure psio_xfer (fd, buf, nchars)
+pstatus             7 ../unix/os/tape.c  pstatus()
+pstr                7 ./gio/ncarutil/autograph/pstr.x procedure pstr (spp_string)
+psym              240 ./symtab/zzdebug.x procedure psym (stp, sym)
+putc                8 ./fio/putc.x       procedure putc (fd, ch)
+putcc              10 ./fio/putcc.x      procedure putcc (fd, ch)
+putchar            32 ./fio/putc.x       procedure putchar (ch)
+putci               8 ./fio/putci.x      procedure putci (fd, ch)
+putline            14 ./fio/putline.x    procedure putline (fd, linebuf)
+puts                1 ./libc/puts.c      puts (str)
+putw                1 ./libc/putw.c      putw (word, fp)
+qm_access         134 ./qpoe/qpmacro.x   pointer procedure qm_access()
+qm_getc           726 ./qpoe/qpmacro.x   int procedure qm_getc (fd, ch)
+qm_scan           313 ./qpoe/qpmacro.x   procedure qm_scan (qm, fname, flags)
+qm_scano          357 ./qpoe/qpmacro.x   procedure qm_scano (qm, fd, flags)
+qm_setdefaults    612 ./qpoe/qpmacro.x   procedure qm_setdefaults (qm, qp)
+qm_setpar         659 ./qpoe/qpmacro.x   int procedure qm_setpar (userval, defval)
+qm_setparam       520 ./qpoe/qpmacro.x   procedure qm_setparam (qm, param, valstr)
+qm_symtab         301 ./qpoe/qpmacro.x   pointer procedure qm_symtab (qm)
+qm_upddefaults    678 ./qpoe/qpmacro.x   procedure qm_upddefaults (qm, qp)
+qp_access           8 ./qpoe/qpaccess.x  int procedure qp_access (poefile, mode)
+qp_accessf          9 ./qpoe/qpaccessf.x int procedure qp_accessf (qp, param)
+qp_add             11 ./qpoe/qpadd.gx    procedure qp_add$t (qp, param, value, comment)
+qp_addb            11 ./qpoe/gen/qpaddb.x procedure qp_addb (qp, param, value, comment)
+qp_addc            11 ./qpoe/gen/qpaddc.x procedure qp_addc (qp, param, value, comment)
+qp_addd            11 ./qpoe/gen/qpaddd.x procedure qp_addd (qp, param, value, comment)
+qp_addf            13 ./qpoe/qpaddf.x    procedure qp_addf (qp, param, datatype, maxelem, comment, flags)
+qp_addi            11 ./qpoe/gen/qpaddi.x procedure qp_addi (qp, param, value, comment)
+qp_addl            11 ./qpoe/gen/qpaddl.x procedure qp_addl (qp, param, value, comment)
+qp_addr            11 ./qpoe/gen/qpaddr.x procedure qp_addr (qp, param, value, comment)
+qp_adds            11 ./qpoe/gen/qpadds.x procedure qp_adds (qp, param, value, comment)
+qp_addx            11 ./qpoe/gen/qpaddx.x procedure qp_addx (qp, param, value, comment)
+qp_arglist        621 ./qpoe/qpgettok.x  int procedure qp_arglist (gt, argbuf, maxch)
+qp_astr            12 ./qpoe/qpastr.x    procedure qp_astr (qp, param, value, comment)
+qp_bind             9 ./qpoe/qpbind.x    procedure qp_bind (qp)
+qp_cfnl           232 ./qpoe/qpgnfn.x    procedure qp_cfnl (fl)
+qp_close            7 ./qpoe/qpclose.x   procedure qp_close (qp)
+qp_closetext      584 ./qpoe/qpgettok.x  procedure qp_closetext (gt)
+qp_copy             9 ./qpoe/qpcopy.x    procedure qp_copy (o_poefile, n_poefile)
+qp_copyf           11 ./qpoe/qpcopyf.x   procedure qp_copyf (o_qp, o_param, n_qp, n_param)
+qp_ctod             9 ./qpoe/qpctod.x    int procedure qp_ctod (str, ip, dval)
+qp_ctoi            12 ./qpoe/qpctoi.x    int procedure qp_ctoi (str, ip, ival)
+qp_delete           7 ./qpoe/qpdelete.x  procedure qp_delete (poefile)
+qp_deletef         10 ./qpoe/qpdeletef.x procedure qp_deletef (qp, param)
+qp_dsym             7 ./qpoe/qpdsym.x    procedure qp_dsym (qp, out)
+qp_dtype           13 ./qpoe/qpdtype.x   int procedure qp_dtype (qp, datatype, dsym)
+qp_elementsize      7 ./qpoe/qpelsize.x  int procedure qp_elementsize (qp, datatype, reftype)
+qp_expandtext      11 ./qpoe/qpexpand.x  int procedure qp_expandtext (qp, s1, s2, maxch)
+qp_flushpar       109 ./qpoe/qpppar.x    procedure qp_flushpar (qp)
+qp_get             11 ./qpoe/qpget.gx    PIXEL procedure qp_get$t (qp, param)
+qp_getb             9 ./qpoe/qpgetb.x    bool procedure qp_getb (qp, param)
+qp_getc            11 ./qpoe/gen/qpgetc.x char procedure qp_getc (qp, param)
+qp_getd            11 ./qpoe/gen/qpgetd.x double procedure qp_getd (qp, param)
+qp_geti            11 ./qpoe/gen/qpgeti.x int procedure qp_geti (qp, param)
+qp_getl            11 ./qpoe/gen/qpgetl.x long procedure qp_getl (qp, param)
+qp_getparam        14 ./qpoe/qpgpar.x    int procedure qp_getparam (qp, param, o_pp)
+qp_getr            11 ./qpoe/gen/qpgetr.x real procedure qp_getr (qp, param)
+qp_gets            11 ./qpoe/gen/qpgets.x short procedure qp_gets (qp, param)
+qp_gettok         122 ./qpoe/qpgettok.x  int procedure qp_gettok (gt, tokbuf, maxch)
+qp_getx             9 ./qpoe/qpgetx.x    complex procedure qp_getx (qp, param)
+qp_gmsym           14 ./qpoe/qpgmsym.x   pointer procedure qp_gmsym (qp, macro, textp)
+qp_gnfn           178 ./qpoe/qpgnfn.x    int procedure qp_gnfn (fl, outstr, maxch)
+qp_gpsym           13 ./qpoe/qpgpsym.x   pointer procedure qp_gpsym (qp, param)
+qp_gstr             8 ./qpoe/qpgstr.x    int procedure qp_gstr (qp, param, outstr, maxch)
+qp_inherit          9 ./qpoe/qpinherit.x procedure qp_inherit (n_qp, o_qp, out)
+qp_lenf             9 ./qpoe/qplenf.x    int procedure qp_lenf (qp, param)
+qp_lenfnl         202 ./qpoe/qpgnfn.x    int procedure qp_lenfnl (fl)
+qp_lessthan       118 ./qpoe/qprlmerge.gx bool procedure qp_lessthan$t (x, y)
+qp_lessthand      118 ./qpoe/gen/qpexmerged.x bool procedure qp_lessthand (x, y)
+qp_lessthand      118 ./qpoe/gen/qprlmerged.x bool procedure qp_lessthand (x, y)
+qp_lessthani      118 ./qpoe/gen/qpexmergei.x bool procedure qp_lessthani (x, y)
+qp_lessthani      118 ./qpoe/gen/qprlmergei.x bool procedure qp_lessthani (x, y)
+qp_lessthanr      118 ./qpoe/gen/qpexmerger.x bool procedure qp_lessthanr (x, y)
+qp_lessthanr      118 ./qpoe/gen/qprlmerger.x bool procedure qp_lessthanr (x, y)
+qp_loadwcs         12 ./qpoe/qploadwcs.x pointer procedure qp_loadwcs (qp)
+qp_maxval         100 ./qpoe/qprlmerge.gx PIXEL procedure qp_maxval$t (x, y)
+qp_maxvald        100 ./qpoe/gen/qpexmerged.x double procedure qp_maxvald (x, y)
+qp_maxvald        100 ./qpoe/gen/qprlmerged.x double procedure qp_maxvald (x, y)
+qp_maxvali        100 ./qpoe/gen/qpexmergei.x int procedure qp_maxvali (x, y)
+qp_maxvali        100 ./qpoe/gen/qprlmergei.x int procedure qp_maxvali (x, y)
+qp_maxvalr        100 ./qpoe/gen/qpexmerger.x real procedure qp_maxvalr (x, y)
+qp_maxvalr        100 ./qpoe/gen/qprlmerger.x real procedure qp_maxvalr (x, y)
+qp_minval          82 ./qpoe/qprlmerge.gx PIXEL procedure qp_minval$t (x, y)
+qp_minvald         82 ./qpoe/gen/qpexmerged.x double procedure qp_minvald (x, y)
+qp_minvald         82 ./qpoe/gen/qprlmerged.x double procedure qp_minvald (x, y)
+qp_minvali         82 ./qpoe/gen/qpexmergei.x int procedure qp_minvali (x, y)
+qp_minvali         82 ./qpoe/gen/qprlmergei.x int procedure qp_minvali (x, y)
+qp_minvalr         82 ./qpoe/gen/qpexmerger.x real procedure qp_minvalr (x, y)
+qp_minvalr         82 ./qpoe/gen/qprlmerger.x real procedure qp_minvalr (x, y)
+qp_mkfname          8 ./qpoe/qpmkfname.x procedure qp_mkfname (poefile, extn, fname, maxch)
+qp_nexttok        535 ./qpoe/qpgettok.x  int procedure qp_nexttok (gt)
+qp_ofnl            67 ./qpoe/qpgnfn.x    pointer procedure qp_ofnl (qp, template, sort)
+qp_ofnls           39 ./qpoe/qpgnfn.x    pointer procedure qp_ofnls (qp, template)
+qp_ofnlu           53 ./qpoe/qpgnfn.x    pointer procedure qp_ofnlu (qp, template)
+qp_open            14 ./qpoe/qpopen.x    pointer procedure qp_open (poefile, mode, o_qp)
+qp_opentext        90 ./qpoe/qpgettok.x  pointer procedure qp_opentext (qp, text)
+qp_parse           12 ./qpoe/qpparse.x   procedure qp_parse (qpspec, root, sz_root, filter, sz_filter)
+qp_parsefl         20 ./qpoe/qpparsefl.x int procedure qp_parsefl (qp, fieldlist, dd)
+qp_pclose           9 ./qpoe/qppclose.x  procedure qp_pclose (fd)
+qp_popen           18 ./qpoe/qppopen.x   int procedure qp_popen (qp, param, mode, type)
+qp_pstr             8 ./qpoe/qppstr.x    procedure qp_pstr (qp, param, strval)
+qp_put             11 ./qpoe/qpput.gx    procedure qp_put$t (qp, param, value)
+qp_putb             9 ./qpoe/qpputb.x    procedure qp_putb (qp, param, value)
+qp_putc            11 ./qpoe/gen/qpputc.x procedure qp_putc (qp, param, value)
+qp_putd            11 ./qpoe/gen/qpputd.x procedure qp_putd (qp, param, value)
+qp_puti            11 ./qpoe/gen/qpputi.x procedure qp_puti (qp, param, value)
+qp_putl            11 ./qpoe/gen/qpputl.x procedure qp_putl (qp, param, value)
+qp_putparam        14 ./qpoe/qpppar.x    int procedure qp_putparam (qp, param, o_pp)
+qp_putr            11 ./qpoe/gen/qpputr.x procedure qp_putr (qp, param, value)
+qp_puts            11 ./qpoe/gen/qpputs.x procedure qp_puts (qp, param, value)
+qp_putx             9 ./qpoe/qpputx.x    procedure qp_putx (qp, param, value)
+qp_queryf          11 ./qpoe/qpqueryf.x  int procedure qp_queryf (qp, param, datatype, maxelem, comment, flags)
+qp_rawtok         389 ./qpoe/qpgettok.x  int procedure qp_rawtok (gt, outstr, maxch)
+qp_read            11 ./qpoe/qpread.x    int procedure qp_read (qp, param, buf, maxelem, first, datatype)
+qp_rebuild          8 ./qpoe/qprebuild.x procedure qp_rebuild (poefile)
+qp_rename           7 ./qpoe/qprename.x  procedure qp_rename (o_poefile, n_poefile)
+qp_renamef          9 ./qpoe/qprenamef.x procedure qp_renamef (qp, param, newname)
+qp_rlmerge         10 ./qpoe/qprlmerge.gx int procedure qp_rlmerge$t (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmerged        10 ./qpoe/gen/qpexmerged.x int procedure qp_rlmerged (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmerged        10 ./qpoe/gen/qprlmerged.x int procedure qp_rlmerged (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmergei        10 ./qpoe/gen/qpexmergei.x int procedure qp_rlmergei (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmergei        10 ./qpoe/gen/qprlmergei.x int procedure qp_rlmergei (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmerger        10 ./qpoe/gen/qpexmerger.x int procedure qp_rlmerger (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_rlmerger        10 ./qpoe/gen/qprlmerger.x int procedure qp_rlmerger (os,oe,olen, xs,xe,nx, ys,ye,ny)
+qp_savewcs          6 ./qpoe/qpsavewcs.x procedure qp_savewcs (qp, mw)
+qp_seekfnl        213 ./qpoe/qpgnfn.x    procedure qp_seekfnl (fl, pos)
+qp_seti             8 ./qpoe/qpseti.x    procedure qp_seti (qp, param, value)
+qp_sizeof          11 ./qpoe/qpsizeof.x  int procedure qp_sizeof (qp, dtype, dsym, reftype)
+qp_stati            8 ./qpoe/qpstati.x   int procedure qp_stati (qp, param)
+qp_sync             7 ./qpoe/qpsync.x    procedure qp_sync (qp)
+qp_ungettok       350 ./qpoe/qpgettok.x  procedure qp_ungettok (gt, tokbuf)
+qp_write           11 ./qpoe/qpwrite.x   procedure qp_write (qp, param, buf, nelem, first, datatype)
+qpex_attrl         24 ./qpoe/qpexattrl.gx int procedure qpex_attrl$t (ex, attribute, xs, xe, xlen)
+qpex_attrld        24 ./qpoe/gen/qpexattrld.x int procedure qpex_attrld (ex, attribute, xs, xe, xlen)
+qpex_attrli        24 ./qpoe/gen/qpexattrli.x int procedure qpex_attrli (ex, attribute, xs, xe, xlen)
+qpex_attrlr        24 ./qpoe/gen/qpexattrlr.x int procedure qpex_attrlr (ex, attribute, xs, xe, xlen)
+qpex_close          8 ./qpoe/qpexclose.x procedure qpex_close (ex)
+qpex_codegen       11 ./qpoe/qpexcode.gx int procedure qpex_codegen$t (ex, atname, assignop, expr, offset, dtype)
+qpex_codegend      11 ./qpoe/gen/qpexcoded.x int procedure qpex_codegend (ex, atname, assignop, expr, offset, dtype)
+qpex_codegeni      11 ./qpoe/gen/qpexcodei.x int procedure qpex_codegeni (ex, atname, assignop, expr, offset, dtype)
+qpex_codegenr      11 ./qpoe/gen/qpexcoder.x int procedure qpex_codegenr (ex, atname, assignop, expr, offset, dtype)
+qpex_dballoc      188 ./qpoe/qpexdata.x  pointer procedure qpex_dballoc (ex, nelem, dtype)
+qpex_dbpstr       141 ./qpoe/qpexdata.x  pointer procedure qpex_dbpstr (ex, strval)
+qpex_debug         15 ./qpoe/qpexdebug.x procedure qpex_debug (ex, out, what)
+qpex_delete        11 ./qpoe/qpexdel.x   procedure qpex_delete (ex, et_last, offset, dtype)
+qpex_evaluate      21 ./qpoe/qpexeval.x  int procedure qpex_evaluate (ex, i_ev, o_ev, nev)
+qpex_free          63 ./qpoe/qpexdata.x  procedure qpex_free (ex, pb_save, db_save)
+qpex_getattribute  16 ./qpoe/qpexgetat.x int procedure qpex_getattribute (ex, attribute, outstr, maxch)
+qpex_getfilter     10 ./qpoe/qpexgetfil.x int procedure qpex_getfilter (ex, outstr, maxch)
+qpex_mark          50 ./qpoe/qpexdata.x  procedure qpex_mark (ex, pb_save, db_save)
+qpex_modfilter     47 ./qpoe/qpexmodfil.x int procedure qpex_modfilter (ex, exprlist)
+qpex_open          14 ./qpoe/qpexopen.x  pointer procedure qpex_open (qp, expr)
+qpex_parse        103 ./qpoe/qpexparse.gx int procedure qpex_parse$t (expr, xs, xe, xlen)
+qpex_parsed       103 ./qpoe/gen/qpexparsed.x int procedure qpex_parsed (expr, xs, xe, xlen)
+qpex_parsei       103 ./qpoe/gen/qpexparsei.x int procedure qpex_parsei (expr, xs, xe, xlen)
+qpex_parser       103 ./qpoe/gen/qpexparser.x int procedure qpex_parser (expr, xs, xe, xlen)
+qpex_pbpin        115 ./qpoe/qpexdata.x  procedure qpex_pbpin (ex, opcode, arg1, arg2, arg3)
+qpex_pbpos        104 ./qpoe/qpexdata.x  pointer procedure qpex_pbpos (ex)
+qpex_refd         168 ./qpoe/qpexdata.x  int procedure qpex_refd (ex, value)
+qpex_sublist       10 ./qpoe/qpexsub.gx  int procedure qpex_sublist$t (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+qpex_sublistd      10 ./qpoe/gen/qpexsubd.x int procedure qpex_sublistd (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+qpex_sublisti      10 ./qpoe/gen/qpexsubi.x int procedure qpex_sublisti (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+qpex_sublistr      10 ./qpoe/gen/qpexsubr.x int procedure qpex_sublistr (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+qpf_access          8 ./imio/iki/qpf/qpfaccess.x procedure qpf_access (kernel, root, extn, acmode, status)
+qpf_close           9 ./imio/iki/qpf/qpfclose.x procedure qpf_close (im, status)
+qpf_copy            9 ./imio/iki/qpf/qpfcopy.x procedure qpf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+qpf_copyparams     12 ./imio/iki/qpf/qpfcopypar.x procedure qpf_copyparams (im, qp)
+qpf_delete          7 ./imio/iki/qpf/qpfdelete.x procedure qpf_delete (kernel, root, extn, status)
+qpf_open           14 ./imio/iki/qpf/qpfopen.x procedure qpf_open (kernel, im, o_im,
+qpf_opix           12 ./imio/iki/qpf/qpfopix.x procedure qpf_opix (im, status)
+qpf_rename          8 ./imio/iki/qpf/qpfrename.x procedure qpf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+qpf_updhdr          6 ./imio/iki/qpf/qpfupdhdr.x procedure qpf_updhdr (im, status)
+qpf_wattr          30 ./imio/iki/qpf/qpfwattr.x procedure qpf_wattr (qpf, im)
+qpf_wfilter         7 ./imio/iki/qpf/qpfwfilter.x procedure qpf_wfilter (qpf, im)
+qpfzcl             53 ./imio/iki/qpf/zfioqp.x procedure qpfzcl (chan, status)
+qpfzop             21 ./imio/iki/qpf/zfioqp.x procedure qpfzop (pkfn, mode, status)
+qpfzrd             67 ./imio/iki/qpf/zfioqp.x procedure qpfzrd (chan, obuf, nbytes, boffset)
+qpfzst            155 ./imio/iki/qpf/zfioqp.x procedure qpfzst (chan, param, value)
+qpfzwr            122 ./imio/iki/qpf/zfioqp.x procedure qpfzwr (chan, ibuf, nbytes, boffset)
+qpfzwt            140 ./imio/iki/qpf/zfioqp.x procedure qpfzwt (chan, status)
+qpio_close          8 ./qpoe/qpioclose.x procedure qpio_close (io)
+qpio_getevents     21 ./qpoe/qpiogetev.x int procedure qpio_getevents (io, o_ev, maskval, maxev, o_nev)
+qpio_getfilter     13 ./qpoe/qpiogetfil.x int procedure qpio_getfilter (io, outstr, maxch)
+qpio_getrange       8 ./qpoe/qpiogetrg.x int procedure qpio_getrange (io, vs, ve, maxdim)
+qpio_loadmask      14 ./qpoe/qpiolmask.x procedure qpio_loadmask (io, mask, merge)
+qpio_loadwcs        9 ./qpoe/qpiolwcs.x  pointer procedure qpio_loadwcs (io)
+qpio_mkindex       20 ./qpoe/qpiomkidx.x procedure qpio_mkindex (io, key)
+qpio_open          18 ./qpoe/qpioopen.x  pointer procedure qpio_open (qp, paramex, mode)
+qpio_parse         18 ./qpoe/qpioparse.x int procedure qpio_parse (io, expr, filter, sz_filter, mask, sz_mask)
+qpio_putevents     14 ./qpoe/qpioputev.x procedure qpio_putevents (io, i_ev, nevents)
+qpio_rbucket        8 ./qpoe/qpiorb.x    int procedure qpio_rbucket (io, evi)
+qpio_readpix       13 ./qpoe/qpiorpix.gx int procedure qpio_readpix$t (io, obuf, vs, ve, ndim, xblock, yblock)
+qpio_readpixi      13 ./qpoe/gen/qpiorpixi.x int procedure qpio_readpixi (io, obuf, vs, ve, ndim, xblock, yblock)
+qpio_readpixs      13 ./qpoe/gen/qpiorpixs.x int procedure qpio_readpixs (io, obuf, vs, ve, ndim, xblock, yblock)
+qpio_setfilter     14 ./qpoe/qpiosetfil.x procedure qpio_setfilter (io, expr)
+qpio_seti          12 ./qpoe/qpioseti.x  procedure qpio_seti (io, param, value)
+qpio_setrange       9 ./qpoe/qpiosetrg.x procedure qpio_setrange (io, vs, ve, ndim)
+qpio_stati          8 ./qpoe/qpiostati.x int procedure qpio_stati (io, param)
+qpio_sync          14 ./qpoe/qpiosync.x  procedure qpio_sync (io)
+qpio_wbucket       14 ./qpoe/qpiowb.x    procedure qpio_wbucket (io, evi)
+qsort               1 ./libc/qsort.c     qsort (base, n, size, compar)
+qsort              20 ./etc/qsort.x      procedure qsort (x, nelem, compare)
+qst                 2 ./libc/qsort.c     qst (base, maxval)
+rcursor            47 ./gio/cursor/rcursor.x int procedure rcursor (stream, outstr, maxch)
+rddata            187 ./gio/calcomp/vttest.x procedure rddata (fname, x, y, npts)
+rdukey             19 ./clio/rdukey.x    int procedure rdukey (keystr, maxch)
+read               14 ./fio/read.x       int procedure read (fd, buffer, maxchars)
+ready               9 ../unix/os/zzstrt.c ready()
+realloc             1 ./libc/realloc.c   realloc (buf, newsize)
+realloc             9 ./memdbg/realloc.x procedure realloc (ubufp, nelems, dtype)
+realloc             9 ./memio/realloc.x  procedure realloc (ubufp, nelems, dtype)
+rename             10 ./fio/rename.x     procedure rename (oldname, newname)
+reopen             15 ./fio/reopen.x     int procedure reopen (fd, mode)
+reset_scan          6 ./fmtio/resetscan.x procedure reset_scan()
+restoretx         265 ./gio/nsppkern/gktpcell.x procedure restoretx (savep, txp)
+rewind              1 ./libc/rewind.c    rewind (fp)
+rindex              1 ./libc/rindex.c    rindex (str, ch)
+rptheta4           12 ./gio/calcomp/rptheta4.x real procedure rptheta4 (p1x, p1y, p2x, p2y)
+rptheta4          297 ./gio/calcomp/vttest.x real procedure rptheta4 (p1x, p1y, p2x, p2y)
+salloc             25 ./memdbg/salloc.x  procedure salloc (output_pointer, nelem, datatype)
+salloc             25 ./memio/salloc.x   procedure salloc (output_pointer, nelem, datatype)
+savetx            225 ./gio/nsppkern/gktpcell.x procedure savetx (savep, txp)
+sbit               12 ./osb/zzdebug.x    procedure sbit()
+sbytes             19 ./gio/ncarutil/sysint/sbytes.x procedure sbytes (bufout, bufin, index, size, skip, count)
+scan               24 ./fmtio/fscan.x    int procedure scan()
+scanc               5 ./fmtio/scanc.x    procedure scanc (cval)
+scanf               1 ./libc/scanf.c     scanf (va_alist)
+scanfile          202 ./symtab/zzdebug.x procedure scanfile (fname, stp)
+seek               15 ./fio/seek.x       procedure seek (fd, offset)
+setbuf              1 ./libc/setbuf.c    setbuf (fp, buf)
+setbuffer           1 ./libc/setbuf.c    setbuffer (fp, buf, size)
+setlinebuf          1 ./libc/setbuf.c    setlinebuf (fp)
+sfree              95 ./memio/salloc.x   procedure sfree (old_sp)
+sfree              99 ./memdbg/salloc.x  procedure sfree (old_sp)
+sgc_dump          188 ./gio/stdgraph/t_showcap.x procedure sgc_dump (fd, data, nchars)
+sgch_draw         117 ./gio/stdgraph/stgdrawch.x procedure sgch_draw (mx, my)
+sgch_flush        132 ./gio/stdgraph/stgdrawch.x procedure sgch_flush()
+sgch_move         100 ./gio/stdgraph/stgdrawch.x procedure sgch_move (mx, my)
+sge_execute       198 ./gio/stdgraph/stgencode.x int procedure sge_execute (program, memory, registers)
+sge_printf        484 ./gio/stdgraph/stgencode.x procedure sge_printf (number, memory, iop, top, program, pc)
+sge_spoolesc       84 ./gio/stdgraph/stgescape.x procedure sge_spoolesc (tr, gki, fn, instruction, bp, buftop, delete_fcn)
+sge_wsenable       62 ./gio/stdgraph/stgescape.x bool procedure sge_wsenable ()
+sge_wstran         41 ./gio/stdgraph/stgescape.x procedure sge_wstran (fn, instruction, x1,y1, x2,y2)
+sgf_getchar       135 ./gio/stdgraph/stgfilter.x int procedure sgf_getchar (fd, svbuf, sp, buf, ip, maxch, nchars)
+sgf_post_filter    17 ./gio/stdgraph/stgfilter.x procedure sgf_post_filter (fd)
+sgf_ttyfilter      37 ./gio/stdgraph/stgfilter.x procedure sgf_ttyfilter (fd, buf, maxch, status)
+sgi_bcell          39 ./gio/sgikern/sgipcell.x procedure sgi_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+sgi_cancel          7 ./gio/sgikern/sgicancel.x procedure sgi_cancel (dummy)
+sgi_clear          10 ./gio/sgikern/sgiclear.x procedure sgi_clear (dummy)
+sgi_close           8 ./gio/sgikern/sgiclose.x procedure sgi_close()
+sgi_closews         9 ./gio/sgikern/sgiclws.x procedure sgi_closews (devname, n)
+sgi_color           7 ./gio/sgikern/sgicolor.x procedure sgi_color (index)
+sgi_dashline       78 ./gio/sgikern/sgipl.x procedure sgi_dashline (g_out, p, npts, ltype)
+sgi_drawchar       15 ./gio/sgikern/sgidrawch.x int procedure sgi_drawchar (ch, x, y, xsize, ysize, orien, font)
+sgi_escape          6 ./gio/sgikern/sgiescape.x procedure sgi_escape (fn, instruction, nwords)
+sgi_faset           8 ./gio/sgikern/sgifaset.x procedure sgi_faset (gki)
+sgi_fillarea        7 ./gio/sgikern/sgifa.x procedure sgi_fillarea (p, npts)
+sgi_flush           7 ./gio/sgikern/sgiflush.x procedure sgi_flush (dummy)
+sgi_font           13 ./gio/sgikern/sgifont.x procedure sgi_font (font)
+sgi_getcellarray    6 ./gio/sgikern/sgigcell.x procedure sgi_getcellarray (nx, ny, x1,y1, x2,y2)
+sgi_getseg        149 ./gio/sgikern/sgipl.x int procedure sgi_getseg (maxlen, penup, ltype)
+sgi_gstring       141 ./gio/sgikern/sgiinit.x pointer procedure sgi_gstring (cap)
+sgi_init           13 ./gio/sgikern/sgiinit.x procedure sgi_init (tty, devname)
+sgi_linetype        8 ./gio/sgikern/sgiline.x procedure sgi_linetype (index)
+sgi_mcell         122 ./gio/sgikern/sgipcell.x procedure sgi_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+sgi_open           12 ./gio/sgikern/sgiopen.x procedure sgi_open (devname, dd)
+sgi_openws         13 ./gio/sgikern/sgiopenws.x procedure sgi_openws (devname, n, mode)
+sgi_plset           9 ./gio/sgikern/sgiplset.x procedure sgi_plset (gki)
+sgi_pmset           8 ./gio/sgikern/sgipmset.x procedure sgi_pmset (gki)
+sgi_polyline       17 ./gio/sgikern/sgipl.x procedure sgi_polyline (p, npts)
+sgi_polymarker      9 ./gio/sgikern/sgipm.x procedure sgi_polymarker (p, npts)
+sgi_putcellarray   16 ./gio/sgikern/sgipcell.x procedure sgi_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+sgi_reset          12 ./gio/sgikern/sgireset.x procedure sgi_reset()
+sgi_text           21 ./gio/sgikern/sgitx.x procedure sgi_text (xc, yc, text, n)
+sgi_txset           9 ./gio/sgikern/sgitxset.x procedure sgi_txset (gki)
+sgk_close         409 ./gio/sgikern/sgk.x procedure sgk_close (fd)
+sgk_draw          587 ./gio/sgikern/sgk.x procedure sgk_draw (fd, a_x, a_y)
+sgk_flush         470 ./gio/sgikern/sgk.x procedure sgk_flush (fd)
+sgk_frame         490 ./gio/sgikern/sgk.x procedure sgk_frame (fd)
+sgk_linewidth     805 ./gio/sgikern/sgk.x procedure sgk_linewidth (fd, width)
+sgk_mkfname       841 ./gio/sgikern/sgk.x procedure sgk_mkfname (root, num, outstr, maxch)
+sgk_move          536 ./gio/sgikern/sgk.x procedure sgk_move (fd, x, y)
+sgk_open          144 ./gio/sgikern/sgk.x int procedure sgk_open (device, tty)
+sgk_vector        707 ./gio/sgikern/sgk.x procedure sgk_vector (a_x1, a_y1, a_x2, a_y2)
+sgm_execute        27 ./gio/stdgraph/stggim.x bool procedure sgm_execute (fn, gim, nwords)
+sgm_getmapping    744 ./gio/stdgraph/stggim.x procedure sgm_getmapping (gim)
+sgm_iomapread     680 ./gio/stdgraph/stggim.x procedure sgm_iomapread (gim)
+sgm_iomapwrite    641 ./gio/stdgraph/stggim.x procedure sgm_iomapwrite (gim)
+sgm_output        761 ./gio/stdgraph/stggim.x procedure sgm_output (cap, gim, nargs)
+sgm_query         797 ./gio/stdgraph/stggim.x procedure sgm_query (query_cap, gim, nargs, retval_cap, retval, nout)
+sgm_queryraster   429 ./gio/stdgraph/stggim.x procedure sgm_queryraster (gim)
+sgm_readcmap      577 ./gio/stdgraph/stggim.x procedure sgm_readcmap (gim)
+sgm_readpixels    481 ./gio/stdgraph/stggim.x procedure sgm_readpixels (gim)
+sgm_spoolesc      330 ./gio/stdgraph/stggim.x bool procedure sgm_spoolesc (tr, gki, fn, gim, bp, buftop, delete_fcn)
+sgm_winsize       408 ./gio/stdgraph/stggim.x procedure sgm_winsize (width, height)
+sgm_writecmap     540 ./gio/stdgraph/stggim.x procedure sgm_writecmap (gim)
+sgm_writepixels   445 ./gio/stdgraph/stggim.x procedure sgm_writepixels (gim)
+sgm_wsenable      311 ./gio/stdgraph/stggim.x bool procedure sgm_wsenable (enable)
+sgm_wstran        102 ./gio/stdgraph/stggim.x bool procedure sgm_wstran (fn, gim, rx1,ry1, rx2,ry2)
+sizeof              5 ./memdbg/sizeof.x  int procedure sizeof (dtype)
+sizeof              5 ./memio/sizeof.x   int procedure sizeof (dtype)
+smark              72 ./memdbg/salloc.x  procedure smark (old_sp)
+smark              72 ./memio/salloc.x   procedure smark (old_sp)
+spf_close           1 ./libc/spf.c       spf_close (fd)
+spf_open            1 ./libc/spf.c       spf_open (buf, maxch)
+sprintf             1 ./libc/sprintf.c   sprintf (va_alist)
+sprintf             8 ./fmtio/sprintf.x  procedure sprintf (outstr, maxch, format_string)
+srf_test            3 ./gio/ncarutil/tests/srftest.x procedure srf_test()
+sscan               7 ./fmtio/sscan.x    procedure sscan (str)
+sscanf              2 ./libc/scanf.c     sscanf (va_alist)
+stalloc             8 ./symtab/stalloc.x int procedure stalloc (stp, blklen)
+stclose             7 ./symtab/stclose.x procedure stclose (stp)
+stenter            10 ./symtab/stenter.x pointer procedure stenter (stp, key, u_symlen)
+stf_access          8 ./imio/iki/stf/stfaccess.x procedure stf_access (kernel, root, extn, acmode, status)
+stf_addpar         12 ./imio/iki/stf/stfaddpar.x procedure stf_addpar (im, pname, dtype, plen, pval, pno)
+stf_close          12 ./imio/iki/stf/stfclose.x procedure stf_close (im, status)
+stf_copy            9 ./imio/iki/stf/stfcopy.x procedure stf_copy (kernel, oroot, oextn, nroot, nextn, status)
+stf_copyfits       11 ./imio/iki/stf/stfcopyf.x procedure stf_copyfits (stf, spool, gpb, user)
+stf_ctype           9 ./imio/iki/stf/stfctype.x int procedure stf_ctype (card, index)
+stf_delete         10 ./imio/iki/stf/stfdelete.x procedure stf_delete (kernel, root, extn, status)
+stf_getb           26 ./imio/iki/stf/stfget.x procedure stf_getb (card, bval)
+stf_getcmt         69 ./imio/iki/stf/stfget.x procedure stf_getcmt (card, comment, maxch)
+stf_gethdrextn     10 ./imio/iki/stf/stfhextn.x procedure stf_gethdrextn (im, o_im, acmode, outstr, maxch)
+stf_geti            8 ./imio/iki/stf/stfget.x procedure stf_geti (card, ival)
+stf_gets           45 ./imio/iki/stf/stfget.x procedure stf_gets (card, outstr, maxch)
+stf_initwcs         7 ./imio/iki/stf/stfiwcs.x procedure stf_initwcs (im)
+stf_mergegpb       19 ./imio/iki/stf/stfmerge.x procedure stf_mergegpb (n_im, o_im)
+stf_mkpixfname     10 ./imio/iki/stf/stfmkpfn.x procedure stf_mkpixfname (hdr_root, hdr_extn, pixfname, maxch)
+stf_newimage       15 ./imio/iki/stf/stfnewim.x procedure stf_newimage (im)
+stf_open           11 ./imio/iki/stf/stfopen.x procedure stf_open (kernel, im, o_im,
+stf_opix           25 ./imio/iki/stf/stfopix.x procedure stf_opix (im, status)
+stf_ordergpb       11 ./imio/iki/stf/stfordgpb.x procedure stf_ordergpb (o_stf, n_stf)
+stf_rdheader       16 ./imio/iki/stf/stfrdhdr.x procedure stf_rdheader (im, group, acmode)
+stf_reblock        10 ./imio/iki/stf/stfreblk.x procedure stf_reblock (im)
+stf_rfitshdr       38 ./imio/iki/stf/stfrfits.x procedure stf_rfitshdr (im, fits, fitslen)
+stf_rgpb           17 ./imio/iki/stf/stfrgpb.x procedure stf_rgpb (im, group, acmode, datamin, datamax)
+stf_rname          12 ./imio/iki/stf/stfrename.x procedure stf_rname (kernel, oroot, oextn, nroot, nextn, status)
+stf_updhdr         10 ./imio/iki/stf/stfupdhdr.x procedure stf_updhdr (im, status)
+stf_wfitshdr       14 ./imio/iki/stf/stfwfits.x procedure stf_wfitshdr (im)
+stf_wgpb           16 ./imio/iki/stf/stfwgpb.x procedure stf_wgpb (im, group, datamin, datamax)
+stfind             12 ./symtab/stfind.x  pointer procedure stfind (stp, key)
+stfindall          10 ./symtab/stfindall.x int procedure stfindall (stp, key, symbols, max_symbols)
+stfree              9 ./symtab/stfree.x  procedure stfree (stp, marker)
+stg_cancel          8 ./gio/stdgraph/stgcancel.x procedure stg_cancel (dummy)
+stg_clear           8 ./gio/stdgraph/stgclear.x procedure stg_clear (dummy)
+stg_close          10 ./gio/stdgraph/stgclose.x procedure stg_close()
+stg_closews         9 ./gio/stdgraph/stgclws.x procedure stg_closews (devname, n)
+stg_ctrl           11 ./gio/stdgraph/stgctrl.x procedure stg_ctrl (cap)
+stg_ctrl1          42 ./gio/stdgraph/stgctrl.x procedure stg_ctrl1 (cap, arg1)
+stg_ctrl2          56 ./gio/stdgraph/stgctrl.x procedure stg_ctrl2 (cap, arg1, arg2)
+stg_ctrl3          71 ./gio/stdgraph/stgctrl.x procedure stg_ctrl3 (cap, arg1, arg2, arg3)
+stg_deactivatews   12 ./gio/stdgraph/stgdeact.x procedure stg_deactivatews (flags)
+stg_draw            8 ./gio/stdgraph/stgdraw.x procedure stg_draw (x, y)
+stg_drawchar       16 ./gio/stdgraph/stgdrawch.x procedure stg_drawchar (ch, x, y, xsize, ysize, orien, font)
+stg_encode         97 ./gio/stdgraph/stgencode.x int procedure stg_encode (program, memory, registers)
+stg_escape         21 ./gio/stdgraph/stgescape.x procedure stg_escape (fn, instruction, nwords)
+stg_faset           8 ./gio/stdgraph/stgfaset.x procedure stg_faset (gki)
+stg_fillarea        9 ./gio/stdgraph/stgfa.x procedure stg_fillarea (p, npts)
+stg_flush           7 ./gio/stdgraph/stgflush.x procedure stg_flush (dummy)
+stg_gdisab          7 ./gio/stdgraph/stggdisab.x procedure stg_gdisab()
+stg_genab           7 ./gio/stdgraph/stggenab.x procedure stg_genab()
+stg_getcellarray    6 ./gio/stdgraph/stggcell.x procedure stg_getcellarray (nx, ny, x1,y1, x2,y2)
+stg_getcursor       8 ./gio/stdgraph/stggcur.x procedure stg_getcursor (cursor)
+stg_getline       115 ./gio/stdgraph/stgrtty.x int procedure stg_getline (fd, obuf)
+stg_grstream        9 ./gio/stdgraph/stggrstr.x procedure stg_grstream (stream)
+stg_gstring       172 ./gio/stdgraph/stginit.x pointer procedure stg_gstring (cap)
+stg_init           14 ./gio/stdgraph/stginit.x procedure stg_init (tty, devname)
+stg_lockcursor     11 ./gio/stdgraph/stglkcur.x procedure stg_lockcursor (new_cursor)
+stg_move            8 ./gio/stdgraph/stgmove.x procedure stg_move (x, y)
+stg_msglen        130 ./gio/stdgraph/stgrtty.x int procedure stg_msglen (fd)
+stg_onerror         9 ./gio/stdgraph/stgonerr.x procedure stg_onerror (errcode)
+stg_onint          11 ./gio/stdgraph/stgonint.x procedure stg_onint (vex, next_handler)
+stg_open           13 ./gio/stdgraph/stgopen.x procedure stg_open (devname, dd, in, out, xres, yres, hardchar)
+stg_openws         15 ./gio/stdgraph/stgopenws.x procedure stg_openws (devname, n, mode)
+stg_output2         8 ./gio/stdgraph/stgoutput.x procedure stg_output2 (fd, program, arg1, arg2)
+stg_outstr          8 ./gio/stdgraph/stgoutstr.x procedure stg_outstr (cap, strval)
+stg_plset           9 ./gio/stdgraph/stgplset.x procedure stg_plset (gki)
+stg_pmset           8 ./gio/stdgraph/stgpmset.x procedure stg_pmset (gki)
+stg_polyline       10 ./gio/stdgraph/stgpl.x procedure stg_polyline (p, npts)
+stg_polymarker     12 ./gio/stdgraph/stgpm.x procedure stg_polymarker (p, npts)
+stg_putcellarray   15 ./gio/stdgraph/stgpcell.x procedure stg_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+stg_putline       110 ./gio/stdgraph/stgwtty.x procedure stg_putline (fd, text)
+stg_rdcursor      216 ./gio/stdgraph/stgrcur.x procedure stg_rdcursor (tty, cursor, output_rc, cn, key, sx,sy, raster, rx,ry)
+stg_reactivatews    9 ./gio/stdgraph/stgreact.x procedure stg_reactivatews (flags)
+stg_readcursor     56 ./gio/stdgraph/stgrcur.x procedure stg_readcursor (cursor, cn, key, sx, sy, raster, rx, ry)
+stg_readtty        17 ./gio/stdgraph/stgrtty.x int procedure stg_readtty (fd, obuf, maxch)
+stg_reset          11 ./gio/stdgraph/stgreset.x procedure stg_reset()
+stg_resolution     12 ./gio/stdgraph/stgres.x procedure stg_resolution (xres, yres)
+stg_setcursor       7 ./gio/stdgraph/stgscur.x procedure stg_setcursor (x, y, cursor)
+stg_text           19 ./gio/stdgraph/stgtx.x procedure stg_text (xc, yc, text, n)
+stg_txquality      10 ./gio/stdgraph/stgtxqual.x procedure stg_txquality (quality)
+stg_txset           9 ./gio/stdgraph/stgtxset.x procedure stg_txset (gki)
+stg_txsize          9 ./gio/stdgraph/stgtxsize.x int procedure stg_txsize (pksize)
+stg_unknown         6 ./gio/stdgraph/stgunkown.x procedure stg_unknown (gki)
+stg_writetty       31 ./gio/stdgraph/stgwtty.x procedure stg_writetty (fd, text, nchars)
+sthash             15 ./symtab/sthash.x  int procedure sthash (key, modulus)
+sthead              8 ./symtab/sthead.x  pointer procedure sthead (stp)
+stinfo              8 ./symtab/stinfo.x  procedure stinfo (stp, fd, verbose)
+stk_mkseg         129 ./memio/salloc.x   procedure stk_mkseg (cur_seg, sp, segment_size)
+stk_mkseg         138 ./memdbg/salloc.x  procedure stk_mkseg (cur_seg, sp, segment_size)
+stmark             11 ./symtab/stmark.x  procedure stmark (stp, marker)
+stname              8 ./symtab/stname.x  pointer procedure stname (stp, sym)
+stnext             10 ./symtab/stnext.x  pointer procedure stnext (stp, sym)
+stnsymbols          9 ./symtab/stnsym.x  int procedure stnsymbols (stp, marker)
+stopen             14 ./symtab/stopen.x  pointer procedure stopen (name, len_index, len_stab, sz_sbuf)
+stpstr             13 ./symtab/stpstr.x  int procedure stpstr (stp, str, minchars)
+strcat              1 ./libc/strcat.c    strcat (s1, s2)
+strcat              5 ./fmtio/strcat.x   procedure strcat (str, outstr, maxch)
+strclose           88 ./fio/stropen.x    procedure strclose (fd)
+strcmp              1 ./libc/strcmp.c    strcmp (s1, s2)
+strcmp              6 ./fmtio/strcmp.x   int procedure strcmp (s1, s2)
+strcpy              1 ./libc/strcpy.c    strcpy (s1, s2)
+strcpy              5 ./fmtio/strcpy.x   procedure strcpy (s1, s2, maxch)
+strdic             13 ./fmtio/strdic.x   int procedure strdic (in_str, out_str, maxchars, dict)
+strefsbuf           7 ./symtab/strefsbuf.x pointer procedure strefsbuf (stp, offset)
+strefstab           7 ./symtab/strefstab.x pointer procedure strefstab (stp, offset)
+streq               5 ./fmtio/streq.x    bool procedure streq (s1, s2)
+strestore          15 ./symtab/strestore.x pointer procedure strestore (fd)
+strge               5 ./fmtio/strge.x    bool procedure strge (s1, s2)
+strgetmode        144 ./fio/stropen.x    int procedure strgetmode (fd)
+strgt               5 ./fmtio/strgt.x    bool procedure strgt (s1, s2)
+stridx              6 ./fmtio/stridx.x   int procedure stridx (ch, str)
+stridxs             9 ./fmtio/stridxs.x  int procedure stridxs (set, str)
+strldx              6 ./fmtio/strldx.x   int procedure strldx (ch, str)
+strldxs             9 ./fmtio/strldxs.x  int procedure strldxs (set, str)
+strle               5 ./fmtio/strle.x    bool procedure strle (s1, s2)
+strlen              1 ./libc/strlen.c    strlen (s)
+strlen              5 ./fmtio/strlen.x   int procedure strlen (str)
+strlt               5 ./fmtio/strlt.x    bool procedure strlt (s1, s2)
+strlwr              7 ./fmtio/strlwr.x   procedure strlwr (a)
+strmac             22 ./fmtio/strmac.x   int procedure strmac (macro, argstr, outstr, maxch)
+strmatch           26 ./fmtio/strmatch.x int procedure strmatch (str, pat)
+strncat             1 ./libc/strncat.c   strncat (s1, s2, n)
+strncmp             1 ./libc/strncmp.c   strncmp (s1, s2, n)
+strncmp             6 ./fmtio/strncmp.x  int procedure strncmp (s1, s2, n)
+strncpy             1 ./libc/strncpy.c   strncpy (s1, s2, n)
+strne               5 ./fmtio/strne.x    bool procedure strne (s1, s2)
+stropen            22 ./fio/stropen.x    int procedure stropen (str, maxch, mode)
+strse1             41 ./fmtio/strsearch.x bool procedure strse1 (str, patstr, patlen)
+strsearch           8 ./fmtio/strsearch.x int procedure strsearch (str, patstr)
+strsetmode        125 ./fio/stropen.x    procedure strsetmode (fd, mode)
+strsrt              9 ./fmtio/strsrt.x   procedure strsrt (x, sb, nstr)
+strtbl             10 ./fmtio/strtbl.x   procedure strtbl (fd, buf, strp, nstr, first_col, last_col, maxch, ncol)
+strupr              7 ./fmtio/strupr.x   procedure strupr (str)
+stsave             12 ./symtab/stsave.x  procedure stsave (stp, fd)
+stsize              9 ./symtab/stsize.x  int procedure stsize (stp)
+stsqueeze           9 ./symtab/stsqueeze.x procedure stsqueeze (stp)
+stty_envreset     292 ./etc/sttyco.x     procedure stty_envreset (envvar, value)
+stty_getarg       456 ./etc/sttyco.x     int procedure stty_getarg (args, ip, keyw, maxkc, value, maxvc, defact, yesno)
+stty_newterm      209 ./etc/sttyco.x     procedure stty_newterm (ttin, ttout, terminal)
+stty_setsize      247 ./etc/sttyco.x     procedure stty_setsize (ttin, ttout, tty)
+stty_showterm     307 ./etc/sttyco.x     procedure stty_showterm (ttin, ttout, fd, all)
+stty_ttyinit      273 ./etc/sttyco.x     procedure stty_ttyinit (ttin, ttout, terminal)
+sttyco             89 ./etc/sttyco.x     procedure sttyco (args, ttin, ttout, outfd)
+stx_chars         481 ./gio/stdgraph/stgtx.x procedure stx_chars (tx, ch, cw, hwsz, hard, orien)
+stx_parameters    258 ./gio/nsppkern/gkttx.x procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+stx_parameters    260 ./gio/imdkern/imdtx.x procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+stx_parameters    281 ./gio/stdgraph/stgtx.x procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+stx_parameters    283 ./gio/sgikern/sgitx.x procedure stx_parameters (xc, yc, totlen, totwidth, x0, y0, dx, dy, polytext,
+stx_segment       198 ./gio/nsppkern/gkttx.x int procedure stx_segment (text, n, out, start_font)
+stx_segment       200 ./gio/imdkern/imdtx.x int procedure stx_segment (text, n, out, start_font)
+stx_segment       203 ./gio/sgikern/sgitx.x int procedure stx_segment (text, n, out, start_font, cw, totwidth)
+stx_segment       221 ./gio/stdgraph/stgtx.x int procedure stx_segment (text, n, out, start_font)
+symbol            369 ./gio/calcomp/vttest.x procedure symbol (xp, yp, size, ch, orien, nchar)
+sys_getcommand    435 ./etc/main.x       int procedure sys_getcommand (fd, cmd, taskname, arglist_offset, timeit, prtype)
+sys_getpars       590 ./etc/main.x       procedure sys_getpars (fname)
+sys_gstrarg       818 ./etc/main.x       procedure sys_gstrarg (args, ip, outstr, maxch)
+sys_mtime          13 ./etc/sysptime.x   procedure sys_mtime (save_time)
+sys_panic           6 ./etc/syspanic.x   procedure sys_panic (errcode, errmsg)
+sys_paramset      631 ./etc/main.x       procedure sys_paramset (args, ip)
+sys_ptime          25 ./etc/sysptime.x   procedure sys_ptime (fd, opstr, save_time)
+sys_redirect      701 ./etc/main.x       procedure sys_redirect (args, ip)
+sys_scanarglist   516 ./etc/main.x       procedure sys_scanarglist (cmdin, i_args)
+syserr              8 ./etc/syserr.x     procedure syserr (errcode)
+syserrs            25 ./etc/syserr.x     procedure syserrs (errcode, user_string)
+sysid              15 ./etc/sysid.x      procedure sysid (outstr, maxch)
+system              1 ./libc/system.c    system (cmd)
+t_allocate         47 ./mtio/zzdebug.x   procedure t_allocate()
+t_autograph        11 ./gio/ncarutil/tests/autograph.x procedure t_autograph()
+t_bfappend        152 ./fio/zzdebug.x    procedure t_bfappend()
+t_calcomp          14 ./gio/calcomp/t_calcomp.x procedure t_calcomp()
+t_cap              47 ./tty/zzdebug.x    procedure t_cap()
+t_clear           1581 ./qpoe/zzdebug.x   procedure t_clear()
+t_client          277 ./fio/zzdebug.x    procedure t_client()
+t_cmp             223 ./fmtio/zzdebug.x  procedure t_cmp()
+t_comp            226 ./qpoe/zzdebug.x   procedure t_comp()
+t_conran           10 ./gio/ncarutil/tests/conran.x procedure t_conran ()
+t_conraq           10 ./gio/ncarutil/tests/conraq.x procedure t_conraq ()
+t_conras           10 ./gio/ncarutil/tests/conras.x procedure t_conras ()
+t_conrec           10 ./gio/ncarutil/tests/conrec.x procedure t_conrec ()
+t_copy            188 ./fmio/zzdebug.x   procedure t_copy()
+t_countpoe        1023 ./qpoe/zzdebug.x   procedure t_countpoe()
+t_create           24 ./fmio/zzdebug.x   procedure t_create()
+t_ctowrd          303 ./fmtio/zzdebug.x  procedure t_ctowrd()
+t_dashchar          7 ./gio/ncarutil/tests/dashchar.x procedure t_dashchar()
+t_dashsmth          7 ./gio/ncarutil/tests/dashsmth.x procedure t_dashsmth()
+t_daytime         323 ./fio/zzdebug.x    procedure t_daytime()
+t_deallocate       82 ./mtio/zzdebug.x   procedure t_deallocate()
+t_debug           131 ./etc/zzdebug.x    procedure t_debug()
+t_dump              7 ./gty/zzdebug.x    procedure t_dump()
+t_dumpevl         481 ./qpoe/zzdebug.x   procedure t_dumpevl()
+t_edit            228 ./etc/zzdebug.x    procedure t_edit()
+t_efont           358 ./gio/nsppkern/zzdebug.x procedure t_efont()
+t_encode           98 ./ki/zzdebug.x     procedure t_encode()
+t_enter            52 ./fmio/zzdebug.x   procedure t_enter()
+t_eq              103 ./fmtio/zzdebug.x  procedure t_eq()
+t_expand          270 ./qpoe/zzdebug.x   procedure t_expand()
+t_extract          83 ./fmio/zzdebug.x   procedure t_extract()
+t_ezconrec         10 ./gio/ncarutil/tests/ezconrec.x procedure t_ezconrec ()
+t_ezisos           10 ./gio/ncarutil/tests/ezisosrf.x procedure t_ezisos()
+t_ezmapg           10 ./gio/ncarutil/tests/ezmapg.x procedure t_ezmapg()
+t_ezsurface        10 ./gio/ncarutil/tests/ezsurface.x procedure t_ezsurface()
+t_ezvelvect        10 ./gio/ncarutil/tests/ezvelvect.x procedure t_ezvelvect()
+t_ezytst           13 ./gio/ncarutil/tests/ezytst.x procedure t_ezytst()
+t_fcache          233 ./fmio/zzdebug.x   procedure t_fcache()
+t_find             18 ./tty/zzdebug.x    procedure t_find()
+t_float           485 ./mwcs/zzdebug.x   procedure t_float()
+t_fnl             111 ./fio/zzdebug.x    procedure t_fnl()
+t_font            330 ./gio/nsppkern/zzdebug.x procedure t_font()
+t_free            116 ./etc/zzdebug.x    procedure t_free()
+t_ge              203 ./fmtio/zzdebug.x  procedure t_ge()
+t_get              52 ./etc/zzdebug.x    procedure t_get()
+t_ggcur            12 ./gio/gki/zzdebug.x procedure t_ggcur()
+t_gkidecode         9 ./gio/stdgraph/t_gkideco.x procedure t_gkidecode()
+t_grey             95 ./gio/nsppkern/zzdebug.x procedure t_grey()
+t_grid             25 ./gio/nsppkern/zzdebug.x procedure t_grid ()
+t_gt              183 ./fmtio/zzdebug.x  procedure t_gt()
+t_hlist           431 ./qpoe/zzdebug.x   procedure t_hlist()
+t_http            368 ./fio/zzdebug.x    procedure t_http()
+t_imdkern           9 ./gio/imdkern/t_imdkern.x procedure t_imdkern()
+t_imt               7 ./imio/zzdebug.x   procedure t_imt()
+t_imtest          204 ./mwcs/zzdebug.x   procedure t_imtest()
+t_init            110 ./tty/zzdebug.x    procedure t_init()
+t_inv             332 ./mwcs/zzdebug.x   procedure t_inv()
+t_irafks           54 ./ki/irafks.x      procedure t_irafks()
+t_isosrf           10 ./gio/ncarutil/tests/isosrf.x procedure t_isosrf()
+t_le              163 ./fmtio/zzdebug.x  procedure t_le()
+t_lex              65 ./fmtio/zzdebug.x  procedure t_lex()
+t_list             89 ./etc/zzdebug.x    procedure t_list()
+t_load            453 ./mwcs/zzdebug.x   procedure t_load()
+t_lt              143 ./fmtio/zzdebug.x  procedure t_lt()
+t_many            205 ./fio/zzdebug.x    procedure t_many()
+t_mark            102 ./etc/zzdebug.x    procedure t_mark()
+t_mat             263 ./fmtio/zzdebug.x  procedure t_mat()
+t_memchk           16 ./memdbg/zzdebug.x procedure t_memchk()
+t_mergei          1460 ./qpoe/zzdebug.x   procedure t_mergei()
+t_mio             150 ./pmio/zzdebug.x   procedure t_mio()
+t_mkfile          119 ./fmio/zzdebug.x   procedure t_mkfile()
+t_mkmask           18 ./pmio/zzdebug.x   procedure t_mkmask()
+t_mkpoe           715 ./qpoe/zzdebug.x   procedure t_mkpoe()
+t_mkttydata        64 ./tty/x_mkttydata.x procedure t_mkttydata()
+t_mpp              30 ./fio/zzdebug.x    procedure t_mpp()
+t_mtcopy          313 ./mtio/zzdebug.x   procedure t_mtcopy()
+t_mtexamine       215 ./mtio/zzdebug.x   procedure t_mtexamine()
+t_mtposition      153 ./mtio/zzdebug.x   procedure t_mtposition()
+t_ncmp            243 ./fmtio/zzdebug.x  procedure t_ncmp()
+t_ne              123 ./fmtio/zzdebug.x  procedure t_ne()
+t_newcopy         390 ./qpoe/zzdebug.x   procedure t_newcopy()
+t_nsppkern          9 ./gio/nsppkern/t_nsppkern.x procedure t_nsppkern()
+t_oldauto          11 ./gio/ncarutil/tests/oldauto.x procedure t_oldauto()
+t_parsei           47 ./qpoe/zzdebug.x   procedure t_parsei()
+t_parser          106 ./qpoe/zzdebug.x   procedure t_parser()
+t_pbb              79 ./fio/zzdebug.x    procedure t_pbb()
+t_plotpoe         1304 ./qpoe/zzdebug.x   procedure t_plotpoe()
+t_pltest          131 ./plio/zzdebug.x   procedure t_pltest()
+t_pmtest          116 ./pmio/zzinterp.x  procedure t_pmtest()
+t_przs              7 ./gio/ncarutil/tests/pwrzs.x procedure t_przs()
+t_put              75 ./etc/zzdebug.x    procedure t_put()
+t_pwrity            7 ./gio/ncarutil/tests/pwrity.x procedure t_pwrity()
+t_qpparse         145 ./qpoe/zzdebug.x   procedure t_qpparse()
+t_realloc          35 ./memio/zzdebug.x  procedure t_realloc()
+t_realloc         139 ./memdbg/zzdebug.x procedure t_realloc()
+t_rebuild         202 ./fmio/zzdebug.x   procedure t_rebuild()
+t_recio           310 ./qpoe/zzdebug.x   procedure t_recio()
+t_rewind          348 ./mtio/zzdebug.x   procedure t_rewind()
+t_rexec            14 ./ki/zzdebug.x     procedure t_rexec()
+t_rread            69 ./ki/zzdebug.x     procedure t_rread()
+t_rtype            47 ./ki/zzdebug.x     procedure t_rtype()
+t_save            386 ./mwcs/zzdebug.x   procedure t_save()
+t_script          1392 ./plio/zzdebug.x   procedure t_script()
+t_seefont         194 ./gio/nsppkern/zzdebug.x procedure t_seefont()
+t_server          238 ./fio/zzdebug.x    procedure t_server()
+t_setfilt         1419 ./qpoe/zzdebug.x   procedure t_setfilt()
+t_setmask         1439 ./qpoe/zzdebug.x   procedure t_setmask()
+t_setwcs          1399 ./qpoe/zzdebug.x   procedure t_setwcs()
+t_sgidecode        13 ./gio/sgikern/t_sgideco.x procedure t_sgidecode()
+t_sgikern           9 ./gio/sgikern/t_sgikern.x procedure t_sgikern()
+t_show            171 ./fmio/zzdebug.x   procedure t_show()
+t_showcap          13 ./gio/stdgraph/t_showcap.x procedure t_showcap()
+t_simple           21 ./mwcs/zzdebug.x   procedure t_simple()
+t_slio              5 ./gio/stdgraph/zzdebug.x procedure t_slio()
+t_spawn           174 ./etc/zzdebug.x    procedure t_spawn()
+t_spool           169 ./fio/zzdebug.x    procedure t_spool()
+t_srch            283 ./fmtio/zzdebug.x  procedure t_srch()
+t_srftest           9 ./gio/ncarutil/tests/srftestd.x procedure t_srftest()
+t_status          119 ./mtio/zzdebug.x   procedure t_status()
+t_stdgraph         12 ./gio/stdgraph/t_stdgraph.x procedure t_stdgraph()
+t_strmln           10 ./gio/ncarutil/tests/strmln.x procedure t_strmln()
+t_sum               9 ./plio/zzsum.x     procedure t_sum()
+t_sum             1364 ./qpoe/zzdebug.x   procedure t_sum()
+t_surface          10 ./gio/ncarutil/tests/surface.x procedure t_surface()
+t_sym              24 ./symtab/zzdebug.x procedure t_sym()
+t_syms            416 ./qpoe/zzdebug.x   procedure t_syms()
+t_testpoe         951 ./qpoe/zzdebug.x   procedure t_testpoe()
+t_text            142 ./gio/nsppkern/zzdebug.x procedure t_text()
+t_tfilter         1107 ./qpoe/zzdebug.x   procedure t_tfilter()
+t_threed           10 ./gio/ncarutil/tests/threed.x procedure t_threed()
+t_threed2          10 ./gio/ncarutil/tests/threed2.x procedure t_threed2()
+t_tokens          164 ./qpoe/zzdebug.x   procedure t_tokens()
+t_tty             342 ./etc/zzdebug.x    procedure t_tty()
+t_txo             130 ./fio/zzdebug.x    procedure t_txo()
+t_txup            276 ./gio/nsppkern/zzdebug.x procedure t_txup()
+t_type            148 ./fmio/zzdebug.x   procedure t_type()
+t_unget            58 ./fio/zzdebug.x    procedure t_unget()
+t_velvect          10 ./gio/ncarutil/tests/velvect.x procedure t_velvect()
+t_vttest           22 ./gio/calcomp/vttest.x procedure t_vttest ()
+t_wcs              68 ./mwcs/zzdebug.x   procedure t_wcs()
+t_wtestfile       170 ./mtio/zzdebug.x   procedure t_wtestfile()
+tc_dummy_ttyload  357 ./tty/x_mkttydata.x int procedure tc_dummy_ttyload (termcap_file, devname, outstr, maxch)
+tc_init_datac     318 ./tty/x_mkttydata.x procedure tc_init_datac (fd, varname, str, nchars)
+tc_init_datai     275 ./tty/x_mkttydata.x procedure tc_init_datai (fd, varname, array, npix)
+tc_putstr         181 ./tty/x_mkttydata.x int procedure tc_putstr (tc, str)
+tc_write_data_declarations215 ./tty/x_mkttydata.x procedure tc_write_data_declarations (fd, tc, termcap_file)
+tcopy_              1 ./libc/zztest.c    tcopy_()
+testtext          393 ./gio/calcomp/vttest.x procedure testtext (gp, fname)
+testxset          469 ./gio/calcomp/vttest.x procedure testxset (format)
+tgettk_             2 ./libc/zztest.c    tgettk_()
+thello_             1 ./libc/zztest.c    thello_()
+ticks             301 ./gio/zzdebug.x    procedure ticks()
+to_short          120 ./gio/calcomp/vttest.x procedure to_short (x, y, npts, p)
+tprint_             1 ./libc/zztest.c    tprint_()
+tscan_              1 ./libc/zztest.c    tscan_()
+tsleep              6 ./etc/tsleep.x     procedure tsleep (seconds)
+ttopen             10 ./etc/ttopen.x     int procedure ttopen (terminal, mode)
+ttseti             28 ./etc/ttopen.x     procedure ttseti (fd, param, value)
+ttsets             64 ./etc/ttopen.x     procedure ttsets (fd, param, svalue)
+ttstati            45 ./etc/ttopen.x     int procedure ttstati (fd, param)
+ttstats            81 ./etc/ttopen.x     int procedure ttstats (fd, param, outstr, maxch)
+tty_binsearch     122 ./tty/ttyindex.x   int procedure tty_binsearch (capcode, t_capcode, ncaps)
+tty_break_line    293 ./tty/ttyputl.x    procedure tty_break_line (fd, tty, ostrike, op, so_type, so_seen)
+tty_continue       14 ../unix/os/zfiotx.c tty_continue (sig, code, scp)
+tty_encode_capability161 ./tty/ttyindex.x   int procedure tty_encode_capability (cap)
+tty_extract_alias 276 ./tty/ttyopen.x    int procedure tty_extract_alias (str, ip, outstr, maxch)
+tty_fetch_entry   139 ./tty/ttyopen.x    procedure tty_fetch_entry (fd, device, tty)
+tty_find_capability 88 ./tty/ttyindex.x   int procedure tty_find_capability (tty, cap, ip)
+tty_index_caps     18 ./tty/ttyindex.x   procedure tty_index_caps (tty, t_capcode, t_capindex, ncaps)
+tty_onsig          13 ../unix/os/zfiotx.c tty_onsig (sig, code, scp)
+tty_rawon          11 ../unix/os/zfiotx.c tty_rawon (port, flags)
+tty_reset          12 ../unix/os/zfiotx.c tty_reset (port)
+tty_scan_termcap_file 71 ./tty/ttyopen.x    procedure tty_scan_termcap_file (tty, termcap_file, devname)
+tty_stop           13 ../unix/os/zfiotx.c tty_stop (sig, code, scp)
+ttycaps             7 ./tty/ttycaps.x    pointer procedure ttycaps (tty)
+ttycdes             5 ./tty/ttycdes.x    procedure ttycdes (tty)
+ttyclear            8 ./tty/ttyclear.x   procedure ttyclear (fd, tty)
+ttyclearln         10 ./tty/ttyclln.x    procedure ttyclearln (fd, tty)
+ttyclose            5 ./tty/ttyclose.x   procedure ttyclose (tty)
+ttyctrl             8 ./tty/ttyctrl.x    int procedure ttyctrl (fd, tty, cap, afflncnt)
+ttydelay            9 ./tty/ttydelay.x   procedure ttydelay (fd, tty, delay)
+ttydevname         13 ./tty/ttydevnm.x   procedure ttydevname (device, ldevice, maxch)
+ttygdes            23 ./tty/ttygdes.x    pointer procedure ttygdes (ttyname)
+ttygetb             6 ./tty/ttygetb.x    bool procedure ttygetb (tty, cap)
+ttygeti             7 ./tty/ttygeti.x    int procedure ttygeti (tty, cap)
+ttygetr             9 ./tty/ttygetr.x    real procedure ttygetr (tty, cap)
+ttygets            23 ./tty/ttygets.x    int procedure ttygets (tty, cap, outstr, maxch)
+ttygoto            11 ./tty/ttygoto.x    procedure ttygoto (fd, tty, col, line)
+ttygputline       134 ./tty/ttyputl.x    procedure ttygputline (fd, tty, text, map_cc)
+ttygsize           16 ./tty/ttygsize.x   procedure ttygsize (in, out, tty, width, height)
+ttyinit            16 ./tty/ttyinit.x    procedure ttyinit (fd, tty)
+ttyload            15 ./tty/ttyload.x    int procedure ttyload (fname, device, outstr, maxch)
+ttyodes            33 ./tty/ttyodes.x    pointer procedure ttyodes (ttyname)
+ttyopen            13 ./tty/ttyopen.x    pointer procedure ttyopen (termcap_file, device, ttyload)
+ttyputline         36 ./tty/ttyputl.x    procedure ttyputline (fd, tty, text, map_cc)
+ttyputs             5 ./tty/ttyputs.x    procedure ttyputs (fd, tty, ctrlstr, afflncnt)
+ttyread            18 ./tty/ttyread.x    int procedure ttyread (fd, tty, outbuf, maxch, patbuf, timeout)
+ttyseti            11 ./tty/ttyseti.x    procedure ttyseti (tty, parameter, value)
+ttyso               5 ./tty/ttyso.x      procedure ttyso (fd, tty, onflag)
+ttystati           10 ./tty/ttystati.x   int procedure ttystati (tty, parameter)
+ttysubi            53 ./tty/ttysubi.x    int procedure ttysubi (ctrlstr, outstr, maxch, coords, ncoords)
+ttywrite           18 ./tty/ttywrite.x   procedure ttywrite (fd, tty, ctrlstr, nchars, afflncnt)
+u_allocstat         3 ../unix/os/zalloc.c u_allocstat (aliases)
+u_crackformat       4 ./libc/scanf.c     u_crackformat (format, fmt)
+u_doarg             3 ./libc/printf.c    u_doarg (fp, formspec, argp, prec, varprec, dtype)/
+u_doprnt            2 ./libc/printf.c    u_doprnt (format, argp, fp)
+u_doscan            3 ./libc/scanf.c     u_doscan (in, format, argp)
+u_scannum           5 ./libc/scanf.c     u_scannum (in, argp, fmt, eofflag)
+u_scanstr           8 ./libc/scanf.c     u_scanstr (in, argp, fmt, eofflag)
+u_setucc            7 ./libc/scanf.c     u_setucc (format, fmt)
+uid_executing       1 ../unix/os/getproc.c uid_executing (uid)
+uio_bwrite         14 ../unix/os/zfiotx.c uio_bwrite (fp, buf, nbytes)
+ungetc              1 ./libc/ungetc.c    ungetc (ch, fp)
+ungetc             20 ./fio/ungetc.x     procedure ungetc (fd, ch)
+ungetci            20 ./fio/ungetci.x    procedure ungetci (fd, ch)
+ungetline          19 ./fio/ungetline.x  procedure ungetline (fd, str)
+unread             14 ./fio/unread.x     procedure unread (fd, buf, nchars)
+urand              16 ./osb/urand.x      real procedure urand (lseed)
+vdm               374 ./gio/zzdebug.x    procedure vdm()
+vfn_decode        578 ./fio/vfntrans.x   int procedure vfn_decode (osfn, ip, outstr, maxch)
+vfn_encode        324 ./fio/vfntrans.x   procedure vfn_encode (vfn, ip, root, lenroot, extn, lenextn)
+vfn_enter         787 ./fio/vfnmap.x     int procedure vfn_enter (vfd, osfn, maxch)
+vfn_expand_ldir   141 ./fio/vfntrans.x   procedure vfn_expand_ldir (vfn, outstr, maxch)
+vfn_getosfn       870 ./fio/vfnmap.x     int procedure vfn_getosfn (vfd, vfn, osfn, maxch)
+vfn_is_hidden_file868 ./fio/vfntrans.x   int procedure vfn_is_hidden_file (fname)
+vfn_map_extension 678 ./fio/vfntrans.x   procedure vfn_map_extension (iraf_extn, os_extn, maxch)
+vfn_squeeze       842 ./fio/vfntrans.x   procedure vfn_squeeze (root, outstr, maxch)
+vfn_translate      50 ./fio/vfntrans.x   procedure vfn_translate (rawvfn, osdir, lenosdir, root, lenroot, extn, lenextn)
+vfn_unmap_extension733 ./fio/vfntrans.x   procedure vfn_unmap_extension (os_extn, iraf_extn, maxch)
+vfnadd            295 ./fio/vfnmap.x     int procedure vfnadd (vfd, osfn, maxch)
+vfnclose          502 ./fio/vfnmap.x     procedure vfnclose (vfd, update_enable)
+vfndel            332 ./fio/vfnmap.x     int procedure vfndel (vfd, osfn, maxch)
+vfnmap            211 ./fio/vfnmap.x     int procedure vfnmap (vfd, osfn, maxch)
+vfnmapu           231 ./fio/vfnmap.x     int procedure vfnmapu (vfd, osfn, maxch)
+vfnopen           134 ./fio/vfnmap.x     pointer procedure vfnopen (vfn, mode)
+vfnunmap          417 ./fio/vfnmap.x     int procedure vfnunmap (vfd, osfn, vfn, maxch)
+vmalloc            14 ./memdbg/vmalloc.x procedure vmalloc (ubufp, nelems, dtype)
+vmalloc            14 ./memio/vmalloc.x  procedure vmalloc (ubufp, nelems, dtype)
+vvfn_checksum     603 ./fio/vfnmap.x     int procedure vvfn_checksum (a, nchars)
+vvfn_escape       555 ./fio/vfntrans.x   procedure vvfn_escape (ch, outbuf, op, maxch)
+vvfn_init_extnmap 793 ./fio/vfntrans.x   procedure vvfn_init_extnmap (map, iraf, os, nextn, max_extn)
+vvfn_init_reserved_extns908 ./fio/vfntrans.x   procedure vvfn_init_reserved_extns (ex, extn, max_extn, nextn)
+vvfn_readmapfile  621 ./fio/vfnmap.x     procedure vvfn_readmapfile (vfd)
+wf_ait_fwd        286 ./mwcs/wfait.x     procedure wf_ait_fwd (fc, p, w)
+wf_ait_init        55 ./mwcs/wfait.x     procedure wf_ait_init (fc, dir)
+wf_ait_inv        395 ./mwcs/wfait.x     procedure wf_ait_inv (fc, w, p)
+wf_arc_fwd         70 ./mwcs/wfarc.x     procedure wf_arc_fwd (fc, p, w)
+wf_arc_init        35 ./mwcs/wfarc.x     procedure wf_arc_init (fc, dir)
+wf_arc_inv        129 ./mwcs/wfarc.x     procedure wf_arc_inv (fc, w, p)
+wf_car_fwd        281 ./mwcs/wfcar.x     procedure wf_car_fwd (fc, p, w)
+wf_car_init        53 ./mwcs/wfcar.x     procedure wf_car_init (fc, dir)
+wf_car_inv        372 ./mwcs/wfcar.x     procedure wf_car_inv (fc, w, p)
+wf_csc_fwd        282 ./mwcs/wfcsc.x     procedure wf_csc_fwd (fc, p, w)
+wf_csc_init        51 ./mwcs/wfcsc.x     procedure wf_csc_init (fc, dir)
+wf_csc_inv        450 ./mwcs/wfcsc.x     procedure wf_csc_inv (fc, w, p)
+wf_decaxis          9 ./mwcs/wfdecaxis.x procedure wf_decaxis (fc, ira, idec)
+wf_fnload          96 ./mwcs/wfinit.x    procedure wf_fnload (name, flags, init, destroy, fwd, inv)
+wf_gls_fwd        280 ./mwcs/wfgls.x     procedure wf_gls_fwd (fc, p, w)
+wf_gls_init        53 ./mwcs/wfgls.x     procedure wf_gls_init (fc, dir)
+wf_gls_inv        375 ./mwcs/wfgls.x     procedure wf_gls_inv (fc, w, p)
+wf_init            12 ./mwcs/wfinit.x    procedure wf_init()
+wf_mer_fwd        285 ./mwcs/wfmer.x     procedure wf_mer_fwd (fc, p, w)
+wf_mer_init        53 ./mwcs/wfmer.x     procedure wf_mer_init (fc, dir)
+wf_mer_inv        376 ./mwcs/wfmer.x     procedure wf_mer_inv (fc, w, p)
+wf_mol_fwd        286 ./mwcs/wfmol.x     procedure wf_mol_fwd (fc, p, w)
+wf_mol_init        56 ./mwcs/wfmol.x     procedure wf_mol_init (fc, dir)
+wf_mol_inv        421 ./mwcs/wfmol.x     procedure wf_mol_inv (fc, w, p)
+wf_msp_coeff      336 ./mwcs/wfmspec.x   procedure wf_msp_coeff (atval, coeff, xmin, xmax)
+wf_msp_destroy    233 ./mwcs/wfmspec.x   procedure wf_msp_destroy (fc)
+wf_msp_eval       405 ./mwcs/wfmspec.x   double procedure wf_msp_eval (coeff, xin)
+wf_msp_evali      508 ./mwcs/wfmspec.x   double procedure wf_msp_evali (coeff, y, x, dydx)
+wf_msp_fwd        257 ./mwcs/wfmspec.x   procedure wf_msp_fwd (fc, in, out)
+wf_msp_init        95 ./mwcs/wfmspec.x   procedure wf_msp_init (fc, dir)
+wf_msp_inv        292 ./mwcs/wfmspec.x   procedure wf_msp_inv (fc, in, out)
+wf_par_fwd        284 ./mwcs/wfpar.x     procedure wf_par_fwd (fc, p, w)
+wf_par_init        54 ./mwcs/wfpar.x     procedure wf_par_init (fc, dir)
+wf_par_inv        391 ./mwcs/wfpar.x     procedure wf_par_inv (fc, w, p)
+wf_pco_fwd        287 ./mwcs/wfpco.x     procedure wf_pco_fwd (fc, p, w)
+wf_pco_init        55 ./mwcs/wfpco.x     procedure wf_pco_init (fc, dir)
+wf_pco_inv        442 ./mwcs/wfpco.x     procedure wf_pco_inv (fc, w, p)
+wf_qsc_fwd        283 ./mwcs/wfqsc.x     procedure wf_qsc_fwd (fc, p, w)
+wf_qsc_init        53 ./mwcs/wfqsc.x     procedure wf_qsc_init (fc, dir)
+wf_qsc_inv        527 ./mwcs/wfqsc.x     procedure wf_qsc_inv (fc, w, p)
+wf_sin_fwd         70 ./mwcs/wfsin.x     procedure wf_sin_fwd (fc, p, w)
+wf_sin_init        35 ./mwcs/wfsin.x     procedure wf_sin_init (fc, dir)
+wf_sin_inv        122 ./mwcs/wfsin.x     procedure wf_sin_inv (fc, w, p)
+wf_smp_binsearch  180 ./mwcs/wfsamp.x    int procedure wf_smp_binsearch (x, v, npts)
+wf_smp_ctran       98 ./mwcs/wfsamp.x    procedure wf_smp_ctran (fc, a_x, a_y)
+wf_smp_init        36 ./mwcs/wfsamp.x    procedure wf_smp_init (fc, dir)
+wf_stg_fwd        161 ./mwcs/wfstg.x     procedure wf_stg_fwd (fc, p, w)
+wf_stg_init        50 ./mwcs/wfstg.x     procedure wf_stg_init (fc, dir)
+wf_stg_inv        256 ./mwcs/wfstg.x     procedure wf_stg_inv (fc, w, p)
+wf_tan_fwd         69 ./mwcs/wftan.x     procedure wf_tan_fwd (fc, p, w)
+wf_tan_init        34 ./mwcs/wftan.x     procedure wf_tan_init (fc, dir)
+wf_tan_inv        116 ./mwcs/wftan.x     procedure wf_tan_inv (fc, w, p)
+wf_tsc_fwd        281 ./mwcs/wftsc.x     procedure wf_tsc_fwd (fc, p, w)
+wf_tsc_init        53 ./mwcs/wftsc.x     procedure wf_tsc_init (fc, dir)
+wf_tsc_inv        411 ./mwcs/wftsc.x     procedure wf_tsc_inv (fc, w, p)
+wf_zea_fwd        160 ./mwcs/wfzea.x     procedure wf_zea_fwd (fc, p, w)
+wf_zea_init        48 ./mwcs/wfzea.x     procedure wf_zea_init (fc, dir)
+wf_zea_inv        259 ./mwcs/wfzea.x     procedure wf_zea_inv (fc, w, p)
+write              11 ./fio/write.x      procedure write (fd, buffer, maxchars)
+writeb             18 ./gio/nsppkern/writeb.x procedure writeb (metacode_buffer, buflen, mbunit)
+xallocate          38 ./etc/xalloc.x     int procedure xallocate (device)
+xdeallocate        74 ./etc/xalloc.x     int procedure xdeallocate (device, rewind)
+xdevowner         166 ./etc/xalloc.x     int procedure xdevowner (device, owner, maxch)
+xdevstatus        124 ./etc/xalloc.x     procedure xdevstatus (device, out)
+xer_fmterrmsg      11 ./etc/xerfmt.x     procedure xer_fmterrmsg (errmsg, outstr, maxch)
+xer_putline        12 ./etc/xerpue.x     procedure xer_putline (fd, text)
+xer_reset           9 ./etc/xerreset.x   procedure xer_reset()
+xer_send_error_statement_to_cl 19 ./etc/xerstmt.x    procedure xer_send_error_statement_to_cl (errcode)
+xer_verify         10 ./etc/xerverify.x  procedure xer_verify()
+xeract             44 ./etc/error.x      procedure xeract (error_code, message, severity)
+xerpop             25 ./etc/xerpop.x     bool procedure xerpop()
+xerpopi            41 ./etc/xerpop.x     int procedure xerpopi()
+xerpsh             10 ./etc/xerpop.x     procedure xerpsh()
+xerpstr            58 ./etc/xerstmt.x    procedure xerpstr (str)
+xerputc            13 ./fio/xerputc.x    procedure xerputc (ch)
+xev_addarg        783 ./fmtio/evexpr.x   procedure xev_addarg (arg, arglist, out)
+xev_binop         184 ./fmtio/evexpr.x   procedure xev_binop (opcode, in1, in2, out)
+xev_boolop        278 ./fmtio/evexpr.x   procedure xev_boolop (opcode, in1, in2, out)
+xev_callfcn       484 ./fmtio/evexpr.x   procedure xev_callfcn (fcn, args, nargs, out)
+xev_error         855 ./fmtio/evexpr.x   procedure xev_error (errmsg)
+xev_error1        811 ./fmtio/evexpr.x   procedure xev_error1 (fmt, arg)
+xev_error2        832 ./fmtio/evexpr.x   procedure xev_error2 (fmt, arg1, arg2)
+xev_freeop        1089 ./fmtio/evexpr.x   procedure xev_freeop (o)
+xev_gettok        868 ./fmtio/evexpr.x   int procedure xev_gettok (ip, out)
+xev_initop        1043 ./fmtio/evexpr.x   procedure xev_initop (o, o_len, o_type)
+xev_makeop        1058 ./fmtio/evexpr.x   procedure xev_makeop (o, o_len, o_type)
+xev_newtype       429 ./fmtio/evexpr.x   int procedure xev_newtype (type1, type2)
+xev_patmatch      389 ./fmtio/evexpr.x   int procedure xev_patmatch (str, pat)
+xev_quest         459 ./fmtio/evexpr.x   procedure xev_quest (cond, trueop, falseop, out)
+xev_startarglist  758 ./fmtio/evexpr.x   procedure xev_startarglist (arg, out)
+xev_unop          138 ./fmtio/evexpr.x   procedure xev_unop (opcode, in, out)
+xgdevlist          17 ./etc/xgdevlist.x  int procedure xgdevlist (device, outstr, maxch, onedev)
+xisatty             8 ./etc/xisatty.x    int procedure xisatty (fd)
+xmjbuf              8 ./etc/xmjbuf.x     procedure xmjbuf (bp)
+xonerror           74 ./etc/onerror.x    procedure xonerror (status)
+xonexit            72 ./etc/onexit.x     procedure xonexit (exit_code)
+xori                5 ./osb/xor.x        int procedure xori (a, b)
+xorl               29 ./osb/xor.x        long procedure xorl (a, b)
+xors               17 ./osb/xor.x        short procedure xors (a, b)
+xpagefiles        115 ./etc/pagefiles.x  procedure xpagefiles (files, device, prompt, first_page, clear_screen, map_cc)
+xstdexh            32 ./etc/maideh.x     procedure xstdexh (exception, next_handler)
+xtoc                6 ./fmtio/xtoc.x     int procedure xtoc (xval, outstr, maxch, decpl, fmt, width)
+xttysize           14 ./etc/xttysize.x   procedure xttysize (width, height)
+xvv_addarg        3793 ./fmtio/evvexpr.x  procedure xvv_addarg (arg, arglist, out)
+xvv_binop         389 ./fmtio/evvexpr.x  procedure xvv_binop (opcode, in1, in2, out)
+xvv_boolop        960 ./fmtio/evvexpr.x  procedure xvv_boolop (opcode, in1, in2, out)
+xvv_callfcn       1846 ./fmtio/evvexpr.x  procedure xvv_callfcn (fcn, args, nargs, out)
+xvv_chtype        4072 ./fmtio/evvexpr.x  procedure xvv_chtype (o1, o2, dtype)
+xvv_error         3867 ./fmtio/evvexpr.x  procedure xvv_error (errmsg)
+xvv_error1        3821 ./fmtio/evvexpr.x  procedure xvv_error1 (fmt, arg)
+xvv_error2        3843 ./fmtio/evvexpr.x  procedure xvv_error2 (fmt, arg1, arg2)
+xvv_freeop        4382 ./fmtio/evvexpr.x  procedure xvv_freeop (o)
+xvv_gettok        3880 ./fmtio/evvexpr.x  int procedure xvv_gettok (ip, out)
+xvv_initop        4327 ./fmtio/evvexpr.x  procedure xvv_initop (o, o_len, o_type)
+xvv_loadsymbols   4411 ./fmtio/evvexpr.x  pointer procedure xvv_loadsymbols (s)
+xvv_makeop        4342 ./fmtio/evvexpr.x  procedure xvv_makeop (o, o_len, o_type)
+xvv_newtype       1509 ./fmtio/evvexpr.x  int procedure xvv_newtype (type1, type2)
+xvv_nulld         4482 ./fmtio/evvexpr.x  double procedure xvv_nulld (ignore)
+xvv_nulli         4464 ./fmtio/evvexpr.x  int procedure xvv_nulli (ignore)
+xvv_nulll         4470 ./fmtio/evvexpr.x  long procedure xvv_nulll (ignore)
+xvv_nullr         4476 ./fmtio/evvexpr.x  real procedure xvv_nullr (ignore)
+xvv_nulls         4458 ./fmtio/evvexpr.x  short procedure xvv_nulls (ignore)
+xvv_patmatch      1469 ./fmtio/evvexpr.x  int procedure xvv_patmatch (str, pat)
+xvv_quest         1545 ./fmtio/evvexpr.x  procedure xvv_quest (cond, in1, in2, out)
+xvv_startarglist  3769 ./fmtio/evvexpr.x  procedure xvv_startarglist (arg, out)
+xvv_unop          265 ./fmtio/evvexpr.x  procedure xvv_unop (opcode, in, out)
+xwhen               5 ./etc/xwhen.x      procedure xwhen (signal, handler, old_handler)
+yyparse           1134 ./fmtio/evexpr.x   int procedure yyparse (fd, yydebug, yylex)
+yyparse           4521 ./fmtio/evvexpr.x  int procedure yyparse (fd, yydebug, yylex)
+zardmt             10 ./mtio/zardmt.x    procedure zardmt (mtchan, buf, maxbytes, offset)
+zardnu            121 ./fio/nullfile.x   procedure zardnu (chan, buf, maxbytes, loffset)
+zardps            124 ./clio/zfiocl.x    procedure zardps (ps, buf, maxbytes, offset)
+zawrmt             10 ./mtio/zawrmt.x    procedure zawrmt (mtchan, buf, nbytes, offset)
+zawrnu            136 ./fio/nullfile.x   procedure zawrnu (chan, buf, nbytes, loffset)
+zawrps            202 ./clio/zfiocl.x    procedure zawrps (ps, buf, nbytes, offset)
+zawtmt             10 ./mtio/zawtmt.x    procedure zawtmt (mtchan, status)
+zawtnu            151 ./fio/nullfile.x   procedure zawtnu (chan, status)
+zawtps            237 ./clio/zfiocl.x    procedure zawtps (ps, status)
+zclsmt             17 ./mtio/zclsmt.x    procedure zclsmt (mtchan, status)
+zclsnu             72 ./fio/nullfile.x   procedure zclsnu (chan, status)
+zclsps             88 ./clio/zfiocl.x    procedure zclsps (chan, status)
+zclstt            1209 ./fio/zfiott.x     procedure zclstt (fd, status)
+zflsnu            203 ./fio/nullfile.x   procedure zflsnu (chan, status)
+zflstt            1221 ./fio/zfiott.x     procedure zflstt (fd, status)
+zgetnu            169 ./fio/nullfile.x   procedure zgetnu (chan, buf, maxch, status)
+zgettt             47 ./fio/zfiott.x     procedure zgettt (fd, buf, maxch, status)
+zmtbsf             24 ../unix/os/zfiomt.c zmtbsf (fd, nfiles)
+zmtbsr             25 ../unix/os/zfiomt.c zmtbsr (fd, nrecords)
+zmtclose           17 ../unix/os/zfiomt.c zmtclose (fd)
+zmtdbg             28 ../unix/os/zfiomt.c zmtdbg (mp, msg)
+zmtdbg1            28 ../unix/os/zfiomt.c zmtdbg1 (mp, fmt, arg)
+zmtdbg2            29 ../unix/os/zfiomt.c zmtdbg2 (mp, fmt, arg1, arg2)
+zmtdbg3            29 ../unix/os/zfiomt.c zmtdbg3 (mp, fmt, arg1, arg2, arg3)
+zmtdbg4            29 ../unix/os/zfiomt.c zmtdbg4 (mp, fmt, arg1, arg2, arg3, arg4)
+zmtdbg5            29 ../unix/os/zfiomt.c zmtdbg5 (mp, fmt, arg1, arg2, arg3, arg4, arg5)
+zmtdbgclose        28 ../unix/os/zfiomt.c zmtdbgclose (mp)
+zmtdbgopen         26 ../unix/os/zfiomt.c zmtdbgopen (mp)
+zmtdesc            17 ../unix/os/zfiomt.c zmtdesc (device, acmode, devcap, devpos)
+zmtfls             28 ../unix/os/zfiomt.c zmtfls (mp)
+zmtfpos            20 ../unix/os/zfiomt.c zmtfpos (mp, newfile)
+zmtfree            20 ../unix/os/zfiomt.c zmtfree (mp)
+zmtfsf             24 ../unix/os/zfiomt.c zmtfsf (fd, nfiles)
+zmtfsr             24 ../unix/os/zfiomt.c zmtfsr (fd, nrecords)
+zmtgetfd           15 ../unix/os/zfiomt.c zmtgetfd (mp)
+zmtopen            16 ../unix/os/zfiomt.c zmtopen (dev, u_acmode)
+zmtrew             23 ../unix/os/zfiomt.c zmtrew (fd)
+znotnu            237 ./fio/nullfile.x   procedure znotnu (chan, loffset)
+znottt            1249 ./fio/zfiott.x     procedure znottt (fd, offset)
+zopnmt             11 ./mtio/zopnmt.x    procedure zopnmt (iodev, acmode, mtchan)
+zopnnu             26 ./fio/nullfile.x   procedure zopnnu (osfn, mode, chan)
+zopntt            1196 ./fio/zfiott.x     procedure zopntt (osfn, mode, chan)
+zputnu            186 ./fio/nullfile.x   procedure zputnu (chan, buf, nchars, status)
+zputtt            176 ./fio/zfiott.x     procedure zputtt (fd, buf, nchars, status)
+zseknu            220 ./fio/nullfile.x   procedure zseknu (chan, loffset, status)
+zsektt            1235 ./fio/zfiott.x     procedure zsektt (fd, offset, status)
+zsestt            1129 ./fio/zfiott.x     procedure zsestt (fd, param, svalue)
+zsettt            972 ./fio/zfiott.x     procedure zsettt (chan, param, value)
+zststt            1159 ./fio/zfiott.x     procedure zststt (fd, param, outstr, maxch, nchars)
+zsttmt             11 ./mtio/zsttmt.x    procedure zsttmt (mtchan, what, lvalue)
+zsttnu             93 ./fio/nullfile.x   procedure zsttnu (chan, param, lvalue)
+zsttps            252 ./clio/zfiocl.x    procedure zsttps (ps, what, lvalue)
+zstttt            1074 ./fio/zfiott.x     procedure zstttt (fd, param, lvalue)
+ztt_getchar       850 ./fio/zfiott.x     int procedure ztt_getchar (chan, ch)
+ztt_getlog        537 ./fio/zfiott.x     procedure ztt_getlog (chan, obuf, maxch, nchars)
+ztt_logdev        422 ./fio/zfiott.x     procedure ztt_logdev (chan)
+ztt_logio         238 ./fio/zfiott.x     procedure ztt_logio (inflag, outflag)
+ztt_lowercase     882 ./fio/zfiott.x     int procedure ztt_lowercase (in, out, nchars)
+ztt_pboff         400 ./fio/zfiott.x     procedure ztt_pboff (errcode)
+ztt_playback      335 ./fio/zfiott.x     procedure ztt_playback (flag)
+ztt_putlog        462 ./fio/zfiott.x     procedure ztt_putlog (chan, dstr, nchars)
+ztt_query         667 ./fio/zfiott.x     int procedure ztt_query (logtext, nchars, dtext, maxch, sz_dtext)
+ztt_ttyput        954 ./fio/zfiott.x     procedure ztt_ttyput (message)
+ztt_uppercase     934 ./fio/zfiott.x     procedure ztt_uppercase (in, out, nchars)
+zz_help           266 ./symtab/zzdebug.x procedure zz_help (fd)
diff --git a/sys/NAMES b/sys/NAMES
new file mode 100644
index 00000000..084bddf0
--- /dev/null
+++ b/sys/NAMES
@@ -0,0 +1,3884 @@
+_ev_loadcache   _ev_loadcache
+_ev_scaniraf    _ev_scaniraf
+_ev_streq       _ev_streq
+_getfile        _getfile
+_u_fmode        _u_fmode
+aabs            aabs
+aabsd           aabsd
+aabsi           aabsi
+aabsl           aabsl
+aabsr           aabsr
+aabss           aabss
+aabsx           aabsx
+aadd            aadd
+aaddd           aaddd
+aaddi           aaddi
+aaddk           aaddk
+aaddkd          aaddkd
+aaddki          aaddki
+aaddkl          aaddkl
+aaddkr          aaddkr
+aaddks          aaddks
+aaddkx          aaddkx
+aaddl           aaddl
+aaddr           aaddr
+aadds           aadds
+aaddx           aaddx
+aand            aand
+aandi           aandi
+aandk           aandk
+aandki          aandki
+aandkl          aandkl
+aandks          aandks
+aandl           aandl
+aands           aands
+aavg            aavg
+aavgd           aavgd
+aavgi           aavgi
+aavgl           aavgl
+aavgr           aavgr
+aavgs           aavgs
+aavgx           aavgx
+abav            abav
+abavd           abavd
+abavi           abavi
+abavl           abavl
+abavr           abavr
+abavs           abavs
+abavx           abavx
+abeq            abeq
+abeqc           abeqc
+abeqd           abeqd
+abeqi           abeqi
+abeqk           abeqk
+abeqkc          abeqkc
+abeqkd          abeqkd
+abeqki          abeqki
+abeqkl          abeqkl
+abeqkr          abeqkr
+abeqks          abeqks
+abeqkx          abeqkx
+abeql           abeql
+abeqr           abeqr
+abeqs           abeqs
+abeqx           abeqx
+abge            abge
+abgec           abgec
+abged           abged
+abgei           abgei
+abgek           abgek
+abgekc          abgekc
+abgekd          abgekd
+abgeki          abgeki
+abgekl          abgekl
+abgekr          abgekr
+abgeks          abgeks
+abgekx          abgekx
+abgel           abgel
+abger           abger
+abges           abges
+abgex           abgex
+abgt            abgt
+abgtc           abgtc
+abgtd           abgtd
+abgti           abgti
+abgtk           abgtk
+abgtkc          abgtkc
+abgtkd          abgtkd
+abgtki          abgtki
+abgtkl          abgtkl
+abgtkr          abgtkr
+abgtks          abgtks
+abgtkx          abgtkx
+abgtl           abgtl
+abgtr           abgtr
+abgts           abgts
+abgtx           abgtx
+able            able
+ablec           ablec
+abled           abled
+ablei           ablei
+ablek           ablek
+ablekc          ablekc
+ablekd          ablekd
+ableki          ableki
+ablekl          ablekl
+ablekr          ablekr
+ableks          ableks
+ablekx          ablekx
+ablel           ablel
+abler           abler
+ables           ables
+ablex           ablex
+ablt            ablt
+abltc           abltc
+abltd           abltd
+ablti           ablti
+abltk           abltk
+abltkc          abltkc
+abltkd          abltkd
+abltki          abltki
+abltkl          abltkl
+abltkr          abltkr
+abltks          abltks
+abltkx          abltkx
+abltl           abltl
+abltr           abltr
+ablts           ablts
+abltx           abltx
+abne            abne
+abnec           abnec
+abned           abned
+abnei           abnei
+abnek           abnek
+abnekc          abnekc
+abnekd          abnekd
+abneki          abneki
+abnekl          abnekl
+abnekr          abnekr
+abneks          abneks
+abnekx          abnekx
+abnel           abnel
+abner           abner
+abnes           abnes
+abnex           abnex
+abor            abor
+abori           abori
+abork           abork
+aborki          aborki
+aborkl          aborkl
+aborks          aborks
+aborl           aborl
+abors           abors
+absu            absu
+absud           absud
+absui           absui
+absul           absul
+absur           absur
+absus           absus
+acht            acht
+acht            acht
+achtb           achtb
+achtc           achtc
+achtcc          achtcc
+achtcd          achtcd
+achtci          achtci
+achtcl          achtcl
+achtcr          achtcr
+achtcs          achtcs
+achtcx          achtcx
+achtd           achtd
+achtdc          achtdc
+achtdd          achtdd
+achtdi          achtdi
+achtdl          achtdl
+achtdr          achtdr
+achtds          achtds
+achtdx          achtdx
+achti           achti
+achtic          achtic
+achtid          achtid
+achtii          achtii
+achtil          achtil
+achtir          achtir
+achtis          achtis
+achtix          achtix
+achtl           achtl
+achtlc          achtlc
+achtld          achtld
+achtli          achtli
+achtll          achtll
+achtlr          achtlr
+achtls          achtls
+achtlx          achtlx
+achtr           achtr
+achtrc          achtrc
+achtrd          achtrd
+achtri          achtri
+achtrl          achtrl
+achtrr          achtrr
+achtrs          achtrs
+achtrx          achtrx
+achts           achts
+achtsc          achtsc
+achtsd          achtsd
+achtsi          achtsi
+achtsl          achtsl
+achtsr          achtsr
+achtss          achtss
+achtsx          achtsx
+achtu           achtu
+achtx           achtx
+achtxc          achtxc
+achtxd          achtxd
+achtxi          achtxi
+achtxl          achtxl
+achtxr          achtxr
+achtxs          achtxs
+achtxx          achtxx
+acjgx           acjgx
+acjgx           acjgx
+aclr            aclr
+aclrc           aclrc
+aclrd           aclrd
+aclri           aclri
+aclrl           aclrl
+aclrr           aclrr
+aclrs           aclrs
+aclrx           aclrx
+acnv            acnv
+acnvd           acnvd
+acnvi           acnvi
+acnvl           acnvl
+acnvr           acnvr
+acnvr           acnvr
+acnvrd          acnvrd
+acnvri          acnvri
+acnvrl          acnvrl
+acnvrr          acnvrr
+acnvrs          acnvrs
+acnvs           acnvs
+adiv            adiv
+adivd           adivd
+adivi           adivi
+adivk           adivk
+adivkd          adivkd
+adivki          adivki
+adivkl          adivkl
+adivkr          adivkr
+adivks          adivks
+adivkx          adivkx
+adivl           adivl
+adivr           adivr
+adivs           adivs
+adivx           adivx
+adjust          adjust
+adot            adot
+adot            adot
+adotd           adotd
+adoti           adoti
+adotl           adotl
+adotr           adotr
+adots           adots
+adotx           adotx
+advz            advz
+advzd           advzd
+advzi           advzi
+advzl           advzl
+advzr           advzr
+advzs           advzs
+advzx           advzx
+aelogd          aelogd
+aelogr          aelogr
+aexp            aexp
+aexpd           aexpd
+aexpi           aexpi
+aexpk           aexpk
+aexpkd          aexpkd
+aexpki          aexpki
+aexpkl          aexpkl
+aexpkr          aexpkr
+aexpks          aexpks
+aexpkx          aexpkx
+aexpl           aexpl
+aexpr           aexpr
+aexps           aexps
+aexpx           aexpx
+afftrr          afftrr
+afftrr          afftrr
+afftrx          afftrx
+afftrx          afftrx
+afftxr          afftxr
+afftxr          afftxr
+afftxx          afftxx
+afftxx          afftxx
+aglt            aglt
+agltc           agltc
+agltd           agltd
+aglti           aglti
+agltl           agltl
+agltr           agltr
+aglts           aglts
+agltx           agltx
+ahgm            ahgm
+ahgmc           ahgmc
+ahgmd           ahgmd
+ahgmi           ahgmi
+ahgml           ahgml
+ahgmr           ahgmr
+ahgms           ahgms
+ahiv            ahiv
+ahivc           ahivc
+ahivd           ahivd
+ahivi           ahivi
+ahivl           ahivl
+ahivr           ahivr
+ahivs           ahivs
+ahivx           ahivx
+aiftrr          aiftrr
+aiftrr          aiftrr
+aiftrx          aiftrx
+aiftrx          aiftrx
+aiftxr          aiftxr
+aiftxr          aiftxr
+aiftxx          aiftxx
+aiftxx          aiftxx
+aimg            aimg
+aimgd           aimgd
+aimgi           aimgi
+aimgl           aimgl
+aimgr           aimgr
+aimgs           aimgs
+alim            alim
+alimc           alimc
+alimd           alimd
+alimi           alimi
+aliml           aliml
+alimr           alimr
+alims           alims
+alimx           alimx
+alln            alln
+allnd           allnd
+allni           allni
+allnl           allnl
+allnr           allnr
+allns           allns
+allnx           allnx
+alloc           alloc
+alog            alog
+alogd           alogd
+alogi           alogi
+alogl           alogl
+alogr           alogr
+alogs           alogs
+alogx           alogx
+alov            alov
+alovc           alovc
+alovd           alovd
+alovi           alovi
+alovl           alovl
+alovr           alovr
+alovs           alovs
+alovx           alovx
+alta            alta
+altad           altad
+altai           altai
+altal           altal
+altar           altar
+altas           altas
+altax           altax
+altm            altm
+altmd           altmd
+altmi           altmi
+altml           altml
+altmr           altmr
+altms           altms
+altmx           altmx
+altr            altr
+altrd           altrd
+altri           altri
+altrl           altrl
+altrr           altrr
+altrs           altrs
+altrx           altrx
+alui            alui
+aluid           aluid
+aluii           aluii
+aluil           aluil
+aluir           aluir
+aluis           aluis
+alut            alut
+alutc           alutc
+alutd           alutd
+aluti           aluti
+alutl           alutl
+alutr           alutr
+aluts           aluts
+amag            amag
+amagd           amagd
+amagi           amagi
+amagl           amagl
+amagr           amagr
+amags           amags
+amagx           amagx
+amap            amap
+amapd           amapd
+amapi           amapi
+amapl           amapl
+amapr           amapr
+amaps           amaps
+amax            amax
+amaxc           amaxc
+amaxd           amaxd
+amaxi           amaxi
+amaxk           amaxk
+amaxkc          amaxkc
+amaxkd          amaxkd
+amaxki          amaxki
+amaxkl          amaxkl
+amaxkr          amaxkr
+amaxks          amaxks
+amaxkx          amaxkx
+amaxl           amaxl
+amaxr           amaxr
+amaxs           amaxs
+amaxx           amaxx
+amed            amed
+amed3           amed3
+amed3c          amed3c
+amed3d          amed3d
+amed3i          amed3i
+amed3l          amed3l
+amed3r          amed3r
+amed3s          amed3s
+amed4           amed4
+amed4c          amed4c
+amed4d          amed4d
+amed4i          amed4i
+amed4l          amed4l
+amed4r          amed4r
+amed4s          amed4s
+amed5           amed5
+amed5c          amed5c
+amed5d          amed5d
+amed5i          amed5i
+amed5l          amed5l
+amed5r          amed5r
+amed5s          amed5s
+amedc           amedc
+amedd           amedd
+amedi           amedi
+amedl           amedl
+amedr           amedr
+ameds           ameds
+amedx           amedx
+amgs            amgs
+amgsd           amgsd
+amgsi           amgsi
+amgsl           amgsl
+amgsr           amgsr
+amgss           amgss
+amgsx           amgsx
+amin            amin
+aminc           aminc
+amind           amind
+amini           amini
+amink           amink
+aminkc          aminkc
+aminkd          aminkd
+aminki          aminki
+aminkl          aminkl
+aminkr          aminkr
+aminks          aminks
+aminkx          aminkx
+aminl           aminl
+aminr           aminr
+amins           amins
+aminx           aminx
+amod            amod
+amodd           amodd
+amodi           amodi
+amodk           amodk
+amodkd          amodkd
+amodki          amodki
+amodkl          amodkl
+amodkr          amodkr
+amodks          amodks
+amodl           amodl
+amodr           amodr
+amods           amods
+amov            amov
+amovc           amovc
+amovd           amovd
+amovi           amovi
+amovk           amovk
+amovkc          amovkc
+amovkd          amovkd
+amovki          amovki
+amovkl          amovkl
+amovkr          amovkr
+amovks          amovks
+amovkx          amovkx
+amovl           amovl
+amovr           amovr
+amovs           amovs
+amovx           amovx
+amul            amul
+amuld           amuld
+amuli           amuli
+amulk           amulk
+amulkd          amulkd
+amulki          amulki
+amulkl          amulkl
+amulkr          amulkr
+amulks          amulks
+amulkx          amulkx
+amull           amull
+amulr           amulr
+amuls           amuls
+amulx           amulx
+aneg            aneg
+anegd           anegd
+anegi           anegi
+anegl           anegl
+anegr           anegr
+anegs           anegs
+anegx           anegx
+anot            anot
+anoti           anoti
+anotl           anotl
+anots           anots
+apkx            apkx
+apkxd           apkxd
+apkxi           apkxi
+apkxl           apkxl
+apkxr           apkxr
+apkxs           apkxs
+apkxx           apkxx
+apol            apol
+apold           apold
+apolr           apolr
+apow            apow
+apowd           apowd
+apowi           apowi
+apowk           apowk
+apowkd          apowkd
+apowki          apowki
+apowkl          apowkl
+apowkr          apowkr
+apowks          apowks
+apowkx          apowkx
+apowl           apowl
+apowr           apowr
+apows           apows
+apowx           apowx
+arav            arav
+aravd           aravd
+aravi           aravi
+aravl           aravl
+aravr           aravr
+aravs           aravs
+aravx           aravx
+arcp            arcp
+arcpd           arcpd
+arcpi           arcpi
+arcpl           arcpl
+arcpr           arcpr
+arcps           arcps
+arcpx           arcpx
+arcz            arcz
+arczd           arczd
+arczi           arczi
+arczl           arczl
+arczr           arczr
+arczs           arczs
+arczx           arczx
+aread           aread
+areadb          areadb
+argt            argt
+argtd           argtd
+argti           argti
+argtl           argtl
+argtr           argtr
+argts           argts
+argtx           argtx
+arlt            arlt
+arltd           arltd
+arlti           arlti
+arltl           arltl
+arltr           arltr
+arlts           arlts
+arltx           arltx
+asel            asel
+aselc           aselc
+aseld           aseld
+aseli           aseli
+aselk           aselk
+aselkc          aselkc
+aselkd          aselkd
+aselki          aselki
+aselkl          aselkl
+aselkr          aselkr
+aselks          aselks
+aselkx          aselkx
+asell           asell
+aselr           aselr
+asels           asels
+aselx           aselx
+asok            asok
+asokc           asokc
+asokd           asokd
+asoki           asoki
+asokl           asokl
+asokr           asokr
+asoks           asoks
+asokx           asokx
+asqr            asqr
+asqrd           asqrd
+asqri           asqri
+asqrl           asqrl
+asqrr           asqrr
+asqrs           asqrs
+asqrx           asqrx
+asrt            asrt
+asrtc           asrtc
+asrtd           asrtd
+asrti           asrti
+asrtl           asrtl
+asrtr           asrtr
+asrts           asrts
+asrtx           asrtx
+assq            assq
+assq            assq
+assq            assq
+assqd           assqd
+assqi           assqi
+assql           assql
+assqr           assqr
+assqs           assqs
+assqx           assqx
+asub            asub
+asubd           asubd
+asubi           asubi
+asubk           asubk
+asubkd          asubkd
+asubki          asubki
+asubkl          asubkl
+asubkr          asubkr
+asubks          asubks
+asubkx          asubkx
+asubl           asubl
+asubr           asubr
+asubs           asubs
+asubx           asubx
+asum            asum
+asum            asum
+asum            asum
+asumd           asumd
+asumi           asumi
+asuml           asuml
+asumr           asumr
+asums           asums
+asumx           asumx
+aupx            aupx
+aupxd           aupxd
+aupxi           aupxi
+aupxl           aupxl
+aupxr           aupxr
+aupxs           aupxs
+aupxx           aupxx
+aveq            aveq
+aveqc           aveqc
+aveqd           aveqd
+aveqi           aveqi
+aveql           aveql
+aveqr           aveqr
+aveqs           aveqs
+aveqx           aveqx
+await           await
+awaitb          awaitb
+awritb          awriteb
+awrite          awrite
+awsu            awsu
+awsud           awsud
+awsui           awsui
+awsul           awsul
+awsur           awsur
+awsus           awsus
+awsux           awsux
+awvg            awvg
+awvgd           awvgd
+awvgi           awvgi
+awvgl           awvgl
+awvgr           awvgr
+awvgs           awvgs
+awvgx           awvgx
+axor            axor
+axori           axori
+axork           axork
+axorki          axorki
+axorkl          axorkl
+axorks          axorks
+axorl           axorl
+axors           axors
+balls           balls
+begmem          begmem
+begmem          begmem
+bfalcx          bfalcx
+bfaloc          bfaloc
+bfbsiz          bfbsiz
+bfchan          bfchan
+bfclos          bfclos
+bffill          bffill
+bfflsh          bfflsh
+bffsiz          bffsiz
+bfmode          bfmode
+bfopen          bfopen
+bfopnx          bfopnx
+bfread          bfread
+bfrseq          bfrseq
+bfseek          bfseek
+bfwrit          bfwrit
+bfwseq          bfwseq
+bitmov          bitmov
+blockt          blockit
+brktie          brktime
+btoi            btoi
+c_access        c_access
+c_allocate      c_allocate
+c_clktime       c_clktime
+c_close         c_close
+c_cnvdate       c_cnvdate
+c_cnvtime       c_cnvtime
+c_cputime       c_cputime
+c_deallocate    c_deallocate
+c_delete        c_delete
+c_devowner      c_devowner
+c_devstatus     c_devstatus
+c_envfind       c_envfind
+c_envfree       c_envfree
+c_envgb         c_envgetb
+c_envgi         c_envgeti
+c_envgs         c_envgets
+c_envlist       c_envlist
+c_envmark       c_envmark
+c_envputs       c_envputs
+c_envreset      c_envreset
+c_envscan       c_envscan
+c_erract        c_erract
+c_errcode       c_errcode
+c_errget        c_errget
+c_error         c_error
+c_fchdir        c_fchdir
+c_filbuf        c_filbuf
+c_finfo         c_finfo
+c_flsbuf        c_flsbuf
+c_flush         c_flush
+c_fmapfn        c_fmapfn
+c_fmkdir        c_fmkdir
+c_fnextn        c_fnextn
+c_fnldir        c_fnldir
+c_fnroot        c_fnroot
+c_fpathname     c_fpathname
+c_fprintf       c_fprintf
+c_fredir        c_fredir
+c_fseti         c_fseti
+c_fstati        c_fstati
+c_getpid        c_getpid
+c_getuid        c_getuid
+c_gflush        c_gflush
+c_imaccess      c_imaccess
+c_imdrcur       c_imdrcur
+c_kimapchan     c_kimapchan
+c_lexnum        c_lexnum
+c_mktemp        c_mktemp
+c_note          c_note
+c_open          c_open
+c_oscmd         c_oscmd
+c_pargb         c_pargb
+c_pargc         c_pargc
+c_pargd         c_pargd
+c_pargi         c_pargi
+c_pargl         c_pargl
+c_pargr         c_pargr
+c_pargs         c_pargs
+c_pargstr       c_pargstr
+c_prchdir       c_prchdir
+c_prcldpr       c_prcldpr
+c_prclose       c_prclose
+c_prdone        c_prdone
+c_prenvfree     c_prenvfree
+c_prenvset      c_prenvset
+c_printf        c_printf
+c_prkill        c_prkill
+c_propdpr       c_propdpr
+c_propen        c_propen
+c_prredir       c_prredir
+c_prsignal      c_prsignal
+c_prstati       c_prstati
+c_rcursor       c_rcursor
+c_rdukey        c_rdukey
+c_read          c_read
+c_rename        c_rename
+c_salloc        c_salloc
+c_seek          c_seek
+c_sfree         c_sfree
+c_smark         c_smark
+c_sppstr        c_sppstr
+c_stggetline    c_stggetline
+c_stgputline    c_stgputline
+c_stropen       c_stropen
+c_strpak        c_strpak
+c_strupk        c_strupk
+c_sttyco        c_sttyco
+c_tsleep        c_tsleep
+c_ttseti        c_ttseti
+c_ttsets        c_ttsets
+c_ttstati       c_ttstati
+c_ttstats       c_ttstats
+c_ttycdes       c_ttycdes
+c_ttycn         c_ttyclearln
+c_ttycr         c_ttyclear
+c_ttyctrl       c_ttyctrl
+c_ttygb         c_ttygetb
+c_ttygi         c_ttygeti
+c_ttygoto       c_ttygoto
+c_ttygr         c_ttygetr
+c_ttygs         c_ttygets
+c_ttyinit       c_ttyinit
+c_ttyodes       c_ttyodes
+c_ttype         c_ttyputline
+c_ttyps         c_ttyputs
+c_ttyseti       c_ttyseti
+c_ttyso         c_ttyso
+c_ttystati      c_ttystati
+c_ungetc        c_ungetc
+c_ungetline     c_ungetline
+c_vfnbrk        c_vfnbrk
+c_wmsec         c_wmsec
+c_write         c_write
+c_xgmes         c_xgmes
+c_xonerr        c_xonerr
+c_xttysize      c_xttysize
+c_xwhen         c_xwhen
+calcmr          calcmarker
+ccpcag          ccp_calcseg
+ccpcle          ccp_close
+ccpclr          ccp_clear
+ccpcls          ccp_closews
+ccpcor          ccp_color
+ccpdrg          ccp_drawseg
+ccpdrr          ccp_drawchar
+ccpese          ccp_escape
+ccpfat          ccp_faset
+ccpfia          ccp_fillarea
+ccpfot          ccp_font
+ccpint          ccp_init
+ccplie          ccp_linetype
+ccplwh          ccp_lwidth
+ccpopn          ccp_open
+ccpops          ccp_openws
+ccpplt          ccp_plset
+ccppmt          ccp_pmset
+ccppoe          ccp_polyline
+ccppor          ccp_polymarker
+ccpret          ccp_reset
+ccptet          ccp_text
+ccptxt          ccp_txset
+cctoc           cctoc
+ccxadt          ccx_addsegpt
+ccxdah          ccx_dash
+ccxgap          ccx_gap
+ccxinl          ccx_intersymbol
+ccxiny          ccx_interpoly
+ccxofs          ccx_offsets
+ccxpas          ccx_parameters
+ccxset          ccx_segment
+chdept          chdeposit
+checkm          checksum
+chfeth          chfetch
+chk_prot        chk_prot
+chrlwr          chrlwr
+chrupr          chrupr
+clargc          clargc
+clargd          clargd
+clargi          clargi
+clargr          clargr
+clccos          clc_compress
+clcenr          clc_enter
+clcfeh          clc_fetch
+clcfid          clc_find
+clcfre          clc_free
+clcint          clc_init
+clclit          clc_list
+clcloe          clclose
+clcmak          clc_mark
+clcmd           clcmd
+clcmdw          clcmdw
+clcnek          clc_newtask
+clcpst          clcpset
+clcscn          clc_scan
+clepst          clepset
+clgcur          clgcur
+clgetb          clgetb
+clgetc          clgetc
+clgetd          clgetd
+clgeti          clgeti
+clgetl          clgetl
+clgetr          clgetr
+clgets          clgets
+clgetx          clgetx
+clgfil          clgfil
+clgkey          clgkey
+clglpb          clglpb
+clglpc          clglpc
+clglpd          clglpd
+clglpi          clglpi
+clglpl          clglpl
+clglpr          clglpr
+clglps          clglps
+clglpx          clglpx
+clglsr          clglstr
+clgpsa          clgpseta
+clgpsb          clgpsetb
+clgpsc          clgpsetc
+clgpsd          clgpsetd
+clgpsi          clgpseti
+clgpsl          clgpsetl
+clgpsr          clgpsetr
+clgpss          clgpsets
+clgpst          clgpset
+clgpsx          clgpsetx
+clgstr          clgstr
+clgwrd          clgwrd
+clinis          cl_initargs
+clktie          clktime
+cllpst          cllpset
+clnarg          clnarg
+clopen          clopen
+clopst          clopset
+clpcls          clpcls
+clplen          clplen
+clpopi          clpopni
+clpops          clpopns
+clpopu          clpopnu
+clppsa          clppseta
+clppsb          clppsetb
+clppsc          clppsetc
+clppsd          clppsetd
+clppsi          clppseti
+clppsl          clppsetl
+clppsr          clppsetr
+clppss          clppsets
+clppst          clppset
+clppsx          clppsetx
+clprew          clprew
+clprif          clprintf
+clpsee          clpset_parname
+clpsit          cl_psio_request
+clpstr          clpstr
+clputb          clputb
+clputc          clputc
+clputd          clputd
+clputi          clputi
+clputl          clputl
+clputr          clputr
+clputs          clputs
+clputx          clputx
+clrawc          clrawc
+clreqr          clreqpar
+clscan          clscan
+clseti          clseti
+clstai          clstati
+cnvdae          cnvdate
+cnvtie          cnvtime
+coerce          coerce
+coerce          coerce
+convtt          conv_test
+convtt          conv_test
+cputie          cputime
+ctocc           ctocc
+ctod            ctod
+ctoi            ctoi
+ctol            ctol
+ctor            ctor
+ctotok          ctotok
+ctowrd          ctowrd
+ctox            ctox
+d_compar        d_compar
+d_qsort         d_qsort
+d_qst           d_qst
+dbgmsg          dbgmsg
+dbgmsg1         dbgmsg1
+dbgmsg2         dbgmsg2
+dbgmsg3         dbgmsg3
+dbgmsg4         dbgmsg4
+dealloc         dealloc
+deletg          deletefg
+diropn          diropen
+dtcscl          dtcscl
+dtoc            dtoc
+dtoc3           dtoc3
+dumpcs          dump_chars
+elogd           elogd
+elogr           elogr
+envdeg          envdebug
+envfid          envfind
+envfit          env_first
+envfre          envfree
+envgeb          envgetb
+envged          envgetd
+envgei          envgeti
+envger          envgetr
+envges          envgets
+envinr          envindir
+envint          env_init
+envlit          envlist
+envmak          envmark
+envnet          env_next
+envpus          envputs
+envret          envreset
+envscn          envscan
+eprinf          eprintf
+erract          erract
+errcoe          errcode
+errget          errget
+evexpr          evexpr
+evvexr          evvexpr
+evvfre          evvfree
+ex_handler      ex_handler
+fakepc          fakepc
+falloc          falloc
+fcanpb          fcanpb
+fcldir          fcldir
+fclobr          fclobber
+fcopy           fcopy
+fcopyo          fcopyo
+fdebug          fdebug
+fdevbf          fdevbf
+fdevbk          fdevblk
+fdevtx          fdevtx
+fdirne          fdirname
+fencd           fencd
+fencd           fencd
+fexbuf          fexbuf
+ffault          ffault
+ffilbf          ffilbf
+ffilsz          ffilsz
+ffldir          ffldir
+fflsbf          fflsbf
+fgdev0          fgdev0
+fgdevm          fgdev_param
+fgetfd          fgetfd
+fgtdir          fgtdir
+filbuf          filbuf
+filerr          filerr
+filopn          filopn
+findsfs         findsfs
+finfo           finfo
+finit           finit
+fioclp          fio_cleanup
+fioqfh          fio_qflush
+fixmem          fixmem
+fixmem          fixmem
+flsbuf          flsbuf
+fmaccs          fm_access
+fmapfn          fmapfn
+fmcloe          fm_close
+fmcopo          fm_copyo
+fmcopy          fm_copy
+fmdebg          fm_debug
+fmdele          fm_delete
+fmfcdg          fm_fcdebug
+fmfcfe          fm_fcfree
+fmfcit          fm_fcinit
+fmfcsc          fm_fcsync
+fmfinf          fm_findlf
+fmfopn          fm_fopen
+fmgetd          fm_getfd
+fmiobd          fmio_bind
+fmioed          fmio_extend
+fmioek          fmio_errchk
+fmiopr          fmio_posterr
+fmiorr          fmio_readheader
+fmiosf          fmio_setbuf
+fmiotk          fmio_tick
+fmkbfs          fmkbfs
+fmkcoy          fmkcopy
+fmkdir          fmkdir
+fmkpbf          fmkpbbuf
+fmlfad          fm_lfaread
+fmlfae          fm_lfawrite
+fmlfat          fm_lfawait
+fmlfbd          fm_lfbinread
+fmlfbe          fm_lfbinwrite
+fmlfbt          fm_lfbinwait
+fmlfce          fm_lfclose
+fmlfcy          fm_lfcopy
+fmlfde          fm_lfdelete
+fmlfne          fm_lfname
+fmlfon          fm_lfopen
+fmlfpe          fm_lfparse
+fmlfsi          fm_lfstati
+fmlfst          fm_lfstat
+fmlfue          fm_lfundelete
+fmlocd          fm_locked
+fmloct          fm_lockout
+fmnexe          fm_nextlfile
+fmopen          fm_open
+fmrebd          fm_rebuild
+fmrene          fm_rename
+fmretd          fm_retfd
+fmseti          fm_seti
+fmstai          fm_stati
+fmsync          fm_sync
+fmterr          fmt_err
+fmtint          fmt_init
+fmtred          fmt_read
+fmtsel          fmt_setcol
+fmtstr          fmtstr
+fmunlk          fm_unlock
+fnextn          fnextn
+fnldir          fnldir
+fnroot          fnroot
+fntclb          fntclsb
+fntcls          fntcls
+fntdir          fntdir
+fntedt          fnt_edit
+fntget          fnt_getpat
+fntgfb          fntgfnb
+fntgfn          fntgfn
+fntleb          fntlenb
+fntmkt          fnt_mkpat
+fntopb          fntopnb
+fntopn          fntopn
+fntopt          fnt_open_list
+fntreb          fntrewb
+fntree          fnt_read_template
+fntrfb          fntrfnb
+fnulle          fnullfile
+fopdir          fopdir
+fopnbf          fopnbf
+fopntx          fopntx
+fowner          fowner
+fpathe          fpathname
+fpequd          fp_equald
+fpequr          fp_equalr
+fpfixd          fp_fixd
+fpfixr          fp_fixr
+fpnonr          fp_nondegenr
+fpnord          fp_normd
+fpnorr          fp_normr
+fpradv          fpradv
+fprfmt          fprfmt
+fprinf          fprintf
+fprntf          fprntf
+fptdir          fptdir
+fputtx          fputtx
+freadp          freadp
+fredio          frediro
+fredir          fredir
+frenae          frename
+frmbfs          frmbfs
+frmtmp          frmtmp
+frtnfd          frtnfd
+fsetev          fset_env
+fsetfd          fsetfd
+fseti           fseti
+fsfdee          fsfdelete
+fsfgee          fsf_getfname
+fsfopn          fsfopen
+fskdir          fskdir
+fstati          fstati
+fstatl          fstatl
+fstats          fstats
+fstdfe          fstdfile
+fstdir          fstdir
+fstrfp          fstrfp
+fsvtfn          fsvtfn
+fswapd          fswapfd
+fulib           fulib
+fulib           fulib
+fwatio          fwatio
+fwritp          fwritep
+fwtacc          fwtacc
+fxfacp          fxf_accum_bufp
+fxfacs          fxf_access
+fxfact          fxf_accum_buft
+fxfadr          fxf_addpar
+fxfakb          fxf_akwb
+fxfakc          fxf_akwc
+fxfakd          fxf_akwd
+fxfaki          fxf_akwi
+fxfakr          fxf_akwr
+fxfalc          fxf_alloc
+fxfald          fxf_altmd
+fxfalr          fxf_altmr
+fxfalu          fxf_altmu
+fxfbls          fxf_blank_lines
+fxfbyt          fxf_byte_short
+fxfche          fxf_check_old_name561
+fxfchm          fxf_chk_ndim
+fxfchp          fxf_check_group
+fxfchv          fxf_check_dup_extnv507
+fxfcle          fxf_close
+fxfcoy          fxf_copy
+fxfcte          fxf_ctype
+fxfdae          fxf_date2limtime
+fxfdee          fxf_delete
+fxfdiw          fxf_discard_keyw
+fxfdur          fxf_dummy_header
+fxfenb          fxf_encodeb
+fxfenc          fxf_encodec
+fxfend          fxf_encoded
+fxfene          fxf_encode_date
+fxfeni          fxf_encodei
+fxfenl          fxf_encodel
+fxfenr          fxf_encoder
+fxfens          fxf_encode_axis
+fxfexr          fxf_extnv_error
+fxffac          fxf_falloc
+fxffcr          fxf_fclobber
+fxffiw          fxf_filter_keyw
+fxffog          fxf_form_messg
+fxffpd          fxf_fpl_equald
+fxfgas          fxf_gaccess
+fxfgeb          fxf_getb
+fxfged          fxf_getd
+fxfgei          fxf_geti
+fxfgen          fxf_gethdrextn
+fxfger          fxf_getr
+fxfget          fxf_getcmt
+fxfglm          fxf_gltm
+fxfgsr          fxf_gstr
+fxfhdt          fxf_hdr_offset
+fxfhee          fxf_header_size
+fxfhef          fxf_header_diff
+fxfint          fxf_init
+fxfisk          fxf_is_blank
+fxfkse          fxf_ks_gvalue
+fxfksl          fxf_ks_val
+fxfksm          fxf_ks_pm
+fxfksn          fxf_ksection
+fxfkss          fxf_ks_errors
+fxfkst          fxf_ksinit
+fxfksx          fxf_ks_lex
+fxflor          fxf_load_header
+fxfmad          fxf_make_card
+fxfmar          fxf_match_str
+fxfmas          fxf_mandatory_cards461
+fxfmay          fxf_make_adj_copy
+fxfmea          fxf_merge_w_ua
+fxfnul          fxf_null
+fxfopn          fxf_open
+fxfopx          fxf_opix
+fxfove          fxf_over_delete
+fxfovt          fxf_overwrite_unit549
+fxfpaa          fxf_pak_data
+fxfprr          fxf_prhdr
+fxfred          fxf_read_card
+fxfree          fxf_rename
+fxfrek          fxf_reblock
+fxfren          fxf_read_xtn
+fxfrep          fxf_ren_tmp
+fxfrfr          fxf_rfitshdr
+fxfrhr          fxf_rheader
+fxfsee          fxf_set_cache_time844
+fxfsex          fxf_setbitpix
+fxfskn          fxf_skip_xtn
+fxfstr          fxf_strcmp_lwr
+fxftox          fxf_totpix
+fxfuad          fxf_ua_card
+fxfuna          fxf_unpack_data
+fxfupd          fxf_update_extend
+fxfupr          fxf_updhdr
+fxfwrr          fxf_write_header
+fxfwrs          fxf_write_blanks
+fxfzcl          fxfzcl
+fxfzop          fxfzop
+fxfzrd          fxfzrd
+fxfzst          fxfzst
+fxfzwr          fxfzwr
+fxfzwt          fxfzwt
+gactie          gactivate
+gacwk           gacwk
+gadraw          gadraw
+gamove          gamove
+gargb           gargb
+gargc           gargc
+gargd           gargd
+gargi           gargi
+gargl           gargl
+gargr           gargr
+gargrd          gargrad
+gargs           gargs
+gargsr          gargstr
+gargtk          gargtok
+gargwd          gargwrd
+gargx           gargx
+gascae          gascale
+gaxdrw          gax_draw
+gaxfis          gax_findticks
+gaxflh          gax_flush
+gaxndc          gax_ndc
+gaxstt          gax_start
+gaxtet          gax_text
+gaxtik          gax_tick
+gbytes          gbytes
+gca             gca
+gcancl          gcancel
+gcas            gcas
+gclear          gclear
+gclks           gclks
+gclose          gclose
+gclrwk          gclrwk
+gclwk           gclwk
+gctod           gctod
+gctol           gctol
+gctox           gctox
+gctran          gctran
+gcurps          gcurpos
+gdawk           gdawk
+gdeace          gdeactivate
+gdrwch          gdrwch
+gescae          gescape
+get_processtable get_processtable
+get_timezone    get_timezone
+getci           getci
+gethot          gethost
+getlie          getline
+getlle          getlline
+getloe          getlongline
+getstr          getstr
+gettok          gettok
+gexflr          gexfls_clear
+gexfls          gexfls
+gexflt          gexfls_set
+gfa             gfa
+gfill           gfill
+gflush          gflush
+gframe          gframe
+gfrint          gfrinit
+ggcell          ggcell
+ggcur           ggcur
+ggetb           ggetb
+ggeti           ggeti
+ggetr           ggetr
+ggets           ggets
+ggscae          ggscale
+ggview          ggview
+ggwind          ggwind
+gimcor          gim_copyraster
+gimcrr          gim_createraster
+gimder          gim_destroyraster
+gimdig          gim_disablemapping
+gimeng          gim_enablemapping
+gimfrg          gim_freemapping
+gimfrp          gim_freecolormap
+gimgeg          gim_getmapping
+gimins          gim_initmappings
+gimiod          gim_iomapread
+gimioe          gim_iomapwrite
+gimlop          gim_loadcolormap
+gimqur          gim_queryraster
+gimrat          gim_rasterinit
+gimreg          gim_refreshmapping
+gimrep          gim_readcolormap
+gimres          gim_readpixels
+gimrex          gim_refreshpix
+gimseg          gim_setmapping
+gimser          gim_setraster
+gimsex          gim_setpix
+gimwrp          gim_writecolormap
+gimwrs          gim_writepixels
+giotr           giotr
+giotrt          giotr_onint
+gkical          gki_cancel
+gkiclr          gki_clear
+gkicls          gki_closews
+gkides          gki_deactivatews
+gkieof          gki_eof
+gkiese          gki_escape
+gkiexe          gki_execute
+gkifat          gki_faset
+gkifen          gki_fetch_next_instruction
+gkiffh          gki_fflush
+gkifia          gki_fillarea
+gkiflh          gki_flush
+gkiger          gki_getcursor
+gkiges          gki_getwcs
+gkigey          gki_getcellarray
+gkiinl          gki_inline_kernel
+gkiint          gki_init
+gkimfe          gki_mftitle
+gkiops          gki_openws
+gkiplt          gki_plset
+gkipmt          gki_pmset
+gkipoe          gki_polyline
+gkipor          gki_polymarker
+gkipuy          gki_putcellarray
+gkiree          gki_retcursorvalue
+gkirer          gki_redir
+gkires          gki_reactivatews
+gkirey          gki_retcellarray
+gkiser          gki_setcursor
+gkises          gki_setwcs
+gkisul          gki_subkernel
+gkitet          gki_text
+gkitxt          gki_txset
+gkiwee          gki_wescape
+gkiwre          gki_write
+gkpcal          gkp_cancel
+gkpcle          gkp_close
+gkpclr          gkp_clear
+gkpcls          gkp_closews
+gkpdes          gkp_deactivatews
+gkpdup          gkp_dump
+gkpese          gkp_escape
+gkpfat          gkp_faset
+gkpfia          gkp_fillarea
+gkpflh          gkp_flush
+gkpger          gkp_getcursor
+gkpges          gkp_getwcs
+gkpgey          gkp_getcellarray
+gkpgrm          gkp_grstream
+gkpinl          gkp_install
+gkpmfe          gkp_mftitle
+gkpops          gkp_openws
+gkpplt          gkp_plset
+gkppmt          gkp_pmset
+gkppoe          gkp_polyline
+gkppor          gkp_polymarker
+gkppst          gkp_pstat
+gkppuy          gkp_putcellarray
+gkpres          gkp_reactivatews
+gkpser          gkp_setcursor
+gkpses          gkp_setwcs
+gkptet          gkp_text
+gkptxg          gkp_txparg
+gkptxt          gkp_txset
+gkpunn          gkp_unknown
+gktcal          gkt_cancel
+gktcle          gkt_close
+gktclr          gkt_clear
+gktcls          gkt_closews
+gktcor          gkt_color
+gktdrr          gkt_drawchar
+gktese          gkt_escape
+gktfat          gkt_faset
+gktfia          gkt_fillarea
+gktflh          gkt_flush
+gktfot          gkt_font
+gktgey          gkt_getcellarray
+gktgsg          gkt_gstring
+gktint          gkt_init
+gktlie          gkt_linetype
+gktmfn          gkt_mfopen
+gktopn          gkt_open
+gktops          gkt_openws
+gktplt          gkt_plset
+gktpmt          gkt_pmset
+gktpoe          gkt_polyline
+gktpor          gkt_polymarker
+gktpuy          gkt_putcellarray
+gktret          gkt_reset
+gkttet          gkt_text
+gkttxt          gkt_txset
+glabax          glabax
+glbdrd          glb_drawgrid
+glbene          glb_encode
+glbeq           glb_eq
+glbfis          glb_find_ticks
+glbgek          glb_gettick
+glblas          glb_label_axis
+glblob          glb_loglab
+glbmip          glb_minorstep
+glbple          glb_plot_title
+glbsep          glb_setup
+glbses          glb_set_axes
+glbset          glb_set_viewport
+glbtin          glb_ticklen
+glbveg          glb_verify_log_scaling
+gline           gline
+gltoc           gltoc
+gmark           gmark
+gmftie          gmftitle
+gmprif          gmprintf
+gmsg            gmsg
+gmsgb           gmsgb
+gmsgc           gmsgc
+gmsgd           gmsgd
+gmsgi           gmsgi
+gmsgl           gmsgl
+gmsgr           gmsgr
+gmsgs           gmsgs
+gmsgx           gmsgx
+gmt_to_lst      gmt_to_lst
+gopen           gopen
+gopeni          gopenui
+gopks           gopks
+gopwk           gopwk
+gpagee          gpagefile
+gpatme          gpatmake
+gpatmh          gpatmatch
+gpcell          gpcell
+gpl             gpl
+gplcae          gpl_cache
+gplcal          gpl_cancel
+gplclb          gpl_clipb
+gplcll          gpl_clipl
+gplclr          gpl_clipr
+gplclt          gpl_clipt
+gplflh          gpl_flush
+gpline          gpline
+gploto          gploto
+gplotv          gplotv
+gplret          gpl_reset
+gplsee          gpl_settype
+gplwci          gpl_wcstogki
+gpm             gpm
+gpmark          gpmark
+gptclb          gpt_clipb
+gptcll          gpt_clipl
+gptclr          gpt_clipr
+gptclt          gpt_clipt
+gptfit          gpt_firstpt
+gptflh          gpt_flush
+gqasf           gqasf
+gqchh           gqchh
+gqchup          gqchup
+gqclip          gqclip
+gqcntn          gqcntn
+gqmk            gqmk
+gqnt            gqnt
+gqopwk          gqopwk
+gqplci          gqplci
+gqpmci          gqpmci
+gqpmi           gqpmi
+gqsort          gqsort
+gqtxal          gqtxal
+gqtxci          gqtxci
+gqtxp           gqtxp
+gqvery          gqverify
+gqwks           gqwks
+grcaxs          grc_axes
+grcbol          grc_boolval
+grccle          grc_close
+grccod          grc_command
+grccur          grc_cursor
+grcint          grc_init
+grckes          grc_keys
+grcmay          grc_mapkey
+grcmee          grc_message
+grcndr          grc_ndctoscr
+grcnds          grc_ndctowcs
+grcopn          grc_open
+grcpcr          grc_pcursor
+grcpoe          grc_polyline
+grcred          grc_read
+grcrel          grc_realval
+grcres          grc_restorecurpos
+grcrew          grc_redraw
+grcrey          grc_readtty
+grcscc          grc_scrtondc
+grcscs          grc_scrtowcs
+grcsen          grc_settran
+grcses          grc_selectwcs
+grcsts          grc_status
+grctet          grc_text
+grcvit          grc_viewport
+grcwan          grc_warn
+grcwcc          grc_wcstondc
+grcwod          grc_word
+grcwre          grc_write
+grdraw          grdraw
+grdwcs          grdwcs
+greace          greactivate
+greset          greset
+grmove          grmove
+grscae          grscale
+gsasf           gsasf
+gsawi           gsawi
+gsawr           gsawr
+gscan           gscan
+gschh           gschh
+gschup          gschup
+gsclip          gsclip
+gscr            gscr
+gscur           gscur
+gselnt          gselnt
+gseti           gseti
+gsetr           gsetr
+gsets           gsets
+gsfaci          gsfaci
+gsfais          gsfais
+gslwsc          gslwsc
+gsmk            gsmk
+gsmksc          gsmksc
+gsplci          gsplci
+gspmci          gspmci
+gspmi           gspmi
+gstati          gstati
+gstatr          gstatr
+gstats          gstats
+gstrct          gstrcat
+gstrcy          gstrcpy
+gstrmh          gstrmatch
+gstsei          gst_set_attribute_i247
+gstser          gst_set_attribute_r264
+gstxal          gstxal
+gstxci          gstxci
+gstxp           gstxp
+gsview          gsview
+gsvp            gsvp
+gswind          gswind
+gswn            gswn
+gtdise          gt_distance
+gtdise          gt_distance
+gtext           gtext
+gtick           gtick
+gtickr          gtickr
+gtliny          gt_linearity
+gtliny          gt_linearity
+gtndis          gt_ndigits
+gtndis          gt_ndigits
+gtrbap          gtr_backup
+gtrcle          gtr_cliptoplane
+gtrcol          gtr_control
+gtrcot          gtr_connect
+gtrctn          gtr_ctran
+gtrdee          gtr_delete
+gtrdit          gtr_disconnect
+gtrfen          gtr_fetch_next_instruction
+gtrfre          gtr_frame
+gtrgfh          gtr_gflush
+gtrgtn          gtr_gtran
+gtrgty          gtr_gtty
+gtrint          gtr_init
+gtrmee          gtr_memusage
+gtrops          gtr_openws
+gtrpae          gtr_page
+gtrpon          gtr_polytran
+gtrpop          gtr_polyclip
+gtrptn          gtr_ptran
+gtrrer          gtr_readcursor
+gtrret          gtr_reset
+gtrrew          gtr_redraw
+gtrset          gtrset
+gtrsts          gtr_status
+gtrtre          gtr_truncate
+gtruno          gtr_undo
+gtrwae          gtr_waitpage
+gtrwrp          gtr_writep
+gtrwrr          gtr_writecursor
+gtrwsn          gtr_wstran
+gttyld          g_ttyload
+gtxset          gtxset
+gtybih          gty_binsearch
+gtycas          gtycaps
+gtycle          gtyclose
+gtyeny          gty_encode_capability161
+gtyexs          gty_extract_alias
+gtyfey          gty_fetch_entry
+gtyfiy          gty_find_capability
+gtygeb          gtygetb
+gtygei          gtygeti
+gtyger          gtygetr
+gtyges          gtygets
+gtyins          gty_index_caps
+gtyopn          gtyopen
+gtysce          gty_scan_termcap_file
+gumark          gumark
+gvline          gvline
+gvmark          gvmark
+gwcsme          gwcs_mkfilename
+gwrwcs          gwrwcs
+gxgtx           gxgtx
+iand            iand
+iand            iand
+idbcle          idb_close
+idbfid          idb_findrecord
+idbfid          idb_findrecord
+idbfir          idb_filstr
+idbgeg          idb_getstring
+idbgeg          idb_getstring
+idbkwp          idb_kwlookup
+idbkwp          idb_kwlookup
+idbnas          idb_naxis
+idbned          idb_nextcard
+idbopn          idb_open
+idbpug          idb_putstring
+idbpug          idb_putstring
+idkcle          idk_close
+idkdrw          idk_draw
+idkflh          idk_flush
+idkfre          idk_frame
+idklih          idk_linewidth
+idkmoe          idk_move
+idkopn          idk_open
+idkver          idk_vector
+ieegmd          ieegmapd
+ieegmp          ieegmap
+ieegmr          ieegmapr
+ieegnd          ieegnand
+ieegnn          ieegnan
+ieegnr          ieegnanr
+ieemad          ieemapd
+ieemap          ieemap
+ieemar          ieemapr
+ieepad          ieepakd
+ieepak          ieepak
+ieepar          ieepakr
+ieesmd          ieesmapd
+ieesmp          ieesmap
+ieesmr          ieesmapr
+ieesnd          ieesnand
+ieesnn          ieesnan
+ieesnr          ieesnanr
+ieestd          ieestatd
+ieestr          ieestatr
+ieestt          ieestat
+ieeupd          ieeupkd
+ieeupk          ieeupk
+ieeupr          ieeupkr
+ieevpd          ieevpakd
+ieevpk          ieevpak
+ieevpr          ieevpakr
+ieevud          ieevupkd
+ieevuk          ieevupk
+ieevur          ieevupkr
+ieezsd          ieezstatd
+ieezsr          ieezstatr
+ieezst          ieezstat
+ikiacs          iki_access
+ikicle          iki_close
+ikicoy          iki_copy
+ikidee          iki_delete
+ikideg          iki_debug
+ikiext          iki_extninit
+ikiged          iki_getfield
+ikigen          iki_getextn
+ikiger          iki_getpar
+ikiint          iki_init
+ikildr          iki_lddriver
+ikimke          iki_mkfname
+ikiopn          iki_open
+ikiopx          iki_opix
+ikipae          iki_parse
+ikiree          iki_rename
+ikiupr          iki_updhdr
+ikivan          iki_validextn
+imaccf          imaccf
+imaccf          imaccf
+imacck          imacck
+imaccs          imaccess
+imaddb          imaddb
+imaddb          imaddb
+imaddd          imaddd
+imaddd          imaddd
+imaddf          imaddf
+imaddf          imaddf
+imaddi          imaddi
+imaddi          imaddi
+imaddk          imaddk
+imaddl          imaddl
+imaddl          imaddl
+imaddr          imaddr
+imaddr          imaddr
+imadds          imadds
+imadds          imadds
+imaflp          imaflp
+imakwb          imakwb
+imakwc          imakwc
+imakwd          imakwd
+imakwi          imakwi
+imakwr          imakwr
+imalin          imalign
+imaplv          imaplv
+imastr          imastr
+imastr          imastr
+imbln1          imbln1
+imbln2          imbln2
+imbln3          imbln3
+imbtrn          imbtran
+imcfnl          imcfnl
+imcfnl          imcfnl
+imckwl          imckwl
+imclos          imclos
+imcopy          imcopy
+imcrea          imcrea
+imcrex          imcrex
+imcssz          imcssz
+imctrt          im_ctranset
+imdbcl          imd_bcell
+imdcal          imd_cancel
+imdcle          imd_close
+imdclr          imd_clear
+imdcls          imd_closews
+imdcor          imd_color
+imddae          imd_dashline
+imddrr          imd_drawchar
+imdect          im_decode_subscript161
+imdele          imdele
+imdele          imdelete
+imdelf          imdelf
+imdelf          imdelf
+imdelk          imdelk
+imdelx          imdelx
+imdese          imd_escape
+imdfat          imd_faset
+imdfia          imd_fillarea
+imdflh          imd_flush
+imdfot          imd_font
+imdgeg          imd_getseg
+imdgey          imd_getcellarray
+imdgsg          imd_gstring
+imdint          imd_init
+imdint          imdinit
+imdlie          imd_linetype
+imdmap          imdmap
+imdmcl          imd_mcell
+imdops          imd_openws
+imdopv          imd_opendev
+imdplt          imd_plset
+imdpmt          imd_pmset
+imdpoe          imd_polyline
+imdpor          imd_polymarker
+imdpuy          imd_putcellarray
+imdret          imd_reset
+imdtet          imd_text
+imdtxt          imd_txset
+imemsg          imemsg
+imerr           imerr
+imfaln          imf_align
+imfgpe          imf_gpixfname
+imfins          imf_initoffsets
+imflpl          imflpl
+imflps          imflps
+imfls           imfls
+imflsd          imflsd
+imflsh          imflsh
+imflsh          imflsh
+imflsi          imflsi
+imflsl          imflsl
+imflsr          imflsr
+imflss          imflss
+imflsx          imflsx
+imfluh          imflush
+imfmke          imf_mkpixfname
+imfnpy          imfn_putkey
+imfnpy          imfn_putkey
+imfnss          imfn_stdkeys
+imfnss          imfn_stdkeys
+imfpae          imf_parse
+imftrs          imf_trans
+imfupr          imf_updhdr
+imgatr          imgatr
+imgclr          imgcluster
+imgdir          imgdir
+imgdix          imgdirx
+imgetb          imgetb
+imgetb          imgetb
+imgetc          imgetc
+imgetc          imgetc
+imgetd          imgetd
+imgetd          imgetd
+imgeti          imgeti
+imgeti          imgeti
+imgetl          imgetl
+imgetl          imgetl
+imgetr          imgetr
+imgetr          imgetr
+imgets          imgets
+imgets          imgets
+imgfte          imgftype
+imgfte          imgftype
+imggs           imggs
+imggsc          imggsc
+imggsd          imggsd
+imggsi          imggsi
+imggsl          imggsl
+imggsr          imggsr
+imggss          imggss
+imggsx          imggsx
+imgibf          imgibf
+imgime          imgimage
+imgkwb          imgkwb
+imgkwc          imgkwc
+imgkwd          imgkwd
+imgkwi          imgkwi
+imgkwr          imgkwr
+imgl1           imgl1
+imgl1d          imgl1d
+imgl1i          imgl1i
+imgl1l          imgl1l
+imgl1r          imgl1r
+imgl1r          imgl1r
+imgl1s          imgl1s
+imgl1s          imgl1s
+imgl1x          imgl1x
+imgl2           imgl2
+imgl2d          imgl2d
+imgl2i          imgl2i
+imgl2l          imgl2l
+imgl2r          imgl2r
+imgl2r          imgl2r
+imgl2s          imgl2s
+imgl2s          imgl2s
+imgl2x          imgl2x
+imgl3           imgl3
+imgl3d          imgl3d
+imgl3i          imgl3i
+imgl3l          imgl3l
+imgl3r          imgl3r
+imgl3r          imgl3r
+imgl3s          imgl3s
+imgl3s          imgl3s
+imgl3x          imgl3x
+imgnfn          imgnfn
+imgnfn          imgnfn
+imgnkw          imgnkw
+imgnl           imgnl
+imgnld          imgnld
+imgnli          imgnli
+imgnll          imgnll
+imgnln          imgnln
+imgnlr          imgnlr
+imgnls          imgnls
+imgnlx          imgnlx
+imgobf          imgobf
+imgs1           imgs1
+imgs1d          imgs1d
+imgs1i          imgs1i
+imgs1l          imgs1l
+imgs1r          imgs1r
+imgs1r          imgs1r
+imgs1s          imgs1s
+imgs1s          imgs1s
+imgs1x          imgs1x
+imgs2           imgs2
+imgs2d          imgs2d
+imgs2i          imgs2i
+imgs2l          imgs2l
+imgs2r          imgs2r
+imgs2r          imgs2r
+imgs2s          imgs2s
+imgs2s          imgs2s
+imgs2x          imgs2x
+imgs3           imgs3
+imgs3d          imgs3d
+imgs3i          imgs3i
+imgs3l          imgs3l
+imgs3r          imgs3r
+imgs3r          imgs3r
+imgs3s          imgs3s
+imgs3s          imgs3s
+imgs3x          imgs3x
+imgsen          imgsection
+imgsiz          imgsiz
+imgstr          imgstr
+imgstr          imgstr
+imhcpy          imhcpy
+iminie          im_init_newimage
+imioff          imioff
+imisec          imisec
+imloop          imloop
+immaky          im_make_newcopy
+immap           immap
+immapz          immapz
+imnote          imnote
+imofnl          imofnl
+imofnl          imofnl
+imofns          imofnls
+imofns          imofnls
+imofnu          imofnlu
+imofnu          imofnlu
+imokwl          imokwl
+imopen          imopen
+imopnc          imopnc
+imopnx          imopnx
+imopsf          imopsf
+impak           impak
+impakd          impakd
+impaki          impaki
+impakl          impakl
+impakr          impakr
+impaks          impaks
+impakx          impakx
+impare          imparse
+impgs           impgs
+impgsd          impgsd
+impgsi          impgsi
+impgsl          impgsl
+impgsr          impgsr
+impgss          impgss
+impgsx          impgsx
+impixf          impixf
+impkwb          impkwb
+impkwc          impkwc
+impkwd          impkwd
+impkwi          impkwi
+impkwr          impkwr
+impl1           impl1
+impl1d          impl1d
+impl1i          impl1i
+impl1l          impl1l
+impl1r          impl1r
+impl1r          impl1r
+impl1s          impl1s
+impl1s          impl1s
+impl1x          impl1x
+impl2           impl2
+impl2d          impl2d
+impl2i          impl2i
+impl2l          impl2l
+impl2r          impl2r
+impl2r          impl2r
+impl2s          impl2s
+impl2s          impl2s
+impl2x          impl2x
+impl3           impl3
+impl3d          impl3d
+impl3i          impl3i
+impl3l          impl3l
+impl3r          impl3r
+impl3r          impl3r
+impl3s          impl3s
+impl3s          impl3s
+impl3x          impl3x
+impml1          im_pmlne1
+impml2          im_pmlne2
+impml3          im_pmlne3
+impmlr          im_pmldhdr
+impmlv          im_pmlnev
+impmmo          im_pmmapo
+impmmp          im_pmmap
+impmon          im_pmopen
+impms1          im_pmsne1
+impms2          im_pmsne2
+impms3          im_pmsne3
+impmsr          im_pmsvhdr
+impmsv          im_pmsnev
+impnl           impnl
+impnld          impnld
+impnli          impnli
+impnll          impnll
+impnln          impnln
+impnlr          impnlr
+impnls          impnls
+impnlx          impnlx
+imps1           imps1
+imps1d          imps1d
+imps1i          imps1i
+imps1l          imps1l
+imps1r          imps1r
+imps1r          imps1r
+imps1s          imps1s
+imps1s          imps1s
+imps1x          imps1x
+imps2           imps2
+imps2d          imps2d
+imps2i          imps2i
+imps2l          imps2l
+imps2r          imps2r
+imps2r          imps2r
+imps2s          imps2s
+imps2s          imps2s
+imps2x          imps2x
+imps3           imps3
+imps3d          imps3d
+imps3i          imps3i
+imps3l          imps3l
+imps3r          imps3r
+imps3r          imps3r
+imps3s          imps3s
+imps3s          imps3s
+imps3x          imps3x
+impstr          impstr
+impstr          impstr
+imputb          imputb
+imputb          imputb
+imputd          imputd
+imputd          imputd
+imputh          imputh
+imputi          imputi
+imputi          imputi
+imputl          imputl
+imputl          imputl
+imputr          imputr
+imputr          imputr
+imputs          imputs
+imputs          imputs
+imrbpx          imrbpx
+imrdhr          imrdhdr
+imrdpx          imrdpx
+imrene          imrename
+imrmbs          imrmbufs
+imrnam          imrnam
+imsamp          imsamp
+imsdir          imsdir
+imsdix          imsdirx
+imsetf          imsetbuf
+imseti          imseti
+imsetm          im_seterrim
+imsetp          im_seterrop
+imsetr          imsetr
+imsinb          imsinb
+imsmpl          imsmpl
+imsmps          imsmps
+imsslv          imsslv
+imstai          imstati
+imstar          imstatr
+imstas          imstats
+imswap          imswap
+imtcle          imtclose
+imtgem          imtgetim
+imtlen          imtlen
+imtmae          imt_mapname
+imtopn          imtopen
+imtopp          imtopenp
+imtrew          imtrew
+imtrgm          imtrgetim
+imtypk          imtypk
+imunmp          imunmap
+imupk           imupk
+imupkd          imupkd
+imupki          imupki
+imupkl          imupkl
+imupkr          imupkr
+imupks          imupks
+imupkx          imupkx
+imwbpx          imwbpx
+imwpix          imwpix
+imwrhr          imwrhdr
+imwrie          imwrite
+imwrpx          imwrpx
+intrde          intr_disable
+intree          intr_enable
+intrrt          intr_reset
+intt            intt
+ior             ior
+ior             ior
+irafmn          iraf_main
+irafpath        irafpath
+ishift          ishift
+ishift          ishift
+itob            itob
+itoc            itoc
+iwcare          iw_cardtype
+iwcfis          iw_cfits
+iwents          iw_enterwcs
+iwfind          iw_findcard
+iwgbis          iw_gbigfits
+iwputr          iw_putstr
+iwputy          iw_putarray
+iwrfis          iw_rfits
+iwsetp          iw_setaxmap
+kardbf          kardbf
+kardgd          kardgd
+kardlp          kardlp
+kardpl          kardpl
+kardpr          kardpr
+kardsf          kardsf
+kawrbf          kawrbf
+kawrgd          kawrgd
+kawrlp          kawrlp
+kawrpl          kawrpl
+kawrpr          kawrpr
+kawrsf          kawrsf
+kawtbf          kawtbf
+kawtgd          kawtgd
+kawtlp          kawtlp
+kawtpl          kawtpl
+kawtpr          kawtpr
+kawtsf          kawtsf
+kbzard          kb_zard
+kbzawr          kb_zawr
+kbzawt          kb_zawt
+kbzcls          kb_zcls
+kbzopn          kb_zopn
+kbzstt          kb_zstt
+kclcpr          kclcpr
+kcldir          kcldir
+kcldpr          kcldpr
+kclsbf          kclsbf
+kclsgd          kclsgd
+kclslp          kclslp
+kclspl          kclspl
+kclssf          kclssf
+kclstx          kclstx
+kclsty          kclsty
+kdvall          kdvall
+kdvown          kdvown
+kernel_panic    kernel_panic
+kfacss          kfacss
+kfaloc          kfaloc
+kfchdr          kfchdr
+kfdele          kfdele
+kfgcwd          kfgcwd
+kfinfo          kfinfo
+kflstx          kflstx
+kflsty          kflsty
+kfmkcp          kfmkcp
+kfmkdr          kfmkdr
+kfpath          kfpath
+kfprot          kfprot
+kfrnam          kfrnam
+kfsubd          kfsubd
+kfxdir          kfxdir
+kgettx          kgettx
+kgetty          kgetty
+kgfdir          kgfdir
+kicont          ki_connect
+kidece          ki_decode
+kience          ki_encode
+kienvt          ki_envreset
+kierrr          ki_error
+kiexte          ki_extnode
+kifine          ki_findnode
+kiflux          ki_flushtx
+kifman          ki_fmapfn
+kifren          ki_freechan
+kigetn          ki_getchan
+kigets          ki_gethosts
+kignoe          ki_gnode
+kiinit          ki_init
+kiloce          ki_localnode
+kimape          ki_mapname
+kimapn          ki_mapchan
+kintpr          kintpr
+kiopes          ki_openks
+kirece          ki_receive
+kisend          ki_send
+kisenv          ki_sendrcv
+kishot          ki_shownet
+kixnoe          ki_xnode
+kmallc          kmalloc
+kmallc          kmalloc
+knottx          knottx
+knotty          knotty
+kopcpr          kopcpr
+kopdir          kopdir
+kopdpr          kopdpr
+kopnbf          kopnbf
+kopngd          kopngd
+kopnlp          kopnlp
+kopnpl          kopnpl
+kopnsf          kopnsf
+kopntx          kopntx
+kopnty          kopnty
+koscmd          koscmd
+kputtx          kputtx
+kputty          kputty
+krealc          krealloc
+krealc          krealloc
+ks_geti         ks_geti
+ks_getlogin     ks_getlogin
+ks_getpass      ks_getpass
+ks_getresvport  ks_getresvport
+ks_getword      ks_getword
+ks_onsig        ks_onsig
+ks_puti         ks_puti
+ks_rexecport    ks_rexecport
+ks_rhosts       ks_rhosts
+ks_socket       ks_socket
+ks_sysname      ks_sysname
+ks_username     ks_username
+ks_whosts       ks_whosts
+ksared          ks_aread
+ksawat          ks_await
+ksawre          ks_awrite
+ksektx          ksektx
+ksekty          ksekty
+kserrr          ks_error
+kservr          kserver
+ksfman          ks_fmapfn
+ksloaf          ks_loadbf
+ksloax          ks_loadtx
+ksrece          ks_receive
+kssend          ks_send
+ksttbf          ksttbf
+ksttgd          ksttgd
+ksttlp          ksttlp
+ksttpl          ksttpl
+ksttpr          ksttpr
+ksttsf          ksttsf
+kstttx          kstttx
+ksttty          ksttty
+kszfif          ks_zfiobf
+kszfit          ks_zfiomt
+kszfix          ks_zfiotx
+ktzcls          kt_zcls
+ktzfls          kt_zfls
+ktzget          kt_zget
+ktznot          kt_znot
+ktzopn          kt_zopn
+ktzput          kt_zput
+ktzsek          kt_zsek
+ktzstt          kt_zstt
+kzclmt          kzclmt
+kzopmt          kzopmt
+kzrdmt          kzrdmt
+kzrwmt          kzrwmt
+kzstmt          kzstmt
+kzwrmt          kzwrmt
+kzwtmt          kzwtmt
+lexnum          lexnum
+lnocle          lno_close
+lnofeh          lno_fetch
+lnoopn          lno_open
+lnosae          lno_save
+loci            loci
+locpr           locpr
+locva           locva
+loggedin        loggedin
+lpopen          lpopen
+lpzard          lp_zaread
+lpzawe          lp_zawrite
+lpzawt          lp_zawait
+ltoc            ltoc
+maideh          ma_ideh
+mallo1          malloc1
+mallo1          malloc1
+mcswap          mcswap
+memchk          memchk
+mgdptr          mgdptr
+mgdptr          mgdptr
+mgtfwa          mgtfwa
+mgtfwa          mgtfwa
+miilen          miilen
+miinem          miinelem
+miipa2          miipak32
+miipa6          miipak16
+miipa8          miipak8
+miipad          miipakd
+miipak          miipak
+miipar          miipakr
+miipke          miipksize
+miirdc          miirdc
+miirdi          miirdi
+miirdl          miirdl
+miirdr          miirdr
+miirec          miireadc
+miired          miiread
+miired          miireadd
+miirei          miireadi
+miirel          miireadl
+miirer          miireadr
+miires          miireads
+miiup2          miiupk32
+miiup6          miiupk16
+miiup8          miiupk8
+miiupd          miiupkd
+miiupk          miiupk
+miiupr          miiupkr
+miiwrc          miiwrc
+miiwrc          miiwritec
+miiwrd          miiwrited
+miiwre          miiwrite
+miiwri          miiwri
+miiwri          miiwritei
+miiwrl          miiwritel
+miiwrl          miiwrl
+miiwrr          miiwriter
+miiwrr          miiwrr
+miiwrs          miiwrites
+miocle          mio_close
+miogld          mio_glsegd
+mioglg          mio_glseg
+miogli          mio_glsegi
+miogll          mio_glsegl
+mioglr          mio_glsegr
+miogls          mio_glsegs
+mioglx          mio_glsegx
+mioopn          mio_open
+mioopo          mio_openo
+miopld          mio_plsegd
+mioplg          mio_plseg
+miopli          mio_plsegi
+miopll          mio_plsegl
+mioplr          mio_plsegr
+miopls          mio_plsegs
+mioplx          mio_plsegx
+miosee          mio_setrange
+miosei          mio_seti
+miosti          mio_stati
+mpgetd          mp_getd
+mpgeti          mp_geti
+msvfwa          msvfwa
+msvfwa          msvfwa
+mtalle          mtallocate
+mtcap           mtcap
+mtclen          mtclean
+mtclre          mt_clrcache
+mtdeae          mtdeallocate
+mtdevd          mt_devallocated
+mtence          mtencode
+mtexae          mt_examine
+mtfile          mtfile
+mtfnae          mtfname
+mtgets          mt_getpos
+mtglok          mt_glock
+mtgtyn          mt_gtyopen
+mtloce          mt_lockname
+mtneeo          mtneedfileno
+mtop            mtop
+mtopen          mtopen
+mtpare          mtparse
+mtposn          mtposition
+mtpute          mt_putline
+mtreae          mt_read_lockfile
+mtrewd          mtrewind
+mtsavd          mt_savekeyword
+mtsavs          mt_savepos
+mtskid          mt_skip_record
+mtstas          mtstatus
+mtsync          mt_sync
+mtupde          mt_update_lockfile
+mwalld          mw_allocd
+mwalls          mw_allocs
+mwaxtn          mw_axtran
+mwc1td          mw_c1trand
+mwc1tn          mw_c1tran
+mwc1tr          mw_c1tranr
+mwc2td          mw_c2trand
+mwc2tn          mw_c2tran
+mwc2tr          mw_c2tranr
+mwcloe          mw_close
+mwcopd          mw_copyd
+mwcops          mw_copys
+mwctfe          mw_ctfree
+mwctrd          mw_ctrand
+mwctrn          mw_ctran
+mwctrr          mw_ctranr
+mwfins          mw_findsys
+mwflop          mw_flookup
+mwgaxp          mw_gaxmap
+mwgaxt          mw_gaxlist
+mwgctd          mw_gctrand
+mwgctn          mw_gctran
+mwgctr          mw_gctranr
+mwgltd          mw_gltermd
+mwgltr          mw_gltermr
+mwgsym          mw_gsystem
+mwgwas          mw_gwattrs
+mwgwsd          mw_gwsampd
+mwgwsr          mw_gwsampr
+mwgwtd          mw_gwtermd
+mwgwtr          mw_gwtermr
+mwinvd          mw_invertd
+mwinvr          mw_invertr
+mwload          mw_load
+mwloam          mw_loadim
+mwltrd          mw_ltrand
+mwltrn          mw_ltran
+mwltrr          mw_ltranr
+mwlubb          mw_lubacksub
+mwlude          mw_ludecompose
+mwmkid          mw_mkidmd
+mwmkir          mw_mkidmr
+mwmmud          mw_mmuld
+mwmmul          mw_mmul
+mwmmur          mw_mmulr
+mwnewm          mw_newsystem
+mwnewy          mw_newcopy
+mwopem          mw_openim
+mwopen          mw_open
+mwrefr          mw_refstr
+mwrote          mw_rotate
+mwsave          mw_save
+mwsavm          mw_saveim
+mwsaxp          mw_saxmap
+mwscae          mw_scale
+mwsctn          mw_sctran
+mwsdes          mw_sdefwcs
+mwseti          mw_seti
+mwshit          mw_shift
+mwshow          mw_show
+mwsltd          mw_sltermd
+mwsltr          mw_sltermr
+mwssym          mw_ssystem
+mwstai          mw_stati
+mwswas          mw_swattrs
+mwswsd          mw_swsampd
+mwswsr          mw_swsampr
+mwswtd          mw_swtermd
+mwswte          mw_swtype
+mwswtr          mw_swtermr
+mwtrad          mw_translated
+mwtrar          mw_translater
+mwv1td          mw_v1trand
+mwv1tn          mw_v1tran
+mwv1tr          mw_v1tranr
+mwv2td          mw_v2trand
+mwv2tn          mw_v2tran
+mwv2tr          mw_v2tranr
+mwvmud          mw_vmuld
+mwvmul          mw_vmul
+mwvmur          mw_vmulr
+mwvtrd          mw_vtrand
+mwvtrn          mw_vtran
+mwvtrr          mw_vtranr
+napmsx          napmsx
+ncgchr          ncgchr
+ncpchr          ncpchr
+ndopen          ndopen
+newpen          newpen
+nextcmd         nextcmd
+nowhie          nowhite
+nscan           nscan
+oifacs          oif_access
+oifcle          oif_close
+oifcoy          oif_copy
+oifdee          oif_delete
+oifgpe          oif_gpixfname
+oifmke          oif_mkpixfname
+oifopn          oif_open
+oifopx          oif_opix
+oifrdr          oif_rdhdr
+oifree          oif_rename
+oiftrm          oif_trim
+oiftrm          oif_trim
+oifupr          oif_updhdr
+oifwrr          oif_wrhdr
+onenty          onentry
+onenty          onentry
+onerre          onerror_remove
+onerrr          onerror
+onexie          onexit_remote
+onexit          onexit
+onint           onint
+onint           onint
+oscmd           oscmd
+osfnik          osfn_initlock
+osfnlk          osfn_lock
+osfnms          osfn_mkfnames
+osfnpe          osfn_pkfname
+osfnrk          osfn_rmlock
+osfntt          osfn_timeleft
+osfnuk          osfn_unlock
+output          output
+packum          packum
+pagefe          pagefile
+pagefs          pagefiles
+pargb           pargb
+pargc           pargc
+pargd           pargd
+pargg           pargg
+pargi           pargi
+pargl           pargl
+pargr           pargr
+pargs           pargs
+pargsr          pargstr
+pargx           pargx
+parses          parse_args
+parses          parse_args
+patamh          pat_amatch
+patfit          pat_filset
+patgel          pat_getccl
+patgse          pat_gsize
+patinx          patindex
+patloe          pat_locate
+patmae          patmake
+patmah          patmatch
+patomh          pat_omatch
+patsts          pat_stclos
+perror          perror
+pggetd          pg_getcmd
+pggete          pg_getline
+pggetr          pg_getstr
+pgpage          pg_pagefile
+pgpeed          pg_peekcmd
+pgpusd          pg_pushcmd
+pgsett          pg_setprompt
+phelp           phelp
+placcs          pl_access
+plallc          pl_alloc
+plascp          pl_asciidump
+plbox           pl_box
+plchke          pl_chkfree
+plcire          pl_circle
+plcler          pl_clear
+plcloe          pl_close
+plcome          pl_compare
+plcoms          pl_compress
+plcree          pl_create
+pldebg          pl_debug
+pldebt          pl_debugout
+plempy          pl_empty
+plfacs          plf_access
+plfcle          plf_close
+plfcoy          plf_copy
+plfdee          plf_delete
+plfnul          plf_null
+plfopn          plf_open
+plfree          plf_rename
+plfupr          plf_updhdr
+plgete          pl_getplane
+plglls          pl_glls
+plglp           pl_glp
+plglpi          pl_glpi
+plglpl          pl_glpl
+plglps          pl_glps
+plglr           pl_glr
+plglri          pl_glri
+plglrl          pl_glrl
+plglrs          pl_glrs
+plgsie          pl_gsize
+pll2p           pl_l2p
+pll2pi          pl_l2pi
+pll2pl          pl_l2pl
+pll2ps          pl_l2ps
+pll2r           pl_l2r
+pll2ri          pl_l2ri
+pll2rl          pl_l2rl
+pll2rs          pl_l2rs
+pllcot          pll_const
+pllemy          pll_empty
+plleql          pll_equal
+plline          pl_line
+pllinl          pl_linestencil
+pllinp          pl_linerop
+plliny          pl_linenotempty
+pllneg          pll_nextseg
+plload          pl_load
+plloaf          pl_loadf
+plloam          pl_loadim
+plloop          plloop
+pllprs          pll_prints
+plnewy          pl_newcopy
+plopen          pl_open
+plot            plot
+plot1           plot1
+plot2           plot2
+plot3           plot3
+plot4           plot4
+plot5           plot5
+plot6           plot6
+plot7           plot7
+plot8           plot8
+plots           plots
+plp2l           pl_p2l
+plp2li          pl_p2li
+plp2ll          pl_p2ll
+plp2ls          pl_p2ls
+plp2r           pl_p2r
+plp2ri          pl_p2ri
+plp2rl          pl_p2rl
+plp2rs          pl_p2rs
+plpixi          pl_pixropi
+plpixl          pl_pixropl
+plpixp          pl_pixrop
+plpixp          pl_pixrop
+plpixs          pl_pixrops
+plplls          pl_plls
+plplp           pl_plp
+plplpi          pl_plpi
+plplpl          pl_plpl
+plplps          pl_plps
+plplr           pl_plr
+plplri          pl_plri
+plplrl          pl_plrl
+plplrs          pl_plrs
+plpoit          pl_point
+plpoln          pl_polygon
+plr2l           pl_r2l
+plr2li          pl_r2li
+plr2ll          pl_r2ll
+plr2ls          pl_r2ls
+plr2p           pl_r2p
+plr2pi          pl_r2pi
+plr2pl          pl_r2pl
+plr2ps          pl_r2ps
+plrani          pl_rangeropi
+plranl          pl_rangeropl
+plranp          pl_rangerop
+plrans          pl_rangerops
+plrcle          plr_close
+plregp          pl_regionrop
+plreqi          plr_equali
+plreql          plr_equal
+plreql          plr_equall
+plreqs          plr_equals
+plrget          plr_getlut
+plrgex          plr_getpix
+plrop           pl_rop
+plropn          plr_open
+plrpri          plr_printi
+plrprl          plr_printl
+plrprs          plr_prints
+plrprt          plr_print
+plrset          plr_setrect
+plsave          pl_save
+plsavf          pl_savef
+plsavm          pl_saveim
+plsect          pl_sectnotconst
+plsecy          pl_sectnotempty
+plsete          pl_setplane
+plseti          pl_seti
+plssie          pl_ssize
+plsslv          plsslv
+plstai          pl_stati
+plstel          pl_stencil
+plterm          plterm
+plubox          pl_ubox
+plucie          pl_ucircle
+plupde          pl_update
+plupon          pl_upolygon
+plvald          plvalid
+pmaccs          pm_access
+pmascp          pm_asciidump
+pmbox           pm_box
+pmcire          pm_circle
+pmcler          pm_clear
+pmempy          pm_empty
+pmglls          pm_glls
+pmglp           pm_glp
+pmglpi          pm_glpi
+pmglpl          pm_glpl
+pmglps          pm_glps
+pmglr           pm_glr
+pmglri          pm_glri
+pmglrl          pm_glrl
+pmglrs          pm_glrs
+pmline          pm_line
+pmliny          pm_linenotempty
+pmnewk          pm_newmask
+pmplls          pm_plls
+pmplp           pm_plp
+pmplpi          pm_plpi
+pmplpl          pm_plpl
+pmplps          pm_plps
+pmplr           pm_plr
+pmplri          pm_plri
+pmplrl          pm_plrl
+pmplrs          pm_plrs
+pmpoit          pm_point
+pmpoln          pm_polygon
+pmrcle          pmr_close
+pmrgex          pmr_getpix
+pmrop           pm_rop
+pmropn          pmr_open
+pmrset          pmr_setrect
+pmsect          pm_sectnotconst
+pmsecy          pm_sectnotempty
+pmsete          pm_setplane
+pmseti          pm_seti
+pmstel          pm_stencil
+pow2            pow2
+pr_enter        pr_enter
+pr_findpid      pr_findpid
+pr_getipc       pr_getipc
+pr_onint        pr_onint
+pr_release      pr_release
+pr_wait         pr_wait
+prchdr          prchdir
+prclcr          prclcpr
+prcldr          prcldpr
+prcloe          prclose
+prdone          prdone
+prdumn          pr_dummy_open
+preal           preal
+prenve          prenvfree
+prenvt          prenvset
+prfilf          prfilbuf
+prfinc          pr_findproc
+prgete          prgetline
+prgetr          pr_getredir
+printp          print_help
+printp          print_help
+prkill          prkill
+prompt          prompt
+pronic          pr_onipc
+propcr          propcpr
+propdr          propdpr
+propen          propen
+proscd          proscmd
+protet          protect
+prpsio          pr_psio
+prpsit          prpsinit
+prpsld          prpsload
+prredr          prredir
+prseti          prseti
+prsigl          prsignal
+prstai          prstati
+prupde          prupdate
+prvret          prv_reset
+przclr          pr_zclspr
+psioit          psio_isxmit
+psioxr          psio_xfer
+pstatus         pstatus
+pstr            pstr
+psym            psym
+putcc           putcc
+putci           putci
+putlie          putline
+qmaccs          qm_access
+qmgetc          qm_getc
+qmscan          qm_scan
+qmscao          qm_scano
+qmsetm          qm_setparam
+qmsetr          qm_setpar
+qmsets          qm_setdefaults
+qmsymb          qm_symtab
+qmupds          qm_upddefaults
+qpaccf          qp_accessf
+qpaccs          qp_access
+qpadd           qp_add
+qpaddb          qp_addb
+qpaddc          qp_addc
+qpaddd          qp_addd
+qpaddf          qp_addf
+qpaddi          qp_addi
+qpaddl          qp_addl
+qpaddr          qp_addr
+qpadds          qp_adds
+qpaddx          qp_addx
+qpargt          qp_arglist
+qpastr          qp_astr
+qpbind          qp_bind
+qpcfnl          qp_cfnl
+qpcloe          qp_close
+qpclot          qp_closetext
+qpcopf          qp_copyf
+qpcopy          qp_copy
+qpctod          qp_ctod
+qpctoi          qp_ctoi
+qpdele          qp_delete
+qpdelf          qp_deletef
+qpdsym          qp_dsym
+qpdtye          qp_dtype
+qpelee          qp_elementsize
+qpexad          qpex_attrld
+qpexai          qpex_attrli
+qpexal          qpex_attrl
+qpexar          qpex_attrlr
+qpexcd          qpex_codegend
+qpexce          qpex_close
+qpexci          qpex_codegeni
+qpexcn          qpex_codegen
+qpexcr          qpex_codegenr
+qpexdc          qpex_dballoc
+qpexde          qpex_delete
+qpexdg          qpex_debug
+qpexdr          qpex_dbpstr
+qpexee          qpex_evaluate
+qpexfe          qpex_free
+qpexge          qpex_getattribute
+qpexgr          qpex_getfilter
+qpexmk          qpex_mark
+qpexmr          qpex_modfilter
+qpexon          qpex_open
+qpexpd          qpex_parsed
+qpexpe          qpex_parse
+qpexpi          qpex_parsei
+qpexpn          qpex_pbpin
+qpexpr          qpex_parser
+qpexps          qpex_pbpos
+qpexpt          qp_expandtext
+qpexrd          qpex_refd
+qpexsd          qpex_sublistd
+qpexsi          qpex_sublisti
+qpexsr          qpex_sublistr
+qpexst          qpex_sublist
+qpfacs          qpf_access
+qpfcle          qpf_close
+qpfcos          qpf_copyparams
+qpfcoy          qpf_copy
+qpfdee          qpf_delete
+qpflur          qp_flushpar
+qpfopn          qpf_open
+qpfopx          qpf_opix
+qpfree          qpf_rename
+qpfupr          qpf_updhdr
+qpfwar          qpf_wattr
+qpfwfr          qpf_wfilter
+qpfzcl          qpfzcl
+qpfzop          qpfzop
+qpfzrd          qpfzrd
+qpfzst          qpfzst
+qpfzwr          qpfzwr
+qpfzwt          qpfzwt
+qpget           qp_get
+qpgetb          qp_getb
+qpgetc          qp_getc
+qpgetd          qp_getd
+qpgeti          qp_geti
+qpgetk          qp_gettok
+qpgetl          qp_getl
+qpgetm          qp_getparam
+qpgetr          qp_getr
+qpgets          qp_gets
+qpgetx          qp_getx
+qpgmsm          qp_gmsym
+qpgnfn          qp_gnfn
+qpgpsm          qp_gpsym
+qpgstr          qp_gstr
+qpinht          qp_inherit
+qpioce          qpio_close
+qpioge          qpio_getrange
+qpiogr          qpio_getfilter
+qpiogs          qpio_getevents
+qpiolk          qpio_loadmask
+qpiols          qpio_loadwcs
+qpiomx          qpio_mkindex
+qpioon          qpio_open
+qpiope          qpio_parse
+qpiops          qpio_putevents
+qpiori          qpio_readpixi
+qpiors          qpio_readpixs
+qpiort          qpio_rbucket
+qpiorx          qpio_readpix
+qpiosc          qpio_sync
+qpiose          qpio_setrange
+qpiosi          qpio_seti
+qpiosi          qpio_stati
+qpiosr          qpio_setfilter
+qpiowt          qpio_wbucket
+qplenf          qp_lenf
+qplenl          qp_lenfnl
+qplesd          qp_lessthand
+qplesd          qp_lessthand
+qplesi          qp_lessthani
+qplesi          qp_lessthani
+qplesn          qp_lessthan
+qplesr          qp_lessthanr
+qplesr          qp_lessthanr
+qploas          qp_loadwcs
+qpmaxd          qp_maxvald
+qpmaxd          qp_maxvald
+qpmaxi          qp_maxvali
+qpmaxi          qp_maxvali
+qpmaxl          qp_maxval
+qpmaxr          qp_maxvalr
+qpmaxr          qp_maxvalr
+qpmind          qp_minvald
+qpmind          qp_minvald
+qpmini          qp_minvali
+qpmini          qp_minvali
+qpminl          qp_minval
+qpminr          qp_minvalr
+qpminr          qp_minvalr
+qpmkfe          qp_mkfname
+qpnexk          qp_nexttok
+qpofnl          qp_ofnl
+qpofns          qp_ofnls
+qpofnu          qp_ofnlu
+qpopen          qp_open
+qpopet          qp_opentext
+qppare          qp_parse
+qpparl          qp_parsefl
+qppcle          qp_pclose
+qppopn          qp_popen
+qppstr          qp_pstr
+qpput           qp_put
+qpputb          qp_putb
+qpputc          qp_putc
+qpputd          qp_putd
+qpputi          qp_puti
+qpputl          qp_putl
+qpputm          qp_putparam
+qpputr          qp_putr
+qpputs          qp_puts
+qpputx          qp_putx
+qpquef          qp_queryf
+qprawk          qp_rawtok
+qpread          qp_read
+qprebd          qp_rebuild
+qprene          qp_rename
+qprenf          qp_renamef
+qprlmd          qp_rlmerged
+qprlmd          qp_rlmerged
+qprlme          qp_rlmerge
+qprlmi          qp_rlmergei
+qprlmi          qp_rlmergei
+qprlmr          qp_rlmerger
+qprlmr          qp_rlmerger
+qpsavs          qp_savewcs
+qpseel          qp_seekfnl
+qpseti          qp_seti
+qpsizf          qp_sizeof
+qpstai          qp_stati
+qpsync          qp_sync
+qpungk          qp_ungettok
+qpwrie          qp_write
+qst             qst
+rcursr          rcursor
+rddata          rddata
+rdukey          rdukey
+ready           ready
+reopen          reopen
+resetn          reset_scan
+restox          restoretx
+rpthe4          rptheta4
+rpthe4          rptheta4
+salloc          salloc
+salloc          salloc
+savetx          savetx
+sbit            sbit
+sbytes          sbytes
+scanc           scanc
+scanfe          scanfile
+sfree           sfree
+sfree           sfree
+sgcdup          sgc_dump
+sgchdw          sgch_draw
+sgchfh          sgch_flush
+sgchme          sgch_move
+sgeexe          sge_execute
+sgeprf          sge_printf
+sgespc          sge_spoolesc
+sgewse          sge_wsenable
+sgewsn          sge_wstran
+sgfger          sgf_getchar
+sgfpor          sgf_post_filter
+sgfttr          sgf_ttyfilter
+sgibcl          sgi_bcell
+sgical          sgi_cancel
+sgicle          sgi_close
+sgiclr          sgi_clear
+sgicls          sgi_closews
+sgicor          sgi_color
+sgidae          sgi_dashline
+sgidrr          sgi_drawchar
+sgiese          sgi_escape
+sgifat          sgi_faset
+sgifia          sgi_fillarea
+sgiflh          sgi_flush
+sgifot          sgi_font
+sgigeg          sgi_getseg
+sgigey          sgi_getcellarray
+sgigsg          sgi_gstring
+sgiint          sgi_init
+sgilie          sgi_linetype
+sgimcl          sgi_mcell
+sgiopn          sgi_open
+sgiops          sgi_openws
+sgiplt          sgi_plset
+sgipmt          sgi_pmset
+sgipoe          sgi_polyline
+sgipor          sgi_polymarker
+sgipuy          sgi_putcellarray
+sgiret          sgi_reset
+sgitet          sgi_text
+sgitxt          sgi_txset
+sgkcle          sgk_close
+sgkdrw          sgk_draw
+sgkflh          sgk_flush
+sgkfre          sgk_frame
+sgklih          sgk_linewidth
+sgkmke          sgk_mkfname
+sgkmoe          sgk_move
+sgkopn          sgk_open
+sgkver          sgk_vector
+sgmexe          sgm_execute
+sgmgeg          sgm_getmapping
+sgmiod          sgm_iomapread
+sgmioe          sgm_iomapwrite
+sgmout          sgm_output
+sgmqur          sgm_queryraster
+sgmquy          sgm_query
+sgmrep          sgm_readcmap
+sgmres          sgm_readpixels
+sgmspc          sgm_spoolesc
+sgmwie          sgm_winsize
+sgmwrp          sgm_writecmap
+sgmwrs          sgm_writepixels
+sgmwse          sgm_wsenable
+sgmwsn          sgm_wstran
+smark           smark
+smark           smark
+spf_close       spf_close
+spf_open        spf_open
+sprinf          sprintf
+srftet          srf_test
+sscan           sscan
+stallc          stalloc
+stcloe          stclose
+stentr          stenter
+stfacs          stf_access
+stfadr          stf_addpar
+stfcle          stf_close
+stfcos          stf_copyfits
+stfcoy          stf_copy
+stfcte          stf_ctype
+stfdee          stf_delete
+stfgeb          stf_getb
+stfgei          stf_geti
+stfgen          stf_gethdrextn
+stfges          stf_gets
+stfget          stf_getcmt
+stfind          stfind
+stfinl          stfindall
+stfins          stf_initwcs
+stfmeb          stf_mergegpb
+stfmke          stf_mkpixfname
+stfnee          stf_newimage
+stfopn          stf_open
+stfopx          stf_opix
+stforb          stf_ordergpb
+stfrdr          stf_rdheader
+stfree          stfree
+stfrek          stf_reblock
+stfrfr          stf_rfitshdr
+stfrgb          stf_rgpb
+stfrne          stf_rname
+stfupr          stf_updhdr
+stfwfr          stf_wfitshdr
+stfwgb          stf_wgpb
+stgcal          stg_cancel
+stgcle          stg_close
+stgclr          stg_clear
+stgcls          stg_closews
+stgct1          stg_ctrl1
+stgct2          stg_ctrl2
+stgct3          stg_ctrl3
+stgctl          stg_ctrl
+stgdes          stg_deactivatews
+stgdrr          stg_drawchar
+stgdrw          stg_draw
+stgene          stg_encode
+stgese          stg_escape
+stgfat          stg_faset
+stgfia          stg_fillarea
+stgflh          stg_flush
+stggdb          stg_gdisab
+stggeb          stg_genab
+stggee          stg_getline
+stgger          stg_getcursor
+stggey          stg_getcellarray
+stggrm          stg_grstream
+stggsg          stg_gstring
+stgint          stg_init
+stglor          stg_lockcursor
+stgmoe          stg_move
+stgmsn          stg_msglen
+stgonr          stg_onerror
+stgont          stg_onint
+stgopn          stg_open
+stgops          stg_openws
+stgou2          stg_output2
+stgour          stg_outstr
+stgplt          stg_plset
+stgpmt          stg_pmset
+stgpoe          stg_polyline
+stgpor          stg_polymarker
+stgpue          stg_putline
+stgpuy          stg_putcellarray
+stgrdr          stg_rdcursor
+stgren          stg_resolution
+stgrer          stg_readcursor
+stgres          stg_reactivatews
+stgret          stg_reset
+stgrey          stg_readtty
+stgser          stg_setcursor
+stgtet          stg_text
+stgtxe          stg_txsize
+stgtxt          stg_txset
+stgtxy          stg_txquality
+stgunn          stg_unknown
+stgwry          stg_writetty
+sthash          sthash
+sthead          sthead
+stinfo          stinfo
+stkmkg          stk_mkseg
+stkmkg          stk_mkseg
+stmark          stmark
+stname          stname
+stnext          stnext
+stnsys          stnsymbols
+stopen          stopen
+stpstr          stpstr
+strcle          strclose
+strdic          strdic
+strefb          strefstab
+streff          strefsbuf
+streq           streq
+strese          strestore
+strge           strge
+strgee          strgetmode
+strgt           strgt
+strids          stridxs
+stridx          stridx
+strlds          strldxs
+strldx          strldx
+strle           strle
+strlt           strlt
+strlwr          strlwr
+strmac          strmac
+strmah          strmatch
+strncp          strncmp
+strne           strne
+stropn          stropen
+strse1          strse1
+strsee          strsetmode
+strseh          strsearch
+strsrt          strsrt
+strtbl          strtbl
+strupr          strupr
+stsave          stsave
+stsize          stsize
+stsque          stsqueeze
+sttyco          sttyco
+sttyet          stty_envreset
+sttygg          stty_getarg
+sttynm          stty_newterm
+sttyse          stty_setsize
+sttysm          stty_showterm
+sttytt          stty_ttyinit
+stxchs          stx_chars
+stxpas          stx_parameters
+stxpas          stx_parameters
+stxpas          stx_parameters
+stxpas          stx_parameters
+stxset          stx_segment
+stxset          stx_segment
+stxset          stx_segment
+stxset          stx_segment
+symbol          symbol
+syserr          syserr
+sysers          syserrs
+sysged          sys_getcommand
+sysges          sys_getpars
+sysgsg          sys_gstrarg
+sysid           sysid
+sysmte          sys_mtime
+syspac          sys_panic
+syspat          sys_paramset
+syspte          sys_ptime
+sysret          sys_redirect
+syssct          sys_scanarglist
+talloe          t_allocate
+tautoh          t_autograph
+tbfapd          t_bfappend
+tcalcp          t_calcomp
+tcap            t_cap
+tcdumd          tc_dummy_ttyload
+tcinic          tc_init_datac
+tcinii          tc_init_datai
+tclear          t_clear
+tcliet          t_client
+tcmp            t_cmp
+tcomp           t_comp
+tconrc          t_conrec
+tconrn          t_conran
+tconrq          t_conraq
+tconrs          t_conras
+tcopy           t_copy
+tcopy           tcopy_
+tcoune          t_countpoe
+tcputr          tc_putstr
+tcreae          t_create
+tctowd          t_ctowrd
+tcwris          tc_write_data_declarations215
+tdashh          t_dashsmth
+tdashr          t_dashchar
+tdayte          t_daytime
+tdeale          t_deallocate
+tdebug          t_debug
+tdump           t_dump
+tdumpl          t_dumpevl
+tedit           t_edit
+tefont          t_efont
+tencoe          t_encode
+tenter          t_enter
+teq             t_eq
+testtt          testtext
+testxt          testxset
+texpad          t_expand
+textrt          t_extract
+tezcoc          t_ezconrec
+teziss          t_ezisos
+tezmag          t_ezmapg
+tezsue          t_ezsurface
+tezvet          t_ezvelvect
+tezytt          t_ezytst
+tfcace          t_fcache
+tfind           t_find
+tfloat          t_float
+tfnl            t_fnl
+tfont           t_font
+tfree           t_free
+tge             t_ge
+tget            t_get
+tgettk          tgettk_
+tggcur          t_ggcur
+tgkide          t_gkidecode
+tgrey           t_grey
+tgrid           t_grid
+tgt             t_gt
+thello          thello_
+thlist          t_hlist
+thttp           t_http
+ticks           ticks
+timdkn          t_imdkern
+timt            t_imt
+timtet          t_imtest
+tinit           t_init
+tinv            t_inv
+tirafs          t_irafks
+tisosf          t_isosrf
+tle             t_le
+tlex            t_lex
+tlist           t_list
+tload           t_load
+tlt             t_lt
+tmany           t_many
+tmark           t_mark
+tmat            t_mat
+tmemck          t_memchk
+tmergi          t_mergei
+tmio            t_mio
+tmkfie          t_mkfile
+tmkmak          t_mkmask
+tmkpoe          t_mkpoe
+tmktta          t_mkttydata
+tmpp            t_mpp
+tmtcoy          t_mtcopy
+tmtexe          t_mtexamine
+tmtpon          t_mtposition
+tncmp           t_ncmp
+tne             t_ne
+tnewcy          t_newcopy
+tnsppn          t_nsppkern
+toldao          t_oldauto
+toshot          to_short
+tparsi          t_parsei
+tparsr          t_parser
+tpbb            t_pbb
+tplote          t_plotpoe
+tpltet          t_pltest
+tpmtet          t_pmtest
+tprint          tprint_
+tprzs           t_przs
+tput            t_put
+tpwriy          t_pwrity
+tqppae          t_qpparse
+trealc          t_realloc
+trealc          t_realloc
+trebud          t_rebuild
+trecio          t_recio
+trewid          t_rewind
+trexec          t_rexec
+trread          t_rread
+trtype          t_rtype
+tsave           t_save
+tscan           tscan_
+tscrit          t_script
+tseeft          t_seefont
+tservr          t_server
+tsetft          t_setfilt
+tsetmk          t_setmask
+tsetws          t_setwcs
+tsgide          t_sgidecode
+tsgikn          t_sgikern
+tshow           t_show
+tshowp          t_showcap
+tsimpe          t_simple
+tsleep          tsleep
+tslio           t_slio
+tspawn          t_spawn
+tspool          t_spool
+tsrch           t_srch
+tsrftt          t_srftest
+tstats          t_status
+tstdgh          t_stdgraph
+tstrmn          t_strmln
+tsum            t_sum
+tsum            t_sum
+tsurfe          t_surface
+tsym            t_sym
+tsyms           t_syms
+tteste          t_testpoe
+ttext           t_text
+ttfilr          t_tfilter
+tthre2          t_threed2
+tthred          t_threed
+ttokes          t_tokens
+ttopen          ttopen
+ttseti          ttseti
+ttsets          ttsets
+ttstai          ttstati
+ttstas          ttstats
+ttty            t_tty
+ttxo            t_txo
+ttxup           t_txup
+tty_continue    tty_continue
+tty_onsig       tty_onsig
+tty_rawon       tty_rawon
+tty_reset       tty_reset
+tty_stop        tty_stop
+ttybih          tty_binsearch
+ttybre          tty_break_line
+ttycas          ttycaps
+ttycds          ttycdes
+ttycle          ttyclose
+ttycln          ttyclearln
+ttyclr          ttyclear
+ttyctl          ttyctrl
+ttydee          ttydevname
+ttydey          ttydelay
+ttyeny          tty_encode_capability161
+ttyexs          tty_extract_alias
+ttyfey          tty_fetch_entry
+ttyfiy          tty_find_capability
+ttygds          ttygdes
+ttygeb          ttygetb
+ttygei          ttygeti
+ttyger          ttygetr
+ttyges          ttygets
+ttygoo          ttygoto
+ttygpe          ttygputline
+ttygse          ttygsize
+ttyins          tty_index_caps
+ttyint          ttyinit
+ttylod          ttyload
+ttyods          ttyodes
+ttyopn          ttyopen
+ttype           t_type
+ttypue          ttyputline
+ttypus          ttyputs
+ttyred          ttyread
+ttysce          tty_scan_termcap_file
+ttysei          ttyseti
+ttyso           ttyso
+ttysti          ttystati
+ttysui          ttysubi
+ttywre          ttywrite
+tunget          t_unget
+tvelvt          t_velvect
+tvttet          t_vttest
+twcs            t_wcs
+twtese          t_wtestfile
+u_allocstat     u_allocstat
+u_atof          atof
+u_atoi          atoi
+u_atol          atol
+u_calloc        calloc
+u_crackformat   u_crackformat
+u_doarg         u_doarg
+u_doprnt        u_doprnt
+u_doscan        u_doscan
+u_envget        envget
+u_eprintf       eprintf
+u_fclose        fclose
+u_fdopen        fdopen
+u_fflush        fflush
+u_fgetc         fgetc
+u_fgets         fgets
+u_fopen         fopen
+u_fprintf       fprintf
+u_fputc         fputc
+u_fputs         fputs
+u_fread         fread
+u_free          free
+u_freopen       freopen
+u_fscanf        fscanf
+u_fseek         fseek
+u_ftell         ftell
+u_fwrite        fwrite
+u_gets          gets
+u_getw          getw
+u_index         index
+u_isatty        isatty
+u_malloc        malloc
+u_mktemp        mktemp
+u_perror        perror
+u_printf        printf
+u_puts          puts
+u_putw          putw
+u_qsort         qsort
+u_realloc       realloc
+u_rewind        rewind
+u_rindex        rindex
+u_scanf         scanf
+u_scannum       u_scannum
+u_scanstr       u_scanstr
+u_setbuf        setbuf
+u_setfbf        setbuffer
+u_setlinebuf    setlinebuf
+u_setucc        u_setucc
+u_sprintf       sprintf
+u_sscanf        sscanf
+u_strcat        strcat
+u_strcmp        strcmp
+u_strcpy        strcpy
+u_strlen        strlen
+u_strnp         strncmp
+u_strnt         strncat
+u_strny         strncpy
+u_system        system
+u_ungetc        ungetc
+uid_executing   uid_executing
+uio_bwrite      uio_bwrite
+ungete          ungetline
+ungeti          ungetci
+unread          unread
+urand           urand
+vdm             vdm
+vfnadd          vfnadd
+vfncle          vfnclose
+vfndee          vfn_decode
+vfndel          vfndel
+vfnene          vfn_encode
+vfnenr          vfn_enter
+vfnexr          vfn_expand_ldir
+vfngen          vfn_getosfn
+vfnise          vfn_is_hidden_file868
+vfnman          vfn_map_extension
+vfnmap          vfnmap
+vfnmau          vfnmapu
+vfnopn          vfnopen
+vfnsqe          vfn_squeeze
+vfntre          vfn_translate
+vfnunn          vfn_unmap_extension733
+vfnunp          vfnunmap
+vlibinit        VLIBINIT
+vmallc          vmalloc
+vmallc          vmalloc
+vvfncm          vvfn_checksum
+vvfnee          vvfn_escape
+vvfnip          vvfn_init_extnmap
+vvfnis          vvfn_init_reserved_extns908
+vvfnre          vvfn_readmapfile
+wfaitd          wf_ait_fwd
+wfaitt          wf_ait_init
+wfaitv          wf_ait_inv
+wfarcd          wf_arc_fwd
+wfarct          wf_arc_init
+wfarcv          wf_arc_inv
+wfcard          wf_car_fwd
+wfcart          wf_car_init
+wfcarv          wf_car_inv
+wfcscd          wf_csc_fwd
+wfcsct          wf_csc_init
+wfcscv          wf_csc_inv
+wfdecs          wf_decaxis
+wffnld          wf_fnload
+wfglsd          wf_gls_fwd
+wfglst          wf_gls_init
+wfglsv          wf_gls_inv
+wfinit          wf_init
+wfmerd          wf_mer_fwd
+wfmert          wf_mer_init
+wfmerv          wf_mer_inv
+wfmold          wf_mol_fwd
+wfmolt          wf_mol_init
+wfmolv          wf_mol_inv
+wfmspd          wf_msp_fwd
+wfmspf          wf_msp_coeff
+wfmspi          wf_msp_evali
+wfmspl          wf_msp_eval
+wfmspt          wf_msp_init
+wfmspv          wf_msp_inv
+wfmspy          wf_msp_destroy
+wfpard          wf_par_fwd
+wfpart          wf_par_init
+wfparv          wf_par_inv
+wfpcod          wf_pco_fwd
+wfpcot          wf_pco_init
+wfpcov          wf_pco_inv
+wfqscd          wf_qsc_fwd
+wfqsct          wf_qsc_init
+wfqscv          wf_qsc_inv
+wfsind          wf_sin_fwd
+wfsint          wf_sin_init
+wfsinv          wf_sin_inv
+wfsmph          wf_smp_binsearch
+wfsmpn          wf_smp_ctran
+wfsmpt          wf_smp_init
+wfstgd          wf_stg_fwd
+wfstgt          wf_stg_init
+wfstgv          wf_stg_inv
+wftand          wf_tan_fwd
+wftant          wf_tan_init
+wftanv          wf_tan_inv
+wftscd          wf_tsc_fwd
+wftsct          wf_tsc_init
+wftscv          wf_tsc_inv
+wfzead          wf_zea_fwd
+wfzeat          wf_zea_init
+wfzeav          wf_zea_inv
+writeb          writeb
+xalloe          xallocate
+xcallc          calloc
+xcallc          calloc
+xdeale          xdeallocate
+xdevor          xdevowner
+xdevss          xdevstatus
+xeract          xeract
+xerfmg          xer_fmterrmsg
+xerpoi          xerpopi
+xerpop          xerpop
+xerpsh          xerpsh
+xerpsr          xerpstr
+xerpuc          xerputc
+xerpue          xer_putline
+xerret          xer_reset
+xerror          error
+xersel          xer_send_error_statement_to_cl
+xervey          xer_verify
+xevadg          xev_addarg
+xevbip          xev_binop
+xevbop          xev_boolop
+xevcan          xev_callfcn
+xever1          xev_error1
+xever2          xev_error2
+xeverr          xev_error
+xevfrp          xev_freeop
+xevgek          xev_gettok
+xevinp          xev_initop
+xevmap          xev_makeop
+xevnee          xev_newtype
+xevpah          xev_patmatch
+xevqut          xev_quest
+xevstt          xev_startarglist
+xevunp          xev_unop
+xfaccs          access
+xfatal          fatal
+xfchdr          fchdir
+xfcloe          close
+xfdele          delete
+xffluh          flush
+xfgetc          getc
+xfgetr          getchar
+xfnote          note
+xfopen          open
+xfputc          putc
+xfputr          putchar
+xfread          read
+xfrnam          rename
+xfscan          fscan
+xfseek          seek
+xfungc          ungetc
+xfwrie          write
+xgdevt          xgdevlist
+xgtpid          getpid
+xgtuid          getuid
+xisaty          xisatty
+xmallc          malloc
+xmallc          malloc
+xmfree          mfree
+xmfree          mfree
+xmjbuf          xmjbuf
+xmktep          mktemp
+xonerr          xonerror
+xonext          xonexit
+xori            xori
+xorl            xorl
+xors            xors
+xpages          xpagefiles
+xprinf          printf
+xqsort          qsort
+xrealc          realloc
+xrealc          realloc
+xsizef          sizeof
+xsizef          sizeof
+xstdeh          xstdexh
+xstrcp          strcmp
+xstrct          strcat
+xstrcy          strcpy
+xstrln          strlen
+xtoc            xtoc
+xttyse          xttysize
+xvvadg          xvv_addarg
+xvvbip          xvv_binop
+xvvbop          xvv_boolop
+xvvcan          xvv_callfcn
+xvvche          xvv_chtype
+xvver1          xvv_error1
+xvver2          xvv_error2
+xvverr          xvv_error
+xvvfrp          xvv_freeop
+xvvgek          xvv_gettok
+xvvinp          xvv_initop
+xvvlos          xvv_loadsymbols
+xvvmap          xvv_makeop
+xvvnee          xvv_newtype
+xvvnud          xvv_nulld
+xvvnui          xvv_nulli
+xvvnul          xvv_nulll
+xvvnur          xvv_nullr
+xvvnus          xvv_nulls
+xvvpah          xvv_patmatch
+xvvqut          xvv_quest
+xvvstt          xvv_startarglist
+xvvunp          xvv_unop
+xwhen           xwhen
+xxscan          scan
+yypare          yyparse
+yypare          yyparse
+zardbf          ZARDBF
+zardks          ZARDKS
+zardlp          ZARDLP
+zardmt          zardmt
+zardnd          ZARDND
+zardnu          zardnu
+zardpl          ZARDPL
+zardpr          ZARDPR
+zardps          zardps
+zardsf          ZARDSF
+zawrbf          ZAWRBF
+zawrks          ZAWRKS
+zawrlp          ZAWRLP
+zawrmt          zawrmt
+zawrnd          ZAWRND
+zawrnu          zawrnu
+zawrpl          ZAWRPL
+zawrpr          ZAWRPR
+zawrps          zawrps
+zawrsf          ZAWRSF
+zawset          ZAWSET
+zawtbf          ZAWTBF
+zawtks          ZAWTKS
+zawtlp          ZAWTLP
+zawtmt          zawtmt
+zawtnd          ZAWTND
+zawtnu          zawtnu
+zawtpl          ZAWTPL
+zawtpr          ZAWTPR
+zawtps          zawtps
+zawtsf          ZAWTSF
+zcall0          ZCALL0
+zcall1          ZCALL1
+zcall2          ZCALL2
+zcall3          ZCALL3
+zcall4          ZCALL4
+zcall5          ZCALL5
+zcall6          ZCALL6
+zcall7          ZCALL7
+zcall8          ZCALL8
+zcall9          ZCALL9
+zcalla          ZCALLA
+zclcpr          ZCLCPR
+zcldir          ZCLDIR
+zcldpr          ZCLDPR
+zclsbf          ZCLSBF
+zclsks          ZCLSKS
+zclslp          ZCLSLP
+zclsmt          zclsmt
+zclsnd          ZCLSND
+zclsnu          zclsnu
+zclspl          ZCLSPL
+zclsps          zclsps
+zclssf          ZCLSSF
+zclstt          zclstt
+zclstx          ZCLSTX
+zclsty          ZCLSTY
+zdojmp          ZDOJMP
+zdvall          ZDVALL
+zdvown          ZDVOWN
+zfacss          ZFACSS
+zfaloc          ZFALOC
+zfchdr          ZFCHDR
+zfdele          ZFDELE
+zfgcwd          ZFGCWD
+zfinfo          ZFINFO
+zflsnu          zflsnu
+zflstt          zflstt
+zflstx          ZFLSTX
+zflsty          ZFLSTY
+zfmkcp          ZFMKCP
+zfmkdr          ZFMKDR
+zfnbrk          ZFNBRK
+zfpath          ZFPATH
+zfprot          ZFPROT
+zfrnam          ZFRNAM
+zfsubd          ZFSUBD
+zfunc0          ZFUNC0
+zfunc1          ZFUNC1
+zfunc2          ZFUNC2
+zfunc3          ZFUNC3
+zfunc4          ZFUNC4
+zfunc5          ZFUNC5
+zfunc6          ZFUNC6
+zfunc7          ZFUNC7
+zfunc8          ZFUNC8
+zfunc9          ZFUNC9
+zfunca          ZFUNCA
+zfxdir          ZFXDIR
+zgcmdl          ZGCMDL
+zgetnu          zgetnu
+zgettt          zgettt
+zgettx          ZGETTX
+zgetty          ZGETTY
+zgfdir          ZGFDIR
+zghost          ZGHOST
+zgtenv          ZGTENV
+zgtime          ZGTIME
+zgtpid          ZGTPID
+zintpr          ZINTPR
+zlocpr          ZLOCPR
+zlocva          ZLOCVA
+zmaloc          ZMALOC
+zmfree          ZMFREE
+zmtbsf          zmtbsf
+zmtbsr          zmtbsr
+zmtclose        zmtclose
+zmtdbg          zmtdbg
+zmtdbg1         zmtdbg1
+zmtdbg2         zmtdbg2
+zmtdbg3         zmtdbg3
+zmtdbg4         zmtdbg4
+zmtdbg5         zmtdbg5
+zmtdbgclose     zmtdbgclose
+zmtdbgopen      zmtdbgopen
+zmtdesc         zmtdesc
+zmtfls          zmtfls
+zmtfpos         zmtfpos
+zmtfree         zmtfree
+zmtfsf          zmtfsf
+zmtfsr          zmtfsr
+zmtgetfd        zmtgetfd
+zmtopen         zmtopen
+zmtrew          zmtrew
+znotnu          znotnu
+znottt          znottt
+znottx          ZNOTTX
+znotty          ZNOTTY
+zopcpr          ZOPCPR
+zopdir          ZOPDIR
+zopdpr          ZOPDPR
+zopnbf          ZOPNBF
+zopnks          ZOPNKS
+zopnlp          ZOPNLP
+zopnmt          zopnmt
+zopnnd          ZOPNND
+zopnnu          zopnnu
+zopnpl          ZOPNPL
+zopnsf          ZOPNSF
+zopntt          zopntt
+zopntx          ZOPNTX
+zopnty          ZOPNTY
+zoscmd          ZOSCMD
+zpanic          ZPANIC
+zputnu          zputnu
+zputtt          zputtt
+zputtx          ZPUTTX
+zputty          ZPUTTY
+zraloc          ZRALOC
+zseknu          zseknu
+zsektt          zsektt
+zsektx          ZSEKTX
+zsekty          ZSEKTY
+zsestt          zsestt
+zsettt          zsettt
+zststt          zststt
+zsttbf          ZSTTBF
+zsttks          ZSTTKS
+zsttlp          ZSTTLP
+zsttmt          zsttmt
+zsttnd          ZSTTND
+zsttnu          zsttnu
+zsttpl          ZSTTPL
+zsttpr          ZSTTPR
+zsttps          zsttps
+zsttsf          ZSTTSF
+zstttt          zstttt
+zstttx          ZSTTTX
+zsttty          ZSTTTY
+zttgeg          ztt_getlog
+zttger          ztt_getchar
+zttloe          ztt_lowercase
+zttloo          ztt_logio
+zttlov          ztt_logdev
+zttpbf          ztt_pboff
+zttplk          ztt_playback
+zttpug          ztt_putlog
+zttquy          ztt_query
+zttttt          ztt_ttyput
+zttupe          ztt_uppercase
+zwmsec          ZWMSEC
+zxgmes          ZXGMES
+zxwhen          ZXWHEN
+zzclmt          ZZCLMT
+zzhelp          zz_help
+zzopmt          ZZOPMT
+zzrdmt          ZZRDMT
+zzrwmt          ZZRWMT
+zzsetk          ZZSETK
+zzstmt          ZZSTMT
+zzstop          ZZSTOP
+zzstrt          ZZSTRT
+zzwrmt          ZZWRMT
+zzwtmt          ZZWTMT
diff --git a/sys/README b/sys/README
new file mode 100644
index 00000000..52391e06
--- /dev/null
+++ b/sys/README
@@ -0,0 +1,27 @@
+These directories contain the source and libraries for the IRAF system, i.e.,
+the system interface or "virtual operating system" (VOS) and the machine
+independent i/o libraries comprising the program interface.  To rebuild the
+VOS merely run "mkpkg" after bringing up the bootstrap utilities and libraries
+in host$.  To relink the system executables after an important modification
+to the VOS, type "mkpkg update".
+
+    clio	command language i/o
+    dbio	database i/o
+    etc		miscellanous system modules
+    fio		file i/o
+    flib	contains nop.x, used to list modules for libmain.o
+    fmtio	formatted i/o
+    gio		graphics i/o
+    imio	image i/o
+    ki		kernel inteface (networking)
+    memio	memory i/o
+    mkpkg	descriptor file for the MKPKG utility
+    mtio	magnetic tape i/o
+    osb		bit and byte primitives
+    spool	record of the last sysgen
+    vops	vector operators
+
+For example:
+
+	mkpkg >& spool &		make or update the VOS libraries
+	mkpkg update			update the system executables
diff --git a/sys/_sys.hd b/sys/_sys.hd
new file mode 100644
index 00000000..4179b770
--- /dev/null
+++ b/sys/_sys.hd
@@ -0,0 +1,5 @@
+# Root help directory for the SYS branch of the help database.
+
+sys		sys = sys$README, 
+		hlp = sys$sys.men,
+		pkg = sys$sys.hd
diff --git a/sys/clio/README b/sys/clio/README
new file mode 100644
index 00000000..757b5550
--- /dev/null
+++ b/sys/clio/README
@@ -0,0 +1,98 @@
+CLIO - Command Language I/O.
+
+This is the interface between IRAF applications and the IRAF command
+language.  To an application, the CL appears to be a database managing named
+"psets" (parameter sets) containing parameters.  CLIO is used by the
+application to read and write these parameters.  The parameter sets are
+predefined at the CL level rather than being dynamically defined by the
+application.
+
+
+EXTERNAL ROUTINES
+
+			 clseti (clio-param, value)
+		value = clstati (clio-param)
+
+        value = clget[bcsilrdx] (param)
+		clput[bcsilrdx] (param, value)
+			 clgstr (param, outstr, maxch)
+			 clpstr (param, value)
+     nelem|EOF = clgl[bcsilrdx] (param, value)
+	   nchars|EOF = clglstr (param, outstr, maxch)
+
+	       key|EOF = clgcur (param, wx, wy, wcs, key, strval, maxch)
+		nitems = clgkey (param, key, strval, maxch)
+	       kwindex = clgwrd (param, keyword, maxchar, dictionary)
+
+		   pp = clopset (pset)
+			clcpset (pp)
+       pval = clgpset[bcsilrdx] (pp, param)
+	      clppset[bcsilrdx] (pp, param, pval)
+		       clgpseta (pp, pname, outstr, maxch)
+		       clppseta (pp, pname, sval)
+			cllpset (pp, fd, format)
+			clepset (pp)
+
+
+OBSOLETE ROUTINES
+
+	     list = clpopn[isu] (param)
+			 clpcls (list)
+			 clprew (list)
+		 nelem = clplen (list)
+		nchars = clgfil (list, fname, maxch)
+
+			clgpset (pp, pname, outstr, maxch)
+			clppset (pp, pname, sval)
+
+
+RESTRICTED ROUTINES
+
+			  clcmd (cmd)
+			 clcmdw (cmd)
+
+			 clopen (stdin, stdout, stderr, device, devtype)
+			 zclsps (chan, status)
+			 zardps (ps, buf, maxbytes, offset)
+			 zawrps (ps, buf, nbytes, offset)
+			 zawtps (ps, status)
+			 zsttps (ps, what, lvalue)
+
+		       clc_init ()
+		   clc_compress ()
+		       clc_free (marker)
+		       clc_mark (marker)
+		    clc_newtask (taskname)
+		      clc_enter (param, value)
+	     nchars = clc_fetch (param, outstr, maxch)
+		 sym = clc_find (param, outstr, maxch)
+		       clc_list (fd, pset, format)
+		       clc_scan (cmd)
+
+			 gexfls ()
+		     gexfls_set (stream, gp_value, epa_gflush)
+		   gexfls_clear (stream)
+
+
+INTERNAL ROUTINES
+
+	       key|EOF = rdukey (keystr, maxch)
+	 charp = clpset_parname (pp, parname)
+       status = cl_psio_request (cmd, arg1, arg2)
+		       clreqpar (param)
+
+
+INTERFACE PARAMETERS
+
+	# clstati parameters (read only).
+	CL_PRTYPE	# parent process type (see below)
+	CL_PCACHE	# symtab descriptor of param cache
+
+	# Process type codes.
+	PR_CONNECTED	# connected subprocess
+	PR_DETACHED	# detached subprocess
+	PR_HOST		# subprocess spawned by host
+
+	# Process interpreter mode codes (used by ONENTRY and the iraf main).
+	PR_NOEXIT	# run interpreter in Iraf Main
+	PR_EXIT		# skip interpreter, shutdown process
diff --git a/sys/clio/clcache.x b/sys/clio/clcache.x
new file mode 100644
index 00000000..2d6df333
--- /dev/null
+++ b/sys/clio/clcache.x
@@ -0,0 +1,490 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<clio.h>
+
+.help clcache
+.nf ___________________________________________________________________________
+CLCACHE -- A package for cacheing the values of static parameters, i.e., 
+parameters with values fixed at task invocation time.
+
+The purpose of this package is to improve the runtime performance of the
+parameter passing mechanism.  The runtime semantics of the CLIO interface are
+not affected.  Transmission of the static parameters during task invocation
+can save many runtime context switches, saving seconds of clock time when
+running tasks which have many (dozens of) parameters.
+
+
+		 clc_init ()			# initialize the cache
+	     clc_compress ()			# rebuild the cache
+	      clc_newtask (taskname)		# set name of root pset
+		 clc_mark (sp)			# mark cache status
+		 clc_free (sp)			# free to last mark
+
+		clc_enter (param, value)	# cache a parameter
+       nchars = clc_fetch (param, out, maxch)	# fetch cached parameter
+          symp = clc_find (param, out, maxch)	# find cached parameter
+
+		 clc_scan (cmd)			# scan a param=value stmt
+		 clc_list (fd, pset, format)	# list params to a file
+
+The cache is initialized by the IRAF main with CLC_INIT during process
+startup and whenever a new task is run.  Parameter value pairs are entered
+into the cache with CLC_ENTER during processing of the command line.
+Runtime get parameter requests from the task are satisfied from the cache if
+possible, querying the CL only if the cached value cannot be found.  Note
+that query mode and list type parameters are never cached since they do not
+have static values.
+
+A task can be called either with named parameters or with unnamed, positional
+parameters.  In the latter case the parameters are passed as "$1", "$2", etc.
+If we receive one or more numbered parameters they will be entered into the
+symbol table in the usual way but a list of offsets of the positional
+arguments will be saved in the clio common.  Subsequent runtime parameter
+requests will be satisfied by trying to find the parameter by name in the
+symbol table, returning the next positional argument if the named parameter
+cannot be found.  This is the mechanism used by the CL to satisfy requests
+for parameters from a task which has no parameter file.
+
+The values of all parameters are saved in the cache in string format.  Since
+all parameters come from the CL in string format this makes for an easy
+interface to the high level CLIO code.  The internal storage format for the
+cache is a SYMTAB hash table, simplifying the implementation and providing
+optimal performance.  There is no fixed limit on the size of the cache.
+.endhelp _____________________________________________________________________
+
+# SYMTAB default allocation parameters (non-limiting).
+define	LEN_INDEX	128		# nbuckets in symtab hash index
+define	LEN_STAB	512		# initial symbol table size
+define	SZ_SBUF		2048		# initial string buffer size
+
+
+# Symbol table structure (not much to it).
+
+define	LEN_SYMSTRUCT	1
+define	SYM_VALUE	Memi[$1]	# sbuf offset of value string
+
+
+# CLC_INIT -- Initialize the parameter cache.  Called during process
+# startup.  May be called repeatedly to reinitialize the cache.
+
+procedure clc_init()
+
+pointer	stopen()
+bool	first_time
+data	first_time /true/
+include	"clio.com"
+errchk	stopen
+
+begin
+	if (first_time) {
+	    cl_stp = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF)
+	    first_time = false
+	} else
+	    call stfree (cl_stp, cl_stmark)
+
+	call stmark (cl_stp, cl_stmark)
+	call aclri (cl_posarg, MAX_POSARGS)
+	cl_nposargs = 0
+	cl_nextarg  = 1
+end
+
+
+# CLC_NEWTASK -- Set the name of the task whose parameters are to be
+# entered into the cache (the taskname is the root pset).
+
+procedure clc_newtask (taskname)
+
+char	taskname[ARB]		# name of the task being run
+
+int	gstrcpy()
+include	"clio.com"
+
+begin
+	cl_psetop = gstrcpy (taskname, cl_psetname, SZ_PSETNAMEBUF) + 2
+	cl_psetindex[1] = 1
+	cl_npsets = 1
+end
+
+
+# CLC_MARK -- Mark storage in the cache for subsequent restoration by
+# clc_free.
+
+procedure clc_mark (marker)
+
+pointer	marker			# receives marked position
+include	"clio.com"
+
+begin
+	call stmark (cl_stp, marker)
+end
+
+
+# CLC_FREE -- Free storage in the cache back to the marked position.  Any
+# positional arguments are lost.
+
+procedure clc_free (marker)
+
+pointer	marker			# marked position
+include	"clio.com"
+
+begin
+	call stfree (cl_stp, marker)
+	cl_nposargs = 0
+	cl_nextarg  = 1
+	call aclri (cl_posarg, MAX_POSARGS)
+end
+
+
+# CLC_ENTER -- Enter a parameter-value pair into the cache.  If the parameter
+# is an unnamed positional parameter ($N) it is entered in the usual way
+# with name $N, but its symtab pointer is also saved in the positional argument
+# list.  It is safe to save the pointer rather than the index because tasks
+# which do not have pfiles never have more than a few arguments, hence the
+# symtab will not be reallocated during entry.
+#
+# If the parameter name is of the form psetname.paramname, extract the pset
+# name and add it to the list of pset names for the task.  The order in which
+# the pset names are defined will be the order in which they are later searched
+# when satifying ambiguous references (where the psetname is not specified).
+
+procedure clc_enter (param, value)
+
+char	param[ARB]		# parameter name
+char	value[ARB]		# parameter value string
+
+pointer	sym
+int	off, ch, pp, op, ip, n
+bool	streq()
+pointer	stenter()
+int	stpstr(), ctoi()
+errchk	stenter, syserrs
+include	"clio.com"
+
+begin
+	sym = stenter (cl_stp, param, LEN_SYMSTRUCT)
+	SYM_VALUE(sym) = stpstr (cl_stp, value, 0)
+
+	if (param[1] == '$') {
+	    # Positional argument (no pfile/pset).
+
+	    ip = 2
+	    if (ctoi (param, ip, n) > 0) {
+		n = max(1, min(MAX_POSARGS, n))
+		cl_posarg[n] = sym
+		cl_nposargs  = max (cl_nposargs, n)
+	    }
+
+	} else {
+	    # Check if the parameter name includes the psetname prefix,
+	    # and if so, append the pset name to the pset name list if
+	    # not already there.
+
+	    pp = cl_psetop
+	    op = pp
+
+	    # Extract psetname.
+	    do ip = 1, SZ_PNAME {
+		ch = param[ip]
+		if (ch == EOS) {
+		    return			# no psetname given
+		} else if (ch == '.') {
+		    cl_psetname[op] = EOS
+		    break
+		} else {
+		    cl_psetname[op] = ch
+		    op = op + 1
+		}
+	    }
+
+	    # If pset already in list we are done.
+	    ch = param[1]
+	    do ip = cl_npsets, 1, -1 {
+		off = cl_psetindex[ip]
+		if (cl_psetname[off] == ch)
+		    if (streq (cl_psetname[pp], cl_psetname[off]))
+			return
+	    }
+
+	    # Pset not found, so enter new pset name into list.
+	    cl_npsets = cl_npsets + 1
+	    if (cl_npsets > MAX_PSETS)
+		call syserrs (SYS_CLNPSETS, cl_psetname[pp])
+
+	    cl_psetindex[cl_npsets] = pp
+	    cl_psetop = op + 1
+	    if (cl_psetop > SZ_PSETNAMEBUF)
+		call syserrs (SYS_CLPSETOOS, cl_psetname[pp])
+	}
+end
+
+
+# CLC_FETCH -- Search the CL parameter cache for the named parameter and
+# return its value if found.  If the parameter is not found and there are
+# positional arguments, return the value of the next positional argument.
+# The number of characters in the output string is returned as the function
+# value if the parameter is found, else ERR is returned.
+
+int procedure clc_fetch (param, outstr, maxch)
+
+char	param[ARB]		# parameter to be fetched
+char	outstr[maxch]		# receives value string of parameter
+int	maxch
+
+pointer	sym, vp
+int	gstrcpy()
+pointer	strefsbuf(), clc_find()
+include	"clio.com"
+
+begin
+	# Search the symbol table for the named parameter.
+	sym = clc_find (param, outstr, maxch)
+
+	# If the named parameter could not be found using the given name or
+	# in any pset in the table, use the next positional argument if there
+	# is one.
+
+	while (sym == NULL)
+	    if (cl_nextarg <= cl_nposargs) {
+		sym = cl_posarg[cl_nextarg]
+		cl_nextarg = cl_nextarg + 1
+	    } else {
+		outstr[1] = EOS
+		return (ERR)
+	    }
+
+	vp = strefsbuf (cl_stp, SYM_VALUE(sym))
+	return (gstrcpy (Memc[vp], outstr, maxch))
+end
+
+
+# CLC_FIND -- Search the CL parameter cache for the named parameter and
+# return its symtab pointer and full name if found. 
+
+pointer procedure clc_find (param, outstr, maxch)
+
+char	param[ARB]		# parameter to be fetched
+char	outstr[maxch]		# receives full name of parameter
+int	maxch
+
+pointer	sym
+int	op, ip, ch, i
+pointer	stfind()
+include	"clio.com"
+
+begin
+	# Look first for the named parameter, and if that is not found,
+	# search each pset for the named parameter, i.e., prepend the name
+	# of each pset to produce a name of the form "pset.param", and
+	# look that up in the symbol table.  The first entry in the pset
+	# name list is the name of the task itself.
+
+	sym = stfind (cl_stp, param)
+	if (sym == NULL) {
+	    do i = 1, cl_npsets {
+		op = 1
+
+		# Start with pset name.
+		do ip = cl_psetindex[i], SZ_PSETNAMEBUF {
+		    ch = cl_psetname[ip]
+		    if (ch == EOS)
+			break
+		    else {
+			cl_pname[op] = ch
+			op = op + 1
+		    }
+		}
+
+		# Add dot delimiter.
+		cl_pname[op] = '.'
+		op = op + 1
+
+		# Lastly add the parameter name.
+		do ip = 1, SZ_FNAME {
+		    ch = param[ip]
+		    if (ch == EOS)
+			break
+		    else {
+			cl_pname[op] = ch
+			op = op + 1
+		    }
+		}
+
+		# Look it up in the symbol table.
+		cl_pname[op] = EOS
+		sym = stfind (cl_stp, cl_pname)
+		if (sym != NULL)
+		    break
+	    }
+	} else
+	    call strcpy (param, cl_pname, SZ_FNAME)
+
+	if (sym != NULL)
+	    call strcpy (cl_pname, outstr, maxch)
+
+	return (sym)
+end
+
+
+# CLC_SCAN -- Extract the param and value substrings from a param=value
+# statement and enter them into the CL parameter cache.
+
+procedure clc_scan (cmd)
+
+char	cmd[ARB]		#I command to be scanned
+
+int	ip
+pointer	sp, param, value, op, nchars
+int	stridx(), ctowrd()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_COMMAND, TY_CHAR)
+
+	# Skip any leading whitespace.
+	for (ip=1;  IS_WHITE(cmd[ip]);  ip=ip+1)
+	    ;
+
+	# Do nothing if blank line or comment.
+	if (cmd[ip] == EOS || cmd[ip] == '\n' || cmd[ip] == '#') {
+	    call sfree (sp)
+	    return
+	}
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) {
+	    Memc[op] = cmd[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance past the assignment operator.
+	while (IS_WHITE (cmd[ip]) || cmd[ip] == '=')
+	    ip = ip + 1
+
+	# Get the value string.
+	nchars = ctowrd (cmd, ip, Memc[value], SZ_COMMAND)
+
+	# Enter the param=value pair into the CL parameter cache.
+	call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end
+
+
+# CLC_LIST -- List the parameters in the named pset to an output file using
+# a caller supplied format.  If no pset is specified the entire contents of
+# the parameter cache are output.  A sample format is "set %s = \"%s\"\n".
+
+procedure clc_list (fd, pset, format)
+
+int	fd			#I output file
+char	pset[ARB]		#I pset to be listed, or EOS for full cache
+char	format[ARB]		#I output format - one %s each for param,value
+
+int	nsyms, i
+pointer	sp, syms, sympset, ip, op, sym, np
+
+bool	strne()
+pointer	sthead(), stnext(), stname(), strefsbuf()
+include	"clio.com"
+
+begin
+	# Count the number of parameters.
+	nsyms = 0
+	for (sym=sthead(cl_stp);  sym != NULL;  sym=stnext(cl_stp,sym))
+	    nsyms = nsyms + 1
+
+	call smark (sp)
+	call salloc (syms, nsyms, TY_POINTER)
+	call salloc (sympset, SZ_FNAME, TY_CHAR)
+
+	# Get a reversed list of symbol pointers.
+	op = syms + nsyms - 1
+	for (sym=sthead(cl_stp);  sym != NULL;  sym=stnext(cl_stp,sym)) {
+	    Memi[op] = sym
+	    op = op - 1
+	}
+
+	# Output the list.
+	do i = 1, nsyms {
+	    sym = Memi[syms+i-1]
+	    np = stname (cl_stp, sym)
+
+	    # Check the pset name if the user named a specific pset.
+	    if (pset[1] != EOS) {
+		# Get the pset name of the parameter.
+		op = sympset
+		for (ip=np;  Memc[ip] != EOS && Memc[ip] != '.';  ip=ip+1) {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+
+		# Skip if the wrong pset.
+		if (strne (Memc[sympset], pset))
+		    next
+	    }
+
+	    call fprintf (fd, format)
+		call pargstr (Memc[np])
+		call pargstr (Memc[strefsbuf(cl_stp,SYM_VALUE(sym))])
+	}
+
+	call sfree (sp)
+end
+
+
+# CLC_COMPRESS -- Compress the parameter cache.  Since every parameter
+# modification results in a new parameter entry (redef), the symbol table
+# can grow quite large if there are many clput type parameter accesses.
+# This operator rebuilds the parameter cache eliminating all old entries.
+
+procedure clc_compress ()
+
+pointer	n_st, o_st
+pointer	sym, newsym, np, vp
+
+int	stpstr()
+pointer	strefsbuf(), stopen(), stname()
+pointer	sthead(), stnext(), stfind(), stenter()
+errchk	stopen, stenter, stpstr
+include	"clio.com"
+
+begin
+	n_st = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF)
+	o_st = cl_stp
+
+	# Copy the symbol table, saving only the most recent entry for
+	# each symbol.
+
+	for (sym=sthead(o_st);  sym != NULL;  sym=stnext(o_st,sym)) {
+	    np = stname (o_st, sym)
+	    if (stfind (n_st, Memc[np]) == NULL) {
+		vp = strefsbuf (o_st, SYM_VALUE(sym))
+		newsym = stenter (n_st, Memc[np], LEN_SYMSTRUCT)
+		SYM_VALUE(newsym) = stpstr (n_st, Memc[vp], 0)
+	    }
+	}
+
+	# Copy back the saved symbols.  The "push/pop" way in which we use
+	# the temporary symbol table to save the symbols automatically
+	# preserves the original symbol table ordering.
+
+	call stfree (o_st, cl_stmark)
+	call stmark (o_st, cl_stmark)
+
+	for (sym=sthead(n_st);  sym != NULL;  sym=stnext(n_st,sym)) {
+	    np = stname (n_st, sym)
+	    vp = strefsbuf (n_st, SYM_VALUE(sym))
+	    newsym = stenter (o_st, Memc[np], LEN_SYMSTRUCT)
+	    SYM_VALUE(newsym) = stpstr (o_st, Memc[vp], 0)
+	}
+
+	call stclose (n_st)
+	call stsqueeze (o_st)
+end
diff --git a/sys/clio/clclose.x b/sys/clio/clclose.x
new file mode 100644
index 00000000..7d2b6cbf
--- /dev/null
+++ b/sys/clio/clclose.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# CLCLOSE -- "Close" the CL files (shut down CLIO).  Called by the IRAF Main
+# upon process shutdown.
+
+procedure clclose ()
+
+int	fd
+
+begin
+	# Remove buffers for the standard streams.
+	do fd = 1, FIRST_FD-1
+	    call frmbfs (fd)
+end
diff --git a/sys/clio/clcmd.x b/sys/clio/clcmd.x
new file mode 100644
index 00000000..99e21340
--- /dev/null
+++ b/sys/clio/clcmd.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<clset.h>
+
+# CLCMD -- Send a command line to the CL.  Virtually any general command
+# may be sent to the CL, providing a great deal of high level power at the
+# compiled task level.  Sending an explicit command to the CL, however,
+# requires that the task have detailed knowledge of the capabilities of
+# the CL and of the syntax of the command language.  This means that the task
+# is very dependent on the CL and may no longer work if the CL is modified,
+# or if there is more than one version of the CL in use in a system.  For
+# this reason CLCMD should only be used where it is truely necessary,
+# usually only in system utilities (for example, in a task like MAKE).
+
+procedure clcmd (cmd)
+
+char	cmd[ARB]
+
+int	junk
+int	oscmd(), clstati()
+errchk	syserr
+
+begin
+	if (cmd[1] == '!')
+	    junk = oscmd (cmd[2], "", "", "")
+	else if (clstati (CL_PRTYPE) != PR_CONNECTED)
+	    call syserr (SYS_CLCMDNC)
+	else {
+	    call flush (STDOUT)
+	    call putline (CLOUT, cmd)
+	    call putci (CLOUT, '\n')
+	    call flush (CLOUT)
+	}
+end
diff --git a/sys/clio/clcmdw.x b/sys/clio/clcmdw.x
new file mode 100644
index 00000000..ca8dfc4c
--- /dev/null
+++ b/sys/clio/clcmdw.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<clset.h>
+
+# CLCMDW -- Send a command line to the CL and wait for completion.
+
+procedure clcmdw (cmd)
+
+char	cmd[ARB]
+char	junkstr[1]
+
+int	junk
+int	oscmd(), clstati()
+errchk	syserr
+
+begin
+	if (cmd[1] == '!')
+	    junk = oscmd (cmd[2], "", "", "")
+	else if (clstati (CL_PRTYPE) != PR_CONNECTED)
+	    call syserr (SYS_CLCMDNC)
+	else {
+	    call flush (STDOUT)
+	    call putline (CLOUT, cmd)
+	    call putci (CLOUT, '\n')
+	    call clgstr ("cl.version", junkstr, 1)	# wait for completion
+	}
+end
diff --git a/sys/clio/clcpset.x b/sys/clio/clcpset.x
new file mode 100644
index 00000000..c6200b66
--- /dev/null
+++ b/sys/clio/clcpset.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLCPSET -- Close a pset.
+
+procedure clcpset (pp)
+
+pointer	pp		# pset descriptor
+
+begin
+	call mfree (pp, TY_STRUCT)
+end
diff --git a/sys/clio/clepset.x b/sys/clio/clepset.x
new file mode 100644
index 00000000..df0dce03
--- /dev/null
+++ b/sys/clio/clepset.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<clio.h>
+include	"clpset.h"
+
+# CLEPSET -- Edit a pset.  What exactly this operation implies depends
+# upon the CL.  To the application, it means any external operation which
+# can modify the pset.
+
+procedure clepset (pp)
+
+pointer	pp			#I pset descriptor
+
+pointer	sp, lbuf
+bool	streq()
+int	getlline()
+errchk	flush, getlline, clc_scan
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_COMMAND, TY_CHAR)
+
+	# Edit pset and dump edited version back to CLIN.  It is not
+	# necessary to write the pset to the CL before editing as the
+	# cache is "write-through" and any clputs will already have
+	# updated the CL version of the pset as well as the cache version.
+
+	call flush (STDOUT)
+	call fprintf (CLOUT, "eparam %s; dparam %s > %s\n")
+	    call pargstr (PS_PSETNAME(pp))
+	    call pargstr (PS_PSETNAME(pp))
+	    call pargstr (IPCOUT)
+	call flush (CLOUT)
+
+	# Parse the new "param = value" statements returned by dparam and
+	# update the parameter cache.
+	
+	while (getlline (CLIN, Memc[lbuf], SZ_COMMAND) != EOF)
+	    if (streq (Memc[lbuf], IPCDONEMSG))
+		break
+	    else
+		call clc_scan (Memc[lbuf])
+
+	# Delete the old parameter entries.
+	call clc_compress()
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clgcur.x b/sys/clio/clgcur.x
new file mode 100644
index 00000000..7ceeb868
--- /dev/null
+++ b/sys/clio/clgcur.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CLGCUR -- Return the next cursor value from a list structured cursor type
+# parameter.  The format of a cursor value is as follows:
+#
+#	X Y WCS KEY [SVAL]
+#
+#	X,Y	x and y cursor coordinates
+#	WCS	wcs in which cursor coordinates are given
+#	KEY	key(stroke) value associated with cursor read
+#	SVAL	optional string associated with given key
+#
+# All fields need not be given, and extra fields may be supplied and will be
+# either ignored or returned in SVAL.  The X-Y-WCS fields may be omitted
+# (in which case the input is KEY-[SVAL]), causing INDEF INDEF 0 KEY SVAL to be
+# returned, exactly as if the INDEF INDEF 0 had been typed in.  The number of
+# fields read is returned as the function value; EOF is returned when the end
+# of the cursor list is reached.
+
+int procedure clgcur (param, wx, wy, wcs, key, strval, maxch)
+
+char	param[ARB]		# parameter to be read
+real	wx, wy			# cursor coordinates
+int	wcs			# wcs to which coordinates belong
+int	key			# keystroke value of cursor event
+char	strval[ARB]		# string value, if any
+int	maxch
+
+char	ch
+pointer	sp, buf, ip
+int	nitems, op, delim
+int	ctor(), ctoi(), cctoc(), clglstr(), stridx()
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE + maxch, TY_CHAR)
+
+	# Flush any buffered text or graphics output.
+	call flush (STDERR)
+	call flush (STDOUT)
+	call gexfls()
+
+	# Read the cursor.
+	if (clglstr (param, Memc[buf], SZ_LINE + maxch) == EOF) {
+	    call sfree (sp)
+	    return (EOF)
+	}
+
+	ip = buf
+	nitems = 0
+	while (IS_WHITE (Memc[ip]))
+	    ip = ip + 1
+
+	if (IS_PRINT(Memc[ip]) && stridx (Memc[ip], "+-.0123456789") == 0) {
+	    # The X-Y-WCS fields have been omitted; supply default values.
+	    wx = INDEF
+	    wy = INDEF
+	    wcs = 0
+	    nitems = 3
+
+	} else {
+	    # Decode the X-Y-WCS fields.
+	    if (ctor (Memc, ip, wx) == 0)
+		goto quit_
+	    nitems = nitems + 1
+	    if (ctor (Memc, ip, wy) == 0)
+		goto quit_
+	    nitems = nitems + 1
+	    if (ctoi (Memc, ip, wcs) == 0)
+		goto quit_
+	    nitems = nitems + 1
+	}
+
+	# Get the KEY field.
+	if (cctoc (Memc, ip, ch) == 0)
+	    goto quit_
+	key = ch
+	nitems = nitems + 1
+
+	# Get the optional SVAL field.
+	while (IS_WHITE (Memc[ip]))
+	    ip = ip + 1
+
+	if (Memc[ip] != '\n' && Memc[ip] != EOS) {
+	    # Check for a quoted string.
+	    if (Memc[ip] == '"' || Memc[ip] == '\'') {
+		delim = Memc[ip]
+		ip = ip + 1
+	    } else
+		delim = 0
+
+	    # Extract the string value.
+	    op = 1
+	    while (op <= maxch && Memc[ip] != '\n' && Memc[ip] != EOS &&
+		Memc[ip] != delim) {
+		strval[op] = Memc[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    strval[op] = EOS
+	    nitems = nitems + 1
+	}
+
+quit_
+	call sfree (sp)
+	return (nitems)
+end
diff --git a/sys/clio/clgetb.x b/sys/clio/clgetb.x
new file mode 100644
index 00000000..4e75ec31
--- /dev/null
+++ b/sys/clio/clgetb.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGETB -- Get a boolean parameter from the CL.
+
+bool procedure clgetb (param)
+
+char	param[ARB]
+bool	bval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    call syserrs (SYS_CLEOFNLP, param)
+	else {
+	    call gargb (bval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTBOOL, param)
+	}
+
+	return (bval)
+end
diff --git a/sys/clio/clgetc.x b/sys/clio/clgetc.x
new file mode 100644
index 00000000..36259ec4
--- /dev/null
+++ b/sys/clio/clgetc.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGETC -- Get a character constant from the CL.
+
+char procedure clgetc (param)
+
+char	param[ARB]
+char	cval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    call syserrs (SYS_CLEOFNLP, param)
+	else {
+	    call gargc (cval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTCC, param)
+	}
+
+	return (cval)
+end
diff --git a/sys/clio/clgetd.x b/sys/clio/clgetd.x
new file mode 100644
index 00000000..12657a74
--- /dev/null
+++ b/sys/clio/clgetd.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGETD -- Get a double precision floating parameter from the CL.
+
+double procedure clgetd (param)
+
+char	param[ARB]
+double	dval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    call syserrs (SYS_CLEOFNLP, param)
+	else {
+	    call gargd (dval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTNUM, param)
+	}
+
+	return (dval)
+end
diff --git a/sys/clio/clgeti.x b/sys/clio/clgeti.x
new file mode 100644
index 00000000..eb3c0019
--- /dev/null
+++ b/sys/clio/clgeti.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGETI -- Get an integer valued parameter from the CL.
+
+int procedure clgeti (param)
+
+char	param[ARB]
+double	dval, clgetd()
+
+begin
+	dval = clgetd (param)
+	if (IS_INDEFD (dval))
+	    return (INDEFI)
+	else
+	    return (int(dval))
+end
diff --git a/sys/clio/clgetl.x b/sys/clio/clgetl.x
new file mode 100644
index 00000000..90a64d40
--- /dev/null
+++ b/sys/clio/clgetl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGETL -- Get a long integer parameter from the CL.
+
+long procedure clgetl (param)
+
+char	param[ARB]
+double	dval, clgetd()
+
+begin
+	dval = clgetd (param)
+	if (IS_INDEFD (dval))
+	    return (INDEFL)
+	else
+	    return (long(dval))
+end
diff --git a/sys/clio/clgetr.x b/sys/clio/clgetr.x
new file mode 100644
index 00000000..e8fb0a4b
--- /dev/null
+++ b/sys/clio/clgetr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGETR -- Get a single precision floating parameter from the CL.
+
+real procedure clgetr (param)
+
+char	param[ARB]
+double	dval, clgetd()
+
+begin
+	dval = clgetd (param)
+	if (IS_INDEFD (dval))
+	    return (INDEFR)
+	else
+	    return (real(dval))
+end
diff --git a/sys/clio/clgets.x b/sys/clio/clgets.x
new file mode 100644
index 00000000..4cc00ab7
--- /dev/null
+++ b/sys/clio/clgets.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGETS -- Get a short integer valued parameter from the CL.
+
+short procedure clgets (param)
+
+char	param[ARB]
+double	dval, clgetd()
+
+begin
+	dval = clgetd (param)
+	if (IS_INDEFD (dval))
+	    return (INDEFS)
+	else
+	    return (short(dval))
+end
diff --git a/sys/clio/clgetx.x b/sys/clio/clgetx.x
new file mode 100644
index 00000000..68e2b068
--- /dev/null
+++ b/sys/clio/clgetx.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGETX -- Get a complex parameter from the CL.
+
+complex procedure clgetx (param)
+
+char	param[ARB]
+complex	xval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    call syserrs (SYS_CLEOFNLP, param)
+	else {
+	    call gargx (xval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTNUM, param)
+	}
+
+	return (xval)
+end
diff --git a/sys/clio/clgfil.x b/sys/clio/clgfil.x
new file mode 100644
index 00000000..62d40dd1
--- /dev/null
+++ b/sys/clio/clgfil.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+
+.help clpopn[isu], clplen, clgfil, clpcls
+.nf ___________________________________________________________________________
+Expand a filename template given as the string value of a CL parameter.
+
+	clpopni - open a sorted input list or open list "STDIN"
+	clpopns - open a sorted list
+	clpopnu - open an unsorted list
+	 clpcls - close a list
+	 clplen - get number of filenames in list
+	 clgfil - get next filename from list
+	 clprew - rewind the list
+
+The CLPOPNI procedure creates a dummy list containing the single filename
+"STDIN" if the standard input is redirected.
+.endhelp ______________________________________________________________________
+
+
+# CLPOPNI -- Open an input list (sorted list of input files).  If the standard
+# input has been redirected, create a dummy list containing the single file
+# name "STDIN", and do not try to access the template parameter.
+
+int procedure clpopni (param)
+
+char	param[ARB]			# CL filename template parameter
+int	sort
+pointer	sp, template, list
+int	fntopnb(), fstati()
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_COMMAND, TY_CHAR)
+
+	sort = YES
+
+	if (fstati (STDIN, F_REDIR) == YES)
+	    list = fntopnb ("STDIN", sort)
+	else {
+	    call clgstr (param, Memc[template], SZ_COMMAND)
+	    list = fntopnb (Memc[template], sort)
+	}
+
+	call sfree (sp)
+	return (list)
+end
+
+
+# CLPOPNS -- Open a sorted list (sorted list of files, not associated with any
+# particular byte stream).
+
+int procedure clpopns (param)
+
+char	param[ARB]			# CL filename template parameter
+int	sort
+pointer	sp, template, list
+int	fntopnb()
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_COMMAND, TY_CHAR)
+
+	sort = YES
+
+	call clgstr (param, Memc[template], SZ_COMMAND)
+	list = fntopnb (Memc[template], sort)
+
+	call sfree (sp)
+	return (list)
+end
+
+
+# CLPOPNU -- Open an unsorted list (unsorted list of files, not associated
+# with any particular stream).
+
+int procedure clpopnu (param)
+
+char	param[ARB]			# CL filename template parameter
+int	sort
+pointer	sp, template, list
+int	fntopnb()
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_COMMAND, TY_CHAR)
+
+	sort = NO
+
+	call clgstr (param, Memc[template], SZ_COMMAND)
+	list = fntopnb (Memc[template], sort)
+
+	call sfree (sp)
+	return (list)
+end
+
+
+# CLPLEN -- Return the number of file names in the list.
+
+int procedure clplen (list)
+
+pointer	list
+int	fntlenb()
+
+begin
+	return (fntlenb (list))
+end
+
+
+# CLGFIL -- Return the next filename from the list.
+
+int procedure clgfil (list, fname, maxch)
+
+int	list			# list descriptor
+char	fname[ARB]		# output string
+int	maxch
+int	fntgfnb()
+
+begin
+	return (fntgfnb (list, fname, maxch))
+end
+
+
+# CLPCLS -- Close a filename list and return all storage.
+
+procedure clpcls (list)
+
+int	list			# list descriptor
+
+begin
+	call fntclsb (list)
+end
+
+
+# GLPREW -- Rewind the filename list.
+
+procedure clprew (list)
+
+int	list			# list descriptor
+
+begin
+	call fntrewb (list)
+end
diff --git a/sys/clio/clgkey.x b/sys/clio/clgkey.x
new file mode 100644
index 00000000..c631076e
--- /dev/null
+++ b/sys/clio/clgkey.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<clset.h>
+
+# CLGKEY -- Return the next keystroke value from a list structured `ukey' type
+# parameter.
+
+int procedure clgkey (param, key, strval, maxch)
+
+char	param[ARB]		# parameter to be read
+int	key			# keystroke value of cursor event
+char	strval[ARB]		# string value, if any
+int	maxch
+
+char	ch
+int	nitems, op
+pointer	sp, buf, ip
+int	cctoc(), clglstr()
+int	clstati(), rdukey()
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Flush any buffered text output.
+	call flush (STDERR)
+	call flush (STDOUT)
+
+	# Read the keyboard in raw mode.
+	if (clstati (CL_PRTYPE) == PR_CONNECTED) {
+	    if (clglstr (param, Memc[buf], SZ_LINE) == EOF) {
+		call sfree (sp)
+		return (EOF)
+	    }
+	} else {
+	    if (rdukey (Memc[buf], SZ_LINE) == EOF) {
+		call sfree (sp)
+		return (EOF)
+	    }
+	}
+
+	ip = buf
+	nitems = 0
+	if (cctoc (Memc, ip, ch) == 0)
+	    goto quit_
+	key = ch
+	nitems = nitems + 1
+
+	while (IS_WHITE (Memc[ip]))
+	    ip = ip + 1
+	if (Memc[ip] != '\n' && Memc[ip] != EOS) {
+	    op = 1
+	    while (op <= maxch && Memc[ip] != '\n' && Memc[ip] != EOS) {
+		strval[op] = Memc[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    strval[op] = EOS
+	    nitems = nitems + 1
+	}
+
+quit_
+	call sfree (sp)
+	return (nitems)
+end
diff --git a/sys/clio/clglpb.x b/sys/clio/clglpb.x
new file mode 100644
index 00000000..313e630b
--- /dev/null
+++ b/sys/clio/clglpb.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGLPB -- Get a list structured boolean parameter from the CL.
+
+int procedure clglpb (param, bval)
+
+char	param[ARB]
+bool	bval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    return (EOF)
+	else {
+	    call gargb (bval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTBOOL, param)
+	}
+
+	return (1)
+end
diff --git a/sys/clio/clglpc.x b/sys/clio/clglpc.x
new file mode 100644
index 00000000..ad28f906
--- /dev/null
+++ b/sys/clio/clglpc.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGLPC -- Get a list structured character constant parameter from the CL.
+
+int procedure clglpc (param, cval)
+
+char	param[ARB]
+char	cval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    return (EOF)
+	else {
+	    call gargc (cval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTCC, param)
+	}
+
+	return (1)
+end
diff --git a/sys/clio/clglpd.x b/sys/clio/clglpd.x
new file mode 100644
index 00000000..e9064790
--- /dev/null
+++ b/sys/clio/clglpd.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGLPD -- Get a list structured double precision floating parameter from
+# the CL.
+
+int procedure clglpd (param, dval)
+
+char	param[ARB]
+double	dval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    return (EOF)
+	else {
+	    call gargd (dval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTNUM, param)
+	}
+
+	return (1)
+end
diff --git a/sys/clio/clglpi.x b/sys/clio/clglpi.x
new file mode 100644
index 00000000..3b3d6800
--- /dev/null
+++ b/sys/clio/clglpi.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGLPI -- Get a list structured integer valued parameter from the CL.
+
+int procedure clglpi (param, ival)
+
+char	param[ARB]
+int	ival, stat, clglpd()
+double	dval
+
+begin
+	stat = clglpd (param, dval)
+	if (IS_INDEFD (dval))
+	    ival = INDEFI
+	else
+	    ival = int (dval)
+	return (stat)
+end
diff --git a/sys/clio/clglpl.x b/sys/clio/clglpl.x
new file mode 100644
index 00000000..f486092b
--- /dev/null
+++ b/sys/clio/clglpl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGLPL -- Get a list structured long integer valued parameter from the CL.
+
+int procedure clglpl (param, lval)
+
+char	param[ARB]
+long	lval
+int	stat, clglpd()
+double	dval
+
+begin
+	stat = clglpd (param, dval)
+	if (IS_INDEFD (dval))
+	    lval = INDEFL
+	else
+	    lval = long (dval)
+	return (stat)
+end
diff --git a/sys/clio/clglpr.x b/sys/clio/clglpr.x
new file mode 100644
index 00000000..2572041c
--- /dev/null
+++ b/sys/clio/clglpr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGLPR -- Get a list structured single precision floating valued parameter
+# from the CL.
+
+int procedure clglpr (param, rval)
+
+char	param[ARB]
+real	rval
+int	stat, clglpd()
+double	dval
+
+begin
+	stat = clglpd (param, dval)
+	if (IS_INDEFD (dval))
+	    rval = INDEFR
+	else
+	    rval = real (dval)
+	return (stat)
+end
diff --git a/sys/clio/clglps.x b/sys/clio/clglps.x
new file mode 100644
index 00000000..d7179eb3
--- /dev/null
+++ b/sys/clio/clglps.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGLPS -- Get a list structured short integer valued parameter from the CL.
+
+int procedure clglps (param, sval)
+
+char	param[ARB]
+short	sval
+int	stat, clglpd()
+double	dval
+
+begin
+	stat = clglpd (param, dval)
+	if (IS_INDEFD (dval))
+	    sval = INDEFS
+	else
+	    sval = short (dval)
+	return (stat)
+end
diff --git a/sys/clio/clglpx.x b/sys/clio/clglpx.x
new file mode 100644
index 00000000..04e597d1
--- /dev/null
+++ b/sys/clio/clglpx.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGLPX -- Get a list structured complex parameter from the CL.
+
+int procedure clglpx (param, xval)
+
+char	param[ARB]
+complex	xval
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    return (EOF)
+	else {
+	    call gargx (xval)
+	    if (nscan() != 1)
+		call syserrs (SYS_CLNOTNUM, param)
+	}
+
+	return (1)
+end
diff --git a/sys/clio/clglstr.x b/sys/clio/clglstr.x
new file mode 100644
index 00000000..f60b58c9
--- /dev/null
+++ b/sys/clio/clglstr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLGLSTR -- Get a list structured string parameter from the CL.
+
+int procedure clglstr (param, outstr, maxch)
+
+char	param[ARB], outstr[maxch]
+int	maxch
+int	clscan(), nscan(), strlen()
+
+begin
+	if (clscan (param) == EOF)
+	    return (EOF)
+	else {
+	    call gargstr (outstr, maxch)
+	    if (nscan() != 1)
+		outstr[1] = EOS
+	}
+
+	return (strlen (outstr))
+end
diff --git a/sys/clio/clgpset.x b/sys/clio/clgpset.x
new file mode 100644
index 00000000..a8dd1d85
--- /dev/null
+++ b/sys/clio/clgpset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSET -- Get the string value of the named pset parameter.
+# [OBSOLETE ROUTINE - see clgpseta.x]
+
+procedure clgpset (pp, pname, outstr, maxch)
+
+pointer	pp			# pset descriptor
+char	pname[ARB]		# parameter name
+char	outstr[maxch]		# output string
+int	maxch			# max chars out
+
+pointer	clpset_parname()
+
+begin
+	call clgstr (PARNAME(pp,pname), outstr, maxch)
+end
diff --git a/sys/clio/clgpseta.x b/sys/clio/clgpseta.x
new file mode 100644
index 00000000..277165d1
--- /dev/null
+++ b/sys/clio/clgpseta.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETA -- Get the string value of the named pset parameter.
+
+procedure clgpseta (pp, pname, outstr, maxch)
+
+pointer	pp			# pset descriptor
+char	pname[ARB]		# parameter name
+char	outstr[maxch]		# output string
+int	maxch			# max chars out
+
+pointer	clpset_parname()
+
+begin
+	call clgstr (PARNAME(pp,pname), outstr, maxch)
+end
diff --git a/sys/clio/clgpsetb.x b/sys/clio/clgpsetb.x
new file mode 100644
index 00000000..651f5306
--- /dev/null
+++ b/sys/clio/clgpsetb.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETB -- Get the boolean value of a pset parameter.
+
+bool procedure clgpsetb (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+bool	clgetb()
+
+begin
+	return (clgetb (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsetc.x b/sys/clio/clgpsetc.x
new file mode 100644
index 00000000..fe54715e
--- /dev/null
+++ b/sys/clio/clgpsetc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETC -- Get the char value of a pset parameter.
+
+char procedure clgpsetc (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+char	clgetc()
+
+begin
+	return (clgetc (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsetd.x b/sys/clio/clgpsetd.x
new file mode 100644
index 00000000..dfd39372
--- /dev/null
+++ b/sys/clio/clgpsetd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETD -- Get the double value of a pset parameter.
+
+double procedure clgpsetd (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+double	clgetd()
+
+begin
+	return (clgetd (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpseti.x b/sys/clio/clgpseti.x
new file mode 100644
index 00000000..c39d102b
--- /dev/null
+++ b/sys/clio/clgpseti.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETI -- Get the int value of a pset parameter.
+
+int procedure clgpseti (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+int	clgeti()
+
+begin
+	return (clgeti (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsetl.x b/sys/clio/clgpsetl.x
new file mode 100644
index 00000000..374f0851
--- /dev/null
+++ b/sys/clio/clgpsetl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETL -- Get the long integer value of a pset parameter.
+
+long procedure clgpsetl (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+long	clgetl()
+
+begin
+	return (clgetl (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsetr.x b/sys/clio/clgpsetr.x
new file mode 100644
index 00000000..598a2c42
--- /dev/null
+++ b/sys/clio/clgpsetr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETR -- Get the real value of a pset parameter.
+
+real procedure clgpsetr (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+real	clgetr()
+
+begin
+	return (clgetr (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsets.x b/sys/clio/clgpsets.x
new file mode 100644
index 00000000..9210a8b2
--- /dev/null
+++ b/sys/clio/clgpsets.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETS -- Get the short integer value of a pset parameter.
+
+short procedure clgpsets (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+short	clgets()
+
+begin
+	return (clgets (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgpsetx.x b/sys/clio/clgpsetx.x
new file mode 100644
index 00000000..b20fda29
--- /dev/null
+++ b/sys/clio/clgpsetx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLGPSETX -- Get the complex value of a pset parameter.
+
+complex procedure clgpsetx (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+
+pointer	clpset_parname()
+complex	clgetx()
+
+begin
+	return (clgetx (PARNAME(pp,parname)))
+end
diff --git a/sys/clio/clgstr.x b/sys/clio/clgstr.x
new file mode 100644
index 00000000..c8ec9ebd
--- /dev/null
+++ b/sys/clio/clgstr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGSTR -- Get a string parameter from the CL.
+
+procedure clgstr (param, outstr, maxch)
+
+char	param[ARB], outstr[maxch]
+int	maxch
+int	clscan(), nscan()
+
+begin
+	if (clscan (param) == EOF)
+	    call syserr (SYS_CLEOFNLP)
+	else {
+	    call gargstr (outstr, maxch)
+	    if (nscan() != 1)
+		outstr[1] = EOS
+	}
+end
diff --git a/sys/clio/clgwrd.x b/sys/clio/clgwrd.x
new file mode 100644
index 00000000..0dd6ee49
--- /dev/null
+++ b/sys/clio/clgwrd.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# CLGWRD -- Get a keyword parameter from the CL, and match it against
+# a dictionary of legal keywords.  Any unambiguous abbreviation is
+# accepted.  The full keyword string is returned in keyword, and the
+# word index of the keyword in the dictionary is returned as the function
+# value.
+
+int procedure clgwrd (param, keyword, maxchar, dictionary)
+
+char	param[ARB]		# CL parameter string
+char	keyword[ARB]		# String matched in dictionary
+int	maxchar			# Maximum size of str
+char	dictionary[ARB]		# Dictionary string
+
+pointer	sp, abbrev
+int	kwindex, strdic()
+
+begin
+	call smark (sp)
+	call salloc (abbrev, SZ_FNAME, TY_CHAR)
+
+	call clgstr (param, Memc[abbrev], maxchar)
+	kwindex = strdic (Memc[abbrev], keyword, maxchar, dictionary)
+
+	if (kwindex <= 0)
+	    call syserrs (SYS_CLGWRD, Memc[abbrev])
+
+        call sfree (sp)
+        return (kwindex)
+end
diff --git a/sys/clio/clio.com b/sys/clio/clio.com
new file mode 100644
index 00000000..78567dd0
--- /dev/null
+++ b/sys/clio/clio.com
@@ -0,0 +1,18 @@
+# CLIO parameters.
+
+int	cl_prtype			# parent process type
+pointer	cl_stp				# clcache symbol table pointer
+int	cl_stmark			# stmark value for initial table
+int	cl_nposargs			# number of $1, $2 type task parameters
+int	cl_nextarg			# index into posarg list
+pointer	cl_posarg[MAX_POSARGS]		# symtab offsets of positional args
+int	ps_status[MAX_PSEUDOFILES]	# for pseudofile drivers
+int	cl_npsets			# number of psets for task (>= 1)
+int	cl_psetop			# next char in pset name buffer
+int	cl_psetindex[MAX_PSETS]		# index of pset names (1 = taskname)
+char	cl_psetname[SZ_PSETNAMEBUF]	# char storage for pset names
+char	cl_pname[SZ_PNAME]		# handy buffer for param names
+
+common	/clio_com/ cl_prtype, cl_stp, cl_stmark, cl_nposargs, cl_nextarg,
+	cl_posarg, ps_status, cl_npsets, cl_psetop, cl_psetindex, cl_psetname,
+	cl_pname
diff --git a/sys/clio/cllpset.x b/sys/clio/cllpset.x
new file mode 100644
index 00000000..aa06a57a
--- /dev/null
+++ b/sys/clio/cllpset.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLLPSET -- List a pset.  Each param,value pair is written to the output
+# file using the caller supplied format, e.g., "set %s = \"%s\"\n".
+
+procedure cllpset (pp, fd, format)
+
+pointer	pp			#I pset descriptor
+int	fd			#I output file
+char	format[ARB]		#I format, one %s each for param, value
+
+begin
+	call clc_compress()
+	call clc_list (fd, PS_PSETNAME(pp), format)
+end
diff --git a/sys/clio/clopen.x b/sys/clio/clopen.x
new file mode 100644
index 00000000..a83bb753
--- /dev/null
+++ b/sys/clio/clopen.x
@@ -0,0 +1,124 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<ttset.h>
+include	<fset.h>
+include	<knet.h>
+
+# CLOPEN -- "Open" the CL files (initialize CLIO).  Called by the IRAF Main
+# upon process startup.  The CL device may be either the CL process,
+# communicating with the current process via intertask communications
+# (via ZARDCL, ZAWRCL), or a text file or terminal.  "Open" the files CLIN
+# and CLOUT, and the standard pseudofiles STDIN, STDOUT, STDERR, STDGRAPH,
+# STDIMAGE, STDPLOT, and PSIOCTRL.
+
+procedure clopen (stdin_chan, stdout_chan, stderr_chan, device, devtype)
+
+int	stdin_chan		# OS channel for the process standard input
+int	stdout_chan		# OS channel for the process standard output
+int	stderr_chan		# OS channel for the standard error output
+int	device			# zlocpr EPA of the driver read routine
+int	devtype			# device type (text or binary)
+
+int	fd, psmode, chan, devepa
+int	fsetfd(), locpr()
+extern	zardps(), zardnu(), zgetty(), zgettt()
+
+begin
+	if (devtype == BINARY_FILE)
+	    psmode = WRITE_ONLY
+	else
+	    psmode = APPEND
+
+	# Allocate and initialize the standard (predefined) file descriptors.
+	# FSETFD performs only the standard initialization.  The remainder
+	# of the code initializes the device dependent parameters.
+
+	fd = fsetfd (CLIN,     "CLIN",     READ_ONLY,  devtype)
+	fd = fsetfd (CLOUT,    "CLOUT",    psmode,     devtype)
+	fd = fsetfd (STDIN,    "STDIN",    READ_ONLY,  devtype)
+	fd = fsetfd (STDOUT,   "STDOUT",   psmode,     devtype)
+	fd = fsetfd (STDERR,   "STDERR",   psmode,     devtype)
+	fd = fsetfd (STDGRAPH, "STDGRAPH", READ_WRITE, BINARY_FILE)
+	fd = fsetfd (STDIMAGE, "STDIMAGE", READ_WRITE, BINARY_FILE)
+	fd = fsetfd (STDPLOT,  "STDPLOT",  READ_WRITE, BINARY_FILE)
+	fd = fsetfd (PSIOCTRL, "PSIOCTRL", READ_WRITE, BINARY_FILE)
+
+	# Set the entry point addresses of the device Z-routines for each
+	# of the special files.  If the process channels are text files
+	# (character files or a terminal) the pseudofiles are connected to
+	# real files (no multiplexing).  Graphics i/o is connected to the
+	# null file if the process channels are textual, hence graphics
+	# output is discarded (unless redirected) when a task is run stand
+	# alone.  If the device we are passed is the kernel terminal driver
+	# TY, connect the VOS logical terminal driver TT instead.
+
+	if (device == locpr (zgetty)) {
+	    devepa = locpr (zgettt)
+	    call zsettt (stdin_chan,  TT_KINCHAN, stdin_chan)
+	    call zsettt (stdout_chan, TT_KOUTCHAN, stdout_chan)
+	} else
+	    devepa = device
+
+	call fseti (CLIN,  F_DEVICE, devepa)
+	call fseti (CLOUT, F_DEVICE, devepa)
+
+	if (devtype == TEXT_FILE) {
+	    # Set device drivers for the textual pseudofiles.
+	    do fd = STDIN, STDERR
+		call fseti (fd, F_DEVICE, devepa)
+	    
+	    # Connect the graphics streams to the null file.
+	    do fd = STDGRAPH, PSIOCTRL
+		call fseti (fd, F_DEVICE, locpr(zardnu))
+
+	} else {
+	    # Connect the pseudofiles to the pseudofile driver.
+	    do fd = STDIN, PSIOCTRL
+		call fseti (fd, F_DEVICE, locpr(zardps))
+	}
+
+	# Associate a device channel with the two IPC streams and with each
+	# pseudofile.
+
+	call fseti (CLIN,  F_CHANNEL, stdin_chan)
+	call fseti (CLOUT, F_CHANNEL, stdout_chan)
+
+	if (devtype == TEXT_FILE) {
+	    call fseti (STDIN,  F_CHANNEL, stdin_chan)
+	    call fseti (STDOUT, F_CHANNEL, stdout_chan)
+	    call fseti (STDERR, F_CHANNEL, stdout_chan)
+
+	    # Open a null file on each graphics stream.
+	    do fd = STDGRAPH, PSIOCTRL {
+		call zopnnu ("", READ_WRITE, chan)
+		call fseti (fd, F_CHANNEL, chan)
+	    }
+
+	} else {
+	    # The channel code for a pseudofile is used for the pseudofile code,
+	    # since the actual i/o is always on channels CLIN and CLOUT.
+
+	    do fd = STDIN, PSIOCTRL
+		call fseti (fd, F_CHANNEL, fd)
+	}
+
+	call fseti (STDERR, F_FLUSHNL, YES)		# flush error messages
+	# call fseti (CLOUT,  F_FLUSHNL, YES)		# flush CL commands
+
+	# Get device block size, and the minimum optimal buffer size for
+	# efficient sequential i/o.
+
+	do fd = CLIN, PSIOCTRL				# device parameters
+	    call fgdev_param (fd)
+
+	# Seek is needed to set the proper logical offset for each file,
+	# as well as to seek to the end of a text file if no CL.
+
+	call seek (CLIN,  BOFL)
+	call seek (CLOUT, EOFL)
+	call seek (STDIN, BOFL)
+
+	do fd = STDOUT, PSIOCTRL
+	    call seek (fd, EOFL)
+end
diff --git a/sys/clio/clopset.x b/sys/clio/clopset.x
new file mode 100644
index 00000000..f06ae0b9
--- /dev/null
+++ b/sys/clio/clopset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLOPSET -- Open a named pset.
+
+pointer procedure clopset (pset)
+
+char	pset[ARB]		# pset name (name of CL pset parameter)
+pointer	pp
+errchk	malloc
+
+begin
+	call malloc (pp, LEN_PSETDES, TY_STRUCT)
+	call strcpy (pset, PS_PSETNAME(pp), SZ_PSPSETNAME)
+
+	return (pp)
+end
diff --git a/sys/clio/clppset.x b/sys/clio/clppset.x
new file mode 100644
index 00000000..b5d2691f
--- /dev/null
+++ b/sys/clio/clppset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSET -- Set the string value of the named pset parameter.
+# [OBSOLETE ROUTINE - see clppseta.x]
+
+procedure clppset (pp, pname, sval)
+
+pointer	pp			# pset descriptor
+char	pname[ARB]		# parameter name
+char	sval[ARB]		# string value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clpstr (PARNAME(pp,pname), sval)
+end
diff --git a/sys/clio/clppseta.x b/sys/clio/clppseta.x
new file mode 100644
index 00000000..4fad477c
--- /dev/null
+++ b/sys/clio/clppseta.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETA -- Set the string value of the named pset parameter.
+
+procedure clppseta (pp, pname, sval)
+
+pointer	pp			# pset descriptor
+char	pname[ARB]		# parameter name
+char	sval[ARB]		# string value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clpstr (PARNAME(pp,pname), sval)
+end
diff --git a/sys/clio/clppsetb.x b/sys/clio/clppsetb.x
new file mode 100644
index 00000000..5ada363f
--- /dev/null
+++ b/sys/clio/clppsetb.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETB -- Set the boolean value of a pset parameter.
+
+procedure clppsetb (pp, parname, bval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+bool	bval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputb (PARNAME(pp,parname), bval)
+end
diff --git a/sys/clio/clppsetc.x b/sys/clio/clppsetc.x
new file mode 100644
index 00000000..46ebcf22
--- /dev/null
+++ b/sys/clio/clppsetc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETC -- Set the char value of a pset parameter.
+
+procedure clppsetc (pp, parname, cval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+char	cval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputc (PARNAME(pp,parname), cval)
+end
diff --git a/sys/clio/clppsetd.x b/sys/clio/clppsetd.x
new file mode 100644
index 00000000..b7fd3376
--- /dev/null
+++ b/sys/clio/clppsetd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETD -- Set the double value of a pset parameter.
+
+procedure clppsetd (pp, parname, dval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+double	dval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputd (PARNAME(pp,parname), dval)
+end
diff --git a/sys/clio/clppseti.x b/sys/clio/clppseti.x
new file mode 100644
index 00000000..6cb06daf
--- /dev/null
+++ b/sys/clio/clppseti.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETI -- Set the integer value of a pset parameter.
+
+procedure clppseti (pp, parname, ival)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+int	ival			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputi (PARNAME(pp,parname), ival)
+end
diff --git a/sys/clio/clppsetl.x b/sys/clio/clppsetl.x
new file mode 100644
index 00000000..23ebae92
--- /dev/null
+++ b/sys/clio/clppsetl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETL -- Set the long integer value of a pset parameter.
+
+procedure clppsetl (pp, parname, lval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+long	lval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputl (PARNAME(pp,parname), lval)
+end
diff --git a/sys/clio/clppsetr.x b/sys/clio/clppsetr.x
new file mode 100644
index 00000000..b917549d
--- /dev/null
+++ b/sys/clio/clppsetr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETR -- Set the real value of a pset parameter.
+
+procedure clppsetr (pp, parname, rval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+real	rval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputr (PARNAME(pp,parname), rval)
+end
diff --git a/sys/clio/clppsets.x b/sys/clio/clppsets.x
new file mode 100644
index 00000000..ef48bfb3
--- /dev/null
+++ b/sys/clio/clppsets.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETS -- Set the short integer value of a pset parameter.
+
+procedure clppsets (pp, parname, sval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+short	sval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputs (PARNAME(pp,parname), sval)
+end
diff --git a/sys/clio/clppsetx.x b/sys/clio/clppsetx.x
new file mode 100644
index 00000000..64815812
--- /dev/null
+++ b/sys/clio/clppsetx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPPSETX -- Set the complex value of a pset parameter.
+
+procedure clppsetx (pp, parname, xval)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# parameter name
+complex	xval			# new value of parameter
+
+pointer	clpset_parname()
+
+begin
+	call clputx (PARNAME(pp,parname), xval)
+end
diff --git a/sys/clio/clpset.h b/sys/clio/clpset.h
new file mode 100644
index 00000000..df52e366
--- /dev/null
+++ b/sys/clio/clpset.h
@@ -0,0 +1,12 @@
+# CLPSET.H -- CL pset access package header file.
+
+define	SZ_PSPSETNAME	31
+define	SZ_PSPARNAME	63
+
+define	LEN_PSETDES	96
+define	PS_PSETNAMEP	P2C($1)				# pset name pointer
+define	PS_PSETNAME	Memc[P2C($1)]			# pset name
+define	PS_PARNAMEP	(P2C($1)+SZ_PSPSETNAME+1)	# pointer to tempbuf
+define	PS_PARNAME	Memc[P2C($1)+SZ_PSPSETNAME+1]	# temp buffer
+
+define	PARNAME		Memc[clpset_parname($1,$2)]
diff --git a/sys/clio/clpsetnm.x b/sys/clio/clpsetnm.x
new file mode 100644
index 00000000..6854d94b
--- /dev/null
+++ b/sys/clio/clpsetnm.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"clpset.h"
+
+# CLPSET_PARNAME -- Return a pointer to the full name (pset.parname) of a
+# parameter in the referenced pset.
+
+pointer procedure clpset_parname (pp, parname)
+
+pointer	pp			# pset descriptor
+char	parname[ARB]		# name of parameter in pset
+
+pointer	op
+int	gstrcpy()
+
+begin
+	op = PS_PARNAMEP(pp)
+	if (Memc[PS_PSETNAMEP(pp)] != EOS) {
+	    op = op + gstrcpy (PS_PSETNAME(pp), Memc[op], SZ_PSPARNAME)
+	    Memc[op] = '.';  op = op + 1
+	}
+	call strcpy (parname, Memc[op], SZ_PSPARNAME-(op-PS_PARNAMEP(pp)))
+
+	return (PS_PARNAMEP(pp))
+end
diff --git a/sys/clio/clpstr.x b/sys/clio/clpstr.x
new file mode 100644
index 00000000..d040fe5d
--- /dev/null
+++ b/sys/clio/clpstr.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPSTR -- Put a string type parameter to the CL.
+
+procedure clpstr (param, value)
+
+char	param[ARB]		# param name
+char	value[ARB]		# new value
+
+pointer	sp, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	call fprintf (CLOUT, "%s=\"%s\"\n")
+	    call pargstr (param)
+	    call pargstr (value)
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], value)
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clputb.x b/sys/clio/clputb.x
new file mode 100644
index 00000000..dcc99ad8
--- /dev/null
+++ b/sys/clio/clputb.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPUTB -- Put a boolean valued parameter to the CL.
+
+procedure clputb (param, bval)
+
+char	param[ARB]
+bool	bval
+
+pointer	sp, value, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Update the parameter in the CL.
+	call sprintf (Memc[value], SZ_FNAME, "%b")
+	    call pargb (bval)
+	call fprintf (CLOUT, "%s = %s\n")
+	    call pargstr (param)
+	    call pargstr (Memc[value])
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clputc.x b/sys/clio/clputc.x
new file mode 100644
index 00000000..333160fe
--- /dev/null
+++ b/sys/clio/clputc.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CLPUTC -- Put a character constant type parameter to the CL.
+
+procedure clputc (param, cval)
+
+char	param[ARB]
+char	cval
+
+pointer	sp, value, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Character constants are stored as strings in the CL.  Add single
+	# quotes about the character value to deimit the string.  The
+	# character may be represented as a single character or as an escape
+	# sequence.
+
+	call sprintf (Memc[value], SZ_FNAME, "'%c'")
+	    call pargc (cval)
+	call fprintf (CLOUT, "%s = %s\n")
+	    call pargstr (param)
+	    call pargstr (Memc[value])
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clputd.x b/sys/clio/clputd.x
new file mode 100644
index 00000000..71403bd9
--- /dev/null
+++ b/sys/clio/clputd.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPUTD -- Put a double precision parameter to the CL.
+
+procedure clputd (param, dval)
+
+char	param[ARB]
+double	dval
+
+pointer	sp, value, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Update the parameter in the CL.
+	call sprintf (Memc[value], SZ_FNAME, "%g")
+	    call pargd (dval)
+	call fprintf (CLOUT, "%s = %s\n")
+	    call pargstr (param)
+	    call pargstr (Memc[value])
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clputi.x b/sys/clio/clputi.x
new file mode 100644
index 00000000..d7c9fc29
--- /dev/null
+++ b/sys/clio/clputi.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPUTI -- Set a CL parameter of type integer.
+
+procedure clputi (param, value)
+
+char	param[ARB]		# parameter to be set
+int	value			# new value
+long	lval
+
+begin
+	lval = value
+	if (IS_INDEFI (value))
+	    lval = INDEFL
+
+	call clputl (param, lval)
+end
+
+
+# CLPUTS -- Set a CL parameter of type short.
+
+procedure clputs (param, value)
+
+char	param[ARB]		# parameter to be set
+short	value			# new value
+long	lval
+
+begin
+	lval = value
+	if (IS_INDEFS (value))
+	    lval = INDEFL
+
+	call clputl (param, lval)
+end
+
+
+# CLPUTL -- Put a long integer parameter to the CL.
+
+procedure clputl (param, lval)
+
+char	param[ARB]
+long	lval
+
+pointer	sp, value, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Update the parameter in the CL.
+	call sprintf (Memc[value], SZ_FNAME, "%d")
+	    call pargl (lval)
+	call fprintf (CLOUT, "%s = %s\n")
+	    call pargstr (param)
+	    call pargstr (Memc[value])
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clputr.x b/sys/clio/clputr.x
new file mode 100644
index 00000000..4ee37caf
--- /dev/null
+++ b/sys/clio/clputr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPUTR -- Put a real valued parameter to the CL.
+
+procedure clputr (param, rval)
+
+char	param[ARB]
+real	rval
+double	dval
+
+begin
+	if (IS_INDEFR(rval))
+	    dval = INDEFD
+	else
+	    dval = rval
+
+	call clputd (param, dval)
+end
diff --git a/sys/clio/clputx.x b/sys/clio/clputx.x
new file mode 100644
index 00000000..7bbe66e7
--- /dev/null
+++ b/sys/clio/clputx.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLPUTX -- Put a complex type parameter to the CL.
+
+procedure clputx (param, xval)
+
+char	param[ARB]
+complex	xval
+
+pointer	sp, value, pname
+pointer	clc_find()
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Update the parameter in the CL.
+	call sprintf (Memc[value], SZ_FNAME, "%z")
+	    call pargx (xval)
+	call fprintf (CLOUT, "%s = %s\n")
+	    call pargstr (param)
+	    call pargstr (Memc[value])
+
+	# If the parameter is in the cache, update the cached value as well.
+	if (clc_find (param, Memc[pname], SZ_FNAME) != NULL)
+	    call clc_enter (Memc[pname], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/sys/clio/clreqpar.x b/sys/clio/clreqpar.x
new file mode 100644
index 00000000..9817c0bf
--- /dev/null
+++ b/sys/clio/clreqpar.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<clset.h>
+
+# CLREQPAR -- Request a parameter from the CL.
+
+procedure clreqpar (param)
+
+char	param[ARB]
+int	clstati()
+
+begin
+	call flush (STDOUT)
+
+	if (clstati (CL_PRTYPE) == PR_CONNECTED) {
+	    call putline (CLOUT, "=")
+	    call putline (CLOUT, param)
+	    call putline (CLOUT, "\n")
+	} else {
+	    call putline (CLOUT, param)
+	    call putline (CLOUT, ": ")
+	}
+
+	call flush (CLOUT)
+end
diff --git a/sys/clio/clseti.x b/sys/clio/clseti.x
new file mode 100644
index 00000000..c676fb19
--- /dev/null
+++ b/sys/clio/clseti.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<clset.h>
+include	<syserr.h>
+include	<clio.h>
+
+# CLSETI -- Set a CLIO option of type integer.  Called by the IRAF Main
+# upon process startup to set the CL_PRTYPE flag.
+
+procedure clseti (parameter, value)
+
+int	parameter		# CLIO parameter being queried
+int	value			# value of parameter (output)
+include	"clio.com"
+
+begin
+	switch (parameter) {
+	case CL_PRTYPE:
+	    cl_prtype = value
+	default:
+	    call syserrs (SYS_CLSETUKNPAR, "clseti")
+	}
+end
diff --git a/sys/clio/clstati.x b/sys/clio/clstati.x
new file mode 100644
index 00000000..05ea76bb
--- /dev/null
+++ b/sys/clio/clstati.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<clio.h>
+include	<clset.h>
+
+# CLSTATI -- Get the value of an integer CLIO parameter.  Currently there is
+# only one CLIO parameter, the process type of the parent (connected, detached,
+# or host).
+
+int procedure clstati (parameter)
+
+int	parameter
+include	"clio.com"
+
+begin
+	switch (parameter) {
+	case CL_PRTYPE:
+	    return (cl_prtype)
+	case CL_PCACHE:
+	    return (cl_stp)
+	default:
+	    call syserrs (SYS_CLSTATUS, "clstati")
+	}
+end
diff --git a/sys/clio/doc/clio.hd b/sys/clio/doc/clio.hd
new file mode 100644
index 00000000..4b5b00f2
--- /dev/null
+++ b/sys/clio/doc/clio.hd
@@ -0,0 +1,40 @@
+# Help directory for the CLIO (command language i/o) system package.
+
+$clio	= "sys$clio/"
+
+clcmd		hlp = clcmd.hlp,		src = clio$clcmd.x
+clgetb		hlp = clget.hlp,		src = clio$clgetb.x
+clgetc		hlp = clget.hlp,		src = clio$clgetc.x
+clgetd		hlp = clget.hlp,		src = clio$clgetd.x
+clgeti		hlp = clget.hlp,		src = clio$clgeti.x
+clgetl		hlp = clget.hlp,		src = clio$clgetl.x
+clgetr		hlp = clget.hlp,		src = clio$clgetr.x
+clgets		hlp = clget.hlp,		src = clio$clgets.x
+clgetx		hlp = clget.hlp,		src = clio$clgetx.x
+clgfil		hlp = clgfil.hlp,		src = clio$clgfil.x
+clglpb		hlp = clglp.hlp,		src = clio$clglpb.x
+clglpc		hlp = clglp.hlp,		src = clio$clglpc.x
+clglpd		hlp = clglp.hlp,		src = clio$clglpd.x
+clglpi		hlp = clglp.hlp,		src = clio$clglpi.x
+clglpl		hlp = clglp.hlp,		src = clio$clglpl.x
+clglpr		hlp = clglp.hlp,		src = clio$clglpr.x
+clglps		hlp = clglp.hlp,		src = clio$clglps.x
+clglpx		hlp = clglp.hlp,		src = clio$clglpx.x
+clglstr		hlp = clglp.hlp,		src = clio$clglstr.x
+clgstr		hlp = clget.hlp,		src = clio$clgstr.x
+clgwrd		hlp = clget.hlp,		src = clio$clgwrd.x
+clpcls		hlp = clgfil.hlp,		src = clio$clgfil.x
+clplen		hlp = clgfil.hlp,		src = clio$clgfil.x
+clpopni		hlp = clgfil.hlp,		src = clio$clgfil.x
+clpopns		hlp = clgfil.hlp,		src = clio$clgfil.x
+clpopnu		hlp = clgfil.hlp,		src = clio$clgfil.x
+clprew		hlp = clgfil.hlp,		src = clio$clgfil.x
+clpstr		hlp = clput.hlp,		src = clio$clpstr.x
+clputb		hlp = clput.hlp,		src = clio$clputb.x
+clputc		hlp = clput.hlp,		src = clio$clputc.x
+clputd		hlp = clput.hlp,		src = clio$clputd.x
+clputi		hlp = clput.hlp,		src = clio$clputi.x
+clputr		hlp = clput.hlp,		src = clio$clputr.x
+clputx		hlp = clput.hlp,		src = clio$clputx.x
+clseti		hlp = clseti.hlp,		src = clio$clseti.x
+clstati		hlp = clstati.hlp,		src = clio$clstati.x
diff --git a/sys/clio/doc/clio.men b/sys/clio/doc/clio.men
new file mode 100644
index 00000000..f7f24059
--- /dev/null
+++ b/sys/clio/doc/clio.men
@@ -0,0 +1,16 @@
+	  clcmd - Send a command to the CL (restricted)
+clget[bcsilrdx] - Get the value of a CL parameter
+        clpopni - Open a sorted input filename template
+        clpopns - Open a sorted filename template or namelist
+        clpopnu - Open an unsorted filename template or namelist
+	 clplen - Number of elements in a list opened with clpopn[isu]
+	 clgfil - Get a file from a list opened with clpopn[isu]
+	 clpcls - Close a list opened with clpopn[isu]
+clglp[bcsilrdx] - Get the next value from a list-structured CL parameter
+	clglstr - Get the next value from a string list-structured CL parameter
+	 clgstr - Get the value of a CL string type parameter
+	 clgwrd - Get the first word from a string valued CL parameter
+	 clpstr - Set the value of a string valued CL parameter
+clput[bcsilrdx] - Set the value of a CL parameter
+	 clseti - Set the value of a CLIO parameter
+	clstati - Get the value of a CLIO parameter
diff --git a/sys/clio/gexfls.x b/sys/clio/gexfls.x
new file mode 100644
index 00000000..5eadf759
--- /dev/null
+++ b/sys/clio/gexfls.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GEXFLS -- Externally callable procedure for flushing graphics output.
+# Called by the CLIO procedure CLGCUR to flush graphics output prior to
+# a cursor read.  The main complication is that since CLGCUR is part of
+# the CLIO package and may be used in a program that does not generate
+# any graphics, we do not want to directly reference any GIO procedures
+# since this would force the linker to load much of GIO.
+
+procedure gexfls()
+
+int	gflush
+pointer	gp[2]
+common	/gxflcm/ gp, gflush
+
+begin
+	if (gflush != NULL) {
+	    if (gp[1] != NULL)
+		call zcall1 (gflush, gp[1])
+	    if (gp[2] != NULL)
+		call zcall1 (gflush, gp[2])
+	}
+end
+
+
+# GEXFLS_SET -- Set pointers to the gflush procedure for a stream.
+
+procedure gexfls_set (stream, gp_value, epa_gflush)
+
+int	stream			# graphics stream
+pointer	gp_value		# graphics descriptor
+int	epa_gflush		# EPA of the gflush procedure
+
+int	gflush
+pointer	gp[2]
+common	/gxflcm/ gp, gflush
+
+begin
+	if (stream == STDGRAPH || stream == STDIMAGE) {
+	    gp[stream-STDGRAPH+1] = gp_value
+	    gflush = epa_gflush
+	}
+end
+
+
+# GEXFLS_CLEAR -- Clear the pointer to the gflush procedure for a stream.
+
+procedure gexfls_clear (stream)
+
+int	stream			# graphics stream
+int	gflush
+pointer	gp[2]
+common	/gxflcm/ gp, gflush
+
+begin
+	if (stream == STDGRAPH || stream == STDIMAGE)
+	    gp[stream-STDGRAPH+1] = NULL
+end
diff --git a/sys/clio/mkpkg b/sys/clio/mkpkg
new file mode 100644
index 00000000..69aca042
--- /dev/null
+++ b/sys/clio/mkpkg
@@ -0,0 +1,75 @@
+# CLIO portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:	
+	clcache.x	clio.com <clio.h> <ctype.h>
+	clclose.x	<config.h>
+	clcmd.x		<clset.h>
+	clcmdw.x	<clset.h>
+	clcpset.x	
+	clepset.x	clpset.h <clio.h>
+	clgcur.x	<ctype.h>
+	clgetb.x	
+	clgetc.x	
+	clgetd.x	
+	clgeti.x	
+	clgetl.x	
+	clgetr.x	
+	clgets.x	
+	clgetx.x	
+	clgfil.x	<fset.h>
+	clgkey.x	<clset.h> <ctype.h>
+	clglpb.x	
+	clglpc.x	
+	clglpd.x	
+	clglpi.x	
+	clglpl.x	
+	clglpr.x	
+	clglps.x	
+	clglpx.x	
+	clglstr.x	
+	clgpset.x	clpset.h
+	clgpseta.x	clpset.h
+	clgpsetb.x	clpset.h
+	clgpsetc.x	clpset.h
+	clgpsetd.x	clpset.h
+	clgpseti.x	clpset.h
+	clgpsetl.x	clpset.h
+	clgpsetr.x	clpset.h
+	clgpsets.x	clpset.h
+	clgpsetx.x	clpset.h
+	clgstr.x	
+	clgwrd.x	
+	cllpset.x	clpset.h
+	clopen.x	<config.h> <fset.h> <knet.h> <ttset.h>
+	clopset.x	clpset.h
+	clppset.x	clpset.h
+	clppseta.x	clpset.h
+	clppsetb.x	clpset.h
+	clppsetc.x	clpset.h
+	clppsetd.x	clpset.h
+	clppseti.x	clpset.h
+	clppsetl.x	clpset.h
+	clppsetr.x	clpset.h
+	clppsets.x	clpset.h
+	clppsetx.x	clpset.h
+	clpsetnm.x	clpset.h
+	clpstr.x	
+	clputb.x	
+	clputc.x	<ctype.h>
+	clputd.x	
+	clputi.x	
+	clputr.x	
+	clputx.x	
+	clreqpar.x	<clset.h>
+	clseti.x	clio.com <clio.h> <clset.h>
+	clstati.x	clio.com <clio.h> <clset.h>
+	gexfls.x	
+	rdukey.x	<ctype.h> <fset.h> <ttset.h>
+	zfiocl.x	clio.com <clio.h> <config.h> <ctype.h> <fio.h>\
+			<fset.h> <knet.h> <mach.h>
+	;
diff --git a/sys/clio/rdukey.x b/sys/clio/rdukey.x
new file mode 100644
index 00000000..5dc44801
--- /dev/null
+++ b/sys/clio/rdukey.x
@@ -0,0 +1,209 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<ttset.h>
+include	<fset.h>
+
+# RD_UKEY -- Read a user keystroke from the terminal.  The "ukey" object is
+# either a single key, or the : key plus associated string value.
+# The value of a ukey parameter is returned as a string (as for rcursor)
+# and is normally fetched by an applications program with CLGKEY.  The
+# format of the command string is
+#
+#	ch strval
+#
+# where the `strval' is present only if CH=:, i.e., the command is a colon
+# escape.  Control keys are encoded as octal codes of the form \NNN.
+
+int procedure rdukey (keystr, maxch)
+
+char	keystr[ARB]	 	# receives keystroke command string
+int	maxch			# max chars out
+
+int	junk, ch
+int	delay, key, tty
+pointer	sp, buf, ip, op
+bool	rawmode_set, ucasein_set
+bool	playback_set, pbverify_set
+
+pointer	ttyodes()
+int	fstati(), ttstati(), envgets(), getci()
+define	again_ 91
+define	done_  92
+errchk	ttyodes, syserrs
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call flush (STDERR)
+	call flush (STDOUT)
+
+	# Note whether playback mode is in effect, and set raw mode if it
+	# is not already set.
+
+	rawmode_set  = (fstati  (STDIN, F_RAW) == YES)
+	playback_set = (ttstati (STDIN, TT_PLAYBACK) == YES)
+	pbverify_set = (ttstati (STDIN, TT_PBVERIFY) == YES)
+	ucasein_set  = (ttstati (STDIN, TT_UCASEIN) == YES)
+
+	if (!rawmode_set)
+	    call fseti (STDIN, F_RAW, YES)
+	if (playback_set) {
+	    delay = ttstati (STDIN, TT_PBDELAY)
+	    call ttseti (STDIN, TT_PBDELAY, 0)
+	}
+
+	# Get keystroke.
+	tty = NULL
+again_
+	if (getci (STDIN, key) == EOF)
+	    goto done_
+
+	if (tty == NULL && (key == ':' || playback_set)) {
+	    junk = envgets ("terminal", Memc[buf], SZ_LINE)
+	    tty = ttyodes (Memc[buf])
+	    if (tty == ERR) {
+		if (!rawmode_set)
+		    call fseti (STDIN, F_RAW, NO)
+		call syserrs (SYS_TTYDEVNF, Memc[buf])
+	    }
+	}
+
+	# If colon escape, clear the current line and read the string value.
+	# The read is performed in raw mode to avoid a line feed and scroll
+	# when the CR is typed.
+	
+	if (key == ':') {
+	    call ttyclearln (STDOUT, tty)
+	    call ttyputline (STDOUT, tty, "\r:", NO)
+	    call flush (STDOUT)
+
+	    for (op=buf;  getci (STDIN, ch) != EOF;  ) {
+		if (ch == '\177' || ch == '\010') {
+		    if (op > buf) {
+			op = op - 1
+			Memc[op] = EOS
+			call ttyclearln (STDOUT, tty)
+			call ttyputline (STDOUT, tty, "\r:", NO)
+			call ttyputline (STDOUT, tty, Memc[buf], NO)
+			call flush (STDOUT)
+		    }
+		} else if (ch == '\003') {
+		    call ttyclearln (STDOUT, tty)
+		    goto again_
+		} else if (ch == '\n' || ch == '\r' || (op - buf) >= SZ_LINE) {
+		    break
+		} else {
+		    call putci (STDOUT, ch)
+		    call flush (STDOUT)
+		    if (ucasein_set && IS_UPPER(ch))
+			Memc[op] = TO_LOWER(ch)
+		    else
+			Memc[op] = ch
+		    op = op + 1
+		}
+	    }
+
+	    Memc[op] = '\n';  op=op+1
+	    Memc[op] = EOS
+
+	    call flush (STDOUT)
+
+	} else {
+	    Memc[buf] = EOS
+	    if (ucasein_set && IS_UPPER(key))
+		key = TO_LOWER(key)
+	}
+
+done_
+	# When we get here the key character has been set and the string
+	# value, if any, is in buf.  If in playback mode with verify
+	# enabled, wait for the user to type a key before continuing.
+	
+	if (playback_set) {
+	    call ttseti (STDIN, TT_PASSTHRU, YES)
+
+	    if (key != ':') {
+		if (!pbverify_set)
+		    call zwmsec (delay)
+		call ttyso (STDOUT, tty, YES)
+		if (key > ' ')
+		    call printf (" [key=%c]")
+		else
+		    call printf (" [key=\\%o]")
+		call pargi (key)
+		call ttyso (STDOUT, tty, NO)
+		call flush (STDOUT)
+	    }
+
+	    if (pbverify_set) {
+		# Read directly from user terminal in passthru mode.
+		while (getci (STDIN, ch) != EOF)
+		    if (ch == ' ') {
+			break
+		    } else if (ch == 'q' || ch == '\003') {
+			call putline (STDOUT, "\r[playback mode terminated]")
+			call flush (STDOUT)
+			call zwmsec (500)
+			call ttseti (STDIN, TT_PLAYBACK, NO)
+			break
+		    } else if (ch == 'g') {
+			call ttseti (STDIN, TT_PBVERIFY, NO)
+			break
+		    } else {
+			call ttyclearln (STDOUT, tty)
+			call ttyso (STDOUT, tty, YES)
+			call putline (STDOUT,
+			    "\r[space=continue,q=quit,g=noverify]")
+			call ttyso (STDOUT, tty, NO)
+			call flush (STDOUT)
+		    }
+	    } else
+		call zwmsec (delay)
+
+	    call ttseti (STDIN, TT_PASSTHRU, NO)
+	    call ttseti (STDIN, TT_PBDELAY, delay)
+	}
+
+	if (tty != NULL) {
+	    call ttyclearln (STDOUT, tty)
+	    call ttycdes (tty)
+	}
+
+	if (!rawmode_set)
+	    call fseti (STDIN, F_RAW, NO)
+
+	if (key == EOF || key == '\032' || key == '\004') {
+	    call strcpy ("EOF\n", keystr, maxch)
+	    call sfree (sp)
+	    return (EOF)
+
+	} else {
+	    op = 1
+	    if (key > ' ') {
+		keystr[op] = key;  op=op+1
+	    } else if (maxch >= 4) {
+		keystr[op] = '\\';  op=op+1
+		keystr[op] = '0';  op=op+1
+		keystr[op] = key / 8 + '0';  op=op+1
+		keystr[op] = mod(key,8) + '0';  op=op+1
+	    }
+
+	    if (Memc[buf] != EOS && maxch > 1) {
+		keystr[op] = ' ';  op=op+1
+		for (ip=buf;  op < maxch && Memc[ip] != EOS;  ip=ip+1) {
+		    keystr[op] = Memc[ip]
+		    op = op + 1
+		}
+	    }
+
+	    # The return string value must be newline delimited.
+	    keystr[op] = '\n';  op=op+1
+	    keystr[op] = EOS
+
+	    call sfree (sp)
+	    return (op - 1)
+	}
+end
diff --git a/sys/clio/zfiocl.x b/sys/clio/zfiocl.x
new file mode 100644
index 00000000..dde60fc9
--- /dev/null
+++ b/sys/clio/zfiocl.x
@@ -0,0 +1,317 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<config.h>
+include	<fset.h>
+include	<fio.h>
+include	<ctype.h>
+include	<clio.h>
+
+define	SZ_NUMSTR	8
+
+.help zfiocl
+.nf __________________________________________________________________________
+ZFIOCL -- FIO z-routines (machine independent) for pseudofile i/o.  The STDIN,
+STDOUT, STDERR, and STDGRAPH streams are implemented as "pseudofiles" when a
+process is run as a connected subprocess communicating with the parent process
+via the IPC facilities.  In such a configuration the standard i/o streams
+(opened by the system [clopen] at process startup) are as follows:
+
+	fd	name		description
+
+	1	CLIN		IPC input from the parent	[low level]
+	2	CLOUT		IPC output to the parent	[low level]
+	3	STDIN		standard input
+	4	STDOUT		standard output
+	5	STDERR		standard error output
+	6	STDGRAPH	standard graphics output
+	7	STDIMAGE	standard greyscal output
+	8	STDPLOT		stdgraph plotter output
+	9	PSIOCTRL	pseudofile i/o control
+
+The CLIN and CLOUT streams are the FIO equivalents of the IPC channels, i.e.,
+they are connected to physical host i/o channels.  The standard i/o streams
+are multiplexed over the IPC channels by a packet passing protocol to the
+parent process, which redirects each stream to an FIO file (which may in turn
+be a pseudofile or a regular file).
+
+During execution of the child the parent has its command input switched to
+the CLOUT stream of the child, and the child commands the parent.  Commands
+are sent over the IPC channels as an SPP text stream, i.e., unpacked ASCII
+lines delimited by the newline character.   Pseudofile data is sent as a
+binary block preceded by a command to the parent to read so many chars from
+the channel and pass it on to the indicated actual file.  Typical output to
+CLOUT might be as follows:
+
+	param1 =
+	param2 =
+	xmit(4,34)
+	[34 chars of data]
+
+This example consists of three independent commands to the parent.  The first
+two are parameter requests and each is followed by a read from CLIN to get
+the parameter value (which is returned in ASCII and is limited to a single
+line).  Syncronization occurs on the read.  The binary data block in the
+third command (XMIT) may contain arbitrary binary data, i.e., pseudofile
+i/o is not limited to text.  In the example shown the 34 chars of data will
+be copied to the file associated by the parent with the STDOUT stream of
+the child.  The association of pseudofile codes at the IPC level with FIO
+file descriptor codes is simple: the pseudofile codes are the same as the
+fd codes.
+
+Although it is not relevant to a discussion of the pseudofile drivers, perhaps
+we should mention what happens to these streams when a process is run stand
+alone, i.e., no IPC channels.  When a process is run stand-alone (prtype ==
+PR_HOST) CLIN, CLOUT, and the pseudofiles are connected to standard i/o
+channels of the process as follows:
+
+	CLIN,STDIN		-> process_stdin
+	CLOUT,STDOUT		-> process_stdout
+	STDERR			-> process_stderr
+	STDGRAPH,etc.		-> null file
+
+The standard i/o streams are normally limited to text data in stand alone
+mode, since the process channels are normally connected to a terminal.  Any
+standard i/o stream may be redirected on the IRAF Main command line to
+either a text or binary file, regardless of the process type (connected,
+detached, or host).
+
+This file contains the FIO device drivers for each pseudofile.  The device
+codes are SI, SO, SE, and SG.  ZARDBF, ZAWRBF, ZAWTBF, and ZSTTBF entry
+points are supplied for each device.
+.endhelp _____________________________________________________________________
+
+
+# ZCLSPS -- Dummy close procedure for all pseudofile streams.
+
+procedure zclsps (chan, status)
+
+int	chan
+int	status
+
+begin
+	status = ERR
+end
+
+
+# ZARDPS -- "Asynchronous" read primitive for a pseudofile.  The read is
+# initiated by sending the following command to the parent:
+# 
+# 	xfer(ps,maxchars)\n
+# 
+# where "ps" is the pseudofile code (3=STDIN, etc.) and "maxchars" is the
+# maximum number of chars to be returned.  The parent responds with the actual
+# number of chars to be sent, followed by newline, followed by the block of
+# data, i.e.:
+# 
+#		CLOUT			          CLIN
+#	    xfer(3,512)\n
+#					    40\n
+#					    [40 chars of data]
+# 
+# The parent responds by writing to the child's CLIN.
+#
+# NOTE1 -- Since this is a device driver (effectively a kernel procedure despite
+# the machine independence) only low level procedures may be used, else a
+# recursive call may result.
+# NOTE2 -- There are some subtleties inherent in all this which are not obvious
+# at first glance.  Since CLIN and STDIN both read from the same IPC, some care
+# is required to ensure that one stream does not steal messages intended for
+# the other.  Fortunately this is not our concern here, but rather that of the
+# high level code.
+
+procedure zardps (ps, buf, maxbytes, offset)
+
+int	ps				# pseudofile
+char	buf[ARB]			# buffer to receive data
+int	maxbytes, maxchars		# capacity of buffer
+long	offset				# ignored at present
+
+char	numstr[SZ_NUMSTR]
+int	nbytes, nchars, ndigits, ip, clin_chan, raw_mode
+int	ctoi(), cl_psio_request(), fstati()
+include	"clio.com"
+define	ioerr_ 91
+
+begin
+	if (ps == STDOUT || ps == STDERR)
+	    goto ioerr_
+	clin_chan = fstati (CLIN, F_CHANNEL)
+	raw_mode  = fstati (ps, F_RAW)
+
+	# Send the XFER command to the parent.  If raw mode is in effect on
+	# the pseudofile, request only a single char.
+
+	if (raw_mode == YES)
+	    maxchars = 1
+	else
+	    maxchars = maxbytes / SZB_CHAR
+
+	if (cl_psio_request ("xfer", ps, maxchars) == ERR)
+	    goto ioerr_
+
+	# Get the number of chars to be read.
+	call zardpr (clin_chan, numstr, SZ_NUMSTR * SZB_CHAR, offset)
+	call zawtpr (clin_chan, nbytes)
+
+	if (nbytes < 0)
+	    goto ioerr_
+	else
+	    ndigits = nbytes / SZB_CHAR
+
+	# Decode count of chars in data block, a simple positive integer
+	# constant followed by a newline.  The case of a single digit
+	# (nchars < 10) is optimized.
+
+	if (ndigits == 0)
+	    nchars = 0
+	else if (ndigits == 1)
+	    nchars = TO_INTEG (numstr[1])
+	else {
+	    numstr[ndigits+1] = EOS
+	    ip = 1
+	    if (ctoi (numstr, ip, nchars) <= 0)
+		goto ioerr_
+	}
+
+	# Read the data.
+	nbytes = nchars * SZB_CHAR
+	if (nchars == 0)
+	    ps_status[ps] = 0				# EOF
+	else {
+	    call zardpr (clin_chan, buf, nbytes, offset)
+	    call zawtpr (clin_chan, ps_status[ps])
+	}
+	return
+ioerr_
+	ps_status[ps] = ERR
+	return
+end
+
+
+# ZAWRPS -- Write primitive for a pseudofile.  The write is initiated by
+# sending the following command to the CL:
+# 
+# 	xmit(ps,nchars)\n
+# 
+# where "ps" is the pseudofile number, and "nchars" is the number of chars
+# of binary data to be read from CLOUT and copied to the file connected to
+# pseudofile "ps" by the parent.
+
+procedure zawrps (ps, buf, nbytes, offset)
+
+int	ps				# pseudofile
+char	buf[ARB]			# buffer to receive data
+int	nbytes				# capacity of buffer
+long	offset				# ignored at present
+
+int	nchars, clout_chan
+int	cl_psio_request(), fstati()
+include	"clio.com"
+define	ioerr_ 91
+
+begin
+	if (ps == STDIN)
+	    goto ioerr_
+	clout_chan = fstati (CLOUT, F_CHANNEL)
+
+	# Send the XMIT command to the parent.
+	nchars = nbytes / SZB_CHAR
+	if (cl_psio_request ("xmit", ps, nchars) == ERR)
+	    goto ioerr_
+
+	# Send the data block.
+	call zawrpr (clout_chan, buf, nbytes, offset)
+	call zawtpr (clout_chan, ps_status[ps])
+	return
+ioerr_
+	ps_status[ps] = ERR
+	return
+end
+
+
+# ZAWTPS -- Wait for i/o to a pseudofile (required by the FIO interface,
+# though pseudofile i/o is not really asynchronous).
+
+procedure zawtps (ps, status)
+
+int	ps			# pseudofile code
+int	status			# nbytes transferred in last packed (output)
+include	"clio.com"
+
+begin
+	status = ps_status[ps]
+end
+
+
+# ZSTTPS -- Channel status of a pseudofile.  With the exception of the optimal
+# buffer size for STDERR we default to the IPC status parameters, since i/o
+# is ultimately over IPC channels to the parent process.
+
+procedure zsttps (ps, what, lvalue)
+
+int	ps			# pseudofile
+int	what			# status parameter requested
+long	lvalue			# output value (long)
+
+int	fstati()
+
+begin
+	if (ps == STDERR && what == FSTT_OPTBUFSIZE)
+	    lvalue = SZ_LINE * SZB_CHAR
+	else
+	    call zsttpr (fstati(CLIN,F_CHANNEL), what, lvalue)
+end
+
+
+# CL_PSIO_REQUEST -- Output "cmd(arg1,arg2)\n" to CLOUT.  Called by CL_ZARDPS
+# and CL_ZAWRPS to send the XMIT and XFER commands to the CL, when writing to
+# or reading from a pseudofile.
+
+int procedure cl_psio_request (cmd, arg1, arg2)
+
+char	cmd[ARB]		# e.g. "xmit" or "xfer"
+int	arg1, arg2		# integer arguments
+
+int	ip, status, clout_chan
+pointer	obuf, sp, op
+long	offset
+int	itoc(), fstati()
+define	output {Memc[op]=$1;op=op+1}
+
+begin
+	call smark (sp)
+	call salloc (obuf, SZ_PATHNAME, TY_CHAR)
+
+	clout_chan = fstati (CLOUT, F_CHANNEL)
+
+	op = obuf
+	for (ip=1;  cmd[ip] != EOS;  ip=ip+1)
+	    output (cmd[ip])
+
+	# Encode argument list.  Arguments are assumed to always be
+	# nonnegative.  Optimized for simple single digit numbers.
+
+	output ('(')
+	if (arg1 < 10)
+	    output (TO_DIGIT (arg1))
+	else
+	    op = op + itoc (arg1, Memc[op], SZ_PATHNAME-(op-obuf))
+
+	output (',')
+
+	if (arg2 < 10)
+	    output (TO_DIGIT (arg2))
+	else
+	    op = op + itoc (arg2, Memc[op], SZ_PATHNAME-(op-obuf))
+
+	output (')')
+	output ('\n')
+
+	call zawrpr (clout_chan, Memc[obuf], (op-obuf) * SZB_CHAR, offset)
+	call zawtpr (clout_chan, status)
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/dbio/README b/sys/dbio/README
new file mode 100644
index 00000000..d5411a74
--- /dev/null
+++ b/sys/dbio/README
@@ -0,0 +1,3 @@
+
+This directory shall contain the sources for the iraf database package.
+See the discussion in the crib sheet for more information on DBIO.
diff --git a/sys/dbio/db2.doc b/sys/dbio/db2.doc
new file mode 100644
index 00000000..66a38c41
--- /dev/null
+++ b/sys/dbio/db2.doc
@@ -0,0 +1,674 @@
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+                            IRAF DATABASE I/O
+                                Doug Tody
+                              November 1984
+
+
+
+
+
+1. INTRODUCTION
+
+    The  IRAF  database  i/o package (DBIO) is a library of SPP callable
+procedures used to create, modify, and access IRAF database files.   All
+access  to  these database files shall be indirectly or directly via the
+DBIO interface.  DBIO shall be  implemented  using  IRAF  file  i/o  and
+memory  management  facilities,  hence  the  package will be compact and
+portable.  The separate CL level package  DBMS  shall  be  provided  for
+interactive  database  access  and for procedural access to the database
+from within CL scripts.  The DBMS tasks will  access  the  database  via
+DBIO.
+
+Virtually  all  runtime IRAF datafiles not maintained in text form shall
+be maintained under DBIO, hence it is essential that  the  interface  be
+both  efficient  and  compact.   In  particular,  bulk data (images) and
+large catalogs shall be maintained  under  DBIO.   The  requirement  for
+flexibility  in  defining  and accessing IRAF image headers necessitates
+quite a sophisticated interface.  Catalog storage is required  primarily
+for  module  intercommunication  and output of the results of the larger
+IRAF applications packages,  but  will  also  be  useful  for  accessing
+astronomical   catalogs  prepared  outside  IRAF  (e.g.,  the  SAO  star 
+catalog).  In  short,  virtually  all  IRAF  applications  packages  are
+expected to make use of DBIO; many will depend upon it heavily.
+
+The  relationship of the DBIO and DBMS packages to each other and to the
+related standard IRAF interfaces is shown in Figure 1.1.
+
+
+                DBMS
+                        DBIO
+                                FIO
+                                MEMIO
+                                        (kernel)
+                                                (datafiles)
+
+             (cl)    |      (vos)     |     (host)
+
+
+
+                        Fig 1.1 Major Interfaces
+
+
+While images will be maintained under DBIO, access to  the  pixels  will
+continue  to  be provided by the IMIO interface.  IMIO is a higher level
+interface which will use DBIO  to  maintain  the  image  header.   Pixel
+
+
+                                  -1-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+storage  will  be  either  in  a  separate  pixel storage file or in the
+database file itself (as a one  dimensional  array),  depending  on  the
+size  of  the  image.   A  system  defined thresold value will determine
+which type of storage is used.  The relationship  of  IMIO  to  DBIO  is
+shown in Figure 1.2.
+
+
+                        IMAGES
+                                IMIO
+                                        DBIO
+                                        FIO
+                                        MEMIO
+
+                        (cl)   |    (vos)
+
+
+             Fig 1.2 Relationship of Database and Image I/O
+
+
+
+2. REQUIREMENTS
+
+    The  requirements  for the DBIO interface are driven by its intended
+usage for image and catalog storage.  It is arguable  whether  the  same
+interface  should  be used for both types of data, but development of an
+interface such as  DBIO  with  all  the  associated  DBMS  utilities  is
+expensive,  hence  we  would  prefer  to  have  to develop only one such
+interface.  Furthermore, it is desirable for the user to  only  have  to
+learn  one  such  interface.   The  primary  functional  and performance
+requirements which DBIO must meet are the following  (in  no  particular
+order).
+
+
+    [1] DBIO  shall  provide a high degree of data independence, i.e., a
+        program shall be able to  access  a  data  structure  maintained
+        under DBIO without detailed knowledge of its contents.
+    
+    [2] A  DBIO  datafile  shall  be self describing and self contained,
+        i.e.,  it  shall  be  possible  to  examine  the  structure  and 
+        contents  of  a  DBIO  datafile  without  prior knowledge of its
+        structure or contents.
+    
+    [3] DBIO shall be able to deal efficiently with  records  containing
+        up  to N fields and with data groups containing up to M records,
+        where N and M are at least sysgen configurable and are order  of
+        magnitude N=10**2 and M=10**6.
+    
+    [4] The  time  required to access an image header under DBIO must be
+        comparable to the time currently  required  for  the  equivalent
+        operation under IMIO.
+    
+
+
+
+
+                                  -2-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+    [5] It  shall  be possible for an image header maintained under DBIO
+        to contain application or user defined  fields  in  addition  to
+        the standard fields required by IMIO.
+    
+    [6] It  shall  be  possible  to  dynamically  add  new  fields to an
+        existing image header (or to any DBIO record).
+    
+    [7] It shall be possible to group similar records  together  in  the
+        database  and  to  perform global operations upon all or part of
+        the records in a group.
+    
+    [8] It  shall  be  possible  for  a  field  of  a  record  to  be  a 
+        one-dimensional array of any of the primitive types.
+    
+    [9] Variant  records (records containing variable size fields) shall
+        be supported, ideally without  penalizing  efficient  access  to
+        databases which do not contain such records.
+    
+    [A] It  shall  be possible to copy a record without knowledge of its
+        contents.
+    
+    [B] It shall be possible to  merge  (join)  two  records  containing
+        disjoint sets of fields.
+    
+    [C] It shall be possible to update a record in place.
+    
+    [D] It   shall  be  possible  to  simultaneously  access  (retrieve, 
+        update, or insert) multiple records from the same data group.
+
+
+To summarize, the primary requirements are data independence,  efficient
+access  to  both  large  and  small  databases,  and  flexibility in the
+contents of the database.
+
+
+
+3. CONCEPTUAL DESIGN
+
+    The DBIO database faciltities shall be  based  upon  the  relational
+model.   The relational model is preferred due to its simplicity (to the
+user) and due to the demonstrable fact  that  relational  databases  can
+efficiently  handle  large amounts of data.  In the relational model the
+database appears to be nothing more  than  a  set  of  TABLES,  with  no
+builtin  connections  between  separate  tables.  The operations defined
+upon these tables are based upon the relational  algebra,  which  is  in
+turn   based   upon  set  theory.   The  major  advantages  claimed  for 
+relational databases are the simplicity of the concept of a database  as
+a  collection  of  tables,  and  the  predictability  of  the relational
+operators due to their being based on a formal theoretical model.
+
+None of the requirements listed  in  section  2  state  that  DBIO  must
+implement  a  relational  database.   Most  of  our  needs can be met by
+structuring our data according to the relational data  model  (i.e.,  as
+
+
+                                  -3-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+tables),  and  providing  a  good SELECT operator for retrieving records
+from the database.  If a semirelational database is sufficient  to  meet
+our  requirements  then most likely that is what will be built (at least
+initially;  the  relational  operators  are  very  attractive  for  data 
+analysis).   DBIO  is not expected to be competitive with any commercial
+relational database; to try to make it so would probably compromise  the
+requirement  that  the  interface  be  compact.   On the other hand, the
+database requirements of IRAF are similar enough to those  addressed  by
+commercial  databases that we would be foolish not to try to make use of
+some of the same technology.
+
+
+        FORMAL RELATIONAL TERM              INFORMAL EQUIVALENTS
+
+                relation                        table
+                tuple                           record, row
+                attribute                       field, column
+                domain                          datatype
+                primary key                     record id
+
+
+A DBIO DATABASE shall consist of one or more RELATIONS  (tables).   Each
+relation  shall  contain zero or more RECORDS (rows of the table).  Each
+record shall contain one or more FIELDS (columns  of  the  table).   All
+records  in  a  relation  shall share the same set of fields, but all of
+the fields in a record need not have been assigned values.  When  a  new
+ATTRIBUTE  (column)  is  added  to an existing relation a default valued
+field is added to each current and future record in the relation.
+
+Each attribute is defined upon a particular DOMAIN,  e.g.,  the  set  of
+all  nonnegative  integer values less than or equal to 100.  It shall be
+possible to specify minimum and maximum  values  for  integer  and  real
+attributes  and  to  enumerate  the  permissible values of a string type
+attribute.  It shall be possible to  specify  a  default  value  for  an
+attribute.   If  no  default  value  is  given  INDEF  is  assumed.  One
+dimensional arrays shall be supported as attribute types; these will  be
+treated  as  atomic datatypes by the relational operators.  Array valued
+attributes shall be either fixed in size (the most  efficient  form)  or
+variant.   There  need be no special character string datatype since one
+dimensional arrays of type character are supported.
+
+Each relation shall be implemented as a separate file.  If the relations
+comprising  a  database are stored in a directory then the directory can
+be thought of as the database.  Public databases will be stored in  well
+known  public  (write  protected) directories, private databases in user
+directories.  The logical directory name of each public database will be
+the  name  of  the  database.   Physical storage for a database need not
+necessarily be allocated locally, i.e.,  a  database  may  be  centrally
+located  and  remotely  accessed if the host computer is part of a local
+area network.
+
+Locking shall be at the level of entire relations  rather  than  at  the
+record  level,  at  least in the initial implementation.  There shall be
+
+
+                                  -4-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+no support for indices in the  initial  implementation  except  possibly
+for  the  primary  key.   It should be possible to add either or both of
+these features to a future implementation  without  changing  the  basic
+DBIO  interface.   Modifications to the internal data structures used in
+database files will  likely  be  necessary  when  adding  such  a  major
+feature,  making  a  save  and  restore  operation  necessary  for  each 
+database file to convert it to the new format.  The save  format  chosen
+(e.g.  FITS  table) should be independent of the internal format used at
+a particular time on a particular host machine.
+
+Images shall be stored in  the  database  as  individual  records.   All
+image  records  shall  share  a  common  subset  of attributes.  Related
+images (image records) may be grouped together to form  relations.   The
+IRAF  image  operators  shall support operations upon relations (sets of
+images) much as the IRAF file operators support operations upon sets  of
+files.
+
+A  unary  image  operator  shall take as input a relation (set of one or
+more images), inserting the processed images into the  output  relation.
+A  binary  image  operator shall take as input either two relations or a
+relation and a record, inserting the processed images  into  the  output
+relation.   In all cases the output relation can be an input relation as
+well.  The input relation will  be  defined  either  by  a  list  or  by
+selection  using  a  theta-join  (operationally  similar  to  a filename
+template).
+
+
+
+3.1 RELATIONAL OPERATORS
+
+    DBIO  shall  support  two  basic  types  of   database   operations: 
+operations  upon  relations  and  operations  upon  records.   The basic
+relational operators are the following.  All of these operators  produce
+as output a new relation.
+
+
+    create
+        Create  a  new  base  relation  (physical  relation as stored on
+        disk) by  specifying  an  initial  set  of  attributes  and  the
+        (file)name  for the new relation.  Attributes and domains may be
+        specified via a data definition  file  or  by  reference  to  an
+        existing   relation.    A  primary  key  (limited  to  a  single 
+        attribute) should be identified.   The  new  relation  initially
+        contains no records.
+    
+    drop
+        Delete  a  (possibly  nonempty) base relation and any associated
+        indices.
+    
+    alter 
+        Add a new attribute or attributes to an existing base  relation.
+        Attributes  may  be  specified  explicitly  or  by  reference to
+        another relation.
+
+
+                                  -5-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+    select
+        Create a new relation by selecting  records  from  one  or  more
+        existing   base  relations.   Input  consists  of  an  algebraic 
+        expression defining the output relation in terms  of  the  input
+        relations  (usage  will  be similar to filename templates).  The
+        output relation need not have the same set of attributes as  the
+        input relations.  The SELECT operator shall ultimately implement
+        all the  basic  operations  of  the  relational  algebra,  i.e.,
+        select,  project,  join,  and the set operations.  At a minimum,
+        selection  and  projection   are   required   in   the   initial 
+        interface.   The  output of SELECT is not a named relation (base
+        relation), but is instead intended to be accessed by the  record
+        level operators discussed in the next section.
+    
+    edit
+        Edit  a  relation.   An  interactive  screen  editor  is entered
+        allowing  the  user  to  add,  delete,  or  modify  tuples  (not 
+        required  in  the  initial  version  of  the  interface).  Field
+        values are verified upon input.
+    
+    sort
+        Make the storage order of the records in a relation  agree  with
+        the  order defined by the primary key (the index associated with
+        the primary key is always sorted but index order need not  agree
+        with   storage  order).   In  general,  retrieval  on  a  sorted 
+        relation  is  more  efficient  than  on  an  unsorted  relation. 
+        Sorting  also eliminates deadspace left by record deletion or by
+        updates involving variant records.
+
+
+Additional  nonalgebraic  operators  are  required  for  examining   the 
+structure  and contents of relations, returning the number of records or
+attributes in a relation,  and  determining  whether  a  given  relation
+exists.
+
+The  SELECT  operator is the primary user interface to DBIO.  Since most
+of the relational power of DBIO is bound up in the SELECT  operator  and
+since  SELECT  will  be  driven  by  an  algebraic expression (character
+string) there is considerable  scope  for  future  enhancement  of  DBIO
+without affecting existing code.
+
+
+
+3.2 RECORD (TUPLE) LEVEL OPERATORS
+
+    While  the user should see primarily operations on entire relations,
+record level processing is necessary at  the  program  level  to  permit
+data  entry  and  implementation of special operators.  The basic record
+level operators are the following.
+
+
+
+
+
+
+                                  -6-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+    retrieve
+        Retrieve the next record from the relation  defined  by  SELECT.
+        While  the  tuples in a relation theoretically form an unordered
+        set, tuples will normally be returned in  either  storage  order
+        or  in  the  sort order of the primary key.  Although all fields
+        of a  retrieved  record  are  accessible,  an  application  will
+        typically have knowledge of only a few fields.
+    
+    update
+        Rewrite  the  (possibly  modified)  current record.  The updated
+        record is written back into the base table  from  which  it  was
+        read.  Not all records produced by SELECT can be updated.
+    
+    insert
+        Insert  a  new  record  into  an  output  relation.   The output
+        relation may be an input relation as well.  Records added to  an
+        output  relation  which  is also an input relation do not become
+        candidates  for  selection  until  another  SELECT  occurs.    A 
+        retrieve   followed   by  an  insert  copies  a  record  without 
+        knowledge of its contents.  A retrieve followed by  modification
+        of  selected  fields followed by an insert copies all unmodified
+        fields of the record.  The attributes of the  input  and  output
+        relations  need  not  match; unmatched output attributes take on
+        their  default  values  and  unmatched  input   attributes   are 
+        discarded.   INSERT  returns  a  pointer  to  the output record,
+        allowing  insertions  of  null  records  to   be   followed   by 
+        initialization of the fields of the new record.
+    
+    delete
+        Delete the current record.
+
+
+Additional operators are required to close or open a relation for record
+level access and to count the number of records in a relation.
+
+
+
+3.2.1 CONSTRUCTING SPECIAL RELATIONAL OPERATORS
+
+    The record level operations may be combined with SELECT in  compiled
+programs  to  implement arbitrary operations upon entire relations.  The
+basic scenario is as follows:
+
+
+    [1] The set of records to be operated upon, defined  by  the  SELECT
+        operator,  is opened as an unordered set (list) of records to be
+        processed.
+    
+    [2] The "next" record in the relation is accessed with RETRIEVE.
+    
+
+
+
+
+
+                                  -7-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+    [3] The application reads or modifies a subset of the fields of  the
+        record,  updating  modified  records  or inserting the record in
+        the output relation.
+    
+    [4] Steps [2] and [3] are repeated until  the  entire  relation  has
+        been processed.
+
+
+Examples of such operators are conversion to and from DBIO and LIST file
+formats, column extraction, mimimum or maximum of an  attribute  (domain
+algebra), and all of the DBMS and IMAGES operators.
+
+
+
+3.3 FIELD (ATTRIBUTE) LEVEL OPERATORS
+
+    Substantial  processing  of  the  contents of a database is possible
+without ever accessing the individual fields  of  a  record.   If  field
+level  access  is  required  the  record  must  first  be  retrieved  or 
+inserted.  Field level access requires knowledge of  the  names  of  the
+attributes  of  the  parent  relation,  but  not  their exact datatypes.
+Automatic type conversion occurs when field values are queried or set.
+
+
+    get 
+        Get the value of the named scalar or vector field (typed).
+    
+    put 
+        Put the value of the named scalar or vector field (typed).
+    
+    read
+        Read the named fields into an  SPP  data  structure,  given  the
+        name,  datatype,  and  length  (if  vector) of each field in the
+        output structure.  There must be  an  attribute  in  the  parent
+        relation for each field in the output structure.
+    
+    write
+        Copy  an  SPP  data structure into the named fields of a record,
+        given the name, datatype, and length (if vector) of  each  field
+        in  the  input  structure.   There  must  be an attribute in the
+        parent relation for each field in the input structure.
+    
+    access
+        Determine whether a relation has the named attribute.
+
+
+
+3.4 STORAGE STRUCTURES
+
+    The DBIO storage structures are the data structures used by DBIO  to
+maintain  relations  in  physical storage.  The primary design goals are
+simplicity and efficiency in time and space.  Most actual relations  are
+expected to fall into three classes:
+
+
+                                  -8-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+    [1] Relations  containing  only  a  single  record,  e.g.,  an image
+        stored alone in a relation.
+    
+    [2] Relations containing several dozen or several  hundred  records,
+        e.g., a collection of spectra from an observing run.
+    
+    [3] Large  relations  containing  10**5  or 10**6 records, e.g., the
+        output of an analysis program or an astronomical catalog.
+
+
+Updates and insertions are generally random access operations; retrieval
+based  on the values of several attributes requires efficient sequential
+access.  Efficient random access for relations [2] and [3] requires  use
+of  an  index.   Efficient  sequential  access  requires that records be
+accessible in storage order without reference to the index,  i.e.,  that
+records  be  chained  in  storage order.  Efficient field access where a
+record contains several dozen attributes requires something better  than
+a linear search over the attribute list.
+
+The  use  of  an  index shall be limited initially to a single index for
+the primary key.  The  primary  key  will  be  restricted  to  a  single
+attribute,  with  the  application defining the attribute to be used (in
+practice few attributes are usable  as  keys).   The  index  will  be  a
+standard  B+  tree,  with one exception: the root block of the tree will
+be maintained in dedicated storage in the datafile.  If and  only  if  a
+relation  grows  so  large  that  it  overflows  the  root  block will a
+separate index file be allocated for the  index.   This  will  eliminate
+most of the overhead associated with the index for small relations.
+
+Efficient  sequential access will be provided in either of two ways: via
+the index in index order or via the records themselves in storage order,
+depending  on  the  operation  being performed.  If an external index is
+used the leaves will be chained to permit  efficient  sequential  access
+in  index  order.   If  the  relation also happens to be sorted in index
+order  then  this  mode  of  access  will  be  very   efficient.    Link 
+information  will  also  be  stored  directly  in  the records to permit
+efficient sequential access when it is not necessary or possible to  use
+the index.
+
+Assuming  that there is at most one index associated with a relation, at
+most two files will be required to implement the relation.  The relation
+itself will have the file extension ".db".  The index file, if any, will
+have the extension ".dbi".  The root name of  both  files  will  be  the
+name of the relation.
+
+The  datafile  header  structure  will probably have to be maintained in
+binary if we are to keep the overhead of datafile access  to  acceptable
+levels  for  small  relations.   Careful  design  of  the  basic  header 
+structure should make most future refinements  to  the  header  possible
+without  modification  of  existing  databases.   The revision number of
+DBIO used to create the datafile will be saved in the header to make  at
+least detection of obsolete headers possible.
+
+
+
+                                  -9-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+3.4.1 STRUCTURE OF A BINARY RELATION
+
+    Putting  all  this  together we come up with the following structure
+for a binary relation:
+
+
+        BOF
+        relation header                         -+
+                magic                            |
+                dbio revision number             |
+                creation date                    |
+                relation name                    |
+                number of attributes             |- fixed size header
+                primary key                      |
+                record size                      |
+                domain list                      |
+                attribute list                   |
+                miscellaneous                    |
+        string buffer                            |
+        root block of index                     -+
+        record 1
+                physical record length (offset to next record)
+                logical record length (implies number of attributes set)
+                field storage
+                <gap>
+        record 2
+                ...
+        record N
+        EOF
+
+
+Vector valued fields with a fixed upper size will be stored directly  in
+the  record, prefixed by the length of the actual vector (which may vary
+from record to record).  Storage for variant fields  will  be  allocated
+outside  the  record, placing only a pointer to the data vector and byte
+count in the record itself.  Variant records are thus reduced  to  fixed
+size  records,  simplifying  record  access and making sequential access
+more efficient.
+
+Records will change size only when  a  new  attribute  is  added  to  an
+existing  relation,  followed  by  assignment into a record written when
+there were fewer attributes.  If the new record will not  fit  into  the
+physical  slot  already  allocated, the record is written at EOF and the
+original record is  deleted.   Deletion  of  a  record  is  achieved  by
+setting  the  logical  record  length to zero.  Storage is not reclaimed
+until a sort occurs, hence recovery of deleted records is possible.
+
+To minimize buffer space and memory to memory copies  when  accessing  a
+relation  it  is  desirable to work directly out of the FIO buffers.  To
+make this possible records will not be  permitted  to  straddle  logical
+block  boundaries.   A file block will typically contain several records
+followed by a gap.  The gap may be used to accomodate  record  expansion
+without  moving a record to EOF.  The size of a file block is fixed when
+
+
+                                 -10-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+the relation is created.
+
+
+
+3.4.2 THE ATTRIBUTE LIST
+
+    Efficient lookup of attribute names suggests maintenance of  a  hash
+table  in the datafile header.  There will be a fixed upper limit on the
+number of attributes permitted in a single  relation  (but  not  on  the
+number  of records).  Placing an upper limit on the number of attributes
+simplifies the software considerably and permits use  of  a  fixed  size
+header,  making  it  possible to read or update the entire header in one
+disk access.  There will also  be  an  upper  limit  on  the  number  of
+domains,  but  the domain list is not searched very often hence a linear
+search will do.
+
+All information about the decomposition of a record into  fields,  other
+than  the  logical  length  of  vector  valued  fields,  is given by the
+attribute list.  Records contain only data with no  embedded  structural
+information  other than the length of the vector fields.  New attributes
+are added to a relation by appending to the  attribute  list.   Existing
+records  are  not affected.  By comparing the logical length of a record
+to the offset for a particular field we can  tell  whether  storage  has
+been allocated for that field in the record.
+
+Domains  are used to limit the range of values a field can take on in an
+assignment, and to flag attribute comparisons which  are  likely  to  be
+erroneous   (e.g.   order   comparison  of  a  pixel  coordinate  and  a 
+wavelength).   The   domains   "bool",   "char",   "short",   etc.   are 
+predefined.   The  following  information  must  be stored for each user
+defined domain:
+
+
+        name                    may be same as attribute name
+        datatype                bool, char, short, etc.
+        physical vector length  0=variant, 1=scalar, N=vector
+        default                 default value, INDEF if not given
+        minimum                 mimimum value (ints and reals)
+        maximum                 maximum value (ints and reals)
+        enumval                 enumerated values (strings)
+
+
+The following information is required to describe each  attribute.   The
+attribute list is maintained separately from the hash table of attribute
+names and can be used to regenerate the hash table of attribute names if
+necessary.
+
+
+        name                    no embedded whitespace
+        domain                  index into domain table
+        offset                  offset in record
+
+
+
+
+                                 -11-
+DBIO (Nov84)               Database I/O Design              DBIO (Nov84)
+
+
+
+All  strings  will  will  be stored in a fixed size string buffer in the
+header area; it is the index of  the  string  which  is  stored  in  the
+domain  and attribute lists.  This eliminates the need to place an upper
+limit on the size of domain names and enumerated value lists  and  makes
+it  possible for a single attribute name string to be referenced in both
+the attribute list and the attribute hash table.
+
+
+
+4. SPECIFICATIONS
diff --git a/sys/dbio/db2.hlp b/sys/dbio/db2.hlp
new file mode 100644
index 00000000..ffe3b74c
--- /dev/null
+++ b/sys/dbio/db2.hlp
@@ -0,0 +1,612 @@
+.help dbio Nov84 "Database I/O Design"
+.ce
+\fBIRAF Database I/O\fR
+.ce
+Doug Tody
+.ce
+November 1984
+.sp 3
+.nh
+Introduction
+
+    The IRAF database i/o package (DBIO) is a library of SPP callable
+procedures used to create, modify, and access IRAF database files.
+All access to these database files shall be indirectly or directly via the
+DBIO interface.  DBIO shall be implemented using IRAF file i/o and memory
+management facilities, hence the package will be compact and portable.
+The separate CL level package DBMS shall be provided for interactive database
+access and for procedural access to the database from within CL scripts.
+The DBMS tasks will access the database via DBIO.
+
+Virtually all runtime IRAF datafiles not maintained in text form shall be
+maintained under DBIO, hence it is essential that the interface be both
+efficient and compact.  In particular, bulk data (images) and large catalogs
+shall be maintained under DBIO.  The requirement for flexibility in defining
+and accessing IRAF image headers necessitates quite a sophisticated interface.
+Catalog storage is required primarily for module intercommunication and
+output of the results of the larger IRAF applications packages, but will also
+be useful for accessing astronomical catalogs prepared outside IRAF (e.g.,
+the SAO star catalog).  In short, virtually all IRAF applications packages
+are expected to make use of DBIO; many will depend upon it heavily.
+
+The relationship of the DBIO and DBMS packages to each other and to the
+related standard IRAF interfaces is shown in Figure 1.1.
+
+
+.ks
+.nf
+		DBMS
+			DBIO
+				FIO
+				MEMIO
+					(kernel)
+						(datafiles)
+
+	     (cl)    |      (vos)     |     (host)
+
+
+
+.fi
+.ce
+Fig 1.1 Major Interfaces
+.ke
+
+
+While images will be maintained under DBIO, access to the pixels will
+continue to be provided by the IMIO interface.  IMIO is a higher level interface
+which will use DBIO to maintain the image header.  Pixel storage will be either
+in a separate pixel storage file or in the database file itself (as a one
+dimensional array), depending on the size of the image.
+A system defined thresold value will determine which type of storage is used.
+The relationship of IMIO to DBIO is shown in Figure 1.2.
+
+
+.ks
+.nf
+			IMAGES
+				IMIO
+					DBIO
+					FIO
+					MEMIO
+
+			(cl)   |    (vos)
+
+
+.fi
+.ce
+Fig 1.2 Relationship of Database and Image I/O
+.ke
+
+.nh
+Requirements
+
+    The requirements for the DBIO interface are driven by its intended usage
+for image and catalog storage.  It is arguable whether the same interface
+should be used for both types of data, but development of an interface such
+as DBIO with all the associated DBMS utilities is expensive, hence we would
+prefer to have to develop only one such interface.  Furthermore, it is desirable
+for the user to only have to learn one such interface.  The primary functional
+and performance requirements which DBIO must meet are the following (in no
+particular order).
+
+.ls
+.ls [1]
+DBIO shall provide a high degree of data independence, i.e., a program
+shall be able to access a data structure maintained under DBIO without
+detailed knowledge of its contents.
+.le
+.ls [2]
+A DBIO datafile shall be self describing and self contained, i.e., it shall
+be possible to examine the structure and contents of a DBIO datafile without
+prior knowledge of its structure or contents.
+.le
+.ls [3]
+DBIO shall be able to deal efficiently with records containing up to N fields
+and with data groups containing up to M records, where N and M are at least
+sysgen configurable and are order of magnitude N=10**2 and M=10**6.
+.le
+.ls [4]
+The time required to access an image header under DBIO must be comparable
+to the time currently required for the equivalent operation under IMIO.
+.le
+.ls [5]
+It shall be possible for an image header maintained under DBIO to contain
+application or user defined fields in addition to the standard fields
+required by IMIO.
+.le
+.ls [6]
+It shall be possible to dynamically add new fields to an existing image header
+(or to any DBIO record).
+.le
+.ls [7]
+It shall be possible to group similar records together in the database
+and to perform global operations upon all or part of the records in a
+group.
+.le
+.ls [8]
+It shall be possible for a field of a record to be a one-dimensional array
+of any of the primitive types.
+.le
+.ls [9]
+Variant records (records containing variable size fields) shall be supported,
+ideally without penalizing efficient access to databases which do not contain
+such records.
+.le
+.ls [A]
+It shall be possible to copy a record without knowledge of its contents.
+.le
+.ls [B]
+It shall be possible to merge (join) two records containing disjoint sets of
+fields.
+.le
+.ls [C]
+It shall be possible to update a record in place.
+.le
+.ls [D]
+It shall be possible to simultaneously access (retrieve, update, or insert)
+multiple records from the same data group.
+.le
+.le
+
+
+To summarize, the primary requirements are data independence, efficient access
+to both large and small databases, and flexibility in the contents of the
+database.
+
+.nh
+Conceptual Design
+    
+    The DBIO database facilities shall be based upon the relational model.
+The relational model is preferred due to its simplicity (to the user)
+and due to the demonstrable fact that relational databases can efficiently
+handle large amounts of data.  In the relational model the database appears
+to be nothing more than a set of \fBtables\fR, with no builtin connections
+between separate tables.  The operations defined upon these tables are based
+upon the relational algebra, which is in turn based upon set theory.
+The major advantages claimed for relational databases are the simplicity
+of the concept of a database as a collection of tables, and the predictability
+of the relational operators due to their being based on a formal theoretical
+model.
+
+None of the requirements listed in section 2 state that DBIO must implement
+a relational database.  Most of our needs can be met by structuring our data
+according to the relational data model (i.e., as tables), and providing a
+good \fBselect\fR operator for retrieving records from the database.  If a
+semirelational database is sufficient to meet our requirements then most
+likely that is what will be built (at least initially; the relational operators
+are very attractive for data analysis).  DBIO is not expected to be competitive
+with any commercial relational database; to try to make it so would probably
+compromise the requirement that the interface be compact.
+On the other hand, the database requirements of IRAF are similar enough to
+those addressed by commercial databases that we would be foolish not to try
+to make use of some of the same technology.
+
+
+.ks
+.nf
+	\fBformal relational term\fR		    \fBinformal equivalents\fR
+
+		relation			table
+		tuple				record, row
+		attribute			field, column
+		domain				datatype
+		primary key			record id
+.fi
+.ke
+
+
+A DBIO \fBdatabase\fR shall consist of one or more \fBrelations\fR (tables).
+Each relation shall contain zero or more \fBrecords\fR (rows of the table).
+Each record shall contain one or more \fBfields\fR (columns of the table).
+All records in a relation shall share the same set of fields,
+but all of the fields in a record need not have been assigned values.
+When a new \fBattribute\fR (column) is added to an existing relation a default
+valued field is added to each current and future record in the relation.
+
+Each attribute is defined upon a particular \fBdomain\fR, e.g., the set of
+all nonnegative integer values less than or equal to 100.  It shall be possible 
+to specify minimum and maximum values for integer and real attributes
+and to enumerate the permissible values of a string type attribute.
+It shall be possible to specify a default value for an attribute.
+If no default value is given INDEF is assumed.
+One dimensional arrays shall be supported as attribute types; these will be
+treated as atomic datatypes by the relational operators.  Array valued
+attributes shall be either fixed in size (the most efficient form) or variant.
+There need be no special character string datatype since one dimensional
+arrays of type character are supported.
+
+Each relation shall be implemented as a separate file.  If the relations
+comprising a database are stored in a directory then the directory can
+be thought of as the database.  Public databases will be stored in well
+known public (write protected) directories, private databases in user
+directories.  The logical directory name of each public database will be
+the name of the database.  Physical storage for a database need not necessarily
+be allocated locally, i.e., a database may be centrally located and remotely
+accessed if the host computer is part of a local area network.
+
+Locking shall be at the level of entire relations rather than at the record
+level, at least in the initial implementation.  There shall be no support for
+indices in the initial implementation except possibly for the primary key.
+It should be possible to add either or both of these features to a future
+implementation without changing the basic DBIO interface.  Modifications to
+the internal data structures used in database files will likely be necessary
+when adding such a major feature, making a save and restore operation
+necessary for each database file to convert it to the new format.
+The save format chosen (e.g. FITS table) should be independent of the
+internal format used at a particular time on a particular host machine.
+
+Images shall be stored in the database as individual records.
+All image records shall share a common subset of attributes.  
+Related images (image records) may be grouped together to form relations.
+The IRAF image operators shall support operations upon relations
+(sets of images) much as the IRAF file operators support operations upon
+sets of files.
+
+A unary image operator shall take as input a relation (set of one or more
+images), inserting the processed images into the output relation.  
+A binary image operator shall take as input either two relations or a
+relation and a record, inserting the processed images into the output
+relation.  In all cases the output relation can be an input relation as
+well.  The input relation will be defined either by a list or by selection
+using a theta-join (operationally similar to a filename template).
+
+.nh 2
+Relational Operators
+
+    DBIO shall support two basic types of database operations: operations upon
+relations and operations upon records.  The basic relational operators
+are the following.  All of these operators produce as output a new relation.
+
+.ls
+.ls create
+Create a new base relation (physical relation as stored on disk) by specifying
+an initial set of attributes and the (file)name for the new relation.
+Attributes and domains may be specified via a data definition file or by
+reference to an existing relation.
+A primary key (limited to a single attribute) should be identified.
+The new relation initially contains no records.
+.le
+.ls drop
+Delete a (possibly nonempty) base relation and any associated indices.
+.le
+.ls alter 
+Add a new attribute or attributes to an existing base relation.
+Attributes may be specified explicitly or by reference to another relation.
+.le
+.ls select
+Create a new relation by selecting records from one or more existing base
+relations.  Input consists of an algebraic expression defining the output
+relation in terms of the input relations (usage will be similar to filename
+templates).  The output relation need not have the same set of attributes as
+the input relations.  The \fIselect\fR operator shall ultimately implement
+all the basic operations of the relational algebra, i.e., select, project,
+join, and the set operations.  At a minimum, selection and projection are
+required in the initial interface.  The output of \fBselect\fR is not a
+named relation (base relation), but is instead intended to be accessed
+by the record level operators discussed in the next section.
+.le
+.ls edit
+Edit a relation.  An interactive screen editor is entered allowing the user
+to add, delete, or modify tuples (not required in the initial version of
+the interface).  Field values are verified upon input.
+.le
+.ls sort
+Make the storage order of the records in a relation agree with the order
+defined by the primary key (the index associated with the primary key is
+always sorted but index order need not agree with storage order).
+In general, retrieval on a sorted relation is more efficient than on an
+unsorted relation.  Sorting also eliminates deadspace left by record
+deletion or by updates involving variant records.
+.le
+.le
+
+
+Additional nonalgebraic operators are required for examining the structure
+and contents of relations, returning the number of records or attributes in
+a relation, and determining whether a given relation exists.
+
+The \fIselect\fR operator is the primary user interface to DBIO.
+Since most of the relational power of DBIO is bound up in the \fIselect\fR
+operator and since \fIselect\fR will be driven by an algebraic expression
+(character string) there is considerable scope for future enhancement
+of DBIO without affecting existing code.
+
+.nh 2
+Record (Tuple) Level Operators
+
+    While the user should see primarily operations on entire relations,
+record level processing is necessary at the program level to permit
+data entry and implementation of special operators.  The basic record
+level operators are the following.
+
+.ls
+.ls retrieve
+Retrieve the next record from the relation defined by \fBselect\fR.
+While the tuples in a relation theoretically form an unordered set,
+tuples will normally be returned in either storage order or in the sort
+order of the primary key.  Although all fields of a retrieved record are
+accessible, an application will typically have knowledge of only a few fields.
+.le
+.ls update
+Rewrite the (possibly modified) current record.  The updated record is
+written back into the base table from which it was read.  Not all records
+produced by \fBselect\fR can be updated.
+.le
+.ls insert
+Insert a new record into an output relation.  The output relation may be an
+input relation as well.  Records added to an output relation which is also
+an input relation do not become candidates for selection until another
+\fBselect\fR occurs.  A retrieve followed by an insert copies a record without
+knowledge of its contents.  A retrieve followed by modification of selected
+fields followed by an insert copies all unmodified fields of the record.
+The attributes of the input and output relations need not match; unmatched
+output attributes take on their default values and unmatched input attributes
+are discarded.  \fBInsert\fR returns a pointer to the output record,
+allowing insertions of null records to be followed by initialization of
+the fields of the new record.
+.le
+.ls delete
+Delete the current record.
+.le
+.le
+
+
+Additional operators are required to close or open a relation for record
+level access and to count the number of records in a relation.
+
+.nh 3
+Constructing Special Relational Operators
+
+    The record level operations may be combined with \fBselect\fR in compiled
+programs to implement arbitrary operations upon entire relations.
+The basic scenario is as follows:
+
+.ls
+.ls [1]
+The set of records to be operated upon, defined by the \fBselect\fR
+operator, is opened as an unordered set (list) of records to be processed.
+.le
+.ls [2]
+The "next" record in the relation is accessed with \fBretrieve\fR.
+.le
+.ls [3]
+The application reads or modifies a subset of the fields of the record,
+updating modified records or inserting the record in the output relation.
+.le
+.ls [4]
+Steps [2] and [3] are repeated until the entire relation has been processed.
+.le
+.le
+
+
+Examples of such operators are conversion to and from DBIO and LIST file
+formats, column extraction, mimimum or maximum of an attribute (domain
+algebra), and all of the DBMS and IMAGES operators.
+
+.nh 2
+Field (Attribute) Level Operators
+
+    Substantial processing of the contents of a database is possible without
+ever accessing the individual fields of a record.  If field level access is
+required the record must first be retrieved or inserted.  Field level access
+requires knowledge of the names of the attributes of the parent relation,
+but not their exact datatypes.  Automatic type conversion occurs when field
+values are queried or set.
+
+.ls
+.ls get
+.sp
+Get the value of the named scalar or vector field (typed).
+.le
+.ls put
+.sp
+Put the value of the named scalar or vector field (typed).
+.le
+.ls read
+Read the named fields into an SPP data structure, given the name, datatype,
+and length (if vector) of each field in the output structure.
+There must be an attribute in the parent relation for each field in the
+output structure.
+.le
+.ls write
+Copy an SPP data structure into the named fields of a record, given the
+name, datatype, and length (if vector) of each field in the input structure.
+There must be an attribute in the parent relation for each field in the
+input structure.
+.le
+.ls access
+Determine whether a relation has the named attribute.
+.le
+.le
+
+.nh 2
+Storage Structures
+
+    The DBIO storage structures are the data structures used by DBIO to
+maintain relations in physical storage.  The primary design goals are
+simplicity and efficiency in time and space.  Most actual relations are
+expected to fall into three classes:
+
+.ls
+.ls [1]
+Relations containing only a single record, e.g., an image stored alone
+in a relation.
+.le
+.ls [2]
+Relations containing several dozen or several hundred records, e.g.,
+a collection of spectra from an observing run.
+.le
+.ls [3]
+Large relations containing 10**5 or 10**6 records, e.g., the output of an
+analysis program or an astronomical catalog.
+.le
+.le
+
+
+Updates and insertions are generally random access operations; retrieval
+based on the values of several attributes requires efficient sequential
+access.  Efficient random access for relations [2] and [3] requires use
+of an index.  Efficient sequential access requires that records be
+accessible in storage order without reference to the index, i.e., that
+records be chained in storage order.  Efficient field access where a
+record contains several dozen attributes requires something better than
+a linear search over the attribute list.
+
+The use of an index shall be limited initially to a single index for
+the primary key.  The primary key will be restricted to a single attribute,
+with the application defining the attribute to be used (in practice few
+attributes are usable as keys).
+The index will be a standard B+ tree, with one exception: the root block
+of the tree will be maintained in dedicated storage in the datafile.
+If and only if a relation grows so large that it overflows the root block
+will a separate index file be allocated for the index.  This will eliminate
+most of the overhead associated with the index for small relations.
+
+Efficient sequential access will be provided in either of two ways: via the
+index in index order or via the records themselves in storage order,
+depending on the operation being performed.  If an external index is used
+the leaves will be chained to permit efficient sequential access in index
+order.  If the relation also happens to be sorted in index order then this
+mode of access will be very efficient.  Link information will also be stored
+directly in the records to permit efficient sequential access when it is
+not necessary or possible to use the index.
+
+Assuming that there is at most one index associated with a relation,
+at most two files will be required to implement the relation.  The relation
+itself will have the file extension ".db".  The index file, if any, will
+have the extension ".dbi".  The root name of both files will be the name of
+the relation.
+
+The datafile header structure will probably have to be maintained in binary
+if we are to keep the overhead of datafile access to acceptable levels for
+small relations.  Careful design of the basic header structure should
+make most future refinements to the header possible without modification of
+existing databases.  The revision number of DBIO used to create the datafile
+will be saved in the header to make at least detection of obsolete headers
+possible.
+
+.nh 3
+Structure of a Binary Relation
+
+    Putting all this together we come up with the following structure for
+a binary relation:
+
+
+.ks
+.nf
+	BOF
+	relation header				-+
+		magic				 |
+		dbio revision number		 |
+		creation date			 |
+		relation name			 |
+		number of attributes		 |- fixed size header
+		primary key			 |
+		record size			 |
+		domain list			 |
+		attribute list			 |
+		miscellaneous			 |
+	string buffer				 |
+	root block of index			-+
+	record 1
+		physical record length (offset to next record)
+		logical record length (implies number of attributes set)
+		field storage
+		<gap>
+	record 2
+		...
+	record N
+	EOF
+.fi
+.ke
+
+
+Vector valued fields with a fixed upper size will be stored directly in the
+record, prefixed by the length of the actual vector (which may vary from
+record to record).
+Storage for variant fields will be allocated outside the record, placing only
+a pointer to the data vector and byte count in the record itself.
+Variant records are thus reduced to fixed size records,
+simplifying record access and making sequential access more efficient.
+
+Records will change size only when a new attribute is added to an existing
+relation, followed by assignment into a record written when there were
+fewer attributes.  If the new record will not fit into the physical slot
+already allocated, the record is written at EOF and the original record
+is deleted.  Deletion of a record is achieved by setting the logical record
+length to zero.  Storage is not reclaimed until a sort occurs, hence
+recovery of deleted records is possible.
+
+To minimize buffer space and memory to memory copies when accessing a
+relation it is desirable to work directly out of the FIO buffers.
+To make this possible records will not be permitted to straddle logical
+block boundaries.  A file block will typically contain several records
+followed by a gap.  The gap may be used to accommodate record expansion
+without moving a record to EOF.  The size of a file block is fixed when
+the relation is created.
+
+.nh 3
+The Attribute List
+
+    Efficient lookup of attribute names suggests maintenance of a hash table
+in the datafile header.  There will be a fixed upper limit on the number of
+attributes permitted in a single relation (but not on the number of records).
+Placing an upper limit on the number of attributes simplifies the software
+considerably and permits use of a fixed size header, making it possible to
+read or update the entire header in one disk access.  There will also be an
+upper limit on the number of domains, but the domain list is not searched
+very often hence a linear search will do.
+
+All information about the decomposition of a record into fields, other than
+the logical length of vector valued fields, is given by the attribute list.
+Records contain only data with no embedded structural information other than
+the length of the vector fields.  New attributes are added to a relation by
+appending to the attribute list.  Existing records are not affected.
+By comparing the logical length of a record to the offset for a particular
+field we can tell whether storage has been allocated for that field in the
+record.
+
+Domains are used to limit the range of values a field can take on in an
+assignment, and to flag attribute comparisons which are likely to be erroneous
+(e.g. order comparison of a pixel coordinate and a wavelength).  The domains
+"bool", "char", "short", etc. are predefined.  The following information
+must be stored for each user defined domain:
+
+
+.ks
+.nf
+	name			may be same as attribute name
+	datatype		bool, char, short, etc.
+	physical vector length	0=variant, 1=scalar, N=vector
+	default			default value, INDEF if not given
+	minimum			mimimum value (ints and reals)
+	maximum			maximum value (ints and reals)
+	enumval			enumerated values (strings)
+.fi
+.ke
+
+
+The following information is required to describe each attribute.
+The attribute list is maintained separately from the hash table of attribute
+names and can be used to regenerate the hash table of attribute names if
+necessary.
+
+
+.ks
+.nf
+	name			no embedded whitespace
+	domain			index into domain table
+	offset			offset in record
+.fi
+.ke
+
+
+All strings will be stored in a fixed size string buffer in the header
+area; it is the index of the string which is stored in the domain and
+attribute lists.  This eliminates the need to place an upper limit on the
+size of domain names and enumerated value lists and makes it possible
+for a single attribute name string to be referenced in both the attribute
+list and the attribute hash table.
+
+.nh
+Specifications
diff --git a/sys/dbio/doc/dbio.hlp b/sys/dbio/doc/dbio.hlp
new file mode 100644
index 00000000..4f163415
--- /dev/null
+++ b/sys/dbio/doc/dbio.hlp
@@ -0,0 +1,413 @@
+.help dbio Oct83 "Database I/O Specifications"
+.ce
+Specifications of the IRAF DBIO Interface
+.ce
+Doug Tody
+.ce
+October 1983
+.ce
+(revised November 1983)
+
+.sh
+1. Introduction
+
+    The IRAF database i/o interface (DBIO) shall provide a limited but
+highly extensible and efficient database capability for IRAF.  DBIO datafiles
+will be used in IRAF to implement image headers and to store the output
+from analysis programs.  The simple structure of a DBIO datafile, and the
+self describing nature of the datafile, should make it easy to address the
+problems of developing a query language, providing a CL interface, and
+transporting datafiles between machines.
+
+.sh
+2. Database Structure: the Data Dictionary
+
+    An IRAF datafile, database file, or "data dictionary" is a set of
+records, each of which must have a unique name within the dictionary,
+but which may be defined in any time order and stored in the datafile
+in any sequential order.  Each record in the data dictionary has the
+following external attributes:
+
+.ls 4
+.ls 12 name
+The name of the record: an SPP style identifier, not to exceed 28
+characters in length.  The name must be unique within the dictionary.
+.le
+.ls aliases
+A record may be known by several names, i.e., several distinct dictionary
+entries may actually point to the same physical record.  The concept is
+similar to the "link" attribute of the UNIX file system.  The number
+of aliases or links is immediately available, but determination of the
+actual names of all the aliases requires a search of the entire dictionary.
+.le
+.ls datatype
+One of the eight primitive datatypes ("bcsilrdx"), or a user defined,
+fixed format structure, made up of primitive-type fields.  In the case
+of a structure, the structure is defined by a C-style structure declaration
+given as a char type record elsewhere in the dictionary.  The "datatype"
+field of a record is one of the strings "b", "c", "s", etc. for the
+primitive types, or the name of the record defining the structure.
+.le
+.ls value
+The value of the dictionary entry is stored in the datafile in binary form
+and is allocated a fixed amount of storage per record element.
+.le
+.ls length
+Each record in the dictionary is potentially an array.  The length field
+gives the number of elements of type "datatype" forming the record.
+New elements may be added by writing to "record_name[*]".
+.le
+.le
+
+
+The values of these attributes are available via ordinary DBIO read
+requests (but writing is not allowed).  Each record in the dictionary
+automatically has the following (user accessible) fields associated with it:
+
+
+.ks
+.nf
+	r_type		char[28]	("b", "c",.. or record name)
+	r_nlinks	long		(initially 1)
+	r_len		long		(initially 1)
+	r_ctime		long		time of record creation 
+	r_mtime		long		time of last modify
+.fi
+.ke
+
+
+Thus, to determine the number of elements in a record, one would make the
+following function call:
+
+	nelements = dbgeti (db, "record_name.r_len")
+
+
+.sh
+2.1 Records and Fields
+
+    The most complicated reference to an entry in the data dictionary occurs
+when a record is structured and both the record and field of the record are
+arrays.  In such a case, a reference will have the form:
+
+.nf
+	"record[i].field[j]"		most complex db reference
+.fi
+
+Such a reference defines a unique physical offset in the datafile.
+Any DBIO i/o transfer which does not involve an illegal type conversion
+may take place at that offset.  Normally, however, if the field is an array,
+the entire array will be transferred in a single read or write request.
+In that case the datafile offset would be specified as follows:
+
+	"record[i].field"
+
+.sh
+3. Basic I/O Procedures
+
+    The basic i/o procedures are patterned after FIO and CLIO, with the
+addition of a string type field ("reference") defining the offset in the
+datafile at which the transfer is to take place.  Sample reference fields
+are given in the previous section.  In most cases, the reference field
+is merely the name of the record or field to be accessed, i.e., "im.ndim",
+"im.pixtype", and so on.  The "dbset" and "dbstat" procedures are used
+to set or inspect DBIO parameters affecting the operation of DBIO itself,
+and do not perform i/o on a datafile.
+
+
+.ks
+.nf
+		    db = dbopen (file_name, access_mode)
+			dbclose (db)
+
+		     dbset[ils] (db, parameter, value)
+	      val = dbstat[ils] (db, parameter)
+
+	  val = dbget[bcsilrdx] (db, reference)
+		dbput[bcsilrdx] (db, reference, value)
+
+			 dbgstr (db, reference, outstr, maxch)
+			 dbpstr (db, reference, string)
+
+       nelems = dbread[csilrdx] (db, reference, buf, maxelems)
+	       dbwrite[csilrdx] (db, reference, buf, nelems)
+.fi
+.ke
+
+
+A new, empty database is created by opening with access mode NEW_FILE.
+The get and put calls are functionally equivalent to those used by
+the CL interface, down to the "." syntax used to reference fields.
+The read and write calls are complicated by the need to be ignorant
+about the actual datatype of a record.  Hence we have added a type
+suffix, with the implication that automatic type conversion will take
+place if reasonable.  This also eliminates the need to convert to and
+from chars in the fourth argument, and avoids the need for a 7**2 type
+conversion matrix.
+
+
+.sh
+4. Other DBIO Procedures
+
+    A number of special purpose routines are provided for adding and
+deleting dictionary entries, making links to create aliases, searching
+a dictionary of unknown content, and so on.  The calls are summarized
+below:
+
+
+.ks
+.nf
+	      stat = dbnextname (db, previous, outstr, maxch)
+	         y/n = dbaccess (db, record_name, datatypes)
+
+		        dbenter (db, record_name, type, nreserve)
+			 dblink (db, alias, existing_record)
+		       dbunlink (db, record_name)
+.fi
+.ke
+		
+
+The semantics of these routines are explained in more detail below:
+
+.ls 4
+.ls 12 dbnextname
+Returns the name of the next dictionary entry.  If the value of the "previous"
+argument is the null string, the name of the first dictionary entry is returned.
+EOF is returned when the dictionary has been exhausted.
+.le
+.ls dbaccess
+Returns YES if the named record exists and has one of the indicated datatypes.
+The datatype string may consist of any of the following: (1) one or more
+primitive type characters specifying the acceptable types, (2) the name of
+a structure definition record, or (3) the null string, in which case only
+the existence of the record is tested.
+.le
+.ls dbenter
+Used to make a new entry in the dictionary.  The "type" field is the name
+of one of the primitive datatypes ("b", "c", etc.), or in the case of a
+structure, the name of the record defining the structure.  The "nreserve"
+field specifies the number of elements of storage to be initially allocated
+(more elements can always be added later).  If nreserve is zero, no storage
+is allocated, and a read error will result if an attempt is made to read
+the record before it has been written.  Storage allocated by dbenter is
+initialized to zero.
+.le
+.ls dblink
+Enter an alias for an existing entry.
+.le
+.ls dbunlink
+Remove an alias from the dictionary.  When the last link is gone,
+the record is physically deleted and storage may be reclaimed.
+.le
+.le
+
+
+.sh
+5. Database Access from the CL
+
+    The self describing nature of a datafile, as well as its relatively
+simple structure, will make development of CL callable database query
+utilities easy.  It shall be possible to access the contents of a datafile
+from a CL script almost as easily as one currently accesses the contents
+of a parameter file.  The main difference is that a separate process must be
+spawned to access the database, but this process may contain any number of
+database access primitives, and will sit in the CL process cache if frequently
+used.  The "onexit" call and F_KEEP FIO option in the program interface allow
+the query task to keep one or more database files open for quick access,
+until the CL disconnects the process.
+
+The ability to access the contents of a database from a CL script is crucial
+if we are to be able to have data independent applications package modules.
+The intention is that CL callable applications modules will not be written
+for any particular instrument, but will be quite general.  At the top level,
+however, we would like to have a "canned" program which knows a lot about
+an instrument, and which calls the more general package routines, passing
+instrument specific parameters.
+
+This top level routine should be a CL script to provide maximum
+flexibility to the scientist using the system at the CL level.  Use of a
+script is also required if modules from different packages are to be called
+from a single high level module (anything else would imply poorly
+structured code).
+This requires that we be able to store arbitrary information in
+image headers, and that this information be available in CL scripts.
+DBIO will provide such a capability.
+
+
+    In addition to access from CL scripts, we will need interactive access
+to datafiles at the CL level.  The DBIO interface makes it easy to
+provide such an interface.  The following functions should be provided:
+.ls 4
+.ls o
+List the contents of a datafile, much as one would list the contents of
+a directory.  Thus, there should be a short mode (record name only), and
+a long mode (including type, length, nlinks, date of last modify, etc.).
+A one name per line mode would be useful for creating lists.  Pattern
+matching would be useful for selecting subsets.
+.le
+.ls o
+List the contents of a record or list of records.  List the elements of
+an array, possibly for further processing by the LISTS package.  In the
+case of a record which is an array of structures, print the values of
+selected fields as a table for further processing by the LISTS utilities.
+And so on.
+.le
+.ls o
+Edit a record.
+.le
+.ls o
+Delete a record.
+.le
+.ls o
+Copy a record or set of records, possibly between two different datafiles.
+.le
+.ls o
+Copy an array element or range of array elements, possibly between two
+different records or two different records in different datafiles.
+.le
+.ls o
+Compress a datafile.  DBIO probably will not reclaim storage online.
+A separate compress operation will be required to reclaim storage in
+heavily edited datafiles, and to consolidate fragmented arrays.
+.le
+.ls o
+And more I'm sure.
+.le
+.le
+
+.sh
+6. DBIO and Imagefiles
+
+    As noted earlier, DBIO will be used to implement the IRAF image header
+structure.  An IRAF imagefile is composed of two parts: the image header
+structure, and the pixel storage file.  Only the name of the pixel storage
+file for an image will be kept in the image header; the pixel storage file
+is always a separate file, which indeed usually resides on a different
+filesystem.  The pixel storage file is often far larger than the image
+header, though the reverse may be true in the case of small one dimensional
+spectra or other small images.  The DBIO format image header file is
+usually not very large and will normally reside in the user's directory
+system.  The pixel storage file is created and managed by IMIO transparently
+to the user and to DBIO.
+
+
+.ks
+.nf
+                      applications program
+
+
+
+                                   IMIO
+
+
+
+			 DBIO
+
+
+
+				    FIO
+
+
+            Structure of a program which accesses images
+.fi
+.ke
+
+
+It shall be possible for an single datafile to contain any number of
+image header structures.  The standard image header shall be implemented
+as a regular DBIO structured record, defined in a structure declaration
+file in the system library directory "lib$".
+
+.sh
+7. Transportability
+
+    The datafile is a essential part of the IRAF, and it is essential that
+we be able to transport datafiles between machines.  The self describing
+nature of datafiles makes this straightforward, provided programmers do
+not store structures in the database in binary.  Binary arrays, however,
+are fine, since they are completely defined.
+
+A datafile must be transformed into a machine independent form for transport
+between machines.  The independence of the records in a datafile, and the simple
+structure of a record, should make transmission of a datafile in tabular
+form (ASCII card image) straightforward.  We shall use the tables extension
+to FITS to transport DBIO datafiles.  A simple unstructured record can
+be represented in the form 'keyword = value' (with some loss of information),
+while a structured record can be represented as a FITS table, given the
+restriction of the fields of a record to the primitive types.
+
+.sh
+8. Implementation Strategies
+
+    Each data dictionary shall consist of a single random access file, the
+"datafile".  The dictionary shall be indexed by a B-tree containing the
+28 character packed name of each record and a 4 byte integer giving the offset
+of either the next block in the B-tree, or of the "inode" structure describing
+the record, for a total of 32 bytes per index entry.  If a record has several
+aliases, each will have a separate entry in the index and all will point to
+the same inode structure.  The size of a B-tree block shall be variable (but
+fixed for a given datafile), and in the case of a typical image header, shall
+be chosen large enough so that the index for the entire image header can be
+contained in a single B-tree block.  The entries within an index block shall
+be maintained in sorted order and entries shall be located by a binary search.
+
+Each physical record or array of records in the datafile shall be described
+by a unique binary inode structure.  The inode structure shall define the
+number of links to the record, the datatype, size, and length of the record, 
+the dates of creation and last modify, the offset of the record in the
+datafile (or the offset of the index block in the case of an array of records),
+and so on.  The inode structures shall be stored in the datafile as a
+contiguous array of records; the inode array may be stored at any offset in
+the datafile.  Overflow of the inode array will be handled by moving the
+array to the end of the file and doubling its size.
+
+New records shall be added to the datafile by appending to the end of the file.
+No attempt shall be made to align records on block boundaries within the
+datafile.  When a record is deleted space will not be reclaimed, i.e.,
+deletion will leave an invisible 'hole' in the datafile (a utility will be
+available for compacting fragmented datafiles).  Array structured records
+shall in general be stored noncontiguously in the datafile, though
+DBIO will try to avoid excessive fragmentation.  The locations of the sections
+of a large array of records shall be described by a separately allocated index
+block.
+
+DBIO will probably make use of the IRAF file i/o (FIO) buffer cache feature to
+access the datafile.  FIO permits both the number and size of the buffers
+used to access a file to be set by the caller at file open time.
+Furthermore, the FIO "reopen" call can be used to establish independent
+buffer caches for the index and inode blocks and for the data records,
+so that heavy data array accesses do not flush out the index blocks, even
+though both are stored in the same file.  Given the sophisticated buffering
+capabilities of FIO, DBIO need only make FIO seek and read/write calls to access
+both inode and record data, explicitly buffering only the B-tree index block
+currently being searched.
+
+On a virtual machine a single FIO buffer the size of the entire datafile can
+be allocated and mapped onto the file, to take advantage of virtual memory
+without compromising transportability.  DBIO would still use FIO seek, read,
+and write calls to access the file, but no FIO buffer faults would occur
+unless the file were extended.  The current FIO interface does not provide
+this feature but it can easily be added in the future without modification
+to the FIO interface, if it is proved that there is anything to be gained.
+
+By carefully configuring the buffer cache for a file, it should be possible
+to keep the B-tree index block and inode array for a moderate size datafile
+buffered most of the time, limiting the number of disk accesses required to
+access a small record to much less than one on the average, without limiting
+the ability of DBIO to access very large dictionaries.  For example, given
+a dictionary of one million entries and a B-tree block size of 128 entries
+(4 KB), only 4 disk accesses would be required to access a primitive record
+in the worst case (no buffer hits).  Very small datafiles, i.e. most image
+headers, would be completely buffered all of the time.
+
+The B-tree index scheme, while very efficient for random record access,
+is also well suited to sequential accesses ("dbnextname()" calls).  A
+straightforward dictionary copy operation using dbnextname, which steps
+through the records of a dictionary in alphabetical order, would
+automatically transpose the dictionary into the most efficient form for
+future alphabetical or clustered accesses, reclaiming storage and
+consolidating fragmented arrays in the process.
+
+The DBIO package, like FIO and IMIO, will dynamically allocate all buffer
+space needed to access a datafile at runtime.  The number of datafiles
+which can be simultaneously accessed by a single program is limited primarily
+by the maximum number of open files permitted a process by the OS.
diff --git a/sys/dbio/new/coords b/sys/dbio/new/coords
new file mode 100644
index 00000000..803ef3c7
--- /dev/null
+++ b/sys/dbio/new/coords
@@ -0,0 +1,73 @@
+.nh 4
+World Coordinates
+
+    In general, an image may simultaneously have any number of world coordinate
+systems associated with it.  It would be quite awkward to try to store an
+arbitrary number of WCS descriptors in the image header, so a separate WCS
+relation is used instead.  If world coordinates are not used no overhead is
+incurred.
+
+Maintenance of the WCS descriptor, transformations of the WCS itself (e.g.,
+when an image changes spatially), and coordinate transformations using the WCS
+are all managed by the WCS package.  This will be a general purpose package
+usable not only in IMIO but also in GIO and other places.  IMIO will be
+responsible for copying the WCS records for an image when a new image is
+created, as well as for correcting the WCS for the effects of subsampling,
+etc. when a section of an image is mapped.
+
+The WCS package will include support for both linear and nonlinear coordinate
+systems.  Each WCS is described by a mapping from pixel space to WCS space
+consisting of a general nonlinear transformation followed by a linear
+transformation.  Either or both of the transformations may be unitary if
+desired, e.g., the simple linear transformation is supported as a special case.
+.ls 4
+.ls 12 image
+The name (value of the \fIimage\fR key in the image header) of the image
+for which the WCS is defined.
+.le
+.ls nlnterm
+A flag specifying whether the WCS includes a nonlinear term.
+.le
+.ls invterm
+A flag specifying whether the WCS includes an inverse nonlinear term.
+If a forward nonlinear transformation is defined but no inverse transformation
+is given, coordinate transformations from WCS space to pixel space may be
+inefficient or impossible.
+.le
+.ls linterm
+A flag specifying whether the WCS includes a linear term.
+.le
+.ls fwdtran
+The interpreter program for the forward nonlinear transformation.
+.le
+.ls invtran
+The interpreter program for the inverse nonlinear transformation.
+.le
+.ls lintran
+A floating point array describing the linear transformation.
+.le
+.le
+
+
+Nonlinear transformations are described by small user supplied \fIprograms\fR
+written in a simple RPN language entered as a variable length character string.
+The RPN language will include builtin intrinsic functions for all the standard
+trigonometric and hyperbolic functions, plus builtin functions for the common
+nonlinear transformations as well.  The advantage of this scheme is that the
+standard transformations are supported very efficiently without sacrificing
+generality.  Even nonstandard nonlinear functions can be computed quite
+efficiently since the runtime overhead of an RPN interpreter can be made quite
+small compared to the time required to evaluate the trigonometric and other
+functions typically used in a nonlinear function.
+
+Implementation of the WCS as a nonlinear function plus a linear function
+makes it trivial for IMIO to automatically update the WCS when a linear
+transformation is applied to the image (the nonlinear term of the WCS will
+not be affected by a linear transformation of the image).
+Implementation of the nonlinear term as a program encoded as a character
+string permits modification of the nonlinear term by \fIconcatentation\fR
+of another nonlinear function, also represented as a character string.
+In other words, the final mapping is given by successive application of
+a series of nonlinear transformations, followed by the linear transformation.
+Hence the WCS may be updated to reflect a subsequent linear or nonlinear
+transformation of the image, regardless of the nature of the original WCS.
diff --git a/sys/dbio/new/dbio.con b/sys/dbio/new/dbio.con
new file mode 100644
index 00000000..9adc7d6c
--- /dev/null
+++ b/sys/dbio/new/dbio.con
@@ -0,0 +1,202 @@
+			   IRAF Database I/O Design
+			           Contents
+
+
+
+1. PREFACE
+
+   1.1  Scope of this Document
+   1.2  Relationship to Previous Documents
+
+
+2. INTRODUCTION
+
+   2.1  The Database Subsystem
+   2.2  Major Subsystems
+   2.3  Related Subsystems
+
+
+3. REQUIREMENTS
+
+   3.1	General Requirements
+        3.1.1  Portability
+        3.1.2  Efficiency
+        3.1.3  Code Size
+        3.1.4  Use of Proprietary Software
+
+   3.2  Special Requirements
+	3.2.1  Catalog Storage
+	3.2.2  Image Storage
+	3.2.3  Intermodule Communication
+	3.2.4  Data Archiving
+
+   3.3	Other Requirements
+	3.3.1  Concurrency
+	3.3.2  Recovery
+	3.3.3  Data Independence
+	3.3.4  Host Database Interface
+
+
+4. CONCEPTUAL DESIGN
+
+   4.1  Terminology
+   4.2  System Architecture
+
+   4.3  The DBMS Package
+   	4.3.1  Overview
+	4.3.2  Procedural Interface
+	       4.3.2.1  General Operators
+	       4.3.2.2  Form Based Data Entry and Retrieval
+	       4.3.2.3  List Interface
+	       4.3.2.4  FITS Table Interface
+	       4.3.2.5  Graphics Interface
+	4.3.3  Command Language Interface
+	4.3.4  Record Selection Syntax
+	4.3.5  Query Language
+	       4.3.5.1  Query Language Functions
+	       4.3.5.2  Language Syntax
+	       4.3.5.3  Sample Queries
+	4.3.6  DB Kernel Operators
+	       4.3.6.1  Dataset Copy and Load
+	       4.3.6.2  Rebuild Dataset
+	       4.3.6.3  Mount Foreign Dataset
+	       4.3.6.4  Crash Recovery
+
+   4.4  The IMIO Interface
+   	4.4.1  Overview
+   	4.4.2  Logical Schema
+   	       4.4.2.1	Standard Fields
+   	       4.4.2.2	History Text
+	       4.4.2.3  World Coordinates
+   	       4.4.2.4  Histogram
+   	       4.4.2.5  Bad Pixel List
+   	       4.4.2.6  Region Mask
+	4.4.3  Group Data
+	4.4.4  Image I/O
+	       4.4.4.1  Image Templates
+	       4.4.4.2  Image Pixel Access
+	       4.4.4.3  Image Database Interface (IDBI)
+	4.4.5  Summary of IMIO Data Structures
+
+   4.5  The DBIO Interface
+	4.5.1  Overview
+	4.5.2  Comparison of DBIO and Commercial Databases
+	4.5.3  Query Language Interface
+	4.5.4  Logical Schema
+	       4.5.4.1  Databases
+	       4.5.4.2  System Tables
+	       4.5.4.3  The System Catalog
+	       4.5.4.4  Relations
+	       4.5.4.5  Attributes
+	       4.5.4.6  Domains
+	       4.5.4.7  Groups
+	       4.5.4.8  Views
+	       4.5.4.9  Null Values
+        4.5.5  Data Definition Language
+	4.5.6  Record Select/Project Expressions
+	       4.5.6.1  Introduction
+	       4.5.6.2  Basic Syntax
+	       4.5.6.3  Examples
+	       4.5.6.4  Evaluation
+	4.5.7  Operators
+	       4.5.7.1  General Operators
+	       4.5.7.2  Record Level Access
+	       4.5.7.3  Field Level Access
+	       4.5.7.4  Variable Length Fields
+	       4.5.7.5  IMIO Support
+	4.5.8  Constructing Special Relational Operators
+	4.5.9  Storage Structures
+
+   4.6  The DBKI Interface (DB Kernel Interface)
+	4.6.1  Overview
+	       4.6.1.1  Default Kernel
+	       4.6.1.2  Host Database Interface
+	       4.6.1.3  Network Support
+	4.6.2  Logical Schema
+	       4.6.2.1  System Tables
+	       4.6.2.2  User Tables
+	       4.6.2.3  Indexes
+	       4.6.2.4  Record Structure
+	4.6.2  Database Management Operators
+	       4.6.2.1  Database Creation and Deletion
+	       4.6.2.2  Database Access
+	       4.6.2.3  Table Creation and Deletion
+	       4.6.2.4  Index Creation and Deletion
+	4.6.3  Record Access Methods
+	       4.6.3.1  Direct Access via an Index
+	       4.6.3.2  Direct Access via the Record ID
+	       4.6.3.3  Sequential Access
+	4.6.4  Record Access Operators
+	       4.6.4.1  Fetch
+	       4.6.4.2  Update
+	       4.6.4.3  Insert
+	       4.6.4.4  Delete
+	       4.6.4.5  Variable Length Fields
+
+   4.7  The DBK (IRAF DB Kernel)
+	4.7.1  Overview
+	4.7.2  Storage Structures
+	       4.7.2.1  Database
+	       4.7.2.2  System Catalog
+	       4.7.2.3  Table Storage
+	4.7.3  The Control Interval
+	       4.7.3.1  Introduction
+	       4.7.3.2  Shared Intervals
+	       4.7.3.3  Private Intervals
+	       4.7.3.4  Record Insertion and Update
+	       4.7.3.5  Record Deletion
+	       4.7.3.6  Adding New Fields
+	       4.7.3.7  Array Storage
+	       4.7.3.8  Rebuilding a Dataset
+	4.7.4  Indexes
+	       4.7.4.1  Nonindexed Tables
+	       4.7.4.2  Primary Index
+	       4.7.4.3  Secondary Indexes
+	       4.7.4.4  Key Compression
+	4.7.5  Host Database Interface (HDBI)
+	4.7.6  Concurrency
+	4.7.7  Backup and Transport
+	4.7.8  Accounting Services
+	4.7.9  Crash Recovery
+
+
+5. SPECIFICATIONS
+
+   5.1  DBMS Package
+	5.1.1  Overview
+	5.1.2  Module Specifications
+
+   5.2  IMIO Interface
+	5.2.1  Overview
+	5.2.2  Examples
+	5.2.3  Module Specifications
+	       5.2.3.1  Image Header Access
+	       5.2.3.2  History Text
+	       5.2.3.3  World Coordinates
+	       5.2.3.4  Bad Pixel List
+	       5.2.3.5  Region Mask
+	       5.2.3.6  Pixel Access
+	5.2.4  Storage Structures
+	       5.2.4.1  IRAF Runtime Format
+	       5.2.4.2  Archival Format
+	       5.2.4.3  Other Formats
+
+   5.3  DBIO (DataBase I/O interface)
+	5.3.1  Overview
+	5.3.2  Examples
+	5.3.3  Module Specifications
+
+   5.4  DBKI (DB Kernel Interface)
+	5.4.1  Overview
+	5.4.3  Module Specifications
+
+   5.5. DBK (IRAF DB Kernel)
+	5.5.1  Overview
+	5.5.2  Storage Structures
+	5.5.3  Error Recovery
+	5.5.4  Concurrency
+
+6. SUMMARY
+
+Glossary
+Index
diff --git a/sys/dbio/new/dbio.hlp b/sys/dbio/new/dbio.hlp
new file mode 100644
index 00000000..d5d9c77f
--- /dev/null
+++ b/sys/dbio/new/dbio.hlp
@@ -0,0 +1,3202 @@
+.help dbss Sep85 "Design of the IRAF Database Subsystem"
+.ce
+\fBDesign of the IRAF Database Subsystem\fR
+.ce
+Doug Tody
+.ce
+September 1985
+.sp 2
+
+.nh
+Preface
+
+    The primary purpose of this document is to define the interfaces comprising
+the IRAF database i/o subsystem to the point where they can be built rapidly
+and efficiently, with confidence that major changes will not be required after
+implementation begins.  The document also serves to inform all interested
+parties of what is planned while there is still time to change the design.
+A change which can easily be made to the design prior to implementation may
+become prohibitively expensive as implementation proceeds.  After implementation
+is completed and the new subsystem has been in use for several months the basic
+interfaces will be frozen and the opportunity for change will have passed.
+
+The description of the database subsystem presented in this document should
+be considered to be no more than a close approximation to the system which
+will actually be built.  The specifications of the interface can be expected
+to change in detail as the implementation proceeds.  Any code which is written
+according to the interface specifications presented in this document may have
+to modified slightly before system testing with the final interfaces can
+proceed.
+
+.nh 2
+Scope of this Document
+
+    The scope of this document is the conceptual design and specification of
+all IRAF packages and i/o interfaces directly involved with either user or
+program access to binary data maintained in mass storage.  Versions of some
+of the interfaces described are already in use; when this is the case it will
+be noted in the text.
+
+This document is neither a user's guide nor a reference manual.  The reader
+is assumed to be familiar with both database technology and with the IRAF
+system.  In particular, the reader should be familiar with the concept of the
+IRAF VOS (virtual operating system), with the features of the IMIO (image i/o),
+FIO (file i/o), and OS (host system interface) interfaces, as well as with the
+architecture of the network interface.
+
+.nh 2
+Relationship to Previous Documents
+
+    This document supercedes the document "IRAF Database I/O", November 1984.
+Most of the concepts presented in that document are still valid but have been
+expanded upon greatly in the present document.  The scope of the original
+document was limited to the DBIO interface alone, whereas the scope of the
+present document has been expanded to encompass all subsystems or packages
+directly involved with binary data access.  This expansion in the scope of
+the project was necessary to meet our primary goal of completing and freezing
+the program interface, of which DBIO is only a small part.  Furthermore, it
+is difficult to have confidence in the design of a single subsystem without
+working out the details of all closely related or dependent subsystems.
+
+In addition to expanding the scope of the database design project to cover
+more interfaces, the requirements which the database subsystem must meet have
+been expanded since the original conceptual design was done.  In particular
+it has become clear that data format conversions are prohibitively expensive
+for our increasingly large datasets.  Conversions such as those between FITS
+and internal format (for an image), or between FITS table and internal format
+(for a database) are too expensive to be performed routinely.  Data which is
+archived in a machine independent format should not have to be reformatted
+to be accessed by the online system.  The archival format may vary from site
+to site and it should be possible to read the different formats without
+reformatting the data.  Large datasets should not have to be reformatted to
+be moved between machines with incompatible binary data formats.
+
+A change such as this in the requirements for an interface can have a major
+impact on the design of the final interface.  It is essential that all such
+requirements be identified and dealt with in the design before implementation
+begins.
+
+.nh
+Introduction
+
+    In this section we introduce the database subsystem and summarize the
+reasons why we need such a system.  We then introduce the major components
+of the database subsystem and briefly mention some related subsystems.
+
+.nh 2
+The Database Subsystem
+
+    The database subsystem (DBSS) is conceived as a single comprehensive system
+to be used to manage and access all binary (non textfile) data accessed by IRAF
+programs.  Simple applications are perhaps most easily and flexibly dealt with
+using text files for the storage of data, descriptors, and control information.
+As the amount of data to be processed grows or as the data structures to be
+accessed grow in complexity, however, the text file approach becomes seriously
+inefficient and cumbersome.  Converting the text files to binary files makes
+processing more efficient but does little to address the problems of complex
+data structures.  Efficient access to complex data structures requires complex
+and expensive software.  Developing such software specially for each and every
+application is prohibitively expensive in a large system; hence the need for
+a general purpose database system becomes clear.
+
+Use of a single central database system has significant additional advantages.
+A standard user interface can be used to examine, edit, list, copy, etc., all
+data maintained under the database system.  Many technical problems may be
+addressed in a general purpose system that would be too expensive to address
+in a particular application, e.g., the problems of storing variable size data
+elements, of dynamically and randomly updating a dataset, of byte packing to
+conserve storage, of maintaining indexes so that a record may be found
+efficiently in a large dataset, of providing data independence so that storage
+formats may be changed without need to change the program accessing the data,
+and of transport of binary datasets between incompatible machines.  All of
+these are examples of problems which are \fInot\fR adequately addressed by the
+current IRAF i/o interfaces nor by the applications programs which use them.
+
+.nh 2
+Major Subsystems
+
+    The major subsystems comprising the IRAF DBSS are depicted in Figure 1.
+At the highest level are the CL (command language) packages, each of which
+consists of a set of user callable tasks.  The IMAGES package (consisting
+of general image processing operators) is shown for completeness but since
+there are many such packages in the system they are not considered part of
+the DBSS and will not be discussed further here.
+The DBMS (database management) package is the user interface to the DBSS,
+and some day will possibly be the largest part of the DBSS in terms of number
+of lines of code.
+
+In the center of the figure we see the VOS (virtual operating system) packages
+IMIO, DBIO and FIO.  FIO (file i/o) is the standard IRAF file interface and
+will not be discussed further here.  IMIO (image i/o) and DBIO (database i/o)
+are the two major i/o interfaces in the DBSS and are the topic of much of the
+rest of this document.  IMIO and DBIO are the two parts of the DBSS of interest
+to applications programmers; these interfaces are implemented as libraries of
+subroutines to be called directly by the applications program.  IMIO and FIO
+are existing interfaces.
+
+At the bottom of the figure is the DB Kernel.  The DB Kernel is the component
+of the DBSS which physically accesses the data in mass storage (via FIO).
+The DB Kernel is called only by DBIO and hence is invisible to both the user
+and the applications programmer.  There is a lot more to the DB Kernel than
+is evident from the figure, and indeed the DB Kernel will be the subject of
+another figure when we discuss the system architecture in section 4.2.
+
+
+.ks
+.nf
+                 DBMS          IMAGES(etc)            (CL)
+                   \             /
+                    \           /                   ---------
+                     \         /
+                      \     IMIO                     
+                       \    /  \       
+                        \  /    \                                  
+                         \/      \                    (VOS)
+                        DBIO     FIO
+                         | 
+                         |
+                         |                          ---------
+                         |
+                         |
+                    (DB Kernel)                (VOS or Host System)
+
+.fi
+.ce
+Figure 1.  Major Components of the Database Subsystem
+.ke
+
+
+With the exception of certain optional subsystems to be outlined later,
+the entire DBSS is machine independent and portable.  The IRAF system may
+be ported to a new machine without any knowledge whatsoever of the
+architecture or functioning of the DBSS.
+
+.nh 2
+Related Subsystems
+
+    Several additional IRAF subsystems or packages are of interest from the
+standpoint of the DBSS.  These are the PLOT package, the graphics interface
+GIO, and the LISTS package.
+
+The PLOT package is a CL level package consisting of general plotting
+utilities.  In general PLOT tasks can accept input in a number of standard
+formats, e.g., \fBlist\fR (text file) format and \fBimagefile\fR format.
+The DBSS will provide an additional standard format which should perhaps be
+directly accessible by the PLOT tasks.  Even if this is not done a very
+general plotting capability will automatically be provided by "piping" the
+list format output of a DBMS task to a PLOT task.  Additional graphics
+capabilities will be provided as built in functions in the DBMS
+\fBquery language\fR, which will access GIO directly to make plots.
+The query language graphics facilities will be faster and more convenient
+to use but less extensive and less sophisticated than those provided by PLOT.
+
+The LISTS package is interesting because the facilities provided and operations
+performed resemble those provided by the DBMS package in many respects.
+The principle difference between the two packages is that the LISTS package
+operates on arbitrary text files whereas the DBMS package operates only
+upon DBIO format binary files.  The textual output of \fIany\fR IRAF or
+non-IRAF program may serve as input to a LISTS operator, as may any ordinary
+text file, e.g., the source files for a program or package.  A typical LISTS
+database is a directory full of source files or documentation; LISTS can also
+operate on tables of numbers but the former application is perhaps more
+common.  Using LISTS it is possible to conveniently and rapidly perform
+operations (evaluate queries) which would be cumbersome or impossible to
+perform with a conventional database system such as DBMS.  On the other hand,
+the LISTS operators would be hopelessly inefficient for the types of
+applications for which DBMS is designed.
+
+.nh
+Requirements
+
+    Requirements define the problem to be solved by a software system.
+There are two types of requirements, non-functional requirements, i.e.,
+restrictions or constraints, and functional requirements, i.e., the functions
+which the system must perform.  Since nearly all IRAF science software will
+be heavily dependent on the DBSS, the requirements for this subsystem are as
+strict as those for any subsystem in IRAF.
+
+.nh 2
+General Requirements
+
+    The general requirements which the DBSS must satisfy primarily take the
+form of constraints or restrictions.  These requirements are common to
+all mainline IRAF system software.  Note that these requirements are \fInot\fR
+automatically enforced for all system software.  If a particular subsystem is
+prototype or optional (not required for the normal functioning of IRAF) then
+these requirements can be relaxed.  In particular, certain parts of the DBSS
+(e.g, the host database interface) are optional and are not subject
+to the same constraints as the mainline software.  The primary functional
+requirements discussed in section 3.2, however, must be met by software which
+satisfies all of the general requirements discussed here.
+
+.nh 3
+Portability
+
+    All software in the DBMS, IMIO, and DBIO interfaces and in the DB kernel
+must be fully portable under IRAF.  To meet this requirement the software
+must be written in the IRAF SPP language using only the facilities provided
+by the IRAF VOS.  In particular, this rules out complicated record locking
+schemes in the DB kernel, as well as any type of centralized database server
+which relies on process control, IPC, or signal handling facilities not
+provided by the IRAF VOS.  For most processes the requirement is even more
+strict, i.e., ordinary IRAF processes are not permitted to rely upon the VOS
+process control or IPC facilities for their normal functioning (the IPC
+connection to the CL is an exception since it is not required to run an
+IRAF process standalone).
+
+.nh 3
+Efficiency
+
+    The database interface must be efficient, particularly when used for
+image access and intermodule communication.  There are as many ways to
+measure the efficiency of an interface as there are applications for the
+interface, and we cannot address them all here.  The dimensions of the
+efficiency matrix we are concerned with here are the cpu time consumed
+during execution, the clock time consumed during execution, e.g, the number
+of file opens and disk seeks or required, and the disk space consumed for
+table storage.  Where necessary efficient cpu utilization will be achieved
+at the expense of memory requirements for code and buffers.
+
+A simple and well defined efficiency requirement is that the cpu and clock
+time required to access the pixels of an image stored in the database from
+a "cold start" (no open files) must not noticeably exceed that required
+by the old IMIO interface.  The efficiency of the new interface for the
+case when many images are to be accessed is expected to be a major improvement
+over that provided by the old IMIO interface, since the old interface
+stores each image in two separate files, whereas the new interface will
+be capable of storing the entire contents of many (small) images in a single
+file.  The amount of disk space required for image header storage is also
+expected to decrease by a large factor when multiple images are stored
+in a single physical file.
+
+.nh 3
+Code Size
+
+    We have already established that a process must directly access the
+database in mass storage to meet our portability and efficiency requirements.
+This type of access requires that the necessary IMIO, DBIO and DB Kernel
+routines be linked into each process requiring database access.  Minimizing
+the amount of text space used by the database code is desirable to minimize
+disk and memory requirements and process spawn time, but is not critical
+since memory is cheap and plentiful and is likely to become even cheaper
+and more plentiful in the future.  Furthermore, the multitask nature of
+IRAF processes allows the text segment used by the database code to be shared
+by many tasks, saving both disk and memory.
+
+The main problem remaining today with large text segments seems to be the
+process spawn time; loading the text segment by demand paging in a virtual
+memory environment can be quite slow.  The fault here seems to lie more with
+the operating system than with IRAF, and probably the solution will require
+tuning either the IRAF system interface or the operating system itself.
+
+Taking all these factors into account it would seem that typical memory
+requirements for the executable database code (not including data buffers)
+in the range 50 to 100 Kb would be acceptable, with 50 Kb being a reasonable
+goal.  This would make the database interface the largest i/o interface in
+IRAF but that seems inevitable considering the complexity of the problem to
+be solved.
+
+.nh 3
+Use of Proprietary Software
+
+    A mainline IRAF interface, i.e., any interface required for the normal
+operation of the system, must belong to IRAF and must be distributed with
+the IRAF system at no additional charge and with no licensing restrictions.
+The source code must be part of the system and is subject to strict
+configuration control by the IRAF group, i.e., the IRAF group is responsible
+for the software and must control it.  This rules out the use of a commercial
+database system for any essential part of the DBSS, but does not rule out
+IRAF access to a commercial database system provided such access is optional,
+i.e., not required for the operation of the standard applications packages.
+The host database interface provided by the DB kernel is an example of such
+an interface.
+
+.nh 2
+Special Requirements
+
+    In this section we present the functional requirements of the DBSS.
+The major applications for which the DBSS in intended are described and
+the desirable characteristics of the DBSS for each application are outlined.
+The major applications thus far identified are catalog storage, image storage,
+intermodule communication, and data archiving.
+
+.nh 3
+Catalog Storage
+
+    The catalog storage application is probably the closest thing in IRAF to a
+conventional database application.  A catalog is a set of records, each of
+which describes a single object.  Each record consists of a set of fields
+of various datatypes describing the attributes of the object.  A record is
+produced by numerical analysis of the object represented as a region of a
+digital array.  All records have the same structure, i.e., set of fields;
+often the records are all the same size (but not necessarily).  A large catalog
+might contain several hundred thousand records.  Examples of such catalogs are
+the SAO star catalog, the IRAS point source catalog, and the catalogs produced
+by analysis programs such as FOCAS (a faint object detection and classification
+program) and RICHFLD (a digital stellar photometry program).  Many similar
+examples can be identified.
+
+Generation of such a catalog by an analysis program is typically a cpu bound
+batch operation requiring many hours of computer time for a large catalog.
+Once the catalog has been generated there are typically numerous questions of
+scientific interest which can be answered using the data in the catalog.
+It is highly desirable that this phase of the analysis be interactive and
+spontaneous, as one question will often lead to another in an unpredictable
+fashion.  A general purpose analysis capability is required which will permit
+the scientist to pose arbitrary queries of arbitrary complexity, to be answered
+by the system in a few seconds (or minutes for large problems), with the answer
+taking the form of a number or name, set or table of numbers or names, plot,
+subcatalog, etc.
+
+Examples of such queries are given below.  Clearly, the set of all possible
+queries of this type is infinite, even assuming a limited number of operators
+operating on a single catalog.  The set of potentially interesting queries
+is equally large.
+.ls 4
+.ls [1]
+Find all objects of type "pqr" for which X is in the range A to B and
+Z is less than 10.
+.le
+.ls [2]
+Compute the mean and standard deviation of attribute X for all objects
+in the set [1].
+.le
+.ls [3]
+Compute and plot (X-Y) for all objects in set [1].
+.le
+.ls [4]
+Plot a circle of size (log2(Z-3.2) * 100) at the position (X,Y) of all objects
+in set [1].
+.le
+.ls [5]
+Print the values of the attributes OBJ, X, Y, and Z of all objects for which
+X is in the range A to B and Y is greater than 30.
+.le
+.le
+
+
+In the past queries such as these have all too often been answered by writing
+a program to answer each query, or worse, by wading though a listing of the
+program output and manually computing the result or manually plotting points
+on a graph.
+
+Given the preceding description of the catalog storage application, we can
+make the following observations about the application of the DBSS to catalog
+storage.
+.ls
+.ls o
+A catalog is typically written once and then read many times.
+.le
+.ls o
+Both public and private catalogs are common.
+.le
+.ls o
+Catalog records are infrequently updated or are not updated at all once the
+original entry has been made in the catalog.
+.le
+.ls o
+Catalog records are rarely if ever deleted.
+.le
+.ls o
+Catalogs can be very large, making efficient storage structures important
+in order to minimize disk storage requirements.
+.le
+.ls o
+Since catalogs can be very large, indexing facilities are required for
+efficient record retrieval and for the efficient evaluation of queries.
+.le
+.ls o
+A general purpose interactive query capability is required for the user to
+effectively make use of the data in a catalog.
+.le
+.le
+
+
+In DBSS terminology a user catalog will often be referred to as a \fBtable\fR
+to avoid confusion with the use of the DBSS term \fBcatalog\fR which refers
+to the system table which lists the contents of a database.
+
+.nh 3
+Image Storage
+
+    A primary requirement for the DBSS, if not \fIthe\fR primary requirement,
+is that the DBSS be suitable for the storage of bulk data or \fBimages\fR.
+An image consists of two parts: an \fIimage header\fR describing the image,
+and a multidimensional array of \fBpixels\fR.  The pixel array is sometimes
+small and sometimes very large indeed.  For efficiency and other reasons the
+actual pixel array is not required to be stored in the database.  Even if the
+pixels are stored directly in the database they are not expected to be used
+in queries.
+
+We can make the following observations about the use of the DBSS for image
+storage.  The reader concerned about how all this might map into the storage
+structures provided by a relational database should assume that the image
+header is stored as a single large, variable size record (tuple), whereas
+a group of images is stored as one or more tables (relations).  If the images
+are large assume the pixels are be stored outside the DBSS in a file, storing
+only the name of the file in the header record.
+.ls
+.ls o
+Images tend to be grouped into sets that have some logical meaning to the user,
+e.g., "nite1", "nite2", "raw", "reduced", etc.  Each group typically contains
+dozens or hundreds of images (enough to require use of an index for efficient
+retrieval).
+.le
+.ls o
+Within a group the individual images are often referred to by a unique ordinal
+number which is automatically assigned by some program (e.g., "nite1.10",
+"nite1.11", etc).
+.le
+.ls o
+Image databases tend to be private databases, created and accessed by a
+single user.
+.le
+.ls o
+The size of the pixel segment of an image varies enormously, e.g., from
+1 kilobyte to 8 megabytes, even 40 megabytes in some cases.
+.le
+.ls o
+Small pixel segments are most efficiently stored directly in the image header
+to minimize the number of file opens and disk seeks required to access the
+pixels once the header has been accessed (as well as to minimize file clutter).
+.le
+.ls o
+Large pixel segments are most efficiently stored separately from the image
+headers to increase clustering and speed sequential searches of a group of
+headers.
+.le
+.ls o
+It is occasionally desirable to store either the image header or the pixel
+segment on a special, non file-structured device.
+.le
+.ls o
+The image header logically consists of a closed set of standard attributes
+common to all images, plus an open set of attributes peculiar to the data
+or to the type of analysis being performed on the data.
+.le
+.ls o
+The operations performed on images are often functions which produce a
+modified version of the input image(s) as a new output image.  It is desirable
+for most header information to be automatically preserved in such a mapping.
+For this to happen automatically without the DBSS requiring knowledge of
+the contents of a header, it is necessary that the header be a single object
+to the DBSS, i.e., a single record in some table, rather than a set of
+related records in several tables.
+.le
+.ls o
+Since the image header needs to be maintained as a single record and since
+the header may contain an unpredictable number of application or data specific
+attributes, image headers can be quite large.
+.le
+.ls o
+Not all image header attributes are simple scalar values or even fixed size
+arrays.  Variable size attributes, i.e., arrays, are common in image headers.
+Examples of such attributes are the bad pixel list, history text, and world
+coordinate system (more on this in a later section).
+.le
+.ls o
+Image header attributes often form logical groupings, e.g., several logically
+related attributes may be required to define the bad pixel list or the world
+coordinate system.
+.le
+.ls o
+The image header structure is often dynamically updated and may change in
+size when updated.
+.le
+.ls o
+It is often necessary to add new attributes to an existing image header.
+.le
+.ls o
+Images are often selectively deleted.  Any subordinate files logically
+associated with the image should be automatically deleted when the image
+header is deleted.  If this is not possible under the DBSS then the DBSS
+should forbid deletion of the image header unless special action is taken
+to remove delete protection.
+.le
+.ls o
+For historical or other reasons, a given site will often maintain images
+in several different and completely incompatible formats.  It is desirable
+for the DBSS to be capable of directly accessing images maintained in a foreign
+format without a format conversion, even if only limited (e.g., read only)
+access is possible.
+.le
+.le
+
+
+In summary, images are characterized by a header with a highly variable set
+of fields, some of which may vary in size during the lifetime of the image.
+New fields may be added to the image header at any time.  Array valued fields
+are common and fields tend to form logical groupings.  The image header is
+best maintained as a single structure under the DBSS.  Image headers can be
+quite large.  The pixel segment of an image can be extremely large and may
+be best maintained outside the DBSS.  Since many existing image archives exist,
+each with its own unique format, it is desirable for the DBSS to be capable
+of accessing multiple storage formats.
+
+Storage of the pixel segment or any other portion of an image in a separate
+file outside the DBSS causes problems which must be dealt with at some level
+in the system, if not by the DBSS.  In particular, problems occur if the user
+tries to backup, restore, copy, rename, or delete any portion of an image using
+a host system utility.  These problems are minimized if all logically related
+data is kept in a single data directory, allowing the database as a whole to
+be moved or backed up with host system utilities.  All pathnames should be
+defined relative to the data directory to permit relocation of the database
+to a different directory.  Ideally all binary datafiles in the database should
+be maintained in a machine independent format to permit movement of the
+database between different machines without reformatting the entire database.
+
+.nh 3
+Intermodule Communication
+
+    A large applications package consists of many separate tasks or programs.
+These tasks are best defined and understood in terms of their operation on a
+central package database.  For example, one task might fit some function to
+an image, leaving a record describing the fit in the database.  A second task
+might take this record as input and use it to control a transformation on
+the original image.  Additional operators implementing a range of algorithms
+or optimized for a discrete set of cases are easily added, each relying upon
+the central database for intermodule communication.
+
+This application of the DBSS is a fairly conventional database application
+except that array valued attributes and logical groupings of attributes are
+common.  For example, assume that a polynomial has been fitted to a data
+vector and we wish to record the fit in the database.  A typical set of
+attributes describing a polynomial fit are shown below.
+
+
+.ks
+.nf
+	image_name	char*30		# name of source image
+	nfeatures	int		# number of features fitted
+	features.x	real*4[*]	# x values of the features
+	features.y	real*4[*]	# y values of the features
+	curve.type	char*10		# curve type
+	curve.ncoeff	int		# number of coefficients
+	curve.coeff	real*4[*]	# coefficients
+.fi
+.ke
+
+
+The data structure shown records the positions (X) and world coordinates (Y)
+of the data features to which the curve was fitted, plus the coefficients of
+the fitted curve itself.  There is no way of predicting the number of features
+hence the X and Y arrays are variable length.  Since the fitted curve might
+be a spline or some other piecewise function rather than a simple polynomial,
+there is likewise no reasonable way to place an upper limit on the amount of
+storage required to store the fitted curve.  This type of record is common in
+scientific applications.
+
+We can now make the following observations regarding the use of the DBSS for
+intermodule communication.
+.ls
+.ls o
+The number of fields in a record tends to be small, but array valued fields
+of variable size are common hence the physical size of a record may be large.
+.le
+.ls o
+A large table might contain several hundred records in typical applications,
+requiring the use of an index for efficient retrieval.
+.le
+.ls o
+Record access is usually random rather than sequential.
+.le
+.ls o
+Random record updates will be rare in some applications, but common in others.
+.le
+.ls o
+Records will often change in size when updated.
+.le
+.ls o
+Selective record deletion is rare, occurring mostly during cleanup following
+an error.
+.le
+.ls o
+New fields are rarely, if ever, added to existing records.  The record structure
+is usually determined by the programmer rather than by the user and tends to
+be well defined.
+.le
+.ls o
+This type of database is typically a private database created and used by a
+single user to process a specific dataset with a specific applications package.
+.le
+.le
+
+
+Application specific information may sometimes be stored directly in the header
+of the image being analyzed, but more often will be stored in one or more
+separate tables, recording the name of the image analyzed in the new record
+as a backpointer, as in the example.  Hence a typical scientific database
+might consist of several tables containing the input images, several tables
+containing intermodule records of various types, and one or more tables
+containing either reduced images or catalog records, depending on whether a
+reduction or analysis operation was performed.
+
+.nh 3
+Data Archiving
+
+    Data archiving refers to the long term storage of raw or reduced data.
+Data archiving is important for the following reasons.
+.ls
+.ls o
+Archiving is currently necessary just to \fItransport\fR data from the
+telescope to the site where reduction and analysis takes place.
+.le
+.ls o
+Permanently archiving the raw (or pre-reduced) data is necessary in case
+an error in the reduction process is later discovered, making it necessary
+for the observer to repeat the reductions.
+.le
+.ls o
+Archiving of the reduced data is desirable to save computer and human time
+in case the analysis phase has to be repeated, or in case additional analysis
+is later discovered to be necessary.
+.le
+.ls o
+Archived data could conceivably be of considerable value to future researchers
+who, given access to such data, might not have to make observations of their
+own, or who might be able to use the archived data to augment or plan their
+own observations.
+.le
+.ls o
+Archived data could be invaluable for future projects studying the variability
+of an object or objects over a period of years.
+.le
+.le
+
+
+Ideally data should be archived as it is taken at the telescope, possibly
+performing some simple pipeline reductions before archiving takes place.
+Subsequent reduction and analysis using the archived data should be possible
+without the format conversion (e.g., FITS to IRAF) currently required.
+This conversion wastes cpu time and disk space as well as user time.
+The problem is already serious and is expected to grow by an order of
+magnitude in the next several years as digital detectors grow in size and
+are used more frequently.
+
+Archival data consists of the digital data itself (the pixels) plus information
+describing the object, the observer, how the data was taken, when and where
+the data was taken, and so on.  This is just the type of information assumed
+to be present in an IRAF image.  In addition one would expect the archive to
+contain one or more \fBmaster catalogs\fR containing exhaustive information
+describing the observations but no data.
+
+Since a permanent digital data archive can be expected to be around for many
+years and to be read on many types of machines, data images should be archived
+in a machine independent format; this format would almost certainly be FITS.
+It is also desirable, though not essential, that the master catalogs be
+readable on a variety of machines and hence be maintained and distributed in
+a machine independent format.  The ideal storage medium for archiving and
+transporting large amounts of digital data appears to be the optical disk.
+
+Archival data and catalog access via the DBSS differs from conventional image
+and catalog access only in the storage format, which is assumed to be machine
+independent, and in the storage medium, which is assumed to be an archival
+medium such as the optical disk.  Direct access to a database on optical
+disk requires that the DBSS be able to read the machine independent format
+directly.
+
+To achieve acceptable performance for direct access it is necessary that
+the storage medium be randomly accessible (unlike, say, a magnetic or optical
+tape) and that the hardware seek time and transfer rate be comparable to those
+provided by magnetic disk technology.  Note that current optical disk readers
+often do not have fast seek times, and that those that do have fast seek times
+generally have a lower storage density than sequential devices due to the gaps
+between sectors.  Even if a device is not fast enough to be used directly it
+is still possible to eliminate the expensive format conversion and do only a
+disk to disk copy, accessing the machine independent format on magnetic disk.
+
+There is no requirement that the IRAF DBSS be used to support data archiving,
+but the DBSS \fIis\fR required to be able to access the data in an archive.
+Accessing the master catalogs as well seems reasonable since such a catalog
+is no different than those described in sections 3.2.1. and 3.2.3; IRAF will
+have the capability to maintain, access, and query such a catalog without
+developing any additional software.
+
+The main obstacle likely to limit the success of data archiving may well be
+the difficulty involved in gaining access to the archive.  If the master
+catalogs were maintained on magnetic disk but released periodically in
+optical disk format for astronomers to refer to at their home institutions,
+access would be much easier (and probably more frequent) than if all the
+astronomers in the country were required to access a single distant computer
+via modem.  Telephone access by sites not on the continent would probably
+be too expensive or problematic to be feasible.
+
+.nh 2
+Other Requirements
+
+    In earlier sections we have discussed the principle constraints and
+primary requirements for the DBSS.  Several other requirements or
+non-requirements deserve mention.
+
+.nh 3
+Concurrency
+
+    All of the applications identified thus far require either read-only access
+to a public database or read-write access to a private database.
+The DBSS is therefore not required to support simultaneous updating by many
+users of a single centralized database, with all the overhead and complication
+associated with record locking, deadlock avoidance and detection, and so on.
+The only exception occurs when a single user has several concurrent processes
+requiring simultaneous update access to the user's private database.  It appears
+that this case can be addressed adequately by distributing the database in
+several datasets and using host system file locking to lock the datasets,
+a technique discussed further in a later section.
+
+.nh 3
+Recovery
+
+    If a database update is aborted for some reason a dataset can be corrupted,
+possibly preventing further access to the dataset.  The DBSS should of course
+protect datasets from corruption in normal circumstances, but it is always
+possible for a hardware or software error (e.g., disk overflow or reboot) to
+cause a dataset to be corrupted.  Some mechanism is required for recovering a
+database that has been corrupted.  The minimum requirement is that the DBSS,
+when asked to access a corrupted dataset, detect that the dataset has been
+corrupted and abort, after which the user runs a recovery task to rebuild the
+dataset minus the corrupted records.
+
+.nh 3
+Data Independence
+
+    Data independence is a fundamental property inherent in virtually all
+database systems.  One of the major reasons one uses a database system is to
+provide data independence.  Data independence is so fundamental that we will
+not discuss it further here.  Suffice it so say that the DBSS must provide
+a high degree of data independence, allowing applications programs to function
+without detailed knowledge of the structure or contents of the database they
+are accessing, and allowing databases to change significantly without
+affecting the programs which access them.
+
+.nh 3
+Host Database Interface
+
+    The host database interface (HDBI) makes it possible for the DBSS to
+interface to a host database system.  The ability to interface to a host
+database system is not a primary requirement for the DBSS but is a highly
+desirable one for many of the same reasons that direct access to archival data
+is important.  The problems of accessing a HDB and of accessing an archive
+maintained in non-DBSS format are similar and might perhaps be addressed
+by a single interface.
+
+.nh
+Conceptual Design
+
+    In this section we develop the design of the various subsystems comprising
+the DBSS at the conceptual level, without bothering with the details of specific
+language bindings or with the details of implementation.  We start by defining
+some important terms and then describe the system architecture.  Lastly we
+describe each of the major subsystems in turn, starting at the highest level
+and working down.
+
+.nh 2
+Terminology
+
+    The DBSS is an implementation of a \fBrelational database\fR.  A relational
+database views data as a collection of \fBtables\fR.  Each table has a fixed
+set of named columns and may contain any number of rows of data.  The rows
+of a table are often referred to as \fBrecords\fR.  A record consists of a set
+of named \fBfields\fR.  The fields of a record are the columns of the table
+containing the record.
+
+We shall use this informal terminology when discussing the contents of a
+physical database.  When discussing the \fIstructure\fR of a database we shall
+use the formal relational terms relation, tuple, attribute, and so on.
+The correspondence between the formal relational terms and their informal
+equivalents is given in the table below.
+
+
+.ks
+.nf
+	\fBformal relational term\fR		    \fBinformal equivalents\fR
+
+		relation			table
+		tuple				record, row
+		attribute			field, column
+		primary key			unique identifier
+		domain				pool of legal values
+.fi
+.ke
+
+
+A \fBrelation\fR is a set of like tuples.  A \fBtuple\fR is a set of
+\fBattributes\fR, each of which is defined upon a specific domain.
+A \fBdomain\fR is an abstract type which defines the legal values an
+attribute may take on (e.g., "posint" or "color").  The tuples of a relation
+must be unique within the containing relation.  The \fBprimary key\fR is
+a subset of the attributes of a relation which is sufficient to uniquely
+identify any tuple in the relation (often a single attribute serves as
+the primary key).
+
+The relational data model was chosen for the DBSS because it is the simplest
+conceptual data model which meets our requirements.  Other possibilites
+considered were the \fBhierarchical\fR model, in which data is organized in
+a tree structure, and the \fBnetwork\fR model, in which data is organized in
+a potentially recursive graph structure.  Virtually all new database systems
+implemented since the mid-seventies have been based on the relational model
+and most database research today is in support of the relational model (the
+remainder goes to the new fifth-generation technology, not to the old data
+models).
+
+The term "relational" in "relational database" comes from the \fBrelational
+algebra\fR, a branch of mathematics based on set theory which defines a
+fundamental and mathematically complete set of operations upon relations
+(tables).  The relational algebra is fundamental to the DBMS query language
+(section 4.3) but can be safely ignored in the rest of the DBSS.  The reader
+is referred to any introductory database text for a discussion of the relational
+algebra and other database technotrivia.  The classic introductory database
+text is \fI"An Introduction to Database Systems"\fR, Volume 1 (Fourth Edition,
+1986) by C. J. Date.
+
+.nh 2
+System Architecture
+
+    The system architecture of the DBSS is depicted in Figure 2.  The parts
+of the figure above the "DBKI" have already been discussed in section 2.2.
+The remainder of the figure is what has been referred to previously as the
+DB kernel.
+
+The primary function of DBIO is record access (retrieval, update, insertion,
+and deletion) based on evaluation of a \fBselect\fR statement input as a string.
+DBIO can also process symbolic definitions of relations and other database
+objects so that new tables may be created.  DBIO does not implement any
+relational operators more complex than select; the more complex relational
+operations are left to the DBMS query language to minimize the size and
+complexity of DBIO.
+
+The basic concept underlying the design of the lower level portions of the DBSS
+is that the DB kernel provides the \fBaccess method\fR for efficiently accessing
+records in mass storage, while DBIO takes care of all higher level functions.
+In particular, DBIO implements all functions required to access the contents
+of a record, while the DB kernel is responsible for storage allocation and for
+the maintenance and use of indexes, but has no knowledge of the actual contents
+of a record (the HDBI is an exception to this rule as we shall see later).
+
+The database kernel interface (DBKI) provides a layer of indirection between
+DBIO and the underlying database kernel (DBK).  The DBKI can support a number
+of different kernels, much the way FIO can support a number of different device
+drivers.  The DBKI also provides network access to a remote database, using
+the existing IRAF kernel interface (KI) to communicate with a DBKI on the
+remote node.  Two standard database kernels are provided.
+
+The primary DBK (at the right in the figure) maintains and accesses DBSS
+binary datasets; this is the most efficient kernel and probably the only
+kernel which will fully implement the semantic actions of the DBKI.
+The second DBK (at the left in the figure) supports the host database
+interface (HDBI) and is used to access archival data, any foreign image
+formats, and the host database system (HDB), if any.  Specialized HDBI
+drivers are required to access foreign image formats or to interface to
+an HDB.
+
+
+.ks
+.nf
+		 DBMS          IMAGES(etc)            (CL)
+                   \             /
+                    \           /                   ---------
+                     \         /
+                      \     IMIO                     
+                       \    /  \       
+                        \  /    \                                  
+                         \/      \  
+                        DBIO     FIO                  (VOS)
+                         | 
+                         |
+                         |
+                        DBKI
+                         |
+                  +------+------+-------+
+                  |             |       |
+                 DBK           DBK    (KI)
+                  |             |       |
+                  |             |       |
+                 HDBI           |       |
+                  |             |       |
+             +----+----+        |       |           ---------
+             |         |        |       |
+             |         |        |       |
+         [archive]   [HDB]  [dataset]   |
+                                        |
+                                        |         (host system)
+                                        -
+				      (LAN)
+					-
+                                        |
+                                        |           ---------
+                                        |
+                                 (Kernel-Server)
+                                        |
+                                        |
+                                       DBKI           (VOS)
+                                        |
+                                    +---+---+
+                                    |       |
+                                   DBK     DBK
+
+
+.fi
+.ce
+Figure 2. \fBDatabase Subsystem Architecture\fR
+.ke
+
+
+.nh 2
+The DBMS Package
+.nh 3
+Overview
+
+    The user interfaces with a database in either of two ways.  The first way
+is via the tasks in an applications package, which perform highly specialized
+operations upon objects stored in the database, e.g., to reduce a certain kind
+of data.  The second way is via the database management package (DBMS), which
+gives the user direct access to any dataset (but not to large pixel arrays
+stored outside the DBSS).  The DBMS provides an assortment of general purpose
+operators which may be used regardless of the type of data stored in the
+database and regardless of the applications program which originally created
+the structures stored in the database.
+
+The DBMS package consists of an assortment of simple procedural operators
+(conventional CL callable parameter driven tasks), a screen editor for tables,
+and the query language, a large program which talks directly to the terminal
+and which has its own special syntax.  Lastly there is a subpackage containing
+tasks useful only for datasets maintained by the primary DBK, i.e., a package
+of relatively low level tasks for things like crash recovery and examining
+the contents of physical datasets.
+
+.nh 3
+Procedural Interface
+
+    The DBMS procedural interface provides a number of the most commonly
+performed database operations in the form of CL callable tasks, allowing
+these simple operations to be performed without the overhead involved in
+entering the query language.  Extensive database manipulations are best
+performed from within the query language, but if the primary concern of
+the user is data reduction in some package other than DBMS the procedural
+operators will be more convenient and less obtrusive.
+
+.nh 4
+General Operators
+
+    DBMS tasks are required to implement the following general database
+management operations.  Detailed specifications for the actual tasks are
+given later.
+.ls
+.ls \fBchdb\fR newdb
+Change the default database.  To minimize typing the DBSS provides a
+"default database" paradigm analogous to the default directory of FIO.
+Note that there need be no obvious connection between database objects
+and files since multiple tables may be stored in a single physical file,
+and the physical database may reside on an optical disk or worse may be
+an HDB.  Therefore the FIO "directory" cannot be used to examine the
+contents of a database.  The default database may be set independently
+of the current directory.
+.le
+.ls \fBpcatalog\fR [database]
+Print the catalog of the named database.  The catalog is a system table
+containing one entry for every table in the database; it is analogous
+to a FIO directory.  Since the catalog is a table it can be examined like
+any other table, but a special task is provided since the print catalog
+operation is so common.  If no argument is given the catalog of the default
+database is printed.
+.le
+.ls \fBptable\fR spe
+Print the contents of the specified relation in list form on the standard
+output.  The operand \fIspe\fR is a general select expression defining
+a new table as a projection of some subset of the records in a set of one or
+more named tables.  The simplest select expression is the name of a single
+table, in which case all fields of all records in the table will be printed.
+More generally, one might print all fields of a single table, selected fields
+of a single table (projection), all fields of selected records of a single
+table (selection), or selected fields of selected records from one or more
+tables (selection plus projection).
+.le
+.ls \fBrcopy\fR spe output_table
+Copy (insert) the records specified by the general select expression
+\fIspe\fR into the named \fIoutput_table\fR.  If the named output table
+does not exist a new one will be created.  If the attributes of the output
+table are different than those of the input table the proper action of
+this operator is not obvious and has not yet been defined.
+.le
+.ls \fBrmove\fR spe output_table
+Move (insert) the relation specified by the general select expression
+\fIspe\fR into the named \fIoutput_table\fR.  If the named output table
+does not exist a new one will be created.  The original records are deleted.
+This operator is used to generate the union of two or more tables.
+.le
+.ls \fBrdelete\fR spe
+Delete the records specified by the general select expression \fIspe\fR.
+Note that this operator deletes records from tables, not the tables themselves.
+.le
+.ls \fBmkdb\fR newdb [ddl_file]
+Create a new, empty database \fInewdb\fR.  If a data definition file
+\fIddl_file\fR is named it will be scanned and any domain, relation, etc.
+definitions therein entered into the new database.
+.le
+.ls \fBmktable\fR table relation
+Create a new, empty table \fItable\fR of type \fIrelation\fR.  The parameter
+\fIrelation\fR may be the name of a DDL file, the name of an existing base
+table, or any general record select/project expression.
+.le
+.ls \fBmkview\fR table relation
+Create a new virtual table (view) defined in terms of one or more existing
+base tables by the operand \fIrelation\fR, which is the same as for the
+task \fImktable\fR.  Operationally, \fBmkview\fR is much like \fBrcopy\fR,
+except that it is considerably faster and the new table does not physically
+store any data.  The new view-table behaves like any other table in most
+operations (except some types of updates).  Note that the new table may
+reference tuples in several different base tables.  A view-table may
+subsequently be converted into a base table with \fBrcopy\fR.  Views are
+discussed in more detail in section 4.5.
+.le
+.ls \fBmkindex\fR table fields
+Make a new index on the named base table over the listed fields.
+.le
+.ls \fBrmtable\fR table
+Drop (delete, remove) the named base table (or view) and any indexes defined
+on the table.
+.le
+.ls \fBrmindex\fR table fields
+Drop (delete, remove) the index defined over the listed fields on the named
+base table.
+.le
+.ls \fBrmdb\fR [database]
+Destroy the named database.  Unless explicitly overridden \fBrmdb\fR will
+refuse to delete a database until all tables therein have been dropped.
+.le
+.le
+
+
+Several terms were introduced in the discussion above which have not yet been
+defined.  A \fBbase table\fR is a physical table (instance of a defined
+relation), unlike a \fBview\fR which is a virtual table defined via selection
+and projection over one or more base tables or other views.  Both types of
+objects behave equivalently in most operations.
+A \fBdata definition language\fR (DDL) is a language syntax used to define
+database objects.
+
+.nh 4
+Forms Based Data Entry and Retrieval
+
+    Many of the records typically stored in a database are too large to be
+printed in list format on a single line.  Some form of multiline output is
+necessary; this multiline representation is called a \fBform\fR.  The full
+terminal screen is used to display a form, e.g. with the fields labeled
+in reverse video and the field values in normal video.  Records are viewed
+one at a time.
+
+Data entry via a form is an interactive process similar to editing a file with
+a screen editor.  The form is displayed, possibly with default values for the
+fields, and the user types in new values for the fields.  Editor commands are
+provided for positioning the cursor to the field to be edited and for editing
+within a field.  The DBSS verifies each value as it is entered using the range
+information supplied with the domain definition for that field.
+Additional checks may be made before the new record is inserted into the
+output table, e.g., the DBSS may verify that values have been entered for
+all fields which do not permit null values.
+.ls
+.ls \fBetable\fR spe
+Call up the forms editor to edit a set of records.  The operand \fIspe\fR
+may be any general select expression.
+.le
+.ls \fBpform\fR spe
+Print a set of records on the standard output, using the forms generator to
+generate a nice self documenting format.
+.le
+.le
+
+
+The \fBforms editor\fR (etable) may be used to display or edit existing records
+as well as to enter new ones.  It is desirable for the forms editor to be able
+to move backward as well as forward in a table, as well as to move randomly
+to a record satisfying a predicate, i.e., search through the table for a
+record.  This makes the forms editor a powerful tool for browsing through a
+database.  If the predicate for a search is specified by entering values or
+boolean expressions into the fields contributing to the predicate then we have
+a query-by-form utility, which has been reported in the literature to be very
+popular with users (since one does not have to remember a syntax and typing
+is minimized).
+
+A variation on the forms editor is \fBpform\fR, used to output records in
+"forms" format.  This will be most useful for large records or for cases where
+one is more interested in studying individual records than in comparing
+different records.  The alternative to forms output is list or tabular format
+output.  This form of output is more concise and can be used as input to the
+\fBlists\fR operators, but may be harder to read and may overflow the output
+line.  List format output is discussed further in the next section.
+
+By default the format of a form is determined automatically by a
+\fBforms generator\fR using information given in the DDL when the database
+was created.  The domain definition capability of the DDL includes provisions
+for specifying the default output format for a field as well as the field label.
+In most cases this will be sufficient information for the forms generator to
+generate an esthetically acceptable form.  If desired the user or programmer can
+modify this form or create a new form from scratch, and the forms generator
+will use the customized form rather than create one of its own.
+
+The CL \fBeparam\fR parameter file editor is an example of a simple forms
+editor.  The main differences between \fBeparam\fR and \fBetable\fR are the
+forms generator and the browsing capability.
+
+.nh 4
+List Interface
+
+    The \fBlist\fR is one of the standard IRAF data structures.  A list is
+an ascii table wherein the standard record delimiter is the newline and the
+standard field delimiter is whitespace.  Comment lines and blank lines are
+ignored within lists; double comment lines ("## ...") may optionally be used
+to label the columns of a list.  By default, non-DBMS lists are free format;
+strings must be quoted if they contain one of the field delimiter characters.
+The field and record delimiter characters may be changed if necessary, e.g.,
+to permit multiline records.  Fixed format lists are available as an option
+and are often required to interface to external (non-IRAF) programs.
+
+The primary advantages of the list or tabular format for printed tables are
+the following.
+.ls
+.ls [1]
+The list or tabular format is the most concise form of printed output.
+The eye can rapidly scan up and down a column to compare the values of
+the same field in a set of records.
+.le
+.ls [2]
+DBMS list output may be used as input to the tasks in the \fBlists\fR,
+\fBplot\fR, and other packages.  Using the pipe syntax, tasks which
+communicate via lists may be connected together to perform arbitrarily
+complex operations.
+.le
+.ls [3]
+List format output is the defacto standard format for the interchange of
+tabular data (e.g., DBSS tables) amongst different computers and programs.
+A list (usually the fixed format variety) may be written onto a cardimage
+tape for export, and conversely, a list read from a cardimage tape may be
+used to enter a table into a DBSS database.
+.le
+.le
+
+
+The most common use for list format output will probably be to print tables.
+When a table is too wide to fit on a line the user will learn to use
+\fBprojection\fR to print only the fields of interest.  The default format
+for DBMS lists will be fixed format, using the format information provided
+in the DDL specification to set the default output format.  Fixed format
+is best for DBMS lists since it forces the field values to line up in nice
+orderly columns, which are easier for a human to read (fixed format is easier
+and more efficient for a computer to read as well, if not to write).
+The type of format used will be recorded in the list header and a
+\fBlist interface\fR will be provided so that all list processing programs
+can access lists equivalently regardless of their format.
+
+As mentioned above, the list interface can be used to import and export tables.
+In particular, an astronomical catalog distributed on card image tape can be
+read directly into a DBSS table once a format descriptor has been prepared
+and the DDL for the new table has been written and used to create an empty
+table ready to receive the data.  After only a few minutes of setup a user can
+have a catalog entered into the database and be getting final results using
+the query language interface!
+.ls
+.ls \fBrtable\fR listfile output_table
+The list \fIlistfile\fR is scanned, inserting successive records from the
+list into the named output table.  A new output table is created if one does
+not already exist.  The format of the list is taken from the list header
+if there is one, otherwise the format specification is provided by the user
+in a separate file.
+.le
+.ls \fBptable\fR spe
+Print the contents of the relation \fIspe\fR in list form on the standard
+output.  The operand \fIspe\fR may be any general select/project expression.
+.le
+.le
+
+
+The \fBptable\fR operator (introduced in section 4.3.2.1) is used to generate
+list output.  The inverse operation is provided by \fBrtable\fR.
+
+.nh 4
+FITS Table Interface
+
+    The FITS table format is a standard format for the transport of tabular
+data.  The idea is very similar to the cardimage format discussed in the last
+section except that the FITS table standard includes a table header used to
+define the format of the encoded table, hence the user does not have to
+prepare a format descriptor to read a FITS table.  The FITS reader and writer
+programs are part of the \fBdataio\fR package.
+
+.nh 4
+Graphics Interface
+
+    All of the \fBplot\fR package graphics facilities are available for plotting
+DBMS data via the \fBlist\fR interface discussed in section 4.3.2.3.  List
+format output may also be used to generate output to drive external (non-IRAF)
+graphics packages.  Plotting facilities are also available via a direct
+interface within the query language; this latter interface is the most efficient
+and will be the most suitable for most graphics applications.  See section
+2.3 for additional comments on the graphics interface.
+
+.nh 3
+Command Language Interface
+
+    All of the DBMS tasks are CL callable and hence part of the command language
+interface to the DBSS.  For example, a CL script task may implement arbitrary
+relational operators using \fBptable\fR to copy a table into a list, \fBfscan\fR
+and \fBprint\fR to read the list and format the modified list, and finally
+\fBrtable\fR to insert the output list into a table.  The query language may
+also be called from within a CL script to process commands passed on the
+command line, via the standard input, or via a temporary file.
+
+Additional operators are required for randomly accessing records without the
+use of a list; suitable operators are shown below.
+.ls
+.ls \fBdbgets\fR record fields
+The named fields of the indicated record are returned as a free format string
+suitable for decoding into individual fields with \fBfscan\fR.
+.le
+.ls \fBdbputs\fR record fields values
+The named fields of the indicated record are set to the values given in the
+free format value string.
+.le
+.le
+
+
+More sophisticated table and record access facilities are conceivable but
+cannot profitably be implemented until an enhanced CL becomes available.
+
+.nh 3
+Record Selection Syntax
+
+    As we have seen, many of the DBMS operators employ a general record
+selection syntax to specify the set of records to be operated upon.
+The selection syntax will include a list of tables and optionally a
+predicate (boolean expression) to be evaluated for each record in the
+listed tables to determine if the record is to be included in the final
+selection set.  In the simplest case a single table is named with no
+predicate in which case the selection set consists of all records in the
+named table.  Parsing and evaluation of the record selection expression
+is performed entirely by the DBIO interface hence we defer detailed
+discussion of selection syntax to the sections describing DBIO.
+
+.nh 3
+Query Language
+
+    In most database systems the \fBquery language\fR is the primary user
+interface, both for the end-user interactively entering adhoc queries, and for
+the programmer entering queries via the host language interface.  The major
+reasons for this are outlined below.
+.ls
+.ls [1]
+A query language interface is much more powerful than a "task" or subroutine
+based interface such as that described in section 4.3.2.  A query language
+can evaluate queries much more complex than the simple "select" operation
+implemented by DBIO and made available to the user in tasks such as
+\fBptable\fR and \fBrcopy\fR.
+.le
+.ls [2]
+A query language is much more efficient than a task interface for repeated
+queries.  Information about a database may be cached between queries and
+files may remain open between queries.  Complex queries may be executed as
+a series of simpler queries, cacheing the intermediate results in memory.
+Graphs may be generated directly from the data without encoding, writing,
+reading, decoding, and deleting an intermediate list.
+.le
+.ls [3]
+A query language can perform many functions via a single interface, reducing
+the amount of code to be written and supported, as well as simplifying the
+user interface.  For example, a query language can be used to globally
+update (edit) tables, as well as to evaluate queries on the database.
+Lacking a query language, such an editing operation would have to be
+implemented with a separate task which would no doubt have its own special
+syntax for the user to remember (e.g, the \fBhedit\fR task in the \fBimages\fR
+package).
+.le
+.le
+
+
+Unlike most commercial database systems, the DBSS is not built around the
+query language.  The heart of the IRAF DBSS is the DBIO interface, which is
+little more than a glorified record access interface.  The query language
+is a high level applications task built upon DBIO, GIO, and the other interfaces
+constituting the IRAF VOS.  This permits us to delay implementation of the
+query language until after the DBSS is in use and our primary requirements have
+been met, and then implement the query language as an experimental prototype.
+Like all data analysis software, the query language is not required to meet
+our primary requirements (data acquisition and reduction), rather it is needed
+to do interesting things with our data once it has been reduced.
+
+.nh 4
+Query Language Functions
+
+    The query language is a prominent part of the user interface and is
+often used interactively directly by the user, but may also be called
+noninteractively from within CL scripts and by SPP programs.  The major
+functions performed by the query language are as follows.
+.ls
+.ls [1]
+The database management operations, i.e., create/destroy database,
+create/drop table or index, sort table, alter table (add new attribute),
+and so on.
+.le
+.ls [2]
+The relational operations, i.e., select, project, join, and divide
+(the latter is rarely implemented).  These are the operations most used
+to evaluate queries on the database.
+.le
+.ls [3]
+The traditional set operations, i.e., union, intersection, difference,
+and cartesian product.
+.le
+.ls [4]
+The editing operations, i.e, selective record update and delete.
+.le
+.ls [5]
+Operations on the columns of tables.  Compute the sum, average, minimum,
+maximum, etc. of the values in a column of a table.  These operations
+are also required for queries.
+.le
+.ls [6]
+Tabular and graphical output.  The result of any query may be printed or
+plotted in a variety of ways, without need to repeat the query.
+.le
+.le
+
+
+The most important function performed by the query language is of course the
+interactive evaluation of queries, i.e., questions about the data in the
+database.  It is beyond the scope of this document to try to give the reader
+a detailed understanding of how a query language is used to evaluate queries.
+
+.nh 4
+Language Syntax
+
+    The great flexibility of a query language derives from the fact that it is
+syntax rather than parameter driven.  The syntax of the DBMS query language
+has not yet been defined.  In choosing a language syntax there are a several
+possible courses of action: [1] implement a standard syntax, [2] extend a
+standard syntax, or [3] develop a new syntax, e.g., as a variation on some
+existing syntax.
+
+The problem with rigorously implementing a standard syntax is that all query
+languages currently in wide use were developed for commercial applications,
+e.g., for banking, inventory, accounting, customer mailing lists, etc.
+Experimental query languages are currently under development for CAD
+applications, analysis of Landsat imagery, and other applications similar
+to ours, but these are all research projects at the present time.
+The basic characteristics desirable in a query language intended for scientific
+data reduction and analysis seem little different than those provided by a query
+language intended for commercial applications, hence the most practical
+approach is probably to start with some existing query language syntax and
+modify or extend it as necessary for our type of data.
+
+There is no standard query language for relational databases.
+The closest thing to a standard is SQL, a language originally developed by
+IBM for System-R (one of the first relational database systems, actually an
+experimental prototype), and still in use in the latest IBM product, DB2.
+This language has since been used in many relational products by many companies.
+SQL is the latest in a series of relational query languages from IBM; earlier
+languages include SQUARE and SEQUEL.  The second most widely used relational
+query language appears to be QUEL, the query language used in both educational
+and commercial INGRES.
+
+Both SQL and QUEL are examples of the so-called "calculus" query languages.
+The other major type of query language is the "algebraic" query language
+(excluding the forms and menu based query languages which are not syntax
+driven).  Examples of algebraic languages are ISBL (PRTV, Todd 1976),
+TABLET (U. Mass.), ASTRID (Gray 1979), and ML (Li 1984).
+These algebraic languages have all been implemented and used, but nowhere
+near as widely as SQL and QUEL.
+
+It is interesting to note that ASTRID and ML were developed by researchers
+active in the area of logic languages.  In particular, the ML (Mathematics-Like)
+query language was implemented in Prolog and some of the character of Prolog
+shows through in the syntax of the language.  There is a close connection
+between the relational algebra and the predicate calculus (upon which the
+logic languages are based) which is currently being actively explored.
+One of the most promising areas of application for the logic languages
+(upon which the so-called "fifth generation" technology is based) is in
+database applications and query languages in particular.
+
+There appears to be no compelling reason for the current dominance of the
+calculus type query language, other than the fact that is what IBM decided
+to use in System-R.  Anything that can be done in a calculus language can
+also be done in an algebraic language and vice versa.
+
+The primary difference between the two languages is that the calculus languages
+want the user to express a complex query as a single large statement,
+whereas the algebraic languages encourage the user to execute a complex
+query as a series of simpler queries, storing the intermediate results as
+snapshots or views (either language can be used either way, but the orientation
+of the two languages is as stated).  For simple queries there is little
+difference between the two languages, although the calculus languages are
+perhaps more readable (more English-like) while the algebraic languages are
+more concise and have a more mathematical character.
+
+The orientation of the calculus languages towards doing everything in a single
+statement provides more scope for optimization than if the equivalent query is
+executed as a series of simpler queries; this is often cited as one of the
+major advantages of the calculus languages.  The procedural nature of the
+algebraic languages does not permit the type of global optimizations employed
+in the calculus languages, but this approach is perhaps more user-friendly
+since the individual steps are easy to understand, and one gets to examine
+the intermediate results to figure out what to do next.  Since a complex query
+is executed incrementally, intermediate results can be recomputed without
+starting over from scratch.  It is possible that, taking user error and lack
+of forethought into account, the less efficient algebraic languages might end
+up using less computer time than the super efficient calculus languages for
+comparable queries.
+
+A further advantage of the algebraic language in a scientific environment is
+that there is more of a distinction between executing a query and printing
+the results of the query than in a calculus language.  The intermediate results
+of a complex query in an algebraic language are named relations (snapshots
+or views); an extra print command must be entered to examine the intermediate
+result.  This is an advantage if the query language provides a variety of ways
+to examine the result of a query, e.g., as a printed table or as some type
+of plot.
+
+.nh 4
+Sample Queries
+
+    At this point several examples of actual queries, however simple they may
+be, should help us to visualize what a query language is like.  Several
+examples of typical scientific queries were given (in English) in section 3.2.1.
+For the convenience of the reader these are duplicated here, followed by actual
+examples in the query languages SQL, QUEL, ASTRID, and ML.  It should be noted
+that these are all examples of very simple queries and these examples do little
+to demonstrate the power of a fully relational query language.
+.ls
+.ls [1]
+Find all objects of type "pqr" for which X is in the range A to B and
+Z is less than 10.
+.le
+.ls [2]
+Compute the mean and standard deviation of attribute X for all objects
+in the set [1].
+.le
+.ls [3]
+Compute and plot (X-Y) for all objects in set [1].
+.le
+.ls [4]
+Plot a circle of size (log2(Z-3.2) * 100) at the position (X,Y) of all objects
+in set [1].
+.le
+.ls [5]
+Print the values of the attributes OBJ, X, Y, and Z of all objects of type
+"pqr" for which X is in the range A to B and Y is greater than 30.
+.le
+.le
+
+
+It should not be difficult for the imaginative reader to make up similar
+queries for a particular astronomical catalog or data archive.
+For example (I can't resist), "find all objects for which B-V exceeds X",
+"find all recorded observations of object X", "find all observing runs on
+telescope X in which astronomer Y participated during the years 1975 to
+1985", "compute the number of cloudy nights in August during the years
+1985 to 1990", and so on.  The possibilities are endless.
+
+Query [5] is an example of a simple select/project query.  This query is
+shown below in the different query languages.  Note that whitespace may be
+redistributed in each query as desired; in particular, the entire query may
+be entered on a single line if desired.  Keywords are shown in upper case
+and data names or values in lower case.  The object "table" is the table
+from which records are to be selected, "pqr" is the desired value of the
+field "type" of table "table", and "x", "y", and "z" are numeric fields of
+the table.
+
+
+.ks
+.nf
+SQL:
+
+	SELECT	obj, x, y, z
+	FROM	table
+	WHERE	type = 'pqr'
+	AND	x >= 10
+	AND	x <= 20
+	AND	z >  30;
+.fi
+.ke
+
+
+.ks
+.nf
+QUEL:
+
+	RANGE OF t IS table
+	RETRIEVE (t.obj, t.x, t.y, t.z)
+	WHERE	t.type = 'pqr'
+	AND	t.x >= 10
+	AND	t.y <= 20
+	AND	t.z >  30
+.fi
+.ke
+
+
+.ks
+.nf
+ASTRID (mnemonic form):
+
+	table
+	SELECTED_ON [
+		type = 'pqr'
+		AND x >= 10
+		AND x <= 20
+		AND z >  30
+	] PROJECTED_TO
+		obj, x, y, z
+.fi
+.ke
+
+
+.ks
+.nf
+ASTRID (mathematical form):
+
+	table ;[ type = 'pqr' AND x >= 10 AND x <= 20 AND z < 10 ] %
+		obj, x, y, z
+.fi
+.ke
+
+
+.ks
+.nf
+ASTRID (alternate query showing use of intermediates):
+
+	a := table ;[ type = 'pqr' AND z > 30 ]
+	b := a ;[ x >= 10 AND x <= 20 ]
+	b % obj,x,y,z
+.fi
+.ke
+
+
+.ks
+.nf
+ML (Li/Prolog):
+
+	table : type=pqr, x >= 10, x <= 20, z < 10 [obj,x,y,z]
+.fi
+.ke
+
+
+Note that in ASTRID and ML selection and projection are implemented as
+operators or qualifiers modifying the relation on the left.  To print all
+fields of all records of a table one need only enter the name of the table.
+The logic language nature of such queries is evident if one thinks of the
+query as a predicate or true/false assertion.  Given such an assertion (query),
+the query processor tries to prove the assertion true by finding all tuples
+satisfying the predicate, using the set of rules given (the database).
+
+For simple queries such as these it makes little difference what query language
+is used; many users would probably prefer the SQL or QUEL syntax for these
+simple queries because of the English like syntax.  To seriously evaluate the
+differences between the different languages more complex queries must be tried,
+but such an exercise is beyond the scope of the present document.
+
+As a final example we present, without supporting explanation, an example
+of a more complex query in SQL (from Date, 1986).  This example is based
+upon a "suppliers-parts-projects" database, consisting of four tables:
+suppliers (S), parts (P), projects (J), and number of parts supplied to
+a specified project by a specified supplier (SPJ), with fields 'supplier
+number' (S#), 'part number' (P#) and 'project number' (J#).  The names
+SPJX and SPJY are aliases for SPJ.  This example is rather contrived and
+the data is not interesting, but it should serve to illustrate the use of
+SQL for complex queries.
+
+
+.ks
+.nf
+Query: Get part numbers for parts supplied to all projects in London.
+
+	SELECT	DISTINCT p#
+	FROM	spj spjx
+	WHERE	NOT EXISTS
+	      ( SELECT	*
+		FROM	j
+		WHERE	city = 'london'
+		AND	NOT EXISTS
+		      ( SELECT	*
+			FROM	spj spjy
+			WHERE	spjy.p# = spjx.p#
+			AND	spjy.j# = j.j# ));
+.fi
+.ke
+
+
+The nesting shown in this example is characteristic of the calculus languages
+when used to evaluate complex queries.  Each SELECT implicitly returns an
+intermediate relation used as input to the next higher level subquery.
+
+.nh 3
+DB Kernel Operators
+
+    All DBMS operators described up to this point have been general purpose
+operators with no knowledge of the form in which data is stored internally.
+Additional operators are required in support of the standard IRAF DB kernels.
+These will be implemented as CL callable tasks in a subpackage off DBMS.
+
+.nh 4
+Dataset Copy and Load
+
+    Since our intention is to store the database in a machine independent
+format, special operators are not required to backup, reload, or copy dataset
+files.  The binary file copy facilities provided by IRAF or the host system
+may be used to backup, reload, or copy dataset files.
+
+.nh 4
+Rebuild Dataset
+
+    Over a period of time a dataset which is subjected to heavy updating
+may become disordered internally, reducing the efficiency of a most record
+access operations.  A utility task is required to efficiently rebuild such
+datasets.  The same result can probably be achieved by an \fIrcopy\fR
+operation but a lower level operator may be more efficient.
+
+.nh 4
+Mount Foreign Dataset
+
+    Before a foreign dataset (archive or local format imagefile) can be
+accessed it must be \fImounted\fR, i.e., the DBSS must be informed of the
+existence and type of the dataset.  The details of the mount operation are
+kernel dependent; ideally the mount operation will consist of little more
+than examining the structure of the foreign dataset and making appropriate
+entries in the system catalog.
+
+.nh 4
+Crash Recovery
+
+    A utility is required for recovering datasets which have been corrupted
+as a result of a hardware or software failure.  There should be sufficient
+redundancy in the internal data structures of a dataset to permit automated
+recovery.  The recover operation is similar to a rebuild so perhaps the
+same task can be used for both operations.
+
+.nh 2
+The IMIO Interface
+.nh 3
+Overview
+
+    The Image I/O (IMIO) interface is an existing subroutine interface used
+to maintain and access bulk data arrays (images).  The IMIO interface is built
+upon the DBIO interface, using DBIO to maintain and access the image headers
+and sometimes to access the stored data (the pixels) as well.  For reasons of
+efficiency IMIO directly accesses the bulk data array when large images are
+involved.
+
+Most of the material presented in this section on the image header is new.
+The pixel access facilities provided by the existing IMIO interface will
+remain essentially unchanged, but the image header facilities provided by
+the current interface are quite limited and badly need to be extended.
+The existing header facilities provide support for the major physical image
+attributes (dimensionality, length of each axis, pixel datatype, etc.) plus
+a limited facility for storing user defined attributes.  The main changes
+in the new interface will be excellent support for history records, world
+coordinates, histograms, a bad pixel list, and image masks.  In addition
+the new interface will provide improved support for user defined attributes,
+and greatly improved efficiency when accessing large groups of images.
+The storage structures will be more localized, hopefully causing less
+confusion for the user.
+
+In this section we first discuss the components of an image, concentrating
+primarily on the different parts of the image header, which is quite a
+complex structure.  We then discuss briefly the (mostly existing) facilities
+for header and pixel access.  Lastly we discuss the storage structures
+normally used to maintain images in mass storage.
+
+.nh 3
+Logical Schema
+
+    Images are stored as records in one or more tables in a database.  More
+precisely, the main part of an image header is a record (row) in some table
+in a database.  In general some of the other tables in a database will contain
+auxiliary information describing the image.  Some of these auxiliary tables
+are maintained by IMIO and will be discussed in this section.  Other tables
+will be created by the applications programs used to reduce the image data.
+
+As far as the DBSS is concerned, the pixel segment of an image is a pretty
+minor item, a single array type attribute in the image header.  Since the
+size of this array can vary enormously from one image to the next some
+strategic questions arise concerning where to store the data.  In general,
+small pixel segments will be stored directly in the image header, while large
+pixel segments will be stored in a separate file from that used to store
+the header records.
+
+The major components of an image (as far as IMIO is concerned) are summarized
+below.  More detailed information on each component is given in the following
+sections.
+.ls
+.ls Standard Header Fields
+An image header is a record in a relation initially of type "image".
+The standard header fields include all attributes necessary to describe
+the physical characteristics of the image, i.e., all attributes necessary
+to access the pixels.
+.le
+.ls History
+History records for all images in a database are stored in a separate history
+relation in time sequence.
+.le
+.ls World Coordinates
+An image may have any number of world coordinate systems associated with it.
+These are stored in a separate world coordinate system relation.
+.le
+.ls Histogram
+An image may have any number of histograms associated with it.
+Histograms for all images in a database are stored in a separate histogram
+relation in time sequence.
+.le
+.ls Pixel Segment
+The pixel segment is stored in the image header, at least from the point of
+view of the logical schema.
+.le
+.ls Bad Pixel List
+The bad pixel list, a variable length integer array, is required to physically
+describe the image hence is stored in the image header.
+.le
+.ls Region Mask
+An image may have any number of region masks associated with it.  Region masks
+for all images in a database are stored in a separate mask relation.  A given
+region mask may be associated with any number of different images.
+.le
+.le
+
+
+In summary, the \fBimage header\fR contains the standard header fields,
+the pixels, the bad pixel list, and any user defined fields the user wishes
+to store directly in the header.  All other information describing an image
+is stored in external non-image relations, of which there may be any number.
+Note that the auxiliary tables (world coordinates, histograms, etc.) are not
+considered part of the image header.
+
+.nh 4
+Standard Header Fields
+
+    The standard header fields are those fields required to describe the
+physical attributes of the image, plus those fields required to physically
+access the image pixels.  The standard header fields are summarized below.
+These fields necessarily reflect the current capabilities of IMIO.  Since
+the DBSS provides data independence, however, new fields may be added in
+the future to support future versions of IMIO without rendering old images
+unreadable.
+.ls
+.ls 12 image
+An integer value automatically assigned by IMIO when the image is created
+which uniquely identifies the image within the containing table.  This field
+is used as the primary key in \fIimage\fR type relations.
+.le
+.ls naxis
+Number of axes, i.e., the dimensionality of the image.
+.le
+.ls naxis[1-4]
+A group of 4 attributes, i.e., \fInaxis1\fR through \fInaxis4\fR,
+each specifying the length of the associated image axis in pixels.
+Axis 1 is an image line, 2 is a column, 3 is a band, and so on.
+If \fInaxis\fR is greater than four additional axis length attributes
+are required.  If \fInaxis\fR is less than four the extra fields are
+set to one.  Distinct attributes are used rather than an array so that
+the image dimensions will appear in printed output, to simplify the use
+of the dimension attributes in queries, and to make the image header
+more FITS-like.
+.le
+.ls linelen
+The physical length of axis one (a line of the image) in pixels.  Image lines
+are often aligned on disk block boundaries (stored in an integral number of
+disk blocks) for greater i/o efficiency.  If \fIlinelen\fR is the same as
+\fInaxis1\fR the image is said to be stored in compressed format.
+.le
+.ls pixtype
+A string valued attribute identifying the datatype of the pixels as stored
+on disk.  The possible values of this attribute are discussed in detail below.
+.le
+.ls bitpix
+The number of bits per pixel.
+.le
+.ls pixels
+The pixel segment.
+.le
+.ls nbadpix
+The number of bad pixels in the image.
+.le
+.ls badpix
+The bad pixel list.  This is effectively a boolean image stored in compressed
+form as a variable length integer array.  The bad pixel list is maintained by
+the pixel list package, a subpackage of IMIO, also used to maintain region
+masks.
+.le
+.ls datamin
+The minimum pixel value.  This field is automatically invalidated (set to a
+value greater than \fIdatamax\fR) whenever the image is modified, unless
+explicitly updated by the caller.
+.le
+.ls datamax
+The maximum pixel value.  This field is automatically invalidated (set to a
+value less than \fIdatamin\fR) whenever the image is modified, unless
+explicitly updated by the caller.
+.le
+.ls title
+The image title, a one line character string identifying the image,
+for annotating plots and other forms of output.
+.le
+.le
+
+
+The possible values of the \fIpixtype\fR field are shown below.  The format
+of the value string is "type.host", where \fItype\fR is the logical datatype
+and \fIhost\fR is the host machine encoding used to represent that datatype.
+
+
+.ks
+.nf
+	  TYPE                DESCRIPTION                MAPS TO
+
+	byte.m		unsigned byte ( 8 bits)		short.spp
+	ushort.m	unsigned word (16 bits)		long.spp
+
+	short.m		short integer, signed		short.spp
+	long.m		long integer, signed		long.spp
+	real.m		single precision floating	real.spp
+	double.m	double precision floating	double.spp
+	complex.m	(real,real)			complex.spp
+.fi
+.ke
+
+
+Note that the first character of each keyword is sufficient to uniquely
+identify the datatype.  The ".m" suffix identifies the "machine" to which
+the datatype refers.  When new images are written \fIm\fR will usually be
+the name of the host machine.  When images written on a different machine
+are read on the local host there is no guarantee that the i/o system will
+recognize the formats for the named machine, but at least the format will
+be uniquely defined.  Some possible values for \fIm\fR are shown below.
+
+
+.ks
+.nf
+	dbk		DBK (database kernel) mip-format
+	mip		machine independent (MII integer,
+			    IEEE floating)
+	sun		SUN formats (same as mip?)
+	vax		DEC Vax data formats
+	mvs		DG MV-series data formats
+.fi
+.ke
+
+
+The DBK format is used when the pixels are stored directly in the image header,
+since only the DBK binary formats are supported in DBK binary datafiles.
+The standard i/o system will be support at least the MIP, DBK, SUN (=MIP),
+and VAX formats.  If the storage format is not the host system format
+conversion to and from the corresponding SPP (host) format will occur at the
+level of the FIO interface to avoid an N-squared type conversion matrix in
+IMIO, i.e., IMIO will see only the SPP datatypes.
+
+Examples of possible \fIpixtype\fR values are "short.vax", i.e., a 16 bit signed
+twos-complement byte-swapped integer format, and "real.mip", the 32 bit IEEE
+single precision floating point format.
+
+.nh 4
+History Text
+
+    The intent of the \fIhistory\fR relation is to record all events which
+modify the image data in a dataset, i.e., all operations which create, delete,
+or modify images.  The attributes of the history relation are shown below.
+Records are added to the history table in time sequence.  Each record logically
+contains one line of history text.
+.ls 4
+.ls 12 time
+The date and time of the event.  This value of this field is automatically
+set by IMIO when the history record is inserted.
+.le
+.ls parent
+The name of the parent image in the case of an image creation event,
+or the name of the affected image in the case of an image modification
+event affecting a single image.
+.le
+.ls child
+The name of the child or newly created image in the case of an image creation
+event.  This field is not used if only a single image is involved in an event.
+.le
+.ls event
+The history text, i.e., a one line description of the event.  The suggested
+format is a task or procedure call naming the task or procedure which modified
+the image and listing its arguments.
+.le
+.le
+
+
+.ks
+.nf
+Example:
+
+            TIME         PARENT       CHILD             EVENT
+
+	Sep 23 20:24    nite1[12]       --       imshift (1.5, -3.4)
+	Sep 23 20:30    nite1[10]    nite1[15]
+	Sep 23 20:30    nite1[11]    nite1[15]
+	Sep 23 20:30    nite1[15]       --       nite1[10] - nite1[11]
+.fi
+.ke
+
+
+The principal reason for collecting all history text together in a single
+relation rather than storing it scattered about in string attributes in the
+image headers is to permit use of the DBMS facilities to pose queries on the
+history of the dataset.  Secondary reasons are the completeness of the history
+record thus provided for the dataset as a whole, and increased efficiency,
+both in the amount of storage required and in the time required to record an
+event (in particular, the time required to create a new image).  Note also that
+the history relation may be used to record events affecting dataset objects
+other than images.
+
+The history of any particular image is easily recovered by printing the values
+of the \fItext\fR field of all records with a particular value of the
+\fIimage\fR key.  The parents or children of any image are easily traced
+using the information in the history relation.  The history of the dataset
+as a whole is given by printing all history records in time sequence.
+History information is not lost when intermediate images are deleted unless
+deletes are explicitly performed upon the history relation.
+
+.nh 4
+World Coordinates
+
+    In general, an image may simultaneously have any number of world coordinate
+systems (WCS) associated with it.  It would be quite awkward to try to store an
+arbitrary number of WCS descriptors in the image header, so a separate WCS
+relation is used instead.  If world coordinates are not used no overhead is
+incurred.
+
+Maintenance of the WCS descriptor, transformation of the WCS itself (e.g.,
+when an image changes spatially), and coordinate transformations using the WCS
+are all managed by a dedicated package, also called WCS.  The WCS package
+is a general purpose package usable not only in IMIO but also in GIO and
+other places.  IMIO will be responsible for copying the WCS records for an
+image when a new image is created, as well as for correcting the WCS for the
+effects of subsampling, coordinate flip, etc. when a section of an image is
+mapped.
+
+A general solution to the WCS problem requires that the WCS package support
+both linear and nonlinear coordinate systems.  The problem is further
+complicated by the variable number of dimensions in an image.  In general
+the number of possible types of nonlinear coordinate systems is unlimited.
+Our solution to this difficult problem is as follows.
+.ls 4
+.ls o
+Each image axis is associated with a one or two dimensional mapping function.
+.le
+.ls o
+Each mapping function consists of a general linear transformation followed
+by a general nonlinear transformation.  Either transformation may be unitary
+(may be omitted) if desired.
+.le
+.ls o
+The linear transformation for an axis consists of some combination of a shift,
+scale change, rotation, and axis flip.
+.le
+.ls o
+The nonlinear transformation for an axis consists of a numerical approximation
+to the underlying nonlinear analytic function.  A one dimensional function is
+approximated by a curve x=f(a) and a two dimensional function is approximated
+by a surface x=f(a,b), where X, A, and B may be any of the image axes.
+A choice of approximating functions is provided, e.g., chebyshev or legendre
+polynomial, piecewise cubic spline, or piecewise linear.
+.le
+.ls o
+The polynomial functions will often provide the simplest solution for well
+behaved coordinate transformations.  The piecewise functions (spline and linear)
+may be used to model any slowly varying analytic function represented in
+cartesian coordinates.  The piecewise functions \fIinterpolate\fR the original
+analytic function on a regular grid, approximating the function between grid
+points with a first or third order polynomial.  The approximation may be made
+arbitrarily good by sampling on a finer grid, trading table space for increased
+precision.
+.le
+.ls o
+For many nonlinear functions, especially those defined in terms of the
+transcendental functions, the fitted curve or surface will be quicker to
+evaluate than the original function, i.e., the approximation will be more
+efficient (evaluation of a bicubic spline is not cheap, however, requiring
+computation of a linear combination of sixteen coefficients for each output
+point).
+.le
+.ls o
+The nonlinear transformation will define the mapping from pixel coordinates
+to world coordinates.  The inverse transformation will be computed by numerical
+inversion (iterative search).  This technique may be too inefficient for some
+applications.
+.le
+.le
+
+
+For example, the WCS for a three dimensional image might consist of a bivariate
+Nth order chebyshev polynomial mapping X and Y to RA and DEC via gnomic
+projection, plus a univariate piecewise linear function mapping each discrete
+image band (Z) to a wavelength value.  If the image were subsequently shifted,
+rotated, magnified, block averaged, etc., or sampled via an image section,
+a linear term would be added to the WCS record of each axis affected by the
+transformation.
+
+A WCS is represented by a \fIset\fR of records in the WCS relation.  One record
+is required for each axis mapped by the transformation.  The attributes of the
+WCS relation are described below.  The records forming a given WCS all share
+the same value of the \fIwcs\fR field.
+.ls
+.ls 12 wcs
+The world coordinate system number, a unique integer code assigned by the WCS
+package when the WCS is added to the database.
+.le
+.ls image
+The name of the image with which the WCS is associated.
+If a WCS is to be associated with more
+than one image retrieval must be via the \fIwcs\fR number rather than the
+\fIimage\fR name field.
+.le
+.ls type
+A keyword supplied by the application identifying the type of coordinate
+system defined by the WCS.  This attribute is used in combination with the
+\fIimage\fR attribute for keyword based retrieval in cases where an image
+may have multiple world coordinate systems.
+.le
+.ls axis
+The image axis mapped by the transformation stored in this record.  The X
+axis is number 1, Y is number 2, and so on.
+.le
+.ls axin1
+The first input axis (independent variable in the transformation).
+.le
+.ls axin2
+The second input axis, set to zero in the case of a univariate transformation.
+.le
+.ls axout
+The number of the input axis (1 or 2) to be used for world coordinate output,
+in the case where there is only the linear term but there are two input axes
+(in which case the linear term produces a pair of world coordinate values).
+.le
+.ls linflg
+A flag indicating whether the linear term is present in the transformation.
+.le
+.ls nlnflg
+A flag indicating whether the nonlinear term is present in the transformation.
+.le
+.ls p1,p2
+Linear transformation: origin in pixel space for input axes 1, 2.
+.le
+.ls w1,w2
+Linear transformation: origin in world space for input axes 1, 2.
+.le
+.ls s1,s2
+Linear transformation: Scale factor DW/DP for input axes 1, 2.
+.le
+.ls rot
+Linear transformation: Rotation angle in degrees counterclockwise from the
+X axis.
+.le
+.ls cvdat
+The curve or surface descriptor for the nonlinear term.  The internal format
+of this descriptor is controlled by the relevant math package.
+This is a variable length array of type real.
+.le
+.ls label
+Axis label for plots.
+.le
+.ls format
+Tick label format for plots, e.g., "0.2h" specifies HMS format in a variable
+field width with two decimal places in the seconds field.
+.le
+.le
+
+
+As noted earlier, the full transformation for an axis involves a linear
+transformation followed by a nonlinear transformation.  The linear term
+is defined in terms of the WCS attributes \fIp1, p2\fR, etc. as shown below.
+The variables X and Y are the input values of the axes \fIaxin1\fR and
+\fIaxin2\fR, which need not correspond to the X and Y axes of the image.
+
+
+.ks
+.nf
+	x' = (x - p1) * s1
+	y' = (y - p2) * s2
+
+	x" = x' * cos(rot) + y' * sin(rot)
+	y" = y' * cos(rot) - x' * sin(rot)
+
+	u  = x" + w1
+	v  = y" + w2
+.fi
+.ke
+
+
+The output variables U and V are then used as input to the nonlinear mapping,
+producing the world coordinate value W for the specified image axis \fIaxis\fR
+as output.
+
+	w  = eval (cvdat, u, v)
+
+The mappings for the special cases [1] no linear transformation,
+[2] no nonlinear transformation, and [3] univariate rather than bivariate
+transformation, are easily derived from the full transformation shown above.
+Note that if there is no nonlinear term the linear term produces world
+coordinates as output, otherwise the intermediate values (U,V) are in
+pixel coordinates.  Note also that if there is no nonlinear term but there
+are two input axes (as in the case of a rotation), attribute \fIaxout\fR
+must be set to indicate whether U or V is to be returned as the output world
+coordinate.
+
+.nh 4
+Image Histogram
+
+    Histogram records are stored in a separate histogram relation outside
+the image header.  An image may have any number of histograms associated
+with it, each defined for a different section of the image.  A given image
+section may have multiple associated histogram records differing in time,
+number of sampling bins, etc., although normally recomputation of the
+histogram for a given section will result in a record update rather than an
+insertion.  A subpackage within IMIO is responsible for the computation of
+histogram records.  Histogram records are not propagated when an image is
+copied.  Modifications to an image made subsequent to computation of a
+histogram record may invalidate or obsolete the histogram.
+.ls 4
+.ls 12 image
+The name of the image or image section to which the histogram record
+applies.
+.le
+.ls time
+The date and time when the histogram was computed.
+.le
+.ls z1
+The pixel value associated with the first bin of the histogram.
+.le
+.ls z2
+The pixel value associated with the last bin of the histogram.
+.le
+.ls npix
+The total number of pixels used to compute the histogram.
+.le
+.ls nbins
+The number of bins in the histogram.
+.le
+.ls bins
+The histogram itself, i.e., an array giving the number of pixels in each
+intensity range.
+.le
+.le
+
+
+The histogram limits Z1 and Z2 will normally correspond to the minimum and
+maximum pixel values in the image section to which the histogram applies.
+
+.nh 4
+Bad Pixel List
+
+    The bad pixel list records the positions of all bad pixels in an image.
+A "bad" pixel is a pixel which has an invalid value and which therefore should
+not be used for image analysis.  As far as IMIO is concerned a pixel is either
+good or bad; if an application wishes to assign a fractional weight to
+individual pixels then a second weight image must be associated with the
+data image by the applications program.
+
+Images tend to have few or no bad pixels.  When bad pixels are present they
+are often grouped into bad regions.  This makes it possible to use data
+compression techniques to efficiently represent the set of bad pixels,
+which is conceptually a simple boolean mask image.
+
+The bad pixel list is represented in the image header as a variable length
+integer array (the runtime structure is slightly more complex).
+This integer array consists of a set of lists.  Each list in the set lists
+the bad pixels in a particular image line.  Each linelist consists of a record
+length field and a line number field, followed by the bad pixel list for that
+line.  The bad pixel list is a series of either column numbers or ranges of
+column numbers.  Single columns are represented in the list as positive
+integers; ranges are indicated by a negative second value.
+
+
+.ks
+.nf
+	15   2 512 512
+	 6  23   4   8   15 -18  44
+	 4  72  23 -29   35
+.fi
+.ke
+
+
+An example of a bad pixel list describing a total of 15 bad pixels is shown
+above.  The first line is the pixel list header which records the total list
+length (15 ints), the number of dimensions (2), and the sizes of each dimension
+(512, 512).  There follow a set of variable length line list records.
+Two such lists are shown in the example, one for line 23 and one for line 72.
+On line 23 columns 4, 8, 15 though 18, and 44 are all bad.  Note that each
+linelist contains only a line number since the list is two dimensional;
+in general an N dimensional image requires N-1 subscripts after the record
+length field, starting with the line number and proceeding to higher dimensions
+to the right.
+
+Even though IMIO provides a bad pixel list capability, many applications will
+not want to bother to check for bad pixels.  In general, pointwise image
+operators which produce a new image as output will not need to check for bad
+pixels.  Non-pointwise image operators, e.g., filtering opertors, may or may
+not wish to check for bad pixels (in principle they should use kernel collapse
+to ignore bad pixels).  Analysis programs, i.e., programs which produce
+database records as output rather than create new images, will usually check
+for and ignore bad pixels.
+
+To avoid machine traps when running the pointwise image operators, all bad
+pixels must have reasonable values, even if these values have to be set
+artificially when the data is archived.  IMAGES SHOULD NOT BE ARCHIVED WITH
+MAGIC IN-PLACE VALUES FOR THE BAD PIXELS (as in FITS) since this forces the
+system to conditionally test the value of every pixel when the image is read,
+an unnecessary operation which is quite expensive for large images.
+The simplicity of the reserved value scheme does not warrant such an expense.
+Note that the reverse operation, i.e., flagging the bad pixels by setting
+them to a magic value, can be carried out very efficiently by the reader
+program given a bad pixel list.
+
+For maximum efficiency those operators which have to deal with bad pixels may
+provide two separate data paths internally, one for data which contains no
+bad pixels and one for data containing some bad pixels.  The path to be taken
+would be chosen dynamically as each image line is input, using the bad pixel
+list to determine which lines contain bad pixels.  Alternatively a program
+may elect to have the bad pixels flagged upon input by assignment of a magic
+value.  The two-path approach is the most desirable one for simple operators.
+The magic value approach is often simplest for the more complex applications
+where duplicating the code to provide two data paths would be costly and the
+operation is already so expensive that the conditional test is not important.
+
+All operations and queries on bad pixel lists are via a general pixel list
+package which is used by IMIO for the bad pixel list but which may be used
+for any other type of pixel list as well.  The pixel list package provides
+operators for creating new lists, adding and deleting pixels and ranges of
+pixels from a list, merging lists, and so on.
+
+.nh 4
+Region Mask
+
+    A region mask is a pixel list which defines some subset of the pixels in
+an image.  Region masks are used to define the region or regions of an image
+to be operated upon.  Region masks are stored in a separate mask relation.
+A mask is a type of pixel list and the standard pixel list package is used
+to maintain and access the mask.  Any number of different region masks may be
+associated with an image, and a given region mask may be used in operations
+upon any number of different images.
+.ls 4
+.ls 12 mask
+The mask number, a unique integer code assigned by the pixel list package
+when the mask is added to the database.
+.le
+.ls image
+The image or image section associated with the mask, if any.
+.le
+.ls type
+The logical type of the mask, a keyword supplied by the applications program
+when the mask is created.
+.le
+.ls naxis
+The number of axes in the mask image.
+.le
+.ls naxis[1-4]
+The length of each image axis in pixels.  If \fInaxis\fR is greater than 4
+additional axis length attributes must be provided.
+.le
+.ls npix
+The total number of pixels in the subset defined by the mask.
+.le
+.ls pixels
+The mask itself, a variable length integer array.
+.le
+.le
+
+
+Examples of the use of region masks include specifying the regions to be
+used in a surface fit to a two dimensional image, or specifying the regions
+to be used to correlate two or more images for image registration.
+A variety of utility tasks will be provided in the \fIimages\fR package for
+creating mask images, interactively and otherwise.  For example, it will
+be possible to display an image and use the image cursor to mark the regions
+interactively.
+
+.nh 3
+Group Data
+
+    The group data format associates a set of keyword = value type
+\fBgroup header\fR parameters with a group of images.  All of the images in
+a group should have the same size, number of dimensions, and datatype;
+this is required for images to be in group format even though it is not
+physically required by the database system.  All of the images in a group
+share the parameters in the group header.  In addition, each image in a
+group has its own private set of parameters (attributes), stored in the
+image header for that image.
+
+The images forming a group are stored in the database as a named base table
+of type \fIimage\fR.  The name of the base table must be the same as the name
+of the group.  Each group is stored in a separate table.  The group headers
+for all groups in the database are stored in a separate \fIgroups\fR table.
+The attributes of the \fIgroups\fR relation are described below.
+.ls 4
+.ls 12 group
+The name of the group (\fIimage\fR table) to which this record belongs.
+.le
+.ls keyword
+The name of the group parameter represented by the current record.
+The keyword name should be FITS compatible, i.e., the name must not exceed
+eight characters in length.
+.le
+.ls value
+The value of the group parameter represented by the current record, encoded
+FITS style as a character string not to exceed 20 characters in length.
+.le
+.ls comment
+An optional comment string, not to exceed 49 characters in length.
+.le
+.le
+
+
+Group format is provided primarily for the STScI/SDAS applications, which
+require data to be in group format.  The format is however useful for any
+application which must associate an arbitrary set of \fIglobal\fR parameters
+with a group of images.  Note that the member images in a group may be
+accessed independently like any other IRAF image since each image has a
+standard image header.  The primary physical attributes will be identical
+in all images in the group, but these attributes must still be present in
+each image header.  For the SDAS group format the \fInaxis\fR, \fInaxisN\fR,
+and \fIbitpix\fR parameters are duplicated in the group header.
+
+.nh 3
+Image I/O
+
+    In this section we describe the facilities available for accessing
+image headers and image data.  The discussion will be limited to those
+aspects of IMIO relevant to a discussion of the DBSS.  The image i/o (IMIO)
+interface and the image database interface (IDBI) are existing interfaces
+which are more properly described in detail elsewhere.
+
+.nh 4
+Image Templates
+    
+    Most IRAF image operators are set up to operate on a group of images,
+rather than a single image.  Membership in such a group is determined at
+runtime by a so-called \fIimage template\fR which may select any subset
+of the images in the database, i.e., and subset of images from any subset
+of \fIimage\fR type base tables.  This type of group should not be confused
+with the \fIgroup format\fR discussed in the last section.  The image template
+is normally entered by the user on the command line and is dynamically
+converted into a list of images by expansion of the template on the current
+contents of the database.
+
+Given an image template the IRAF applications program calls an IMIO routine
+to "open" the template.  Successive calls to a get image name routine are made
+to operate upon the individual images in the group.  When all images have been
+processed the template is closed.
+
+The images in a group defined by an image template must exist by definition
+when the template is expanded, hence the named images must either be input
+images or the operation must update or delete the named images.  If an
+output image is to be produced for each input image the user must supply the
+name of the table into which the new images are to be inserted.  This is
+exactly the same type of operation performed by the DBMS operators, and in
+fact most image operators are relational operators, i.e., they take a
+relation as input and produce a new relation as output.  Note that the user
+is required to supply only the name of the output table, not the names of
+the individual images.  The output table may be one of the input tables if
+desired.
+
+An image template is syntactically equivalent to a DBIO record selection
+expression with one exception: each image name may optionally be modified
+by appending an \fIimage section\fR to specify the subset of the pixels in
+the image to be operated upon.  An example of an image section string is
+"[*,100]"; this references column 100 of the associated image.  The image
+section syntax is discussed in detail in the \fICL User's Guide\fR.
+
+Since the image template syntax is nearly identical to the general DBIO record
+selection syntax the reader is referred to the discussion of the latter syntax
+presented in section 4.5.6 for further details.  The new DBIO syntax is largely
+upwards compatible with the image template syntax currently in use.
+
+.nh 4
+Image Pixel Access
+
+    IMIO provides quite sophisticated pixel access facilities which it is
+beyond the scope of the present document to discuss in detail.  Complete
+data independence is provided, i.e., the applications program in general
+need not know the actual dimensionality, size, datatype, or storage mode
+of the image, what format the image is stored in, or even what device or
+machine the image resides on.  This is not to say that the application is
+forbidden from knowing these things, since more efficient i/o is possible
+if there is a match between the logical and physical views of the data.
+
+Pixel access via IMIO is via the FIO interface.  The DBSS is charged with
+management of the pixel storage file (if any) and with setting up the
+FIO interface so that IMIO can access the pixels.  Both buffered and virtual
+memory mapped access is supported; which is actually used is transparent to
+the user.  The types of i/o operations provided are "get", "put", and "update".
+The objects upon which i/o may be performed are image lines, image columns,
+N-dimensional subrasters, and pixel lists.
+
+New in the DBIO based version of IMIO are update mode and column and pixel
+list i/o, plus direct access via virtual memory mapping using the static file
+driver.
+
+.nh 4
+Image Database Interface (IDBI)
+
+    The image database interface is a simple keyword based interface to the
+(non array valued) fields of the standard image header.  The IDBI isolates
+the image oriented applications program from the method used to store the
+header, i.e., programs which access the header via the IDBI don't care whether
+the header is implemented upon DBIO or some other record i/o interface.
+In particular, the IDBI is an existing interface which is \fInot\fR currently
+implemented upon DBIO, but which will be converted to use DBIO when it becomes
+available.  Programs which currently use the IDBI should require few if any
+changes when DBIO is installed.
+
+The philosophy of isolating the applications program using IMIO from the
+underlying interfaces is followed in all the subpackages forming the IMIO
+interface.  Additional IMIO subpackages are provided for appending history
+records, creating and reading histograms, and so on.
+
+.nh 3
+Summary of IMIO Data Structures
+
+    As we have seen, an image is represented as a record in a table in some
+database.  The image record consists of a set of standard fields, a set of
+user defined fields, and the pixel segment, or at least sufficient information
+to locate and access the pixel segment if it is stored externally.
+An image database may contain a number of other tables; these are summarized
+below.
+
+
+.ks
+.nf
+	<images>	Image storage (a set of tables named by the user)
+	groups		Header records for group format data
+	histograms	Histograms of images or image sections
+	history		Image history records
+	masks		Region masks
+	wcs		World coordinate systems
+.fi
+.ke
+
+
+Any number of additional application specific tables may be present in an
+actual database.  The names of the application and user defined tables must
+not conflict with the reserved table names shown above (or with the names of
+the DBIO system tables discussed in the next section).  The pixel segment of
+an image and possibly the image header may be stored in a non-DBSS format
+accessed via the HDBI.  All the other tables are stored in the standard DBSS
+format.
+
+.nh 2
+The DBIO Interface
+.nh 3
+Overview
+
+    The database i/o (DBIO) interface is the interface by which all compiled
+programs directly or indirectly access data maintained by the DBSS.  DBIO is
+primarily a high level record manager interface.  DBIO defines the logical
+structure of a database and directly implements most of the operations
+possible upon the objects in a database.
+
+The major functions of DBIO are to translate a record select/project expression
+into a series of physical record accesses, and to provide the applications
+program with access to the contents of the specified records.  DBIO hides the
+the physical structure and contents of the stored records from the applications
+program; providing data independence is one of the major concerns of DBIO.
+DBIO is not directly concerned with the physical storage of tables and records
+in mass storage, nor with the methods used to physically access such objects.
+The latter operations, i.e., the \fIaccess method\fR, are provided by a database
+kernel (DBK).
+
+We first review the philosophy underlying the design of DBIO, and discuss
+how DBIO differs from most commercial database systems.  Next we describe
+the logical structure of a database and introduce the objects making up a
+database.  The method used to define an actual database is described,
+followed by a description of the methods used to access the contents of a
+database.  Lastly we describe the mapping of a DBIO database into physical
+files.
+
+.nh 3
+Comparision of DBIO and Commercial Databases
+
+    The design of the DBIO interface is based on a thorough study of existing
+database systems (most especially System-R, DB2 and INGRES).  It was clear from
+the beginning that these systems were not ideally suited to our application,
+even if the proprietary and portability issues were ignored.  Eventually the
+differences between these commercial database systems and the system we need
+became clear.  The differences are due to a change in focus and emphasis as
+much as to the obvious differences between scientific and commercial
+applications, and are summarized below.
+.ls 4
+.ls o
+The commercial systems are not sufficiently flexible in the types of data that
+can be stored.  In particular these systems do not in general support variable
+length arrays of arbitrary datatype; most do not support even static arrays.
+Only a few systems allow new attributes to be added to existing tables.
+Most systems talk about domains but few implement them.  We need both array
+storage and the ability to dynamically add new attributes, and it appears that
+domains will be quite useful as well.
+.le
+.ls o
+Most commercial systems emphasize the query language, which forms the basis
+for the host language interface as well as the user interface.  The query
+language is the focus of these systems.  In our case the DBSS is embedded
+within IRAF as one of many subsystems.  While we do need query language
+facilities at the user level, we do not need such sophisticated facilities
+at the DBIO level and would rather do without the attendant complexity and
+overhead.
+.le
+.ls o
+Commercial database systems are designed for use in a multiuser transaction
+processing environment.  Many users may simultaneously be performing update
+and revtrieval operations upon a single centralized database.  The financial
+success of the company may well depend upon the integrity of the database.
+Downtime can be very expensive.
+
+In contrast we anticipate having many independent databases.  These will be
+of two kinds: public and private.  The public databases will virtually always be
+accessed read only and the entire database can be locked for exclusive access
+if it should ever need updating.  Only the private databases are subject to
+heavy updating; concurrent access is required for background jobs but the
+granularity of locking can be fairly coarse.  If a database should become
+corrupted it can be fixed at leisure or even regenerated from scratch without
+causing great hardship.  Concurrency, integrity, and recovery are therefore
+less important for our applications than in a commercial environment.
+.le
+.ls o
+Most commercial database systems (with the exception of the UNIX based INGRES)
+are quite machine, device, and host system dependent.  In our case portability
+of both the software and the data is a primary concern.  The requirement that
+we be able to archive data in a machine independent format and read it on a
+variety of machines seems to be an unusual one.
+.le
+.le
+
+
+In summary, we need a simple interface which provides flexibility in the way
+in which data can be stored, and which supports complex, dynamic data structures
+containing variable length arrays of any datatype and size.  The commercial
+database systems do not provide enough flexibility in the types of data
+structures they can support, nor do they provide enough flexibility in storage
+formats.  On the other hand, the commercial systems provide a more sophisticated
+host language interface than we need.  DBIO should therefore emphasize flexible
+data structures but avoid a complex syntax and all the problems that come with
+such.  Concurrency and integrity are important but are not the major concerns
+they would be in a commercial system.
+
+.nh 3
+Query Language Interface
+
+    We noted in the last section that DBIO should be a simple record manager
+type interface rather than an embedded query language type interface.  This
+approach should yield the simplest interface meeting our primary requirements.
+Nonetheless a host language interface to the query language is possible and
+can be added in the future without compromising the present DBIO interface
+design.
+
+The query language will be implemented as a conventional CL callable task in
+the DBMS package.  Command input to the query language will be interactively
+via the terminal (the usual case), or noninteractively via a string type
+command line argument or via a file.  Any compiled program can send commands
+to the query language (or to any CL task) using the CLIO \fBclcmd\fR procedure.
+Hence a crude but usable HLI query language interface will exist as soon as
+a query language becomes available.  A true high level embedded query language
+interface could be built using the same interface internally, but this should
+be left to some future compiled version of SPP rather than attempted with the
+current preprocessor.  We have no immediate plans to build such an embedded
+query language interface but there is nothing in the current design to hinder
+such a project should it someday prove worthwhile.
+
+.nh 3
+Logical Schema
+
+    In this section we present the logical schema of a DBIO database.
+A DBIO database consists of a set of \fBsystem tables\fR and a set of
+\fBuser tables\fR.  The system tables define the structure of the database
+and its contents; the user tables contain user data.  All tables are instances
+of named \fBrelations\fR or \fBviews\fR.  Relations and views are ordered
+collections of \fBattributes\fR or \fBgroups\fR of attributes.  Each attribute
+is defined upon some particular \fBdomain\fR.  The structure of the objects
+in a database is defined at runtime by processing a specification written in
+the \fBdata definition language\fR.
+
+.nh 4
+Databases
+
+    A DBIO database is a collection of named tables.  All databases include
+a standard set of \fBsystem tables\fR defining the structure and contents
+of the database.  Any number of user or application defined tables may also
+be present in the database.  The most important system table is the database
+\fIcatalog\fR which includes a record describing each user or system table
+in the database.
+
+Conceptually a database is similar to a directory containing files.  The catalog
+corresponds to the directory and the tables correspond to the files.
+A database is however a different type of object; there need be no obvious
+connection between the objects in a database and the physical directories and
+files used to store a database, e.g., several tables might be stored in one
+file, one table might be stored in many files, the tables might be stored on
+a special device and not in files at all, and so on.
+
+In general the mapping of tables into physical objects is hidden from the user
+and is not important.  The only exception to this is the association of a
+database with a specific FIO directory.  The mapping between databases and
+directories is one to one, i.e., a directory may contain only one database,
+and a database is contained in a single directory.  An entire database can
+be physically moved, copied, backed up, or restored by merely performing a
+binary copy of the contents of the directory.  DBIO dynamically generates all
+file names relative to the database directory, hence moving a database to
+a different directory is harmless.
+
+To hide the database directory from the user DBIO supports the concept of a
+\fBcurrent database\fR in much the way that FIO supports the concept of a
+current directory.  Tables are normally referenced by name, e.g., "ptable masks"
+without explicitly naming the database (i.e., directory) in which the table
+resides.  The current database is maintained independently of the current
+directory, allowing the user to change directories without affecting the
+current database.  This is particularly useful when accessing public databases
+(maintained in a write protected directory) or when accessing databases which
+reside on a remote node.  To list the contents of the current database the
+user must type "pcat" rather than "dir".  The current database defaults to
+the current directory until the user explicitly sets the current database
+with the \fBchdb\fR command.
+
+Databases are referred to by the filename of the database directory.
+The IRAF system will provide a "master catalog" of public databases,
+consisting of little more than a set of CL environment definitions assigning
+logical names to the database directories.  Whenever possible logical names
+should be used rather than pathnames to hide the pathname of the database.
+
+.nh 4
+System Tables
+
+    The structure and contents of a DBIO database are described by the same
+table mechanism used to maintain user data.  DBIO automatically maintains
+the system tables, which are normally protected from writing by the user
+(the system tables can be manually updated like any other table in a desperate
+situation).  Since the system tables are ordinary tables, they can be
+inspected, queried, etc., using the same utilities used to access the user
+data tables.  The system tables are summarized below.
+.ls 4
+.ls 12 syscat
+The database catalog.
+Contains an entry (record) for every table or view in the database.
+.le
+.ls sysatt
+The attribute list table.
+Contains an entry for every attribute in every table in the database.
+.le
+.ls sysddt
+The domain descriptor table.
+Contains an entry for every defined domain in the database.  Any number of
+attributes may share the same domain.
+.le
+.ls sysidt
+The index descriptor table.
+Contains an entry for every primary or secondary index in the database.
+.le
+.le
+
+
+The system tables are visible to the user, i.e., they appear in the database
+catalog.  Like the user tables, the system tables are themselves described by
+entries in the database catalog, attribute list table, and domain descriptor
+table.
+
+.nh 4
+The System Catalog
+
+    The \fBsystem catalog\fR is effectively a "table of contents" for the
+database.  The fields of the catalog relation \fBsyscat\fR are as follows.
+.ls 4
+.ls 12 table
+The name of the user or system table described by the current record.
+Table names may contain any combination of the alphanumeric characters,
+underscore, or period and must not exceed 32 characters in length.
+.le
+.ls relid
+The table identifier.  A unique integer code by which the table is referred
+to internally.
+.le
+.ls type
+Identifies the type of table, e.g., base table or view.
+.le
+.ls ncols
+The number of columns (attributes) in the table.
+.le
+.ls nrows
+The number of rows (records, tuples) in the table.
+.le
+.ls rsize
+The size of a record in bytes, not including array storage.
+.le
+.ls tsize
+An estimate of the total number of bytes of storage currently in use by the
+table, including array storage.
+.le
+.ls ctime
+The date and time when the table was created.
+.le
+.ls mtime
+The date and time when the table was last modified.
+.le
+.ls flags
+A small integer containing flag bits used internally by DBIO.
+These include the protection bits for the table.  Initially only write
+protection and delete protection will be supported (for everyone).
+Additional protections are of course provided by the file system.
+A flag bit is also used to indicate that the table has one or more
+indexes, to avoid an unnecessary search of the \fBsysidx\fR table when
+accessing an unindexed table.
+.le
+.le
+
+
+Only a subset of these fields will be of interest to the user in ordinary
+catalog listings.  The \fBpcatalog\fR task will by default print only the
+most interesting fields.  Any of the other DBMS output tasks may be used
+to inspect the catalog in detail.
+
+.nh 4
+Relations
+
+    A \fBrelation\fR is an ordered set of named attributes, each of which is
+defined upon some specific domain.  A \fBbase table\fR is a named instance
+of some relation.  A base table is a real object like a file; a base table
+appears in the catalog and consumes storage on disk.  The term "table" is
+more general, and is normally used to refer to any object which can be
+accessed like a base table.
+
+A DBIO relation is defined by a set of records describing the attributes
+of the relation.  The attribute lists of all relations are stored in the
+\fBsysatt\fR table, described in the next section.
+
+.nh 4
+Attributes
+
+    An \fBattribute\fR of a relation is a datum which describes some aspect
+of the object described by the relation.  Each attribute is defined by a
+record in the \fBsysatt\fR table, the fields of which are described below.
+The attribute descriptor table, while visible to the user if they wish to
+examine the structure of the database in detail, is primarily an internal
+table used by DBIO to define the structure of a record.
+.ls 4
+.ls 12 name
+The name of the attribute described by the current record.
+Attribute names may contain any combination of the alphanumeric characters
+or underscore and must not exceed 16 characters in length.
+.le
+.ls attid
+The attribute identifier.  A unique integer code by which the attribute is
+referred to internally.  The \fIattid\fR is unique within the relation to
+which the attribute belongs, and defines the ordering of attributes within
+the relation.
+.le
+.ls relid
+The relation identifier of the table to which this attribute belongs.
+.le
+.ls domid
+The domain identifier of the domain to which this attribute belongs.
+.le
+.ls dtype
+A single character identifying the atomic datatype of this attribute.
+Note that domain information is not used for most runtime record accesses.
+.le
+.ls prec
+The precision of the atomic datatype of this attribute, i.e., the number
+of bytes of storage per element.
+.le
+.ls count
+The number of elements of type \fIdtype\fR in the attribute.  If this value
+is one the attribute is a scalar.  Zero implies a variable length array
+and N denotes a static array of N elements.
+.le
+.ls offset
+The offset of the field in bytes from the start of the record.
+.le
+.ls width
+The width of the field in bytes.  All fields occupy a fixed amount of space
+in a record.  In the case of variable length arrays fields \fBoffset\fR and
+\fBwidth\fR refer to the array descriptor.
+.le
+.le
+
+
+In summary, the attribute list defines the physical structure of a record
+as stored in mass storage.  DBIO is responsible for encoding and decoding
+records as well as for all access to the fields of records.  A record is
+encoded as a byte stream in a machine independent format.  The physical
+representation of a record is discussed further in a later section describing
+the DBIO storage structures.
+
+.nh 4
+Domains
+
+    A domain is a restricted implementation of an abstract datatype.
+Simple examples are the atomic datatypes char, integer, real, etc.; no doubt
+these will be the most commonly used domains.  A more interesting example is
+the \fItime\fR domain.  Times are stored in DBIO as attributes defined upon
+the \fItime\fR domain.  The atomic datatype of a time attribute is a four byte
+integer; the value is the long integer value returned by the IRAF system
+procedure \fBclktime\fR.  Integer time values are convenient for time domain
+arithmetic, but are not good for printed output.  The definition of the
+\fItime\fR domain therefore includes a specification for the output format
+which will cause time attributes to be printed as a formatted date/time string.
+
+Domains are used to verify input and to format output, hence there is no
+domain related overhead during record retrieval.  The only exception to
+this rule occurs when returning the value of an uninitialized attribute,
+in which case the default value must be fetched from the domain descriptor.
+
+Domains may be defined either globally for the entire database or locally for
+a specific table.  Attributes in any table may be defined upon a global domain.
+The system table \fBsysddt\fR defines all global and local domains.
+The attributes of this table are outlined below.
+.ls 4
+.ls 12 name
+The name of the domain described by the current record.
+Domain names may contain any combination of the alphanumeric characters
+or underscore and must not exceed 16 characters in length.
+.le
+.ls domid
+The domain identifier.  A unique integer code by which the domain is referred
+to internally.  The \fIdomid\fR is unique within the table for which the domain
+is defined.
+.le
+.ls relid
+The relation identifier of the table to which this domain belongs.
+This is set to zero if the domain is defined globally.
+.le
+.ls grpid
+The group identifier of the group to which this domain belongs.
+This is set to zero if the domain does not belong to a special group.
+A negative value indicates that the named domain is itself a group
+(groups are discussed in the next section).
+.le
+.ls dtype
+A single character identifying the atomic datatype upon which the domain
+is defined.
+.le
+.ls prec
+The precision of the atomic datatype of this domain, i.e., the number
+of bytes of storage per element.
+.le
+.ls defval
+The default value for attributes defined upon this domain (a byte string of
+length \fIprec\fR bytes).  If no default value is specified DBIO will assume
+that null values are not permitted for attributes defined upon this domain.
+.le
+.ls minval
+The minimum value permitted.  This attribute is used only for integer or real
+valued domains.
+.le
+.ls maxval
+The maximum value permitted.  This attribute is used only for integer or real
+valued domains.
+.le
+.ls enumval
+If the domain is string valued with a fixed number of permissible value strings,
+the legal values may be enumerated in this string valued field.
+.le
+.ls units
+The units label for attributes defined upon this domain.
+.le
+.ls format
+The default output format for printed output.  All SPP formats are supported
+(e.g., including HMS, HM, octal, etc.) plus some special DBMS formats, e.g.,
+the time format.
+.le
+.ls width
+The field width in characters for printed output.
+.le
+.le
+
+
+Note that the \fIunits\fR and \fIformat\fR fields and the four "*val" fields
+are stored as variable length character arrays, hence there is no fixed limit
+on the sizes of these strings.  Use of a variable length field also minimizes
+storage requirements and makes it easy to test for an uninitialized value.
+Only fixed length string fields and scalar valued numeric fields may be used
+in indexes and selection predicates, however.
+
+A number of global domains are predefined by DBIO.  These are summarized
+in the table below.
+
+
+.ks
+.nf
+	NAME	DTYPE	PREC	DEFVAL
+
+	byte	  u	 1	  0
+	char	  c	arb	nullstr
+	short	  i	 2	INDEFS
+	int	  i	 4	INDEFI
+	long	  i	 4	INDEFL
+	real	  r	 4	INDEFR
+	double    r	 8	INDEFD
+	time      i	 4	  0
+.fi
+.ke
+
+
+The predefined global domains, as well as all user defined domains, are defined
+in terms of the four DBK variable precision atomic datatypes.  These are the
+following:
+
+
+.ks
+.nf
+	NAME	DTYPE	PREC	  DESCRIPTION
+
+	char	  c	>=1	character
+	uint	  u	1-4	unsigned integer
+	int	  i	1-4	signed integer
+	real	  r	2-8	floating point
+.fi
+.ke
+
+
+DBIO stores records with the field values encoded in the machine independent
+variable precision DBK data format.  The precision of an atomic datatype is
+specified by an integer N, the number of bytes of storage to be reserved for
+the value.  The permissible precisions for each DBK datatype are shown in
+the preceding table.  The actual encoding used is designed to simplify the
+semantics of the DBK and is not any standard format.  The DBK binary encoding
+will be described in a later section.
+
+.nh 4
+Groups
+
+    A \fBgroup\fR is a logical grouping of several related attributes.
+A group is much like a relation except that a group is a type of domain
+and may be used as such to define the attributes of relations.  Since groups
+are similar to relations groups are defined in the \fBsysatt\fR table
+(groups do not however appear in the system catalog).  Each member of a
+group is an attribute defined upon some domain; nesting of groups is permitted.
+
+Groups are expanded when a relation is defined, hence the runtime system
+need not be aware of groups.  Expansion of a group produces a set of ordinary
+attributes wherein each attribute name consists of the group name glued
+to the member name with a period, e.g., the resolved attributes "cv.ncoeff"
+and "cv.type" are the result of expansion of a two-member group attribute
+named "cv".
+
+The main purposes of the group construct are to simplify data definition and
+to give the forms generator additional information for structuring formatted
+output.  Groups provide a simple capability for structuring data within a table.
+Whenever the same grouping of attributes occurs in several tables the group
+mechanism should be used to ensure that all instances of the group are
+defined equivalently.
+
+.nh 4
+Views
+
+    A \fBview\fR is a virtual table defined in terms of one or more base
+tables or other views via a record select/project expression.  Views provide
+different ways of looking at the same data; the view mechanism can be very
+useful when working with large, complex base tables (it saves typing).
+Views allow the user to focus on just the data that interests them and ignore
+the rest.  The view mechansism also significantly increases the amount of data
+independence provided by DBIO, since a base table can be made to look
+differently to different applications programs without physically modifying
+the table or producing several copies of the same table.  This capability can
+be invaluable when the tables involved are very large or cannot be modified
+for some reason.
+
+A view provides a "window" into one or more base tables.  The window is
+dynamic in the sense that changes to the underlying base tables are immediately
+visible through the window.  This is because a view does not contain any data
+itself, but is rather a \fIdefinition\fR via record selection and projection
+of a new table in terms of existing tables.  For example, consider the
+following imaginary select/project expression (SPE):
+
+	data1 [x >= 10 and x <= 20] % obj, x, y
+
+This defines a new table with attributes \fIobj\fR, \fIx\fR, and \fIy\fR
+consisting of all records of table \fIdata1\fR for which X is in the range
+10 to 20.  We could use the SPE shown to copy the named fields of the
+selected records to produce a new base table, e.g. \fId1x\fR.
+The view mechanism allows us to define table \fId1x\fR as a view-table,
+storing only the SPE shown.  When the view-table \fId1x\fR is subsequently
+queried DBIO will \fImerge\fR the SPE supplied in the new query with that
+stored in the view, returning only records which satisfy both selection
+expressions.  This works because the output of an SPE is a table and can
+therefore be used as input to another SPE, i.e., two or more selection
+expressions can be combined to form a more complex expression.
+
+A view appears to the user (or to a program) as a table, behaving equivalently
+to a base table in most operations.  View-tables appear in the catalog and
+can be created and deleted much like ordinary tables.
+
+.nh 4
+Null Values
+
+    Null valued attributes are possible in any database system; they are
+guaranteed to occur when the system permits new attributes to be dynamically
+added to existing, nonempty base tables.  DBIO deals with null values by
+the default value mechanism mentioned earlier in the discussion of domains.
+When the value of an uninitialized attribute is referenced DBIO automatically
+supplies the user specified default value of the attribute.  The defaulting
+mechanism supports three cases; these are summarized below.
+.ls 4
+.ls o
+If null values are not permitted for the referenced attribute DBIO will
+return an error condition.  This case is indicated by the absence of a
+default value.
+.le
+.ls o
+Indefinite (or any special value) may be returned as the default value if
+desired, allowing the calling program to test for a null value.
+.le
+.ls o
+A valid default value may be returned, with no checking for null values
+occurring in the calling program.
+.le
+.le
+
+
+Testing for null values in predicates is possible only if the default value
+is something recognizable like INDEF, and is handled by the conventional
+equality operator.  Indefinites are propagated in expressions by the usual
+rules, i.e., the result of any arithmetic expression containing an indefinite
+is indefinite, order comparison where an operand is indefinite is illegal,
+and equality or inequality comparison is legal and is well defined.
+
+.nh 3
+Data Definition Language
+
+    The data definition language (DDL) is used to define the objects in a
+database, e.g., during table creation.  The function of the DBIO table
+creation procedure is to add tuples to the system tables to define a new
+table and all attributes, groups, and domains used in the table.  The data
+definition tuples can come from either of two sources: [1] they can be
+copied in compiled form from an existing table, or [2] they can be
+generated by compilation of a DDL source specification.
+
+In appearance DDL looks much like a series of structure declarations such
+as one finds in most modern compiled languages.  DDL text may be entered
+either via a string buffer in the argument list (no file access required)
+or via a text file named in the argument list to the table creation procedure.
+
+The DDL syntax has not yet been defined.  An example of what a DDL declaration
+for the IMIO \fImasks\fR relation might look like is shown below.  The syntax
+shown is a generalization of the SPP+ syntax for a structure declaration with
+a touch of the CL thrown in.  If a relation is defined only in terms of the
+predefined domains or atomic datatypes and has no primary key, etc., then the
+declaration would look very much like an SPP+ (or C) structure declaration.
+
+
+.ks
+.nf
+	relation masks {
+		u2	mask	{ width=6 }
+		c64	image	{ defval="", format="%20.20s", width=21 }
+		c15	type	{ defval="generic" }
+		byte	naxis
+		long	naxis1, naxis2, naxis3, naxis4
+		long	npix
+		i2	pixels[]
+	} where {
+		key	= mask+image+type
+		comment	= "image region masks"
+	}
+.fi
+.ke
+
+
+The declaration shown identifies the primary key for the relation and gives
+a comment describing the relation, then declares the attributes of the
+relation.  In this example all domains are either local and are declared
+implicitly, or they are global and are predefined.  For example, DBIO will
+automatically create a domain named "type" belonging to the relation "masks"
+for the attribute named "type".  DBIO is assumed to provide default values
+for the attributes of each domain (e.g., "format", "width", etc.) not
+specified explicitly in the declaration.  It should be possible to keep
+the DDL syntax simple enough that a LALR parser does not have to be used,
+reducing text memory requirements and the time required to process the DDL,
+and improving error diagnostics.
+
+.nh 3
+Record Select/Project Expressions
+
+    Most programs using DBIO will be relational operators, taking a table
+as input, performing some operation or transformation upon the table, and
+either updating the table or producing a new table as output.  DBIO record
+select/project expressions (SPE) are used to define the input table.
+By using an SPE one can define the input table to be any subset of the
+fields (projection) of any subset of the records (selection) of any set of
+base tables or views (set union).
+
+The general form of a select/project expression is shown below.  The syntax
+is patterned after the algebraic languages and even happens to be upward
+compatible with the existing IMIO image template syntax.
+
+
+.ks
+.nf
+	tables [pred] [upred] % fields
+
+where
+
+	tables		Is a comma delimited list of tables.
+
+	,		Is the set union operator (in the tables and
+			    fields lists).
+
+	[		Is the selection operator.
+
+	pred		Is a predicate, i.e., a boolean condition.
+			    The simplest predicate is a constant or
+			    list of constants, specifying a set of
+			    possible values for the primary key.
+
+	upred		Is a user predicate, passed back to the
+			    calling program appended to the record
+			    name but not used by DBIO.  This feature
+			    is used to implement image sections.
+
+	%		Is the projection operator.
+
+	fields		Is a comma delimited list of \fIexpressions\fR
+			    defined upon the attributes of the input
+			    relation, defining the attributes of the
+			    output relation.
+.fi
+.ke
+
+
+All components of an SPE are optional except \fItables\fR; the simplest
+SPE is the name of a single table.  Some simple examples follow.
+
+.nh 4
+Examples
+
+    Print all fields of table \fInite1\fR.  The table \fInite1\fR is an image
+table containing several images with primary keys 1, 2, 3, and so on.
+
+	cl> ptable nite1
+
+Print selected fields of table \fInite1\fR.
+
+	cl> ptable nite1%image,title
+
+Plot line 200 of image 2 in table \fInite1\fR.
+
+	cl> graph nite1[2][*,200]
+
+Print image statistics on the indicated images in table \fInite1\fR.
+The example shows a predicate specifying images 1, 3, and 5 through 12,
+not an image section.
+
+	cl> imstat nite1[1,3,5:12]
+
+Print the names and number of bad pixels in tables \fInite1\fR and \fIm87\fR
+for all images that have any bad pixels.
+
+	cl> ptable "nite1,m87 [nbadpix > 0] % image, nbadpix"
+
+
+The tables in an SPE may be general select/project expressions, not just the
+names of base tables or views as in the examples.  In other words, SPEs
+may be nested, using parenthesis around the inner SPE if necessary to indicate
+the order of evaluation.  As noted earlier in the discussion of views,
+the ability of SPEs to nest is used to implement views.  Nesting may also
+be used to perform selection or projection upon the individual input tables.
+For example, the SPE used in the following command specifies the union of
+selected records from tables \fInite1\fR and \fInite2\fR.
+
+	cl> imstat nite1[1,8,21:23],nite2[9]
+
+.nh 3
+Operators
diff --git a/sys/dbio/new/dbio.hlp.1 b/sys/dbio/new/dbio.hlp.1
new file mode 100644
index 00000000..202b4488
--- /dev/null
+++ b/sys/dbio/new/dbio.hlp.1
@@ -0,0 +1,346 @@
+.help dbio Jul85 "Database I/O Design"
+.ce
+\fBIRAF Database I/O\fR
+.ce
+Conceptual Design
+.ce
+Doug Tody
+.ce
+July 1985
+.sp 3
+.nh
+Introduction
+    The DBIO (database i/o) interface is a library of SPP callable procedures
+used to access data structures maintained in mass storage.  While DBIO is at
+the heart of the IRAF database subsystem, it is only a part of that subsystem.
+Other major components of the database subsystem include the IMIO interface
+(image i/o), a higher level interface used to access bulk data maintained
+in part under DBIO, and the DBMS package (data base management system), a CL
+level package providing the user with direct access to any database maintained
+under DBIO.  Additional structure is found beneath DBIO; this is for the most
+part invisible to both the programmer and the user but is of fundamental
+importance to the design, as we shall see later.
+.ks
+.nf
+                   DBMS                               (cl)
+                     \                              ---------
+                      \     IMIO                     
+                       \    /  \       
+                        \  /    \                                  
+                         \/      \                    (vos)
+                        DBIO     FIO
+                         |
+                         |                          ---------
+                         |
+                    (DB kernel)                    (vos or host)    
+.fi
+.ce
+Figure 1.  Major Interfaces
+.ke
+                       
+.nh
+Requirements
+    The requirements for the DBIO interface are driven by its intended usage
+for image and catalog storage.  It is arguable whether the same interface
+should be used for both types of data, but development of an interface such
+as DBIO with all the associated DBMS utilities is expensive, hence we would
+prefer to have to develop only one such interface.  Furthermore, it is desirable
+for the user to only have to learn one such interface.  The primary functional
+and performance requirements which DBIO must meet are the following (in no
+particular order).
+.ls
+.ls [1]
+DBIO shall provide a high degree of data independence, i.e., a program
+shall be able to access a data structure maintained under DBIO without
+detailed knowledge of its contents.
+.le
+.ls [2]
+A DBIO datafile shall be self describing and self contained, i.e., it shall
+be possible to examine the structure and contents of a DBIO datafile without
+prior knowledge of its structure or contents.
+.le
+.ls [3]
+DBIO shall be able to deal efficiently with records containing up to N fields
+and with data groups containing up to M records, where N and M are at least
+sysgen configurable and are order of magnitude N=10**2 and M=10**6.
+.le
+.ls [4]
+The time required to access an image header under DBIO must be comparable
+to the time currently required for the equivalent operation under IMIO.
+.le
+.ls [5]
+It shall be possible for an image header maintained under DBIO to contain
+application or user defined fields in addition to the standard fields
+required by IMIO.
+.le
+.ls [6]
+It shall be possible to dynamically add new fields to an existing image header
+(or to any DBIO record).
+.le
+.ls [7]
+It shall be possible to group similar records together in the database
+and to perform global operations upon all or part of the records in a
+group.
+.le
+.ls [8]
+It shall be possible for a field of a record to be a one-dimensional array
+of any of the primitive types.
+.le
+.ls [9]
+Variant records (records containing variable size fields) shall be supported,
+ideally without penalizing efficient access to databases which do not contain
+such records.
+.le
+.ls [A]
+It shall be possible to copy a record without knowledge of its contents.
+.le
+.ls [B]
+It shall be possible to merge (join) two records containing disjoint sets of
+fields.
+.le
+.ls [C]
+It shall be possible to update a record in place.
+.le
+.ls [D]
+It shall be possible to simultaneously access (retrieve, update, or insert)
+multiple records from the same data group.
+.le
+.le
+To summarize, the primary requirements are data independence, efficient access
+to both large and small databases, and flexibility in the contents of the
+database.
+.nh
+Conceptual Design
+    
+    The DBIO database faciltities shall be based upon the relational model.
+The relational model is preferred due to its simplicity (to the user)
+and due to the demonstrable fact that relational databases can efficiently
+handle large amounts of data.  In the relational model the database appears
+to be nothing more than a set of \fBtables\fR, with no builtin connections
+between separate tables.  The operations defined upon these tables are based
+upon the relational algebra, which is in turn based upon set theory.
+The major advantages claimed for relational databases are the simplicity
+of the concept of a database as a collection of tables, and the predictability
+of the relational operators due to their being based on a formal theoretical
+model.
+None of the requirements listed in section 2 state that DBIO must implement
+a relational database.  Most of our needs can be met by structuring our data
+according to the relational data model (i.e., as tables), and providing a
+good \fBselect\fR operator for retrieving records from the database.  If a
+semirelational database is sufficient to meet our requirements then most
+likely that is what will be built (at least initially; the relational operators
+are very attractive for data analysis).  DBIO is not expected to be competitive
+with any commercial relational database; to try to make it so would probably
+compromise the requirement that the interface be compact.
+On the other hand, the database requirements of IRAF are similar enough to
+those addressed by commercial databases that we would be foolish not to try
+to make use of some of the same technology.
+.ks
+.nf
+	\fBformal relational term\fR		    \fBinformal equivalents\fR
+		relation			table
+		tuple				record, row
+		attribute			field, column
+		domain				datatype
+		primary key			record id
+.fi
+.ke
+A DBIO \fBdatabase\fR shall consist of one or more \fBrelations\fR (tables).
+Each relation shall contain zero or more \fBrecords\fR (rows of the table).
+Each record shall contain one or more \fBfields\fR (columns of the table).
+All records in a relation shall share the same set of fields,
+but all of the fields in a record need not have been assigned values.
+When a new \fBattribute\fR (column) is added to an existing relation a default
+valued field is added to each current and future record in the relation.
+Each attribute is defined upon a particular \fBdomain\fR, e.g., the set of
+all nonnegative integer values less than or equal to 100.  It shall be possible 
+to specify minimum and maximum values for integer and real attributes
+and to enumerate the permissible values of a string type attribute.
+It shall be possible to specify a default value for an attribute.
+If no default value is given INDEF is assumed.
+One dimensional arrays shall be supported as attribute types; these will be
+treated as atomic datatypes by the relational operators.  Array valued
+attributes shall be either fixed in size (the most efficient form) or variant.
+There need be no special character string datatype since one dimensional
+arrays of type character are supported.
+Each relation shall be implemented as a separate file.  If the relations
+comprising a database are stored in a directory then the directory can
+be thought of as the database.  Public databases will be stored in well
+known public (write protected) directories, private databases in user
+directories.  The logical directory name of each public database will be
+the name of the database.  Physical storage for a database need not necessarily
+be allocated locally, i.e., a database may be centrally located and remotely
+accessed if the host computer is part of a local area network.
+Locking shall be at the level of entire relations rather than at the record
+level, at least in the initial implementation.  There shall be no support for
+indices in the initial implementation except possibly for the primary key.
+It should be possible to add either or both of these features to a future
+implementation without changing the basic DBIO interface.  Modifications to
+the internal data structures used in database files will likely be necessary
+when adding such a major feature, making a save and restore operation
+necessary for each database file to convert it to the new format.
+The save format chosen (e.g. FITS table) should be independent of the
+internal format used at a particular time on a particular host machine.
+Images shall be stored in the database as individual records.
+All image records shall share a common subset of attributes.  
+Related images (image records) may be grouped together to form relations.
+The IRAF image operators shall support operations upon relations
+(sets of images) much as the IRAF file operators support operations upon
+sets of files.
+A unary image operator shall take as input a relation (set of one or more
+images), inserting the processed images into the output relation.  
+A binary image operator shall take as input either two relations or a
+relation and a record, inserting the processed images into the output
+relation.  In all cases the output relation can be an input relation as
+well.  The input relation will be defined either by a list or by selection
+using a theta-join (operationally similar to a filename template).
+.nh 2
+Relational Operators
+    DBIO shall support two basic types of database operations: operations upon
+relations and operations upon records.  The basic relational operators
+are the following.  All of these operators produce as output a new relation.
+.ls
+.ls create
+Create a new base relation (physical relation as stored on disk) by specifying
+an initial set of attributes and the (file)name for the new relation.
+Attributes and domains may be specified via a data definition file or by
+reference to an existing relation.
+A primary key (limited to a single attribute) should be identified.
+The new relation initially contains no records.
+.le
+.ls drop
+Delete a (possibly nonempty) base relation and any associated indices.
+.le
+.ls alter 
+Add a new attribute or attributes to an existing base relation.
+Attributes may be specified explicitly or by reference to another relation.
+.le
+.ls select
+Create a new relation by selecting records from one or more existing base
+relations.  Input consists of an algebraic expression defining the output
+relation in terms of the input relations (usage will be similar to filename
+templates).  The output relation need not have the same set of attributes as
+the input relations.  The \fIselect\fR operator shall ultimately implement
+all the basic operations of the relational algebra, i.e., select, project,
+join, and the set operations.  At a minimum, selection and projection are
+required in the initial interface.  The output of \fBselect\fR is not a
+named relation (base relation), but is instead intended to be accessed
+by the record level operators discussed in the next section.
+.le
+.ls edit
+Edit a relation.  An interactive screen editor is entered allowing the user
+to add, delete, or modify tuples (not required in the initial version of
+the interface).  Field values are verified upon input.
+.le
+.ls sort
+Make the storage order of the records in a relation agree with the order
+defined by the primary key (the index associated with the primary key is
+always sorted but index order need not agree with storage order).
+In general, retrieval on a sorted relation is more efficient than on an
+unsorted relation.  Sorting also eliminates deadspace left by record
+deletion or by updates involving variant records.
+.le
+.le
+Additional nonalgebraic operators are required for examining the structure
+and contents of relations, returning the number of records or attributes in
+a relation, and determining whether a given relation exists.
+The \fIselect\fR operator is the primary user interface to DBIO.
+Since most of the relational power of DBIO is bound up in the \fIselect\fR
+operator and since \fIselect\fR will be driven by an algebraic expression
+(character string) there is considerable scope for future enhancement
+of DBIO without affecting existing code.
+.nh 2
+Record (Tuple) Level Operators
+    While the user should see primarily operations on entire relations,
+record level processing is necessary at the program level to permit
+data entry and implementation of special operators.  The basic record
+level operators are the following.
+.ls
+.ls retrieve
+Retrieve the next record from the relation defined by \fBselect\fR.
+While the tuples in a relation theoretically form an unordered set,
+tuples will normally be returned in either storage order or in the sort
+order of the primary key.  Although all fields of a retrieved record are
+accessible, an application will typically have knowledge of only a few fields.
+.le
+.ls update
+Rewrite the (possibly modified) current record.  The updated record is
+written back into the base table from which it was read.  Not all records
+produced by \fBselect\fR can be updated.
+.le
+.ls insert
+Insert a new record into an output relation.  The output relation may be an
+input relation as well.  Records added to an output relation which is also
+an input relation do not become candidates for selection until another
+\fBselect\fR occurs.  A retrieve followed by an insert copies a record without
+knowledge of its contents.  A retrieve followed by modification of selected
+fields followed by an insert copies all unmodified fields of the record.
+The attributes of the input and output relations need not match; unmatched
+output attributes take on their default values and unmatched input attributes
+are discarded.  \fBInsert\fR returns a pointer to the output record,
+allowing insertions of null records to be followed by initialization of
+the fields of the new record.
+.le
+.ls delete
+Delete the current record.
+.le
+.le
+Additional operators are required to close or open a relation for record
+level access and to count the number of records in a relation.
+.nh 3
+Constructing Special Relational Operators
+    The record level operations may be combined with \fBselect\fR in compiled
+programs to implement arbitrary operations upon entire relations.
+The basic scenario is as follows:
+.ls
+.ls [1]
+The set of records to be operated upon, defined by the \fBselect\fR
+operator, is opened as an unordered set (list) of records to be processed.
+.le
+.ls [2]
+The "next" record in the relation is accessed with \fBretrieve\fR.
+.le
+.ls [3]
+The application reads or modifies a subset of the fields of the record,
+updating modified records or inserting the record in the output relation.
+.le
+.ls [4]
+Steps [2] and [3] are repeated until the entire relation has been processed.
+.le
+.le
+Examples of such operators are conversion to and from DBIO and LIST file
+formats, column extraction, mimimum or maximum of an attribute (domain
+algebra), and all of the DBMS and IMAGES operators.
+.nh 2
+Field (Attribute) Level Operators
+    Substantial processing of the contents of a database is possible without
+ever accessing the individual fields of a record.  If field level access is
+required the record must first be retrieved or inserted.  Field level access
+requires knowledge of the names of the attributes of the parent relation,
+but not their exact datatypes.  Automatic type conversion occurs when field
+values are queried or set.
+.ls
+.ls get
+.sp
+Get the value of the named scalar or vector field (typed).
+.le
+.ls put
+.sp
+Put the value of the named scalar or vector field (typed).
+.le
+.ls read
+Read the named fields into an SPP data structure, given the name, datatype,
+and length (if vector) of each field in the output structure.
+There must be an attribute in the parent relation for each field in the
+output structure.
+.le
+.ls write
+Copy an SPP data structure into the named fields of a record, given the
+name, datatype, and length (if vector) of each field in the input structure.
+There must be an attribute in the parent relation for each field in the
+input structure.
+.le
+.ls access
+Determine whether a relation has the named attribute.
+.le
+.le
diff --git a/sys/dbio/new/dbki.hlp b/sys/dbio/new/dbki.hlp
new file mode 100644
index 00000000..a825f6ef
--- /dev/null
+++ b/sys/dbio/new/dbki.hlp
diff --git a/sys/dbio/new/ddl b/sys/dbio/new/ddl
new file mode 100644
index 00000000..8c1256b7
--- /dev/null
+++ b/sys/dbio/new/ddl
@@ -0,0 +1,125 @@
+1. Data Definition Language
+
+	Used to define relations and domains.
+	Table driven.
+
+
+1.1 Domains
+
+    Domains are used to save storage, format output, and verify input, as well
+as to document the structure of a database.  DBIO does not use domain
+information to verify the legality of predicates.
+
+
+	attributes of a domain:
+
+		name		domain name
+		type		atomic type
+		default		default value (none, indef, actual)
+		minimum		minimum value permitted
+		maximum		maximum value permitted
+		enumval		list of legal values
+		units		units label
+		format		default output format
+
+
+	predefined (atomic) domains:
+
+		bool
+		byte*N
+		char*N
+		int*N
+		real*N
+
+The precision of an atomic domain is specified by N, the number of bytes of
+storage to be reserved for the value.  N may be any integer value greater
+than or equal to N=1 for byte, char, and int, or N=2 for real.  The byte
+datatype is an unsigned (positive) integer.  The floating point datatype
+has a one byte (8 bit) base 2 exponent.  For example, char*1 is a signed
+byte, byte*2 is an unsigned 16 bit integer, and real*2 is a 16 bit floating
+point number.
+
+
+1.2 Groups
+
+    A group is an aggregate of two or more domains or other groups.  Groups
+as well as domains may be used to define the attributes of a relation.
+Repeating groups, i.e., arrays of groups, are not allowed (a finite number
+of named instances of a group may however be declared within a single relation).
+
+
+	attributes of a group:
+
+		name		group name as used in relation declarations
+		nelements	number of elements (attributes) in group
+		elements	set of elements (see below)
+
+	
+	attributes of each group element:
+
+		name		attribute name
+		domain		domain on which attribute is defined
+		naxis		number of axes if array valued
+		naxisN		length of each axis if array valued
+		label		column label for output tables
+
+
+1.3 Relations
+
+    A relation declaration consists of a list of the attributes forming the
+relation.  An attribute is a named instance of an atomic domain, user defined
+domain, or group.  Any group, including nested groups, may be decomposed
+into a set of named instances of domains, each of which is defined upon an
+atomic datatype, hence a relation declaration is decomposable into a linear
+list of atomic fields.  The relation is the logical unit of storage in a
+database.  A base table is an named instance of some relation.
+
+
+	attributes of a relation:
+
+		name		name of the relation
+		nattributes	number of attributes
+		atr_list	list of attributes (see below)
+		primary_key
+		title
+
+	
+	attributes of each attribute of a relation:
+
+		name		attribute name
+		domain		domain on which attribute is defined
+		naxis		number of axes if array valued
+		naxisN		length of each axis if array valued
+		label		column label for output tables
+
+
+The atomic attributes of a relation may be either scalar or array valued.
+The array valued attributes may be either static (the amount of storage is
+set in the relation declaration) or dynamic (a variable amount of storage
+is allocated at runtime).  Array valued attributes may not be used as
+predicates in queries.
+
+
+1.4 Views
+
+    A view is a logical relation defined upon one or more base tables, i.e.,
+instances of named relations.  The role views perform in a database is similar
+to that performed by base tables, but views do not in themselves occupy any
+storage.  The purpose of a view is to permit the appearance of the database
+to be changed to suit the needs of a variety of applications, without having
+to physically change the database itself.  As a trivial example, a view may
+be used to provide aliases for the names of the attributes of a relation.
+
+
+	attributes of a view:
+
+		name		name of the view
+		nattributes	number of attributes
+		atr_list	list of attributes (see below)
+
+	
+	attributes of each attribute of a view:
+
+		name		attribute name
+		mapping		name of the table and attribute to which this
+				    view attribute is mapped
diff --git a/sys/dbio/new/schema b/sys/dbio/new/schema
new file mode 100644
index 00000000..ef99ac1b
--- /dev/null
+++ b/sys/dbio/new/schema
@@ -0,0 +1,307 @@
+1. Database Schema
+
+    A logical database consists of a standard set of system tables describing
+the database, plus any number of user data tables.  The system tables are the
+following:
+
+
+	syscat		System catalog.  Lists all base tables, views, groups,
+			and relations in the database.  The names of all tables,
+			relations, views, and groups must be distinct.  Note
+			that the catalog does not list the attributes composing
+			a particular base table, relation, view, or group.
+
+	REL_atl		Attribute list table.  Descriptor table for the table,
+			relation, view, or group REL.  Lists the attributes
+			comprising REL.  One such table is required for each
+			relation, view, or group defined in the database.
+
+	sysddt		Domain descriptor table.  Describes all user defined
+			domains used in the database.  Note that the scope of
+			a domain definition is the entire database, not one
+			relation.
+
+	sysidt		Index descriptor table.  Lists all of the indexes in
+			the database.
+
+	sysadt		Alias descriptor table.  Defines aliases for the names
+			of tables or attributes.
+
+
+In addition to the standard tables, a table is required for each relation,
+view, or group listing the attributes (fields) comprising the relation, view,
+or group.  A base table which is an instance of a named relation is described
+by the table defining the relation.  If a given base table has been altered
+since its creation, e.g., by the addition of new attributes, then a separate
+table is required listing the attributes of the altered base table.  In effect,
+a new relation type is automatically defined by the database system listing the
+attributes of the altered base table.
+
+Like the user tables, the system tables are themselves described by attribute
+list tables stored in the database.  The database system need only know the
+structure of an attribute list table to decipher the structure of the rest of
+the database.  A single access method can be used to access all database
+structures (excluding the indexes, which are probably not stored as tables).
+
+
+2. Storage Structures
+
+    A database is maintained in a single random access binary file.  This one
+file contains all user tables and indexes and all system tables.  A single
+file is used to minimize the number of file opens and disk accesses required
+to access a record from a "cold start", i.e., after process startup.  Use of
+a single file also simplifies bookeeping for the user, minimizes directory
+clutter, and aids in database backup and transport.  For clarity we shall
+refer to this database file as a "datafile".  A datafile is a DBIO format
+binary file with the extension ".db".
+
+What the user perceives as a database is one or more datafiles plus any
+logically associated non-database files.  While database tasks may
+simultaneously access several databases, access will be much more efficient
+when multiple records are accessed in a single datafile than when a single
+record is accessed in multiple datafiles.
+
+
+2.1 Database Design
+
+    When designing a database the user or applications programmer must consider
+the following issues:
+
+    [1]	The logical structure of the database must be defined, i.e., the
+	organization of the data into tables.  While in many cases this is
+	trivial, e.g., when there is only one type of table, in general this
+	area of database design is nontrivial and will require the services
+	of a database expert familiar with the relational algebra,
+	normalization, the entity/relationship model, etc.
+
+    [2]	The clustering of tables into datafiles must be defined.  Related
+	tables which are fairly static should normally be placed in the same
+	datafile.  Tables which change a lot or which may be used for a short
+	time and then deleted may be best placed in separate datafiles.
+	If the database is to be accessed simultaneously by multiple processes,
+	e.g., when running background jobs, then it may be necessary to place
+	the input tables in read only datafiles and the output tables in
+	separate private access datafiles to permit concurrent access (DBIO
+	does not support record level locking).
+
+    [3] The type and number of indexes required for each table must be defined.
+	Most tables will require some sort of index for efficient retrieval.
+	Maintenance of an index slows insertion, hence output tables may be
+	better off without an index; indexes can be added later when the time
+	comes to read the table.  The type of index (linear, hash, or B-tree)
+	must be defined, and the keys used in the index must be listed.
+
+    [4]	Large text or binary files which are logically associated with the
+    	database may be implemented as physically separate, non-database files,
+	saving only the name of the file in the database, or as variable length
+	attributes, storing the data in the database itself.  Large files may
+	be more efficiently accessed when stored outside the database, while
+	small files consume less storage and are more efficiently accessed when
+	stored in a datafile.  Storing a file outside the database complicates 
+	database management and transport.
+
+
+3. DBIO
+
+    DBIO is the host language interface to the database system.  The interface
+is a procedural rather than query oriented interface; the query facilities
+provided by DBIO are limited to select/project.  DBIO is designed to be fast and
+compact and hence is little more than an access method.  A process typically
+has direct access to a database via a high bandwidth binary file i/o interface.
+
+Although we will not discuss it further here, we note that a compiled
+application which requires query level access to a database can send queries
+to the DBMS query language via the CL, using CLCMD (the query language resides
+in a separate process).  This is much the same technique as is used in
+commercial database packages.  A formal DBIO query language interface will be
+defined when the query language is itself defined.
+
+
+3.1 Database Management Functions
+
+    DBIO provides a range of functions for database management, i.e., operations
+on the database as a whole as opposed to the access functions, used for
+retrieval, update, insertion, etc.  The database management functions are
+summarized below.
+
+
+	open	database
+	close	database
+	create	database	initially empty
+	delete	database
+	change	database	(change default working database)
+
+	create	table		from DDL; from compiled DDT, ALT
+	drop	table
+	alter	table
+	sort	table
+
+	create	view
+	drop	view
+
+	create	index
+	drop	index
+
+
+A database must be opened or created before any other operations can be
+performed on the database (excluding delete).  Several databases may be
+open simultaneously.  New tables are created by any of several methods,
+i.e., from a written specification in the Data Definition Language (DDL),
+by inheriting the attributes of an existing table, or by successive alter
+table operations, adding a new attribute to the table definition in each call.
+
+
+3.2 Data Access Functions
+
+    A program accesses the database record by record via a "cursor".  A cursor
+is a pointer into a virtual table defined by evaluating a select/project
+statement upon a database.  This virtual table, or "selection set", consists of
+a set of record ids referencing actual records in one or more base tables.
+The individual records are not physically accessed by DBIO until a fetch,
+update, insert, or delete operation is performed by the applications program
+upon the record currently pointed to by the cursor.
+
+
+3.2.1 Record Level Access Functions
+
+    The record access functions allow a program to read and write entire records
+in one operation.  For the sake of data independence the program must first
+define the exact format of the logical record to be read or written; this
+format may differ from the physical record format in the number, order, and
+datatype of the fields to be accessed.  The names of the fields in the logical
+record must however match those in the physical record (unless aliased),
+and not all datatype conversions are legal.
+
+
+	open	cursor
+	close	cursor
+	length	cursor
+	next	cursor element
+
+	fetch	record
+	update	record
+	insert	record
+	delete	record
+
+	get/put	scalar field (typed)
+	get/put	vector field (typed)
+
+
+Logical records are passed between DBIO and the calling program in the form
+of a binary data structure via a pointer to the structure.  Storage for the
+structure is allocated by the calling program.  Only fixed size fields may be
+passed in this manner; variable size fields are represented in the static
+structure by an integer count of the current number of elements in the field.
+A separate call is required to read or write the contents of a variable length
+field.
+
+The dynamically allocated binary structure format is flexible and efficient
+and will be the most suitable format for most applications.  A character string
+format is also supported wherein the successive fields are encoded into
+successive ranges of columns.  This format is useful for data entry and
+forms generation, as well as for communication with foreign languages (e.g.,
+Fortran) which do not provide the data structuring facilities necessary for
+binary record transmission.
+
+The functions of the individual record level access operators are discussed
+in more detail below.
+
+	
+	fetch	Read the physical record currently pointed to by the cursor
+		into an internal holding area in DBIO.  Return the fields of
+		the specified logical record to the calling program.  If no
+		logical record was specified the only function is to copy the
+		physical record into the DBIO holding area.
+
+	modify	Update the internal copy of the physical record from the fields
+		of the logical record passed as an argument, but do not update
+		the physical input record.
+
+	update	Update the internal copy of the physical record from the fields
+		of the logical record passed as an argument, then update the
+		physical record in mass storage.  Mass storage will be updated
+		only if the local copy of the record has been modified.
+
+	insert	Update the internal copy of the physical record from the fields
+		of the logical record passed as an argument, then insert the
+		physical record into the specified output table.  The record
+		currently in the holding area is used regardless of its origin,
+		hence an explicit fetch is required to copy a record.
+
+	delete	The record currently pointed to by the cursor is deleted.
+	
+
+For example, to perform a select/project operation on a database one could
+open a cursor on the selection set defined by the indicated select/project
+statement (passed as a character string), then FETCH and print successive
+records until EOF is reached on the cursor.  To perform some operation on
+the elements of a selection set, producing a new table as output, one might
+FETCH each element, use and possibly modify the binary data structure returned
+by the FETCH, and then INSERT the modified record into the output table.
+
+When performing an UPDATE operation on the tuples of a selection set defined
+over multiple input tables, the tuples in separate input tables need not all
+have the same set of attributes.  INSERTion into an output table, however,
+requires that the new output tuples be union compatible with the existing
+tuples in the output table, or the mismatched attributes in the output tuples
+will be either lost or created with null values.  If the output table is a new
+table the attribute list of the new table may be defined to be either the
+union or intersection of the attribute lists of all tables in the selection
+set used as input.
+
+
+3.2.2 Field Level Access Functions
+
+    The record level access functions can be cumbersome when only one or two
+of the fields in a record are to be accessed.  The fields of a record may be
+accessed individually by typed GET and PUT procedures (e.g., DBGETI, DBPUTI)
+after copying the record in question into the DBIO holding area with FETCH.
+
+
+3.3 DBKI
+
+    The DataBase Kernel Interface (DBKI) is the interface between DBIO and
+one or more DataBase Kernels (DBK).  The DBKI supports multiple database
+kernels, each of which may support multiple storage formats.  The DBKI does
+not itself provide any database functionality, rather it provides a level
+of indirection between DBIO and the actual DBK used for a given dataset.
+The syntax and semantics of the procedures forming the DBKI interface are
+those required of a DBK, i.e., there is a one-to-one mapping between DBKI
+procedures and DBK procedures.
+
+A DBIO call to a DBKI procedure will normally be passed on to a DBK procedure
+resident in the same process, providing maximum performance.  If the DBK is
+especially large, e.g., when the DBK is a host database system, it may reside
+in a separate process with the DBK procedures in the local process serving
+only as an i/o interface.  On a system configured with network support DBKI
+will also provide the capability to access a DBK resident on a remote node.
+In all cases when a remote DBK is accessed, the interprocess or network
+interface occurs at the level of the DBKI.  Placing the interface at the
+DBKI level, rather than at the FIO z-routine level, provides a high bandwidth
+between the DBK and mass storage, greatly increasing performance since only
+selected records need be passed over the network interface.
+
+
+3.4 DBK
+
+    A DBIO database kernel (DBK) provides a "record manager" type interface,
+similar to the popular ISAM and VSAM interfaces developed by IBM (the actual
+access method used is based on the DB2 access method which is a variation on
+VSAM).  The DBK is responsible for the storage and retrieval of records from
+tables, and for the maintainance and use of any indexes maintained upon such
+tables.  The DBK is also responsible for arbitrating database access among
+concurrent processes (e.g., record locking, if provided), for error recovery,
+crash recovery, backup, and so on.  All data access via DBIO is routed through
+a DBK.  In no case does DBIO bypass the DBK to directly access mass storage.
+
+The DBK does not have any knowledge of the contents of a record (an exception
+occurs if the DBK is actually an interface to a host database system).
+To the DBK a record is a byte string.  Encoding and decoding of records is
+performed by DBIO.  The actual encoding used is machine independent and space
+efficient (byte packed).  Numeric fields are encoded in such a way that a
+generic comparison procedure may be used for order comparisons of all fields
+regardless of their datatype.  This greatly simplifies both the evaluation of
+predicates (e.g., in a select) and the maintenance of indexes.  The use of a
+machine independent encoding provides equivalent database semantics on all
+machines and transparent network access without redundant encode/decode,
+as well as making it trivial to transport databases between machines.
diff --git a/sys/dbio/new/spie.ms b/sys/dbio/new/spie.ms
new file mode 100644
index 00000000..ce380b70
--- /dev/null
+++ b/sys/dbio/new/spie.ms
@@ -0,0 +1,17 @@
+.TL
+The IRAF Data Reduction and Analysis System
+.AU
+Doug Tody
+.AI
+National Optical Astronomy Observatories
+Central Computer Services
+IRAF Group
+.PP
+.ls 2
+The Interactive Reduction and Analysis Facility (IRAF) is a general purpose
+data reduction and analysis system that has been under development by the
+National Optical Astronomy Observatories (NOAO) for the past several years
+and which is now in use within NOAO, at the Space Telescope Science Institute,
+and at several other sites on several different computers and operating systems.
+The philosophy and design goals of the IRAF system are discussed and the
+facilities provided by the current system are summarized.
diff --git a/sys/etc/README b/sys/etc/README
new file mode 100644
index 00000000..6a1ebe0a
--- /dev/null
+++ b/sys/etc/README
@@ -0,0 +1,4 @@
+This directory contains miscellaneous parts of the IRAF system code.
+These include the error handling facilities, the IRAF Main and associated
+routines (the default exception handler, and ONEXIT), environment access
+facilities, and time conversion facilities.
diff --git a/sys/etc/brktime.x b/sys/etc/brktime.x
new file mode 100644
index 00000000..dbd94a7c
--- /dev/null
+++ b/sys/etc/brktime.x
@@ -0,0 +1,79 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <time.h>
+
+define	SECONDS_PER_DAY		86400
+define	SECONDS_PER_HOUR	3600
+define	SECONDS_PER_MINUTE	60
+define	MONDAY			2
+
+# BRKTIME -- Break a long integer time (such as returned by GETTIME or FINFO)
+# into the fields of the structure defined in <time.h>.  The procedure is
+# valid from 00:00:00 01-Jan-1980 to 23:23:59 28-Feb-2100.
+
+procedure brktime (ltime, tm)
+
+long	ltime			# seconds since 00:00:00 01-Jan-1980
+int	tm[LEN_TMSTRUCT]	# broken down time (output struct)
+
+long	temp			# working variable
+long	seconds			# seconds in current day
+long	days			# whole days since Monday 00-Jan-1980
+int	nights			# whole days since 00-Jan of current year
+
+int	year			# year counter
+int	days_per_year		# days per year
+
+int	month			# month counter
+int	days_per_month[12]	# days per month
+data	days_per_month/31,0,31,30,31,30,31,31,30,31,30,31/
+
+begin
+        seconds = mod (ltime, SECONDS_PER_DAY)
+        days = ltime / SECONDS_PER_DAY + 1
+
+        # Break hours, minutes, seconds.
+
+        TM_HOUR(tm) = seconds / SECONDS_PER_HOUR
+        temp = seconds - TM_HOUR(tm) * SECONDS_PER_HOUR
+        TM_MIN(tm) = temp / SECONDS_PER_MINUTE
+        TM_SEC(tm) = temp - TM_MIN(tm) * SECONDS_PER_MINUTE
+
+        # Break day of week.
+
+        TM_WDAY(tm) = mod (days + MONDAY, 7)
+	if (TM_WDAY(tm) == 0)
+	    TM_WDAY(tm) = 7
+
+        # Break year, day of year.
+
+        temp = 0	# whole days since 00-Jan-1980 on last day of last year
+        year = 1980
+	days_per_year = 366
+	while (days > temp + days_per_year) {
+	    temp = temp + days_per_year
+	    year = year + 1
+	    if (mod (year, 4) == 0)
+	        days_per_year = 366
+	    else
+	        days_per_year = 365
+        }
+        TM_YEAR(tm) = year
+        TM_YDAY(tm) = days - temp
+
+        # Break month, day of month.
+
+	nights = TM_YDAY(tm)
+	if (mod (TM_YEAR(tm), 4) == 0)
+	    days_per_month[2] = 29
+	else
+	    days_per_month[2] = 28
+	temp = 0	# whole days since 00-Jan on last day of last month
+	month = 1
+	while (nights > temp + days_per_month[month]) {
+	    temp = temp + days_per_month[month]
+	    month = month + 1
+	}
+	TM_MONTH(tm) = month
+	TM_MDAY(tm) = nights - temp
+end
diff --git a/sys/etc/btoi.x b/sys/etc/btoi.x
new file mode 100644
index 00000000..468ba352
--- /dev/null
+++ b/sys/etc/btoi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# BTOI -- Convert boolean to integer.
+
+int procedure btoi (boolean_value)
+
+bool	boolean_value
+
+begin
+	if (boolean_value)
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/etc/clktime.x b/sys/etc/clktime.x
new file mode 100644
index 00000000..84155919
--- /dev/null
+++ b/sys/etc/clktime.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLKTIME -- Get the current clock time (local standard time) in units
+# of seconds since 00:00:00 01-Jan-80.  This can be broken down into days,
+# hours, seconds, etc. with BRKTIME, or printed as a date/time string with
+# CNVTIME.
+
+long procedure clktime (old_time)
+
+long	old_time, new_time
+long	cpu_time
+
+begin
+	call zgtime (new_time, cpu_time)
+	return (new_time - old_time)
+end
diff --git a/sys/etc/cnvdate.x b/sys/etc/cnvdate.x
new file mode 100644
index 00000000..7e2cd4e9
--- /dev/null
+++ b/sys/etc/cnvdate.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<time.h>
+
+define	SZ_WEEKDAY		3
+define	SZ_MONTH		3
+
+# CNVDATE -- Convert a time in integer seconds since midnight on Jan 1, 1980
+# into a short string such as "May 15 18:24".  The length of the output
+# string is given by the parameter SZ_DATE in <time.h>.  Note that CNVTIME
+# is also available if a longer, more informative string is desired.
+
+procedure cnvdate (ltime, outstr, maxch)
+
+long	ltime			# seconds since 00:00:00 01-Jan-1980
+char	outstr[ARB]
+int	maxch
+
+long	one_year_ago
+int	fd, tm[LEN_TMSTRUCT]
+
+long	clktime()
+int	stropen()
+string	month "JanFebMarAprMayJunJulAugSepOctNovDec"
+data	one_year_ago /0/
+errchk	stropen
+
+begin
+	if (one_year_ago == 0)
+	    one_year_ago = clktime (0) - 3600 * 24 * (365 - 31)
+
+	call brktime (ltime, tm)
+	fd = stropen (outstr, maxch, NEW_FILE)
+
+	call fprintf (fd, "%3.3s %2d ")
+	    call pargstr (month [(TM_MONTH(tm) - 1) * SZ_MONTH + 1])
+	    call pargi (TM_MDAY(tm))
+
+	# If time is recent (within the past year), print the time of day,
+	# otherwise print the year.
+
+	if (ltime > one_year_ago) {
+	    call fprintf (fd, "%2d:%02d")
+		call pargi (TM_HOUR(tm))
+		call pargi (TM_MIN(tm))
+	} else {
+	    call fprintf (fd, "%5d")
+		call pargi (TM_YEAR(tm))
+	}
+
+	call strclose (fd)
+end
diff --git a/sys/etc/cnvtime.x b/sys/etc/cnvtime.x
new file mode 100644
index 00000000..372daf03
--- /dev/null
+++ b/sys/etc/cnvtime.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<time.h>
+
+define	SZ_WEEKDAY		3
+define	SZ_MONTH		3
+
+# CNVTIME -- Convert a time in integer seconds since midnight on Jan 1, 1980
+# into a string, i.e., "Mon 16:30:05 17-Mar-2001".  The maximum length of the
+# output string is given by the parameter SZ_TIME in <time.h>.
+
+procedure cnvtime (ltime, outstr, maxch)
+
+long	ltime			# seconds since 00:00:00 01-Jan-1980
+char	outstr[ARB]
+int	maxch
+int	tm[LEN_TMSTRUCT]	# broken down time structure
+string	weekday "SunMonTueWedThuFriSat"
+string	month   "JanFebMarAprMayJunJulAugSepOctNovDec"
+
+begin
+	call brktime (ltime, tm)
+	call sprintf (outstr, maxch, "%3.3s %02d:%02d:%02d %02d-%3.3s-%04d")
+	    call pargstr (weekday [(TM_WDAY(tm) - 1) * SZ_WEEKDAY + 1])
+	    call pargi (TM_HOUR(tm))
+	    call pargi (TM_MIN(tm))
+	    call pargi (TM_SEC(tm))
+	    call pargi (TM_MDAY(tm))
+	    call pargstr (month [(TM_MONTH(tm) - 1) * SZ_MONTH + 1])
+	    call pargi (TM_YEAR(tm))
+end
diff --git a/sys/etc/cputime.x b/sys/etc/cputime.x
new file mode 100644
index 00000000..b56b7280
--- /dev/null
+++ b/sys/etc/cputime.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CPUTIME -- Return the difference between the current cpu time consumed
+# and the argument, in long integer milliseconds.
+
+long procedure cputime (old_cputime)
+
+long	old_cputime, new_cputime
+long	clk_time
+
+begin
+	call zgtime (clk_time, new_cputime)
+	return (new_cputime - old_cputime)
+end
diff --git a/sys/etc/doc/Proc.hlp b/sys/etc/doc/Proc.hlp
new file mode 100644
index 00000000..023a5316
--- /dev/null
+++ b/sys/etc/doc/Proc.hlp
@@ -0,0 +1,22 @@
+			        Process Control
+
+Connected Subprocesses
+
+	     pid = propen (process, in, out)
+	   stat = prclose (pid)
+	 stat = prgetline (in, lbuf)
+		  prredir (pid, stream, new_fd)
+		 prsignal (pid, signal)
+		 prupdate (message)
+
+	    pid = propcpr (process, in, out)
+	   stat = prclcpr (pid)
+
+
+
+Detached Processes
+
+	    job = propdpr (process, bkgfile)
+	   stat = prcldpr (job)
+	     y/n = prdone (job)
+		   prkill (job)
diff --git a/sys/etc/doc/error.hlp b/sys/etc/doc/error.hlp
new file mode 100644
index 00000000..7776093f
--- /dev/null
+++ b/sys/etc/doc/error.hlp
@@ -0,0 +1,51 @@
+
+.help error, fatal, errchk, erract, iferr 2 "Error Handling Strategy"
+.sh
+ERROR HANDLING
+
+    A recoverable error condition is asserted with ERROR.  An irrecoverable
+error condition is asserted with FATAL.  Error recovery is implemented
+using the IFERR and IFNOERR statements in the preprocessor language.
+ERRACT may be called in an IFERR statement to cause a warning to be issued,
+or to cause a particular error action to be taken.  ERRCODE returns either
+OK or the integer code of the posted error.
+
+Language support includes the IFERR and IFNOERR statements and the ERRCHK
+declaration.  The IFERR statement is grammatically equivalent to the IF
+statement.  Note that the condition to be tested in an IFERR statement may
+be a procedure call or assignment statement, while the IF statement tests
+a boolean expression.
+
+
+.nf
+	errchk	proc1, proc2, ...		# errchk declaration
+
+	iferr (procedure call or assignment statement)
+	    <error_action_statement>
+
+	iferr {
+	    <any statements, including IFERR>
+	} then
+	    <error_action_statement>
+
+
+Library procedures (ERROR and FATAL cause a RETURN):
+
+	  error (errcode, error_message)
+	  fatal (errcode, error_message)
+	 erract (severity)
+  val = errcode ()
+
+
+ERRACT severity codes (<error.h>):
+
+	EA_WARN			# issue a warning message
+	EA_ERROR		# assert recoverable error
+	EA_FATAL		# assert fatal error
+.fi
+
+
+An arithmetic exception (X_ARITH) will be trapped by an IFERR statement,
+provided the posted handler(s) return without causing error restart.
+X_INT and X_ACV may only be caught by posting an exception handler with
+XWHEN.
diff --git a/sys/etc/doc/etc.hd b/sys/etc/doc/etc.hd
new file mode 100644
index 00000000..759ba4e2
--- /dev/null
+++ b/sys/etc/doc/etc.hd
@@ -0,0 +1,29 @@
+# Help directory for the ETC (miscellaneous system stuff) package.
+
+$etc	= "sys$etc/"
+
+brktime		hlp = brktime.hlp,		src = etc$brktime.x
+btoi		hlp = btoi.hlp,			src = etc$btoi.x
+clktime		hlp = clktime.hlp,		src = etc$clktime.x
+cnvdate		hlp = cnvdate.hlp,		src = etc$cnvdate.x
+cnvtime		hlp = cnvtime.hlp,		src = etc$cnvtime.x
+cputime		hlp = cputime.hlp,		src = etc$cputime.x
+envgetb		hlp = envget.hlp,		src = etc$envgetb.x
+envgeti		hlp = envget.hlp,		src = etc$envgeti.x
+envgets		hlp = envget.hlp,		src = etc$envgets.x
+erract		hlp = erract.hlp,		src = etc$erract.x
+errcode		hlp = errcode.hlp,		src = etc$errcode.x
+error		hlp = error.hlp,		src = etc$error.x
+getuid		hlp = getuid.hlp,		src = etc$getuid.x
+itob		hlp = itob.hlp,			src = etc$itob.x
+lpopen		hlp = lpopen.hlp,		src = etc$lpopen.x
+main		hlp = main.hlp,			src = etc$main.x
+onerror		hlp = onerror.hlp,		src = etc$onerror.x
+onexit		hlp = onexit.hlp,		src = etc$onexit.x
+oscmd		hlp = oscmd.hlp,		src = etc$oscmd.x
+qsort		hlp = qsort.hlp,		src = etc$qsort.x
+sys_ptime	hlp = sys_ptime.hlp,		src = etc$sys_ptime.x
+syserr		hlp = syserr.hlp,		src = etc$syserr.x
+tsleep		hlp = tsleep.hlp,		src = etc$tsleep.x
+urand		hlp = urand.hlp,		src = etc$urand.x
+xwhen		hlp = xwhen.hlp,		src = etc$xwhen.x
diff --git a/sys/etc/doc/etc.men b/sys/etc/doc/etc.men
new file mode 100644
index 00000000..5ed6f4ad
--- /dev/null
+++ b/sys/etc/doc/etc.men
@@ -0,0 +1,24 @@
+	brktime - Convert a long integer time into year, month, day, etc.
+	   btoi - Boolean to integer
+	clktime - Get the clock time
+	cnvdate - Convert long integer time to date string (short format)
+	cnvtime - Convert long integer time to time string (long format)
+	cputime - Get the CPU time consumed by the process
+    envget[bis] - Get a boolean, integer, or string valued environment variable
+	 erract - Take an error action for a previously posted error
+	errcode - Get the error code of the posted error
+	  error - Post an error and take an error action
+	 getuid - Get the name of the runtime user of a program
+	   itob - Convert integer to boolean
+	 lpopen - Open the line printer as a file
+	   main - The IRAF Main
+	onerror - Post a procedure to be executed if error recovery occurs
+	 onexit - Post a procedure to be executed upon process shutdown
+	  oscmd - Send a command to the host operating system
+	  qsort - General quick sort for any data structure
+      sys_mtime - Mark the time (for timing programs)
+      sys_ptime - Print the elapsed time since last mark
+	 syserr - Post a system error and take an error action
+	 tsleep - Delay process execution
+	  urand - Uniform random number generator
+	  xwhen - Post an exception handler
diff --git a/sys/etc/doc/psio.doc b/sys/etc/doc/psio.doc
new file mode 100644
index 00000000..d0f34c9a
--- /dev/null
+++ b/sys/etc/doc/psio.doc
@@ -0,0 +1,275 @@
+.help pr_psio
+.nf __________________________________________________________________________
+PR_PSIO -- Pseudofile i/o for a process.  Process an i/o request for the
+specified pseudofile stream of the specified process.  Called either to read
+command input from the CLIN of a process, or to process a read or write
+request to a pseudofile of a process.
+
+
+1. Introduction
+
+    Pseudofile i/o in a multiprocess configuration, e.g., for the graphics
+streams, is quite complex and difficult to explain briefly.  I have tried to
+cover the major points here but warn the reader that it is not going to be easy
+to understand the flow of data and control involved.  The problem is a difficult
+one due to the nature of the IPC protocol and the complexity of the three
+process architecture required when an external graphics kernel is used.  The
+discussion herein is not complete but should as least give the reader some
+idea of what is going on.
+
+
+2. Pseudofile I/O
+
+    While a task is running the CL will be reading command input from the task.
+This read eventually resolves into a call to PR_PSIO on the CLIN for the
+process.  When pseudofile i/o occurs, e.g., the process writes to STDOUT or
+STDERR, an XMIT or XFER directive will be seen in the CLIN input from the
+process.  If we are directed to XMIT to an ordinary file our task is relatively
+easy, i.e., we read the data block from CLIN and write it to the output file.
+A directive to read from the standard input is also easy, i.e., we read from
+the standard input of the parent (assuming i/o is not redirected) and write
+the data block to the CLOUT of the process preceded by a count of the number
+of chars.
+
+
+2.1 I/O to a Graphics Stream
+
+    If we are directed to read or write a graphics stream our task is somewhat
+more difficult.  The standard graphics streams STDGRAPH, STDIMAGE, and STDPLOT
+differ from other pseudofiles in that the streams are both readable and
+writable, provided all data is used up before switching modes.  A graphics
+stream may be connected to a file if output is being spooled, to the builtin
+STDGRAPH kernel if the graphics device is the graphics terminal, or to a
+graphics kernel resident in an external subprocess.
+
+If a graphics stream is redirected to a spool file we merely copy output to
+the file and reading is forbidden.  If output is to an external graphics
+kernel but is unfiltered (no workstation transformation, e.g., for STDPLOT),
+we merely copy data blocks on to the subprocess but the protocol involved
+is nontrivial.  If output is to the builtin STDGRAPH kernel or to an
+external interactive kernel, output must be filtered through GIOTR before
+being written to the local or remote graphics kernel.  Graphics input is
+also possible and is handled similarly but without need to call GIOTR.
+
+Before reading or writing a graphics stream GIO will send a special directive to
+PR_PSIO to connect a kernel to the stream.  This directive is passed to PR_PSIO
+via an XMIT to the special pseudofile PSIOCONTROL.  The data passed in the
+XMIT call will be the GKI control instruction to be executed by PSIO.  There
+are currently three such directives, i.e., OPENWS, SETWCS, and GETWCS.  Each
+such directive is included in the normal metacode stream as well, but by
+writing to a special pseudofile we avoid the need to have PR_PSIO scan each
+metacode stream for control instructions, a fairly expensive operation if a
+lot of data is involved.
+
+
+2.1.1 Graphics Stream Dataflow
+
+    A frame buffer is associated with each graphics stream in the parent
+process.  If graphics output (metacode) is being filtered, each output record
+is appended to the frame buffer and then GIOTR is called to filter the new
+instructions.  GIOTR writes the filtered metacode stream either directly to
+the builtin kernel or to the graphics output pseudofile stream of the parent
+process.
+
+Output to the builtin kernel is easy to understand: GIOTR merely calls the
+kernel to execute the transformed instruction.  If output is to an external
+kernel we unfortunately cannot simply write to the kernel because we require
+that the graphics kernel task be a conventional task callable from either
+the CL or by the graphics system, i.e., by PL_PSIO.  We must buffer the
+transformed output metacode and pass it on to the kernel process only when
+requested to do so by an XFER command from the kernel.
+
+This buffering is done in a somewhat tricky way which makes it look like we
+are writing to a simple file, and which allows us to use conventional READ and
+WRITE calls to access the graphics stream.  GIOTR, if not writing to the
+builtin kernel, will write to one of the three graphics streams of the parent
+process, i.e., to STDGRAPH, STDIMAGE, or STDPLOT.  The graphics stream of the
+parent is logically connected to the same stream in the kernel process.  We
+arrange things such that data may be written or read into the FIO buffer
+associated with the stream, but the buffer will never actually be flushed,
+since this would cause the contents to appear as garbage on the user terminal.
+
+The sequence of events for an XMIT to STDGRAPH with an external kernel is as
+follows:
+
+	
+	The parent process (CL) blocks, waiting for a read on the IPC
+	    channel to the graphics task.
+
+	Graphics task writes to stdgraph.
+	FIO flushes stdgraph buffer through IPC channel.
+
+	PR_PSIO (in the parent) sees XMIT to stdgraph.
+	Parent reads data record from IPC channel, appending the
+	    data record to the frame buffer for the stream.
+
+	PR_PSIO calls GIOTR to process the new metacode.
+	GIOTR writes the transformed metacode instructions to the stdgraph
+	    stream of the parent and returns control to PR_PSIO.
+
+	PR_PSIO rewinds the stdgraph buffer in preparation for a read and
+	    stacks the pending XMIT request and directs its command input
+	    to the IPC of the kernel process.
+
+	The kernel process sends zero or more XMIT or XFER requests to
+	    the parent to read or write pseudofile streams other than
+	    stdgraph.
+	The kernel process sends an XFER request to the parent to read
+	    from stdgraph.
+	The parent reads the data record from the stdgraph FIO buffer
+	    and passes it on to the kernel, completing the XFER request
+	    of the kernel as well as the original XMIT request of the
+	    graphics task.
+
+	The parent process (CL) blocks, waiting for a read on the IPC
+	    channel to the graphics task.
+
+
+The sequence of operations for an XFER request from the graphics task is
+as follows.
+
+	The parent process (CL) blocks, waiting for a read on the IPC
+	    channel to the graphics task.
+
+	The parent receives an XFER request from the graphics task.
+	If there is any data in the stdgraph buffer the parent returns
+	    that to the graphics task, otherwise the PR_PSIO procedure
+	    pushes an XFER request and redirects its input to the
+	    graphics kernel.
+
+	The kernel process sends zero or more XMIT or XFER requests to
+	    the parent to read or write pseudofile streams other than
+	    stdgraph.
+	The kernel process sends an XMIT request to the parent to write
+	    to stdgraph.
+	The parent reads the data block from the IPC channel to the kernel
+	    and writes it to stdgraph, completing the XMIT request.
+
+	The parent pops the XFER request and copies the data in the stdgraph
+	    buffer to the graphics task, completing the original XFER request.
+
+	The parent process (CL) blocks, waiting for a read on the IPC
+	    channel to the graphics task.
+
+
+In summary, the principal data buffers involved in pseudofile i/o to a graphics
+stream are the frame buffer, used by GIOTR to spool the metacode instructions
+for a graphics frame, and the FIO buffer for the graphics stream, used to
+pass data between XMIT/XFER request pairs from cooperating processes at
+opposite ends of a graphics stream.
+
+
+3. Summary
+
+    The actual code required to implement all this is probably easier to
+understand than the English description.  To summarize the justification for
+the complexity of the scheme we have adopted:
+
+    [1] The graphics kernel task is a conventional CL callable task with
+	parameters etc., usable to process metacode from a metafile or from
+	a pipe as well as callable by PR_PSIO.  The conventional IPC protocol
+	is used in the graphics kernel task.  Other tasks may be resident in
+	the same process, saving disk and memory.
+
+    [2] The graphics kernel may read STDIN and write STDOUT and STDERR while
+	processing metacode, allowing access to the graphics terminal via the
+	CL process, output of debugging information during operation, and
+	output of error messages during operation.
+.endhelp ______________________________________________________________________
+
+
+# PR_PSIO -- Process an i/o request for the specified pseudofile stream
+# of the specified process.
+
+procedure pr_psio (pid, active_fd)
+
+pid	process id
+fd	process stream for which i/o is requested
+
+begin
+	in = pr.clin
+	fd = active_fd
+	clear stack
+
+	# Process i/o requests from the subprocess until a request is received
+	# and processed for pseudofile FD.
+
+	repeat {
+	    while (filbuf (in) != EOF) {
+		determine type of request and destfd
+
+		if (xmit request to stream destfd) {
+		    if (graphics filtering enabled) {
+			read data record and append to frame buffer
+			call giotr to filter output to destfd
+		    } else {
+			read data record from process
+			write record to destfd
+		    }
+		    if (destination is a process) {
+			rewind destfd buffer for read
+			push (fd)
+			push (in)
+			push (xmit)
+			fd = destfd
+			in = newpr.clin
+			next
+		    }
+
+		} else if (xfer request from stream destfd) {
+		    if (destfd is a process and buffer is empty) {
+			push (fd)
+			push (in)
+			push (xfer)
+			fd = destfd
+			in = newpr.clin
+			next
+		    } else {
+			read data record from destfd
+			write data record to process
+		    }
+
+		} else if (gio directive) {
+		    if (open workstation)
+			connect a kernel process to a graphics stream
+		    else if (setwcs)
+			save wcs for the stream
+		    else if (getwcs)
+			write wcs data to the process
+
+		} else {
+		    destfd = CLIN
+		    if (fd != CLIN)
+			error: unsolicited command input from the subprocess
+		}
+
+		if (destfd == fd) {
+		    if (stack not empty) {
+			pop (request)
+			pop (in)
+			pop (fd)
+			if (request == xfer) {
+			    read data record from fd
+			    write data record to process owning "in"
+			}
+		    } else
+			break
+		}
+	    }
+	} until (stack is empty)
+end
+
+
+
+File routing:
+
+    Each pseudofile in a subprocess is associated with a stream in the parent
+process.  A subprocess pseudofile may map to a real file or to a parent
+pseudofile.  When a subprocess is connected as a graphics kernel graphics
+i/o will be via any one of the standard graphics streams STDGRAPH etc.,
+with said graphics stream connected to the same stream in the parent.
+The subprocess streams STDIN, STDOUT, and STDERR are by default connected
+to the same streams in the parent, allowing the subprocess to access the
+terminal, output error messages, and so on.  A graphics kernel will be able
+to access the standard i/o streams even while connected as a subprocess
+to filter GKI metacode.
diff --git a/sys/etc/dtmcnv.x b/sys/etc/dtmcnv.x
new file mode 100644
index 00000000..63d89a12
--- /dev/null
+++ b/sys/etc/dtmcnv.x
@@ -0,0 +1,482 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <time.h>
+
+
+# DTMCNV.X -- Date and time conversions.
+# 
+# The file contains the source for only the DTM routines listed below.  All
+# the related system date and time routines are also summarized so that the
+# whole (rather scattered) interface can be viewed at a glance.
+# 
+# FITS-Like Date and Time String Conversions
+# 
+#       status = dtm_decode (datestr, y,m,d, h, oldfits)
+#       nchars = dtm_encode (datestr,maxch, y,m,d, h, precision, flags)
+#   status = dtm_decode_hms (datestr, y,m,d, h,m,s, oldfits)
+#   nchars = dtm_encode_hms (datestr,maxch, y,m,d, h,m,s, precision, flags)
+#        status = dtm_ltime (datestr, ltime)
+# 
+# 
+# General Date and Time Conversions
+# 
+# 	          cnvdate (ltime, outstr, maxch)
+# 		  cnvtime (ltime, outstr, maxch)
+# 		  brktime (ltime, tm)
+# 
+# System Time
+# 
+#            lval = clktime (old_time)		# returns local time
+# 	   lval = cputime (old_cputime)		# process cpu time, seconds
+# 	   gmt = lsttogmt (lst)			# lst/gmt are in seconds
+# 	   lst = gmttolst (gmt)			# lst/gmt are in seconds
+# 
+# 		sys_mtime (save_time)		# mark/print cpu time used
+# 		sys_ptime (fd, opstr, save_time)
+# 
+# 
+# Kernel Support
+# 
+# 		   zgtime (clktime, cputime)	# clock/cpu time in seconds
+# 		   zgmtco (gmtcor)		# GMT = LST + gmtco (seconds)
+# 
+# LST here means local standard time (clock time), including any correction
+# for daylight savings time.
+
+
+
+# DTM_DECODE -- Decode the FITS format DATE-OBS string value into year,
+# month, day and time fields.  OK is returned if the date string is
+# successfully decoded, ERR if it is not.  The DATE-OBS string value may be
+# in any of the following forms:  DD/MM/YY (flags = TF_OLDFITS), CCYY-MM-DD
+# (flags = 0, time = INDEFD), or CCYY-MM-DDTHH:MM:SS[.SSS...] (flags=0,
+# time = double precision number).  This routine verifies only the syntax.
+# Routines in the SLALIB or ASTUTIL libraries can be used to check for
+# valid year, month, day, or time values.
+
+int procedure dtm_decode (datestr, year, month, day, time, flags)
+
+char	datestr[ARB]	#I the input date-obs string
+int	year		#O the output year (INDEFI if undefined)
+int	month		#O the output month (INDEFI if undefined)
+int	day		#O the output day (INDEFI if undefined)
+double	time		#O the output time in hours (INDEFD if undefined)
+int	flags		#O see <time.h>
+
+double	dval
+int	oldfits, ip, nchars, ival 
+int	ctoi(), ctod()
+
+begin
+	# Initialize.
+	year = INDEFI
+	month = INDEFI
+	day = INDEFI
+	time = INDEFD
+	flags = 0
+
+	# Determine whether the format is old or new and get the day or
+	# month accordingly.
+	ip = 1
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    flags = or (flags, TF_OLDFITS)
+	    oldfits = YES
+	    day = ival
+	} else if (nchars == 4) {
+	    flags = and (flags, not(TF_OLDFITS))
+	    oldfits = NO
+	    year = ival
+	} else
+	    return (ERR)
+
+	# Check syntax.
+	if (oldfits == NO && datestr[ip] == '-')
+	    ip = ip + 1
+	else if (oldfits == YES && datestr[ip] == '/')
+	    ip = ip + 1
+	else
+	    return (ERR)
+
+	# Get the month
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    month = ival
+	} else
+	    return (ERR)
+	if (oldfits == NO && datestr[ip] == '-')
+	    ip = ip + 1
+	else if (oldfits == YES && datestr[ip] == '/')
+	    ip = ip + 1
+	else
+	    return (ERR)
+
+	# Get the year or day.
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    if (oldfits == YES)
+		year = 1900 + ival
+	    else
+		day = ival
+	} else
+	    return (ERR)
+
+	if (datestr[ip] != 'T' || oldfits == YES)
+	    return (OK)
+
+	# Get the time.
+	ip = ip + 1
+	nchars = ctod (datestr, ip, dval) 
+	if (nchars < 8)
+	    return (ERR)
+	else
+	    time = dval
+
+	# Check for trailing garbage in the input string. Ignore whitespace.
+	while (IS_WHITE(datestr[ip]))
+	    ip = ip + 1
+
+	if (datestr[ip] != EOS)
+	    return (ERR)
+	else
+	    return (OK)
+end
+
+
+# DTM_DECODE_HMS -- Decode a FITS format DATE-OBS string into year, month,
+# day, hours, minutes, and seconds fields.  OK is returned if the date string
+# is successfully decoded, ERR if it is not.  The DATE-OBS string value may
+# be in any of the following forms: DD/MM/YY (oldfits = YES), CCYY-MM-DD
+# (oldfits = NO, hours = INDEFI, minutes = INDEFI, seconds = INDEFD), or
+# CCYY-MM-DDTHH:MM:SS[.SSS...] (oldfits = NO, hours = integer, minutes =
+# integer, seconds = double precision number).  This routine verifies only
+# that the syntax is correct.  Routines in the SLALIB or ASTUTIL libraries
+# can be used to check for valid year, month, day, or time values.
+
+int procedure dtm_decode_hms (datestr,
+	year, month, day, hours, minutes, seconds, flags)
+
+char	datestr[ARB]	#I the input date-obs string
+int	year		#O the output year (INDEFI if undefined)
+int	month		#O the output month (INDEFI if undefined)
+int	day		#O the output day (INDEFI if undefined)
+int	hours		#O the output hours (INDEFI if undefined)
+int	minutes		#O the output minutes (INDEFI if undefined)
+double	seconds		#O the output seconds (INDEFD if undefined)
+int	flags		#O see <time.h>
+
+double	dval
+int	oldfits, ip, nchars, ival 
+int	ctoi(), ctod()
+
+begin
+	# Initialize.
+	year = INDEFI
+	month = INDEFI
+	day = INDEFI
+	hours = INDEFI
+	minutes = INDEFI
+	seconds = INDEFD
+	flags = 0
+
+	# Determine whether the format is old or new and get the day
+	# or month accordingly.
+	ip = 1
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    flags = or (flags, TF_OLDFITS)
+	    oldfits = YES
+	    day = ival
+	} else if (nchars == 4) {
+	    flags = and (flags, not(TF_OLDFITS))
+	    oldfits = NO
+	    year = ival
+	} else
+	    return (ERR)
+
+	# Check syntax.
+	if (oldfits == NO && datestr[ip] == '-')
+	    ip = ip + 1
+	else if (oldfits == YES && datestr[ip] == '/')
+	    ip = ip + 1
+	else
+	    return (ERR)
+
+	# Get the month.
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    month = ival
+	} else
+	    return (ERR)
+	if (oldfits == NO && datestr[ip] == '-')
+	    ip = ip + 1
+	else if (oldfits == YES && datestr[ip] == '/')
+	    ip = ip + 1
+	else
+	    return (ERR)
+
+	# Get the year or day.
+	nchars = ctoi (datestr, ip, ival)
+	if (nchars == 2) {
+	    if (oldfits == YES)
+		year = 1900 + ival
+	    else
+		day = ival
+	} else
+	    return (ERR)
+
+	if (datestr[ip] != 'T' || oldfits == YES)
+	    return (OK)
+
+	# Get the hours.
+	ip = ip + 1
+	nchars = ctoi (datestr, ip, ival) 
+	if (nchars == 2)
+	    hours = ival
+	else
+	    return (ERR)
+	if (datestr[ip] != ':') 
+	    return (ERR)
+
+	# Get the minutes.
+	ip = ip + 1
+	nchars = ctoi (datestr, ip, ival) 
+	if (nchars == 2)
+	    minutes = ival
+	else
+	    return (ERR)
+	if (datestr[ip] != ':') 
+	    return (ERR)
+
+	# Get the seconds.
+	ip = ip + 1
+	nchars = ctod (datestr, ip, dval) 
+	if (nchars < 2)
+	    return (ERR)
+	else
+	    seconds = dval
+
+	# Check for trailing garbage in the input string. Ignore whitespace.
+	while (IS_WHITE(datestr[ip]))
+	    ip = ip + 1
+
+	if (datestr[ip] != EOS)
+	    return (ERR)
+	else
+	    return (OK)
+end
+
+
+# DTM_ENCODE -- Encode year, month, day and time fields into a valid FITS
+# format DATE-OBS string value.  The number of characters in the output
+# string is returned as the function value.  The returned DATE-OBS keyword
+# value may be in any of the following formats: DD/MM/YY (oldfits = YES,
+# 1900 <= year < 2000), CCYY-MM-DD (oldfits = NO, time = INDEFD), or
+# CCYY-MM-DDTHH:MM:SS[.SSS...] (oldfits = NO, time = double precision
+# number). This routine formats the string but does not check for valid
+# input values.  Routines in the SLALIB or ASTUTIL libraries can be used
+# to create valid year, month, day, or time values.
+
+int procedure dtm_encode (datestr, maxch,
+	year, month, day, time, precision, flags)
+
+char	datestr[ARB]		#O the output date string
+int	maxch			#I the maximum length of the output date string
+int	year			#I the input year, e.g. 1999
+int	month			#I the input month, e.g. 1-12
+int	day			#I the input day, e.g. 1-31 
+double	time			#I the input time in hours, INDEFD if undefined
+int	precision		#I the precision of the output time field
+int	flags			#I see <time.h>
+
+int	oldfits, field
+int	strlen(), btoi()
+
+begin
+	datestr[1] = EOS
+	oldfits = btoi (and (flags, TF_OLDFITS) != 0)
+
+	if (oldfits == YES) {
+	    if (year >= 1900 && year < 2000) {
+	        call sprintf (datestr, maxch, "%02d/%02d/%02d")
+		    call pargi (day)
+		    call pargi (month)
+		    call pargi (mod (year, 1900))
+	    }
+	} else if (IS_INDEFD(time)) {
+	    call sprintf (datestr, maxch, "%04d-%02d-%02d")
+		call pargi (year)
+		call pargi (month)
+		call pargi (day)
+	} else {
+	    if (precision <= 0)
+		field = 8
+	    else
+		field = 9 + precision
+	    call sprintf (datestr, maxch, "%04d-%02d-%02dT%0*.*h")
+	        call pargi (year)
+	        call pargi (month)
+	        call pargi (day)
+	        call pargi (field)
+	        call pargi (precision)
+	        call pargd (time)
+	}
+
+	return (strlen (datestr))
+end
+
+
+# DTM_ENCODE_HMS -- Encode year, month, day, hours, minutes, and seconds
+# fields into a valid FITS format DATE-OBS string value.  The number of
+# characters in the output string is returned as the function value.  The
+# returned DATE-OBS keyword value may be in any of the following formats:
+# DD/MM/YY (oldfits = YES, 1900 <= year < 2000), CCYY-MM-DD (oldfits = NO,
+# time = INDEFD), or CCYY-MM-DDTHH:MM:SS[.SSS...] (oldfits = NO, time =
+# double precision number). This routine formats the string but does not
+# check for valid input values.  Routines in the SLALIB or ASTUTIL libraries
+# can be used to create valid year, month, day, or time values.
+
+int procedure dtm_encode_hms (datestr, maxch,
+	year, month, day, hours, minutes, seconds, precision, flags)
+char	datestr[ARB]		#O the output date string
+int	maxch			#I the maximum length of the output date string
+
+int	year			#I the input year, e.g. 1999
+int	month			#I the input month, e.g. 1-12
+int	day			#I the input day, e.g. 1-31 
+int	hours			#I the input hours field, INDEFI if undefined
+int	minutes			#I the input minutes field, INDEFI if undefined
+double	seconds			#I the input seconds field, INDEFD if undefined
+int	precision		#I the precision of the output time field
+int	flags			#I see <time.h>
+
+int	oldfits, field
+int	strlen(), btoi()
+
+begin
+
+	datestr[1] = EOS
+	oldfits = btoi (and (flags, TF_OLDFITS) != 0)
+
+	if (oldfits == YES) {
+	    if (year >= 1900 && year < 2000) {
+	        call sprintf (datestr, maxch, "%02d/%02d/%02d")
+		    call pargi (day)
+		    call pargi (month)
+		    call pargi (mod (year, 1900))
+	    }
+	} else if (IS_INDEFI(hours) || IS_INDEFI(minutes) ||
+	    IS_INDEFD(seconds)) {
+	    call sprintf (datestr, maxch, "%04d-%02d-%02d")
+		call pargi (year)
+		call pargi (month)
+		call pargi (day)
+	} else {
+	    if (precision <= 0)
+		field = 2
+	    else
+		field = 3 + precision
+	    call sprintf (datestr, maxch, "%04d-%02d-%02dT%02d:%02d:%0*.*f")
+	        call pargi (year)
+	        call pargi (month)
+	        call pargi (day)
+		call pargi (hours)
+		call pargi (minutes)
+	        call pargi (field)
+	        call pargi (precision)
+	        call pargd (seconds)
+	}
+
+	return (strlen (datestr))
+end
+
+
+# DTM_LTIME -- Decode a FITS format DATE-OBS string into the number of
+# seconds since 00:00:00 01-Jan-1980.  OK is returned if the date string
+# is successfully decoded, ERR if it is not or if it is a negative value.
+# The 'datestr' string value may be in any of the following forms: DD/MM/YY
+# or CCYY-MM-DD (where time is INDEF and assumed to be midnight), or as
+# CCYY-MM-DDTHH:MM:SS[.SSS...].
+
+int procedure dtm_ltime (datestr, ltime)
+
+char	datestr[ARB]		#I the input date string
+long	ltime			#O seconds since 00:00:00 01-Jan-1980
+
+double	sec
+int	oldfits, ndays
+int	hr, min, yr, mon, day
+
+double	dtm_date_to_julday()
+int	dtm_decode_hms()
+
+define	START_IRAF_EPOCH	2444239.5	# JD of 00:00:00 01-Jan-1980
+define  SECONDS_PER_DAY         86400
+define  SECONDS_PER_HOUR        3600
+define  SECONDS_PER_MINUTE      60
+
+begin
+	ltime = INDEFL		# initialize
+
+	if (dtm_decode_hms (datestr, yr,mon,day, hr,min,sec, oldfits) == ERR)
+	    return (ERR)
+
+	# Take care of the assumption that 2-digit years are 1900.
+	if (oldfits == YES)
+	    yr = yr + 100
+
+	# If we had a time specified, convert it to the number of seconds
+	# that day.
+	if (IS_INDEFI(hr) || IS_INDEFI(min) || IS_INDEFD(sec)) 
+	    ltime = 0
+	else
+	    ltime = (hr * SECONDS_PER_HOUR) + (min * SECONDS_PER_MINUTE) + sec
+
+	# Compute the number of days since the start of the iraf epoch.
+	ndays =  dtm_date_to_julday (yr, mon, day, 0.0d0) - START_IRAF_EPOCH
+
+	# Convert days to seconds, add to time from before.
+	ltime = ltime + (ndays * SECONDS_PER_DAY)
+
+	if (ltime >= 0)
+	    return (OK)
+	else
+	    return (ERR)
+end
+
+
+# DTM_DATE_TO_JULDAY -- Convert date to Julian day. Assumes dates after year 99.
+
+double procedure dtm_date_to_julday (year, month, day, t)
+
+int	year			# Year
+int	month			# Month (1-12)
+int	day			# Day of month
+double	t			# Time for date (mean solar day)
+
+double	jd
+int	y, m, d
+
+begin
+	if (year < 100)
+	    y = 1900 + year
+	else
+	    y = year
+
+	if (month > 2)
+	    m = month + 1
+	else {
+	    m = month + 13
+	    y = y - 1
+	}
+
+	jd = int (365.25D0 * y) + int (30.6001 * m) + day + 1720995
+	if (day + 31 * (m + 12 * y) >= 588829) {
+	    d = int (y / 100)
+	    m = int (y / 400)
+	    jd = jd + 2 - d + m
+	}
+	jd = jd - 0.5 + int (t * 360000. + 0.5) / 360000. / 24.
+	return (jd)
+end
diff --git a/sys/etc/envgetb.x b/sys/etc/envgetb.x
new file mode 100644
index 00000000..564aa67f
--- /dev/null
+++ b/sys/etc/envgetb.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ENVGETB -- Check whether the named option is set in the environment.
+# Return true only if the option is defined in the environment and either has
+# no value string (i.e., the existence of the variable is what is significant)
+# or a value string which begins with the character 'y' or 'Y'.
+
+bool procedure envgetb (varname)
+
+char	varname[ARB]
+bool	answer
+pointer	sp, def
+int	envfind()
+
+begin
+	call smark (sp)
+	call salloc (def, SZ_LINE, TY_CHAR)
+
+	if (envfind (varname, Memc[def], SZ_LINE) < 0)
+	    answer = false
+	else {
+	    switch (Memc[def]) {
+	    case 'y', 'Y', EOS:
+		answer = true
+	    default:				# abort not justified
+		answer = false
+	    }
+	}
+
+	call sfree (sp)
+	return (answer)
+end
diff --git a/sys/etc/envgetd.x b/sys/etc/envgetd.x
new file mode 100644
index 00000000..749c3aef
--- /dev/null
+++ b/sys/etc/envgetd.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+
+# ENVGETD -- Fetch an environment variable and try to interpret its value
+# as a double.  Abort if variable is not found or cannot be converted to
+# a number.
+
+double procedure envgetd (varname)
+
+char	varname[ARB]
+
+int	ip
+double	dval
+char	val[MAX_DIGITS]
+int	ctod(), envfind()
+errchk	envfind, syserrs
+
+begin
+	ip = 1
+	if (envfind (varname, val, MAX_DIGITS) > 0)
+	    if (ctod (val, ip, dval) > 0)
+		return (dval)
+
+	call syserrs (SYS_ENVNNUM, varname)
+end
diff --git a/sys/etc/envgeti.x b/sys/etc/envgeti.x
new file mode 100644
index 00000000..a3e14190
--- /dev/null
+++ b/sys/etc/envgeti.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+
+# ENVGETI -- Fetch an environment variable and try to interpret its value
+# as an integer.  Abort if variable is not found or cannot be converted to
+# a number.
+
+int procedure envgeti (varname)
+
+char	varname[ARB]
+
+int	ival, ip
+char	val[MAX_DIGITS]
+int	ctoi(), envfind()
+errchk	envfind, syserrs
+
+begin
+	ip = 1
+	if (envfind (varname, val, MAX_DIGITS) > 0)
+	    if (ctoi (val, ip, ival) > 0)
+		return (ival)
+
+	call syserrs (SYS_ENVNNUM, varname)
+end
diff --git a/sys/etc/envgetr.x b/sys/etc/envgetr.x
new file mode 100644
index 00000000..5ec04d58
--- /dev/null
+++ b/sys/etc/envgetr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ENVGETR -- Fetch an environment variable and try to interpret its value
+# as a real.  Abort if variable is not found or cannot be converted to
+# a number.
+
+real procedure envgetr (varname)
+
+char	varname[ARB]
+double	val, envgetd()
+
+begin
+	val = envgetd (varname)
+	if (IS_INDEFD(val))
+	    return (INDEFR)
+	else
+	    return (val)
+end
diff --git a/sys/etc/envgets.x b/sys/etc/envgets.x
new file mode 100644
index 00000000..969a660d
--- /dev/null
+++ b/sys/etc/envgets.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<fset.h>
+include	"environ.h"
+
+# ENVGETS -- Search the environment list for the named environment variable
+# and return the string value if found.  If not found and the process input
+# is a terminal (the process is being run interactively in debug mode), generate
+# a query on the terminal, read the value of the environment variable, enter
+# it into the environment table, and return the value to the caller.
+
+int procedure envgets (key, value, maxch)
+
+char	key[ARB]		# environment variable name
+char	value[maxch]		# string value (output)
+int	maxch
+
+char	buf[SZ_FNAME]
+int	nchars, ttydriver, junk, in, out, ip
+int	gstrcpy(), envfind(), fstati(), strlen(), envputs()
+extern	zgetty()
+
+begin
+	# Search the environment list first.
+	nchars = envfind (key, value, maxch)
+	if (nchars >= 0)
+	    return (nchars)
+
+	# Key not found.  If the process input CLIN is a terminal, query the
+	# user for the value of the environment variable.  Only low level
+	# calls are used in the query to avoid the possibity of recursion.
+
+	call zlocpr (zgetty, ttydriver)
+	iferr {
+	    out = fstati (CLOUT, F_CHANNEL)
+	    in  = fstati (CLIN,  F_CHANNEL)
+	} then
+	    return (0)
+
+	if (fstati (CLIN, F_DEVICE) == ttydriver) {
+	    # Issue prompt, format "env.key: "
+	    call zputty (out, "env.", 4, junk)
+	    call zputty (out, key, strlen(key), junk)
+	    call zputty (out, ": ", 2, junk)
+	    call zflsty (out, junk)
+
+	    # Get value and enter in envlist, excluding the trailing newline.
+
+	    call zgetty (in, buf, SZ_FNAME, nchars)
+	    if (nchars <= 0)
+		return (0)
+	    for (ip=1;  buf[ip] != '\n' && ip <= nchars;  ip=ip+1)
+		;
+	    buf[ip] = EOS
+	    junk = envputs (key, buf)
+
+	    return (gstrcpy (buf, value, maxch))
+
+	} else
+	    return (0)
+end
diff --git a/sys/etc/envindir.x b/sys/etc/envindir.x
new file mode 100644
index 00000000..48902eee
--- /dev/null
+++ b/sys/etc/envindir.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# ENVINDIR -- Return the name of an environment variable which may be given
+# by the value of another environment variable as "@envvar".
+
+procedure envindir (envvar, outstr, maxch)
+
+char	envvar[ARB]		# possibly indirect env. variable name
+char	outstr[ARB]		# receives value of variable
+int	maxch
+
+pointer	sp, envname
+int	envfind()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (envname, SZ_FNAME, TY_CHAR)
+
+	call strcpy (envvar, outstr, maxch)
+
+	while (outstr[1] == '@') {
+	    call strcpy (outstr[2], Memc[envname], SZ_FNAME)
+	    if (envfind (Memc[envname], outstr, maxch) <= 0)
+		call syserrs (SYS_ENVNF, Memc[envname])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/etc/envinit.x b/sys/etc/envinit.x
new file mode 100644
index 00000000..3b58f444
--- /dev/null
+++ b/sys/etc/envinit.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"environ.h"
+
+# ENV_INIT -- Called by the IRAF main to initialize the environment common
+# upon process startup.
+
+procedure env_init()
+
+bool	first_time
+int	kmalloc()
+include	"environ.com"
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    if (kmalloc (envbuf, LEN_ENVBUF, TY_SHORT) == ERR)
+		call sys_panic (SYS_MFULL, "Out of memory")
+
+	    call aclrs (threads, NTHREADS)
+	    len_envbuf = LEN_ENVBUF
+	    last = NULL
+	    top = 1
+	    first_time = false
+	}
+end
diff --git a/sys/etc/environ.com b/sys/etc/environ.com
new file mode 100644
index 00000000..4a2fae17
--- /dev/null
+++ b/sys/etc/environ.com
@@ -0,0 +1,8 @@
+# Common for the environment list package.
+
+pointer	envbuf			# buffer containing the environment list
+int	len_envbuf		# length of the envbuf buffer
+int	last			# index of the last list element entered
+int	top			# index of the next list element
+short	threads[NTHREADS]	# hashed threads through list
+common	/envcom/ envbuf, len_envbuf, last, top, threads
diff --git a/sys/etc/environ.h b/sys/etc/environ.h
new file mode 100644
index 00000000..ccdc77c8
--- /dev/null
+++ b/sys/etc/environ.h
@@ -0,0 +1,28 @@
+# ENVIRON.H -- Global defines for the environment list package.
+
+# Strings may optionally be quoted in SET stmts with either ' or ".
+define	IS_QUOTE	($1 == '\'' || $1 == '"')
+
+# Size limiting definitions.
+
+define	NTHREADS	199		# number of hash threads
+define	MAX_HASHCHARS	18		# max chars to use for hashing
+define	LEN_ENVBUF	20480		# storage for environment list
+define	INC_ENVBUF	4096		# increment if overflow occurs
+define	MAX_SZKEY	32		# max chars in a key
+define	MIN_SZVALUE	20		# min allocated space for value
+define	MAX_SZVALUE	4096		# max chars in value string
+define	MAX_LENLISTELEM	(4+(MAX_SZKEY+1+MAX_SZVALUE+1+SZ_SHORT-1)/SZ_SHORT)
+
+# List element structure, stored in ENVBUF, which is allocated as an array of
+# type SHORT integer.  Each list element is aligned on a short integer boundary
+# within the array.  E_NEXT points to the next element in a thread, whereas
+# E_LASTELEM points to the last element in the envbuf (which is a stack).
+
+define	E_NEXT		Mems[$1]	# next element in thread (list)
+define	E_LASTELEM	Mems[$1+1]	# next element in envbuf
+define	E_REDEF		Mems[$1+2]	# set if element is redefined
+define	E_LEN		Mems[$1+3]	# nchars allocated for value string
+define	E_SETP		(($1+4-1)*SZ_SHORT+1)	# char pointer to name field
+define	E_SET		Memc[E_SETP($1)]	# "name=value" string
+define	E_SETOFFSET	4
diff --git a/sys/etc/environ.x b/sys/etc/environ.x
new file mode 100644
index 00000000..24e6b814
--- /dev/null
+++ b/sys/etc/environ.x
@@ -0,0 +1,315 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+include	"environ.h"
+
+.help environ
+.nf ___________________________________________________________________________
+ENVIRON -- Routines for managing the environment list.  The environment list
+is global in scope.  A process, e.g., the CL, builds up the environment list
+and passes it on to a child process when the process is spawned.
+
+       nchars = envgets (name, value, maxch)	# get value of envvar
+	redef =	envputs (name, value)		# set value of envvar
+       nchars = envfind (name, value, maxch)	# get value of envvar if def
+		envmark (sp)			# mark stack pointer
+      nredefs = envfree (sp, userfcn)		# free back to marked posn
+
+	 bool = envgetb (name)			# get boolean value of envvar
+	  int = envgeti (name)			# get integer value of envvar
+		envlist (fd, prefix, show_redefs)	# print envlist on file
+	nscan =	envscan (input_source)		# read SET stmts from a file
+
+	 el = env_first (valp)			# head of envlist
+	  el = env_next (el, valp, show_redefs) # next element of envlist
+
+The environment list is maintained as a multi-threaded linked list.  This
+provides the searching efficiency of a hash table plus stack like semantics
+for redefinitions and for freeing blocks of variables.  There are two primary
+data structures internally, an array of pointers to the heads of the threads,
+and a buffer containing the list elements.  These data structures are
+dynamically allocated and will be automatically reallocated at runtime if
+overflow occurs.  The number of threads determines the hashing efficiency and
+is a compile time parameter.
+
+The ENVMARK and ENVFREE procedures mark and free storage on the environment
+list stack.  All environment variables defined or redefined after a call to
+ENVMARK will be deleted and storage freed by a call to ENVFREE.  If a redef
+is freed the next most recent definition becomes current.  ENVFREE returns
+as its function value the number of redefined variables uncovered by the free
+operation.  The calling program must mark and free in the correct order or the
+environment list may be trashed.
+
+The ENVLIST procedure prints the environment list on a file.  Redefined values
+will only be printed if desired.  The environment list is printed as a list of
+SET statements in most recent first order, i.e.,
+
+	set nameN=valueN
+	set nameM=valueM
+	    ...
+	set name1=value1
+
+The ENVLIST function is used both to inspect the environment list and to pass
+the list on to a child process.  Redefined variables are omitted when passing
+the list on to a child process, hence the order of definition does not matter.
+The output format is "prefix name=value", where the prefix string is supplied
+by the user.
+
+The ENVSCAN function parses one or more SET statements, calling ENVPUTS to
+enter the SET declarations into the environment list.  The argument is either
+a SET declaration or a string of the form "set @filename", where "filename" is
+the name of a file containing set declarations.
+.endhelp ______________________________________________________________________
+
+
+# ENVFIND -- Search the environment list for the named environment variable
+# and return the string value if found.
+
+int procedure envfind (key, value, maxch)
+
+char	key[ARB]		# environment variable name
+char	value[maxch]		# string value (output)
+int	maxch
+
+long	sum
+pointer	el, ep
+int	head, ip, nchars
+int	envputs(), gstrcpy()
+include	"environ.com"
+
+begin
+	# Get index into envbuf of the first element of the thread.
+	if (key[1] == EOS)
+	    head = NULL
+	else {
+	    sum = 0
+	    do ip = 1, MAX_HASHCHARS {
+		if (key[ip] == EOS)
+		    break
+		sum = sum + (sum + key[ip])
+	    }
+	    head = threads[mod(sum,NTHREADS)+1]
+	}
+
+	# If thread is not empty search down it for the named key and return
+	# the value string if found.  Note that the value of the E_NEXT pointer
+	# is given as an integer offset into envbuf to facilitate reallocation
+	# upon overflow.
+
+	if (head != NULL)
+	    for (el = envbuf + head;  el > envbuf;  el = envbuf + E_NEXT(el)) {
+		ep = E_SETP(el)
+		for (ip=1;  key[ip] == Memc[ep];  ip=ip+1)
+		    ep = ep + 1
+		if (key[ip] == EOS && Memc[ep] == '=')
+		    return (gstrcpy (Memc[ep+1], value, maxch))
+	    }
+
+	# Key not found.  Ask the host system for the value of the environment
+	# variable.
+
+	call strpak (key, value, maxch)
+	call zgtenv (value, value, maxch, nchars)
+
+	if (nchars >= 0)  {
+	    call strupk (value, value, maxch)
+	    ip = envputs (key, value)
+	    return (nchars)
+	} else {
+	    value[1] = EOS
+	    return (ERR)
+	}
+end
+
+
+# ENVPUTS -- Add a new SET definition to the environment list.  A SET operation
+# is allowed to redefine a previously defined environment variable, but if the
+# new definition is a redef we return YES as the function value.  If the set
+# is a no-op (null key, or redef with the same value as previously) the envlist
+# is not modified and NO is returned as the function value.
+
+int procedure envputs (key, value)
+
+char	key[ARB]		# environment variable name
+char	value[ARB]		# string value
+
+long	sum
+int	head, thread_index, redef, ip
+pointer	el, op, ep
+
+bool	streq()
+pointer	coerce()
+int	gstrcpy(), krealloc()
+include	"environ.com"
+
+begin
+	if (key[1] == EOS)
+	    return (NO)
+
+	# Get index into envbuf of the first element of the thread.
+	sum = 0
+	do ip = 1, MAX_HASHCHARS {
+	    if (key[ip] == EOS)
+		break
+	    sum = sum + (sum + key[ip])
+	}
+
+	thread_index = mod (sum, NTHREADS) + 1
+	head = threads[thread_index]
+
+	# If thread is not empty search down it for the named key to see if we
+	# have a redefinition.  If we have a redef but the new value is the
+	# same as the old, do nothing.  Otherwise flag the element being
+	# redefined as a redefinition (so that ENVLIST can ignore it).
+
+	redef = NO
+	if (head != NULL)
+	    for (el = envbuf + head;  el > envbuf;  el = envbuf + E_NEXT(el)) {
+		ep = E_SETP(el)
+		for (ip=1;  key[ip] == Memc[ep];  ip=ip+1)
+		    ep = ep + 1
+		if (key[ip] == EOS && Memc[ep] == '=')
+		    if (streq (Memc[ep+1], value))
+			return (NO)
+		    else {
+			E_REDEF(el) = YES
+			redef = YES
+			break
+		    }
+	    }
+
+	# Append the new list element to the end of ENVBUF, increasing the size
+	# of the buffer if overflow occurs.  The list structure must be aligned
+	# on a short integer boundary.  Set the back link pointers for searches.
+
+	if (top + MAX_LENLISTELEM >= len_envbuf) {
+	    len_envbuf = len_envbuf + INC_ENVBUF
+	    if (krealloc (envbuf, len_envbuf, TY_SHORT) == ERR)
+		call sys_panic (SYS_MFULL, "Out of memory")
+	}
+
+	el = envbuf + top
+	E_NEXT(el)     = head
+	E_LASTELEM(el) = last
+	E_REDEF(el)    = NO
+
+	# Deposit the string "key=value" in the E_SET field.  At least
+	# MIN_SZVALUE chars are allocated for the value string, to permit
+	# the value to be updated via ENVRESET (possibly changing size in
+	# the process).
+
+	op = E_SETP(el)
+	op = op + gstrcpy (key, Memc[op], MAX_SZKEY)
+	Memc[op] = '='
+	op = op + 1
+	E_LEN(el) = max (MIN_SZVALUE, gstrcpy(value,Memc[op],MAX_SZVALUE))
+	op = op + E_LEN(el) + 1
+
+	last = top
+	threads[thread_index] = last
+	top = coerce (op, TY_CHAR, TY_SHORT) - envbuf
+
+	# Update the environment in any connected kernel servers.
+	call ki_envreset (key, value)
+
+	return (redef)
+end
+
+
+# ENVMARK -- Mark the position in the environment list.  A subsequent call
+# to ENVFREE with the marked position as argument will unset all elements
+# set after the marked position.
+
+procedure envmark (old_top)
+
+int	old_top			# top of envbuf stack
+include	"environ.com"
+
+begin
+	old_top = top
+end
+
+
+# ENVFREE -- Free all environment list entries set since the matching call
+# to ENVMARK.  Return as the function value the number of redefined environment
+# variables uncovered by the free operation.  If the ZLOCPR integer entry point
+# address of the user supplied function USERFCN is nonnull the function will
+# be called with the name and value of each uncovered redefinition.  The calling
+# sequence is as follows:  subroutine userfcn (name, value)
+
+int procedure envfree (old_top, userfcn)
+
+int	old_top			# top of envbuf stack
+int	userfcn			# epa of function called for uncovered redefs
+
+int	nredefs, head, i, j, t
+pointer	sp, start, namep, el1, el2, ep1, ep2
+include	"environ.com"
+
+begin
+	if (old_top < 1 || old_top >= top)
+	    return (0)
+
+	call smark (sp)
+	call salloc (namep, SZ_FNAME, TY_CHAR)
+
+	nredefs = 0
+
+	# Clear the redef flags for all list elements that are redefined by
+	# elements above the new top, and count the number of uncovered redefs.
+	# Examine only non-empty threads.
+
+	for (t=1;  t <= NTHREADS;  t=t+1) {
+	    head = threads[t]
+	    if (head != NULL) {
+		# Examine only list elements in the thread which lie above the
+		# top we are reverting to.
+
+		for (j = head;  j >= old_top;  j = E_NEXT(el1)) {
+		    el1 = envbuf + j
+
+		    # Scan down the thread to see if this is a redefinition,
+		    # and clear the redef flag if so.
+
+		    for (i = j;  i != NULL;  i = E_NEXT(el2)) {
+			el2 = envbuf + i
+			if (E_REDEF(el2) == YES) {
+			    ep1 = E_SETP(el1)
+			    ep2 = E_SETP(el2)
+			    start = ep2
+			    while (Memc[ep1] == Memc[ep2] && Memc[ep1] != '=') {
+				ep1 = ep1 + 1
+				ep2 = ep2 + 1
+			    }
+			    if (Memc[ep1] == '=') {
+				E_REDEF(el2) = NO
+				nredefs = nredefs + 1
+				if (userfcn != NULL) {
+				    call strcpy (Memc[start], Memc[namep],
+					ep2 - start)
+				    call zcall2 (userfcn,
+					Memc[namep], Memc[ep2+1])
+				}
+				break
+			    }
+			}
+		    }
+		}
+
+		# Set the head of the thread to the first element below
+		# the new top.
+
+		threads[t] = j
+	    }
+	}
+
+	# The variable OLD_TOP is the index of a list element.  Make it the
+	# new top.
+
+	top = old_top
+	last = E_LASTELEM(envbuf+top)
+
+	call sfree (sp)
+	return (nredefs)
+end
diff --git a/sys/etc/envlist.x b/sys/etc/envlist.x
new file mode 100644
index 00000000..ebd904b6
--- /dev/null
+++ b/sys/etc/envlist.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"environ.h"
+
+# ENVLIST -- Print the environment list on the output file as a sequence of
+# SET commands.  The commands are given in the reverse of the order in which
+# they were originally entered.  Printing of redefined variables may be
+# inhibited if desired.
+
+procedure envlist (fd, prefix, print_redefined_variables)
+
+int	fd			# output file
+char	prefix[ARB]		# prefix string to be prepended to each line
+int	print_redefined_variables
+pointer	el
+include	"environ.com"
+
+begin
+	for (el = envbuf + last;  el > envbuf;  el = envbuf + E_LASTELEM(el))
+	    if (E_REDEF(el) == NO || print_redefined_variables == YES) {
+		call putline (fd, prefix)
+		call putline (fd, E_SET(el))
+		call putci (fd, '\n')
+	    }
+end
diff --git a/sys/etc/envnext.x b/sys/etc/envnext.x
new file mode 100644
index 00000000..80ddf226
--- /dev/null
+++ b/sys/etc/envnext.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"environ.h"
+
+# ENV_FIRST -- Return a pointer to the first (most recently entered) entry
+# in the environment list.  A pointer to the string definition of the entry
+# is returned as the output argument.
+
+pointer procedure env_first (valp)
+
+pointer	valp			# pointer to environment string
+pointer	el
+include	"environ.com"
+
+begin
+	el = envbuf + last
+	if (el > envbuf) {
+	    valp = E_SETP(el)
+	    return (el)
+	} else
+	    return (NULL)
+end
+
+
+# ENV_NEXT -- Return a pointer to the next element in the environment list.
+# A pointer to the string value of the element is returned as the output
+# argument.
+
+pointer procedure env_next (last_el, valp, show_redefines)
+
+pointer	last_el			# pointer to last element returned
+pointer	valp			# receives charp of next element define string
+int	show_redefines		# do not skip redefined elements
+
+pointer	el
+include	"environ.com"
+
+begin
+	el = envbuf + E_LASTELEM(last_el)
+
+	while (el > envbuf) {
+	    if (E_REDEF(el) == NO || show_redefines == YES)
+		break
+	    else
+		el = envbuf + E_LASTELEM(el)
+	}
+
+	if (el > envbuf) {
+	    valp = E_SETP(el)
+	    return (el)
+	} else
+	    return (NULL)
+end
diff --git a/sys/etc/envreset.x b/sys/etc/envreset.x
new file mode 100644
index 00000000..9ca8c5d7
--- /dev/null
+++ b/sys/etc/envreset.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	"environ.h"
+
+# ENVRESET -- Update the value of the named environment variable in place.
+# This is used to permanently change the value of an environment variable,
+# unlike ENVPUTS which will create a temporary redefinition which can later
+# be discarded via ENVFREE.  A fixed amount of string storage is allocated
+# for the value string when the environment variable is first defined; if
+# the new value won't fit we simply call ENVPUTS to redefine the variable
+# at the top of the environment stack.  A more sophisticated storage
+# mechanism could be devised which could dynamically allocate more storage,
+# but the simpler scheme seems adequate at present.
+
+procedure envreset (key, value)
+
+char	key[ARB]		# environment variable name
+char	value[ARB]		# new string value
+
+long	sum
+pointer	el, ep
+int	head, ip, junk, maxch
+int	envputs(), strlen()
+include	"environ.com"
+
+begin
+	# Get index into envbuf of the first element of the thread.
+	if (key[1] == EOS)
+	    head = NULL
+	else {
+	    sum = 0
+	    do ip = 1, MAX_HASHCHARS {
+		if (key[ip] == EOS)
+		    break
+		sum = sum + (sum + key[ip])
+	    }
+	    head = threads[mod(sum,NTHREADS)+1]
+	}
+
+	# If thread is not empty search down it for the named key; if the key
+	# is redefined the most recent entry is updated.
+
+	el = NULL
+	if (head != NULL)
+	    for (el = envbuf + head;  el > envbuf;  el = envbuf + E_NEXT(el)) {
+		ep = E_SETP(el)
+		for (ip=1;  key[ip] == Memc[ep];  ip=ip+1)
+		    ep = ep + 1
+		if (key[ip] == EOS && Memc[ep] == '=')
+		    break
+	    }
+
+	# If the named key is not found or the new value won't fit add or
+	# redefine the variable, otherwise set the new value.
+
+	if (el <= envbuf)
+	    junk = envputs (key, value)
+	else if (strlen(value) > E_LEN(el))
+	    junk = envputs (key, value)
+	else {
+	    maxch = E_LEN(el)
+	    call strcpy (value, Memc[ep+1], maxch)
+	    call ki_envreset (key, value)
+	}
+end
diff --git a/sys/etc/envscan.x b/sys/etc/envscan.x
new file mode 100644
index 00000000..06f7a411
--- /dev/null
+++ b/sys/etc/envscan.x
@@ -0,0 +1,149 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"environ.h"
+
+define	MAXLEV	8			# max nesting of includes
+define	SZ_LBUF	(SZ_COMMAND+SZ_LINE)	# max length SET on a single line
+
+
+# ENVSCAN -- Parse one or more SET or RESET declarations and enter them into
+# the environment list.
+#
+# Syntax:	(set|reset) name = value	enter a definition
+#		set @filename			scan a file
+#
+# Comments, blank lines, and lines containing unrecognized statements are
+# ignored without warning.
+
+int procedure envscan (cmd)
+
+char	cmd[ARB]		# command text to begin scan
+
+char	ch
+int	fd, in, nset, lev, sv_fd[MAXLEV]
+pointer	sp, ip, op, op_top, lbuf, name, value
+int	open(), stropen(), getlline(), strmatch(), nowhite()
+errchk	open, stropen, getlline, syserrs
+string	s_reset "^#reset#"
+string	s_set "^#set#"
+define	again_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LBUF, TY_CHAR)
+	call salloc (name, MAX_SZKEY, TY_CHAR)
+	call salloc (value, MAX_SZVALUE, TY_CHAR)
+
+	# Position to after the set or reset.
+	in = strmatch (cmd, s_set)
+	if (in == 0) {
+	    in = strmatch (cmd, s_reset)
+	    if (in == 0) {
+		call sfree (sp)
+		return (0)
+	    }
+	}
+
+	# Open the input to be scanned.
+	if (cmd[in] == '@')
+	    fd = open (cmd[in+1], READ_ONLY, TEXT_FILE)
+	else
+	    fd = stropen (cmd, ARB, READ_ONLY)
+
+	# Process all SET or RESET statements in the file.  Ignore all other
+	# statements.
+
+	nset = 0
+	lev  = 0
+
+	repeat {
+	    # Get the next SET statement into lbuf, leave IN at index of first
+	    # char of the name field.
+
+	    if (getlline (fd, Memc[lbuf], SZ_LBUF) == EOF) {
+		if (lev > 0) {
+		    call close (fd)
+		    fd = sv_fd[lev]
+		    lev = lev - 1
+		    next
+		} else
+		    break
+	    } else if (Memc[lbuf] == '\n' || Memc[lbuf] == '#') {
+		next
+	    } else {
+		in = strmatch (Memc[lbuf], s_set)
+		if (in == 0)
+		    in = strmatch (Memc[lbuf], s_reset)
+
+		if (in <= 0)
+		    next
+		else if (Memc[lbuf+in-1] == '@') {
+		    ch = nowhite (Memc[lbuf+in], Memc[lbuf], SZ_LINE)
+		    lev = lev + 1
+		    if (lev > MAXLEV)
+			call syserrs (SYS_FOPEN, Memc[lbuf])
+		    sv_fd[lev] = fd
+		    fd = open (Memc[lbuf], READ_ONLY, TEXT_FILE)
+		    next
+		}
+	    }
+
+	    # Parse the name and value strings and enter into the environment
+	    # list.  Ignore optional quotes and whitespace.  Ignore rest of
+	    # line following the value field.
+
+	    op = name
+	    op_top = name + MAX_SZKEY
+	    ip = lbuf + in - 1
+	    for (ch=Memc[ip];  ch != '=' && ch != EOS;  ch=Memc[ip]) {
+		if (!IS_QUOTE(ch) && !IS_WHITE(ch)) {
+		    Memc[op] = Memc[ip]
+		    op = min (op_top, op + 1)
+		}
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+
+	    op = value
+	    if (Memc[ip] == '=') {
+		ip = ip + 1
+		while (IS_WHITE(Memc[ip]) || IS_QUOTE(Memc[ip]))
+		    ip = ip + 1
+		op_top = value + MAX_SZVALUE
+
+		for (ch=Memc[ip];  ch != EOS;  ch=Memc[ip]) {
+		    if (IS_QUOTE(ch) || ch == '\n') {
+			break
+
+		    } else if (ch == '\\' && Memc[ip+1] == '\n') {
+again_			if (getlline (fd, Memc[lbuf], SZ_LBUF) == EOF)
+			    break
+
+			# Skip leading whitespace on the continuation line.
+			for (ip=lbuf;  IS_WHITE(Memc[ip]);  ip=ip+1)
+			    ;
+			# Check for a commented out continuation line.
+			if (Memc[ip] == '#')
+			    goto again_
+
+		    } else {
+			Memc[op] = ch
+			op = min (op_top, op + 1)
+			ip = ip + 1
+		    }
+		}
+	    }
+	    Memc[op] = EOS
+
+	    # Enter the SET definition into the environment list.
+	    call envreset (Memc[name], Memc[value])
+	    nset = nset + 1
+	}
+
+	call close (fd)
+	call sfree (sp)
+
+	return (nset)
+end
diff --git a/sys/etc/erract.x b/sys/etc/erract.x
new file mode 100644
index 00000000..5400544d
--- /dev/null
+++ b/sys/etc/erract.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<error.h>
+
+.help erract
+.nf _________________________________________________________________________
+ERRACT -- Take error action.  Called by FATAL, and by ERROR if a handler
+is not posted.  May be called by a user error handler to pass an error
+back up to the handler at the next level, or to change the severity of
+an error.  Warning messages are posted to the standard error output, 
+whereas fatal errors result in error recovery followed by transmission of
+the ERROR statement to the CL.
+
+Error restart consists of the following steps:
+
+    (1) The IRAF main is restarted with the error code as argument.
+    (2) The main goes through error recovery.  Error recovery consists
+	of cleaning up the files system, i.e., closing open files and
+	deleting NEW_FILES and TEMP_FILES, clearing the stack, and calling
+	any procedures posted with ONERROR.  
+    (3) The ERROR statement is sent to the CL.  An example of the
+	error statment is "ERROR (501, "Access Violation")".
+    (4) The main either waits for the next command, or if run from the CL
+	and the error code is SYS_XINT (a CL kill in response to a keyboard
+	interrupt), the main returns, shutting the process down.  Procedures
+	posted with ONEXIT are called when the process shuts down.
+
+Any errors occuring during error restart or while executing the ONEXIT
+procedures are fatal and result in immediate process termination, usually
+with a panic error message.  This is necessary to prevent infinite error
+recursion.  Also, if we are killed by the CL we should die and not hang up
+trying to send error messages to the CL.
+.endhelp ____________________________________________________________________
+
+procedure erract (severity)
+
+int	severity
+int	op, jumpbuf[LEN_JUMPBUF]
+char	wmsg[SZ_LINE]
+int	gstrcpy()
+include	"error.com"
+common	/JUMPCOM/ jumpbuf
+
+begin
+	# Clear error restart condition.  Called by the IRAF Main
+	# after successful completion of error recovery.
+
+	if (severity == EA_RESTART) {
+	    err_restart = err_restart + 1
+	    xerflg = false
+	    return
+	} else if (severity == OK) {
+	    err_restart = 0
+	    xerflg = false
+	    return
+	}
+
+	# Any uncaught errors occuring during error restart are fatal and
+	# will result in process termination.  This is necessary to prevent
+	# recursion and to ensure that a process killed by the CL dies if
+	# it cannot complete cleanup and shutdown without errors.  If error
+	# recursion occurs we will be called repeatedly, causing the counter
+	# to be incremented until a panic abort occurs.
+
+	if (severity != EA_WARN && err_restart > 2) {
+	    call xer_fmterrmsg (xermsg, xermsg, SZ_XERMSG)
+	    call sys_panic (xercod, xermsg)
+	}
+
+	# If a handler is posted, set flag and return, deferring error
+	# recovery to the user handler.  If warning message, merely put
+	# message to stderr.  Otherwise initiate error recovery by restarting
+	# the IRAF main.  This sounds reentrant, but it is not since it is an
+	# error restart using ZDOJMP.  The ERROR statement is not sent to
+	# the CL until error recovery has completed.
+
+	if (severity == EA_ERROR && nhandlers > 0)
+	    xerflg = true
+	else {
+	    call xer_fmterrmsg (xermsg, xermsg, SZ_XERMSG)
+	    if (severity == EA_WARN) {
+		op =      gstrcpy ("Warning: ", wmsg, SZ_LINE) + 1
+		op = op + gstrcpy (xermsg, wmsg[op], SZ_LINE - op + 1)
+		wmsg[op]   = '\n'
+		wmsg[op+1] = EOS
+		call xer_putline (STDERR, wmsg)
+	    } else {
+		err_restart = err_restart + 1
+		call zdojmp (jumpbuf, xercod)		# Restart IRAF main.
+	    }
+	}
+end
diff --git a/sys/etc/errcode.x b/sys/etc/errcode.x
new file mode 100644
index 00000000..99df994b
--- /dev/null
+++ b/sys/etc/errcode.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# ERRCODE -- Return the integer code of the last error posted.  The error
+# code is set to a positive nonnegative integer by a call to ERROR or
+# FATAL, and is cleared (set to OK) whenever an IFERR block is entered.
+# Note that if we are called from within an error handler (true part of
+# an IFERR block), xerflg is false, so we cannot test xerflg to see if
+# an error occurred.
+
+int procedure errcode()
+
+include	"error.com"
+
+begin
+	return (xercod)
+end
diff --git a/sys/etc/errget.x b/sys/etc/errget.x
new file mode 100644
index 00000000..e2ba10a9
--- /dev/null
+++ b/sys/etc/errget.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# ERRGET -- Return the integer code and descriptive error message string
+# of the last error posted.  The error code is set to a positive nonnegative
+# integer by a call to ERROR or FATAL, and is cleared (set to OK) whenever
+# an IFERR block is entered.  Note that if we are called from within an error
+# handler (true part of an IFERR block), xerflg is false, so we cannot test
+# xerflg to see if an error occurred.
+
+int procedure errget (outstr, maxch)
+
+char	outstr[maxch]		# error message
+int	maxch
+include	"error.com"
+
+begin
+	call xer_fmterrmsg (xermsg, outstr, maxch)
+	return (xercod)
+end
diff --git a/sys/etc/error.com b/sys/etc/error.com
new file mode 100644
index 00000000..2a7257f1
--- /dev/null
+++ b/sys/etc/error.com
@@ -0,0 +1,7 @@
+
+bool	xerflg			# set when error is posted
+int	xercod			# error code
+int	nhandlers		# handler nesting level
+int	err_restart		# YES during error restart, NO otherwise
+char	xermsg[SZ_XERMSG]	# error message string
+common	/xercom/ xerflg,xercod,nhandlers,err_restart,xermsg
diff --git a/sys/etc/error.x b/sys/etc/error.x
new file mode 100644
index 00000000..42c390b5
--- /dev/null
+++ b/sys/etc/error.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# ERROR -- Take an error action.  A call to ERROR does not necessarily
+# terminate task execution, i.e., if an IFERR error handler is posted it
+# will receive control after the procedure call stack is unwound back
+# to the procedure containing the error handler.
+
+procedure error (error_code, message)
+
+int	error_code		# positive error code identifying error
+char	message[ARB]		# error message describing error
+include	"error.com"
+
+begin
+	if (xerflg) {					# error already posted?
+	    if (max(error_code,1) == xercod)
+		return					# same error again
+	    else
+		call erract (EA_FATAL)			# too many errors
+	}
+
+	call xeract (error_code, message, EA_ERROR)
+end
+
+
+# FATAL -- Called when a fatal (irrecoverable) error occurs.  Fatal errors
+# cannot be caught by IFERR handlers.  The calling task is terminated and
+# error recovery is initiated in the IRAF Main.
+
+procedure fatal (error_code, message)
+
+int	error_code		# positive error code identifying error
+char	message[ARB]		# error message describing error
+
+begin
+	call xeract (error_code, message, EA_FATAL)
+end
+
+
+# XERACT -- Take an error action; called by ERROR or FATAL.
+
+procedure xeract (error_code, message, severity)
+
+int	error_code		# positive error code identifying error
+char	message[ARB]		# error message describing error
+int	severity		# severity of the error
+include	"error.com"
+
+begin
+	xerflg = true					# post error
+	xercod = max (1, error_code)
+	call strcpy (message, xermsg, SZ_XERMSG)
+
+	if (nhandlers > 0 && severity == EA_ERROR)	# is a handler posted?
+	    return
+	else
+	    call erract (severity)			# take error action
+end
diff --git a/sys/etc/gen/miireadd.x b/sys/etc/gen/miireadd.x
new file mode 100644
index 00000000..de15b8c1
--- /dev/null
+++ b/sys/etc/gen/miireadd.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_readd (fd, spp, maxelem)
+
+int	fd			#I input file
+double	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_DOUBLE)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_DOUBLE) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_DOUBLE))
+		call miiupkd (Memc[bp], spp, nelem, TY_DOUBLE)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_DOUBLE))
+		call miiupkd (spp, spp, nelem, TY_DOUBLE)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/miireadi.x b/sys/etc/gen/miireadi.x
new file mode 100644
index 00000000..666166e6
--- /dev/null
+++ b/sys/etc/gen/miireadi.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_readi (fd, spp, maxelem)
+
+int	fd			#I input file
+int	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_INT)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_INT) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_INT))
+		call miiupki (Memc[bp], spp, nelem, TY_INT)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_INT))
+		call miiupki (spp, spp, nelem, TY_INT)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/miireadl.x b/sys/etc/gen/miireadl.x
new file mode 100644
index 00000000..7a43688c
--- /dev/null
+++ b/sys/etc/gen/miireadl.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_readl (fd, spp, maxelem)
+
+int	fd			#I input file
+long	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_LONG)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_LONG) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_LONG))
+		call miiupkl (Memc[bp], spp, nelem, TY_LONG)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_LONG))
+		call miiupkl (spp, spp, nelem, TY_LONG)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/miireadr.x b/sys/etc/gen/miireadr.x
new file mode 100644
index 00000000..f3cded45
--- /dev/null
+++ b/sys/etc/gen/miireadr.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_readr (fd, spp, maxelem)
+
+int	fd			#I input file
+real	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_REAL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_REAL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_REAL))
+		call miiupkr (Memc[bp], spp, nelem, TY_REAL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_REAL))
+		call miiupkr (spp, spp, nelem, TY_REAL)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/miireads.x b/sys/etc/gen/miireads.x
new file mode 100644
index 00000000..acd7481a
--- /dev/null
+++ b/sys/etc/gen/miireads.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_reads (fd, spp, maxelem)
+
+int	fd			#I input file
+short	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_SHORT)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_SHORT) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_SHORT))
+		call miiupks (Memc[bp], spp, nelem, TY_SHORT)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_SHORT))
+		call miiupks (spp, spp, nelem, TY_SHORT)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/miiwrited.x b/sys/etc/gen/miiwrited.x
new file mode 100644
index 00000000..0b8d45c1
--- /dev/null
+++ b/sys/etc/gen/miiwrited.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_writed (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_DOUBLE)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipakd (spp, Memc[bp], nelem, TY_DOUBLE)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/miiwritei.x b/sys/etc/gen/miiwritei.x
new file mode 100644
index 00000000..aa52be4a
--- /dev/null
+++ b/sys/etc/gen/miiwritei.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_writei (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_INT)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipaki (spp, Memc[bp], nelem, TY_INT)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/miiwritel.x b/sys/etc/gen/miiwritel.x
new file mode 100644
index 00000000..f9b800a5
--- /dev/null
+++ b/sys/etc/gen/miiwritel.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_writel (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_LONG)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipakl (spp, Memc[bp], nelem, TY_LONG)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/miiwriter.x b/sys/etc/gen/miiwriter.x
new file mode 100644
index 00000000..94dcec38
--- /dev/null
+++ b/sys/etc/gen/miiwriter.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_writer (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_REAL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipakr (spp, Memc[bp], nelem, TY_REAL)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/miiwrites.x b/sys/etc/gen/miiwrites.x
new file mode 100644
index 00000000..ec2f48aa
--- /dev/null
+++ b/sys/etc/gen/miiwrites.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_writes (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_SHORT)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipaks (spp, Memc[bp], nelem, TY_SHORT)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/mkpkg b/sys/etc/gen/mkpkg
new file mode 100644
index 00000000..5437d80d
--- /dev/null
+++ b/sys/etc/gen/mkpkg
@@ -0,0 +1,30 @@
+# Make the ETC portion of the system library libsys.a.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	miireadd.x	<mii.h>
+	miireadi.x	<mii.h>
+	miireadl.x	<mii.h>
+	miireadr.x	<mii.h>
+	miireads.x	<mii.h>
+	miiwrited.x	<mii.h>
+	miiwritei.x	<mii.h>
+	miiwritel.x	<mii.h>
+	miiwriter.x	<mii.h>
+	miiwrites.x	<mii.h>
+
+	nmireadd.x	<nmi.h>
+	nmireadi.x	<nmi.h>
+	nmireadl.x	<nmi.h>
+	nmireadr.x	<nmi.h>
+	nmireads.x	<nmi.h>
+	nmiwrited.x	<nmi.h>
+	nmiwritei.x	<nmi.h>
+	nmiwritel.x	<nmi.h>
+	nmiwriter.x	<nmi.h>
+	nmiwrites.x	<nmi.h>
+	;
diff --git a/sys/etc/gen/nmireadb.x b/sys/etc/gen/nmireadb.x
new file mode 100644
index 00000000..c3c0f75e
--- /dev/null
+++ b/sys/etc/gen/nmireadb.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMIREAD -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readb (fd, spp, maxelem)
+
+int	fd			#I input file
+bool	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_BOOL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_BOOL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_BOOL))
+		call nmiupkb (Memc[bp], spp, nelem, TY_BOOL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_BOOL))
+		call nmiupkb (spp, spp, nelem, TY_BOOL)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmireadd.x b/sys/etc/gen/nmireadd.x
new file mode 100644
index 00000000..2d7c086a
--- /dev/null
+++ b/sys/etc/gen/nmireadd.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readd (fd, spp, maxelem)
+
+int	fd			#I input file
+double	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_DOUBLE)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_DOUBLE) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_DOUBLE))
+		call nmiupkd (Memc[bp], spp, nelem, TY_DOUBLE)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_DOUBLE))
+		call nmiupkd (spp, spp, nelem, TY_DOUBLE)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmireadi.x b/sys/etc/gen/nmireadi.x
new file mode 100644
index 00000000..c07d5914
--- /dev/null
+++ b/sys/etc/gen/nmireadi.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readi (fd, spp, maxelem)
+
+int	fd			#I input file
+int	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_INT)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_INT) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_INT))
+		call nmiupki (Memc[bp], spp, nelem, TY_INT)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_INT))
+		call nmiupki (spp, spp, nelem, TY_INT)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmireadl.x b/sys/etc/gen/nmireadl.x
new file mode 100644
index 00000000..888beedf
--- /dev/null
+++ b/sys/etc/gen/nmireadl.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readl (fd, spp, maxelem)
+
+int	fd			#I input file
+long	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_LONG)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_LONG) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_LONG))
+		call nmiupkl (Memc[bp], spp, nelem, TY_LONG)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_LONG))
+		call nmiupkl (spp, spp, nelem, TY_LONG)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmireadr.x b/sys/etc/gen/nmireadr.x
new file mode 100644
index 00000000..e8338400
--- /dev/null
+++ b/sys/etc/gen/nmireadr.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readr (fd, spp, maxelem)
+
+int	fd			#I input file
+real	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_REAL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_REAL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_REAL))
+		call nmiupkr (Memc[bp], spp, nelem, TY_REAL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_REAL))
+		call nmiupkr (spp, spp, nelem, TY_REAL)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmireads.x b/sys/etc/gen/nmireads.x
new file mode 100644
index 00000000..190ce28f
--- /dev/null
+++ b/sys/etc/gen/nmireads.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_reads (fd, spp, maxelem)
+
+int	fd			#I input file
+short	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_SHORT)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_SHORT) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_SHORT))
+		call nmiupks (Memc[bp], spp, nelem, TY_SHORT)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_SHORT))
+		call nmiupks (spp, spp, nelem, TY_SHORT)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/gen/nmiwriteb.x b/sys/etc/gen/nmiwriteb.x
new file mode 100644
index 00000000..9e3c19a0
--- /dev/null
+++ b/sys/etc/gen/nmiwriteb.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMIWRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writeb (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_BOOL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipakb (spp, Memc[bp], nelem, TY_BOOL)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/nmiwrited.x b/sys/etc/gen/nmiwrited.x
new file mode 100644
index 00000000..d357fe4c
--- /dev/null
+++ b/sys/etc/gen/nmiwrited.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writed (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_DOUBLE)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipakd (spp, Memc[bp], nelem, TY_DOUBLE)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/nmiwritei.x b/sys/etc/gen/nmiwritei.x
new file mode 100644
index 00000000..98e33f12
--- /dev/null
+++ b/sys/etc/gen/nmiwritei.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writei (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_INT)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipaki (spp, Memc[bp], nelem, TY_INT)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/nmiwritel.x b/sys/etc/gen/nmiwritel.x
new file mode 100644
index 00000000..0772b954
--- /dev/null
+++ b/sys/etc/gen/nmiwritel.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writel (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_LONG)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipakl (spp, Memc[bp], nelem, TY_LONG)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/nmiwriter.x b/sys/etc/gen/nmiwriter.x
new file mode 100644
index 00000000..3f22404b
--- /dev/null
+++ b/sys/etc/gen/nmiwriter.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writer (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_REAL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipakr (spp, Memc[bp], nelem, TY_REAL)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gen/nmiwrites.x b/sys/etc/gen/nmiwrites.x
new file mode 100644
index 00000000..ed284024
--- /dev/null
+++ b/sys/etc/gen/nmiwrites.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writes (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_SHORT)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipaks (spp, Memc[bp], nelem, TY_SHORT)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gethost.x b/sys/etc/gethost.x
new file mode 100644
index 00000000..029a9a0d
--- /dev/null
+++ b/sys/etc/gethost.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETHOST -- Get the network name of the host machine.
+
+procedure gethost (outstr, maxch)
+
+char	outstr[maxch]		# receives host name string
+int	maxch
+
+begin
+	call zghost (outstr, maxch)
+	call strupk (outstr, outstr, maxch)
+end
diff --git a/sys/etc/getpid.x b/sys/etc/getpid.x
new file mode 100644
index 00000000..6665a55e
--- /dev/null
+++ b/sys/etc/getpid.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETPID -- Get the process id.
+
+int procedure getpid()
+
+int	pid
+
+begin
+	call zgtpid (pid)
+	return (pid)
+end
diff --git a/sys/etc/getuid.x b/sys/etc/getuid.x
new file mode 100644
index 00000000..3da5bbba
--- /dev/null
+++ b/sys/etc/getuid.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETUID -- Get user id, i.e., return the name of the user.  We do this by
+# creating a temporary file and calling fowner to get the name of the file
+# owner.
+
+procedure getuid (user_name, maxch)
+
+char	user_name[ARB]
+int	maxch
+pointer	sp, tempfile
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (tempfile, SZ_FNAME, TY_CHAR)
+
+	call mktemp ("tmp$uid", Memc[tempfile], SZ_FNAME)
+	call close (open (Memc[tempfile], NEW_FILE, BINARY_FILE))
+	call fowner (Memc[tempfile], user_name, maxch)
+	call delete (Memc[tempfile])
+
+	call sfree (sp)
+end
diff --git a/sys/etc/gmtcnv.x b/sys/etc/gmtcnv.x
new file mode 100644
index 00000000..7713c9c0
--- /dev/null
+++ b/sys/etc/gmtcnv.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GMTCNV.X -- GMT (Greenwich mean time) to LST (local standard time, or clock
+# time) conversions.
+#
+#          gmt = lsttogmt (lst)                 # lst/gmt are in seconds
+#          lst = gmttolst (gmt)                 # lst/gmt are in seconds
+
+
+
+# GMTTOLST -- Convert a long integer value in GMT seconds to LST seconds.
+
+long procedure gmttolst (gmt)
+
+long	gmt			# GMT in seconds
+int	gmtco
+
+begin
+	call zgmtco (gmtco)
+	return (gmt - gmtco)
+end
+
+
+
+# LSTTOGMT -- Convert a long integer value in LST seconds to GMT seconds.
+
+long procedure lsttogmt (lst)
+
+long	lst			# LST in seconds
+int	gmtco
+
+begin
+	call zgmtco (gmtco)
+	return (lst + gmtco)
+end
diff --git a/sys/etc/gqsort.x b/sys/etc/gqsort.x
new file mode 100644
index 00000000..8092aa29
--- /dev/null
+++ b/sys/etc/gqsort.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR 	32			# log2(maxpts)  (4e9)
+
+# GQSORT -- General quicksort for arbitrary objects.  X is an integer array
+# indexing the array to be sorted.  The user supplied COMPARE function is used
+# to compare objects indexed by X:
+# 
+# 	-1,0,1 = compare (arg, x1, x2)
+# 
+# where the value returned by COMPARE has the following significance:
+# 
+# 	-1	obj[x1]  < obj[x2]
+# 	 0	obj[x1] == obj[x2]
+# 	 1	obj[x1]  > obj[x2]
+# 
+# The value ARG is private to the compare routine and is merely passed on to
+# the compare routine by gqsort.  This allows context data to be passed to
+# the compare routine without the need for initialization routines or commons.
+# QSORT reorders the elements of the X array, which must be of type integer.
+
+procedure gqsort (x, nelem, compare, arg)
+
+int	x[ARB]			#U array to be sorted
+int	nelem			#I number of elements in array
+extern	compare()		#I function to be called to compare elements
+int	arg			#I private data to be passed to compare func
+
+int	i, j, k, lv[LOGPTR], p, pivot, uv[LOGPTR], temp
+define	swap {temp=$1;$1=$2;$2=temp}
+int	compare()
+
+begin
+	lv[1] = 1
+	uv[1] = nelem
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy loop to trigger the optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # subfile, to avoid quadratic behavior on an already
+		    # sorted list.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (x[j], x[k])
+		    pivot = x[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  compare (arg, x[i], pivot) < 0;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (compare (arg, x[j], pivot) <= 0)
+				break
+			if (i < j)			# out of order pair
+			    swap (x[i], x[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (x[i], x[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/etc/intr.x b/sys/etc/intr.x
new file mode 100644
index 00000000..e30d610c
--- /dev/null
+++ b/sys/etc/intr.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<xwhen.h>
+
+define	LEN_SAVE	10
+
+# INTR_DISABLE, INTR_ENABLE -- Disable interrupts to protect a critical
+# section of code.  The interrupt handler is saved on a stack and restored
+# when interupts are reenabled.
+
+procedure intr_disable()
+
+int	sp
+int	save[LEN_SAVE]
+common	/zintde/ sp, save
+
+begin
+	sp = sp + 1
+	if (sp > LEN_SAVE)
+	    call sys_panic (1, "interrupt save stack overflow")
+
+	call zxwhen (X_INT, X_IGNORE, save[sp])
+end
+
+
+# INTR_ENABLE -- Reenable interrupts (restore saved interrupt handler).
+
+procedure intr_enable()
+
+int	junk
+int	sp
+int	save[LEN_SAVE]
+common	/zintde/ sp, save
+
+begin
+	if (sp <= 0)
+	    call sys_panic (1, "interrupt save stack underflow")
+
+	call zxwhen (X_INT, save[sp], junk)
+	sp = sp - 1
+end
+
+
+# INTR_RESET -- Clear the interrupt handler save stack.
+
+procedure intr_reset()
+
+int	sp
+int	save[LEN_SAVE]
+common	/zintde/ sp, save
+
+begin
+	sp = 0
+end
diff --git a/sys/etc/itob.x b/sys/etc/itob.x
new file mode 100644
index 00000000..e01c6302
--- /dev/null
+++ b/sys/etc/itob.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ITOB -- Convert integer to boolean.
+
+bool procedure itob (integer_value)
+
+int	integer_value
+
+begin
+	if (integer_value == NO)
+	    return (false)
+	else
+	    return (true)
+end
diff --git a/sys/etc/lineoff.x b/sys/etc/lineoff.x
new file mode 100644
index 00000000..23fe9050
--- /dev/null
+++ b/sys/etc/lineoff.x
@@ -0,0 +1,113 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# LINEOFF -- Textfile line offset package.  This is a simple little package
+# used to keep track of the file offsets of the lines in a text file.
+# The entry points are as follows.
+#
+#	  lp = lno_open (maxlines)
+#	      lno_close (lp)
+#	       lno_save (lp, line, loffset, tag)
+#    OK|ERR = lno_fetch (lp, line, loffset, tag)
+#
+# The SAVE procedure is used to save line offsets in the database, and the
+# FETCH procedure is used to look up line offsets, returning ERR if the offset
+# of the line is not stored.
+
+define	MIN_NLINES	64
+define	LEN_LNODES	5
+define	LNO_MAXLINES	Memi[$1]	# number of lines stored
+define	LNO_SLOT	Memi[$1+1]	# cycles around available slots
+define	LNO_LINENUMP	Memi[$1+2]	# pointer to array of line numbers
+define	LNO_LINEOFFP	Memi[$1+3]	# pointer to array of line offsets
+define	LNO_LINETAGP	Memi[$1+4]	# pointer to array of line tags
+
+# LNO_OPEN -- Open the line offset descriptor.
+
+pointer procedure lno_open (maxlines)
+
+int	maxlines	# max lines to store offsets for
+int	nlines
+pointer	lp
+errchk	calloc, malloc
+
+begin
+	nlines = max (MIN_NLINES, maxlines)
+
+	call calloc (lp, LEN_LNODES, TY_STRUCT)
+	LNO_MAXLINES(lp) = nlines
+	call calloc (LNO_LINENUMP(lp), nlines, TY_LONG)
+	call malloc (LNO_LINEOFFP(lp), nlines, TY_LONG)
+	call malloc (LNO_LINETAGP(lp), nlines, TY_LONG)
+
+	return (lp)
+end
+
+
+# LNO_CLOSE -- Return the line offset descriptor.
+
+procedure lno_close (lp)
+
+pointer	lp		# line offset descriptor
+
+begin
+	call mfree (LNO_LINENUMP(lp), TY_LONG)
+	call mfree (LNO_LINEOFFP(lp), TY_LONG)
+	call mfree (LNO_LINETAGP(lp), TY_LONG)
+	call mfree (lp, TY_STRUCT)
+end
+
+
+# LNO_SAVE -- Save a line number/offset pair in the LNO database.
+
+procedure lno_save (lp, line, loffset, ltag)
+
+pointer	lp		# line offset descriptor
+int	line		# line number
+long	loffset		# line offset from NOTE
+long	ltag		# tag value assoc. with line
+int	slot
+
+begin
+	slot = LNO_SLOT(lp) + 1
+	if (slot > LNO_MAXLINES(lp))
+	    slot = 1
+	LNO_SLOT(lp) = slot
+
+	Memi[LNO_LINENUMP(lp)+slot-1] = line
+	Meml[LNO_LINEOFFP(lp)+slot-1] = loffset
+	Meml[LNO_LINETAGP(lp)+slot-1] = ltag
+end
+
+
+# LNO_FETCH -- Search the LNO database for an entry for the indicated line and
+# return its file offset if found.  No assumptions are made about the ordering
+# of the data since lines could have been entered in any order.  ERR is
+# returned if the line is not found in the database.  A simple linear search
+# is sufficient given that the applications using this package are not expected
+# to look up a line often.
+
+int procedure lno_fetch (lp, line, loffset, ltag)
+
+pointer	lp		# line offset descriptor
+int	line		# line number to search for
+long	loffset		# receives line offset if entry for line is found
+long	ltag		# receives tag value assoc. with line
+
+int	maxl, i
+pointer	nump, offp, tagp
+
+begin
+	maxl = LNO_MAXLINES(lp) - 1
+	nump = LNO_LINENUMP(lp)
+	offp = LNO_LINEOFFP(lp)
+	tagp = LNO_LINETAGP(lp)
+	
+	do i = 0, maxl
+	    if (Memi[nump+i] == line) {
+		loffset = Meml[offp+i]
+		ltag = Meml[tagp+i]
+		return (OK)
+	    }
+
+	return (ERR)
+end
diff --git a/sys/etc/locpr.x b/sys/etc/locpr.x
new file mode 100644
index 00000000..3af66d1d
--- /dev/null
+++ b/sys/etc/locpr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# LOCPR -- Return the entry point address of a procedure, suitable for input
+# to a ZCALL prcocedure to call the target procedure indirectly.
+
+int procedure locpr (proc)
+
+extern	proc()			# external procedure
+int	epa
+
+begin
+	call zlocpr (proc, epa)
+	return (epa)
+end
diff --git a/sys/etc/locva.x b/sys/etc/locva.x
new file mode 100644
index 00000000..d3cc3bea
--- /dev/null
+++ b/sys/etc/locva.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# LOCVA -- Return the address (in CHAR units) of a variable.
+
+int procedure locva (variable)
+
+int	variable		# data object to be addressed
+int	address
+
+begin
+	call zlocva (variable, address)
+	return (address)
+end
diff --git a/sys/etc/lpopen.x b/sys/etc/lpopen.x
new file mode 100644
index 00000000..4754e779
--- /dev/null
+++ b/sys/etc/lpopen.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+
+define	LP_INACTIVE	0
+define	LP_READ		1
+define	LP_WRITE	2
+define	(LPCOM,	common /lprcom/ lp_type, lp_nbytes)
+
+# LPOPEN -- Open the line printer device as a text or binary file.  If opened
+# as a text file, we arrange for the chars to be packed upon output, but in all
+# cases the printer device appears to be a streaming binary file to FIO.
+# If the printer device is opened as a binary file, the data stream is passed
+# directly on to the device without modification.  To simplify things a little
+# we permit only one printer to be open at a time; this restriction can easily
+# be removed should it prove desirable.
+
+int procedure lpopen (device, mode, type)
+
+char	device[ARB]
+int	mode, type
+
+int	fd
+int	lp_type, lp_nbytes
+bool	streq()
+int	fopnbf()
+extern	zopnlp(), lp_zaread(), lp_zawrite(), lp_zawait(), zsttlp(), zclslp()
+LPCOM
+
+begin
+	# The TEXT device is special; it has a termcap entry and is used to
+	# format text for an ASCII textfile rather than a printer.
+
+	if (streq (device, "text"))
+	    fd = STDOUT
+	else {
+	    lp_type   = type
+	    lp_nbytes = ERR
+	    fd = fopnbf (device, mode,
+		zopnlp, lp_zaread, lp_zawrite, lp_zawait, zsttlp, zclslp)
+	}
+
+	return (fd)
+end
+
+
+# LP_ZAREAD -- FIO z-aread routine for the line printer device.  FIO calls
+# us with the size of the buffer in bytes.  If the printer is opened as a
+# text file, we read a factor of SZB_CHAR less than that from the lowest
+# level, then unpack the data inplace in the FIO buffer.
+
+procedure lp_zaread (chan, buf, maxbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	maxbytes
+long	offset			# ignore, since lp is streaming device
+
+int	nbytes
+int	lp_type, lp_nbytes
+LPCOM
+
+begin
+	nbytes = maxbytes
+	if (lp_type == TEXT_FILE)
+	    nbytes = nbytes / SZB_CHAR
+
+	call zardlp (chan, buf, nbytes, offset)
+	call zawtlp (chan, lp_nbytes)
+
+	if (lp_nbytes > 0 && lp_type == TEXT_FILE)
+	    call chrupk (buf, 1, buf, 1, lp_nbytes)
+end
+
+
+# LP_ZAWRITE -- FIO z-awrite routine for the line printer device.  FIO calls
+# us with the size of the buffer in bytes.  If the printer is opened as a
+# text file, we first pack the data inplace in the FIO buffer, then write it
+# out to the device.  It is ok to modify the data directly in the FIO buffer
+# since the device is a streaming device (no seeks).
+
+procedure lp_zawrite (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset			# ignore, since lp is streaming device
+
+int	nbytes_to_write
+int	lp_type, lp_nbytes
+LPCOM
+
+begin
+	nbytes_to_write = nbytes
+	if (lp_type == TEXT_FILE) {
+	    nbytes_to_write = nbytes_to_write / SZB_CHAR
+	    call chrpak (buf, 1, buf, 1, nbytes_to_write)
+	}
+
+	call zawrlp (chan, buf, nbytes_to_write, offset)
+	call zawtlp (chan, lp_nbytes)
+end
+
+
+# LP_ZAWAIT -- Wait for i/o to the line printer to complete.  We do not bother
+# with truely asynchronous i/o for line printer devices.
+
+procedure lp_zawait (chan, nbytes)
+
+int	chan
+int	nbytes
+int	lp_type, lp_nbytes
+LPCOM
+
+begin
+	nbytes = lp_nbytes
+end
diff --git a/sys/etc/maideh.x b/sys/etc/maideh.x
new file mode 100644
index 00000000..d0850deb
--- /dev/null
+++ b/sys/etc/maideh.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<xwhen.h>
+include	<syserr.h>
+include	<fset.h>
+
+define	SZ_ERRMSG	SZ_LINE
+
+# MA_IDEH -- Iraf Main routine which installs the default exception handler.
+# A single handler processes all exceptions.
+
+procedure ma_ideh()
+
+extern	xstdexh()
+int	junk, i, epa_standard_handler
+int	exception[4]
+data	exception /X_ACV, X_INT, X_ARITH, X_IPC/
+
+begin
+	call zlocpr (xstdexh, epa_standard_handler)
+	do i = 1, 4
+	    call xwhen (exception[i], epa_standard_handler, junk)
+
+	# Initialize the critical section protection stack.
+	call intr_reset()
+end
+
+
+# XSTDEXH -- Standard exception handler.  Unless the user code posts a handler
+# for a particular exception, this handler will gain control.
+
+procedure xstdexh (exception, next_handler)
+
+int	exception			# code for exception
+int	next_handler			# EPA of next handler to be called
+
+char	os_errmsg[SZ_ERRMSG]
+int	os_errcode
+
+begin
+	# Get OS description of the exception.
+	call zxgmes (os_errcode, os_errmsg, SZ_ERRMSG)
+	call strupk (os_errmsg, os_errmsg, SZ_ERRMSG)
+
+	# Cancel any output and resync awaits.
+	call fseti (STDOUT, F_CANCEL, OK)
+	call fseti (CLOUT, F_CANCEL, OK)
+	call fseti (CLIN, F_CANCEL, OK)
+
+	# Set this here as error() will return immediately if it comes back.
+	next_handler = X_IGNORE
+
+	# Take error action.
+	switch (exception) {
+	case X_ACV:
+	    if (os_errcode > 0)
+		call fatal (SYS_XACV, os_errmsg)
+	    else
+		call fatal (SYS_XACV, "Access violation")
+	case X_ARITH:
+	    if (os_errcode > 0)
+		call fatal (SYS_XARITH, os_errmsg)
+	    else
+		call fatal (SYS_XARITH, "Arithmetic exception")
+	case X_INT:
+	    if (os_errcode > 0)
+		call fatal (SYS_XINT, os_errmsg)
+	    else
+		call fatal (SYS_XINT, "Keyboard interrupt")
+	case X_IPC:
+	    call fatal (SYS_XIPC, "Write to IPC with no reader")
+
+	default:
+	    call fatal (ERR, "Unknown exception")
+	}
+end
diff --git a/sys/etc/main.x b/sys/etc/main.x
new file mode 100644
index 00000000..db6937bc
--- /dev/null
+++ b/sys/etc/main.x
@@ -0,0 +1,908 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<error.h>
+include	<syserr.h>
+include	<clset.h>
+include	<fset.h>
+include	<ctype.h>
+include	<printf.h>
+include	<xwhen.h>
+include	<knet.h>
+
+.help iraf_main
+.nf __________________________________________________________________________
+The IRAF MAIN
+
+    Task resident interpreter for interface to CL.  Supervises process startup
+and shutdown, error restart, and task execution.  A process may contain any
+number of tasks, which need not be related.  The iraf main allows a process to
+be run either directly (interactively or in batch) or from the CL.  A brief
+description of the operation of the Main is given here; additional documentation
+is given in the System Interface Reference Manual.
+
+
+EXECUTION
+
+[1] The process containing the IRAF Main is run.  The PROCESS MAIN, a machine
+    dependent code segment, gains control initially.  The process main
+    determines whether the task is being run from as a connected subprocess,
+    as a detached process, or as a host process, and opens the process
+    standard i/o channels.  The process main then calls the IRAF Main, i.e., us.
+
+[2] The IRAF Main performs the initialization associated with process startup
+    and then enters the interpreter loop waiting for a command.  A number of
+    special commands are implemented, e.g.:
+
+	?		print menu
+	bye		shutdown process
+	chdir		change directory
+	set		set environment variable or variables
+
+    Any other command is assumed to be the name of a task.  The syntax of a
+    task invocation statement is as follows:
+
+	[$]task [<[fname]], ([[stream[(T|B)]]>[fname]])|([[stream]>>[fname]])
+
+    Everything but the task name is optional.  A leading $ enables printing of
+    the cpu time and clock time consumed by the process at termination.  Any
+    combination of the standard i/o streams may be redirected on the command
+    line into a file.  If the stream is redirected at the CL level redirection
+    is shown on the command line but the filename is omitted.
+
+[3] The communications protocol during task execution varies depending on
+    whether or not we are talking to the CL.  If talking directly to the user,
+    the interpreter generates a prompt, and the standard input and output is
+    not blocked into XMIT and XFER commands.  Interactive parameter requests
+    have the form "paramname: response" while CL/IPC requests have the form
+    "paramname=\nresponse", where "response" is the value entered by the user.
+
+[4] Task termination is indicated in interactive mode by generation of a prompt
+    for the next command and in CL/IPC mode by transmission of the command
+    "bye" to the parent process.  If a task terminates abnormally the command
+    "error" is sent to the parent process or the terminal, and the Main reenters
+    the interpreter loop.
+
+A unique SYS_RUNTASK procedure is generated for each process at compile time by
+performing string substitution on a TASK statement appearing in the source code.
+The SYS_RUNTASK procedure contains the task dictionary, CALL statements for
+each task, plus the special task "?".  The main itself, i.e. this file, is a
+precompiled library procedure which has no direct knowledge of the commands
+to be run.
+
+
+ERROR RECOVERY
+
+    If a task terminates abnormally two things can happen: [1] a panic abort
+occurs, causing immediate shutdown of the process (rare), or [2] the IRAF Main
+is reentered at the ZSVJMP statement by a corresponding call to ZDOJMP from
+elsewhere in the system, e.g., ERRACT in the error handling code.
+
+Error restart consists of the following steps:
+
+    (1) The IRAF main is reentered at the point just after the ZDOJMP statement,
+	with a nonzero error code identifying the error in STATUS.
+    (2) The main performs error recovery, cleaning up the files system (deleting
+	NEW_FILES and TEMP_FILES), clearing the stack, and calling any
+	procedures posted with ONERROR.  At present the error recovery code does
+	not free heap buffers or clear posted exception handlers.
+    (3) The ERROR statement is sent to the CL.  An example of the
+	error statment is "ERROR (501, "Access Violation")".
+    (4) The main reenters the interpreter loop awaiting the next command from
+	the CL.
+
+Any error occuring during error restart is fatal and results in immediate
+process termination, usually with a panic error message.  This is necessary
+to prevent infinite error recursion.
+
+
+SHUTDOWN
+
+    The process does not shutdown when interrupted by the CL or during error
+recovery, unless a panic occurs.  In normal operation shutdown only occurs when
+the command BYE is received from the parennt process, or when EOF is read from
+the process standard input.  Procedures posted during execution with ONEXIT 
+will be called during process shutdown.  Any error occuring while executing
+an ONEXIT procedure is fatal and will result in a panic abort of the process.
+.endhelp _____________________________________________________________________
+
+define	SZ_VALSTR		SZ_COMMAND
+define	SZ_CMDBUF		(SZ_COMMAND+1024)
+define	SZ_TASKNAME		32
+define	TIMEIT_CHAR		'$'
+define	MAXFD			5		# max redirectable fd's
+define	STARTUP			0		# stages of execution
+define	SHUTDOWN		1
+define	IDLE			2
+define	EXECUTING		3
+define	DUMMY			finit		# any procedure will do
+
+
+# IRAF_MAIN -- Execute commands read from the standard input until the special
+# command "bye" is received, initiating process shutdown.  The arguments tell
+# the process type (connected, detached, or host) and identify the process
+# standard i/o channels and device driver to be used.
+
+int procedure iraf_main (a_cmd, a_inchan, a_outchan, a_errchan,
+	a_driver, a_devtype, prtype, bkgfile, jobcode, sys_runtask, onentry)
+
+char	a_cmd[ARB]		# command to be executed or null string
+int	a_inchan		# process standard input
+int	a_outchan		# process standard output
+int	a_errchan		# process standard error output
+int	a_driver		# ZLOCPR address of device driver
+int	a_devtype		# device type (text or binary)
+int	prtype			# process type (connected, detached, host)
+char	bkgfile[ARB]		# packed filename of bkg file if detached
+int	jobcode			# jobcode if detached process
+extern	sys_runtask()		# client task execution procedure
+extern	onentry()		# client onentry procedure
+
+bool	networking
+int	inchan, outchan, errchan, driver, devtype
+char	cmd[SZ_CMDBUF], taskname[SZ_TASKNAME], bkgfname[SZ_FNAME]
+char	irafinit[SZ_LINE]
+int	arglist_offset, timeit, junk, interactive, builtin_task, cmdin
+int	jumpbuf[LEN_JUMPBUF], status, errstat, state, interpret, i
+long	save_time[2]
+pointer	sp
+
+bool	streq()
+extern	DUMMY()
+int	sys_getcommand(), sys_runtask(), oscmd()
+int	access(), envscan(), onentry(), stropen(), envgets()
+errchk	xonerror, fio_cleanup
+common	/JUMPCOM/ jumpbuf
+string	nullfile "dev$null"
+data	networking /KNET/
+define	shutdown_ 91
+
+# The following common is required on VMS systems to defeat the Fortran
+# optimizer, which would otherwise produce optimizations that would cause
+# a future return from ZSVJMP to fail.  Beware that this trick may fail on
+# other systems with clever optimizers.
+
+common	/zzfakecom/ state
+
+begin
+	# The following initialization code is executed upon process
+	# startup only.
+
+	errstat = OK
+	state = STARTUP
+	call mio_init()
+	call zsvjmp (jumpbuf, status)
+	if (status != OK)
+	    call sys_panic (EA_FATAL, "fatal error during process startup")
+
+	# Install the standard exception handlers, but if we are a connected
+	# subprocess do not enable interrupts until process startup has
+	# completed.
+
+	call ma_ideh()
+	if (prtype == PR_CONNECTED)
+	    call intr_disable()
+
+	inchan  = a_inchan
+	outchan = a_outchan
+	errchan = a_errchan
+	driver  = a_driver
+	devtype = a_devtype
+
+	# If the system is configured with networking initialize the network
+	# interface and convert the input channel codes and device driver
+	# code to their network equivalents.
+
+	if (networking)
+	    call ki_init (inchan, outchan, errchan, driver, devtype)
+
+	# Other initializations.
+	call env_init()
+	call fmt_init (FMT_INITIALIZE)			# init printf
+	call xer_reset()				# init error checking
+	call erract (OK)				# init error handling
+	call onerror (DUMMY)				# init onerror
+	call onexit  (DUMMY)				# init onexit 
+	call finit()					# initialize FIO
+	call clopen (inchan, outchan, errchan, driver, devtype)
+	call clseti (CL_PRTYPE, prtype)
+	call clc_init()					# init param cache
+	call strupk (bkgfile, bkgfname, SZ_FNAME)
+
+	# If we are running as a host process (no IRAF parent process) look
+	# for the file "zzsetenv.def" in the current directory and then in
+	# the system library, and initialize the environment from this file
+	# if found.  This works because the variable "iraf$" is defined at
+	# the ZGTENV level.
+
+	interactive = NO
+	if (prtype == PR_HOST) {
+	    interactive = YES
+	    if (access ("zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @zzsetenv.def"))
+		    ;
+	    } else if (access ("hlib$zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @hlib$zzsetenv.def"))
+		    ;
+	    } else if (access ("host$hlib/zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @host$hlib/zzsetenv.def"))
+		    ;
+	    }
+
+	    # Allow the 'irafinit' environment variable to point to a file
+	    # that may partially override the system zzsetenv.def file.
+	    if (envgets ("irafinit", irafinit, SZ_LINE) > 0) {
+	        if (access (irafinit, 0, 0) == YES) {
+		    call sprintf (cmd, SZ_CMDBUF, "set @%s")
+			call pargstr (cmd)
+		    iferr (junk = envscan (cmd))
+		        ;
+		}
+	    }
+	}
+
+	# Save context for error restart.  If an error occurs execution
+	# resumes just past the ZSVJMP statement with a nonzero status.
+
+	call smark (sp)
+	call zsvjmp (jumpbuf, status)
+
+	if (status != OK) {
+	    errstat = status
+
+	    # Give up if error occurs during shutdown.
+	    if (state == SHUTDOWN)
+		call sys_panic (errstat, "fatal error during process shutdown")
+
+	    # Tell error handling package that an error restart is in
+	    # progress (necessary to avoid recursion).
+
+	    call erract (EA_RESTART)
+
+	    iferr {
+		# Call user cleanup routines and then clean up files system.
+		# Make sure that user cleanup routines are called FIRST.
+
+		call xonerror (status)
+		call ma_ideh()
+		call flush (STDERR)
+		do i = CLIN, STDPLOT
+		    call fseti (i, F_CANCEL, OK)
+		call fio_cleanup (status)
+		call fmt_init (FMT_INITIALIZE)
+		call sfree (sp)
+	    } then
+		call erract (EA_FATAL)			# panic abort
+
+	    # Send ERROR statement to the CL, telling the CL that the task
+	    # has terminated abnormally.  The CL will either kill us, resulting
+	    # in error restart with status=SYS_XINT, or send us another command
+	    # to execute.  If we are connected but idle, do not send the ERROR
+	    # statement because the CL will not read it until it executes the
+	    # next task (which it will then mistakenly think has aborted).
+
+	    if (!(prtype == PR_CONNECTED && state == IDLE))
+		call xer_send_error_statement_to_cl (status)
+
+	    # Inform error handling code that error restart has completed,
+	    # or next error call will result in a panic shutdown.
+
+	    call erract (OK)
+	    call xer_reset ()
+	    status = OK
+	}
+
+	# During process startup and shutdown the parent is not listening to
+	# us, hence we dump STDOUT and STDERR into the null file.  If this is
+	# not done and we write to CLOUT, deadlock may occur.  During startup
+	# we also call the ONENTRY procedure.  This is a no-op for connected
+	# and host subprocesses unless a special procedure is linked by the
+	# user (for detached processes the standard ONENTRY procedure opens
+	# the bkgfile as CLIN).  The return value of ONENTRY determines whether
+	# the interpreter loop is entered.  Note that ONENTRY permits complete
+	# bypass of the standard interpreter loop by an application (e.g. the
+	# IRAF CL).
+
+	if (state == STARTUP) {
+	    # Redirect stderr and stdout to the null file.
+	    if (prtype == PR_CONNECTED) {
+		call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+		call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	    }
+
+	    # Call the custom or default ONENTRY procedure.  The lowest bit
+	    # of the return value contains the PR_EXIT/PR_NOEXIT flag, higher
+	    # bits may contain a more meaningful 7-bit status code which will
+	    # be returned to the shell.
+
+	    i = onentry (prtype, bkgfname, a_cmd)
+	    if (mod(i, 2) == PR_EXIT) {
+		interpret = NO
+		errstat = i / 2
+		goto shutdown_
+	    } else
+		interpret = YES
+
+	    # Open the command input stream.  If a command string was given on
+	    # the command line then we read commands from that, otherwise we
+	    # take commands from CLIN.
+
+	    for (i=1;  IS_WHITE(a_cmd[i]) || a_cmd[i] == '\n';  i=i+1)
+		;
+	    if (a_cmd[i] != EOS) {
+		cmdin = stropen (a_cmd, ARB, READ_ONLY)
+		call fseti (cmdin, F_KEEP, YES)
+		interpret = NO
+		interactive = NO
+	    } else
+		cmdin = CLIN
+	}
+
+	# Interpreter loop of the IRAF Main.  Execute named tasks until the
+	# command "bye" is received, or EOF is read on the process standard
+	# input (CLIN).  Prompts and other perturbations in the CL/IPC protocol
+	# are generated if we are being run directly as a host process.
+
+	while (sys_getcommand (cmdin, cmd, taskname, arglist_offset,
+	    timeit, prtype) != EOF) {
+
+	    builtin_task = NO
+	    if (streq (taskname, "bye")) {
+		# Initiate process shutdown.
+		break
+	    } else if (streq (taskname, "set") || streq (taskname, "reset")) {
+		builtin_task = YES
+	    } else if (streq (taskname, "cd")  || streq (taskname, "chdir")) {
+		builtin_task = YES
+	    } else if (prtype == PR_CONNECTED && streq (taskname, "_go_")) {
+		# Restore the normal standard output streams, following
+		# completion of process startup.  Reenable interrupts.
+		call close (STDOUT)
+		call close (STDERR)
+		call intr_enable()
+		state = IDLE
+		next
+	    } else if (taskname[1] == '!') {
+		# Send a command to the host system.
+		junk = oscmd (cmd[arglist_offset], "", "", "")
+		next
+	    } else
+		state = EXECUTING
+
+	    if (builtin_task == NO) {
+		if (timeit == YES)
+		    call sys_mtime (save_time)
+
+		# Clear the parameter cache.
+		call clc_init()
+
+		# Set the name of the root pset.
+		call clc_newtask (taskname)
+
+		# Process the argument list, consisting of any mixture of
+		# parameter=value directives and i/o redirection directives.
+
+		call sys_scanarglist (cmdin, cmd[arglist_offset])
+	    }
+
+	    # Call sys_runtask (the code for which was generated automatically
+	    # by the preprocessor in place of the TASK statement) to search
+	    # the dictionary and run the named task.
+
+	    errstat = OK
+            call mem_init (taskname)
+	    if (sys_runtask (taskname,cmd,arglist_offset,interactive) == ERR) {
+		call flush (STDOUT)
+		call sprintf (cmd, SZ_CMDBUF,
+		    "ERROR (0, \"Iraf Main: Unknown task name (%s)\")\n")
+		    call pargstr (taskname)
+		call putline (CLOUT, cmd)
+		call flush (CLOUT)
+		state = IDLE
+		next
+	    }
+            call mem_fini (taskname)
+
+	    # Cleanup after successful termination of command.  Flush the
+	    # standard output, cancel any unread standard input so the next
+	    # task won't try to read it, print elapsed time if enabled,
+	    # check for an incorrect error handler, call any user posted
+	    # termination procedures, close open files, close any redirected
+	    # i/o and restore the normal standard i/o streams.
+
+	    if (builtin_task == NO) {
+
+		call flush (STDOUT)
+		call fseti (STDIN, F_CANCEL, OK)
+
+		if (timeit == YES)
+		    call sys_ptime (STDERR, taskname, save_time)
+
+		call xer_verify()
+		call xonerror (OK)
+		call fio_cleanup (OK)
+
+		if (prtype == PR_CONNECTED) {
+		    call putline (CLOUT, "bye\n")
+		    call flush (CLOUT)
+		}
+		if (state != STARTUP)
+		    state = IDLE
+	    }
+	}
+
+	# The interpreter has exited after receipt of "bye" or EOF.  Redirect
+	# stdout and stderr to the null file (since the parent is no longer
+	# listening to us), call the user exit procedures if any, and exit.
+
+shutdown_
+	state = SHUTDOWN
+	if (prtype == PR_CONNECTED) {
+	    call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+	    call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	} else if (prtype == PR_HOST && cmd[1] == EOS && interpret == YES) {
+	    call putci (CLOUT, '\n')
+	    call flush (CLOUT)
+	}
+
+	call xonexit (OK)
+	call fio_cleanup (OK)
+	call clclose()
+
+	return (errstat)
+end
+
+
+# SYS_GETCOMMAND -- Get the next command from the input file.  Ignore blank
+# lines and comment lines.  Parse the command and return the components as
+# output arguments.  EOF is returned as the function value when eof file is
+# reached on the input file.
+
+int procedure sys_getcommand (fd, cmd, taskname, arglist_offset, timeit, prtype)
+
+int	fd			#I command input file
+char	cmd[SZ_CMDBUF]		#O command line
+char	taskname[SZ_TASKNAME]	#O extracted taskname, lower case
+int	arglist_offset		#O offset into CMD of first argument
+int	timeit			#O if YES, time the command
+int	prtype			#I process type code
+
+int	ip, op
+int	getlline(), stridx()
+
+begin
+	repeat {
+	    # Get command line.  Issue prompt first if process is being run
+	    # interactively.
+
+	    if (prtype == PR_HOST && fd == CLIN) {
+		call putline (CLOUT, "> ")
+		call flush (CLOUT)
+	    }					
+	    if (getlline (fd, cmd, SZ_CMDBUF) == EOF)
+		return (EOF)
+
+	    # Check for timeit character and advance to first character of
+	    # the task name.
+
+	    timeit = NO
+	    for (ip=1;  cmd[ip] != EOS;  ip=ip+1) {
+		if (cmd[ip] == TIMEIT_CHAR && timeit == NO)
+		    timeit = YES
+		else if (!IS_WHITE (cmd[ip]))
+		    break
+	    }
+
+	    # Skip blank lines and comment lines.
+	    switch (cmd[ip]) {
+	    case '#', '\n', EOS:
+		next
+	    case '?', '!':
+		taskname[1] = cmd[ip]
+		taskname[2] = EOS
+		arglist_offset = ip + 1
+		return (OK)
+	    }
+
+	    # Extract task name.
+	    op = 1
+	    while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) {
+		taskname[op] = cmd[ip]
+		ip = ip + 1
+		op = min (SZ_TASKNAME + 1, op + 1)
+	    }
+	    taskname[op] = EOS
+
+	    # Determine index of argument list.
+	    while (IS_WHITE (cmd[ip]))
+		ip = ip + 1
+	    arglist_offset = ip
+
+	    # Get rid of the newline.
+	    for (;  cmd[ip] != EOS;  ip=ip+1)
+		if (cmd[ip] == '\n') {
+		    cmd[ip] = EOS
+		    break
+		}
+
+	    return (OK)
+	}
+end
+
+
+# SYS_SCANARGLIST -- Parse the argument list of a task.  At the level of the
+# iraf main the command syntax is very simple.  There are two types of
+# arguments, parameter assignments (including switches) and i/o redirection
+# directives.  All param assignments are of the form  "param=value",  where
+# PARAM must start with a lower case alpha and where VALUE is either quoted or
+# is delimited by one of the metacharacters [ \t\n<>\\].  A redirection argument
+# is anything which is not a parameter set argument, i.e., any argument which
+# does not start with a lower case alpha.
+
+procedure sys_scanarglist (cmdin, i_args)
+
+int	cmdin			# command input stream
+char	i_args[ARB]		# (first part of) argument list
+
+int	fd
+char	ch
+bool	skip
+pointer	sp, fname, args, ip, op
+int	getlline()
+
+begin
+	call smark (sp)
+	call salloc (args, SZ_CMDBUF, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call strcpy (i_args, Memc[args], SZ_CMDBUF)
+
+	# Do not skip whitespace for param=value args on the command line.
+	skip = false
+
+	# Inform FIO that all standard i/o streams are unredirected (overridden
+	# below if redirected by an argument).
+
+	for (fd=1;  fd < FIRST_FD;  fd=fd+1)
+	    call fseti (fd, F_REDIR, NO)
+
+	# Process each argument in the argument list.  If the command line ends
+	# with an escaped newline then continuation is assumed.  Arguments are
+	# delimited by whitespace.
+
+	for (ip=args;  Memc[ip] != '\n' && Memc[ip] != EOS;  ) {
+	    # Advance to the next argument.
+	    while (IS_WHITE (Memc[ip]))
+		ip = ip + 1
+
+	    # Check for continuation.
+	    ch = Memc[ip]
+	    if (ch == '\\' && (Memc[ip+1] == '\n' || Memc[ip+1] == EOS)) {
+		if (getlline (cmdin, Memc[args], SZ_CMDBUF) == EOF) {
+		    call sfree (sp)
+		    return
+		}
+		ip = args
+		next
+	    } else if (ch == '\n' || ch == EOS)
+		break
+
+	    # If the argument begins with an alpha, _, or $ (e.g., $nargs)
+	    # then it is a param=value argument, otherwise it must be a redir.
+	    # The form @filename causes param=value pairs to be read from
+	    # the named file.
+
+	    if (ch == '@') {
+		op = fname
+		for (ip=ip+1;  Memc[ip] != EOS;  ip=ip+1)
+		    if (IS_WHITE (Memc[ip]) || Memc[ip] == '\n')
+			break
+		    else if (Memc[ip] == '\\' && Memc[ip+1] == '\n')
+			break
+		    else {
+			Memc[op] = Memc[ip]
+			op = op + 1
+		    }
+		Memc[op] = EOS
+		call sys_getpars (Memc[fname])
+
+	    } else if (IS_ALPHA(ch) || ch == '_' || ch == '$') {
+		call sys_paramset (Memc, ip, skip)
+	    } else
+		call sys_redirect (Memc, ip)
+	}
+
+	call sfree (sp)
+end
+
+
+# SYS_GETPARS -- Read a sequence of param=value parameter assignments from
+# the named file and enter them into the CLIO cache for the task.
+
+procedure sys_getpars (fname)
+
+char	fname			# pset file
+
+bool	skip
+int	lineno, fd
+pointer	sp, lbuf, ip
+int	open(), getlline()
+errchk	open, getlline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_CMDBUF, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	# Skip whitespace for param = value args in a par file.
+	skip = true
+
+	lineno = 0
+	while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) {
+	    lineno = lineno + 1
+	    for (ip=lbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#' || Memc[ip] == '\n')
+		next
+	    iferr (call sys_paramset (Memc, ip, skip)) {
+		for (;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+		    ;
+		Memc[ip] = EOS
+		call eprintf ("Bad param assignment, line %d: `%s'\n")
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# SYS_PARAMSET -- Extract the param and value substrings from a param=value
+# or switch argument and enter them into the CL parameter cache.  (see also
+# clio.clcache).
+
+procedure sys_paramset (args, ip, skip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of argument
+bool	skip			# skip whitespace within "param=value" args
+
+pointer	sp, param, value, op
+int	stridx()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_VALSTR, TY_CHAR)
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) {
+	    Memc[op] = args[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance to the switch character or assignment operator.
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '+':
+	    # Boolean switch "yes".
+	    ip = ip + 1
+	    call strcpy ("yes", Memc[value], SZ_VALSTR)
+	
+	case '-':
+	    # Boolean switch "no".
+	    ip = ip + 1
+	    call strcpy ("no", Memc[value], SZ_VALSTR)
+
+	case '=':
+	    # Extract the value field.  This is either a quoted string or a
+	    # string delimited by any of the metacharacters listed below.
+
+	    ip = ip + 1
+	    if (skip) {
+		while (IS_WHITE (args[ip]))
+		    ip = ip + 1
+	    }
+	    call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR)
+
+	default:
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Enter the param=value pair into the CL parameter cache.
+	call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end
+
+
+# SYS_REDIRECT -- Process a single redirection argument.  The syntax of an
+# argument to redirect the standard input is
+#
+#	< [fname]
+#
+# If the filename is omitted it is understood that STDIN has been redirected
+# in the CL.  The syntax to redirect a standard output stream is
+#
+#	[45678][TB](>|>>)[fname]
+#
+# where [4567] is the FD number of a standard output stream (STDOUT, STDERR,
+# STDGRAPH, STDIMAGE, or STDPLOT), and [TB] indicates if the file is text or
+# binary.  If the stream is redirected at the CL level the output filename
+# will be given as `$', serving only to indicate that the stream is redirected.
+
+procedure sys_redirect (args, ip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of redir arg
+
+pointer	sp, fname
+int	fd, mode, type
+int	ctoi()
+define	badredir_ 91
+errchk	fredir, fseti
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Get number of stream (0 if not given).
+	if (ctoi (args, ip, fd) <= 0)
+	    fd = 0
+
+	# Get file type (optional).
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case 'T', 't':
+	    type = TEXT_FILE
+	    ip = ip + 1
+	case 'B', 'b':
+	    type = BINARY_FILE
+	    ip = ip + 1
+	default:
+	    type = 0
+	}
+
+	# Check for "<", ">", or ">>".
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '<':
+	    ip = ip + 1
+	    mode = READ_ONLY
+	    if (fd == 0)
+		fd = STDIN
+	    else if (fd != STDIN || fd != CLIN)
+		goto badredir_
+
+	case '>':
+	    ip = ip + 1
+	    if (args[ip] == '>') {
+		ip = ip + 1
+		mode = APPEND
+	    } else
+		mode = NEW_FILE
+
+	    if (fd == 0)
+		fd = STDOUT
+	    else {
+		switch (fd) {
+		case CLOUT, STDOUT, STDERR, STDGRAPH, STDIMAGE, STDPLOT:
+		    ;
+		default:
+		    goto badredir_
+		}
+	    }
+
+	default:
+	    # Not a redirection argument.
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Set default file type for given stream if no type specified.
+	if (type == 0)
+	    switch (fd) {
+	    case CLIN, CLOUT, STDIN, STDOUT, STDERR:
+		type = TEXT_FILE
+	    default:
+		type = BINARY_FILE
+	    }
+
+	# Extract the filename, if any.  If the CL has redirected the output
+	# and is merely using the redirection syntax to inform us of this,
+	# the metafilename "$" is given.
+
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+	
+	if (args[ip] == '$') {
+	    Memc[fname] = EOS
+	    ip = ip + 1
+	} else
+	    call sys_gstrarg (args, ip, Memc[fname], SZ_FNAME)
+
+	# At this point we have FD, FNAME, MODE and TYPE.  If no file is
+	# named the stream has already been redirected by the parent and
+	# all we need to is inform FIO that the stream has been redirected.
+	# Otherwise we redirect the stream in the local process.  A locally
+	# redirected stream will be closed and the normal direction restored
+	# during FIO cleanup, at program termination or during error
+	# recovery.
+
+	if (Memc[fname] != EOS)
+	    call fredir (fd, Memc[fname], mode, type)
+	else
+	    call fseti (fd, F_REDIR, YES)
+
+	call sfree (sp)
+	return
+
+badredir_
+	call error (2, "IRAF Main: illegal redirection")
+end
+
+
+# SYS_GSTRARG -- Extract a string field.  This is either a quoted string or a
+# string delimited by any of the metacharacters " \t\n<>\\".
+
+procedure sys_gstrarg (args, ip, outstr, maxch)
+
+char	args[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[maxch]		# receives string field
+int	maxch
+
+char	delim, ch
+int	op
+int	stridx()
+
+begin
+	op = 1
+	if (args[ip] == '"' || args[ip] == '\'') {
+	    # Quoted value string.
+
+	    delim = args[ip]
+	    for (ip=ip+1;  args[ip] != delim && args[ip] != EOS;  ip=ip+1) {
+		if (args[ip] == '\n') {
+		    break
+		} else if (args[ip] == '\\' && args[ip+1] == delim) {
+		    outstr[op] = delim
+		    op = op + 1
+		    ip = ip + 1
+		} else {
+		    outstr[op] = args[ip]
+		    op = op + 1
+		}
+	    }
+
+	} else {
+	    # Nonquoted value string.
+
+	    for (delim=-1;  args[ip] != EOS;  ip=ip+1) {
+		ch = args[ip]
+		if (ch == '\\' && (args[ip+1] == '\n' || args[ip+1] == EOS))
+		    break
+		else if (stridx (ch, " \t\n<>\\") > 0)
+		    break
+		else {
+		    outstr[op] = ch
+		    op = op + 1
+		}
+	    }
+	}
+
+	outstr[op] = EOS
+	if (args[ip] == delim)
+	    ip = ip + 1
+end
diff --git a/sys/etc/miiread.gx b/sys/etc/miiread.gx
new file mode 100644
index 00000000..a3efff2d
--- /dev/null
+++ b/sys/etc/miiread.gx
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREAD -- Read a block of data stored externally in MII format.
+# Data is returned in the format of the local host machine.
+
+int procedure mii_read$t (fd, spp, maxelem)
+
+int	fd			#I input file
+PIXEL	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxelem, MII_PIXEL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_PIXEL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_PIXEL))
+		call miiupk$t (Memc[bp], spp, nelem, TY_PIXEL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_PIXEL))
+		call miiupk$t (spp, spp, nelem, TY_PIXEL)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/miireadc.x b/sys/etc/miireadc.x
new file mode 100644
index 00000000..9354307c
--- /dev/null
+++ b/sys/etc/miireadc.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIREADC -- Read a block of character data stored externally in MII format.
+# Data is returned in the machine independent character format.
+
+int procedure mii_readc (fd, spp, maxchars)
+
+int	fd			# input file
+int	spp[ARB]		# receives data
+int	maxchars		# max number of chars to be read
+
+pointer	sp, bp
+int	pksize, nchars
+int	miipksize(), miinelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = miipksize (maxchars, MII_BYTE)
+	nchars = max (maxchars, pksize)
+
+	if (nchars > maxchars) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, nchars, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, miinelem (nchars, MII_BYTE))
+		call miiupk8 (Memc[bp], spp, nchars, TY_CHAR)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, miinelem (nchars, MII_BYTE))
+		call miiupk8 (spp, spp, nchars, TY_CHAR)
+	    }
+	}
+
+	return (nchars)
+end
diff --git a/sys/etc/miiwrite.gx b/sys/etc/miiwrite.gx
new file mode 100644
index 00000000..0bfce225
--- /dev/null
+++ b/sys/etc/miiwrite.gx
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITE -- Write a block of data to a file in MII format.
+# The input data is in the host system native binary format.
+
+procedure mii_write$t (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_PIXEL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipak$t (spp, Memc[bp], nelem, TY_PIXEL)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/miiwritec.x b/sys/etc/miiwritec.x
new file mode 100644
index 00000000..bdc20818
--- /dev/null
+++ b/sys/etc/miiwritec.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+# MIIWRITEC -- Write a block of character data to a file in MII format.
+# The input data is assumed to be in a machine independent format. 
+
+procedure mii_writec (fd, spp, nchars)
+
+int	fd			# output file
+int	spp[ARB]		# data to be written
+int	nchars			# number of chars units to be written
+
+pointer	sp, bp
+int	bufsize
+int	miipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = miipksize (nchars, MII_BYTE)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipak8 (spp, Memc[bp], nchars, TY_CHAR)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/mkpkg b/sys/etc/mkpkg
new file mode 100644
index 00000000..578c290b
--- /dev/null
+++ b/sys/etc/mkpkg
@@ -0,0 +1,125 @@
+# Make the ETC portion of the system library libsys.a.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+generic:
+	$ifolder (gen/miireadi.x, miiread.gx) 
+		$generic -k -p gen/ -t silrd miiread.gx
+	$endif
+	$ifolder (gen/miiwritei.x, miiwrite.gx)
+		$generic -k -p gen/ -t silrd miiwrite.gx
+	$endif
+	$ifolder (gen/nmireadi.x, nmiread.gx) 
+		$generic -k -p gen/ -t silrd nmiread.gx
+	$endif
+	$ifolder (gen/nmiwritei.x, nmiwrite.gx)
+		$generic -k -p gen/ -t silrd nmiwrite.gx
+	$endif
+	;
+
+libsys.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+	@gen
+
+	brktime.x	<time.h>
+	btoi.x	
+	clktime.x	
+	cnvdate.x	<time.h>
+	cnvtime.x	<time.h>
+	cputime.x	
+	dtmcnv.x	<time.h> <ctype.h>
+	envgetb.x	
+	envgetd.x	<mach.h>
+	envgeti.x	<mach.h>
+	envgetr.x	
+	envgets.x	environ.h <fset.h> <knet.h>
+	envindir.x	
+	envinit.x	environ.com environ.h
+	environ.x	environ.com environ.h <knet.h>
+	envlist.x	environ.com environ.h
+	envnext.x	environ.com environ.h
+	envreset.x	environ.com environ.h <knet.h>
+	envscan.x	environ.h <ctype.h>
+	erract.x	error.com <config.h> <error.h>
+	errcode.x	error.com <error.h>
+	errget.x	error.com <error.h>
+	error.x		error.com <error.h>
+	gethost.x	
+	getpid.x	
+	getuid.x	
+	gmtcnv.x
+	gqsort.x	
+	intr.x		<xwhen.h>
+	itob.x	
+	lineoff.x	
+	locpr.x	
+	locva.x	
+	lpopen.x	<knet.h> <mach.h>
+	maideh.x	<fset.h> <xwhen.h>
+	main.x		<clset.h> <config.h> <ctype.h> <error.h> <fset.h>\
+			<knet.h> <printf.h> <xwhen.h>
+	miireadc.x	<mii.h>
+	miiwritec.x	<mii.h>
+	nmireadb.x	<nmi.h>
+	nmireadc.x	<nmi.h>
+	nmiwriteb.x	<nmi.h>
+	nmiwritec.x	<nmi.h>
+	onentry.x	<clset.h> <error.h> <fset.h> <knet.h>
+	onerror.x	<config.h> <error.h>
+	onexit.x	<config.h> <error.h>
+	oscmd.x		<clset.h> <ctype.h> <error.h> <knet.h>
+	pagefiles.x	<chars.h> <ctype.h> <error.h> <finfo.h> <fset.h>\
+			<mach.h> <ttyset.h>
+	prchdir.x	
+	prclcpr.x	prc.com <config.h>
+	prcldpr.x	prd.com <config.h> <knet.h>
+	prclose.x	prc.com <config.h> <prstat.h>
+	prdone.x	prd.com <config.h>
+	prenvfree.x	
+	prenvset.x	
+	prfilbuf.x	prc.com <config.h> <fio.h>
+	prfindpr.x	prc.com <config.h>
+	prgline.x	prc.com <config.h> <ctype.h> <fset.h>
+	prgredir.x	prc.com <config.h>
+	prkill.x	prd.com <config.h> <knet.h>
+	propcpr.x	prc.com <config.h> <fset.h> <knet.h> <prstat.h>\
+			<xwhen.h>
+	propdpr.x	prd.com <config.h> <knet.h>
+	propen.x	<knet.h>
+	proscmd.x	prc.com <config.h>
+	prpsio.x	prc.com <chars.h> <config.h> <error.h> <fio.com>\
+			<fio.h> <fset.h> <gio.h>
+	prpsload.x	prc.com <config.h>
+	prredir.x	prc.com <config.h>
+	prseti.x	prc.com <config.h> <prstat.h>
+	prsignal.x	prc.com <config.h> <knet.h>
+	prstati.x	prc.com <config.h> <prstat.h>
+	prupdate.x	prc.com <config.h> <error.h> <prstat.h>
+	psioisxt.x	<ctype.h> <gio.h>
+	psioxfer.x	
+	qsort.x	
+	sttyco.x	<ctype.h> <error.h> <ttset.h> <ttyset.h>
+	syserr.x	
+	sysid.x	
+	syspanic.x	
+	sysptime.x	<ctype.h>
+	tsleep.x	
+	ttopen.x	<fset.h>
+        urlget.x        <ctype.h> <fset.h> <mach.h>
+        votable.x
+	xalloc.x	<ctype.h> <knet.h> <xalloc.h>
+	xerfmt.x	<ctype.h>
+	xerpop.x	error.com <error.h>
+	xerpue.x	<config.h> <fio.com> <fio.h> <mach.h>
+	xerreset.x	error.com <error.h>
+	xerstmt.x	error.com <ctype.h> <error.h>
+	xerverify.x	error.com <error.h>
+	xgdevlist.x	<xalloc.h>
+	xisatty.x	<clset.h> <fset.h>
+	xmjbuf.x	<config.h>
+	xttysize.x	<clset.h>
+	xwhen.x	
+	;
diff --git a/sys/etc/nmiread.gx b/sys/etc/nmiread.gx
new file mode 100644
index 00000000..401f1c2c
--- /dev/null
+++ b/sys/etc/nmiread.gx
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_READ -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_read$t (fd, spp, maxelem)
+
+int	fd			#I input file
+PIXEL	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxelem, NMI_PIXEL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_PIXEL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_PIXEL))
+		call nmiupk$t (Memc[bp], spp, nelem, TY_PIXEL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, nminelem (nchars, NMI_PIXEL))
+		call nmiupk$t (spp, spp, nelem, TY_PIXEL)
+	    }
+	}
+
+	return (nelem)
+end
diff --git a/sys/etc/nmireadb.x b/sys/etc/nmireadb.x
new file mode 100644
index 00000000..dc23866c
--- /dev/null
+++ b/sys/etc/nmireadb.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+
+# NMI_READB -- Read a block of data stored externally in NMI format.
+# Data is returned in the format of the local host machine.
+
+int procedure nmi_readb (fd, spp, maxelem)
+
+int	fd			#I input file
+bool	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nminelem (maxelem, NMI_INT)
+	nelem  = EOF
+
+	# Read data into user buffer and unpack in place.
+	nchars = read (fd, spp, pksize)
+	if (nchars != EOF)
+	    nelem = min (maxelem, pksize)
+
+	return (nelem)
+end
diff --git a/sys/etc/nmireadc.x b/sys/etc/nmireadc.x
new file mode 100644
index 00000000..be65b9dd
--- /dev/null
+++ b/sys/etc/nmireadc.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMIREADC -- Read a block of character data stored externally in NMI format.
+# Data is returned in the native machine character format.
+
+int procedure nmi_readc (fd, spp, maxchars)
+
+int	fd			# input file
+int	spp[ARB]		# receives data
+int	maxchars		# max number of chars to be read
+
+pointer	sp, bp
+int	pksize, nchars
+int	nmipksize(), nminelem(), read()
+errchk	read()
+
+long	note()
+
+begin
+	pksize = nmipksize (maxchars, NMI_BYTE)
+	nchars = max (maxchars, pksize)
+
+	if (nchars > maxchars) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, nchars, TY_CHAR)
+
+	    nchars = read (fd, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, nminelem (nchars, NMI_BYTE))
+		call nmiupk8 (Memc[bp], spp, nchars, TY_CHAR)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = read (fd, spp, pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, nminelem (nchars, NMI_BYTE))
+		call nmiupk8 (spp, spp, nchars, TY_CHAR)
+	    }
+	}
+
+	return (nchars)
+end
diff --git a/sys/etc/nmiwrite.gx b/sys/etc/nmiwrite.gx
new file mode 100644
index 00000000..1efc4e45
--- /dev/null
+++ b/sys/etc/nmiwrite.gx
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMI_WRITE -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_write$t (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nelem, NMI_PIXEL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipak$t (spp, Memc[bp], nelem, TY_PIXEL)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/nmiwriteb.x b/sys/etc/nmiwriteb.x
new file mode 100644
index 00000000..2819d1e8
--- /dev/null
+++ b/sys/etc/nmiwriteb.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+
+# NMI_WRITEB -- Write a block of data to a file in NMI format.
+# The input data is in the host system native binary format.
+
+procedure nmi_writeb (fd, spp, nelem)
+
+int	fd			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+int	bufsize
+int	nminelem()
+
+begin
+	bufsize = nminelem (nelem, NMI_INT)
+	call write (fd, spp, bufsize)
+end
diff --git a/sys/etc/nmiwritec.x b/sys/etc/nmiwritec.x
new file mode 100644
index 00000000..16dc572c
--- /dev/null
+++ b/sys/etc/nmiwritec.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <nmi.h>
+
+# NMIWRITEC -- Write a block of character data to a file in NMI format.
+# The input data is assumed to be in a native machine format. 
+
+procedure nmi_writec (fd, spp, nchars)
+
+int	fd			# output file
+int	spp[ARB]		# data to be written
+int	nchars			# number of chars units to be written
+
+pointer	sp, bp
+int	bufsize
+int	nmipksize()
+
+begin
+	call smark (sp)
+
+	bufsize = nmipksize (nchars, NMI_BYTE)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call nmipak8 (spp, Memc[bp], nchars, TY_CHAR)
+	call write (fd, Memc[bp], bufsize)
+
+	call sfree (sp)
+end
diff --git a/sys/etc/onentry.x b/sys/etc/onentry.x
new file mode 100644
index 00000000..6a2e823d
--- /dev/null
+++ b/sys/etc/onentry.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<error.h>
+include	<clset.h>
+include	<fset.h>
+
+define	NFD		2
+
+# ONENTRY -- Default procedure called by the IRAF Main during process startup,
+# before entering the interpreter loop.  If desired the user can supply their
+# own ONENTRY procedure; this will be used instead of the system default if
+# specified on the link line before the iraf libraries are searched.
+# This procedure is a no-op for a connected or host process.  For a detached
+# process the default action is to redirect the standard input to the bkgfile,
+# which is assumed to be a text file containing commands to be executed by
+# the Main.
+#
+# The basic host calling sequence for an iraf process is as follows:
+#
+#	 x_file.e [-c | -d bkgfile ] [ command ]
+#
+# This is parsed by the zmain (host level main), returning the process type
+# in PRTYPE, the bkgfile string in BKGFILE if the process type is detached,
+# and anything remaining on the command line in CMD.  If a custom onentry
+# procedure is used CMD can be anything; all the iraf main does is concatenate
+# the arguments into a string and pass it to the onentry procedure as CMD.
+
+int procedure onentry (prtype, bkgfile, cmd)
+
+int	prtype			#I process type (connected, detached, host)
+char	bkgfile[ARB]		#I osfn of bkg file, if detached process
+char	cmd[ARB]		#I command argument string, if any
+
+char	osfn[SZ_FNAME]
+int	chan, loc_zgettx, i, fd[NFD]
+data	fd[1] /CLIN/, fd[2] /STDIN/
+extern	zgettx()
+
+begin
+	if (prtype == PR_DETACHED) {
+	    # Open the bkgfile and connect it to CLIN and STDIN.  The stdin
+	    # supplied by the process main is not used in this mode.
+	    # We assume that no i/o has yet occurred on either file.  Note
+	    # that we do not wish to use FREDIR as that would preclude
+	    # redirection on the command line.
+
+	    call strpak (bkgfile, osfn, SZ_FNAME)
+	    call zopntx (osfn, READ_ONLY, chan)
+	    if (chan == ERR)
+		call sys_panic (EA_FATAL, "Cannot open bkgfile")
+	    call zlocpr (zgettx, loc_zgettx)
+
+	    do i = 1, NFD {
+		call fseti (fd[i], F_CHANNEL, chan)
+		call fseti (fd[i], F_DEVICE, loc_zgettx)
+		call fseti (fd[i], F_TYPE, TEXT_FILE)
+	    }
+	}
+
+	# If PR_EXIT is returned the interpreter loop is bypassed and process
+	# shutdown occurs immediately.
+
+	return (PR_NOEXIT)
+end
diff --git a/sys/etc/onerror.x b/sys/etc/onerror.x
new file mode 100644
index 00000000..d8bd36f3
--- /dev/null
+++ b/sys/etc/onerror.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+
+# ONERROR -- Give system the EPA of a procedure to be executed when task
+# termination occurs (either normal task termination or task termination
+# via error recovery).  Each procedure will be called with the task termination
+# status, i.e., OK for normal termination, else the ERRCODE argument to ERROR.
+
+procedure onerror (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+
+int	epa, i
+bool	first_time
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+data	first_time /true/
+
+begin
+	# The first call is by the IRAF main at process startup time, with
+	# a dummy argument.
+
+	if (first_time) {
+	    nprocs = 0
+	    first_time = false
+	    return
+	}
+
+	call zlocpr (user_proc, epa)
+
+	# Ignore the call if the procedure has already been posted.
+	# Otherwise tack address of proc onto list and return.
+
+	for (i=1;  i <= nprocs;  i=i+1)
+	    if (epa == proc_list[i])
+		return
+
+	nprocs = nprocs + 1
+	if (nprocs > MAX_ONERROR)
+	    iferr (call syserr (SYS_SONERROVFL))
+		call erract (EA_WARN)
+
+	proc_list[nprocs] = epa
+end
+
+
+# ONERROR_REMOVE -- Remove a previously posted ONERROR procedure.
+
+procedure onerror_remove (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+
+int	epa, i
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+
+begin
+	call zlocpr (user_proc, epa)
+	for (i=1;  i <= nprocs;  i=i+1)
+	    if (proc_list[i] == epa)
+		proc_list[i] = 0
+end
+
+
+# XONERROR -- Called at task termination by the IRAF Main to execute each of
+# the posted user error cleanup procedures (if any).  Procedures are executed
+# in the order in which they were posted.  The task termination status is
+# passed to the called procedure as the single argument to the procedure.
+# The list of termination handlers is cleared when finished.
+
+procedure xonerror (status)
+
+int	status			#I task termination status (OK or error code)
+
+int	nprocs_to_execute, i
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+errchk	zcall1
+
+begin
+	# Clear "nprocs" before calling user procedures, to ensure that
+	# a reentrant call does not lead to an infinite loop (i.e., in the
+	# event of an error during execution of a cleanup procedure). 
+	# In principle this should not be necessary, since an error occurring
+	# during error restart should result in a panic abort.
+
+	nprocs_to_execute = nprocs
+	nprocs = 0
+
+	for (i=1; i <= nprocs_to_execute;  i=i+1)
+	    if (proc_list[i] != 0)
+		call zcall1 (proc_list[i], status)
+end
diff --git a/sys/etc/onexit.x b/sys/etc/onexit.x
new file mode 100644
index 00000000..44212cf1
--- /dev/null
+++ b/sys/etc/onexit.x
@@ -0,0 +1,88 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+
+# ONEXIT -- Give system the EPA of a procedure to be executed when process
+# shutdown occurs.
+
+procedure onexit (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+bool	first_time
+int	epa, i
+int	proc_list[MAX_ONEXIT], nprocs
+common	/onexcm/ nprocs, proc_list
+data	first_time /true/
+
+begin
+	# The first call is by the IRAF main at process startup time, with
+	# a dummy argument.
+
+	if (first_time) {
+	    nprocs = 0
+	    first_time = false
+	    return
+	}
+
+	call zlocpr (user_proc, epa)
+
+	# Ignore the call if the procedure has already been posted.
+	# Otherwise tack address of proc onto list and return.
+
+	for (i=1; i <= nprocs;  i=i+1)
+	    if (epa == proc_list[i])
+		return
+
+	nprocs = nprocs + 1
+	if (nprocs > MAX_ONEXIT)
+	    iferr (call syserr (SYS_SONEXITOVFL))
+		call erract (EA_WARN)
+
+	proc_list[nprocs] = epa
+end
+
+
+# ONEXIT_REMOVE -- Remove a previously posted ONEXIT procedure.
+
+procedure onexit_remote (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+
+int	epa, i
+int	proc_list[MAX_ONERROR], nprocs
+common	/onexcm/ nprocs, proc_list
+
+begin
+	call zlocpr (user_proc, epa)
+	for (i=1;  i <= nprocs;  i=i+1)
+	    if (proc_list[i] == epa)
+		proc_list[i] = 0
+end
+
+
+# XONEXIT -- Called at process shutdown time by the IRAF main to execute
+# each posted user exit procedure.  Exit procedures are called in the order
+# in which they were posted.  Try to survive errors so that all exit
+# procedures may be called.  Do not take an error action or issue a warning
+# message, since by the time we are called the CL has stopped listening to
+# us (it might possibly be safer to panic).
+
+procedure xonexit (exit_code)
+
+int	exit_code			#I passed to exit handlers
+int	nprocs_to_execute, i
+int	proc_list[MAX_ONEXIT], nprocs
+common	/onexcm/ nprocs, proc_list
+errchk	zcall1
+
+begin
+	nprocs_to_execute = nprocs
+	nprocs = 0
+
+	for (i=1; i <= nprocs_to_execute;  i=i+1)
+	    if (proc_list[i] != 0)
+		iferr (call zcall1 (proc_list[i], exit_code))
+		    ;
+end
diff --git a/sys/etc/oscmd.x b/sys/etc/oscmd.x
new file mode 100644
index 00000000..78b723c2
--- /dev/null
+++ b/sys/etc/oscmd.x
@@ -0,0 +1,116 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<clset.h>
+include	<error.h>
+include	<knet.h>
+
+# OSCMD -- Send a (machine dependent) command to the host operating system.
+# Try to spool the standard output and error output in the named files if
+# nonnull names for the files are given.  OK is returned if the command
+# executes successfully.
+
+int procedure oscmd (cmd, infile, outfile, errfile)
+
+char	cmd[ARB]		# host command
+char	infile[ARB]		# name of host command input file
+char	outfile[ARB]		# name of file to receive output
+char	errfile[ARB]		# name of file to receive error output
+
+int	status, ip, ch
+pointer	sp, cmdbuf, osin, osout, oserr, ostmp, op
+errchk	fmapfn, mktemp, fclobber, flush, putline
+int	clstati(), getci()
+bool	fnullfile()
+
+begin
+	call smark (sp)
+	call salloc (cmdbuf, SZ_COMMAND, TY_CHAR)
+	call salloc (osin, SZ_PATHNAME, TY_CHAR)
+	call salloc (osout, SZ_PATHNAME, TY_CHAR)
+	call salloc (oserr, SZ_PATHNAME, TY_CHAR)
+	call salloc (ostmp, SZ_PATHNAME, TY_CHAR)
+
+	# If we are called from the root process, e.g., the CL, the ZOSCMD
+	# primitive is called directly to transmit the host command, otherwise
+	# the OS command is sent up to the parent (root) process which calls
+	# ZOSCMD.  This is necessary because the ZOSCMD primitive will not
+	# work from a subprocess on some systems, due to difficulties trying
+	# to spawn the host command interpreter.
+
+	if (clstati (CL_PRTYPE) != PR_CONNECTED) {
+	    # Root process: send command directly to the host command
+	    # interpreter.
+		
+	    # Pack command string and get OS versions of the filenames.
+	    call strpak (cmd, Memc[cmdbuf], SZ_COMMAND)
+	    if (infile[1] == EOS)
+		call strpak ("", Memc[osin], SZ_PATHNAME)
+	    else
+		call fmapfn (infile, Memc[osin], SZ_PATHNAME)
+
+	    # If output is directed to dev$null, save in temp file and delete.
+	    if (fnullfile(outfile) || fnullfile(errfile))
+		call mktemp ("tmp$null", Memc[ostmp], SZ_PATHNAME)
+	    else
+		Memc[ostmp] = EOS
+
+	    if (outfile[1] == EOS)
+		call strpak ("", Memc[osout], SZ_PATHNAME)
+	    else if (fnullfile (outfile))
+		call fmapfn (Memc[ostmp], Memc[osout], SZ_PATHNAME)
+	    else {
+		call fclobber (outfile)
+		call fmapfn (outfile, Memc[osout], SZ_PATHNAME)
+	    }
+
+	    if (errfile[1] == EOS)
+		call strpak ("", Memc[oserr], SZ_PATHNAME)
+	    else if (fnullfile (errfile))
+		call fmapfn (Memc[ostmp], Memc[oserr], SZ_PATHNAME)
+	    else {
+		call fclobber (errfile)
+		call fmapfn (errfile, Memc[oserr], SZ_PATHNAME)
+	    }
+
+	    # Execute the command and wait for completion.
+	    call zoscmd (Memc[cmdbuf], Memc[osin], Memc[osout], Memc[oserr],
+		status)
+
+	    # Discard output directed to dev$null.
+	    if (Memc[ostmp] != EOS)
+		iferr (call delete (Memc[ostmp]))
+		    call erract (EA_WARN)
+
+	} else {
+	    # Connected subprocess.  Send the command to the parent process to
+	    # be processed as a system directive by the pseudofile i/o system
+	    # in the parent process.  Synchronous execution is desired, so wait
+	    # for a status return from the parent process before returning.
+	    # The redirection files are ignored in this mode.
+
+	    call flush (CLOUT)
+
+	    # Send command.
+	    Memc[cmdbuf] = '!'
+	    op = cmdbuf + 1
+	    for (ip=1;  cmd[ip] != EOS && cmd[ip] != '\n';  ip=ip+1) {
+		Memc[op] = cmd[ip]
+		op = op + 1
+	    }
+	    Memc[op] = '\n'
+	    Memc[op+1] = EOS
+	    call putline (CLOUT, Memc[cmdbuf])
+	    call flush (CLOUT)
+
+	    # Get the return status, encoded as a nonnegative decimal integer.
+	    for (status=0;  getci (CLIN, ch) != EOF;  )
+		if (ch == '\n')
+		    break
+		else
+		    status = status * 10 + TO_INTEG(ch)
+	}
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/etc/pagefiles.x b/sys/etc/pagefiles.x
new file mode 100644
index 00000000..22ef4840
--- /dev/null
+++ b/sys/etc/pagefiles.x
@@ -0,0 +1,1140 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<error.h>
+include	<ctype.h>
+include	<chars.h>
+include	<mach.h>
+include	<finfo.h>
+include	<fset.h>
+
+# PAGEFILES.X -- Page through a file or set of files.  Both backwards and
+# forwards traversals of files and file lists are supported, but not
+# (currently) backwards paging of a pipe.
+#
+# This program is a hack as it was coded starting from the original PAGE
+# program, which was much simpler.  TODO: Add upscrolling and the ability
+# to buffer input and scoll backwards on a pipe.  The present program is
+# monolithic and should be restructured if these features are added.
+
+define	CC_PREFIX	'^'
+define	MAKE_PRINTABLE	($1+'A'-1)
+define	SZ_QUERYMSG	80
+define	SZ_KEYSTR	80
+define	LNO_MAXLINES	2048
+define	SZ_LONGLINE	4096
+define	MAX_PAGE	100
+define	MAX_PBCMD	100
+define	UKEYS		"ukey"		# CL parameter for keyboard input
+
+# Command keystrokes.
+
+define	HELPTXT "[q=quit,e=edit,d=dn,u=up,f|sp=fpg,b=bpg,j|cr=dnln,k=upln,.=bof,N=nfile,P=pfile]"
+
+define	HELP		'?'		# print helptxt
+define	QUIT		'q'		# return to CL
+define	EDIT		'e'		# edit current file
+define	FWD_SCREEN	'f'		# forward one full screen
+define	BACK_SCREEN	'b'		# back one full screen
+define	SCROLL_DOWN	'd'		# forward half a screen
+define	SCROLL_UP	'u'		# back half a screen
+define	PREV_LINE	'k'		# back one line
+define	NEXT_LINE	'j'		# forward one line
+define	TO_BOF		'.'		# to beginning of file
+define	TO_EOF		'G'		# to end of file
+define	TO_EOF_ALT	'g'		# to end of file
+define	SEARCH		'n'		# search for next occurrence of pattern
+define	REDRAW		'\014'		# redraw screen
+
+define	NEXT_FILE	'N'		# goto next file in list
+define	PREV_FILE	'P'		# goto previous file in list
+define	NEXT_FILE_ALT	'\016'		# <ctrl/n>
+define	PREV_FILE_ALT	'\020'		# <ctrl/p>
+
+define	LCMD		':'		# colon commands
+define	TO_FILE		'F'		# ":file filename"
+
+
+# PAGEFILES -- Display a text file or files on the standard output (the user
+# terminal) one screen at a time, pausing after each screen has been filled.
+# The program is keystroke driven in raw mode, and currently recognizes the
+# keystrokes defined above.
+# 
+# If map_cc is enabled, all unknown control characters will be converted into
+# printable sequences.  The following control character sequences have a
+# special significance in IRAF textfiles: FF=formfeed, SO=set standout mode,
+# SI=clear standout mode.  These sequences are mapped into whatever the output
+# device requires upon output by the TTY subroutines.
+
+procedure pagefiles (files)
+
+char	files[ARB]		# file template
+
+string	device "terminal"
+string	prompt ""
+int	first_page
+int	clear_screen
+int	map_cc
+
+begin
+	first_page = 1
+	clear_screen = YES
+	map_cc = YES
+
+	call xpagefiles (files, device,
+	    prompt, first_page, clear_screen, map_cc)
+end
+
+
+# PAGEFILE -- Page a single file; an alternate entry point to the more general
+# routine.  A prompt string different than the filename may be specified and
+# the screen is not cleared when scrolling downward.
+
+procedure pagefile (fname, prompt)
+
+char	fname[ARB]		# name of file to be paged
+char	prompt[ARB]		# prompt string, if different than fname
+
+string	device "terminal"
+int	first_page
+int	clear_screen
+int	map_cc
+
+begin
+	first_page = 1
+	clear_screen = NO
+	map_cc = YES
+
+	call xpagefiles (fname, device,
+	    prompt, first_page, clear_screen, map_cc)
+end
+
+
+# XPAGEFILES -- Generalized file pager.
+
+procedure xpagefiles (files, device, prompt, first_page, clear_screen, map_cc)
+
+char	files[ARB]		# file template
+char	device[ARB]		# output device name
+char	prompt[ARB]		# prompt string (filename if null)
+int	first_page		# first page to be displayed
+int	clear_screen		# clear screen between pages
+int	map_cc			# map control chars on output
+
+bool	redirin, useroot
+pointer	sp, fname, newfname, tty, lbuf
+int	spoolfd, list, nfiles, cmd, i, j, n, o
+
+pointer	ttyodes()
+bool	ttygetb()
+int	strncmp(), strlen()
+int	fntopnb(), fntrfnb(), fntlenb(), fnldir()
+int	pg_getcmd(), pg_pagefile(), fstati()
+errchk	fntopnb, ttyodes, ttygetb, fntrfnb, pg_pagefile, pg_getcmd
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (newfname, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	list = fntopnb (files, YES)
+	nfiles = fntlenb (list)
+	spoolfd = NULL
+
+	tty = ttyodes (device)
+	redirin = (fstati (STDIN, F_REDIR) == YES)
+
+	# If terminal cannot scroll, set clear_screen to true regardless of the
+	# value given above.
+
+	if (ttygetb (tty, "ns"))
+	    clear_screen = YES
+
+	cmd = NEXT_FILE
+	for (i=1;  i <= nfiles && cmd != QUIT;  i=i+1) {
+	    # Get next filename.
+	    if (fntrfnb (list, i, Memc[fname], SZ_FNAME) == EOF)
+		break
+
+	    # Page the file.
+	    cmd = pg_pagefile (tty, Memc[fname], Memc[newfname], prompt,
+		clear_screen, first_page, map_cc, i, nfiles, redirin, spoolfd)
+
+	    # Decide what to do next.
+	    while (cmd != QUIT) {
+		switch (cmd) {
+		case NEXT_FILE, BLANK, NEXT_LINE, CR, LF:
+		    if (i >= nfiles)
+			cmd = pg_getcmd (tty, "no more files", 0,0,0,i,nfiles)
+		    else
+			break
+		case PREV_FILE:
+		    if (i <= 1)
+			cmd = pg_getcmd (tty, "at first file", 0,0,0,i,nfiles)
+		    else {
+			i = i - 2
+			break
+		    }
+
+		case TO_FILE:
+		    # Position within the file list.  If the user specified a
+		    # logical directory in the filename, perform the compares
+		    # on the raw filenames in the list, otherwise use only the
+		    # root filename.
+
+		    useroot = (fnldir(Memc[newfname],Memc[fname],SZ_FNAME) <= 0)
+		    n = strlen (Memc[newfname])
+
+		    for (j=1;  j <= nfiles;  j=j+1)
+			if (fntrfnb (list, j, Memc[lbuf], SZ_FNAME) > 0) {
+			    if (useroot)
+				o = fnldir (Memc[lbuf], Memc[fname], SZ_FNAME)
+			    else
+				o = 0
+			    if (strncmp (Memc[lbuf+o], Memc[newfname], n) >= 0)
+				break
+			}
+
+		    if (j > nfiles)
+			i = nfiles - 1
+		    else
+			i = j - 1
+		    break
+
+		case LCMD:
+		    # Colon escape.  Only :file is recognized at this level.
+
+		    call pg_getstr (Memc[newfname], SZ_FNAME)
+		    cmd = TO_FILE
+
+		case HELP:
+		    cmd = pg_getcmd (tty, HELPTXT, 0,0,0,0,0)
+
+		default:
+err_		    if (!redirin) {
+		        call eprintf ("\07")
+		        call flush (STDERR)
+			i = i - 1		# redisplay current file
+		    }
+		    break
+		}
+	    }
+	}
+
+	if (spoolfd != NULL)
+	    call close (spoolfd)
+
+	call fntclsb (list)
+	call sfree (sp)
+end
+
+
+# PG_PAGEFILE -- Display the named file on the standard output, page by
+# page, pausing for user response between pages.
+
+int procedure pg_pagefile (tty, fname, newfname, u_prompt, clear_screen,
+	first_page, map_cc, fileno, nfiles, redirin, spoolfd)
+
+pointer	tty
+char	fname[ARB]		# file to be paged
+char	newfname[ARB]		# next file to be page (ret. by :file)
+char	u_prompt[ARB]		# prompt string, if not same as filename
+int	clear_screen		# clear screen between pages?
+int	first_page		# first page of file to be displayed
+int	map_cc			# map control characters?
+int	fileno			# current file number
+int	nfiles			# number of files to be paged
+bool	redirin			# reading from the standard input
+int	spoolfd			# fd if spooling output in a file
+
+char	patbuf[SZ_LINE]
+int	nlines, ncols, maxlines, maxcols
+long	fi[LEN_FINFO], nchars, totchars, loffset
+pointer	sp, lbuf, prompt, token, cmdbuf, ip, op, lp
+long	pgoff[MAX_PAGE], pgnch[MAX_PAGE], pglno[MAX_PAGE]
+int	fd, lineno, linelen, nleft, destline, toklen, lnout, i
+bool	ateof, first_call, redirout, pushback, upline, upline_ok
+int	o_loffset, o_nchars, o_lineno, o_pageno, junk, pageno, cmd, ch, n
+
+long	note()
+pointer	lno_open()
+bool	streq(), ttygetb()
+int	pg_getcmd(), ctoi(), strncmp(), patmake(), patmatch(), pg_peekcmd()
+int	open(), finfo(), strlen(), pg_getline(), getci()
+int	lno_fetch(), fstati(), ttyctrl()
+data	first_call /true/
+
+define	err_ 91
+define	quit_ 92
+define	search_ 93
+define	destline_ 94
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LONGLINE, TY_CHAR)
+	call salloc (cmdbuf, SZ_LINE, TY_CHAR)
+	call salloc (prompt, SZ_FNAME, TY_CHAR)
+	call salloc (token, SZ_FNAME, TY_CHAR)
+
+	if (first_call) {
+	    # The pattern buffer is retained indefinitely.
+	    patbuf[1] = EOS
+	    spoolfd = NULL
+	    first_call = false
+	}
+
+	call pg_setprompt (Memc[prompt], u_prompt, fname)
+	call xttysize (ncols, nlines)
+	maxlines = nlines - 1
+	maxcols  = ncols
+
+	redirout = (fstati (STDOUT, F_REDIR) == YES)
+	upline_ok = (!redirout && ttygetb(tty,"cm") && ttygetb(tty,"al"))
+	call pg_pushcmd (NULL)
+
+	# Get file size for (xx%) info in nomore.  If reading from the
+	# standard input, file size is not known.
+
+	nchars = 0
+	if (streq (fname, "STDIN")) {
+	    totchars = -1
+	} else if (finfo (fname, fi) == ERR) {
+	    call sprintf (Memc[lbuf], SZ_LINE, "Cannot access file `%s'")
+		call pargstr (fname)
+	    cmd = pg_getcmd (tty, Memc[lbuf], 0, 0, 0, fileno, nfiles)
+	    call sfree (sp)
+	    return (cmd)
+	} else
+	    totchars = FI_SIZE(fi)
+
+	# If file is empty, return immediately without clearing screen.
+	if (totchars == 0) {
+	    call sprintf (Memc[lbuf], SZ_LINE, "Null length file `%s'")
+		call pargstr (fname)
+	    cmd = pg_getcmd (tty, Memc[lbuf], 0, 0, 0, fileno, nfiles)
+	    call sfree (sp)
+	    return (cmd)
+	}
+
+	# Open the file.
+	iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) {
+	    call sprintf (Memc[lbuf], SZ_LINE, "Cannot open file `%s'")
+		call pargstr (fname)
+	    cmd = pg_getcmd (tty, Memc[lbuf], 0, 0, 0, fileno, nfiles)
+	    call sfree (sp)
+	    return (cmd)
+	}
+
+	# Open the line offset save/fetch database.
+	lp = lno_open (LNO_MAXLINES)
+
+	# Advance to the first page of the file to be displayed.  Pages are
+	# marked by FF chararacters in the text.  If the first page is number
+	# one, do nothing.  If the first character in the file is FF, do not
+	# count it.  This is necessary to count pages correctly whether or not
+	# the first page is preceeded by a FF.
+
+	pageno = 1
+	lineno = 1
+	pgoff[1] = BOF
+	pgnch[1] = nchars
+	pglno[1] = lineno
+
+	if (first_page > 1) {
+	    junk = getci (fd, ch)
+	    nchars = nchars + 1
+
+	    while (pageno < first_page) {
+		while (getci (fd, ch) != '\f') {
+		    nchars = nchars + 1
+		    if (ch == '\n')
+			lineno = lineno + 1
+		    if (ch == EOF) {
+			call close (fd)
+			call lno_close (lp)
+			call sfree (sp)
+			return
+		    }
+		}
+		pageno = pageno + 1
+		nchars = nchars + 1
+		pgoff[pageno] = note (fd)
+		pgnch[pageno] = nchars
+		pglno[pageno] = lineno
+	    }
+	}
+
+	# Always clear the screen between files; the "clear_screen" param
+	# applies only to the pages of a single file.
+
+	if (!redirout) {
+	    call ttyclear (STDERR, tty)
+	    call flush (STDERR)
+	}
+
+	# Output lines, mapping control characters if enabled.  Pause at the
+	# end of every screen, or when FF is encountered in the text.
+
+	pushback= false
+	ateof	= false
+	nleft	= maxlines	# nlines left to display before prompt
+	lnout   = 0
+
+	repeat {
+	    # Fetch and display the next line of the file.
+
+	    if (pushback)
+		pushback = false
+	    else
+		loffset = note (fd)
+
+	    if (pg_getline (fd, Memc[lbuf]) == EOF) {
+		if ((nfiles==1 && lineno <= maxlines) || redirin || redirout) {
+		    # Simply quit if a single small file or the standard input
+		    # is being paged.
+
+		    call close (fd)
+		    call lno_close (lp)
+		    call sfree (sp)
+		    return (QUIT)
+
+		} else {
+		    nchars = totchars + SZ_LINE
+		    ateof = true
+		    nleft = 0
+		}
+
+	    } else if (Memc[lbuf] == '\f') {
+		# Formfeed encountered; pause for the prompt and print the
+		# remainder of the line on the next screen.  If we have not
+		# yet written anything on the screen (nleft=maxlines) don't
+		# bother to prompt again.
+
+		pageno = pageno + 1
+		pgoff[pageno] = loffset
+		pglno[pageno] = lineno
+		pgnch[pageno] = nchars
+		call ungetline (fd, Memc[lbuf+1])
+		pushback = true
+
+		if (nleft == maxlines)
+		    next
+		else
+		    nleft = 0
+
+	    } else {
+		# Output line, processing all escapes as req'd by the device.
+		# Keep track of position in file for %done message in prompt,
+		# and of position on screen so that we know when to prompt.
+
+		call lno_save (lp, lineno, loffset, nchars)
+		linelen = strlen (Memc[lbuf])
+		nchars  = nchars + linelen
+		lineno  = lineno + 1
+
+		# Count the number of printed columns in the output text.
+		n = 1
+		do i = 1, linelen
+		    if (ch >= ' ')
+			n = n + 1
+		    else if (ch == '\t') {
+			n = n + 1
+			while (mod (n-1, 8) != 0)
+			    n = n + 1
+		    }
+
+		# Decrement lines left on screen.
+		nleft = nleft - max (1, ((n + maxcols-1) / maxcols))
+
+		if (spoolfd != NULL)
+		    call putline (spoolfd, Memc[lbuf])
+
+		# Cancel upline if line is too long.
+		if (upline && lnout <= 0 && linelen >= maxcols) {
+		    call ttyclear (STDERR, tty)
+		    call flush (STDERR)
+		    upline = false
+		    lnout = 0
+		}
+
+		if (!(upline && lnout > 0))
+		    call ttyputline (STDOUT, tty, Memc[lbuf], map_cc)
+		lnout = min (maxlines, lnout + 1)
+	    }
+
+	    if (nleft <= 0) {
+		# Move cursor to query line at end of line insert sequence.
+		if (upline) {
+		    # Don't bother if the next command is another insert.
+		    if (pg_peekcmd() != PREV_LINE) {
+			call ttygoto (STDOUT, tty, 1, lnout + 1)
+			call ttyclearln (STDOUT, tty)
+		    }
+		    upline = false
+		}
+
+		# Pause and get next keystroke from the user.
+		cmd = pg_getcmd (tty, Memc[prompt], nchars, totchars, lineno,
+		    fileno, nfiles)
+
+		# Allow use of the space bar to advance to the next file,
+		# when at the end of the current file.
+
+		if (ateof && nfiles > 1 && (cmd == BLANK || cmd == FWD_SCREEN))
+		    cmd = NEXT_FILE
+
+		repeat {
+		    switch (cmd) {
+		    case NEXT_FILE:
+			# This really means the next file if multiple files.
+			if (nfiles > 1)
+			    goto quit_
+			else if (pushback) {
+			    cmd = FWD_SCREEN
+			    next
+			}
+
+			# Otherwise we want the next page (formfeed).
+			o_loffset = note (fd)
+			o_nchars  = nchars
+			o_lineno  = lineno
+
+			repeat {
+			    loffset = note (fd)
+			    n = pg_getline (fd, Memc[lbuf])
+			    if (n == EOF) {
+				if (!redirin) {
+				    call seek (fd, o_loffset)
+				    pushback = false
+				    nchars = o_nchars
+				    lineno = o_lineno
+				    ateof  = false
+				}
+				cmd = pg_getcmd (tty, "No more pages",
+				    nchars,totchars, lineno, fileno,nfiles)
+				Memc[lbuf] = EOS
+				break
+			    }
+
+			    call lno_save (lp, lineno, loffset, nchars)
+
+			    if (Memc[lbuf] == '\f') {
+				pageno = min (MAX_PAGE, pageno + 1)
+				pgoff[pageno] = loffset
+				pgnch[pageno] = nchars
+				pglno[pageno] = lineno
+				if (!redirout) {
+				    call ttyclear (STDERR, tty)
+				    call flush (STDERR)
+				    lnout = 0
+				}
+				call ungetline (fd, Memc[lbuf+1])
+				pushback = true
+				nleft = maxlines
+				break
+			    }
+
+			    nchars = nchars + n
+			    lineno = lineno + 1
+			}
+
+			if (n == EOF)
+			    next
+			else
+			    break
+
+		    case PREV_FILE:
+			# If there are multiple files go to previous file,
+			# otherwise, go to previous page (formfeed).
+
+			if (nfiles > 1)
+			    goto quit_
+			if (redirin)
+			    goto err_
+
+			# Special case - just reached beginning of next
+			# page, but still displaying previous page.
+
+			if (pglno[pageno] == lineno)
+			    pageno = max (1, pageno - 1)
+
+			# If the beginning of the current page is not on
+			# the screen, go back to the beginning of the page.
+
+			if (lineno <= pglno[pageno]+maxlines)
+			    pageno = max (1, pageno - 1)
+
+			# Go there.
+			call seek (fd, pgoff[pageno])
+			nchars = pgnch[pageno]
+			lineno = pglno[pageno]
+			pushback = false
+
+			if (!redirout) {
+			    call ttyclear (STDERR, tty)
+			    call flush (STDERR)
+			    lnout = 0
+			}
+			if (getci (fd, ch) != '\f')
+			    call ungetci (fd, ch)
+			nleft = maxlines
+			break
+
+		    case QUIT:
+quit_			call close (fd)
+			call lno_close (lp)
+			call sfree (sp)
+			return (cmd)
+
+		    case TO_BOF:
+			if (redirin)
+			    goto err_
+
+			call pg_setprompt (Memc[prompt], u_prompt, fname)
+			call seek (fd, BOFL)
+			pushback = false
+			Memc[lbuf] = EOS
+			ateof  = false
+			lineno = 1
+			nchars = 0
+			nleft  = maxlines
+			pageno = 1
+
+			if (!redirout) {
+			    call ttyclear (STDERR, tty)
+			    call flush (STDERR)
+			    lnout = 0
+			}
+			break
+
+		    case FWD_SCREEN, BLANK:
+			if (!ateof && clear_screen == YES && !redirout) {
+			    call ttyclear (STDERR, tty)
+			    call flush (STDERR)
+			    lnout = 0
+			}
+			nleft = maxlines
+			break
+
+		    case TO_EOF, TO_EOF_ALT:
+			destline = MAX_INT
+			goto destline_
+		    case SCROLL_DOWN:
+			nleft = (maxlines + 1) / 2
+			break
+		    case SCROLL_UP:
+			if (redirin)
+			    goto err_
+			if (upline_ok) {
+			    destline = lineno - 2
+			    do i = 1, ((maxlines + 1) / 2 - 1)
+				if (lineno - lnout - i > 1)
+				    call pg_pushcmd (PREV_LINE)
+			} else
+			    destline = lineno - ((maxlines + 1) / 2) - 1
+			goto destline_
+		    case BACK_SCREEN:
+			if (redirin)
+			    goto err_
+			destline = lineno - maxlines - 1
+			goto destline_
+		    case PREV_LINE:
+			if (redirin)
+			    goto err_
+			destline = lineno - 2
+			goto destline_
+		    case REDRAW:
+			if (redirin)
+			    goto err_
+			destline = lineno
+			goto destline_
+		    case NEXT_LINE, CR, LF:
+			nleft = 1
+			break
+		    case SEARCH:
+			# Stop at next line containing current pattern.
+			goto search_
+
+		    case HELP:
+			cmd = pg_getcmd (tty, HELPTXT, 0, 0, 0, 0, 0)
+			# get another command
+
+		    case EDIT:
+			# Edit the file being paged.
+			if (redirin)
+			    goto err_
+
+			# Close file and LNO database.
+			call close (fd)
+			call lno_close (lp)
+			call flush (STDOUT)
+			call flush (STDERR)
+
+			# Command the CL to edit the file.
+			call sprintf (Memc[lbuf], SZ_LINE, "edit (\"%s\")")
+			    call pargstr (fname)
+			iferr (call clcmdw (Memc[lbuf]))
+			    call erract (EA_WARN)
+
+			# Reopen the file and LNO database.
+			iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) {
+			    call sfree (sp)
+			    return (NEXT_FILE)
+			} else
+			    lp = lno_open (LNO_MAXLINES)
+
+			# Redisplay the file at the BOF.
+			if (!redirout) {
+			    call ttyclear (STDERR, tty)
+			    call flush (STDERR)
+			    lnout = 0
+			}
+			Memc[lbuf] = EOS
+			nchars = 0
+			lineno = 1
+			nleft  = maxlines
+			break
+
+		    case LCMD:
+			# Colon escape.
+			call pg_getstr (Memc[cmdbuf], SZ_LINE)
+			for (ip=cmdbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+			    ;
+
+			if (Memc[ip] == '!') {
+			    # Send a command to the CL.
+
+			    iferr (call clcmdw (Memc[cmdbuf+1]))
+				call erract (EA_WARN)
+			    cmd = pg_getcmd (tty, Memc[prompt],
+				nchars, totchars, lineno, fileno, nfiles)
+			    Memc[lbuf] = EOS
+			    next
+
+			} else if (Memc[ip] == '/') {
+			    # Search for a line containing the given pattern.
+
+			    if (patmake (Memc[ip+1], patbuf, SZ_LINE) == ERR)
+				goto err_
+search_
+			    if (patbuf[1] == EOS) {
+				cmd = pg_getcmd (tty, "No current pattern",
+				    0, 0, 0, fileno, nfiles)
+				Memc[lbuf] = EOS
+				next
+			    }
+
+			    o_loffset = note (fd)
+			    o_nchars  = nchars
+			    o_lineno  = lineno
+			    o_pageno  = pageno
+
+			    repeat {
+				loffset = note (fd)
+				n = pg_getline (fd, Memc[lbuf])
+				if (n == EOF) {
+				    if (!redirin) {
+					call seek (fd, o_loffset)
+					pushback = false
+					nchars = o_nchars
+					lineno = o_lineno
+					pageno = o_pageno
+					ateof  = false
+				    }
+				    cmd = pg_getcmd (tty, "Pattern not found",
+					nchars,totchars,lineno,fileno,nfiles)
+				    Memc[lbuf] = EOS
+				    break
+				}
+
+				call lno_save (lp, lineno, loffset, nchars)
+				if (Memc[lbuf] == '\f') {
+				    pageno = pageno + 1
+				    pgoff[pageno] = loffset
+				    pgnch[pageno] = nchars
+				    pglno[pageno] = lineno
+				}
+
+				if (patmatch (Memc[lbuf], patbuf) > 0) {
+				    if (redirin) {
+					call ungetline (fd, Memc[lbuf])
+					pushback = true
+					nleft = maxlines
+					break
+				    } else {
+					destline = lineno
+					nchars = nchars + n
+					lineno = lineno + 1
+					goto destline_
+				    }
+				}
+
+				nchars = nchars + n
+				lineno = lineno + 1
+			    }
+
+			    if (n == EOF)
+				next
+			    else
+				break
+			}
+
+			# Case ":cmd arg".
+			for (op=token;  IS_ALPHA (Memc[ip]);  ip=ip+1) {
+			    Memc[op] = Memc[ip]
+			    op = op + 1
+			}
+			for (;  IS_WHITE (Memc[ip]);  ip=ip+1)
+			    ;
+			Memc[op] = EOS
+			toklen = op - token
+
+			# Print help if no : string given.
+			if (toklen <= 0) {
+			    call strcpy ("help", Memc[token], SZ_FNAME)
+			    toklen = 4
+			}
+
+			if (strncmp (Memc[token], "line", toklen) == 0) {
+			    # Move to the destination line, expressed as
+			    # ":line N" for an absolute line, or ":line +/-N"
+			    # for a relative move.
+
+			    destline = lineno
+			    if (Memc[ip] == '+') {
+				ip = ip + 1
+				if (ctoi (Memc, ip, n) > 0)
+				    destline = lineno + n
+			    } else if (Memc[ip] == '-') {
+				ip = ip + 1
+				if (ctoi (Memc, ip, n) > 0)
+				    destline = lineno - n
+			    } else if (ctoi (Memc, ip, n) > 0)
+				destline = n
+destline_
+			    # Upscroll one line?
+			    if (upline_ok && destline == lineno-2)
+				upline = true
+
+			    # Determine line at top of new screen.
+			    nleft = maxlines
+			    if (destline < lineno && destline >= lineno-lnout-1)
+				destline = destline - lnout + 1
+			    else
+				destline = destline - nleft + 1
+
+			    # Don't upscroll off the top of the screen.
+			    if (destline < 1) {
+				destline = 1
+				upline = false
+			    }
+
+			    # Look up the desired line offset in the database
+			    # and go directly there if found, otherwise either
+			    # advance forward or rewind the file and advance
+			    # forward to the indicated line.
+
+			    if (lno_fetch(lp,destline,loffset,nchars)==ERR) {
+				if (!redirin && destline < lineno) {
+				    call seek (fd, BOFL)
+				    pushback = false
+				    lineno = 1
+				    pageno = 1
+				    nchars = 0
+				    ateof  = false
+				    call pg_setprompt (Memc[prompt],
+					u_prompt, fname)
+				}
+
+				while (lineno < destline) {
+				    loffset = note (fd)
+				    n = pg_getline (fd, Memc[lbuf])
+				    if (n == EOF) {
+					destline = lineno - 1	# goto EOF
+					goto destline_
+				    }
+				    call lno_save (lp, lineno, loffset, nchars)
+				    if (Memc[lbuf] == '\f') {
+					pageno = pageno + 1
+					pgoff[pageno] = loffset
+					pgnch[pageno] = nchars
+					pglno[pageno] = lineno
+				    }
+				    nchars = nchars + n
+				    lineno = lineno + 1
+				}
+			    } else if (!redirin) {
+				call seek (fd, loffset)
+				pushback = false
+				lineno = destline
+				ateof  = false
+
+				# Determine which page we are in.
+				do i = 2, MAX_PAGE
+				    if (pglno[i] <= 0) {
+					pageno = i - 1
+					break
+				    } else if (pglno[i] >= lineno) {
+					pageno = i
+					break
+				    }
+
+				call pg_setprompt (Memc[prompt],u_prompt,fname)
+			    }
+
+			    # Prepare to draw the screen.  Upline mode means
+			    # we want to insert a line at the top of the screen
+			    # and then skip to the page prompt; otherwise we
+			    # clear the screen and output a full page of text.
+
+			    if (!redirout) {
+				if (upline) {
+				    # Clear screen if backing up over a page.
+				    if (destline+1 == pglno[pageno])
+					call ttyclear (STDERR, tty)
+				    call ttygoto (STDOUT, tty, 1, 1)
+				    junk = ttyctrl (STDOUT, tty, "al", maxlines)
+				    lnout = 0
+				} else {
+				    call ttyclear (STDERR, tty)
+				    upline = false
+				    lnout = 0
+				}
+				call flush (STDERR)
+			    }
+			    Memc[lbuf] = EOS
+			    break
+
+			} else if (strncmp (Memc[token], "file", toklen) == 0) {
+			    # Position to the named file (must be in file list).
+
+			    call strcpy (Memc[ip], newfname, SZ_FNAME)
+			    call close (fd)
+			    call lno_close (lp)
+			    call sfree (sp)
+			    return (TO_FILE)
+
+			} else if (strncmp (Memc[token],"spool",toklen) == 0) {
+			    # Begin spooling output in a file.
+
+			    if (spoolfd != NULL) {
+				call close (spoolfd)
+				spoolfd = NULL
+			    }
+
+			    if (Memc[ip] == EOS) {
+				;
+			    } else iferr {
+				spoolfd = open (Memc[ip], APPEND, TEXT_FILE)
+			    } then {
+				spoolfd = NULL
+				call erract (EA_WARN)
+			    }
+
+			    # Get next keystroke from the user.
+			    cmd = pg_getcmd (tty, Memc[prompt],
+				nchars, totchars, lineno, fileno, nfiles)
+
+			} else {
+			    cmd = pg_getcmd (tty,
+			    "colon cmds: :!cmd :/pat :line L :file F :spool F",
+				0, 0, 0, 0, 0)
+			}
+
+		    default:
+err_			call eprintf ("\07")
+			call flush (STDERR)
+			cmd = pg_getcmd (tty, Memc[prompt], nchars, totchars,
+			    lineno, fileno, nfiles)
+		    }
+		}
+	    }
+	}
+end
+
+
+# PG_SETPROMPT -- Set the prompt string for the ukey end-of-page query.
+# The name of the file currently being paged is used unless a prompt string
+# is given.
+
+procedure pg_setprompt (prompt, u_prompt, fname)
+
+char	prompt[SZ_FNAME]		# receives prompt string
+char	u_prompt[ARB]			# user prompt string
+char	fname[ARB]			# file being paged
+
+int	gstrcpy()
+
+begin
+	if (gstrcpy (u_prompt, prompt, SZ_FNAME) <= 0)
+	    call strcpy (fname, prompt, SZ_FNAME)
+end
+
+
+# PG_GETLINE -- Get a line from the input file.  Accumulates very long lines
+# (requiring several getline calls to read) into a single string.
+
+int procedure pg_getline (fd, lbuf)
+
+int	fd			# input file
+char	lbuf[SZ_LONGLINE]	# output buffer
+
+int	nchars, op
+int	getline()
+errchk	getline
+
+begin
+	for (op=1;  op + SZ_LINE < SZ_LONGLINE;  op=op+nchars) {
+	    nchars = getline (fd, lbuf[op])
+	    if (nchars == EOF) {
+		if (op == 1)
+		    return (EOF)
+		else
+		    return (op - 1)
+	    } else if (lbuf[op+nchars-1] == '\n')
+		break
+	}
+
+	return (op + nchars - 1)
+end
+
+
+# PG_GETCMD -- Query the user for a single character command keystroke.
+# A prompt naming the current file and our position in it is printed,
+# we read the single character command keystroke in raw mode, and then
+# the prompt line is cleared and we return.
+
+int procedure pg_getcmd (tty, fname, nchars, totchars, lineno, fileno, nfiles)
+
+pointer	tty			# tty descriptor
+char	fname[ARB]		# prefix string
+long	nchars			# position in file
+long	totchars		# size of file
+int	lineno			# current line number
+int	fileno			# current file number
+int	nfiles			# nfiles being paged through
+
+char	keystr[SZ_KEYSTR]
+int	key, pb, pbcmd[MAX_PBCMD]
+common	/pgucom/ key, pb, pbcmd, keystr
+int	clgkey(), fstati()
+
+begin
+	# If any commands have been pushed, return the next pushed command
+	# without generating a query.
+
+	if (pb > 0) {
+	    key = pbcmd[pb]
+	    pb = pb - 1
+	    return (key)
+	}
+
+	# If the standard output is redirected, skip the query and just go on
+	# to the next page.
+
+	if (fstati (STDOUT, F_REDIR) == YES)
+	    return (FWD_SCREEN)
+
+	# Ensure synchronization with the standard output.
+	call flush (STDOUT)
+
+	# Print query in standout mode, preceded by %done info.
+	call ttyso (STDERR, tty, YES)
+	call eprintf ("%s")
+	    call pargstr (fname)
+	if (totchars > 0) {
+	    if (nchars >= totchars + SZ_LINE)
+		call eprintf ("-(EOF)")
+	    else {
+		call eprintf ("-(%02d%%)")
+		    call pargi (max(0, min(99, nchars * 100 / totchars)))
+	    }
+	}
+	if (lineno > 0) {
+	    call eprintf ("-line %d")
+		call pargi (lineno - 1)
+	}
+	if (fileno > 0 && nfiles > 0) {
+	    call eprintf ("-file %d of %d")
+		call pargi (fileno)
+		call pargi (nfiles)
+	}
+	call ttyso (STDERR, tty, NO)
+	call flush (STDERR)
+
+	call fseti (STDIN, F_SETREDRAW, REDRAW)
+
+	# Read the user's response, normally a single keystroke.
+	if (clgkey (UKEYS, key, keystr, SZ_KEYSTR) == EOF)
+	    key = INTCHAR
+
+	call fseti (STDIN, F_SETREDRAW, 0)
+
+	if (key == INTCHAR)
+	    key = QUIT
+	else if (key == NEXT_FILE_ALT)
+	    key = NEXT_FILE
+	else if (key == PREV_FILE_ALT)
+	    key = PREV_FILE
+
+	# Erase the prompt and return.
+	call eprintf ("\r")
+	call ttyclearln (STDERR, tty)
+	call flush (STDERR)
+
+	return (key)
+end
+
+
+# PG_GETSTR -- Called after receipt of a : key to get the string value.
+
+procedure pg_getstr (strval, maxch)
+
+char	strval[maxch]		# receives string
+int	maxch
+
+char	keystr[SZ_KEYSTR]
+int	key, pb, pbcmd[MAX_PBCMD]
+common	/pgucom/ key, pb, pbcmd, keystr
+
+begin
+	call strcpy (keystr, strval, maxch)
+end
+
+
+# PG_PUSHCMD -- Push back a command keystroke.
+
+procedure pg_pushcmd (cmd)
+
+int	cmd			#I command to be pushed
+
+char	keystr[SZ_KEYSTR]
+int	key, pb, pbcmd[MAX_PBCMD]
+common	/pgucom/ key, pb, pbcmd, keystr
+
+begin
+	if (cmd <= 0)
+	    pb = 0
+	else {
+	    pb = min (MAX_PBCMD, pb + 1)
+	    pbcmd[pb] = cmd
+	}
+end
+
+
+# PG_PEEKCMD -- Peek at any pushed back command keystroke.
+
+int procedure pg_peekcmd()
+
+char	keystr[SZ_KEYSTR]
+int	key, pb, pbcmd[MAX_PBCMD]
+common	/pgucom/ key, pb, pbcmd, keystr
+
+begin
+	if (pb <= 0)
+	    return (ERR)
+	else
+	    return (pbcmd[pb])
+end
diff --git a/sys/etc/prc.com b/sys/etc/prc.com
new file mode 100644
index 00000000..5893ef10
--- /dev/null
+++ b/sys/etc/prc.com
@@ -0,0 +1,27 @@
+define	MAX_PS		10		# maximum pseudofiles
+
+# Process table common.
+
+int	pr_pid[MAX_CHILDPROCS]		# process id
+int	pr_status[MAX_CHILDPROCS]	# process status
+int	pr_inchan[MAX_CHILDPROCS]	# input IPC channel from child
+int	pr_infd[MAX_CHILDPROCS]		# fd of input IPC
+int	pr_outchan[MAX_CHILDPROCS]	# output IPC channel to child
+int	pr_outfd[MAX_CHILDPROCS]	# fd of output IPC
+int	pr_nopen[MAX_CHILDPROCS]	# number of open channels
+int	pr_pstofd[MAX_CHILDPROCS,MAX_PS]	# pseudofile -> FD
+int	pr_last_exit_code		# exit code of last process closed
+int	pr_lastio			# index of last active process
+int	pr_index			# index of current process
+int	pr_oldipc			# old X_IPC handler
+int	epa_giotr			# gio.cursor driver entry points
+int	epa_control			#	"	"
+int	epa_gflush			#	"	"
+int	epa_writep			#	"	"
+int	epa_readtty			#	"	"
+int	epa_writetty			#	"	"
+
+common	/prccom/ pr_pid, pr_status, pr_inchan, pr_infd, pr_outchan, pr_outfd,
+	pr_nopen, pr_pstofd, pr_lastio, pr_last_exit_code, pr_index, pr_oldipc,
+	epa_giotr, epa_control, epa_gflush, epa_writep, epa_readtty,
+	epa_writetty
diff --git a/sys/etc/prchdir.x b/sys/etc/prchdir.x
new file mode 100644
index 00000000..d11c903a
--- /dev/null
+++ b/sys/etc/prchdir.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PRCHDIR -- Change the current working directory of a connected child
+# process, or of all connected subprocesses if pid=0.
+
+procedure prchdir (pid, newdir)
+
+int	pid		# process id of child, or 0 for all subprocesses
+char	newdir[ARB]	# new directory
+pointer	sp, cmd
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_COMMAND, TY_CHAR)
+
+	call strcpy ("chdir ", Memc[cmd], SZ_COMMAND)
+	call strcat (newdir, Memc[cmd], SZ_COMMAND)
+
+	call prupdate (pid, Memc[cmd], YES)
+	call sfree (sp)
+end
diff --git a/sys/etc/prclcpr.x b/sys/etc/prclcpr.x
new file mode 100644
index 00000000..e5dd397c
--- /dev/null
+++ b/sys/etc/prclcpr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# PRCLCPR -- Close a connected subprocess.  Given the PID of the child process
+# we get the input and output file descriptors from the process table and
+# close both files.  When the second file is closed the process is disconnected
+# by the PR_ZCLSPR procedure, which leaves the exit status in the process table
+# common.
+
+int procedure prclcpr (pid)
+
+int	pid			# process id of child process
+
+int	child
+int	pr_findproc()
+include	"prc.com"
+errchk	syserr
+
+begin
+	# Search process table for the PID of the child process and close it
+	# if found.  Return process termination code to parent.
+
+	child = pr_findproc (pid)
+	if (child == ERR)
+	    call syserr (SYS_PRNOTFOUND)
+
+	call close (pr_infd[child])
+	call close (pr_outfd[child])
+
+	return (pr_last_exit_code)
+end
diff --git a/sys/etc/prcldpr.x b/sys/etc/prcldpr.x
new file mode 100644
index 00000000..479fffb9
--- /dev/null
+++ b/sys/etc/prcldpr.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+
+define	NOKILL		NO
+define	KILL		YES
+
+# PRCLDPR -- Close a detached process.  Called following process termination
+# to obtain the exit status and free up any system resources still allocated
+# to the job.  If called prior to job termination execution of the current
+# process will be suspended until the bkg job terminates.  PRDONE should be
+# called to determine if the job is still running if waiting is not desired.
+
+int procedure prcldpr (job)
+
+int	job			# slot number of job in prd.com table
+int	exit_status
+include	"prd.com"
+
+begin
+	# Wait for process to terminate if it is still active.  If we are
+	# interrupted the process table is left unmodified.  If the process
+	# has been killed the exit status will have been left in the table
+	# and ZCLDPR should not be called again.
+
+	if (pr_jobcode[job] == NULL)
+	    call syserr (SYS_PRBKGNF)
+	else if (pr_active[job] == YES)
+	    call zcldpr (pr_jobcode[job], NOKILL, exit_status)
+	else
+	    exit_status = pr_exit_status[job]
+
+	# Free all remaining resources allocated to job.  The bkgfile should
+	# already have been deleted by the process but if not, e.g., in the
+	# event of abnormal process termination, we delete it ourselves.  The
+	# buffer for the bkgfile filename is freed as is the slot in the
+	# process table.
+
+	iferr (call delete (Memc[pr_bkgfile[job]]))
+	    ;
+	call mfree (pr_bkgfile[job], TY_CHAR)
+	pr_jobcode[job] = NULL
+
+	return (exit_status)
+end
diff --git a/sys/etc/prclose.x b/sys/etc/prclose.x
new file mode 100644
index 00000000..26e2702c
--- /dev/null
+++ b/sys/etc/prclose.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<prstat.h>
+
+# PRCLOSE -- Close a connected subprocess.  Send the command "bye" to the
+# child to initiate process shutdown, then close the IPC channels and
+# wait for the child to terminate, returning the termination status to
+# our caller.  Note that process shutdown may take an arbitrarily long
+# time, depending on the number and nature of ONEXIT procedures posted by
+# tasks in the the child process.
+
+int procedure prclose (pid)
+
+int	pid			# process-id of child process
+
+int	child
+int	pr_findproc(), prclcpr()
+include	"prc.com"
+errchk	syserr
+
+begin
+	child = pr_findproc (pid)
+	if (child == ERR)
+	    call syserr (SYS_PRNOTFOUND)
+
+	if (pr_status[child] != P_DONE && pr_status[child] != P_DEAD)
+	    call putline (pr_outfd[child], "bye\n")
+
+	return (prclcpr (pid))
+end
diff --git a/sys/etc/prd.com b/sys/etc/prd.com
new file mode 100644
index 00000000..599dc6b6
--- /dev/null
+++ b/sys/etc/prd.com
@@ -0,0 +1,8 @@
+# Job table for detached processes.
+
+int	pr_jobcode[MAX_BKGJOBS]		# job code assigned by host system
+int	pr_active[MAX_BKGJOBS]		# set to NO if job is killed
+int	pr_exit_status[MAX_BKGJOBS]	# exit status of process
+pointer	pr_bkgfile[MAX_BKGJOBS]		# bkgfile filename (signals job term)
+
+common	/prdcom/ pr_jobcode, pr_active, pr_exit_status, pr_bkgfile
diff --git a/sys/etc/prdone.x b/sys/etc/prdone.x
new file mode 100644
index 00000000..2df2dccc
--- /dev/null
+++ b/sys/etc/prdone.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# PRDONE -- Determine if a detached process (background job) has completed.
+# This is a difficult process to perform portably at the system call level,
+# hence the deletion of the bkgfile is used to signal the completion of a
+# detached process.  If the detached process fails to delete its bkgfile
+# for some reason, PRCLDPR will do so if the process has indeed terminated.
+
+int procedure prdone (job)
+
+int	job			# job number (slot number in job table)
+int	access()
+include	"prd.com"
+
+begin
+	if (pr_jobcode[job] == NULL)
+	    call syserr (SYS_PRBKGNF)
+
+	if (access (Memc[pr_bkgfile[job]], 0, 0) == YES)
+	    return (NO)
+	else
+	    return (YES)
+end
diff --git a/sys/etc/prenvfree.x b/sys/etc/prenvfree.x
new file mode 100644
index 00000000..90908789
--- /dev/null
+++ b/sys/etc/prenvfree.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PRENVFREE -- Free any recently defined or redefined environment variables,
+# updating the values of any redefined variables uncovered by the free
+# operation in the specified connected subprocesses.
+
+int procedure prenvfree (pid, marker)
+
+int	pid		# pid of process to be updated, or 0 for all subprocs
+int	marker		# stack pointer returned by ENVMARK
+
+int	ev_pid
+common	/prvcom/ ev_pid
+int	locpr(), envfree()
+extern	prv_reset()
+
+begin
+	ev_pid = pid
+	return (envfree (marker, locpr (prv_reset)))
+end
+
+
+# PRV_RESET -- Reset the value of an environment variable in the specified
+# connected subprocesses.
+
+procedure prv_reset (name, value)
+
+char	name[ARB]		# name of variable to be reset
+char	value[ARB]		# new value
+
+int	ev_pid
+common	/prvcom/ ev_pid
+
+begin
+	call prenvset (ev_pid, name, value)
+end
diff --git a/sys/etc/prenvset.x b/sys/etc/prenvset.x
new file mode 100644
index 00000000..6c21133d
--- /dev/null
+++ b/sys/etc/prenvset.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PRENVSET -- Change the value of an environment variable in a connected child
+# process, or in all connected subprocesses if pid=0.
+
+procedure prenvset (pid, envvar, valuestr)
+
+int	pid		# process id of child, or 0 for all subprocesses
+char	envvar[ARB]	# name of environment variable
+char	valuestr[ARB]	# value of environment variable
+pointer	sp, cmd
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_COMMAND, TY_CHAR)
+
+	call strcpy ("set ",   Memc[cmd], SZ_COMMAND)
+	call strcat (envvar,   Memc[cmd], SZ_COMMAND)
+	call strcat ("=",      Memc[cmd], SZ_COMMAND)
+	call strcat (valuestr, Memc[cmd], SZ_COMMAND)
+
+	call prupdate (pid, Memc[cmd], NO)
+	call sfree (sp)
+end
diff --git a/sys/etc/prfilbuf.x b/sys/etc/prfilbuf.x
new file mode 100644
index 00000000..4ec09907
--- /dev/null
+++ b/sys/etc/prfilbuf.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# PRFILBUF -- Fill the FIO buffer from a process.  The function is equivalent
+# to the ordinary FIO filbuf with the exception that pseudofile read and
+# write directives are intercepted and processed.  Hence, the reader sees a
+# stream of application specific commands need not know about pseudofile i/o.
+
+int procedure prfilbuf (fd)
+
+int	fd			# parent's input IPC from child process
+
+int	pr
+int	filbuf(), prpsio()
+include	"prc.com"
+
+begin
+	# Determine which process has the given file as its CLIN stream.
+	# If FD not associated with a process call ordinary FILBUF, otherwise
+	# call PR_PSIO.  To minimize searches of the process table we keep
+	# track of the slot number of the last active pid.
+
+	if (pr_infd[pr_lastio] == fd && pr_pid[pr_lastio] != NULL)
+	    pr = pr_lastio
+	else {
+	    for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+		if (pr_pid[pr] != NULL)
+		    if (pr_infd[pr] == fd)
+			break
+	    if (pr > MAX_CHILDPROCS)
+		return (filbuf (fd))			# normal file
+	    pr_lastio = pr
+	}
+
+	return (prpsio (pr_pid[pr], CLIN, FF_READ))
+end
diff --git a/sys/etc/prfindpr.x b/sys/etc/prfindpr.x
new file mode 100644
index 00000000..3df73ed2
--- /dev/null
+++ b/sys/etc/prfindpr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# PR_FINDPROC -- Search the process table for the given PID of a child process,
+# returning the index of the process if found.
+
+int procedure pr_findproc (pid)
+
+int	pid			# process id of child process
+int	pr
+include	"prc.com"
+
+begin
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if (pr_pid[pr] == pid)
+		return (pr)
+	
+	return (ERR)
+end
diff --git a/sys/etc/prgline.x b/sys/etc/prgline.x
new file mode 100644
index 00000000..21ec1780
--- /dev/null
+++ b/sys/etc/prgline.x
@@ -0,0 +1,204 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<fset.h>
+
+define	XMIT		0
+define	XFER		1
+
+# PRGETLINE -- Get a line of text from a process.  The function is equivalent
+# to the ordinary FIO getline with the exception that pseudofile read and
+# write directives are intercepted and processed.  Hence, the reader sees a
+# stream of application specific commands need not know about pseudofile i/o.
+# The function of PRGETLINE is such that it can be used in place of GETLINE
+# on any file; pseudofile directives are recognized and process only if the
+# FD is associated with a connected subprocess.
+
+int procedure prgetline (fd, lbuf)
+
+int	fd			# parent's input IPC from child process
+char	lbuf[SZ_LINE]		# output line buffer
+
+char	ch
+int	nchars, maxchars, nchars_read, raw_mode_set, ndigits
+int	bufsize, outfd, destfd, pr, pseudofile, line_type, offset
+pointer	sp, buf, ip
+
+char	getc()
+int	getline(), read(), fstati(), ctoi(), itoc()
+errchk	syserr, getline, fstati, read, write, pr_decodeargs, putc, getc
+include	"prc.com"
+
+begin
+	call smark (sp)
+
+	pr = 0
+	buf = NULL
+	raw_mode_set = 0
+
+	repeat {
+	    nchars = getline (fd, lbuf)
+
+	    # Return immediately if not XMIT or XFER directive.  This code is
+	    # exercised heavily when performing raw mode i/o, hence some
+	    # clarity is sacrificed for the sake of efficiency.
+	    #
+	    # Syntax: "xmit(P,NNN)" or "xfer(P,NNN)"
+	    #	       12345678         12345678
+	    #
+	    # where P is the pseudofile code (0<P<10) and NNN is the size of
+	    # the data block in chars.  In the following code all explicit
+	    # integer constants refer to the character offsets shown above.
+
+	    if (lbuf[1] != 'x' || nchars == EOF) {
+		break
+	    } else if (lbuf[2] == 'm') {
+		if (lbuf[3] == 'i' && lbuf[4] == 't' && lbuf[5] == '(') {
+		    line_type = XMIT
+		    pseudofile = TO_INTEG (lbuf[6])
+		} else
+		    break
+	    } else if (lbuf[2] == 'f') {
+		if (lbuf[3] == 'e' && lbuf[4] == 'r' && lbuf[5] == '(') {
+		    line_type = XFER
+		    pseudofile = TO_INTEG (lbuf[6])
+		} else
+		    break
+	    } else
+		break
+
+	    # Ignore directive if FD not associated with a process.  To minimize
+	    # searches of the process table we keep track of the slot number
+	    # of the last active pid.
+
+	    if (pr == 0) {
+		if (pr_infd[pr_lastio] == fd && pr_pid[pr_lastio] != NULL)
+		    pr = pr_lastio
+		else {
+		    for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+			if (pr_pid[pr] != NULL)
+			    if (pr_infd[pr] == fd)
+				break
+		    if (pr > MAX_CHILDPROCS)
+			break
+		    pr_lastio = pr
+		}
+		outfd  = pr_outfd[pr]
+	    }
+
+	    # Map pseudofile code to a file descriptor in the local process.
+
+	    destfd = pr_pstofd[pr,pseudofile]
+
+
+	    # RAW mode transfers are handled as a special case to minimize the
+	    # per-character overhead.
+
+	    if (lbuf[8] == '1' && lbuf[9] == ')') {
+		if (line_type == XMIT) {
+		    # XMIT
+		    if (getc (fd, ch) == EOF)
+			call syserr (SYS_PRIPCSYNTAX)
+
+		    # Clear RAW input mode if newline is encountered in output.
+		    # Only works for STDIN/STDOUT, but that is all raw mode is
+		    # used for with pseudofiles.
+
+		    if (ch == '\n')
+			if (destfd == STDOUT) {
+			    call fseti (STDIN, F_RAW, NO)
+			    if (raw_mode_set == STDIN)
+				raw_mode_set = 0
+			}
+
+		    call putc (destfd, ch)
+		    call flush (destfd)
+
+		} else {
+		    # XFER
+		    if (raw_mode_set != destfd) {
+			call fseti (destfd, F_RAW, YES)
+			raw_mode_set = destfd
+		    }
+
+		    if (getc (destfd, ch) == EOF)
+			call putline (outfd, "0\n")
+		    else {
+			call putline (outfd, "1\n")
+			call flush (outfd)
+			call putc (outfd, ch)
+		    }
+		    call flush (outfd)
+		}
+		next
+	    }
+
+
+	    # GENERAL XMIT or XFER directive.  Read a block of data from one
+	    # stream and transmit it to the other stream.
+
+	    if (buf == NULL) {
+		bufsize = fstati (fd, F_BUFSIZE)
+		call salloc (buf, bufsize, TY_CHAR)
+	    }
+	    
+	    offset = 8
+	    if (ctoi (lbuf, offset, nchars) <= 0)
+		call syserr (SYS_PRIPCSYNTAX)
+
+	    if (line_type == XMIT) {
+		# XMIT -- Copy the block of data from the IPC channel to the
+		# destination file.
+
+		nchars_read = read (fd, Memc[buf], nchars)
+		if (nchars_read != nchars)
+		    call syserr (SYS_PRIPCSYNTAX)
+		else {
+		    # Clear RAW input mode if set and newline is encountered
+		    # in the output stream.
+
+		    if (destfd == STDOUT)
+			if (fstati (STDIN, F_RAW) == YES)
+			    for (ip=buf+nchars-1;  ip >= buf;  ip=ip-1)
+				if (Memc[ip] == '\n') {
+				    call fseti (STDIN, F_RAW, NO)
+				    if (raw_mode_set == STDIN)
+					raw_mode_set = 0
+				    break
+				}
+
+		    call write (destfd, Memc[buf], nchars)
+		    call flush (destfd)
+		}
+		next
+
+	    } else {
+		# XFER -- Read up to maxchars chars from the input file and
+		# pass them on to the output IPC channel.
+
+		maxchars = min (nchars, bufsize)
+		nchars = read (destfd, Memc[buf], maxchars)
+		if (nchars == EOF)
+		    nchars = 0
+
+		# Write the byte count record followed by the data record.
+		# These must be written as two separate records or deadlock
+		# will occur (with the reader waiting for the second record).
+
+		ndigits = itoc (nchars, lbuf, SZ_LINE)
+		lbuf[ndigits+1] = '\n'
+		call write (outfd, lbuf, ndigits + 1)
+		call flush (outfd)
+
+		call write (outfd, Memc[buf], nchars)
+		call flush (outfd)
+
+		next
+	    }
+	}
+
+	call sfree (sp)
+	return (nchars)
+end
diff --git a/sys/etc/prgredir.x b/sys/etc/prgredir.x
new file mode 100644
index 00000000..c5ffceee
--- /dev/null
+++ b/sys/etc/prgredir.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# PR_GETREDIR -- Get the pseudofile redirection code for a process.
+
+int procedure pr_getredir (pid, stream)
+
+int	pid			# process id
+int	stream			# stream for which redirection info is needed
+
+int	pr
+int	pr_findproc()
+include	"prc.com"
+
+begin
+	pr = pr_findproc (pid)
+	return (pr_pstofd[pr,stream])
+end
diff --git a/sys/etc/prkill.x b/sys/etc/prkill.x
new file mode 100644
index 00000000..f6938923
--- /dev/null
+++ b/sys/etc/prkill.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+
+define	NOKILL		NO
+define	KILL		YES
+
+# PRKILL -- Kill a detached process.  Control does not return until the process
+# has terminated, unless the kill fails for some reason.  If the process exists
+# and is terminated by the kill directive, the exit status is left in the
+# process table for return by PRCLDPR.
+
+procedure prkill (job)
+
+int	job			# slot number of job in prd.com table
+include	"prd.com"
+errchk	syserr
+
+begin
+	# Kill the process if there is such a process and it is still active.
+	# It is an error to try to kill a nonexistent process or a process
+	# which has already been killed.
+
+	if (pr_jobcode[job] == NULL)
+	    call syserr (SYS_PRBKGNF)
+	else if (pr_active[job] == NO)
+	    call syserr (SYS_PRBKGNOKILL)
+	else {
+	    call zcldpr (pr_jobcode[job], KILL, pr_exit_status[job])
+	    if (pr_exit_status[job] == ERR)
+		call syserr (SYS_PRBKGNOKILL)
+	    else
+		pr_active[job] = NO
+	}
+
+	# Delete the bkgfile if the process has not already done so during
+	# shutdown.
+	iferr (call delete (Memc[pr_bkgfile[job]]))
+	    ;
+end
diff --git a/sys/etc/propcpr.x b/sys/etc/propcpr.x
new file mode 100644
index 00000000..b7b394a1
--- /dev/null
+++ b/sys/etc/propcpr.x
@@ -0,0 +1,201 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<xwhen.h>
+include	<prstat.h>
+
+# PROPCPR -- Open a connected subprocess, i.e., spawn the subprocess and
+# connect the two IPC channels to FIO file descriptors.  No i/o is done on
+# the IPC channels, hence this relatively low level command is independent
+# of the IPC protocol used.  PROPEN should be used if the standard IPC
+# protocol is followed, so that the environment and current working directory
+# may be passed to the subprocess.
+
+int procedure propcpr (process, in, out)
+
+char	process[ARB]		# filename of executable process file
+int	in			# fd of IPC input from child (output)
+int	out			# fd of IPC output to child (output)
+
+bool	first_time
+int	pr, loc_onipc
+pointer	sp, fname
+int	fopnbf()
+extern	pr_onipc(), pr_dummy_open(), pr_zclspr()
+extern	zardpr(), zawrpr(), zawtpr(), zsttpr()
+errchk	xwhen, fmapfn, syserr
+include	"prc.com"
+
+define	cleanup1_ 91
+define	cleanup2_ 92
+define	cleanup3_ 93
+data	first_time /true/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the process table.  Post exception handler to recover
+	# from write to IPC with no reader.
+
+	if (first_time) {
+	    do pr = 1, MAX_CHILDPROCS
+		pr_pid[pr] = NULL
+	    pr_lastio = 1		# any legal slot number will do
+	    pr_last_exit_code = OK
+	    call zlocpr (pr_onipc, loc_onipc)
+	    call xwhen (X_IPC, loc_onipc, pr_oldipc)
+	    first_time = false
+	}
+
+	# Find empty process slot.
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if (pr_pid[pr] == NULL)
+		break
+	if (pr > MAX_CHILDPROCS)
+	    call syserr (SYS_PROVFL)
+	pr_index = pr
+
+	# Initialize the mapping of pseudofile codes to file descriptor numbers.
+	# PS codes begin at 1, corresponding to STDIN.
+
+	pr_pstofd[pr,STDIN]    = STDIN
+	pr_pstofd[pr,STDOUT]   = STDOUT
+	pr_pstofd[pr,STDERR]   = STDERR
+	pr_pstofd[pr,STDGRAPH] = STDGRAPH
+	pr_pstofd[pr,STDIMAGE] = STDIMAGE
+	pr_pstofd[pr,STDPLOT]  = STDPLOT
+
+	# Spawn process and open IPC channels.
+	call fmapfn (process, Memc[fname], SZ_PATHNAME)
+	call zopcpr (Memc[fname], pr_inchan[pr], pr_outchan[pr], pr_pid[pr])
+	if (pr_pid[pr] == ERR)
+	    goto cleanup3_
+	pr_nopen[pr] = 2
+
+	# Set up file descriptors for the two IPC channels.
+
+	call strcpy (process, Memc[fname], SZ_PATHNAME)
+	call strcat (".in", Memc[fname], SZ_PATHNAME)
+	iferr (in = fopnbf (Memc[fname], READ_ONLY,
+	    pr_dummy_open, zardpr, zawrpr, zawtpr, zsttpr, pr_zclspr))
+	    goto cleanup2_
+	pr_infd[pr] = in
+
+	call strcpy (process, Memc[fname], SZ_PATHNAME)
+	call strcat (".out", Memc[fname], SZ_PATHNAME)
+	iferr (out = fopnbf (Memc[fname], WRITE_ONLY,
+	    pr_dummy_open, zardpr, zawrpr, zawtpr, zsttpr, pr_zclspr))
+	    goto cleanup1_
+	pr_outfd[pr] = out
+
+	pr_status[pr] = P_RUNNING
+	call sfree (sp)
+	return (pr_pid[pr])
+
+cleanup1_
+	iferr (call close (out))
+	    ;
+cleanup2_
+	iferr (call close (in))
+	    ;
+cleanup3_
+	call sfree (sp)
+	pr_pid[pr] = NULL
+	call syserrs (SYS_PROPEN, process)
+end
+
+
+# PR_DUMMY_OPEN -- Dummy ZOPNPR procedure called by FIO to "open" the IPC
+# channel to a subprocess.  Our only function is to return the appropriate
+# channel code to FIO, since the channel has already been opened by ZOPCPR.
+
+procedure pr_dummy_open (osfn, mode, chan)
+
+char	osfn[ARB]		# not used
+int	mode			# used to select read or write IPC channel
+int	chan			# returned to FIO
+include	"prc.com"
+
+begin
+	if (mode == READ_ONLY)
+	    chan = pr_inchan[pr_index]
+	else
+	    chan = pr_outchan[pr_index]
+end
+
+
+# PR_ZCLSPR -- Dummy "zclspr" routine called by FIO to close an IPC channel
+# when CLOSE is called on the corresponding FIO file descriptor.  A subprocess
+# opened with PROPCPR is normally closed with PRCLCPR, but if error recovery
+# takes place CLOSE will automatically be called by the system to close both
+# file descriptors.  We decrement the count of open channels and close the
+# process and both IPC channels when the count reaches zero.  Hence, a
+# connected subprocess may be closed either by calling PRCLCPR or by closing
+# the IN and OUT file descriptors.
+
+procedure pr_zclspr (chan, status)
+
+int	chan			# either inchan or outchan of process
+int	status			# OK or ERR on output
+int	pr
+include	"prc.com"
+
+begin
+	do pr = 1, MAX_CHILDPROCS
+	    if (pr_pid[pr] != NULL)
+		if (pr_inchan[pr] == chan || pr_outchan[pr] == chan) {
+		    pr_nopen[pr] = pr_nopen[pr] - 1
+		    if (pr_nopen[pr] == 0) {
+			call zclcpr (pr_pid[pr], pr_last_exit_code)
+			pr_pid[pr] = NULL
+		    }
+		    status = OK
+		    return
+		}
+
+	status = ERR
+end
+
+
+# PR_ONIPC -- Exception handler for the X_IPC (write to IPC with no reader)
+# exception.  This exception occurs when the child process dies unexpectedly.
+# Determine what process was being written to, cancel any output (to prevent
+# a cascade of onipcs trying to flush the output buffer), and cause FIO to
+# return a file write error.  We cannot do any more than that w/o reentrancy
+# problems.
+
+procedure pr_onipc (vex, next_handler)
+
+int	vex		# virtual exception
+int	next_handler	# next handler in chain
+int	pr, fd
+int	fstati()
+include	"prc.com"
+
+begin
+	# Chain to next exception handler, if any.
+	next_handler = pr_oldipc
+
+	# Get the FD of the file being written to at the time that the
+	# exception occurred.  We assume that the write operation is still
+	# in progress when the exception takes place.
+
+	fd = fstati (0, F_LASTREFFILE)
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if (pr_pid[pr] != NULL)
+		if (pr_outfd[pr] == fd)
+		    break
+	if (pr > MAX_CHILDPROCS)
+	    return
+
+	# Cancel any buffered output and remove write permission to ensure
+	# that we will not get a cascade of X_IPC exceptions.
+
+	call fseti (fd, F_CANCEL, ERR)
+	call fseti (fd, F_MODE, READ_ONLY)
+	pr_status[pr] = P_DEAD
+end
diff --git a/sys/etc/propdpr.x b/sys/etc/propdpr.x
new file mode 100644
index 00000000..79690a60
--- /dev/null
+++ b/sys/etc/propdpr.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+
+# PROPDPR -- Open a detached process.  A detached process runs independently of
+# and asynchronous with the parent, with no direct communications (i.e., like
+# the IPC channels of connected subprocesses).  The bkgfile is prepared by the
+# parent and read by the detached process, telling the detached process what
+# to do.  There are no restrictions on the format or contents of the bkgfile
+# other than those placed by the implementor of the two processes (either a
+# text or binary file may be used).  Deletion of the bkgfile is however assumed
+# to signify that the bkg process has terminated.
+
+int procedure propdpr (process, bkgfile, bkgmsg)
+
+char	process[ARB]		# vfn of executable process file
+char	bkgfile[ARB]		# vfn of background file
+char	bkgmsg[ARB]		# control string for kernel
+
+bool	first_time
+int	jobcode, pr
+pointer	sp, process_osfn, bkgfile_osfn, pk_bkgmsg
+data	first_time /true/
+errchk	fmapfn, syserrs, malloc
+include	"prd.com"
+
+begin
+	call smark (sp)
+	call salloc (process_osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (bkgfile_osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (pk_bkgmsg,    SZ_LINE,     TY_CHAR)
+
+	# First time initialization of the job table.
+	if (first_time) {
+	    do pr = 1, MAX_BKGJOBS
+		pr_jobcode[pr] = NULL
+	    first_time = false
+	}
+
+	# Get job slot.
+	for (pr=1;  pr <= MAX_BKGJOBS;  pr=pr+1)
+	    if (pr_jobcode[pr] == NULL)
+		break
+	if (pr > MAX_BKGJOBS)
+	    call syserrs (SYS_PRBKGOVFL, process)
+
+	# Map file names.
+	call fmapfn (process, Memc[process_osfn], SZ_PATHNAME)
+	call fmapfn (bkgfile, Memc[bkgfile_osfn], SZ_PATHNAME)
+	call strpak (bkgmsg,  Memc[pk_bkgmsg],    SZ_LINE)
+
+	# Spawn or enqueue detached process.
+	call zopdpr (Memc[process_osfn], Memc[bkgfile_osfn], Memc[pk_bkgmsg],
+	    jobcode)
+	if (jobcode == ERR)
+	    call syserrs (SYS_PRBKGOPEN, process)
+
+	# Set up bkg job descriptor.
+	pr_jobcode[pr] = jobcode
+	pr_active[pr] = YES
+	call malloc (pr_bkgfile[pr], SZ_FNAME, TY_CHAR)
+	call strcpy (bkgfile, Memc[pr_bkgfile[pr]], SZ_FNAME)
+
+	call sfree (sp)
+	return (pr)
+end
diff --git a/sys/etc/propen.x b/sys/etc/propen.x
new file mode 100644
index 00000000..21bdf334
--- /dev/null
+++ b/sys/etc/propen.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+
+# PROPEN -- Open a connected subprocess.  Call PROPCPR to spawn the child
+# process and connect the input and output IPC channels to FIO file
+# descriptors, then pass the environment list and current working directory
+# to the child.  The child is left waiting for the next command from the
+# parent, which is eventually written to the OUT channel by the parent.
+#
+# N.B.: If the child cannot process a SET or CHDIR command it is will take
+# a panic exit, raising the X_IPC exception in the parent.  This is necessary
+# to avoid filling the IN (childs out) IPC channel, which would cause deadlock
+# if the parent were to fill the other channel with SET commands.  Output of
+# SET commands w/o handshaking is desirable to minimize context switches and
+# IPC records and hence speed up process startup.
+
+int procedure propen (process, in, out)
+
+char	process[ARB]		# filename of executable file
+int	in, out			# input, output file descriptors to child
+
+int	pid, print_redefined_variables, status
+pointer	sp, cwd
+int	propcpr()
+data	print_redefined_variables /NO/
+errchk	propcpr, envlist, putline, putci
+
+begin
+	call smark (sp)
+	call salloc (cwd, SZ_PATHNAME, TY_CHAR)
+
+	# Connect the subprocess with read and write IPC channels.
+
+	pid = propcpr (process, in, out)
+
+	# Pass the environment list to the child, omitting all but the most
+	# recent definitions of each variable.  The list is passed in the
+	# opposite order from which it was redefined, but it does not matter
+	# since there is only one entry for each variable.
+
+	call envlist (out, "set ", print_redefined_variables)
+
+	# Set the current working directory in the child, in case the OS does
+	# not do so, and to save the child the need to ask the kernel for the
+	# cwd name, an expensive operation on some systems.
+
+	call zfgcwd (Memc[cwd], SZ_PATHNAME, status)
+	call strupk (Memc[cwd], Memc[cwd], SZ_PATHNAME)
+	call putline (out, "chdir ")
+	call putline (out, Memc[cwd])
+	call putci (out, '\n')
+
+	# The command "_go_" must be sent to the child to signal that process
+	# startup is completed.  The process STDOUT and STDERR are redirected
+	# into the nullfile during startup, hence we will see no output if
+	# this command is not sent.
+
+	call putline (out, "_go_\n")
+
+	# Flush the output so the child can munch on this while we go off and
+	# do something else.
+	call flush (out)
+
+	call sfree (sp)
+	return (pid)
+end
diff --git a/sys/etc/proscmd.x b/sys/etc/proscmd.x
new file mode 100644
index 00000000..cf1e5bb3
--- /dev/null
+++ b/sys/etc/proscmd.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# PROSCMD -- Process an OS escape command from a subprocess.  Execute the
+# command and return the exit status to the subprocess via IPC.
+
+procedure proscmd (pr, cmd)
+
+int	pr		# subprocess process slot number
+char	cmd[ARB]	# host command to be executed
+
+char	statbuf[5]
+int	fd, status, op
+int	itoc(), oscmd()
+include	"prc.com"
+
+begin
+	fd = pr_outfd[pr]
+
+	# Execute the command (waits for completion).
+	status = oscmd (cmd, "", "", "")
+
+	# Encode the return status.
+	op = itoc (status, statbuf, 5) + 1
+	statbuf[op] = '\n'
+	statbuf[op+1] = EOS
+
+	# Return the status to the subprocess.
+	call write (fd, statbuf, op)
+	call flush (fd)
+end
diff --git a/sys/etc/prpsio.x b/sys/etc/prpsio.x
new file mode 100644
index 00000000..99050481
--- /dev/null
+++ b/sys/etc/prpsio.x
@@ -0,0 +1,484 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<fio.h>
+include	<fset.h>
+include	<chars.h>
+include	<error.h>
+include	<config.h>
+include	<syserr.h>
+
+define	LEN_STACK	5		# depth one level, four fields
+define	LEN_STACKFRAME	5		# size of one pushed stack frame
+
+define	S_PR		stack[$1]
+define	S_IN		stack[$1+1]
+define	S_DESTFD	stack[$1+2]
+define	S_STREAM	stack[$1+3]
+define	S_REQUEST	stack[$1+4]
+
+define	push		{stkp=stkp+1;stack[stkp]=($1)}
+define	pop		{$1=stack[stkp];stkp=stkp-1}
+
+
+# PR_PSIO -- Pseudofile i/o for a process.  Process an i/o request for the
+# specified pseudofile stream of the specified process.  Called either to read
+# command input from the CLIN of a process, or to process a read or write
+# request to a pseudofile of a process.  I/O to STDIN, STDOUT, and STDERR
+# consists of simple binary copies of records.  Output to the graphics streams
+# STDGRAPH, STDIMAGE, or STDPLOT consists of GKI metacode and is optionally
+# spooled and filtered with GIOTR (to apply the workstation transformation)
+# before be passed to a graphics kernel.  Process to process i/o is tricky
+# since we must wait for a process to read or write (send us an XMIT or XFER)
+# before transferring a data record.  A process may read or write to streams
+# of its own choosing before satisfying our request.  A graphics kernel
+# connected as a subprocess reads and writes metacode on a graphics stream
+# and is free to read and write STDIN, STDOUT, etc. during execution as if
+# the kernel were being run as a CL task.
+#
+# Note: This code is far more subtle than it appears.  I was unable to express
+# the subtleties in comments, eventually concluding that the code was easier
+# to understand than the explanation (see Notes.psio for the attempts).  Beware
+# that the code is not completely general and assumes certain restrictions on
+# process configurations.
+
+int procedure pr_psio (pid, fd, rwflag)
+
+int	pid			# process id number
+int	fd			# file for which request is desired
+int	rwflag			# type of transfer to wait for
+
+pointer	ip, op
+int	stack[LEN_STACK], stkp, nchars, nleft
+int	stream, pr, in, record_type, rq, iotype
+int	pseudofile, destfd, destpr, destination, ps, flags
+bool	filter_gki, graphics_stream, xmit_pending, ioctrl
+
+int	filbuf(), read(), strncmp(), fstati()
+int	pr_findproc(), psio_isxmit(), zfunc2(), zfunc3()
+errchk	epa_writep, epa_giotr, epa_writetty, epa_readtty, epa_gflush
+errchk	pr_findproc, psio_xfer, filbuf, read, write, flush, syserr
+include	<fio.com>
+include	"prc.com"
+
+begin
+	stream = fd
+	pr = pr_findproc (pid)
+	in = pr_infd[pr]
+	stkp = 0
+
+	if (rwflag == FF_WRITE) {
+	    # We have been called to write to a subprocess.  Simulate a
+	    # pending XMIT request by pushing an XMIT on the stack.  This
+	    # causes XFER requests to be processed from the subprocess
+	    # until the FIO buffer for destfd is exhausted.
+
+	    push (pr)
+	    push (in)
+	    push (fd)
+	    push (stream)
+	    push (XMIT)
+	}
+
+# call putline (STDERR, "----------------------------------------------\n")
+# call eprintf ("PSIO (pid=%d, pr=%d, stream=%d)\n")
+# call pargi(pid); call pargi(pr); call pargi(stream)
+
+	# Process i/o requests from the subprocess until a request is received
+	# for the stream FD.  Unsolicited requests from the process do not
+	# satisfy the request we were called for, e.g., a process may read from
+	# STDIN or write to STDERR before reading from fd=STDGRAPH.
+
+	repeat {
+	    repeat {
+# call eprintf ("\n.....fill buffer: in=%d, pr=%d, stream=%d, stkp=%d\n")
+# call pargi(in); call pargi(pr); call pargi(stream); call pargi(stkp)
+		nleft = itop[in] - iop[in]
+		if (nleft <= 0)
+		    nleft = filbuf (in)
+
+# for(ip=iop[in];ip<itop[in];ip=ip+1)call putc(STDERR, Memc[ip])
+		if (nleft == EOF) {
+		    stkp = 0
+		    nchars = 0
+		    break
+		} else
+		    ip = iop[in]
+
+		# Determine the type of directive, e.g., OS escape, xmit/xfer,
+		# or data (anything other than a pseudofile directive).
+
+		if (Memc[ip] == '!')
+		    record_type = OSCMD
+		else if (Memc[ip] != 'x')
+		    record_type = DATA
+		else 
+		    record_type = psio_isxmit (Memc[ip], pseudofile, nchars)
+
+# call eprintf ("record_type=%d, ps=%d, nchars=%d\n")
+# call pargi(record_type); call pargi(pseudofile); call pargi(nchars)
+
+		if (record_type == OSCMD) {
+		    itop[in] = ip
+		    nchars = nleft
+
+		} else if (record_type == DATA) {
+		    pseudofile = CLIN
+		    nchars = nleft
+
+		} else if (pseudofile < PSIOCTRL) {
+		    # Decode the destination code into the destination FD,
+		    # process slot number, and GKI filter flag.
+
+		    destination = pr_pstofd[pr,pseudofile]
+# call eprintf ("redir code = %d\n"); call pargi (destination)
+		    if (destination <= 0) {
+			destination = -destination
+			filter_gki = true
+		    } else
+			filter_gki = false
+		    
+		    if (destination > KSHIFT) {
+			destfd = mod (destination, KSHIFT)
+			destpr = destination / KSHIFT
+		    } else {
+			destfd = destination
+			destpr = 0
+		    }
+
+		    graphics_stream = (destfd >= STDGRAPH && destfd <= STDPLOT)
+
+		    # Discard the xmit or xfer directive.  We will reuse the
+		    # buffer at Memc[ip] later for temporary storage.
+
+		    itop[in] = ip
+# call eprintf ("filter=%b, destfd=%d, destpr=%d\n")
+# call pargb(filter_gki); call pargi (destfd); call pargi (destpr)
+
+		} else {
+		    # Pseudofile control directive.
+		    record_type = PSIO
+		    itop[in] = ip
+		}
+
+		# Process the record (data or PSIO directive).
+		switch (record_type) {
+		case DATA:
+		    # Ordinary data record.  If the requested fd is not CLIN
+		    # we have an unsolicited command input error.  If this 
+		    # occurs on a graphics stream, reset the stream (close the
+		    # kernel and free all storage) to avoid leaving the graphics
+		    # system in a funny state.
+
+		    iotype = FF_READ
+		    destfd = CLIN
+
+		    if (stream != destfd) {
+			# Reset graphics stream.
+			if (graphics_stream)
+			    call zcall1 (epa_gflush, stream)
+
+			# Take error action.
+			Memc[ip+nchars] = EOS
+			call putline (STDERR, Memc[ip])
+			call syserr (SYS_PRPSIOUCI)
+		    }
+
+		case XMIT:
+		    # Write to a process pseudofile.
+		    iotype = FF_READ
+
+		    # If pseudofile output is not connected to a stream read
+		    # and discard the data block.  This situation occurs
+		    # whenever a task in interrupted.
+
+		    if (destfd == 0) {
+			if (read (in, Memc[ip], nchars) < nchars)
+			    call syserr (SYS_PRIPCSYNTAX)
+			next
+		    }
+
+		    if (filter_gki) {
+			# Process a block of GKI metacode.  Append the block
+			# to the frame buffer for the stream and call GIOTR
+			# to process the metacode.
+
+			op = zfunc2 (epa_writep, destfd, nchars)
+			if (read (in, Memc[op], nchars) < nchars)
+			    call syserr (SYS_PRIPCSYNTAX)
+# call eprintf ("___giotr, %d chars\n")
+# call pargi (nchars)
+
+			# Call GIOTR to process the graphics data.  Any data
+			# to be returned to the client is spooled in the
+			# graphics stream to be read by a subsequent XFER.
+
+			call fseti (destfd, F_CANCEL, OK)
+			call zcall1 (epa_giotr, destfd)
+			call seek (destfd, BOFL)
+
+		    } else {
+			# Binary transfer.
+
+			if (read (in, Memc[ip], nchars) < nchars)
+			    call syserr (SYS_PRIPCSYNTAX)
+
+			# If writing to a standard stream and a raw mode i/o
+			# control sequence is seen, do a fseti on STDIN in
+			# this process to set up raw mode at the FIO level
+			# on the stream.  If we don't do this, raw mode will
+			# be set in the driver but will be disabled in the
+			# first i/o operation by a nchars>1 read request from
+			# FIO.
+
+			if (destfd >= STDIN && destfd <= STDERR) {
+			    ioctrl = (Memc[ip] == ESC &&
+				(nchars==LEN_RAWCMD || nchars==LEN_RAWCMD+1))
+			    if (ioctrl) {
+				if (strncmp(Memc[ip],RAWOFF,LEN_RAWCMD) == 0) {
+				    flags = IO_NORMAL
+				} else if (strncmp (Memc[ip],
+				    RAWON, LEN_RAWCMD) == 0) {
+				    flags = IO_RAW
+				    if (Memc[ip+LEN_RAWCMD] == 'N')
+					flags = flags + IO_NDELAY
+				} else
+				    ioctrl = false
+			    }
+
+			    if (ioctrl)
+				call fseti (STDIN, F_IOMODE, flags)
+			    else {
+				call zcall3 (epa_writetty, destfd, Memc[ip],
+				    nchars)
+			    }
+			} else {
+			    call write (destfd, Memc[ip], nchars)
+			    if (!graphics_stream)
+				call flush (destfd)
+			}
+		    }
+
+		    # If writing to another process, push the current request
+		    # and transfer command input to the destination process.
+		    # Rewind the destfd file buffer so that it may be read by
+		    # the process in a subsequent XFER call on the stream.
+
+		    if (destpr != 0) {
+			if (graphics_stream)
+			    call seek (destfd, BOFL)
+
+			push (pr)
+			push (in)
+			push (destfd)
+			push (stream)
+			push (XMIT)
+
+			pr = destpr
+			in = pr_infd[pr]
+			stream = destfd
+# call eprintf ("push XMIT, new in = %d, new pr = %d\n")
+# call pargi (in); call pargi(pr)
+
+		    } else if (stkp > 0) {
+			# If the XMIT just completed satisfies a pending XFER
+			# request, complete the XFER request and pop it from
+			# the stack.
+
+			rq = stkp - LEN_STACKFRAME + 1
+			if (S_REQUEST(rq) == XFER &&
+			    S_DESTFD(rq)  == destfd) {
+
+			    pop (record_type)
+			    pop (stream)
+			    pop (destfd)
+			    pop (in)
+			    pop (pr)
+
+			    call seek (stream, BOFL)
+			    nchars = itop[stream] - iop[stream]
+			    if (nchars <= 0)
+				nchars = 0
+			    else
+				nchars = read (stream, Memc[ip], nchars)
+# call eprintf ("XFER completed from fd=%d to pr=%d, %d chars\n")
+# call pargi(stream); call pargi(pr); call pargi(nchars)
+			    call psio_xfer (pr_outfd[pr], Memc[ip], nchars)
+
+			    # The stream buffer should now be empty as only
+			    # one IPC record at a time is buffered for an
+			    # XFER request.  Mark the buffer empty.
+
+			    call fseti (stream, F_CANCEL, OK)
+			}
+		    }
+
+		case XFER:
+		    # Read from a pseudofile.
+		    iotype = FF_WRITE
+
+		    if (destpr != 0 && iop[destfd] >= itop[destfd]) {
+			# Read from another process.  Pseudofile FIO buffer
+			# is empty.  Push the current request and transfer
+			# command input to the second process to give it an
+			# opportunity to write data into the buffer so that
+			# we can complete the XFER request.
+
+			push (pr)
+			push (in)
+			push (destfd)
+			push (stream)
+			push (XFER)
+
+			pr = destpr
+			in = pr_infd[pr]
+			stream = destfd
+# call eprintf ("push XFER, new in = %d, new pr = %d\n")
+# call pargi (in); call pargi(pr)
+
+		    } else {
+			# Binary transfer.  If reading from the stream
+			# associated with a pushed XMIT and the stream
+			# buffer is empty, the XMIT has been completed
+			# and must be popped.
+
+			xmit_pending = false
+			if (stkp > 0) {
+			    rq = stkp - LEN_STACKFRAME + 1
+			    if (S_REQUEST(rq) == XMIT && S_DESTFD(rq) == destfd)
+				xmit_pending = true
+			}
+
+# call eprintf ("in XFER: req=%d, str=%d, xmp=%b, iop=%d, itop=%d\n")
+# call pargi(S_REQUEST(rq)); call pargi(S_STREAM(rq))
+# call pargb(xmit_pending); call pargi(iop[destfd]); call pargi(itop[destfd])
+
+			if (xmit_pending && iop[destfd] >= itop[destfd]) {
+			    # The pending XMIT has been completed (the stream
+			    # buffer has been emptied by the reading process).
+			    # Push the current XFER request back into the
+			    # process input stream since we are not prepared
+			    # to deal with it now.
+
+			    itop[in] = iop[in] + nleft
+
+			    # Pop the XMIT request.
+			    pop (record_type)
+			    pop (stream)
+			    pop (destfd)
+			    pop (in)
+			    pop (pr)
+			    ip = iop[in]
+
+			    # Empty the fully read stream buffer.
+			    call fseti (destfd, F_CANCEL, OK)
+# call eprintf ("XFER pops XMIT; push back XFER for later\n")
+
+			} else {
+			    # Satisfy XFER by reading a data record and
+			    # returning it to the requesting process.
+			    # A request to read a single char enables raw
+			    # mode, just as it does for ZGETTX.
+
+# This should not be necessary since the raw mode control sequence is
+# intercepted above.  Also it is incorrect since F_NDELAY is not supported.
+#			    if (nchars == 1)
+#				call fseti (destfd, F_RAW, YES)
+
+			    if (destfd == STDIN) {
+				nchars = zfunc3 (epa_readtty,
+				    destfd, Memc[ip], nchars)
+			    } else
+				nchars = read (destfd, Memc[ip], nchars)
+			    if (nchars == EOF)
+				nchars = 0
+# call eprintf ("XFER completed from fd=%d to pr=%d, %d chars\n")
+# call pargi(destfd); call pargi(pr); call pargi(nchars)
+			    call psio_xfer (pr_outfd[pr], Memc[ip], nchars)
+			}
+		    }
+
+
+		case PSIO:
+		    # Pseudofile i/o control directive.  These directives are
+		    # used to connect graphics kernels to streams, to set and
+		    # get WCS, set cursor mode parameters, etc.  An XMIT to the
+		    # pseudofile PSIOCTRL is use to pass control instructions
+		    # via us to GTR_CONTROL, below.  Note that the PSIOCTRL
+		    # pseudofile is used to control all the graphics pseudofile
+		    # streams.  The number of the graphics pseudofile stream
+		    # to be operated upon by gtr_control is passed as the first
+		    # integer word of the data block.
+
+		    # Read pseudofile number.
+		    iotype = 0
+		    if (read (in, ps, SZ_INT32) < SZ_INT32)
+			call syserr (SYS_PRIPCSYNTAX)
+
+		    # Read data block.
+		    nchars = nchars - SZ_INT32
+		    if (read (in, Memc[ip], nchars) < nchars)
+			call syserr (SYS_PRIPCSYNTAX)
+
+		    # Call gtr_control to process the control directives.
+		    iferr (call zcall3 (epa_control,ps,Memc[ip],pr_pid[pr]))
+			call erract (EA_WARN)
+
+		    # When writing to a graphics subkernel gtr_control may
+		    # leave graphics metacode spooled in the graphics stream
+		    # which we need to pass on to the subkernel.  This is
+		    # done by pushing an XMIT on the psio control stack to
+		    # cause the subkernel process to be polled to see if it
+		    # wants the spooled data.
+
+		    nchars = fstati (ps, F_FILESIZE)
+		    if (nchars > 0) {
+			destination = abs(pr_pstofd[pr,ps])
+			if (destination > KSHIFT) {
+			    destfd = mod (destination, KSHIFT)
+			    destpr = destination / KSHIFT
+			} else {
+			    destfd = destination
+			    destpr = 0
+			}
+
+			if (destpr != 0) {
+			    call seek (destfd, BOFL)
+
+			    push (pr)
+			    push (in)
+			    push (destfd)
+			    push (stream)
+			    push (XMIT)
+
+			    pr = destpr
+			    in = pr_infd[pr]
+			    stream = destfd
+			}
+		    }
+
+		case OSCMD:
+		    # OS escape directive.  There are portability problems
+		    # with issuing ZOSCMD os escapes from subprocesses, so
+		    # subprocesses send OS escapes to us (the parent process)
+		    # as !cmd commands on CLOUT.
+
+		    Memc[ip+nchars] = EOS
+		    call proscmd (pr, Memc[ip+1])
+		}
+
+	    } until (stkp <= 0 && record_type != OSCMD)
+
+# call eprintf ("termination ps(%d)=st(%d), io(%d)=rw(%d)\n")
+# call pargi(pseudofile); call pargi(stream)
+# call pargi(iotype); call pargi(rwflag)
+	} until (pseudofile == stream && iotype == rwflag)
+
+# call putline (STDERR, "----------------------------------------------\n")
+# call eprintf ("EXIT PSIO\n")
+
+	if (nchars == 0)
+	    return (EOF)
+	else
+	    return (nchars)
+end
diff --git a/sys/etc/prpsload.x b/sys/etc/prpsload.x
new file mode 100644
index 00000000..c44eea03
--- /dev/null
+++ b/sys/etc/prpsload.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+
+# PRPSLOAD -- Must be called at process startup time to initialize pseudofile
+# i/o for the graphics streams, if any i/o to the graphics pseudofiles is
+# expected.  The arguments are the LOCPR entry point addresses of the graphics
+# driver (gio.cursor) procedures to be called to process i/o requests on the
+# graphics streams.
+
+procedure prpsload (giotr, control, gflush, writep, readtty, writetty)
+
+extern	giotr()			#I gio.cursor driver procedures
+extern	control()		#I	"		"
+extern	gflush()		#I	"		"
+extern	writep()		#I	"		"
+extern	readtty()		#I	"		"
+extern	writetty()		#I	"		"
+
+int	locpr()
+include	"prc.com"
+
+begin
+	epa_giotr	= locpr (giotr)
+	epa_control	= locpr (control)
+	epa_gflush	= locpr (gflush)
+	epa_writep	= locpr (writep)
+	epa_readtty	= locpr (readtty)
+	epa_writetty	= locpr (writetty)
+end
diff --git a/sys/etc/prredir.x b/sys/etc/prredir.x
new file mode 100644
index 00000000..baf68b48
--- /dev/null
+++ b/sys/etc/prredir.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# PRREDIR -- Redirect the pseudofile stream of a connected subprocess.  A newly
+# connected subprocess inherits the pseudofile streams of the parent, i.e.,
+# a write to STDOUT by the child will be directed to the STDOUT of the parent.
+# Note that unlike FREDIR, the destination stream must already be open and
+# is unaffected by the redirection of the pseudofile (the pseudofile stream is
+# redirected into the existing stream).  The destination file need not be of
+# the same type (binary) as the pseudofile, unless the pseudofile stream
+# contains binary data.
+
+procedure prredir (pid, stream, new_fd)
+
+int	pid			# process-id of child
+int	stream			# stream to be redirected (STDIN, STDOUT, etc)
+int	new_fd			# destination FD (already opened)
+
+int	pr
+int	pr_findproc()
+include	"prc.com"
+errchk	syserr
+
+begin
+	pr = pr_findproc (pid)
+	if (pr == ERR)
+	    call syserr (SYS_PRNOTFOUND)
+
+	pr_pstofd[pr,stream] = new_fd
+end
diff --git a/sys/etc/prseti.x b/sys/etc/prseti.x
new file mode 100644
index 00000000..ad798d42
--- /dev/null
+++ b/sys/etc/prseti.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<prstat.h>
+
+# PRSETI -- Set the value of a parameter for a connected subprocess.
+
+procedure prseti (pid, param, value)
+
+int	pid			#I process id of connected subprocess
+int	param			#I parameter to be set
+int	value			#I new parameter value
+
+int	pr
+int	pr_findproc()
+include	"prc.com"
+errchk	syserr
+
+begin
+	pr = pr_findproc (pid)
+	if (pr == ERR)
+	    call syserr (SYS_PRNOTFOUND)
+
+	switch (param) {
+	case PR_STATUS:
+	    pr_status[pr] = value
+	case PR_INCHAN:
+	    pr_inchan[pr] = value
+	case PR_INFD:
+	    pr_infd[pr] = value
+	case PR_OUTCHAN:
+	    pr_outchan[pr] = value
+	case PR_OUTFD:
+	    pr_outfd[pr] = value
+	case PR_STDIN:
+	    pr_pstofd[pr,STDIN] = value
+	case PR_STDERR:
+	    pr_pstofd[pr,STDERR] = value
+	case PR_STDOUT:
+	    pr_pstofd[pr,STDOUT] = value
+	case PR_STDGRAPH:
+	    pr_pstofd[pr,STDGRAPH] = value
+	case PR_STDIMAGE:
+	    pr_pstofd[pr,STDIMAGE] = value
+	case PR_STDPLOT:
+	    pr_pstofd[pr,STDPLOT] = value
+	default:
+	    call syserr (SYS_PRSTAT)
+	}
+end
diff --git a/sys/etc/prsignal.x b/sys/etc/prsignal.x
new file mode 100644
index 00000000..0ec647a0
--- /dev/null
+++ b/sys/etc/prsignal.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<knet.h>
+
+# PRSIGNAL -- Send a signal (interrupt) to a child process.  It is an error
+# if the pid given is not found in the process table.
+
+procedure prsignal (pid, signal)
+
+int	pid			# process-id of child process
+int	signal			# code of signal to be sent (e.g. X_INT)
+
+int	child
+int	pr_findproc()
+include	"prc.com"
+errchk	syserr
+
+begin
+	child = pr_findproc (pid)
+	if (child != ERR)
+	    call zintpr (pid, signal, child)
+
+	if (child == ERR)
+	    call syserr (SYS_PRSIGNAL)
+end
diff --git a/sys/etc/prstati.x b/sys/etc/prstati.x
new file mode 100644
index 00000000..bd3eb221
--- /dev/null
+++ b/sys/etc/prstati.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<prstat.h>
+
+# PRSTATI -- Get the value of a parameter for a connected subprocess.
+
+int procedure prstati (pid, param)
+
+int	pid			# process id of connected subprocess
+int	param			# parameter for which status is desired
+int	pr
+int	pr_findproc()
+include	"prc.com"
+errchk	syserr
+
+begin
+	pr = pr_findproc (pid)
+	if (pr == ERR)
+	    call syserr (SYS_PRNOTFOUND)
+
+	switch (param) {
+	case PR_STATUS:
+	    return (pr_status[pr])
+	case PR_INCHAN:
+	    return (pr_inchan[pr])
+	case PR_INFD:
+	    return (pr_infd[pr])
+	case PR_OUTCHAN:
+	    return (pr_outchan[pr])
+	case PR_OUTFD:
+	    return (pr_outfd[pr])
+	case PR_STDIN:
+	    return (pr_pstofd[pr,STDIN])
+	case PR_STDERR:
+	    return (pr_pstofd[pr,STDERR])
+	case PR_STDOUT:
+	    return (pr_pstofd[pr,STDOUT])
+	case PR_STDGRAPH:
+	    return (pr_pstofd[pr,STDGRAPH])
+	case PR_STDIMAGE:
+	    return (pr_pstofd[pr,STDIMAGE])
+	case PR_STDPLOT:
+	    return (pr_pstofd[pr,STDPLOT])
+	default:
+	    call syserr (SYS_PRSTAT)
+	}
+end
diff --git a/sys/etc/prupdate.x b/sys/etc/prupdate.x
new file mode 100644
index 00000000..49aa7e56
--- /dev/null
+++ b/sys/etc/prupdate.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<config.h>
+include	<prstat.h>
+
+# PRUPDATE -- Broadcast a message to a process, or if pid=0, to all connected
+# subprocesses.  Used primarily to incrementally pass SET and CHDIR commands to
+# subprocesses, eliminating the need to reconnect each process.  Note that the
+# child process does not return "bye" in response to one of the builtin
+# functions SET and CHDIR.  NOTE: if a child process is marked "busy" the
+# message is not sent to that process; only idle processes receive the message.
+
+procedure prupdate (pid, message, flushout)
+
+int	pid			#I process to be updated, or 0 for all procs
+char	message[ARB]		#I message to be broadcast to each child
+int	flushout		#I flush output
+
+int	pr, status
+pointer	sp, cmd, op
+int	gstrcpy(), prstati()
+include	"prc.com"
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_COMMAND, TY_CHAR)
+
+	# Make sure that the message string is non-null and is newline
+	# delimited.
+
+	op = cmd + gstrcpy (message, Memc[cmd], SZ_COMMAND)
+	if (op == cmd) {
+	    call sfree (sp)
+	    return
+	} else if (Memc[op-1] != '\n') {
+	    Memc[op] = '\n'
+	    Memc[op+1] = EOS
+	}
+
+	# Broadcast the message.  If the child fails to process the command
+	# and returns the ERROR statement, the error will not be detected until
+	# the next user command is sent to the process (and indeed may corrupt
+	# the protocol).  The parent should execute the SET or CHDIR prior
+	# to sending it to the child to make sure it is valid.
+
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if ((pid != NULL && pr_pid[pr] == pid) ||
+		(pid == NULL && pr_pid[pr] != NULL)) {
+
+		status = prstati (pr_pid[pr], PR_STATUS)
+		if (status == P_RUNNING) {
+		    iferr (call putline (pr_outfd[pr], Memc[cmd]))
+			call erract (EA_WARN)
+		    else if (flushout == YES)
+			call flush (pr_outfd[pr])
+		}
+	    }
+
+	call sfree (sp)
+end
diff --git a/sys/etc/psioisxt.x b/sys/etc/psioisxt.x
new file mode 100644
index 00000000..ddebd7df
--- /dev/null
+++ b/sys/etc/psioisxt.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<gio.h>
+
+
+# PSIO_ISXMIT -- Test for a pseudofile directive.  Return XMIT, XFER, or DATA
+# as the function value, and if we do have a pseudofile, decode the pseudofile
+# number and char count.
+#
+# Syntax: "xmit(P,NNN)" or "xfer(P,NNN)"
+#          12345678         12345678
+#
+# where P is the pseudofile code (0<P<10) and NNN is the size of the data block
+# in chars.  In the following code all explicit integer constants refer to the
+# character offsets shown above.
+
+int procedure psio_isxmit (lbuf, pseudofile, nchars)
+
+char	lbuf[ARB]		# text
+int	pseudofile		# pseudofile code (output)
+int	nchars			# block size (output)
+int	line_type, ip
+int	ctoi()
+errchk	syserr
+
+begin
+	# Decode line type.  If we are called we have already determined that
+	# lbuf[1] is 'x'.
+
+	if (lbuf[2] == 'm') {
+	    if (lbuf[3] == 'i' && lbuf[4] == 't' && lbuf[5] == '(')
+		line_type = XMIT
+	    else
+		return (DATA)
+	} else if (lbuf[2] == 'f') {
+	    if (lbuf[3] == 'e' && lbuf[4] == 'r' && lbuf[5] == '(')
+		line_type = XFER
+	    else
+		return (DATA)
+	} else
+	    return (DATA)
+	
+	# Get pseudofile code.
+	ip = 6
+	if (ctoi (lbuf, ip, pseudofile) <= 0)
+	    call syserr (SYS_PRIPCSYNTAX)
+
+	while (lbuf[ip] == ',' || IS_WHITE(lbuf[ip]))
+	    ip = ip + 1
+
+	# Get char size of data block.
+	if (ctoi (lbuf, ip, nchars) <= 0)
+	    call syserr (SYS_PRIPCSYNTAX)
+
+	return (line_type)
+end
diff --git a/sys/etc/psioxfer.x b/sys/etc/psioxfer.x
new file mode 100644
index 00000000..ca286512
--- /dev/null
+++ b/sys/etc/psioxfer.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	SZ_NUMBUF	8		# encoded count for an XFER
+
+
+# PSIO_XFER -- Transfer a data record to a process to complete an XFER
+# request.  Write the byte count record followed by the data record.
+# These must be written as two separate records or deadlock
+# will occur (with the reader waiting for the second record).
+
+procedure psio_xfer (fd, buf, nchars)
+
+int	fd			# output file
+char	buf[ARB]		# buffer containing record to be written
+int	nchars			# length of record
+
+int	ndigits
+char	numbuf[SZ_NUMBUF]
+int	itoc()
+
+begin
+	if (nchars >= 0) {
+	    ndigits = itoc (nchars, numbuf, SZ_NUMBUF)
+	    numbuf[ndigits+1] = '\n'
+	    call write (fd, numbuf, ndigits + 1)
+	    call flush (fd)
+
+	    if (nchars > 0) {
+		call write (fd, buf, nchars)
+		call flush (fd)
+	    }
+	}
+end
diff --git a/sys/etc/qsort.x b/sys/etc/qsort.x
new file mode 100644
index 00000000..f7efc4d3
--- /dev/null
+++ b/sys/etc/qsort.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR 	32			# log2(maxpts)  (4e9)
+
+# QSORT -- General quicksort for arbitrary objects.  X is an integer array
+# indexing the array to be sorted.  The user supplied COMPARE function is used
+# to compare objects indexed by X:
+# 
+# 	-1,0,1 = compare (x1, x2)
+# 
+# where the value returned by COMPARE has the following significance:
+# 
+# 	-1	obj[x1]  < obj[x2]
+# 	 0	obj[x1] == obj[x2]
+# 	 1	obj[x1]  > obj[x2]
+# 
+# QSORT reorders the elements of the X array, which must be of type integer.
+# **NOTE** - See also gqsort.x, a more recent version of this routine.
+
+procedure qsort (x, nelem, compare)
+
+int	x[ARB]			# array to be sorted
+int	nelem			# number of elements in array
+extern	compare()		# function to be called to compare elements
+
+int	i, j, k, lv[LOGPTR], p, pivot, uv[LOGPTR], temp
+define	swap {temp=$1;$1=$2;$2=temp}
+int	compare()
+
+begin
+	lv[1] = 1
+	uv[1] = nelem
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy loop to trigger the optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # subfile, to avoid quadratic behavior on an already
+		    # sorted list.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (x[j], x[k])
+		    pivot = x[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  compare (x[i], pivot) < 0;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (compare (x[j], pivot) <= 0)
+				break
+			if (i < j)			# out of order pair
+			    swap (x[i], x[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (x[i], x[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/etc/sttyco.x b/sys/etc/sttyco.x
new file mode 100644
index 00000000..54f2c5ce
--- /dev/null
+++ b/sys/etc/sttyco.x
@@ -0,0 +1,519 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<ttyset.h>
+include	<ttset.h>
+
+.help sttyco
+.nf ---------------------------------------------------------------------------
+STTYCO -- Set/stat VOS terminal driver options via command string.  This is a
+high level front-end to the ttset/ttstat procedures, used to set or query the
+individual terminal driver parameters.  Since STTYCO is driven by a command
+string it may be called either as a task or as a subroutine.  When called as
+a task, e.g, as the STTY task in the CL, the argument list is simply
+concatenated into a long string and passed to STTYCO for processing.
+
+The argument list consists of zero or more argument strings, as follows:
+
+	reset			Reset default terminal settings
+	init			Send initialization sequence to the terminal
+	show			Show terminal settings
+	all			Show all parameters, even if not in use
+	<nullarglist>		Show terminal settings
+	<unknown>	 	Assumed to be the termcap name of a terminal.
+				  Set envvars `terminal', `ttyncols', and
+				  `ttynlines' for the named terminal.
+	baud=N			Set envvar `ttybaud=N'.
+	ncols=N			Set envvar `ttyncols=N'.
+	nlines=N		Set envvar `ttynlines=N'.
+	resize			Reset the screen size parameters.
+
+	clear			Disable named driver functions.
+
+	ucasein 		Map input to lower case.
+	ucaseout 		Map output to upper case.
+
+	logio [=logiofile] 	Log all i/o to the terminal in a file.
+	login [=loginfile] 	Log input from terminal in a file.
+	logout [=logoutfile] 	Log output to terminal in a file.
+
+	playback [=pbfile]	Read terminal input from a logfile.
+	verify			Pause at newline when in playback mode.
+	delay=N			Msec delay in playback mode, verify disabled.
+
+Simply naming a parameter like ucasein, logio, etc., causes that function to
+be enabled, or disabled if preceeded by the keyword `clear'.  Any of the
+sequences +, -, =yes, =no may also be appended to turn the function on or off.
+The logging functions may also take a filename argument, e.g., logio=file
+enables i/o logging into the named file.  The default filenames are as follows:
+
+	logio		home$ttyio.log
+	login		home$ttin.log
+	logout		home$ttout.log
+	playback	home$ttin.log
+
+If verify is disabled a delay will precede each record returned from the
+input file; the default delay is quite short.  Pause mode is terminated by
+typing a space or carriage return to continue execution, or `q' to terminate
+playback mode.
+.endhelp ----------------------------------------------------------------------
+
+define	STTY_KEYWORDS "|reset|init|all|show|baud|ncols|nlines|resize|clear|\
+	|ucasein|ucaseout|logio|login|logout|playback|verify|delay|"
+
+define	RESET		1	# reset default terminal settings
+define	INIT		2	# send initialization sequence to the terminal
+define	ALL		3	# show all parameters
+define	SHOW		4	# show parameters
+define	BAUD		5	# set envvar `ttybaud'
+define	NCOLS		6	# set envvar `ttyncols'
+define	NLINES		7	# set envvar `ttynlines'
+define	RESIZE		8	# reset the screen size parameters
+define	CLEAR		9	# set default action to NO rather than YES
+#	newline		10
+define	UCASEIN		11	# map input to lower case
+define	UCASEOUT	12	# map output to upper case
+define	LOGIO		13	# log all i/o in a file
+define	LOGIN		14	# log input in a file
+define	LOGOUT		15	# log output in a file
+define	PLAYBACK	16	# take input from a file
+define	VERIFY		17	# wait for user to type a key after each record
+define	DELAY		18	# msec delay after each record in playback mode
+
+
+# STTYCO -- Main entry point.  Input consists of an argument list of arbitrary
+# length.  Output is to the given file descriptor.
+
+procedure sttyco (args, ttin, ttout, outfd)
+
+char	args[ARB]		# argument list
+int	ttin, ttout		# tty file descriptors
+int	outfd			# write task output here
+
+pointer	sp, keyw, value, tty
+int	startcol, ival, nargs, yesno, defact, show, all, ip
+int	stty_getarg(), strdic(), ctoi()
+pointer	ttyodes()
+
+string	keywords STTY_KEYWORDS
+errchk	ttseti, ttsets, stty_ttyinit
+define	argerr_ 91
+
+begin
+	call smark (sp)
+	call salloc (keyw, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+
+	defact = YES
+	show = NO
+	all = NO
+	ip = 1
+
+	# Process successive keyword=value arguments.
+
+	for (nargs=0;  stty_getarg (args, ip, Memc[keyw], SZ_FNAME, Memc[value],
+	    SZ_FNAME, defact, yesno) != EOF;  nargs = nargs + 1) {
+
+	    switch (strdic (Memc[keyw], Memc[keyw], SZ_FNAME, keywords)) {
+	    case RESET:
+		call ttseti (ttin, TT_INITIALIZE, yesno)
+	    case INIT:
+		call stty_ttyinit (ttin, ttout, "terminal")
+
+	    case ALL:
+		all = yesno
+		show = YES
+	    case SHOW:
+		show = yesno
+	    case BAUD:
+		if (IS_DIGIT (Memc[value]))
+		    call stty_envreset ("ttybaud", Memc[value])
+		else
+		    goto argerr_
+	    case NCOLS:
+		if (IS_DIGIT (Memc[value]))
+		    call stty_envreset ("ttyncols", Memc[value])
+		else
+		    goto argerr_
+	    case NLINES:
+		if (IS_DIGIT (Memc[value]))
+		    call stty_envreset ("ttynlines", Memc[value])
+		else
+		    goto argerr_
+
+	    case RESIZE:
+		tty = ttyodes ("terminal")
+		call stty_setsize (ttin, ttout, tty)
+		call ttycdes (tty)
+
+	    case CLEAR:
+		defact = NO
+
+	    case UCASEIN:
+		call ttseti (ttin, TT_UCASEIN, yesno)
+	    case UCASEOUT:
+		call ttseti (ttin, TT_UCASEOUT, yesno)
+
+	    case LOGIO:
+		if (yesno == YES && Memc[value] != EOS)
+		    call ttsets (ttin, TT_IOFILE, Memc[value])
+		call ttseti (ttin, TT_LOGIO, yesno)
+	    case LOGIN:
+		if (yesno == YES && Memc[value] != EOS)
+		    call ttsets (ttin, TT_INFILE, Memc[value])
+		call ttseti (ttin, TT_LOGIN, yesno)
+	    case LOGOUT:
+		if (yesno == YES && Memc[value] != EOS)
+		    call ttsets (ttin, TT_OUTFILE, Memc[value])
+		call ttseti (ttin, TT_LOGOUT, yesno)
+	    case PLAYBACK:
+		if (yesno == YES && Memc[value] != EOS)
+		    call ttsets (ttin, TT_PBFILE, Memc[value])
+		call ttseti (ttin, TT_PLAYBACK, yesno)
+		    
+	    case VERIFY:
+		call ttseti (ttin, TT_PBVERIFY, yesno)
+	    case DELAY:
+		startcol = 1
+		if (ctoi (Memc[value], startcol, ival) > 0)
+		    call ttseti (ttin, TT_PBDELAY, ival)
+		else
+		    goto argerr_
+
+	    default:
+		# If not keyword, must be a terminal name.
+		iferr (call stty_newterm (ttin, ttout, Memc[keyw]))
+		    call erract (EA_WARN)
+	    }
+	}
+
+	# If the argument list was null or the SHOW flag was set, show
+	# the current terminal settings.
+
+	if (nargs == 0 || show == YES)
+	    call stty_showterm (ttin, ttout, outfd, all)
+
+	call sfree (sp)
+	return
+
+argerr_
+	call syserrs (SYS_STTYNUMARG, Memc[keyw])
+	call sfree (sp)
+end
+
+
+# STTY_NEWTERM -- Configure the environment for a new type of terminal.
+
+procedure stty_newterm (ttin, ttout, terminal)
+
+int	ttin, ttout			# tty file descriptors
+char	terminal[ARB]			# termcap name of new terminal
+
+pointer	sp, vp, tty
+pointer	ttyodes()
+
+bool	ttygetb()
+int	ttygets()
+errchk	ttyodes, stty_envreset, ttygsize
+
+begin
+	call smark (sp)
+	call salloc (vp, SZ_FNAME, TY_CHAR)
+
+	tty = ttyodes (terminal)
+
+	# Set the terminal parameters.
+	call stty_envreset ("terminal", terminal)
+	call stty_setsize (ttin, ttout, tty)
+
+	# Set the stdgraph device name for this terminal, if given.
+	if (ttygetb (tty, "gd")) {
+	    if (ttygets (tty, "gd", Memc[vp], SZ_FNAME) <= 0)
+		call strcpy (terminal, Memc[vp], SZ_FNAME)
+	} else
+	    call strcpy ("none", Memc[vp], SZ_FNAME)
+	call stty_envreset ("stdgraph", Memc[vp])
+
+	call ttycdes (tty)
+	call sfree (sp)
+end
+
+
+# STTY_SETSIZE -- Determine the terminal screen size in characters, and set
+# up the environment appropriately.
+
+procedure stty_setsize (ttin, ttout, tty)
+
+int	ttin, ttout			# tty file descriptors
+pointer	tty
+
+char	num[4]
+int	ncols, nlines, n
+int	itoc()
+
+begin
+	call ttygsize (ttin, ttout, tty, ncols, nlines)
+
+	n = itoc (ncols, num, 4)
+	call stty_envreset ("ttyncols", num)
+	call ttyseti (tty, TTY_NCOLS, ncols)
+
+	n = itoc (nlines, num, 4)
+	call stty_envreset ("ttynlines", num)
+	call ttyseti (tty, TTY_NLINES, nlines)
+end
+
+
+# STTY_TTYINIT -- Output the initialization string and the contents of
+# the initialization file to the terminal, if either is specified in the
+# termcap entry for the device.
+
+procedure stty_ttyinit (ttin, ttout, terminal)
+
+int	ttin, ttout			# tty file descriptors
+char	terminal[ARB]			# termcap name of new terminal
+
+pointer	tty
+pointer	ttyodes()
+
+begin
+	tty = ttyodes (terminal)
+	call ttyinit (ttout, tty)
+	call flush (ttout)
+	call ttycdes (tty)
+end
+
+
+# STTY_ENVRESET -- Set the value of an environment variable in the current
+# process and in all connected subprocesses.
+
+procedure stty_envreset (envvar, value)
+
+char	envvar[ARB]		# environment variable to be set
+char	value[ARB]		# new value
+
+errchk	envreset
+
+begin
+	call envreset (envvar, value)
+	call prenvset (0, envvar, value)
+end
+
+
+# STTY_SHOWTERM -- Show the current terminal driver status.
+
+procedure stty_showterm (ttin, ttout, fd, all)
+
+int	ttin, ttout		# tty file descriptors
+int	fd			# where the output goes
+int	all			# show all params, even if not in use
+
+int	junk
+pointer	sp, val
+bool	ucasein, ucaseout, shift, logio, login, logout, playback, showall
+int	ttstati(), ttstats(), envfind()
+
+string	unknown "[unknown]"
+string	on "on"
+string	off "off"
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_FNAME, TY_CHAR)
+
+	ucasein  = (ttstati (ttin, TT_UCASEIN) == YES)
+	ucaseout = (ttstati (ttin, TT_UCASEOUT) == YES)
+	shift	 = (ttstati (ttin, TT_SHIFTLOCK) == YES)
+	logio	 = (ttstati (ttin, TT_LOGIO) == YES)
+	login	 = (ttstati (ttin, TT_LOGIN) == YES)
+	logout	 = (ttstati (ttin, TT_LOGOUT) == YES)
+	playback = (ttstati (ttin, TT_PLAYBACK) == YES)
+	showall  = (all == YES)
+
+	# Show tty environment variables.
+
+	if (envfind ("terminal", Memc[val], SZ_FNAME) <= 0)
+	    call strcpy ("?", Memc[val], SZ_FNAME)
+	call fprintf (fd, "%s ")
+	    call pargstr (Memc[val])
+
+	if (envfind ("ttyncols", Memc[val], SZ_FNAME) <= 0)
+	    call strcpy ("?", Memc[val], SZ_FNAME)
+	call fprintf (fd, "ncols=%s ")
+	    call pargstr (Memc[val])
+
+	if (envfind ("ttynlines", Memc[val], SZ_FNAME) <= 0)
+	    call strcpy ("?", Memc[val], SZ_FNAME)
+	call fprintf (fd, "nlines=%s ")
+	    call pargstr (Memc[val])
+
+	if (showall || ucasein || ucaseout) {
+	    if (envfind ("ttybaud", Memc[val], SZ_FNAME) <= 0)
+		call strcpy ("?", Memc[val], SZ_FNAME)
+	    call fprintf (fd, "baudrate=%s ")
+		call pargstr (Memc[val])
+
+	    call fprintf (fd, "ucasein=%b ")
+		call pargb (ucasein)
+	    call fprintf (fd, "ucaseout=%b ")
+		call pargb (ucaseout)
+	    call fprintf (fd, "shift=%b\n")
+		call pargb (shift)
+	} else
+	    call fprintf (fd, "\n")
+
+	# Show internal driver state variables in `show all' mode.
+
+	if (showall) {
+	    call fprintf (fd,
+		"kichan=%d kochan=%d lichan=%d lochan=%d pbchan=%d ")
+		call pargi (ttstati (ttin, TT_KINCHAN))
+		call pargi (ttstati (ttin, TT_KOUTCHAN))
+		call pargi (ttstati (ttin, TT_LOGINCHAN))
+		call pargi (ttstati (ttin, TT_LOGOUTCHAN))
+		call pargi (ttstati (ttin, TT_PBINCHAN))
+
+	    call fprintf (fd, "raw=%b passthru=%b\n")
+		call pargb (ttstati (ttin, TT_RAWMODE) == YES)
+		call pargb (ttstati (ttin, TT_PASSTHRU) == YES)
+	}
+
+	# Show the status of the logging options.
+
+	if (logio || showall) {
+	    junk = ttstats (ttin, TT_IOFILE, Memc[val], SZ_FNAME)
+	    call fprintf (fd, "logio=%s [%s]\n")
+		call pargstr (Memc[val])
+		if (logio)
+		    call pargstr (on)
+		else
+		    call pargstr (off)
+	}
+	
+	if (!logio || showall) {
+	    if (login || showall) {
+		junk = ttstats (ttin, TT_INFILE, Memc[val], SZ_FNAME)
+		call fprintf (fd, "login=%s [%s]\n")
+		    call pargstr (Memc[val])
+		    if (login)
+			call pargstr (on)
+		    else
+			call pargstr (off)
+	    }
+	    if (logout || showall) {
+		junk = ttstats (ttin, TT_OUTFILE, Memc[val], SZ_FNAME)
+		call fprintf (fd, "logout=%s [%s]\n")
+		    call pargstr (Memc[val])
+		    if (logout)
+			call pargstr (on)
+		    else
+			call pargstr (off)
+	    }
+	}
+
+	if (playback || showall) {
+	    junk = ttstats (ttin, TT_PBFILE, Memc[val], SZ_FNAME)
+	    call fprintf (fd, "playback=%s [%s] ")
+		call pargstr (Memc[val])
+		if (playback)
+		    call pargstr (on)
+		else
+		    call pargstr (off)
+
+	    call fprintf (fd, "verify=%b ")
+		call pargb (ttstati (ttin, TT_PBVERIFY) == YES)
+	    call fprintf (fd, "delay=%d (msec)")
+		call pargi (ttstati (ttin, TT_PBDELAY))
+	    call fprintf (fd, "\n")
+	}
+
+	if (playback) {
+	    call fprintf (fd, "script recorded with terminal=%s, stdgraph=%s\n")
+		if (ttstats (ttin, TT_TDEVICE, Memc[val], SZ_FNAME) <= 0)
+		    call pargstr (unknown)
+		else
+		    call pargstr (Memc[val])
+		if (ttstats (ttin, TT_GDEVICE, Memc[val], SZ_FNAME) <= 0)
+		    call pargstr (unknown)
+		else
+		    call pargstr (Memc[val])
+	}
+
+	call sfree (sp)
+end
+
+
+# STTY_GETARG -- Get the next argument from an argument list.  Arguments are of
+# the form keyw, keyw+, keyw-, keyw=(yes|y), keyw=(no|n), or keyw=value.
+# All forms are reduced to a flag YESNO and a value string VALUE.  The forms
+# keyw=yes, key=no, etc., cause YESNO to be set but not VALUE.  If only the
+# keyword name is given YESNO is set to YES and VALUE to the null string.
+# The number of characters in the keyword=value argument string is returned
+# as the function value, or EOF when the argument list is exhausted.
+
+int procedure stty_getarg (args, ip, keyw, maxkc, value, maxvc, defact, yesno)
+
+char	args[ARB]		# argument string
+int	ip			# index into argument string [RW]
+char	keyw[ARB]		# receives keyword name
+int	maxkc			# max chars in keyw string	
+char	value[ARB]		# receives value string or EOS
+int	maxvc			# max chars in value string
+int	defact			# default action (yes/no) if only keyword given
+int	yesno			# boolean value of parameter
+
+int	op
+int	ip_save
+bool	streq()
+
+begin
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+	
+	ip_save = ip
+
+	# Get keyword name.
+	for (op=1;  IS_ALNUM (args[ip]);  ip=ip+1) {
+	    keyw[op] = args[ip]
+	    op = min (maxkc, op + 1)
+	}
+	keyw[op] = EOS
+
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	value[1] = EOS
+	yesno = defact
+
+	if (args[ip] == '=') {
+	    # Extract value string.
+	    op = 1
+	    for (ip=ip+1;  args[ip] > ' ';  ip=ip+1) {
+		value[op] = args[ip]
+		op = min (maxvc, op + 1)
+	    }
+	    value[op] = EOS
+
+	    # Check for keyw=[yes|no].
+	    if (streq (value, "yes") || streq (value, "y")) {
+		yesno = YES
+		value[1] = EOS
+	    } else if (streq (value, "no") || streq (value, "n")) {
+		yesno = NO
+		value[1] = EOS
+	    }
+	} else if (args[ip] == '+') {
+	    yesno = YES
+	    ip = ip + 1
+	} else if (args[ip] == '-') {
+	    yesno = NO
+	    ip = ip + 1
+	}
+
+	if (ip <= ip_save)
+	    return (EOF)
+	else
+	    return (ip - ip_save)
+end
diff --git a/sys/etc/syserr.x b/sys/etc/syserr.x
new file mode 100644
index 00000000..a14d516d
--- /dev/null
+++ b/sys/etc/syserr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	SZ_ERRMSG	SZ_LINE
+
+# SYSERR -- Process a system error.  No arguments; print only the error
+# message from the system error message file.
+
+procedure syserr (errcode)
+
+int	errcode
+
+begin
+	call syserrs (errcode, "")
+end
+
+
+# SYSERRS -- System error, with a user supplied string argument.   We do not
+# want to search the system error message file until ERRACT is called to
+# output the error message and initiate error recovery, because if an IFERR
+# error handler is posted the message will never be used.  Hence we encode
+# an error message of the form "123 user_string", where "123" is the encoded
+# system error message number.  If a message is ever actually output the
+# 123 will be expanded into a readable error message.
+
+procedure syserrs (errcode, user_string)
+
+int	errcode
+char	user_string[ARB]
+
+char	buf[SZ_ERRMSG]
+int	ip, op
+int	itoc()
+
+begin
+	# Encode error code, to be used to search error message file.
+	op = itoc (errcode, buf, SZ_ERRMSG) + 1
+
+	if (user_string[1] != EOS) {
+	    buf[op] = ' '
+	    op = op + 1
+	    for (ip=1;  op <= SZ_ERRMSG && user_string[ip] != EOS;  ip=ip+1) {
+		buf[op] = user_string[ip]
+		op = op + 1
+	    }
+	}
+	buf[op] = EOS
+
+	call error (errcode, buf)
+end
diff --git a/sys/etc/sysid.x b/sys/etc/sysid.x
new file mode 100644
index 00000000..94bd77bc
--- /dev/null
+++ b/sys/etc/sysid.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SYSID -- Return a line of text identifying the current user, machine, and
+# version of IRAF, and containing the current date and time.  The format is
+# as follows:
+#
+#	NOAO/IRAF V1.3 username@lyra Tue 09:47:50 27-Aug-85
+#
+# The string "NOAO/IRAF V1.3" is given by the value of the environment variable
+# "version", defined in lib$clpackage.cl (unless redefined by the user).  The
+# string "username" is the value of the environment variable "userid", defined
+# by the user in the login.cl file.  The output string is not terminated by a
+# newline.
+
+procedure sysid (outstr, maxch)
+
+char	outstr[maxch]			# receives id string
+int	maxch
+
+pointer	sp, buf
+int	op, nchars
+int	envfind(), gstrcpy()
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	nchars = envfind ("version", outstr, maxch)
+	if (nchars <= 0)
+	    nchars = gstrcpy ("NOAO/IRAF", outstr, maxch)
+
+	op = nchars + 1
+	outstr[op] = ' '
+	op = op + 1
+
+	# The variable "userid" is defined in the user's login.cl file.  This
+	# gives the user the opportunity to set the value of this string to
+	# something other than their host system login name.
+
+	nchars = envfind ("userid", Memc[buf], SZ_LINE)
+
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	outstr[op] = '@'
+	op = op + 1
+
+	call gethost (Memc[buf], SZ_LINE)
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	outstr[op] = ' '
+	op = op + 1
+
+	call cnvtime (clktime(long(0)), Memc[buf], SZ_LINE)
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	outstr[op] = EOS
+
+	call sfree (sp)
+end
diff --git a/sys/etc/syspanic.x b/sys/etc/syspanic.x
new file mode 100644
index 00000000..8ddfdb81
--- /dev/null
+++ b/sys/etc/syspanic.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SYS_PANIC -- Unconditionally abort process execution.  Called when an error
+# condition occurs so serious that process execution cannot continue reliably.
+
+procedure sys_panic (errcode, errmsg)
+
+int	errcode			# error code
+char	errmsg[ARB]		# error message
+
+begin
+	# Since process termination is imminent we may as well overwrite the
+	# error message string by packing it in place.
+
+	call strpak (errmsg, errmsg, ARB)
+	call zpanic (errcode, errmsg)
+end
diff --git a/sys/etc/sysptime.x b/sys/etc/sysptime.x
new file mode 100644
index 00000000..3a2657c2
--- /dev/null
+++ b/sys/etc/sysptime.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+define	SZ_OBUF		8
+define	CPU		1
+define	CLK		2
+
+
+# SYS_MTIME -- Mark the time, i.e., save the current clock and cpu times in
+# the save buffer.
+
+procedure sys_mtime (save_time)
+
+long	save_time[2]			# mark time buffer
+
+begin
+	call zgtime (save_time[CLK], save_time[CPU])
+end
+
+
+# SYS_PTIME -- Print the cpu and clock time consumed since the last call to
+# SYS_MTIME.
+
+procedure sys_ptime (fd, opstr, save_time)
+
+int	fd				# output file
+char	opstr[ARB]			# optional operand name string
+long	save_time[2]			# mark time buffer
+
+int	op, junk
+char	obuf[SZ_OBUF]
+long	new_clk, new_cpu
+int	d_clk, d_cpu, msec, sec, percent
+int	itoc()
+
+begin
+	call zgtime (new_clk, new_cpu)
+	d_clk = (new_clk - save_time[CLK]) 	# clk seconds
+	d_cpu = (new_cpu - save_time[CPU])	# cpu msec
+
+	call putline (fd, "Time ")
+	if (opstr[1] != EOS) {
+	    call putci (fd, '(')
+	    call putline (fd, opstr)
+	    call putline (fd, ") ")
+	}
+
+	# Output the cpu time in seconds.
+	op = itoc (d_cpu / 1000, obuf, SZ_OBUF) + 1
+	obuf[op] = '.'; op = op + 1
+	msec = mod (d_cpu, 1000)
+	if (msec < 100) {
+	    obuf[op] = '0'; op = op + 1
+	}
+	if (msec < 10) {
+	    obuf[op] = '0'; op = op + 1
+	}
+	if (msec > 0)
+	    op = op + itoc (msec, obuf[op], SZ_OBUF-op+1)
+	call putline (fd, obuf)
+
+	# Output the clock time in minutes and seconds.
+	call putci (fd, ' ')
+	op = itoc (d_clk / 60, obuf, SZ_OBUF) + 1
+	obuf[op] = ':'; op = op + 1
+	sec = mod (d_clk, 60)
+	obuf[op] = TO_DIGIT(sec/10); op = op + 1
+	obuf[op] = TO_DIGIT(mod(sec,10)); op = op + 1
+	obuf[op] = EOS
+	call putline (fd, obuf)
+
+	# Output the percent cpu utilization.
+	call putci (fd, ' ')
+	if (d_clk < 1)
+	    call strcpy ("99", obuf, SZ_OBUF)
+	else {
+	    percent = min (99, d_cpu / d_clk / 10)
+	    junk = itoc (percent, obuf, SZ_OBUF)
+	}
+
+	call putline (fd, obuf)
+	call putline (fd, "%\n")
+end
diff --git a/sys/etc/tsleep.x b/sys/etc/tsleep.x
new file mode 100644
index 00000000..d1dbccb1
--- /dev/null
+++ b/sys/etc/tsleep.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TSLEEP -- Suspend execution of the calling task for the specified number
+# of seconds.
+
+procedure tsleep (seconds)
+
+int	seconds
+
+begin
+	if (seconds > 0)
+	    call zwmsec (seconds * 1000)
+end
diff --git a/sys/etc/ttopen.x b/sys/etc/ttopen.x
new file mode 100644
index 00000000..979d6f67
--- /dev/null
+++ b/sys/etc/ttopen.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+
+# TTOPEN -- Open a terminal for direct i/o.  The logical device "dev$tty"
+# denotes the user terminal.  Note that this string is passed on to the
+# kernel without modification, despite the apparent use of a logical directory.
+# (See also fio$zfiott.x, the logical terminal driver).
+
+int procedure ttopen (terminal, mode)
+
+char	terminal[ARB]		# device to be opened
+int	mode
+
+int	fopntx()
+extern	zopntt(), zgettt(), zputtt(), zflstt(), zstttt(), zclstt(),
+	zsektt(), znottt()
+
+begin
+	return (fopntx (terminal, mode, zopntt, zgettt, zputtt, zflstt,
+	    zstttt, zclstt, zsektt, znottt))
+end
+
+
+# TTSETI -- Set special terminal driver options.  The regular FIO options
+# are set using FSETI.
+
+procedure ttseti (fd, param, value)
+
+int	fd			# file descriptor
+int	param			# parameter to be set
+int	value			# new value
+
+int	channel
+int	fstati()
+
+begin
+	channel = fstati (fd, F_CHANNEL)
+	call zsettt (channel, param, value)
+end
+
+
+# TTSTATI -- Stat special terminal driver options.
+
+int procedure ttstati (fd, param)
+
+int	fd			# file descriptor
+int	param			# parameter to be set
+
+long	lvalue
+int	channel
+int	fstati()
+
+begin
+	channel = fstati (fd, F_CHANNEL)
+	call zstttt (channel, param, lvalue)
+	return (lvalue)
+end
+
+
+# TTSETS -- Set special terminal driver option, type string.  The regular FIO
+# options are set using FSETI.
+
+procedure ttsets (fd, param, svalue)
+
+int	fd			# file descriptor
+int	param			# parameter to be set
+char	svalue[ARB]		# new string value
+
+int	channel
+int	fstati()
+
+begin
+	channel = fstati (fd, F_CHANNEL)
+	call zsestt (channel, param, svalue)
+end
+
+
+# TTSTATS -- Stat special terminal driver options, type string.
+
+int procedure ttstats (fd, param, outstr, maxch)
+
+int	fd			# file descriptor
+int	param			# parameter to be set
+char	outstr[maxch]		# receives parameter value
+int	maxch
+
+int	nchars
+int	channel
+int	fstati()
+
+begin
+	channel = fstati (fd, F_CHANNEL)
+	call zststt (channel, param, outstr, maxch, nchars)
+	return (nchars)
+end
diff --git a/sys/etc/urlget.x b/sys/etc/urlget.x
new file mode 100644
index 00000000..23270fed
--- /dev/null
+++ b/sys/etc/urlget.x
@@ -0,0 +1,384 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+
+
+# HTTP error codes we care about
+
+define	HTTP_OK		200			# Success
+define	HTTP_CREATED	201			# Created
+define	HTTP_ACCEPTED	202			# Accepted
+define	HTTP_PARTIAL	203			# Partial Information
+define	HTTP_NORESP	204			# No Response
+
+define	HTTP_MOVED	301			# Moved
+define	HTTP_FOUND	302			# Found
+define	HTTP_SEEOTHER	303			# Method
+define	HTTP_NOTMOD	304			# Not Modified
+
+define	HTTP_BADREQ	400			# Bad Request
+define	HTTP_UNAUTH	401			# Unauthorized
+define	HTTP_PAYMENT	402			# Payment Required
+define	HTTP_FORBIDDEN	403			# Forbidden
+define	HTTP_NOTFOUND	404			# Not Found
+
+define	HTTP_INTERR	500			# Internal Error
+define	HTTP_NOTIMP	501			# Not Implemented
+define	HTTP_OVERLOAD	502			# Service Temporarily Overloaded
+define	HTTP_GWTIMEOUT	503			# Gateway Timeout
+
+define 	SZ_BUF		8192			# download buffer
+
+define 	DBG_HDRS	FALSE
+
+
+
+# URL_GET -- Do an HTTP GET on the given URL, save the results to the named
+# file.  If a 'reply' pointer is given, return the request reply string (must
+# be allocated at least SZ_PATHNAME).
+
+int procedure url_get (url, fname, reply)
+
+char	url[ARB]				#i URL to access
+char	fname[ARB]				#i local filename
+pointer	reply					#u pointer to reply string
+
+char	protocol[SZ_FNAME], host[SZ_FNAME], path[SZ_BUF], emsg[SZ_PATHNAME]
+char	inurl[SZ_PATHNAME], outname[SZ_PATHNAME]
+int	port, stat
+pointer buf
+
+int	url_access(), strcmp()
+bool	url_redirect()
+
+define	redirect_	99
+
+begin
+	# Breakup the URL into usable pieces.
+	call strcpy (url, inurl, SZ_PATHNAME)
+redirect_
+	call url_break (inurl, protocol, host, port, path)
+
+	# Check for a supported protocol.
+	if (strcmp (protocol, "http") != 0) {
+	    call aclrc (emsg, SZ_PATHNAME)
+	    call sprintf (emsg, SZ_PATHNAME,  "Unsupported URI protocol (%s)")
+		call pargstr (protocol)
+	    call error (0, emsg)
+	}
+
+	# Download the file to the given name
+	call strcpy (fname, outname, SZ_PATHNAME)
+
+	if (reply == NULL) {
+	    call calloc (buf, SZ_LINE, TY_CHAR)
+	    stat = url_access (host, port, path, outname, buf)
+	    if (url_redirect (stat, buf, inurl)) {     # check for a redirection
+		call mfree (buf, TY_CHAR)
+	        goto redirect_
+	    }
+	    call mfree (buf, TY_CHAR)
+
+	} else {
+	    stat = url_access (host, port, path, outname, reply)
+	    if (url_redirect (stat, reply, inurl))     # check for a redirection
+	        goto redirect_
+	}
+
+	# URL Error Codes are returned as negative values, positive values 
+	# are the number of bytes read.  We let the caller decode the return
+	# value, if desired, using the url_errcode() procedure.
+
+	return (stat)
+end
+
+
+# URL_REDIRECT -- Check for a redirection reply code and modify the URL so
+# we can try again.
+
+bool procedure url_redirect (stat, reply, url)
+
+int	stat					#i status code
+pointer	reply					#i pointer to reply string
+char	url[ARB]				#u access url
+
+int	code, loc
+pointer	ip, op
+char	inurl[SZ_LINE]
+
+int	strsearch()
+bool	streq()
+
+begin
+	code = - stat
+
+	if (code == HTTP_MOVED || code == HTTP_FOUND || code == HTTP_SEEOTHER) {
+	    loc = strsearch (Memc[reply], "Location:")
+	    if (loc > 0) {
+	 	call aclrc (inurl, SZ_LINE)
+		call strcpy (url, inurl, SZ_LINE)
+        	for (ip=reply+loc; IS_WHITE(Memc[ip]); ip=ip+1)
+                    ;
+		for (op=1; Memc[ip] != '\n'; op=op+1) {
+		    url[op] = Memc[ip]
+		    ip = ip + 1
+		}
+		url[op-1] = EOS
+
+		if (streq (inurl, url))
+		    return (FALSE)
+
+		return (TRUE)
+	    }
+	}
+
+	return (FALSE)
+end
+
+
+# URL_BREAK -- Break the URL into components needed to make the netpath.
+
+procedure url_break (url, protocol, host, port, path)
+
+char	url[SZ_BUF]			#i url to parse
+char	protocol[ARB]			#o URL protocol (only HTTP, for now)
+char	host[ARB]			#o host name
+int	port				#o server port (if specified, or 80)
+char    path[ARB]			#o path part of URL, including args
+
+int	i, nch, ip
+int	ctoi()
+
+begin
+	port = 80				# set default port number
+
+	# Pull out the protocol part of the URL.
+	for (ip=1; url[ip] != ':'; ip = ip + 1)
+	    protocol[ip] = url[ip]
+	protocol[ip] = '\0'
+
+	# Skip the "://" separator.
+	while (url[ip] == ':' || url[ip] == '/')
+	    ip = ip + 1
+
+	# Get the host name.
+	for (i=1; url[ip] != ':' && url[ip] != '/' && url[ip] != EOS; i=i+1) {
+	    host[i] = url[ip]
+	    ip = ip + 1
+	}
+	host[i] = '\0'
+
+	if (url[ip] == EOS) {
+	    call strcpy ("/", path, 2)
+	    return
+	}
+
+	# Extract a port number of specified
+	if (url[ip] == ':') {
+	    ip = ip + 1
+	    nch = ctoi (url, ip, port)
+	}
+
+	# Get the remaining path.
+	for (i=1; url[ip] != EOS; i = i + 1) {
+	    path[i] = url[ip]
+	    ip = ip + 1
+	}
+	path[i] = '\0'
+end
+
+
+# URL_ACCESS -- Do an HTTP GET of a resource to the named file.
+
+int procedure url_access (host, port, path, fname, reply)
+
+char	host[ARB]				#i host name
+int	port					#i server port number
+char	path[ARB]				#i resource path
+char	fname[ARB]				#i saved file path
+pointer	reply					#i reply buffer
+
+pointer	rep
+int	in, out, nchars, totchars, retcode, clen, ip
+char	buf[SZ_BUF], netpath[SZ_PATHNAME], request[SZ_BUF], hd[SZ_PATHNAME]
+bool	done
+
+int	open(), access(), ndopen(), getline(), read(), strlen(), ctoi()
+int	strncmp(), url_retcode()
+
+begin
+	# Connect to server on the given host.
+	call sprintf (netpath, SZ_PATHNAME, "inet:%d:%s:%s")
+	    call pargi (port)
+	    call pargstr (host)
+	    call pargstr ("text")
+
+	iferr (in = ndopen (netpath, READ_WRITE)) {
+	    call eprintf ("cannot access host '%s:%d'\n")
+		call pargstr (host)
+		call pargi (port)
+	    return (- HTTP_NOTFOUND)
+	}
+
+	# Format the request header.
+	call aclrc (request, SZ_BUF)
+	call sprintf (request, SZ_BUF, "GET %s HTTP/1.0\n")
+	    call pargstr (path)
+	call strcat ("Accept: */*\n", request, SZ_BUF)
+	call strcat ("User-Agent: IRAF/urlget\n", request, SZ_BUF)
+	call strcat ("Host: ", request, SZ_BUF)
+	call strcat ( host, request, SZ_BUF)
+	call strcat ("\n", request, SZ_BUF)
+	call strcat ("Connection: keep-alive\n\n", request, SZ_BUF)
+
+	# Send the GET-url request to the server.
+	nchars = strlen (request)
+	call write (in, request, nchars)
+	call flush (in)
+	call fseti (in, F_CANCEL, OK)
+
+	if (DBG_HDRS) {
+	    call eprintf ("request [%d]:\n%s\n")
+		call pargi (nchars)
+		call pargstr (request)
+	}
+
+        # Read the reply. Read the HTTP header assuming it ends with a \n or
+        # a \r\n. and then validate it will return the request correctly.
+	done = false
+	clen = -1
+	call calloc (rep, SZ_PATHNAME, TY_CHAR)
+        repeat {
+	    call aclrc (hd, SZ_PATHNAME)
+            nchars = getline (in, hd)
+            if (nchars <= 0)
+                break
+	    call strcat (hd, Memc[rep], SZ_PATHNAME)
+	    if (strncmp (hd, "Content-Length:", 15) == 0) {
+		ip = 16
+		nchars = ctoi (hd, ip, clen)
+	    }
+        } until ((hd[1] == '\r' && hd[2] == '\n') || (hd[1] == '\n'))
+
+	if (DBG_HDRS) {
+	    call eprintf ("reply: %s\nclen = %d\n")
+		call pargstr (Memc[rep])
+		call pargi(clen)
+	}
+
+	# Make sure we have a valid file.
+	retcode = url_retcode (Memc[rep])
+
+	if (reply != NULL)
+	    call strcpy (Memc[rep], Memc[reply], SZ_PATHNAME)
+	call mfree (rep, TY_CHAR)
+	if (retcode != HTTP_OK)
+	    return (- retcode)
+
+
+	# Open the named output file.
+	if (access (fname, 0, 0) == YES)
+	    call syserrs (SYS_FCLOBBER, fname)
+	iferr (out = open (fname, NEW_FILE, TEXT_FILE))
+	    call syserrs (SYS_FOPEN, fname)
+
+	# Now read the resource and save it to the named file.
+	totchars = 0
+	done = false
+	repeat {
+	    call aclrc (buf, SZ_BUF)
+	    nchars = read (in, buf, SZ_BUF)
+	    if (nchars > 0) {
+		call write (out, buf, nchars)
+		call flush (out)
+		totchars = totchars + nchars
+		done = false
+	    } else
+		done = true
+
+	    if (clen > 0 && totchars >= clen)
+		break
+	} until (done)
+
+	call close (in)				# clean up
+	call close (out)
+
+	return (totchars)			# return number of chars read
+end
+
+
+# URL_RETCODE -- Get the return code from the HTTP header reply.
+
+int procedure url_retcode (reply)
+
+char	reply[ARB]				#i reply string
+
+int	ip, len, code, ctoi()
+
+begin
+	for (ip=1; !IS_WHITE(reply[ip]); ip=ip+1)
+		;
+	len = ctoi (reply, ip, code)
+
+	return (code)
+end
+
+
+#  URL_ERRCODE - Convert between an HTTP return code and the equivalent
+#  syserr() code value.
+
+int procedure url_errcode (code)
+
+int	code					#i http return code
+
+begin
+	# Note:  Not all error codes are implemented in syserr.  In this
+	# case we just return the input code.
+
+	switch (code) {
+	case HTTP_OK:				# Success
+	    ;
+	case HTTP_CREATED:			# Created
+	    ;
+	case HTTP_ACCEPTED:			# Accepted
+	    ;
+	case HTTP_PARTIAL:			# Partial Information
+	    ;
+	case HTTP_NORESP:			# No Response
+	    ;
+
+	case HTTP_MOVED:			# Moved
+	    return (SYS_URLREDIRECT);
+	case HTTP_FOUND:			# Found
+	    return (SYS_URLREDIRECT);
+	case HTTP_SEEOTHER:			# See Other
+	    return (SYS_URLREDIRECT);
+	case HTTP_NOTMOD:			# Not Modified
+	    ;
+
+	case HTTP_BADREQ:			# Bad Request
+	    return (SYS_URLBADREQUEST)
+	case HTTP_UNAUTH:			# Unauthorized
+	    ;
+	case HTTP_PAYMENT:			# Payment Required
+	    ;
+	case HTTP_FORBIDDEN:			# Forbidden
+	    return (SYS_URLFORBIDDEN)
+	case HTTP_NOTFOUND:			# Not Found
+	    return (SYS_URLNOTFOUND)
+
+	case HTTP_INTERR:			# Internal Error
+	    return (SYS_URLINTERROR)
+	case HTTP_NOTIMP:			# Not Implemented
+	    ;
+	case HTTP_OVERLOAD:			# Service Temporarily Overloaded
+	    ;
+	case HTTP_GWTIMEOUT:			# Gateway Timeout
+	    ;
+	}
+
+	return (code)
+end
diff --git a/sys/etc/votable.x b/sys/etc/votable.x
new file mode 100644
index 00000000..ec931030
--- /dev/null
+++ b/sys/etc/votable.x
@@ -0,0 +1,304 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fio.h>
+include <votParse_spp.h>
+
+
+# VOTABLE.X -- Utility procedures for dealing with VOTables.
+
+
+# VOTINIT -- Initialize the VOT struct, parse the document and save the
+# summary.  We return the VOT struct pointer itself, the caller is
+# responsible for accessing the VOT_ROOT to get the raw root handle
+
+pointer procedure votinit (votable)
+
+char	votable[ARB]				#i VOTable file name
+
+pointer	vot, vot_handle
+
+#  Declare the libVOTable functions we'll be using.
+int	vx_openVOTABLE(), vx_getRESOURCE(), vx_getTABLE(), vx_getDATA()
+int	vx_getTABLEDATA(), vx_getFIELD(), vx_getINFO(), vx_getPARAM()
+int	vx_getNCols(), vx_getNRows(), vx_getLength()
+
+begin
+	# Allocate the structure.
+	call calloc (vot, SZ_VOT_STRUCT, TY_STRUCT)
+
+	# Open and parse the votable.
+	vot_handle = vx_openVOTABLE (votable)
+	if (vot_handle <= 0) {
+	    call eprintf ("Cannot open file: '%s'\n")
+		call pargstr (votable)
+	    return (NULL)
+	}
+	VOT_ROOT(vot) = vot_handle
+
+	# Now get various handles from the table.
+	VOT_RES(vot)   = vx_getRESOURCE (vot_handle)
+	VOT_TAB(vot)   = vx_getTABLE (VOT_RES(vot))
+	VOT_DATA(vot)  = vx_getDATA (VOT_TAB(vot))
+	VOT_TDATA(vot) = vx_getTABLEDATA (VOT_DATA(vot))
+
+    	VOT_INFO(vot)  = vx_getINFO (VOT_RES(vot))
+    	VOT_PARAM(vot) = vx_getPARAM (VOT_RES(vot))
+    	VOT_FIELD(vot) = vx_getFIELD (VOT_TAB(vot))
+
+	VOT_NRES(vot)  = vx_getLength (VOT_RES(vot))
+	VOT_NCOLS(vot) = vx_getNCols (VOT_TDATA(vot))
+	VOT_NROWS(vot) = vx_getNRows (VOT_TDATA(vot))
+
+	return (vot) 				# return the struct pointer
+end
+
+
+# VOTCLOSE -- Close the VOT struct and free any resources.
+
+procedure votclose (vot)
+
+pointer	vot					#i VOT struct pointer
+
+begin
+	call vx_closeVOTABLE (VOT_ROOT(vot))
+	call mfree (vot, TY_STRUCT)
+end
+
+# IS_VOTABLE --  Utility routine to determine if the named file is a VOTable
+# XML document.
+
+define	VOT_MAXLINES		10
+
+bool procedure is_votable (fname)
+
+char	fname[ARB]				#i local filename
+
+int	i, fd, nchars
+bool	stat
+char	buf[SZ_LINE]
+
+int	open (), access (), getline (), strsearch ()
+
+begin
+	stat = FALSE
+
+	if (access (fname, 0, 0) == NO)
+	    return (stat)
+
+	iferr {
+            fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	    # Look for a "<VOTABLE>" element in the first 10 lines of the file.
+	    for (i=0; i < VOT_MAXLINES; i = i + 1) {
+                call aclrc (buf, SZ_LINE)
+                nchars = getline (fd, buf)
+		if (nchars == EOF)
+		    break
+
+		call strupr (buf)
+                if (strsearch (buf, "<VOTABLE") > 0)
+                    stat = TRUE
+            }
+            call close (fd)
+	} then
+	    stat = FALSE
+
+	return (stat)
+end
+
+
+# VOT_CONVERT -- Convert a VOTable to some other format.
+
+define VOT_FMTS 	"|ascii|asv|bsv|csv|tsv|html|shtml|fits|xml|raw|votable"
+
+define ASCII   1                       # ascii separated values
+define ASV     2                       # ascii separated values
+define BSV     3                       # bar separated values
+define CSV     4                       # comma separated values
+define TSV     5                       # tab separated values
+define HTML    6                       # standalone HTML document
+define SHTML   7                       # single HTML <table> element
+define FITS    8                       # FITS binary table
+define XML     9                       # VOTable alias
+define RAW     10                      #    "      "
+define VOTBL   11                      #    "      "
+
+int procedure vot_convert (in, out, fmt)
+
+char	in[ARB]					#i VOTable file name
+char	out[ARB]				#i FITS bintable file name
+char	fmt[ARB]				#i format name
+
+pointer	sp, nodename, buf
+char	osfn[SZ_PATHNAME], cnvname[SZ_PATHNAME], format[SZ_LINE]
+int	vfd, status, ip, opt, delim, infile, outfile
+
+int	vfnopen(), vfnmapu(), access(), ki_gnode(), strdic(), strncmp()
+int	open(), getline()
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_FNAME, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+
+	# Map input VFN to OSFN.
+	ip = 1
+	if (strncmp (in, "http://", 7) == 0) {
+	    call strcpy (in, osfn, SZ_PATHNAME)
+	} else {
+	    vfd = vfnopen (in, READ_ONLY)
+	    status = vfnmapu (vfd, osfn, SZ_PATHNAME)
+	    call vfnclose (vfd, VFN_NOUPDATE)
+
+	    # If the file resides on the local node strip the node name,
+	    # returning a legal host system filename as the result.
+	    if (ki_gnode (osfn, Memc[nodename], delim) == 0)
+	        ip = delim + 1
+	}
+
+        # Create a tempfile name for the converted output file.
+        call mktemp ("/tmp/vo", cnvname, SZ_PATHNAME)
+        call strcat (".", cnvname, SZ_PATHNAME)
+        call strcat (fmt, cnvname, SZ_PATHNAME)
+
+
+	# Validate the format.
+	opt = strdic (fmt, format, SZ_LINE, VOT_FMTS)
+        if (opt == 0) {
+            call eprintf ("Invalid output format '%s'\n")
+		call pargstr (fmt)
+	    call sfree (sp)
+            return (ERR)
+        }
+	if (opt == VOTBL || opt == XML || opt == RAW)
+	    call strcpy ("vot", format, SZ_FNAME)
+	if (opt == ASCII)
+	    call strcpy ("asv", format, SZ_FNAME)
+
+
+        # Convert the file from VOTable to FITS bintable.
+        call vx_vocopy (5, "-f", format, "-o", cnvname, osfn[ip])
+
+	if (access (cnvname,0,0) == NO) {
+	    call eprintf ("Cannot convert %s to '%s'\n")
+		call pargstr (osfn[ip])
+		call pargstr (fmt)
+	    return (ERR)
+	}
+
+        # Delete the downloaded XML file, copy the bintable into its
+        # place and delete the converted output filename.
+	if (streq (in, out))
+            call delete (in)
+
+
+	# Copy converted file to output file.  Works for STDOUT/STDERR as
+	# well.
+	infile = open (cnvname, READ_ONLY, TEXT_FILE)
+	outfile = open (out, NEW_FILE, TEXT_FILE)
+
+	while (getline (infile, Memc[buf]) != EOF)
+	    call putline (outfile, Memc[buf])
+
+	call close (infile)
+	call close (outfile)
+
+        call delete (cnvname) 		# delete the temporary converted file
+	call sfree (sp)
+	return (OK)
+end
+
+
+# VOT_TO_FITS -- Convert a VOTable to a FITS bintable.
+
+int procedure vot_to_fits (in, out)
+
+char	in[ARB]					#i VOTable file name
+char	out[ARB]				#i FITS bintable file name
+
+pointer	sp, nodename
+char	osfn[SZ_PATHNAME], cnvname[SZ_PATHNAME]
+int	vfd, status, ip, delim
+
+int	vfnopen(), vfnmapu(), access(), ki_gnode()
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_FNAME, TY_CHAR)
+
+	# Map input VFN to OSFN.
+	vfd = vfnopen (in, READ_ONLY)
+	status = vfnmapu (vfd, osfn, SZ_PATHNAME)
+	call vfnclose (vfd, VFN_NOUPDATE)
+
+	# If the file resides on the local node strip the node name,
+	# returning a legal host system filename as the result.
+	if (ki_gnode (osfn, Memc[nodename], delim) == 0)
+	    ip = delim + 1
+	else
+	    ip = 1
+
+
+        # Create a tempfile name for the converted output file.
+        call mktemp ("/tmp/vo", cnvname, SZ_PATHNAME)
+        call strcat (".fits", cnvname, SZ_PATHNAME)
+
+        # Convert the file from VOTable to FITS bintable.
+        call vx_vocopy (5, "-f", "fits", "-o", cnvname, osfn[ip])
+
+	if (access (cnvname,0,0) == NO)
+	    return (ERR)
+
+        # Delete the downloaded XML file, copy the bintable into its
+        # place and delete the converted output filename.
+	if (streq (in, out))
+            call delete (in)
+
+        call fcopy (cnvname, out)   	# copy converted file to output file
+        call delete (cnvname) 		# delete the temporary converted file
+
+	call sfree (sp)
+
+	return (OK)
+end
+
+
+# VOT_FROM_FITS -- Convert from a FITS bintable to a VOTable.
+
+int procedure vot_from_fits (in, out)
+
+char	in[ARB]					#i FITS bintable file name
+char	out[ARB]				#i VOTable file name
+
+char	osfn[SZ_PATHNAME], cnvname[SZ_PATHNAME]
+int	vfd, status
+
+int	vfnopen(), vfnmapu()
+bool	streq()
+
+begin
+	# Map input VFN to OSFN.
+	vfd = vfnopen (in, READ_ONLY)
+	status = vfnmapu (vfd, osfn, SZ_PATHNAME)
+	call vfnclose (vfd, VFN_NOUPDATE)
+
+        # Create a tempfile name for the converted output file.
+        call mktemp ("/tmp/vo", cnvname, SZ_PATHNAME)
+        call strcat (".xml", cnvname, SZ_PATHNAME)
+
+        # Convert the file from VOTable to FITS bintable.
+        call vx_vocopy (5, "-f", "votable", "-o", cnvname, osfn)
+
+        # Delete the downloaded XML file, copy the bintable into its
+        # place and delete the converted output filename.
+	if (streq (in, out))
+            call delete (in)
+
+        call fcopy (cnvname, out)   	# copy converted file to output file
+        call delete (cnvname) 		# delete the temporary converted file
+
+	return (OK)
+end
diff --git a/sys/etc/xalloc.x b/sys/etc/xalloc.x
new file mode 100644
index 00000000..63be577a
--- /dev/null
+++ b/sys/etc/xalloc.x
@@ -0,0 +1,197 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<xalloc.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<knet.h>
+
+.helpsys xalloc
+.nf _________________________________________________________________________
+XALLOC -- Device allocation package.
+
+	  xallocate (device)
+	xdeallocate (device, rewind)
+	  xdevowner (device, owner, maxch)
+	 xdevstatus (device, out)
+	  xgdevlist (device, devlist, maxch, onedev)
+
+status:
+
+	DV_DEVFREE	device is free and can be allocated
+	DV_DEVALLOC	device is already allocated
+	DV_DEVINUSE	device is in use by someone else
+	DV_DEVNOTFOUND	device is not in device table
+
+The allocatable devices are defined in the text file dev$tapecap.
+.endhelp ____________________________________________________________________
+
+define	SZ_DEVLIST	256
+define	ALLOCATE	1
+define	DEALLOCATE	0
+
+
+# XALLOCATE -- Attempt to allocate the named device, i.e., allocate the device
+# for exclusive i/o, and ready it for i/o following some sort of OPEN call.
+# Allocate performs the function called "mount" on some systems, as well as
+# allocating the device.
+
+int procedure xallocate (device)
+
+char	device[ARB]		#I device to be allocated
+
+pointer	sp, devlist
+int	status, onedev
+int	xgdevlist(), mtfile()
+errchk	xgdevlist, mtallocate
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (devlist, SZ_DEVLIST, TY_CHAR)
+
+	# Fetch the device list for the named device.
+	onedev = NO
+	status = xgdevlist (device, Memc[devlist], SZ_DEVLIST, onedev)
+	if (status != OK)
+	    goto done_
+
+	# Attempt to allocate the device at the host system level.
+	call strpak (Memc[devlist], Memc[devlist], SZ_DEVLIST)
+	call zdvall (Memc[devlist], ALLOCATE, status)
+
+	# If that worked and the device is a magtape, call MTIO to complete
+	# the allocation process.
+
+	if (status == OK && mtfile (device) == YES)
+	    call mtallocate (device)
+done_
+	call sfree (sp)
+	return (status)
+end
+
+
+# XDEALLOCATE -- Deallocate the named device.
+
+int procedure xdeallocate (device, rewind)
+
+char	device[ARB]		#I device to be deallocated
+int	rewind			#I rewind if magtape?
+
+int	status, onedev
+pointer	sp, devlist, osdev, owner
+int	xgdevlist(), mtfile()
+errchk	xgdevlist, syserrs
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (devlist, SZ_DEVLIST, TY_CHAR)
+	call salloc (osdev, SZ_FNAME, TY_CHAR)
+	call salloc (owner, SZ_FNAME, TY_CHAR)
+
+	# Get the i/o device name.
+	onedev = YES
+	status = xgdevlist (device, Memc[osdev], SZ_FNAME, onedev)
+	if (status != OK)
+	    goto done_
+
+	# Verify that the device is actually allocated.  If the device is a
+	# magtape, call MTIO to conditionally rewind the drive and deallocate
+	# the drive in MTIO.
+
+	call strpak (Memc[osdev], Memc[osdev], SZ_FNAME)
+	call zdvown (Memc[osdev], Memc[owner], SZ_FNAME, status)
+	if (status != DV_DEVALLOC)
+	    call syserrs (SYS_MTNOTALLOC, device)
+	else if (mtfile (device) == YES)
+	    call mtdeallocate (device, rewind)
+
+	# Fetch the device list for the named device.
+	onedev = NO
+	status = xgdevlist (device, Memc[devlist], SZ_DEVLIST, onedev)
+	if (status != OK)
+	    goto done_
+
+	# Physically deallocate the device.
+	call strpak (Memc[devlist], Memc[devlist], SZ_DEVLIST)
+	call zdvall (Memc[devlist], DEALLOCATE, status)
+done_
+	call sfree (sp)
+	return (status)
+end
+
+
+# XDEVSTATUS -- Print the status of the named device on the output file.
+
+procedure xdevstatus (device, out)
+
+char	device[ARB]		#I device
+int	out			#I output file
+
+int	status
+char	owner[SZ_FNAME]
+int	xdevowner(), mtfile()
+errchk	xdevowner, mtfile
+
+begin
+	status = xdevowner (device, owner, SZ_FNAME)
+
+	switch (status) {
+	case DV_DEVFREE:
+	    call fprintf (out, "device %s is not currently allocated\n")
+		call pargstr (device)
+	    if (mtfile (device) == YES)
+		iferr (call mtstatus (out, device))
+		    ;
+	case DV_DEVINUSE:
+	    call fprintf (out, "device %s is currently allocated to %s\n")
+		call pargstr (device)
+		call pargstr (owner)
+	case DV_DEVALLOC:
+	    if (mtfile (device) == YES)
+		call mtstatus (out, device)
+	    else {
+		call fprintf (out, "device %s is allocated\n")
+		    call pargstr (device)
+	    }
+	default:
+	    call fprintf (out, "cannot get device status for `%s'\n")
+		call pargstr (device)
+	}
+end
+
+
+# XDEVOWNER -- Determine whether or not the named device is already
+# allocated, and if the device is currently allocated to someone else,
+# return the owner name.
+
+int procedure xdevowner (device, owner, maxch)
+
+char	device[ARB]		#I device to be deallocated
+char	owner[maxch]		#O receives owner name
+int	maxch			#I max chars out
+
+pointer	sp, devlist
+int	status, onedev
+int	xgdevlist()
+errchk	xgdevlist
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (devlist, SZ_DEVLIST, TY_CHAR)
+
+	# Fetch the device list for the named device.
+	onedev = YES
+	status = xgdevlist (device, Memc[devlist], SZ_DEVLIST, onedev)
+	if (status != OK)
+	    goto done_
+
+	# Query device allocation.
+	call strpak (Memc[devlist], Memc[devlist], SZ_DEVLIST)
+	call zdvown (Memc[devlist], owner, maxch, status)
+	call strupk (owner, owner, maxch)
+done_
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/etc/xerfmt.x b/sys/etc/xerfmt.x
new file mode 100644
index 00000000..596e6ce5
--- /dev/null
+++ b/sys/etc/xerfmt.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# XER_FMTERRMSG -- Expand error message encoded as "123 user_string" into
+# a full error message by looking the error message string up in lib$syserrmsg.
+# If the first character of ERRMSG is nonnumeric no processing is done.
+# The conversion may be performed in place, i.e., errmsg and outstr may be
+# the same array.
+
+procedure xer_fmterrmsg (errmsg, outstr, maxch)
+
+char	errmsg[ARB]			# encoded error message.
+char	outstr[maxch]			# output string
+int	maxch
+
+char	buf[SZ_LINE], user_string[SZ_FNAME]
+int	codelen, nchars, chan, ip, op, junk
+int	strncmp(), envfind(), gstrcpy()
+define	nofile_ 91
+
+begin
+	# Determine ndigits in error code.
+	for (ip=1;  IS_DIGIT (errmsg[ip]);  ip=ip+1)
+	    ;
+	codelen = ip - 1
+
+	# Output message as is if no error code.  Copy into local buf first
+	# in case errmsg and outstr overlap.
+
+	if (codelen == 0) {
+	    call strcpy (errmsg, buf, SZ_LINE)
+	    call strcpy (buf, outstr, maxch)
+	    return
+	}
+
+	# Extract the user string into a local buffer.
+	while (IS_WHITE (errmsg[ip]))
+	    ip = ip + 1
+	for (op=1;  errmsg[ip] != EOS && errmsg[ip] != '\n';  ip=ip+1) {
+	    user_string[op] = errmsg[ip]
+	    op = op + 1
+	}
+	user_string[op] = EOS
+
+	# Generate the OS pathname of the "lib$syserrmsg" file.
+	if (envfind ("iraf", buf, SZ_LINE) > 0) {
+	    call zfsubd (buf, SZ_LINE, "lib", nchars)
+	    call strcat ("syserrmsg", buf, SZ_LINE)
+	    call strpak (buf, buf, SZ_LINE)
+	} else
+	    goto nofile_
+
+	# Open and search the system error message file.
+	call zopntx (buf, READ_ONLY, chan)
+	if (chan == ERR)
+	    goto nofile_
+
+	repeat {
+	    call zgettx (chan, buf, SZ_LINE, nchars)
+	    if (nchars == 0 || nchars == ERR) {
+		call zclstx (chan, junk)
+		goto nofile_
+	    } else if (strncmp (buf, errmsg, codelen) == 0) {
+		call zclstx (chan, junk)
+		break
+	    }
+	}
+
+	# Skip the error code prefix and the blank which follows.
+	for (ip=codelen+1;  IS_WHITE(buf[ip]);  ip=ip+1)
+	    ;
+
+	# Output system error message.
+	for (op=1;  buf[ip] != '\n' && buf[ip] != EOS;  ip=ip+1) {
+	    outstr[op] = buf[ip]
+	    op = op + 1
+	}
+	
+	# Add user operand, if supplied, enclosed in parens.
+	if (user_string[1] != EOS) {
+	    outstr[op] = ' '
+	    outstr[op+1] = '('
+	    op = op + 2
+	    op = op + gstrcpy (user_string, outstr[op], maxch-op+1)
+	    outstr[op] = ')'
+	    op = op + 1
+	}
+
+	outstr[op] = EOS
+	return
+
+nofile_
+	call strcpy (errmsg, buf, SZ_LINE)
+	call strcpy (buf, outstr, maxch)
+end
diff --git a/sys/etc/xerpop.x b/sys/etc/xerpop.x
new file mode 100644
index 00000000..a4723508
--- /dev/null
+++ b/sys/etc/xerpop.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# XERPSH -- Push an error handler on the error "stack".  All we really need
+# do is keep track of the number of nested handlers.  If an error condition
+# already exists when we are called, an error has occurred which was not
+# caught, probably because of a missing errchk declaration.
+
+procedure xerpsh()
+
+include	"error.com"
+
+begin
+	if (xerflg)					# error not caught
+	    call erract (EA_FATAL)
+	nhandlers = nhandlers + 1
+	xercod = OK
+end
+
+
+# XERPOP -- Pop an error handler, and return the error status flag (true if
+# an error occurred).
+
+bool procedure xerpop()
+
+bool	error_status
+include	"error.com"
+
+begin
+	nhandlers = nhandlers - 1
+	error_status = xerflg
+	xerflg = false
+
+	return (error_status)
+end
+
+
+# XERPOPI -- Integer version of XERPOP.
+
+int procedure xerpopi()
+
+bool	error_status
+include	"error.com"
+
+begin
+	nhandlers = nhandlers - 1
+	error_status = xerflg
+	xerflg = false
+
+	if (error_status)
+	    return (1)
+	else
+	    return (0)
+end
diff --git a/sys/etc/xerpue.x b/sys/etc/xerpue.x
new file mode 100644
index 00000000..9cc995ee
--- /dev/null
+++ b/sys/etc/xerpue.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<fio.h>
+
+# XER_PUTLINE -- Put a line to the output file (STDERR), using only low level
+# routines.  It is important to use run time indirection through the device
+# table here, to avoid linking the entire IPC and KI into non-IRAF programs
+# that use error handlers, e.g., HSI or IMFORT programs.
+
+procedure xer_putline (fd, text)
+
+int	fd
+char	text[ARB]
+
+long	offset
+int	nchars, junk
+int	strlen()
+include	<fio.com>
+
+begin
+	nchars = strlen (text)
+	fp = fiodes[fd]
+
+	if (FTYPE(fp) == BINARY_FILE) {
+	    offset = 0
+	    call zcall4 (ZAWRBF(fp), FCHAN(fp), text, nchars * SZB_CHAR, offset)
+	    call zcall2 (ZAWTBF(fp), FCHAN(fp), junk)
+	} else
+	    call zcall4 (ZPUTTX(fp), FCHAN(fp), text, nchars, junk)
+end
diff --git a/sys/etc/xerreset.x b/sys/etc/xerreset.x
new file mode 100644
index 00000000..773e38f9
--- /dev/null
+++ b/sys/etc/xerreset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# XER_RESET -- Called to initialize error handling.  Used during startup and
+# during error recovery (e.g. in an interrupt handler) to reset the state of
+# the error handling code.
+
+procedure xer_reset()
+
+include	"error.com"
+
+begin
+	xerflg = false
+	xercod = OK
+	err_restart = NO
+	nhandlers = 0
+	xermsg[1] = EOS
+end
diff --git a/sys/etc/xerstmt.x b/sys/etc/xerstmt.x
new file mode 100644
index 00000000..0a28167b
--- /dev/null
+++ b/sys/etc/xerstmt.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_NUMBUF	6
+
+# XERSTMT -- Format and issue an error statement to the CL.  Note that this is
+# a command issued to the CL, not a line written to STDERR.  The error code and
+# error message string output were posted in the last call to ERROR or FATAL.
+# 
+# Example:	ERROR (501, "Access Violation")
+# 
+# The actual concatentation and transmission of the error message is carried
+# out by the primitive XERPUTC, rather than by PUTLINE and PUTC calls to CLOUT,
+# to avoid recursion in the FIO routines, probably leading to error recursion.
+
+procedure xer_send_error_statement_to_cl (errcode)
+
+int	errcode
+char	numbuf[SZ_NUMBUF]
+int	ip, junk, itoc()
+include	"error.com"
+
+begin
+	# The error code is passed as an argument rather than taken from the
+	# xercom common because XERPOP clears the error code before we are
+	# called by the IRAF Main.
+
+	junk = itoc (errcode, numbuf, SZ_NUMBUF)
+
+	# Format the ERROR statement and sent it to the CL.
+
+	call xerpstr ("ERROR (")
+	call xerpstr (numbuf)
+	call xerpstr (", \"")
+
+	# Output error message string, omitting characters like newline or
+	# quote which could cause syntax problems.
+
+	for (ip=1;  xermsg[ip] != EOS;  ip=ip+1)
+	    if (IS_PRINT (xermsg[ip]) && xermsg[ip] != '"')
+		call xerputc (xermsg[ip])
+
+	# Ring terminal bell if unexpected error (anything other than
+	# a keyboard interrupt).
+
+	if (xercod != SYS_XINT)
+	    call xerpstr ("\7")
+	call xerpstr ("\")\n")
+end
+
+
+# XERPSTR -- Put a string to the CL (special routine, to avoid recursion).
+# Use PUTLINE in normal code.
+
+procedure xerpstr (str)
+
+char	str[ARB]
+int	ip
+
+begin
+	for (ip=1;  str[ip] != EOS;  ip=ip+1)
+	    call xerputc (str[ip])
+end
diff --git a/sys/etc/xerverify.x b/sys/etc/xerverify.x
new file mode 100644
index 00000000..dfb4e88a
--- /dev/null
+++ b/sys/etc/xerverify.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# XER_VERIFY -- The following procedure is called by the iraf main after
+# a task completes, to verify that NHANDLERS is zero, indicating that an XERPOP
+# was executed for each XERPSH.  Note that a transfer out of an IFERR block
+# (a programming error) could prevent XERPOP from being called.
+
+procedure xer_verify()
+
+include	"error.com"
+
+begin
+	if (xerflg)
+	    call erract (EA_FATAL)
+	if (nhandlers != 0) {
+	    nhandlers = 0
+	    call putline (STDERR, "Warning: Transfer out of IFERR block\n")
+	}
+end
diff --git a/sys/etc/xgdevlist.x b/sys/etc/xgdevlist.x
new file mode 100644
index 00000000..d20b68a9
--- /dev/null
+++ b/sys/etc/xgdevlist.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<xalloc.h>
+
+# XGDEVLIST -- Fetch the allocation string for the named logical device from
+# the device table (tapecap file).  DV_DEVNOTFOUND is returned there is no
+# entry in the device table for the device.  An error action is taken if there
+# is any problem reading the device entry.
+#
+# This routine is a bit of an anachronism in the days of tapecap, but is
+# left pretty much as it was originally to minimize code modifications.
+# In principle the allocation code can be used to allocate any device, not
+# just tape drives.  This is still the case, given an entry for the device
+# in the tapecap file.
+
+int procedure xgdevlist (device, outstr, maxch, onedev)
+
+char	device[ARB]		#I logical device name
+char	outstr[maxch]		#O receives device list
+int	maxch			#I max chars out
+int	onedev			#I return i/o device instead?
+
+pointer	gty
+int	nchars
+pointer	mtcap()
+int	gtygets(), strlen()
+errchk	syserrs
+
+begin
+	# Fetch the tapecap entry for the named device.  Do not close the GTY
+	# descriptor.  mtcap always keeps the last one in an internal cache.
+
+	iferr (gty = mtcap (device))
+	    return (DV_DEVNOTFOUND)
+
+	if (onedev == YES)
+	    nchars = gtygets (gty, "dv", outstr, maxch)
+	else
+	    nchars = gtygets (gty, "al", outstr, maxch)
+
+	call ki_xnode (device, outstr, maxch)
+	nchars = strlen (outstr)
+
+	if (nchars <= 0)
+	    call syserrs (SYS_MTTAPECAP, device)
+
+	return (OK)
+end
diff --git a/sys/etc/xisatty.x b/sys/etc/xisatty.x
new file mode 100644
index 00000000..177bec67
--- /dev/null
+++ b/sys/etc/xisatty.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<clset.h>
+include	<fset.h>
+
+# XISATTY -- Test if the given file is a terminal.
+
+int procedure xisatty (fd)
+
+int	fd			# file descriptor of candidate device
+int	epa, epa_tt, epa_ty
+extern	zgettt(), zgetty()
+int	fstati(), clstati()
+
+begin
+	# If we are a connected subprocess, the referenced file is a standard
+	# stream, and i/o has not been redirected, assume that the file behaves
+	# as a terminal.
+
+	if (clstati(CL_PRTYPE) == PR_CONNECTED)
+	    if (fd == STDIN || fd == STDOUT || fd == STDERR)
+		if (fstati (fd, F_REDIR) == NO)
+		    return (YES)
+		else
+		    return (NO)
+
+	# Otherwise, the use of the terminal driver tells us if the file is
+	# open on a terminal device.
+
+	epa = fstati (fd, F_DEVICE)
+	call zlocpr (zgettt, epa_tt)
+	call zlocpr (zgetty, epa_ty)
+
+	if (epa == epa_tt || epa == epa_ty)
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/etc/xmjbuf.x b/sys/etc/xmjbuf.x
new file mode 100644
index 00000000..45585060
--- /dev/null
+++ b/sys/etc/xmjbuf.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# XMJBUF -- Return a char pointer to the IRAF main interpreter context restart
+# buffer (for ZDOJMP restarts).
+
+procedure xmjbuf (bp)
+
+pointer	bp			#O pointer to jumpbuf
+
+int	a_jb, a_mem
+int	jumpbuf[LEN_JUMPBUF]
+common	/JUMPCOM/ jumpbuf
+
+begin
+	call zlocva (jumpbuf[1], a_jb)
+	call zlocva (Memc, a_mem)
+	bp = a_jb - a_mem + 1
+end
diff --git a/sys/etc/xttysize.x b/sys/etc/xttysize.x
new file mode 100644
index 00000000..4c95056e
--- /dev/null
+++ b/sys/etc/xttysize.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<clset.h>
+
+# XTTYSIZE -- Query the size of the terminal screen in characters.  This is
+# different than simply reading the screen size from the environment or from
+# termcap, because the screen size will be queried at runtime if the terminal
+# has a screen which can change size at runtime.  Note that when this routine
+# is called, the variables ttyncols and ttynlines are updated in the IRAF
+# environment, allowing ordinary envgeti calls to be used thereafter to query
+# the screen size.  The XTTYSIZE routine should not be called all over the
+# place, because it may involve i/o to the terminal.
+
+procedure xttysize (width, height)
+
+int	width			# width of screen (out)
+int	height			# height of screen (out)
+
+int	junk, i
+pointer	sp, buf, tty
+pointer	ttyodes()
+int	clstati(), getline(), envgeti(), envscan()
+errchk	clcmd, getline, envgeti, ttyodes
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# If we are a connected subprocess it is difficult to write directly
+	# to the terminal, since the terminal is opened by the CL.  Hence we
+	# have the CL run the STTY task instead to reset the screen size
+	# parameters in the environment.  If we are not a connected subprocess
+	# we query the terminal size directly, assuming that the terminal is
+	# opened on the process standard input and output.
+
+	if (clstati (CL_PRTYPE) == PR_CONNECTED) {
+	    call clcmd ("stty resize")
+	    do i = 1, 2
+		if (getline (CLIN, Memc[buf]) != EOF)
+		    junk = envscan (Memc[buf])
+	    width  = envgeti ("ttyncols")
+	    height = envgeti ("ttynlines")
+
+	} else {
+	    tty = ttyodes ("terminal")
+	    call ttygsize (STDIN, STDOUT, tty, width, height)
+	    call ttycdes (tty)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/etc/xwhen.x b/sys/etc/xwhen.x
new file mode 100644
index 00000000..948eca8f
--- /dev/null
+++ b/sys/etc/xwhen.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XWHEN -- Post an exception handler.
+
+procedure xwhen (signal, handler, old_handler)
+
+int	signal				# signal to be caught
+int	handler				# epa of user supplied exception handler
+int	old_handler			# epa of old handler, if any
+
+begin
+	call zxwhen (signal, handler, old_handler)
+end
diff --git a/sys/etc/zzdebug.x b/sys/etc/zzdebug.x
new file mode 100644
index 00000000..05324872
--- /dev/null
+++ b/sys/etc/zzdebug.x
@@ -0,0 +1,404 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<chars.h>
+
+# Debug the ENVIRON environment list package.  The following definitions are
+# from the header of "environ.x" and are used by envdebug to examine the
+# environment list data structures; these should be compared to the defs in
+# environ.x to make sure they agree.  Use of a header file is not warranted
+# since we really do not want the environ.x data structures known outside
+# the package.
+
+task	get	= t_get,
+	put	= t_put,
+	list	= t_list,
+	mark	= t_mark,
+	free	= t_free,
+	debug	= t_debug,
+	spawn	= t_spawn,
+	edit	= t_edit,
+	tty	= t_tty,
+	urlget	= t_urlget
+
+
+# Strings may optionally be quoted in SET stmts with either ' or ".
+define	IS_QUOTE	($1 == '\'' || $1 == '"')
+
+# Size limiting definitions.
+
+define	NTHREADS	100		# number of hash threads
+define	HASH_FACTOR	1637		# divisor for hash function
+define	NHASHCHARS	6		# no. chars used for hashing
+define	LEN_ENVBUF	1500		# storage for environment list
+define	INC_ENVBUF	500		# increment if overflow occurs
+define	MAX_SZKEY	32		# max chars in a key
+define	MAX_SZVALUE	80		# max chars in value string
+define	MAX_LENLISTELEM	(3+(MAX_SZKEY+1+MAX_SZVALUE+1+SZ_SHORT-1)/SZ_SHORT)
+
+# List element structure, stored in ENVBUF, which is allocated as an array of
+# type SHORT integer.  Each list element is aligned on a short integer boundary
+# within the array.  E_NEXT points to the next element in a thread, whereas
+# E_LASTELEM points to the last element in the envbuf (which is a stack).
+
+define	E_NEXT		Mems[$1]	# next element in thread (list)
+define	E_LASTELEM	Mems[$1+1]	# next element in envbuf
+define	E_REDEF		Mems[$1+2]	# set if element is redefined
+define	E_SETP		P2C($1+3)	# char pointer to name field
+define	E_SET		Memc[E_SETP($1)]	# "name=value" string
+define	E_SETOFFSET	3
+
+
+# GET -- Lookup the definition of an environment variable.
+
+procedure t_get()
+
+char	name[SZ_FNAME]
+char	value[SZ_LINE]
+int	envgets()
+
+begin
+	call clgstr ("name", name, SZ_FNAME)
+	if (envgets (name, value, SZ_LINE) <= 0) {
+	    call printf ("%s not found\n")
+		call pargstr (name)
+	} else {
+	    call printf ("%s = %s\n")
+		call pargstr (name)
+		call pargstr (value)
+	}
+end
+
+
+# PUT -- Enter a new environment variable or list of variables into the
+# environment list.  Enter "stmt: set name=value" to enter a single variable,
+# or "stmt: set @filename" to process set statements from a file.
+
+procedure t_put()
+
+char	stmt[SZ_LINE]
+int	envscan()
+
+begin
+	call clgstr ("statement", stmt, SZ_LINE)
+	call printf ("%d set statements processed\n")
+	    call pargi (envscan (stmt))
+end
+
+
+# LIST -- Print the environment list.
+
+procedure t_list()
+
+bool	clgetb()
+int	btoi()
+
+begin
+	call envlist (STDOUT, "    ", btoi (clgetb ("show_redefs")))
+end
+
+
+# MARK -- Mark the end of the environment list for later restoration by
+# the FREE task.
+
+procedure t_mark()
+
+int	top
+common	/xxx/ top
+
+begin
+	call envmark (top)
+	call printf ("top = %d\n")
+	    call pargi (top)
+end
+
+
+# FREE -- Free the environment list back to the last position marked.
+
+procedure t_free()
+
+int	top
+int	envfree()
+common	/xxx/ top
+
+begin
+	call printf ("free uncovers %d redefs\n")
+	    call pargi (envfree (top, 0))
+end
+
+
+# DEBUG -- Print the internal data structures (the hash table) of the
+# environment list package.
+
+procedure t_debug()
+
+begin
+	call envdebug (STDOUT)
+end
+
+
+# ENVDEBUG -- Print the contents of the environment list data structures for
+# debugging the code.
+
+procedure envdebug (fd)
+
+int	fd			# output file
+int	i, t, head
+pointer	el, ep
+include	"environ.com"
+
+begin
+	call fprintf (fd, "envbuf at %d, len %d, last=%d, top=%d, %d%% full\n")
+	    call pargi (envbuf)
+	    call pargi (len_envbuf)
+	    call pargi (last)
+	    call pargi (top)
+	    call pargr (real(top) / real(len_envbuf) * 100.0)
+
+	for (t=1;  t <= NTHREADS;  t=t+1) {
+	    call fprintf (fd, "%6d"); call pargi (t)
+	    head = threads[t]
+	    if (head != NULL)
+		for (i=head;  i != NULL;  i=E_NEXT(el)) {
+		    el = envbuf + i
+		    call putci (fd, ' ')
+		    for (ep=E_SETP(el);  Memc[ep] != '=';  ep=ep+1)
+			call putc (fd, Memc[ep])
+		}
+	    call putci (fd, '\n')
+	}
+end
+
+
+# SPAWN -- Spawn a connected subprocess.  Used to test process control and
+# interprocess communication.
+
+procedure t_spawn()
+
+char	process[SZ_FNAME]
+char	lbuf[SZ_LINE]
+int	in, out, pid
+int	prgetline(), propen(), prclose(), strmatch()
+define	done_ 91
+
+begin
+	call clgstr ("process", process, SZ_FNAME)
+	pid = propen (process, in, out)
+
+	call putline (STDERR, "-> ")
+	call flush (STDERR)
+
+	while (prgetline (STDIN, lbuf) != EOF) {
+	    if (strmatch (lbuf, "^bye") > 0)
+		break
+	    else {
+		call putline (out, lbuf)
+		call flush (out)
+	    }
+
+	    while (prgetline (in, lbuf) != EOF) {
+		call putline (STDERR, lbuf)
+
+		if (strmatch (lbuf, "^bye") > 0)
+		    break
+		else {
+		    call putline (STDERR, ">> ")
+		    call flush (STDERR)
+		    if (prgetline (STDIN, lbuf) == EOF)
+			goto done_
+		    call putline (out, lbuf)
+		}
+
+		call flush (STDERR)
+		call flush (out)
+	    }
+
+	    call putline (STDERR, "------------\n")
+	    call putline (STDERR, "-> ")
+	    call flush (STDERR)
+	}
+
+done_
+	call putline (STDERR, "\n")
+	call eprintf ("termination code %d\n")
+	    call pargi (prclose (pid))
+end
+
+
+# EDIT -- Test raw mode to a terminal.
+
+procedure t_edit()
+
+char	lbuf[SZ_LINE], temp[SZ_LINE], ch
+int	i, stdline
+
+char	getchar()
+int	envgets(), ttygeti()
+pointer	tty, ttyodes()
+define	accum_ 91
+define	done_ 92
+
+begin
+	# Set terminal to raw mode.
+	call fseti (STDIN, F_RAW, YES)
+
+	# Open termcap for terminal.
+	if (envgets ("terminal", lbuf, SZ_LINE) <= 0)
+	    call strcpy ("vt100", lbuf, SZ_LINE)
+	tty = ttyodes (lbuf)
+	stdline = ttygeti (tty, "li")
+
+	# Edit loop.  The variable I is the character position within the
+	# line.  Start out in insert mode, with line displayed at bottom
+	# of terminal screen.
+
+	lbuf[1] = EOS
+	i = 1
+	call ttygoto (STDOUT, tty, 1, stdline)
+	call flush (STDOUT)
+	goto accum_
+
+	while (getchar (ch) != EOF) {
+	    switch (ch) {
+
+	    case 'h':
+		# Move left one column.
+		if (i <= 1)
+		    call putci (STDOUT, BEL)
+		else {
+		    call putci (STDOUT, BS)
+		    i = i - 1
+		}
+
+	    case 'l':
+		# Move right one column.
+		if (lbuf[i+1] == EOS)
+		    call putci (STDOUT, BEL)
+		else {
+		    call putc  (STDOUT, lbuf[i])
+		    i = i + 1
+		}
+
+	    case 'x':
+		# Delete a character.
+		call strcpy (lbuf[i+1], lbuf[i], SZ_LINE-i+1)
+		call putline (STDOUT, lbuf[i])
+		call putci (STDOUT, BLANK)
+		call ttygoto (STDOUT, tty, i, STDLINE)
+
+		if (i > 1 && lbuf[i] == EOS) {
+		    call putci (STDOUT, BS)
+		    i = i - 1
+		}
+
+	    case 'i':
+		# Insert a character.
+accum_
+		while (getchar (ch) != ESC) {
+		    call putc (STDOUT, ch)
+		    if (ch == '\r')
+			goto done_
+
+		    # Insert char in line buffer.
+		    call strcpy (lbuf[i], temp, SZ_LINE)
+		    lbuf[i] = ch
+		    i = i + 1
+		    call strcpy (temp, lbuf[i], SZ_LINE-i+1)
+
+		    # Redraw right portion of line.
+		    call putline (STDOUT, lbuf[i])
+		    call ttygoto (STDOUT, tty, i, STDLINE)
+		    call flush (STDOUT)
+		}
+
+		if (i > 1) {
+		    call putci (STDOUT, BS)
+		    i = i - 1
+		}
+
+	    case '\f':
+		# Redraw line.
+		call printf ("\r%s")
+		    call pargstr (lbuf)
+		call ttygoto (STDOUT, tty, i, STDLINE)
+
+	    case '\r':
+		break
+
+	    default:
+		call putci (STDOUT, BEL)
+	    }
+
+	    call flush (STDOUT)
+	}
+
+done_
+	call fseti (STDIN, F_RAW, NO)
+	call putci (STDOUT, '\n')
+	call ttycdes (tty)
+end
+
+
+# TTY -- Test direct terminal i/o.
+
+procedure t_tty()
+
+int	in, out, ch
+int	ttopen(), getci()
+bool	clgetb()
+
+begin
+	if (clgetb ("dualstreams")) {
+	    in  = ttopen ("dev$tty", READ_ONLY)
+	    out = ttopen ("dev$tty", WRITE_ONLY)
+	} else {
+	    in  = ttopen ("dev$tty", READ_WRITE)	# NOT SUPPORTED
+	    out = in
+	}
+
+	call fseti (in, F_RAW, YES)
+	while (getci (in, ch) > 0) {
+	    call fprintf (out, "%c\r\n")
+		call pargi (ch)
+	    call flush (out)
+	    if (ch == EOFCHAR)
+		break
+	}
+
+	if (in == out)
+	    call close (in)
+	else {
+	    call close (out)
+	    call close (in)
+	}
+end
+
+
+# URL_GET -- Do an HTTP GET of a URL
+
+procedure t_urlget ()
+
+pointer	reply
+char	url[SZ_LINE], fname[SZ_FNAME]
+bool	hdr
+int	nread
+
+int	url_get()
+
+begin
+	call clgstr ("url", url, SZ_LINE) 		# get the parameters
+	call clgstr ("fname", fname, SZ_FNAME)
+	hdr = clgetb ("hdr")
+
+	call calloc (reply, SZ_LINE, TY_CHAR)
+
+	nread = url_get (url, fname, reply)
+
+	call eprintf ("File '%s', downloaded %d bytes.\n")
+	    call pargstr (fname)
+	    call pargi (nread)
+
+	if (hdr)
+	    call eprintf (Memc[reply])
+	call mfree (reply, TY_CHAR)
+end
diff --git a/sys/fio/README b/sys/fio/README
new file mode 100644
index 00000000..f4cf4d79
--- /dev/null
+++ b/sys/fio/README
@@ -0,0 +1,10 @@
+This directory contains the IRAF File I/O (FIO) routines.  This version of
+FIO fully implements revision 5 of the FIO interface as described in Fio.hlp.
+Internally, however, the buffer management code has been simplified by
+restricting the number of buffers to one per file, and omitting global buffers.
+These features will be added in an upcoming revision of FIO.  No modifications
+to the external specifications of the FIO interface should be necessary.
+D. Tody, 04-Apr-83.
+
+Jul84	Added filename mapping, filename locking, extensive modifications to
+	make use of the new kernel.
diff --git a/sys/fio/access.x b/sys/fio/access.x
new file mode 100644
index 00000000..6a7db09d
--- /dev/null
+++ b/sys/fio/access.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<ctype.h>
+include	<config.h>
+include	<fio.h>
+include	<fset.h>
+
+# ACCESS -- Determine the accessiblity of a file.  Use "access(file,0,0)"
+# to determine if a file exists.  Specify the mode and/or type to see if
+# the file is accessible in a certain mode, and to verify the type of the file.
+
+int procedure access (fname, mode, type)
+
+char	fname[ARB]		# filename
+int	mode			# file access mode (0 if dont care)
+int	type			# file type (txt|bin) (0 if dont care)
+
+int	zmode, status, fd, ip
+int	fstati(), fstdfile()
+include	<fio.com>
+include	"mmap.inc"
+errchk	fmapfn
+define	exit_ 91
+
+begin
+	status = NO
+
+	# Ignore any whitespace at the beginning of the filename.
+	for (ip=1;  IS_WHITE (fname[ip]);  ip=ip+1)
+	    ;
+
+	# Special handling is required for the pseudofiles STDIN, STDOUT, etc.
+	if (fname[ip] == 'S') {
+	    if (fstdfile (fname[ip], fd) == YES) {
+		if (mode == 0 || mode == fstati (fd, F_MODE))
+		    if (type == 0 || type == fstati (fd, F_TYPE)) {
+			status = YES
+			goto exit_
+		    }
+		goto exit_
+	    }
+	}
+
+	# Regular files.  If the filename cannot be mapped the file does not
+	# exist (or the filename mapping file is lost or unreadable).
+
+	iferr (call fmapfn (fname[ip], pathname, SZ_PATHNAME))
+	    goto exit_
+
+	zmode = mode
+	if (mode >= READ_ONLY && mode <= TEMP_FILE)
+	    zmode = mmap[mode]
+	call zfacss (pathname, zmode, type, status)
+
+exit_
+	return (status)
+end
diff --git a/sys/fio/aread.x b/sys/fio/aread.x
new file mode 100644
index 00000000..a57c92c9
--- /dev/null
+++ b/sys/fio/aread.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AREAD -- Asychronous block read from a binary file.  Reads can only
+# start at a character offset which is an integral multiple of the file
+# block size.
+
+procedure aread (fd, buffer, maxchars, char_offset)
+
+int	fd			# FIO file descriptor
+int	maxchars		# maximum number of chars to be read
+char	buffer[ARB]		# buffer into which data is to be read
+long	char_offset		# one-indexed char offset in file
+
+int	maxbytes
+long	byte_offset
+
+begin
+	maxbytes = maxchars * SZB_CHAR
+	byte_offset = (char_offset-1) * SZB_CHAR + 1
+
+	call areadb (fd, buffer, maxbytes, byte_offset)
+end
diff --git a/sys/fio/areadb.x b/sys/fio/areadb.x
new file mode 100644
index 00000000..6f810c6e
--- /dev/null
+++ b/sys/fio/areadb.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# AREADB -- Asychronous byte-oriented block read from a binary file.  Reads
+# can only start at a character offset which is an integral multiple of the
+# file block size.
+
+procedure areadb (fd, buffer, maxbytes, byte_offset)
+
+int	fd			# FIO file descriptor
+int	maxbytes		# maximum number of machine bytes to read
+char	buffer[ARB]		# buffer into to which data is to be read
+long	byte_offset		# one-indexed byte offset in file
+
+long	file_offset
+int	junk, awaitb()
+errchk	filerr, syserr
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	# If channel is active, wait for completion.  Do not abort if await is
+	# not called between i/o requests, since this is what happens when an
+	# error occurs, ant it would lead to a file error following error
+	# restart.
+
+	if (FCIOMODE(fp) != INACTIVE)
+	    junk = awaitb (FAFD(fp))
+
+	if (FBLKSIZE(fp) == 0)				# streaming device
+	    ;
+	else if (byte_offset < 1)
+	    call filerr (FNAME(fp), SYS_FARDOOB)
+	else if (FILSIZE(fp) >= 0 && byte_offset - (FILSIZE(fp)*SZB_CHAR) > 1) {
+	    FNBYTES(fp) = 0				# return EOF
+	    return
+	}
+
+	# If not a streaming device, check alignment of block.  If streaming
+	# device, file offset passed to z-routine must be zero.
+
+	file_offset = byte_offset
+	if (FBLKSIZE(fp) > 0) {
+	    if (mod (byte_offset-1, (FBLKSIZE(fp)*SZB_CHAR)) != 0)
+		call filerr (FNAME(fp), SYS_FARDALIGN)
+	} else
+	    file_offset = 0
+
+	call zlocva (buffer, FLOCBUF(fp))
+	FCIOMODE(fp) = READ_IN_PROGRESS
+	FFIOMODE(fp) = READ_IN_PROGRESS
+	FAFD(fp) = fd
+
+	# If the CLOSE flag is set for the channel, open and close the channel
+	# at the host level every time an i/o operation takes place.  (Used to
+	# save host channel descriptors).  The code is structured so that the
+	# FCLOSEFD flag may change state at any time, with the channel being
+	# left either closed or open the next time we are called.  Any open or
+	# read errors are reported as read errors when AWAITB is later called.
+
+	if (FCLOSEFD(fp) == NO && FCHAN(fp) != ERR)
+	    call zcall4 (ZARDBF(fp), FCHAN(fp), buffer, maxbytes, file_offset)
+	else {
+	    if (FCHAN(fp) == ERR)
+		call zcall3 (FDEVOPEN(fp), FPKOSFN(fp), FMODE(fp), FCHAN(fp))
+	    if (FCHAN(fp) != ERR) {
+		call zcall4 (ZARDBF(fp),
+		    FCHAN(fp), buffer, maxbytes, file_offset)
+		if (FCLOSEFD(fp) == YES) {
+		    junk = awaitb (FAFD(fp))
+		    call zcall2 (ZCLSBF(fp), FCHAN(fp), junk)
+		    FCHAN(fp) = ERR
+		}
+	    }
+	}
+end
diff --git a/sys/fio/await.x b/sys/fio/await.x
new file mode 100644
index 00000000..64deeb40
--- /dev/null
+++ b/sys/fio/await.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+include	<fio.h>
+
+# AWAIT -- Wait for any pending i/o operations on a file to complete.
+# Must be called after an AREAD or AWRITE (to check for an i/o error
+# and for synchronization) or an abort will result.
+
+int procedure await (fd)
+
+int	fd
+pointer	bufp
+int	nbytes, nchars, nfill, loc_Mem, zero, mode
+int	awaitb()
+include	<fio.com>
+
+data	loc_Mem /0/, zero /0/
+errchk	syserr
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	# Read the i/o mode before awaitb clears it.
+	mode = FFIOMODE(fp)
+
+	# Wait for i/o.
+	nbytes = awaitb (fd)
+	if (nbytes <= 0)
+	    return (nbytes)
+
+	# Zero fill the last char of the output buffer if the last transfer was
+	# a read and the number of bytes read was not commensurate with the
+	# size of a char.
+
+	if (mode == READ_IN_PROGRESS && nbytes > 0) {
+	    nchars = (nbytes + SZB_CHAR-1) / SZB_CHAR
+	    nfill  = nchars * SZB_CHAR - nbytes
+
+	    if (nfill > 0) {
+		if (loc_Mem == 0)
+		    call zlocva (Memc, loc_Mem)
+		bufp = FLOCBUF(fp) - loc_Mem + 1
+		call bytmov (zero, 1, Memc[bufp], nbytes + 1, nfill)
+	    }
+	}
+
+	# On exit from AWAITB, fp.filstat contains the number of chars
+	# transferred in the last aread or awrite, or ERR.
+
+	return (FILSTAT(fp))
+end
diff --git a/sys/fio/awaitb.x b/sys/fio/awaitb.x
new file mode 100644
index 00000000..3d27f748
--- /dev/null
+++ b/sys/fio/awaitb.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+
+# AWAITB -- Wait for any pending i/o operations on a file to complete.
+# Must be called after an AREADB or AWRITEB (to check for an i/o error
+# and for synchronization) or an abort will result.
+
+int procedure awaitb (fd)
+
+int	fd
+int	nbytes, nchars
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	if (FFIOMODE(fp) == INACTIVE)
+	    return (FNBYTES(fp))
+	else
+	    call zcall2 (ZAWTBF(fp), FCHAN(fp), nbytes)
+
+	nchars = nbytes
+	if (nbytes >= 0)
+	    nchars = (nbytes + SZB_CHAR-1) / SZB_CHAR
+
+	FNBYTES(fp)  = nbytes
+	FILSTAT(fp)  = nchars
+
+	FCIOMODE(fp) = INACTIVE			# clear channel
+	FFIOMODE(fp) = INACTIVE			# complete fd request
+
+	if (nbytes >= 0)
+	    return (nbytes)
+	else
+	    return (ERR)
+end
diff --git a/sys/fio/awrite.x b/sys/fio/awrite.x
new file mode 100644
index 00000000..a189d0e3
--- /dev/null
+++ b/sys/fio/awrite.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AWRITE -- Asychronous block write to a binary file.  Writes can only
+# start at a character offset which is an integral multiple of the file
+# block size.
+
+procedure awrite (fd, buffer, nchars, char_offset)
+
+int	fd
+int	nchars
+char	buffer[ARB]
+long	char_offset
+
+int	nbytes
+long	byte_offset
+
+begin
+	nbytes = nchars * SZB_CHAR
+	byte_offset = (char_offset-1) * SZB_CHAR + 1
+
+	call awriteb (fd, buffer, nbytes, byte_offset)
+end
diff --git a/sys/fio/awriteb.x b/sys/fio/awriteb.x
new file mode 100644
index 00000000..8c4f1c4d
--- /dev/null
+++ b/sys/fio/awriteb.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# AWRITEB -- Asychronous byte-oriented block write to a binary file.  Writes
+# can only start at a byte offset which is an integral multiple of the file
+# block size.
+
+procedure awriteb (fd, buffer, nbytes, byte_offset)
+
+int	fd			# FIO file descriptor
+int	nbytes			# number of machine bytes to be written
+char	buffer[ARB]		# buffer containing the data
+long	byte_offset		# one-indexed byte offset in file
+
+long	file_offset, szb_file
+int	junk, awaitb()
+errchk	filerr, syserr
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	# Ignore null writes.
+	if (nbytes == 0)
+	    return
+
+	# If channel is active, wait for completion.  Do not abort if await is
+	# not called between i/o requests, since this is what happens when an
+	# error occurs, ant it would lead to a file error following error
+	# restart.
+
+	if (FCIOMODE(fp) != INACTIVE)
+	    junk = awaitb (FAFD(fp))
+
+	if (FBLKSIZE(fp) > 0)				# not streaming device
+	    if (byte_offset < 1 || byte_offset - (FILSIZE(fp)*SZB_CHAR) > 1)
+		call filerr (FNAME(fp), SYS_FAWROOB)
+
+	# If not a streaming device, check alignment of block.  If streaming
+	# device, byte offset passed to z-routine must be zero.
+
+	file_offset = byte_offset
+	if (FBLKSIZE(fp) > 0) {
+	    if (mod (byte_offset-1, (FBLKSIZE(fp)*SZB_CHAR)) != 0)
+		call filerr (FNAME(fp), SYS_FAWRALIGN)
+	} else
+	    file_offset = 0
+
+	# Keep track of file size if appending to file.  FIO keeps track of
+	# the file size to the nearest char.  FILSIZE is negative for certain
+	# types of files, in which case we do not know the file size.
+
+	if (FILSIZE(fp) >= 0) {
+	    szb_file = max (FILSIZE(fp) * SZB_CHAR, file_offset-1 + nbytes)
+	    FILSIZE(fp) = (szb_file + SZB_CHAR-1) / SZB_CHAR
+	}
+
+	FCIOMODE(fp) = WRITE_IN_PROGRESS
+	FFIOMODE(fp) = WRITE_IN_PROGRESS
+	FAFD(fp) = fd
+
+	# If the CLOSE flag is set for the channel, open and close the channel
+	# at the host level every time an i/o operation takes place.  (Used to
+	# save host channel descriptors).  The code is structured so that the
+	# FCLOSEFD flag may change state at any time, with the channel being
+	# left either closed or open the next time we are called.  Any open or
+	# write errors are reported as write errors when AWAITB is later called.
+
+	if (FCLOSEFD(fp) == NO && FCHAN(fp) != ERR)
+	    call zcall4 (ZAWRBF(fp), FCHAN(fp), buffer, nbytes, file_offset)
+	else {
+	    if (FCHAN(fp) == ERR)
+		call zcall3 (FDEVOPEN(fp), FPKOSFN(fp), FMODE(fp), FCHAN(fp))
+	    if (FCHAN(fp) != ERR) {
+		call zcall4 (ZAWRBF(fp),
+		    FCHAN(fp), buffer, nbytes, file_offset)
+		if (FCLOSEFD(fp) == YES) {
+		    junk = awaitb (FAFD(fp))
+		    call zcall2 (ZCLSBF(fp), FCHAN(fp), junk)
+		    FCHAN(fp) = ERR
+		}
+	    }
+	}
+end
diff --git a/sys/fio/close.x b/sys/fio/close.x
new file mode 100644
index 00000000..622557c5
--- /dev/null
+++ b/sys/fio/close.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# CLOSE -- Close a file, after possibly flushing the output buffer, and
+# returning the file buffer (if any) and file descriptor.
+
+procedure close (fd_arg)
+
+int	fd_arg, fd
+int	status
+errchk	flush, mfree, frtnfd
+include	<fio.com>
+
+begin
+	fp = fiodes[fd_arg]
+	if (fp == NULL)
+	    return
+	else
+	    call fcanpb (fd_arg)		# cancel any pushback
+
+	if (redir_fd[fd_arg] > 0) {
+	    # If the stream was redirected locally onto a new file by FREDIR,
+	    # swap streams back to their original order and close the redir
+	    # file.
+
+	    fd = redir_fd[fd_arg]
+	    call flush (fd_arg)
+	    call fswapfd (fd, fd_arg)
+	    redir_fd[fd_arg] = 0
+	} else
+	    fd = fd_arg
+
+	switch (fd) {
+	case STDIN, CLIN:
+	    return
+	case STDOUT, STDERR, CLOUT, STDGRAPH, STDIMAGE, STDPLOT:
+	    call flush (fd)
+
+	default:
+	    call flush (fd)
+	    status = OK
+
+	    switch (FTYPE(fp)) {
+	    case TEXT_FILE:
+		call zcall2 (ZCLSTX(fp), FCHAN(fp), status)
+		call frtnfd (fd)
+	    case STRING_FILE:
+		call strclose (fd)
+	    case SPOOL_FILE:
+		call frtnfd (fd)
+
+	    default:
+		FREFCNT(fp) = FREFCNT(fp) - 1
+		if (FREFCNT(fp) <= 0) {
+		    if (FCHAN(fp) != ERR)
+			call zcall2 (ZCLSBF(fp), FCHAN(fp), status)
+
+		    if (FCD(fp) != FLCD(fp))		# separate chandes?
+			call mfree (FCD(fp), TY_STRUCT)
+		}
+		call frtnfd (fd)
+	    }
+
+	    if (status == ERR)
+		call filerr (FNAME(fp), SYS_FCLOSE)
+	}
+end
diff --git a/sys/fio/delete.x b/sys/fio/delete.x
new file mode 100644
index 00000000..c842d334
--- /dev/null
+++ b/sys/fio/delete.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<syserr.h>
+include	<error.h>
+include	<config.h>
+include	<fio.h>
+
+# DELETE -- Delete a single physical file.  It is an error if the file does
+# not exist, is protected, or if the file simply cannot be deleted.  DELETEFG
+# should be called if deletion of subfiles or multiple versions is desired.
+# Interrupts are disabled while the VFN database is open to protect the
+# database, ensure that that the lock on the mapping file is cleared, and to
+# ensure that the mapping file is closed.
+
+procedure delete (fname)
+
+char	fname[ARB]		# file to be deleted
+
+int	status
+bool	nosuchfile
+pointer	vp, sp, osfn
+
+int	vfndel()
+bool	fnullfile()
+pointer	vfnopen()
+define	abort_ 91
+define	close_ 92
+
+begin
+	# The null file "dev$null" is a special case; ignore attempts to
+	# delete this file.
+
+	if (fnullfile (fname))
+	    return
+
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	call intr_disable()
+	iferr (vp = vfnopen (fname, VFN_WRITE))
+	    goto abort_
+
+	# Delete the VFN and determine if the file actually exists.
+	nosuchfile = false
+	iferr (status = vfndel (vp, Memc[osfn], SZ_PATHNAME))
+	    goto close_
+
+	if (status == ERR)
+	    nosuchfile = true
+	else {
+	    call zfacss (Memc[osfn], 0, 0, status)
+	    if (status == NO) {
+		#  If the file is a symlink pointing to a non-existent file,
+		#  we'll delete the link below.
+	        call zfacss (Memc[osfn], 0, SYMLINK_FILE, status)
+	        if (status == YES)
+		    nosuchfile = false
+	        else
+		    nosuchfile = true
+	    }
+	}
+
+	# It is an error to try to delete a nonexistent file.
+	if (nosuchfile) {
+	    iferr (call filerr (fname, SYS_FDELNXF))
+		goto close_
+	}
+
+	# Is the file protected?
+	call zfprot (Memc[osfn], QUERY_PROTECTION, status)
+
+	if (status == YES) {
+	    iferr (call filerr (fname, SYS_FDELPROTFIL))
+		goto close_
+	} else {
+	    # Try to delete the file.  If the delete operation succeeds but
+	    # the file still exists, an older version has surfaced and the
+	    # VFN must not be deleted from the file table.
+
+	    call zfdele (Memc[osfn], status)
+	    if (status == ERR) {
+		iferr (call filerr (fname, SYS_FDELETE))
+		    goto close_
+	    } else {
+		call zfacss (Memc[osfn], 0, 0, status)
+		if (status == YES) {
+		    iferr (call vfnclose (vp, VFN_NOUPDATE))
+			goto abort_
+		} else {
+		    iferr (call vfnclose (vp, VFN_UPDATE))
+			goto abort_
+		}
+	    }
+	}
+
+	call sfree (sp)
+	call intr_enable()
+	return
+
+
+	# Error recovery nasties.
+close_
+	iferr (call vfnclose (vp, VFN_NOUPDATE))
+	    ;
+abort_
+	call intr_enable()
+	call sfree (sp)
+	call erract (EA_ERROR)
+end
diff --git a/sys/fio/deletefg.x b/sys/fio/deletefg.x
new file mode 100644
index 00000000..be397efd
--- /dev/null
+++ b/sys/fio/deletefg.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# DELETEFG -- Delete a file group, i.e., the file, all subfiles, and all
+# versions.  It is an error if the file does not exist, is protected, or
+# if the file simply cannot be deleted.  A subfile is a physical file which
+# is logically subordinate to another file and which must be deleted if the
+# main file is deleted (e.g., a pixel storage file is a subfile of an
+# imagefile).
+
+procedure deletefg (fname, versions, subfiles)
+
+char	fname[ARB]		# file or file group to be deleted
+int	versions		# delete all versions
+int	subfiles		# delete any subfiles (no subsubfiles)
+
+int	n, max_versions
+errchk	delete, erract
+
+begin
+	max_versions = 1
+	if (versions == YES)
+	    max_versions = 30000
+	    
+	for (n=0;  n < max_versions;  n=n+1) {
+	    # Delete the main file.
+	    iferr (call delete (fname))
+		if (n == 0)
+		    call erract (EA_ERROR)
+		else
+		    break
+	    # Delete any subfiles.
+	    if (subfiles == YES)
+		call fsfdelete (fname)
+	}
+end
diff --git a/sys/fio/diropen.x b/sys/fio/diropen.x
new file mode 100644
index 00000000..52f099ce
--- /dev/null
+++ b/sys/fio/diropen.x
@@ -0,0 +1,289 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<error.h>
+include	<syserr.h>
+include	<config.h>
+include	<fset.h>
+include	<diropen.h>
+include	<fio.h>
+
+define	MAX_OPENDIR	20
+
+# DIROPEN -- Open a directory file for reading.  Directories are opened
+# as read only text files.  Writing, seeking, etc. are not permitted.
+# The machine dependent OSFN's returned by the kernel are converted to
+# VFN's and hidden files are skipped.  Skipping of hidden files may be
+# overriden (i.e., all filenames may be passed) as a option.
+
+int procedure diropen (fname, mode)
+
+char	fname[ARB]		# directory file to be opened
+int	mode			# pass or skip hidden filenames
+
+int	fd, dirf
+bool	first_time
+int	dirmode[MAX_OPENDIR]
+int	oschan[MAX_OPENDIR]
+pointer	vfnptr[MAX_OPENDIR], vp, sp, osfn
+
+pointer	vfnopen()
+int	fopntx(), fstati(), errcode()
+extern	fopdir(), fgtdir(), fptdir(), ffldir(), fstdir(), fcldir()
+extern	fskdir(), fntdir()
+errchk	fopntx, vfnopen, syserrs
+common	/dircom/ dirmode, oschan, vfnptr
+data	first_time /true/
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	# Free up all descriptor slots.
+	if (first_time) {
+	    do dirf = 1, MAX_OPENDIR
+		oschan[dirf] = 0
+	    first_time = false
+	}
+
+	# The file name must be mapped explicitly because FIO will not map
+	# filenames opened on special devices (when FOPNTX is called).
+
+	call fmapfn (fname, Memc[osfn], SZ_PATHNAME)
+	call strupk (Memc[osfn], Memc[osfn], SZ_PATHNAME)
+
+	# Open the VFN database, used to unmap filenames.
+	vp = vfnopen (Memc[osfn], VFN_UNMAP)
+
+	# Open the file.  We call FIO which eventually calls FOPDIR.
+
+	iferr {
+	    fd = fopntx (Memc[osfn], READ_ONLY,
+		fopdir, fgtdir, fptdir, ffldir, fstdir, fcldir, fskdir, fntdir)
+	} then {
+	    call vfnclose (vp, VFN_NOUPDATE)
+	    if (errcode() == SYS_FOPENDEV)
+		call syserrs (SYS_FOPENDIR, fname)
+	    else
+		call erract (EA_ERROR)
+	}
+
+	# Get the channel number (index into dirmode and oschan) assigned
+	# by FOPDIR.  Save the mode and vp for later.
+	
+	dirf = fstati (fd, F_CHANNEL)
+	dirmode[dirf] = mode
+	vfnptr[dirf]  = vp
+
+	call sfree (sp)
+	return (fd)
+end
+
+
+# FOPDIR -- Open a directory; this is the "zopntx" routine called by FIO.
+# Allocate a directory descriptor and call the kernel to physically open
+# the directory.
+
+procedure fopdir (osfn, mode, channel)
+
+char	osfn[ARB]		# packed OS filename of directory file
+int	mode			# file access mode (always read_only)
+int	channel			# we return index into oschan
+
+int	dirf
+int	dirmode[MAX_OPENDIR]
+int	oschan[MAX_OPENDIR]
+int	vfnptr[MAX_OPENDIR]
+common	/dircom/ dirmode, oschan, vfnptr
+
+begin
+	channel = ERR
+	if (mode != READ_ONLY)
+	    return
+
+	# Allocate a descriptor.
+	for (dirf=1;  dirf <= MAX_OPENDIR;  dirf=dirf+1)
+	    if (oschan[dirf] == 0)
+		break
+
+	# Open the physical directory file and return directory file index
+	# as the channel number.  Free the slot if ZOPDIR returns ERR.
+
+	if (dirf <= MAX_OPENDIR) {
+	    call zopdir (osfn, oschan[dirf])
+	    if (oschan[dirf] == ERR)
+		oschan[dirf] = 0
+	    else
+		channel = dirf
+	}
+end
+
+
+# FCLDIR -- Close a directory previously opened with FOPDIR.
+
+procedure fcldir (channel, status)
+
+int	channel			# index into oschan
+int	status
+
+int	dirmode[MAX_OPENDIR]
+int	oschan[MAX_OPENDIR]
+int	vfnptr[MAX_OPENDIR]
+common	/dircom/ dirmode, oschan, vfnptr
+
+begin
+	if (channel < 1 || channel > MAX_OPENDIR)
+	    status = ERR
+	else if (oschan[channel] == 0)
+	    status = ERR
+	else {
+	    call zcldir (oschan[channel], status)
+	    oschan[channel] = 0
+	    iferr (call vfnclose (vfnptr[channel], VFN_NOUPDATE))
+		status = ERR
+	}
+end
+
+
+# FGTDIR -- Get the next "line of text", i.e. VFN, from a directory.  Since we
+# are being accessed as a text file we must return an unpacked string delimited
+# by a newline.  OS filenames are converted to virtual filenames and hidden
+# files are skipped if desired.  Raw mode is not supported.
+
+procedure fgtdir (chan, outline, maxch, status)
+
+int	chan			# oschan index
+char	outline[maxch]		# buffer which receives the VFN
+int	maxch			# maxchars to return
+int	status
+
+int	nchars
+pointer	vp, sp, osfn
+int	dirmode[MAX_OPENDIR]
+int	oschan[MAX_OPENDIR]
+int	vfnptr[MAX_OPENDIR]
+
+int	vfnunmap(), vfn_is_hidden_file()
+errchk	vfnunmap, vfn_is_hidden_file
+common	/dircom/ dirmode, oschan, vfnptr
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_FNAME, TY_CHAR)
+
+	status = ERR
+	if (chan < 1 || chan > MAX_OPENDIR)
+	    goto done_
+	if (oschan[chan] == 0)
+	    goto done_
+	vp = vfnptr[chan]
+
+	repeat {
+	    call zgfdir (oschan[chan], Memc[osfn], SZ_FNAME, nchars)
+	    if (nchars > 0) {
+		nchars = vfnunmap (vp, Memc[osfn], outline, maxch)
+		if (nchars > 0 && nchars < maxch) {
+		    if (dirmode[chan] == SKIP_HIDDEN_FILES)
+			if (outline[1] == '.' ||
+			    vfn_is_hidden_file (outline) == YES) {
+			    nchars = 0
+			    next
+			}
+		    outline[nchars+1] = '\n'
+		    nchars = nchars + 1
+		    outline[nchars+1] = EOS
+		}
+	    }
+	} until (nchars != 0)
+
+	# FIO expects to read 0 chars when EOF is reached.
+	if (nchars == EOF)
+	    status = 0
+	else
+	    status = nchars
+done_
+	call sfree (sp)
+end
+
+
+# FPTDIR -- Put a line to a directory.  This function is illegal on directories.
+# In principle FIO will never permit us to be called.
+
+procedure fptdir (chan, line, nchars, status)
+
+int	chan, nchars, status
+char	line[ARB]
+
+begin
+	status = ERR
+end
+
+
+# FFLDIR -- Flush output to a directory.  This function is illegal on
+# directories.  In principle FIO will never permit us to be called.
+
+procedure ffldir (chan, status)
+
+int	chan, status
+
+begin
+	status = ERR
+end
+
+
+# FSTDIR -- Get file status for a directory file/device.  This is a legal
+# function, used to get the buffer size.
+
+procedure fstdir (chan, param, lvalue)
+
+int	chan			# not used
+int	param			# parameter for which status is desired
+long	lvalue			# returned value
+
+begin
+	switch (param) {
+	case FSTT_BLKSIZE:
+	    lvalue = 1
+	case FSTT_FILSIZE:
+	    lvalue = 0
+	case FSTT_OPTBUFSIZE:
+	    lvalue = SZ_LINE
+	case FSTT_MAXBUFSIZE:
+	    lvalue = 0
+	default:
+	    lvalue = ERR
+	}
+end
+
+
+# FSKDIR -- Seek on a directory file.  Ignore seek to BOF since ZOPDIR
+# opens at BOF automatically (FIO will call us to seek to BOF when the
+# file is opened).
+
+procedure fskdir (chan, offset, status)
+
+int	chan, status
+long	offset
+
+begin
+	switch (offset) {
+	case BOFL:
+	    status = OK
+	default:
+	    status = ERR
+	}
+end
+
+
+# FNTDIR -- Note position on a directory file.  Seeking is illegal on
+# directories so we merely return ERR.
+
+procedure fntdir (chan, offset)
+
+int	chan
+long	offset
+
+begin
+	offset = ERR
+end
diff --git a/sys/fio/doc/fio.hd b/sys/fio/doc/fio.hd
new file mode 100644
index 00000000..08da85cc
--- /dev/null
+++ b/sys/fio/doc/fio.hd
@@ -0,0 +1,54 @@
+# Help directory for the FIO (file i/o) system package.
+
+$fio	= "sys$fio/"
+
+access		hlp = access.hlp,		src = fio$access.x
+aread		hlp = aread.hlp,		src = fio$aread.x
+areadb		hlp = areadb.hlp,		src = fio$areadb.x
+await		hlp = await.hlp,		src = fio$await.x
+awaitb		hlp = awaitb.hlp,		src = fio$awaitb.x
+awrite		hlp = awrite.hlp,		src = fio$awrite.x
+awriteb		hlp = awriteb.hlp,		src = fio$awriteb.x
+close		hlp = close.hlp,		src = fio$close.x
+delete		hlp = delete.hlp,		src = fio$delete.x
+diropen		hlp = diropen.hlp,		src = fio$diropen.x
+falloc		hlp = falloc.hlp,		src = fio$falloc.x
+fcopy		hlp = fcopy.hlp,		src = fio$fcopy.x
+fdevbf		hlp = fdevbf.hlp,		src = fio$fdevbf.x
+fdevtx		hlp = fdevtx.hlp,		src = fio$fdevtx.x
+finfo		hlp = finfo.hlp,		src = fio$finfo.x
+flush		hlp = flush.hlp,		src = fio$flush.x
+fnextn		hlp = fnextn.hlp,		src = fio$fnextn.x
+fnldir		hlp = fnldir.hlp,		src = fio$fnldir.x
+fnroot		hlp = fnroot.hlp,		src = fio$fnroot.x
+fntcls		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntclsb		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntgfn		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntgfnb		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntlenb		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntopn		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntopnb		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fntrewb		hlp = fntgfn.hlp,		src = fio$fntgfn.x
+fopnbf		hlp = fopnbf.hlp,		src = fio$fopnbf.x
+fopntx		hlp = fopntx.hlp,		src = fio$fopntx.x
+fowner		hlp = fowner.hlp,		src = fio$fowner.x
+fpathname	hlp = fpathname.hlp,		src = fio$fpathname.x
+fseti		hlp = fseti.hlp,		src = fio$fseti.x
+fstati		hlp = fstati.hlp,		src = fio$fstati.x
+fstatl		hlp = fstatl.hlp,		src = fio$fstatl.x
+fstats		hlp = fstats.hlp,		src = fio$fstats.x
+getc		hlp = getc.hlp,			src = fio$getc.x
+getline		hlp = getline.hlp,		src = fio$getline.x
+mktemp		hlp = mktemp.hlp,		src = fio$mktemp.x
+note		hlp = note.hlp,			src = fio$note.x
+open		hlp = open.hlp,			src = fio$open.x
+protect		hlp = protect.hlp,		src = fio$protect.x
+putc		hlp = putc.hlp,			src = fio$putc.x
+putcc		hlp = putcc.hlp,		src = fio$putcc.x
+putline		hlp = putline.hlp,		src = fio$putline.x
+read		hlp = read.hlp,			src = fio$read.x
+rename		hlp = rename.hlp,		src = fio$rename.x
+reopen		hlp = reopen.hlp,		src = fio$reopen.x
+seek		hlp = seek.hlp,			src = fio$seek.x
+stropen		hlp = stropen.hlp,		src = fio$stropen.x
+write		hlp = write.hlp,		src = fio$write.x
diff --git a/sys/fio/doc/fio.hlp b/sys/fio/doc/fio.hlp
new file mode 100644
index 00000000..1f87049f
--- /dev/null
+++ b/sys/fio/doc/fio.hlp
@@ -0,0 +1,1912 @@
+
+.help fio Jan83 "File i/o Design Rev.5"
+.tp 30
+.sh
+STRUCTURE OF THE BASIC FILE I/O PROCEDURES
+
+     The high level FIO input procedures are GETC, GETLINE, and READ.
+These procedures read directly out of the "current buffer".  When the
+buffer is exhausted, FILBUF is called to refill the buffer.  The action
+taken by FILBUF depends on whether the file contains text or binary data,
+but does not depend on the characteristics of the device on which the
+file is resident.  The output procedures are similar to the input
+procedures, except that FLSBUF is called to flush the buffer when it fills.
+
+
+
+
+.ks
+.nf
+	              getc     getline     read
+
+
+
+		               filbuf
+
+
+              text files                     binary files
+
+	             zgettx    fmkbfs     ffault
+
+
+
+	          Structure of the Input Procedures
+.fi
+.ke
+
+
+
+
+
+.ks
+.nf
+		      putc     putline     write
+
+
+
+
+		               flsbuf
+
+
+	        text files                 binary files
+
+
+	             zputtx    fmkbfs     ffault
+
+
+
+	          Structure of the Output Procedures
+.fi
+.ke
+
+
+The "file fault" procedure (FFAULT) is called by both FILBUF and FLSBUF
+for binary files, when the referenced data lies outside the range of
+the current buffer.
+
+
+
+.ks
+.nf
+ 	                        ffault
+
+
+
+	                      
+	             ffilbf     frelnk      fflsbf
+
+
+
+
+                          fwatio      fbseek
+
+
+
+	       aread      await      aseek/anote     awrite
+
+
+
+	       zaread     zawait     zseek/znote     zawrite
+
+
+
+	        FIO Structure for Accessing Binary Files
+.fi
+.ke
+
+
+In the above structure chart, the "z" routines at the lowest level
+are system and device dependent, and are actually part of the system
+interface, rather than FIO.  A separate set of z-routines is required
+for each device serviced by FIO (regular binary files, the CL interface,
+pipes, magtapes, memory, etc.).
+
+All of the system and device dependence of FIO is concentrated
+into the z-routines.  Only the routines AREAD, AWRITE, and AWAIT know
+that more than one type of binary device is serviced by FIO.  Furthermore,
+FIO maintains a device table containing the entry point addresses of
+the z-routines for each device.  This provides a clean interface to the
+device dependent routines, and makes it possible to add new devices
+without editing the source for FIO.  In fact, it is possible to interface
+new devices to FIO dynamically, at run time.
+
+
+.tp 10
+.sh
+SEMICODE FOR THE BASIC FILE I/O PROCEDURES
+
+     The procedures GETC and PUTC read and write character data, a single
+character at a time.  Since these procedures may be called once for each
+character in a file, they must be as efficient (ergo, simple) as feasible.
+These machine code for these routines should be hand optimized if much
+text processing (i.e. compilations) is anticipated.
+
+
+
+.nf
+.tp 5
+int procedure getc (fd, ch)			# get character
+
+begin
+	if (iop < bufptr || iop >= itop)	# buffer exhausted?
+	    switch (filbuf(fd)) {
+	    case EOF:
+		return (EOF)
+	    case ERR:
+		take error action
+	    }
+
+	ch = Mem[iop]
+	iop = iop + 1
+
+	return (ch)
+end
+
+
+
+.tp 5
+procedure putc (fd, ch)				# put character
+
+begin
+	if (iop < bufptr || iop >= otop) {	# buffer full?
+	    if (flsbuf (fd) == ERR)
+		take error action
+	}
+
+	Mem[iop] = ch
+	iop = iop + 1
+
+	if (ch == newline) {			# end of line?
+	    if (flush on newline is enabled for this file)
+		if (flsbuf (fd) == ERR)
+		    take error action
+	}
+end
+.fi
+
+
+Characters and strings (and even binary data) may be "pushed back" into
+the input stream.  UNGETC pushes a single character.  Subsequent calls
+to GETC, GETLINE, READ, etc. will read out the characters in the order
+in which they were pushed (first in, first out).  When all of the
+pushback data has been read, reading resumes at the preceeding file
+position, which may either be in one of the primary buffers, or an
+earlier state in the pushback buffer.
+
+UNGETS differs from UNGETC in that it pushes back whole strings,
+in a last in, first out fashion.  UNGETS is used to implement recursive
+macro expansions.  The amount of recursion permitted may be specified
+after the file is opened, and before any data is pushed back.  Recursion
+is limited by the size of the input pointer stack, and pushback capacity
+by the size of the pushback buffer.
+
+
+.tp 5
+.nf
+procedure ungetc (fd, ch)		# push back a character
+
+begin	
+	if (iop < bufptr || iop >= otop) {
+	    if (no pushback buffer)
+		create pushback buffer
+	    else
+		error: "pushback buffer overflow"
+
+	    stack old iop, itop
+
+	    set iop to point at beginning of the pushback buffer,
+	    set itop to iop, otop to top of pushback buffer.
+	}
+
+	Mem[iop] = ch
+	iop = iop + 1
+	itop = itop + 1
+end
+
+
+
+.tp 5
+procedure ungets (fd, str)		# recursively push back a string
+
+begin
+	if (iop < bufptr || iop >= otop) {
+	    if (no pushback buffer) {
+		create pushback buffer
+		setup iop, buftop for pushback buffer
+	    } else
+		error: "pushback buffer overflow"
+	}
+
+	stack old iop, itop
+	copy string to Mem[iop], advance iop
+	itop = iop
+end
+.fi
+
+
+
+Calls to GETLINE may be intermixed with calls to GETC, READ, and so on.
+If, however, only GETLINE is used to access a file, and the associated
+file is a text file, a file buffer will never need to be created (the
+data will be placed directly in the user buffer instead).
+If a buffer has been created and is not yet empty, GETLINE will read the
+remainder of the current line from that buffer, before again calling FILBUF.
+
+The newline character is returned as part of the line.  The maximum size
+of a line (size of a line buffer) is set at compile time by the system
+wide constant SZ_LINE.  The constant SZ_LINE includes space for the newline
+character, but not for the EOS marker (character array dimensions never
+include space for the EOS, because the preprocessor automatically allows an
+extra character for the EOS when dimensioning the array for Fortran).
+.nf
+
+
+.tp 5
+int procedure getline (fd, linebuf)		# get a line from file
+
+begin
+	op = 1
+	if (buffer is empty and file type is TEXT_FILE) {
+	    # call ZGETTX to copy line directly into user linebuf
+	    zgettx (channel(fd), linebuf, status)
+
+	} else {
+	    while (op <= SZ_LINE) {
+		if (iop < bufptr || iop >= itop) {
+		    status = filbuf (fd)
+		    if (status == ERR || status == EOF)
+			break
+		}
+		
+		linebuf[op] = Mem[iop]
+		iop = iop + 1
+		op = op + 1
+
+		if (the character was newline)
+		    break
+	    }
+	    linebuf[op] = EOS
+	}
+
+	if (status == ERR)
+	    take error action
+	else if (op == 1)
+	    return (EOF)
+	else
+	    return (op - 1)			# number of chars
+end
+
+
+
+
+.tp 5
+procedure putline (fd, linebuf)			# put a line to file
+
+begin
+	for (i=1;  linebuf[i] != EOS;  i=i+1) {
+	    if (iop < bufptr || iop >= otop)
+		if (flsbuf (fd) == ERR)
+		    take error action
+	    }
+
+	    Mem[iop] = linebuf[i]
+	    iop = iop + 1
+
+	    if (the character is newline) {
+		if (flush on newline is enabled)
+		    if (flsbuf (fd) == ERR)
+			take error action
+	    }
+	}
+end
+
+
+
+.fi
+The READ procedure reads a maximum of MAXCHARS characters from the file
+FD into the user supplied buffer BUFFER.  In the case of block structured
+devices, READ will continue to read blocks from the file until the output
+buffer has filled.  In the case of record structured devices (i.e., terminals,
+text files, pipes) READ will read at most one record, after exhausting the
+contents of the file buffer.
+
+
+
+.tp 5
+.nf
+int procedure read (fd, buffer, maxchars)
+
+begin
+	check that fd is a valid file opened for reading
+	nchars = 0
+
+	while (nchars <= maxchars) {
+	    if (iop < bufptr || iop >= itop) {
+		switch (filbuf(fd)) {
+		case EOF:
+		    break
+		case ERR:
+		    take error action
+		default:
+		    # don't loop if record structured device or EOF
+		    if (nchars read != buffer size)
+			maxchars = min (maxchars, nchars + nchars read)
+		}
+	    }
+	    chunk = min (maxchars - nchar, itop - iop)
+	    if (chunk <= 0)
+		break
+	    else {
+		amovc (Memc[iop], buffer[nchars+1], chunk)
+		iop = iop + chunk
+		nchars = nchars + chunk
+	    }
+	}
+
+	if (nchars == 0)
+	    return (EOF)
+	else
+	    return (nchars)
+end
+
+
+
+
+.tp 5
+procedure write (fd, buffer, maxchars)
+
+begin
+	check that fd is a valid file opened for writing
+	nchars = 0
+
+	while (nchars <= maxchars) {
+	    if (iop < bufptr || iop >= otop) {
+		if (flsbuf (fd) == ERR)
+		    take error action
+	    }
+	    chunk = min (maxchars - nchar, otop - iop)
+	    if (chunk <= 0)
+		break
+	    else {
+		amovc (buffer[nchars+1], Mem[iop], chunk)
+		iop = iop + chunk
+		nchars = nchars + chunk
+	    }
+	}
+end
+
+
+
+
+.tp 5
+int procedure filbuf (fd)
+
+begin
+	verify fd: file open with read permission
+
+	if (iop points into pushback buffer) {
+	    pop state off pushback stack
+	    return (itop - bufptr)
+	    # eventually end up back in a real file buffer
+	} else if (no buffers) {
+	    call fmkbfs to allocate buffer space for the file
+	    # fmkbfs must adjust iop to reflect current file position
+	}
+
+	if (TEXT_FILE)
+	    zgettx (fd, file_buffer, nchars)
+	else
+	    nchars = ffault (fd, logical_offset_in_file)
+
+	iop = bufptr
+	itop = max (bufptr, bufptr + nchars)
+	otop = bufptr
+
+	return (nchars)
+end
+
+
+
+
+.tp 5
+int procedure flsbuf (fd)
+
+begin
+	verify fd: file open with write permission
+	if (no buffers)
+	    call fmkbfs to allocate buffer space
+
+	if (otop = bufptr) {
+	    set otop to top of buffer
+	    status = OK
+	} else if (TEXT_FILE) {
+	    zputtx (channel[fd], file_buffer, status)
+	    reset iop to start of buffer
+	} else {
+	    status = ffault (fd, logical_offset)
+	}
+
+	return (status)
+end
+.fi
+
+
+.sh
+Buffer Management for Binary Files
+
+     FIO maintains a "current buffer" for each file.  A "file pointer"
+is also maintained for each file.  The file pointer is the character offset
+within the file at which the next i/o transfer will occur.  When the file
+pointer no longer points into the current buffer, a "file fault" occurs.
+The file pointer is modified when, and only when, an i/o transfer or seek
+occurs.
+
+All i/o to binary files is routed through FFAULT.  FILBUF and FLSBUF handle
+i/o to text files directly.
+
+FFAULT makes a binary file appear to be a contiguous array (stream) of
+characters, regardless of the device on which the file is resident, and
+regardless of the block size.  Image i/o and structure i/o depend on the
+buffer management capabilities of FFAULT for efficient i/o.
+
+FFAULT must be able to deal with variable block size devices.  The block
+size is a run time variable, which is device dependent.
+Magtapes and Mem files, for example, have a block size of one char,
+whereas most disks have 256 char blocks (assuming two machine bytes per char).
+
+Image i/o requires that the number and size of the buffers for a file
+be variable, and that asynchronous i/o be possible.  The size of a
+buffer, and the size of the data segment to be read in (normally one
+row in the case of two dimensional imagefiles) need not be the same.
+
+Structure or virtual i/o is based on a global pool of buffers, shared
+amongst all the files currently mapped for virtual i/o.  Each buffer
+in the pool is always linked into the list for the global pool, and is
+also linked into the local list for a file, when containing data from
+that file.  New buffers are allocated from the tail of the global list.
+
+The virtual i/o primitives interface to file i/o via READ and WRITE
+requests on a mapped file.  FFAULT is required to manage the global pool
+properly when faulting on a mapped file.  The number and size of the
+buffers in the global pool are run time variables.
+
+FFAULT calculates the file offset of the new buffer implied by the offset
+argument (note that offset may be BOF or EOF as well as a real offset).
+No actual i/o takes place if the data is already buffered.
+
+
+
+.tp 5
+.nf
+int procedure ffault (fd, char_offset)
+
+fd:		file descriptor number
+char_offset:	desired char offset in file
+
+begin
+	calculate buffer_offset (modulus block size)
+	if (i/o in progress on file fd)
+	    wait for completion (awatio)
+
+	if (buffer is already in local pool)
+	    relink buffer at head of list (frelnk)
+	else {
+	    if (buffer has been written into)
+		flush to file (fflsbf)
+	    relink next buffer at head of lists (frelnk)
+	    set buffer offset for new buffer
+	    fill buffer from file (ffilbf)
+	}
+
+	if (file is being accessed sequentially)
+	    initiate write behind or read ahead
+
+	set iop corresponding to desired char_offset
+	return (status: OK, ERR, or EOF)
+end
+.fi
+
+
+.sh
+Verification of the File Fault Procedure
+
+     The database managed by FFAULT consists of the local and global
+buffer lists, and the file descriptor structure.  The major types of
+file access are (1) sequential read, (2) write at EOF, (3) random
+access, and (4) sequential write not at EOF.  A mode change may occur
+at any time.  In what follows, we follow the logic of FFAULT through
+for these four modes of access, to verify that FFAULT works properly
+in each case.
+
+.tp 4
+.ls 4 Case 1: Sequential Read
+
+FFAULT will detect the sequential nature of the read requests, and will
+begin reading ahead asychronously.  No writing occurs, since the buffer
+is never written into.  If a buffer were to be written into, the subsequent
+write i/o operation would cause read ahead to be interrupted for a time
+(random mode would be asserted temporarily).
+
+.ks
+.nf
+    normally, read ahead will be in progress
+    wait for i/o
+    buffer is now in pool
+    relink buffer at head of lists
+    initiate i/o on next available buffer
+
+    when EOF is detected, buffer is zeroed, EOF is returned
+.fi
+.ke
+.le
+
+.tp 4
+.ls Case 2: Sequential Write at EOF
+
+When writing at EOF, FFAULT will detect the fact that the writes are
+occurring sequentially, and will start flushing the newly filled buffers
+asynchronously.  Read ahead does not occur, since the file is positioned
+at EOF.
+
+.ks
+.nf
+    normally, write behind will be in progress
+    wait for i/o
+    get next buffer (will not need to be flushed, due to
+	automatic write behind)
+    relink buffer at head of lists
+    fill buffer (no actual file access when at EOF)
+    initiate write behind of most recent buffer
+.fi
+.ke
+.le
+
+.tp 4
+.ls Case 3: Random Access
+
+Old buffer is left in pool.  No i/o is done on the old buffer, regardless
+of whether the old buffer has been written into or not (unless there is only
+one buffer in the pool).  The buffer pool serves as a cache, with the buffers
+linked in order of most recent access.  Read ahead and write behind do not
+occur as long as the pattern of access remains random.
+
+.ks
+.nf
+    no i/o in progress
+    buffer not in pool
+    take buffer from tail of list
+    relink buffer at head of lists
+    if (buffer needs to be flushed)
+	flush it, wait for completion
+    fill buffer
+.fi
+.ke
+.le
+
+.tp 4
+.ls Case 4: Sequential Write not at EOF
+
+This mode differs from write at EOF in that read and write i/o operations
+are interspersed.  Since only one i/o operation can be in effect on a
+given file at one time, we cannot both read ahead and write behind.
+Write behind will occur, but reading will not be asynchrounous.
+
+.ks
+.nf
+    wait for i/o
+    buffer not in pool
+    take buffer from tail of list
+    relink buffer at head of lists
+    buffer will not need to be flushed, due to write behind
+    fill buffer, wait for completion
+    initiate write behind of most recent buffer
+.fi
+.ke
+.le
+
+
+
+
+.fi
+In certain circumstances, such as when IMIO overwrites a line of an
+image, where each line is known to be aligned on a block boundary,
+the "fill buffer" operation can be omitted (since it is guaranteed
+that the entire contents of the buffer will be overwritten before the
+buffer is flushed).  The fill buffer operation is disabled via an FSET
+option.  Both access modes 3 and 4 are affected, yielding a factor
+of two reduction in the number of i/o transfers.
+
+
+
+
+.tp 5
+.nf
+procedure ffilbf (fd, bufdes)
+
+fd:	file descriptor number
+bufdes:	buffer descriptor
+
+begin
+	if (at EOF)
+	    return
+	else {
+	    if (io in progress on file fd)
+		call fwatio to wait for completion of transfer
+	    fbseek (fd, bufdes)
+	    aread (fd, Memc[bufptr], buffer_size)
+
+	    set i/o mode word in buffer descriptor
+	    set pointer to active buffer in file descriptor
+	}
+end
+
+
+
+.fi
+The FFLSBF routine is called by FFAULT to actually flush a buffer to
+the file.  Note that if the buffer is at the end of the file, and the
+buffer is only partially full, a partially full block will be written.
+If partial file blocks are not permitted by the underlying system,
+the z-routine must compensate.
+
+
+
+.tp 6
+.nf
+procedure fflsbf (fd, bufdes)
+
+fd:	file descriptor number
+bufdes:	buffer descriptor
+
+begin
+	if (no write permission on file)
+	    take error action
+	if (io in progress on file fd)
+	    call fwatio to wait for completion of transfer
+
+	nchars = max (iop, itop) - bufptr
+	fbseek (fd, bufdes)
+	awrite (fd, Memc[bufptr], nchars)
+
+	set i/o mode word in buffer descriptor
+	set pointer to active buffer in file descriptor
+end
+
+
+
+
+.tp 5
+procedure fwatio (fd)
+
+begin
+	if (i/o mode == NULL)
+	    return
+	nchars = await (fd)
+
+	if (nchars == ERR)
+	    set ERROR bit in status word
+	else {
+	    # set i/o pointers in buffer descriptor
+	    if (i/o mode == READ_IN_PROGRESS)
+		itop = bufptr + nchars
+	    else
+		# don't change itop, data still valid
+	    otop = bufptr
+	    clear i/o mode word in buffer descriptor
+	    clear pointer to active buffer in file descriptor
+	}
+end
+
+
+
+
+.tp 5
+procedure fbseek (fd, bufdes)
+
+begin
+	if (current_offset != buffer_offset)
+	    aseek (fd, buffer_offset)
+end
+
+
+
+
+.fi
+SEEK is used to move the file pointer (offset in a file at which the
+next data transfer will occur).  With text files, one can only seek
+to the start of a line, the position of which must have been determined
+by a prior call to NOTE.  For binary files, SEEK merely sets the logical
+offset within the file.  This will usually cause a file fault when the
+next i/o transfer occurs.  An actual physical seek does not occur until
+the fault occurs.
+
+The logical offset is the character offset in the file at which the next
+i/o transfer will occur.  In general, there is no simple relationship
+between the logical offset and the actual physical offset in the file.
+The physical offset is the file offset at which the next AREAD or AWRITE
+transfer will occur, and is maintained by those routines and by the system.
+The logical offset may be set to any character in a file.  The physical
+offset is always a multiple of the device block size.
+
+The logical offset is defined at all times by the offset of the current
+buffer (buf_offset), and by the offset within the buffer (iop-bufptr).
+The logical offset may take on the special values BOF and EOF.
+Since the offset of the first character in a file is one (1),
+and BOF and EOF are zero or negative, the special offsets are unambiguous.
+
+.rj (logical offset)
+	new iop = offset - buf_offset + bufptr
+
+A logical seek on a binary file is effected merely by setting the in-buffer
+pointer IOP according to the relation shown above.  A macro LSEEK (fd, offset)
+is defined to perform a logical seek with inline code.
+.nf
+
+
+
+.tp 5
+procedure seek (fd, offset)
+
+begin
+	verify that fd is a legal file descriptor of an open file
+	clear any pushback
+
+	# make newly written data readable
+	itop = max (itop, iop)
+
+	if (TEXT_FILE) {
+	    if (buffer has been written into)
+		call zputtx to flush buffer to file
+	    reset iop to beginning of buffer
+	    if (offset is not equal to offset of buffer)
+		call zsektx routine to seek on text file
+	} else
+	    lseek (fd, offset)
+end
+
+
+
+
+.tp 5
+long procedure note (fd)	# note file position for later seek
+
+begin
+	verify that fd is a legal file descriptor of an open file
+
+	if (TEXT_FILE) {
+	    call znottx to get offset into text file
+	    if (a buffer is in use)
+		save offset of buffer in buffer descriptor
+	    return (offset)
+	} else
+	    return (logical offset)
+end
+
+
+
+
+.tp 5
+procedure flush (fd)
+
+begin
+	verify fd: file open with write permission
+
+	if (TEXT_FILE)
+	    if (buffer has been written into) {
+		call zputtx to write out buffer
+		reset buffer pointers
+	    }
+	else
+	    for (each buffer in local pool)
+		if (buffer has been written into)
+		    call fflsbf to flush buffer
+end
+
+
+
+
+.fi
+The asynchronous i/o primitives ZAREAD and ZAWRIT must enforce device block
+boundaries.  Thus, if maxchars is not an integral multiple of the block size,
+the file pointer will nonetheless be advanced to the next block boundary.
+Some files (such as Mem files and magtapes) may have a block size of one char.
+
+Note that memory may be accessed as a "file".  This facility is most often
+used by the formatted i/o routines, to decode and encode character data in
+strings.  On a virtual memory machine, an entire binary file could be mapped
+into memory, then opened with MEMOPEN as a memory resident file (this would
+in effect replaces the FFAULT file faults by hardware page faults).
+
+The calling program is required to call AWAIT after an AREAD or AWRITE call to
+a file, before issuing the next i/o request to that file.  Failure to do so
+causes an error action to be taken.  This is done to ensure that the success
+or failure of the i/o transfer (the status returned by AWAIT) is checked by
+the calling program.
+
+The z-routines ZCALL2 and ZCALL3 are machine dependent routines which
+call the procedure whose entry point address is given as the first argument.
+The numeric suffix N means that the procedure given as the first argument is
+to be called with N arguments, the values of which make up the remaining
+arguments to ZCALL.  The additional machine dependence of this routine
+is thought to be more than justified by the clean, flexible interface
+which it provides between FIO and the various supported devices.
+.nf
+
+
+
+.tp 5
+procedure aread (fd, buffer, maxchars)
+
+begin
+	check that fd is a valid file opened for reading
+	if (i/o is already in progress on file fd)
+	    error: "i/o already in progress"
+	set read_in_progress word in file descriptor
+
+	zcall3 (zaread[fd], channel[fd], buffer, maxchars)
+end
+
+
+
+.fi
+Note that FIO, when it seeks to the end of a file for a buffered binary
+write, actually seeks to the nearest block boundary preceeding the physical
+EOF which is an integral multiple of the file buffer size.  When the file
+buffer fills, it is flushed out, OVERWRITING THE EOF.  This may pose problems
+for the implementor of the ZAWRITE routine on some systems.
+
+
+
+.tp 5
+.nf
+procedure awrite (fd, buffer, maxchars)
+
+begin
+	check that fd is a valid file opened for writing
+	if (i/o is already in progress on file fd)
+	    error: "i/o already in progress"
+	set write_in_progress in i/o mode word in file descriptor
+
+	zcall3 (zawrite[fd], channel[fd], buffer, maxchars)
+end
+
+
+
+
+.tp 5
+int procedure await (fd)
+
+begin
+	verify thaf fd is a legal file descriptor of an open file
+
+	if (bad error code in file descriptor)
+	    set status to ERR
+	else if (no io in progress on file fd)
+	    return (0)
+	else
+	    zcall2 (zawait[fd], channel[fd], status)
+
+	switch (status) {
+	case ERR:
+	    set error code in file descriptor
+	case EOF:
+	    set EOF flag
+	default:
+	    increment file position counter by N file blocks
+	    set nchars_last_transfer in file descriptor
+	}
+
+	clear io_in_progress word in file descriptor
+	return (status)
+end
+
+
+
+
+.tp 5
+procedure aseek (fd, offset)
+
+begin
+	switch (offset) {
+	case BOF:
+	    char_offset = 1
+	    clear at EOF flag
+	case EOF:
+	    if (already at EOF)
+		return
+	    else {
+		zcall2 (zaseek[fd], channel[fd], EOF)
+		current_offset = anote (fd)
+		char_offset = current_offset
+		set at EOF flag
+	    }
+	default:
+	    char_offset = offset
+	    clear at EOF flag
+	}
+
+	# can seek only to the beginning of a device block
+	block_offset = char_offset - mod (char_offset-1, block_size)
+
+	zcall2 (zaseek[fd], channel[fd], block_offset)
+	if (anote(fd) != block_offset)
+	    take error action
+end
+
+
+
+.tp 5
+long procedure anote (fd)
+
+begin
+	zcall2 (zanote[fd], channel[fd], current_offset)
+	return (current_offset)
+end
+.fi
+
+
+
+.sh
+Z-ROUTINES REQUIRED TO INTERFACE TO A BINARY DEVICE
+
+     The interface between FIO and a binary device is defined by a set of
+six so called z-routines.  These routines may be as device and system
+dependent as necessary, provided the standard calling sequences and semantics
+are implemented.
+
+The following z-routines are required for each device serviced by FIO.
+Since only the entry point addresses are given to FIO, the actual names
+are arbitrary, but must be distinct to avoid collisions.  The names shown
+are reserved.
+
+.ks
+.nf
+	zaread	(channel, buffer, maxchars)
+	zawrit	(channel, buffer, maxchars)
+	zawait	(channel, nchars/EOF/ERR)
+	zaseek	(channel, char_offset/BOF/EOF)
+	zanote	(channel, char_offset)
+	zblksz	(channel, device_block_size_in_chars)
+.fi
+.ke
+
+The exact specifications of these routines will be detailed in the system
+interface documentation.
+
+
+The following binary devices are fully supported by the program interface:
+
+
+.ks
+.nf
+		device type			initialization
+
+	regular random access binary files	OPEN
+	the CL interface (STDIN,STDOUT,...)	task startup
+	pipes					CONNECT
+	memory					MEMOPEN
+	magnetic tapes				MTOPEN
+	graphics devices			GOPEN
+.fi
+.ke
+
+
+A new device may be interfaced to FIO at run time with the procedure FIODEV.
+Repetitive calls to FIODEV for the same device are harmless and are
+ignored.  The maximum number of devices that may be interfaced to FIO is set
+when FIO is compiled.  An error action will occur if this number is exceedd.
+
+	fiodev	(zaread, zawrit, zawait, zaseek, zanote, zblksz)
+
+The purpose of FIODEV is to make the entry points of the z-routines for the
+new device known to FIO.  The device table is indexed by the entry point
+address of the ZAREAD procedure, which must therefore be distinct for each
+device.
+
+A default device is associated with a file when the file is opened.
+To specify a device other than the default device requires a call to FSET,
+passing the entry point address of the ZAREAD procedure for the device.
+The device must have been installed with the FIODEV call by the time FSET
+is called to associate the device with a particular file, or an error action
+will result.
+
+
+.sh
+SEMICODE FOR THE FIO INITIALIZATION AND CONTROL PROCEDURES
+
+     Before any i/o can be done on a file, the file must be opened.  The
+standard OPEN procedure may be used to access ordinary files containing either
+text or binary data.  To access a file on one of the special devices, a special
+open procedure must be used (MEMOPEN, MTOPEN, ..).
+
+All file open procedures are alike in that they call the FIO routine
+FGETFD to allocate and initialize (with defaults) a file descriptor.
+Assorted calls to FSET and possibly FIODEV may optionally follow,
+if the default file parameters are not applicable to the device in question.
+
+
+
+
+.ks
+.nf
+		     open                       close
+
+
+
+
+                          fgetfd     frtnfd     flush
+
+
+
+
+       zmapfn  zopen      malloc     mfree                  zclose
+
+
+
+	       Structure of the Initialization Procedures
+.fi
+.ke
+
+
+
+
+.tp 5
+.nf
+int procedure open (file, mode, type)
+
+file:	file name (EOS terminated character string)
+mode:	type of access permission desired
+type:	file type (text or binary)
+
+begin
+	# allocate and initialize file descriptor
+	fd = fgetfd (file, mode, type)
+	if (fd == ERR) {
+	    set error code in file descriptor
+	    return (ERR)
+	}
+
+	# map virtual file name to OS file name
+	zmapfn (file, osfname, SZ_OSFNAME)
+
+	switch (type) {			# open file
+	case TEXT_FILE:
+	    zopntx (osfname, mode, channel[fd])
+	case BINARY_FILE:
+	    zopenb (osfname, mode, channel[fd])
+	default:
+	    set error code in file descriptor
+	    channel[fd] = ERR
+	}
+
+	if (channel[fd] == ERR) {
+	    frtnfd (fd)			# return file descriptor
+	    return (ERR)
+	} else
+	    return (fd)
+end
+
+
+
+.fi
+To conserve resources (file descriptors, buffer space) a file should be
+closed when no longer needed.  Any file buffers that may have been
+created and written into will be flushed before being deallocated.
+
+CLOSE ignores any attempts to close STDIN or CLIN.  Attempts to close
+STDOUT, STDERR, or CLOUT cause the respective output byte stream to be
+flushed, but are otherwise ignored.  An error action results if one
+attempts to close a file which is not open, or if one attempts to close
+a file which was not opened with OPEN.
+.nf
+
+
+
+.tp 5
+procedure close (fd)			# close an opened file
+
+begin
+	if (fd == STDIN || fd = CLIN) {
+	    return
+	} else if (fd == STDOUT || fd == STDERR || fd == CLOUT) {
+	    flush (fd)
+	    return
+	} else if (fd is not a valid file descriptor of an open file) {
+	    take error action
+	} else if (file device is not a standard one)
+	    take error action
+
+	flush (fd)
+	zclose (channel[fd])
+	frtnfd (fd)
+end
+
+
+
+
+
+.tp 5
+int procedure fgetfd (file, mode, type)		# get file descriptor
+
+file:	file name (EOS terminated character string)
+mode:	type of access permission desired
+type:	file type (text or binary)
+
+begin
+	# find an unused file descriptor slot
+	for (fd=FIRST_FD;  fd <= LAST_FD;  fd=fd+1)
+	    if (fdes[fd] == NULL)
+		break
+	if (fd > LAST_FD)
+	    return (ERR)
+
+	# allocate memory for file descriptor proper
+	fdes[fd] = malloc (sizeof_struct_fiodes, TY_CHAR)
+	if (fdes[fd] == NULL)
+	    return (ERR)
+
+	initialize fields of file descriptor to default values
+	return (fd)
+end
+
+
+
+
+.tp 5
+procedure frtnfd (fd)		# return file descriptor and buffers
+
+begin
+	if (fdes[fd] == NULL)
+	    return
+	
+	# deallocate file buffers, if any
+
+	if (file takes its buffers from the global pool) {
+	    if (any buffers were actually ever allocated)
+		decrement reference count of files using global pool
+	    for (each buffer in the local list) {
+		unlink buffer from the local list
+		if (global pool reference count is zero) {
+		    unlink buffer from the global list
+		    return buffer space to the system
+		} else
+		    link at tail of the global list
+	    }
+	} else
+	    for (each buffer in the local list) {
+		unlink buffer from the local list
+		return buffer space to the system
+	    }
+
+	if (push back buffer exists)
+	    return push-back buffer
+	
+	mfree (fdes[fd], TY_CHAR)
+	fdes[fd] = NULL
+end
+.fi
+
+
+.sh
+SETTING AND INSPECTING THE FIO CONTROL PARAMETERS
+
+     Any file may be accessed after specifying only the file name, access
+mode, and file type parameters in the OPEN call.
+Occasionally, however, it is desirable to change the default file control
+parameters, to optimize i/o to the file.  The IMIO and VSIO interfaces,
+for example, control the size, number, and ownership of the FIO file buffers.
+
+
+.ks
+.nf
+		fset (fd, parameter, value)
+	value = fget (fd, parameter)
+.fi
+.ke
+
+
+The FSET procedure is used to set the FIO parameters for a particular file,
+while FGET is used to inspect the values of these parameters.  The special
+value DEFAULT will restore the default value of the indicated parameter.
+The following parameters are defined:
+
+.ls 4
+.ls 15 ADVICE
+This parameter is used to advise FIO on the type of access expected for
+the file.  The legal values are SEQUENTIAL and RANDOM.  Given such advice,
+FIO will set up the buffers for the file using system dependent defaults
+for the buffer types, sizes, and numbers.  ADVICE is more system independent
+than explicit calls to NBUFFERS, BUF_SIZE, and so on.
+.le
+.ls ASYNC_IO
+If enabled (value = YES), and there are two or more buffers in the pool,
+FIO will employ read ahead and early write behind when a sequential pattern
+of i/o is detected.  Specifying NO for this parameter guarantees that
+buffered data will be retained until reuse of a buffer is forced by a fault.
+Note that even if ASYNC_IO is enabled, read ahead and early write behind
+are ONLY used while the pattern of i/o remains sequential.
+.le
+.ls BUF_SIZE
+The size of a file buffer, in chars.  The actual size of the buffer
+created and used by FIO depends on the device block size and may be larger
+than BUF_SIZE, but will not be any smaller.
+.le
+.ls BUF_TYPE
+This parameter may have one of two values, LOCAL or GLOBAL, specifying whether
+a local pool of buffers is to be created, or whether buffers are to be drawn
+from the global pool.
+.le
+.ls FIO_DEVICE
+The value given must be the entry point address of the ZAREAD procedure
+for the desired device.  The device must have been installed in the FIO
+device table by a prior call to FIODEV.
+.le
+.ls FLUSH_NL
+If enabled, the output buffer will be flushed after every line of output text,
+rather than when the buffer fills or when a flush is otherwise forced.
+Useful when the output file is an interactive terminal.
+.le
+.ls GBUF_SIZE
+The size of a buffer in the global pool, in chars.
+The FD parameter is ignored.
+.le
+.ls GNBUFFERS
+The number of file buffers in the global pool.
+The FD parameter is ignored.
+.le
+.ls NBUFFERS
+The number of file buffers in the local pool.
+.le
+.ls PBB_SIZE
+The size of the combined push back buffer and push back control stack area,
+in chars.
+.le
+.le
+
+
+The parameters controlling the size and number of the various buffers
+(ADVICE, NBUFFERS, BUF_SIZE, BUF_TYPE, PBB_SIZE, GNBUFFERS, GBUF_SIZE) must
+be set before i/o causes the affected buffers to be created using the default
+number and size parameters.  Thereafter, FSET calls to change these parameters
+will be ignored.  The values of the other parameters may be changed at any
+time, with the new values taking effect immediately.
+
+.sh
+Example 1:  File access is expected to be highly random.
+
+     The most system independent approach is to call FSET to set the
+ADVICE parameter to RANDOM.
+
+
+.nf
+	include <fio.h>
+	    ...
+
+	fd = open (file, READ_WRITE, BINARY_FILE)
+	if (fd == ERR)
+	    ...
+
+	call fset (fd, ADVICE, RANDOM)
+.fi
+
+.sh
+Example 2:  High speed sequential access is desired
+
+     In this case, the best approach would again be to call FSET to set ADVICE
+to SEQUENTIAL.  To demonstrate use of some of the other parameters, we have
+taken a different approach here.
+
+
+.nf
+	fd = open (file, READ_ONLY, BINARY_FILE)
+	if (fd == ERR)
+	    ...
+
+	call fset (fd, NBUFFERS, 2)
+	call fset (fd, BUF_SIZE, SZ_BLOCK * 16)
+	call fset (fd, ASYNC_IO, YES)
+.fi
+
+
+In practice it will rarely be necessary for the user to call FSET, because
+the facilities provided by VSIO and IMIO (which do call FSET in the manner
+shown) will probably provide the desired i/o capability, without need to
+resort to the comparatively low level facilities provided by FIO.
+Another reason for NOT calling FSET is that the system provided defaults
+may indeed be best for the system on which the software is being run.
+
+The default values selected for the FIO parameters may be tuned to the
+particular system.  At one extreme, for example, we might provide a global
+pool containing only two buffers, each the size of a single disk block.
+By default, all files would share these buffers, and asynchronous i/o
+would be disabled.  This would be the minimum memory configuration.
+At the other extreme, we might allocate two large buffers to each file,
+with asynchronous i/o enabled.
+
+
+.sh
+DETAILS OF THE FIO DATA STRUCTURES
+
+     By this point we have sufficiently detailed information about the
+functioning of FIO to be able to fill in the details of the data
+structures.  The FIO database consists of the MAXFD file descriptors,
+the global buffer pool, the descriptor for the global pool, and the
+device table.  Each file descriptor controls a local list of buffers,
+and possibly a buffer for pushed back data.   A buffer descriptor
+structure is associated with each file buffer.
+
+
+
+.ks
+.nf
+# Static part of file descriptor structures
+
+common fiocom {
+	int	gnbufs			# size of global pool
+	int	gbufsize		# size of global buffer
+	int	gnref			# number of files using gpool
+	struct	bufdes *ghead		# head of the global list
+	struct	bufdes *gtail		# tail of the local list
+	int	ndev			# number of devices
+	int	zdev[SZ_DEVTBL]		# device table
+	char	*iop[MAXFD]		# i/o pointer
+	char	*itop[MAXFD]		# itop for current buffer
+	char	*otop[MAXFD]		# otop for current buffer
+	char	*bufptr[MAXFD]		# pointer to current buffer
+	long	offset[MAXFD]		# offset of the current buffer
+	struct	fiodes *fdes[MAXFD]	# pointer to rest of fd
+	char	osfname[SZ_OSFNAME]	# buffer for OS file names
+}
+.fi
+.ke
+
+
+.ks
+.nf
+# Template for dynamically allocated part of file descriptor
+
+struct fiodes {
+	char	fname[SZ_FNAME]		# file name string
+	int	fmode			# mode of access
+	int	ftype			# type of file
+	int	fchan			# OS file number (channel)
+	int	fdev			# index into device table
+	int	bufsize			# size of a file buffer
+	int	pbbsize			# size of pushback buffer
+	int	nbufs			# number of local buffers
+	int	fflags			# flag bits
+	int	nchars			# size of last transfer
+	int	iomode			# set if i/o in progress
+	int	errcode			# error code
+	long    fpos			# actual file position
+	char	*pbbp			# pointer to pushback buffer
+	char	*pbsp			# pushback stack pointer
+	char	*pbsp0			# pointer to stack elem 0
+	struct	bufdes *iobuf		# buffer i/o being done on
+	struct	bufdes *lhead		# head of local list
+	struct	bufdes *ltail		# tail of local list
+}
+.fi
+.ke
+
+
+.nf
+# flags (saved in fdes[fd].fflags)
+
+	F_ASYNC				# enable async_io
+	F_EOF				# true if at EOF
+	F_ERR				# set when error occurs
+	F_FLUSHNL			# flush after newline
+	F_GLOBAL			# local or global buffers
+	F_RANDOM			# optimize for rand. access
+	F_READ				# read perm on file
+	F_SEQUENTIAL			# optimize for seq. access
+	F_WRITE				# write perm on file
+.fi
+
+
+
+.ks
+.nf
+# Buffer descriptor structure.
+
+struct bufdes {		
+	int	b_fd			# fd to which buffer belongs
+	int	b_iomode		# set when i/o in progress
+	int	b_bufsize		# size of buffer, chars
+	long	b_offset		# offset of buffer in file
+	char	*b_itop			# saved itop
+	char	*b_otop			# saved otop
+	char	*b_bufptr		# pointer to start of buffer
+	struct	bufdes *luplnk		# next buffer up, local list
+	struct	bufdes *ldnlnk		# next buffer down, local list
+	struct	bufdes *guplnk		# next buffer up, global list
+	struct	bufdes *gdnlnk		# next buffer down, global list
+}
+.fi
+.ke
+
+
+.sh
+SEMICODE FOR THE FIO DATABASE ACCESS PROCEDURES
+
+     Routines are required to allocate and deallocate buffers,
+and to link and unlink buffers from the buffer lists.  Now that the
+data structures have been more clearly defined, we shall go into a
+little more detail in the semicode.
+
+
+.ks
+.nf
+	                        fmkbfs
+
+
+
+                                fmklst
+
+
+
+		   flnkhd       fmkbuf       flnktl
+
+
+
+		                malloc
+
+
+
+	      Structure of the Buffer Allocation Procedures
+.fi
+.ke
+
+
+
+The main buffer creation procedure, FMKBFS, is called by either
+FILBUF or FLSBUF when i/o is first done on a file.  FMKLST allocates
+a set of buffers and links them into a doubly linked list.  FLNKHD
+links a buffer at the head of a list, while FLNKTL links a buffer at
+the tail of a list.  FMKBUF calls MALLOC to allocate memory for a file
+buffer, and initializes the descriptor for the buffer.
+
+
+
+
+.tp 5
+.nf
+procedure fmkbfs (fd)
+
+fd:	file descriptor number
+fp:	pointer to file descriptor
+bp:	pointer to buffer descriptor
+
+begin
+	if (use global pool) {
+	    if (no buffers in global pool yet) {
+		gnbufs = fmklst (NULL, gnbufs, gbufsize, GLOBAL)
+		if (gnbufs <= 0)		# can't make buffers
+		    take error action
+	    }
+	    gnref = gnref + 1
+
+	} else {				# create local buffers
+	    adjust bufsize to be an integral number of device blocks
+	    fp = fdes[fd]
+	    fp.nbufs = fmklst (fd, fp.nbufs, bufsize, LOCAL)
+
+	    if (fp.nbufs == 0)			# must be at least one
+		take error action
+	}
+end
+
+
+
+.fi
+Unlink a buffer from whatever lists it is on, relink it at head of the
+local list, and also at head of global list if a mapped file.  Called
+by FFAULT.
+.nf
+
+
+.tp 5
+procedure frelnk (fd, bp) 
+
+fd:	file descriptor number
+bp:	pointer to buffer descriptor
+
+begin
+	# relink buffer at head of the local list for file fd
+	call funlnk (bp, LOCAL)
+	call flnkhd (fd, bp, LOCAL)
+
+	# relink at head of global list, if buffer in global pool
+	if (buffer is linked into the global pool) {
+	    call funlnk (bp, GLOBAL)
+	    call flnkhd (fd, bp, GLOBAL)
+	}
+end
+
+
+
+
+.tp 5
+int procedure fmklst (fd, nbufs, bufsize, list)		# make list
+
+list:	either global or local
+bufdes:	pointer to buffer descriptor
+
+begin
+	for (nb=0;  nb <= nbufs;  nb=nb+1) {
+	    bufdes = fmkbuf (fd, bufsize)
+	    if (bufdes == NULL)
+		break
+	    else if (nb == 1)
+		flnkhd (fd, bufdes, list)
+	    flnktl (fd, bufdes, list)
+	}
+	return (nb)
+end
+
+
+
+
+.tp 5
+int procedure fmkbuf (fd, bufsize)		# make a buffer
+
+begin
+	assert (bufsize > 0 && mod (bufsize, block_size) == 0)
+
+	sizeof_buffer = sizeof (struct bufdes) + bufsize
+	bufdes_pointer = malloc (sizeof_buffer, TY_CHAR)
+	if (bufdes_pointer == NULL)
+	    return (NULL)
+	else {
+	    initialize buffer descriptor
+	    return (bufdes_pointer)
+	}
+end
+
+
+
+
+.tp 5
+procedure flnkhd (fd, bp, list)		# link buf at head of list
+
+fd:	file descriptor number
+bp:	pointer to buffer descriptor
+list:	global or local
+fp:	pointer to file descriptor
+
+begin
+	assert (bp != NULL)
+	assert (list == LOCAL || list == GLOBAL)
+
+	switch (list) {
+	case GLOBAL:
+	    if (buffer not already linked at head of list) {
+		bp.gdnlnk = ghead
+		ghead.guplnk = bp
+		ghead = bp
+	    }
+	case LOCAL:
+	    fp = fdes[fd]
+	    if (buffer not already linked at head of list) {
+		bp.fd = fd
+		bp.ldnlnk = fp.lhead
+		if (fp.lhead != NULL)
+		    fp.lhead.luplnk = bp
+		fp.lhead = bp
+	    }
+	}
+end
+
+
+
+
+.tp 5
+procedure flnktl (fd, bp, list)		# link buf at tail of list
+
+fd:	file descriptor number
+bp:	pointer to buffer descriptor
+list:	global or local
+fp:	pointer to file descriptor
+
+begin
+	assert (bp != NULL)
+	assert (list == LOCAL || list == GLOBAL)
+
+	switch (list) {
+	case GLOBAL:
+	    if (buffer not already linked at tail of list) {
+		bp.guplnk = gtail
+		gtail.gdnlnk = bp
+		gtail = bp
+	    }
+	case LOCAL:
+	    fp = fdes[fd]
+	    if (buffer not already linked at tail of list) {
+		bp.fd = fd
+		bp.luplnk = fp.ltail
+		if (fp.ltail != NULL)
+		    fp.ltail.ldnlnk = bp
+		fp.ltail = bp
+	    }
+	}
+end
+
+
+
+
+.tp 5
+procedure flnkto (fd, bp, to)		# link buf bp after to
+
+bp:	pointer to descriptor of buffer to be linked
+to:	pointer to descriptor of buffer to be linked to
+
+begin
+	bp.ldnlnk = to.ldnlnk
+	bp.luplnk = to
+	to.ldnlnk = bp
+	if (bp.ldnlnk == NULL)
+	    fdes[fd].ltail = bp			# new tail of list
+	else
+	    bp.ldnlnk.luplnk = bp
+end
+
+
+
+
+.tp 5
+procedure funlnk (bp, list)			# unlink from list
+
+bp:	pointer to buffer descriptor
+list:	global or local
+fp:	pointer to file descriptor
+
+begin
+	switch (list) {
+
+	case GLOBAL:
+	    if (buffer is at head of the global list)
+		ghead = bp.gdnlnk
+	    if (buffer is at tail of the global list)
+		gtail = bp.guplnk
+	    if (bp.guplnk != NULL)
+		bp.guplnk.gdnlnk = bp.gdnlnk
+	    if (bp.gdnlnk != NULL)
+		bp.gdnlnk.guplnk = bp.guplnk
+
+	case LOCAL:
+	    fp = fdes[bp.fd]
+	    if (buffer is at head of the local list)
+		fp.lhead = bp.ldnlnk
+	    if (buffer is at tail of the local list)
+		fp.ltail = bp.luplnk
+	    if (bp.luplnk != NULL)
+		bp.luplnk.ldnlnk = bp.ldnlnk
+	    if (bp.ldnlnk != NULL)
+		bp.ldnlnk.luplnk = bp.luplnk
+	}
+end
+.fi
+
+
+.sh
+SEMICODE FOR FFAULT, AGAIN
+
+     The file fault procedure lies at the heart of FIO.  Now that the
+data structures, initialization procedures, and linked list operators are
+clearer, it is time to go back and fill in some of the details in FFAULT.
+
+
+
+.tp 5
+.nf
+int procedure ffault (fd, char_offset)
+
+fd:		file descriptor number
+char_offset:	desired char offset in file
+bp:		pointer to a buffer descriptor
+fp:		pointer to the file descriptor
+
+begin
+	# calculate buffer_offset (modulus file buffer size)
+	buffer_offset = char_offset - mod(char_offset, buffer_size) + 1
+
+	# compute pointers to fd structure, current buffer
+	fp = fdes[fd]
+	bp = fp.lhead
+
+	# update i/o pointers in the buffer descriptor
+	# note writes may have pushed iop beyond original itop
+	itop[fd] = max(itop[fd], iop[fd])
+	if (bp != NULL) {
+	    bp.b_itop = itop[fd]
+	    bp.b_otop = otop[fd]
+	}
+	    
+	# if buffer is found in local pool, relink at head of list.
+	if (ffndbf (fd, buffer_offset, bp) == YES) {
+	    frelnk (fd, bp)
+	    itop[fd] = bp.b_itop
+	    otop[fd] = bp.b_otop
+
+	# this next section of code is invoked whenever a fault
+	# occurs which requires an actual i/o transfer.
+
+	} else {
+	    if (bp.otop != bp.b_bufptr)		# buffer dirty?
+		fflsbf (fd, bp)			# flush buffer
+
+	    frelnk (fd, bp)			# relink at head
+	    bp.b_offset = buffer_offset
+
+	    if (F_READ flag is set) {
+		ffilbf (fd, bp)			# fill buffer
+		fwatio (fd)
+	    } else {
+		bp.b_itop = bp.b_bufptr
+		bp.b_otop = bp.b_bufptr
+	    }
+
+	    # if asynchronous i/o is enabled (only if two or more
+	    # buffers) initiate write behind or read ahead, if 
+	    # fwatio has detected a sequential pattern of i/o.
+
+	    if (ASYNC_IO enabled)
+		switch (io_pattern) {
+		case WSEQ:			# write behind
+		    bufp = bp.ldnlnk
+		    if (bufp != NULL)
+			if (bufp.b_otop != bufp.b_bufptr)
+			    fflsbf (fd, bufp)
+		case RSEQ:			# read ahead
+		    new_buffer_offset = buffer_offset + buffer_size
+		    if (ffndbf (fd, new_buffer_offset, bufp) == YES)
+			# skip read ahead, buffer already in pool
+		    else if (bufp.b_otop == bufp.b_bufptr) {
+			if (bufp.luplnk != fp.lhead) {
+			    funlnk (bufp, LOCAL)
+			    flnkto (bp, bufp, fp.lhead)
+			}
+			if (buffer in global pool) {
+			    funlnk (bufp, GLOBAL)
+			    flnkhd (bufp, GLOBAL)
+			}
+			bufp.b_offset = new_buffer_offset
+			ffilbf (fd, bufp)
+		    }
+		}
+	}
+
+	bufptr[fd] = bp.b_bufptr		# set i/o pointers
+	offset[fd] = buffer_offset
+	lseek (fd, char_offset)
+
+	if (fp.status == ERR)			# check for ERR,EOF
+	    return (ERR)
+	else if (iop[fd] == itop[fd])
+	    return (EOF)
+	else
+	    return (itop[fd] - iop[fd])		# return nchars
+end
+
+
+
+
+# Search for a file buffer.  If found, return buffer pointer in BP,
+# otherwise allocate a buffer from the tail of either the global or
+# local list.
+
+
+.tp 5
+int procedure ffndbf (fd, buffer_offset, bp)
+
+begin
+	# desired buffer may be on the way; wait and see
+	if (read in progress on file fd)
+	    fwatio (fd)
+
+	# search local pool for the buffer
+	for (bp = fp.lhead;  bp != NULL;  bp = bp.ldnlnk)
+	    if (bp.b_offset == buffer_offset)
+		break
+
+	# if buffer already in pool, return buffer pointer,
+	# otherwise use oldest buffer in appropriate list.
+
+	if (bp != NULL)			# buffer found in pool
+	    return (YES)
+	else {				# use buffer at tail of list
+	    if (this file uses global pool) {
+		bp = gtail
+		if (io in progress on this buffer)
+		    fwatio (bp.fd)
+	    } else
+		bp = fp.ltail
+	    return (NO)
+	}
+
+end
+.fi
+
+
+.sh
+SUMMARY OF THE FIO/OS INTERFACE (MACHINE DEPENDENT PRIMITIVES)
+
+     FIO depends on a number of machine dependent primitives.  Many of these
+have been introduced in the semicode.  Other primitives are not involved in
+i/o, and hence have not appeared thus far in the discussion.  Primitives are
+required to map virtual file names into OS file names.
+
+The goal in designing the FIO/OS interface was to make the primitives as
+"primitive" as feasible, rather than to minimize the number of primitives.
+These primitives should be easy to implement on almost any modern minicomputer.
+The ideal target OS will provide asynchronous, random access i/o,
+logical name facilities, multiple directories per task, multitasking and
+intertask communication facilities, and dynamic memory allocation/deallocation
+facilities.
+
+
+.nf
+Text Files
+
+	zopntx	(osfn, access_mode; chan)
+
+	zgettx	(chan, line_buf, maxchars; nchars)
+	zputtx	(chan, line_buf, nchars; nchars)
+	zflstx	(chan)
+	zfsttx	(chan, what; status_info)
+	zclstx	(chan)
+	zsektx	(chan, znotln_offset; status)
+	znottx	(chan; file_offset)
+
+
+Binary File Initialization (one set per device)
+
+	zopnbf	(osfn, access_mode; chan)
+	zfaloc	(osfn, nchars; chan)
+
+
+Binary File I/O primitives (one set per device)
+
+	zaread	(chan, buffer, maxchars, file_offset)
+	zawrit	(chan, buffer, maxchars, file_offset)
+	zawait	(chan; status)
+	zfsttb	(chan, what; status_info)
+	zclsbf	(chan; status)
+
+	standard devices: regular files, inter-task pipes (CL,GIO),
+			  memory, magnetic tapes.
+
+
+Virtual File Name Mapping
+
+	zmapfn	(vfn, osfn, maxch)
+	zabsfn	(vfn, osfn, maxch)
+
+
+File Manipulation, Status, File Protection, Temporary Files
+
+	zacces	(osfn, mode, type; status)
+	zfdele	(osfn; status)
+	zrenam	(from_osfn, to_osfn; status)
+	zfprot	(osfn)
+	zmktmp	(root, temp_file_osfn)
+
+
+Other Dependencies (also used outside of FIO)
+
+	zcallN	(entry_point, arg1, ..., argN)
+	pntr =	malloc	(nelements, data_type)
+	pntr =	calloc	(nelements, data_type)
+		mfree	(pntr, data_type)
+	int =	and	(int, int)
+	int =	or	(int, int)
+	int =	loc	(reference)
+.fi
+
+
+The STATUS returned by the Z-routines may be ERR or a meaningful number,
+such as the channel number or number of characters read or written.
+EOF is signified at this level by a return value of zero for the number
+of characters read (only ZGETTX and ZAREAD read from a file).  There is
+no provision for special error codes or messages at the Z-routine level.
diff --git a/sys/fio/doc/fio.men b/sys/fio/doc/fio.men
new file mode 100644
index 00000000..a0b2ddb6
--- /dev/null
+++ b/sys/fio/doc/fio.men
@@ -0,0 +1,50 @@
+	 access - Determine the type or accessibility of a file
+	  aread - Asynchronous read from a binary file
+	 areadb - Asynchronous read from a binary file in byte units
+	  await - Wait for an asynchronous i/o transfer to complete
+	 awaitb - Wait for i/o, and return status in byte units
+	 awrite - Asynchronous write to a binary file
+	awriteb - Asynchronous write to a binary file in byte units
+	  close - Close a file
+	 delete - Delete a file
+	diropen - Open a directory as a text file
+	 falloc - Preallocate (uninitialized) storage for a file
+	  fcopy - Copy a file
+	 fdevbf - Install a new binary device in the FIO device table
+	 fdevtx - Install a new text device in the FIO device table
+	  finfo - Get directory information for a file
+	  flush - Flush any buffered output to a file
+	 fnextn - Extract the extension field of a filename
+	 fnldir - Extract the logical directory field of a filename
+	 fnroot - Extract the root field of a filename
+	 fntcls - Close unbuffered list
+	fntclsb - Close buffered list
+	 fntgfn - Get next filename from unbuffered list
+	fntgfnb - Get next filename from buffered list
+	fntlenb - Get number of filenames in a buffered list
+	 fntopn - Open an unbuffered filename list
+	fntopnb - Expand template and open a buffered filename list
+	fntrewb - Rewind the list
+	 fopnbf - Open a binary file on a special device
+	 fopntx - Open a text file on a special device
+	 fowner - Get the name of the owner of a file
+      fpathname - Get the full pathname of a file
+	  fseti - Set an integer FIO parameter
+	 fstati - Get the value of an integer FIO parameter
+	 fstatl - Get the value of a long integer FIO parameter
+	 fstats - Get the value of a string valued FIO parameter
+	   getc - Get the next character from a file
+	getline - Get the next line from a text file
+	 mktemp - Make a unique temporary filename
+	   note - Note the long integer position in a file for a later seek
+	   open - Open or create a text or binary file
+	protect - Protect a file from deletion
+	   putc - Put a character to a file
+	  putcc - Put only printable characters to a file
+	putline - Put a line to to a text file
+	   read - Read a binary block of data from a file
+	 rename - Change the name of a file
+	 reopen - Reopen a file on another file descriptor
+	   seek - Set the file offset of the next char to be read or written
+	stropen - Open a character string as a file
+	  write - Write a binary block of data to a file
diff --git a/sys/fio/doc/vfn.hlp b/sys/fio/doc/vfn.hlp
new file mode 100644
index 00000000..d6c20e8b
--- /dev/null
+++ b/sys/fio/doc/vfn.hlp
@@ -0,0 +1,1028 @@
+.help vfn Jul84 "Virtual Filename Mapping"
+.ce
+\fBVirtual Filename Mapping Package\fR
+.ce
+Detailed Design
+.ce
+Doug Tody
+.ce
+July 1984
+.sp 2
+.NH
+Introduction
+
+    This document presents the detailed design of the filename mapping
+code, used by FIO to map virtual filenames (VFN's) to host operating system
+filenames (OSFN's) and back again.  A description of the filename mapping
+algorithm is given in \fIThe Reference Manual for the IRAF System Interface\fR,
+May 1984.  The purpose of this document is more to design the software than
+to document the design, hence much is omitted.  The discussion concentrates
+on those aspects of the problem which were least-understood at the time of
+the design.
+
+.sh
+Primary Functions
+
+.nf
+	map vfn->osfn
+	map osfn->vfn
+.fi
+
+.sh
+Functions for accessing the vfnmap file
+
+.nf
+	open and optionally lock vfnmap file
+	close and unlock vfnmap file
+
+	add entry to vfnmap
+	delete entry from vfnmap
+	lookup entry in vfnmap
+.fi
+
+.sh
+Mapping Functions
+
+.nf
+	extract OSDIR prefix
+	extract LDIR prefix
+	expand LDIR
+	fold subdir into OSDIR
+	encode filename via escape sequence encoding
+	decode encoded filename
+	squeeze filename
+	map filename extension
+.fi
+
+
+.nh
+VFN Virtual Filename Mapping Package
+
+    The VFN package is used to map and unmap virtual filenames and to add and
+delete virtual filenames from the VFN database.  A distinct open operation is
+required for each vfn to be accessed.  Any number of vfn's may be simultaneously
+open for reading, but only \fIone\fR vfn may be opened for writing.
+The mapping file is not physically opened unless the escape sequence encoded
+filename is degenerate.  It is intended that the vfn will be opened for only
+a brief period of time to minimize the amount of time that the mapping file
+is locked.  The mapping file is locked only if the vfn is degenerate and the
+access mode is VFN_WRITE.  The recognized vfn access modes are VFN_READ,
+VFN_WRITE, and VFN_UNMAP (for reading directories).
+
+
+.ks
+.nf
+	vp =	 vfnopen (vfn, mode)
+		vfnclose (vp, update)
+	stat =    vfnmap (vp, osfn)
+	stat =	  vfnadd (vp, osfn)
+	stat =    vfndel (vp, osfn)
+	stat =	vfnunmap (vp, osfn, vfn)
+
+	stat =    fmapfn (vfn, osfn)	[=:vfnopen/RO,vfnmap,vfnclose]
+.fi
+.ke
+
+
+A distinction is made between mapping the filename and opening and closing
+the vfn to permit efficient and secure error recovery.  The mapping file is
+not updated on disk until the physical file operation (create, delete, etc)
+has succeeded.  If the operation fails \fBvfnclose\fR is called with NO_UPDATE
+and the mapping file is not touched.  The the vfn was opened VFN_READ the
+update flag is ignored.  No vfn disk data structures will be modified
+if a vfn is closed with NO_UPDATE set.  If updating is enabled, ".zmd"
+dependency files may be created or deleted, the mapping file may be created,
+deleted, or updated.
+
+The procedure \fBvfnmap\fR returns ERR if the vfn is degenerate but no entry
+could be found in the mapping file, i.e., if the file does not exist.
+A status value of OK does not, however, imply that the file exists.
+\fBVfnadd\fR returns ERR if the vfn is degenerate and an entry already
+exists in the mapping file.  If the status return is OK and the vfn is
+degenerate then a new entry has been added to the mapping file.
+\fBVfndel\fR returns ERR if the vfn is degenerate but no entry
+could be found in the mapping file.  \fIOsfn\fR is returned as a packed string.
+The output buffer should be dimensioned SZ_PATHNAME.
+
+.nh
+Semicode for Selected FIO Procedures
+
+    The RO class procedures call FMAPFN to map the VFN of an existing file
+into an OSFN.  These operations are straightforward since the vfn database
+is not affected.
+
+.ks
+.nf
+	access, fchdir, finfo, fpath, fprot:	RO operations
+	falloc, open/NF, fmkcopy:		RW=ADD procedures
+	delete					RW=DEL procedure
+	rename					RW=DEL+ADD
+.fi
+.ke	
+
+
+.nf
+# FALLOC -- Create a new file and allocate uninitialized storage.  Open/NF and
+# make copy are similar operations hence the semicode is not shown.
+
+procedure falloc (vfn, size)
+
+begin
+	# Map filename and determine if a file already exists with the
+	# same name.
+	vp = vfnopen (vfn, VFN_WRITE)			# LOCK
+	if (vfnadd (vp, osfn) == ERR)
+	    existing_file = yes
+	else {
+	    call zfacss to see if file exists
+	    existing_file = yes if file exists
+	}
+
+	# If file exists and clobber is enabled, try to delete the file.
+	# If filename is degenerate, entry is either already in mapping file
+	# (if file exists), or has been added.
+
+	if (existing_file)
+	    iferr {
+		if (file clobber enabled)
+		    delete file
+		else
+		    error ("falloc would clobber file 'vfn'")
+	    } then {
+		vfnclose (vp, NO_UPDATE)
+		erract (EA_ERROR)
+	    }
+
+	# Allocate the new file and update the filename mapping database.
+
+	call ZFALOC to allocate the file
+	if (failure) {
+	    vfnclose (vp, NO_UPDATE)
+	    error ("cannot allocate file 'vfn'")
+	} else
+	    vfnclose (vp, UPDATE)			# UNLOCK
+end
+
+
+# DELETE -- Delete a file and all subfiles.  A subfile is a file which is
+# logically part of the parent file but which is physically a separate file
+# at the kernel level.  An example is the pixel storage file associated with
+# an image.  Whenever a file is deleted all subfiles must be deleted as well.
+# The subfiles need not reside in the same directory as the main file.
+# Subfile information is maintained in a separate, "invisible" file for each
+# file having subfiles.  The subfile list file has the same vfn as the main
+# file with the extension ".sfl" appended.  If the vfn already had an extension
+# it is retained in the root of the new filename.  For example, the vfn of the
+# subfile list file for "data.db" would be "data.db.sfl".
+
+procedure delete (vfn)
+
+begin
+	# Delete the main file
+	fdelpf (vfn)
+
+	# Delete any subfiles.  Print warning message if a subfile appears
+	# in the list but cannot be deleted.
+	
+	ifnoerr (fd = fsf_open (vfn, READ_ONLY)) {
+	    while (getline (fd, subfilename, SZ_FNAME) != EOF)
+		iferr (fdelpf (subfilename))
+		    call erract (EA_WARN)
+	    close (fd)
+	}
+end
+
+
+# FDELPF -- Delete a single physical file.  Check if the file is protected
+# and do not try to delete the file if it is protected.  If file cannot be
+# deleted, determine why and print appropriate error message, and do not update
+# the mapping file.
+
+procedure fdelpf (vfn)
+
+begin
+	vp = vfnopen (vfn, VFN_WRITE)			# LOCK
+	if (vfndel (vp, osfn) == ERR) {
+	    vfnclose (vp, NO_UPDATE)
+	    error ("attempt to delete a nonexistent file (vfn)")
+	} 
+
+	call ZFPROT to check for file protection
+	if (file is protected) {
+	    vfnclose (vp, NO_UPDATE)
+	    error ("attempt to delete a protected file (vfn)")
+	}
+		
+	call ZFDELE to delete the file
+	if (failure) {
+	    vfnclose (vp, NO_UPDATE)
+	    call ZFACCS to determine if file exists
+	    if (no such file)
+		error ("attempt to delete a nonexistent file (vfn)")
+	    else
+		error ("cannot delete file 'vfn'")
+	}
+
+	vfnclose (vp, UPDATE)				# UNLOCK
+end
+
+
+# RENAME -- Rename a file.  A file may be renamed within a single directory
+# or may be moved to another directory by the rename operation.  Note that
+# we may only have one VFN opened for writing at a time.
+
+procedure rename (oldvfn, newvfn)
+
+begin
+	# Delete old filename from VFN database.
+	vp = vfnopen (oldvfn, VFN_WRITE)
+	if (vfndel (vp, oldosfn) == ERR) {
+	    vfnclose (vp, NO_UPDATE)
+	    error ("attempt to rename a nonexistent file (vfn)")
+	} else
+	    vfnclose (vp, UPDATE)
+
+	# Add new filename to VFN database.
+	vp = vfnopen (newvfn, VFN_WRITE)
+	if (vfnadd (vp, newosfn) == ERR) {
+	    vfnclose (vp, NO_UPDATE)
+	    error ("cannot create new file 'vfn'")
+	} else
+	    vfnclose (vp, UPDATE)
+	
+	# Rename the physical file.
+	call ZFRNAM to rename the file
+
+	# Patch up VFN database if the rename operation fails.  If the rename
+	# fails then most likely the OSFN's were short and no mapping file
+	# access was involved (else we would have had an abort above), but
+	# then the calls cost almost nothing so make them anyhow.
+
+	if (rename fails) {
+	    # Restore old filename.
+	    vp = vfnopen (oldvfn, VFN_WRITE)
+	    vfnadd (vp, oldosfn)
+	    vfnclose (vp, UPDATE)
+
+	    # Delete new filename.
+	    vp = vfnopen (newvfn, VFN_WRITE)
+	    vfndel (vp, newosfn)
+	    vfnclose (vp, UPDATE)
+
+	    error ("cannot rename file (oldvfn -> newvfn)")
+	}
+end
+.fi
+
+.nh
+Locking and Concurrency Considerations
+
+    A locking mechanism is necessary to prevent two or more processes from
+simultaneously modifying a mapping file.  The dimensions of the problem are
+as follows:
+
+.ls
+.ls [1]
+Mutual exclusion must be guaranteed.  The period of time during which a process
+opens and reads the mapping file, modifies it, and updates the file on disk
+is the critical section.  The locking protocol must guarantee that only one
+process can be in the critical section at a time.  A read-only access of the
+mapping file is not a critical section, but we must guarantee that the file
+is not in the process of being written when such a read occurs.
+.le
+.ls [2]
+Deadlock must either be prevented or it must be detected and broken.
+Deadlock will eventually occur if a process is permitted to simultaneously
+access more than one mapping file.  Deadlock will occur if process A locks
+directory D1 and process B locks D2, then B tries to lock D1 and A tries to
+lock D2.
+.le
+.ls [3]
+Lockout will occur if a process dies while in the critical section, thus
+failing to remove the lock.
+.le
+.le
+
+
+On a system which provides file locking, i.e., which forbids a process
+access to a file which is open with write permission by another process,
+the host OS guarantees mutual exclusion and protection from lockout.
+Unfortunately many UNIX systems (and probably some other systems as well)
+do not provide file locking.  The scheme discussed in this section is
+awkward but provides secure locking on such systems.  The file locking
+facilities discussed herein are designed to make use of host system file
+locking if available.  The discussion is oriented towards the problems
+of providing locking on systems which do not provide locking at the kernel
+level, i.e., in \fBzopnbf\fR.
+
+.nh 2
+Mutual Exclusion
+
+    Mutual exclusion can be guaranteed by use of a \fBsemaphore\fR.
+The transportability requirement makes it very difficult to implement a
+general semaphore, but a binary semaphore is possible using a null length
+file in the same directory as the mapping file.  To implement a semaphore
+we must test and set the lock all in the same operation, to prevent
+interleaving of the operations by two processes simultaneously trying to
+set a lock (i.e., process A tests for a lock and finds none, B tests for a
+lock and finds none, A sets a lock, B sets a lock, and mutual exclusion is
+violated).
+
+A suitable binary semaphore can be implemented by \fIdeleting\fR the lock
+file to set the lock, rather than by testing for the lock (no lock file)
+and then creating the lock file to set the lock.  We assume that the delete
+operation will return error for an attempt to delete a nonexistent file.
+Thus if the lock file can be successfully deleted, the lock has been tested
+and found to be absent and the directory has been locked, all in one
+indivisible kernel operation.
+
+
+.ks
+.nf
+	# Gain exclusive access to a file.  The file must have an
+	# associated lockfile which is deleted while a process has
+	# the file locked.
+
+	while (delete (lockfile) == ERR)
+	    ;
+
+
+	# Give up exclusive access to a file.
+	create (lockfile)
+.fi
+.ke
+
+
+The above is a bit simplistic because the file itself may not exist,
+in which case there will be no lockfile, and the process may not have
+delete permission for the lockfile if there is one.  The point here is
+that the OS kernel guarantees that only one process will be allowed
+to successfully delete the lockfile, hence the deletion operation can
+serve to gain exclusive access to a file.  The problem of lockout, wherein
+the lockfile gets lost, is dealt with later.
+
+Locking the directory is necessary whenever the mapping file is to be modified.
+While it is not necessary to lock the directory to read the mapping file,
+by not doing so we run the risk of trying to read while the file is being
+written to (permissible on some systems, an error condition on others).
+The simplest solution to this problem is to lock the file for all accesses,
+including reads as well as writes.  The problem with this approach is that
+it precludes read access on directories for which a process does not have
+write permission (preventing generation of the lock file).  This is not
+acceptable.  Our solution is to include a \fBchecksum\fR in the mapping file.
+If the file exists but cannot be opened for reading and a lock exists on the
+directory, we will wait until the lock is lifted to read the file.  If the
+checksum is in error the read will be repeated until a valid checksum is
+obtained.
+
+.nh 2
+Deadlock
+
+    Deadlock can be avoided by the simple expedient of permitting a process to
+lock only one directory at a time.  The only time a process needs to lock
+more than one directory is when renaming a file with a long, degenerate name
+from one directory to another.  Deadlock is unlikely but would certainly
+occur at infrequent intervals.  Locking only one directory at a time is
+inefficient (because separate references are needed to map the filename
+and to edit the mapping file), but it does not matter since lock file
+accesses are expected to be infrequent (few mapped filenames are degenerate).
+Detection of and breaking of deadlock is possible but not worth the trouble.
+Thus we shall avoid the problem of deadlock entirely by permitting a process
+to lock only a single directory at a time, for only a brief period of time.
+
+.nh 2
+Lockout
+
+    At this point we have a solution which guarantees mutual exclusion and the
+avoidance of deadlock nearly 100% of the time.  The only problem remaining
+is \fBlockout\fR.  It is not possible to prevent lockout since we cannot
+guarantee that a process (or the computer) will not die while in a critical
+section, preventing removal of the lock.
+
+The obvious way to implement automatic recovery from lockout is to add a
+provision for timeout.  While we cannot guarantee that the time spent
+in a critical section will be less than some absolute amount (because of
+variable load conditions, swapping, the time required to delete a very
+large file, etc.), we can say that the time spent in a critical section will
+rarely be larger than some number on the order of one second.  In a worst
+case situation where several processes are heavily accessing a directory
+it could take an arbitrarily long time for a particular process to gain a
+lock on the directory, but this is very unlikely.
+
+If a process times out while waiting we must either abort or proceed to break
+the lock.  This may be done by creating a new lockfile as if the transaction
+had been completed.  There is a hidden bug, however -- if two or
+more processes timeout simultaneously, the following scenario might occur:
+
+
+.kf
+.nf
+	A times out
+	B times out
+	A breaks the lock
+	A enters wait loop and places a new lock,
+	    entering the critical section
+	B breaks the lock set by A
+	B enters wait loop and places a new lock,
+	    entering the critical section
+	[...mutual exclusion is violated...]
+.fi
+.ke
+
+
+No matter how unlikely this scenario might be, it prevents us from using the
+simple technique to break the lock.  Breaking the lock appears to be another
+critical section, so perhaps we can use another semaphore to protect the lock
+(we ignore the complications of checking for write permission on the directory,
+which should be dealt with when the lock is set).
+
+Even if a semaphore is used concurrency
+can still be a problem, as another process may timeout and break the lock
+shortly after the first process has done so; this can happen because the
+section between timeout and the test for permission to break the lock is
+interruptable.  To get around this we apply an additional constraint
+that the lock can only be broken if it has been in place for a specified
+interval of time which is much larger than the timeout interval.  This suffices
+to recover from a process crash and prevents two processes from breaking
+the lock at almost the same time.
+
+
+.ks
+.nf
+	# Try to set a lock on the directory.  If we timeout, try to get
+	# permission to break the lock; only one process is permitted to
+	# break the lock, and the lock can only be broken once in a
+	# specified interval of time.  The timelock files are normally
+	# created whenever the directory is locked.
+
+	repeat {
+	    while (delete (lockfile) == ERR)
+		if (timeout)
+		    if (delete (timelock1) != ERR) {
+			get creation date of timelock2
+			if (timelock2 is an old file) {
+			    create (lockfile)
+			    delete (timelock2); create (timelock2)
+			    create (timelock1)
+			} else
+			    create (timelock1)
+		    }
+	} until (lock is established)
+
+	# Back to normal.
+	carry out transaction
+	create (lockfile)
+.fi
+.ke
+
+
+Lockout is still possible if the process or the computer dies in the interval
+between deletion and creation of timelock1, but the chances of that happening
+are very remote because the interval is short and it only occurs during
+recovery from lockout.  An additional check should perhaps be provided to
+detect this unlikely circumstance and break the lock without further ado
+if timelock1 somehow gets permanently deleted.  The mapping file can be
+checkpointed when this occurs to minimize the risk.
+
+.nh 2
+Rollback
+
+    Unfortunately, automatic lockout detection and recovery brings with it
+the possibility that the lock will be broken when a process takes an abnormally
+long time to complete a transaction.  This might happen when a heavily loaded
+system has begun swapping processes, or when a background job with a
+very low priority accesses a directory.  We must be able to detect that the
+lock has been broken and \fIrollback\fR the transaction, i.e., obtain a new
+lock and try again, repeating the unsuccessful transaction.
+
+Timeouts leading to improper breaking of the lock are not a problem if the
+host system provides file locking for files opened for writing.  After placing
+the lock on a directory a process will open the mapping file with readwrite
+permission and all other processes will be locked out until the transaction
+completes.  Unfortunately file locking is not provided on all systems (e.g.,
+many versions of UNIX do not provide file locking).
+
+Secure protection from a broken lock is difficult because if we check that
+the lock is still in place and then perform the update, another process may
+break the lock immediately after we check that the lock is in place and
+before the update occurs.  About the best we can do is check the creation time
+on timelock2 immediately before updating, updating only if the timelock has
+not been touched since we created it at lock time.  If the lock has been
+broken our timelock file will have been deleted and the transaction must be
+rolled back.  If a lot of time remains on the lock we go ahead and perform
+the update, otherwise a new timelock2 is written, providing a time equal to
+the minimum lifetime of a lock in which to update the file.
+
+
+.ks
+.nf
+	perform transaction upon MFD (in memory)
+
+	# Determine if the lock is still in place and likely to remain
+	# in place until the update is completed.
+
+	repeat {
+	    get creation date of timelock2
+	    if (not the timelock we set at vfn_wait time)
+		rollback transaction
+	    else if (not much time left on lock)
+		rollback transaction
+	    else
+		break
+	}
+
+	# Update and remove the lock.
+
+	update the mapping file
+	close (mapping file)
+
+	get creation date of timelock2
+	if (not our timelock)
+	    bad news: warn user
+
+	create (lockfile)
+.fi
+.ke
+
+.nh 2
+File Locking Facilties
+
+    From the above code fragments it appears that the lockfile approach
+to file locking will work on any machine on which it is an error to delete
+a nonexistent file.  The next step is to encapsulate all this in file
+locking primitives which will use the host OS file locking facilities if
+any, otherwise the lockfile techniques we have developed.  A set of file
+locking primitives are presented below.  These are low level routines
+with fairly restrictive semantics, and are not intended to be used in other
+than system code.
+
+
+.ks
+.nf
+	time =	    osfn_lock (osfn)
+	nsec =	osfn_timeleft (osfn, time)
+	nsec =	  osfn_unlock (osfn, time)
+.fi
+.ke
+
+
+A file is locked with the \fBosfn_lock\fR primitive, which returns when
+it has successfully placed a lock on the file \fIosfn\fR.  The lock is
+guaranteed to remain in place for at least \fItimeout\fR seconds, where
+\fItimeout\fR is a system constant.
+On some systems the file may not actually be locked until it is opened
+with write access.  If the file does not exist or cannot be locked
+\fBerror\fR is called.  If the file is already locked but the lock has
+expired \fBosfn_lock\fR will break the old lock and return when it has
+set a new one.
+
+The primitive \fBosfn_timeleft\fR returns the number of seconds remaining
+on the lock on file \fIosfn\fR.  ERR is returned if the file is no longer
+locked or if the file is currently locked by another user.
+
+A lock is removed with \fBosfn_unlock\fR.  The number of seconds remaining
+on the lock at the time it was removed is returned as the function value.
+ERR is returned if the file was no longer locked or had been locked by
+another user when \fBosfn_unlock\fR was called.
+
+
+.nf
+# OSFN_LOCK -- Lock the named OSFN, i.e., gain exclusive write access
+# to a file.  Only the process gaining the lock on a file may write
+# to it, but there is no guarantee that another process may not read
+# a locked file.  On some systems the file will not actually be locked
+# until it is opened with write permission.  If multiple files exist
+# in a directory with the same root but different extensions, only one
+# can be locked at a time.
+
+long procedure osfn_lock (osfn)
+
+begin
+	# Even if file locking is provided by the OS we must determine
+	# if the file is write protected.  If the file is not write
+	# protected but cannot be opened for writing our caller will
+	# conclude that the file is locked by another process.
+
+	if (file locking is handled by the OS)
+	    if (file osfn is write protected)
+		error ("no write permission on file 'osfn'")
+	    else
+		return (clktime)
+
+	# Generate filenames.
+	basename = osfn minus any extension
+	lockfile  = strpak (basename // ".lok")
+	timelock1 = strpak (basename // ".tl1")
+	timelock2 = strpak (basename // ".tl2")
+
+	# If the lockfile can be deleted (usual case) then we have
+	# little to do.
+	if (delete (lockfile) == OK)
+	    goto setlock_
+
+	# If the lockfile cannot be deleted check that the file itself
+	# exists and that we have delete permission on the directory.
+
+	if (file 'osfn' does not exist)
+	    error ("attempt to lock a nonexistent file (osfn)")
+	if (no delete permission on directory)
+	    error ("cannot delete file (lockfile)")
+
+	# The file exists and all the necessary permissions are granted,
+	# hence someone else has the file locked and we must wait.
+
+	repeat {
+	    for (nsec=0;  nsec < timeout_period;  nsec=nsec+1)
+		if (delete (lockfile) == OK)
+		    goto setlock_
+	    if (delete (timelock1) == OK) {
+		get creation date of timelock2
+		if (timelock2 is an old file or does not exist) {
+		    create (lockfile)
+		    delete (timelock2); create (timelock2)
+		    create (timelock1)
+		} else
+		    create (timelock1)
+	    } else if (continual failure to delete timelock1)
+		create (timelock1)
+	}
+
+setlock_
+	delete (timelock2)
+	create (timelock2)
+
+	return (creation time of timelock2)
+end
+
+
+# OSFN_TIMELEFT -- Determine if a file is still locked, and if so, how
+# much time remains on the lock.  TIME is the time value returned when
+# the file was locked.  All time values are in units of seconds.
+
+int procedure osfn_timeleft (osfn, time)
+
+begin
+	if (file locking is handled by the OS)
+	    return (big number)
+
+	basename  = osfn minus any extension
+	lockfile  = strpak (basename // ".lok")
+	timelock2 = strpak (basename // ".tl2")
+
+	if (lockfile exists)
+	    return (ERR)
+	else if (cannot get file info on timelock2)
+	    return (ERR)
+	else if (timelock2.create_time != time)
+	    return (ERR)
+	else {
+	    timeleft = max (0, timeout_period - (clktime - time)
+	    return (timeleft)
+	}
+end
+
+
+# OSFN_UNLOCK -- Release the lock on a file and return the number of
+# seconds that were left on the lock.  ERR is returned if the file is
+# no longer locked or if the lock is not the one originally placed
+# on the file.
+
+int procedure osfn_unlock (osfn, time)
+
+begin
+	timeleft = osfn_timeleft (osfn, time)
+
+	if (timeleft != ERR) {
+	    basename = osfn minus any extension
+	    lockfile = strpak (basename // ".lok")
+	    create (lockfile)
+	}
+
+	return (timeleft)
+end
+.fi
+
+.nh
+VFN Package Data Structures
+
+    A process may have only a single VFN open with write permission at any
+one time to eliminate the possibility of deadlock (section 4).  Any number
+of VFN's may be open for read-only access, e.g., when recursively descending
+a directory tree.  Most VFN accesses do not involve a reference to a mapping
+file.  Since the mapping file is infrequently referenced, separate descriptors
+are used for the VFN and the mapping file.  The VFN descriptor is called the
+VFD and the mapping file descriptor the MFD.
+
+The MFD is only allocated if a mapping file is referenced, i.e., if the OSFN
+is long.  Before allocating a new MFD we must search the list of open VFN's
+to see if the mapping file has already been opened and assigned a MFD.  Every
+VFN must have its own VFD.  To prevent having to MALLOC a
+VFD every time a filename is mapped, one VFD will always be allocated (after
+the first file reference).  Thus, for a simple filename mapping where the
+OSFN is short, no MALLOC or other kernel calls will be required, i.e., the only
+expense will be the string operations required to map the filename.
+
+
+.ks
+.nf
+# VFN Descriptor
+
+struct vfd {
+	struct	mfd *v_mfd		# ptr to mapping file descr.
+	int	v_acmode		# access mode
+	int	v_len_osdir		# length of v_osdir string
+	int	v_len_root		# length of v_root string
+	int	v_len_extn		# length of v_extn string
+	char	v_vfn[33]		# original VFN, minus LDIR
+	char	v_osdir[33]		# OS directory name
+	char	v_root[33]		# encoded root filename
+	char	v_extn[33]		# encoded and mapped extension
+}
+.fi
+.ke
+
+
+.ks
+.nf
+# Mapping File Descriptor.  The length of the descriptor is adjusted as 
+# necessary to provide storage for the filename pairs.
+
+struct mfd {
+	long	m_locktime		# clktime when lock set
+	int	m_fd			# file descriptor
+	int	m_nfiles		# number of files in map list
+	int	m_lastop		# last operation performed
+	int	m_modified		# was database modified
+	char	m_vfnmap[]		# OSFN of mapping file
+	int	m_checksum		# checksum of m_fnmap
+	char	m_fnmap[nfiles*34*2]	# vfn/osfn pairs
+}
+.fi
+.ke
+
+.nh
+Semicode for Parts of the VFN Package
+
+.nf
+# VFNOPEN -- Open that part of the VFN database associated with a particular
+# VFN.  Allocate VFD descriptor, map but do not squeeze VFN to long OSFN.
+
+pointer procedure vfnopen (vfn, mode)
+
+begin
+	if (first_time) {
+	    permanently allocate a VFD
+	    nvfn_open = 0
+	    first_time = false
+	}
+
+	# Allocate and initialize VFD.
+	if (no VFN's open) {
+	    use preallocated VFD
+	    increment count of open VFN's
+	} else
+	    allocate a new VFD
+
+	call fbrkfn to break VFN into OSDIR, ROOT, and EXTN fields
+
+	return (pointer to VFD)
+end
+
+
+# VFNCLOSE -- Close a VFN and optionally update the VFN database.  An update
+# is performed only if the mapping file is open with write permission,
+# a modify transaction has occurred, and updating is enabled.
+
+procedure vfnclose (vp, update)
+
+begin
+	# If the mapping file was not used or if it was not modified we
+	# just return the buffers and quit.
+
+	mfp = vp.mfp
+	if (mfp == NULL) {
+	    if (nvfn_open > 1)
+		mfree (vp, TY_STRUCT)
+	    return
+	} else if (mfp.m_modified == NO || update == NO_UPDATE) {
+	    mfree (mfp, TY_STRUCT)
+	    if (nvfn_open > 1)
+		mfree (vp, TY_STRUCT)
+	    return
+	}
+
+	# If we get here the mapping file is open with write permission,
+	# a transaction has been performed which modified the database,
+	# and we were called with updating enabled.  Rollback (repeat)
+	# the transaction if the lock has been broken or if there is not
+	# enough time remaining on the lock.
+
+	while (osfn_timeleft (mfp.m_vfnmap, mfp.m_locktime) < xx) {
+	    osfn_unlock (mfp.m_vfnmap, mfp.m_locktime)
+	    switch (mfp.lastop) {
+	    case VFN_ADD:
+		vfnadd (vp, junkstr)
+	    case VFN_DEL:
+		vfndel (vp, junkstr)
+	    }
+	}
+
+	# Update and close the mapping file.
+	compute checksum and store in the mapping file
+	rewrite mapping file to disk
+	close (mapping file)
+
+	if (osfn_unlock (mfp.m_vfnmap, mfp.m_locktime) == ERR)
+	    warn ("broken file protect lock in directory 'vp.v_osdir'")
+
+	mfree (mfp, TY_STRUCT)
+	if (nvfn_open > 1)
+	    mfree (vp, TY_STRUCT)
+end
+
+
+# VFNMAP -- Map and pack the VFN into an OSFN, but do not modify the
+# database.  The mapping file is accessed only if the filename is
+# degenerate.
+
+int procedure vfnmap (vp, osfn)
+
+begin
+	# If the OSFN is short or long but still unique within directory,
+	# then it is not necessary to access the mapping file.
+
+	if (root is longer than permitted by host system) {
+	    squeeze root
+	    if (squeezed root filename is unique within directory) {
+		concatenate and pack osfn
+		return (OK)
+	    }
+	}
+
+	# If we get here then the squeezed filename is degenerate, i.e.,
+	# not unique within the directory.  It is necessary to read the
+	# mapping file to learn what OSFN has been assigned to the file.
+
+	mfp = allocate and init mapping file descriptor
+	mfp.m_vfnmap = strpak (osdir // "zzvfnmap.vfn")
+
+	# Open or create the mapping file.  Create must precede lock
+	# as lock will abort if the file to be locked does not exist.
+	# If opening existing file READ_WRITE, lock first to determine
+	# if we have write perm on file, then keep trying to open file
+	# until open succeeds (if OS level file locking is in use the
+	# open will return ERR as long as another process has the
+	# file open for writing).
+
+	switch (vp.v_acmode) {
+	case VFN_WRITE:
+	    if (no mapping file created yet) {
+		create a new mapping file
+		time = osfn_lock (mfp.m_vfnmap)
+	    } else {
+		time = osfn_lock (mfp.m_vfnmap)
+		repeat {
+		    open mapping file for READ_WRITE access
+		    sleep (1)
+		} until (open succeeds)
+	    }
+	default:
+	    open mapping file for READ_ONLY access
+	}
+
+	# Read mapping file into descriptor.  Increase default size of
+	# descriptor if necessary to read entire file.  Repeat the
+	# read if the checksum is invalid, indicating that a write
+	# was in progress when we read.
+
+	maxch = default buffer size for the filename map
+	repeat {
+	    repeat {
+		read maxch chars into mfp.m_checksum
+		if (nchars_read >= maxch) {
+		    increase size of descriptor
+		    maxch = maxch + increase in storage
+		}
+	    } until (nchars_read < maxch)
+	    compute checksum
+	} until (checksum == mfp.m_checksum)
+
+	if (nchars_read == EOF)
+	    mfp.m_nfiles = 0
+	else
+	    mfp.m_nfiles = max (0, (nchars - SZ_INT) / SZ_FNMAP_PAIR)
+
+	search mfp.m_fnmap for filename vp.vfn
+	if (not found)
+	    status = ERR
+	else {
+	    status = OK
+	    pack osfn to output argument
+	}
+
+	if (access_mode != VFN_WRITE)
+	    close mapping file
+
+	return (status)
+end
+
+
+# VFNADD -- Map a VFN to an OSFN and add an entry for the VFN to the
+# database if the OSFN is degenerate.
+
+procedure vfnadd (vp, osfn)
+
+begin
+	# If VFNMAP does not return ERR then the file already exists.
+	# We return ERR if the file already exists.
+
+	if (vfnmap (vp, osfn) != ERR)
+	    return (ERR)
+	else if (short osfn)
+	    return (OK)
+
+	if (osfn is degenerate) {
+	    generate a unique new_osfn
+	    create degeneracy flag file osfn // ".zmd"
+	    osfn = strpak (new_osfn)
+	}
+
+	add vfn,osfn pair to vp.mfp.m_fnmap
+	mfp.m_lastop = VFN_ADD
+
+	return (OK)
+end
+
+
+# VFNDEL -- Map a VFN to an OSFN and delete the entry for the VFN from
+# the database if the OSFN is degenerate.  Do not delete the degeneracy
+# flag file if no longer degenerate, because even though the OSFN is
+# no longer degenerate the OSFN reflects the former degeneracy of the
+# file, and we do not want to rename the file.
+
+procedure vfnadd (vp, osfn)
+
+begin
+	# If VFNMAP returns ERR then the file does not exist.
+	# We return ERR if the file does not exist.
+
+	if (vfnmap (vp, osfn) == ERR)
+	    return (ERR)
+	else if (short osfn)
+	    return (OK)
+
+	delete vfn,osfn pair to vp.mfp.m_fnmap
+	mfp.m_lastop = VFN_DEL
+
+	return (OK)
+end
+
+
+# FBRKFN -- Transform a VFN into an OSDIR, an escape sequence encoded and
+# extension mapped root OS filename ROOT, and an extension EXTN.  The root
+# may be longer than permitted by the host OS, i.e., squeezing is not done
+# here.
+
+procedure fbrkfn (vfn, osdir, lenosdir, root, lenroot, extn, lenextn)
+
+begin
+	# If the VFN begins with an OSDIR prefix it is assumed to be an OSFN
+	# and no mapping is performed.
+
+	call ZFXDIR to extract osdir prefix, if any
+	if (osdir prefix found) {
+	    copy remainder of vfn to root
+	    return
+	}
+
+	osdir = null_string
+	root = null_string
+	extn = null_string
+
+	# Process the directory and filename fields.  In the case of a simple
+	# filename the first pass performs the escape sequence encoding of the
+	# filename directly into root, and we return after possibly mapping
+	# the extension.
+
+	repeat {
+	    extract next field into root and extn with escape sequence encoding
+	    if (delimiter == '$')
+		if (osdir == null_string) {
+		    osdir = recursively expand ldir
+		    if (ldir not found)
+			error ("logical directory 'ldir' not found")
+		} else
+		    error ("illegal $ delimiter in filename 'vfn'")
+	    } else if (delimiter == '/')
+		fold field, a subdirectory, into osdir
+	} until (delimiter == EOS)
+
+	# At this point we have osdir, root, and extn strings, any of which may
+	# be null.  If more than one "." delimited extn string was encountered
+	# during escape sequence encoding, or if the maximum extn length was
+	# exceedd, then that extn will already have been incorporated into the
+	# root.
+
+	if (extn != null_string)
+	    map filename extension
+end
diff --git a/sys/fio/falloc.x b/sys/fio/falloc.x
new file mode 100644
index 00000000..c84ef000
--- /dev/null
+++ b/sys/fio/falloc.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<syserr.h>
+include	<error.h>
+include	<config.h>
+include	<fio.h>
+
+# FALLOC -- Create a binary file of a given size, and open as a binary file
+# with read write permission.  Interrupts are disabled while the VFN database
+# is open to protect the database, ensure that that the lock on the mapping
+# file is cleared, and to ensure that the mapping file is closed.
+
+procedure falloc (fname, file_size)
+
+char	fname[ARB]			# virtual file name
+long	file_size			# file size in chars
+
+int	status, junk
+pointer	vp
+
+int	vfnadd()
+pointer	vfnopen()
+bool	fnullfile()
+errchk	fclobber
+include	<fio.com>
+
+define	close_ 91
+define	abort_ 92
+
+begin
+	# The null file "dev$null" is a special case; ignore attempts to
+	# create this file.
+
+	if (fnullfile (fname))
+	    return
+
+	# Perform clobber checking, delete old file if one exists.
+	# Note that this must be done before opening the new VFN for
+	# writing or deadlock on the VFN database may occur.
+
+	call fclobber (fname)
+
+	# Add new VFN and get the OSFN of the new file.
+	# Allocate the file and update VFN database.
+
+	call intr_disable()
+	iferr (vp = vfnopen (fname, VFN_WRITE))
+	    goto abort_
+	iferr (junk = vfnadd (vp, pathname, SZ_PATHNAME))
+	    goto close_
+
+	call zfaloc (pathname, file_size * SZB_CHAR, status)
+	if (status == ERR) {
+	    iferr (call filerr (fname, SYS_FALLOC))
+		goto close_
+	} else
+	    iferr (call vfnclose (vp, VFN_UPDATE))
+		goto abort_
+
+	call intr_enable()
+	return
+
+
+	# Error recovery nasties.
+close_
+	iferr (call vfnclose (vp, VFN_NOUPDATE))
+	    ;
+abort_
+	call intr_enable()
+	call erract (EA_ERROR)
+end
diff --git a/sys/fio/fcache.x b/sys/fio/fcache.x
new file mode 100644
index 00000000..c5dc3f11
--- /dev/null
+++ b/sys/fio/fcache.x
@@ -0,0 +1,733 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<mach.h>
+include	<finfo.h>
+include	<diropen.h>
+include	<fset.h>
+include	<knet.h>
+
+
+#  FCACHE -- Simple file caching interface.  Our purpose is to take as
+#  input a URL string and return a unique name for a local disk file.
+#  The format of the name is of the form
+#
+#	cache$urlXXXXXX[.extn]
+#
+#  where 'cache' is a logical directory for the stored file, and the XXXXXXX
+#  is the computed 32-bit checksum of the input URL string.  To provide a 
+#  backward mapping of the filename in the cache to the original URL, a
+#  file of the same name prefixed with a "." (e.g. "cache$.urlXXXX") will be
+#  created containing the URL string.  This file may also be checked to 
+#  avoid collisions of names in rare cases where multiple checksums may be
+#  the same for different URLs.  
+#
+#  The 'cache' environment variables is used to define the location of the
+#  cache directory.  When creating a cache filename, the caller may choose 
+#  to append an extension to the file if it determines this is appropriate 
+#  for the type of file accessed.  In this case, the dot-file will remain as
+#  just the root part of the name.
+#
+#  This interface is intentionally simple so that it may be shared with host
+#  applications that also require a cache.
+#
+#
+#	fcinit  (cache, pattern)
+#      fcpurge  (cache, verbose, age)
+#    fcdestroy  (cache, verbose)
+#
+#	fclist  (cache, verbose, fd)
+#     fclookup  (cache, src, cfname, extn, maxch)
+#
+#     fcaccess  (cache, inname, extn)
+#        fcadd  (cache, inname, cfname, maxch)
+#     fcdelete  (cache, fname)
+#       fcwait  (cache, fname, timeout)
+#
+#	fcname  (cache, in, root, out, maxch)
+#        fcsrc  (cache, in, out, maxch)
+
+
+
+# FCINIT -- Initialize the file cache, i.e. delete all contents that contain
+# the pattern substring (or all files if no pattern is specified).
+
+procedure fcinit (cache, pattern)
+
+char	cache[ARB]				#i cache dir to initialize
+char	pattern[ARB]				#i filename substring pattern
+
+int	dir, len
+char	cfname[SZ_PATHNAME], fname[SZ_LINE], dirname[SZ_PATHNAME]
+char	patbuf[SZ_LINE]
+
+int	access(), strlen(), diropen(), isdirectory(), getline()
+int	patmatch(), patmake()
+errchk	delete()
+
+begin
+	# Simply create the directory if it doesn't exist.
+	if (access (cache, 0, 0) == NO) {
+	    call fmkdir (cache)
+	    return
+
+	} else if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	    call syserr (SYS_FOPENDIR)
+
+
+	if (patmake (pattern, patbuf, SZ_LINE) == ERR)
+	    call error (1, "Pattern is too complex")
+
+
+	# Otherwise, read through the directory and remove the contents.
+	dir = diropen (dirname, PASS_HIDDEN_FILES)
+
+	while (getline (dir, fname) != EOF) {
+	    len = strlen (fname)
+	    fname[len] = '\0'
+
+	    call sprintf (cfname, SZ_PATHNAME, "%s/%s")
+		call pargstr (cache)
+		call pargstr (fname)
+
+	    # We only delete plain files, skip directories.
+	    if (isdirectory (cfname, dirname, SZ_PATHNAME) > 0)
+		next
+
+	    if (patmatch (fname, patbuf) > 0) {
+	        iferr (call delete (cfname))	# delete the file, ignore errors
+		    ;
+	    }
+	}
+
+	call close (dir)			# clean up
+end
+
+
+# FCPURGE -- Clean out a cache of file older than the given age.
+
+procedure fcpurge (cache, verbose, age)
+
+char	cache[ARB]				#i cache dir to initialize
+bool	verbose					#i print verbose output?
+int	age					#i age (in days)
+
+int	dir, len
+long	info[LEN_FINFO], old
+char	cfname[SZ_FNAME], fname[SZ_LINE], dirname[SZ_PATHNAME]
+
+int	access(), strlen(), diropen(), isdirectory(), getline(), finfo()
+long	clktime()
+
+begin
+	# Simply return if it doesn't exist.
+	if (access (cache, 0, 0) == NO)
+	    return
+
+	if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	    call syserr (SYS_FOPENDIR)
+
+	# Otherwise, read through the directory and delete old files.
+	dir = diropen (dirname, SKIP_HIDDEN_FILES)
+
+	old = (clktime (0) - age * 86400)	# expiration time
+	while (getline (dir, fname) != EOF) {
+	    len = strlen (fname)
+	    fname[len] = '\0'
+
+	    call sprintf (cfname, SZ_PATHNAME, "%s/%s")
+		call pargstr (cache)
+		call pargstr (fname)
+
+	    # Skip directories.
+	    if (isdirectory (cfname, dirname, SZ_FNAME) > 0)
+		next
+
+	    if (finfo (cfname, info) == ERR)
+		next
+
+	    if (FI_CTIME(info) < old) {
+		if (verbose) {
+		    call eprintf ("Purging '%s'\n")
+			call pargstr (fname)
+		}
+	        call fcdelete (cache, fname)	# delete the file
+	    }
+	}
+
+	call close (dir)			# clean up
+end
+
+
+# FCDESTROY -- Destroy the named cache directory.
+
+procedure fcdestroy (cache, verbose)
+
+char	cache[ARB]				#i cache dir to initialize
+bool	verbose					#i print verbose output
+
+int	dir, len
+char	cfname[SZ_FNAME], fname[SZ_LINE], dirname[SZ_PATHNAME]
+
+int	access(), strlen(), diropen(), isdirectory(), getline()
+
+begin
+	# Simply return if it doesn't exist.
+	if (access (cache, 0, 0) == NO)
+	    return 
+
+	if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	    call syserr (SYS_FOPENDIR)
+
+	# Otherwise, read through the directory and delete old files.
+	dir = diropen (dirname, PASS_HIDDEN_FILES)
+
+	while (getline (dir, fname) != EOF) {
+	    len = strlen (fname)
+	    fname[len] = '\0'
+
+	    call sprintf (cfname, SZ_PATHNAME, "%s/%s")
+		call pargstr (cache)
+		call pargstr (fname)
+
+	    # Skip directories.
+	    if (isdirectory (cfname, dirname, SZ_FNAME) > 0 || fname[1] != '.')
+		next
+
+	    if (verbose) {
+		call eprintf ("Purging '%s'\n")
+		    call pargstr (fname[2])
+	    }
+	    call fcdelete (cache, fname[2])	# delete the file
+	}
+	call close (dir)			# clean up
+
+	call frmdir (cache)			# delete the cache directory
+end
+
+
+# FCLIST -- List info about the cache to the given descriptor.
+
+procedure fclist (cache, verbose, fd)
+
+char	cache[ARB]				#i cache dir to initialize
+bool	verbose					#i verbose output
+int	fd					#i output file descriptor
+
+int	dir, len, age
+char	cfname[SZ_FNAME], fname[SZ_LINE], dirname[SZ_PATHNAME]
+char	src[SZ_LINE], date[SZ_LINE]
+long	file_info[LEN_FINFO]
+
+int	access(), strlen(), diropen(), isdirectory(), getline(), finfo()
+bool 	streq()
+long	clktime()
+
+begin
+	# Simply return if it doesn't exist.
+	if (access (cache, 0, 0) == NO) {
+	    call fmkdir (cache)
+	    return
+	} else if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	    call syserr (SYS_FOPENDIR)
+
+	# Otherwise, read through the directory and remove the contents.
+	dir = diropen (dirname, PASS_HIDDEN_FILES)
+
+	while (getline (dir, fname) != EOF) {
+	    len = strlen (fname)
+	    fname[len] = '\0'
+	    
+	    # We only delete plain files, skip directories.
+	    if (streq (fname, ".") || streq (fname, "..") || fname[1] != '.')
+		next
+
+	    ifnoerr (call fcsrc (cache, fname, src, SZ_LINE)) {
+		call sprintf (cfname, SZ_FNAME, "%s/%s")
+		    call pargstr (cache)
+		    call pargstr (fname)
+		if (finfo (cfname, file_info) != ERR) 
+		    call cnvdate (FI_CTIME(file_info), date, SZ_LINE)
+		else
+		    call strcpy (" ", date, SZ_LINE)
+		age = (clktime(0) - FI_CTIME(file_info) + 86400) / 86400
+
+		if (verbose) {
+	            call fprintf (fd, "%16s  %s  %s\n")
+		        call pargstr (fname[2])
+		        call pargstr (date)
+		        call pargstr (src)
+		} else {
+	            call fprintf (fd, "%16s  %d  %s\n")
+		        call pargstr (fname[2])
+		        call pargi (age)
+		        call pargstr (src)
+		}
+	    }
+	}
+end
+
+
+# FCLOOKUP -- Lookup the src string and return the cached filename. If a
+# filename in the cache is specified, return the src string.  Both strings
+# must be at least 'maxch' chars long.
+
+procedure fclookup (cache, src, cfname, extn, maxch)
+
+char	cache[ARB]				#i cache dir to initialize
+char	src[ARB]				#i lookup string
+char	cfname[ARB]				#i cached filename
+char	extn[ARB]				#i filename extension
+int	maxch					#i output file descriptor
+
+int	dir, len
+char	dirname[SZ_PATHNAME], fname[SZ_LINE], csrc[SZ_LINE]
+
+int	diropen(), getline(), strlen(), isdirectory(), access ()
+bool	streq()
+
+begin
+	if (access (cache, 0, 0) == YES) {
+	    if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	        call syserr (SYS_FOPENDIR)
+	} else {
+	    call aclrc (cfname, SZ_FNAME)
+	    return
+	}
+
+	if (src[1] != EOS) {
+	    call fcname (cache, src, "f", cfname, maxch)
+
+	    dir = diropen (dirname, PASS_HIDDEN_FILES)
+	    while (getline (dir, fname) != EOF) {
+	        len = strlen (fname)
+	        fname[len] = '\0'
+
+	        # We only delete plain files, skip directories.
+	        if (streq(fname, ".") || streq(fname, "..") || fname[1] != '.')
+		    next
+
+	        ifnoerr (call fcsrc (cache, fname, csrc, SZ_LINE)) {
+		    if (streq (src, csrc)) {
+		        call strcpy (fname[2], cfname, maxch)
+	    		call close (dir)
+
+			# Look for the extension.
+			call fc_find_extn (cache, cfname, extn, maxch)
+			return
+		    }
+	        }
+	    }
+	    call close (dir)
+
+	} else if (cfname[1] != EOS)
+	    call fcsrc (cache, cfname, src, SZ_LINE)
+end
+
+
+# FCACCESS -- See if a file is already in the cache.  For best results, the 
+# input file name should include the full directory path name.
+
+bool procedure fcaccess (cache, inname, extn)
+
+char	cache[ARB]				#i cache dir to initialize
+char	inname[ARB]				#i input file name
+char	extn[ARB]				#i file extension
+
+char	cname[SZ_PATHNAME], root[SZ_PATHNAME]
+char	extfile[SZ_PATHNAME], lext[SZ_PATHNAME]
+bool	stat
+
+int	access(), fnroot()
+
+begin
+	# No cache, no file....
+	if (access (cache, 0, 0) == NO)
+	    return (FALSE)
+
+	# Get the cache filename.
+	call fcname (cache, inname, "f", cname, SZ_PATHNAME)
+	call aclrc (lext, SZ_PATHNAME)
+	if (extn[1] != EOS) {
+	    if (fnroot (cname, root, SZ_PATHNAME) > 0)
+	        call fc_find_extn (cache, root, lext, SZ_PATHNAME)
+	}
+
+	call sprintf (extfile, SZ_PATHNAME, "%s.%s")
+	    call pargstr (cname)
+	    call pargstr (lext)
+
+        stat = (access (cname, 0, 0) == YES || access (extfile, 0, 0) == YES)
+        return (stat)
+end
+
+
+# FCADD -- Add a new file to the cache.  This is a wrapper around copying
+# the file and returning the cached name.  For best results, the input file
+# name should include the full directory path name.
+
+procedure fcadd (cache, inname, extn, cname, maxch)
+
+char	cache[ARB]				#i cache dir to initialize
+char	inname[ARB]				#i input file name
+char	extn[ARB]				#i file extension
+char	cname[ARB]				#o cached filename
+int	maxch					#i size of output file name
+
+char	fname[SZ_PATHNAME], imname[SZ_PATHNAME]
+char	dotfile[SZ_PATHNAME]
+int	retcode, status
+
+int	access(), strncmp(), url_get(), url_errcode(), fnroot()
+bool	fcaccess()
+
+errchk	url_get(), delete()
+
+begin
+	if (access (cache, 0, 0) == NO)
+	    call fmkdir (cache)
+
+	# Get the cache filename.
+	call fcname (cache, inname, "f", cname, maxch)
+
+	if (access (cname, 0, 0) == YES) {
+#	    iferr (call delete (cname))		# delete the file, ignore errors
+#	        ;
+	    return
+	}
+
+
+	if (extn[1] != EOS) {
+	    call sprintf (fname, SZ_PATHNAME, "%s.%s")
+	        call pargstr (cname)
+	        call pargstr (extn)
+	    if (access (fname, 0, 0) == YES) {
+	        iferr (call delete (fname))	# delete the file, ignore errors
+	            ;
+	    }
+	} else
+	    call strcpy (cname, fname, SZ_PATHNAME)
+
+
+	if (strncmp ("http://", inname, 7) == 0) {
+	    if (! fcaccess (cache, inname, "")) {
+	        retcode = url_get (inname, fname, NULL)
+		if (retcode < 0) {
+		    status = fnroot (cname, fname, maxch)
+		    call sprintf (dotfile, SZ_PATHNAME, "%s/.%s")
+			call pargstr (cache)
+			call pargstr (fname)
+	            call delete (dotfile)	# delete the dot file
+		    call filerr (inname, url_errcode (-retcode))
+		    return
+		}
+
+	        # Create a symlink to the file that can be used as an image ref.
+	        call sprintf (imname, SZ_PATHNAME, "%s.fits")
+	            call pargstr (fname)
+	        call fsymlink (imname, fname)
+	    }
+
+	    if (extn[1] != EOS)
+		call strcpy (fname, cname, maxch)
+
+	} else if (strncmp ("file://localhost", inname, 16) == 0) {
+	    iferr (call fcopy (inname[16], fname))
+	        call syserr (SYS_FMKCOPY)
+	    call strcpy (fname, cname, maxch)
+
+	} else if (strncmp ("file://localhost", inname, 17) == 0) {
+	    iferr (call fcopy (inname[18], fname))
+	        call syserr (SYS_FMKCOPY)
+	    call strcpy (fname, cname, maxch)
+
+	} else if (strncmp ("file://", inname, 7) == 0) {
+	    iferr (call fcopy (inname[7], fname))
+	        call syserr (SYS_FMKCOPY)
+	    call strcpy (fname, cname, maxch)
+
+	} else {
+	    iferr (call fcopy (inname, fname))
+	        call syserr (SYS_FMKCOPY)
+	    call strcpy (fname, cname, maxch)
+	}
+end
+
+
+# FCDELETE -- Delete a named file from the cache.
+
+procedure fcdelete (cache, fname)
+
+char	cache[ARB]				#i cache dir to initialize
+char	fname[ARB]				#i cache filename to delete
+
+int	dir, len
+char	cfname[SZ_FNAME], dfname[SZ_LINE], dotfile[SZ_FNAME]
+char	dirname[SZ_FNAME]
+
+int	access(), diropen(), strlen(), strsearch(), getline(), isdirectory()
+
+errchk	delete()
+
+begin
+	if (access (cache, 0, 0) == NO) {
+	    return
+	} else if (isdirectory (cache, dirname, SZ_PATHNAME) == 0)
+	    call syserr (SYS_FOPENDIR)
+
+
+	call sprintf (cfname, SZ_FNAME, "%s%s")
+	    call pargstr (cache)
+	    call pargstr (fname)
+	call sprintf (dotfile, SZ_FNAME, "%s.%s")
+	    call pargstr (cache)
+	    call pargstr (fname)
+
+
+	if (access (cfname, 0, 0) == YES) {
+	    iferr (call delete (cfname))
+		;
+	}
+	if (access (dotfile, 0, 0) == YES) {
+	    iferr (call delete (dotfile))
+		;
+	}
+
+	# Loop through any other files in the directory that begin with
+	# the requested file.  This removes the links created that may
+	# contain file-type specific extensions.
+
+	dir = diropen (dirname, SKIP_HIDDEN_FILES)
+	while (getline (dir, dfname) != EOF) {
+	    len = strlen (dfname)
+	    dfname[len] = '\0'
+
+	    call sprintf (cfname, SZ_FNAME, "%s/%s")
+	        call pargstr (cache)
+	        call pargstr (dfname)
+
+	    if (strsearch (dfname, fname) > 0) {
+	    	iferr (call deletefg (cfname, YES, YES))
+		    call funlink (cfname)
+	    }
+	}
+	call close (dir)
+end
+
+
+# FCWAIT -- Wait for the named file to appear in the cache.
+
+int procedure fcwait (cache, fname)
+
+char	cache[ARB]				#i cache dir to initialize
+char	fname[ARB]				#i cache filename to wait for
+
+char	cfname[SZ_FNAME], errfile[SZ_FNAME], lockfile[SZ_FNAME]
+char	root[SZ_FNAME], extn[SZ_FNAME]
+
+int	access(), fnroot(), fnextn()
+
+begin
+	if (access (cache, 0, 0) == NO)
+	    call fmkdir (cache)
+
+	if (fnroot (fname, root, SZ_FNAME) == 0)
+	    return
+	if (fnextn (fname, extn, SZ_FNAME) == 0)
+	    ;
+
+	call sprintf (cfname, SZ_FNAME, "%s%s")
+	    call pargstr (cache)
+	    call pargstr (root)
+	if (extn[1] != EOS) {
+	    call strcat (".", cfname, SZ_PATHNAME)
+	    call strcat (extn, cfname, SZ_PATHNAME)
+	}
+	call sprintf (errfile, SZ_FNAME, "%s.%s.ERR")
+	    call pargstr (cache)
+	    call pargstr (root)
+	call sprintf (lockfile, SZ_FNAME, "%s.%s.LOCK")
+	    call pargstr (cache)
+	    call pargstr (root)
+
+
+	# Even if we've asked to pre-fetch the data, we want to avoid 
+	# having to do any process synchronization with the threads
+	# downloading the data.  So, block until the requested file is
+	# available, or we get a file with a ".ERR" extension that 
+	# indicates an error.
+
+	if (access (cfname, 0, 0) == NO || access (lockfile,0,0) == YES) {
+	    while (access (cfname,0,0) == NO || access (lockfile,0,0) == YES) {
+		if (access (errfile, 0, 0) == YES)
+		    return (0)
+		call tsleep (1)
+	    }
+	}
+	return (access (cfname, 0, 0))
+end
+
+
+# FCNAME -- Convert an input filename/string/url/whatever to a unique
+# filename in the cache.  
+
+procedure fcname (cache, in, root, out, maxch)
+
+char	cache[ARB]				#i cache directory
+char	in[ARB]					#i input string/name
+char	root[ARB]				#i cache name root
+char	out[ARB]				#o output cache filename
+int	maxch					#i max size of filename
+
+char	dotfile[SZ_PATHNAME], line[SZ_LINE]
+int	fd, len, sum
+
+int	strsum(), strlen(), getline(), access(), filopn()
+bool	streq()
+
+extern  zopntx(), zgettx()
+errchk	filopn
+
+begin
+	if (access (cache, 0, 0) == NO)
+	    call fmkdir (cache)
+
+	# Initialize the output string, trash any newlines in the string.
+	call aclrc (out, maxch)
+	len = strlen (in)
+	if (in[len] == '\n')
+	    in[len] = EOS
+
+	# Compute the string checksum.
+	sum = strsum (in, len, SZ_LINE)
+
+	# Format the dotfile name string.
+	call sprintf (dotfile, SZ_PATHNAME, "%s.%s%d")
+	    call pargstr (cache)
+	    call pargstr (root)
+	    call pargi (sum)
+
+	# Format the name string.
+	call sprintf (out, maxch, "%s%s%d")
+	    call pargstr (cache)
+	    call pargstr (root)
+	    call pargi (sum)
+
+	# Check to see if the file already exists.
+	if (access (dotfile, 0, 0) == YES) {
+	    fd = filopn (dotfile, READ_ONLY, TEXT_FILE, zopntx, zgettx)
+	    if (getline (fd, line) != EOF) {
+		len = strlen (line)
+		line[len] = '\0'		# kill newline
+	        call close (fd)
+		if (streq (in, line))  	# file exists and is current
+		    return
+
+	 	else {
+		    # FIXME -- what to do ????
+		    ;
+		}
+	    }
+	    call close (fd)
+
+	} else {
+	    # File doesn't exist so the name is unique.  Write the src string.
+	    fd = filopn (dotfile, NEW_FILE, TEXT_FILE, zopntx, zgettx)
+	    call fprintf (fd, "%s\n")
+		call pargstr (in)
+	    call close (fd)
+	}
+end
+
+
+# FCSRC -- Return the source string for the named cache file.
+
+procedure fcsrc (cache, in, out, maxch)
+
+char	cache[ARB]				#i cache directory
+char	in[ARB]					#i cache file name
+char	out[ARB]				#o source string
+int	maxch					#i size of output string
+
+int	fd, len
+char	dotfile[SZ_PATHNAME], cfname[SZ_PATHNAME]
+char	dirname[SZ_PATHNAME], root[SZ_FNAME], line[SZ_LINE]
+
+int	access(), fnldir(), fnroot(), open(), strlen(), getline()
+
+begin
+	# Be sure the input file exists, if so the get the root part of
+	# the filename.
+	call sprintf (cfname, SZ_PATHNAME, "%s/%s")
+	    call pargstr (cache)
+	    call pargstr (in)
+	if (access (in, 0, 0) == NO) {
+	    if (access (cfname, 0, 0) == NO) {
+		call strcpy ("", out, SZ_FNAME)
+		return
+	    }
+	} else
+	    call strcpy (in, cfname, SZ_PATHNAME)
+	
+	# Break up the filename.
+	if (fnldir (cfname, dirname, SZ_PATHNAME) == NULL)
+	    call strcpy ("./", dirname, SZ_PATHNAME)	# use current dir
+	if (fnroot (cfname, root, SZ_FNAME) == NULL)
+	    call strcpy (in, root, SZ_PATHNAME)		# use current dir
+
+	# Read the dotfile to get the source string.
+	if (root[1] == '.')
+	    call sprintf (dotfile, maxch, "%s/%s")
+	else
+	    call sprintf (dotfile, maxch, "%s/.%s")
+	    call pargstr (cache)
+	    call pargstr (root)
+
+	if (access (dotfile, 0, 0) == YES) {
+	    fd = open (dotfile, READ_ONLY, TEXT_FILE)
+	    if (getline (fd, line) == EOF)
+	        call aclrc (out, maxch)
+	    call close (fd)
+	} else
+	    call aclrc (line, SZ_LINE)
+
+	# Copy to the output string.
+	len = strlen (line)
+	line[len] = '\0'
+	call strcpy (line, out, SZ_LINE)
+end
+
+			
+# FC_FIND_EXTN -- Given a cache filename, see if a file/link exists with
+# an extension and return the extn string.
+
+procedure fc_find_extn (cache, cfname, extn, maxch)
+
+char	cache[ARB]				#i cache directory
+char	cfname[ARB]				#i cache file name
+char	extn[ARB]				#o file extension
+int	maxch					#i size of output string
+
+char	fname[SZ_LINE], cmp[SZ_PATHNAME]
+int	fd, clen, flen
+
+int	diropen(), strncmp(), strlen(), getline()
+
+begin
+	call strcpy (cfname, cmp, maxch)
+	call strcat (".", cmp, maxch)
+	clen = strlen (cmp)
+
+	fd = diropen (cache, SKIP_HIDDEN_FILES)
+	while (getline (fd, fname) != EOF) {
+	    flen = strlen (fname)
+	    fname[flen] = '\0'
+
+	    if (strncmp (fname, cmp, clen) == 0) {
+		call strcpy (fname[clen+1], extn, maxch)
+		break
+	    }
+	}
+	call close (fd)
+end
diff --git a/sys/fio/fcanpb.x b/sys/fio/fcanpb.x
new file mode 100644
index 00000000..a3c58ab8
--- /dev/null
+++ b/sys/fio/fcanpb.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FCANPB -- Cancel any pushed back data, restoring the original file pointers.
+# This should be done before performing any non-i/o operation which relys
+# upon the FIO data structures being in their normal state (e.g., before the
+# file buffers are deallocated).
+
+procedure fcanpb (fd)
+
+int	fd		# file descriptor
+
+int	pb_sp
+int	and()
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	while (and (fflags[fd], FF_PUSHBACK) != 0) {
+	    pb_sp = FPBSP(fp)
+
+	    iop[fd]	= Memi[pb_sp];	pb_sp = pb_sp + 1
+	    itop[fd]	= Memi[pb_sp];	pb_sp = pb_sp + 1
+	    bufptr[fd]	= Memi[pb_sp];	pb_sp = pb_sp + 1
+	    FPBIOP(fp)	= Memi[pb_sp];	pb_sp = pb_sp + 1
+
+	    FPBSP(fp) = pb_sp
+
+	    # When the pb stack pointer reaches the top of the pushback buffer,
+	    # all pushed back data has been read.  Note that the stack pointer
+	    # is a pointer to int while FPBTOP is a pointer to char.
+
+	    if (pb_sp >= (FPBTOP(fp) - 1) / SZ_INT + 1)
+		fflags[fd] = fflags[fd] - FF_PUSHBACK
+	}
+end
diff --git a/sys/fio/fchdir.x b/sys/fio/fchdir.x
new file mode 100644
index 00000000..92b34ee0
--- /dev/null
+++ b/sys/fio/fchdir.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# FCHDIR -- Change the current working directory.
+
+procedure fchdir (newdir)
+
+char	newdir[ARB]
+
+int	ip, status
+pointer	sp, vfn, osfn1, osfn2
+int	ki_extnode(), envfind()
+errchk	fmapfn, ki_extnode
+
+begin
+	call smark (sp)
+	call salloc (vfn,   SZ_FNAME,    TY_CHAR)
+	call salloc (osfn1, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn2, SZ_PATHNAME, TY_CHAR)
+
+	call strcpy (newdir, Memc[vfn], SZ_FNAME)
+
+	# Check for names of the form "node!" and convert them into
+	# "node!home$".  This will also convert the null string into
+	# a chdir to home$.
+
+	ip = ki_extnode (Memc[vfn], Memc[osfn1], SZ_PATHNAME, status)
+	if (newdir[ip+1] == EOS)
+	    call strcat ("home$", Memc[vfn], SZ_FNAME)
+
+	# Try the name as is.
+	call fmapfn (Memc[vfn], Memc[osfn1], SZ_PATHNAME)
+	call strupk (Memc[osfn1], Memc[osfn1], SZ_PATHNAME)
+
+	call zfpath (Memc[osfn1], Memc[osfn2], SZ_PATHNAME, status)
+	call zfsubd (Memc[osfn2], SZ_PATHNAME, "", status)
+
+	call strpak (Memc[osfn2], Memc[osfn2], SZ_PATHNAME)
+	call zfchdr (Memc[osfn2], status)
+
+	# Try chdir ldir$.
+	if (status == ERR) {
+	    call strcpy (Memc[vfn], Memc[osfn1], SZ_FNAME)
+	    if (envfind (Memc[osfn1], Memc[osfn2], SZ_PATHNAME) > 0) {
+		call strcat ("$", Memc[osfn1], SZ_PATHNAME)
+		call fmapfn (Memc[osfn1], Memc[osfn2], SZ_PATHNAME)
+		call zfchdr (Memc[osfn2], status)
+	    } else
+		status = ERR
+	}
+
+	call sfree (sp)
+	if (status == ERR)
+	    call syserrs (SYS_FCHDIR, newdir)
+end
diff --git a/sys/fio/fclobber.x b/sys/fio/fclobber.x
new file mode 100644
index 00000000..f692176e
--- /dev/null
+++ b/sys/fio/fclobber.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FCLOBBER -- Clobber the named file if it exists.  Avoid clobbering a file
+# which is already open.  File clobber is enabled by the environment variable
+# of the same name.  If the file exists and clobber is disabled, it is an
+# error unless multiple versions are permitted ("multversions").
+
+procedure fclobber (fname)
+
+char	fname[ARB]
+int	fd
+int	access()
+bool	streq(), envgetb()
+errchk	filerr, access, envgetb
+include	<fio.com>
+
+begin
+	# Avoid clobbering a file which is already open.
+
+	for (fd=FIRST_FD;  fd <= LAST_FD;  fd=fd+1)
+	    if (fiodes[fd] != NULL)
+		if (streq (fname, FNAME(fiodes[fd])))
+		    call filerr (fname, SYS_FCLOBOPNFIL)
+
+	# If file clobbering is disabled, make sure file does not exist,
+	# otherwise try to clobber the file if it exists.  No clobber
+	# checking is performed for special devices.  If "multversions" is
+	# disabled we assume that the OS will open a new version of the
+	# file rather than overwrite the old one, and the clobber error
+	# is defeated.
+
+	if (access (fname,0,0) == YES)
+	    if (envgetb ("clobber")) {
+		iferr (call delete (fname))
+		    call filerr (fname, SYS_FCANTCLOB)
+	    } else if (!envgetb ("multversions"))
+		call filerr (fname, SYS_FCLOBBER)
+end
diff --git a/sys/fio/fcopy.x b/sys/fio/fcopy.x
new file mode 100644
index 00000000..de21fba8
--- /dev/null
+++ b/sys/fio/fcopy.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<fset.h>
+
+define	MIN_BUFSIZE	512
+
+
+# FCOPY -- Copy a file.  Works for either text or binary files.  The new file
+# will not be created unless the input file can be opened successfully.  All
+# buffer space is dynamically allocated, and buffer sizes are automatically
+# adjusted by the system for efficient sequential access (the actual buffer
+# size is dependent on the machine, device, and file type).
+
+procedure fcopy (oldfile, newfile)
+
+char	oldfile[ARB]
+char	newfile[ARB]
+
+int	in, out, file_type, fd
+int	open(), access(), fsfopen(), fstdfile()
+errchk	open, fcopyo, access
+
+begin
+	if (access (oldfile, 0, TEXT_FILE) == YES)
+	    file_type = TEXT_FILE
+	else
+	    file_type = BINARY_FILE
+
+	in = open (oldfile, READ_ONLY, file_type)
+	if (fstdfile (newfile, out) == NO) {
+	    iferr (call fmkcopy (oldfile, newfile)) {
+		call close (in)
+		call erract (EA_ERROR)
+	    }
+	    out = open (newfile, APPEND, file_type)
+	}
+
+	# Warn user if the file being copied has subfiles.
+	ifnoerr (fd = fsfopen (oldfile, READ_ONLY)) {
+	    call close (fd)
+	    call eprintf ("Warning from fcopy: file `%s' has subfiles\n")
+		call pargstr (oldfile)
+	}
+
+	# Copy the file.
+	call fcopyo (in, out)
+
+	call close (in)
+	call close (out)
+end
+
+
+# FCOPYO -- Copy a file, where both the input and output files have
+# already been open.  Works regardless of the datatype of the files.
+
+procedure fcopyo (in, out)
+
+int	in			# input file descriptor
+int	out			# output file descriptor
+
+pointer	sp, buf
+int	buf_size
+int	fstati(), read()
+errchk	read, write
+
+begin
+	call smark (sp)
+
+	# Set up file buffers, intermediate buffer for efficient
+	# sequential i/o (advice is ignored if text file).  Local buffer
+	# is made same size as FIO buffer.
+
+	call fseti (in, F_ADVICE, SEQUENTIAL)
+	call fseti (out, F_ADVICE, SEQUENTIAL)
+	buf_size = max (MIN_BUFSIZE, fstati (in, F_BUFSIZE))
+	call salloc (buf, buf_size, TY_CHAR)
+
+	while (read (in, Memc[buf], buf_size) != EOF)
+	    call write (out, Memc[buf], fstati (in, F_NCHARS))
+
+	call sfree (sp)
+end
diff --git a/sys/fio/fdebug.x b/sys/fio/fdebug.x
new file mode 100644
index 00000000..6998ab98
--- /dev/null
+++ b/sys/fio/fdebug.x
@@ -0,0 +1,163 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FDEBUG -- Decode and print the contents of a file descriptor or of all
+# file descriptors on the standard output.
+
+procedure fdebug (out, fd1_arg, fd2_arg)
+
+int	out, fd1_arg, fd2_arg
+int	fd, fd1, fd2, n
+int	and()
+long	note()
+pointer	ffp
+include	<fio.com>
+
+begin
+	fd1 = max(1, min(LAST_FD, fd1_arg))
+	if (fd2_arg <= 0)
+	    fd2 = LAST_FD
+	else
+	    fd2 = max(1, min(LAST_FD, fd2_arg))
+
+	if (fd1 < FIRST_FD) {
+	    n = 0					# count open files
+	    do fd = 1, LAST_FD
+		if (fiodes[fd] != NULL)
+		    n = n + 1
+
+	    call fprintf (out,
+		"FIO Status: %d open files, %d installed devices\n\n")
+		call pargi (n)
+		call pargi (next_dev / LEN_DTE)		# count devices
+	}
+
+	for (fd=fd1;  fd <= fd2;  fd=fd+1) {
+	    ffp = fiodes[fd]
+	    if (ffp != NULL) {
+		call fprintf (out, "%2d  (%s), %s, %s, fp=%d,\n")
+		    call pargi (fd)
+		    call pargstr (FNAME(ffp))
+
+		    switch (FMODE(ffp)) {
+		    case READ_ONLY:
+			call pargstr ("READ_ONLY")
+		    case READ_WRITE:
+			call pargstr ("READ_WRITE")
+		    case WRITE_ONLY:
+			call pargstr ("WRITE_ONLY")
+		    case APPEND:
+			call pargstr ("APPEND")
+		    case NEW_FILE:
+			call pargstr ("NEW_FILE")
+		    case TEMP_FILE:
+			call pargstr ("TEMP_FILE")
+		    default:
+			call pargstr ("ILLEGAL_FMODE")
+		    }
+
+		    switch (FTYPE(ffp)) {
+		    case TEXT_FILE:
+			call pargstr ("TEXT_FILE")
+		    case BINARY_FILE:
+			call pargstr ("BINARY_FILE")
+		    case STRING_FILE:
+			call pargstr ("STRING_FILE")
+		    case SPOOL_FILE:
+			call pargstr ("SPOOL_FILE")
+		    default:
+			call pargstr ("ILLEGAL_FTYPE")
+		    }
+		    call pargi (ffp)
+
+		call fprintf (out, "    ")
+		call fprintf (out,
+		"chan=%d, device=%d, epa=0%xX, filesize(chars)=%d, posn=%s,\n")
+		    call pargi (FCHAN(ffp))
+		    call pargi ((FDEV(ffp)-1) / LEN_DTE + 1)
+		    call pargi (zdev[FDEV(ffp)])
+		    call pargl (FILSIZE(ffp))
+
+		    if (FILSIZE(ffp) < 0)
+			call pargl (note(fd))
+		    else if (boffset[fd] > FILSIZE(ffp))
+			call pargstr ("EOF")
+		    else
+			call pargl (note(fd))
+
+		call fprintf (out, "    ")
+		call fprintf (out,
+		"iomode=%s, status=%s, refcnt=%d, afd=%d,\n")
+		    switch (FFIOMODE(ffp)) {
+		    case INACTIVE:
+			call pargstr ("INACTIVE")
+		    case READ_IN_PROGRESS:
+			call pargstr ("READ_IN_PROGRESS")
+		    case WRITE_IN_PROGRESS:
+			call pargstr ("WRITE_IN_PROGRESS")
+		    default:
+			call pargstr ("ILLEGAL")
+		    }
+
+		    switch (FILSTAT(ffp)) {
+		    case ERR:
+			call pargstr ("ERR")
+		    case OK:
+			call pargstr ("OK")
+		    default:
+			call pargi (FILSTAT(ffp))
+		    }
+
+		    call pargi (FREFCNT(ffp))
+		    call pargi (FAFD(ffp))
+
+		call fprintf (out, "    ")
+		call fprintf (out,
+		"nbufs=%d, bufsize=%d, optbufsize=%d, blksize=%d,\n")
+		    call pargi (FNBUFS(ffp))
+		    call pargi (FBUFSIZE(ffp))
+		    call pargi (FOPTBUFSIZE(ffp))
+		    call pargi (FBLKSIZE(ffp))
+
+		call fprintf (out, "    ")
+		call fprintf (out,
+		"pbbufsize=%d, pbbuf=%d, pbtop=%d, pbiop=%d, pbsp=%d,\n")
+		    call pargi (FPBBUFSIZE(ffp))
+		    call pargi (FPBBUF(ffp))
+		    call pargi (FPBTOP(ffp))
+		    call pargi (FPBIOP(ffp))
+		    call pargi (FPBSP(ffp))
+
+		call fprintf (out, "    ")
+		call fprintf (out,
+		"iop=%d, itop=%d, otop=%d, bp=%d, top=%d, offset=%d,\n")
+		    call pargi (iop[fd])
+		    call pargi (itop[fd])
+		    call pargi (otop[fd])
+		    call pargi (bufptr[fd])
+		    call pargi (buftop[fd])
+		    call pargi (boffset[fd])
+
+		call fprintf (out, "    Flags =")
+		if (and (FF_FLUSH, fflags[fd]) != 0)
+		    call fprintf (out, " FLUSH")
+		if (and (FF_FLUSHNL, fflags[fd]) != 0)
+		    call fprintf (out, " FLUSHNL")
+		if (and (FF_READ, fflags[fd]) != 0)
+		    call fprintf (out, " READ")
+		if (and (FF_WRITE, fflags[fd]) != 0)
+		    call fprintf (out, " WRITE")
+		if (and (FF_KEEP, fflags[fd]) != 0)
+		    call fprintf (out, " KEEP")
+		if (and (FF_EOF, fflags[fd]) != 0)
+		    call fprintf (out, " EOF")
+		if (and (FF_ERR, fflags[fd]) != 0)
+		    call fprintf (out, " ERR")
+		if (and (FF_PUSHBACK, fflags[fd]) != 0)
+		    call fprintf (out, " PUSHBACK")
+		call fprintf (out, "\n\n")
+	    }
+	}
+end
diff --git a/sys/fio/fdevbf.x b/sys/fio/fdevbf.x
new file mode 100644
index 00000000..beba8d4b
--- /dev/null
+++ b/sys/fio/fdevbf.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FDEVBF -- Install a new binary file device in the device table, if it has
+# not already been installed.
+
+procedure fdevbf (zard, zawr, zawt, zstt, zcls)
+
+int	i, dev_epa
+extern	zard(), zawr(), zawt(), zstt(), zcls()
+include	<fio.com>
+
+begin
+	# Search the device table to see if the device is already installed.
+	# The ZDEV array indices the EPA of the read procedure of each device
+	# driver.
+
+	call zlocpr (zard, dev_epa)
+	for (i=1;  i < next_dev;  i=i+LEN_DTE)
+	    if (zdev[i] == dev_epa)
+		return
+
+	# Device not found; install the new device in the device table.
+	next_dev = next_dev + LEN_DTE
+	if (next_dev > LEN_DEVTBL)
+	    call syserr (SYS_FDEVTBLOVFL)
+	else {
+	    call zlocpr (zard, zdev[i])
+	    call zlocpr (zawr, zdev[i+1])
+	    call zlocpr (zawt, zdev[i+2])
+	    call zlocpr (zstt, zdev[i+3])
+	    call zlocpr (zcls, zdev[i+4])
+	}
+end
diff --git a/sys/fio/fdevblk.x b/sys/fio/fdevblk.x
new file mode 100644
index 00000000..b3a73cab
--- /dev/null
+++ b/sys/fio/fdevblk.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+
+# FDEVBLK -- Get the device block size of the device on which the named logical
+# directory resides.  The named logical directory must have write permission.
+# A file pathname may be used to pass the logical directory name.
+
+int procedure fdevblk (path)
+
+char	path[ARB]			# pathname of directory or file
+
+pointer	sp, fname, ldir, tempfn
+int	fd, junk, block_size
+int	fstati(), open(), fnldir()
+errchk	mktemp, open, close
+
+begin
+	call smark (sp)
+	call salloc (ldir,   SZ_PATHNAME, TY_CHAR)
+	call salloc (fname,  SZ_PATHNAME, TY_CHAR)
+	call salloc (tempfn, SZ_PATHNAME, TY_CHAR)
+
+	# Generate the name of a temporary file in named directory.
+	junk = fnldir (path, Memc[ldir], SZ_PATHNAME)
+	call strcpy (Memc[ldir], Memc[fname], SZ_PATHNAME)
+	call strcat ("zbk", Memc[fname], SZ_PATHNAME)
+	call mktemp (Memc[fname], Memc[tempfn], SZ_PATHNAME)
+
+	# Open the file and get the device block size.
+	iferr {
+	    fd = open (Memc[tempfn], NEW_FILE, BINARY_FILE)
+	    block_size = fstati (fd, F_BLKSIZE)
+	    call close (fd)
+	    call delete (Memc[tempfn])
+	} then
+	    call syserrs (SYS_FACCDIR, Memc[ldir])
+
+	call sfree (sp)
+	return (block_size)
+end
diff --git a/sys/fio/fdevtx.x b/sys/fio/fdevtx.x
new file mode 100644
index 00000000..65c02fc8
--- /dev/null
+++ b/sys/fio/fdevtx.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FDEVTX -- Install a new text file device in the device table, if it has
+# not already been installed.
+
+procedure fdevtx (zget, zput, zfls, zstt, zcls, zsek, znot)
+
+int	i, dev_epa
+extern	zget(), zput(), zfls(), zstt(), zcls(), zsek(), znot()
+include	<fio.com>
+
+begin
+	# Search the device table to determine if the device has already been
+	# installed.  The ZDEV array indices the device table by the EPA of
+	# each device driver.
+
+	call zlocpr (zget, dev_epa)
+	for (i=1;  i < next_dev;  i=i+LEN_DTE)
+	    if (zdev[i] == dev_epa)
+		return
+
+	# Device not found.  Install the new device in the table.
+	next_dev = next_dev + LEN_DTE
+	if (next_dev > LEN_DEVTBL)
+	    call syserr (SYS_FDEVTBLOVFL)
+	else {
+	    call zlocpr (zget, zdev[i])
+	    call zlocpr (zput, zdev[i+1])
+	    call zlocpr (zfls, zdev[i+2])
+	    call zlocpr (zstt, zdev[i+3])
+	    call zlocpr (zcls, zdev[i+4])
+	    call zlocpr (zsek, zdev[i+5])
+	    call zlocpr (znot, zdev[i+6])
+	}
+end
diff --git a/sys/fio/fdirname.x b/sys/fio/fdirname.x
new file mode 100644
index 00000000..aa24709d
--- /dev/null
+++ b/sys/fio/fdirname.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<knet.h>
+
+# FDIRNAME -- Return the concatenatable directory prefix for the named
+# directory.  If no vfn is given (null string), a path to the current
+# directory is returned.
+
+procedure fdirname (vfn, path, maxch)
+
+char	vfn[ARB]		# VFN of directory
+char	path[ARB]		# unpacked path to directory
+int	maxch
+
+int	len1, len2, ch
+int	gstrcpy()
+
+begin
+	if (vfn[1] == EOS) {
+	    # Null vfn; return current directory.
+	    call strcpy ("./", path, maxch)
+	    return
+	}
+
+	# Do we have an OS directory reference?
+	call zfxdir (vfn, path, maxch, len2)
+	ch = path[len2]
+	if (len2 > 0 && !(IS_ALNUM(ch) || ch == '_'))
+	    return
+
+	# Do we have an "ldir$" or "subdir/"?  If so, quit, else if the last
+	# char is a normal identifier class filename char, assume that we have
+	# a VFN and add the / delimiter.  This technique is not infallible,
+	# and a better solution would be to have ZFXDIR or FDIRNAME itself
+	# execute on the remote node.
+
+	len1 = gstrcpy (vfn, path, maxch)
+	ch = path[len1]
+	if (ch == '$' || ch == '/')
+	    return
+
+	# Must be a subdirectory of the form "subdir".  Add the /.
+	path[len1+1] = '/'
+	path[len1+2] = EOS
+end
diff --git a/sys/fio/fexbuf.x b/sys/fio/fexbuf.x
new file mode 100644
index 00000000..38ba5b3d
--- /dev/null
+++ b/sys/fio/fexbuf.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+define	INC_BUFSIZE		4096
+
+
+# FEXBUF -- Expand the size of the file buffer.  Called by FLSBUF when the FIO
+# buffer fills while writing to a file of type SPOOL_FILE.  Spool files are
+# files of arbitrary size, buffered entirely in memory.  Typically, a finite
+# amount of data is written into a spoolfile, the file is rewound, the data
+# is read back out, and so on.  This makes it possible to use the file interface
+# to pass data between program modules.
+
+procedure fexbuf (fd)
+
+int	fd			# file which needs a larger buffer
+
+pointer	bp
+int	offset
+errchk	malloc, realloc
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	bp = bufptr[fd]
+	offset = iop[fd] - bp
+
+	if (bufptr[fd] == NULL) {
+	    if (FBUFSIZE(fp) == 0)
+		FBUFSIZE(fp) = SZ_SPOOLBUF
+	    call malloc (bp, FBUFSIZE(fp), TY_CHAR)
+	} else {
+	    FBUFSIZE(fp) = FBUFSIZE(fp) + INC_BUFSIZE
+	    call realloc (bp, FBUFSIZE(fp), TY_CHAR)
+	}
+
+	boffset[fd] = 1
+	bufptr[fd]  = bp
+	buftop[fd]  = bp + FBUFSIZE(fp)
+
+	iop[fd]  = bp + offset  
+	itop[fd] = iop[fd]
+	otop[fd] = buftop[fd]
+end
diff --git a/sys/fio/ffault.x b/sys/fio/ffault.x
new file mode 100644
index 00000000..76f43f4a
--- /dev/null
+++ b/sys/fio/ffault.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<config.h>
+include	<fio.h>
+
+# FFAULT -- Read a file block into the file buffer (pick up file buffer and
+# put it down on another part of the file).  Although in this implementation
+# there is only a single, local, file buffer for each file, in the future
+# a variable number of either global or local buffers will be supported, as
+# well as read ahead and write behind (see Fio.doc).
+
+int procedure ffault (fd, file_offset, nreserve, rwflag)
+
+int	fd
+long	file_offset		# char offset to be faulted in
+int	nreserve		# size of transfer pending
+int	rwflag			# next access is a read or a write
+
+pointer	bp
+long	buffer_offset, fboff
+int	bufsize, nchars_read
+bool	block_write, stream, at_eof
+
+int	and()
+errchk	ffilbf, fflsbf, fwatio
+define	ioerror_ 91
+include	<fio.com>
+
+begin
+	# assert (file open, buffer already created)
+	# assert (iop does not point into buffer)
+
+	fp = fiodes[fd]
+	bp = bufptr[fd]
+	bufsize = FBUFSIZE(fp)
+	fboff   = FIRSTBUFOFF(fp)
+	stream  = (FBLKSIZE(fp) == 0)
+
+	# Calculate buffer_offset (modulus file buffer size).  If the output
+	# device is a pipe or terminal (stream device), which does not permit
+	# rewriting of data and seeking, empty buffer.
+
+	if (stream) {
+	    buffer_offset = file_offset	
+	} else if (file_offset <= 0) {
+	    iferr (call filerr (FNAME(fp), SYS_FSEEK))
+		goto ioerror_
+	} else
+	    buffer_offset = (file_offset-fboff) / bufsize * bufsize + fboff
+
+	# Update i/o pointers (if an empty or partially full buffer has been
+	# written into, determine the top of the valid part of the buffer).
+
+	UPDATE_IOP(fd)
+	    
+	# Flush buffer if it has been written into.  Write out only as much
+	# of the buffer as has been filled.
+
+	if (BUF_MODIFIED(fd)) {
+	    iferr (call fflsbf (fd, bp, otop[fd]-bp, boffset[fd]))
+		goto ioerror_
+
+	    # We need to do this wait here since we immediately use this buffer
+	    # without doing a wait. Which screws up the data going out to disk.
+	    # This can be done away with when multi-buffering is done. (FJR).
+
+	    call fwatio (fd)
+	}
+
+	# Fill buffer from file only if the file was opened with read
+	# permission, and if the fault was not caused by a WRITE which will
+	# immediately overwrite the entire contents of the buffer.
+
+	if (rwflag == FF_WRITE) {
+	    block_write = (stream ||
+		(file_offset == buffer_offset && nreserve >= bufsize))
+	} else
+	    block_write = false
+
+	if (block_write) {
+	    itop[fd] = bp
+	    otop[fd] = bp
+
+	} else if (and(FF_READ,fflags[fd]) == 0) {
+	    # Read is disabled.  Zero-fill buffer; if inside existing
+	    # random access file, set ITOP to end of buffer so that the
+	    # entire buffer will be written when flushed.
+
+	    at_eof = (FILSIZE(fp) >= 0 && buffer_offset > FILSIZE(fp))
+	    otop[fd] = bp
+
+	    if (at_eof)
+		itop[fd] = bp
+	    else
+		itop[fd] = bp + bufsize
+
+	    # Zero-fill the buffer.
+	    call aclrc (Memc[bp], bufsize)
+
+	} else {
+	    iferr {
+		# Initialize buffer from file.
+		call ffilbf (fd, bp, bufsize, buffer_offset)
+		call fwatio (fd)
+	    } then
+		goto ioerror_
+	}
+
+	boffset[fd] = buffer_offset
+	LSEEK (fd, file_offset)				# set i/o pointer
+
+	nchars_read = itop[fd] - iop[fd]
+	if (nchars_read <= 0)
+	    return (EOF)
+	else
+	    return (nchars_read)			# only valid for a read
+
+	# If an i/o error occurs, mark the buffer empty and pass the error
+	# back to our caller.
+
+ioerror_
+	itop[fd] = bp
+	otop[fd] = bp
+	call erract (EA_ERROR)
+end
diff --git a/sys/fio/ffilbf.x b/sys/fio/ffilbf.x
new file mode 100644
index 00000000..8948ce89
--- /dev/null
+++ b/sys/fio/ffilbf.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FFILBF -- Called by FFAULT to fill the file buffer for a binary file.
+
+procedure ffilbf (fd, bp, bufsize, buffer_offset)
+
+int	fd, bufsize
+pointer	bp
+bool	at_eof, stream_dev
+long	buffer_offset
+errchk	fwatio
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	if (FBUFMODE(fp) != INACTIVE)
+	    call fwatio (fd)
+
+	# If streaming device, read unconditionally, otherwise if
+	# positioned at EOF, initialize buffer pointers and return,
+	# else initiate read to fill buffer from file and return.
+
+	stream_dev = (FBLKSIZE(fp) == 0)
+	at_eof = (FILSIZE(fp) >= 0 && buffer_offset > FILSIZE(fp))
+
+	if (!stream_dev && at_eof) {
+	    itop[fd] = bufptr[fd]
+	    otop[fd] = bufptr[fd]
+	} else {
+	    call aread (fd, Memc[bp], bufsize, buffer_offset)
+	    FBUFMODE(fp) = READ_IN_PROGRESS
+	}
+end
diff --git a/sys/fio/ffilsz.x b/sys/fio/ffilsz.x
new file mode 100644
index 00000000..2a8a2926
--- /dev/null
+++ b/sys/fio/ffilsz.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+
+# FFILSZ -- Return file size in chars.  When first called, the status
+# z-routine for the channel is called to get the file size.  Thereafter,
+# FIO keeps track of the file size.
+
+long procedure ffilsz (fd)
+
+int	fd
+long	file_size
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	UPDATE_IOP(fd)					# update i/o pointers
+
+	switch  (FTYPE(fp)) {
+	case TEXT_FILE:
+	    call zcall3 (ZSTTTX(fp), FCHAN(fp), FSTT_FILSIZE, file_size)
+	    file_size = file_size + (otop[fd] - bufptr[fd])
+
+	case STRING_FILE, SPOOL_FILE:
+	    file_size = otop[fd] - bufptr[fd]
+
+	default:
+	    # Call channel status z-routine to get file size if this is the
+	    # first request.  Thereafter, FIO keeps track of file size.
+	    # Beware that FILSIZE (updated by AWRITE or by us) does not
+	    # necessarily include data just recently written into the current
+	    # buffer.
+
+	    if (FILSIZE(fp) < 0) {
+		call zcall3 (ZSTTBF(fp), FCHAN(fp), FSTT_FILSIZE, file_size)
+		file_size = (file_size + SZB_CHAR-1) / SZB_CHAR
+	    } else
+		file_size = FILSIZE(fp)
+
+	    # If writing at EOF (or first block of a new file), and the file
+	    # buffer has not yet been flushed, the file size is the buffer
+	    # offset minus one (number of chars written to disk) plus the
+	    # number of chars in the file buffer.
+
+	    if (BUF_MODIFIED(fd))
+		file_size = max (file_size,
+		    boffset[fd]-1 + (itop[fd] - bufptr[fd]))
+	}
+
+	FILSIZE(fp) = file_size				# update fildes
+	return (file_size)
+end
diff --git a/sys/fio/fflsbf.x b/sys/fio/fflsbf.x
new file mode 100644
index 00000000..7503609a
--- /dev/null
+++ b/sys/fio/fflsbf.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FFLSBF -- Flush the file buffer.  Called by FFAULT to initiate a write
+# of the file buffer when a fault occurs.
+
+procedure fflsbf (fd, bp, maxchars, buffer_offset)
+
+int	fd
+pointer	bp
+int	maxchars
+long	buffer_offset
+errchk	fwatio
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	if (FBUFMODE(fp) != INACTIVE)
+	    call fwatio (fd)
+	call awrite (fd, Memc[bp], maxchars, buffer_offset)
+
+	FBUFMODE(fp) = WRITE_IN_PROGRESS
+end
diff --git a/sys/fio/fgdevpar.x b/sys/fio/fgdevpar.x
new file mode 100644
index 00000000..b9da21b3
--- /dev/null
+++ b/sys/fio/fgdevpar.x
@@ -0,0 +1,88 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+.help fgdev_param
+.nf ________________________________________________________________________
+FGDEV_PARAM -- Get device parameters (block size, optimum buffer size)
+and set up file descriptor accordingly.  Called by FILOPN and FINIT.
+
+	FSTT_BLKSIZE		Device block size:
+				   >= 1 if block structured device
+				   == 0 if streaming device (terminal,
+					pipe, tape, etc.)
+
+	FSTT_OPTBUFSIZE		Minimum optimal buffer size for efficient
+				sequential i/o.  Actual buffer size may be
+				any integer multiple of this value.
+
+	FSTT_MAXBUFSIZE		Maximum buffer size permitted, i.e., maximum
+				size transfer permitted in a call to aread
+				or awrite.  FIO will not create a buffer
+				larger than this value, but will try to use
+				a larger buffer if created externally.
+
+	FSTT_FILSIZE		File size, chars.  This is requested only
+				once for an open file, and is not requested
+				for streaming binary files.
+.endhelp ____________________________________________________________________
+
+procedure fgdev_param (fd)
+
+int	fd
+pointer	ffp
+long	fgdev0(), ffilsz()
+errchk	fgdev0, ffilsz
+include	<fio.com>
+
+begin
+	ffp = fiodes[fd]
+
+	FBLKSIZE(ffp)    = max (0, fgdev0 (ffp, FSTT_BLKSIZE))
+	FOPTBUFSIZE(ffp) = max (1, fgdev0 (ffp, FSTT_OPTBUFSIZE))
+	FMAXBUFSIZE(ffp) = max (0, fgdev0 (ffp, FSTT_MAXBUFSIZE))
+	FIRSTBUFOFF(ffp) = 1
+
+	# If regular device, and file size is not yet known, get file size.
+	if (FBLKSIZE(ffp) > 0 && FILSIZE(ffp) < 0) {
+	    FILSIZE(ffp) = fgdev0 (ffp, FSTT_FILSIZE)
+	    FILSIZE(ffp) = ffilsz (fd)			# add buffered output
+	}
+
+	if (FTYPE(ffp) == BINARY_FILE)
+	    FBUFSIZE(ffp) = FOPTBUFSIZE(ffp)
+	else
+	    FBUFSIZE(ffp) = max (SZ_LINE, FOPTBUFSIZE(ffp))
+end
+
+
+# FGDEV0 -- Internal procedure to get status from either a text or binary
+# file, rounding the byte count up to an integral number of chars.
+
+long procedure fgdev0 (ffp, what)
+
+pointer	ffp
+int	what
+
+long	nbytes
+int	status_epa
+include	<fio.com>
+
+begin
+	if (FTYPE(ffp) == BINARY_FILE)
+	    status_epa = ZSTTBF(ffp)
+	else
+	    status_epa = ZSTTTX(ffp)
+
+	call zcall3 (status_epa, FCHAN(ffp), what, nbytes)
+	if (nbytes == ERR)
+	    call filerr (FNAME(ffp), SYS_FDEVSTAT)
+
+	if (FTYPE(ffp) == BINARY_FILE)
+	    return ((nbytes+SZB_CHAR-1) / SZB_CHAR)
+	else
+	    return (nbytes)
+end
diff --git a/sys/fio/fgetfd.x b/sys/fio/fgetfd.x
new file mode 100644
index 00000000..7669421f
--- /dev/null
+++ b/sys/fio/fgetfd.x
@@ -0,0 +1,135 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <config.h>
+include <fio.h>
+
+# FGETFD -- Allocate a file descriptor.  Called by all OPEN routines.
+# Search static part of file descriptor storage for an open file descriptor.
+# Allocate memory for rest of file descriptor, initialize all fields.
+
+int procedure fgetfd (filename, mode, type)
+
+char    filename[ARB]           # name of file to be assigned a descriptor
+int     mode                    # access mode
+int     type                    # file type
+
+int     fd
+int     fsetfd()
+include	<fio.com>
+
+begin
+        for (fd=FIRST_FD;  fd <= LAST_FD && fiodes[fd] != NULL;  fd=fd+1)
+            ;
+        if (fd > LAST_FD)                               # out of descriptors
+            call syserr (SYS_FTOOMANYFILES)
+
+        return (fsetfd (fd, filename, mode, type))
+end
+
+
+# FSETFD -- Initialize the file descriptor FD.
+
+int procedure fsetfd (fd, filename, mode, type)
+
+int     fd                      # fd to be initialized
+char    filename[ARB]           # name of file to be assigned to FD
+int     mode                    # access mode
+int     type                    # file type
+
+int	or()
+errchk  calloc, filerr, syserr
+include <fio.com>
+include "mmap.inc"
+
+begin
+        # Allocate descriptor.
+        call calloc (fp, LEN_FIODES, TY_STRUCT)
+
+        iop[fd]      = NULL
+        itop[fd]     = NULL
+        otop[fd]     = NULL
+        bufptr[fd]   = NULL
+        buftop[fd]   = NULL
+        boffset[fd]  = 1
+        redir_fd[fd] = NULL
+        fflags[fd]   = 0
+        fiodes[fd]   = fp                               # set ptr to fildes
+        FCD(fp)      = FLCD(fp)                         # set ptr to chandes
+
+	# Set the file permission bits for the given mode.  Note that read
+	# permission is required in append mode on a binary file since the
+	# partial block at the end of the file has to be read in before we
+	# can append to it.
+
+        switch (mode) {
+        case STRING_FILE, SPOOL_FILE:
+            # (neither read or write perm, disable flushnl)
+        case READ_ONLY:
+            fflags[fd] = FF_READ
+            FILSIZE(fp) = -1                            # file size unknown
+        case WRITE_ONLY:
+            fflags[fd] = FF_WRITE
+            FILSIZE(fp) = -1                            # file size unknown
+        case READ_WRITE, APPEND:
+            fflags[fd] = FF_READ + FF_WRITE
+            FILSIZE(fp) = -1
+        case NEW_FILE, TEMP_FILE:
+	    if (type == STATIC_FILE) {
+		fiodes[fd] = NULL
+		call mfree (fp, TY_STRUCT)
+		call filerr (filename, SYS_FSFOPNF)
+	    }
+            fflags[fd] = FF_READ + FF_WRITE
+            FILSIZE(fp) = 0                             # zero length file
+        default:
+	    fiodes[fd] = NULL
+	    call mfree (fp, TY_STRUCT)
+            call filerr (filename, SYS_FILLEGMODE)
+        }
+
+        switch (type) {
+        case STRING_FILE, SPOOL_FILE:
+            # Allocate an (improper) device for string "files".  Since there
+            # is no channel for a string file, any improper i/o on a string
+            # file will result in an error return.
+
+            FDEV(fp) = TX_DRIVER
+
+	    # Spool files have all read and write permissions turned off
+	    # so that they never try to write to a device driver - the file
+	    # consists of only the buffered data.  Spool files are considered
+	    # to be streaming binary files, so also set the blk size to 0.
+
+	    if (type == SPOOL_FILE) {
+		fflags[fd] = 0
+		FBLKSIZE(fp) = 0
+	    }
+
+        case TEXT_FILE:
+            fflags[fd] = or (FF_FLUSH, fflags[fd])
+            FDEV(fp) = TX_DRIVER
+        case BINARY_FILE:
+            FDEV(fp) = BF_DRIVER
+        case STATIC_FILE:
+            FDEV(fp) = SF_DRIVER
+        default:
+	    fiodes[fd] = NULL
+	    call mfree (fp, TY_STRUCT)
+            call filerr (filename, SYS_FILLEGTYPE)
+        }
+
+	# A static file is equivalent to a binary file at the VOS level.
+        FMODE(fp) = mmap[mode]
+	if (type == STATIC_FILE)
+	    FTYPE(fp) = BINARY_FILE
+	else
+	    FTYPE(fp) = type
+
+        FCHAN(fp) = -1
+        FNBUFS(fp) = 1
+        FREFCNT(fp) = 1                                 # no. fd active on chan
+        call strcpy (filename, FNAME(fp), SZ_FFNAME)
+
+        return (fd)
+end
diff --git a/sys/fio/filbuf.x b/sys/fio/filbuf.x
new file mode 100644
index 00000000..55878cad
--- /dev/null
+++ b/sys/fio/filbuf.x
@@ -0,0 +1,113 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FILBUF -- Fill the file buffer.  Called by GETC, GETLINE, and READ when the
+# i/o pointer no longer points into the file buffer.  This happens when
+# (1) there is no file buffer yet, (2) all the data in the buffer has been
+# read, or (3) a SEEK has occurred.
+
+int procedure filbuf (fd)
+
+int	fd			#I input file
+
+pointer	bp, pb_sp
+int	maxch, nchars_read
+
+int	ffault()
+errchk	fmkbfs, ffault, filerr, syserr
+include	<fio.com>
+define	again_ 91
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)			# verification
+	    call syserr (SYS_FILENOTOPEN)
+again_
+	if (and (FF_READ+FF_PUSHBACK, fflags[fd]) == 0) {
+	    if (FTYPE(fp) == STRING_FILE || FTYPE(fp) == SPOOL_FILE)
+		return (EOF)
+	    else
+		call filerr (FNAME(fp), SYS_FNOREADPERM)
+	}
+
+	# If filbuf was called at the end of a pushed back block of data,
+	# pop the old i/o pointers off the pushback stack and resume i/o
+	# at the point at which it was interrupted.
+
+	if (and (fflags[fd], FF_PUSHBACK) != 0) {
+	    repeat {
+		pb_sp = FPBSP(fp)
+
+		iop[fd]    = Memi[pb_sp];	pb_sp = pb_sp + 1
+		itop[fd]   = Memi[pb_sp];	pb_sp = pb_sp + 1
+		bufptr[fd] = Memi[pb_sp];	pb_sp = pb_sp + 1
+		FPBIOP(fp) = Memi[pb_sp];	pb_sp = pb_sp + 1
+
+		FPBSP(fp) = pb_sp
+
+		# When the pb stack pointer reaches the top of the pushback
+		# buffer, all pushed back data has been read.  Note that the
+		# stack pointer is a pointer to int while FPBTOP is a pointer
+		# to char.
+
+		if (pb_sp >= (FPBTOP(fp) - 1) / SZ_INT + 1)
+		    fflags[fd] = fflags[fd] - FF_PUSHBACK
+
+		# If there was no data left when pushback occurred, then we
+		# aren't done yet.
+
+		nchars_read = itop[fd] - iop[fd]
+		if (nchars_read > 0)
+		    return (nchars_read)
+
+	    } until (and (fflags[fd], FF_PUSHBACK) == 0)
+	    goto again_
+	}
+
+	# If we do not have a file buffer yet, allocate one.
+	bp = bufptr[fd]
+	if (bp == NULL) {
+	    call fmkbfs (fd)
+	    bp = bufptr[fd]
+	}
+
+	if (FTYPE(fp) == TEXT_FILE) {
+	    # Get next line from text file, initialize pointers.  In raw mode
+	    # we only read one character at a time.
+
+	    if (and (FF_RAW, fflags[fd]) == 0)
+		maxch = FBUFSIZE(fp)
+	    else
+		maxch = 1
+	    call zcall4 (ZGETTX(fp), FCHAN(fp), Memc[bp], maxch, nchars_read)
+
+	    iop[fd] = bp
+	    itop[fd] = max (bp, bp + nchars_read)
+	    otop[fd] = bp
+
+	} else if (FNCHARS(fp) < 0) {
+	    # Validate data in buffer without performing a physical read (used
+	    # to attempt error recovery following a read error - see fseti).
+
+	    nchars_read = -FNCHARS(fp)
+	    iop[fd] = bp
+	    itop[fd] = bp + nchars_read
+	    otop[fd] = bp
+
+	} else {
+	    # Fill buffer from binary file.
+	    nchars_read = ffault (fd, LNOTE(fd), 0, FF_READ)
+	}
+
+	switch (nchars_read) {
+	case ERR:
+	    call filerr (FNAME(fp), SYS_FREAD)
+	case 0:
+	    return (EOF)
+	default:
+	    return (nchars_read)			# (or ERR)
+	}
+end
diff --git a/sys/fio/filerr.x b/sys/fio/filerr.x
new file mode 100644
index 00000000..2f5b07da
--- /dev/null
+++ b/sys/fio/filerr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FILERR -- Take an error action, including the name of the file in the
+# error message.  Note that the order of the arguments is reversed in
+# filerr and syserr; this is unfortunate, but too hard to change at this
+# point.  The logic behind this (if there is any) is that the main operand
+# of filerr is the file name, that of syserr the error number.
+
+procedure filerr (fname, errcode)
+
+char	fname[ARB]
+int	errcode
+
+begin
+	call syserrs (errcode, fname)
+end
diff --git a/sys/fio/filopn.x b/sys/fio/filopn.x
new file mode 100644
index 00000000..72a71309
--- /dev/null
+++ b/sys/fio/filopn.x
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+include	<fset.h>
+
+# FILOPN -- Open a file on an installed device.  A file descriptor is
+# allocated and initialized.  If a new file is being opened, file clobber
+# (overwrite) checking is performed.  If the file exists but cannot be
+# accessed because it is open by another process, and file waiting is
+# enabled (usually in batch mode), the process is blocked until the file
+# becomes available.  If one attempts to "open" one of the files "STDIN",
+# "STDOUT", "STDERR", etc.  the fd of the appropriate standard file is returned.
+# Interrupts are disabled while the VFN database is open to protect the
+# database, ensure that that the lock on the mapping file is cleared, and to
+# ensure that the mapping file is closed.
+
+int procedure filopn (fname, mode, type, zopen_proc, device)
+
+char	fname[ARB]			# virtual file name
+int	mode				# access mode (ro,rw,apnd,newf,temp)
+int	type				# text or binary file
+extern	zopen_proc(), device()
+
+pointer	vp
+bool	standard_device
+int	ip, fd, dev_epa, junk, status, vfnmode
+
+pointer	vfnopen()
+int	fgetfd(), fstdfile(), vfnadd(), vfnmap(), locpr()
+errchk	fwtacc, seek, fclobber, fgetfd
+include	<fio.com>
+define	cleanup_ 91
+define	close_ 92
+define	abort_ 93
+
+begin
+	for (ip=1;  IS_WHITE (fname[ip]);  ip=ip+1)
+	    ;
+
+	# Do not bother to check access mode if reopening a standard
+	# stream.  If one attempts to write to STDIN or read from STDOUT,
+	# a suitable error message will be generated at that time.  If
+	# a standard file such as STDIN is reopened read-write but never
+	# written to, however, that is acceptable.
+
+	if (fstdfile (fname[ip], fd) == YES)		# standard stream?
+	    return (fd)
+
+	# Determine if "device" is a standard disk device, i.e., the driver
+	# TX or BF or the static file driver SF.  Clobber and filewait are
+	# only performed for disk files.
+
+	dev_epa = locpr (device)
+	standard_device = (dev_epa == zdev[TX_DRIVER] ||
+			   dev_epa == zdev[BF_DRIVER] ||
+			   dev_epa == zdev[SF_DRIVER])
+
+	# Perform clobber checking and waiting only for standard devices.
+	# If clobber is enabled and we are opening a new file, any existing
+	# file will be deleted.
+
+	if (standard_device && (mode == NEW_FILE || mode == TEMP_FILE))
+	    call fclobber (fname[ip])
+
+	# Allocate and initialize the file descriptor.
+	fd = fgetfd (fname[ip], mode, type)
+	call fseti (fd, F_DEVICE, dev_epa)
+	fp = fiodes[fd]
+
+	# Get OS pathname of file.
+	if (standard_device) {
+
+	    # Don't open VFN with write perm if file is readonly, else
+	    # lockout may occur on the mapping file.
+
+	    if (FMODE(fp) == READ_ONLY)
+		vfnmode = VFN_READ
+	    else
+		vfnmode = VFN_WRITE
+
+	    call intr_disable()
+	    iferr (vp = vfnopen (fname[ip], vfnmode))
+		goto abort_
+
+	    if (FMODE(fp) == NEW_FILE) {
+		iferr (junk = vfnadd (vp, FPKOSFN(fp), SZ_FFNAME))
+		    goto close_
+	    } else {
+		iferr (status = vfnmap (vp, FPKOSFN(fp), SZ_FFNAME))
+		    goto close_
+		if (status == ERR)
+		    iferr (call syserrs (SYS_FOPEN, fname[ip]))
+			goto close_
+	    }
+
+	    iferr (call vfnclose (vp, VFN_UPDATE))
+		goto abort_
+	    call intr_enable()
+
+	} else
+	    call strpak (fname[ip], FPKOSFN(fp), SZ_FFNAME)
+
+	# Open file.  If file exists on a standard device but cannot be
+	# accessed and "filewait" is enabled, wait for file to become
+	# accessible.
+
+	repeat {
+	    call zopen_proc (FPKOSFN(fp), FMODE(fp), FCHAN(fp))
+	    FDEVOPEN(fp) = locpr (zopen_proc)
+
+	    fp = fiodes[fd]
+	    if (FCHAN(fp) == ERR) {
+		iferr {
+		    if (standard_device) {
+			iferr (call fwtacc (fd, fname[ip]))
+			    call syserrs (SYS_FOPEN, fname[ip])
+		    } else {
+			call syserrs (SYS_FOPENDEV, fname[ip])
+		    }
+		} then
+		    goto cleanup_
+	    } else
+		break
+	}
+
+	# Get the device parameters (block size, file size, streamer, etc.)
+	iferr (call fgdev_param (fd))
+	    goto cleanup_
+
+	iferr {
+	    if (mode == APPEND)
+		call seek (fd, EOFL)
+	    else
+		call seek (fd, BOFL)
+
+	    # Save name of temporary file for automatic deletion at program
+	    # termination.
+	    if (mode == TEMP_FILE)
+		call fsvtfn (fname)
+	} then
+	    goto cleanup_
+
+	return (fd)
+
+cleanup_
+	call frtnfd (fd)
+	call erract (EA_ERROR)
+	return (ERR)
+
+
+	# Error recovery nasties for when the VFN is open.
+close_
+	iferr (call vfnclose (vp, VFN_NOUPDATE))
+	    ;
+abort_
+	call frtnfd (fd)
+	call intr_enable()
+	call erract (EA_ERROR)
+	return (ERR)
+end
diff --git a/sys/fio/finfo.x b/sys/fio/finfo.x
new file mode 100644
index 00000000..898b354b
--- /dev/null
+++ b/sys/fio/finfo.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<finfo.h>
+include	<config.h>
+include	<fio.h>
+
+.help finfo
+.nf ___________________________________________________________________________
+FINFO -- Return information on the named file (directory entry).
+See <finfo.h> for a definition of the contents of the output structure.
+
+The times are returned in units of seconds from midnight on Jan 1, 1980,
+local standard time.  Use CTIME to convert the integer time into a character
+string.  The owner name is returned as a character string (stored as chars
+in the long integer finfo array).  The owner permissions are bits 1-2 of the
+FI_PERM field, group permissions are bits 3-4, world bits 5-6.  The meaning
+of the bits are RW (read, write).  Execute permission is indicated by a
+file type.  Note that the file size is returned in BYTES, rather than chars
+(bytes are more desirable for directory listings).
+
+Call ZFPROT to determine if a file has delete permission.  Call ACCESS to
+determine if a "regular" file is of type text or binary.  This information
+requires additional expense to obtain on some systems, is not required for
+a simple directory listing, and hence is not provided by FINFO.
+.endhelp ______________________________________________________________________
+
+int procedure finfo (fname, ostruct)
+
+char	fname[ARB]
+long	ostruct[LEN_FINFO]
+int	status
+include	<fio.com>
+
+begin
+	iferr (call fmapfn (fname, pathname, SZ_PATHNAME))
+	    return (ERR)
+
+	call zfinfo (pathname, ostruct, status)
+
+	# ZFINFO returns the file owner string as a packed string.
+	if (status != ERR)
+	    call strupk (FI_OWNER(ostruct), FI_OWNER(ostruct), FI_SZOWNER)
+
+	return (status)
+end
diff --git a/sys/fio/finit.x b/sys/fio/finit.x
new file mode 100644
index 00000000..730afa0a
--- /dev/null
+++ b/sys/fio/finit.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+include	<ttset.h>
+include	<fio.h>
+
+# FINIT -- Initialize FIO.  Called once by the IRAF Main upon process startup.
+# Mark all file descriptors empty and install drivers for the standard file 
+# defices, i.e., text file, binary file, terminal, and IPC.
+
+procedure finit()
+
+int	fd, first_time
+
+extern	zgettx(), zputtx(), zflstx(), zstttx(), zclstx(), zsektx(), znottx()
+extern	zgetty(), zputty(), zflsty(), zsttty(), zclsty(), zsekty(), znotty()
+extern	zgettt(), zputtt(), zflstt(), zstttt(), zclstt(), zsektt(), znottt()
+extern	zgetnu(), zputnu(), zflsnu(), zsttnu(), zclsnu(), zseknu(), znotnu()
+extern	zardbf(), zawrbf(), zawtbf(), zsttbf(), zclsbf()
+extern	zardsf(), zawrsf(), zawtsf(), zsttsf(), zclssf()
+extern	zardpr(), zawrpr(), zawtpr(), zsttpr(), pr_zclspr()
+extern	zardps(), zawrps(), zawtps(), zsttps(), zclsps()
+extern	zardnu(), zawrnu(), zawtnu()
+
+include	<fio.com>
+data	first_time /YES/
+errchk	syserr
+
+begin
+	# If we are called more than once it is probably due to a name conflict
+	# with a user routine, so generate a fatal error abort.
+
+	if (first_time == YES)
+	    first_time = NO
+	else iferr (call syserr (SYS_FINITREP))
+	    call erract (EA_FATAL)
+
+	# Free up all the file descriptors.  Note that FDs 1 through FIRST_FD
+	# will be assigned to CLIN through STDERR by CLOPEN.
+
+	do fd = 1, LAST_FD
+	    fiodes[fd] = NULL
+
+	# Install the standard devices in the device table.  The first entry
+	# should be the standard text file device, followed by the standard
+	# binary file device.  NOTE: the standard devices must be installed
+	# in the table in the order TX,BF,TY,PR,SF to agree with the device
+	# code definitions in fio.h.  The NU drivers implement the nullfile.
+
+	next_dev = 1
+	call fdevtx (zgettx, zputtx, zflstx, zstttx, zclstx, zsektx, znottx)
+	call fdevbf (zardbf, zawrbf, zawtbf, zsttbf, zclsbf)
+	call fdevtx (zgettt, zputtt, zflstt, zstttt, zclstt, zsektt, znottt)
+	call fdevbf (zardpr, zawrpr, zawtpr, zsttpr, pr_zclspr)
+	call fdevbf (zardsf, zawrsf, zawtsf, zsttsf, zclssf)
+
+	call fdevtx (zgetty, zputty, zflsty, zsttty, zclsty, zsekty, znotty)
+	call fdevtx (zgetnu, zputnu, zflsnu, zsttnu, zclsnu, zseknu, znotnu)
+	call fdevbf (zardnu, zawrnu, zawtnu, zsttnu, zclsnu)
+	call fdevbf (zardps, zawrps, zawtps, zsttps, zclsps)
+
+	# Initialize the TEMP_FILE handler.
+	call fsvtfn ("")
+
+	# Initialize the TT logical terminal driver.
+	call zsettt (0, TT_INITIALIZE, 0)
+end
diff --git a/sys/fio/fioclean.x b/sys/fio/fioclean.x
new file mode 100644
index 00000000..4b4671a3
--- /dev/null
+++ b/sys/fio/fioclean.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fset.h>
+include	<error.h>
+include	<fio.h>
+
+# FIO_CLEANUP -- Clean up FIO after a crash, or upon normal termination of
+# a task.  Flush all open files (harmless on read only files, closed files).
+# Close all open user files, unless the KEEP flag bit is set.  Delete any
+# partial new files, and all temporary files.  Since this routine is called
+# during error restart, convert any errors into warning messages to avoid an
+# infinite loop.
+
+procedure fio_cleanup (status)
+
+int	status
+
+int	fd
+bool	stddev
+int	mode, ref_count
+include	<fio.com>
+errchk	close
+
+begin
+	call flush (STDERR)
+	call fio_qflush (STDOUT,   status)
+	call fio_qflush (STDGRAPH, status)
+	call fio_qflush (STDIMAGE, status)
+	call fio_qflush (STDPLOT,  status)
+
+	for (fd=1;  fd < FIRST_FD;  fd=fd+1) {
+	    # Cancel any pushback on the standard streams.
+	    if (and (fflags[fd], FF_PUSHBACK) != 0)
+		call fcanpb (fd)
+
+	    # If any of the standard streams have been redirected locally (>0),
+	    # cancel the redirection and close the redirection files.
+	    # If streams were redirected by parent (<0), cancel the flag as
+	    # the duration of the flag is only until task termination.
+
+	    if (redir_fd[fd] > 0) {
+		iferr (call close (fd))
+		    ;
+	    } else if (redir_fd[fd] < 0)
+		redir_fd[fd] = 0
+	}
+
+	# Restore the default no flush on newline attribute to STDOUT.
+	call fseti (STDOUT, F_FLUSHNL, NO)
+
+	# Delete any files opened TEMP_FILE during program execution.
+	iferr (call frmtmp())
+	    call erract (EA_WARN)
+
+	# Close all open user files unless the F_KEEP (keep open) flag has
+	# been set.
+
+	for (fd=FIRST_FD;  fd <= LAST_FD;  fd=fd+1) {
+	    fp = fiodes[fd]
+
+	    if (fp != NULL) {				# file open?
+		# Do nothing if file is to be kept open.
+		if (and (FF_KEEP, fflags[fd]) != 0)
+		    next
+
+		# Do not try to flush the output of a string file, or it
+		# will cause error recursion.   The mode of the string file
+		# is reset to READ_ONLY to avoid writing the EOS at the end
+		# of the string buffer, as if the file is being closed during
+		# cleanup following task termination (which should not
+		# normally be the case) the buffer may no longer exist.
+
+		if (FTYPE(fp) == STRING_FILE) {
+		    call strsetmode (fd, READ_ONLY)
+		    call close (fd)
+		    next
+		} else if (FTYPE(fp) == SPOOL_FILE) {
+		    call close (fd)
+		    next
+		}
+
+		iferr (call fio_qflush (fd, status))
+		    call erract (EA_WARN)		# keep open?
+
+		stddev = (FDEV(fp)==TX_DRIVER || FDEV(fp)==BF_DRIVER)
+		call strcpy (FNAME(fp), pathname, SZ_PATHNAME)
+		ref_count = FREFCNT(fp) - 1
+		mode = FMODE(fp)
+
+		iferr {
+		    call close (fd)
+
+		    # Delete any new files that have been only partially
+		    # written into.
+
+		    if (stddev && mode == NEW_FILE && ref_count <= 0)
+			call delete (pathname)
+		} then
+		    call erract (EA_WARN)
+	    }
+	}
+end
+
+
+# FIO_QFLUSH -- If cleanup is being performed following normal task completion
+# (status is OK), flush any buffered output to file.  If cleanup occurs during
+# error restart, cancel any buffered output.
+
+procedure fio_qflush (fd, status)
+
+int	fd, status
+pointer	bp
+include	<fio.com>
+
+begin
+	if (status == OK) {
+	    # Flush any buffered output.
+	    call flush (fd)
+
+	} else {
+	    # Cancel any buffered output.
+	    call fcanpb (fd)
+
+	    bp = bufptr[fd]
+	    itop[fd] = bp
+	    otop[fd] = bp
+	    iop[fd] = bp
+	}
+end
diff --git a/sys/fio/flsbuf.x b/sys/fio/flsbuf.x
new file mode 100644
index 00000000..6f651577
--- /dev/null
+++ b/sys/fio/flsbuf.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# FLSBUF -- Flush the file buffer.  Called by PUTC, PUTLINE, and WRITE
+# when the i/o pointer no longer points into the file buffer.  Prior to
+# the first write to a buffer, the OTOP pointer will be set to the 
+# beginning of the buffer.  The first call to FLSBUF advances OTOP to the
+# end of the buffer.  The next call to FLSBUF finds the buffer "dirty",
+# and flushes the buffer, leaving the buffer ready to be written into
+# (OTOP left pointing at the end of the buffer).  A seek on a binary file
+# will usually leave the i/o pointer pointing outside the buffer, which
+# requires a call to FFAULT (file fault).
+
+procedure flsbuf (fd, nreserve)
+
+int	fd, nreserve
+pointer	bp
+bool	iop_in_range
+int	nchars_written, ffault(), and()
+errchk	fmkbfs, syserr, filerr, ffault
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	bp = bufptr[fd]
+
+	if (fd <= 0 || fp == NULL)			# verification
+	    call syserr (SYS_FILENOTOPEN)
+	else if (and (FF_WRITE, fflags[fd]) == 0) {
+	    if (FTYPE(fp) == SPOOL_FILE) {
+		if (otop[fd] < buftop[fd])
+		    otop[fd] = buftop[fd]
+		else
+		    call fexbuf (fd)
+		return
+	    } else
+		call filerr (FNAME(fp), SYS_FNOWRITEPERM)
+	}
+
+	iop_in_range = iop[fd] >= bufptr[fd] && iop[fd] < buftop[fd]
+
+	if (bp == NULL) {				# no buffer yet
+	    call fmkbfs (fd)
+	    bp = bufptr[fd]
+	    itop[fd] = bp
+	    if (FTYPE(fp) == BINARY_FILE)
+		nchars_written = ffault (fd, LNOTE(fd), nreserve, FF_WRITE)
+	    else
+		nchars_written = 0
+					
+	} else if (iop_in_range && otop[fd] < buftop[fd]) {
+	    nchars_written = 0				# buffer not full yet?
+
+	} else if (FTYPE(fp) == TEXT_FILE) {		# text files
+	    call fputtx (fd, Memc[bp], iop[fd] - bp, nchars_written)
+	    iop[fd] = bp
+	    itop[fd] = bp
+
+	} else						# binary files
+	    nchars_written = ffault (fd, LNOTE(fd), nreserve, FF_WRITE)
+
+	otop[fd] = buftop[fd]				# make space available
+
+	if (nchars_written == ERR)
+	    call filerr (FNAME(fp), SYS_FWRITE)
+end
diff --git a/sys/fio/flush.x b/sys/fio/flush.x
new file mode 100644
index 00000000..9d321059
--- /dev/null
+++ b/sys/fio/flush.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# FLUSH -- Flush any buffered output to the file.
+
+procedure flush (fd)
+
+int	fd
+pointer	bp
+int	status, and()
+errchk	filerr, fflsbf, fwatio
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fp == NULL)
+	    return
+	else if (FTYPE(fp) == STRING_FILE || FTYPE(fp) == SPOOL_FILE)
+	    return
+	bp = bufptr[fd]
+
+	call fcanpb (fd)	# cancel any pushback
+	UPDATE_IOP(fd)		# update the i/o pointers
+
+	if (BUF_MODIFIED(fd)) {
+	    # Buffer has been written into and must be flushed to disk.
+	    if (and (FF_WRITE, fflags[fd]) == 0)
+		call filerr (FNAME(fp), SYS_FNOWRITEPERM)
+
+	    if (FTYPE(fp) == TEXT_FILE) {
+		call fputtx (fd, Memc[bp], otop[fd] - bp, status)
+		iop[fd] = bp
+		itop[fd] = bp
+	    } else {
+		call fflsbf (fd, bp, otop[fd]-bp, boffset[fd])
+		call fwatio (fd)
+		if (FBLKSIZE(fp) == 0) {	# streaming device?
+		    boffset[fd] = LNOTE(fd)
+		    iop[fd] = bp
+		    otop[fd] = bp
+		    itop[fd] = bp
+		}
+		status = FILSTAT(fp)
+	    }
+
+	    if (status == ERR)
+		call filerr (FNAME(fp), SYS_FWRITE)
+	    otop[fd] = bp
+	}
+
+	if (FTYPE(fp) == TEXT_FILE && and (FF_WRITE, fflags[fd]) != 0)
+	    call zcall2 (ZFLSTX(fp), FCHAN(fp), status)
+
+	if (status == ERR)
+	    call filerr (FNAME(fp), SYS_FWRITE)
+end
diff --git a/sys/fio/fmapfn.x b/sys/fio/fmapfn.x
new file mode 100644
index 00000000..20fed43a
--- /dev/null
+++ b/sys/fio/fmapfn.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FMAPFN -- Map the VFN of an existing file to a packed OSFN.  ERR is returned
+# if there is insufficient information in the VFN database to map the filename.
+# OK is returned if the mapping can be performed, but a status of OK does not
+# imply that the named file exists.
+
+procedure fmapfn (vfn, osfn, maxch)
+
+char	vfn[ARB]		# virtual filename of file to be mapped.
+char	osfn[maxch]		# packed OS filename (output)
+int	maxch
+
+int	status, ip, delim
+pointer	vfd, sp, nodename
+pointer	vfnopen()
+int	vfnmapu(), ki_gnode()
+errchk	vfnopen, vfnmapu, syserrs
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_FNAME, TY_CHAR)
+
+	# Map VFN to OSFN.
+
+	vfd = vfnopen (vfn, READ_ONLY)
+	status = vfnmapu (vfd, osfn, maxch)
+	call vfnclose (vfd, VFN_NOUPDATE)
+
+	if (status == ERR)
+	    call syserrs (SYS_FNOSUCHFILE, vfn)
+
+	# If the file resides on the local node strip the node name, returning
+	# a legal host system filename as the result.
+
+	if (ki_gnode (osfn, Memc[nodename], delim) == 0)
+	    ip = delim + 1
+	else
+	    ip = 1
+
+	call osfn_pkfname (osfn[ip], osfn, maxch)
+	call sfree (sp)
+end
diff --git a/sys/fio/fmkbfs.x b/sys/fio/fmkbfs.x
new file mode 100644
index 00000000..12102e88
--- /dev/null
+++ b/sys/fio/fmkbfs.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FMKBFS -- Make file buffer.  Called by FILBUF or FLSBUF when i/o is first
+# done on a file, to create the file buffer.  Note that the logical offset
+# must be maintained when the buffer pointer is changed.
+
+procedure fmkbfs (fd)
+
+int	fd
+pointer	bp
+int	dev_blksz
+long	offset
+errchk	malloc, FBUF_ALLOC
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	# Apply constraints on the size of a file i/o buffer.
+
+	if (FTYPE(fp) != TEXT_FILE) {
+	    # Promote the input buffer size to the next integral number of
+	    # device blocks.
+
+	    dev_blksz = FBLKSIZE(fp)
+	    if (dev_blksz > 1) {
+		FBUFSIZE(fp) = (FBUFSIZE(fp) + dev_blksz-1) /
+		    dev_blksz * dev_blksz
+	    } else
+		FBUFSIZE(fp) = max (1, FBUFSIZE(fp))
+
+	    # There is no maximum buffer (i/o transfer) size if the value
+	    # returned by the kernel is zero.
+
+	    if (FMAXBUFSIZE(fp) > 0)
+		FBUFSIZE(fp) = min (FMAXBUFSIZE(fp), FBUFSIZE(fp))
+	}
+
+	# Note file offset, allocate buffer and initialize i/o pointers,
+	# restore seek offset (which depends on buffer pointer, buf offset).
+
+	offset = LNOTE(fd)
+	if (FTYPE(fp) == TEXT_FILE)
+	    call malloc (bp, FBUFSIZE(fp), TY_CHAR)
+	else
+	    call FBUF_ALLOC (bp, FBUFSIZE(fp), TY_CHAR)
+
+	boffset[fd] = NULL
+	bufptr[fd] = bp
+	buftop[fd] = bp + FBUFSIZE(fp)
+	itop[fd] = bp
+	otop[fd] = bp
+
+	if (FTYPE(fp) == BINARY_FILE)
+	    LSEEK (fd, offset)
+	else
+	    iop[fd] = bp
+end
diff --git a/sys/fio/fmkcopy.x b/sys/fio/fmkcopy.x
new file mode 100644
index 00000000..c49cff19
--- /dev/null
+++ b/sys/fio/fmkcopy.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+include	<fio.h>
+
+# FMKCOPY -- Create a null length copy of an existing file.  The new file
+# inherits all the directory attributes of the original file.  For example,
+# if the oldfile is an executable file, the new one will be too.  This avoids
+# file copy operations which copy the file data but lose file attributes.
+# Interrupts are disabled while the VFN database is open to protect the
+# database, ensure that that the lock on the mapping file is cleared, and to
+# ensure that the mapping file is closed.
+
+procedure fmkcopy (oldfile, newfile)
+
+char	oldfile[ARB]		# file to be copied
+char	newfile[ARB]		# newfile
+
+char	url[SZ_PATHNAME], old[SZ_PATHNAME]
+int	status, file_exists, junk
+pointer	vp, sp, oldosfn, newosfn
+int	vfnadd(), strncmp(), nowhite()
+pointer	vfnopen()
+errchk	delete, filerr, fmapfn, fclobber
+include	<fio.com>
+define	close_ 91
+define	abort_ 92
+
+begin
+	call smark (sp)
+	call salloc (oldosfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (newosfn, SZ_PATHNAME, TY_CHAR)
+
+
+        # If we're given a URL to a file, cache it.
+	call aclrc (old, SZ_PATHNAME)
+        if (strncmp ("http:", oldfile, 5) == 0)
+	    return
+        else if (strncmp ("file:", oldfile, 5) == 0)
+	    return
+        else {
+            # Strip any whitespace at either end of the filename.
+            if (nowhite (oldfile, old, SZ_PATHNAME) == 0)
+                call syserr (SYS_FNOFNAME)
+        }
+
+	# Get OSFN of old file and verify that the file exists.
+
+	call fmapfn (old, Memc[oldosfn], SZ_PATHNAME)
+	call zfacss (Memc[oldosfn], 0, 0, file_exists)
+	if (file_exists == NO)
+	    call filerr (oldfile, SYS_FOPEN)
+
+	# Perform clobber checking, delete old file if one exists.
+	# Note that this must be done before opening the new VFN for
+	# writing or deadlock may occur.
+
+	call fclobber (newfile)
+	
+	# Add the new VFN to the VFN database and create the new file.
+
+	call intr_disable()
+	iferr (vp = vfnopen (newfile, VFN_WRITE))
+	    goto abort_
+	iferr (junk = vfnadd (vp, Memc[newosfn], SZ_PATHNAME))
+	    goto close_
+
+	call zfmkcp (Memc[oldosfn], Memc[newosfn], status)
+	if (status == ERR) {
+	    iferr (call filerr (newfile, SYS_FMKCOPY))
+		goto close_
+	} else
+	    iferr (call vfnclose (vp, VFN_UPDATE))
+		goto abort_
+
+	call intr_enable()
+	call sfree (sp)
+	return
+
+
+	# Error recovery nasties.
+close_
+	iferr (call vfnclose (vp, VFN_NOUPDATE))
+	    ;
+abort_
+	call intr_enable()
+	call sfree (sp)
+	call erract (EA_ERROR)
+end
diff --git a/sys/fio/fmkdir.x b/sys/fio/fmkdir.x
new file mode 100644
index 00000000..79e1454b
--- /dev/null
+++ b/sys/fio/fmkdir.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# FMKDIR -- Create a new, empty directory.  An error action is taken if the
+# name of the new directory is too long, if a file already exists with the
+# same name, or if there is no write permission on the directory.
+
+procedure fmkdir (newdir)
+
+char	newdir[ARB]		# virtual or OS-dependent directory spec
+
+int	status
+pointer	sp, osfn, dirname
+int	access()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (dirname, SZ_PATHNAME, TY_CHAR)
+
+	# It is an error if the named file already exists, be it a directory
+	# or not.  If the file does not exist but the filename cannot be
+	# mapped that indicates that the directory name is too long and
+	# FMAPFN tried to access the mapping file.  Filename mapping does not
+	# currently map long directory names so we do not permit directories
+	# with long names to be created here.  Filename mapping (using the
+	# mapping file) is intentionally not supported for reasons of
+	# efficiency and to discourage use of very long diectory names, which
+	# would tend to overflow filename buffers.
+
+	if (access (newdir, 0, 0) == YES)
+	    call syserrs (SYS_FMKDIR, newdir)
+	iferr (call fmapfn (newdir, Memc[osfn], SZ_PATHNAME))
+	    call syserrs (SYS_FMKDIRFNTL, newdir)
+	
+	# Always present ZFMKDR with a directory pathname (rather than an
+	# absolute or cwd relative filename), in case the kernel procedure
+	# is not smart enough to handle all these possibilities.
+
+	call strupk (Memc[osfn], Memc[osfn], SZ_PATHNAME)
+	call zfpath (Memc[osfn], Memc[dirname], SZ_PATHNAME, status)
+	if (status != ERR)
+	    call zfsubd (Memc[dirname], SZ_PATHNAME, "", status)
+
+	# Try to create the new directory.  If the directory cannot be created
+	# use the OS name of the directory in the error message to close the
+	# loop with the user.
+
+	if (status != ERR) {
+	    call strpak (Memc[dirname], Memc[osfn], SZ_PATHNAME)
+	    call zfmkdr (Memc[osfn], status)
+	}
+	if (status == ERR)
+	    call syserrs (SYS_FMKDIR, Memc[dirname])
+
+	call sfree (sp)
+end
diff --git a/sys/fio/fmkpbbuf.x b/sys/fio/fmkpbbuf.x
new file mode 100644
index 00000000..ee891949
--- /dev/null
+++ b/sys/fio/fmkpbbuf.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FMKPBBUF -- Make the push back buffer.  Called when the first attempt is
+# made to push data back into an input stream.
+
+procedure fmkpbbuf (fd)
+
+int	fd
+int	buflen
+pointer	bp
+errchk	malloc
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (bufptr[fd] == NULL)
+	    call fmkbfs (fd)
+
+	buflen = FPBBUFSIZE(fp)
+	if (buflen <= 0) {
+	    buflen = SZ_PBBUF
+	    FPBBUFSIZE(fp) = buflen
+	}
+
+	call malloc (bp, buflen, TY_CHAR)
+
+	FPBBUF(fp) = bp
+	FPBTOP(fp) = bp + buflen
+	FPBIOP(fp) = bp
+	FPBSP(fp) = (FPBTOP(fp) - 1) / SZ_INT + 1
+end
diff --git a/sys/fio/fnextn.x b/sys/fio/fnextn.x
new file mode 100644
index 00000000..47e73a08
--- /dev/null
+++ b/sys/fio/fnextn.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FNEXTN -- Extract the file name extension from a virtual file name (or a
+# machine dependent file name.  If the VFN contains no extension field, the
+# null string is returned.  The number of chars in the extension string is
+# returned as the function value.
+
+int procedure fnextn (vfn, outstr, maxch)
+
+char	vfn[ARB], outstr[maxch]
+int	maxch
+int	root_offset, extn_offset
+int	gstrcpy()
+
+begin
+	call zfnbrk (vfn, root_offset, extn_offset)
+	if (vfn[extn_offset] != EOS)
+	    extn_offset = extn_offset + 1
+
+	return (gstrcpy (vfn[extn_offset], outstr, maxch))
+end
diff --git a/sys/fio/fnldir.x b/sys/fio/fnldir.x
new file mode 100644
index 00000000..2bcfbd94
--- /dev/null
+++ b/sys/fio/fnldir.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FNLDIR -- Extract the logical directory prefix from a virtual file name,
+# e.g., the "ldir$" field in  "ldir$root.extn",  or the field "ldir$a/b/"
+# in the vfn  "ldir$a/b/file.xtn".  Both logical and OS dependent directory
+# prefixes are successfully extracted.  The prefix returned is the (logical
+# or explicit) file name of the directory containing the named file.  If the
+# VFN contains no logical directory field, the null string is returned,
+# signifying the current directory.  The number of chars in the directory
+# prefix is returned as the function value.
+
+int procedure fnldir (vfn, outstr, maxch)
+
+char	vfn[ARB], outstr[maxch]
+int	maxch
+int	root_offset, extn_offset
+int	gstrcpy()
+
+begin
+	call zfnbrk (vfn, root_offset, extn_offset)
+	return (gstrcpy (vfn[1], outstr, min (maxch, root_offset-1)))
+end
diff --git a/sys/fio/fnroot.x b/sys/fio/fnroot.x
new file mode 100644
index 00000000..91042e87
--- /dev/null
+++ b/sys/fio/fnroot.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FNROOT -- Extract the root file name from a virtual file name (or from a
+# machine dependent filename.  If the VFN contains no root name, the null
+# string is returned.  This occurs when the VFN refers to a directory or
+# device, or when the VFN string is a null string.  The number of chars in
+# the root file name is returned as the function value.
+
+int procedure fnroot (vfn, outstr, maxch)
+
+char	vfn[ARB], outstr[maxch]
+int	maxch
+int	root_offset, extn_offset, nchars_root
+int	gstrcpy()
+
+begin
+	call zfnbrk (vfn, root_offset, extn_offset)
+	nchars_root = max(0, min(maxch, extn_offset - root_offset))
+
+	return (gstrcpy (vfn[root_offset], outstr, nchars_root))
+end
diff --git a/sys/fio/fntgfn.x b/sys/fio/fntgfn.x
new file mode 100644
index 00000000..3f2ba5de
--- /dev/null
+++ b/sys/fio/fntgfn.x
@@ -0,0 +1,1004 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<pattern.h>
+include	<syserr.h>
+include	<diropen.h>
+
+.help fntgfn
+.nf _________________________________________________________________________
+File Name Template Package
+
+This package contains routines to expand a file name template string into a
+list of file names, and to access the individual elements of the list.  The
+template is a list of file names, patterns, and/or list file names.  The
+concatenation operator may be used within input list elements to form new
+output filenames.  String substitution may also be used to form new filenames.
+
+Sample template string:
+
+	alpha, *.x, data* // .pix, [a-m]*, @list_file
+
+This template would be expanded as the file "alpha", followed in successive
+calls by all the files in the current directory whose names end in ".x",
+followed by all files whose names begin with "data" with the extension ".pix"
+appended, and so on.  The @ character signifies a list file (file containing
+regular file names).
+
+String substitution uses the first string given for the template, expands
+the template, and for each filename generated by the template, substitutes
+the second string to generate a new filename.  Some examples follow.
+
+	*.%x%y%			change extension to `y'
+	*%%_abc%.imh		append `_abc' to root
+	nite%1%2%.1024.imh	change `nite1' to `nite2'
+
+Main entry points:
+
+	fntopnb - expand template and open a buffered filename list
+	fntgfnb - get next filename from buffered list (sequential)
+	fntrfnb - get next filename from buffered list (random)
+	fntclsb - close buffered list
+	fntlenb - get number of filenames in a buffered list
+	fntrewb - rewind the list
+
+Low Level Entry Points:
+
+	 fntopn - open an unbuffered filename list
+	 fntgfn - get next filename from unbuffered list
+	 fntcls - close unbuffered list
+
+The B suffix routines are the highest level and most convenient to use.
+The remaining routines expand a template "on the fly" and do not permit
+sorting or determination of the length of the list.
+.endhelp ____________________________________________________________________
+
+# FNTB descriptor structure.
+define	LEN_FNTBHDR		5
+define	FNTB_MAGIC		5164
+define	B_MAGIC			Memi[$1]
+define	B_SBUFPTR		Memi[$1+1]	# string buffer pointer
+define	B_NSTR			Memi[$1+2]	# number of strings
+define	B_STRNUM		Memi[$1+3]	# used to read list
+define	B_STRINDX		Memi[$1+$2-1+4]	# index of string
+
+# FNTU descriptor structure.
+define	LEN_FNTUHDR		(10+1024+256)
+define	FNTU_MAGIC		5664
+define	U_MAGIC			Memi[$1]
+define	U_FILDES		Memi[$1+1]
+define	U_TEMPLATE		Memi[$1+2]	# pointer
+define	U_TEMPLATE_INDEX	Memi[$1+3]
+define	U_PATTERN		(P2C($1+10))
+define	U_LDIR			(P2C($1+1034))
+
+# Special characters and size limiting definitions.
+define	TOK_DELIM		','		# token delimiter
+define	LIST_FILE_CHAR		'@'		# @listfile
+define	CH_EDIT			'%'		# string substitution metachar
+define	SZ_PATTERN		1023
+define	SZ_LDIR			255
+define	SZ_PATSTR		1023
+define	MAX_EDIT		8
+define	MAX_PATTERNS		8
+
+# Tokens.
+define	EO_TEMPLATE		1
+define	LIST_FILE		2
+define	PATTERN_STRING		3
+define	FILE_NAME		4
+
+# Size limiting definitions (initial buffer sizes).
+define	SZ_DEFSTRBUF		2048		# default string buffer size
+define	LEN_INDEXVECTOR		256		# initial length of index vector
+
+
+# FNTOPNB -- General open buffered list routine, for any type of filename list.
+# Expand template into string buffer, sort if so indicated.
+
+int procedure fntopnb (template, sort)
+
+char	template[ARB]		# filename template
+int	sort			# sort expanded patterns
+
+int	nedit[MAX_PATTERNS], junk, nchars
+bool	is_template[MAX_PATTERNS], is_edit[MAX_PATTERNS], sortlist, is_url
+pointer	sp, pbuf, fname, rname, extn, ebuf, sbuf, list, ip, op, ep, pp
+pointer	patp[MAX_PATTERNS], flist[MAX_PATTERNS], editp[MAX_EDIT]
+int	nlists, npat, nstr, maxstr, nextch, sz_sbuf, ix, first_string, ch, i
+int	fntopn(), fntgfn(), fnt_getpat(), gstrcpy(), fnt_edit(), stridx()
+int	patmake(), patmatch(), strncmp()
+errchk	fntopn, fntgfn, syserr, malloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (rname, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (extn,  SZ_FNAME, TY_CHAR)
+	call salloc (pbuf,  SZ_LINE, TY_CHAR)
+	call salloc (ebuf,  SZ_LINE, TY_CHAR)
+
+	# Allocate list descriptor.
+	call malloc (list, LEN_FNTBHDR + LEN_INDEXVECTOR, TY_INT)
+	call malloc (sbuf, SZ_DEFSTRBUF, TY_CHAR)
+
+	B_MAGIC(list) = FNTB_MAGIC
+	maxstr = LEN_INDEXVECTOR
+	sz_sbuf = SZ_DEFSTRBUF
+	nextch = 1				# offset into string buffer
+	nstr = 0
+
+	# Read the file names into the string buffer.  Dynamically adjust
+	# the size of the string buffer and/or index vector as necessary.
+	# There must always be at least SZ_FNAME chars left in the string
+	# buffer.  The outer loop is over comma delimited fields of the
+	# filename template.  The inner loop is over individual filenames.
+
+	ix = 1
+	while (fnt_getpat (template, ix, patp, npat, pbuf, SZ_LINE) > 0) {
+	    first_string = nstr + 1
+	    sortlist = (sort == YES)
+	    nlists = 0
+	    ep = ebuf
+
+	    # Each piece of the current comma delimited template may consist
+	    # of several sublists to be independently expanded and concatenated
+	    # to form each output filename.  The lists must either be degenerate
+	    # (a simple string) or actual lists to be expanded with FNTOPN.
+
+	    do i = 1, npat {
+		is_template[i] = false
+		is_edit[i] = false
+		nedit[i] = 0
+		op = patp[i]
+
+		# Examine sublist to see if it is a template or a string
+		# constant.  If template, open file list.  Template
+		# metacharacters may be escaped to be included in filenames.
+		# If the pattern contains edit substitution sequences it
+		# must be processed to remove the substitution strings.
+
+		is_url = false
+		for (ip=op;  Memc[ip] != EOS;  ip=ip+1) {
+		    ch = Memc[ip]
+
+		    if (ch == ':' && strncmp (Memc[ip+1], "//", 2) == 0) {
+			# URL string.
+			is_template[i] = false
+			is_edit[i] = false
+			is_url = true
+		    } else if (!is_url && stridx (Memc[ip], "@*?[%") > 0) {
+			if (ip > patp[i] && Memc[ip-1] == '\\') {
+			    Memc[op-1] = ch
+			    ip = ip + 1
+			    ch = Memc[ip]
+			} else if (ch == CH_EDIT) {
+			    is_edit[i] = true
+			} else {
+			    if (ch == '@' && op == ip)
+				sortlist = false
+			    if (!is_url)
+			        is_template[i] = true
+			}
+		    }
+
+		    Memc[op] = ch
+		    op = op + 1
+		}
+
+		Memc[op] = EOS
+
+		# Open filename template if pattern contained metacharacters.
+		# A string constant containing edit string substitution is a
+		# special case, eg. "file%%_2%.ext".
+
+		if (is_template[i] || is_edit[i]) {
+		    editp[i] = ep
+		    call fnt_mkpat (Memc[patp[i]], Memc[fname], SZ_FNAME,
+			ep, nedit[i])
+		    flist[i] = fntopn (Memc[fname])
+
+		    # In the case of a string constant edit we do not really
+		    # have a file template, but we open one anyhow just to
+		    # make use of the common code and the descriptor.
+
+		    if (!is_template[i]) {
+			# Encode the pattern (containing the %%).
+			junk = patmake (Memc[fname], Memc[U_PATTERN(flist[i])],
+			    SZ_PATTERN)
+
+			# Strip the %% from the pattern, leaving the "input"
+			# filename in patp[i].
+
+			op = patp[i]
+			for (ip=fname;  Memc[ip] != EOS;  ip=ip+1)
+			    if (Memc[ip] != CH_EDIT) {
+				Memc[op] = Memc[ip]
+				op = op + 1
+			    }
+			Memc[op] = EOS
+
+			# Now match the stripped pattern against the %%
+			# pattern.  This sets up U_PATTERN for the edit.
+
+			junk = patmatch (Memc[patp[i]],
+			    Memc[U_PATTERN(flist[i])])
+		    } else
+			nlists = nlists + 1
+		}
+	    }
+
+	    # Expand the template into a sequence of filenames in the string
+	    # buffer, saving the indices of the list elements in the STRINDX
+	    # array.  Reallocate a larger buffer if necessary.  If the sublists
+	    # are not all the same length the shortest list will terminate the
+	    # output list.
+
+	    repeat {
+		# Concatenate the next element from each sublist; the sublists
+		# may be either real lists or string constants.  Concatenate
+		# only to the root filename.
+
+		Memc[extn] = EOS
+		op = fname
+
+		do i = 1, npat {
+		    # Save first extension field encountered and set op to
+		    # end of root.
+
+		    if (Memc[extn] == EOS)
+			for (ip=op-1;  ip > fname;  ip=ip-1)
+			    if (Memc[ip] == '.') {
+				call strcpy (Memc[ip], Memc[extn], SZ_FNAME)
+				op = ip
+				break
+			    }
+
+		    # Concatenate the next file element.  This can be either a
+		    # file name from a file template, a constant file name from
+		    # a string edit expression, or a simple string constant.
+
+		    if (!is_url && (is_template[i] || is_edit[i])) {
+			ip = rname
+			pp = flist[i]
+			if (is_template[i]) {
+			    if (fntgfn (pp, Memc[rname], SZ_FNAME) == EOF) {
+				op = fname
+				break
+
+			    } else if (U_FILDES(pp) != NULL) {
+				# Reading from a directory or list; set offset
+				# of substring to be edited to exclude any
+				# ldir prefix, since this will not have been
+				# used for the pattern match.
+
+				nchars = gstrcpy (Memc[U_LDIR(pp)],Memc[op],ARB)
+				op = op + nchars
+				ip = ip + nchars
+			    }
+			} else
+			    call strcpy (Memc[patp[i]], Memc[rname], SZ_FNAME)
+
+			op = op + fnt_edit (Memc[ip], Memc[op], editp[i],
+			    nedit[i], Memc[U_PATTERN(pp)])
+
+		    } else {
+			op = op + gstrcpy (Memc[patp[i]], Memc[op], ARB)
+		    }
+		}
+
+		# End of list if nothing returned.
+		if (op == fname)
+		    break
+
+		# Tack extension back on.
+		if (Memc[extn] != EOS)
+		    op = op + gstrcpy (Memc[extn], Memc[op], ARB)
+
+		# Need more room for list element pointers?
+		nstr = nstr + 1
+		if (nstr > maxstr) {
+		    maxstr = maxstr + LEN_INDEXVECTOR
+		    call realloc (list, LEN_FNTBHDR + maxstr, TY_INT)
+		}
+
+		# Out of space in string buffer?
+		if (nextch + (op - fname) >= sz_sbuf) {
+		    sz_sbuf = sz_sbuf + SZ_DEFSTRBUF
+		    call realloc (sbuf, sz_sbuf, TY_CHAR)
+		}
+
+		# Save index of list element, move chars to string buffer.
+		# Allow space for the EOS after each string.
+
+		B_STRINDX(list,nstr) = nextch
+		nextch = nextch +
+		    gstrcpy (Memc[fname], Memc[sbuf+nextch-1], ARB) + 1
+
+	    } until (nlists == 0)
+
+	    do i = 1, npat
+		if (is_template[i] || is_edit[i])
+		    call fntcls (flist[i])
+
+	    # If sorting is desired and the pattern did not specify an explicit
+	    # list (e.g., "@listfile"), sort the last batch of filenames.
+
+	    if (sortlist && nstr > first_string)
+		call strsrt (B_STRINDX(list,first_string), Memc[sbuf],
+		    nstr - first_string + 1)
+	}
+
+	# Update the string buffer descriptor, return unused buffer space.
+	# Rewind the list in preparation for reading (set strnum=1).
+
+	call realloc (sbuf, nextch, TY_CHAR)
+	call realloc (list, LEN_FNTBHDR + nstr, TY_INT)
+
+	B_NSTR(list)	= nstr
+	B_STRNUM(list)	= 1
+	B_SBUFPTR(list)	= sbuf
+
+	call sfree (sp)
+	return (list)
+end
+
+
+# FNT_MKPAT -- Take a pattern string possibly containing %a%b% string
+# substitution sequences, returning a pattern string as required for PATMAKE,
+# and a sequence of substitution strings for later use by FNT_EDIT to edit
+# filenames matched by FNTGFN.
+
+procedure fnt_mkpat (pat, patstr, maxch, ep, nedit)
+
+char	pat[ARB]		# pattern with embedded substitution sequences
+char	patstr[maxch]		# receives pattern as req'd by PATMAKE
+int	maxch
+pointer	ep			# where to put substitution string chars
+int	nedit			# number of substitution chars
+
+int	nhat
+int	ip, op
+
+begin
+	nedit = 0
+	nhat  = 0
+	op    = 1
+
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == CH_EDIT) {
+		if (ip > 1 && pat[ip-1] == '\\') {
+		    # Moved escaped metacharacter to pattern string.
+		    patstr[op] = pat[ip]
+		    op = op + 1
+
+		} else if (nhat > 0) {
+		    # Copy substitution string to ebuf.
+		    patstr[op] = pat[ip]
+		    op = op + 1
+		    nedit = nedit + 1
+
+		    ip = ip + 1
+		    while (pat[ip] != EOS && pat[ip] != CH_EDIT) {
+			Memc[ep] = pat[ip]
+			ep = ep + 1
+			ip = ip + 1
+		    }
+
+		    Memc[ep] = EOS
+		    ep = ep + 1
+		    if (pat[ip] == EOS)
+			ip = ip - 1
+		    nhat = 0
+
+		} else {
+		    patstr[op] = pat[ip]
+		    op = op + 1
+		    nhat = nhat + 1
+		}
+
+	    } else {
+		patstr[op] = pat[ip]
+		op = op + 1
+		if (op > maxch)
+		    break
+	    }
+	}
+
+	patstr[op] = EOS
+end
+
+
+# FNT_EDIT -- Perform string substitution on a matched filename, using the
+# list of substitution strings written by FNT_MKPAT, the first of which is
+# pointed to by EDITP.  The regions to be replaced were marked symbolically
+# by the CH_EDIT characters in the user supplied pattern.  The actual indices
+# of these regions depend upon the actual filename and are saved by the
+# pattern matching code in the encoded pattern buffer PATBUF, for retrieval
+# by PATINDEX.  Carry out the substitution and return the length of the
+# output string as the function argument.
+
+int procedure fnt_edit (in, out, editp, nedit, patbuf)
+
+char	in[ARB]			# input string to be edited
+char	out[ARB]		# receives edited string
+pointer	editp			# pointer to first substitution string
+int	nedit			# number of edits required
+char	patbuf[ARB]		# encoded pattern
+
+pointer	ep
+int	ip1, ip2, ip, op, i
+int	patindex()
+
+begin
+	ep = editp - 1
+	ip = 1
+	op = 1
+
+	do i = 1, nedit {
+	    # Get indices of first and last+1 characters to be substituted for
+	    # in the input string.
+
+	    ip1 = patindex (patbuf, (i-1) * 2 + 1)
+	    ip2 = patindex (patbuf, (i-1) * 2 + 2)
+	    if (ip1 == 0 || ip2 == 0 || ip1 > ip2)
+		break		# cannot happen
+
+	    # Copy up to first char to be replaced.
+	    for (;  ip < ip1;  ip=ip+1) {
+		out[op] = in[ip]
+		op = op + 1
+	    }
+
+	    # Append substitution string.
+	    for (ep=ep+1;  Memc[ep] != EOS;  ep=ep+1) {
+		out[op] = Memc[ep]
+		op = op + 1
+	    }
+
+	    # Continue at character IP2 in the input string.
+	    ip = ip2
+	}
+
+	# Copy remainder of input string to the output string.
+	for (;  in[ip] != EOS;  ip=ip+1) {
+	    out[op] = in[ip]
+	    op = op + 1
+	}
+
+	out[op] = EOS
+	return (op - 1)
+end
+
+
+# FNTGFNB -- Return the next filename from the list.
+
+int procedure fntgfnb (list, fname, maxch)
+
+pointer	list			# list descriptor pointer
+char	fname[ARB]		# output filename
+int	maxch
+
+pointer	strptr
+int	file_number
+int	gstrcpy()
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	file_number = B_STRNUM(list)
+	if (file_number > B_NSTR(list))
+	    return (EOF)
+	else {
+	    B_STRNUM(list) = file_number + 1
+	    strptr = B_SBUFPTR(list) + B_STRINDX(list,file_number) - 1
+	    return (gstrcpy (Memc[strptr], fname, maxch))
+	}
+end
+
+
+# FNTRFNB -- Return the indexed filename from the list.  For applications
+# which need to access the list at random.  Returns len(fname) or EOF for
+# references to nonexistent list elements.
+
+int procedure fntrfnb (list, index, fname, maxch)
+
+pointer	list			# list descriptor pointer
+int	index			# index of list element to be returned
+char	fname[ARB]		# output filename
+int	maxch
+
+pointer	strptr
+int	gstrcpy()
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	if (index < 1 || index > B_NSTR(list))
+	    return (EOF)
+	else {
+	    strptr = B_SBUFPTR(list) + B_STRINDX(list,index) - 1
+	    return (gstrcpy (Memc[strptr], fname, maxch))
+	}
+end
+
+
+# FNTCLSB -- Close a buffered list and return all storage.
+
+procedure fntclsb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	call mfree (B_SBUFPTR(list), TY_CHAR)
+	call mfree (list, TY_INT)
+end
+
+
+# FNTREWB -- Rewind a buffered filename list.
+
+procedure fntrewb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	B_STRNUM(list) = 1
+end
+
+
+# FNTLENB -- Return the number of filenames in the list.
+
+int procedure fntlenb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	return (B_NSTR(list))
+end
+
+
+# FNT_GETPAT -- Return the next comma delimited field from the template string
+# with any leading or trailing whitespace stripped off.  The field may consist
+# of a simple string constant, a filename template, or a sequence of either
+# delimited by concatenation operators //.  We do not make any distinction here
+# between string constants and patterns; return the \ with all escape sequences
+# as this will be stripped by the higher level code if used to include pattern
+# matching metacharacters in filenames.
+
+int procedure fnt_getpat (template, ix, patp, npat, sbuf, maxch)
+
+char	template[ARB]		# template from which to extract field
+int	ix			# next char in template
+pointer	patp[MAX_PATTERNS]	# receives pointers to sublists (patterns)
+int	npat			# receives number of PATP elements set
+pointer	sbuf			# used to store output strings
+int	maxch			# maxch chars out
+
+int	ch, peek
+bool	is_url
+pointer	op
+
+int	strncmp(), stridx()
+errchk	syserr
+
+begin
+	while (IS_WHITE(template[ix]) || template[ix] == ',')
+	    ix = ix + 1
+
+	patp[1] = sbuf
+	npat = 1
+	op = sbuf
+	is_url = false
+
+	#for (ch=template[ix];  ch != EOS && ch != ',';  ch=template[ix]) {
+	for (ch=template[ix];  ch != EOS;  ch=template[ix]) {
+	    peek = template[ix+1]
+	    if (IS_WHITE (ch)) {
+		# Ignore all whitespace.
+		ix = ix + 1
+		next
+
+	    } else if ((is_url && ch == ',')) {
+		if (stridx (peek, "+-.0123456789") == 0) {
+		    break
+		} else {
+		    # Keep a comma in a URL followed by a digit
+		    Memc[op] = ','
+		    op = op + 1
+		    ix = ix + 1
+		}
+
+	    } else if (!is_url && ch == ',') {
+		break
+
+	    } else if (ch == '\\' && template[ix+1] == ',') {
+		# Escape a comma.
+		Memc[op] = ','
+		op = op + 1
+		ix = ix + 2
+
+	    } else if (!is_url && (ch == '/' && template[ix+1] == '/')) {
+		# Concatenation operator: start a new sublist.
+		Memc[op] = EOS
+		op = op + 1
+		ix = ix + 2
+		npat = npat + 1
+		if (npat > MAX_PATTERNS)
+		    call syserr (SYS_FNTMAXPAT)
+		patp[npat] = op
+
+	    } else if (ch == ':' && strncmp ("//", template[ix+1], 2) == 0) {
+		# Start of URL string, deposit in output list.
+		Memc[op] = ch
+		op = op + 1
+		ix = ix + 1
+		is_url = true
+
+	    } else {
+		# Ordinary character, deposit in output list.
+		Memc[op] = ch
+		op = op + 1
+		ix = ix + 1
+	    }
+
+	    if (op - sbuf > maxch)
+		break
+	}
+
+	Memc[op] = EOS
+	return (op - sbuf)
+end
+
+
+# FNTGFN -- Get the next file name from the named parameter (template).
+# This is the guy that does all the work.  A file name may be selected from
+# a directory file or list file by pattern matching, or may come from the
+# template list string itself.
+
+int procedure fntgfn (pp, outstr, maxch)
+
+pointer	pp			# pattern pointer
+char	outstr[ARB]		# output filename
+int	maxch
+
+bool	match
+pointer	ip, sp, linebuf, fname, patstr
+int	nchars, token, first_ch, last_ch, status
+
+bool	streq()
+int	getline(), gpatmatch(), patmake(), nowhite(), gstrcat()
+int	fnt_read_template(), fnt_open_list()
+errchk	salloc, getline, close, fnt_open_list, syserr
+
+begin
+	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	call smark (sp)					# get buffers
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+	call salloc (patstr, SZ_PATSTR, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	repeat {
+	    # Read file names from either list file or directory file, until
+	    # one is found which matches pattern, or until EOF is reached.
+	    # Make sure pattern matches the ENTIRE file name string, rather
+	    # than a substring.
+
+	    if (U_FILDES(pp) != NULL) {			# reading from a file?
+		while (getline (U_FILDES(pp), Memc[linebuf]) != EOF) {
+		    for (ip=linebuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+			;
+		    nchars = nowhite (Memc[ip], Memc[fname], maxch)
+		    if (nchars == 0)			# skip blank lines
+			next
+
+		    # If the encoded pattern is the null string match anything.
+		    if (Memc[U_PATTERN(pp)] == EOS) {
+			match = true
+		    } else if (gpatmatch (Memc[fname], Memc[U_PATTERN(pp)],
+			first_ch, last_ch) > 0) {
+			match = (first_ch == 1 && last_ch == nchars)
+		    } else
+			match = false
+
+		    if (match) {
+			call strcpy (Memc[U_LDIR(pp)], outstr, maxch)
+			nchars = gstrcat (Memc[fname], outstr, maxch)
+			call sfree (sp)
+			return (nchars)
+		    }
+		}
+
+		call close (U_FILDES(pp))
+		U_FILDES(pp) = NULL
+	    }
+
+	    switch (fnt_read_template (pp, Memc[linebuf], SZ_LINE, token)) {
+	    case EO_TEMPLATE:
+		nchars = EOF
+		outstr[1] = EOS
+		call sfree (sp)
+		return (nchars)
+
+	    case LIST_FILE, PATTERN_STRING:
+		# Break the pattern string into a list file or directory
+		# name and a pattern.
+
+		if (token == PATTERN_STRING) {
+		    Memc[patstr] = '^'
+		    ip = patstr + 1
+		} else
+		    ip = patstr
+
+		U_FILDES(pp) = fnt_open_list (Memc[linebuf], Memc[ip],
+		    SZ_PATSTR-1, Memc[fname], Memc[U_LDIR(pp)], token)
+
+		# Encode the pattern.  If the pattern is matchall set encoded
+		# pattern string to NULL and pattern matching will be skipped.
+
+		if (streq (Memc[patstr], "?*"))
+		    Memc[U_PATTERN(pp)] = EOS
+		else {
+		    status = patmake (Memc[patstr], Memc[U_PATTERN(pp)],
+			SZ_PATTERN)
+		    if (status == ERR)
+			call syserr (SYS_FNTBADPAT)
+		}
+		
+	    default:					# simple file name
+		nchars = nowhite (Memc[linebuf], outstr, maxch)
+		if (nchars > 0) {
+		    call sfree (sp)
+		    return (nchars)
+		}
+	    }
+	}
+end
+
+
+# FNT_READ_TEMPLATE -- Get next token from template string, return integer
+# code identifying the type of token.
+
+int procedure fnt_read_template (pp, outstr, maxch, token)
+
+pointer	pp				#I pointer to param descriptor
+char	outstr[maxch]			#O receives token
+int	maxch				#I max chars out
+int	token				#O token type code
+
+int	nseen, i
+pointer	ip, ip_start, op, cp
+int	stridx(), strncmp()
+
+begin
+	ip = U_TEMPLATE_INDEX(pp)			# retrieve pointer
+	while (IS_WHITE (Memc[ip]))
+	    ip = ip + 1
+
+
+	switch (Memc[ip]) {
+	case EOS:
+	    op = 1
+	    token = EO_TEMPLATE
+
+	case LIST_FILE_CHAR:				# list file spec
+	    ip = ip + 1					# skip the @
+	    for (op=1;  Memc[ip] != TOK_DELIM && Memc[ip] != EOS;  op=op+1) {
+		outstr[op] = Memc[ip]
+		ip = ip + 1
+	    }
+	    token = LIST_FILE
+	    if (Memc[ip] == TOK_DELIM)
+		ip = ip + 1
+
+	default:					# fname or pat string
+	    token = FILE_NAME
+	    # Extract token.  Determine if regular file name or pattern string.
+	    # Disable metacharacters not useful for file name patterns.
+
+	    ip_start = ip
+	    for (op=1;  Memc[ip] != EOS;  ip=ip+1) {
+		if (Memc[ip] == CH_ESCAPE && Memc[ip+1] != EOS) {
+		    # Escape sequence.  Pass both the escape and the escaped
+		    # character on to the lower level code.
+
+		    outstr[op] = CH_ESCAPE
+		    op = op + 1
+		    ip = ip + 1
+
+		} else if (Memc[ip] == TOK_DELIM) {
+		    ip = ip + 1
+		    break
+
+		} else if (Memc[ip] == FNLDIR_CHAR || Memc[ip] == '/') {
+		    token = FILE_NAME
+
+		} else if (Memc[ip] == '*') {
+		    # Map "*" into "?*".
+		    token = PATTERN_STRING
+		    outstr[op] = '?'
+		    op = op + 1
+
+		} else if (Memc[ip] == '%') {
+		    # The % metacharacter must appear twice (not three times,
+		    # as the high level code strips the subsitution field) to
+		    # be recognized as the pattern substitution metacharacter.
+
+		    nseen = 0
+		    do i = 1, ARB {
+			cp = ip_start + i - 1
+			if (Memc[cp] == EOS || Memc[cp] == TOK_DELIM)
+			    break
+			else if (Memc[cp] == '%' && Memc[cp-1] != '\\')
+			    nseen = nseen + 1
+		    }
+		    if (nseen < 2) {
+			outstr[op] = CH_ESCAPE
+			op = op + 1
+		    }
+		} else if (stridx (Memc[ip], "[?{") > 0)
+		    token = PATTERN_STRING
+
+		outstr[op] = Memc[ip]
+		op = op + 1
+	    }
+	}
+	    
+	# Remove any trailing whitespace.
+	op = op - 1
+	while (op > 0 && IS_WHITE (outstr[op]))
+	    op = op - 1
+	outstr[op+1] = EOS
+
+	if (op > 0)
+	    if (outstr[op] == FNLDIR_CHAR || outstr[op] == '/')
+		token = PATTERN_STRING
+
+	U_TEMPLATE_INDEX(pp) = ip			# update pointer
+
+	return (token)
+end
+
+
+# FNT_OPEN_LIST -- Open list file or directory.  If reading from a directory,
+# open the current directory if a directory name is not given.  Extract
+# pattern string (if any), and return in PATSTR.  If no pattern string is
+# given, return a pattern which will match all files in the list.
+
+int procedure fnt_open_list (str, patstr, maxch, fname, ldir, ftype)
+
+int	maxch, ftype
+char	ldir[SZ_LDIR]
+char	str[ARB], patstr[maxch], fname[SZ_FNAME]
+int	fd, ip, op, fnt_delim, pat_start, dirmode
+int	open(), diropen()
+errchk	open, diropen, fpathname
+
+begin
+	op = 1
+	fnt_delim = NULL
+	pat_start = NULL
+
+	# Search for a valid directory prefix.
+	for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+	    fname[op] = str[ip]
+	    if (ftype != LIST_FILE)
+		if (fname[op] == FNLDIR_CHAR || fname[op] == '//')
+		    if (op == 1 || fname[op-1] != '\\') {
+			fnt_delim = op
+			pat_start = ip + 1
+		    }
+	    op = op + 1
+	}
+	fname[op] = EOS
+
+	if (ftype == LIST_FILE) {
+	    if (fnt_delim != NULL)
+		fname[fnt_delim] = EOS
+	    fd = open (fname, READ_ONLY, TEXT_FILE)
+	    ldir[1] = EOS
+
+	} else {
+	    if (fnt_delim != NULL)		# specific directory
+		fname[fnt_delim+1] = EOS
+	    else				# current directory
+		fname[1] = EOS
+	    call fpathname (fname, ldir, SZ_LDIR)
+
+	    dirmode = SKIP_HIDDEN_FILES
+	    if (pat_start != NULL) {
+		if (str[pat_start] == '.')
+		    dirmode = PASS_HIDDEN_FILES
+	    } else if (ftype != LIST_FILE && str[1] == '.')
+		dirmode = PASS_HIDDEN_FILES
+
+	    fd = diropen (ldir, dirmode)
+	    call strcpy (fname, ldir, SZ_LDIR)
+	}
+
+	# If pattern string is appended to list file name, extract
+	# it, otherwise set the default pattern "match all" (*).
+
+	op = 1
+	if (pat_start != NULL)
+	    ip = pat_start
+	else if (ftype != LIST_FILE)
+	    ip = 1
+
+	for (;  str[ip] != EOS;  ip=ip+1) {
+	    patstr[op] = str[ip]
+	    op = op + 1
+	}
+
+	# No pattern string given, default to "?*".
+	if (op == 1) {
+	    patstr[1] = CH_ANY
+	    patstr[2] = CH_CLOSURE
+	    op = 3
+	}
+	patstr[op] = EOS
+
+	return (fd)
+end
+
+
+# FNTOPN -- Open and initialize the template descriptor.
+
+pointer procedure fntopn (template)
+
+char	template[ARB]
+
+pointer	pp
+int	nchars
+int	strlen()
+errchk	calloc, malloc
+
+begin
+	nchars = strlen (template)
+
+	call calloc (pp, LEN_FNTUHDR, TY_STRUCT)
+	call malloc (U_TEMPLATE(pp), nchars, TY_CHAR)
+
+	call strcpy (template, Memc[U_TEMPLATE(pp)], nchars)
+	U_TEMPLATE_INDEX(pp) = U_TEMPLATE(pp)
+	U_MAGIC(pp) = FNTU_MAGIC
+
+	return (pp)
+end
+
+
+# FNTCLS -- Close the template descriptor, return space.
+
+procedure fntcls (pp)
+
+pointer	pp
+errchk	syserr
+
+begin
+	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	if (U_FILDES(pp) != NULL)
+	    call close (U_FILDES(pp))
+
+	call mfree (U_TEMPLATE(pp), TY_CHAR)
+	call mfree (pp, TY_STRUCT)
+end
diff --git a/sys/fio/fnullfile.x b/sys/fio/fnullfile.x
new file mode 100644
index 00000000..4080a03b
--- /dev/null
+++ b/sys/fio/fnullfile.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FNULLFILE -- Determine if the named file is the null file.
+
+bool procedure fnullfile (fname)
+
+char	fname[ARB]		# null file candidate
+
+pointer	sp, osfn
+bool	first_time, bval
+char	nullpath[SZ_FNAME]
+int	strmatch()
+bool	streq()
+
+data	first_time /true/
+string	nullfile "dev$null"
+
+begin
+	# Some simple, fast tests first.
+	if (streq (fname, nullfile))
+	    return (true)
+	else if (strmatch (fname, "{null}") == 0)
+	    return (false)
+
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	if (first_time) {
+	    call fpathname (nullfile, nullpath, SZ_FNAME)
+	    first_time = false
+	}
+
+	call fpathname (fname, Memc[osfn], SZ_PATHNAME)
+	bval = streq (Memc[osfn], nullpath)
+
+	call sfree (sp)
+	return (bval)
+end
diff --git a/sys/fio/fopnbf.x b/sys/fio/fopnbf.x
new file mode 100644
index 00000000..277c9565
--- /dev/null
+++ b/sys/fio/fopnbf.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FOPNBF -- Open a binary file on a device.  A new entry is made in the
+# device table if the device has not already been installed.
+
+int procedure fopnbf (fname, mode, zopn, zard, zawr, zawa, zstt, zcls)
+
+char	fname[ARB]
+int	mode
+extern	zopn(), zard(), zawr(), zawa(), zstt(), zcls()
+int	filopn()
+
+begin
+	call fdevbf (zard, zawr, zawa, zstt, zcls)
+	return (filopn (fname, mode, BINARY_FILE, zopn, zard))
+end
diff --git a/sys/fio/fopntx.x b/sys/fio/fopntx.x
new file mode 100644
index 00000000..4b120ca7
--- /dev/null
+++ b/sys/fio/fopntx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FOPNTX -- Open a text file on a device.  A new entry is made in the
+# device table if the device has not already been installed.
+
+int procedure fopntx (fname,mode,zopn,zget,zput,zfls,zstt,zcls,zsek,znot)
+
+char	fname[ARB]
+int	mode
+extern	zopn(), zget(), zput(), zfls(), zstt(), zcls(), zsek(), znot()
+int	filopn()
+
+begin
+	call fdevtx (zget, zput, zfls, zstt, zcls, zsek, znot)
+	return (filopn (fname, mode, TEXT_FILE, zopn, zget))
+end
diff --git a/sys/fio/fowner.x b/sys/fio/fowner.x
new file mode 100644
index 00000000..40cc7fc1
--- /dev/null
+++ b/sys/fio/fowner.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<finfo.h>
+include	<syserr.h>
+
+# FOWNER -- Get the name of the owner of a file.
+
+procedure fowner (fname, owner, maxch)
+
+char	fname[ARB]			# file name
+char	owner[ARB]			# owner name string
+int	maxch				# max chars in owner name string
+long	file_info[LEN_FINFO]
+int	finfo()
+
+begin
+	if (finfo (fname, file_info) == ERR)
+	    call filerr (fname, SYS_FOWNER)
+	call strcpy (FI_OWNER(file_info), owner, maxch)
+end
diff --git a/sys/fio/fpathname.x b/sys/fio/fpathname.x
new file mode 100644
index 00000000..12c29e1f
--- /dev/null
+++ b/sys/fio/fpathname.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<knet.h>
+include	<fio.h>
+
+# FPATHNAME -- Return the full OS pathname for a vfn.  If no vfn is given
+# (null string), the pathname of the current directory is returned.  Do not
+# try to make the pathname into a directory name; if it already is a directory
+# name, however, it will remain so.
+
+procedure fpathname (vfn, output_pathname, maxchars)
+
+char	vfn[ARB]			# VFN of file
+char	output_pathname[maxchars]	# pathname of file
+int	maxchars
+
+int	status
+include	<fio.com>
+errchk	filerr
+
+begin
+	status = OK
+	
+	if (vfn[1] == EOS)
+	    call strpak (vfn, pathname, SZ_PATHNAME)
+	else iferr (call fmapfn (vfn, pathname, SZ_PATHNAME))
+	    status = ERR
+
+	if (status != ERR) {
+	    call strupk (pathname, pathname, SZ_PATHNAME)
+	    call zfpath (pathname, output_pathname, maxchars, status)
+	}
+
+	if (status == ERR)
+	    call filerr (vfn, SYS_FPATHNAME)
+end
diff --git a/sys/fio/fputtx.x b/sys/fio/fputtx.x
new file mode 100644
index 00000000..0cea6f04
--- /dev/null
+++ b/sys/fio/fputtx.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FPUTTX -- Put a line to a text file.  Flush output if flag is set.
+# Called by FLSBUF, SEEK, FLUSH, etc. to flush an output line.
+
+procedure fputtx (fd, buf, nchars, status)
+
+int	fd, nchars, status
+char	buf[ARB]
+int	and()
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	call zcall4 (ZPUTTX(fp), FCHAN(fp), buf, nchars, status)
+
+	if (status != ERR && and (FF_FLUSHNL, fflags[fd]) != 0)
+	    call zcall2 (ZFLSTX(fp), FCHAN(fp), status)
+end
diff --git a/sys/fio/freadp.x b/sys/fio/freadp.x
new file mode 100644
index 00000000..facd74ec
--- /dev/null
+++ b/sys/fio/freadp.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+include <syserr.h>
+include <fio.h>
+
+# FREADP -- Read from a file, directly accessing the file data in the FIO
+# buffer rather than copying the data from the FIO buffer to the user buffer.
+# This technique can be used for very efficient file access, but is not as
+# general as an ordinary read.  In particular the requested data segment
+# must lie entirely within the FIO buffer, and the referenced data must be
+# used before a file fault causes the buffer contents to be replaced.  The
+# file size should be known in advance and any attempt to read outside the
+# file boundaries is interpreted as an error.
+
+pointer procedure freadp (fd, offset, nchars)
+
+int	fd		# file to be accessed
+long	offset		# file offset in chars
+int	nchars		# nchars to "read"
+
+pointer	bp, fiop
+int	ffault()
+errchk	filerr, ffault, fmkbfs
+include	<fio.com>
+
+begin
+	# Move file buffer onto file block containing the file offset.
+	# Verify that the buffer contains nchars of file data in contiguous
+	# storage.  If the file buffer already contains the referenced
+	# data segment no fault is necessary and this is quite fast.
+	# The iop is left pointing to the first char following the
+	# referenced data block.
+
+	repeat {
+	    bp   = bufptr[fd]
+	    fiop = offset - boffset[fd] + bp		# lseek
+
+	    if (fiop < bp || fiop >= itop[fd]) {
+		if (bp == NULL) {
+		    call fmkbfs (fd)
+		    next
+		}
+		if (ffault (fd, offset, nchars, FF_READ) == EOF)
+		    call filerr (FNAME(fiodes[fd]), SYS_FREADP)
+		fiop = iop[fd]
+	    }
+
+	    iop[fd] = fiop + nchars
+	    if (iop[fd] > itop[fd])
+		call filerr (FNAME(fiodes[fd]), SYS_FREADP)
+
+	    return (fiop)
+	}
+end
diff --git a/sys/fio/fredir.x b/sys/fio/fredir.x
new file mode 100644
index 00000000..4b8f14b2
--- /dev/null
+++ b/sys/fio/fredir.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+# FREDIR -- Redirect the i/o to stream FD onto file FNAME.  FD must be the file
+# descriptor of an open file which has not already been redirected.  The mode
+# of access and file type of the redirection file need not agree with those of
+# the stream being redirected.
+#
+# The "redir_fd" file parameter has the following meaning:
+#	redir_fd[fd] <  0	i/o redirected in the parent process
+#	redir_fd[fd] == 0	i/o is not redirected
+#	redir_fd[fd] >  0	i/o has been redirected in the local process
+#				  to file FD redir_fd[fd]
+
+procedure fredir (fd, fname, mode, type)
+
+int	fd			# stream to be redirected
+char	fname[ARB]		# name of redirection file
+int	mode			# access mode of redirection file
+int	type			# file type of redirection file
+
+int	newfd, junk
+int	open(), itoc()
+include	<fio.com>
+errchk	open, syserrs
+
+begin
+	# Cancel any pushback on the open file.
+	call fcanpb (fd)
+
+	# Verify that file FD is open and has not already been redirected.
+
+	junk = itoc (fd, pathname, SZ_PATHNAME)
+	if (fiodes[fd] == NULL)
+	    call syserrs (SYS_FREDIRFNO, pathname)
+	else if (redir_fd[fd] != NULL)
+	    call syserrs (SYS_FMULTREDIR, pathname)
+
+	# Open the redirection file and swap file descriptors.  CLOSE will
+	# automatically swap back and close the redirection file.
+
+	newfd = open (fname, mode, type)
+	call frediro (fd, newfd)
+end
+
+
+# FREDIRO -- Redirect a stream to another stream which has already been
+# opened.
+
+procedure frediro (fd, newfd)
+
+int	fd			# stream to be redirected
+int	newfd			# where it is to be redirected
+include	<fio.com>
+
+begin
+	call fswapfd (fd, newfd)
+	redir_fd[fd] = newfd
+end
diff --git a/sys/fio/frename.x b/sys/fio/frename.x
new file mode 100644
index 00000000..b02fbe56
--- /dev/null
+++ b/sys/fio/frename.x
@@ -0,0 +1,122 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+include	<fio.h>
+
+# FRENAME -- Change the name of a file, or move a file from one directory
+# to another.  All file attributes, including file protection, are
+# transferred with the file.  If a file already exists with the new name,
+# protection and clobber checking are performed and the old file is deleted
+# if permitted.  Interrupts are disabled while the VFN database is open to
+# protect the database, ensure that that the lock on the mapping file is
+# cleared, and to ensure that the mapping file is closed.
+
+procedure frename (oldfname, newfname)
+
+char	oldfname[ARB]		# old filename
+char	newfname[ARB]		# new filename
+
+int	file_exists
+int	status, junk
+pointer	sp, vp, oldosfn, newosfn, errmsg
+
+pointer	vfnopen()
+bool	fnullfile()
+int	vfnadd(), vfndel()
+include	<fio.com>
+errchk	syserrs
+
+define	fixvfn_ 91
+define	close_ 92
+define	abort_ 93
+
+begin
+	# The null file "dev$null" is a special case; ignore attempts to
+	# rename this file.
+
+	if (fnullfile (oldfname))
+	    call syserrs (SYS_FRENAME, oldfname)
+	else if (fnullfile (newfname))
+	    call syserrs (SYS_FRENAME, newfname)
+
+	call smark (sp)
+	call salloc (oldosfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (newosfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	# Format the string "oldfname -> newfname" for error messages.
+	call strcpy (oldfname, Memc[errmsg], SZ_LINE)
+	call strcat (" --> ",  Memc[errmsg], SZ_LINE)
+	call strcat (newfname, Memc[errmsg], SZ_LINE)
+
+	# Get OSFN of old file and verify that the file exists.  Delete
+	# the old file from the database.
+
+	call intr_disable()
+	iferr (vp = vfnopen (oldfname, VFN_WRITE))
+	    goto abort_
+	iferr (status = vfndel (vp, Memc[oldosfn], SZ_PATHNAME))
+	    goto close_
+	if (status == ERR)
+	    file_exists = NO
+	else
+	    call zfacss (Memc[oldosfn], 0, 0, file_exists)
+
+	if (file_exists == NO) {
+	    iferr (call syserrs (SYS_FRENAME, Memc[errmsg]))
+		goto close_
+	} else iferr (call vfnclose (vp, VFN_UPDATE))
+	    goto abort_
+
+	# Perform clobber checking, delete old newfile if one exists.
+	# Note that this must be done before opening the new VFN for
+	# writing or deadlock may occur.
+
+	iferr (call fclobber (newfname))
+	    goto fixvfn_
+
+	# Add the new VFN to the VFN database and create the new file.
+	# If the vfnadd or the physical rename operation fail then we
+	# must go back and undelete the old VFN.
+
+	iferr (vp = vfnopen (newfname, VFN_WRITE))
+	    goto abort_
+	iferr (status = vfnadd (vp, Memc[newosfn], SZ_PATHNAME))
+	    goto close_
+	if (status != ERR)
+	    call zfrnam (Memc[oldosfn], Memc[newosfn], status)
+
+	if (status == ERR) {
+	    # Close new VFN, reopen old one and undelete old VFN.
+	    iferr (call vfnclose (vp, VFN_NOUPDATE))
+		goto abort_
+fixvfn_
+	    iferr (vp = vfnopen (oldfname, VFN_WRITE))
+		goto abort_
+	    iferr (junk = vfnadd (vp, Memc[oldosfn], SZ_PATHNAME))
+		goto close_
+	    iferr (call vfnclose (vp, VFN_UPDATE))
+		goto abort_
+	    iferr (call syserrs (SYS_FRENAME, Memc[errmsg]))
+		goto abort_
+	} else
+	    iferr (call vfnclose (vp, VFN_UPDATE))
+		goto abort_
+
+	call intr_enable()
+	call sfree (sp)
+	return
+
+
+	# Error recovery nasties.
+close_
+	iferr (call vfnclose (vp, VFN_NOUPDATE))
+	    ;
+abort_
+	call intr_enable()
+	call sfree (sp)
+	call erract (EA_ERROR)
+end
diff --git a/sys/fio/frmbfs.x b/sys/fio/frmbfs.x
new file mode 100644
index 00000000..ec1df5e7
--- /dev/null
+++ b/sys/fio/frmbfs.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FRMBFS -- Return file buffer.  Called by FSET to change the buffer size,
+# and by FRTNFD when a file is closed.
+
+procedure frmbfs (fd)
+
+int	fd			# file descriptor
+
+long	offset
+errchk	mfree, flush
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (bufptr[fd] == NULL)
+	    return
+	else
+	    call fcanpb (fd)
+
+	# Note file offset, return buffer and initialize i/o pointers,
+	# restore seek offset (which depends on buffer pointer, buf offset).
+
+	offset = LNOTE(fd)
+	call mfree (bufptr[fd], TY_CHAR)
+	call mfree (FPBBUF(fp), TY_CHAR)
+
+	bufptr[fd] = NULL
+	boffset[fd] = NULL
+	buftop[fd] = NULL
+	itop[fd] = NULL
+	otop[fd] = NULL
+
+	LSEEK (fd, offset)
+end
diff --git a/sys/fio/frmdir.x b/sys/fio/frmdir.x
new file mode 100644
index 00000000..d12ad082
--- /dev/null
+++ b/sys/fio/frmdir.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# FRMDIR -- Remove an empty directory.  An error action is taken if the
+# name of the directory is too long, if directory exists but is not
+# empty, or if there is no write permission on the directory.
+
+procedure frmdir (dir)
+
+char	dir[ARB]		# virtual or OS-dependent directory spec
+
+int	status
+pointer	sp, osfn, dirname
+int	access()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (dirname, SZ_PATHNAME, TY_CHAR)
+
+	iferr (call fmapfn (dir, Memc[osfn], SZ_PATHNAME))
+	    call syserrs (SYS_FMKDIRFNTL, dir)
+	
+	# Always present ZFRMDR with a directory pathname (rather than an
+	# absolute or cwd relative filename), in case the kernel procedure
+	# is not smart enough to handle all these possibilities.
+
+	call strupk (Memc[osfn], Memc[osfn], SZ_PATHNAME)
+	call zfpath (Memc[osfn], Memc[dirname], SZ_PATHNAME, status)
+	if (status != ERR)
+	    call zfsubd (Memc[dirname], SZ_PATHNAME, "", status)
+
+	# Try to remove the directory.  If the directory cannot be removed
+	# use the OS name of the directory in the error message to close the
+	# loop with the user.
+
+	if (status != ERR) {
+	    call strpak (Memc[dirname], Memc[osfn], SZ_PATHNAME)
+	    call zfrmdr (Memc[osfn], status)
+	}
+	if (status == ERR)
+	    call syserrs (SYS_FRMDIR, Memc[dirname])
+
+	call sfree (sp)
+end
diff --git a/sys/fio/frtnfd.x b/sys/fio/frtnfd.x
new file mode 100644
index 00000000..cf98aa55
--- /dev/null
+++ b/sys/fio/frtnfd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FRTNFD -- Return file descriptor and buffers.
+
+procedure frtnfd (fd)
+
+int	fd
+include	<fio.com>
+
+begin
+	if (fiodes[fd] != NULL) {
+	    call frmbfs (fd)
+	    call mfree (fiodes[fd], TY_STRUCT)
+	    fiodes[fd] = NULL
+	}
+end
diff --git a/sys/fio/fseti.x b/sys/fio/fseti.x
new file mode 100644
index 00000000..42068096
--- /dev/null
+++ b/sys/fio/fseti.x
@@ -0,0 +1,403 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	<fset.h>
+include	<fio.h>
+
+# FSETI -- Set File I/O options.  FSETI is not intended to be called
+# routinely by user code.  To provide maximum flexibility, any FIO parameter
+# can be changed, and no checking is performed.  Hence, the file buffer size,
+# device, device channel, and so on can be changed during i/o to a file,
+# though doing so is probably an error.  User beware.
+# 
+# The only FIO parameters that should be set in applications programs are
+# F_FLUSHNL (flush output at end of every line of text), and occasionally
+# F_ADVICE (sequential or random).
+
+procedure fseti (fd, param, value)
+
+int	fd			# file in question
+int	param			# parameter to be set
+int	value			# value of parameter
+
+pointer	bp, ffp
+long	file_offset
+int	i, junk, outfd, flags
+bool	blocked_file, setraw, ndelay
+char	set_redraw[LEN_SETREDRAW]
+char	rawcmd[LEN_RAWCMD+1]
+
+int	await(), xisatty()
+include	<fio.com>
+
+begin
+	ffp = fiodes[fd]
+	if (fd <= 0 || ffp == NULL)
+	    iferr (call syserr (SYS_FILENOTOPEN))
+		call erract (EA_FATAL)
+
+	switch (param) {
+
+	case F_ADVICE:
+	    # Set file buffer size, based on expected type of i/o.  By default,
+	    # the device dependent OPTBUFSIZE is used.  If i/o is expected to
+	    # be very random, an integral multiple of the device block size is
+	    # used (beware of 1 char block files).  If highly sequential i/o is
+	    # expected, a large buffer is allocated.
+
+	    if (fd >= FIRST_FD && bufptr[fd] == NULL)
+		switch (value) {
+		case RANDOM:
+		    FBUFSIZE(ffp) = LEN_RANDBUF * max (1, FBLKSIZE(ffp))
+		case SEQUENTIAL:
+		    FBUFSIZE(ffp) = LEN_SEQBUF * FOPTBUFSIZE(ffp)
+		default:
+		    FBUFSIZE(ffp) = FOPTBUFSIZE(ffp)
+		}
+	    
+	case F_ASYNC:
+	    # Enable asynchronous i/o.
+	    ;						# not implemented
+
+	case F_BLKSIZE:
+	    # Set the device block size in chars.
+	    FBLKSIZE(ffp) = value
+
+	case F_BUFPTR, F_BUFSIZE:
+	    # An externally created buffer can be installed by setting F_BUFPTR
+	    # and either F_BUFSIZE or F_BUFTOP (do NOT forget to set both).
+	    # The file buffer size can be changed by a call to F_BUFSIZE,
+	    # even after doing i/o on a file. In both cases, the current file
+	    # offset will be retained.
+
+	    if (param == F_BUFSIZE && FBUFSIZE(ffp) == value)
+		return
+	    else if (bufptr[fd] != NULL) {
+		call flush (fd)
+		call frmbfs (fd)
+	    }
+
+	    if (param == F_BUFSIZE) {
+		FBUFSIZE(ffp) = value
+		if (buftop[fd] == NULL && bufptr[fd] != NULL)
+		    buftop[fd] = bufptr[fd] + value
+	    } else {
+		file_offset = LNOTE (fd)
+		bufptr[fd] = value
+		boffset[fd] = NULL
+		LSEEK (fd, file_offset)
+		if (buftop[fd] == NULL && FBUFSIZE(ffp) != NULL)
+		    buftop[fd] = bufptr[fd] + FBUFSIZE(ffp)
+	    }
+
+	case F_BUFTOP:
+	    # Set a pointer to the top of a buffer (first char after buffer).
+	    buftop[fd] = value
+	    if (FBUFSIZE(ffp) == NULL && bufptr[fd] != NULL)
+		FBUFSIZE(ffp) = buftop[fd] - bufptr[fd]
+
+	case F_FILESIZE:
+	    # Set the file size.  Should not be called by ordinary programs;
+	    # intended for use only in system code which writes to a file at
+	    # the kernel level, preventing FIO from keeping track of the file
+	    # size.
+
+	    FILSIZE(ffp) = value
+
+	case F_FIRSTBUFOFF:
+	    # FIO divides a random access binary file up into a series of
+	    # fixed size buffers, or file "pages".  By default the first buffer
+	    # is at file offset BOF=1, but this does not have to be the case,
+	    # and sometimes it is desirable to align the file buffers starting
+	    # at some format specific offset in the file.  Note that doing so
+	    # renders the file segment to the left of FIRSTBUFOFF inaccessible.
+
+	    call flush (fd)
+	    call frmbfs (fd)
+	    FIRSTBUFOFF(ffp) = value
+
+	case F_BUFTYPE:
+	    # Use file-local buffers or the global pool.
+	    ;						# not implemented
+
+	case F_CANCEL:
+	    # Cancel any buffered data.  For a blocked file, the file offset
+	    # is preserved, hence the only effect is to force the file buffer
+	    # to be refilled.  Any changes made to buffered data are cancelled
+	    # when the buffer is refilled.  For a streaming file, the i/o
+	    # pointers are reset to the beginning of the buffer, to force the
+	    # next read to refill the buffer, or to cause the next write to
+	    # start filling the buffer.
+
+	    call fcanpb (fd)
+	    blocked_file = (FBLKSIZE(ffp) > 0)
+	    if (blocked_file)
+		file_offset = LNOTE(fd)
+
+	    bp = bufptr[fd]
+	    if (FFIOMODE(ffp) != INACTIVE)
+		junk = await (fd)
+
+	    iop[fd] = bp
+	    itop[fd] = bp
+	    otop[fd] = bp
+	    
+	    if (blocked_file) {
+		boffset[fd] = 0		# invalidate buffer
+		LSEEK (fd, file_offset)
+	    } else
+		boffset[fd] = 1		# causes rewind to set iop=bp
+
+	    FILSTAT(ffp) = value
+
+	case F_CHANNEL:
+	    # Kernel i/o channel number.
+	    FCHAN(ffp) = value
+
+	case F_CLOBBER:
+	    # Allow NEW_FILE files to overwrite old files of the same name.
+	    call fset_env ("clobber", value)
+
+	case F_CLOSEFD:
+	    # If this option is set for a file descriptor, the host channel
+	    # is reopened every time an i/o operation takes place (aread or
+	    # awrite), and is closed while the channel is inactive.  This
+	    # is useful to save host system file descriptors, so that a
+	    # program may have a very large number of files "open" at any one
+	    # time (one is still limited by the maximum number of available
+	    # FIO file descriptors).  This option is supported only for binary
+	    # files opened in some mode other than NEW_FILE; special devices
+	    # are supported, but only if the device is randomly accessible and
+	    # does not map file segments in to memory.
+
+	    if (value == YES && FCLOSEFD(ffp) == NO) {
+		if (FTYPE(ffp) == TEXT_FILE)
+		    iferr (call filerr (FNAME(ffp), SYS_FCLFDTX))
+			call erract (EA_FATAL)
+		if (FMODE(ffp) == NEW_FILE)
+		    iferr (call filerr (FNAME(ffp), SYS_FCLFDNF))
+			call erract (EA_FATAL)
+
+		if (FCHAN(ffp) != ERR) {
+		    call zcall2 (ZCLSBF(ffp), FCHAN(ffp), junk)
+		    FCHAN(ffp) = ERR
+		}
+
+		FCLOSEFD(ffp) = YES
+
+	    } else if (value == NO) {
+		# Wait until the next i/o operation occurs to reopen the file.
+		FCLOSEFD(ffp) = NO
+	    }
+
+	case F_DEVICE:
+	    # Set entry point address of the read entry point of the device
+	    # driver for a file.
+
+	    for (i=1;  i < next_dev;  i=i+LEN_DTE)
+		if (value == zdev[i]) {
+		    FDEV(ffp) = i
+		    return
+		}
+	    iferr (call filerr (FNAME(ffp), SYS_FDEVNOTFOUND))
+		call erract (EA_FATAL)
+
+	case F_FILEWAIT:
+	    # Wait for a file to become accessible during open.
+	    call fset_env ("filewait", value)
+
+	case F_FLUSHNL:
+	    # Flush output when newline is seen.
+	    if (value == YES)
+		fflags[fd] = or (FF_FLUSH + FF_FLUSHNL, fflags[fd])
+	    else if (FTYPE(ffp) == TEXT_FILE)
+		fflags[fd] = and (not(FF_FLUSHNL), fflags[fd])
+	    else
+		fflags[fd] = and (not(FF_FLUSH + FF_FLUSHNL), fflags[fd])
+
+	case F_KEEP:
+	    # Keep a file open after program termination.
+	    if (value == YES)
+		fflags[fd] = or (FF_KEEP, fflags[fd])
+	    else
+		fflags[fd] = and (not(FF_KEEP), fflags[fd])
+
+	case F_MODE:
+	    # Set access mode of a file.
+	    switch (value) {
+	    case READ_ONLY:
+		fflags[fd] = and (not(FF_WRITE), fflags[fd])
+	    case READ_WRITE:
+		fflags[fd] = or (FF_READ + FF_WRITE, fflags[fd])
+	    case WRITE_ONLY:			# disable buf read in ffault
+		fflags[fd] = and (not(FF_READ), fflags[fd])
+	    default:
+		iferr (call filerr (FNAME(ffp), SYS_FILLEGMODE))
+		    call erract (EA_FATAL)
+	    }
+	    FMODE(ffp) = value
+
+	case F_NBUFS:
+	    # Set the number of i/o buffers for a file.
+	    ;						# not implemented
+
+	case F_ONEVERSION:
+	    # Keep only one version of each file (in UNIX fashion, as opposed
+	    # to the multiple versions of VMS).
+	    call fset_env ("multversions", value)
+
+	case F_PBBSIZE:
+	    # Set the push-back buffer size for a file.
+	    if (FPBBUF(ffp) == NULL)
+		FPBBUFSIZE(ffp) = value
+
+	case F_TYPE:
+	    # Set the file type (text, binary, etc).
+	    FTYPE(ffp) = value
+
+	    if (value == TEXT_FILE) {
+		fflags[fd] = or (FF_FLUSH, fflags[fd])
+
+	    } else if (value == SPOOL_FILE) {
+		# Reading and writing must be disabled for spool file or
+		# filbuf and flsbuf won't work.  Also set the block size
+		# to zero, since spool files are considered to be streaming
+		# files.
+
+		fflags[fd] = 0
+		FBLKSIZE(ffp) = 0
+	    }
+
+	case F_IOMODE, F_RAW:
+	    # Set the i/o mode for reading from a text device.  In raw mode,
+	    # if the text device is a terminal, each character is returned as
+	    # it is typed and most control characters are passed through on
+	    # reads.  If nonblocking raw mode is selected, each read will
+	    # return immediately whether or not there is any data to be read.
+	    # If no data could be read EOF is returned, but in RAWNB mode
+	    # this indicates merely that no input data was available.
+
+	    setraw = (and (value, IO_RAW) != 0)
+	    ndelay = (and (value, IO_NDELAY) != 0)
+
+	    fflags[fd] = and (not(FF_RAW+FF_NDELAY), fflags[fd])
+	    if (setraw) {
+		flags = FF_RAW
+		if (ndelay)
+		    flags = flags + FF_NDELAY
+		fflags[fd] = or (fflags[fd], flags)
+	    }
+
+	    # Send a special control sequence to the IRAF tty driver to
+	    # physically turn raw mode on or off.  If this were not done then
+	    # raw mode would not be turned off until the next read occurred,
+	    # which is counter intuitive and dangerous, as an abort might
+	    # occur before the read, leaving the terminal in never never
+	    # land.  The funny string must of course agree with what ZPUTTY
+	    # expects.
+
+	    if (fd == STDIN || fd == STDOUT || fd == STDERR)
+		outfd = STDOUT
+	    else
+		outfd = fd
+
+	    if (xisatty (outfd) == YES && and (fflags[outfd], FF_WRITE) != 0) {
+		call flush (outfd)
+
+		if (setraw) {
+		    call strcpy (RAWON, rawcmd, LEN_RAWCMD)
+		    if (ndelay)
+			rawcmd[LEN_RAWCMD+1] = 'N'
+		    else
+			rawcmd[LEN_RAWCMD+1] = 'B'
+		    rawcmd[LEN_RAWCMD+2] = EOS
+		    call putline (outfd, rawcmd)
+		} else
+		    call putline (outfd, RAWOFF)
+
+		call flush (outfd)
+	    }
+
+	case F_SETREDRAW:
+	    # Set the value of, and enable transmission of, the redraw control
+	    # code to be issued following process suspension while in raw mode.
+	    # Following a process suspend/continue while in raw mode, this code
+	    # will be returned to the applications process in the next GETC
+	    # call, as if it had been typed by the user.  The redraw control
+	    # code must be set to some positive nonzero value to enable
+	    # transmission of the code by the terminal driver.  Setting the
+	    # code to zero disables the feature.  The terminal driver (ZFIOTY)
+	    # for host systems which do not support process suspension will
+	    # recognize but ignore this control sequence.  Note that the redraw
+	    # control code to be returned by the driver is limited to a single
+	    # character, e.g., <ctrl/l> or <ctrl/r>, depending upon the
+	    # application.
+
+	    if (fd == STDIN || fd == STDOUT || fd == STDERR)
+		outfd = STDOUT
+	    else
+		outfd = fd
+
+	    if (xisatty (outfd) == YES && and (fflags[outfd], FF_WRITE) != 0) {
+		call strcpy (SETREDRAW, set_redraw, LEN_SETREDRAW)
+		set_redraw[LEN_SETREDRAW] = value
+		call flush (outfd)
+		call write (outfd, set_redraw, LEN_SETREDRAW)
+		call flush (outfd)
+	    }
+
+	case F_REDIR:
+	    # Set redir_fd to a negative value to indicate that the stream
+	    # has been redirected in the parent process.  If redir_fd is
+	    # already set to a nonzero value, indicating that i/o has already
+	    # been redirected either locally or in the parent, do nothing.
+
+	    if (value == YES) {
+		if (redir_fd[fd] == 0)
+		    redir_fd[fd] = -1
+	    } else
+		redir_fd[fd] = 0
+
+	case F_VALIDATE:
+	    # Validate the contents of the FIO buffer, e.g., after an i/o
+	    # error has occurred during AREAD but it is thought that at least
+	    # part of the data in the buffer may be valid.  VALUE is the
+	    # number of chars for which the FIO buffer is to be validated
+	    # in the next call to FILBUF.  This must be the only case for
+	    # which FNCHARS can take on a negative value.
+
+	    FNCHARS(ffp) = -value
+	    FNBYTES(ffp) = value * SZB_CHAR
+	    FILSTAT(ffp) = OK
+
+	default:
+	    # This is a fatal error to prevent error recursion.
+	    iferr (call filerr (FNAME(ffp), SYS_FSETUKNPAR))
+		call erract (EA_FATAL)
+	}
+end
+
+
+# FSET_ENV -- Set the value of a boolean environment variable used for file
+# control.  A set environment call affects all programs in the current process
+# and in all subprocesses, unless overriden by another SET statement or
+# forgotten by ENVFREE.
+
+procedure fset_env (envvar, value)
+
+char	envvar[ARB]		# name of environment variable to be set
+int	value			# YES or NO
+int	junk
+int	envputs()
+
+begin
+	switch (value) {
+	case YES:
+	    junk = envputs (envvar, "yes")
+	case NO:
+	    junk = envputs (envvar, "no")
+	}
+end
diff --git a/sys/fio/fsfopen.x b/sys/fio/fsfopen.x
new file mode 100644
index 00000000..21ff9c95
--- /dev/null
+++ b/sys/fio/fsfopen.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FSFOPEN -- Open the subfile list file.  A subfile is a physical file which is
+# logically subordinate to another file (e.g., the pixel storage file is a
+# subfile of an imagefile).  The subfile list file is a hidden textfile,
+# containing a list of filenames.
+
+int procedure fsfopen (fname, mode)
+
+char	fname[ARB]		# name of logical file
+int	mode			# access mode for subfile list
+
+int	fd
+pointer	sp, listfile
+int	open()
+errchk	open, fsf_getfname
+
+begin
+	call smark (sp)
+	call salloc (listfile, SZ_FNAME, TY_CHAR)
+
+	call fsf_getfname (fname, Memc[listfile], SZ_FNAME)
+	fd = open (Memc[listfile], mode, TEXT_FILE)
+
+	call sfree (sp)
+	return (fd)
+end
+
+
+# FSFDELETE -- Delete all of the subfiles of a file, then the subfile list
+# file itself.
+
+procedure fsfdelete (fname)
+
+char	fname[ARB]		# file whose subfiles are to be deleted
+int	fd
+pointer	sp, subfile
+int	fsfopen(), getline()
+errchk	getline, delete, fsf_getfname
+
+begin
+	call smark (sp)
+	call salloc (subfile, SZ_FNAME, TY_CHAR)
+
+	# Open the list and delete each subfile.  To avoid recursion this must
+	# be done by calling delete, hence subfiles may not have subfiles.
+	# It is not an error if the listfile cannot be opened, i.e., if there
+	# are no subfiles.
+
+	iferr (fd = fsfopen (fname, READ_ONLY)) {
+	    call sfree (sp)
+	    return
+	}
+
+	while (getline (fd, Memc[subfile]) != EOF)
+	    call delete (Memc[subfile])
+	call close (fd)
+
+	# Delete the listfile itself.
+
+	call fsf_getfname (fname, Memc[subfile], SZ_FNAME)
+	call delete (Memc[subfile])
+
+	call sfree (sp)
+end
+
+
+# FSF_GETFNAME -- Get the name of the subfile list file for a file.
+
+procedure fsf_getfname (fname, fsf_file, maxch)
+
+char	fname[ARB]		# main file
+char	fsf_file[maxch]		# file containing names of subfiles
+int	maxch
+
+begin
+	call strcpy (fname, fsf_file, maxch)
+	call strcat (SUBFILE_EXTN, fsf_file, maxch)
+end
diff --git a/sys/fio/fstati.x b/sys/fio/fstati.x
new file mode 100644
index 00000000..9f22fe62
--- /dev/null
+++ b/sys/fio/fstati.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fset.h>
+include	<fio.h>
+
+# FSTATI -- Get information on the status and characteristics of an open
+# file.  Returns an integer value.  See also FSTATL and FSTATS (for long
+# integer and string status values).
+
+int procedure fstati (fd, what)
+
+int	fd				#I file descriptor
+int	what				#I parameter to be returned
+
+pointer	ffp, pb, pbtop
+int	flag, ffd, nchars, seglen, iomode
+int	and(), btoi()
+bool	envgetb()
+long	ffilsz()
+include	<fio.com>
+
+begin
+	ffp = fiodes[fd]
+
+	switch (what) {
+	case F_ASYNC:
+	    return (NO)				# async i/o not implemented
+	case F_BLKSIZE:
+	    return (FBLKSIZE(ffp))
+	case F_BUFPTR:
+	    return (bufptr[fd])
+	case F_BUFSIZE:
+	    return (FBUFSIZE(ffp))
+	case F_BUFTYPE:
+	    return (F_LOCAL)			# global bufs not implemented
+	case F_FILESIZE:
+	    FILSIZE(ffp) = ffilsz(fd)
+	    return (FILSIZE(ffp))
+	case F_FIRSTBUFOFF:
+	    return (FIRSTBUFOFF(ffp))
+	case F_CHANNEL:
+	    return (FCHAN(ffp))
+	case F_CLOBBER:
+	    return (btoi (envgetb ("clobber")))
+	case F_CLOSEFD:
+	    return (FCLOSEFD(ffp))
+	case F_DEVCODE:
+	    return (FDEV(ffp))
+	case F_DEVICE:
+	    return (zdev[FDEV(ffp)])
+
+	case F_EOF:
+	    if (FILSIZE(ffp) < 0 || LNOTE(fd) < ffilsz (fd))
+		return (NO)
+	    else
+		return (YES)
+
+	case F_FILEWAIT:
+	    return (btoi (envgetb ("filewait")))
+	case F_FIODES:
+	    return (ffp)
+	case F_FLUSHNL:
+	    flag = FF_FLUSHNL
+	case F_IOMODE:
+	    iomode = 0
+	    if (and (fflags[fd], FF_RAW) != 0)
+		iomode = iomode + IO_RAW
+	    if (and (fflags[fd], FF_NDELAY) != 0)
+		iomode = iomode + IO_NDELAY
+	    return (iomode)
+	case F_KEEP:
+	    flag = FF_KEEP
+
+	case F_LASTREFFILE:
+	    # Return FD of last active file, i.e., the file on which i/o was
+	    # most recently done (or on which i/o is in progress).  FIO sets
+	    # "fp" in fio.com whenever a file operation takes place.
+
+	    for (ffd=1;  ffd <= LAST_FD;  ffd=ffd+1)
+		if (fiodes[ffd] != NULL && fiodes[ffd] == fp)
+		    return (ffd)
+	    return (NULL)
+
+	case F_MODE:
+	    return (FMODE(ffp))
+
+	case F_NBUFS:
+	    if (bufptr[fd] == NULL)
+		return (0)
+	    else
+		return (FNBUFS(ffp))
+
+	case F_NCHARS:
+	    return (FNCHARS(ffp))
+	case F_ONEVERSION:
+	    return (btoi (envgetb ("multversions")))
+	case F_OPEN:
+	    return (YES)
+	case F_OPTBUFSIZE:
+	    return (FOPTBUFSIZE(ffp))
+	case F_RAW:
+	    flag = FF_RAW
+	case F_READ:
+	    flag = FF_READ
+
+	case F_REDIR:
+	    if (redir_fd[fd] != 0)
+		return (YES)
+	    else
+		return (NO)
+
+	case F_SZBBLK:
+	    return (FNBYTES(ffp))
+	case F_TYPE:
+	    return (FTYPE(ffp))
+	case F_WRITE:
+	    flag = FF_WRITE
+	case F_MAXBUFSIZE:
+	    return (FMAXBUFSIZE(ffp))
+
+	case F_UNREAD:
+	    UPDATE_IOP(fd)
+	    if (iop[fd] < bufptr[fd] || iop[fd] >= itop[fd])
+		nchars = 0
+	    else
+		nchars = itop[fd] - iop[fd]
+	    if (and (FF_PUSHBACK, fflags[fd]) != 0) {
+		pbtop = (FPBTOP(ffp) - 1) / SZ_INT + 1
+		for (pb=FPBSP(ffp);  pb < pbtop;  pb=pb+4) {
+		    seglen = Memi[pb+1] - Memi[pb]
+		    if (seglen > 0)
+			nchars = nchars + seglen
+		}
+	    }
+	    return (nchars)
+
+	default:
+	    return (ERR)
+	}
+
+	if (and (flag, fflags[fd]) != 0)		# test a flag bit
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/fio/fstatl.x b/sys/fio/fstatl.x
new file mode 100644
index 00000000..3b4fdd26
--- /dev/null
+++ b/sys/fio/fstatl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+include	<fset.h>
+include	<fio.h>
+
+# FSTATL -- Return a file status value of type long integer (l).
+
+long procedure fstatl (fd, what)
+
+int	fd, what
+int	ffilsz()
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    iferr (call syserr (SYS_FILENOTOPEN))
+		call erract (EA_FATAL)
+
+	switch (what) {
+	case F_FILESIZE:
+	    FILSIZE(fp) = ffilsz (fd)
+	    return (FILSIZE(fp))
+	default:
+	    iferr (call filerr (FNAME(fp), SYS_FSTATUNKPAR))
+		call erract (EA_FATAL)
+	}
+end
diff --git a/sys/fio/fstats.x b/sys/fio/fstats.x
new file mode 100644
index 00000000..469d0cc2
--- /dev/null
+++ b/sys/fio/fstats.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fset.h>
+include	<syserr.h>
+include	<fio.h>
+
+# FSTATS -- Return a file status value of type string (s).
+
+procedure fstats (fd, what, outstr, maxch)
+
+int	fd, what, maxch
+char	outstr[ARB]
+pointer	ffp
+errchk	syserr
+include	<fio.com>
+
+begin
+	ffp = fiodes[fd]
+	if (fd <= 0 || ffp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	switch (what) {
+	case F_FILENAME:
+	    call strcpy (FNAME(ffp), outstr, maxch)
+	default:
+	    call filerr (FNAME(ffp), SYS_FSTATUNKPAR)
+	}
+end
diff --git a/sys/fio/fstdfile.x b/sys/fio/fstdfile.x
new file mode 100644
index 00000000..b3f570a9
--- /dev/null
+++ b/sys/fio/fstdfile.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FSTDFILE -- Determine if the named file is a standard stream, and if so,
+# return its file descriptor.
+
+int procedure fstdfile (fname, ofd)
+
+char	fname[ARB]
+int	ofd
+bool	streq()
+
+begin
+	ofd = NULL
+
+	if (fname[1] != 'S' || fname[2] != 'T') {
+	    return (NO)
+	} else if (streq (fname, "STDIN")) {
+	    ofd = STDIN
+	    return (YES)
+	} else if (streq (fname, "STDOUT")) {
+	    ofd = STDOUT
+	    return (YES)
+	} else if (streq (fname, "STDERR")) {
+	    ofd = STDERR
+	    return (YES)
+	} else if (streq (fname, "STDGRAPH")) {
+	    ofd = STDGRAPH
+	    return (YES)
+	} else if (streq (fname, "STDIMAGE")) {
+	    ofd = STDIMAGE
+	    return (YES)
+	} else if (streq (fname, "STDPLOT")) {
+	    ofd = STDPLOT
+	    return (YES)
+	} else
+	    return (NO)
+end
diff --git a/sys/fio/fstrfp.x b/sys/fio/fstrfp.x
new file mode 100644
index 00000000..851bb6b1
--- /dev/null
+++ b/sys/fio/fstrfp.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# FSTRFP -- Get a dummy file descriptor for use by STROPEN "files".
+# The static part of the descriptor is returned to later be allocated
+# by STROPEN.  The dynamic part is permanently allocated, and is used to
+# make the string look more like a regular file.
+
+procedure fstrfp (newfp)
+
+pointer	newfp
+pointer	str_fp
+int	fd, fgetfd()
+data	str_fp /NULL/
+include	<fio.com>
+
+begin
+	if (str_fp == NULL) {
+	    fd = fgetfd ("String_File", STRING_FILE, STRING_FILE)
+	    str_fp = fiodes[fd]
+	    fiodes[fd] = NULL
+	}
+
+	newfp = str_fp
+end
diff --git a/sys/fio/fsvtfn.x b/sys/fio/fsvtfn.x
new file mode 100644
index 00000000..25b82f94
--- /dev/null
+++ b/sys/fio/fsvtfn.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+define	SZ_TMPFILBUF		100
+define	SZ_INCREMENT		100
+
+
+# FSVTFN -- Save the name of a temporary file for automatic deletion at task
+# termination.
+
+procedure fsvtfn (fname)
+
+char	fname[ARB]
+bool	first_time
+int	sz_tmpbuf, nchars
+int	strlen()
+errchk	malloc, realloc
+
+pointer	tmpbuf
+int	nextch
+common	/ftfcom/ tmpbuf, nextch
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    tmpbuf = NULL
+	    first_time = false
+	}
+
+	# Call with a null filename permits first time initialization.
+	if (fname[1] == EOS)
+	    return
+
+	# Initial allocation of buffer.
+	if (tmpbuf == NULL) {
+	    sz_tmpbuf = SZ_TMPFILBUF
+	    call malloc (tmpbuf, sz_tmpbuf, TY_CHAR)
+	    nextch = 0
+	}
+
+	# Increase size of buffer if necessary.
+	nchars = strlen (fname)
+	if (nchars == 0)
+	    return
+	else {
+	    while (nextch + nchars + 1 >= sz_tmpbuf) {
+		sz_tmpbuf = sz_tmpbuf + SZ_INCREMENT
+		call realloc (tmpbuf, sz_tmpbuf, TY_CHAR)
+	    }
+	}
+
+	# Save name of temporary file in buffer.
+	call strcpy (fname, Memc[tmpbuf+nextch], ARB)
+	nextch = nextch + nchars + 1
+end
+
+
+# FRMTMP -- Delete all temporary files and return space.  It seems harmless
+# for the user to explicitly delete a temporary file, so we do not complain
+# if the file does not exist.
+
+procedure frmtmp()
+
+pointer	buftop, ip
+int	strlen(), access()
+
+pointer	tmpbuf
+int	nextch
+common	/ftfcom/ tmpbuf, nextch
+
+begin
+	if (tmpbuf != NULL) {
+	    buftop = tmpbuf + nextch
+	    for (ip=tmpbuf;  ip < buftop;  ip = ip + strlen (Memc[ip]) + 1)
+		if (access (Memc[ip],0,0) == YES)
+		    iferr (call delete (Memc[ip]))
+			call erract (EA_WARN)
+	    call mfree (tmpbuf, TY_CHAR)
+	}
+end
diff --git a/sys/fio/fswapfd.x b/sys/fio/fswapfd.x
new file mode 100644
index 00000000..d51d69a9
--- /dev/null
+++ b/sys/fio/fswapfd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+define	SWAPI		{tempi=$1;$1=$2;$2=tempi}
+define	SWAPL		{templ=$1;$1=$2;$2=templ}
+define	SWAPP		{tempp=$1;$1=$2;$2=tempp}
+
+# FSWAPFD -- Swap the file descriptors of two open files.  All i/o to file
+# fd1 is redirected to fd2 and vice versa, until the swap is reversed.
+# We are used by FREDIR to temporarily redirect i/o (normally to one of the
+# standard streams) to a special file.  If CLOSE is called to close a
+# redirected file, we are called to unswap the two streams and then the
+# redirection file is closed.  All the i/o pointers, buffer pointers, and
+# so on of the original stream are restored to exactly the condition they
+# were in before (unless i/o has occurred on the other file during the
+# interim).
+
+procedure fswapfd (fd1, fd2)
+
+int	fd1, fd2		# file descriptors to be swapped.
+int	tempi
+long	templ
+pointer	tempp
+include	<fio.com>
+
+begin
+ 	SWAPL (boffset[fd1], boffset[fd2])
+ 	SWAPP (bufptr[fd1], bufptr[fd2])
+ 	SWAPP (buftop[fd1], buftop[fd2])
+ 	SWAPP (iop[fd1], iop[fd2])
+ 	SWAPP (itop[fd1], itop[fd2])
+ 	SWAPP (otop[fd1], otop[fd2])
+ 	SWAPP (fiodes[fd1], fiodes[fd2])
+ 	SWAPI (redir_fd[fd1], redir_fd[fd2])
+end
diff --git a/sys/fio/fsymlink.x b/sys/fio/fsymlink.x
new file mode 100644
index 00000000..c742baa7
--- /dev/null
+++ b/sys/fio/fsymlink.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# FSYMLINK -- Remove a symlink.
+
+procedure fsymlink (link, target)
+
+char	link[ARB]			# link name
+char	target[ARB]			# target file
+
+int	status
+pointer	sp, oslnk, ostgt, lname, tname
+int	access()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (lname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tname, SZ_PATHNAME, TY_CHAR)
+	call salloc (oslnk, SZ_PATHNAME, TY_CHAR)
+	call salloc (ostgt, SZ_PATHNAME, TY_CHAR)
+
+	# It is an error if the link file already exists.
+	if (access (link, 0, 0) == YES)
+	    call syserrs (SYS_FSYMLINK, link)
+	
+        # Always present ZFLINK with a full pathname (rather than an
+        # absolute or cwd relative filename), in case the kernel procedure
+        # is not smart enough to handle all these possibilities.
+	call aclrc (Memc[oslnk], SZ_PATHNAME)
+        iferr (call fmapfn (link, Memc[oslnk], SZ_PATHNAME))
+            call syserrs (SYS_FSYMLINK, link)
+
+#        call strupk (Memc[oslnk], Memc[oslnk], SZ_PATHNAME)
+#        call strpak (Memc[oslnk], Memc[oslnk], SZ_PATHNAME)
+
+
+	call aclrc (Memc[ostgt], SZ_PATHNAME)
+        iferr (call fmapfn (target, Memc[ostgt], SZ_PATHNAME))
+            call syserrs (SYS_FSYMLINK, target)
+        
+#        call strupk (Memc[ostgt], Memc[ostgt], SZ_PATHNAME)
+#        call strpak (Memc[ostgt], Memc[ostgt], SZ_PATHNAME)
+
+	# Try to create the symlink.
+	call zflink (Memc[ostgt], Memc[oslnk], status)
+	if (status == ERR)
+	    call syserrs (SYS_FSYMLINK, link)
+
+	call sfree (sp)
+end
diff --git a/sys/fio/funlink.x b/sys/fio/funlink.x
new file mode 100644
index 00000000..402076f0
--- /dev/null
+++ b/sys/fio/funlink.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# FUNLINK -- Remove a symlink.
+
+procedure funlink (lname)
+
+char	lname[ARB]			# link name
+
+int	status
+pointer	sp, oslnk
+int	access()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (oslnk, SZ_PATHNAME, TY_CHAR)
+
+	# It is an error if the link file doesn't exist.
+	if (access (lname, 0, 0) == NO)
+	    call syserrs (SYS_FOPEN, lname)
+	
+	# Try to remove the symlink.
+        iferr (call fmapfn (lname, Memc[oslnk], SZ_PATHNAME))
+            call syserrs (SYS_FSYMLINK, lname)
+	call zfulnk (Memc[oslnk], status)
+	if (status == ERR)
+	    call syserrs (SYS_FUNLINK, lname)
+
+	call sfree (sp)
+end
diff --git a/sys/fio/futime.x b/sys/fio/futime.x
new file mode 100644
index 00000000..72ef268b
--- /dev/null
+++ b/sys/fio/futime.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+
+
+.help futime
+.nf ___________________________________________________________________________
+FUTIME -- Set the file access/modify times of a file.  Time arguments are
+assumed to be in units of seconds from midnight on Jan 1, 1980, local standard
+time.  A file may be "touched" to update it's modify time to the current
+clock time using the CLKTIME function with a call such as
+
+	stat = futime (fname, NULL, clktime(0))
+
+Remote files are handled via the KI interface automatically.
+.endhelp ______________________________________________________________________
+
+int procedure futime (fname, atime, mtime)
+
+char	fname[ARB]
+long	atime, mtime
+int	status
+include	<fio.com>
+
+begin
+	iferr (call fmapfn (fname, pathname, SZ_PATHNAME))
+	    return (ERR)
+
+	# Update the time, let the HSI routine handle NULL values.
+	call zfutim (pathname, atime, mtime, status)
+
+	return (status)
+end
diff --git a/sys/fio/fwatio.x b/sys/fio/fwatio.x
new file mode 100644
index 00000000..15e9c249
--- /dev/null
+++ b/sys/fio/fwatio.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# FWATIO -- Wait for i/o to complete on the file buffer, update file
+# buffer pointers.
+
+procedure fwatio (fd)
+
+int	fd
+int	nchars, bufmode
+int	await()
+errchk	filerr
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+
+	if (FBUFMODE(fp) == INACTIVE)
+	    return
+
+	else {
+	    nchars = await (fd)
+
+	    # Set the buffer mode flag to inactive regardless of the status
+	    # returned by await.  
+
+	    bufmode = FBUFMODE(fp)
+	    FBUFMODE(fp) = INACTIVE
+
+	    if (bufmode == READ_IN_PROGRESS) {
+		if (nchars == ERR)
+		    call filerr (FNAME(fp), SYS_FREAD)
+		else
+		    itop[fd] = bufptr[fd] + nchars
+
+	    } else if (nchars == ERR) {
+		# If an i/o error occurs on a write invalidate the buffer
+		# else during error recovery close will try again to write
+		# the data, probably causing another error.
+
+		otop[fd] = bufptr[fd]
+		call filerr (FNAME(fp), SYS_FWRITE)
+	    }
+
+	    otop[fd] = bufptr[fd]
+	}
+end
diff --git a/sys/fio/fwritep.x b/sys/fio/fwritep.x
new file mode 100644
index 00000000..f92aeaf0
--- /dev/null
+++ b/sys/fio/fwritep.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+include <syserr.h>
+include <fio.h>
+
+# FWRITEP -- Write to a file, directly accessing the file data in the FIO
+# buffer rather than copying the data from the user buffer to the FIO buffer.
+# This technique can be used for very efficient file access, but is not as
+# general as an ordinary write.  In particular the requested data segment
+# must lie entirely within the FIO buffer, and the data must be written into
+# the FIO buffer before a file fault causes the buffer contents to be flushed
+# to disk.  The file size should be known in advance and any attempt to write
+# outside the file boundaries is interpreted as an error.
+#
+# NOTE -- This routine returns a pointer into the FIO buffer.  No data is
+# transferred in the call itself.  The data is not actually written to the
+# output file until the FIO buffer is faulted out.  If the output file is
+# readwrite and offset,nchars does not span the entire buffer, file data
+# will be read into the buffer when it is first faulted in.  Hence, FWRITEP
+# may be used for updating the contents of a file.
+
+pointer procedure fwritep (fd, offset, nchars)
+
+int	fd		# file to be accessed
+long	offset		# file offset in chars
+int	nchars		# nchars to "write"
+
+int	junk
+pointer	fiop, bp
+int	ffault()
+errchk	filerr, ffault, fmkbfs
+include	<fio.com>
+
+begin
+	# Move file buffer onto file block containing the file offset.
+	# Verify that the buffer contains nchars of file data in contiguous
+	# storage.  If the file buffer already contains the referenced
+	# data segment no fault is necessary and this is quite fast.
+	# The iop is left pointing to the first char following the
+	# referenced data block.
+
+	repeat {
+	    bp   = bufptr[fd]
+	    fiop = offset - boffset[fd] + bp		# lseek
+
+	    if (fiop < bp || fiop >= otop[fd]) {
+		if (bp == NULL) {
+		    call fmkbfs (fd)
+		    next
+		}
+		junk = ffault (fd, offset, nchars, FF_WRITE)
+		fiop = iop[fd]
+		otop[fd] = buftop[fd]
+	    }
+
+	    iop[fd] = fiop + nchars
+	    if (iop[fd] > otop[fd])
+		call filerr (FNAME(fiodes[fd]), SYS_FWRITEP)
+
+	    return (fiop)
+	}
+end
diff --git a/sys/fio/fwtacc.x b/sys/fio/fwtacc.x
new file mode 100644
index 00000000..bcedcae0
--- /dev/null
+++ b/sys/fio/fwtacc.x
@@ -0,0 +1,120 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include <finfo.h>
+include	<fio.h>
+
+define	MIN_DELAY	1
+define	MAX_DELAY	60
+define	INC_DELAY	1
+define	SOMEFILE	"hlib$iraf.h"
+
+
+# FWTACC -- Called if a file open fails.  Determine if failure to open file
+# was due to the file already being open by another task.  If so, and file
+# waiting is enabled in the environment, wait for file to become accessible,
+# otherwise take error action.
+
+procedure fwtacc (fd, fname)
+
+int	fd				#I file we are trying to open
+char	fname[ARB]			#I name of file
+
+bool	locked
+pointer	sp, osfn
+int	perm, delay, chan, status, ofd
+long	fi[LEN_FINFO]
+
+int	access(), finfo()
+bool	streq(), envgetb()
+errchk	filerr, fmapfn
+include	<fio.com>
+define	noacc_ 91
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	fp = fiodes[fd]
+	if (FMODE(fp) == NEW_FILE)
+	    call filerr (fname, SYS_FOPEN)
+
+	# If file is blocked for some reason because it is already open
+	# by this process, waiting would result in a deadlock.
+
+	for (ofd=FIRST_FD;  ofd <= LAST_FD;  ofd=ofd+1)
+	    if (ofd != fd && fiodes[ofd] != NULL)
+		if (streq (fname, FNAME(fiodes[ofd])))
+		    call filerr (fname, SYS_FWTOPNFIL)
+
+	# If file waiting is enabled, the file exists and has write permission
+	# for us but is not writable at the moment, wait for the file to
+	# become available.  FINFO is used to determine the "permanent"
+	# permissions for the file and the file owner.  ACCESS determines the
+	# runtime accessibility of the file.  The permanent file protection may
+	# permit writing but the file may not be accessible for writing at
+	# runtime if opened for exclusive access by another process.
+
+	if (finfo (fname, fi) == ERR)
+	    call filerr (fname, SYS_FOPNNEXFIL)
+
+	# Directory files are not accessible as files.
+	if (FI_TYPE(fi) == FI_DIRECTORY)
+	    goto noacc_
+
+	# Test if we the open failed because we cannot physically open any
+	# more files.
+
+	call fmapfn (SOMEFILE, Memc[osfn], SZ_PATHNAME)
+	call zopntx (Memc[osfn], READ_ONLY, chan)
+	if (chan == ERR)
+	    call filerr (fname, SYS_FTOOMANYFILES)
+	else
+	    call zclstx (chan, status)
+
+	# If the file exists, we cannot access it, and there is no temporary
+	# read or write lock in place on the file, then the file cannot be
+	# accessed.
+
+	perm = FI_PERM(fi)
+	locked = false
+	if (and (fflags[fd], FF_READ) != 0)
+	    locked = locked || (and (perm, FF_RDLOCK) != 0)
+	if (and (fflags[fd], FF_WRITE) != 0)
+	    locked = locked || (and (perm, FF_WRLOCK) != 0)
+
+	# If filewait is enabled, wait for the file to become accessible.
+	if (envgetb ("filewait") && locked) {
+	    call putline (STDERR, "Waiting for access to file '")
+	    call putline (STDERR, fname)
+	    call putline (STDERR, "'\n")
+
+	    for (delay=MIN_DELAY;  delay > 0;  delay=delay+INC_DELAY) {
+		call tsleep (min (delay, MAX_DELAY))
+
+		if (access (fname,0,0) == NO)
+		    call filerr (fname, SYS_FOPNNEXFIL)
+		else if (access (fname,FMODE(fp),0) == YES) {
+		    call sfree (sp)
+		    return
+		}
+		
+		# Verify that the file is still locked.
+		if (finfo (fname, fi) == ERR)
+		    call filerr (fname, SYS_FOPNNEXFIL)
+
+		locked = false
+		if (and (fflags[fd], FF_READ) != 0)
+		    locked = locked || (and (perm, FF_RDLOCK) != 0)
+		if (and (fflags[fd], FF_WRITE) != 0)
+		    locked = locked || (and (perm, FF_WRLOCK) != 0)
+		
+		if (!locked)
+		    break
+	    }
+	} 
+noacc_
+	call sfree (sp)
+    	call filerr (fname, SYS_FWTNOACC)
+end
diff --git a/sys/fio/getc.x b/sys/fio/getc.x
new file mode 100644
index 00000000..b8c469d5
--- /dev/null
+++ b/sys/fio/getc.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# GETC -- Get a character from a file.
+
+char procedure getc (fd, ch)
+
+int	fd			# input file
+char	ch			# character (output)
+int	filbuf()
+errchk	filbuf
+include	<fio.com>
+
+begin
+ 	if (iop[fd] < bufptr[fd] || iop[fd] >= itop[fd])
+	    if (filbuf(fd) == EOF) {
+		ch = EOF
+		return (EOF)
+	    }
+
+	ch = Memc[iop[fd]]
+	iop[fd] = iop[fd] + 1
+
+	return (ch)
+end
diff --git a/sys/fio/getchar.x b/sys/fio/getchar.x
new file mode 100644
index 00000000..2a2b6cd9
--- /dev/null
+++ b/sys/fio/getchar.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETCHAR -- Get a character from the standard input.
+
+char procedure getchar (ch)
+
+char	ch			# character (output)
+char	getc()
+
+begin
+	return (getc (STDIN, ch))
+end
diff --git a/sys/fio/getci.x b/sys/fio/getci.x
new file mode 100644
index 00000000..64dd6f66
--- /dev/null
+++ b/sys/fio/getci.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# GETCI -- Get a character (passed as an integer) from a file.
+
+int procedure getci (fd, ch)
+
+int	fd			# input file
+int	ch			# character (output)
+int	filbuf()
+errchk	filbuf
+include	<fio.com>
+
+begin
+ 	if (iop[fd] < bufptr[fd] || iop[fd] >= itop[fd])
+	    if (filbuf(fd) == EOF) {
+		ch = EOF
+		return (EOF)
+	    }
+
+	ch = Memc[iop[fd]]
+	iop[fd] = iop[fd] + 1
+
+	return (ch)
+end
diff --git a/sys/fio/getline.x b/sys/fio/getline.x
new file mode 100644
index 00000000..78bdb285
--- /dev/null
+++ b/sys/fio/getline.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include <fio.h>
+
+# GETLINE -- Get a line of text from a file.  If file buffer is empty and
+# file is a text file, read line directly into the buffer supplied by the
+# calling procedure.  If text is buffered, copy characters out of file buffer
+# into the output buffer until the newline character is encountered.  Refill
+# buffer as necessary.  Note IOP, ITOP are moved into local variables to
+# optimize the loop.  The fd values must be updated before calling FILBUF
+# and upon exit from the loop.
+
+int procedure getline (fd, linebuf)
+
+int	fd				# input file
+char	linebuf[ARB]			# output line buffer (>= SZ_LINE)
+
+bool	pushback
+char	ch
+pointer	ip, ip_top, op
+int	maxch, status
+int	filbuf(), and()
+errchk	filbuf, filerr
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call filerr (FNAME(fp), SYS_FILENOTOPEN)
+
+	pushback = (and (fflags[fd], FF_PUSHBACK) != 0)
+
+	if (FTYPE(fp) == TEXT_FILE && iop[fd] == itop[fd] && !pushback) {
+	    # Get next line from text file, initialize pointers.  In raw mode
+	    # we only read one character at a time.
+
+	    if (and (FF_RAW, fflags[fd]) == 0)
+		maxch = SZ_LINE
+	    else
+		maxch = 1
+	    call zcall4 (ZGETTX(fp), FCHAN(fp), linebuf, maxch, status)
+
+	    if (status == ERR)
+		call filerr (FNAME(fp), SYS_FREAD)
+	    op = max (0, status+1)
+
+	} else {
+	    op = 1
+	    ip = iop[fd]			# loop optimization stuff
+	    ip_top = itop[fd]
+	    if (ip < bufptr[fd])
+		goto 10
+
+	    while (op <= SZ_LINE) {
+		if (ip >= ip_top) {
+		    iop[fd] = ip
+ 10		    status = filbuf (fd)
+		    ip = iop[fd]
+		    ip_top = itop[fd]
+		    if (status <= 0)
+			break
+		}
+		
+		ch = Memc[ip]
+		linebuf[op] = ch
+		ip = ip + 1
+		op = op + 1
+
+		if (ch == '\n')
+		    break
+	    }
+	    iop[fd] = ip
+	}
+
+	if (op <= 1) {
+	    FNCHARS(fp) = 0
+	    return (EOF)
+	} else {
+	    FNCHARS(fp) = op - 1
+	    linebuf[op] = EOS
+	    return (op - 1)			# number of chars read
+	}
+end
diff --git a/sys/fio/getlline.x b/sys/fio/getlline.x
new file mode 100644
index 00000000..e8e25d77
--- /dev/null
+++ b/sys/fio/getlline.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETLLINE -- Get a logical line of text, i.e., an arbitrarily long line
+# possibly broken up into multiple segments of size SZ_LINE.  Accumulation
+# stops when the indicated number of chars have been read, or newline is
+# detected.  MAXCH must be at least SZ_LINE characters greater than the
+# longest line to be read.
+
+int procedure getlline (fd, obuf, maxch)
+
+int	fd			#I input file
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars out, >= SZ_LINE
+
+int	op, status
+int	getline()
+errchk	getline
+
+begin
+	op = 1
+
+	while (maxch - op + 1 >= SZ_LINE) {
+	    # Get next physical line from the file.
+	    status = getline (fd, obuf[op])
+	    if (status == EOF) {
+		if (op == 1)
+		    return (EOF)
+		else
+		    return (op - 1)
+	    } else
+		op = op + status
+
+	    # If the last physical line read ends in a newline we are done.
+	    # If no newline we get another line, thereby reconstructing long
+	    # lines broken by the SZ_LINE limit of getline().
+
+	    if (obuf[op-1] == '\n')
+		break
+	}
+
+	return (op - 1)
+end
diff --git a/sys/fio/glongline.x b/sys/fio/glongline.x
new file mode 100644
index 00000000..6350cb3e
--- /dev/null
+++ b/sys/fio/glongline.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GETLONGLINE -- Get a long line, i.e., a logical line possibly spanning
+# several physical lines with the newlines escaped at the ends.  Skip
+# comment lines and .help sections.  Blank lines are not skipped.
+# Lines not terminated by newlines are joined to form a longer line.
+# MAXCH must be at least SZ_LINE characters greater than the size of the
+# longest line to be read.
+
+int procedure getlongline (fd, obuf, maxch, linenum)
+
+int	fd			#I input file
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars out
+int	linenum			#U line number counter
+
+int	op, status
+int	getline(), strncmp()
+errchk	getline
+
+begin
+	op = 1
+
+	while (maxch - op + 1 >= SZ_LINE) {
+	    # Get next non-comment line.
+	    repeat {
+		status = getline (fd, obuf[op])
+		if (status > 0 && obuf[op+status-1] == '\n')
+		    linenum = linenum + 1
+
+		if (status == EOF) {
+		    break
+		} else if (obuf[op] == '#') {
+		    next
+		} else if (obuf[op] == '.') {
+		    # Skip help sections.
+		    if (strncmp (obuf[op], ".help", 5) == 0) {
+			repeat {
+			    status = getline (fd, obuf[op])
+			    linenum = linenum + 1
+			    if (status == EOF)
+				break
+			    if (strncmp (obuf[op], ".endhelp", 8) == 0)
+				break
+			}
+		    } else
+			break
+		} else
+		    break
+	    }
+
+	    if (status == EOF) {
+		if (op == 1)
+		    return (EOF)
+		else
+		    return (op - 1)
+	    } else
+		op = op + status
+
+	    # If the last physical line read ends in a newline we are done,
+	    # unless the newline is escaped.  If there is no newline we get
+	    # another line, thereby reconstructing long lines broken by the
+	    # SZ_LINE limit of getline().
+
+	    if (obuf[op-1] == '\n')
+		if (obuf[op-2] == '\\')
+		    op = op - 2
+		else
+		    break
+	}
+
+	return (op - 1)
+end
diff --git a/sys/fio/isdir.x b/sys/fio/isdir.x
new file mode 100644
index 00000000..92008da1
--- /dev/null
+++ b/sys/fio/isdir.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<finfo.h>
+
+# ISDIRECTORY -- Test whether the named file is a directory.  Check first to
+# see if it is a subdirectory of the current directory; otherwise look in
+# the environment to see if it is a logical directory.  If VFN is a directory,
+# return the OS pathname of the directory in pathname, and the number of
+# chars in the pathname as the function value.  Otherwise return 0.
+
+int procedure isdirectory (vfn, pathname, maxch)
+
+char	vfn[ARB]		# name to be tested
+char	pathname[ARB]		# receives path of directory
+int	maxch			# max chars out
+
+bool	isdir
+pointer	sp, fname, op
+int	ip, fd, nchars, ch
+long	file_info[LEN_FINFO]
+int	finfo(), diropen(), gstrcpy(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Copy the VFN string, minus any whitespace on either end.
+	op = fname
+	for (ip=1;  vfn[ip] != EOS;  ip=ip+1) {
+	    ch = vfn[ip]
+	    if (!IS_WHITE (ch)) {
+		Memc[op] = ch
+		op = op + 1
+	    }
+	}
+	Memc[op] = EOS
+
+	# Remove any trailing '/' from the pathname.
+	if (Memc[op-1] == '/')
+	    Memc[op-1] = EOS
+
+	isdir = false
+	if (finfo (Memc[fname], file_info) != ERR) {
+	    isdir = (FI_TYPE(file_info) == FI_DIRECTORY)
+
+	    if (isdir) {
+		call fdirname (Memc[fname], pathname, maxch)
+		nchars = strlen (pathname)
+	    }
+
+	} else {
+	    # If we get here, either VFN is a logical directory (with the
+	    # $ omitted), or it is the name of a new file.
+
+	    Memc[op] = '$'
+	    Memc[op+1] = EOS
+	    ifnoerr (fd = diropen (Memc[fname], 0)) {
+		call close (fd)
+		isdir = true
+	    }
+
+	    nchars = gstrcpy (Memc[fname], pathname, maxch)
+	}
+
+	call sfree (sp)
+	if (isdir)
+	    return (nchars)
+	else {
+	    pathname[1] = EOS
+	    return (0)
+	}
+end
diff --git a/sys/fio/mkpkg b/sys/fio/mkpkg
new file mode 100644
index 00000000..f135befc
--- /dev/null
+++ b/sys/fio/mkpkg
@@ -0,0 +1,123 @@
+# Make the file i/o (FIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	access.x	mmap.inc <config.h> <ctype.h> <fio.com> <fio.h>\
+			<fset.h> <knet.h>
+	aread.x		<mach.h>
+	areadb.x	<config.h> <fio.com> <fio.h> <mach.h>
+	await.x		<config.h> <fio.com> <fio.h> <mach.h>
+	awaitb.x	<config.h> <fio.com> <fio.h> <mach.h>
+	awrite.x	<mach.h>
+	awriteb.x	<config.h> <fio.com> <fio.h> <mach.h>
+	close.x		<config.h> <fio.com> <fio.h>
+	delete.x	<config.h> <error.h> <fio.h> <knet.h>
+	deletefg.x	<error.h>
+	diropen.x	<config.h> <diropen.h> <error.h> <fio.h> <fset.h>\
+			<knet.h>
+	falloc.x	<config.h> <error.h> <fio.com> <fio.h> <knet.h> <mach.h>
+        fcache.x        <ctype.h> <diropen.h> <finfo.h> <fset.h> <mach.h>
+	fcanpb.x	<config.h> <fio.com> <fio.h>
+	fchdir.x	<knet.h>
+	fclobber.x	<config.h> <fio.com> <fio.h>
+	fcopy.x		<error.h> <fset.h>
+	fdebug.x	<config.h> <fio.com> <fio.h>
+	fdevbf.x	<config.h> <fio.com> <fio.h>
+	fdevblk.x	<fset.h>
+	fdevtx.x	<config.h> <fio.com> <fio.h>
+	fdirname.x	<ctype.h> <knet.h>
+	fexbuf.x	<config.h> <fio.com> <fio.h>
+	ffault.x	<config.h> <error.h> <fio.com> <fio.h>
+	ffilbf.x	<config.h> <fio.com> <fio.h>
+	ffilsz.x	<config.h> <fio.com> <fio.h> <mach.h>
+	fflsbf.x	<config.h> <fio.com> <fio.h>
+	fgdevpar.x	<config.h> <fio.com> <fio.h> <mach.h>
+	fgetfd.x	<fio.com> mmap.inc <config.h> <fio.com> <fio.h>
+	filbuf.x	<config.h> <fio.com> <fio.h>
+	filerr.x	
+	filopn.x	<config.h> <ctype.h> <error.h> <fio.com> <fio.h>\
+			<fset.h>
+	finfo.x		<config.h> <finfo.h> <fio.com> <fio.h> <knet.h>
+	finit.x		<config.h> <error.h> <fio.com> <fio.h> <knet.h>\
+			<ttset.h>
+	fioclean.x	<config.h> <error.h> <fio.com> <fio.h> <fset.h>
+	flsbuf.x	<config.h> <fio.com> <fio.h>
+	flush.x		<config.h> <fio.com> <fio.h>
+	fmapfn.x	<config.h> <fio.h>
+	fmkbfs.x	<config.h> <fio.com> <fio.h>
+	fmkcopy.x	<config.h> <error.h> <fio.com> <fio.h> <knet.h>
+	fmkdir.x	<knet.h>
+	fmkpbbuf.x	<config.h> <fio.com> <fio.h>
+	fnextn.x	
+	fnldir.x	
+	fnroot.x	
+	frmdir.x	<knet.h>
+	fntgfn.x	<chars.h> <ctype.h> <diropen.h> <pattern.h>
+	fnullfile.x	
+	fopnbf.x	
+	fopntx.x	
+	fowner.x	<finfo.h>
+	fpathname.x	<config.h> <fio.com> <fio.h> <knet.h>
+	fputtx.x	<config.h> <fio.com> <fio.h>
+	freadp.x	<fio.com> <config.h> <fio.h>
+	fredir.x	<config.h> <fio.com> <fio.h>
+	frename.x	<config.h> <error.h> <fio.com> <fio.h> <knet.h>
+	frmbfs.x	<config.h> <fio.com> <fio.h>
+	frtnfd.x	<config.h> <fio.com> <fio.h>
+	fseti.x		<config.h> <error.h> <fio.com> <fio.h> <fset.h>\
+			<mach.h>
+	fsfopen.x	<config.h> <fio.h>
+	fstati.x	<config.h> <fio.com> <fio.h> <fset.h> <mach.h>
+	fstatl.x	<config.h> <error.h> <fio.com> <fio.h> <fset.h>
+	fstats.x	<config.h> <fio.com> <fio.h> <fset.h>
+	fstdfile.x	
+	fstrfp.x	<config.h> <fio.com> <fio.h>
+	fsymlink.x	<knet.h>
+	fsvtfn.x	<error.h>
+	fswapfd.x	<config.h> <fio.com> <fio.h>
+	funlink.x	<knet.h>
+	futime.x	<config.h> <knet.h>
+	fwatio.x	<config.h> <fio.com> <fio.h>
+	fwritep.x	<fio.com> <config.h> <fio.h>
+	fwtacc.x	<config.h> <fio.com> <fio.h> <finfo.h>
+	getc.x		<config.h> <fio.com> <fio.h>
+	getchar.x	
+	getci.x		<config.h> <fio.com> <fio.h>
+	getline.x	<config.h> <fio.com> <fio.h>
+	getlline.x	
+	glongline.x	
+	isdir.x		<ctype.h> <finfo.h>
+	mktemp.x	
+	ndopen.x	<fset.h>
+	note.x		<config.h> <fio.com> <fio.h>
+	nowhite.x	<ctype.h>
+	nullfile.x	<config.h> <fio.h>
+	open.x		<knet.h>
+	osfnlock.x	<config.h> <ctype.h> <finfo.h> <knet.h>
+	poll.x 		<poll.h> <fio.h> <fset.h> <config.h> <syserr.h>
+	protect.x	<config.h> <fio.com> <fio.h> <knet.h> <protect.h>
+	putc.x		<config.h> <fio.com> <fio.h>
+	putcc.x		<ctype.h>
+	putci.x		<config.h> <fio.com> <fio.h>
+	putline.x	<config.h> <fio.com> <fio.h> <mach.h>
+	read.x		<config.h> <fio.com> <fio.h>
+	rename.x	<error.h> <fio.h>
+	reopen.x	<config.h> <fio.com> <fio.h>
+	seek.x		<config.h> <fio.com> <fio.h>
+	stropen.x	<config.h> <fio.com> <fio.h>
+	ungetc.x	<config.h> <fio.com> <fio.h>
+	ungetci.x	<config.h> <fio.com> <fio.h>
+	ungetline.x	<config.h> <fio.com> <fio.h>
+	unread.x	<config.h> <fio.com> <fio.h>
+	vfnmap.x	<config.h> <ctype.h> <error.h> <fio.h> <knet.h>\
+			<mach.h>
+	vfntrans.x	<chars.h> <config.h> <ctype.h> <fio.h> <knet.h>
+	write.x		<config.h> <fio.com> <fio.h>
+	xerputc.x	<config.h> <fio.com> <fio.h> <mach.h>
+	zfiott.x	zfiott.com <chars.h> <ctype.h> <fio.h> <knet.h>\
+			<ttset.h>
+	;
diff --git a/sys/fio/mktemp.x b/sys/fio/mktemp.x
new file mode 100644
index 00000000..272d4c64
--- /dev/null
+++ b/sys/fio/mktemp.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+define	RADIX		26
+define	SZ_SUFFIX	10
+define	NTRIES		5
+define	MAX_TRIP	5000
+
+# MKTEMP -- Make a unique file name (used to generate temporary file names).
+# Format of name is "seedNNNNcc.." where the seed is supplied by the caller,
+# NNNN is (normally) the lowest four digits of the process id, and the
+# characters "cc..." are the radix 26 representation of a local counter
+# (maintained in static storage).  The algorithm used virtually guarantees
+# a unique name on the first try.  Logical directory prefixes are allowed.
+
+procedure mktemp (seed, temp_file, maxchars)
+
+char	seed[ARB], temp_file[ARB], suffix[SZ_SUFFIX]
+int	maxchars, counter, i, n, op, pid
+int	access(), itoc()
+data	counter/0/
+
+begin
+	call zgtpid (pid)				# get process id
+
+	do i = 1, MAX_TRIP {
+	    call strcpy (seed, temp_file, maxchars)
+	    op = itoc (mod(pid,10000), suffix, SZ_SUFFIX)
+	    call strcat (suffix, temp_file, maxchars)
+
+	    counter = counter + 1
+	    op = 1
+	    for (n=counter;  n > 0;  n = (n-1) / RADIX) {
+		suffix[op] = mod (n-1, RADIX) + 'a'
+		op = op + 1
+	    }
+	    suffix[op] = EOS
+	    call strcat (suffix, temp_file, maxchars)
+
+	    if (access (temp_file,0,0) == NO)		# does file exist?
+		return
+	    else if (mod(i,NTRIES) == 0)
+		pid = pid + mod(counter,10)		# not likely to get here
+	}
+
+	call filerr (seed, SYS_FMKTEMP)
+end
diff --git a/sys/fio/mmap.inc b/sys/fio/mmap.inc
new file mode 100644
index 00000000..aebc0f27
--- /dev/null
+++ b/sys/fio/mmap.inc
@@ -0,0 +1,8 @@
+# map 6 file modes into one of five simpler modes
+int	mmap[TEMP_FILE]
+data	mmap[READ_ONLY]  /READ_ONLY/
+data	mmap[READ_WRITE] /READ_WRITE/
+data	mmap[WRITE_ONLY] /WRITE_ONLY/
+data	mmap[APPEND]     /APPEND/
+data	mmap[NEW_FILE]   /NEW_FILE/
+data	mmap[TEMP_FILE]  /NEW_FILE/
diff --git a/sys/fio/ndopen.x b/sys/fio/ndopen.x
new file mode 100644
index 00000000..bb71933e
--- /dev/null
+++ b/sys/fio/ndopen.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+
+
+# NDOPEN -- Open a network device.  This is used by a client to connect to
+# a server, or by a server to establish a port to which clients can connect.
+# The open may or may not block until a client has connected, depending upon
+# the type of connection.  The access mode should be NEW_FILE for a server
+# connection, anything else is a client connection.  If the server is to
+# support multiple client connections the server connection can be opened
+# in nonblocking mode, then used to listen for client connections which are
+# accepted each on a separate connection (see zfiond.c for details).  Most
+# clients use mode READ_WRITE.  The connection is bidirectional and stream
+# oriented.
+#
+# The syntax of the filename argument (network address) is determined by the
+# host level ND driver.  The filename is passed on to the driver transparently
+# to the portable IRAF code.  System independent IRAF code should treat these
+# strings as data, like host filenames, and not attempt to parse or construct
+# the strings.  Refer to the ND driver source for further information on the
+# ND filename syntax.
+#
+# The host driver (os$zfiond.c) determines the types of network or
+# interprocess connections supported.  For example, the initial ND driver for
+# UNIX/IRAF systems supports Internet sockets, UNIX domain sockets, and FIFO
+# pipes.
+# 
+# If the same file descriptor is used for both reading and writing some means
+# is needed to synchronize data transfer.  When switching between reads and
+# writes, the client code should execute a F_CANCEL on the stream before the
+# first read or write of a sequence.  FLUSH should be called after the last
+# write.  For example,
+# 
+# 	call fseti (fd, F_CANCEL, OK)
+# 	call write (fd, buf, nchars)
+# 	    <optional additional writes>
+# 	call flush (fd)
+# 
+# 	call fseti (fd, F_CANCEL, OK)
+# 	nchars = read (fd, buf, maxch)
+# 	    <optional additional reads>
+#
+# A better approach however is to open two separate steams at the FIO level
+# and use one for reading a one for writing.  After the first stream is 
+# opened using NDOPEN, a second file descriptor can be opened using REOPEN.
+# Both will share the same underlying network connection, but one stream
+# can be used for reading and one for writing, with separate buffers for
+# each stream and full streaming i/o capabilities.
+#
+# Any of the i/o routines may be used, e.g., getc/putc may be used to perform
+# character i/o on the stream, with FIO doing the buffering.
+#
+# Once opened all ND connections are byte streams.  The protocol used for
+# client-server communications is determined entirely by the server; an IRAF
+# client may connect to a "foreign" server via an ND connection, so long
+# as the correct client-server protocol is observed.  If the server supports
+# multiple clients multiple ND connections may be made, either in the same
+# process or in different processes.  An IRAF task using the ND interface
+# may be a server, but currently the ND driver does not support multiple
+# concurrent client connections, since the connection and i/o block.
+# Multiple nonconcurrent (i.e. sequential) clients are possible.  Multiple
+# conncurent connections are possible only if a scheme is used such as having
+# inetd spawn a server process for each connection.
+
+int procedure ndopen (fname, mode)
+
+char	fname[ARB]		#I network address
+int	mode			#I access mode
+
+int	ip, fd
+char	port[SZ_PATHNAME]
+int	fopnbf(), strncmp(), ctoi(), fstati()
+extern	zopnnd(), zardnd(), zawrnd(), zawtnd(), zsttnd(), zclsnd()
+
+begin
+	# If a server connection is being opened (mode NEW_FILE) then
+	# check for the pseudo-domain "sock", which is defined by ZFIOND
+	# and used to accept a client connection request made to a server
+	# port.  The ND driver in the kernel requires a host channel number
+	# so we must convert the FIO file descriptor passed in by the client.
+
+	if (mode == NEW_FILE && strncmp(fname,"sock:",5) == 0) {
+	    ip = 6
+	    if (ctoi (fname, ip, fd) <= 0)
+		return (ERR)
+	    call sprintf (port, SZ_PATHNAME, "sock:%d")
+		call pargi (fstati (fd, F_CHANNEL))
+	} else
+	    call strcpy (fname, port, SZ_PATHNAME)
+
+	return (fopnbf (port, mode,
+	    zopnnd, zardnd, zawrnd, zawtnd, zsttnd, zclsnd))
+end
diff --git a/sys/fio/note.x b/sys/fio/note.x
new file mode 100644
index 00000000..d50ee01d
--- /dev/null
+++ b/sys/fio/note.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# NOTE -- Note offset in file for a subsequent SEEK.  If text file, the offset
+# of the current line is returned; it is only permissible to seek to the
+# beginning of a line on a text file.  If binary file, the offset returned is
+# the offset at which the next BUFFERED i/o transfer will occur.  If file is
+# being accessed unbuffered random, the concept of file position is meaningless.
+
+long procedure note (fd)
+
+int	fd
+errchk	filerr
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call filerr (FNAME(fp), SYS_FILENOTOPEN)
+
+	if (FTYPE(fp) == TEXT_FILE) {
+	    call zcall2 (ZNOTTX(fp), FCHAN(fp), boffset[fd])
+	    return (boffset[fd])
+	} else
+	    return (LNOTE(fd))
+end
diff --git a/sys/fio/nowhite.x b/sys/fio/nowhite.x
new file mode 100644
index 00000000..966ebc20
--- /dev/null
+++ b/sys/fio/nowhite.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# NOWHITE -- Return the input string minus any whitespace or newlines,
+# returning a count of the number of nonwhite characters as the function value.
+
+int procedure nowhite (in, out, maxch)
+
+char	in[ARB]			# input string
+char	out[ARB]		# output string
+int	maxch			# max chars out
+
+int	ch
+int	ip, op
+
+begin
+	op = 1
+	do ip = 1, ARB {
+	    ch = in[ip]
+	    if (ch <= ' ') {
+		if (ch == EOS)
+		    break
+		else if (IS_WHITE(ch) || ch == '\n')
+		    next
+	    }
+	    if (op > maxch)
+		break
+	    out[op] = ch
+	    op = op + 1
+	}
+
+	out[op] = EOS
+	return (op - 1)
+end
diff --git a/sys/fio/nullfile.x b/sys/fio/nullfile.x
new file mode 100644
index 00000000..363984d1
--- /dev/null
+++ b/sys/fio/nullfile.x
@@ -0,0 +1,251 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+.help nullfile
+.nf ___________________________________________________________________________
+NULLFILE -- Text and binary file drivers for the nullfile, "dev$null".
+These special drivers behave like regular text or binary drivers but
+have the special property that no i/o occurs, i.e., all output is discarded,
+making it appear as if the write was successful, and EOF is returned for
+all attempts to read from the file.
+.endhelp ______________________________________________________________________
+
+define	MAX_NULLFILES		(LAST_FD-FIRST_FD+1)
+define	SZ_DEFINBUF		1		# buffer size when reading
+define	SZ_DEFOUTBUF		2048		# buffer size when writing
+
+define	NU_INUSE		01B
+define	NU_READ			02B
+define	NU_WRITE		04B
+
+
+# ZOPNNU -- Open a nullfile.  Used for both binary and text nullfiles.
+
+procedure zopnnu (osfn, mode, chan)
+
+char	osfn[ARB]		# osfn version of dev$null, presumably
+int	mode			# not used
+int	chan			# assigned channel (output)
+
+bool	first_time
+int	nu
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+data	first_time /true/
+
+begin
+	# First time initialization.
+	if (first_time) {
+	    do nu = 1, MAX_NULLFILES
+		flags[nu] = 0
+	    first_time = false
+	}
+
+	# Find open slot.
+	for (nu=1;  nu <= MAX_NULLFILES;  nu=nu+1)
+	    if (flags[nu] == 0)
+		break
+	if (nu > MAX_NULLFILES) {
+	    chan = ERR
+	    return
+	}
+
+	switch (mode) {
+	case READ_ONLY:
+	    flags[nu] = NU_INUSE + NU_READ
+	case READ_WRITE:
+	    flags[nu] = NU_INUSE + NU_READ + NU_WRITE
+	default:
+	    flags[nu] = NU_INUSE + NU_WRITE
+	}
+
+	count[nu] = 0
+	chan = nu
+end
+
+
+# ZCLSNU -- Close a null file.  Used for both text and binary null files.
+
+procedure zclsnu (chan, status)
+
+int	chan
+int	status
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] == 0)
+	    status = ERR
+	else {
+	    flags[chan] = 0
+	    status = OK
+	}
+end
+
+
+# ZSTTNU -- Status of a null file.  Used for both text and binary null files.
+
+procedure zsttnu (chan, param, lvalue)
+
+int	chan
+int	param
+long	lvalue
+int	and()
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	switch (param) {
+	case FSTT_BLKSIZE:
+	    lvalue = 0
+	case FSTT_FILSIZE:
+	    lvalue = 0
+	case FSTT_OPTBUFSIZE, FSTT_MAXBUFSIZE:
+	    if (and (flags[chan], NU_WRITE) != 0)
+		lvalue = SZ_DEFOUTBUF
+	    else
+		lvalue = SZ_DEFINBUF
+	}
+end
+
+
+# ZARDNU, ZAWRNU, ZAWTNU -- Binary file i/o to the null file.
+
+procedure zardnu (chan, buf, maxbytes, loffset)
+
+int	chan, maxbytes
+char	buf[ARB]
+long	loffset
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	count[chan] = 0
+end
+
+
+procedure zawrnu (chan, buf, nbytes, loffset)
+
+int	chan, nbytes
+char	buf[ARB]
+long	loffset
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	count[chan] = nbytes
+end
+
+
+procedure zawtnu (chan, status)
+
+int	chan, status
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    status = count[chan]
+	else
+	    status = ERR
+end
+
+
+# ZGETNU, ZPUTNU, ZFLSNU, ZSEKNU, ZNOTNU -- Text file i/o to the null file.
+
+procedure zgetnu (chan, buf, maxch, status)
+
+int	chan, maxch, status
+char	buf[ARB]
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    status = 0
+	else
+	    status = ERR
+end
+
+
+procedure zputnu (chan, buf, nchars, status)
+
+int	chan, nchars, status
+char	buf[ARB]
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    status = nchars
+	else
+	    status = ERR
+end
+
+
+procedure zflsnu (chan, status)
+
+int	chan
+int	status
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    status = OK
+	else
+	    status = ERR
+end
+
+
+procedure zseknu (chan, loffset, status)
+
+int	chan, status
+long	loffset
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    status = OK
+	else
+	    status = ERR
+end
+
+
+procedure znotnu (chan, loffset)
+
+int	chan
+long	loffset
+
+int	flags[MAX_NULLFILES]
+int	count[MAX_NULLFILES]
+common	/znucom/ flags, count
+
+begin
+	if (flags[chan] != 0)
+	    loffset = 0
+	else
+	    loffset = ERR
+end
diff --git a/sys/fio/open.x b/sys/fio/open.x
new file mode 100644
index 00000000..cc540aa3
--- /dev/null
+++ b/sys/fio/open.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<knet.h>
+
+# OPEN -- Open a text or binary file on the default device.  If the filename
+# is "dev$null" the null file driver is used.  Writes to the null file are
+# discarded and reads return EOF.  No device is physically opened, hence
+# multiple processes may write to the null file at one time.
+
+int procedure open (fname, mode, type)
+
+char	fname[ARB]			# virtual file name
+int	mode				# access mode (ro,rw,apnd,newf,temp)
+int	type				# text or binary file
+
+int	fd
+pointer	sp, vfn
+char	url[SZ_PATHNAME], cache[SZ_PATHNAME], extn[SZ_PATHNAME]
+
+bool	nullfile, fnullfile()
+extern	zopnbf(), zopntx(), zardbf(), zgettx(), zopnsf(), zardsf()
+extern	zopnnu(), zardnu(), zgetnu()
+int	filopn(), fgetfd(), nowhite(), strncmp()
+
+errchk	syserr, fgetfd, filopn, seek
+
+begin
+	call smark (sp)
+	call salloc (vfn, SZ_PATHNAME, TY_CHAR)
+
+
+        # If we're given a URL to a file, cache it.
+	call aclrc (Memc[vfn], SZ_PATHNAME)
+	call strcpy ("cache$", cache, SZ_PATHNAME)
+	call strcpy ("", extn, SZ_PATHNAME)
+
+        if (strncmp ("http:", fname, 5) == 0) {
+	    call strcpy (fname, url, SZ_PATHNAME)
+	    if (mode == NEW_FILE)
+		call syserr (SYS_FNOWRITEPERM)
+            call fcadd (cache, url, extn, Memc[vfn], SZ_PATHNAME)
+
+        } else if (strncmp ("file:///localhost", fname, 17) == 0) {
+	    # Handle local 'file' URIs
+	    if (nowhite (fname[18], Memc[vfn], SZ_PATHNAME) == 0)
+	        call syserr (SYS_FNOFNAME)
+
+        } else if (strncmp ("file://localhost", fname, 16) == 0) {
+	    # Handle local 'file' URIs
+	    if (nowhite (fname[16], Memc[vfn], SZ_PATHNAME) == 0)
+	        call syserr (SYS_FNOFNAME)
+
+        } else if (strncmp ("file://", fname, 7) == 0) {
+	    # Handle local 'file' URIs
+	    if (nowhite (fname[7], Memc[vfn], SZ_PATHNAME) == 0)
+	        call syserr (SYS_FNOFNAME)
+
+        } else {
+	    # Strip any whitespace at either end of the filename.
+	    if (nowhite (fname, Memc[vfn], SZ_PATHNAME) == 0)
+	        call syserr (SYS_FNOFNAME)
+	}
+
+	# Check for the null file.
+	nullfile = fnullfile (Memc[vfn])
+
+	# Open the file.
+	switch (type) {	
+	case TEXT_FILE:
+	    if (nullfile)
+		fd = filopn (Memc[vfn], mode, type, zopnnu, zgetnu)
+	    else
+		fd = filopn (Memc[vfn], mode, type, zopntx, zgettx)
+	case BINARY_FILE:
+	    if (nullfile)
+		fd = filopn (Memc[vfn], mode, type, zopnnu, zardnu)
+	    else
+		fd = filopn (Memc[vfn], mode, type, zopnbf, zardbf)
+	case STATIC_FILE:
+	    if (nullfile)
+		fd = filopn (Memc[vfn], mode, type, zopnnu, zardnu)
+	    else
+		fd = filopn (Memc[vfn], mode, type, zopnsf, zardsf)
+	case SPOOL_FILE:
+	    if (nullfile)
+		fd = filopn (Memc[vfn], mode, type, zopnnu, zardnu)
+	    else {
+		fd = fgetfd (Memc[vfn], mode, type)
+		call seek (fd, BOFL)
+	    }
+	default:
+	    call syserrs (SYS_FILLEGTYPE, Memc[vfn])
+	    fd = ERR
+	}
+
+	call sfree (sp)
+	return (fd)
+end
diff --git a/sys/fio/osfnlock.x b/sys/fio/osfnlock.x
new file mode 100644
index 00000000..213d75ac
--- /dev/null
+++ b/sys/fio/osfnlock.x
@@ -0,0 +1,417 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<syserr.h>
+include	<config.h>
+include	<finfo.h>
+include	<ctype.h>
+
+# Override the definition of ONECASE_OUT given in <config.h>.  This is necessary
+# for networking until time permits a real fix to the filename mapping code.
+# The override is necessary to prevent OSFN_PKFNAME from case-converting
+# filenames destined for translation on a remote node.
+
+define	ONECASE_OUT	false
+
+.help file_locking
+.nf ___________________________________________________________________________
+FILE LOCKING package.  Lock the named OSFN for exclusive write access.
+The host OS file locking facilities are used if available, otherwise null
+length files are used to implement advisory locks.  Read access may or may
+not be excluded while a file is locked, depending on the host system.
+
+	time =	    osfn_lock (osfn)
+	nsec =	  osfn_unlock (osfn, time)
+	nsec =	osfn_timeleft (osfn, time)
+		osfn_initlock (osfn)
+		  osfn_rmlock (osfn)
+
+A file is locked with the OSFN_LOCK primitive, which will wait or another
+process to unlock the file if it is already locked.  The lock is guaranteed
+to remain in place for at least FILELOCK_PERIOD seconds.  If the file does not
+exist or cannot be locked ERROR is called.  If the file is already locked but
+the lock has expired osfn_lock will break the old lock and return when it has
+set a new one.
+
+A lock is removed with OSFN_UNLOCK.  The number of seconds remaining on the
+lock at the time it was removed is returned as the function value; this value
+should be checked to ensure that the lock was not broken due to a timeout.
+ERR is returned if the file was no longer locked or had been locked by another
+user when OSFN_UNLOCK was called.  OSFN_RMLOCK is used to delete all lock
+files (if any) when the main file is deleted.
+
+The primitive OSFN_TIMELEFT returns the number of seconds remaining on the
+lock on file osfn.  ERR is returned if the file is no longer locked or if the
+file is currently locked by another user.  OSFN_INITLOCK is called to create
+the locking files initially, to avoid having to wait for a timeout when
+placing the first lock.
+.endhelp ____________________________________________________________________
+
+define	FILEWAIT_PERIOD	5		# wait 5 seconds for file to unlock
+define	MAX_DELAY	90		# recover from missing timelock1
+define	setlock_	91
+
+
+# OSFN_LOCK -- Lock the named OSFN, i.e., gain exclusive write access to a file.
+# Only the process gaining the lock on a file may write to it, but there is no
+# guarantee that another process may not read a locked file.  On some systems
+# the file will not actually be locked until it is opened with write permission.
+# If multiple files exist in a directory with the same root but different
+# extensions, only one can be locked at a time.  An ERROR exit is taken if the
+# file is write protected.
+
+long procedure osfn_lock (osfn)
+
+char	osfn[ARB]		# OS pathname of file to be locked
+bool	os_has_file_locking
+int	nsec, delay, status
+long	fi[LEN_FINFO]
+pointer	sp, lockfile, timelock1, timelock2, fname
+long	clktime()
+data	os_has_file_locking /OS_FILELOCKING/
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Even if file locking is provided by the OS we must determine if the
+	# file does not exist or is write protected.  If the file is not write
+	# protected but cannot be opened for writing our caller will conclude
+	# that the file is locked by another process.
+
+	call zfacss (osfn, READ_WRITE, 0, status)
+	if (status == ERR) {
+	    call strupk (osfn, Memc[fname], SZ_FNAME)
+	    call syserrs (SYS_FNOWRITEPERM, Memc[fname])
+	} else if (os_has_file_locking) {
+	    call sfree (sp)
+	    return (clktime (long(0)))
+	}
+
+	call salloc (lockfile,  SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock1, SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock2, SZ_PATHNAME, TY_CHAR)
+
+	# Host system does not provide file locking; we must do it ourselves
+	# using null files as semaphores.  The lock files need not exist
+	# when we are first called; they will be automatically generated
+	# when timeout occurs.
+
+	# Generate osfn's of the lockfile and timelock files.
+	call osfn_mkfnames (osfn, Memc[lockfile], Memc[timelock1],
+	    Memc[timelock2], SZ_PATHNAME)
+
+	# The lock is set by deleteing the lockfile.  Usually the file will
+	# be deleted on the first try, but if someone else has the file
+	# locked or if the lockfile is missing, we have to keep trying.
+	# If the lockfile cannot be deleted check that the file itself
+	# exists with write permission.  We ASSUME that if we have write
+	# permission on the file we are trying to lock, we also have
+	# delete permission on the directory in which it is resident.
+
+	delay = 0
+	repeat {
+	    # Try to set lock.
+	    for (nsec=0;  nsec < FILEWAIT_PERIOD;  nsec=nsec+1) {
+		call zfdele (Memc[lockfile], status)
+		if (status == OK)
+		    goto setlock_
+	    }
+	    delay = delay + nsec
+
+	    # Timeout: if the lock is old, break it and try again to set
+	    # new lock.  No need to check status because if we get here we
+	    # know osfn exists and we have write+delete perm on directory.
+	    # N.B.: this block is subtle; see fio$doc/vfn.hlp for a detailed
+	    # discussion of timeout and recovery from lockout.
+
+	    call zfdele (Memc[timelock1], status)
+	    if (status == OK) {
+		call zfinfo (Memc[timelock2], fi, status)
+		if (status == ERR || clktime(FI_CTIME(fi)) >= FILELOCK_PERIOD) {
+		    call zfmkcp (osfn, Memc[lockfile], status)
+		    call zfdele (Memc[timelock2], status)
+		    call zfmkcp (osfn, Memc[timelock2], status)
+		    call zfmkcp (osfn, Memc[timelock1], status)
+		} else
+		    call zfmkcp (osfn, Memc[timelock1], status)
+	    } else if (delay >= MAX_DELAY)
+		call zfmkcp (osfn, Memc[timelock1], status)
+	}
+
+setlock_
+	call zfdele (Memc[timelock2], status)
+	call zfmkcp (osfn, Memc[timelock2], status)
+	call zfinfo (Memc[timelock2], fi, status)
+
+	call sfree (sp)
+	return (FI_CTIME(fi))
+end
+
+
+# OSFN_TIMELEFT -- Determine if a file is still locked, and if so, how
+# much time remains on the lock.  TIME is the time value returned when
+# the file was locked.  All time values are in units of seconds.
+
+int procedure osfn_timeleft (osfn, time)
+
+char	osfn[ARB]		# OS pathname of file to be locked
+long	time			# time when lock set
+
+bool	os_has_file_locking
+int	time_left, status, file_exists
+long	fi[LEN_FINFO]
+pointer	sp, lockfile, timelock1, timelock2
+long	clktime()
+data	os_has_file_locking /OS_FILELOCKING/
+
+begin
+	if (os_has_file_locking)
+	    return (FILELOCK_PERIOD)
+
+	call smark (sp)
+	call salloc (lockfile,  SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock1, SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock2, SZ_PATHNAME, TY_CHAR)
+
+	call osfn_mkfnames (osfn, Memc[lockfile], Memc[timelock1],
+	    Memc[timelock2], SZ_PATHNAME)
+
+	# If the lockfile exists the file is no longer locked.
+	call zfacss (Memc[lockfile], 0, 0, file_exists)
+	if (file_exists == YES) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	call zfinfo (Memc[timelock2], fi, status)
+	call sfree (sp)
+
+	if (status == ERR)
+	    return (ERR)
+	else if (FI_CTIME(fi) != time)
+	    return (ERR)
+	else {
+	    time_left = max (0, FILELOCK_PERIOD - clktime (time))
+	    return (time_left)
+	}
+end
+
+
+# OSFN_UNLOCK -- Release the lock on a file and return the number of seconds
+# that were left on the lock.  ERR is returned if the file is no longer locked
+# or if the lock is not the one originally placed on the file.
+
+int procedure osfn_unlock (osfn, time)
+
+char	osfn[ARB]		# OS pathname of file to be locked
+long	time			# time when lock set
+
+bool	os_has_file_locking
+int	time_left, status
+pointer	sp, lockfile, timelock1, timelock2
+int	osfn_timeleft()
+data	os_has_file_locking /OS_FILELOCKING/
+
+begin
+	if (os_has_file_locking)
+	    return (FILELOCK_PERIOD)
+
+	call smark (sp)
+	call salloc (lockfile,  SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock1, SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock2, SZ_PATHNAME, TY_CHAR)
+
+	call osfn_mkfnames (osfn, Memc[lockfile], Memc[timelock1],
+	    Memc[timelock2], SZ_PATHNAME)
+
+	time_left = osfn_timeleft (osfn, time)
+
+	if (time_left != ERR)
+	    call zfmkcp (osfn, Memc[lockfile], status)
+
+	call sfree (sp)
+	return (time_left)
+end
+
+
+# OSFN_RMLOCK -- Remove the locks (delete all lock files) on a file.  Called
+# to remove auxiliary lock files when the main file is deleted.
+
+procedure osfn_rmlock (osfn)
+
+char	osfn[ARB]		# OS pathname of main file
+bool	os_has_file_locking
+int	junk
+pointer	sp, lockfile, timelock1, timelock2
+data	os_has_file_locking /OS_FILELOCKING/
+
+begin
+	if (os_has_file_locking)
+	    return
+
+	call smark (sp)
+	call salloc (lockfile,  SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock1, SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock2, SZ_PATHNAME, TY_CHAR)
+
+	call osfn_mkfnames (osfn, Memc[lockfile], Memc[timelock1],
+	    Memc[timelock2], SZ_PATHNAME)
+
+	call zfdele (Memc[lockfile],  junk)
+	call zfdele (Memc[timelock1], junk)
+	call zfdele (Memc[timelock2], junk)
+
+	call sfree (sp)
+end
+
+
+# OSFN_INITLOCK -- Create the locking files for the named file.  Should
+# only be called once, generally when the file itself is created.  If we
+# are not called OSFN_LOCK will create the files anyhow, but only after
+# timing out, which takes a while.
+
+procedure osfn_initlock (osfn)
+
+char	osfn[ARB]		# OS pathname of file to be locked
+bool	os_has_file_locking
+int	status
+pointer	sp, lockfile, timelock1, timelock2
+data	os_has_file_locking /OS_FILELOCKING/
+
+begin
+	if (os_has_file_locking)
+	    return
+
+	call smark (sp)
+	call salloc (lockfile,  SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock1, SZ_PATHNAME, TY_CHAR)
+	call salloc (timelock2, SZ_PATHNAME, TY_CHAR)
+
+	call osfn_mkfnames (osfn, Memc[lockfile], Memc[timelock1],
+	    Memc[timelock2], SZ_PATHNAME)
+
+	call zfmkcp (osfn, Memc[lockfile],  status)
+	call zfmkcp (osfn, Memc[timelock1], status)
+	call zfmkcp (osfn, Memc[timelock2], status)
+
+	if (status == ERR)
+	    call syserrs (SYS_FINITLOCK, osfn)
+
+	call sfree (sp)
+end
+
+
+# OSFN_MKFNAMES -- Given the OSFN of the file to be locked, generate and
+# return the names of the lockfile and the two timelock files.
+
+procedure osfn_mkfnames (osfn, lockfile, timelock1, timelock2, maxch)
+
+char	osfn[ARB]		# OS filename of file to be locked
+char	lockfile[maxch]		# OSFN of locking file
+char	timelock1[maxch]	# OSFN of the first timelock file
+char	timelock2[maxch]	# OSFN of the second timelock file
+int	maxch
+
+char	ch
+int	op, last_dot, max_chars
+pointer	sp, ip, fname
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call strupk (osfn, Memc[fname], SZ_PATHNAME)
+	ip = fname
+	op = 1
+	last_dot = 0
+
+	for (ch=Memc[ip];  ch != EOS;  ch=Memc[ip]) {
+	    lockfile[op] = ch
+	    timelock1[op] = ch
+	    timelock2[op] = ch
+	    if (ch == '.')
+		last_dot = op
+	    ip = ip + 1
+	    op = op + 1
+	}
+
+	if (last_dot > 0)
+	    op = last_dot
+	max_chars = maxch - op + 1
+	    
+	call strcpy (LOCKFILE_EXTN,  lockfile[op],  max_chars)
+	call osfn_pkfname (lockfile, lockfile, maxch)
+	call strcpy (TIMELOCK1_EXTN, timelock1[op], max_chars)
+	call osfn_pkfname (timelock1, timelock1, maxch)
+	call strcpy (TIMELOCK2_EXTN, timelock2[op], max_chars)
+	call osfn_pkfname (timelock2, timelock2, maxch)
+
+	call sfree (sp)
+end
+
+
+# OSFN_PKFNAME -- Convert an unpacked lower case OS filename into a true host
+# OS filename.  Convert to the host case if necessary and pack the string.
+# Strip any backslash escapes remaining in the filename.
+
+procedure osfn_pkfname (spp_osfn, host_osfn, maxch)
+
+char	spp_osfn[ARB]			# unpacked, mixed or lower case OSFN
+char	host_osfn[maxch]		# packed OSFN
+int	maxch
+
+int	op, i
+int	ch
+
+begin
+	if (CASE_INSENSITIVE && ONECASE_OUT) {
+	    switch (HOST_CASE) {
+	    case 'U', 'u':
+		op = 1
+		do i = 1, maxch {
+		    ch = spp_osfn[i]
+		    if (ch == EOS)
+			break
+		    else if (IS_LOWER (ch))
+			host_osfn[op] = TO_UPPER (ch)
+		    else if (ch == '\\')
+			op = op - 1
+		    else
+			host_osfn[op] = ch
+		    op = op + 1
+		}
+	    default:
+		op = 1
+		do i = 1, maxch {
+		    ch = spp_osfn[i]
+		    if (ch == EOS)
+			break
+		    else if (IS_UPPER (ch))
+			host_osfn[op] = TO_LOWER (ch)
+		    else if (ch == '\\')
+			op = op - 1
+		    else
+			host_osfn[op] = ch
+		    op = op + 1
+		}
+	    }
+
+	} else {
+	    op = 1
+	    do i = 1, maxch {
+		ch = spp_osfn[i]
+		if (ch == EOS)
+		    break
+		else if (ch == '\\')
+		    op = op - 1
+		else
+		    host_osfn[op] = ch
+		op = op + 1
+	    }
+	}
+
+	host_osfn[op] = EOS
+	call strpak (host_osfn, host_osfn, maxch)
+end
diff --git a/sys/fio/poll.x b/sys/fio/poll.x
new file mode 100644
index 00000000..22e2bd14
--- /dev/null
+++ b/sys/fio/poll.x
@@ -0,0 +1,250 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fio.h>
+include	<fset.h>
+include <config.h>
+include	<syserr.h>
+include	<poll.h>
+
+
+.help poll
+.nf ___________________________________________________________________________
+POLL -- FIO descriptor polling interface.  See <poll.h> for a definition of
+the interface data structures and flags, this file is required to be included
+by source files using this interface.
+
+       fds = poll_open ()		    # open a poll descriptor set
+	 npolls = poll (fds, nfds, timeout) # poll the set
+            poll_close (fds)		    # free the poll descriptor set
+
+             poll_zero (fds)		    # zero the poll array
+              poll_set (fds, fd, type)	    # set fd to poll for type
+            poll_clear (fds, fd, type)	    # unset type on fd poll
+       y/n = poll_test (fds, fd, type)	    # test fd for type event
+     N = poll_get_nfds (fds)		    # get size of descriptor set
+
+The polling interface provides the same functionality as the unix function
+of the same name with a few implementation differences.  The poll_open()
+procedure is used to allocate a dynamic structure containing the descriptors
+to be polled, poll_close() is used when done to free that structure.
+	The poll_zero(), poll_set(), and poll_clear() utility functions are 
+used to manipulate the descriptor set by zeroing the entire set, or adding or
+removing a descriptor check for the specified polling type.  Polling types
+include POLLIN (fd is readable), POLLOUT (fd is writeable & won't block), or
+POLLPRI (priority info at fd).  The poll_test() function can be used to test
+for these types folling the return of poll().  Additionally, a descriptor may
+be checked for POLLERR (fd has error condition), POLLHUP (fd has been hung up
+on), POLLNVAL (invalid pollfd entry).  Descriptors may be checked for more
+than one testable event.
+	Once the descriptor set has been created, the poll() function can be
+called to check for activity on the set.  A negative timeout value will cause
+the function to block indefinitely, otherwise it represents a wait time given
+in milliseconds.  The poll() function will return a negative number if an
+error is encountered, zero if the call times out and no file descriptors have
+been selected, or a positive number indicating the number of descriptors
+which can be serviced without blocking.
+.endhelp ______________________________________________________________________
+
+
+# POLL_OPEN -- Open a poll descriptor set.
+
+pointer procedure poll_open ()
+
+pointer	fds
+
+begin
+	iferr (call calloc (fds, LEN_FPOLL, TY_STRUCT))
+	    call syserr (SYS_MFULL)
+
+	return (fds)
+end
+
+
+# POLL -- Poll the descriptor set.
+
+int procedure poll (fds, nfds, timeout)
+
+pointer	fds
+int	nfds
+int	timeout
+
+int	pfds[LEN_FPOLL]
+int	i, j, npoll, status
+
+include	<fio.com>
+
+begin
+	# Transform the descriptor set to a linear array.
+	j = 0 
+	for (i=1; j < nfds; i=i+3) {
+	     pfds[i  ] = FCHAN(fiodes[POLL_FD(fds,j)])
+	     pfds[i+1] = POLL_EVENTS(fds,j)
+	     pfds[i+2] = POLL_REVENTS(fds,j)
+	     j = j + 1
+	}
+
+	# Call the kernel routine to poll on the descriptor set.
+	call zfpoll (pfds, nfds, timeout, npoll, status)
+	if (status == ERR)
+	    return (ERR)
+
+	j = 0 
+	for (i=3; j < nfds; i=i+3) {
+	     POLL_REVENTS(fds,j) = pfds[i]
+	     j = j + 1
+	}
+
+	return (npoll)
+end
+
+
+# POLL_CLOSE -- Close and free a poll descriptor set.
+
+procedure poll_close (fds)
+
+pointer	fds					#i descriptor set pointer
+
+begin
+	call mfree (fds, TY_STRUCT)
+end
+
+
+# POLL_ZERO -- Zero the descriptor set.
+
+procedure poll_zero (fds)
+
+pointer	fds					#i descriptor set pointer
+
+begin
+	call aclri (Memi[fds], LEN_FPOLL)
+end
+
+
+# POLL_SET -- Add a descriptor to the set, and/or modify the event type.
+# The type may be a bitwise or of testable events.
+
+procedure poll_set (fds, fd, type)
+
+pointer	fds					#i descriptor set pointer
+int	fd					#i file descriptor
+int	type					#i event type
+
+int	i, top
+int	ori()
+
+begin
+	top = POLL_NFD(fds)
+	if (top > MAX_POLL_FD)
+	    call eprintf ("File descriptor set overflow.\n")
+
+	for (i=0; i < top; i=i+1) {
+	    # Search for requested descriptor and OR the type on the event mask.
+	    if (fd == POLL_FD(fds,i)) {
+		POLL_EVENTS(fds,i) = ori (POLL_EVENTS(fds,i), type)
+		return
+	    }
+	}
+
+	# Descriptor not found, add it to the set at the top
+	POLL_FD(fds,top) = fd
+	POLL_EVENTS(fds,top) = ori (POLL_EVENTS(fds,top), type)
+	POLL_NFD(fds) = top + 1
+end
+
+
+# POLL_GET_NFDS -- Get the number of descriptors in the set.
+
+int procedure poll_get_nfds (fds)
+
+pointer	fds					#i descriptor set pointer
+
+begin
+	return (POLL_NFD(fds))
+end
+
+
+# POLL_CLEAR -- Remove a descriptor or event type from the set.  The type
+# may be a bitwise or of testable events.   If the event mask becomes NULL
+# the descriptor is removed entirely from the set.
+
+procedure poll_clear (fds, fd, type)
+
+pointer	fds					#i descriptor set pointer
+int	fd					#i file descriptor
+int	type					#i event type
+
+int	i, j, top
+int	noti(), andi()
+
+begin
+	top = POLL_NFD(fds)
+
+	for (i=0; i < top; i=i+1) {
+	    # Search for requested descriptor.
+	    if (fd == POLL_FD(fds,i)) {
+		POLL_EVENTS(fds,i) = andi (noti(type), POLL_EVENTS(fds,i))
+		
+		# If there are no events, remove the descriptor from the set
+		# by deleting it from the array and shifting the remainder.
+		if (POLL_EVENTS(fds,i) == 0) {
+		    for (j=i+1; i < top; j=j+1) {
+		        POLL_FD(fds,i) = POLL_FD(fds,j)
+		        POLL_EVENTS(fds,i) = POLL_EVENTS(fds,j)
+		        i = i + 1
+		    }
+		    POLL_NFD(fds) = top - 1
+		    break
+		}
+	    }
+	}
+end
+
+
+# POLL_TEST -- Test the descriptor for the given event type.
+
+int procedure poll_test (fds, fd, type)
+
+pointer	fds					#i descriptor set pointer
+int	fd					#i file descriptor
+int	type					#i event type
+
+int	i, top
+int	andi()
+
+begin
+	top = POLL_NFD(fds)
+
+	for (i=0; i < top; i=i+1) {
+	    # Search for requested descriptor.
+	    if (fd == POLL_FD(fds,i)) {
+		# OR the type on the event mask.
+		if (andi (POLL_REVENTS(fds,i), type) > 0)
+		    return (YES)
+		else
+		    return (NO)
+	    }
+	}
+
+	return (NO)
+end
+
+
+# POLL_PRINT -- Print the descriptor set (debug utility).
+
+procedure poll_print (fds)
+
+pointer	fds					#i descriptor set pointer
+
+int	i, top
+
+begin
+	top = POLL_NFD(fds)
+
+	for (i=0; i < top; i=i+1) {
+	    call eprintf ("%2d:  fd=%3d  events=%6d  revents=%6d\n")
+		call pargi(i)
+		call pargi(POLL_FD(fds,i))
+		call pargi(POLL_EVENTS(fds,i))
+		call pargi(POLL_REVENTS(fds,i))
+	}
+end
diff --git a/sys/fio/protect.x b/sys/fio/protect.x
new file mode 100644
index 00000000..64434638
--- /dev/null
+++ b/sys/fio/protect.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<protect.h>
+include	<config.h>
+include	<syserr.h>
+include	<knet.h>
+include	<fio.h>
+
+# PROTECT -- Protect a file from deletion.  The recognized action codes are
+# defined in <protect.h> and are used to set, remove, or query file
+# protection.
+
+int procedure protect (fname, action)
+
+char	fname[ARB]		# file name
+int	action			# protect action (prot, unprot, query)
+
+bool	fnullfile()
+int	status, access()
+errchk	filerr, fmapfn
+include	<fio.com>
+
+begin
+	# The null file "dev$null" is a special case; ignore attempts to
+	# alter the protection of this file.
+
+	if (fnullfile (fname))
+	    if (action == QUERY_PROTECTION)
+		return (YES)
+	    else
+		return (OK)
+
+	call fmapfn (fname, pathname, SZ_PATHNAME)
+	call zfprot (pathname, action, status)
+
+	if (status == ERR) {
+	    if (access (fname,0,0) == YES) {
+		switch (action) {
+		case SET_PROTECTION:
+		    call filerr (fname, SYS_FPROTECT)
+		case REMOVE_PROTECTION:
+		    call filerr (fname, SYS_FUNPROTECT)
+		default:
+		    # If the file exists but we cannot query its protection,
+		    # better to indicate that it is protected than to abort.
+		    return (YES)
+		}
+	    } else if (access (fname, 0, DIRECTORY_FILE) == YES) {
+		switch (action) {
+		case SET_PROTECTION:
+		    return (OK)			# directory files are protected
+		case REMOVE_PROTECTION:
+		    call filerr (fname, SYS_FUNPROTECT)
+		default:
+		    return (YES)
+		}
+	    } else
+		call filerr (fname, SYS_FPROTNEXFIL)
+	} else
+	    return (status)
+end
diff --git a/sys/fio/putc.x b/sys/fio/putc.x
new file mode 100644
index 00000000..3021347d
--- /dev/null
+++ b/sys/fio/putc.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# PUTC -- Put a character to a file.
+
+procedure putc (fd, ch)
+
+int	fd			# output file
+char	ch			# character to be output
+
+int	and()
+errchk	flsbuf
+include	<fio.com>
+
+begin
+	if (iop[fd] < bufptr[fd] || iop[fd] >= otop[fd])
+	    call flsbuf (fd, 0)
+
+	Memc[iop[fd]] = ch
+	iop[fd] = iop[fd] + 1
+
+	if (ch == '\n')				# end of line of text?
+	    if (and (FF_FLUSH, fflags[fd]) != 0)
+		call flsbuf (fd, 0)
+end
+
+
+# PUTCHAR -- Put a character to the standard output.
+
+procedure putchar (ch)
+
+char	ch			# character to be output
+
+begin
+	call putc (STDOUT, ch)
+end
diff --git a/sys/fio/putcc.x b/sys/fio/putcc.x
new file mode 100644
index 00000000..ac96f50e
--- /dev/null
+++ b/sys/fio/putcc.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+define	SZ_CCSTR		5
+
+# PUTCC -- Put a character to a file.  This procedure is identical to PUTC,
+# except that nonprintable characters are rendered as escape sequences.
+
+procedure putcc (fd, ch)
+
+int	fd
+char	ch
+char	ccstr[SZ_CCSTR]
+int	ip, n, ctocc()
+
+begin
+	if (IS_PRINT (ch))
+	    call putc (fd, ch)
+	else {
+	    n = ctocc (ch, ccstr, SZ_CCSTR)
+	    do ip = 1, n
+		call putc (fd, ccstr[ip])
+	}
+end
diff --git a/sys/fio/putci.x b/sys/fio/putci.x
new file mode 100644
index 00000000..eeedb30e
--- /dev/null
+++ b/sys/fio/putci.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+
+# PUTCI -- Put a character constant (passed as an integer) to a file.
+
+procedure putci (fd, ch)
+
+int	fd			# output file
+int	ch			# character to be output
+int	and()
+errchk	flsbuf
+include	<fio.com>
+
+begin
+	if (iop[fd] < bufptr[fd] || iop[fd] >= otop[fd])
+	    call flsbuf (fd, 0)
+
+	Memc[iop[fd]] = ch
+	iop[fd] = iop[fd] + 1
+
+	if (ch == '\n')				# end of line of text?
+	    if (and (FF_FLUSH, fflags[fd]) != 0)
+		call flsbuf (fd, 0)
+end
diff --git a/sys/fio/putline.x b/sys/fio/putline.x
new file mode 100644
index 00000000..bc69da66
--- /dev/null
+++ b/sys/fio/putline.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<mach.h>
+include	<fio.h>
+
+# PUTLINE -- Put a line or part of a line of text to a file.  May be called
+# several times to build up a line of text.  FLUSHNL should always be set
+# for text files (when the file is opened) to avoid flushing partial lines
+# to text files.  This is a major output procedure hence the code has been
+# carefully optimized to do as much as possible in loops.
+
+procedure putline (fd, linebuf)
+
+int	fd				# output file
+char	linebuf[ARB]			# line to be output
+
+int	ch, ip, ip_top, i
+pointer	op, op_top
+int	and()
+errchk	syserr, flsbuf
+include	<fio.com>
+define	done_ 91
+
+begin
+	if (fd <= 0 || fiodes[fd] == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	# Copy the i/o pointers into local storage for more efficient access.
+	op = iop[fd]
+	op_top = otop[fd]
+
+	# Check for a file fault.
+	if (op < bufptr[fd] || op > op_top) {
+	    call flsbuf (fd, 0)
+	    op = iop[fd]
+	    op_top = otop[fd]
+	}
+
+	# Copy all characters until EOS is seen.  Flush the buffer if it fills
+	# or if newline is seen and FF_FLUSH is set for the stream.
+
+	if (and (fflags[fd], FF_FLUSH) == 0) {
+	    # Flush on newline is disabled.  A special loop is used for this
+	    # case to eliminate the need to compare every character against
+	    # newline.
+
+	    for (ip=1;  linebuf[ip] != EOS;  ip=ip_top+1) {
+		# A do loop is used here to trigger Fortran optimization.  Note
+		# that FLSBUF must not be called from within the loop or loop
+		# optimization will be turned off by most compilers.
+
+		ip_top = ip + (op_top-op) - 1
+		do i = ip, ip_top {
+		    Memc[op] = linebuf[i]
+		    op = op + 1
+		    if (linebuf[i+1] == EOS)
+			goto done_
+		}
+
+		# If we reach here then the buffer is full and needs to be
+		# flushed.
+
+		iop[fd] = op
+		call flsbuf (fd, 0)
+		op = iop[fd]
+		op_top = otop[fd]
+	    }
+
+	} else {
+	    # This section of code is used when it is necessary to check for
+	    # newline and flush after every line of text.
+
+	    for (ip=1;  linebuf[ip] != EOS;  ip=ip_top+1) {
+		ip_top = ip + (op_top-op) - 1
+		do i = ip, ip_top {
+		    ch = linebuf[i]
+		    Memc[op] = ch
+		    op = op + 1
+		    if (ch == '\n') {
+			ip_top = i
+			break
+		    }
+		    if (linebuf[i+1] == EOS)
+			goto done_
+		}
+
+		# If we get here then either newline has been seen or the output
+		# buffer is full.  In either case the buffer must be flushed.
+
+		iop[fd] = op
+		call flsbuf (fd, 0)
+		op = iop[fd]
+		op_top = otop[fd]
+	    }
+	}
+done_
+	iop[fd] = op
+	FNCHARS(fiodes[fd]) = ip - 1
+end
diff --git a/sys/fio/read.x b/sys/fio/read.x
new file mode 100644
index 00000000..69e71ba7
--- /dev/null
+++ b/sys/fio/read.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# READ -- Read binary chars from a file.  Data is read in "chunks" from
+# the file buffer into the output buffer supplied by the calling procedure,
+# refilling the file buffer as necessary.  The read terminates, possibly
+# returning fewer than the maximum number of chars, if the file buffer
+# cannot be filled (as occurs at the EOF of a binary file, or when reading
+# from a terminal or pipe).
+
+int procedure read (fd, buffer, maxchars)
+
+int	fd
+char	buffer[ARB]
+int	maxchars
+
+int	maxch
+bool	stream
+int	nchars, chunk_size, nchars_read, filbuf()
+errchk	filbuf, filerr
+include	<fio.com>
+
+begin
+	if (fd <= 0 || fiodes[fd] == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	nchars = 0
+	maxch = maxchars
+	stream = (FBLKSIZE(fiodes[fd]) == 0)
+
+	while (nchars < maxch) {
+	    if (iop[fd] < bufptr[fd] || iop[fd] >= itop[fd]) {
+		nchars_read = filbuf (fd)
+		if (nchars_read == EOF)
+		    break		# return EOF only if nchars = 0
+		else {
+		    # Don't loop if record structured device or EOF.
+		    if (itop[fd] < buftop[fd] || stream)
+			maxch = min (maxchars, nchars + nchars_read)
+		}
+	    }
+	    chunk_size = min (maxch - nchars, itop[fd] - iop[fd])
+	    if (chunk_size <= 0)
+		break
+	    else {
+		call amovc (Memc[iop[fd]], buffer[nchars+1], chunk_size)
+		iop[fd] = iop[fd] + chunk_size
+		nchars = nchars + chunk_size
+	    }
+	}
+
+	FILSTAT(fiodes[fd]) = nchars
+	FNCHARS(fiodes[fd]) = nchars
+
+	if (nchars == 0)
+	    return (EOF)
+	else
+	    return (nchars)
+end
diff --git a/sys/fio/rename.x b/sys/fio/rename.x
new file mode 100644
index 00000000..c52c28bf
--- /dev/null
+++ b/sys/fio/rename.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<fio.h>
+
+# RENAME -- Rename a file.  First try to rename the file using the ZFRNAM
+# kernel primitive, accessed by FRENAME.  If that fails try to copy the
+# file and delete the original.
+
+procedure rename (oldname, newname)
+
+char	oldname[ARB]			# old filename
+char	newname[ARB]			# new filename
+
+int	junk, protect()
+errchk	fcopy, protect
+
+begin
+	# Try a simple file rename first.
+	ifnoerr (call frename (oldname, newname))
+	    return
+
+	# That failed, so copy the file to the new name.
+	call fcopy (oldname, newname)
+
+	# Now delete the original.  Transfer file protection to the new file,
+	# if the old file was protected.
+
+	if (protect (oldname, QUERY_PROTECTION) == YES) {
+	    iferr (junk = protect (oldname, REMOVE_PROTECTION)) {
+		call delete (newname)
+		call erract (EA_ERROR)
+	    }
+	    call delete (oldname)
+	    junk = protect (newname, SET_PROTECTION)
+	} else
+	    call delete (oldname)
+end
diff --git a/sys/fio/reopen.x b/sys/fio/reopen.x
new file mode 100644
index 00000000..59ddba30
--- /dev/null
+++ b/sys/fio/reopen.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# REOPEN -- Reopen a binary file.  Used to gain two or more independent
+# sets of buffers to access a binary file.  No protection against two
+# file descriptors trying to write to the same part of the file at the
+# same time, which may result in loss of data.  The file descriptors and
+# buffers of reopened files are independent, but all files accessing the
+# same channel share the same channel descriptor (necessary to synchronize
+# i/o requests and to maintain a unique file size parameter).
+
+int procedure reopen (fd, mode)
+
+int	fd, mode
+pointer	newfp, ffp
+int	newfd, fgetfd()
+errchk	syserr, malloc, seek
+include	<fio.com>
+
+begin
+	ffp = fiodes[fd]
+	if (fd <= 0 || ffp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	if (FMODE(ffp) == READ_ONLY && mode != READ_ONLY)
+	    call filerr (FNAME(ffp), SYS_FREOPNMODE)
+	if (FTYPE(ffp) != BINARY_FILE)
+	    call filerr (FNAME(ffp), SYS_FREOPNTYPE)
+
+	newfd = fgetfd (FNAME(ffp), mode, BINARY_FILE)
+	newfp = fiodes[newfd]
+
+	FDEV(newfp) = FDEV(ffp)
+	FBUFSIZE(newfp) = FBUFSIZE(ffp)
+	FCHAN(newfp) = FCHAN(ffp)
+
+	# If this is the first reopen, allocate space for a separate channel
+	# descriptor and copy the channel descriptor from the original file.
+
+	if (FCD(ffp) == FLCD(ffp)) {
+	    call malloc (FCD(ffp), LEN_CHANDES, TY_STRUCT)
+	    call amovi (Memi[FLCD(ffp)], Memi[FCD(ffp)], LEN_CHANDES)
+	}
+
+	FREFCNT(ffp) = FREFCNT(ffp) + 1			# bump ref count
+	FCD(newfp) = FCD(ffp)
+
+	if (mode == APPEND)
+	    call seek (newfd, EOFL)
+
+	return (newfd)
+end
diff --git a/sys/fio/seek.x b/sys/fio/seek.x
new file mode 100644
index 00000000..73440a3c
--- /dev/null
+++ b/sys/fio/seek.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# SEEK -- Position the i/o pointer (file offset at which the next i/o transfer
+# will occur) for a file.  Note that ITOP may have to be adjusted before
+# performing the seek, to make newly written data readable (as when writing at
+# EOF, seeking backward within the same buffer, and reading).  A physical seek
+# is performed for text files.  For binary files, a logical seek is performed,
+# adjusting the i/o pointer.  Physical seeks on binary files are initiated
+# by FFAULT, when filling or flushing a file buffer.
+
+procedure seek (fd, offset)
+
+int	fd			# file
+long	offset			# offset == BOF,EOF, or char offset
+
+pointer	bp
+long	file_offset
+int	status
+long	ffilsz()
+errchk	filerr, syserr, ffilsz
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	call fcanpb (fd)	# cancel any pushback
+	UPDATE_IOP(fd)		# make newly written data readable
+
+	if (FTYPE(fp) == TEXT_FILE) {
+	    # General seeks only permitted on text files opened for reading.
+	    if (FMODE(fp) != READ_ONLY)
+		if (offset != BOF && offset != EOF)
+		    call filerr (FNAME(fp), SYS_FSEEKNTXF)
+
+	    bp = bufptr[fd]
+	    if (BUF_MODIFIED(fd)) {		# flush buffer?
+		call fputtx (fd, Memc[bp], otop[fd] - bp, status)
+		if (status != ERR)
+		    call zcall2 (ZFLSTX(fp), FCHAN(fp), status)
+		if (status == ERR)
+		    call filerr (FNAME(fp), SYS_FWRITE)
+	    }
+
+	    iop[fd] = bp
+	    itop[fd] = bp
+	    otop[fd] = bp
+
+	    call zcall3 (ZSEKTX(fp), FCHAN(fp), offset, status)
+	    if (status == ERR)
+		call filerr (FNAME(fp), SYS_FSEEK)
+
+	} else {				# logical seek (binary files)
+	    switch (offset) {
+	    case BOF:
+		file_offset = 1
+	    case EOF:
+		file_offset = ffilsz (fd) + 1
+	    default:
+		file_offset = offset
+	    }
+	    iop[fd] = file_offset - boffset[fd] + bufptr[fd]
+	}
+end
diff --git a/sys/fio/stropen.x b/sys/fio/stropen.x
new file mode 100644
index 00000000..ac3c8068
--- /dev/null
+++ b/sys/fio/stropen.x
@@ -0,0 +1,151 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# STROPEN, STRCLOSE -- Open/close a character string for file i/o.  Called by
+# sprintf (for example) to make the output string look like a file.
+# 
+# The string is made to appear to be the file buffer.  It is a fatal error
+# if the string is not char aligned with Mem.  If the output string should
+# overflow, FIO will call FLSBUF, resulting in a system error action.  STROPEN,
+# for efficiency reasons, does not really open a file, it merely validates the
+# buffer pointers and reserves a file descriptor.  Note that the buffer
+# pointers may be negative.  Seeks are illegal on a string file, and will
+# cause an error action to be taken.
+# 
+# If alignment is not automatically guaranteed for char data on your machine,
+# define "stropen" as "memopen($1,$2,$3,TEXT_FILE)", and "strclose" as "close",
+# in <iraf.h> (or install a dummy procedure in the library).
+
+int procedure stropen (str, maxch, mode)
+
+char	str[ARB]			#I string buffer for i/o
+int	maxch				#I capacity of buffer
+int	mode				#I FIO access mode
+
+pointer	bp
+int	fd, ip, loc_str, loc_Mem
+errchk	syserr
+include	<fio.com>
+
+begin
+	# Find an unused file descriptor.
+	for (fd=FIRST_FD;  fd <= LAST_FD && fiodes[fd] != NULL;  fd=fd+1)
+	    ;
+	if (fd > LAST_FD)
+	    call syserr (SYS_FTOOMANYFILES)
+
+	# Compute pointer (Memc index) to the string.
+	call zlocva (str,  loc_str)
+	call zlocva (Memc, loc_Mem)
+	bp = loc_str - loc_Mem + 1
+
+	# Get file descriptor and init the buffer pointers.
+	call fstrfp (fiodes[fd])
+	call strsetmode (fd, mode)
+	bufptr[fd] = bp
+	buftop[fd] = bp + maxch
+	fflags[fd] = 0
+
+	# If string is being opened in any of the following modes, it
+	# must be an initialized (written into) string with an EOS.
+	# Find EOS and set itop accordingly.
+
+	if (mode == READ_ONLY || mode == READ_WRITE || mode == APPEND)
+	    for (ip=1;  str[ip] != EOS && ip <= maxch;  ip=ip+1)
+		;
+
+	# Seeks are illegal on strings.  Modes RO and RW are equivalent, as
+	# are WO, NF, and TF.  Append is like WO/NF/TF, but the i/o pointer is
+	# positioned at the EOS.  An EOS will automatically be written when
+	# a file opened with mode WO, NF, TF, or AP is closed.
+
+	iop[fd]  = bp
+	itop[fd] = bp
+	otop[fd] = bp + maxch
+
+	switch (mode) {
+	case READ_ONLY, READ_WRITE:
+	    itop[fd] = bp + ip - 1
+	    otop[fd] = bp
+	case APPEND:
+	    iop[fd] = bp + ip - 1
+	}
+
+	return (fd)
+end
+
+
+# STRCLOSE -- Close a string file previously opened by STROPEN.  If writing
+# to a new string, append an EOS to the end of the string.  This routine is
+# automatically called by CLOSE if the string was opened as a file with
+# STROPEN.  Applications should call CLOSE, instead of calling STRCLOSE
+# directly, to ensure that the file descriptor allocated by STROPEN and FIO
+# is fully closed.
+
+procedure strclose (fd)
+
+int	fd				#I file descriptor
+int	strgetmode()
+errchk	syserr
+include	<fio.com>
+
+begin
+	if (fd < 0 || fiodes[fd] == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	# Free any file pushback.
+	call mfree (FPBBUF(fiodes[fd]), TY_CHAR)
+
+	# If string was opened for writing, append EOS.  NOTE that if the
+	# string was opened with length N, the EOS will go into location N+1
+	# if the string is completely full.
+
+	switch (strgetmode(fd)) {
+	case WRITE_ONLY, APPEND, NEW_FILE, TEMP_FILE:
+	    Memc[iop[fd]] = EOS
+	default:
+	    ;
+	}
+
+	# Free the file descriptor.
+	bufptr[fd] = NULL
+	fiodes[fd] = NULL
+end
+
+
+# STRSETMODE -- Set the access mode for a string file.  This is an internal
+# routine normally called only by STROPEN above.  It may also called during
+# task termination and cleanup to change the string file access mode to avoid
+# an attempt to EOS terminate the string buffer, before closing off any still
+# open string files
+
+procedure strsetmode (fd, mode)
+
+int	fd				#I file descriptor
+int	mode				#I file access mode
+include	<fio.com>
+
+begin
+	# For a string file the access mode is arbitrarily saved in BOFFSET
+	# for CLOSE (strclose), which needs to know the access mode in order
+	# to append an EOS.  BOFFSET is not otherwise used for string files
+	# since the string buffer has no associated file offset.
+
+	boffset[fd] = mode
+end
+
+
+# STRGETMODE -- Get the access mode for a string file.  This is an internal
+# routine normally called only by STRCLOSE.
+
+int procedure strgetmode (fd)
+
+int	fd				#I file descriptor
+include	<fio.com>
+
+begin
+	return (boffset[fd])
+end
diff --git a/sys/fio/ungetc.x b/sys/fio/ungetc.x
new file mode 100644
index 00000000..89f31c10
--- /dev/null
+++ b/sys/fio/ungetc.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# UNGETC -- Push a character back into the input stream.  Pushback is last
+# in first out, i.e., the last character pushed will be the first character
+# returned in the next getc, getline, or read.  Multiple characters and
+# strings may be pushed back into the input until the push back buffer
+# overflows.  Overflow is often an indication of recursion in whatever
+# routine is doing the pushback.
+#
+# Single character pushback is fairly expensive, but the i/o system is
+# very efficient for even character at a time input and is optimized with
+# that in mind.  The overhead for pushing back an entire string is about
+# the same as for a single character, so recursive macro expansion may be
+# implemented quite efficiently with this pushback technique.
+
+procedure ungetc (fd, ch)
+
+int	fd			# file
+char	ch			# char to be pushed back
+pointer	pb_sp, pb_iop
+int	or()
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	if (FPBBUF(fp) == NULL)
+	    call fmkpbbuf (fd)
+
+	# Push the old pb_iop, iop, itop and bufptr on the stack.  Note bufptr
+	# must be set to a value less than or equal to iop to avoid a buffer
+	# fault.
+
+	pb_iop = FPBIOP(fp)
+	pb_sp  = FPBSP(fp) - 1
+
+	Memi[pb_sp] = pb_iop
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = bufptr[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = itop[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = iop[fd]
+
+	# Deposit the char in the pbbuf and set up i/o pointers.  When iop
+	# reaches itop filbuf will pop the old input pointers off the pbstack.
+	# Note: pushed back data grows upward, while the pb stack grows
+	# downward.
+
+	Memc[pb_iop] = ch
+	bufptr[fd] = pb_iop
+	iop[fd] = pb_iop
+	pb_iop = pb_iop + 1
+	itop[fd] = pb_iop
+
+	# Check for overflow.
+	if (pb_iop >= (pb_sp - 1) * SZ_INT + 1)
+	    call syserrs (SYS_FPBOVFL, FNAME(fp))
+	
+	FPBSP(fp) = pb_sp
+	FPBIOP(fp) = pb_iop
+	fflags[fd] = or (fflags[fd], FF_PUSHBACK)
+end
diff --git a/sys/fio/ungetci.x b/sys/fio/ungetci.x
new file mode 100644
index 00000000..9a8283a3
--- /dev/null
+++ b/sys/fio/ungetci.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# UNGETCI -- Push a character back into the input stream.  Pushback is last
+# in first out, i.e., the last character pushed will be the first character
+# returned in the next getc, getline, or read.  Multiple characters and
+# strings may be pushed back into the input until the push back buffer
+# overflows.  Overflow is often an indication of recursion in whatever
+# routine is doing the pushback.
+#
+# Single character pushback is fairly expensive, but the i/o system is
+# very efficient for even character at a time input and is optimized with
+# that in mind.  The overhead for pushing back an entire string is about
+# the same as for a single character, so recursive macro expansion may be
+# implemented quite efficiently with this pushback technique.
+
+procedure ungetci (fd, ch)
+
+int	fd			# file
+int	ch			# char to be pushed back
+pointer	pb_sp, pb_iop
+int	or()
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	if (FPBBUF(fp) == NULL)
+	    call fmkpbbuf (fd)
+
+	# Push the old pb_iop, iop, itop and bufptr on the stack.  Note bufptr
+	# must be set to a value less than or equal to iop to avoid a buffer
+	# fault.
+
+	pb_iop = FPBIOP(fp)
+	pb_sp  = FPBSP(fp) - 1
+
+	Memi[pb_sp] = pb_iop
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = bufptr[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = itop[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = iop[fd]
+
+	# Deposit the char in the pbbuf and set up i/o pointers.  When iop
+	# reaches itop filbuf will pop the old input pointers off the pbstack.
+	# Note: pushed back data grows upward, while the pb stack grows
+	# downward.
+
+	Memc[pb_iop] = ch
+	bufptr[fd] = pb_iop
+	iop[fd] = pb_iop
+	pb_iop = pb_iop + 1
+	itop[fd] = pb_iop
+
+	# Check for overflow.
+	if (pb_iop >= (pb_sp - 1) * SZ_INT + 1)
+	    call syserrs (SYS_FPBOVFL, FNAME(fp))
+	
+	FPBSP(fp) = pb_sp
+	FPBIOP(fp) = pb_iop
+	fflags[fd] = or (fflags[fd], FF_PUSHBACK)
+end
diff --git a/sys/fio/ungetline.x b/sys/fio/ungetline.x
new file mode 100644
index 00000000..b93717ef
--- /dev/null
+++ b/sys/fio/ungetline.x
@@ -0,0 +1,75 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# UNGETLINE -- Push an EOS delimited string back into the input stream.
+# The next getc will return the first char of the pushed back string,
+# followed by successive chars in the string until EOS is reached, at which
+# time input reverts to wherever it was before pushback.  Pushback is last
+# in first out, i.e., the last string pushed will be the first string scanned
+# when reading.  Multiple characters and strings may be pushed back into the
+# input until the push back buffer overflows.  Overflow is often an indication
+# of recursion in whatever routine is doing the pushback.
+#
+# N.B.: this routine really pushes a string, not a line, i.e. we don't give
+# a whiz about newline characters.
+
+procedure ungetline (fd, str)
+
+int	fd			# file
+char	str[ARB]		# string to be pushed back
+
+int	or()
+pointer	ip, pb_iop, pb_sp, iop_limit
+errchk	syserr, syserrs, fmkpbbuf
+include	<fio.com>
+
+begin
+	fp = fiodes[fd]
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	if (str[1] == EOS)
+	    return
+	if (FPBBUF(fp) == NULL)
+	    call fmkpbbuf (fd)
+
+	# Push the old pb_iop, iop, itop and bufptr on the stack for later
+	# restoration of the interrupted input stream by filbuf.  Note bufptr
+	# must be changed to point to a value less than iop to avoid a buffer
+	# fault.
+
+	pb_sp  = FPBSP(fp) - 1
+	pb_iop = FPBIOP(fp)
+
+	Memi[pb_sp] = pb_iop
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = bufptr[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = itop[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = iop[fd]
+
+	# Copy the string into the buffer; abort if the buffer overflows.
+	# Set iop to point to first char of string.  Note: pushed back chars
+	# grow upward while the stacked i/o pointers grow downward.
+
+	bufptr[fd] = pb_iop
+	iop[fd] = pb_iop
+	iop_limit = (pb_sp - 1) * SZ_INT + 1
+
+	for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+	    if (pb_iop >= iop_limit)
+		call syserrs (SYS_FPBOVFL, FNAME(fp))
+	    Memc[pb_iop] = str[ip]
+	    pb_iop = pb_iop + 1
+	}
+
+	itop[fd] = pb_iop
+	
+	FPBSP(fp) = pb_sp
+	FPBIOP(fp) = pb_iop
+	fflags[fd] = or (fflags[fd], FF_PUSHBACK)
+end
diff --git a/sys/fio/unread.x b/sys/fio/unread.x
new file mode 100644
index 00000000..1319e6b1
--- /dev/null
+++ b/sys/fio/unread.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# UNREAD -- Push a binary block of data back into the input stream.  Pushback
+# is last in first out, i.e., the pushed back data will be read before input
+# resumes at the point at which it was interrupted.  Multiple blocks of data
+# may be pushed back into the input until the push back buffer overflows.
+# Overflow is often an indication of recursion in whatever routine is doing
+# the pushback.
+
+procedure unread (fd, buf, nchars)
+
+int	fd			# file
+char	buf[ARB]		# data block to be pushed back
+int	nchars			# nchars to push back
+
+int	or()
+pointer	pb_iop, pb_sp
+errchk	syserr, syserrs, fmkpbbuf
+include	<fio.com>
+
+begin
+	fp = fiodes (fd)
+	if (fd <= 0 || fp == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	if (FPBBUF(fp) == NULL)
+	    call fmkpbbuf (fd)
+
+	# Push the old pb_iop, iop, itop and bufptr on the stack for later
+	# restoration of the interrupted input stream by filbuf.  Note bufptr
+	# must be set to <= iop to avoid a buffer fault.
+
+	pb_sp  = FPBSP(fp) - 1
+	pb_iop = FPBIOP(fp)
+
+	Memi[pb_sp] = pb_iop
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = bufptr[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = itop[fd]
+	pb_sp = pb_sp - 1
+	Memi[pb_sp] = iop[fd]
+
+	# Check that room remains for the data.
+	if (((pb_sp - 1) * SZ_INT + 1) - pb_iop < nchars)
+	    call syserrs (SYS_FPBOVFL, FNAME(fp))
+
+	# Move the data block into the buffer.  Set the iop to point to the
+	# first char of the block.  Note: data grows upwards while the stack
+	# grows downward.
+
+	bufptr[fd] = pb_iop
+	iop[fd] = pb_iop
+	call amovc (buf, Memc[pb_iop], nchars)
+	pb_iop = pb_iop + nchars
+	itop[fd] = pb_iop
+	
+	FPBSP(fp) = pb_sp
+	FPBIOP(fp) = pb_iop
+	fflags[fd] = or (fflags[fd], FF_PUSHBACK)
+end
diff --git a/sys/fio/vfnmap.x b/sys/fio/vfnmap.x
new file mode 100644
index 00000000..6eff8b2e
--- /dev/null
+++ b/sys/fio/vfnmap.x
@@ -0,0 +1,899 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<ctype.h>
+include	<mach.h>
+include	<error.h>
+include	<syserr.h>
+include	<config.h>
+include	<fio.h>
+
+.help vfnmap
+.nf ___________________________________________________________________________
+VFNMAP -- A package for mapping virtual filenames to and from OS filenames.
+The abstract datatype dealt with here is the VFN.  The operations defined for
+a VFN are [1] map to OSFN, [2] add a new VFN to the VFN database, and [3] delete
+a VFN from the VFN database.  The VFN database is manipulated only by this
+package.  This is an internal package, not a user package -- the semantics of
+locking parts of the VFN database are delicate.
+
+A VFN must be opened separately for each file to be accessed, except when
+reading a directory in which case the vfnmap must be opened separately for
+each directory to be scanned.  Only a single VFN may be opened for writing by
+a process at any one time (any number of VFN's, including directories, may be
+opened for reading at any one time).  The mapping file is not physically opened
+unless the escape sequence encoded filename is degenerate.  The mapping file is
+locked only if the vfn is degenerate and the access mode is VFN_WRITE.  The
+recognized vfn access modes are VFN_READ, VFN_WRITE, and VFN_UNMAP (for reading
+directories).
+
+It is intended that THE VFN WILL BE OPENED FOR ONLY A BRIEF PERIOD OF TIME TO
+MINIMIZE THE AMOUNT OF TIME THAT THE MAPPING FILE IS LOCKED.  Furthermore,
+while the VFN is locked we must avoid any operations that involve waiting for
+system resources and hence introduce the possibility of deadlock.
+
+	vp =	 vfnopen (vfn, mode)
+		vfnclose (vp, update)
+	stat =    vfnmap (vp, osfn, maxch)
+	stat =	  vfnadd (vp, osfn, maxch)
+	stat =    vfndel (vp, osfn, maxch)
+	stat =	vfnunmap (vp, osfn, vfn, maxch)
+
+		  fmapfn (vfn, osfn, maxch)	[=:vfnopen/RO,vfnmap,vfnclose]
+
+A distinction is made between mapping the filename and opening and closing
+the vfn to permit efficient and secure error recovery.  The mapping file is
+not updated on disk until the physical file operation (create, delete, etc)
+has succeeded.  If the operation fails vfnclose is called with VFN_NOUPDATE
+and the mapping file is not touched.  If the vfn was opened VFN_READ the
+update flag is ignored.  No vfn disk data structures will be modified if a
+vfn is closed with VFN_NOUPDATE set.  If updating is enabled, ".zmd" dependency
+files may be created or deleted, the mapping file may be created, deleted,
+or updated.
+
+The VFNMAP, VFNADD, VFNDEL, and VFNUNMAP procedures all perform a mapping
+operation, returning OK if the filename could be mapped and ERR if the
+mapping fails and no OSFN or VFN is returned.  A VFNMAP, VFNADD, or VFNDEL
+mapping can only return ERR if the VFN is degenerate and either no entry
+was found in the mapping file (VFNMAP, VFNDEL) or there already was an entry
+(VFNADD).  OSFN is returned as a packed string, VFN as a normal string.
+
+NOTE1 -- (Dec84) The "degeneracy flag files" are no longer used, but some of
+the code has been left in place, to avoid having to modify and test the code
+after its removal.  This code should be removed when other modifications are
+required which will require careful testing of the package.
+
+NOTE2 -- Interrupts and automatic error checking should be disabled while a
+VFN is open to prevent corruption of the mapping file, failure to remove a
+file lock, or failure to close the mapping file.
+.endhelp ______________________________________________________________________
+
+define	SZ_VFN		255		# max chars in V_VFN field
+define	LEN_FN		128		# no. chars allocated to VFNFN field
+define	SZ_FNPAIR	(LEN_FN*2)	# size of filename pair 2(+EOS+align)
+define	MAX_LONGFNAMES	100		# max filename pairs in FNMAP
+define	SZ_ZFD		4		# size of ".zfd" extension
+define	MAX_READS	5		# max trys to read mapping file
+define	MAX_DEGENERACY	50		# max VFN's mapping to same OSFN
+define	MAX_DIGITS	2		# max digits in degeneracy index
+
+define	V_MAP		1		# VFN opcodes
+define	V_ADD		2
+define	V_DEL		3
+define	V_UNMAP		4
+
+# VFD -- VFN descriptor structure.  Assumes an 80 char (or less) OSDIR field
+# and 35 char (or less) VFN, ROOT and EXTN fields (see fio.h).
+
+define	LEN_VFD		778
+
+define	V_MFD		Memi[$1]		# ptr to mapping file descriptor
+define	V_ACMODE	Memi[$1+1]		# access mode
+define	V_LENOSDIR	Memi[$1+2]		# length of OSDIR string
+define	V_LENROOT	Memi[$1+3]		# length of ROOT string
+define	V_LENEXTN	Memi[$1+4]		# length of EXTN string
+define	V_LONGROOT	Memi[$1+5]		# root field exceeds OS limit
+define	V_VFN		Memc[P2C($1+10)]	# VFN - ldir
+define	V_OSDIR		Memc[P2C($1+266)]	# OS directory
+define	V_ROOT		Memc[P2C($1+522)]	# OS root filename
+define	V_EXTN		Memc[P2C($1+650)]	# OS extension
+
+# MFD -- Mapping file descriptor structure.  An upper limit is placed on
+# the number of filename pairs in the descriptor because it is assumed that
+# long filenames are rare.  Note that this places a limit on the number of long
+# filenames in the directory, not on the number of files in the directory.
+# If this is a problem the code is not difficult to generalize.
+
+define	LEN_MFD		(250+MAX_LONGFNAMES*SZ_FNPAIR/SZ_STRUCT)
+define	MIN_LENMFD	(250+1*SZ_FNPAIR/SZ_STRUCT)
+define	SZ_MAPFNAME	(240*SZ_STRUCT-1)
+
+define	M_CHECKSUM	Memi[$1]		# checksum of file when written
+define	M_CHAN		Memi[$1+1]		# OS channel of mapping file
+define	M_LOCKTIME	Meml[$1+2]		# clktime when lock set
+define	M_NFILES	Memi[$1+3]		# no. filename pairs in map
+define	M_LASTOP	Memi[$1+4]		# code for last op on database
+define	M_MODIFIED	Memi[$1+5]		# YES if database modified
+define	M_ADDZMD	Memi[$1+6]		# create .zmd file at update
+define	M_DELZMD	Memi[$1+7]		# delete .zmd file at update
+define	M_MAPFNAME	Memc[P2C($1+10)]	# name of map file
+define	M_FNMAP		(P2C($1+250))		# filename pairs
+
+# Subscript the (VFN,OSFN) filename pairs.  For example, FN_VFN(mfd,n)
+# references the VFN field of filename pair N of the mapping file MFD.
+
+define	FN_VFN		Memc[M_FNMAP($1)+(($2)*2-2)*LEN_FN]
+define	FN_OSFN		Memc[M_FNMAP($1)+(($2)*2-1)*LEN_FN]
+
+
+# VFNOPEN -- Open a VFN.  Allocate VFD and convert the VFN into OSFN, ROOT,
+# and EXTN fields.  The EXTN field is mapped to the OS extension, but the
+# ROOT field may be longer than is permitted by the OS.  The mapping file
+# is not referenced until the OSFN is requested in a map, add, or del op.
+
+pointer procedure vfnopen (vfn, mode)
+
+char	vfn[ARB]		# virtual filename
+int	mode			# access mode for VFN database
+
+bool	first_time
+int	n_open_vfns, root_offset, extn_offset
+pointer	def_vfd, vfd
+data	first_time /true/
+common	/vfncom/ n_open_vfns
+errchk	syserrs, malloc, calloc, vfn_translate, vvfn_readmapfile
+
+begin
+	# After the first call a single VFD will be allocated at all times.
+	# This eliminates the need to allocate and free a descriptor in each
+	# call.
+
+	if (first_time) {
+	    call malloc (def_vfd, LEN_VFD, TY_STRUCT)
+	    n_open_vfns = 0
+	    first_time = false
+	}
+
+	# Allocate and initialize the VFD.
+
+	if (n_open_vfns <= 0) {
+	    vfd = def_vfd
+	    call aclri (Memi[vfd], LEN_VFD)
+	} else
+	    call calloc (vfd, LEN_VFD, TY_STRUCT)
+	n_open_vfns = n_open_vfns + 1
+
+	# Break the VFN into its component parts.  Map using escape sequence
+	# encoding, but do not squeeze the OSFN.  Most calls are read only
+	# accesses that do not involve accessing the VFN database.  The
+	# following is what takes all the time (string concatenation and
+	# packing in VFNMAP is also a factor).
+
+	call vfn_translate (vfn, V_OSDIR(vfd), V_LENOSDIR(vfd),
+				 V_ROOT(vfd),  V_LENROOT(vfd),
+				 V_EXTN(vfd),  V_LENEXTN(vfd))
+
+	# Determine whether the length of the root exceeds the max host system
+	# filename length, and set flag if so.  If longroot, squeeze the root
+	# because the unsqueezed root is not useful for anything.  The V_VFN
+	# field is used as a temporary.
+
+	if (V_LENROOT(vfd) > MAX_ROOTLEN) {
+	    call vfn_squeeze (V_ROOT(vfd), V_VFN(vfd), MAX_ROOTLEN)
+	    call strcpy (V_VFN(vfd), V_ROOT(vfd), MAX_ROOTLEN)
+	    V_LENROOT(vfd) = MAX_ROOTLEN
+	    V_LONGROOT(vfd) = YES
+	} else
+	    V_LONGROOT(vfd) = NO
+
+	# Set access mode and save VFN.
+	V_ACMODE(vfd) = mode
+
+	switch (mode) {
+	case VFN_READ, VFN_WRITE:
+	    call zfnbrk (vfn, root_offset, extn_offset)
+	    call strcpy (vfn[root_offset], V_VFN(vfd), SZ_VFN)
+	case VFN_UNMAP:
+	    call vvfn_readmapfile (vfd)
+	default:
+	    call syserrs (SYS_FVFNMODE, vfn)
+	}
+	
+	return (vfd)
+end
+
+
+# VFNMAP -- Map and pack the VFN into an OSFN, but do not modify the database.
+# The mapping file is accessed only if the OS filename is degenerate, i.e.,
+# if the directory contains more than one VFN mapping to the same OSFN after
+# escape sequence encoding and squeezing.
+
+int procedure vfnmap (vfd, osfn, maxch)
+
+pointer	vfd			# pointer to VFD descriptor
+char	osfn[ARB]		# char buffer to receive packed OSFN
+int	maxch
+
+int	status
+int	vfnmapu()
+
+begin
+	status = vfnmapu (vfd, osfn, maxch)
+	call osfn_pkfname (osfn, osfn, maxch)
+
+	return (status)
+end
+
+
+# VFNMAPU -- Map but do not pack a VFN into an OSFN.  Call VFNMAP if you want
+# a packed osfn.
+
+int procedure vfnmapu (vfd, osfn, maxch)
+
+pointer	vfd			# pointer to VFD descriptor
+char	osfn[maxch]		# char buffer to receive unpacked OSFN
+int	maxch
+
+int	op, status
+int	gstrcpy(), vfn_getosfn()
+errchk	vfn_getosfn, vvfn_readmapfile
+define	degenerate_ 91
+
+begin
+	# The OSDIR and ROOT fields are used twice below, so we concatenate
+	# them here.
+
+	op = gstrcpy (V_OSDIR(vfd), osfn, maxch) + 1
+	op = op + gstrcpy (V_ROOT(vfd), osfn[op], maxch-op+1)
+
+	# If the root field of the osfn is within the length limit for a host
+	# system filename all we have to do is concatenate and pack, returning
+	# the packed osfn.  If the root has been squeezed we have to look to
+	# see if it is unique within the directory; if it is then we do not
+	# have to read the mapping file.  Filename mapping is fast provided
+	# we do not have to read the mapping file.
+
+	if (V_LONGROOT(vfd) == YES)
+	    goto degenerate_
+
+	# Concatenate the final osfn.
+	if (V_LENEXTN(vfd) > 0 && op < maxch) {
+	    osfn[op] = EXTN_DELIMITER
+	    op = op + 1
+	    call strcpy (V_EXTN(vfd), osfn[op], maxch-op+1)
+	} else
+	    osfn[op] = EOS
+
+	return (OK)
+
+
+degenerate_
+	# If we get here then the squeezed filename is degenerate and we have
+	# to read the mapping file to get the OSFN assigned by VFNADD.  If the
+	# mapping file does not exist and the VFN is open with write perm,
+	# then we were probably called by VFNADD and we go ahead and create
+	# a new mapping file.
+
+	call vvfn_readmapfile (vfd)
+
+	# Search the file name list for the named VFN.
+	if (vfn_getosfn (vfd, V_VFN(vfd), osfn, maxch) <= 0)
+	    status = ERR
+	else
+	    status = OK
+
+	M_LASTOP(V_MFD(vfd)) = V_MAP
+
+	return (status)
+end
+
+
+# VFNADD -- Map a VFN to an OSFN and add the VFN,OSFN pair to the VFN database
+# if the OSFN is long.  An entry must be made whether or not the filename is
+# degenerate, to permit the inverse mapping.
+
+int procedure vfnadd (vfd, osfn, maxch)
+
+pointer	vfd			# pointer to VFN descriptor
+char	osfn[maxch]		# buffer to receive packed OSFN
+int	maxch
+
+int	file_exists
+int	vfnmap(), vfn_enter()
+errchk	vfnmap
+
+begin
+	# Call VFNMAP to perform the mapping and possibly open the database.
+	# If VFNMAP returns ERR then the filename was degenerate but was not
+	# found in the database, which is what we want since we are adding
+	# the file.  We return ERR if the file already exists, whether or
+	# not the name is degenerate.
+
+	if (vfnmap (vfd, osfn, maxch) == ERR) {
+	    # Long filename but no entry found in database; we have to add
+	    # a new entry.
+	    return (vfn_enter (vfd, osfn, maxch))
+	} else if (V_LONGROOT(vfd) == NO) {
+	    # Short filename; see if physical file exists.
+	    call zfacss (osfn, 0, 0, file_exists)
+	    if (file_exists == YES)
+		return (ERR)
+	    else
+		return (OK)
+	} else
+	    # VFN found in database and filename is long.
+	    return (ERR)
+end
+
+
+# VFNDEL -- Map a VFN to an OSFN and delete the VFN,OSFN pair from the VFN
+# database if the OSFN is long.
+
+int procedure vfndel (vfd, osfn, maxch)
+
+pointer	vfd			# pointer to VFN descriptor
+char	osfn[maxch]		# buffer to receive packed OSFN
+int	maxch
+
+char	first_char
+int	fn, fn_index, ip, junk
+pointer	sp, root, extn, mfd, vfnp
+bool	streq()
+int	vfnmap()
+errchk	vfnmap
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_VFNFN, TY_CHAR)
+	call salloc (extn, SZ_VFNFN, TY_CHAR)
+
+	# Call VFNMAP to perform the mapping and possibly open the database.
+	# If VFNMAP returns ERR then the filename was degenerate but was not
+	# found in the database and we are done.  If VFNMAP returns OK we
+	# are done unless the filename is long.
+
+	if (vfnmap (vfd, osfn, maxch) == ERR) {
+	    # Long filename but no entry found in database; nothing to delete.
+	    call sfree (sp)
+	    return (ERR)
+	} else if (V_LONGROOT(vfd) == NO) {
+	    # Short filename; nothing to delete but it is not an error.
+	    call sfree (sp)
+	    return (OK)
+	}
+
+	# If we get here the VFN was found in the database and the filename
+	# is long.  Locate the VFN entry and determine if there are any
+	# other entries mapping to the same squeezed root.
+
+	mfd = V_MFD(vfd)
+	vfnp = M_FNMAP(mfd)
+	first_char = V_VFN(vfd)
+	fn_index = 0
+	M_DELZMD(mfd) = YES
+
+	do fn = 1, M_NFILES(mfd) {
+	    if (Memc[vfnp] == first_char) {
+		if (fn_index == 0)
+		    if (streq (Memc[vfnp], V_VFN(vfd)))
+			fn_index = fn
+		ip = 1
+		call vfn_encode (Memc[vfnp], ip, Memc[root], junk, Memc[extn],
+		    junk)
+		if (streq (Memc[root], V_ROOT(vfd))) {
+		    M_DELZMD(mfd) = NO
+		    if (fn_index != 0)
+			break
+		}
+	    }
+	    vfnp = vfnp + SZ_FNPAIR
+	}
+
+	# Delete the filename pair from the database.  Deletion is effected by
+	# shifting the higher indexed filename pairs back one filepair.
+	# We are more concerned here about saving space in the mapping file
+	# and in the MFD, than in making set deletion efficient.
+
+	for (fn = fn_index + 1;  fn <= M_NFILES(mfd);  fn=fn+1)
+	    call amovc (FN_VFN(mfd,fn), FN_VFN(mfd,fn-1), SZ_FNPAIR)
+	M_NFILES(mfd) = M_NFILES(mfd) - 1
+
+	M_LASTOP(mfd) = V_DEL
+	M_MODIFIED(mfd) = YES
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# VFNUNMAP -- Convert an OSFN into a VFN.  Search the MFD file list for the
+# named OSFN, and if found return the associated VFN as an output argument and
+# the length of the VFN string as the function value.  If entry is not found
+# perform the inverse transformation (map extension, invert escape sequence
+# encoding).  The VFN returned does not include a logical directory prefix.
+# This function is called to perform the inverse mapping when reading
+# directories.
+
+int procedure vfnunmap (vfd, osfn, vfn, maxch)
+
+pointer	vfd			# VFN descriptor
+char	osfn[maxch]		# OS filename to be searched for (packed)
+char	vfn[ARB]		# receives unpacked VFN
+int	maxch
+
+char	first_char
+int	fn, op, extn_offset
+pointer	mfd, osfnp, sp, osfname, ip
+bool	streq()
+int	gstrcpy(), vfn_decode()
+
+begin
+	call smark (sp)
+	call salloc (osfname, SZ_PATHNAME, TY_CHAR)
+
+	call strupk (osfn, Memc[osfname], SZ_PATHNAME)
+	if (CASE_INSENSITIVE && HOST_CASE != 'L')
+	    call strlwr (Memc[osfname])
+
+	# Search mapping file for OSFN and return VFN if found.
+
+	mfd = V_MFD(vfd)
+	osfnp = M_FNMAP(mfd) + LEN_FN
+	first_char = Memc[osfname]
+
+	do fn = 1, M_NFILES(mfd) {
+	    if (Memc[osfnp] == first_char)
+		if (streq (Memc[osfnp], Memc[osfname])) {
+		    call sfree (sp)
+		    return (gstrcpy (FN_VFN(mfd,fn), vfn, maxch))
+		}
+	    osfnp = osfnp + SZ_FNPAIR
+	}
+
+	# No entry in mapping file, so we must perform the inverse
+	# transformation.  Decode the root, unmap and decode the extension,
+	# and return VFN.  If there are multiple EXTN_DELIMITER delimited
+	# fields only the final one is mapped as an extension, but all are
+	# decoded.
+
+	vfn[1] = EOS
+	extn_offset = 0
+	ip = osfname
+	op = 1
+
+	while (Memc[ip] != EOS) {
+	    op = op + vfn_decode (Memc, ip, vfn[op], maxch-op+1)
+	    if (Memc[ip] == EXTN_DELIMITER) {
+		ip = ip + 1
+		vfn[op] = '.'
+		op = op + 1
+		vfn[op] = EOS
+		extn_offset = op
+	    }
+	}
+
+	# Add mapped filename extension.  If the OS extension maps into a
+	# null VFN extension omit the trailing period.  If the . is preceded
+	# by another dot it is not considered an extension delimiter.
+
+	if (extn_offset > 0) {
+	    call vfn_unmap_extension (vfn[extn_offset], vfn[extn_offset],
+		SZ_VFNFN - extn_offset + 1)
+	    if (vfn[extn_offset] != EOS) {
+		for (op=extn_offset;  vfn[op] != EOS;  op=op+1)
+		    ;
+	    } else if (extn_offset<=2 || vfn[extn_offset-2] == EXTN_DELIMITER) {
+		op = extn_offset
+	    } else {
+		vfn[extn_offset-1] = EOS
+		op = extn_offset - 1
+	    }
+	}
+
+	call sfree (sp)
+	return (op - 1)
+end
+
+
+# VFNCLOSE -- Close a VFN.  Update the VFN database if the MFD has been
+# modified and updating is enabled.  Release the lock on the directory and
+# return all storage.
+
+procedure vfnclose (vfd, update_enable)
+
+pointer	vfd			# VFN descriptor
+int	update_enable		# update the database?
+
+int	n_open_vfns, lastop, junk, len_struct
+int	status
+pointer	sp, fname, osfn, mfd
+
+int	osfn_unlock(), osfn_timeleft()
+int	vfnadd(), vfndel(), vvfn_checksum()
+common	/vfncom/ n_open_vfns
+errchk	osfn_unlock, osfn_timeleft, vfnadd, vfndel, syserrs
+define	freemfd_ 91
+define	freevfd_ 92
+define	unlock_ 93
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn,  SZ_PATHNAME, TY_CHAR)
+
+	# If the mapping file was never referenced or the database was not
+	# modified in the MFD, just return buffers and quit.
+
+	mfd = V_MFD(vfd)
+	n_open_vfns = n_open_vfns - 1
+
+	if (mfd == NULL)
+	    goto freevfd_
+	else if (M_MODIFIED(mfd) == NO || update_enable == VFN_NOUPDATE) {
+	    if (V_ACMODE(vfd) == VFN_WRITE)
+		goto unlock_
+	    else
+		goto freemfd_
+	}
+
+	# If we get here then the mapping file is open with write permission,
+	# a transaction has been performed which modified the database, and we
+	# were called with updating enabled.  If there is not enough time
+	# remaining on the lock to permit the update, rollback (repeat) the
+	# last transaction, otherwise update the database on disk.
+
+	call osfn_pkfname (M_MAPFNAME(mfd), Memc[osfn], SZ_PATHNAME)
+
+	while (osfn_timeleft (Memc[osfn], M_LOCKTIME(mfd)) < MIN_TIMELEFT) {
+	    # Rollback transaction.  Hopefully it wont take so long this time
+	    # (should only take a second or so).
+
+	    junk = osfn_unlock (Memc[osfn], M_LOCKTIME(mfd))
+	    lastop = M_LASTOP(mfd)
+	    call mfree (mfd, TY_STRUCT)
+
+	    switch (lastop) {
+	    case V_ADD:
+		junk = vfnadd (vfd, Memc[fname], SZ_PATHNAME)
+	    case V_DEL:
+		junk = vfndel (vfd, Memc[fname], SZ_PATHNAME)
+	    }
+	}
+
+	# From here on we are committed.  Update and close the mapping file.
+	# Add checksum to ensure correct reads.
+
+	len_struct = LEN_MFD - (MAX_LONGFNAMES - M_NFILES(mfd)) *
+	    (SZ_FNPAIR / SZ_STRUCT)
+	M_CHECKSUM(mfd) = vvfn_checksum (Memi[mfd+1], (len_struct - 1) * SZ_INT)
+
+	call zawrbf (M_CHAN(mfd), Memi[mfd], len_struct * SZ_STRUCT * SZB_CHAR,
+	    long(1))
+	call zawtbf (M_CHAN(mfd), status)
+	if (status == ERR)
+	    call syserrs (SYS_FWRITE, M_MAPFNAME(mfd))
+unlock_
+	call zclsbf (M_CHAN(mfd), status)
+	if (status == ERR)
+	    call syserrs (SYS_FCLOSE, M_MAPFNAME(mfd))
+
+	# All done!  Unlock the directory.  If there are no files left in
+	# the mapping file, delete the file and all lock files.
+
+	call osfn_pkfname (M_MAPFNAME(mfd), Memc[osfn], SZ_PATHNAME)
+	if (M_NFILES(mfd) == 0) {
+	    call zfdele (Memc[osfn], junk)
+	    call osfn_rmlock (Memc[osfn])
+	} else if (osfn_unlock (Memc[osfn], M_LOCKTIME(mfd)) == ERR) {
+	    iferr (call syserrs (SYS_FNOLOCK, M_MAPFNAME(mfd)))
+		call erract (EA_WARN)
+	}
+
+freemfd_
+	call mfree (mfd, TY_STRUCT)
+freevfd_
+	if (n_open_vfns > 0)
+	    call mfree (vfd, TY_STRUCT)
+	call sfree (sp)
+end
+
+
+# VVFN_READMAPFILE -- Open and read the mapping file.  In VFN_WRITE mode a
+# new mapping file is created if necessary.
+
+procedure vvfn_readmapfile (vfd)
+
+pointer	vfd			# pointer to VFD descriptor
+
+int	new_struct_size, checksum, file_exists, maxbytes, new_mapping_file
+int	nbytes, len_file, junk, chan, ntrys, errnum, status
+long	locktime
+pointer	sp, mfd, fname, pkosfn
+
+int	vvfn_checksum()
+long	osfn_lock()
+errchk	calloc, syserrs, osfn_lock, osfn_init
+define	cleanup_ 91
+define	reallynew_ 92
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pkosfn, SZ_PATHNAME, TY_CHAR)
+
+	call calloc (mfd, LEN_MFD, TY_STRUCT)
+	V_MFD(vfd)	= mfd
+
+	# Make OSFN of mapping file.  If the mode is VFN_UNMAP then the root
+	# field, if any, is the filename of the directory containing the
+	# mapping file.
+
+	call strcpy (V_OSDIR(vfd), M_MAPFNAME(mfd), SZ_MAPFNAME)
+	if (V_ACMODE(vfd) == VFN_UNMAP && V_LENROOT(vfd) > 0)
+	    call zfsubd (M_MAPFNAME(mfd), SZ_MAPFNAME, V_ROOT(vfd), junk)
+	call strcat (FNMAPPING_FILE, M_MAPFNAME(mfd), SZ_MAPFNAME)
+	call strlwr (M_MAPFNAME(mfd))
+	call osfn_pkfname (M_MAPFNAME(mfd), Memc[fname], SZ_PATHNAME)
+
+	# Open or create mapping file.  Create must precede lock as lock will
+	# abort if the file to be locked does not exist.  OSFN_LOCK will call
+	# error if no write perm on directory.  If file locking is implemented
+	# by host, open will return ERR if file is write locked by another
+	# process, in which case we wait until the file can be opened.
+
+	call zfacss (Memc[fname], 0, 0, file_exists)
+	new_mapping_file = NO
+
+	switch (V_ACMODE(vfd)) {
+	case VFN_WRITE:
+	    # Determine whether or not the mapping file exists.
+	    call osfn_pkfname (M_MAPFNAME(mfd), Memc[pkosfn], SZ_PATHNAME)
+
+	    if (file_exists == YES) {
+		# Open an existing mapping file for exclusive access.
+		iferr (locktime = osfn_lock (Memc[pkosfn])) {
+		    call mfree (mfd, TY_STRUCT)
+		    V_MFD(vfd) = NULL
+		    call erract (EA_ERROR)
+		}
+		repeat {
+		    call zopnbf (Memc[fname], READ_WRITE, chan)
+		    if (chan == ERR)
+			call zwmsec (1000)
+		} until (chan != ERR || !OS_FILELOCKING)
+
+	    } else {
+		# Create a new mapping file and init the locks.
+		new_mapping_file = YES
+		call zopnbf (Memc[fname], NEW_FILE, chan)
+		if (chan != ERR) {
+		    call osfn_initlock (Memc[pkosfn])
+		    locktime = osfn_lock (Memc[pkosfn])
+		} else {
+		    errnum = SYS_FOPEN
+		    goto cleanup_
+		}
+	    }
+	default:
+	    if (file_exists == YES)
+		call zopnbf (Memc[fname], READ_ONLY, chan)
+	}
+
+	if (file_exists == YES && chan == ERR) {
+	    errnum = SYS_FOPEN
+	    goto cleanup_
+	}
+
+	# Read mapping file into descriptor.  Repeat the read if the
+	# checksum is invalid, indicating that our read occurred while
+	# an update was in progress (locking need not lockout reads).
+
+	if (file_exists == YES) {
+	    ntrys = 0
+
+	    repeat {
+		# Read the file into the MFD.
+		maxbytes = LEN_MFD * SZ_STRUCT * SZB_CHAR
+		call zardbf (chan, Memi[mfd], maxbytes, long(1))
+		call zawtbf (chan, nbytes)
+
+		# The mapping file can be zero length if it was opened for
+		# updating but never written into.
+
+		if (nbytes == 0)
+		    goto reallynew_
+
+		len_file = nbytes / SZB_CHAR / SZ_STRUCT
+		if (len_file < MIN_LENMFD) {
+		    errnum = SYS_FREAD
+		    goto cleanup_
+		}
+
+		# The checksum excludes the checksum field of MFD, but the
+		# entire MFD is written to the mapping file.  Note that the
+		# file will contain garbage at the end following a file
+		# deletion (the file list gets shorter but the file does not).
+		# Compute checksum using only the valid file data, since that
+		# is how it is computed when the file is updated.
+
+		len_file = LEN_MFD - (MAX_LONGFNAMES - M_NFILES(mfd)) *
+		    (SZ_FNPAIR / SZ_STRUCT)
+		checksum = vvfn_checksum (Memi[mfd+1], (len_file-1) * SZ_INT)
+
+		ntrys = ntrys + 1
+	    } until (checksum == M_CHECKSUM(mfd) || ntrys > MAX_READS)
+
+	    if (ntrys > MAX_READS) {
+		errnum = SYS_FVFNCHKSUM
+		goto cleanup_
+	    }
+	}
+
+reallynew_
+
+	# Close the mapping file if it is never going to be updated, and return
+	# any unused space in the mapping file descriptor.
+
+	if (V_ACMODE(vfd) != VFN_WRITE) {
+	    if (file_exists == YES) {
+		call zclsbf (chan, status)
+		if (status == ERR)
+		    call syserrs (SYS_FCLOSE, M_MAPFNAME(mfd))
+	    }
+	    new_struct_size = LEN_MFD -
+		(MAX_LONGFNAMES - M_NFILES(mfd)) * (SZ_FNPAIR/SZ_STRUCT)
+	    call realloc (mfd, new_struct_size, TY_STRUCT)
+	    V_MFD(vfd) = mfd
+	} else {
+	    M_CHAN(mfd) = chan
+	    M_LOCKTIME(mfd) = locktime
+	}
+
+	call sfree (sp)
+	return
+
+cleanup_
+	call strcpy (M_MAPFNAME(mfd), Memc[fname], SZ_PATHNAME)
+	call mfree (mfd, TY_STRUCT)
+	V_MFD(vfd) = NULL
+	call syserrs (errnum, Memc[fname])
+end
+
+
+# VFN_ENTER -- Add a new filename pair to the mapping file.  The VFN was not
+# found in the database but that does not mean that there is not already an
+# occurrence of the OSFN in the database and in the directory; if the OSFN is
+# already in use, the filename is degenerate.  If the OSFN exists in the
+# directory then create ".zmd" degeneracy file and generate a unique OSFN,
+# adding a new VFN,OSFN pair to the database.
+
+int procedure vfn_enter (vfd, osfn, maxch)
+
+pointer	vfd			# pointer to VFN descriptor
+char	osfn[maxch]		# packaged OS filename (in/out)
+int	maxch
+
+int	file_exists, op, ndigits, m, n, num, offset, fn
+pointer	sp, fname, numbuf, mfd
+int	gstrcpy(), itoc()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (numbuf, MAX_DIGITS, TY_CHAR)
+
+	# Generate the first attempt at the OSFN of the new file.
+
+	op = gstrcpy (V_OSDIR(vfd), Memc[fname], SZ_PATHNAME)
+	op = op + gstrcpy (V_ROOT(vfd), Memc[fname+op], SZ_PATHNAME-op)
+	if (V_LENEXTN(vfd) > 0) {
+	    Memc[fname+op] = EXTN_DELIMITER
+	    op = op + 1
+	    call strcpy (V_EXTN(vfd), Memc[fname+op], SZ_PATHNAME-op)
+	}
+	offset = V_LENOSDIR(vfd) + 1
+
+	# Determine if a file already exists with the new OSFN.  If so we
+	# must flag the file as degenerate and generate a unique OSFN.
+
+	call osfn_pkfname (Memc[fname], osfn, maxch)
+	call zfacss (osfn, 0, 0, file_exists)
+
+	if (file_exists == YES) {
+	    # Set flag to create degeneracy flag file at update time.
+	    M_ADDZMD(mfd) = YES
+
+	    # Generate a unique OSFN for the new file.  This is done by
+	    # overwriting the 2nd and following characters of the root with
+	    # a number until a unique name results.  Nines are preferred as
+	    # they occur least frequently in ordinary filenames.
+
+	    for (m=0;  file_exists == YES && m * 10 < MAX_DEGENERACY;  m=m+1)
+		for (n=9;  file_exists == YES && n >= 0;  n=n-1) {
+		    num = m * 10 + n
+		    ndigits = itoc (num, Memc[numbuf], MAX_DIGITS)
+		    call amovc (Memc[numbuf], Memc[fname+offset], ndigits)
+		    call osfn_pkfname (Memc[fname], osfn, maxch)
+		    call zfacss (osfn, 0, 0, file_exists)
+		}
+
+	    if (m * 10 >= MAX_DEGENERACY)
+		call syserrs (SYS_FDEGEN, Memc[fname])
+	}
+
+	# Add the filename pair to the database.  The directory prefix is
+	# omitted.  If we run out of room in the mapping file we just abort.
+
+	mfd = V_MFD(vfd)
+	fn = M_NFILES(mfd) + 1
+	M_NFILES(mfd) = fn
+	if (fn > MAX_LONGFNAMES)
+	    call syserrs (SYS_FTMLONGFN, Memc[fname])
+
+	# Save the VFN and OSFN, minus the directory prefix, in the mapping
+	# file structure.
+
+	call strcpy (V_VFN(vfd),  FN_VFN(mfd,fn),  SZ_VFNFN)
+	call strcpy (Memc[fname+offset-1], FN_OSFN(mfd,fn), SZ_VFNFN)
+
+	M_LASTOP(mfd) = V_ADD
+	M_MODIFIED(mfd) = YES
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# VFN_GETOSFN -- Search the MFD file list for the named VFN, and if found
+# return the assigned OSFN as an output argument and the length of the OSFN
+# string as the function value.  ERR is returned if the entry cannot be found.
+# The OSFN includes the OSDIR prefix.
+
+int procedure vfn_getosfn (vfd, vfn, osfn, maxch)
+
+pointer	vfd			# VFN descriptor
+char	vfn[ARB]		# virtual filename to be searched for
+char	osfn[maxch]		# receives unpacked OSFN
+int	maxch
+
+char	first_char
+int	fn, op
+pointer	mfd, vfnp
+bool	streq()
+int	gstrcpy()
+
+begin
+	mfd = V_MFD(vfd)
+	vfnp = M_FNMAP(mfd)
+	first_char = vfn[1]
+
+	do fn = 1, M_NFILES(mfd) {
+	    if (Memc[vfnp] == first_char)
+		if (streq (Memc[vfnp], vfn)) {
+		    op = gstrcpy (V_OSDIR(vfd), osfn, maxch) + 1
+		    op = op + gstrcpy (FN_OSFN(mfd,fn), osfn[op], maxch-op+1)
+		    return (op - 1)
+		}
+	    vfnp = vfnp + SZ_FNPAIR
+	}
+
+	return (ERR)
+end
+
+
+# VVFN_CHECKSUM -- Compute the integer checksum of a char array.
+
+int procedure vvfn_checksum (a, nchars)
+
+char	a[nchars]		# array to be summed
+int	nchars			# length of array
+int	i, sum
+
+begin
+	sum = 0
+	do i = 1, nchars
+	    sum = sum + a[i]
+
+	return (sum)
+end
diff --git a/sys/fio/vfntrans.x b/sys/fio/vfntrans.x
new file mode 100644
index 00000000..44f4f36f
--- /dev/null
+++ b/sys/fio/vfntrans.x
@@ -0,0 +1,937 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<syserr.h>
+include	<chars.h>
+include	<config.h>
+include	<knet.h>
+include	<fio.h>
+
+.help vfntrans
+.nf ___________________________________________________________________________
+VFNTRANS -- Procedures for translating VFN's to OSFN's and back again in
+memory.  These procedures are called by the VFNMAP procedures, but do not
+access the VFN database.  This package contains most of the knowledge of the
+characteristics of OS filenames.  The characteristics of OS filenames (max
+length, extensions, etc.) are defined in <config.h>.
+
+	    vfn_translate (vfn, osdir, lenosdir, root, lenroot, extn, lenextn)
+	  vfn_expand_ldir (vfn, outstr, maxch)
+	       vfn_encode (vfn, ip, root, lenroot, extn, lenextn)
+      nchars = vfn_decode (osfn, ip, vfn, maxch)
+        vfn_map_extension (iraf_extn, os_extn, maxch)
+      vfn_unmap_extension (iraf_extn, os_extn, maxch)
+    	      vfn_squeeze (root, outstr, maxch)
+ y/n = vfn_is_hidden_file (fname)
+
+The main vfn to osfn translation routine is VFN_TRANSLATE.  VFN_EXPAND_LDIR
+performs recursive logical directory expansion.  The encode and decode routines
+perform escape sequence encoding and its inverse.  Substitution of OS filename
+extensions for IRAF extensions, and vice versa, is performed by the map
+extension procedures.
+.endhelp ______________________________________________________________________
+
+# Size limiting definitions.
+
+define	MAX_PUSHBACK	16	# determines length of pushback stack
+define	SZ_PBBUF	255	# size of pushback buffer
+define	MAX_EXTENSIONS	20	# max filename extension pairs in EXTN_MAP
+define	MAX_RESERVEXTN	20	# max reserved filename extensions
+define	SZ_EXTNMAP	64	# storage for iraf/os extn pairs
+
+
+# VFN_TRANSLATE -- Translate a VFN into the OSDIR, ROOT, and EXTN fields.
+# If a logical directory prefix is given it will be recursively expanded.
+# Any number of subdirectories may be given; each is folded into the OSDIR.
+# The ROOT field is escape sequence encoded but not squeezed.  The EXTN
+# field is encoded and selected IRAF extensions are mapped into OS
+# extensions.
+
+procedure vfn_translate (rawvfn, osdir, lenosdir, root, lenroot, extn, lenextn)
+
+char	rawvfn[ARB]		# input virtual filename
+char	osdir[SZ_OSDIR]		# OS directory prefix		(output)
+int	lenosdir		# length of the osdir string	(output)
+char	root[SZ_VFNFN]		# OS root filename		(output)
+int	lenroot			# length of the root string	(output)
+char	extn[SZ_VFNFN]		# OS filename extension		(output)
+int	lenextn			# length of the extn string	(output)
+
+pointer	sp, ip, vfn, fname, sqroot
+int	gstrcpy(), nowhite()
+errchk	syserr
+
+begin
+	call smark (sp)
+	call salloc (vfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (sqroot, MAX_ROOTLEN, TY_CHAR)
+
+	# Strip any whitespace at either end of the filename.
+	if (nowhite (rawvfn, Memc[vfn], SZ_PATHNAME) == 0)
+	    call syserr (SYS_FNOFNAME)
+
+	# If the VFN begins with a legal OS directory prefix it is assumed
+	# to be an OSFN and no mapping is performed.  Do not bother to break
+	# the filename into osdir, root, extn.
+
+	call zfxdir (Memc[vfn], osdir, SZ_OSDIR, lenosdir)
+
+	if (lenosdir > 0) {
+	    # VFN is actually an OSFN.  Return the OSFN as the osdir filename
+	    # to avoid the 32 char restriction.
+	    root[1] = EOS
+	    lenroot = 0
+	    extn[1] = EOS
+	    lenextn = 0
+
+	    lenosdir = gstrcpy (Memc[vfn], osdir, SZ_OSDIR)
+
+	    call sfree (sp)
+	    return
+	}
+
+	# The VFN is really a VFN.  Check for a logical directory prefix and
+	# recursively expand it into an OS directory prefix if found.  A VFN of
+	# the form "ldir$xxx" is converted to "osdir // xxx".  Additional
+	# subdirectories may be introduced in the expansion.
+
+	call vfn_expand_ldir (Memc[vfn], Memc[fname], SZ_PATHNAME)
+	call zfxdir (Memc[fname], osdir, SZ_OSDIR, lenosdir)
+	ip = fname + lenosdir
+
+	# Translate the VFN.  Each pass through the loop extracts and processes
+	# the next field of the VFN.  A field may be a subdirectory delimited
+	# by a /, a root filename, or an extension.  Subdirectory names are
+	# encoded and squeezed but not looked up in the mapping table, hence
+	# long directory names must be unique within a directory.
+
+	repeat {
+	    call vfn_encode (Memc, ip, root, lenroot, extn, lenextn)
+	    if (Memc[ip] == '/' ||
+		(root[1] == '.' && lenroot == 1) ||
+		(root[1] == '.' && root[2] == '.' && lenroot == 2)) {
+
+		if (lenroot > MAX_ROOTLEN) {
+		    call vfn_squeeze (root, Memc[sqroot], MAX_ROOTLEN)
+		    call zfsubd (osdir, SZ_OSDIR, Memc[sqroot], lenosdir)
+		} else
+		    call zfsubd (osdir, SZ_OSDIR, root, lenosdir)
+		root[1] = EOS
+		lenroot = 0
+		if (Memc[ip] == '/')
+		    ip = ip + 1
+	    }
+	} until (Memc[ip] == EOS)
+
+	# Map IRAF extension into OS extension.
+	if (lenextn > 0)
+	    call vfn_map_extension (extn, extn, SZ_VFNFN)
+	call sfree (sp)
+end
+
+
+# VFN_EXPAND_LDIR -- Copy the input VFN to the output string.  As the copy is
+# being performed we scan for the ldir delimiter.  If it is encountered, we
+# lookup the ldir in the environment and push the value back into the input,
+# resuming scanning on the new input.  Logical directories are thus expanded
+# recursively, i.e., one ldir may reference another in its definition.  If an
+# ldir references itself storage will overflow and an error message is printed.
+
+procedure vfn_expand_ldir (vfn, outstr, maxch)
+
+char	vfn[ARB]	# VFN possibly containing an ldir prefix
+char	outstr[maxch]	# output string
+int	maxch
+
+char	ch
+pointer	pbbuf					# pushback buffer
+pointer	pb_stack[MAX_PUSHBACK]			# pushback stack
+int	n, op, op_node, op_env, pbsp, in
+pointer	nextch, ip, sp
+
+int	envfind(), gstrcpy(), ki_localnode()
+define	input {$1=Memc[ip];ip=ip+1}
+define	output {outstr[op]=$1;op=op+1}
+errchk	syserrs, envfind
+
+begin
+	call smark (sp)
+	call salloc (pbbuf, SZ_PBBUF, TY_CHAR)
+
+	# Discard leading whitespace and copy the VFN into the input buffer.
+	for (in=1;  IS_WHITE (vfn[in]);  in=in+1)
+	    ;
+
+	nextch  = pbbuf + gstrcpy (vfn[in], Memc[pbbuf], SZ_PBBUF) + 1
+	ip      = pbbuf
+	op      = 1	
+	op_node = 1
+	pbsp    = 1
+
+	# Copy characters successively from the input buffer to the output
+	# buffer (outstr).  Expand logical names recursively (by rescanning
+	# the translation string returned by ENVGETS).
+
+	repeat {
+	    input (ch)
+	    if (IS_ALNUM (ch)) {			# --- regular chars
+		output (ch)
+
+	    } else if (ch == FNNODE_CHAR) {
+		# If CH is the node name delimiter, either the named node
+		# is the local node passed as a prefix to any ldir strings,
+		# or the node was referenced IN one of the logical directory
+		# replacement strings.
+
+		if (pbsp == 1) {
+		    # If no logical directory definitions have been pushed
+		    # back, the named node must be the local node.
+
+		    output (ch)
+		    op_node = op
+
+		} else {
+		    outstr[op] = EOS
+
+		    if (ki_localnode (outstr) == YES) {
+			# Same as above; ignore local node prefix.
+			output (ch)
+			op_node = op
+
+		    } else {
+			# A remote node has been referenced during logical
+			# directory expansion.  Filename translation must take
+			# place on the remote node, so exit immediately,
+			# returning the new filename "node!vfn".  This will
+			# repeat when filename translation resumes on the
+			# remote node, but over there the named node will be
+			# the local node and the if(yes) branch will be taken.
+
+			output (ch)
+			op = op + gstrcpy (vfn[in], outstr[op], maxch-op+1)
+			break
+		    }
+		}
+
+	    } else if (ch == FNLDIR_CHAR) {
+		# If CH is the logical name delimiter, look up the logical name
+		# in the environment table.  If found, push definition back into
+		# pbbuf, clear the output buffer, and scan pushed back string.
+		# If not found, pass the string on as a file name.  Delete the
+		# '$' character, so that OS directory specs like "osdir$"
+		# are passed on correctly.
+
+		output (EOS)
+		n = envfind (outstr[op_node], Memc[nextch],
+		    pbbuf + SZ_PBBUF - nextch)
+
+		if (n >= 0) {				# push back defn
+		    pb_stack[pbsp] = ip			# save ip on stk
+		    pbsp = pbsp + 1
+		    ip = nextch				# set ip to new input
+		    nextch = nextch + n + 1
+		    # Check for recursion (stack overflow).
+		    if (pbsp > MAX_PUSHBACK || nextch-pbbuf >= SZ_PBBUF)
+			call syserrs (SYS_FZMAPRECUR, Memc[pbbuf])
+		    op = op_node			# discard logical name
+		} else
+		    op = op - 1				# cancel EOS, delete $
+
+	    } else if (ch == '(') {
+		# Environment substitution.  Mark the position of the left
+		# paren for later replacement.
+
+		op_env = op
+		output (ch)
+
+	    } else if (ch == ')') {
+		# Complete an environment substitution.
+
+		outstr[op_env] = EOS
+		n = gstrcpy (outstr[op_node], Memc[nextch],
+		    pbbuf + SZ_PBBUF - nextch)
+
+		pb_stack[pbsp] = ip			# save ip on stk
+		pbsp = pbsp + 1
+		ip = nextch				# set ip to new input
+		nextch = nextch + n
+
+		# Check for recursion (stack overflow).
+		if (pbsp > MAX_PUSHBACK || nextch-pbbuf >= SZ_PBBUF)
+		    call syserrs (SYS_FZMAPRECUR, Memc[pbbuf])
+
+		# Get the envvar value string; use null string if not defined.
+		output (EOS)
+		n = envfind (outstr[op_env+1], Memc[nextch],
+		    pbbuf + SZ_PBBUF - nextch)
+		if (n <= 0) {
+		    Memc[nextch] = EOS
+		    n = 0
+		}
+
+		nextch = nextch + n + 1
+		op = op_node
+
+	    } else if (ch == EOS) {
+		# EOS may mean either the end of a pushed back string, or the
+		# end of the VFN string.  Pop old ip off stack, continue until
+		# the pushback stack is empty (end of VFN).
+
+		pbsp = pbsp - 1				# pop old ip off stk
+		ip = pb_stack[pbsp]
+		if (pbsp == 0)				# --- all done
+		    break
+
+	    } else if (ch == ESCAPE) {
+		# Escaped characters are passed straight to the output.
+		# Preserve the escape unless the escaped character is a
+		# metacharacter recognized by this procedure (i.e., $ or @).
+
+		input (ch)
+		if (ch == EOS)
+		    ip = ip - 1
+		else if (ch == FNLDIR_CHAR || ch == FNNODE_CHAR)
+		    output (ch)
+		else {
+		    output ('\\')
+		    output (ch)
+		}
+
+	    } else if (ch > BLANK) {
+		# Whitespace and control chars are deleted.
+		output (ch)
+	    }
+
+	    if (op > maxch)				# check for overflow
+		call syserrs (SYS_FZMAPOVFL, vfn)
+	}
+
+	output (EOS)
+	call sfree (sp)
+end
+
+
+# VFN_ENCODE -- Extract and encode the next field of the input VFN.  The subdir
+# delimiter / or EOS will delimit the scan; the input pointer must be set to
+# the first character to be scanned upon input and is left pointing at the
+# delimiter character upon output.  If the field is a subdir no extension will
+# be returned.  If an extension is encountered but its length exceeds that
+# permitted by the OS or if another "." delimited field is encountered then
+# the "." is encoded and the extension is included in the root.  If the OS is
+# case insensitive the output string will be all lower case.
+
+procedure vfn_encode (vfn, ip, root, lenroot, extn, lenextn)
+
+char	vfn[ARB]		# virtual filename to be scanned
+int	ip			# offset of first char to be scanned (in/out)
+char	root[SZ_VFNFN]		# receives the encoded root filename
+int	lenroot			# nchars in root
+char	extn[SZ_VFNFN]		# receives the encoded filename extn
+int	lenextn			# nchars in extn
+
+int	out, i
+char	ch, nextch
+bool	uc_mode, processing_extension, escape_extension, subdir
+pointer	sp, field, op
+
+int	gstrcpy()
+define	putch {Memc[op]=$1;op=op+1}
+define	notextn_ 91
+
+begin
+	call smark (sp)
+	call salloc (field, SZ_FNAME, TY_CHAR)
+
+	# Skip leading whitespace and control chars.
+	while (vfn[ip] > 0 && vfn[ip] <= BLANK)
+	    ip = ip + 1
+
+	# Do something sensible if the null string is input.
+	if (vfn[ip] == EOS) {
+	    root[1] = EOS
+	    extn[1] = EOS
+	    lenroot = 0
+	    lenextn = 0
+	    call sfree (sp)
+	    return
+	}
+
+	out = 1
+	op = field
+	uc_mode = false
+	processing_extension = false
+	escape_extension = false
+
+	# If the first char is legal in an OSFN but is not a letter and only
+	# letters are permitted as the first char, then a no-op sequence (shift
+	# to lower) is output first.  
+
+	if (LEADING_ALPHA_ONLY)
+	    if (vfn[ip] != '.' && !IS_ALPHA(vfn[ip]))
+		call vvfn_escape (SHIFT_TO_LOWER, root, out, SZ_VFNFN)
+
+	# The main loop.  Examine each input character and output zero or
+	# more characters depending on the input character class and on what
+	# the host system permits.  Most characters are expected to be lower
+	# case alphas or digits, hence what we do after these first couple of
+	# IF's should not affect efficiency much.  NOTE: set the escape char
+	# to NUL to turn off escapes on a machine that allows any char in a
+	# a filename.
+
+	ch = vfn[ip]
+	do i = 1, ARB {
+	    if (ch == EOS) {
+		break
+	    } else if (IS_LOWER(ch)) {
+		if (uc_mode) {
+		    putch (VFN_ESCAPE_CHAR)
+		    putch (SHIFT_TO_LOWER)
+		    uc_mode = false
+		}
+		putch (ch)
+
+	    } else if (IS_DIGIT(ch)) {
+		putch (ch)
+		
+	    } else if (ch == '_') {
+		if (UNDERSCORE_PERMITTED)
+		    putch (ch)
+		else {
+		    putch (VFN_ESCAPE_CHAR)
+		    putch (UNDERSCORE_CODE)
+		}
+
+	    } else if (IS_UPPER(ch)) {
+		if (!CASE_INSENSITIVE)
+		    putch (ch)
+		else if (uc_mode)
+		    putch (TO_LOWER(ch))
+		else {
+		    # Determine whether to do a case shift or just escape
+		    # a single character.  The crossover point is at 2 chars.
+		    # If the next character is also upper case we shift up.
+
+		    putch (VFN_ESCAPE_CHAR)
+		    if (IS_UPPER (vfn[ip+1])) {
+			uc_mode = true
+			putch (SHIFT_TO_UPPER)
+		    } else
+			putch (SHIFT_NEXTCHAR)
+		    putch (TO_LOWER(ch))
+		}
+
+	    } else if (ch == '.') {
+		# Determine whether the "." marks an extension or is part of
+		# one of the two special subdirectories "." and "..".
+
+		subdir = false
+		if (op == field && !processing_extension) {
+		    nextch = vfn[ip+1]
+		    if (nextch == '/' || nextch == EOS) {
+			subdir = true
+		    } else if (nextch == '.' &&
+		    	      (vfn[ip+2] == '/' || vfn[ip+2] == EOS)) {
+			subdir = true
+			putch (ch)
+			ip = ip + 1
+		    }
+		}
+		    
+		if (subdir) {
+		    putch (ch)
+
+		} else if (processing_extension) {
+		    # We are already processing an extension and have just
+		    # encountered another one (e.g., "file.x.old").  Escape
+		    # the dot and include it and the old extension in the
+		    # root.  Start a new extension.
+
+		    putch (EOS)
+		    if (PERIOD_PERMITTED) {
+			root[out] = '.'
+			out = out + 1
+		    } else
+			call vvfn_escape (PERIOD_CODE, root, out, SZ_VFNFN)
+		    out = out + gstrcpy (Memc[field], root[out], SZ_VFNFN-out+1)
+		    op = field
+		    escape_extension = false
+		
+		} else {
+		    # This is the first extension to be encountered.  Move the
+		    # contents of the field buffer to root and clear the buffer.
+
+		    putch (EOS)
+		    out = out + gstrcpy (Memc[field], root[out], SZ_VFNFN-out+1)
+		    op = field
+		    processing_extension = true
+		    escape_extension = false
+		}
+
+	    } else if (ch == '\\' && vfn[ip+1] != EOS) {
+		# Escaped characters are passed unconditionally, stripping the
+		# escape character itself unless used to escape the first char
+		# of an extension, in which case the \ must be retained in the
+		# output extension to defeat extension mapping.
+
+		if (processing_extension && op == field)
+		    escape_extension = true
+		ip = ip + 1
+		putch (vfn[ip])
+
+	    } else if (ch == '/') {
+		# End of subdirectory name terminates scan.  Extensions are
+		# not recognized within subdirectory names; include as part
+		# of root name.
+
+		if (processing_extension)
+		    goto notextn_
+		else
+		    break
+
+	    } else if (ch <= BLANK) {
+		# Strip whitespace and control chars.
+	    } else {
+		# Unknown characters are not mapped; user's discretion.
+		putch (ch)
+	    }
+
+	    # If we are processing an extension and the max length of an OS
+	    # extension has been exceeded, the extension is considered part of
+	    # the root and we are no longer processing an extension.
+
+	    if (processing_extension)
+		if (op - field > MAX_EXTNLEN) {
+notextn_	    if (PERIOD_PERMITTED) {
+			root[out] = '.'
+			out = out + 1
+		    } else
+			call vvfn_escape (PERIOD_CODE, root, out, SZ_VFNFN)
+		    processing_extension = false
+		    escape_extension = false
+		    if (ch == '/')
+			break
+		}
+
+	    ip = ip + 1
+	    ch = vfn[ip]
+	}
+
+	putch (EOS)
+	if (processing_extension) {
+	    # Move extension to the extn output buffer.  Add the escape
+	    # character if the extension was escaped.
+	    if (escape_extension) {
+		extn[1] = '\\'
+		lenextn = gstrcpy (Memc[field], extn[2], SZ_VFNFN-1) + 1
+	    } else
+		lenextn = gstrcpy (Memc[field], extn, SZ_VFNFN)
+
+	    # If extn is the null string then root ended in a period; include
+	    # the period in the root.
+	    if (lenextn == 0)
+		if (PERIOD_PERMITTED) {
+		    root[out] = '.'
+		    out = out + 1
+		} else
+		    call vvfn_escape (PERIOD_CODE, root, out, SZ_VFNFN)
+
+	    root[out] = EOS
+	    lenroot = out - 1
+
+	} else {
+	    extn[1] = EOS
+	    lenextn = 0
+	    lenroot = out + gstrcpy (Memc[field], root[out], SZ_VFNFN-out+1) - 1
+	}
+
+	call sfree (sp)
+end
+
+
+# VVFN_ESCAPE -- Deposit a character in the output buffer preceded by the
+# escape character.  Ensure that the output buffer does not overflow.
+
+procedure vvfn_escape (ch, outbuf, op, maxch)
+
+int	ch		# character to be output (passed as an INT)
+char	outbuf[maxch]	# output buffer
+int	op		# output pointer (in/out)
+int	maxch
+
+begin
+	outbuf[op] = VFN_ESCAPE_CHAR
+	op = min (maxch, op + 1)
+	outbuf[op] = ch
+	op = min (maxch, op + 1)
+end
+
+
+# VFN_DECODE -- Decode an escape sequence encoded field of a filename.  This is
+# easier than encoding because we have fewer decisions to make.
+#
+# NOTE: set the escape char to NUL on a machine which allows any character in a
+# filename.  Since such a character will never be encountered in filenames this
+# effectively turns off decoding and will prevent misinterpretation of OS
+# filenames not written by IRAF.
+
+int procedure vfn_decode (osfn, ip, outstr, maxch)
+
+char	osfn[ARB]	# escape sequence encoded filename
+int	ip		# input pointer (in/out)
+char	outstr[maxch]	# output string
+int	maxch
+
+int	ch, op
+bool	convert_to_upper
+define	putback_ 91
+
+begin
+	convert_to_upper = false
+
+	# Optimization: most filenames start with a simple sequence of letters.
+	# Dispense with these as a special case, and fall into the more general
+	# code when some other character is encountered.
+
+	do op = 1, maxch {
+	    ch = osfn[ip+op-1]
+	    if (ch != VFN_ESCAPE_CHAR && IS_LOWER (ch))
+		outstr[op] = ch
+	    else {
+		ip = ip + op - 1
+		break
+	    }
+	}
+
+	for (ch=osfn[ip];  ch != EOS && op <= maxch;  ch=osfn[ip]) {
+	    # Process escapes.
+
+	    if (ch == VFN_ESCAPE_CHAR && osfn[ip+1] != EOS) {
+		ip = ip + 1
+		ch = osfn[ip]
+
+		switch (ch) {
+		case SHIFT_NEXTCHAR:
+		    if (IS_LOWER (osfn[ip+1])) {
+			ip = ip + 1
+			outstr[op] = TO_UPPER (osfn[ip])
+			op = op + 1
+		    } else
+			goto putback_
+
+		case SHIFT_TO_LOWER, SHIFT_TO_UPPER:
+		    if (IS_LOWER (osfn[ip+1]))
+			convert_to_upper = (ch == SHIFT_TO_UPPER)
+		    else
+			goto putback_
+
+		case UNDERSCORE_CODE:
+		    outstr[op] = '_'
+		    op = op + 1
+
+		case PERIOD_CODE:
+		    outstr[op] = '.'
+		    op = op + 1
+
+		default:
+		    # Not a recognized escape.  Output the escape char
+		    # and put the next char back into the input.
+putback_
+		    outstr[op] = VFN_ESCAPE_CHAR
+		    op = op + 1
+		    ip = ip - 1
+		}
+	    
+	    } else if (IS_LOWER (ch)) {
+		if (convert_to_upper)
+		    outstr[op] = TO_UPPER(ch)
+		else
+		    outstr[op] = ch
+		op = op + 1
+
+	    } else if (ch == EXTN_DELIMITER) {
+		break
+
+	    } else if (ch == FNLDIR_CHAR) {
+		outstr[op] = '\\'
+		op = op + 1
+		outstr[op] = ch
+		op = op + 1
+
+	    } else {
+		outstr[op] = ch
+		op = op + 1
+	    }
+
+	    ip = ip + 1
+	}
+
+	outstr[op] = EOS
+	return (op - 1)
+end
+
+
+# VFN_MAP_EXTENSION -- Map an IRAF filename extension to a host OS filename
+# extension.  Unrecognized extensions are merely copied.  The set of
+# extensions to be mapped is defined in <config.h>
+
+procedure vfn_map_extension (iraf_extn, os_extn, maxch)
+
+char	iraf_extn[ARB]		# IRAF filename extension
+char	os_extn[maxch]		# OS filename extension
+int	maxch
+
+bool	first_time
+char	first_char
+int	extn
+bool	streq()
+data	first_time /true/
+
+int	nextn			# number of extensions in map
+short	iraf[MAX_EXTENSIONS]	# indices of IRAF extensions
+short	os[MAX_EXTENSIONS]	# indices of OS extensions
+char	map[SZ_EXTNMAP]		# iraf to os mappings, e.g. "|iraf,os|.."
+common	/vfnxtn/ nextn, iraf, os, map
+
+begin
+	# Init the iraf and os index arrays and count the number of extension
+	# in the map.
+
+	if (first_time) {
+	    call vvfn_init_extnmap (map, iraf, os, nextn, MAX_EXTENSIONS)
+	    first_time = false
+	}
+
+	first_char = iraf_extn[1]
+
+	# Escaped extensions, i.e., "root.\extn", are passed on unmodified but
+	# with the escape character deleted.
+
+	if (first_char == '\\') {
+	    call strcpy (iraf_extn[2], os_extn, maxch)
+	    return
+	}
+	    
+	# Search map for the IRAF extension and of found return OS extension,
+	# else return IRAF extension.
+
+	if (first_char != EOS)
+	    for (extn=1;  extn <= nextn;  extn=extn+1)
+		if (map[iraf[extn]] == first_char)
+		    if (streq (iraf_extn, map[iraf[extn]])) {
+			call strcpy (map[os[extn]], os_extn, maxch)
+			return
+		    }
+
+	call strcpy (iraf_extn, os_extn, maxch)
+end
+
+
+# VFN_UNMAP_EXTENSION -- Convert OS extension to IRAF extension by table lookup
+# in the MAP array of extn pairs.
+
+procedure vfn_unmap_extension (os_extn, iraf_extn, maxch)
+
+char	os_extn[maxch]		# OS filename extension
+char	iraf_extn[ARB]		# IRAF filename extension
+int	maxch
+
+int	extn
+char	first_char
+bool	first_time
+bool	streq()
+data	first_time /true/
+
+int	nextn			# number of extensions in map
+short	iraf[MAX_EXTENSIONS]	# indices of IRAF extensions
+short	os[MAX_EXTENSIONS]	# indices of OS extensions
+char	map[SZ_EXTNMAP]		# iraf to os mappings, e.g. "|iraf,os|.."
+common	/vfnxtn/ nextn, iraf, os, map
+
+begin
+	# Init the iraf and os index arrays and count the number of extension
+	# in the map.
+
+	if (first_time) {
+	    call vvfn_init_extnmap (map, iraf, os, nextn, MAX_EXTENSIONS)
+	    first_time = false
+	}
+
+	# Search map for the OS extension and if found return IRAF extension.
+	# If the OS extension matches an IRAF extension then escape the first
+	# char of the extension to avoid interpretation as an IRAF extension.
+
+	first_char = os_extn[1]
+	if (first_char != EOS)
+	    for (extn=1;  extn <= nextn;  extn=extn+1) {
+		if (map[os[extn]] == first_char) {
+		    if (streq (os_extn, map[os[extn]])) {
+			call strcpy (map[iraf[extn]], iraf_extn, maxch)
+			return
+		    }
+		}
+		if (map[iraf[extn]] == first_char) {
+		    if (streq (os_extn, map[iraf[extn]])) {
+			iraf_extn[1] = '\\'
+			call strcpy (map[iraf[extn]], iraf_extn[2], maxch-1)
+			return
+		    }
+		}
+	    }
+
+	call strcpy (os_extn, iraf_extn, maxch)
+end
+
+
+# VVFN_INIT_EXTNMAP -- Scan the map and initialize the indices of the
+# extension strings the first time we are called.  Replace the field
+# delimiters with EOS to ease string comparisons.  The format of the map
+# string is "Airaf,osA...", where A is any field delimiter character and
+# a comma must be given between fields.  Embedded whitespace is not
+# permitted.  For example:  map = "|a,olb|e,exe|"
+
+procedure vvfn_init_extnmap (map, iraf, os, nextn, max_extn)
+
+char	map[ARB]		# set of extns to be mapped
+short	iraf[max_extn]		# indices of IRAF extensions
+short	os[max_extn]		# indices of OS extensions
+int	nextn			# number of extensions in map
+int	max_extn
+
+int	ip
+char	delim
+bool	first_time
+data	first_time /true/
+
+begin
+	if (!first_time)
+	    return
+
+	call strcpy (EXTN_MAP, map, SZ_EXTNMAP)
+	nextn = 0
+	delim = map[1]
+	if (delim == EOS)
+	    return
+
+	for (ip=2;  map[ip] != EOS && nextn < max_extn;  ip=ip+1) {
+	    nextn = nextn + 1
+
+	    iraf[nextn] = ip
+	    while (map[ip] != ',' && map[ip] != EOS)
+		ip = ip + 1
+	    map[ip] = EOS
+	    ip = ip + 1
+
+	    os[nextn] = ip
+	    while (map[ip] != delim && map[ip] != EOS)
+		ip = ip + 1
+	    map[ip] = EOS
+	}
+
+	if (nextn > max_extn)
+	    call fatal (1, "fio$vfntrans.x: too many extensions")
+
+	first_time = false
+end
+
+
+# VFN_SQUEEZE -- Squeeze the root filename (or any string) to fit into the
+# output string.  Squeezing preserves the first N-1 and final characters of
+# the input string, e.g., if N=6 "concatenate" is squeezed to "concae".
+
+procedure vfn_squeeze (root, outstr, maxch)
+
+char	root[ARB]		# input string to be squeezed
+char	outstr[maxch]		# output, squeezed string
+int	maxch			# length of squeezed string
+
+int	ip, op
+
+begin
+	# Omit leading whitespace.
+	for (ip=1;  IS_WHITE (root[ip]);  ip=ip+1)
+	    ;
+
+	# Squeeze root to outstr.
+	for (op=0;  root[ip] != EOS;  ip=ip+1) {
+	    op = min (maxch, op + 1)
+	    outstr[op] = root[ip]
+	}
+	outstr[op+1] = EOS
+end
+
+
+# VFN_IS_HIDDEN_FILE -- Determine if the named file is a hidden file.
+# Hidden files are files with reserved extensions.  The set of reserved
+# extensions is given by a list of the form "|.ex1|.ext|...|".
+
+int procedure vfn_is_hidden_file (fname)
+
+char	fname[ARB]		# unpacked filename
+char	ch
+short	extn[MAX_RESERVEXTN]
+bool	first_time
+int	nextn, first_char, off, i
+bool	streq()
+int	strldx()
+string	reserved RESERVED_EXTNS
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    call vvfn_init_reserved_extns (reserved, extn,MAX_RESERVEXTN, nextn)
+	    first_time = false
+	}
+
+	if (nextn > 0) {
+	    ch = EXTN_DELIMITER
+	    off = strldx (ch, fname) + 1
+	    first_char = fname[off]
+
+	    if (off > 0 && first_char != EOS)
+		do i = 1, nextn
+		    if (reserved[extn[i]] == first_char)
+			if (streq (reserved[extn[i]], fname[off]))
+			    return (YES)
+	}
+	
+	return (NO)
+end
+
+
+# VVFN_INIT_RESERVED_EXTNS -- Inde the list of reserved extensions.  Overwrite
+# the delimiter character with EOS, set the indices of the extension strings
+# in the EXTN array, and count the number of extensions.  The format of the
+# reserved extension array is "|str1|str2|str3|...|strN|", where the first
+# char is taken to be the delimiter character.
+
+procedure vvfn_init_reserved_extns (ex, extn, max_extn, nextn)
+
+char	ex[ARB]			# list of reserved extensions
+short	extn[max_extn]		# indices of substrings
+int	max_extn		# max extensions
+int	nextn			# number of extensions (output)
+
+char	delim
+int	ip
+
+begin
+	nextn = 0
+	delim = ex[1]
+	if (delim == EOS)
+	    return
+	ip = 2
+
+	while (ex[ip] != EOS && nextn < max_extn) {
+	    nextn = nextn + 1
+	    extn[nextn] = ip
+
+	    while (ex[ip] != delim && ex[ip] != EOS)
+		ip = ip + 1
+
+	    if (ex[ip] == delim) {
+		ex[ip] = EOS
+		ip = ip + 1
+	    }
+	}
+end
diff --git a/sys/fio/write.x b/sys/fio/write.x
new file mode 100644
index 00000000..66241ff5
--- /dev/null
+++ b/sys/fio/write.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fio.h>
+
+# WRITE -- Write binary chars to a file.  The specified number of chars will
+# always be written (with the file buffer being flushed as many times as
+# necessary) unless an error occurs.
+
+procedure write (fd, buffer, maxchars)
+
+int	fd
+char	buffer[ARB]
+int	maxchars
+int	nchars, chunk_size
+errchk	flsbuf
+include	<fio.com>
+
+begin
+	if (fd <= 0 || fiodes[fd] == NULL)
+	    call syserr (SYS_FILENOTOPEN)
+
+	nchars = 0
+
+	while (nchars < maxchars) {
+	    if (iop[fd] < bufptr[fd] || iop[fd] >= otop[fd])
+		call flsbuf (fd, maxchars - nchars)
+	    chunk_size = min (maxchars - nchars, otop[fd] - iop[fd])
+	    if (chunk_size <= 0)
+		break
+	    else {
+		call amovc (buffer[nchars+1], Memc[iop[fd]], chunk_size)
+		iop[fd] = iop[fd] + chunk_size
+		nchars = nchars + chunk_size
+	    }
+	}
+
+	FNCHARS(fiodes[fd]) = nchars
+end
diff --git a/sys/fio/xerputc.x b/sys/fio/xerputc.x
new file mode 100644
index 00000000..5fda4026
--- /dev/null
+++ b/sys/fio/xerputc.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+
+# XERPUTC -- Low level routine, called by the error handling code, to
+# accumulate an error command, and send it off to the CL.  Clumsy, but
+# necessary to avoid recursion if an error abort occurs in a routine
+# such as PUTC or FLSBUF.  The buffer is automatically flushed to CLOUT
+# when newline is encountered.
+
+procedure xerputc (ch)
+
+char	ch
+int	op, junk, nchars
+char	msg[SZ_LINE+1]
+include	<fio.com>
+data	op /1/
+
+begin
+	msg[op] = ch
+
+	if (ch == '\n' || op > SZ_PATHNAME) {
+	    fp = fiodes[CLOUT]
+	    nchars = op
+	    op = 0
+
+	    if (FTYPE(fp) == TEXT_FILE)
+		call fputtx (CLOUT, msg, nchars, junk)
+	    else {
+		call zcall4 (ZAWRBF(fp), FCHAN(fp), msg, nchars * SZB_CHAR, 0)
+	    }
+	}
+
+	op = op + 1
+end
diff --git a/sys/fio/zfiott.com b/sys/fio/zfiott.com
new file mode 100644
index 00000000..f48830bc
--- /dev/null
+++ b/sys/fio/zfiott.com
@@ -0,0 +1,35 @@
+# ZFIOTT.COM -- State variables for the VOS terminal driver.
+
+int	tty_kinchan			# kernel input channel of terminal
+int	tty_koutchan			# kernel output channel of terminal
+int	tty_inlogchan			# input spoolfile
+int	tty_outlogchan			# output spoolfile
+int	tty_pbinchan			# playback spoolfile
+int	tty_delay			# playback delay/rec, msec
+int	tty_ip				# pointer into tty_inbuf
+int	tty_filter			# EPA of filter callback
+int	tty_filter_key			# character key which triggers filter
+bool	tty_ucasein			# map upper case input to lower case
+bool	tty_ucaseout			# map output to upper case
+bool	tty_shiftlock			# software shiftlock for ucasein mode
+bool	tty_rawmode			# in raw terminal mode
+bool	tty_logio			# logio logging in effect
+bool	tty_login			# input logging in effect
+bool	tty_logout			# output logging in effect
+bool	tty_playback			# playback mode (cmd input from file)
+bool	tty_verify			# pause when newline seen in input
+bool	tty_passthru			# passthru mode (direct i/o to device)
+char	tty_iofile[SZ_FNAME]		# name of logio spoolfile
+char	tty_infile[SZ_FNAME]		# name of login spoolfile
+char	tty_outfile[SZ_FNAME]		# name of logout spoolfile
+char	tty_pbfile[SZ_FNAME]		# name of playback spoolfile
+char	tty_tdevice[SZ_DEVNAME]		# terminal device at record time
+char	tty_gdevice[SZ_DEVNAME]		# stdgraph device at record time
+char	tty_inbuf[SZ_LINE]		# input line data buffer
+
+common	/zttcom/ tty_kinchan, tty_koutchan, tty_inlogchan, tty_outlogchan,
+	tty_pbinchan, tty_delay, tty_ip, tty_filter, tty_filter_key,
+	tty_ucasein, tty_ucaseout, tty_shiftlock, tty_rawmode, tty_logio,
+	tty_login, tty_logout, tty_playback, tty_verify, tty_passthru,
+	tty_iofile, tty_infile, tty_outfile, tty_pbfile, tty_tdevice,
+	tty_gdevice, tty_inbuf
diff --git a/sys/fio/zfiott.x b/sys/fio/zfiott.x
new file mode 100644
index 00000000..ec7af7e8
--- /dev/null
+++ b/sys/fio/zfiott.x
@@ -0,0 +1,1256 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<ttset.h>
+include	<ctype.h>
+include	<chars.h>
+include	<fio.h>
+
+# ZFIOTT -- Logical device driver for terminals.  This VOS level driver
+# implements various software terminal options as a transformation on the
+# data stream to the hardware terminal driver "os$zfioty.c".  In particular,
+# the TT driver can transform input from a monocase terminal into the mixed
+# case input required by IRAF, allowing IRAF to be used with old monocase
+# terminals, and allowing the user to lock a dual case terminal into upper
+# case if desired.  The driver can also log i/o to a file, log the input
+# or output streams to separate files, or take input from an input logfile
+# (`playback' the command input in a file).
+
+define	HELP "\
+\n\r[space or return to continue, g to turn verify off, q to quit]"
+
+define	CONTINUE	' '		# execute command from logfile
+define	CONTINUE_ALT	'\r'		# alternative char to continue
+define	QUIT		'q'		# terminate playback mode
+define	GO		'g'		# continue with verify disabled
+define	CTRLCHAR	'^'		# used for shift escape functions
+define	SHIFTLOCK	'+'		# ^+
+define	SHIFTOFF	'-'		# ^-
+define	BEGINCOM	'{'		# \{ comment \}
+define	ENDCOM		'}'		# \{ comment \}
+
+define	RMARGIN		75		# for spoolfile output
+define	DONTCARE	2		# something other than YES or NO
+define	PBDELAY		500		# default delay in playback mode (msec)
+define	SZ_LOGLINE	4096		# max chars in a logfile record
+define	SZ_DEVNAME	20		# max size termcap/graphcap device name
+
+define	IOFILE		"home$ttyio.log"
+define	INFILE		"home$ttyin.log"
+define	OUTFILE		"home$ttyout.log"
+define	PBFILE		"home$ttyin.log"
+
+
+# ZGETTT -- Get a line of text from a terminal.  Map the input to lower case
+# if indicated, and not in raw mode.
+
+procedure zgettt (fd, buf, maxch, status)
+
+int	fd			# input file
+char	buf[ARB]		# output buffer
+int	maxch			# max chars out
+int	status			# actual chars out
+
+pointer	sp, logbuf
+int	nchars, ch, i
+int	ztt_lowercase(), ztt_query(), gstrcpy(), and()
+include	"zfiott.com"
+define	nextline_ 91
+define	again_ 92
+
+begin
+	# Set raw mode if reading a single character.
+	if (maxch == 1)
+	    tty_rawmode = true
+
+	if (tty_playback && !tty_passthru) {
+	    # Read from the command input spoolfile.
+
+	    if (tty_inbuf[tty_ip] == EOS) {
+		call smark (sp)
+		call salloc (logbuf, SZ_LOGLINE, TY_CHAR)
+nextline_
+		call ztt_getlog (tty_pbinchan, Memc[logbuf], SZ_LOGLINE, nchars)
+
+		if (nchars == 1 && Memc[logbuf] == EOFCHAR) {
+		    call ztt_ttyput ("[EOF]\n")
+		    status = 0
+
+		} else if (nchars > 0) {
+		    # Process any \{ ... \} sequences in the line from the
+		    # logfile, leave 'status' chars of data text in tty_inbuf.
+
+		    if (ztt_query (Memc[logbuf], nchars,
+			tty_inbuf, SZ_LINE, status) == QUIT) {
+
+			# User commands us to quit.
+			tty_inbuf[1] = EOS
+			tty_ip = 1
+			status = 0
+
+		    } else {
+			# Copy data text to tty_inbuf.
+			tty_inbuf[status+1] = EOS
+			status = gstrcpy (tty_inbuf, buf, maxch)
+			tty_ip = status + 1
+
+			# If there was no data on the line but we get here,
+			# then the line must have been all control directive,
+			# so go fetch another line from the logfile.
+
+			if (status == 0)
+			    goto nextline_
+		    }
+		} else
+		    status = nchars
+
+		call sfree (sp)
+
+	    } else {
+		status = gstrcpy (tty_inbuf[tty_ip], buf, maxch)
+		tty_ip = tty_ip + status
+		if (!tty_verify || tty_rawmode)
+		    call zwmsec (tty_delay)
+	    }
+
+	    # Terminate playback if there is the read returns zero chars,
+	    # unless this was due to a programmed EOF in the data stream.
+
+	    if (status <= 0 && Memc[logbuf] != EOFCHAR) {
+		call ztt_playback (NO)
+		call ztt_ttyput ("[playback mode terminated]\n")
+		buf[1] = '\n'
+		status = 1
+	    }
+
+	} else {
+	    # Read from the terminal.
+again_	    call zgetty (fd, buf, maxch, status)
+
+	    if (status > 0) {
+		# Some terminals set the parity bit, which may not be masked
+		# by the OS terminal driver in raw mode.  Make sure that the
+		# parity bits are cleared.
+
+		if (tty_rawmode)
+		    do i = 1, status {
+			ch = buf[i]
+			buf[i] = and (ch, 177B)
+		    }
+
+		# Filter the input if a filter has been posted and the filter
+		# key is seen as the first character of the input data block.
+		# The filter edits the input buffer and returns the number of
+		# input characters left in the buffer after applying the filter.
+
+		if (tty_filter != 0)
+		    if (buf[1] == tty_filter_key) {
+			call zcall4 (tty_filter, fd, buf, maxch, status)
+			if (status == 0)
+			    goto again_
+		    }
+	    }
+	}
+
+	# Log the input string if input logging is in effect.
+	if (tty_login && !tty_passthru) {
+	    if (status <= 0)
+		call ztt_putlog (tty_inlogchan, "\032", 1)
+	    else
+		call ztt_putlog (tty_inlogchan, buf, status)
+	}
+
+	# If UCASE mode in set and not in raw mode, map the input string to
+	# lower case.
+
+	if ((tty_ucasein || tty_ucaseout) && status > 0)
+	    if (!tty_rawmode && tty_ucasein)
+		status = ztt_lowercase (buf, buf, status)
+end
+
+
+# ZPUTTT -- Put "nchars" characters into the text file "fd".  Map the output
+# to upper case if so indicated.  Watch for the RAWOFF control string, used
+# to turn raw mode off.
+
+procedure zputtt (fd, buf, nchars, status)
+
+int	fd			# file to be written to
+char	buf[ARB]		# data to be output
+int	nchars			# nchars to write to file
+int	status			# return status
+
+int	ch
+pointer	sp, obuf
+bool	ctrlstr
+int	strncmp()
+include	"zfiott.com"
+define	noucase_ 91
+
+begin
+	# Do not map the raw-mode-off control sequence to upper case.
+	ctrlstr = false
+	if (tty_rawmode)
+	    if (nchars == LEN_RAWCMD && buf[1] == ESC)
+		if (strncmp (buf, RAWOFF, LEN_RAWCMD) == 0) {
+		    ctrlstr = true
+		    tty_rawmode = false
+		} else if (strncmp (buf, RAWON, LEN_RAWCMD) == 0) {
+		    ctrlstr = true
+		    tty_rawmode = true
+		}
+
+	if (tty_ucaseout) {
+	    # If not control string and raw mode is not in effect, map the
+	    # string to upper case and output it.  Do not map escape or control
+	    # sequences, i.e., any string which begins with a control character.
+
+	    if (!ctrlstr && !tty_rawmode) {
+		ch = buf[1]
+		if (ch < BLANK)
+		    if (ch != HT && ch != LF && ch != FF && ch != CR)
+			goto noucase_
+
+		call smark (sp)
+		call salloc (obuf, SZ_LINE, TY_CHAR)
+
+		call ztt_uppercase (buf, Memc[obuf], nchars)
+		call zputty (fd, Memc[obuf], nchars, status)
+
+		if (tty_logout && !tty_passthru)
+		    call ztt_putlog (tty_outlogchan, Memc[obuf], nchars)
+
+		call sfree (sp)
+		return
+	    }
+	}
+noucase_
+	call zputty (fd, buf, nchars, status)
+	if (tty_logout && !tty_passthru)
+	    call ztt_putlog (tty_outlogchan, buf, nchars)
+end
+
+
+# ZTT_LOGIO -- Enable or disable logging of terminal i/o in a file.  Logging
+# is used for debug purposes but may also be used to keep a complete record
+# of a terminal session.
+
+procedure ztt_logio (inflag, outflag)
+
+int	inflag			# log input stream (YES|NO|DONTCARE)
+int	outflag			# log output stream (YES|NO|DONTCARE)
+
+int	status
+pointer	sp, osfn, fname
+string	openerr "cannot open file "
+include	"zfiott.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	# Enable/disable logging of the input stream.
+	if (inflag == YES) {
+	    if (tty_login) {
+		call zclstx (tty_inlogchan, status)
+		tty_inlogchan = NULL
+		tty_login = false
+	    }
+
+	    if (tty_logio)
+		call strcpy (tty_iofile, Memc[fname], SZ_PATHNAME)
+	    else
+		call strcpy (tty_infile, Memc[fname], SZ_PATHNAME)
+
+	    ifnoerr (call fmapfn (Memc[fname], Memc[osfn], SZ_PATHNAME)) {
+		call zopntx (Memc[osfn], APPEND, tty_inlogchan)
+		tty_login = (tty_inlogchan != ERR)
+	    }
+
+	    if (tty_login)
+		call ztt_logdev (tty_inlogchan)
+	    else {
+		call ztt_ttyput (openerr)
+		call ztt_ttyput (Memc[fname])
+		call ztt_ttyput ("\n")
+	    }
+
+	} else if (inflag == NO && tty_login) {
+	    call zclstx (tty_inlogchan, status)
+	    tty_inlogchan = NULL
+	    tty_login = false
+	    if (tty_logio) {
+		tty_logout = false
+		tty_logio = false
+	    }
+	}
+
+	# If LOGIO mode is in effect, set the output logfile to the same
+	# as the input logfile, otherwise open the output logfile.
+
+	if (tty_logio && tty_login) {
+	    tty_logout = true
+	    tty_outlogchan = tty_inlogchan
+
+	} else if (outflag == YES) {
+	    if (tty_logout) {
+		call zclstx (tty_outlogchan, status)
+		tty_outlogchan = NULL
+		tty_logout = false
+	    }
+
+	    ifnoerr (call fmapfn (tty_outfile, Memc[osfn], SZ_PATHNAME)) {
+		call zopntx (Memc[osfn], APPEND, tty_outlogchan)
+		tty_logout = (tty_outlogchan != ERR)
+	    }
+
+	    if (tty_logout)
+		call ztt_logdev (tty_outlogchan)
+	    else {
+		call ztt_ttyput (openerr)
+		call ztt_ttyput (tty_outfile)
+		call ztt_ttyput ("\n")
+	    }
+
+	} else if (outflag == NO && tty_logout) {
+	    call zclstx (tty_outlogchan, status)
+	    tty_outlogchan = NULL
+	    tty_logout = false
+	}
+	 
+	call sfree (sp)
+end
+
+
+# ZTT_PLAYBACK -- Enable or disable playback mode.  When playback mode is
+# in effect command input is redirected to a tty logfile rather than to the
+# terminal.  Successive commands are read from the logfile and echoed on
+# the terminal.  If `verify' mode playback is enabled the user must then
+# tap the space bar or CR to continue, at which time the line of text is
+# returned to the calling program.  Playback mode terminates when EOF is
+# seen on the input file, or when the user types `q' in response to the
+# verify query.
+
+procedure ztt_playback (flag)
+
+int	flag			# YES to enable playback, NO to disable
+
+int	status
+pointer	sp, osfn
+extern	ztt_pboff()
+string	openerr "cannot open file "
+include	"zfiott.com"
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	if (flag == YES) {
+	    # If we try to turn on playback mode while in login mode, log
+	    # the command but do not interrupt login mode or try to reopen
+	    # the ttyin.log file.  The logged `stty playback' command will
+	    # cause a (possibly infinite) loop when the logfile is later
+	    # played back.
+
+	    if (tty_login) {
+		call ztt_ttyput ("[command logged but not executed]\n")
+		call sfree (sp)
+		return
+	    }
+
+	    # Clear playback mode if already in effect.
+	    if (tty_playback) {
+		call zclstx (tty_pbinchan, status)
+		tty_pbinchan = NULL
+		tty_playback = false
+	    }
+
+	    # Open login file.
+	    ifnoerr (call fmapfn (tty_pbfile, Memc[osfn], SZ_PATHNAME)) {
+		call zopntx (Memc[osfn], READ_ONLY, tty_pbinchan)
+		tty_playback = (tty_pbinchan != ERR)
+	    }
+
+	    # Setup to clear playback mode if error occurs during playback.
+	    if (tty_playback) {
+		call onerror (ztt_pboff)
+		tty_tdevice[1] = EOS
+		tty_gdevice[1] = EOS
+	    } else {
+		call ztt_ttyput (openerr)
+		call ztt_ttyput (tty_pbfile)
+		call ztt_ttyput ("\n")
+	    }
+
+	} else if (flag == NO && tty_playback) {
+	    # Clear playback mode.
+
+	    call zclstx (tty_pbinchan, status)
+	    tty_pbinchan = NULL
+	    tty_playback = false
+	}
+
+	call sfree (sp)
+end
+
+
+# ZTT_PBOFF -- Called during error recovery to disable playback mode.
+
+procedure ztt_pboff (errcode)
+
+int	errcode			# error status
+
+int	status
+include	"zfiott.com"
+
+begin
+	if (errcode != OK && tty_playback) {
+	    call zclstx (tty_pbinchan, status)
+	    tty_pbinchan = NULL
+	    tty_playback = false
+	    tty_rawmode  = false
+	    tty_passthru = false
+	}
+end
+
+
+# ZTT_LOGDEV -- Record the names of the terminal and stdgraph devices in a
+# logfile.  The format ("\X=devname\n") MUST agree with that in ztt_getlog.
+# Also timestamp the logfile.
+
+procedure ztt_logdev (chan)
+
+int	chan			# output file
+
+int	status
+pointer	sp, obuf, devname
+int	envfind(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (obuf, SZ_LINE, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Timestamp the new entry in the logfile.
+	call strcpy ("\O=", Memc[obuf], SZ_LINE)
+	call sysid (Memc[obuf+3], SZ_LINE-3)
+	call strcat ("\n", Memc[obuf], SZ_LINE)
+	call zputtx (chan, Memc[obuf], strlen(Memc[obuf]), status)
+
+	if (envfind ("terminal", Memc[devname], SZ_FNAME) > 0) {
+	    call strcpy ("\T=", Memc[obuf], SZ_LINE)
+	    call strcat (Memc[devname], Memc[obuf], SZ_LINE)
+	    call strcat ("\n", Memc[obuf], SZ_LINE)
+	    call zputtx (chan, Memc[obuf], strlen(Memc[obuf]), status)
+	}
+	if (envfind ("stdgraph", Memc[devname], SZ_FNAME) > 0) {
+	    call strcpy ("\G=", Memc[obuf], SZ_LINE)
+	    call strcat (Memc[devname], Memc[obuf], SZ_LINE)
+	    call strcat ("\n", Memc[obuf], SZ_LINE)
+	    call zputtx (chan, Memc[obuf], strlen(Memc[obuf]), status)
+	}
+
+	call sfree (sp)
+end
+
+
+# ZTT_PUTLOG -- Put a message to the logfile.  All characters in the data
+# string are rendered into printable form.  Long lines are broken and the
+# output is followed by a newline.
+
+procedure ztt_putlog (chan, dstr, nchars)
+
+int	chan			# kernel i/o channel
+char	dstr[ARB]		# data string
+int	nchars			# length of data string (0 if EOS delimited)
+
+char	cch
+pointer	sp, obuf, op
+int	status, ip, ch, n
+int	strlen(), ctocc()
+define	output {Memc[op]=($1);op=op+1}
+include	"zfiott.com"
+
+begin
+	# It is harmless to call us if logging is disabled.
+	if (!tty_login && !tty_logout)
+	    return
+
+	call smark (sp)
+	call salloc (obuf, SZ_LINE, TY_CHAR)
+
+	n = nchars
+	if (n <= 0)
+	    n = strlen (dstr)
+
+	# Output the data string, rendering all characters into printable form.
+	# Break long lines.  The characters \ and ^ must be escaped since they
+	# are logfile metacharacters.  Data spaces are output as \s since
+	# whitespace in the logfile is ignored.
+
+	op = obuf
+	do ip = 1, n {
+	    ch = dstr[ip]
+	    if (ch == ' ') {
+		output ('\\')
+		output ('s')
+	    } else if (ch == '^' || ch == '\\') {
+		output ('\\')
+		output (ch)
+	    } else if (IS_PRINT (ch)) {
+		output (ch)
+	    } else if (ch == NUL) {
+		output ('^')
+		output ('@')
+	    } else {
+		cch = ch
+		op = op + ctocc (cch, Memc[op], 5)
+	    }
+
+	    if (op - obuf >= RMARGIN && ip+1 < n) {
+		output ('\\')
+		output ('\n')
+		call zputtx (chan, Memc[obuf], op-obuf, status)
+		for (op=obuf;  op < obuf+4;  op=op+1)
+		    Memc[op] = ' '
+	    }
+	}
+
+	# Terminate and output the line.
+	if (op > obuf) {
+	    output ('\n')
+	    call zputtx (chan, Memc[obuf], op-obuf, status)
+	    call zflstx (chan, status)
+	}
+
+	call sfree (sp)
+end
+
+
+# ZTT_GETLOG -- Read text from a logfile written by ztt_putlog.  All control
+# codes and spaces are rendered into escape sequences; newline marks the end
+# of each record and an escaped newline followed by leading whitespace on a
+# line indicates continuation.  Blank lines in the logfile equate to null
+# length records and are ignored.
+
+procedure ztt_getlog (chan, obuf, maxch, nchars)
+
+int	chan			# kernel input channel (text file)
+char	obuf[maxch]		# output buffer
+int	maxch			# max chars to return
+int	nchars			# nchars returned or EOF
+
+bool	incom
+int	lastch, ch, op, o
+char	cch, cc[4], devname[SZ_DEVNAME]
+int	ztt_getchar(), cctoc()
+include	"zfiott.com"
+
+begin
+	# Process characters and escape sequence encoded characters from
+	# the logfile until either maxch character have been output or an
+	# unescaped newline is seen.  Ignore empty lines.  Text enclosed
+	# in \{ ... \} (comment text) is returned without change.
+
+	incom = false
+	ch = NULL
+
+	for (op=1;  op <= 1 && ch != EOF;  ) {
+	    while (op <= maxch) {
+		# Get the next character (not efficient, but doesn't matter
+		# since this is only called in `stty playback' mode).
+
+		if (ztt_getchar (chan, ch) == EOF) {
+		    break
+		} else if (IS_WHITE (ch) && !incom) {
+		    next
+		} else if (ch == '\n' && !incom) {
+		    break
+
+		} else if (ch == '^') {
+		    # Map a control code, e.g., ^[.
+		    if (ztt_getchar (chan, ch) == EOF)
+			break
+		    ch = mod (ch, 40B)
+
+		} else if (ch == '\\') {
+		    # Map an escape sequence, e.g., \n, \r, \^, \040, etc.
+		    if (ztt_getchar (chan, ch) == EOF)
+			break
+
+		    switch (ch) {
+		    case '\n':
+			next
+		    case 's':
+			ch = ' '
+			# output ch, below
+
+		    case BEGINCOM, ENDCOM:
+			# Copy a \{ ... \} logfile comment (to be echoed but
+			# not returned as data).
+
+			obuf[op] = '\\'
+			op = op + 1
+			obuf[op] = ch
+			op = op + 1
+
+			incom = (ch == BEGINCOM)
+			next
+
+		    case 'T', 'G', 'O', '#':
+			# Recall a terminal or stdgraph device name from the
+			# logfile (device used when logfile was written).
+			# The format must be "\X=devname\n".  \O is the
+			# timestamp string, which we simply read and discard.
+			# \# is for logfile comments.
+
+			lastch = ch
+			o = 1
+			repeat {
+			    if (ztt_getchar (chan, ch) == EOF)
+				break
+			    else if (ch == '\n')
+				break
+			    else {
+				devname[o] = ch
+				o = min (SZ_DEVNAME, o + 1)
+			    }
+			}
+			devname[o] = EOS
+
+			if (lastch == 'T')
+			    call strcpy (devname[2], tty_tdevice, SZ_DEVNAME)
+			else if (lastch == 'G')
+			    call strcpy (devname[2], tty_gdevice, SZ_DEVNAME)
+			next
+
+		    case '^', '\\':
+			# output ch, below
+
+		    default:
+			cc[1] = '\\'
+			cc[2] = ch
+			if (IS_DIGIT (ch)) {
+			    for (o=3;  o <= 4;  o=o+1)
+				if (ztt_getchar (chan, ch) == EOF)
+				    break
+				else
+				    cc[o] = ch
+			    cc[o] = EOS
+			} else
+			    cc[3] = EOS
+			o = 1;  o = cctoc (cc, o, cch)
+			ch = cch
+			# output ch, below
+		    }
+		}
+
+		obuf[op] = ch
+		op = op + 1
+	    }
+	}
+
+	nchars = op - 1
+end
+
+
+# ZTT_QUERY -- Called in playback mode to echo a line of logfile input text to
+# the terminal and wait for the user to tap the CONTINUE key to continue.
+# If the response is QUIT playback mode is terminated and input is restored
+# to the terminal.  If the response is GO verify mode is disabled for the
+# remainder of the playback session.  It would be easy for us to allow the
+# user to edit the command line rather than just accept it, but this could too
+# easily cause loss of sync with the input logfile, hence is not allowed.
+# Echoing and verify are disabled if raw mode is in effect.
+
+int procedure ztt_query (logtext, nchars, dtext, maxch, sz_dtext)
+
+char	logtext[ARB]		# line of text from logfile
+int	nchars			# nchars in logfile text
+char	dtext[maxch]		# line of text to be returned from zgettt
+int	maxch			# max chars returned
+int	sz_dtext		# actual chars returned
+
+char	text[1]
+pointer	sp, etext, ep
+bool	learn, incom, verify, format_control
+int	status, delay, ip_save, ip, op, ch, n
+
+int	ctoi()
+include	"zfiott.com"
+define	done_ 91
+define	deposit_ 92
+
+begin
+	call smark (sp)
+	call salloc (etext, SZ_LINE, TY_CHAR)
+
+	# The logfile line may contain embedded sequences of text which are
+	# to be echoed to the terminal, but which are not to be returned as
+	# data to the calling program.  This comment or explanatory text is
+	# enclosed in braces as "\{ ... \}".  Control over the verify/delay
+	# parameters may be specified for the command block by modifying
+	# the opening sequence, i.e., "\{%V+ ..." sets verify mode for the
+	# block, "\{%V-" disables verify mode, and "\{%NNNN sets the delay
+	# to NNNN msec.  A leading !, e.g., "%!V+" causes the change to be
+	# "learned", i.e., the control parameter is permanently changed.
+
+	verify = (tty_verify && !tty_rawmode)
+	delay  = tty_delay
+	incom  = false
+	ep     = etext
+	op     = 1
+
+	# Process the logfile text into the text to be echoed and the data
+	# (obuf) text to be returned to the calling program.
+
+	format_control = false
+	for (ip=1;  ip <= nchars;  ) {
+	    if (logtext[ip] == '\\') {
+		if (ip < nchars && logtext[ip+1] == BEGINCOM) {
+		    # Begin comment section.
+		    ip = ip + 2
+		    incom = true
+
+		    # Check for the verify/delay overrides.
+		    while (logtext[ip] == '%') {
+			ip_save = ip
+			ip = ip + 1
+
+			# If !V+ or !delay, learn new value.
+			learn = (logtext[ip] == '!')
+			if (learn)
+			    ip = ip + 1
+
+			if (logtext[ip] == 'V') {
+			    ip = ip + 1
+			    if (logtext[ip] == '+') {
+				verify = true
+				if (learn)
+				    tty_verify = true
+				ip = ip + 1
+			    } else if (logtext[ip] == '-') {
+				verify = false
+				if (learn)
+				    tty_verify = false
+				ip = ip + 1
+			    } else
+				ip = ip_save
+			} else if (IS_DIGIT (logtext[ip])) {
+			    if (ctoi (logtext, ip, delay) <= 0) {
+				delay = tty_delay
+				ip = ip_save
+			    } else if (learn)
+				tty_delay = delay
+			}
+
+			if (ip > ip_save)
+			    format_control = true
+			else
+			    break
+		    }
+
+		} else if (incom && ip < nchars && logtext[ip+1] == ENDCOM) {
+		    # End comment section.
+		    ip = ip + 2
+		    incom = false
+		} else
+		    goto deposit_
+
+	    } else {
+deposit_	# Do not include the trailing data-newline in the echo text.
+		if (incom || (!tty_rawmode && logtext[ip] != '\n'))  {
+		    Memc[ep] = logtext[ip]
+		    ep = ep + 1
+		}
+		if (logtext[ip] == '\n' && ip < nchars) {
+		    if (ep > etext) {
+			n = ep - etext
+			call zputty (tty_koutchan, Memc[etext], ep-etext, n)
+			call zflsty (tty_koutchan, status)
+		    }
+		    ep = etext
+		}
+		if (!incom) {
+		    op = min (maxch, op)
+		    dtext[op] = logtext[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+	    }
+	}
+
+	# Don't need to add EOS for counted kernel i/o strings.
+	sz_dtext = op - 1
+
+	# Output any remaining echo text.
+	if (ep > etext) {
+	    n = ep - etext
+	    call zputty (tty_koutchan, Memc[etext], n, status)
+	    call zflsty (tty_koutchan, status)
+	    ep = etext
+	}
+
+	# Do not verify or delay for blank lines with no format control.
+	if (!format_control && sz_dtext == 1 && dtext[1] == '\n') {
+	    ch = NULL
+	    goto done_
+	}
+
+	# If verify is disabled, return after the specified delay.
+	if (!verify) {
+	    call zwmsec (delay)
+	    ch = NULL
+	    goto done_
+	}
+
+	# If verify is enabled, wait for user response.  Note that the 1
+	# char read leaves the terminal in raw mode.
+
+	repeat {
+	    call zgetty (tty_kinchan, text, 1, status)
+	    if (status > 0)
+		ch = text[1]
+	    else 
+		ch = EOF
+
+	    if (ch == EOF || ch == INTCHAR || ch == QUIT) {
+		call ztt_playback (NO)
+		ch = QUIT
+		break
+	    } else if (ch == GO) {
+		tty_verify = false
+		break
+	    } else if (ch == CONTINUE || ch == CONTINUE_ALT) {
+		break
+	    } else {
+		# Ignore other characters.
+		call ztt_ttyput (HELP)
+	    }
+	} 
+
+	# Restore terminal to line mode, if raw mode was not already in
+	# effect before our query.
+
+	if (!tty_rawmode)
+	    call ztt_ttyput (RAWOFF)
+
+done_
+	if (dtext[sz_dtext] == '\n')
+	    call ztt_ttyput ("\n")
+
+	call sfree (sp)
+	return (ch)
+end
+
+
+# ZTT_GETCHAR -- Get a character from a channel.
+
+int procedure ztt_getchar (chan, ch)
+
+int	chan			# input channel
+int	ch			# receives character
+
+char	text[1]
+int	status
+
+begin
+	call zgettx (chan, text, 1, status)
+	if (status <= 0) {
+	    ch = EOF
+	    return (EOF)
+	} else {
+	    ch = text[1]
+	    return (ch)
+	}
+end
+
+
+# ZTT_LOWERCASE -- Map a character string input in upper case to lower case.
+# Control sequences may be embedded in the sequence to artifically generate
+# upper case characters.
+#
+#	^	shift up next character
+#	^+	shift lock (stay in upper case)
+#	^-	clear shift lock
+#	^^	a single ^
+#
+# The case shift control sequences are shown above.  These are not recognized
+# when the terminal is in raw mode.
+
+int procedure ztt_lowercase (in, out, nchars)
+
+char	in[ARB]			# input string
+char	out[ARB]		# output string
+int	nchars			# input string length
+
+int	ch
+int	ip, op
+include	"zfiott.com"
+
+begin
+	op = 1
+	for (ip=1;  ip <= nchars;  ip=ip+1) {
+	    ch = in[ip]
+
+	    if (ch == CTRLCHAR) {
+		ch = in[ip+1]
+		ip = ip + 1
+
+		switch (ch) {
+		case CTRLCHAR:
+		    out[op] = ch
+		    op = op + 1
+		case SHIFTLOCK:
+		    tty_shiftlock = true
+		case SHIFTOFF:
+		    tty_shiftlock = false
+		default:
+		    if (IS_LOWER (ch))
+			ch = TO_UPPER (ch)
+		    out[op] = ch
+		    op = op + 1
+		}
+	    } else if (tty_shiftlock) {
+		if (IS_LOWER (ch))
+		    ch = TO_UPPER (ch)
+		out[op] = ch
+		op = op + 1
+	    } else {
+		if (IS_UPPER (ch))
+		    ch = TO_LOWER (ch)
+		out[op] = ch
+		op = op + 1
+	    }
+	}
+
+	return (op - 1)
+end
+
+
+# ZTT_UPPERCASE -- Convert a string to upper case.
+
+procedure ztt_uppercase (in, out, nchars)
+
+char	in[ARB]			# input string
+char	out[ARB]		# output string
+int	nchars			# string length
+
+int	ch, i
+
+begin
+	do i = 1, nchars {
+	    ch = in[i]
+	    if (IS_LOWER (ch))
+		ch = TO_UPPER (ch)
+	    out[i] = ch
+	}
+end
+
+
+# ZTT_TTYPUT -- Write directly to the user terminal.
+
+procedure ztt_ttyput (message)
+
+char	message[ARB]		# message string
+
+int	status
+int	stridxs(), strlen()
+include	"zfiott.com"
+
+begin
+	call zputty (tty_koutchan, message, strlen(message), status)
+	if (stridxs ("\n", message) > 0)
+	    call zflsty (tty_koutchan, status)
+end
+
+
+# ZSETTT -- Set TT terminal driver options.  Must be called before any i/o is
+# done via the TT driver, e.g., by fio$finit.
+
+procedure zsettt (chan, param, value)
+
+int	chan			# kernel i/o channel (not used)
+int	param			# parameter to be set
+int	value			# new value
+
+bool	itob()
+bool	first_time
+data	first_time /true/
+include	"zfiott.com"
+
+begin
+	switch (param) {
+	case TT_INITIALIZE:
+	    if (!first_time) {
+		# Close any open log files.
+		call ztt_playback (NO)
+		call ztt_logio (NO, NO)
+	    }
+
+	    tty_inlogchan  = NULL
+	    tty_outlogchan = NULL
+	    tty_pbinchan   = NULL
+	    tty_ucasein    = false
+	    tty_ucaseout   = false
+	    tty_shiftlock  = false
+	    tty_rawmode    = false
+	    tty_logio      = false
+	    tty_login      = false
+	    tty_logout     = false
+	    tty_playback   = false
+	    tty_verify     = false
+	    tty_passthru   = false
+	    tty_delay      = PBDELAY
+	    tty_filter     = NULL
+	    tty_filter_key = 0
+
+	    call strcpy (IOFILE,  tty_iofile,  SZ_FNAME)
+	    call strcpy (INFILE,  tty_infile,  SZ_FNAME)
+	    call strcpy (OUTFILE, tty_outfile, SZ_FNAME)
+	    call strcpy (PBFILE,  tty_pbfile,  SZ_FNAME)
+
+	    tty_tdevice[1] = EOS
+	    tty_gdevice[1] = EOS
+	    tty_inbuf[1] = EOS
+	    tty_ip = 1
+
+	    first_time = false
+
+	case TT_KINCHAN:
+	    tty_kinchan = value
+	case TT_KOUTCHAN:
+	    tty_koutchan = value
+	case TT_LOGINCHAN:
+	    tty_inlogchan = value
+	case TT_LOGOUTCHAN:
+	    tty_outlogchan = value
+	case TT_PBINCHAN:
+	    tty_pbinchan = value
+	case TT_SHIFTLOCK:
+	    tty_shiftlock = itob (value)
+	case TT_RAWMODE:
+	    tty_rawmode = itob (value)
+
+	case TT_UCASEIN:
+	    tty_ucasein = itob (value)
+	case TT_UCASEOUT:
+	    tty_ucaseout = itob (value)
+
+	case TT_LOGIO:
+	    tty_logio = true
+	    call ztt_logio (value, value)
+	case TT_LOGIN:
+	    tty_logio = false
+	    call ztt_logio (value, DONTCARE)
+	case TT_LOGOUT:
+	    tty_logio = false
+	    call ztt_logio (DONTCARE, value)
+	case TT_PASSTHRU:
+	    tty_passthru = itob (value)
+
+	case TT_PLAYBACK:
+	    call ztt_playback (value)
+	case TT_PBVERIFY:
+	    tty_verify = itob (value)
+	case TT_PBDELAY:
+	    tty_delay = value
+
+	case TT_FILTER:
+	    tty_filter = value
+	case TT_FILTERKEY:
+	    tty_filter_key = value
+
+	default:
+	    # (ignore)
+	}
+end
+
+
+# ZSTTTT -- Stat TT terminal driver options.  Check for the special TT params,
+# else pass the request to the hardware driver.
+
+procedure zstttt (fd, param, lvalue)
+
+int	fd			# file number (not used)
+int	param			# parameter to be set
+long	lvalue			# new value
+
+int	btoi()
+include	"zfiott.com"
+
+begin
+	switch (param) {
+	case TT_KINCHAN:
+	    lvalue = tty_kinchan
+	case TT_KOUTCHAN:
+	    lvalue = tty_koutchan
+	case TT_LOGINCHAN:
+	    lvalue = tty_inlogchan
+	case TT_LOGOUTCHAN:
+	    lvalue = tty_outlogchan
+	case TT_PBINCHAN:
+	    lvalue = tty_pbinchan
+	case TT_UCASEIN:
+	    lvalue = btoi (tty_ucasein)
+	case TT_UCASEOUT:
+	    lvalue = btoi (tty_ucaseout)
+	case TT_SHIFTLOCK:
+	    lvalue = btoi (tty_shiftlock)
+	case TT_RAWMODE:
+	    lvalue = btoi (tty_rawmode)
+	case TT_LOGIO:
+	    lvalue = btoi (tty_logio)
+	case TT_LOGIN:
+	    lvalue = btoi (tty_login)
+	case TT_LOGOUT:
+	    lvalue = btoi (tty_logout)
+	case TT_PASSTHRU:
+	    lvalue = btoi (tty_passthru)
+	case TT_PLAYBACK:
+	    lvalue = btoi (tty_playback)
+	case TT_PBVERIFY:
+	    lvalue = btoi (tty_verify)
+	case TT_PBDELAY:
+	    lvalue = tty_delay
+	case TT_FILTER:
+	    lvalue = tty_filter
+	case TT_FILTERKEY:
+	    lvalue = tty_filter_key
+	default:
+	    call zsttty (fd, param, lvalue)
+	}
+end
+
+
+# ZSESTT -- Set a TT terminal driver string valued option.
+
+procedure zsestt (fd, param, svalue)
+
+int	fd			# file number (not used)
+int	param			# parameter to be set
+char	svalue[ARB]		# new value
+
+include	"zfiott.com"
+
+begin
+	switch (param) {
+	case TT_IOFILE:
+	    call strcpy (svalue, tty_iofile, SZ_FNAME)
+	case TT_INFILE:
+	    call strcpy (svalue, tty_infile, SZ_FNAME)
+	case TT_OUTFILE:
+	    call strcpy (svalue, tty_outfile, SZ_FNAME)
+	case TT_PBFILE:
+	    call strcpy (svalue, tty_pbfile, SZ_FNAME)
+	case TT_TDEVICE:
+	    call strcpy (svalue, tty_tdevice, SZ_DEVNAME)
+	case TT_GDEVICE:
+	    call strcpy (svalue, tty_gdevice, SZ_DEVNAME)
+	default:
+	    # (ignore)
+	}
+end
+
+
+# ZSTSTT -- Stat TT terminal driver string valued option.
+
+procedure zststt (fd, param, outstr, maxch, nchars)
+
+int	fd			# file number (not used)
+int	param			# parameter to be set
+char	outstr[maxch]		# string value
+int	maxch			# max chars out
+int	nchars			# len (outstr)
+
+int	gstrcpy()
+include	"zfiott.com"
+
+begin
+	switch (param) {
+	case TT_IOFILE:
+	    nchars = gstrcpy (tty_iofile, outstr, maxch)
+	case TT_INFILE:
+	    nchars = gstrcpy (tty_infile, outstr, maxch)
+	case TT_OUTFILE:
+	    nchars = gstrcpy (tty_outfile, outstr, maxch)
+	case TT_PBFILE:
+	    nchars = gstrcpy (tty_pbfile, outstr, maxch)
+	case TT_TDEVICE:
+	    nchars = gstrcpy (tty_tdevice, outstr, maxch)
+	case TT_GDEVICE:
+	    nchars = gstrcpy (tty_gdevice, outstr, maxch)
+	default:
+	    nchars = 0
+	}
+end
+
+
+# The following functions are straight pass throughs to the hardware
+# driver for this device.
+# --------------------------
+
+# ZOPNTT -- Open a terminal.
+
+procedure zopntt (osfn, mode, chan)
+
+char	osfn[ARB]		# UNIX filename
+int	mode			# file access mode
+int	chan			# UNIX channel of file (output)
+
+begin
+	call zopnty (osfn, mode, chan)
+end
+
+
+# ZCLSTT -- Close a terminal.
+
+procedure zclstt (fd, status)
+
+int	fd			# channel
+int	status			# return status
+
+begin
+	call zclsty (fd, status)
+end
+
+
+# ZFLSTT -- Flush any buffered terminal output.
+
+procedure zflstt (fd, status)
+
+int	fd			# channel
+int	status			# return status
+
+begin
+	call zflsty (fd, status)
+end
+
+
+# ZSEKTT -- Seek on a text file to the character offset given by a prior
+# call to ZNOTTT.  This offset should always refer to the beginning of a line.
+# (not used for terminals).
+
+procedure zsektt (fd, offset, status)
+
+int	fd			# channel
+long	offset			# new offset
+int	status			# return status
+
+begin
+	call zsekty (fd, offset, status)
+end
+
+
+# ZNOTTT -- Return the seek offset of the beginning of the current line
+# of text (not used for terminals).
+
+procedure znottt (fd, offset)
+
+int	fd			# channel
+long	offset			# file offset
+
+begin
+	call znotty (fd, offset)
+end
diff --git a/sys/fio/zzdebug.x b/sys/fio/zzdebug.x
new file mode 100644
index 00000000..1e7179fc
--- /dev/null
+++ b/sys/fio/zzdebug.x
@@ -0,0 +1,625 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+include	<fset.h>
+include	<finfo.h>
+include	<fio.h>
+
+
+# ZZDEBUG -- Debug tasks for the FIO (file i/o) interface.
+
+task	mpp	= t_mpp,
+	unget	= t_unget,
+	pbb	= t_pbb,
+	fnl	= t_fnl,
+	txo	= t_txo,
+	bfap	= t_bfappend,
+	spool	= t_spool,
+	many	= t_many,
+	server	= t_server,
+	client	= t_client,
+	oserver	= t_old_server,
+	oclient	= t_old_client,
+	daytime = t_daytime,
+	http	= t_http,
+	utime	= t_utime,
+	symlink	= t_symlink,
+	unlink	= t_unlink
+
+
+define 	SZ_BUF		2048
+
+
+# MPP -- Test macro pushback.
+
+procedure t_mpp()
+
+int	fd
+char	ch
+char	getc()
+
+begin
+	fd = STDIN
+
+	while (getc (fd, ch) != EOF) {
+	    if (ch == '%') {
+		ch = '$'
+		call ungetc (fd, ch)
+	    } else if (ch == '\n') {
+		call putchar (ch)
+		call flush (STDOUT)
+	    } else if (ch == '^') {
+		call ungetline (fd, "carat")
+	    } else if (ch == '&') {
+		call ungetline (fd, "amper%sand")
+	    } else
+		call putchar (ch)
+	}
+end
+
+
+# UNGET-- Test ungetline.
+
+procedure t_unget()
+
+char	lbuf[SZ_LINE]
+int	getline()
+
+begin
+	while (getline (STDIN, lbuf) != EOF) {
+	    if (lbuf[1] == '.') {
+		call ungetline (STDIN, lbuf[2])
+		call ungetline (STDIN, "pbb\n")
+	    } else {
+		call putline (STDOUT, lbuf)
+		call flush (STDOUT)
+	    }
+	    call fdebug (STDOUT, STDIN, STDIN)
+	}
+end
+
+
+# PBB -- Test multilevel pushback.
+
+procedure t_pbb()
+
+char	lbuf[SZ_LINE]
+int	fd
+int	getline()
+include	<fio.com>
+
+begin
+	fd = STDIN
+	fp = fiodes[fd]
+
+	call fdebug (STDERR, fd, fd)
+	call ungetline (fd, "aaa\n")
+	call fdebug (STDERR, fd, fd)
+	call ungetline (fd, "bbb\n")
+	call fdebug (STDERR, fd, fd)
+	call ungetline (fd, "ccc\n")
+	call fdebug (STDERR, fd, fd)
+	call ungetline (fd, "ddd\n")
+	call fdebug (STDERR, fd, fd)
+
+	call eprintf ("pbb='%s'\n\n"); call pargstr (FPBBUF(fp))
+
+	while (getline (fd, lbuf) != EOF) {
+	    call putline (STDERR, lbuf)
+	    call fdebug (STDERR, fd, fd)
+	}
+end
+
+
+# FNL -- Test filename template expansion.
+
+procedure t_fnl()
+
+char	fname[SZ_FNAME]
+int	list, clpopns(), clgfil(), clplen()
+
+begin
+	list = clpopns ("files")
+	call printf ("nfiles = %d\n"); call pargi (clplen(list))
+
+	while (clgfil (list, fname, SZ_FNAME) != EOF) {
+	    call printf ("%s\n"); call pargstr (fname)
+	}
+
+	call clpcls (list)
+end
+
+
+# TXO -- Test the mixing of PUTC, PUTLINE, and WRITE calls to a text file.
+
+procedure t_txo()
+
+int	fd, i, j
+int	open()
+
+begin
+	fd = open ("junk", NEW_FILE, TEXT_FILE)
+
+	do i = 1, 5 {
+	    do j = 1, 5
+		call putci (fd, 'a' + i - 1)
+	    call putline (fd, "12345")
+	    call write (fd, "_6789[] ", 8)
+	}
+
+	call close (fd)
+end
+
+
+# BFAP -- Test appending to a binary file.  Should create the file and then
+# add an unpacked line of text in each successive call.
+
+procedure t_bfappend()
+
+int	fd
+int	open(), strlen()
+string	text "1234567890\n"
+
+begin
+	fd = open ("_bf", APPEND, BINARY_FILE)
+	call fdebug (STDERR, fd, fd)
+	call write (fd, text, strlen(text))
+	call fdebug (STDERR, fd, fd)
+	call close (fd)
+end
+
+
+# SPOOL -- Test the spoolfile file type.
+
+procedure t_spool()
+
+int	fd, i, j, n
+int	open(), read()
+
+begin
+	fd = open ("spool", READ_WRITE, SPOOL_FILE)
+	call fdebug (STDERR, fd, fd)
+
+	call eprintf ("write test data\n")
+	do i = 1, 10000
+	    call write (fd, i, SZ_INT)
+
+	call fdebug (STDERR, fd, fd)
+	call eprintf ("rewind file:\n")
+	call seek (fd, BOFL)
+	call fdebug (STDERR, fd, fd)
+
+	call eprintf ("read back test data\n")
+	do i = 1, 10000 {
+	    n = read (fd, j, SZ_INT)
+	    if (n < SZ_INT || i != j) {
+		call eprintf ("read failure at word %d=%d of 10000, stat=%d\n")
+		    call pargi (i)
+		    call pargi (j)
+		    call pargi (n)
+	    }
+	}
+
+	call eprintf ("test successful\n")
+	call close (fd)
+end
+
+
+# MANY -- Test what happens when we try to open too many files.
+
+procedure t_many()
+
+char	fname[SZ_FNAME]
+int	list, nfiles, fd
+int	open(), fntopn(), fntgfn()
+
+begin
+	list = fntopn ("fio$*.x")
+
+	for (nfiles=1;  fntgfn(list,fname,SZ_FNAME) != EOF;  nfiles=nfiles+1) {
+	    fd = open (fname, READ_ONLY, TEXT_FILE)
+	    call eprintf ("%d %s\n")
+		call pargi (nfiles)
+		call pargstr (fname)
+	}
+
+	call fntcls (list)
+end
+
+
+# SERVER -- Simple ND server for testing the network driver.  This server
+# listens on the specified port and waits for a client connection, then
+# returns a status message for every message received from the client,
+# shutting down when the client exits.
+
+procedure t_server()
+
+char	buf[SZ_BUF]
+int	fdi, fdo, nb, i
+int	ndopen(), read(), reopen()
+
+begin
+	do i = 1, 5 {
+	    call printf ("server waiting for connection\n")
+	    fdi = ndopen ("unix:/tmp/nd:text", NEW_FILE)
+	    fdo = reopen (fdi, READ_WRITE)
+
+	    call printf ("fdin = %d  fdout = %d\n")
+		call pargi (fdi) ; call pargi (fdo)
+
+	    call fdebug (STDOUT, fdi, fdo)
+	    call flush (STDOUT)
+
+	    repeat {
+		nb = read (fdi, buf, SZ_BUF)
+		if (nb > 0) {
+		    call fprintf (STDOUT, "read %d bytes from client\n")
+			call pargi (nb)
+		    call flush (STDOUT)
+
+		    call fprintf (fdo, "read %d bytes from client\n")
+			call pargi (nb)
+		    call flush (fdo)
+		}
+	    } until (nb <= 0)
+
+	    call printf ("client has disconnected\n")
+	    call close (fdi)
+	    call close (fdo)
+	}
+end
+
+
+# CLIENT -- Connect to the server on the given port and send a number of
+# test messages, then close the connection and exit.
+
+procedure t_client()
+
+char	buf[SZ_BUF]
+int	fdi, fdo, n, i, msglen
+int	msgsize[8]
+
+int	ndopen(), read(), reopen()
+data	msgsize /64, 128, 256, 134, 781, 3, 19, 1544/
+
+begin
+	fdi = ndopen ("unix:/tmp/nd:text", READ_WRITE)
+	fdo = reopen (fdi, READ_WRITE)
+
+	call printf ("fdin = %d  fdout = %d\n")
+	    call pargi (fdi) ; call pargi (fdo)
+
+	call fdebug (STDOUT, fdi, fdo)
+	call flush (STDOUT)
+
+	for (i=1;  i <= 5;  i=i+1) {
+	    msglen = msgsize[mod(i,8)+1)
+	    call printf ("send %d chars to server\n")
+		call pargi (msglen)
+
+	    call write (fdo, buf, msglen)
+	    call flush (fdo)
+
+	    n = read (fdi, buf, SZ_BUF)
+	    if (n > 0) {
+		buf[n+1] = EOS
+		call printf ("read %d bytes from server\n")
+		    call pargi (n)
+		call printf ("server: %s\n")
+		    call pargstr (buf)
+	    } else {
+		call printf ("server has disconnected\n")
+		break
+	    }
+	    call flush (STDOUT)
+	}
+
+	call close (fdi)
+	call close (fdo)
+end
+
+
+# SERVER -- Simple ND server for testing the network driver.  This server
+# listens on the specified port and waits for a client connection, then
+# returns a status message for every message received from the client,
+# shutting down when the client exits.
+#
+# To test the ND driver, start up two copies of zzdebug.e, one running the
+# server task and the other the client task.  Give the same value of "port"
+# to both, and start the server.  It will pause waiting for a client.  Then
+# start a test sequence in the client setting "nmsg" to the number of
+# messages to be exchanged.  The client will send nmsg messages of various
+# sizes to the server and echo on the stdout the response returned by the
+# server.
+#
+# NOTE - this is the original version, before adding support for "reopen"
+# to have two fully streaming file descriptors per connection.
+
+procedure t_old_server()
+
+char	port[SZ_LINE]
+char	buf[SZ_BUF]
+int	fd, sum, n, maxconn, i
+int	ndopen(), read(), checksum(), clgeti()
+
+begin
+	call clgstr ("port", port, SZ_LINE)
+	maxconn = clgeti ("maxconn")
+	if (maxconn <= 0)
+	    maxconn = 9999
+
+	do i = 1, maxconn {
+	    call printf ("server waiting for connection\n")
+	    fd = ndopen (port, NEW_FILE)
+
+	    repeat {
+		call fseti (fd, F_CANCEL, YES)
+		n = read (fd, buf, SZ_BUF)
+		if (n > 0) {
+		    call fseti (fd, F_CANCEL, YES)
+		    sum = checksum (buf, n)
+		    call fprintf (fd, "read %d bytes from client, sum=%x")
+			call pargi (n)
+			call pargi (sum)
+		    call flush (fd)
+		}
+	    } until (n <= 0)
+
+	    call printf ("client has disconnected\n")
+	    call close (fd)
+	}
+end
+
+
+# CLIENT -- Connect to the server on the given port and send a number of
+# test messages, then close the connection and exit.
+#
+# NOTE - this is the original version, before adding support for "reopen"
+# to have two fully streaming file descriptors per connection.
+
+procedure t_old_client()
+
+char	buf[SZ_BUF]
+char	port[SZ_LINE]
+int	fd, nmsg, n, i, msglen
+int	msgsize[8]
+
+int	ndopen(), read(), clgeti(), checksum()
+data	msgsize /64, 128, 256, 134, 781, 3, 19, 1544/
+
+begin
+	call clgstr ("port", port, SZ_LINE)
+	nmsg = clgeti ("nmsg")
+
+	fd = ndopen (port, READ_WRITE)
+
+	for (i=1;  i <= nmsg;  i=i+1) {
+	    msglen = msgsize[mod(i,8)+1)
+	    call printf ("send %d chars to server, sum=%x\n")
+		call pargi (msglen)
+		call pargi (checksum (buf, msglen))
+
+	    call fseti (fd, F_CANCEL, YES)
+	    call write (fd, buf, msglen)
+	    call flush (fd)
+
+	    call fseti (fd, F_CANCEL, YES)
+	    n = read (fd, buf, SZ_BUF)
+	    if (n > 0) {
+		buf[n+1] = EOS
+		call printf ("server: %s\n")
+		    call pargstr (buf)
+	    } else {
+		call printf ("server has disconnected\n")
+		break
+	    }
+	    call flush (STDOUT)
+	}
+
+	call close (fd)
+end
+
+
+# DAYTIME -- Connect to the daytime service on the local host and print
+# out what it returns.
+
+procedure t_daytime()
+
+int	fd, nchars, ip
+char	hostname[SZ_FNAME]
+char	line[SZ_LINE], netpath[SZ_LINE]
+int	ndopen(), read(), strlen()
+
+begin
+	# Open the daytime service on the named host or the local host.
+	call clgstr ("host", hostname, SZ_FNAME)
+	if (strlen(hostname) > 0) {
+	    call sprintf (netpath, SZ_LINE, "inet:daytime:%s")
+		call pargstr (hostname)
+	    iferr (fd = ndopen (netpath, READ_WRITE)) {
+		call printf ("cannot access host\n")
+		return
+	    }
+	} else {
+	    iferr (fd = ndopen("inet:daytime",READ_WRITE))
+		call printf("fail 1\n")
+	    iferr (fd = ndopen("inet:daytime:localhost",READ_WRITE))
+		call printf("fail 2\n")
+	}
+
+	# Read and print the daytime text.
+	call fseti (fd, F_CANCEL, OK)
+	nchars = read (fd, line, SZ_LINE)
+	if (nchars > 0) {
+	    call strupk (line, line, SZ_LINE)
+	    for (ip=1;  line[ip] != EOS;  ip=ip+1)
+		if (line[ip] == '\n') {
+		    line[ip] = EOS
+		    break
+		}
+	    call printf ("%s\n")
+		call pargstr (line)
+	}
+
+	call close (fd)
+end
+
+
+# HTTP -- Connect to a HTTP server on the given host, read a URL and print
+# what it returns.
+
+procedure t_http()
+
+bool	done
+int	fd, nchars, lastch
+char	hostname[SZ_FNAME], buf[SZ_BUF]
+char	netpath[SZ_LINE], path[SZ_LINE]
+int	ndopen(), read()
+
+begin
+	# Connect to HTTP server (default port 80) on the given host.
+	call clgstr ("host", hostname, SZ_FNAME)
+	call sprintf (netpath, SZ_LINE, "inet:80:%s:text")
+	    call pargstr (hostname)
+	iferr (fd = ndopen (netpath, READ_WRITE)) {
+	    call printf ("cannot access host\n")
+	    return
+	}
+
+	# Get the URL/URI (file pathname) to be read.
+	call clgstr ("path", path, SZ_LINE)
+
+	# Send the get-url request to the server.
+	call fprintf (fd, "GET %s HTTP/1.0\n\n")
+	    call pargstr (path)
+	call flush (fd)
+
+	# Read and print the given URL.  The returned text consists of the
+	# HTTP protocol header, a blank line, then the document text.
+	# Since this is a debug routine we output the protocol header as
+	# well as the document, but a real program would probably strip
+	# the header since it is not part of the document data.
+
+	repeat {
+	    call fseti (fd, F_CANCEL, OK)
+	    nchars = read (fd, buf, SZ_BUF)
+	    if (nchars > 0) {
+		buf[nchars+1] = EOS
+		call putline (STDOUT, buf)
+		lastch = buf[nchars]
+		done = false
+	    } else
+		done = true
+	} until (done)
+
+	if (lastch != '\n')
+	    call putline (STDOUT, "\n")
+
+	call close (fd)
+end
+
+
+# CHECKSUM -- Compute the checksum of a data buffer.
+
+int procedure checksum (buf, nchars)
+
+char	buf[ARB]		#I input buffer
+int 	nchars			#I number of chars
+
+int	sum, i
+
+begin
+	sum = 0
+	do i = 1, nchars {
+	    if (and (sum, 1) != 0)
+		sum = sum / 2 + 8000X
+	    else
+		sum = sum / 2
+	    sum = sum + buf[i]
+	    sum = and (sum, 0FFFFX)
+	}
+
+	return (sum)
+end
+
+
+# UTIME -- Test file modify time updates.
+
+procedure t_utime ()
+
+char	fname[SZ_LINE]
+int	offset
+long    fi[LEN_FINFO]
+
+int	futime(), finfo(), clgeti()
+
+begin
+	# Get parameters.
+	call clgstr ("fname", fname, SZ_LINE)
+	offset = clgeti ("offset")
+
+	# Get initial file times.
+        if (finfo (fname, fi) == ERR) 
+            call syserrs (SYS_FOPEN, fname)
+	call printf ("Initial times:  atime = %d  mtime = %d\n")
+	    call pargl (FI_ATIME(fi))
+	    call pargl (FI_MTIME(fi))
+
+
+	# Update the time by the offset.
+	if (futime (fname, FI_ATIME(fi)+offset, FI_MTIME(fi)+offset) == ERR)
+	    call error (0, "Fatal futime() error")
+	
+	# Get modified file times.
+        if (finfo (fname, fi) == ERR) 
+            call syserrs (SYS_FOPEN, fname)
+	call printf ("Mofified times: atime = %d  mtime = %d\n")
+	    call pargl (FI_ATIME(fi))
+	    call pargl (FI_MTIME(fi))
+
+
+	# Test the NULL arguments, output shouldn't change.
+	if (futime (fname, NULL, FI_MTIME(fi)) == ERR)
+	    call error (0, "Fatal futime() error")
+	
+	# Get modified file times.
+        if (finfo (fname, fi) == ERR) 
+            call syserrs (SYS_FOPEN, fname)
+	call printf ("NULL test time: atime = %d  mtime = %d\n")
+	    call pargl (FI_ATIME(fi))
+	    call pargl (FI_MTIME(fi))
+end
+
+
+# SYMLINK -- Create a symlink.
+
+procedure t_symlink ()
+
+char	link[SZ_PATHNAME], target[SZ_PATHNAME]
+int 	status
+
+int	sum, i
+
+begin
+	call clgstr ("link", link, SZ_PATHNAME)
+	call clgstr ("target", target, SZ_PATHNAME)
+
+	call fsymlink (link, target)
+end
+
+
+# UNLINK -- Remove a symlink.
+
+procedure t_unlink ()
+
+char	link[SZ_PATHNAME], target[SZ_PATHNAME]
+int 	status
+
+int	sum, i
+
+begin
+	call clgstr ("link", link, SZ_PATHNAME)
+	call funlink (link)
+end
diff --git a/sys/fmio/README b/sys/fmio/README
new file mode 100644
index 00000000..726dbc3b
--- /dev/null
+++ b/sys/fmio/README
@@ -0,0 +1,339 @@
+FMIO -- BINARY FILE MANAGER (Jul88 DCT)
+----------------------------------------------
+
+    This directory contains the sources for a general low level binary file
+manager (FMIO).  The purpose of this file manager is to manage a fixed number
+of "lightweight files", or LFILES, maintained within a single variable length
+binary file.  This facility is used by higher level interfaces such as
+database interfaces to store variable length objects efficiently in a single
+host binary file.
+
+
+1. INTERFACE PROCEDURES
+
+1.1 General Procedures
+
+    The main FMIO interface procedures are summarized in the table below.
+Most access to lfile data is intended to be via the FIO binary file driver
+procedures (beginning with fm_lfopen in the figure).
+
+	yes|no = fm_acccess (datafile, mode)
+		  fm_rename (datafile, newname)
+		    fm_copy (datafile, newname)
+		  fm_delete (datafile)
+		 fm_rebuild (datafile)
+
+	       fm = fm_open (datafile, mode)
+		    fm_seti (fm, param, ival)
+	    ival = fm_stati (fm, param)
+		   fm_debug (fm, out, what)
+		   fm_copyo (fm, fm_to)
+		    fm_sync (fm)
+		   fm_close (fm)
+
+       lfile = fm_nextlfile (fm)
+		  fm_lfname (fm, lfile, type, lfname, maxch)
+        ERR|OK = fm_lfparse (lfname, fm, lfile, type)
+		  fm_lfcopy (fm_src, lfile_src, fm_dst, lfile_dst)
+		   fm_fopen (fm, lfile, mode, type)
+
+		  fm_lfopen (lfname, mode, lf)
+		 fm_lfstati (lf, param, ival)
+		 fm_lfaread (lf, buf, nbytes, offset, status)
+		fm_lfawrite (lf, buf, nbytes, offset, status)
+		 fm_lfawait (lf, status)
+		 fm_lfclose (lf, status)
+
+		  fm_lfstat (fm, lfile, statbuf)
+		fm_lfdelete (fm, lfile)
+	      fm_lfundelete (fm, lfile)
+
+
+1.2 Buffer Cache
+
+    To avoid excessive disk i/o when randomly accessing the datafile, it is
+desirable to maintain a cache of several lfile data buffers, e.g., so that
+accesses to a series of objects stored in a single lfile, or repeated accesses
+to portions of several lfiles should incur minimal disk accesses.  A simple
+way to implement such a buffer cache is to simply open each lfile as a file
+under FIO, leaving it up to FIO to manage the file buffer, and maintaining
+a LRU cache of open lfiles.  The number of buffers (open lfiles) is easily
+parameterized.  The buffer cache procedures are summarized in the figure
+below.
+
+              fd = fm_getfd (fm, lfile, mode, type)
+                   fm_retfd (fm, lfile)
+                 fm_lockout (fm, lfile)
+                 fm_debugfd (fm, out)
+
+The fm_getfd routine maps an lfile onto a file descriptor.  A file descriptor
+is opened on the lfile only when necessary.  Once opened, an lfile remains in
+the cache until forced out by the LRU replacement algorithm, or the datafile
+is closed.  While the datafile remains open, removal of an lfile from the
+cache (closing the associated file descriptor) is permitted only after a call
+to fm_retfd; calling this routine does not immediately close the file, it only
+permits it to be closed.  Repeated to fm_getfd should return a file descriptor
+immediately, with very little overhead, with an already active file buffer,
+hence repeated calls to the cache manager and FIO may often be made without
+incurring any disk accesses.
+
+Note that lfiles may be opened on file descriptors via direct calls to the
+file manager, regardless of whether these lfiles are already open in the
+buffer cache (e.g., with fm_fopen).  This allows two or more independent
+file buffers to be simultaneously active on the same lfile, but opens the
+possibility of loss of data if the buffers overlap.  If this is a problem,
+the routine fm_lockoutfd may be called to prevent inadvertent use of an lfile
+by the cache.  This should be followed by a call to fm_retfd to clear the
+lockout bit once the reason for the lockout (usually a noncached lfile open)
+is gone.  The routine fm_debugfd will print information on stream 'out'
+describing the status of the buffer cache.
+
+
+2. FILE STRUCTURE
+
+The layout of a datafile is as follows:
+
+	    +   +-------------------------+
+	    |   |     datafile header     |     (fixed size)
+     stored |   |  +-------------------+  |
+       as - +   |        file table       |     (configurable)
+      unit  |   |  +-------------------+  |
+	    |   |      page table index   |     (configurable)
+	    +   +-------------------------+
+                             |
+                         data pages             (dynamic)
+                             |
+                             v
+
+The datafile header is a fixed format binary structure.  The file table
+contains one entry for each lfile stored in the datafile; the maximum number
+of lfiles is fixed at datafile creation time.  Each lfile is known by its
+lfile number, ranging from zero to MAXLFILES.  Lfile zero is the PAGE TABLE,
+used to map each data page in the datafile to the lfile to which it is
+allocated.  The first user lfile is hence number 1.  Lfiles may by any size;
+storage is allocated in units of PAGES.  The page size is fixed at datafile
+creation time.	There are two types of files, binary (opaque) files, and
+text files.  Both file types appear as binary files to the high level code,
+i.e., both are accessed by a FIO binary file driver, the only difference
+being that for a text file, data blocks are assumed to contain text and are
+packed/unpacked during i/o (saving storage and rendering the file machine
+independent).
+
+It is important to realize that lfiles are referred to only by FILE NUMBER
+in this interface; any association with symbolic names must be made at a
+higher level (lfiles are by no means necessarily associated with "files" at
+the higher level, i.e., they might be used to store variable length parameters,
+relations, or whatever).  All lfiles exist, in a sense, as zero length files
+at datafile creation time.  To open a new lfile, one first calls fm_nextlfile
+to get the file number of an empty lfile.  Lfiles can be deleted, but storage
+is never deallocated; new pages are always allocated at the end of file.
+Hence deleted lfiles can be undeleted, and the entire datafile must normally
+be copied (or "rebuilt") to reclaim unused space and coalesce file segments
+for more efficient i/o.  (There are cases where a deleted lfile can be reused
+without rebuilding the lfile: fm_nextlfile will begin reusing deleted lfiles
+after it wraps around, and the client software can always open an lfile
+NEW_FILE, overwriting the pages already allocated to the lfile).
+
+The FMIO datafile itself, and any text files stored therein, is maintained in
+a machine indepenent format.  Binary file data is merely copied to and from
+the datafile, hence it is up to the client software to store binary data in
+a machine independent format, if desired.
+
+
+2.1 Recovery
+
+    Since new data pages are always allocated at the end of file (next
+available PTE), and the datafile state is always sync-ed as a unit, protected
+as a critical section (ignoring modifications to lfile data), a datafile
+should always be recoverable after a crash, with loss only of data written
+since the last sync.  The datafile is sync-ed automatically every several
+minutes.  Applications wishing to protect newly written lfile data can sync
+the datafile manually if desired.
+
+
+3. RUNTIME DATA STRUCTURES
+
+The internal runtime data structures are summarized below.  The terminology
+used is as follows:
+
+	FM		file manager
+	FT		file table
+	FTE		file table entry
+	LFILE		lightweight file
+	PAGE		unit of datafile file storage
+	PT		page table
+	PTE		page table entry
+	PTI		page table index
+
+
+# FMDES -- Main FM descriptor.
+struct fmdes {
+	int	fm_magic		# identifies file/descriptor type
+	int	fm_active		# set once descriptor is initialized
+	int	fm_chan			# host i/o channel for datafile
+	int	fm_mode			# datafile access mode
+	int	fm_dfversion		# datafile file version
+	int	fm_szpage		# datafile page size, bytes
+	int	fm_nlfiles		# number of lfiles
+	int	fm_datastart		# file offset of first data page
+	int	fm_devblksize		# device block size
+	int	fm_optbufsize		# default file buffer size
+	int	fm_maxbufsize		# maximum file buffer size
+	int	fm_lsynctime		# time descriptor last updated on disk
+	int	fm_dhmodified		# set if header needs to be updated
+
+	int	fm_ftoff		# offset (su) of FT in datafile
+	int	fm_ftlastnf		# file number of last lfile allocated
+	struct	fte (*fm_ftable)[]	# file table storage
+
+	int	fm_ptioff		# offset (su) of PTI in datafile
+	int	fm_ptilen		# allocated length of PTI
+	int	fm_ptinpti		# number of PTI entries in use
+	int	fm_ptindex[]		# PTI storage
+
+	int	fm_ptlen		# allocated length of page table array
+	int	fm_ptnpte		# number of PTE's in use (#data pages)
+	int	fm_ptlupte		# highest PTE updated on disk
+	short	fm_ptable[]		# runtime page table array
+
+	struct	lfcache *fm_lfcache;	# lfile cache descriptor
+	int	fm_errcode		# error code of posted error
+	char	fm_erropstr[]		# operand string of posted error
+	char	fm_dfname[]		# datafile name, for error messages
+}
+
+
+3.1 Page Table
+
+    During runtime access to the datafile, the page table is a vector mapping
+each datafile page to an lfile.  Each page is allocated to a single lfile, and
+lfile storage is allocated in units of pages.  As the datafile is extended by
+writing to lfiles, elements are the in-core page table array.
+
+When an lfile is first accessed, the in-core page table is scanned to find
+those pages belonging to the lfile, building up a vector mapping offsets in
+the lfile into datafile page numbers, i.e., to offsets in the physical
+datafile.  As new pages are allocated to an lfile by writing at end of file,
+both the lfile page vector and datafile page table are extended.
+
+Assume the datafile page size is 512 bytes.  Since a PTE is 2 bytes, each PT
+page holds 256 PTEs, representing 128 Kb of file space.  1 Mb of file space
+(2048 pages) therefore requires 8 pages of page table space.  If we allocate
+a default PT index of 256 slots, this gives us (for a 512 byte page) a 32 Mb
+default maximum file size.
+
+Only the PT index, stored in the datafile header, and the PT pages mapping
+datafile page to lfile, are physically stored in the datafile.  The PT index
+size is fixed.  The PT pages may be stored anywhere in the data pages and
+are pointed to by the PT index.  The PT is stored as lfile zero.
+
+This scheme is not intended for use with extremely large datafiles, or with
+datafiles containing a very large number of lfiles.  A datafile of 32-256 Mb,
+page size 512-4096, containing up to several hundred lfiles is the design
+limit.  Of course, each datafile is a single host file, and there can be any
+number of datafiles.
+
+
+3.2 File Table
+
+    The file table (FT) describes each lfile in the datafile.  Each lfile
+has an entry in the file table, regardless of whether the lfile has ever been
+accessed or contains any data.	As stored in the datafile, the FT is an array
+of file table entries (FTEs) containing two longwords of data each, i.e.,
+
+	FTE.1:	file size, bytes
+	FTE.2:	flag bits (text, deleted, etc.)
+
+Additional information must be maintained while an lfile is being accessed
+at runtime.  The full runtime FTE is as follows.
+
+	struct fte {
+		struct	fmdes *lf_fm	# backpointer to FMIO descriptor
+		int	lf_fsize	# file size, bytes
+		int	lf_flags	# flag bits
+		int	lf_status	# runtime i/o status (byte count)
+		int	lf_ltsize	# logical byte size of last transfer
+		int	lf_npages	# npages in lfile (pagemap size)
+		int	*lf_pagemap	# pagemap array for lfile
+		int	lf_pmlen	# pagemap array length (allocated)
+	}
+
+flag bits:
+	
+	LF_DELETED		set if the lfile is deleted
+	LF_TEXTFILE		set if the lfile data is byte-packed text
+	LF_IOINPROGRESS		set when i/o transfer is in progress
+
+Deleting an lfile merely causes the FT_DELETED bit to be set; the actual
+data will be lost only if the lfile is reused or explicitly overwritten,
+or in a copy or rebuild operation.  Lfile space, once allocated, is never
+freed, i.e., new pages are always allocated at the end of the datafile,
+but lfile space can be *reused* by opening the lfile NEW_FILE and writing
+into it.
+
+Space for all lfile descriptors is preallocated in the FTE array at datafile
+open time.  When an lfile is first accessed the pagemap for that lfile is
+filled in; subsequent accesses to the lfile (lfile opens) while the datafile
+remains open require very little overhead, since the lfile descriptor is
+accessible via a vectored array reference, and will already have been activated.
+
+
+4. EXAMPLE
+
+    The following dialogue is from the debug tasks in ZZDEBUG.  A datafile Q
+containing four textfiles has been created, and we print out the contents of
+this with SHOW.  Next we copy the datafile to Q, and "show" that.  Note that
+the page table file is moved to the beginning of the data pages area (which
+will avoid an extra disk access during the datafile open), and all lfiles
+have been rendered contiguous (lfile 5 was not stored in two segments in the
+original datafile).
+
+> ?
+    create   wfile    pfile    show     copy     rebuild  
+> 
+> show
+datafile: q
+FMIO V1.1: datafile=q, pagesize=512, nlfiles=128
+nlfinuse=5, nlfdeleted=0, nlffree=123, ftoff=13, ftlastnf=0
+headersize=2560, filesize=20992, freespace=1408 bytes (6%)
+fm=15AE9X, chan=4, mode=2, time since last sync=1 seconds
+datastart=2561, devblksize=512, optbufsize=2048, maxbufsize=0
+ptioff=271, ptilen=256, npti=1, ptlen=512, npte=36, lupte=36
+====================== file table =======================
+    0 size=72 [page table]
+    1 size=1114 textfile
+    2 size=7037 textfile
+    5 size=4422 textfile
+    6 size=4379 textfile
+=================== page table index ====================
+    4
+====================== page table =======================
+    1    1    1    0    2    2    2    2    2    2    2    2    2    2    2
+    2    2    2    5    5    6    6    6    6    6    6    6    6    6    5
+    5    5    5    5    5    5
+> 
+> copy
+source: q
+destination: p
+> 
+> show
+datafile: p
+FMIO V1.1: datafile=p, pagesize=512, nlfiles=128
+nlfinuse=5, nlfdeleted=0, nlffree=123, ftoff=13, ftlastnf=0
+headersize=2560, filesize=20992, freespace=1408 bytes (6%)
+fm=15AE9X, chan=4, mode=2, time since last sync=0 seconds
+datastart=2561, devblksize=512, optbufsize=2048, maxbufsize=0
+ptioff=271, ptilen=256, npti=1, ptlen=512, npte=36, lupte=36
+====================== file table =======================
+    0 size=72 [page table]
+    1 size=1114 textfile
+    2 size=7037 textfile
+    5 size=4422 textfile
+    6 size=4379 textfile
+=================== page table index ====================
+    1
+====================== page table =======================
+    0    1    1    1    2    2    2    2    2    2    2    2    2    2    2
+    2    2    2    5    5    5    5    5    5    5    5    5    6    6    6
+    6    6    6    6    6    6
+> 
diff --git a/sys/fmio/fmaccess.x b/sys/fmio/fmaccess.x
new file mode 100644
index 00000000..c1324fc4
--- /dev/null
+++ b/sys/fmio/fmaccess.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FM_ACCESS -- Test to see if the name FMIO datafile exists and is accessible
+# with the given permissions.
+
+int procedure fm_access (dfname, mode)
+
+char	dfname[ARB]		#I datafile name
+int	mode			#I access mode (0 to just test existence)
+
+int	access()
+
+begin
+	return (access (dfname, mode, 0))
+end
diff --git a/sys/fmio/fmclose.x b/sys/fmio/fmclose.x
new file mode 100644
index 00000000..87e20674
--- /dev/null
+++ b/sys/fmio/fmclose.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<knet.h>
+include	"fmio.h"
+
+# FM_CLOSE -- Close a datafile opened under FMIO.
+
+procedure fm_close (fm)
+
+pointer	fm			#I FMIO descriptor
+
+pointer	lf
+int	status, i
+errchk	fmio_bind, fm_fcfree, fmio_errchk
+
+begin
+	# An open-new-file followed by a close should create an empty datafile.
+	if (FM_ACTIVE(fm) == NO)
+	    call fmio_bind (fm)
+
+	# Shut down the file cache, if in use (does a sync).
+	if (FM_FCACHE(fm) != NULL)
+	    call fm_fcfree (fm)
+	else
+	    call fm_sync (fm)
+
+	# Report any posted errors.
+	call fmio_errchk (fm)
+
+	# Close the physical datafile.
+	call zclsbf (FM_CHAN(fm), status)
+	if (status == ERR)
+	    iferr (call syserrs (SYS_FMCLOSE, FM_DFNAME(fm)))
+		call erract (EA_WARN)
+
+	# Free any storage used by the runtime file table.
+	lf = FM_FTABLE(fm)
+	do i = 0, FM_NLFILES(fm) {
+	    if (LF_PAGEMAP(lf) != NULL)
+		call mfree (LF_PAGEMAP(lf), TY_INT)
+	    lf = lf + LEN_FTE
+	}
+
+	# Free the main descriptor.
+	call mfree (FM_PTABLE(fm), TY_SHORT)
+	call mfree (FM_PTINDEX(fm), TY_INT)
+	call mfree (FM_FTABLE(fm), TY_INT)
+	call mfree (fm, TY_STRUCT)
+end
diff --git a/sys/fmio/fmcopy.x b/sys/fmio/fmcopy.x
new file mode 100644
index 00000000..1125a820
--- /dev/null
+++ b/sys/fmio/fmcopy.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"fmset.h"
+
+# FM_COPY -- Copy a datafile, preserving all the physical attributes, but
+# eliminating waste storage and rendering file structures logically contiguous.
+
+procedure fm_copy (dfname, newname)
+
+char	dfname[ARB]		#I existing datafile
+char	newname[ARB]		#I new datafile name
+
+pointer	o_fm, n_fm
+pointer	fm_open()
+int	fm_stati()
+errchk	fm_open, fm_copyo
+
+begin
+	# Open the old and new datafiles.
+	o_fm = fm_open (dfname, READ_ONLY)
+	n_fm = fm_open (newname, NEW_FILE)
+
+	# The child inherits the attributes of the parent.
+	call fm_seti (n_fm, FM_PAGESIZE,   fm_stati(o_fm,FM_PAGESIZE))
+	call fm_seti (n_fm, FM_MAXLFILES,  fm_stati(o_fm,FM_MAXLFILES))
+
+	# Copy the datafile and clean up.
+	iferr (call fm_copyo (o_fm, n_fm)) {
+	    call fm_close (o_fm)
+	    call fm_close (n_fm)
+	    call erract (EA_ERROR)
+	} else {
+	    call fm_close (o_fm)
+	    call fm_close (n_fm)
+	}
+end
diff --git a/sys/fmio/fmcopyo.x b/sys/fmio/fmcopyo.x
new file mode 100644
index 00000000..a6fd0be2
--- /dev/null
+++ b/sys/fmio/fmcopyo.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	"fmio.h"
+
+# FM_COPYO -- Copy an existing, open datafile to a new, open but empty
+# datafile, rendering all lfile storage contiguous and omitting deleted
+# lfiles.  Lfile numbers are preserved by the copy operation, hence
+# deleted lfiles will leave holes (zero length lfiles) in the file table.
+
+procedure fm_copyo (old, new)
+
+pointer	old, new		#I FMIO descriptors of source and destination
+
+pointer	o_ft, o_lf
+int	n_szbpage, nlfiles, dpages, npte_perpage, npti, p1, dp, i
+errchk	fmio_bind, syserrs, fm_lfcopy
+int	fmio_extend()
+
+begin
+	call fmio_bind (old)
+	call fmio_bind (new)
+
+	# Scan the file table of the old datafile and determine the number of
+	# data pages required to store the valid lfiles therein.  Note that
+	# the page size may differ in the old and new datafiles.
+
+	o_ft = FM_FTABLE(old)
+	n_szbpage = FM_SZBPAGE(new)
+	nlfiles = min (FM_NLFILES(old), FM_NLFILES(new))
+	dpages = 0
+
+	do i = 0, nlfiles {
+	    o_lf = o_ft + i * LEN_FTE
+	    if (LF_FSIZE(o_lf) <= 0 || and(LF_FLAGS(o_lf),LFF_ALLOCATED) == 0)
+		next
+	    dpages = dpages + (LF_FSIZE(o_lf) + n_szbpage-1) / n_szbpage
+	}
+
+	# Now allocate enough lfile 0 space in the new datafile to permit
+	# contiguous storage of the entire datafile page table.
+
+	npte_perpage = n_szbpage / (SZ_SHORT * SZB_CHAR)
+	npti = (dpages + npte_perpage-1) / npte_perpage
+	if (npti > FM_PTILEN(new))
+	    call syserrs (SYS_FMPTIOVFL, FM_DFNAME(new))
+
+	for (p1=FM_PTINPTI(new)+1;  p1 <= npti;  p1=p1+1) {
+	    dp = fmio_extend (new, PT_LFILE, 1)
+	    if (dp == ERR)
+		call syserrs (SYS_FMCOPYO, FM_DFNAME(new))
+	    Memi[FM_PTINDEX(new)+p1-1] = dp
+	    FM_PTINPTI(new) = p1
+	    FM_DHMODIFIED(new) = YES
+	}
+
+	# Copy the lfiles (excluding the page table).
+	do i = 1, nlfiles
+	    call fm_lfcopy (old, i, new, i)
+
+	call fm_sync (new)
+end
diff --git a/sys/fmio/fmdebug.x b/sys/fmio/fmdebug.x
new file mode 100644
index 00000000..183e4481
--- /dev/null
+++ b/sys/fmio/fmdebug.x
@@ -0,0 +1,182 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmset.h"
+include	"fmio.h"
+
+# FM_DEBUG -- Print debug info on the contents of a datafile.
+#
+# Flags:
+#	FMD_HEADER		general header parameters
+#	FMD_FTABLE		summarize file table contents
+#	FMD_PTINDEX		print page table index
+#	FMD_PTABLE		print page table
+#	FMD_ALL			print everything
+
+procedure fm_debug (fm, out, what)
+
+pointer	fm			#I FMIO descriptor
+int	out			#I output file
+int	what			#I what to print
+
+pointer	ft, lf
+bool	deleted
+int	nlfiles, nlfdeleted, nlfinuse, i
+int	szbpage, spaceinuse, filesize, freespace
+long	clktime()
+errchk	fmio_bind
+
+define	end_header_	91
+define	end_ftable_	92
+define	end_ptindex_	93
+define	end_ptable_	94
+
+begin
+	call fmio_bind (fm)
+
+	ft = FM_FTABLE(fm)
+	nlfiles = FM_NLFILES(fm)
+	szbpage = FM_SZBPAGE(fm)
+
+	# Print header and summary information?
+	if (and (what, FMD_HEADER) == 0)
+	    goto end_header_
+
+	# Scan the file table and compute some important statistics.
+	spaceinuse = 0
+	nlfdeleted = 0
+	nlfinuse = 0
+
+	do i = 0, nlfiles {
+	    lf = ft + i * LEN_FTE
+	    deleted = (and (LF_FLAGS(lf), LFF_DELETED) != 0)
+	    if (deleted)
+		nlfdeleted = nlfdeleted + 1
+	    if (!deleted) {
+		if (LF_FSIZE(lf) > 0)
+		    spaceinuse = spaceinuse + LF_FSIZE(lf)
+		if (and (LF_FLAGS(lf), LFF_ALLOCATED) != 0)
+		    nlfinuse = nlfinuse + 1
+	    }
+	}
+
+	filesize = FM_PTNPTE(fm) * szbpage + FM_DATASTART(fm) - 1
+	freespace = max (0, filesize - spaceinuse - (FM_DATASTART(fm)-1))
+
+	call fprintf (out,
+	"FMIO V%d.%d: datafile=%s, pagesize=%d, nlfiles=%d\n")
+	    call pargi (FM_DFVERSION(fm) / 100)
+	    call pargi (mod(FM_DFVERSION(fm),100))
+	    call pargstr (FM_DFNAME(fm))
+	    call pargi (szbpage)
+	    call pargi (nlfiles)
+
+	call fprintf (out,
+	    "nlfinuse=%d, nlfdeleted=%d, nlffree=%d, ftoff=%d, ftlastnf=%d\n")
+	    call pargi (nlfinuse)
+	    call pargi (nlfdeleted)
+	    call pargi (nlfiles - nlfinuse)
+	    call pargi (FM_FTOFF(fm))
+	    call pargi (FM_FTLASTNF(fm))
+
+	call fprintf (out,
+	    "headersize=%d, filesize=%d, freespace=%d bytes (%d%%)\n")
+	    call pargi (FM_DATASTART(fm) - 1)
+	    call pargi (filesize)
+	    call pargi (freespace)
+	    if (freespace <= 0)
+		call pargi (0)
+	    else
+		call pargi (freespace * 100 / filesize)
+
+	call fprintf (out,
+	    "fm=%xX, chan=%d, mode=%d, time since last sync=%d seconds\n")
+	    call pargi (fm)
+	    call pargi (FM_CHAN(fm))
+	    call pargi (FM_MODE(fm))
+	    call pargi (clktime (FM_LSYNCTIME(fm)))
+
+	call fprintf (out,
+	    "datastart=%d, devblksize=%d, optbufsize=%d, maxbufsize=%d\n")
+	    call pargi (FM_DATASTART(fm))
+	    call pargi (FM_DEVBLKSIZE(fm))
+	    call pargi (FM_OPTBUFSIZE(fm))
+	    call pargi (FM_MAXBUFSIZE(fm))
+
+	call fprintf (out, "ptioff=%d, ptilen=%d, npti=%d, ")
+	    call pargi (FM_PTIOFF(fm))
+	    call pargi (FM_PTILEN(fm))
+	    call pargi (FM_PTINPTI(fm))
+	call fprintf (out, "ptlen=%d, npte=%d, lupte=%d\n")
+	    call pargi (FM_PTLEN(fm))
+	    call pargi (FM_PTNPTE(fm))
+	    call pargi (FM_PTLUPTE(fm))
+
+end_header_
+
+	# Print file table?
+	if (and (what, FMD_FTABLE) == 0)
+	    goto end_ftable_
+
+	call fprintf (out,
+	    "====================== file table =======================\n")
+	do i = 0, nlfiles {
+	    lf = ft + i * LEN_FTE
+	    if (LF_FSIZE(lf) == 0)
+		next
+	    call fprintf (out, " %4d size=%d")
+		call pargi (i)
+		call pargi (LF_FSIZE(lf))
+	    if (i == 0)
+		call fprintf (out, " [page table]")
+	    if (LF_PAGEMAP(lf) != NULL) {
+		call fprintf (out, " npages=%d pmlen=%d")
+		    call pargi (LF_NPAGES(lf))
+		    call pargi (LF_PMLEN(lf))
+	    }
+	    if (and (LF_FLAGS(lf), LFF_ALLOCATED) != 0)
+		call fprintf (out, " allocated")
+	    if (and (LF_FLAGS(lf), LFF_DELETED) != 0)
+		call fprintf (out, " deleted")
+	    if (and (LF_FLAGS(lf), LFF_TEXTFILE) != 0)
+		call fprintf (out, " textfile")
+	    call fprintf (out, "\n")
+	}
+
+end_ftable_
+
+	# Print page table index?
+	if (and (what, FMD_PTINDEX) == 0)
+	    goto end_ptindex_
+
+	call fprintf (out,
+	    "=================== page table index ====================\n")
+	do i = 0, FM_PTINPTI(fm) - 1 {
+	    call fprintf (out, " %4d")
+		call pargi (Memi[FM_PTINDEX(fm)+i])
+	    if (mod (i+1, 15) == 0)
+		call fprintf (out, "\n")
+	}
+	if (mod (FM_PTINPTI(fm), 15) != 0)
+	    call fprintf (out, "\n")
+
+end_ptindex_
+
+	# Print page table?
+	if (and (what, FMD_PTABLE) == 0)
+	    goto end_ptable_
+
+	call fprintf (out,
+	    "====================== page table =======================\n")
+	do i = 0, FM_PTNPTE(fm) - 1 {
+	    call fprintf (out, " %4d")
+		call pargs (Mems[FM_PTABLE(fm)+i])
+	    if (mod (i+1, 15) == 0)
+		call fprintf (out, "\n")
+	}
+	if (mod (FM_PTINPTI(fm), 15) != 0)
+	    call fprintf (out, "\n")
+
+end_ptable_
+
+	call flush (out)
+end
diff --git a/sys/fmio/fmdelete.x b/sys/fmio/fmdelete.x
new file mode 100644
index 00000000..b90fb2af
--- /dev/null
+++ b/sys/fmio/fmdelete.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FM_DELETE -- Delete a datafile.
+
+procedure fm_delete (dfname)
+
+char	dfname[ARB]		#I datafile name
+
+begin
+	call delete (dfname)
+end
diff --git a/sys/fmio/fmfcache.x b/sys/fmio/fmfcache.x
new file mode 100644
index 00000000..6e1d16fe
--- /dev/null
+++ b/sys/fmio/fmfcache.x
@@ -0,0 +1,395 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<fset.h>
+include	"fmset.h"
+include	"fmio.h"
+
+.help fcache
+.nf -------------------------------------------------------------------------
+FCACHE -- FMIO File (Buffer) Cache package.
+
+    This package is used to manage a cache of lfile data buffers maintained on
+a FMIO datafile.  The number and size of data buffers is user configurable:
+the number of buffers by a call to FM_SETI to set FM_FCACHESIZE, and the buffer
+size by a call to FSETI to set the file buffer size.
+
+		  fm_fcinit (fm, cachesize)
+                 fm_fcdebug (fm, out, what)
+		  fm_fcsync (fm)
+		  fm_fcfree (fm)
+
+              fd = fm_getfd (fm, lfile, mode, type)
+                   fm_retfd (fm, lfile)
+                 fm_lockout (fm, lfile)
+                  fm_unlock (fm, lfile)
+	   bool = fm_locked (fm, lfile)
+
+The cache is a conventional LRU cache.  FM_GETFD returns the file descriptor
+of an open, cached file opened on an lfile, locking the file in the cache in
+the process.  A subsequent call to FM_RETFD is required to allow the cache
+slot to be reused.  FM_LOCKOUT may be used to lock a particular lfile out of
+the cache; FM_UNLOCK releases the lock.
+.endhelp --------------------------------------------------------------------
+
+define	LEN_FCACHE	(3+($1)*LEN_FSLOT)	# len = LEN_FCACHE(cachesize)
+define	FC_NFILES	Memi[$1]		# number of files in cache
+define	FC_REFCNT	Memi[$1+1]		# cache reference count
+define	FC_LFSTAT	Memi[$1+2]		# lfile statistics array
+define	FC_FS		((($2)-1)*LEN_FSLOT+($1)+3)	# get slot pointer
+
+define	LEN_FSLOT	4
+define	FC_NREF		Memi[$1]		# number of refs to this slot
+define	FC_LRU		Memi[$1+1]		# LRU count for slot
+define	FC_LFILE	Memi[$1+2]		# lfile assigned to slot
+define	FC_FD		Memi[$1+3]		# file descriptor
+
+
+# FM_GETFD -- Map a FIO file descriptor onto an lfile and return the file
+# descriptor.  The opened file descriptor remains in the cache after the
+# access, until the file ages out of the cache.  
+
+int procedure fm_getfd (fm, lfile, mode, type)
+
+pointer	fm		# FMIO descriptor
+int	lfile		# lfile to be opened
+int	mode		# file access mode
+int	type		# file type
+
+int	acmode, lru, i
+pointer	oldest, fc, fs, st
+
+bool	fm_locked()
+pointer	fm_findlf()
+int	fm_fopen(), fstati()
+errchk	fm_fopen, fm_fcinit, syserrs, close
+define	ref_	91
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc == NULL) {
+	    call fm_fcinit (fm, FM_SZFCACHE(fm))
+	    fc = FM_FCACHE(fm)
+	}
+
+	# Keep debug statistics on lfile accesses.
+	st = FC_LFSTAT(fc)
+	if (st != NULL)
+	    Mems[st+lfile] = Mems[st+lfile] + 1
+
+	fs = fm_findlf (fc, lfile)
+	if (fs != NULL) {
+	    # If lfile is already in the cache and the new mode is NEW_FILE,
+	    # or we need write perm and do not currently have it, close and
+	    # reopen the lfile with the desired mode.
+
+	    if (mode == NEW_FILE ||
+		(mode != READ_ONLY && fstati (FC_FD(fs), F_WRITE) == NO)) {
+ref_
+		if (FC_NREF(fs) > 1)
+		    call syserrs (SYS_FMFSINUSE, FM_DFNAME(fm))
+		if (FC_NREF(fs) == 1)
+		    call close (FC_FD(fs))
+		if (fm_locked (fm, lfile))
+		    call syserrs (SYS_FMLFLOCKED, FM_DFNAME(fm))
+
+		if (mode == WRITE_ONLY || mode == APPEND)
+		    acmode = READ_WRITE
+		else
+		    acmode = mode
+
+		FC_FD(fs) = fm_fopen (fm, lfile, acmode, type)
+		FC_NREF(fs) = 1
+		FC_LFILE(fs) = lfile
+	    }
+
+	    # Reference the cached lfile.
+	    FC_REFCNT(fc) = FC_REFCNT(fc) + 1
+	    FC_LRU(fs)    = FC_REFCNT(fc)
+	    FC_NREF(fs)   = FC_NREF(fs) + 1
+	    if (mode == APPEND)
+		call seek (FC_FD(fs), EOFL)
+
+	    return (FC_FD(fs))
+
+	} else {
+	    # Lfile is not in cache.  Find the oldest slot. 
+	    oldest = NULL
+	    lru = NULL
+	    do i = 1, FC_NFILES(fc) {
+		fs = FC_FS(fc,i)
+		if (FC_NREF(fs) <= 1)
+		    if (lru == NULL || FC_LRU(fs) < lru) {
+			lru = FC_LRU(fs)
+			oldest = fs
+			if (FC_NREF(fs) <= 0)
+			    break
+		    }
+	    }
+
+	    # Abort if all cache slots are busy.
+	    if (oldest == NULL)
+		call syserrs (SYS_FMFCFULL, FM_DFNAME(fm))
+
+	    # Replace the file in the cache, and return new descriptor.
+	    fs = oldest
+	    goto ref_
+	}
+end
+
+
+# FM_RETFD -- Return a cached file, i.e., decrement the reference count for
+# the file so that it may be returned.  If FM_RETFD is called when the file
+# is sitting in the cache idle, the file is physically closed (i.e., a GETFD
+# followed by one RETFD leaves the file cached and idle, ready for another
+# GETFD without losing context, but another RETFD while the file is idle
+# closes the file and removes it from the cache).
+
+procedure fm_retfd (fm, lfile)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile to be returned
+
+pointer	fc, fs
+pointer	fm_findlf()
+errchk	fm_fcinit
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc == NULL) {
+	    call fm_fcinit (fm, FM_SZFCACHE(fm))
+	    fc = FM_FCACHE(fm)
+	}
+
+	fs = fm_findlf (fc, lfile)
+	if (fs != NULL) {
+	    FC_NREF(fs) = FC_NREF(fs) - 1
+	    if (FC_NREF(fs) <= 0) {
+		call close (FC_FD(fs))
+		FC_NREF(fs) = 0
+	    }
+	}
+end
+
+
+# FM_LOCKOUT -- Lock an lfile out of the file cache.
+
+procedure fm_lockout (fm, lfile)
+
+pointer	fm		#I FMIO descriptor
+int	lfile		#I lfile to be locked out
+
+pointer	fc, fs, lf
+pointer	fm_findlf()
+errchk	fm_fcinit, close, syserrs
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc == NULL) {
+	    call fm_fcinit (fm, FM_SZFCACHE(fm))
+	    fc = FM_FCACHE(fm)
+	}
+
+	# Close lfile if it is already in the cache, but idle.
+	fs = fm_findlf (fc, lfile)
+	if (fs != NULL) {
+	    if (FC_NREF(fs) > 1)
+		call syserrs (SYS_FMLOKACTLF, FM_DFNAME(fm))
+	    FC_NREF(fs) = FC_NREF(fs) - 1
+	    if (FC_NREF(fs) <= 0) {
+		call close (FC_FD(fs))
+		FC_NREF(fs) = 0
+	    }
+	}
+
+	# Set the lockout bit in the file table.
+	lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	LF_FLAGS(lf) = or (LF_FLAGS(lf), LFF_LOCKOUT)
+end
+
+
+# FM_UNLOCK -- Unlock an lfile.
+
+procedure fm_unlock (fm, lfile)
+
+pointer	fm		#I FMIO descriptor
+int	lfile		#I lfile to be locked out
+
+pointer	lf
+
+begin
+	# Clear the lockout bit in the file table.
+	lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	LF_FLAGS(lf) = and (LF_FLAGS(lf), not(LFF_LOCKOUT))
+end
+
+
+# FM_LOCKED -- Test the lfile lockout bit.
+
+bool procedure fm_locked (fm, lfile)
+
+pointer	fm		#I FMIO descriptor
+int	lfile		#I lfile to be locked out
+
+pointer	lf
+
+begin
+	# Test the lockout bit in the file table.
+	lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	return (and (LF_FLAGS(lf), LFF_LOCKOUT) != 0)
+end
+
+
+# FM_FINDLF -- Search the cache for the given lfile.
+
+pointer procedure fm_findlf (fc, lfile)
+
+pointer	fc		#I file cache descriptor
+int	lfile		#I lfile to search for
+
+int	i
+pointer	fs
+
+begin
+	do i = 1, FC_NFILES(fc) {
+	    fs = FC_FS(fc,i)
+	    if (FC_NREF(fs) != 0 && FC_LFILE(fs) == lfile)
+		return (fs)
+	}
+
+	return (NULL)
+end
+
+
+# FM_FCDEBUG -- Print debug info describing the contents and status of the
+# file cache.
+
+procedure fm_fcdebug (fm, out, what)
+
+pointer	fm		#I FMIO descriptor
+int	out		#I output file
+int	what		#I type of debug output
+
+int	nref, i
+pointer	fc, fs, st
+errchk	fm_fcinit
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc == NULL) {
+	    call fm_fcinit (fm, FM_SZFCACHE(fm))
+	    fc = FM_FCACHE(fm)
+	}
+
+	# Print cache status.
+	if (and (what, FCD_CACHE) != 0) {
+	    call fprintf (out, "#  LRU NREF LFILE  FD\n")
+	    do i = 1, FC_NFILES(fc) {
+		fs = FC_FS(fc,i)
+		call fprintf (out, "%6d %4d %5d %3d\n")
+		    call pargi (FC_LRU(fs))
+		    call pargi (FC_NREF(fs))
+		    if (FC_NREF(fs) > 0) {
+			call pargi (FC_LFILE(fs))
+			call pargi (FC_FD(fs))
+		    } else {
+			call pargi (0)
+			call pargi (0)
+		    }
+	    }
+	}
+
+	# Print lfile access statistics.
+	if (and (what, FCD_LFSTATISTICS) != 0) {
+	    st = FC_LFSTAT(fc)
+	    if (st != NULL) {
+		call fprintf (out, "-------- getfd's per lfile ---------\n")
+		do i = 0, FM_NLFILES(fm) {
+		    nref = Mems[st+i]
+		    if (nref > 0) {
+			call fprintf (out, "%4d %4d\n")
+			    call pargi (i)
+			    call pargi (nref)
+		    }
+		}
+	    }
+	}
+end
+
+
+# FM_FCINIT -- Init the file cache.
+
+procedure fm_fcinit (fm, cachesize)
+
+pointer	fm		#I FMIO descriptor
+int	cachesize	#I size of cache, file slots
+
+pointer	fc
+
+begin
+	if (FM_FCACHE(fm) != NULL)
+	    call fm_fcfree (fm)
+
+	call calloc (fc, LEN_FCACHE(cachesize), TY_STRUCT)
+	call calloc (FC_LFSTAT(fc), FM_NLFILES(fm)+1, TY_SHORT)
+	FC_NFILES(fc) = cachesize
+	FC_REFCNT(fc) = 1
+
+	FM_FCACHE(fm) = fc
+end
+
+
+# FM_FCFREE -- Shutdown the file cache and free all resources, ignoring
+# all file reference counts.
+
+procedure fm_fcfree (fm)
+
+pointer	fm		#I FMIO descriptor
+
+int	i
+pointer	fc, fs
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc == NULL)
+	    return
+
+	# Update the datafile.
+	call fm_fcsync (fm)
+
+	# Close any cached files.
+	do i = 1, FC_NFILES(fc) {
+	    fs = FC_FS(fc,i)
+	    if (FC_NREF(fs) >= 1)
+		iferr (call close (FC_FD(fs)))
+		    call erract (EA_WARN)
+	}
+
+	call mfree (FC_LFSTAT(fc), TY_SHORT)
+	call mfree (FM_FCACHE(fm), TY_STRUCT)
+end
+
+
+# FM_FCSYNC -- Sync the file cache and datafile.
+
+procedure fm_fcsync (fm)
+
+pointer	fm		#I FMIO descriptor
+
+int	i
+pointer	fc, fs
+
+begin
+	fc = FM_FCACHE(fm)
+	if (fc != NULL) {
+	    do i = 1, FC_NFILES(fc) {
+		fs = FC_FS(fc,i)
+		if (FC_NREF(fs) >= 1)
+		    iferr (call flush (FC_FD(fs)))
+			call erract (EA_WARN)
+	    }
+	}
+
+	call fm_sync (fm)
+end
diff --git a/sys/fmio/fmfopen.x b/sys/fmio/fmfopen.x
new file mode 100644
index 00000000..6b3b897a
--- /dev/null
+++ b/sys/fmio/fmfopen.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FM_FOPEN -- Open an lfile as an FIO file.  A FIO file descriptor is returned
+# for the open file.  CLOSE is used to close the opened file.
+
+int procedure fm_fopen (fm, lfile, mode, type)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile to be opened
+int	mode			#I file access mode
+int	type			#I logical file type
+
+int	fd
+pointer	sp, lfname
+extern	fm_lfopen(), fm_lfclose()
+extern	fm_lfaread(), fm_lfawrite(), fm_lfawait(), fm_lfstati()
+int	fopnbf()
+errchk	fopnbf
+
+begin
+	call smark (sp)
+	call salloc (lfname, SZ_FNAME, TY_CHAR)
+
+	call fm_lfname (fm, lfile, type, Memc[lfname], SZ_FNAME)
+	fd = fopnbf (Memc[lfname], mode, fm_lfopen, fm_lfaread, fm_lfawrite,
+	    fm_lfawait, fm_lfstati, fm_lfclose)
+
+	call sfree (sp)
+	return (fd)
+end
diff --git a/sys/fmio/fmio.h b/sys/fmio/fmio.h
new file mode 100644
index 00000000..41c43676
--- /dev/null
+++ b/sys/fmio/fmio.h
@@ -0,0 +1,97 @@
+# FMIO.H -- File manager interface definitions (private to FMIO).
+
+define  FMIO_MAGIC      28006           # "fm"
+define  FMIO_VERSION    101             # current interface version number
+define  DEF_PAGESIZE    512             # default page size, bytes
+define  DEF_MAXLFILES   128             # default max lfiles / datafile
+define  DEF_MAXPTPAGES  256             # default max page table pages
+define  DEF_OPTBUFNP    4               # default npages in lfile FIO buffer
+define  DEF_MAXBUFNP    0               # default npages max buffer size
+define  DEF_BIGBUFNP    16              # large buffer for lfile copies
+define  DEF_DFHDRLEN    4096            # default DF header buflen (su)
+define  DEF_FCACHESIZE  8               # default open files in file cache
+define  DEF_PMLEN       64              # default lfile pagemap array length
+define  INC_PMLEN       128             # default page table buflen (pte)
+define  SZ_DFNAME       63              # datafile name
+define  SZ_ERROPSTR     63              # operand string, for posted errors
+define  SYNC_INTERVAL   300             # interval between automatic syncs
+define  PT_LFILE        0               # lfile in which page table is stored
+
+# Main FMIO descriptor.
+define  LEN_FMDES       150
+# GEN
+define  FM_MAGIC        Memi[$1+0]      # set once descriptor is initialized
+define  FM_ACTIVE       Memi[$1+1]      # set once descriptor is initialized
+define  FM_CHAN         Memi[$1+2]      # host channel of datafile
+define  FM_MODE         Memi[$1+3]      # access mode of datafile
+define  FM_DFVERSION    Memi[$1+4]      # datafile version number
+define  FM_SZBPAGE      Memi[$1+5]      # datafile page size, bytes
+define  FM_NLFILES      Memi[$1+6]      # number of lfiles in datafile
+define  FM_DATASTART    Memi[$1+7]      # file offset of first data page
+define  FM_DEVBLKSIZE   Memi[$1+8]      # device block size
+define  FM_OPTBUFSIZE   Memi[$1+9]      # optimum FIO buffer size
+define  FM_MAXBUFSIZE   Memi[$1+10]     # maximum FIO buffer size
+define  FM_SZFCACHE     Memi[$1+11]     # number of LF in file cache
+define  FM_LSYNCTIME    Memi[$1+12]     # time of last sync
+define  FM_DHMODIFIED   Memi[$1+13]     # datafile header has been modified
+# FT
+define  FM_FTOFF        Memi[$1+15]     # offset of stored file table (su)
+define  FM_FTLASTNF     Memi[$1+16]     # last new file allocated (runtime)
+define  FM_FTABLE       Memi[$1+17]     # pointer to in-core file table
+# PTI
+define  FM_PTIOFF       Memi[$1+20]     # offset of stored PTI (su)
+define  FM_PTILEN       Memi[$1+21]     # page table index length (allocated)
+define  FM_PTINPTI      Memi[$1+22]     # number of page table pages
+define  FM_PTINDEX      Memi[$1+23]     # pointer to page table index
+# PT
+define  FM_PTLEN        Memi[$1+25]     # number of allocated PTE entries
+define  FM_PTNPTE       Memi[$1+26]     # number of PTEs (data pages) in-core
+define  FM_PTLUPTE      Memi[$1+27]     # last updated PTE on disk
+define  FM_PTABLE       Memi[$1+28]     # pointer to page table data
+# LFC
+define  FM_FCACHE       Memi[$1+30]     # pointer to file cache descriptor
+define  FM_ERRCODE      Memi[$1+31]     # opcode for posting errors
+define  FM_ERROPSTR     Memc[P2C($1+32)]# error operand string
+define  FM_DFNAME       Memc[P2C($1+96)]# datafile name, for error messages
+
+# File table entry (FTE) during datafile access.
+define  LEN_FTE         8               # length of file table entry (ints)
+define  LF_FM           Memi[$1]        # backpointer to FMIO descriptor
+define  LF_FSIZE        Memi[$1+1]      # file size, bytes
+define  LF_FLAGS        Memi[$1+2]      # file bitflags
+define  LF_STATUS       Memi[$1+3]      # status word for async i/o
+define  LF_LTSIZE       Memi[$1+4]      # logical size of last transfer
+define  LF_NPAGES       Memi[$1+5]      # number of pages in file page table
+define  LF_PAGEMAP      Memi[$1+6]      # pointer to pagemap array
+define  LF_PMLEN        Memi[$1+7]      # length of pagemap array
+
+# FTE bitflags.
+define	LFF_SAVE		007B	# flags saved while datafile is closed
+define  LFF_ALLOCATED		001B	# lfile slot has been allocated
+define  LFF_DELETED             002B    # set if file is deleted
+define  LFF_TEXTFILE            004B    # set if file is a text file
+define  LFF_IOINPROGRESS        010B    # set when i/o is in progress
+define  LFF_LOCKOUT             020B    # set when i/o is in progress
+
+# --------------
+# Physical datafile file format.
+
+# Datafile file header.
+define  LEN_DHSTRUCT    12
+define  DH_MAGIC        Memi[$1]        # magic value identifying data format
+define  DH_DFVERSION    Memi[$1+1]      # FMIO version used to write datafile
+define  DH_SZBPAGE      Memi[$1+2]      # datafile page size, bytes
+define  DH_NLFILES      Memi[$1+3]      # number of lfiles in datafile
+define  DH_FTOFF        Memi[$1+4]      # offset of file table in datafile
+define  DH_FTLASTNF     Memi[$1+5]      # last new file allocated (runtime)
+define  DH_PTIOFF       Memi[$1+6]      # offset of stored page table index
+define  DH_PTILEN       Memi[$1+7]      # page table index length (allocated)
+define  DH_PTINPTI      Memi[$1+8]      # number of page table pages
+define  DH_PTLEN        Memi[$1+9]      # number of allocated PTE entries
+define  DH_PTNPTE       Memi[$1+10]     # number of PTEs (data pages)
+define  DH_DATASTART    Memi[$1+11]     # file offset of first data page
+
+# File table entry (FTE) on disk.
+define  LEN_FTEX        2               # length of file table entry (ints)
+define  FT_FSIZE        Memi[$1]        # file size, bytes
+define  FT_FLAGS        Memi[$1+1]      # file bitflags
diff --git a/sys/fmio/fmiobind.x b/sys/fmio/fmiobind.x
new file mode 100644
index 00000000..b31c7ada
--- /dev/null
+++ b/sys/fmio/fmiobind.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"fmio.h"
+
+# FMIO_BIND -- Called when a new datafile is being created, to bind the
+# current datafile parameters set in the descriptor to the physical datafile.
+
+procedure fmio_bind (fm)
+
+pointer	fm			#I FMIO descriptor
+
+pointer	ft, pti, pt
+int	chan, szbpage, ftoff, ftlen, ptioff, ptilen, ptlen
+
+begin
+	if (FM_ACTIVE(fm) != NO)
+	    return
+
+	# Initialize buffer sizes.
+	call fmio_setbuf (fm)
+
+	chan    = FM_CHAN(fm)
+	szbpage = FM_SZBPAGE(fm)
+	ftoff   = LEN_DHSTRUCT + 1
+	ftlen   = (FM_NLFILES(fm) + 1) * LEN_FTE
+	ptioff  = ftoff + (FM_NLFILES(fm) + 1) * LEN_FTEX
+	ptilen  = FM_PTILEN(fm)
+	ptlen	= szbpage / (SZ_SHORT * SZB_CHAR)
+
+	# Determine the byte offset of the first data page.
+	FM_DATASTART(fm) = max (1,
+	    (((ptioff+ptilen-1) * SZ_INT*SZB_CHAR) + szbpage-1) /
+	    szbpage) * szbpage + 1
+
+	# Initialize the file table.
+	call calloc (ft, ftlen, TY_STRUCT)
+	FM_FTOFF(fm)		= ftoff
+	FM_FTLASTNF(fm)		= 0
+	FM_FTABLE(fm)		= ft
+
+	# Initialize the page table index.
+	call calloc (pti, ptilen, TY_INT)
+	FM_PTIOFF(fm)		= ptioff
+	FM_PTINPTI(fm)		= 0
+	FM_PTINDEX(fm)		= pti
+
+	# Initialize the page table, stored in the data pages.  Note that the
+	# page table length must be an integral multiple of the page size.
+
+	call calloc (pt, ptlen, TY_SHORT)
+	FM_PTLEN(fm)		= ptlen
+	FM_PTNPTE(fm)		= 0
+	FM_PTLUPTE(fm)		= 0
+	FM_PTABLE(fm)		= pt
+
+	FM_ACTIVE(fm) = YES
+	FM_DHMODIFIED(fm) = YES
+
+	call fm_sync (fm)
+end
diff --git a/sys/fmio/fmioerr.x b/sys/fmio/fmioerr.x
new file mode 100644
index 00000000..dd15e7be
--- /dev/null
+++ b/sys/fmio/fmioerr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmio.h"
+
+# FMIO_ERRCHK -- Check for a posted error, and process the error if one is
+# posted.
+
+procedure fmio_errchk (fm)
+
+pointer	fm			#I FMIO descriptor
+
+int	errcode
+
+begin
+	errcode = FM_ERRCODE(fm)
+	if (errcode != OK) {
+	    FM_ERRCODE(fm) = OK
+	    call syserrs (errcode, FM_ERROPSTR(fm))
+	}
+end
diff --git a/sys/fmio/fmioextnd.x b/sys/fmio/fmioextnd.x
new file mode 100644
index 00000000..0517eb93
--- /dev/null
+++ b/sys/fmio/fmioextnd.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <mach.h>
+include "fmio.h"
+
+# FMIO_EXTEND -- Allocate new pages in the datafile.  Allocate the new pages
+# and modify the in-core page table and lfile pagemap accordingly.  The PTI is
+# not modified, allocating new pages to store the page table itself, until
+# fm_sync is called.  The page number of the first page allocated is returned
+# as the function value (a contiguous sequence of pages will be allocated).
+
+int procedure fmio_extend (fm, lfile, npages)
+
+pointer fm                      #I FMIO descriptor
+int     lfile                   #I lfile getting the new pages
+int     npages                  #I number of pages to add
+
+pointer pt, pm, lf
+int	npte_perpage, npti
+int     inc, np, p1, p2, l1, l2, i
+int	krealloc()
+
+begin
+        # Extend the global page table.
+        p1 = FM_PTNPTE(fm) + 1
+        p2 = p1 + npages - 1
+
+	# Make sure we have enough page table index entries for the new pages.
+	if (lfile != PT_LFILE) {
+	    npte_perpage = FM_SZBPAGE(fm) / (SZB_CHAR*SZ_SHORT)
+	    np = p2 + FM_PTILEN(fm)
+	    npti = (np + npte_perpage-1) / npte_perpage
+	    if (npti > FM_PTILEN(fm)) {
+		call fmio_posterr (fm, SYS_FMPTIOVFL, FM_DFNAME(fm))
+		return (ERR)
+	    }
+	}
+
+        # Increase the size of the in-core page table if necessary.
+        if (p2 > FM_PTLEN(fm)) {
+	    inc = FM_SZBPAGE(fm) / (SZ_SHORT * SZB_CHAR)
+            FM_PTLEN(fm) = ((p2 + inc-1) / inc) * inc
+            if (krealloc (FM_PTABLE(fm), FM_PTLEN(fm), TY_SHORT) == ERR)
+		return (ERR)
+        }
+
+        # Add the pages to the global page table.
+        FM_PTNPTE(fm) = p2
+        pt = FM_PTABLE(fm)
+        do i = p1, p2
+            Mems[pt+i-1] = lfile
+
+        lf = FM_FTABLE(fm) + lfile * LEN_FTE
+        pm = LF_PAGEMAP(lf)
+
+        # Extend the lfile page table if the lfile is active.
+        if (pm != NULL) {
+            l1 = LF_NPAGES(lf) + 1
+            l2 = l1 + npages - 1
+
+            # Increase the size of the lfile pagemap if necessary.
+            if (l2 > LF_PMLEN(lf)) {
+                LF_PMLEN(lf) = (l2 + INC_PMLEN-1) / INC_PMLEN * INC_PMLEN
+                if (krealloc (LF_PAGEMAP(lf), LF_PMLEN(lf), TY_INT) == ERR)
+		    return (ERR)
+                pm = LF_PAGEMAP(lf)
+            }
+
+            # Add the pages to the lfile page table.
+            LF_NPAGES(lf) = l2
+            do i = l1, l2
+                Memi[pm+i-1] = p1 + i - l1
+        }
+
+	# Update the FTE for lfile zero (the page table file).
+	lf = FM_FTABLE(fm)
+	LF_FSIZE(lf) = FM_PTNPTE(fm) * SZ_SHORT * SZB_CHAR
+
+        FM_DHMODIFIED(fm) = YES
+        return (p1)
+end
diff --git a/sys/fmio/fmiopost.x b/sys/fmio/fmiopost.x
new file mode 100644
index 00000000..23c5eaae
--- /dev/null
+++ b/sys/fmio/fmiopost.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmio.h"
+
+# FMIO_POSTERR -- Post an error.  This is called to flag an error condition
+# by low level code that cannot call the error handling code directly.
+
+procedure fmio_posterr (fm, errcode, opstr)
+
+pointer	fm			#I FMIO descriptor
+int	errcode			#I error code
+char	opstr[ARB]		#I operand id string
+
+begin
+	# In case of multiple errors, post only the first one.
+	if (FM_ERRCODE(fm) == OK) {
+	    FM_ERRCODE(fm) = errcode
+	    call strcpy (opstr, FM_ERROPSTR(fm), SZ_ERROPSTR)
+	}
+end
diff --git a/sys/fmio/fmiorhdr.x b/sys/fmio/fmiorhdr.x
new file mode 100644
index 00000000..1b7f6c3c
--- /dev/null
+++ b/sys/fmio/fmiorhdr.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<knet.h>
+include	"fmio.h"
+
+# FMIO_READHEADER -- Read the header of a FMIO datafile and set up the FMIO
+# runtime descriptor.
+
+procedure fmio_readheader (fm)
+
+pointer	fm			#I FMIO descriptor
+
+pointer	sp, buf, dh, pti, pt, ft, ip, op
+int	offset, buflen, npti, p1, p2, d1, d2, b_off1, b_off2, i
+int	status, chan, nbytes, nwords, maxpages, szbpage
+errchk	syserrs, calloc, malloc, realloc
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (dh, LEN_DHSTRUCT, TY_STRUCT)
+
+	chan = FM_CHAN(fm)
+
+	# Make a guess at the size of buffer needed to hold the header.
+	buflen = DEF_DFHDRLEN
+	call malloc (buf, buflen, TY_STRUCT)
+
+	# Read the full datafile header area into BUF.
+	repeat {
+	    # Get the raw data.
+	    nbytes = buflen * (SZ_STRUCT * SZB_CHAR)
+	    call zardbf (chan, Memi[buf], nbytes, 1)
+	    call zawtbf (chan, status)
+	    if (status == ERR)
+		call syserrs (SYS_FMRERR, FM_DFNAME(fm))
+
+	    # Extract the datafile header struct.
+	    call miiupk32 (Memi[buf], Memi[dh], LEN_DHSTRUCT, TY_STRUCT)
+	    if (DH_MAGIC(dh) != FMIO_MAGIC)
+		call syserrs (SYS_FMBADMAGIC, FM_DFNAME(fm))
+
+	    # Repeat if the full header was not read.
+	    if (DH_DATASTART(dh)-1 > nbytes) {
+		buflen = DH_DATASTART(dh)-1 / (SZ_STRUCT * SZB_CHAR)
+		call realloc (buf, buflen, TY_STRUCT)
+	    } else if (status < DH_DATASTART(dh)-1) {
+		call syserrs (SYS_FMTRUNC, FM_DFNAME(fm))
+	    } else
+		break
+	}
+
+	# Compute region of file in buffer.
+	b_off1 = 1
+	b_off2 = b_off1 + buflen * SZ_STRUCT * SZB_CHAR
+
+	# Copy general header fields.
+	FM_DFVERSION(fm)	= DH_DFVERSION(dh)
+	FM_SZBPAGE(fm)		= DH_SZBPAGE(dh)
+	FM_NLFILES(fm)		= DH_NLFILES(dh)
+	FM_DATASTART(fm)	= DH_DATASTART(dh)
+	FM_LSYNCTIME(fm)	= clktime(0)
+	FM_DHMODIFIED(fm)	= NO
+
+	# Initialize buffer sizes.
+	szbpage = FM_SZBPAGE(fm)
+	call fmio_setbuf (fm)
+	if (FM_SZBPAGE(fm) != szbpage)
+	    call syserrs (SYS_FMBLKCHSZ, FM_DFNAME(fm))
+
+	# Initialize the file table.
+	call calloc (ft, (FM_NLFILES(fm) + 1) * LEN_FTE, TY_STRUCT)
+	FM_FTOFF(fm)		= DH_FTOFF(dh)
+	FM_FTLASTNF(fm)		= DH_FTLASTNF(dh)
+	FM_FTABLE(fm)		= ft
+
+	ip = buf + FM_FTOFF(fm) - 1
+	call miiupk32 (Memi[ip], Memi[ip],
+	    (FM_NLFILES(fm) + 1) * LEN_FTEX, TY_INT)
+
+	do i = 0, FM_NLFILES(fm) {
+	    op = ft + i * LEN_FTE
+	    LF_FSIZE(op) = FT_FSIZE(ip)
+	    LF_FLAGS(op) = FT_FLAGS(ip)
+	    ip = ip + LEN_FTEX
+	}
+
+	# Read the page table index.
+	FM_PTIOFF(fm)		= DH_PTIOFF(dh)
+	FM_PTILEN(fm)		= DH_PTILEN(dh)
+	FM_PTINPTI(fm)		= DH_PTINPTI(dh)
+
+	ip = buf + FM_PTIOFF(fm) - 1
+	call malloc (pti, FM_PTILEN(fm), TY_INT)
+	call miiupk32 (Memi[ip], Memi[pti], FM_PTILEN(fm), TY_INT)
+	FM_PTINDEX(fm)		= pti
+
+	# Now read the page table itself, stored in the data pages.
+	FM_PTLEN(fm)		= DH_PTLEN(dh)
+	FM_PTNPTE(fm)		= DH_PTNPTE(dh)
+	FM_PTLUPTE(fm)		= DH_PTNPTE(dh)
+
+	call malloc (pt, FM_PTLEN(fm), TY_SHORT)
+	FM_PTABLE(fm)		= pt
+
+	maxpages = FM_MAXBUFSIZE(fm) / FM_SZBPAGE(fm)
+	if (maxpages <= 0)
+	    maxpages = DEF_BIGBUFNP
+
+	op = pt
+	npti = FM_PTINPTI(fm)
+	for (p1=1;  p1 <= npti;  p1=p2) {
+	    # Get a contiguous range of page table pages.
+	    d1 = Memi[pti+p1-1]
+	    for (p2=p1+1;  p2 <= npti;  p2=p2+1) {
+		d2 = Memi[pti+p2-1]
+		if (d2-d1 != p2-p1 || p2-p1 >= maxpages)
+		    break
+	    }
+
+	    # Read in the pages.
+	    nbytes = (p2 - p1) * FM_SZBPAGE(fm)
+	    nwords = nbytes / (SZB_CHAR * SZ_SHORT)
+	    offset = (d1-1) * FM_SZBPAGE(fm) + FM_DATASTART(fm)
+
+	    # Check to see if data is in BUF before reading datafile.
+	    if (offset >= b_off1 && (offset+nbytes) <= b_off2)
+		call bytmov (Memi[buf], offset, Mems[op], 1, nbytes)
+	    else {
+		call zardbf (chan, Mems[op], nbytes, offset)
+		call zawtbf (chan, status)
+		if (status < nbytes)
+		    call syserrs (SYS_FMTRUNC, FM_DFNAME(fm))
+	    }
+
+	    op = op + nwords
+	}
+
+	# Swap the data.
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (Mems[pt], 1, Mems[pt], 1, npti * FM_SZBPAGE(fm))
+
+	call mfree (buf, TY_STRUCT)
+	call sfree (sp)
+end
diff --git a/sys/fmio/fmiosbuf.x b/sys/fmio/fmiosbuf.x
new file mode 100644
index 00000000..358d4136
--- /dev/null
+++ b/sys/fmio/fmiosbuf.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	"fmio.h"
+
+# FMIO_SETBUF -- Set the various buffer size parameters, making sure that the
+# physical constraints are met, i.e., that the buffers are an integral
+# multiple of the device block size, and do not exceed the maximum transfer
+# size for the device.
+
+procedure fmio_setbuf (fm)
+
+pointer	fm			#I FMIO descriptor
+
+int	devblksize, devmaxsize
+int	optbufsize, maxbufsize, szbpage
+
+begin
+	# Get the device parameters for the device on which datafile resides.
+	call zsttbf (FM_CHAN(fm), FSTT_BLKSIZE, devblksize)
+	call zsttbf (FM_CHAN(fm), FSTT_MAXBUFSIZE, devmaxsize)
+
+	# Make sure the page size is an integral multiple of the block size.
+	szbpage = (FM_SZBPAGE(fm) + devblksize-1) / devblksize * devblksize
+
+	# Set the optimum (default) file buffer size.
+	optbufsize = FM_OPTBUFSIZE(fm)
+	if (optbufsize <= 0) {
+	    if (DEF_OPTBUFNP <= 0)
+		call zsttbf (FM_CHAN(fm), FSTT_OPTBUFSIZE, optbufsize)
+	    else
+		optbufsize = DEF_OPTBUFNP * szbpage
+	}
+
+	# Set the maximum file buffer size.
+	maxbufsize = FM_MAXBUFSIZE(fm)
+	if (maxbufsize <= 0) {
+	    if (DEF_MAXBUFNP > 0)
+		maxbufsize = DEF_MAXBUFNP * szbpage
+	    else
+		maxbufsize = devmaxsize
+	}
+
+	# Apply constraints and store values.
+	if (devmaxsize > 0)
+	    maxbufsize = min (maxbufsize, devmaxsize)
+	if (maxbufsize > 0)
+	    FM_MAXBUFSIZE(fm) = max (szbpage, maxbufsize / szbpage * szbpage)
+
+	FM_OPTBUFSIZE(fm) = max (szbpage, optbufsize / szbpage * szbpage)
+	FM_DEVBLKSIZE(fm) = devblksize
+	FM_SZBPAGE(fm)    = szbpage
+
+	FM_DHMODIFIED(fm) = YES
+end
diff --git a/sys/fmio/fmiotick.x b/sys/fmio/fmiotick.x
new file mode 100644
index 00000000..c29e035b
--- /dev/null
+++ b/sys/fmio/fmiotick.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmio.h"
+
+# FMIO_TICK -- Check the clock and do things that need to get done
+# periodically, like sync the datafile.
+
+procedure fmio_tick (fm)
+
+pointer	fm			#I FMIO descriptor
+
+long	clktime()
+
+begin
+	if (clktime(FM_LSYNCTIME(fm)) > SYNC_INTERVAL)
+	    call fm_sync (fm)
+end
diff --git a/sys/fmio/fmlfard.x b/sys/fmio/fmlfard.x
new file mode 100644
index 00000000..2e463f72
--- /dev/null
+++ b/sys/fmio/fmlfard.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFAREAD -- Asynchronous blocked read from an lfile.  The differences
+# between text and binary lfiles are not visible above this level; both
+# appear as binary files to FIO.
+
+procedure fm_lfaread (lf, buf, maxbytes, offset)
+
+pointer	lf			#I lfile descriptor
+char	buf[ARB]		#O output data buffer
+int	maxbytes		#I max bytes to read
+long	offset			#I lfile offset
+
+int	status, nb
+
+begin
+	# If reading text data, unpack the text data in place.
+	if (and (LF_FLAGS(lf), LFF_TEXTFILE) != 0) {
+	    nb = (maxbytes + SZB_CHAR-1) / SZB_CHAR
+	    call fm_lfbinread (lf, buf, nb, (offset-1) / SZB_CHAR + 1)
+	    call fm_lfbinwait (lf, status)
+	    if (status > 0)
+		call chrupk (buf, 1, buf, 1, min(maxbytes,status))
+	} else
+	    call fm_lfbinread (lf, buf, maxbytes, offset)
+end
diff --git a/sys/fmio/fmlfawr.x b/sys/fmio/fmlfawr.x
new file mode 100644
index 00000000..7d122dc0
--- /dev/null
+++ b/sys/fmio/fmlfawr.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFAWRITE -- Asynchronous blocked write to an lfile.  The differences
+# between text and binary lfiles are not visible above this level; both
+# appear as binary files to FIO.
+
+procedure fm_lfawrite (lf, buf, nbytes, offset)
+
+pointer	lf			#I lfile descriptor
+char	buf[ARB]		#O input data buffer
+int	nbytes			#I nbytes to write
+long	offset			#I lfile offset
+
+int	status, nb
+pointer	sp, pk_buf
+
+begin
+	if (and (LF_FLAGS(lf), LFF_TEXTFILE) == 0)
+	    call fm_lfbinwrite (lf, buf, nbytes, offset)
+	else {
+	    call smark (sp)
+	    call salloc (pk_buf, nbytes / SZB_CHAR, TY_CHAR)
+
+	    # Wait for i/o to complete before freeing buffer!
+	    nb = (nbytes + SZB_CHAR-1) / SZB_CHAR
+	    call chrpak (buf, 1, Memc[pk_buf], 1, nb)
+	    call fm_lfbinwrite (lf, Memc[pk_buf], nb, (offset-1)/SZB_CHAR+1)
+	    call fm_lfbinwait (lf, status)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/fmio/fmlfawt.x b/sys/fmio/fmlfawt.x
new file mode 100644
index 00000000..1fa66581
--- /dev/null
+++ b/sys/fmio/fmlfawt.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFAWAIT -- Wait for i/o on an lfile.
+
+procedure fm_lfawait (lf, status)
+
+pointer	lf			#I lfile descriptor
+int	status			#O i/o status (nbytes transferred or ERR)
+
+begin
+	call fm_lfbinwait (lf, status)
+	if (and (LF_FLAGS(lf), LFF_TEXTFILE) != 0)
+	    if (status > 0)
+		status = status * SZB_CHAR
+end
diff --git a/sys/fmio/fmlfbrd.x b/sys/fmio/fmlfbrd.x
new file mode 100644
index 00000000..acead281
--- /dev/null
+++ b/sys/fmio/fmlfbrd.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFBINREAD -- Asynchronous blocked binary read from an lfile.  We deal
+# only with binary data here; unpacking of text must be done at a higher
+# level.  The basic procedure is to convert the indicated lfile segment into
+# a range of lfile pages, then use the pagemap for the lfile to map these onto
+# physical datafile pages.  I/O is done in chunks of contiguous pages until
+# the requested amount of data has been transferred.
+
+procedure fm_lfbinread (lf, buf, maxbytes, offset)
+
+pointer	lf			#I lfile descriptor
+char	buf[ARB]		#O output data buffer
+int	maxbytes		#I max bytes to read
+long	offset			#I lfile offset
+
+pointer	fm, pm
+int	status, chan, nleft, szbpage
+int	l1,l2, p1,p2, d1,d2, op, nb, np
+
+begin
+	fm = LF_FM(lf)
+	pm = LF_PAGEMAP(lf)
+
+	# Verify descriptor.
+	if (fm == NULL || pm == NULL) {
+	    LF_STATUS(lf) = ERR
+	    return
+	} else
+	    LF_STATUS(lf) = 0
+
+	np = LF_NPAGES(lf)
+	chan = FM_CHAN(fm)
+	    
+	# Check that the read is in bounds.
+	nleft = min (offset + maxbytes, LF_FSIZE(lf) + 1) - offset
+	if (nleft <= 0)
+	    return		# read at EOF
+
+	# Map lfile offset,nbytes into a range of lfile pages.
+	# I/O transfers are required to be aligned on page boundaries.
+	# Note that less than full page may be transferred in a read.
+
+	szbpage = FM_SZBPAGE(fm)
+	l1 = (offset - 1) / szbpage + 1
+	l2 = l1 + ((nleft + szbpage-1) / szbpage) - 1
+
+	# Read the data from the physical datafile into the user buffer,
+	# mapping lfile pages to physical offsets and moving data in chunks
+	# of as many contiguous pages as possible.
+
+	op = 1
+	for (p1=l1;  nleft > 0 && p1 <= l2;  p1=p2) {
+	    # Get a contiguous range of datafile pages.
+	    d1 = Memi[pm+p1-1]
+	    for (p2=p1+1;  p2 <= l2;  p2=p2+1) {
+		d2 = Memi[pm+p2-1]
+		if (d2 - d1 != p2 - p1)
+		    break
+	    }
+
+	    # Read in the file segment.
+	    nb = min (nleft, (p2 - p1) * szbpage)
+	    call zardbf (chan, buf[op], nb, (d1-1)*szbpage + FM_DATASTART(fm))
+	    LF_FLAGS(lf) = or (LF_FLAGS(lf), LFF_IOINPROGRESS)
+	    LF_LTSIZE(lf) = nb
+	    
+	    # Bump the i/o counters.
+	    op = op + nb / SZB_CHAR
+	    nleft = nleft - nb
+
+	    # If we didn't read all the data, wait until the read completes.
+	    if (nleft > 0) {
+		call zawtbf (chan, status)
+		LF_FLAGS(lf) = and (LF_FLAGS(lf), not(LFF_IOINPROGRESS))
+		if (status == ERR) {
+		    LF_STATUS(lf) = ERR
+		    return
+		} else if (status == 0) {
+		    break
+		} else
+		    LF_STATUS(lf) = LF_STATUS(lf) + status
+	    }
+	}
+end
diff --git a/sys/fmio/fmlfbwr.x b/sys/fmio/fmlfbwr.x
new file mode 100644
index 00000000..f16b71d1
--- /dev/null
+++ b/sys/fmio/fmlfbwr.x
@@ -0,0 +1,109 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFBINWRITE -- Asynchronous blocked binary write to an lfile.  We deal
+# only with binary data here; unpacking of text must be done at a higher
+# level.  The basic procedure is to convert the indicated lfile segment into
+# a range of lfile pages, then use the pagemap for the lfile to map these onto
+# physical datafile pages.  I/O is done in chunks of contiguous pages until
+# the requested amount of data has been transferred.  When writing at or
+# beyond EOF, new pages are automatically allocated upon demand.
+
+procedure fm_lfbinwrite (lf, buf, nbytes, offset)
+
+pointer	lf			#I lfile descriptor
+char	buf[ARB]		#I input data buffer
+int	nbytes			#I nbytes to write
+long	offset			#I lfile offset
+
+pointer	fm, pm
+int	status, chan, nleft, szbpage
+int	lfile, l1,l2, p1,p2, d1,d2, ip, nb, nt
+int	fmio_extend()
+
+begin
+	fm = LF_FM(lf)
+	pm = LF_PAGEMAP(lf)
+
+	# Verify descriptor.
+	if (fm == NULL || pm == NULL) {
+	    LF_STATUS(lf) = ERR
+	    return
+	} else
+	    LF_STATUS(lf) = 0
+
+	chan = FM_CHAN(fm)
+	szbpage = FM_SZBPAGE(fm)
+	lfile = (lf - FM_FTABLE(fm)) / LEN_FTE
+	nleft = nbytes
+
+	# Extend the pagemap?
+	while (offset + nbytes > LF_NPAGES(lf)*szbpage + 1)
+	    if (fmio_extend (fm, lfile, 1) == ERR) {
+		LF_STATUS(lf) = ERR
+		return
+	    } else
+		pm = LF_PAGEMAP(lf)
+
+	# Map lfile offset,nbytes into a range of lfile pages.
+	# I/O transfers are required to be aligned on page boundaries.
+
+	l1 = (offset - 1) / szbpage + 1
+	l2 = l1 + ((nleft + szbpage-1) / szbpage) - 1
+
+	# Write the data from the user buffer to the physical datafile,
+	# mapping lfile pages to physical offsets and moving data in chunks
+	# of as many contiguous pages as possible.
+
+	ip = 1
+	for (p1=l1;  nleft > 0 && p1 <= l2;  p1=p2) {
+	    # Get a contiguous range of datafile pages.
+	    d1 = Memi[pm+p1-1]
+	    for (p2=p1+1;  p2 <= l2;  p2=p2+1) {
+		d2 = Memi[pm+p2-1]
+		if (d2 - d1 != p2 - p1)
+		    break
+	    }
+
+	    # Compute the logical transfer size NB, and the amount of data
+	    # to be physically written NT.  The latter is always an integral
+	    # number of datafile pages in size.  NOTE that this requires that
+	    # the user buffer be an integral multiple of the page size, to
+	    # prevent referencing off the end of the buffer.
+
+	    nb = min (nleft, (p2 - p1) * szbpage)
+	    nt = (nb + szbpage-1) / szbpage * szbpage
+	    LF_LTSIZE(lf) = nb
+
+	    # Write the file segment.
+	    call zawrbf (chan, buf[ip], nt, (d1-1)*szbpage + FM_DATASTART(fm))
+	    LF_FLAGS(lf) = or (LF_FLAGS(lf), LFF_IOINPROGRESS)
+	    
+	    # Bump the i/o counters.
+	    ip = ip + nb / SZB_CHAR
+	    nleft = nleft - nb
+
+	    # If we didn't write all the data, wait until the write completes.
+	    if (nleft > 0) {
+		call zawtbf (chan, status)
+		LF_FLAGS(lf) = and (LF_FLAGS(lf), not(LFF_IOINPROGRESS))
+		if (status == ERR) {
+		    LF_STATUS(lf) = ERR
+		    return
+		} else if (status == 0) {
+		    break
+		} else
+		    LF_STATUS(lf) = LF_STATUS(lf) + min(LF_LTSIZE(lf),status)
+	    }
+	}
+
+	# Update the lfile size counter.
+	nb = offset + nbytes - 1
+	if (nb > LF_FSIZE(lf)) {
+	    LF_FSIZE(lf) = nb
+	    FM_DHMODIFIED(fm) = YES
+	}
+end
diff --git a/sys/fmio/fmlfbwt.x b/sys/fmio/fmlfbwt.x
new file mode 100644
index 00000000..2310c281
--- /dev/null
+++ b/sys/fmio/fmlfbwt.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	"fmio.h"
+
+# FM_LFBINWAIT -- Wait for i/o on a binary lfile.
+
+procedure fm_lfbinwait (lf, status)
+
+pointer	lf			#I lfile descriptor
+int	status			#O i/o status (nbytes transferred or ERR)
+
+pointer	fm
+int	chan
+
+begin
+	fm = LF_FM(lf)
+	chan = FM_CHAN(fm)
+
+	# Wait for i/o and increment byte count.
+	if (and (LF_FLAGS(lf), LFF_IOINPROGRESS) != 0) {
+	    call zawtbf (chan, status)
+	    if (status >= 0)
+		LF_STATUS(lf) = LF_STATUS(lf) + min(LF_LTSIZE(lf),status)
+	    else
+		LF_STATUS(lf) = ERR
+	    LF_FLAGS(lf) = and (LF_FLAGS(lf), not(LFF_IOINPROGRESS))
+	}
+
+	call fmio_tick (fm)
+	status = LF_STATUS(lf)
+end
diff --git a/sys/fmio/fmlfcls.x b/sys/fmio/fmlfcls.x
new file mode 100644
index 00000000..3084373d
--- /dev/null
+++ b/sys/fmio/fmlfcls.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmio.h"
+
+# FM_LFCLOSE -- Close an lfile descriptor.  There isn't much for us to do,
+# since the physical datafile remains open, and opening an lfile does not
+# allocate a descriptor.
+
+procedure fm_lfclose (lf, status)
+
+pointer	lf			#I lfile descriptor
+int	status			#O i/o status (nbytes transferred or ERR)
+
+pointer	fm
+
+begin
+	fm = LF_FM(lf)
+
+	if (fm == NULL)
+	    status = ERR
+	else if (FM_MAGIC(fm) != FMIO_MAGIC)
+	    status = ERR
+	else
+	    status = OK
+
+	call fmio_tick (fm)
+end
diff --git a/sys/fmio/fmlfcopy.x b/sys/fmio/fmlfcopy.x
new file mode 100644
index 00000000..db937a7b
--- /dev/null
+++ b/sys/fmio/fmlfcopy.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	"fmio.h"
+
+# FM_LFCOPY -- Copy an lfile, either to another lfile within the same
+# datafile, or to another datafile.
+
+procedure fm_lfcopy (old, o_lfile, new, n_lfile)
+
+pointer	old, new		#I FMIO descriptors of source and destination
+int	o_lfile, n_lfile	#I lfile numbers of source and dest. lfiles
+
+long	offset
+int	n_szbpage
+pointer	sp, o_ft, n_ft, o_lf, n_lf, o_lfname, n_lfname, buf
+int	maxpages, maxbytes, nbytes, type, nleft, status
+
+errchk	fmio_errchk, fmio_bind, syserrs
+define	olderr_ 91
+define	newerr_ 92
+
+begin
+	# Verify input.
+	if (o_lfile < 0 || o_lfile > FM_NLFILES(old))
+	    goto olderr_
+	if (n_lfile < 0 || n_lfile > FM_NLFILES(new))
+	    goto newerr_
+
+	# Compute some useful values.
+	o_ft = FM_FTABLE(old)
+	n_ft = FM_FTABLE(new)
+	n_szbpage = FM_SZBPAGE(new)
+	maxpages = FM_MAXBUFSIZE(new) / n_szbpage
+	if (maxpages <= 0)
+	    maxpages = DEF_BIGBUFNP
+	maxbytes = n_szbpage * maxpages
+
+	# Copy the lfile.
+	o_lf = o_ft + o_lfile * LEN_FTE
+	n_lf = n_ft + n_lfile * LEN_FTE
+
+	# Skip empty or deleted lfiles.
+	LF_FLAGS(n_lf) = and (LF_FLAGS(o_lf), not(LFF_DELETED))
+	if (LF_FSIZE(o_lf) <= 0 || and(LF_FLAGS(o_lf),LFF_DELETED) != 0)
+	    return
+
+	# Get lfile type.
+	type = BINARY_FILE
+	if (and(LF_FLAGS(o_lf),LFF_TEXTFILE) != 0)
+	    type = TEXT_FILE
+
+	# Allocate buffers.
+	call smark (sp)
+	call salloc (o_lfname, SZ_FNAME, TY_CHAR)
+	call salloc (n_lfname, SZ_FNAME, TY_CHAR)
+	call salloc (buf, maxbytes / SZB_CHAR, TY_CHAR)
+
+	# Open old lfile.
+	call fm_lfname (old, o_lfile, type, Memc[o_lfname], SZ_FNAME)
+	call strpak (Memc[o_lfname], Memc[o_lfname], SZ_FNAME)
+	call fm_lfopen (Memc[o_lfname], READ_ONLY, o_lf)
+	if (o_lf == ERR)
+	    goto olderr_
+
+	# Open new lfile.
+	call fm_lfname (new, n_lfile, type, Memc[n_lfname], SZ_FNAME)
+	call strpak (Memc[n_lfname], Memc[n_lfname], SZ_FNAME)
+	call fm_lfopen (Memc[n_lfname], NEW_FILE, n_lf)
+	if (n_lf == ERR)
+	    goto newerr_
+
+	# Copy the lfile data (as a binary file to avoid needless
+	# character unpack/pack).
+
+	nleft = LF_FSIZE(o_lf)
+	for (offset=1;  nleft > 0;  offset=offset+nbytes) {
+	    # Read a block of data.
+	    call fm_lfbinread (o_lf, Memc[buf], maxbytes, offset)
+	    call fm_lfbinwait (o_lf, nbytes)
+	    if (nbytes == ERR)
+		goto olderr_
+	    else if (nbytes == 0)
+		break
+
+	    # Write to the new datafile.
+	    call fm_lfbinwait (n_lf, status)
+	    if (status == ERR)
+		goto newerr_
+	    call fm_lfbinwrite (n_lf, Memc[buf], nbytes, offset)
+	    nleft = nleft - nbytes
+	}
+
+	# Wait for the last write to terminate.
+	call fm_lfbinwait (n_lf, status)
+	if (status == ERR)
+	    goto newerr_
+
+	# Close the lfiles.
+	call fm_lfclose (o_lf, status)
+	if (status == ERR)
+	    goto olderr_
+	call fm_lfclose (n_lf, status)
+	if (status == ERR)
+	    goto newerr_
+
+	call fmio_errchk (old)
+	call fmio_errchk (new)
+
+	call sfree (sp)
+	return
+
+olderr_
+	call syserrs (SYS_FMLFCOPY, FM_DFNAME(old))
+newerr_
+	call syserrs (SYS_FMLFCOPY, FM_DFNAME(new))
+end
diff --git a/sys/fmio/fmlfdel.x b/sys/fmio/fmlfdel.x
new file mode 100644
index 00000000..001de927
--- /dev/null
+++ b/sys/fmio/fmlfdel.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"fmio.h"
+
+# FM_LFDELETE -- Delete an lfile.
+
+procedure fm_lfdelete (fm, lfile)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile number
+
+pointer	lf
+errchk	syserrs, fmio_bind, fmio_errchk
+
+begin
+	call fmio_bind (fm)
+	call fmio_errchk (fm)
+
+        # Verify input.
+        if (lfile < 0 || lfile > FM_NLFILES(fm))
+            call syserrs (SYS_FMLFNOOB, FM_DFNAME(fm))
+
+        lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	LF_FLAGS(lf) = or (LF_FLAGS(lf), LFF_DELETED)
+
+	FM_DHMODIFIED(fm) = YES
+	call fmio_tick (fm)
+end
diff --git a/sys/fmio/fmlfname.x b/sys/fmio/fmlfname.x
new file mode 100644
index 00000000..1d0b92e7
--- /dev/null
+++ b/sys/fmio/fmlfname.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fmset.h>
+include	"fmio.h"
+
+# FM_LFNAME -- Encode the pseudo-filename for an lfile.  This is necessary to
+# pass all lfile info through FIO, when opening a file descriptor on an lfile.
+#
+# The filename syntax is "Tddd.fff" where
+#
+#       T       is 'B' or 'T' for text or binary
+#       ddd     is the encoded descriptor pointer
+#       fff     is the encoded lfile number
+
+procedure fm_lfname (fm, lfile, type, lfname, maxch)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile number
+int	type			#I file type, text or binary
+char	lfname[maxch]		#O encoded lfile filename
+int	maxch			#I max chars out
+
+int	op
+int	itoc()
+errchk	fmio_bind, fmio_errchk
+
+begin
+	call fmio_bind (fm)
+	call fmio_errchk (fm)
+	if (maxch <= 0)
+	    return
+
+	op = 1
+	if (type == TEXT_FILE)
+	    lfname[op] = 'T'
+	else
+	    lfname[op] = 'B'
+	op = min (maxch, op + 1)
+
+	op = min (maxch, op + itoc (fm, lfname[op], maxch-op+1))
+	lfname[op] = '.'
+	op = min (maxch, op + 1)
+	op = min (maxch, op + itoc (lfile, lfname[op], maxch-op+1))
+	lfname[op] = EOS
+end
diff --git a/sys/fmio/fmlfopen.x b/sys/fmio/fmlfopen.x
new file mode 100644
index 00000000..a267834a
--- /dev/null
+++ b/sys/fmio/fmlfopen.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "fmio.h"
+
+# FM_LFOPEN -- Open an lfile.  This routine is designed to be called with a
+# pseudo-filename identifying the FMIO datafile, lfile therein, and file type.
+# This is necessary to conform to the binary file driver interface standard.
+
+procedure fm_lfopen (pk_lfname, mode, chan)
+
+char	pk_lfname[ARB]		#I encoded lfile specification (packed char)
+int	mode			#I file access mode
+int	chan			#O i/o channel assigned (descriptor)
+
+int	flags, lfile, type, np, i
+pointer	sp, lfname, fm, lf, pt, pm
+int	kmalloc(), krealloc(), fm_lfparse()
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (lfname, SZ_FNAME, TY_CHAR)
+
+	flags = 0
+
+	# Parse the file spec.
+	call strupk (pk_lfname, Memc[lfname], SZ_FNAME)
+	if (fm_lfparse (Memc[lfname], fm, lfile, type) == ERR)
+	    goto err_
+	else if (type == TEXT_FILE)
+	    flags = flags + LFF_TEXTFILE
+
+	# Verify input.
+	if (FM_MAGIC(fm) != FMIO_MAGIC)
+	    goto err_
+	else if (lfile < 0 || lfile > FM_NLFILES(fm))
+	    goto err_
+	else if (lfile == PT_LFILE && mode != READ_ONLY)
+	    goto err_		# protect page table!
+
+	lf = FM_FTABLE(fm) + lfile * LEN_FTE
+
+	# Activate the descriptor?
+	if (LF_PAGEMAP(lf) == NULL) {
+	    LF_PMLEN(lf) = DEF_PMLEN
+	    if (kmalloc (LF_PAGEMAP(lf), DEF_PMLEN, TY_INT) == ERR)
+		goto err_
+
+	    pm = LF_PAGEMAP(lf)
+	    pt = FM_PTABLE(fm)
+	    np = 0
+
+	    # Determine the lfile pages from the global page table.
+	    do i = 1, FM_PTNPTE(fm)
+		if (Mems[pt+i-1] == lfile) {
+		    np = np + 1
+		    if (np > LF_PMLEN(lf)) {
+			LF_PMLEN(lf) = (np+INC_PMLEN-1) / INC_PMLEN * INC_PMLEN
+			if (krealloc (pm, LF_PMLEN(lf), TY_INT) == ERR)
+			    goto err_
+			LF_PAGEMAP(lf) = pm
+		    }
+		    Memi[pm+np-1] = i
+		}
+
+	    LF_NPAGES(lf) = np
+	}
+
+	# Mode dependent processing.
+	if (mode == NEW_FILE || and (LF_FLAGS(lf), LFF_DELETED) != 0) {
+	    LF_FSIZE(lf) = 0
+	    LF_FLAGS(lf) = flags
+	}
+	    
+	LF_FM(lf) = fm
+	LF_STATUS(lf) = 0
+	LF_FLAGS(lf) = or (LFF_ALLOCATED,
+	    and (LF_FLAGS(lf), not(LFF_IOINPROGRESS)))
+
+	FM_DHMODIFIED(fm) = YES
+
+	chan = lf
+	call fmio_tick (fm)
+	call sfree (sp)
+	return
+err_
+	chan = ERR
+	call sfree (sp)
+end
diff --git a/sys/fmio/fmlfparse.x b/sys/fmio/fmlfparse.x
new file mode 100644
index 00000000..63f43a84
--- /dev/null
+++ b/sys/fmio/fmlfparse.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fmset.h>
+
+# FM_LFPARSE -- Parse an encoded lfile filename.
+# The filename syntax is "Tddd.fff" where
+#
+#	T	is 'B' or 'T' for text or binary
+#	ddd	is the encoded descriptor pointer
+#	fff	is the encoded lfile number
+
+int procedure fm_lfparse (lfname, fm, lfile, type)
+
+char	lfname[ARB]		#I encoded lfile filename
+pointer	fm			#O FMIO descriptor
+int	lfile			#O lfile number
+int	type			#O lfile file type (text or binary)
+
+int	ip
+int	ctoi()
+
+begin
+	# Determine file type.
+	if (lfname[1] == 'T')
+	    type = TEXT_FILE
+	else
+	    type = BINARY_FILE
+
+	# Get FMIO descriptor.
+	ip = 2
+	if (ctoi (lfname, ip, fm) <= 0)
+	    return (ERR)
+	
+	# Skip . delimiter.
+	if (lfname[ip] == '.')
+	    ip = ip + 1
+	else
+	    return (ERR)
+
+	# Get lfile number.
+	if (ctoi (lfname, ip, lfile) <= 0)
+	    return (ERR)
+
+	return (OK)
+end
diff --git a/sys/fmio/fmlfstat.h b/sys/fmio/fmlfstat.h
new file mode 100644
index 00000000..14df119b
--- /dev/null
+++ b/sys/fmio/fmlfstat.h
@@ -0,0 +1,10 @@
+# FMLFSTAT.H -- Lfile status structure definitions.
+
+# Lfstat structure.
+define	LEN_LFSTAT	2		# struct size
+define	LFU_SIZE	$1[1]		# lfile size, bytes
+define	LFU_FLAGS	$1[2]		# lfile flag bits
+
+# Flag bits.
+define	LFB_DELETED	1B		# delete bit
+define	LFB_TEXTFILE	2B		# file contains packed text
diff --git a/sys/fmio/fmlfstat.x b/sys/fmio/fmlfstat.x
new file mode 100644
index 00000000..a5829de0
--- /dev/null
+++ b/sys/fmio/fmlfstat.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fmlfstat.h>
+include	"fmio.h"
+
+# FMLFSTAT.H -- Query the attributes of an lfile.
+
+int procedure fm_lfstat (fm, lfile, statbuf)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile number
+int	statbuf[ARB]		#O receives status
+
+pointer	lf
+errchk	fmio_bind, fmio_errchk
+
+begin
+	call fmio_bind (fm)
+	call fmio_errchk (fm)
+
+        # Verify input.
+        if (lfile < 0 || lfile > FM_NLFILES(fm))
+            return (ERR)
+
+	# Copy out the lfile status.
+        lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	LFU_SIZE(statbuf)  = LF_FSIZE(lf)
+	LFU_FLAGS(statbuf) = LF_FLAGS(lf)
+
+	return (OK)
+end
diff --git a/sys/fmio/fmlfstt.x b/sys/fmio/fmlfstt.x
new file mode 100644
index 00000000..951c44c2
--- /dev/null
+++ b/sys/fmio/fmlfstt.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<fio.h>
+include	"fmio.h"
+
+# FM_LFSTATI -- Stat an lfile.
+
+procedure fm_lfstati (lf, param, lvalue)
+
+pointer	lf			#I lfile descriptor
+int	param			#I parameter code
+long	lvalue			#O parameter value
+
+pointer	fm
+int	chan
+
+begin
+	fm = LF_FM(lf)
+	chan = FM_CHAN(fm)
+
+	# Only the file size differs for each lfile.
+	switch (param) {
+	case FSTT_FILSIZE:
+	    lvalue = LF_FSIZE(lf)
+	case FSTT_BLKSIZE:
+	    lvalue = FM_SZBPAGE(fm)
+	case FSTT_OPTBUFSIZE:
+	    lvalue = FM_OPTBUFSIZE(fm)
+	case FSTT_MAXBUFSIZE:
+	    lvalue = FM_MAXBUFSIZE(fm)
+	}
+
+	# For text lfiles, things appear to be SZB_CHAR larger.
+	if (and (LF_FLAGS(lf), LFF_TEXTFILE) != 0)
+	    lvalue = lvalue * SZB_CHAR
+end
diff --git a/sys/fmio/fmlfundel.x b/sys/fmio/fmlfundel.x
new file mode 100644
index 00000000..98c822ee
--- /dev/null
+++ b/sys/fmio/fmlfundel.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"fmio.h"
+
+# FM_LFUNDELETE -- Undelete an lfile.
+
+procedure fm_lfundelete (fm, lfile)
+
+pointer	fm			#I FMIO descriptor
+int	lfile			#I lfile number
+
+pointer	lf
+errchk	syserrs, fmio_bind, fmio_errchk
+
+begin
+	call fmio_bind (fm)
+	call fmio_errchk (fm)
+
+        # Verify input.
+        if (lfile < 0 || lfile > FM_NLFILES(fm))
+            call syserrs (SYS_FMLFNOOB, FM_DFNAME(fm))
+
+        lf = FM_FTABLE(fm) + lfile * LEN_FTE
+	LF_FLAGS(lf) = and (LF_FLAGS(lf), not(LFF_DELETED))
+	FM_DHMODIFIED(fm) = YES
+	call fmio_tick (fm)
+end
diff --git a/sys/fmio/fmnextlf.x b/sys/fmio/fmnextlf.x
new file mode 100644
index 00000000..0747a799
--- /dev/null
+++ b/sys/fmio/fmnextlf.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"fmio.h"
+
+# FM_NEXTLFILE -- Return the next available (empty) lfile.  An error action
+# is taken if all lfiles are currently in use.  Deleted lfiles will be reused
+# if no unused lfiles are found.
+
+int procedure fm_nextlfile (fm)
+
+pointer	fm			#I FMIO descriptor
+
+pointer	ft, lf
+int	nlfiles, flags, fn, i
+errchk	syserrs, fmio_bind, fmio_errchk
+
+begin
+	call fmio_bind (fm)
+	call fmio_errchk (fm)
+
+	fn = FM_FTLASTNF(fm)
+	ft = FM_FTABLE(fm)
+	nlfiles = FM_NLFILES(fm)
+
+	# Travel once around the file table and abort if all entries are used.
+	# New files are normally returned in sequence.  Deleted files can be
+	# reused.
+
+	do i = 1, nlfiles {
+	    fn = fn + 1
+	    if (fn > nlfiles)
+		fn = 1
+	    lf = ft + fn * LEN_FTE
+	    flags = LF_FLAGS(lf)
+	    if (and(flags,LFF_ALLOCATED) == 0 || and(flags,LFF_DELETED) != 0)
+		break
+	}
+
+	if (i > nlfiles)
+	    call syserrs (SYS_FMOOF, FM_DFNAME(fm))
+
+	FM_FTLASTNF(fm) = fn
+	FM_DHMODIFIED(fm) = YES
+	call fmio_tick (fm)
+
+	return (fn)
+end
diff --git a/sys/fmio/fmopen.x b/sys/fmio/fmopen.x
new file mode 100644
index 00000000..8a8657ba
--- /dev/null
+++ b/sys/fmio/fmopen.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<knet.h>
+include	"fmio.h"
+
+# FM_OPEN -- Open or create a FMIO datafile.  Since this is a low level
+# interface we do not want to impose a choice of a file extension on the
+# datafile, so if a file extension is desired it must be supplied.
+
+pointer procedure fm_open (fname, mode)
+
+char	fname[ARB]		#I datafile filename
+int	mode			#I file access mode
+
+int	chan, n
+pointer	sp, osfn, fn, fm
+errchk	syserrs, calloc, fclobber
+int	nowhite()
+
+begin
+	call smark (sp)
+	call salloc (fn, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	n = nowhite (fname, Memc[fn], SZ_PATHNAME)
+
+	# Take care to not clobber an existing file.
+	if (mode == NEW_FILE)
+	    call fclobber (Memc[fn])
+
+	# Open the datafile.
+	call fmapfn (Memc[fn], Memc[osfn], SZ_PATHNAME)
+	call zopnbf (Memc[osfn], mode, chan)
+	if (chan == ERR)
+	    call syserrs (SYS_FMOPEN, Memc[fn])
+
+	# Allocate the FMIO descriptor.
+	call calloc (fm, LEN_FMDES, TY_STRUCT)
+
+	FM_MODE(fm) = mode
+	FM_CHAN(fm) = chan
+	FM_MAGIC(fm) = FMIO_MAGIC
+	FM_SZFCACHE(fm) = DEF_FCACHESIZE
+	call strcpy (Memc[fn], FM_DFNAME(fm), SZ_DFNAME)
+
+	if (mode == NEW_FILE) {
+	    # Wait until first i/o operation to finish initialization.
+	    FM_DFVERSION(fm) = FMIO_VERSION
+	    FM_SZBPAGE(fm)   = DEF_PAGESIZE
+	    FM_NLFILES(fm)   = DEF_MAXLFILES
+	    FM_PTILEN(fm)    = DEF_MAXPTPAGES
+	    FM_ACTIVE(fm)    = NO
+
+	} else {
+	    # Open an existing datafile.
+	    iferr (call fmio_readheader(fm)) {
+		call mfree (fm, TY_STRUCT)
+		call erract (EA_ERROR)
+	    } else
+		FM_ACTIVE(fm) = YES
+	}
+
+	call sfree (sp)
+	return (fm)
+end
diff --git a/sys/fmio/fmrebuild.x b/sys/fmio/fmrebuild.x
new file mode 100644
index 00000000..9eb55656
--- /dev/null
+++ b/sys/fmio/fmrebuild.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FM_REBUILD -- Rebuild a datafile.  This has no affect on the logical content
+# of a datafile, but is desirable for efficiency reasons to eliminate waste
+# space (e.g., from deleted lfiles), and render the file structures logically
+# contiguous within the file, increasing i/o access efficiency.
+
+procedure fm_rebuild (dfname)
+
+char	dfname[ARB]		#I datafile name
+
+pointer	sp, tfname
+errchk	fm_copy, fm_delete, fm_rename
+
+begin
+	call smark (sp)
+	call salloc (tfname, SZ_PATHNAME, TY_CHAR)
+
+	# The copy operation rebuilds a datafile.
+	call mktemp (dfname, Memc[tfname], SZ_PATHNAME)
+	call fm_copy (dfname, Memc[tfname])
+	call fm_delete (dfname)
+	call fm_rename (Memc[tfname], dfname)
+
+	call sfree (sp)
+end
diff --git a/sys/fmio/fmrename.x b/sys/fmio/fmrename.x
new file mode 100644
index 00000000..e5221536
--- /dev/null
+++ b/sys/fmio/fmrename.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FM_RENAME -- Rename (or move) a datafile.
+
+procedure fm_rename (old, new)
+
+char	old[ARB], new[ARB]	#I old, new datafile names
+
+begin
+	call rename (old, new)
+end
diff --git a/sys/fmio/fmset.h b/sys/fmio/fmset.h
new file mode 100644
index 00000000..a271cc27
--- /dev/null
+++ b/sys/fmio/fmset.h
@@ -0,0 +1,24 @@
+# FMSET.H -- User definitions for FMIO.
+
+# SET/STAT codes.
+define	FM_ACMODE		1	#RO datafile access mode
+define	FM_FCACHESIZE		2	#RW number of files in open file cache
+define	FM_MAXFBSIZE		3	#RW maximum lfile-FIO buffer size
+define	FM_MAXLFILES		4	#RW number of lfiles in datafile
+define	FM_MAXPTPAGES		5	#RW max page table pages (max filesize)
+define	FM_OPTFBSIZE		6	#RW default lfile-FIO buffer size
+define	FM_OSCHAN		7	#RO os channel of datafile
+define	FM_PAGESIZE		8	#RW datafile page size, bytes
+define	FM_VERSION		9	#RO FMIO version number of datafile
+
+# FM_DEBUG flags.
+define	FMD_HEADER		001B	# general header parameters
+define	FMD_FTABLE		002B	# summarize file table contents
+define	FMD_PTINDEX		004B	# print page table index
+define	FMD_PTABLE		010B	# print page table
+define	FMD_ALL			017B	# print everything
+
+# FM_FCDEBUG flags.
+define	FCD_CACHE		001B	# print current cache status
+define	FCD_LFSTATISTICS	002B	# print statistics on lfile getfd's
+define	FCD_ALL			003B	# print everything
diff --git a/sys/fmio/fmseti.x b/sys/fmio/fmseti.x
new file mode 100644
index 00000000..84cefc27
--- /dev/null
+++ b/sys/fmio/fmseti.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmset.h"
+include	"fmio.h"
+
+# FM_SETI -- Set the value of an FMIO integer parameter.
+
+procedure fm_seti (fm, param, value)
+
+pointer	fm		#I FMIO descriptor
+int	param		#I parameter code from <fmset.h>
+int	value		#I new parameter value
+
+int	szbpage
+
+begin
+	szbpage = FM_SZBPAGE(fm)
+
+	switch (param) {
+	case FM_ACMODE:
+	    ; # read-only
+	case FM_MAXLFILES:
+	    FM_NLFILES(fm) = value
+	case FM_MAXPTPAGES:
+	    FM_PTILEN(fm) = value
+	case FM_OSCHAN:
+	    FM_CHAN(fm) = value
+	case FM_PAGESIZE:
+	    FM_SZBPAGE(fm) = value
+	case FM_VERSION:
+	    ; # read-only
+	case FM_OPTFBSIZE:
+	    FM_OPTBUFSIZE(fm) = value
+	case FM_MAXFBSIZE:
+	    FM_MAXBUFSIZE(fm) = value
+	case FM_FCACHESIZE:
+	    FM_SZFCACHE(fm) = value
+	}
+end
diff --git a/sys/fmio/fmstati.x b/sys/fmio/fmstati.x
new file mode 100644
index 00000000..82720ade
--- /dev/null
+++ b/sys/fmio/fmstati.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fmset.h"
+include	"fmio.h"
+
+# FM_STATI -- Query an FMIO integer parameter.
+
+int procedure fm_stati (fm, param)
+
+pointer	fm		#I FMIO descriptor
+int	param		#I parameter code from <fmset.h>
+
+begin
+	switch (param) {
+	case FM_ACMODE:
+	    return (FM_MODE(fm))
+	case FM_MAXLFILES:
+	    return (FM_NLFILES(fm))
+	case FM_MAXPTPAGES:
+	    return (FM_PTILEN(fm))
+	case FM_OSCHAN:
+	    return (FM_CHAN(fm))
+	case FM_PAGESIZE:
+	    return (FM_SZBPAGE(fm))
+	case FM_VERSION:
+	    return (FM_DFVERSION(fm))
+	case FM_OPTFBSIZE:
+	    return (FM_OPTBUFSIZE(fm))
+	case FM_MAXFBSIZE:
+	    return (FM_MAXBUFSIZE(fm))
+	case FM_FCACHESIZE:
+	    return (FM_SZFCACHE(fm))
+	default:
+	    return (ERR)
+	}
+end
diff --git a/sys/fmio/fmsync.x b/sys/fmio/fmsync.x
new file mode 100644
index 00000000..7c7d8112
--- /dev/null
+++ b/sys/fmio/fmsync.x
@@ -0,0 +1,169 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<knet.h>
+include	"fmio.h"
+
+define	SZB_SHORT	(SZB_CHAR*SZ_SHORT)
+
+# FM_SYNC -- Update any buffered portions of the datafile on disk which have
+# been modified since the last update.
+
+procedure fm_sync (fm)
+
+pointer	fm			#I FMIO descriptor
+
+pointer	sp, ip, op, dhbuf, pgbuf, pti, dh, ft, pt
+int	maxpages, nbytes, npti, p1, p2, d1, d2, dp, i
+int	szbpage, chan, buflen, status, npte_perpage
+int	fmio_extend()
+long	clktime()
+
+begin
+	if (FM_MODE(fm) == READ_ONLY)
+	    return
+
+	call smark (sp)
+	chan = FM_CHAN(fm)
+	szbpage = FM_SZBPAGE(fm)
+	npte_perpage = szbpage / SZB_SHORT
+
+	call intr_disable()
+
+	# Get more page table space (pages).  During a normal file extend
+	# occurring while writing to a file, PTEs for *data* pages are added
+	# to the incore global page table and to the PT for the lfile.
+	# The additional pages needed to store the PT and PTI as they grow
+	# are however not allocated during i/o.  We wait and do this at sync
+	# time to provide maximal separation of the data pages and PT pages,
+	# rendering both as contiguous as possible.
+
+	# Check for page table index overflow (datafile too large).
+	npti = (FM_PTNPTE(fm) + npte_perpage-1) / npte_perpage
+	if (npti > FM_PTILEN(fm)) {
+	    call fmio_posterr (fm, SYS_FMPTIOVFL, FM_DFNAME(fm))
+
+	    # Truncate the page table to try to recover the datafile with
+	    # some loss of data.
+
+	    npti = FM_PTILEN(fm)
+	    FM_PTNPTE(fm) = npti * npte_perpage - (npti - FM_PTINPTI(fm))
+	}
+
+	# Allocate the page table pages.
+	for (p1=FM_PTINPTI(fm)+1;  p1 <= npti;  p1=p1+1) {
+	    dp = fmio_extend (fm, PT_LFILE, 1)
+	    if (dp != ERR) {
+		Memi[FM_PTINDEX(fm)+p1-1] = dp
+		FM_PTINPTI(fm) = p1
+		FM_DHMODIFIED(fm) = YES
+	    } else
+		call fmio_posterr (fm, SYS_FMPTIOVFL, FM_DFNAME(fm))
+	}
+
+	# Update the datafile header area.
+	if (FM_DHMODIFIED(fm) != NO) {
+	    # Allocate a buffer to hold the encoded datafile header area.
+	    buflen = (FM_DATASTART(fm) - 1) / (SZ_STRUCT * SZB_CHAR)
+	    call salloc (dhbuf, buflen, TY_STRUCT)
+
+	    # Encode and output the datafile header.
+	    call salloc (dh, LEN_DHSTRUCT, TY_STRUCT)
+
+	    DH_MAGIC(dh)	 = FMIO_MAGIC
+	    DH_DFVERSION(dh)	 = FM_DFVERSION(fm)
+	    DH_SZBPAGE(dh)	 = szbpage
+	    DH_NLFILES(dh)	 = FM_NLFILES(fm)
+	    DH_FTOFF(dh)	 = FM_FTOFF(fm)
+	    DH_FTLASTNF(dh)	 = FM_FTLASTNF(fm)
+	    DH_PTIOFF(dh)	 = FM_PTIOFF(fm)
+	    DH_PTILEN(dh)	 = FM_PTILEN(fm)
+	    DH_PTINPTI(dh)	 = FM_PTINPTI(fm)
+	    DH_PTLEN(dh)	 = FM_PTLEN(fm)
+	    DH_PTNPTE(dh)	 = FM_PTNPTE(fm)
+	    DH_DATASTART(dh)	 = FM_DATASTART(fm)
+
+	    call miipak32 (Memi[dh], Memi[dhbuf], LEN_DHSTRUCT, TY_STRUCT)
+
+	    # Output the file table.
+	    ft = FM_FTABLE(fm)
+	    op = dhbuf + FM_FTOFF(fm) - 1
+	    do i = 0, FM_NLFILES(fm) {
+		ip = ft + i * LEN_FTE
+		FT_FSIZE(op) = LF_FSIZE(ip)
+		FT_FLAGS(op) = and (LFF_SAVE, LF_FLAGS(ip))
+		op = op + LEN_FTEX
+	    }
+
+	    op = dhbuf + FM_FTOFF(fm) - 1
+	    call miipak32 (Memi[op], Memi[op],
+		(FM_NLFILES(fm) + 1) * LEN_FTEX, TY_INT)
+
+	    # Output the page table index.
+	    call miipak32 (Memi[FM_PTINDEX(fm)], Memi[dhbuf+FM_PTIOFF(fm)-1],
+		FM_PTILEN(fm), TY_INT)
+
+	    # Update the whole thing on disk.
+	    call zawrbf (chan, Memi[dhbuf], FM_DATASTART(fm)-1, 1)
+	    call zawtbf (chan, status)
+	    if (status == ERR)
+		call fmio_posterr (fm, SYS_FMWRERR, FM_DFNAME(fm))
+
+	    FM_DHMODIFIED(fm) = NO
+	}
+
+	# Don't cache these pointers before calling fmio_extend!
+	pt  = FM_PTABLE(fm)
+	pti = FM_PTINDEX(fm)
+
+	# Update the page table itself, stored in the data pages.
+	if (FM_PTNPTE(fm) > FM_PTLUPTE(fm)) {
+
+	    # Determine the max transfer size.
+	    maxpages = FM_MAXBUFSIZE(fm) / szbpage
+	    if (maxpages <= 0)
+		maxpages = DEF_BIGBUFNP
+	    
+	    # Get an output temporary buffer if we have to swap on output.
+	    if (BYTE_SWAP2 == YES)
+		call salloc (pgbuf, maxpages * szbpage / SZB_SHORT, TY_SHORT)
+
+	    # Determine the PT page containing the LUPTE+1.
+	    p1 = FM_PTLUPTE(fm) / npte_perpage + 1
+
+	    # Update that and all following PT pages.
+	    npti = FM_PTINPTI(fm)
+	    for (;  p1 <= npti;  p1=p2) {
+		# Get a contiguous range of page table pages.
+		d1 = Memi[pti+p1-1]
+		for (p2=p1+1;  p2 <= npti;  p2=p2+1) {
+		    d2 = Memi[pti+p2-1]
+		    if (d2-d1 != p2-p1 || p2-p1 >= maxpages)
+			break
+		}
+
+		# Swap the data and set IP for the output transfer.
+		ip = pt + (p1 - 1) * npte_perpage
+		nbytes = (min(npti+1,p2) - p1) * szbpage
+		if (BYTE_SWAP2 == YES) {
+		    call bswap2 (Mems[ip], 1, Mems[pgbuf], 1, nbytes)
+		    ip = pgbuf
+		}
+
+		# Update the pages.
+		call zawrbf (chan, Mems[ip], nbytes,
+		    (d1-1) * szbpage + FM_DATASTART(fm))
+		call zawtbf (chan, status)
+		if (status < nbytes)
+		    call fmio_posterr (fm, SYS_FMWRERR, FM_DFNAME(fm))
+	    }
+
+	    FM_PTLUPTE(fm) = FM_PTNPTE(fm)
+	}
+
+	FM_LSYNCTIME(fm) = clktime(0)
+	call intr_enable()
+
+	call sfree (sp)
+end
diff --git a/sys/fmio/mkpkg b/sys/fmio/mkpkg
new file mode 100644
index 00000000..0daf637a
--- /dev/null
+++ b/sys/fmio/mkpkg
@@ -0,0 +1,52 @@
+# Make the FMIO (file manager i/o) library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+zzdebug:
+zzdebug.e:
+	$omake	zzdebug.x <error.h> <ctype.h> fmset.h
+	$link	zzdebug.o
+	;
+
+libsys.a:
+	fmaccess.x	
+	fmclose.x	fmio.h <error.h> <knet.h>
+	fmcopy.x	fmset.h <error.h>
+	fmcopyo.x	fmio.h <mach.h>
+	fmdebug.x	fmio.h fmset.h
+	fmdelete.x	
+	fmfcache.x	fmio.h fmset.h <error.h> <fset.h>
+	fmfopen.x	
+	fmiobind.x	fmio.h <mach.h>
+	fmioerr.x	fmio.h
+	fmioextnd.x	fmio.h <mach.h>
+	fmiopost.x	fmio.h
+	fmiorhdr.x	fmio.h <knet.h> <mach.h>
+	fmiosbuf.x	fmio.h <config.h> <fio.h>
+	fmiotick.x	fmio.h
+	fmlfard.x	fmio.h <mach.h>
+	fmlfawr.x	fmio.h <mach.h>
+	fmlfawt.x	fmio.h <mach.h>
+	fmlfbrd.x	fmio.h <knet.h> <mach.h>
+	fmlfbwr.x	fmio.h <knet.h> <mach.h>
+	fmlfbwt.x	fmio.h <knet.h>
+	fmlfcls.x	fmio.h
+	fmlfcopy.x	fmio.h <mach.h>
+	fmlfdel.x	fmio.h
+	fmlfname.x	fmio.h <fmset.h>
+	fmlfopen.x	fmio.h
+	fmlfparse.x	<fmset.h>
+	fmlfstat.x	fmio.h <fmlfstat.h>
+	fmlfstt.x	fmio.h <config.h> <fio.h> <mach.h>
+	fmlfundel.x	fmio.h
+	fmnextlf.x	fmio.h
+	fmopen.x	fmio.h <error.h> <knet.h>
+	fmrebuild.x	
+	fmrename.x	
+	fmseti.x	fmio.h fmset.h
+	fmstati.x	fmio.h fmset.h
+	fmsync.x	fmio.h <knet.h> <mach.h>
+	;
diff --git a/sys/fmio/zzdebug.x b/sys/fmio/zzdebug.x
new file mode 100644
index 00000000..1764d62e
--- /dev/null
+++ b/sys/fmio/zzdebug.x
@@ -0,0 +1,303 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<fmlfstat.h>
+include	<mach.h>
+include	"fmset.h"
+
+# ZZDEBUG.X -- Debug routines for the FMIO package.
+
+task	create	= t_create,
+	enter	= t_enter,
+	extract	= t_extract,
+	mkfile	= t_mkfile,
+	type	= t_type,
+	show	= t_show,
+	copy	= t_copy,
+	rebuild	= t_rebuild,
+	fcache	= t_fcache
+
+
+# CREATE -- Create a new, empty datafile.
+
+procedure t_create()
+
+pointer	fm
+char	datafile[SZ_FNAME]
+int	pagesize, nlfiles, maxptpages
+
+int	clgeti()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	pagesize   = clgeti ("pagesize")
+	nlfiles    = clgeti ("nlfiles")
+	maxptpages = clgeti ("maxptpages")
+
+	fm = fm_open (datafile, NEW_FILE)
+	if (pagesize > 0)
+	    call fm_seti (fm, FM_PAGESIZE, pagesize)
+	if (nlfiles > 0)
+	    call fm_seti (fm, FM_MAXLFILES, nlfiles)
+	if (maxptpages > 0)
+	    call fm_seti (fm, FM_MAXPTPAGES, maxptpages)
+	call fm_close (fm)
+end
+
+
+# ENTER -- Copy a regular disk file into an lfile.
+
+procedure t_enter()
+
+pointer	fm
+int	lfile, type, fd, lf
+char	datafile[SZ_FNAME], fname[SZ_FNAME]
+int	clgeti(), open(), fm_fopen(), access()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	call clgstr ("fname", fname, SZ_FNAME)
+	lfile = clgeti ("lfile")
+
+	if (access (fname, 0, TEXT_FILE) == YES)
+	    type = TEXT_FILE
+	else
+	    type = BINARY_FILE
+
+	fm = fm_open (datafile, READ_WRITE)
+	fd = open (fname, READ_ONLY, type)
+	lf = fm_fopen (fm, lfile, NEW_FILE, type)
+	call fcopyo (fd, lf)
+
+	call close (lf)
+	call close (fd)
+	call fm_close (fm)
+end
+
+
+# EXTRACT -- Copy an lfile out into a disk file.
+
+procedure t_extract()
+
+pointer	fm
+int	lfstat[LEN_LFSTAT]
+int	lfile, type, fd, lf
+char	datafile[SZ_FNAME], fname[SZ_FNAME]
+int	clgeti(), open(), fm_fopen(), fm_lfstat()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	call clgstr ("fname", fname, SZ_FNAME)
+	lfile = clgeti ("lfile")
+
+	fm = fm_open (datafile, READ_ONLY)
+
+	if (fm_lfstat (fm, lfile, lfstat) == ERR)
+	    call error (1, "cannot stat lfile")
+	else if (and (LFU_FLAGS(lfstat), LFB_TEXTFILE) != 0)
+	    type = TEXT_FILE
+	else
+	    type = BINARY_FILE
+
+	lf = fm_fopen (fm, lfile, READ_ONLY, type)
+	fd = open (fname, NEW_FILE, type)
+	call fcopyo (lf, fd)
+
+	call close (lf)
+	call close (fd)
+	call fm_close (fm)
+end
+
+
+# MKFILE -- Create a file of the given size (in kilobytes) containing all
+# zero data.
+
+procedure t_mkfile()
+
+pointer	fm
+int	lfile, lf, kb, i
+char	datafile[SZ_FNAME], buf[1024/SZB_CHAR]
+int	clgeti(), fm_fopen()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	lfile = clgeti ("lfile")
+	kb = clgeti ("kb")
+
+	fm = fm_open (datafile, READ_WRITE)
+	lf = fm_fopen (fm, lfile, NEW_FILE, BINARY_FILE)
+
+	do i = 1, kb
+	    iferr (call write (lf, buf, 1024/SZB_CHAR)) {
+		call erract (EA_WARN)
+		break
+	    }
+
+	call close (lf)
+	call fm_close (fm)
+end
+
+
+# TYPE -- Print the contents of an lfile on the standard output.
+
+procedure t_type()
+
+pointer	fm
+int	lfile, fd
+char	datafile[SZ_FNAME]
+int	clgeti(), fm_fopen()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	lfile = clgeti ("lfile")
+
+	fm = fm_open (datafile, READ_WRITE)
+	fd = fm_fopen (fm, lfile, READ_ONLY, TEXT_FILE)
+	call fcopyo (fd, STDOUT)
+
+	call close (fd)
+	call fm_close (fm)
+end
+
+
+# SHOW -- Print the datafile status.
+
+procedure t_show()
+
+pointer	fm
+char	datafile[SZ_FNAME]
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+
+	fm = fm_open (datafile, READ_WRITE)
+	call fm_debug (fm, STDOUT, FMD_ALL)
+	call fm_close (fm)
+end
+
+
+# COPY -- Copy a datafile.
+
+procedure t_copy()
+
+char	df_src[SZ_FNAME]
+char	df_dst[SZ_FNAME]
+
+begin
+	call clgstr ("source", df_src, SZ_FNAME)
+	call clgstr ("destination", df_dst, SZ_FNAME)
+	call fm_copy (df_src, df_dst)
+end
+
+
+# REBUILD -- Rebuild a datafile.
+
+procedure t_rebuild()
+
+char	datafile[SZ_FNAME]
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	call fm_rebuild (datafile)
+end
+
+
+# Test the file cache package.
+# -------------------------------
+
+define	GETFD		1
+define	RETFD		2
+define	LOCKOUT		3
+define	UNLOCK		4
+define	LOCKED		5
+define	SYNC		6
+define	DEBUG		7
+#
+define	FCDEBUG		9
+define	PFILE		10
+define	BYE		11
+
+define	KEYWORDS	"|getfd|retfd|lockout|unlock|locked|sync|debug|\
+			 |fcdebug|pfile|bye|"
+
+
+# FCACHE -- Test the file cache package.
+
+procedure t_fcache()
+
+pointer	fm
+int	lfile, mode, type, fd
+char	datafile[SZ_FNAME], keyword[SZ_FNAME], junk[SZ_FNAME]
+int	strdic(), fscan(), fm_getfd()
+bool	fm_locked()
+pointer	fm_open()
+
+begin
+	call clgstr ("datafile", datafile, SZ_FNAME)
+	fm = fm_open (datafile, READ_WRITE)
+
+	call printf ("* ")
+	call flush (STDOUT)
+	while (fscan (STDIN) != EOF) {
+	    call gargwrd (keyword, SZ_FNAME)
+	    if (IS_ALPHA(keyword[1]))
+		switch (strdic (keyword, junk, SZ_FNAME, KEYWORDS)) {
+		case GETFD:
+		    call gargi (lfile)
+		    call gargi (mode)
+		    call gargi (type)
+		    iferr (fd = fm_getfd (fm, lfile, mode, type))
+			call erract (EA_WARN)
+		    else {
+			call printf ("fd = %d\n")
+			    call pargi (fd)
+		    }
+		case RETFD:
+		    call gargi (lfile)
+		    call fm_retfd (fm, lfile)
+
+		case LOCKOUT:
+		    call gargi (lfile)
+		    iferr (call fm_lockout (fm, lfile))
+			call erract (EA_WARN)
+		case UNLOCK:
+		    call gargi (lfile)
+		    iferr (call fm_unlock (fm, lfile))
+			call erract (EA_WARN)
+		case LOCKED:
+		    call gargi (lfile)
+		    call printf ("locked = %b\n")
+			call pargb (fm_locked (fm, lfile))
+
+		case SYNC:
+		    call fm_fcsync (fm)
+		case DEBUG:
+		    call fm_debug (fm, STDOUT, FMD_ALL)
+		case FCDEBUG:
+		    call fm_fcdebug (fm, STDOUT, FCD_ALL)
+		case PFILE:
+		    call gargi (lfile)
+		    fd = fm_getfd (fm, lfile, READ_ONLY, TEXT_FILE)
+		    iferr (call fcopyo (fd, STDOUT))
+			call erract (EA_WARN)
+		    call fm_retfd (fm, lfile)
+		case BYE:
+		    break
+		default:
+		    call eprintf ("commands: %s\n")
+			call pargstr (KEYWORDS)
+		}
+
+	    call printf ("* ")
+	    call flush (STDOUT)
+	}
+
+	call fm_close (fm)
+end
diff --git a/sys/fmtio/README b/sys/fmtio/README
new file mode 100644
index 00000000..08d8bd28
--- /dev/null
+++ b/sys/fmtio/README
@@ -0,0 +1,6 @@
+This directory contains the IRAF Formatted I/O (FMTIO) routines.  The FMTIO
+package includes the string utilities (str___), character utilities (chr___),
+encode/decode primitives (ctod, itoc, etc.), and the high level SCAN and
+PRINTF routines.  This is a full implementation of FMTIO (excluding the
+language dependent features that will be provided when the full language
+becomes available).
diff --git a/sys/fmtio/cctoc.x b/sys/fmtio/cctoc.x
new file mode 100644
index 00000000..6ad6ea8f
--- /dev/null
+++ b/sys/fmtio/cctoc.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+
+define	OCTAL		8
+
+# CCTOC -- Convert a character constant into the ASCII value of the character
+# represented.  A character constant may be any whitespace delimited
+# character, backslash escaped character, or a string of the form 'c', '\c',
+# or '\nnn'.  The following are all legal character constants:
+# 
+# 	c	'c'	'\n'	'\07'	\	\\	\n
+# 
+# The number of characters successfully converted is returned as the function
+# value.
+
+int procedure cctoc (str, ip, cval)
+
+char	str[ARB]		# input string
+int	ip			# index into input string
+char	cval			# receives character value
+
+long	lval
+bool	eat_tick
+int	n, junk, ip_save
+int	stridx(), gctol()
+include	"escchars.inc"
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+	ip_save = ip
+
+	if (str[ip] == SQUOTE) {				# '...'
+	    eat_tick = true
+	    ip = ip + 1
+	} else
+	    eat_tick = false
+
+	if (str[ip] == ESCAPE && str[ip+1] != EOS) {		# \...
+	    ip = ip + 1
+	    n = stridx (str[ip], escape_chars)			# \c
+	    if (n > 0) {
+		cval = mapped_chars[n]
+		ip = ip + 1
+	    } else if (IS_DIGIT (str[ip])) {			# \nnn
+		junk = gctol (str, ip, lval, -OCTAL)
+		cval = lval
+	    } else if (eat_tick) {				# '\c'
+		cval = str[ip]
+		ip = ip + 1
+	    } else
+		cval = ESCAPE					# \ alone
+
+	} else if (str[ip] != EOS) {
+	    cval = str[ip]					# c or 'c'
+	    ip = ip + 1
+
+	} else if (eat_tick)
+	    cval = SQUOTE					# 'EOS
+
+	if (eat_tick && str[ip] == SQUOTE)
+	    ip = ip + 1
+
+	return (ip - ip_save)
+end
diff --git a/sys/fmtio/chdeposit.x b/sys/fmtio/chdeposit.x
new file mode 100644
index 00000000..0e0dc961
--- /dev/null
+++ b/sys/fmtio/chdeposit.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CHDEPOSIT -- Deposit a character in a string at the offset OP.  Bump OP,
+# taking care not to overflow the string.
+
+procedure chdeposit (ch, str, maxch, op)
+
+char	ch			# character to be deposited
+char	str[ARB]		# output string
+int	maxch			# maxch chars in output string
+int	op			# pointer into output string
+
+begin
+	str[op] = ch
+	if (op < maxch)
+	    op = op + 1
+end
diff --git a/sys/fmtio/chfetch.x b/sys/fmtio/chfetch.x
new file mode 100644
index 00000000..f9ab4197
--- /dev/null
+++ b/sys/fmtio/chfetch.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CHFETCH -- Return the next character from a string, bump pointer.
+
+char procedure chfetch (str, ip, ch)
+
+char	str[ARB], ch
+int	ip
+
+begin
+	ch = str[ip]
+	if (ch != EOS)
+	    ip = ip + 1
+
+	return (ch)
+end
diff --git a/sys/fmtio/chrlwr.x b/sys/fmtio/chrlwr.x
new file mode 100644
index 00000000..a0050207
--- /dev/null
+++ b/sys/fmtio/chrlwr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CHRLWR -- Convert char to lower case
+
+char procedure chrlwr (ch)
+
+char	ch
+
+begin
+	if (IS_UPPER (ch))
+	    return (TO_LOWER (ch))
+	else
+	    return (ch)
+end
diff --git a/sys/fmtio/chrupr.x b/sys/fmtio/chrupr.x
new file mode 100644
index 00000000..53f6582e
--- /dev/null
+++ b/sys/fmtio/chrupr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CHRUPR -- Convert char to upper case.
+
+char procedure chrupr (ch)
+
+char	ch
+
+begin
+	if (IS_LOWER (ch))
+	    return (TO_UPPER (ch))
+	else
+	    return (ch)
+end
diff --git a/sys/fmtio/clprintf.x b/sys/fmtio/clprintf.x
new file mode 100644
index 00000000..d456c0a5
--- /dev/null
+++ b/sys/fmtio/clprintf.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# CLPRINTF -- Format and output a string to the CL to set the value of the
+# named (string or struct type) parameter.  For example, to set a cursor
+# struct parameter,  "clprintf (param, "%8.4f %8.4f %c")" ...
+
+procedure clprintf (param, format_string)
+
+char	param[ARB], format_string[ARB]
+
+begin
+	call putline (CLOUT, param)
+	call putline (CLOUT, " = \"")
+	call fprntf (CLOUT, format_string, CL_PARAM)
+end
diff --git a/sys/fmtio/clscan.x b/sys/fmtio/clscan.x
new file mode 100644
index 00000000..563954d3
--- /dev/null
+++ b/sys/fmtio/clscan.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CLSCAN -- Begin a scan of the value of a CL parameter
+
+int procedure clscan (param)
+
+char	param[ARB]
+int	getline(), strncmp(), clc_fetch()
+include	"scan.com"
+errchk	clreqpar, getline
+
+begin
+	# Fetch the value of a CL parameter.  First look in the parameter
+	# cache, querying the CL for the value of the parameter only if it
+	# is not found in the cache.
+
+	if (clc_fetch (param, sc_scanbuf, SZ_SCANBUF) == ERR) {
+	    call clreqpar (param)
+	    if (getline (CLIN, sc_scanbuf) == EOF)
+		return (EOF)
+	}
+
+	# Check for EOF on a list structured parameter; if not EOF initialize
+	# formatted input for the clget procedures.
+
+	if (strncmp ("EOF\n", sc_scanbuf, 4) == 0)
+	    return (EOF)
+	else {
+	    call reset_scan()
+	    return (OK)
+	}
+end
diff --git a/sys/fmtio/ctocc.x b/sys/fmtio/ctocc.x
new file mode 100644
index 00000000..b2f4197a
--- /dev/null
+++ b/sys/fmtio/ctocc.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+define	OCTAL		8
+
+# CTOCC -- Convert a character into a printable character constant.
+# Printable characters are output as is.  The standard control characters
+# (newline, tab, etc.) are output as escape sequences (\n, \t, etc.).
+# Other control characters are output in the form '^X'.  Characters which
+# are neither printable nor standard control characters are output as
+# octal constants of the form '\DDD'.  Note that the ouput string is not
+# enclosed in ticks ('\n', etc.), because the generated character constant
+# might appear in a quoted string (or someplace other than an explicit
+# character constant).
+
+int procedure ctocc (ch, outstr, maxch)
+
+char	ch			# character to be output
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+
+int	op, n
+int	stridx()
+define	output 	{outstr[op]=$1;op=op+1;if(op>maxch)goto overflow_}
+define	overflow_ 99
+include	"escchars.inc"
+
+begin
+	op = 1
+
+	if (maxch > 0) {
+	    if (IS_PRINT(ch)) {				# output char as is
+		output (ch)
+	    } else if (IS_CNTRL (ch)) {
+		n = stridx (ch, mapped_chars)
+		if (n > 0) {				# '\c'
+		    output ('\\')
+		    output (escape_chars[n])
+		} else {
+		    output ('^')			# control chars
+		    output (ch + 'A' - 1)
+		}
+
+	    } else {					# '\nnn' 
+		# Always output 3 digits so that strings like \0405 (a blank
+		# followed by a `5') can be interpreted during the reverse
+		# encoding operation.
+
+		output ('\\')
+		output (TO_DIGIT (mod (ch / 0100B, 010B)))
+		output (TO_DIGIT (mod (ch / 0010B, 010B)))
+		output (TO_DIGIT (mod (ch / 0001B, 010B)))
+	    }
+	}
+
+	outstr[op] = EOS
+	return (op-1)
+
+overflow_
+	outstr[1] = '?'					# no room, print '?'
+	outstr[2] = EOS
+	return (1)
+end
diff --git a/sys/fmtio/ctod.x b/sys/fmtio/ctod.x
new file mode 100644
index 00000000..06b1d351
--- /dev/null
+++ b/sys/fmtio/ctod.x
@@ -0,0 +1,154 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <ctype.h>
+
+define	DECIMAL		10
+
+.help
+.nf _________________________________________________________________________
+Attempt to convert a string to a number:  nchar = ctod (str, ip, dval)
+The index IP must be set to the first character to be scanned upon entry
+to CTOD, and will be left pointing at the first untranslated character.
+
+If the string is successfully converted, the number of characters used
+is returned as the function argument.  If the string (or the first few
+characters of the string) cannot be interpreted as a number, zero will be
+returned.  Note that even if no numeric characters are encountered, the
+index IP may be incremented, if leading whitespace is encountered (but the
+return value N will still be zero).
+
+The upper case string "INDEF" is a legal real number, as is "." (. == 0.0).
+Sexagesimal numbers are permitted.  Excess digits of precision are ignored.
+Out of range exponents are detected, and result in the value INDEF being
+returned (this is not considered an ERROR condition).  Any number with an
+exponent greater than or equal to MAX_EXPONENT is interpreted as INDEF,
+regardless of the mantissa.  The number need not contain a decimal point.
+
+Lexical form of a sexagesimal number:
+
+	D :==	[0-9]		numeric digit
+	E :==	[eEdD]		exponent symbol
+
+	({D}*:)+{D}*(".")?{D}*({E}("+"|"-")?{D}+)?
+
+The format for sexagesimal numbers is fairly permissive.  Any number of
+colon fields are permitted, with any number of digits (including zero) in
+each field.  An exponent may occur at the end of a sexagesimal number.
+Leading zeros may be omitted in the fields.
+.endhelp ____________________________________________________________________
+
+
+# CTOD -- Convert a string to double precision real.
+
+int procedure ctod (str, ip, dval)
+
+char	str[ARB]		# string to be converted
+int	ip			# pointer into str
+double	dval			# receives binary value
+
+bool	neg
+char	dig[MAX_DIGITS]
+int	j, e, vexp, ip_start
+long	expon
+double	value, scalar
+int	strncmp(), gctol(), stridx()
+
+begin
+	while (IS_WHITE (str[ip]))			# skip whitespace
+	    ip = ip + 1
+	ip_start = ip
+	dval = INDEFD
+				
+	if (strncmp (str[ip], "INDEF", 5) == 0) {	# check for "INDEF"
+	    for (ip=ip+5;  IS_ALPHA (str[ip]) || str[ip] == '_';  ip=ip+1)
+		;
+	    return (ip - ip_start)
+	}
+
+	neg = (str[ip] == '-')				# check for sign
+	if (neg || str[ip] == '+')
+	    ip = ip + 1
+
+	while (str[ip] == '0')				# ignore leading zeros
+	    ip = ip + 1
+
+	dval = 0.0
+	scalar = 60.0
+
+	repeat {					# accumulate digits
+	    for (j=1;  j <= MAX_DIGITS && IS_DIGIT(str[ip]);  j=j+1) {
+		dig[j] = str[ip]
+		ip = ip + 1
+	    }
+
+	    for (e=0;  IS_DIGIT(str[ip]);  e=e+1)	# ignore the rest
+		ip = ip + 1
+
+	    scalar = scalar / 60.0
+	    if (ip > 1 && stridx(str[ip], "'\":dDhHmMsS")>0) {  # sexagesimal?
+		ip = ip + 1
+		dig[j] = EOS
+		value = 0.0				# convert digits
+		for (j=1;  dig[j] != EOS;  j=j+1)
+		    value = value * 10.0D0 + TO_INTEG (dig[j])
+		dval = dval + value * scalar * (10.0 ** e)
+
+		while (str[ip] != EOS && 		# multiple spaces etc
+		    stridx(str[ip]," '\":dDhHmMsS")>0)
+		        ip = ip + 1
+	    } else
+		break
+	}
+
+	if (str[ip] == '.') {				# check for a fraction
+	    ip = ip + 1
+	    if (j == 1)					# skip leading zeros
+		while (str[ip] == '0') {		# if str = "0.00ddd"
+		    ip = ip + 1
+		    e = e - 1
+		}
+	    for (;  j <= MAX_DIGITS && IS_DIGIT(str[ip]);  j=j+1) {
+		dig[j] = str[ip]
+		e = e - 1				# adjust scale factor
+		ip = ip + 1
+	    }						# discard insignificant
+	    while (IS_DIGIT (str[ip]))			# fractional digits
+		ip = ip + 1
+	}
+
+	dig[j] = EOS					# no more digits
+	vexp = e + j - 1				# save for ovfl check
+	if (ip == ip_start)				# not a number?
+	    return (0)
+
+	value = 0.0					# convert the mantissa
+	for (j=1;  dig[j] != EOS;  j=j+1)
+	    value = value * 10.0D0 + TO_INTEG (dig[j])
+	if (e != 0)
+	    value = value * (10.0D0 ** e)		# scale by e
+
+
+	# Check for exponent.
+
+	j = ip
+	expon = 0
+	if (stridx (str[ip], "eEdD") > 0) {		# exponent?
+	    ip = ip + 1
+	    if (gctol (str, ip, expon, DECIMAL) <= 0) {
+		ip = j					# return chars
+		expon = 0
+	    }
+	}
+
+	if (abs(vexp+expon) > MAX_EXPONENTD)		# check for overflow
+	    return (ip - ip_start)
+
+	dval = dval + value * scalar
+	if (expon != 0)
+	    dval = dval * (10.0D0 ** expon)		# apply exponent
+
+	if (neg)
+	    dval = -dval
+	return (ip - ip_start)
+end
diff --git a/sys/fmtio/ctoi.x b/sys/fmtio/ctoi.x
new file mode 100644
index 00000000..ce791222
--- /dev/null
+++ b/sys/fmtio/ctoi.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CTOI -- Simple character to integer (decimal radix).
+
+int procedure ctoi (str, ip, ival)
+
+char	str[ARB]	# decimal encoded numeric string
+int	ip		# starting index in string (input/output)
+int	ival		# decoded integer value (output)
+
+bool	neg
+int	sum
+int	ip_start
+int	strncmp()
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+	ip_start = ip
+
+	# Check for "INDEF".
+	if (str[ip] == 'I')
+	    if (strncmp (str[ip], "INDEF", 5) == 0)
+		if (!IS_ALNUM (str[ip+5])) {
+		    ival = INDEFI
+		    ip = ip + 5
+		    return (5)
+		}
+
+	neg = (str[ip] == '-')
+	if (neg)
+	    ip = ip + 1
+
+	sum = 0
+	while (IS_DIGIT (str[ip])) {
+	    sum = sum * 10 + TO_INTEG (str[ip])
+	    ip = ip + 1
+	}
+
+	if (neg)
+	    ival = -sum
+	else
+	    ival = sum
+
+	return (ip - ip_start)
+end
diff --git a/sys/fmtio/ctol.x b/sys/fmtio/ctol.x
new file mode 100644
index 00000000..a83d1384
--- /dev/null
+++ b/sys/fmtio/ctol.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CTOL -- Simple character to long integer (decimal radix).
+
+int procedure ctol (str, ip, lval)
+
+char	str[ARB]	# decimal encoded numeric string
+int	ip		# starting index in string (input/output)
+long	lval		# decoded integer value (output)
+
+bool	neg
+long	sum
+int	ip_start
+int	strncmp()
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+	ip_start = ip
+
+	# Check for "INDEF".
+	if (str[ip] == 'I')
+	    if (strncmp (str[ip], "INDEF", 5) == 0)
+		if (!IS_ALNUM (str[ip+5])) {
+		    lval = INDEFL
+		    ip = ip + 5
+		    return (5)
+		}
+
+	neg = false
+	if (IS_DIGIT (str[ip+1]))
+	    if (str[ip] == '-') {
+		neg = true
+		ip = ip + 1
+	    } else if (str[ip] == '+')
+		ip = ip + 1
+
+	sum = 0
+	while (IS_DIGIT (str[ip])) {
+	    sum = sum * 10 + TO_INTEG (str[ip])
+	    ip = ip + 1
+	}
+
+	if (neg)
+	    lval = -sum
+	else
+	    lval = sum
+
+	return (ip - ip_start)
+end
diff --git a/sys/fmtio/ctor.x b/sys/fmtio/ctor.x
new file mode 100644
index 00000000..a8fd16f1
--- /dev/null
+++ b/sys/fmtio/ctor.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# CTOR -- Character to real.  The number of characters converted to produce
+# the output number is returned as the function value (0 is returned if the
+# input cannot be interpreted as a number).
+
+int procedure ctor (str, ip, rval)
+
+char	str[ARB]		# input string to be decoded
+int	ip			# first character to be used in string
+real	rval			# decoded real value (output)
+
+double	dval
+int	nchars, expon
+int	ctod()
+
+begin
+	nchars = ctod (str, ip, dval)
+	if (abs(dval) > EPSILOND)
+	    expon = int (log10 (abs(dval)))
+	else
+	    expon = 0
+
+	if (IS_INDEFD(dval))
+	    rval = INDEFR
+	else if (expon > MAX_EXPONENTR)
+	    return (0)
+	else
+	    rval = dval
+	
+	return (nchars)
+end
diff --git a/sys/fmtio/ctotok.x b/sys/fmtio/ctotok.x
new file mode 100644
index 00000000..333984c9
--- /dev/null
+++ b/sys/fmtio/ctotok.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctotok.h>
+include <ctype.h>
+include	<chars.h>
+include	<lexnum.h>
+
+.help CTOTOK 2 "String Utilities"
+.ih ___________________________________________________________________________
+NAME
+CTOTOK -- Return next token from input text.
+.ih
+USAGE
+token = ctotok (string, ip, outstr, maxch)
+.ih
+PARAMETERS
+The integer value returned by CTOTOK is a code identifying the type of token
+matched.  The predefined tokens recognized by CTOTOK (defined in <ctotok.h>)
+are the following:
+.ls
+.nf
+TOK_IDENTIFER		[a-zA-Z][a-zA-Z0-9_$.]*
+TOK_NUMBER		[0-9][-+0-9.:xXa-fA-F]*
+TOK_OPERATOR		[-+*/!@#$%^&=`~<>?|]+
+TOK_PUNCTUATION		[,:;(){}] or "[", "]"
+TOK_STRING		"..."
+TOK_CHARCON		'.'
+TOK_EOS			end of string
+TOK_NEWLINE		end of line
+TOK_UNKNOWN		control characters
+.fi
+.le
+.ls string
+The EOS delimited character string from which the next token is to be
+extracted.
+.le
+.ls ip
+On input, contains the index of the first character to be scanned
+(initially 1).  On output, left pointing at the first character after
+the current token, unless EOS was reached.  IP should normally be left
+alone in successive calls to CTOTOK.
+.le
+.ls outstr
+String to receive the extracted token value.
+.le
+.ls maxch
+Capacity of the "outstr" buffer.
+.le
+.ih
+DESCRIPTION
+CTOTOK is useful for many simple parsing tasks.  For example, it is used
+by the HELP utility to parse the ".help" directive, which consists of
+a list of keywords (delimited by commas), followed by two strings or
+identifiers.
+
+CTOTOK selects the type of token to be extracted based on the token
+class membership of the first nonwhitespace character encountered.
+Characters are copied to the output string until a character not belonging
+to the current class is encountered (or until MAXCH characters have been
+output).  Whitespace is always a token delimiter.  The integer code for the
+corresponding token is returned as the function value.
+
+An identifier is a letter followed by any number of letters, digits, or
+one of the characters [_.$].  A number is any legal integer, octal,
+hexadecimal, sexagesimal, or floating point number.  All legal numbers are
+matched: however, many illegal numbers (e.g. "99.33.22") are matched as well.
+The numeric conversion routines may be used to verify that a number token
+is actually a legal number, as well as to convert the number to binary.
+
+An operator is one or more operator characters, or any of the characters
+[_.$], not occurring as part of an identifier, but occurring instead as the
+first character of an operator.  Note that a string of operator characters
+is considered a single token, whereas punctuation characters are returned
+as separate tokens.  Strings are enclosed by either single or double quotes,
+and all escape sequences are recognized and processed.
+Control characters and DEL match the "unknown" token.
+.ih
+SEE ALSO
+tokens(1), strmatch(), patmatch()
+.endhelp ______________________________________________________________________
+
+define	TABLESIZE	95
+define	NUMCHSIZE	6
+define	OFFSET		' '
+
+
+# CTOTOK -- Character string to token.  The token is returned in OUTSTR and the
+# token type code is returned as the function value.
+
+int procedure ctotok (str, ip, outstr, maxch)
+
+char	str[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[ARB]		# buffer to receive token
+int	maxch			# max chars in output buffer
+
+int	currclass
+char	class[TABLESIZE]
+int	op, ch, i, junk, nchars
+int	ctowrd(), lexnum(), cctoc()
+include	"tokdata.inc"
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+
+	ch = str[ip]
+	i  = max(1, min(TABLESIZE, ch - OFFSET))
+	op = 1
+
+	if (ch == EOS) {				# select class (token)
+	    outstr[1] = EOS
+	    return (TOK_EOS)
+
+	} else if (ch == NEWLINE) {			# end of line
+	    outstr[1] = ch
+	    outstr[2] = EOS
+	    ip = ip + 1
+	    return (TOK_NEWLINE)
+
+	} else if (ch <= OFFSET) {			# control characters
+	    while (op <= maxch && ch != EOS && ch <= OFFSET) {
+		outstr[op] = ch
+		op = op + 1
+		ip = ip + 1
+		ch = str[ip]
+	    }
+	    outstr[op] = EOS
+	    return (TOK_UNKNOWN)
+
+	} else if (ch == DQUOTE) {			# string constant
+	    junk = ctowrd (str, ip, outstr, maxch)
+	    return (TOK_STRING)
+
+	} else if (ch == SQUOTE || ch == ESCAPE) {
+	    nchars = cctoc (str, ip, junk)
+	    call strcpy (str[ip-nchars], outstr, nchars)
+	    return (TOK_CHARCON)
+
+	} else if (lexnum (str, ip, nchars) != LEX_NONNUM) {
+	    call strcpy (str[ip], outstr, nchars)
+	    ip = ip + nchars
+	    return (TOK_NUMBER)
+
+	} else if (class[i] == TOK_IDENTIFIER && !IS_ALPHA (ch)) {
+	    currclass = TOK_OPERATOR
+
+	} else if (class[i] == TOK_PUNCTUATION) {	# only one at a time
+	    outstr[1] = ch
+	    outstr[2] = EOS
+	    ip = ip + 1
+	    return (TOK_PUNCTUATION)
+
+	} else
+	    currclass = class[i]
+
+	repeat {					# copy token to output
+	    outstr[op] = ch
+	    op = op + 1
+	    ip = ip + 1
+	    ch = str[ip]
+	    i  = max(1, min(TABLESIZE, ch - OFFSET))
+	} until (ch == EOS || ch <= OFFSET || class[i] != currclass)
+
+	outstr[op] = EOS
+	return (currclass)
+end
diff --git a/sys/fmtio/ctowrd.x b/sys/fmtio/ctowrd.x
new file mode 100644
index 00000000..5f511075
--- /dev/null
+++ b/sys/fmtio/ctowrd.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+
+# CTOWRD -- Break whitespace delimited token or quoted string out of input
+# stream.  If string, process escape sequences.  The number of characters
+# converted from the input string, excluding whitespace, is returned as the
+# function value.
+
+int procedure ctowrd (str, ip, outstr, maxch)
+
+char	str[ARB]			# input string
+int	ip				# pointer into input string
+char	outstr[ARB]			# receives extracted word
+int	maxch
+
+char	cch
+int	ch, junk, op
+int	ip_start, delim, i
+define	qsput_ 91
+define	wsput_ 92
+int	cctoc()
+
+begin
+	while (IS_WHITE(str[ip]))
+	    ip = ip + 1
+	ip_start = ip
+
+	delim = str[ip]
+	if (delim == DQUOTE || delim == SQUOTE) {
+	    # Extract a quoted string.
+	    op = 1
+	    ip = ip + 1
+	    do i = 1, ARB {
+		ch = str[ip]
+		if (ch == EOS) {
+		    break
+		} else if (ch == ESCAPE) {
+		    ch = str[ip+1]
+		    if (ch == delim) {
+			ip = ip + 2
+			goto qsput_
+		    } else {
+			junk = cctoc (str, ip, cch)
+			ch = cch
+			goto qsput_
+		    }
+		} else if (ch == delim) {
+		    ip = ip + 1
+		    break
+		} else {
+	   	    ip = ip + 1
+qsput_		    if (op <= maxch) {
+			outstr[op] = ch
+			op = op + 1
+		    }
+		}
+	    }
+	} else {
+	    # Extract a whitespace delimited string.
+	    op = 1
+	    do i = 1, ARB {
+		ch = str[ip]
+		if (IS_WHITE(ch) || ch == '\n' || ch == EOS) {
+		    break
+		} else if (ch == ESCAPE) {
+		    junk = cctoc (str, ip, cch)
+		    ch = cch
+		    goto wsput_
+		} else {
+		    ip = ip + 1
+wsput_		    if (op <= maxch) {
+			outstr[op] = ch
+			op = op + 1
+		    }
+		}
+	    }
+	}
+
+	outstr[op] = EOS
+	return (ip - ip_start)
+end
diff --git a/sys/fmtio/ctox.x b/sys/fmtio/ctox.x
new file mode 100644
index 00000000..3f0479a2
--- /dev/null
+++ b/sys/fmtio/ctox.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# CTOX -- Convert a character string into a complex number.  The complex
+# number must have the form (r,i), with no embedded whitespace (GCTOX is
+# cabable of accepting numbers in other formats).
+
+int procedure ctox (str, ip, xval)
+
+char	str[ARB]
+int	ip, ip_save
+double	dval1, dval2
+complex	xval
+int	ctod()
+define	notanumber_ 99
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+	ip_save = ip
+	dval2 = 0.0d0
+
+	if (str[ip] == '(') {				# x = (r1,r2)
+	    ip = ip + 1
+	    if (ctod (str, ip, dval1) <= 0)
+		goto notanumber_
+	    if (str[ip] != ',')
+		goto notanumber_
+	    ip = ip + 1
+	    if (ctod (str, ip, dval2) <= 0)
+		goto notanumber_
+	    if (str[ip] != ')')
+		goto notanumber_
+	    ip = ip + 1
+	} else
+	    goto notanumber_
+
+	if (IS_INDEFD(dval1) || IS_INDEFD(dval2))
+	    xval = INDEFX
+	else
+	    xval = complex (dval1, dval2)
+	return (ip - ip_save)
+
+notanumber_
+	ip = ip_save
+	return (0)
+end
diff --git a/sys/fmtio/doc/evexpr.hlp b/sys/fmtio/doc/evexpr.hlp
new file mode 100644
index 00000000..386baf91
--- /dev/null
+++ b/sys/fmtio/doc/evexpr.hlp
@@ -0,0 +1,147 @@
+				    EVEXPR
+		 Evaluating Algebraic Expressions in SPP Programs
+			      dct 17 April 1985
+
+
+
+1. Introduction
+
+    EVEXPR is a function which takes an algebraic expression as input,
+evaluates the expression, and returns the value of the expression as the
+function value.  The input expression (a character string) is parsed and
+reduced to a single value.  The operands to the expression may be either
+constants or identifiers (foreign strings).  If an identifier is encountered
+the user supplied get operand procedure is called to return the value of
+the operand.  Operands are described by the operand structure, and operands
+are passed about by a pointer to such a structure.  The value of the
+expression is returned as the function value and is a pointer to an operand
+structure.  Operands of different datatypes may be mixed in an expression
+with the usual automatic type coercion rules.  All SPP datatypes are
+supported plus the string datatype.  All SPP operators and intrinsic
+functions are recognized.
+
+
+2. Procedures
+
+	op = evexpr (expr, locpr(getop), locpr(ufcn))
+	      getop (identifier, op)
+	       ufcn (fcn, args, nargs, op)
+
+where
+
+	evexpr	The main entry point.
+	expr	A character string, the expression to be evaluated.
+	getop	A user supplied procedure which returns the value
+		  of a nonconstant operand given the NAME of the operand
+		  (a character string) as input.  If locpr(getop) is
+		  NULL only constant operands are permitted in the
+		  expression.
+	ufcn	A user supplied procedure which returns the value of
+		  a user defined function given the name of the function
+		  as the first argument (a string).  If locpr(ufcn) is
+		  NULL only the standard functions are permitted.
+	fcn	Name of the function to be evaluated.
+	args	Array of pointers to operands (the arguments to the function).
+	nargs	Number of arguments to function.
+	op	A pointer to an operand structure
+
+
+A a simple example, consider the following statement which evaluates a
+constant expression and prints the value on the standard output.
+
+
+	include	<evexpr.h>
+	pointer	o, evexpr()
+
+	o = evexpr ("sin(.5)**2 + cos(.5)**2)", NULL, NULL)
+	switch (O_TYPE(o)) {
+	case TY_INT:
+	    call printf ("result = %d\n")
+		call pargi (O_VALI(o))
+	case TY_REAL:
+	    call printf ("result = %g\n")
+		call pargr (O_VALR(o))
+	case TY_CHAR:
+	    call printf ("result = %s\n")
+		call pargstr (O_VALC(o))
+	}
+
+
+If a syntax error occurs while parsing the expression EVEXPR will take the
+error action "syntax error".  The NULL arguments could be replaced by the
+LOCPR addresses of get operand and/or user function procedures if required
+by the application.
+
+
+3. Lexical Form
+
+    The lexical form of the input expression is the same as that of SPP and
+the CL for all numeric, character, and  string constants and operators.
+Any other sequence of characters is considered an identifier and will be
+passed to the user supplied get operand function to be turned into an operand.
+
+
+4. Syntax
+
+    Parsing and evaluating of the input expression is carried out by an SPP/Yacc
+parser.  The grammar recognized by the parser is given below.
+
+
+expr	:	CONST				# numeric or string constant
+	|	IDENT				# external operand (getop)
+	|	'-' expr %prec UMINUS
+	|	expr '+'  expr
+	|	expr '-'  expr
+	|	expr '*'  expr
+	|	expr '/'  expr
+	|	expr '**' expr
+	|	expr '//' expr
+	|	'!' expr
+	|	expr '<'  expr
+	|	expr '<=' expr
+	|	expr '>'  expr
+	|	expr '>=' expr
+	|	expr '==' expr
+	|	expr '!=' expr
+	|	expr '&&' expr
+	|	expr '||' expr
+	|	IDENT '(' arglist ')'		# function call
+	|	'?' expr ':' expr		# conditional expression
+	|	'(' expr ')'
+	;
+
+arglist	:	# Empty.
+	|	arglist ',' expr
+	;
+
+
+2. Data Structures
+
+    The operand structure (size 3 su) is used to represent all operands in
+expressions and on the parser stack.  Operands are passed to and from the
+outside world by means of a pointer to an operand structure.  The caller
+is responsible for string storage of string operands passed to EVEXPR.
+EVEXPR manages string storage for temporary string operands created during
+expression evaluation, as well as storage for the final string value if
+the expression is string valued.  In the latter case the value string should
+be used before EVEXPR is again called.
+
+
+	struct operand {
+		int	type		# operand datatype
+		union {
+		bool	v_b		# boolean value
+		int	v_i		# integer value
+		real	v_r		# real value
+		char	*v_s		# string value
+		} v
+	}
+
+
+SPP equivalent (<evexpr.h>)
+
+		O_TYPE(o)		# operand datatype
+		O_VALB(o)		# boolean value
+		O_VALI(o)		# integer value (or string ptr)
+		O_VALR(o)		# real value
+		O_VALC(o)		# string value
diff --git a/sys/fmtio/doc/fmtio.hd b/sys/fmtio/doc/fmtio.hd
new file mode 100644
index 00000000..525911dc
--- /dev/null
+++ b/sys/fmtio/doc/fmtio.hd
@@ -0,0 +1,77 @@
+# Help directory for the FMTIO (formatted i/o) package.
+
+$fmtio	= "sys$fmtio/"
+
+cctoc		hlp = xtoc.hlp,		src = fmtio$cctoc.x
+chdeposit	hlp = chdeposit.hlp,	src = fmtio$chdeposit.x
+chfetch		hlp = chfetch.hlp,	src = fmtio$chfetch.x
+chrlwr		hlp = chrlwr.hlp,	src = fmtio$chrlwr.x
+chrupr		hlp = chrupr.hlp,	src = fmtio$chrupr.x
+clprintf	hlp = printf.hlp,	src = fmtio$clprintf.x
+clscan		hlp = scan.hlp,		src = fmtio$clscan.x
+ctocc		hlp = ctox.hlp,		src = fmtio$ctocc.x
+ctod		hlp = ctox.hlp,		src = fmtio$ctod.x
+ctoi		hlp = ctox.hlp,		src = fmtio$ctoi.x
+ctol		hlp = ctox.hlp,		src = fmtio$ctol.x
+ctor		hlp = ctox.hlp,		src = fmtio$ctor.x
+ctotok		hlp = ctox.hlp,		src = fmtio$ctotok.x
+ctowrd		hlp = ctox.hlp,		src = fmtio$ctowrd.x
+ctox		hlp = ctox.hlp,		src = fmtio$ctox.x
+dtoc		hlp = xtoc.hlp,		src = fmtio$dtoc.x
+eprintf		hlp = printf.hlp,	src = fmtio$eprintf.x
+fprintf		hlp = printf.hlp,	src = fmtio$fprintf.x
+fscan		hlp = scan.hlp,		src = fmtio$fscan.x
+gargb		hlp = garg.hlp,		src = fmtio$gargb.x
+gargc		hlp = garg.hlp,		src = fmtio$gargc.x
+gargd		hlp = garg.hlp,		src = fmtio$gargd.x
+gargi		hlp = garg.hlp,		src = fmtio$gargi.x
+gargl		hlp = garg.hlp,		src = fmtio$gargl.x
+gargr		hlp = garg.hlp,		src = fmtio$gargr.x
+gargrad		hlp = garg.hlp,		src = fmtio$gargrad.x
+gargs		hlp = garg.hlp,		src = fmtio$gargs.x
+gargstr		hlp = garg.hlp,		src = fmtio$gargstr.x
+gargtok		hlp = garg.hlp,		src = fmtio$gargtok.x
+gargwrd		hlp = garg.hlp,		src = fmtio$gargwrd.x
+gargx		hlp = garg.hlp,		src = fmtio$gargx.x
+gctod		hlp = ctox.hlp,		src = fmtio$gctod.x
+gctol		hlp = ctox.hlp,		src = fmtio$gctol.x
+gltoc		hlp = xtoc.hlp,		src = fmtio$gltoc.x
+gstrcat		hlp = gstrcat.hlp,	src = fmtio$gstrcat.x
+gstrcpy		hlp = gstrcpy.hlp,	src = fmtio$gstrcpy.x
+itoc		hlp = xtoc.hlp,		src = fmtio$itoc.x
+lexnum		hlp = lexnum.hlp,	src = fmtio$lexnum.x
+ltoc		hlp = xtoc.hlp,		src = fmtio$ltoc.x
+nscan		hlp = scan.hlp,		src = fmtio$nscan.x
+pargb		hlp = parg.hlp, 	src = fmtio$pargb.x
+pargc		hlp = parg.hlp,		src = fmtio$parg.x
+pargs		hlp = parg.hlp,		src = fmtio$parg.x
+pargi		hlp = parg.hlp,		src = fmtio$parg.x
+pargl		hlp = parg.hlp,		src = fmtio$parg.x
+pargr		hlp = parg.hlp,		src = fmtio$parg.x
+pargd		hlp = parg.hlp,		src = fmtio$parg.x
+pargx		hlp = parg.hlp,		src = fmtio$parg.x
+pargstr		hlp = parg.hlp,		src = fmtio$pargstr.x
+patmatch	hlp = patmatch.hlp,	src = fmtio$patmatch.x
+printf		hlp = printf.hlp,	src = fmtio$printf.x
+scanc		hlp = scan.hlp,		src = fmtio$scanc.x
+sprintf		hlp = printf.hlp,	src = fmtio$sprintf.x
+sscan		hlp = scan.hlp,		src = fmtio$sscan.x
+strcat		hlp = strcat.hlp,	src = fmtio$strcat.x
+strcpy		hlp = strcpy.hlp,	src = fmtio$strcpy.x
+strdic		hlp = strdic.hlp,	src = fmtio$strdic.x
+streq		hlp = streq.hlp,	src = fmtio$streq.x
+strge		hlp = strge.hlp,	src = fmtio$strge.x
+strgt		hlp = strgt.hlp,	src = fmtio$strgt.x
+stridx		hlp = stridx.hlp,	src = fmtio$stridx.x
+strldx		hlp = strldx.hlp,	src = fmtio$strldx.x
+strle		hlp = strle.hlp,	src = fmtio$strle.x
+strlen		hlp = strlen.hlp,	src = fmtio$strlen.x
+strlt		hlp = strlt.hlp,	src = fmtio$strlt.x
+strlwr		hlp = strlwr.hlp,	src = fmtio$strlwr.x
+strmatch	hlp = strmatch.hlp,	src = fmtio$strmatch.x
+strncmp		hlp = strncmp.hlp,	src = fmtio$strncmp.x
+strne		hlp = strne.hlp,	src = fmtio$strne.x
+strsearch	hlp = strsearch.hlp,	src = fmtio$strsearch.x
+strtbl		hlp = strtbl.hlp,	src = fmtio$strtbl.x
+strupr		hlp = strupr.hlp,	src = fmtio$strupr.x
+xtoc		hlp = xtoc.hlp,		src = fmtio$xtoc.x
diff --git a/sys/fmtio/doc/fmtio.men b/sys/fmtio/doc/fmtio.men
new file mode 100644
index 00000000..897a8139
--- /dev/null
+++ b/sys/fmtio/doc/fmtio.men
@@ -0,0 +1,59 @@
+	  cctoc - Character constant to char
+      chdeposit - Deposit a character in a string with overflow protection
+	chfetch - Fetch a character from a string
+	 chrlwr - Convert a character to lower case
+	 chrupr - Convert a character to upper case
+       clprintf - Formatted print to a CL parameter
+	 clscan - Scan a CL parameter
+	  ctocc - Char to character constant
+	   ctod - Character to double
+	   ctoi - Character to integer
+	   ctol - Character to long
+	   ctor - Character to real
+	   ctox - Character to complex
+	 ctotok - Character to lexical token
+	 ctowrd - Character to whitespace delimited word
+	   dtoc - Double to character
+	eprintf - Formatted print to STDERR
+	fprintf - Formatted print to any file
+	  fscan - Scan a file
+ garg[bcsilrdx] - Get scan argument
+	gargrad - Get scan argument in any numerical radix
+	gargstr - Get scan argument of type string
+	gargtok - Get scan argument of type token
+	gargwrd - Get scan argument of type word
+	  gctod - General character to double
+	  gctol - General character to long (any radix)
+	  gltoc - General long to character (any radix)
+	gstrcat - String concatenation returning length of output string
+	gstrcpy - String copy returning length of output string
+	   itoc - Integer to character
+	 lexnum - Lexically analyze a string to determine if it is a number
+	   ltoc - Long to character
+	  nscan - Get number of arguments successfully converted in last scan
+ parg[bcsilrdx] - Pass an argument to a printf
+	pargstr - Pass a string type argument to a printf
+       patmatch - General pattern matching
+	 printf - Formatted print to STDOUT
+	  scanc - Get the next character from a scan
+	sprintf - Formatted print to a string buffer
+	  sscan - Scan a string buffer
+	 strcat - String concatenation
+	 strcpy - String copy
+	 strdic - Look a string up in a dictionary
+	  streq - Compare strings for equality
+	  strge - Is string A greater than or equal to string B
+	  strgt - Is string A greater than string B
+	 stridx - First occurrence of a character in a string
+	 strldx - Last occurrence of a character in a string
+	  strle - Is string A less than or equal to string B
+	 strlen - Length of a string
+	  strlt - Is string A less than string B
+	 strlwr - Convert string to lower case
+       strmatch - Search a string for a pattern
+	strncmp - Compare the first N characters of two strings
+	  strne - Is string A not equal to string B
+      strsearch - Fast string search, no metacharacters
+	 strtbl - Print a list of strings in a table
+	 strupr - Convert a string to upper case
+	   xtoc - Complex to character
diff --git a/sys/fmtio/doc/lexnum.hlp b/sys/fmtio/doc/lexnum.hlp
new file mode 100644
index 00000000..647654b1
--- /dev/null
+++ b/sys/fmtio/doc/lexnum.hlp
@@ -0,0 +1,303 @@
+
+.help lexnum 2 "string utilities"
+.ih _________________________________________________________________________
+NAME
+lexnum -- Determine if string is a number
+.ih
+USAGE
+token_type = lexnum (str, ip, nchars)
+
+.ih
+PARAMETERS
+.ls str
+String to be scanned.
+.le
+.ls ip
+Index within the string as which scanning is to start.  Not modified.
+.le
+.ls nchars
+On output, the number of characters in the number, not including any
+leading whitespace.
+.le
+.ih
+DESCRIPTION
+The character string is scanned to determine if the next token is a
+legal number, and if so, the type of number.  The function value identifies
+the type of number.  The possible return values, defined in <lexnum.h>,
+as as follows:
+
+.nf
+	LEX_OCTAL	(+|-)?[0-7]+[bB]
+	LEX_DECIMAL	(+|-)?[0-9]+
+	LEX_HEX		(+|-)?[0-9a-fA-F]+[xX]
+	LEX_REAL	floating, exponential [eEdD], sexagesimal
+	LEX_NONNUM	not a number
+.fi
+.ih
+IMPLEMENTATION
+Numtype is implemented as a finite state automaton.  Additional documentation
+is provided with the source code.
+.ih
+SEE ALSO
+gctod(2), ctotok(2).
+.endhelp ___________________________________________________________________
+
+
+
+.help states 2 "States of the LEXNUM Finite State Automaton"
+.fi
+
+
+.ks
+.nf
+start:								(1)
+	+-		shift	unop_or_number
+	0-7		shift	odhr
+	8-9		shift	dhr
+	acf		reduce	not_a_number
+	ed		reduce	not_a_number
+	:		shift	maybe_real_number
+	.		shift	maybe_real_fraction
+	x		reduce	not_a_number
+	b		reduce	not_a_number
+	other		reduce	not_a_number
+.fi
+.ke
+
+
+.ks
+.nf
+unop_or_number:		(+|-)					(2)
+	+-		revert
+	0-7		shift	odhr
+	8-9		shift	dhr
+	acf		revert
+	ed		revert
+	:		revert
+	.		shift	maybe_real_fraction
+	x		revert
+	b		revert
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+odhr:			(+|-)?[0-7]				(3)
+	+-		reduce	decimal_number
+	0-7		accept
+	8-9		shift	dhr
+	acf		shift	h
+	ed		shift	maybe_hex_or_rexp
+	:		shift	maybe_real_number
+	.		shift	real_fraction
+	x		reduce	hex_number
+	b		shift	octal_or_hex_number
+	other		reduce	decimal_number
+.fi
+.ke
+
+
+.ks
+.nf
+dhr:			(+|-)?[0-9]+				(4)
+	+-		reduce	decimal_number
+	0-7		accept
+	8-9		accept
+	acf		shift	h
+	ed		shift	maybe_hex_or_rexp
+	:		shift	maybe_real_number
+	.		shift	real_fraction
+	x		reduce	hex_number
+	b		shift	h
+	other		reduce	decimal_number
+.fi
+.ke
+
+
+.ks
+.nf
+maybe_real_fraction:	(+|-)?"."				(5)
+	+-		revert
+	0-7		shift	real_fraction
+	8-9		shift	real_fraction
+	acf		revert
+	ed		revert
+	:		revert
+	.		revert
+	x		revert
+	b		revert
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+h:			(+|-)?[0-9]*[a-f]			(6)
+	+-		revert
+	0-7		accept
+	8-9		accept
+	acf		accept
+	ed		accept
+	:		revert
+	.		revert
+	x		reduce	hex_number
+	b		accept
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+maybe_hex_or_rexp:	(+|-)?[0-9]+[ed]			(7)
+	+-		shift	maybe_rexp
+	0-7		shift	hex_or_rexp
+	8-9		shift	hex_or_rexp
+	acf		shift	h
+	ed		shift	h
+	:		revert
+	.		revert
+	x		reduce	hex_number
+	b		shift	h
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+maybe_real_number:	(+|-)?[0-9]*":"				(8)
+	+-		revert
+	0-7		shift	r
+	8-9		shift	r
+	acf		revert
+	ed		revert
+	:		accept
+	.		revert
+	x		revert
+	b		revert
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+octal_or_hex_number:	(+|-)?[0-7]"b"				(9)
+	+-		reduce	octal_number
+	0-7		shift	h
+	8-9		shift	h
+	acf		shift	h
+	ed		shift	h
+	:		reduce	octal_number
+	.		reduce	octal_number
+	x		reduce	hex_number
+	b		shift	h
+	other		reduce	octal_number
+.fi
+.ke
+
+
+.ks
+.nf
+real_fraction:		(+|-)?"."[0-9]				(10)
+	+-		reduce	real_number
+	0-7		accept
+	8-9		accept
+	acf		reduce	real_number
+	ed		shift	rfr_or_rexp
+	:		reduce	real_number
+	.		reduce	real_number
+	x		reduce	real_number
+	b		reduce	real_number
+	other		reduce	real_number
+.fi
+.ke
+
+
+.ks
+.nf
+rfr_or_rexp:		(+|-)?"."[0-9]+[ed]			(11)
+	+-		shift	maybe_rexp
+	0-7		shift	rexp
+	8-9		shift	rexp
+	acf		revert
+	ed		revert
+	:		revert
+	.		revert
+	x		revert
+	b		revert
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+maybe_rexp:		(+|-)?[0-9]+[ed](+|-)			(12)
+	+-		revert
+	0-7		shift	rexp
+	8-9		shift	rexp
+	acf		revert
+	ed		revert
+	:		revert
+	.		revert
+	x		revert
+	b		revert
+	other		revert
+.fi
+.ke
+
+
+.ks
+.nf
+hex_or_rexp:		(+|-)?[0-9]+[ed][0-9]			(13)
+	+-		reduce	real_number
+	0-7		accept
+	8-9		accept
+	acf		shift	h
+	ed		shift	h
+	:		reduce	real_number
+	.		reduce	real_number
+	x		reduce	hex_number
+	b		reduce	real_number
+	other		reduce	real_number
+.fi
+.ke
+
+
+.ks
+.nf
+r:			(+|-)?[0-9]*":"[0-9]			(14)
+	+-		reduce	real_number
+	0-7		accept
+	8-9		accept
+	acf		reduce	real_number
+	ed		shift	maybe_rexp
+	:		accept
+	.		shift	maybe_real_fraction
+	x		reduce	real_number
+	b		reduce	real_number
+	other		reduce	real_number
+.fi
+.ke
+
+
+.ks
+.nf
+rexp:			(+|-)?[0-9]+[ed](+|-)[0-9]		(15)
+	+-		reduce	real_number
+	0-7		accept
+	8-9		accept
+	acf		reduce	real_number
+	ed		reduce	real_number
+	:		reduce	real_number
+	.		reduce	real_number
+	x		reduce	real_number
+	b		reduce	real_number
+	other		reduce	real_number
+.fi
+.ke
diff --git a/sys/fmtio/dtcscl.x b/sys/fmtio/dtcscl.x
new file mode 100644
index 00000000..afd6adc5
--- /dev/null
+++ b/sys/fmtio/dtcscl.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# DTCSCL -- Scales a double precision real, maintaining maximum precision.
+# Called by DTOC and CTOD.
+
+procedure dtcscl (v, e, sense)
+
+double	v		# value to be scaled
+int	e		# exponent
+int	sense		# sense of scaling (0=apply e to v;  1=calc e)
+
+begin
+	if (sense == 0) 		# scale v by 10 ** e
+	    v = v * (10.0d0 ** e)
+
+	else {				# scale number to 0.1 <= v < 1.0
+	    if (v == 0.0d0)
+		e = 0
+	    else {
+	        e = -1
+	        while (v < 0.1d0) {
+		    v = v * 10.0d0
+		    e = e - 1
+		    if (v == 0.0d0) {	# check for underflow to zero
+			e = 0
+			break
+		    }
+	        }
+	        while (v >= 1.0d0) {
+		    v = v / 10.0d0
+		    e = e + 1
+	        }
+	    }
+	}
+end
diff --git a/sys/fmtio/dtoc.x b/sys/fmtio/dtoc.x
new file mode 100644
index 00000000..6bf7571e
--- /dev/null
+++ b/sys/fmtio/dtoc.x
@@ -0,0 +1,129 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<printf.h>
+
+# DTOC -- Format and output a floating point number, in any of the formats
+# F,E,G,H, or M (H and M are hours-minutes-seconds and minutes-seconds formats,
+# respectively).
+
+int procedure dtoc (dval, outstr, maxch, decpl, a_fmt, width)
+
+double	dval			# number to be output
+char	outstr[ARB]		# output string
+int	maxch			# size of the output string
+int	decpl			# number of decimal places or precision
+int	a_fmt, fmt		# format type (feghm)
+int	width			# field width
+
+bool	neg
+double	val
+int	op, round, h, m, s, f, v, i
+int	dtoc3(), ltoc()
+
+define	output {outstr[op]=$1;op=op+1;if(op>maxch)goto retry_}
+define	retry_ 91
+
+begin
+	# If HMS format is not desired, simply call DTOC3.  Control also
+	# returns to this point in the event of overflow.
+
+	fmt = a_fmt
+	if (IS_UPPER (fmt))
+	    fmt = TO_LOWER (fmt)
+
+	if (fmt == FMT_FIXED || fmt == FMT_EXPON || fmt == FMT_GENERAL ||
+	    IS_INDEFD(dval)) {
+retry_	
+	    return (dtoc3 (dval, outstr, maxch, decpl, fmt, width))
+	}
+
+	# HMS format is implemented using calls to DTOC3, LTOC.  Use zero
+	# fill to get two chars for the second and third fields, if necessary.
+	# The second field is omitted for "m" format.  No whitespace is
+	# permitted in an HMS (or other) number.  If the format is %H or %M
+	# (instead of the usual %h or %m) scale the number by 15 before output
+	# (converting degrees to hours).
+
+	if (IS_UPPER (a_fmt))
+	    val = dval / 15.0
+	else
+	    val = dval
+
+	# Working with a positive number simplifies things.
+	neg = (val < 0.0)
+	if (neg)
+	    val = -val
+
+	# Decompose number into HMS or MS.
+	h = 0
+	if (fmt == FMT_HMS) {
+	    h = int(val);  val = (val - h) * 60.0
+	}
+	m = int(val);  val = (val - m) * 60.0
+	s = int(val);  val = (val - s)
+
+	# Round the fractional seconds field and carry if the rounded value
+	# is greater than 60.  This has to be done explicitly due to the
+	# "base 60" sexagesimal arithmetic.
+
+	round = (10.0 ** decpl)
+	f = int (val * round + 0.5)
+	while (f >= round) {
+	    f = f - round
+	    s = s + 1
+	}
+	while (s >= 60) {
+	    s = s - 60
+	    m = m + 1
+	}
+	while (m >= 60) {
+	    m = m - 60
+	    h = h + 1
+	}
+
+	# Format the output string.
+	op = 1
+	if (neg)
+	    output ('-')
+
+	# Output the first field, which is the hours field for HMS format,
+	# or the minutes field for MS format.
+
+	if (fmt == FMT_HMS)
+	    v = h
+	else
+	    v = h * 60 + m
+	op = op + ltoc (v, outstr[op], maxch-op+1)
+	output (':')
+
+	# Output the minutes field in HMS format.
+	if (fmt == FMT_HMS) {
+	    output (TO_DIGIT (m / 10))
+	    output (TO_DIGIT (mod (m, 10)))
+	    output (':')
+	}
+
+	# Output the seconds field.
+	output (TO_DIGIT (s / 10))
+	output (TO_DIGIT (mod (s, 10)))
+
+	# Output the fraction, if any.
+	if (decpl > 0) {
+	    output ('.')
+	    do i = 1, decpl {
+		round = round / 10
+		output (TO_DIGIT (f / round))
+		f = mod (f, round)
+	    }
+	}
+
+	# If the HMS format does not fit, go try a more compact format.
+	if (op-1 > abs(width) || op > maxch) {
+	    fmt = FMT_GENERAL
+	    goto retry_
+	}
+
+	outstr[op] = EOS
+	return (op-1)
+end
diff --git a/sys/fmtio/dtoc3.x b/sys/fmtio/dtoc3.x
new file mode 100644
index 00000000..76101dd1
--- /dev/null
+++ b/sys/fmtio/dtoc3.x
@@ -0,0 +1,285 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <ctype.h>
+include <printf.h>
+
+.help dtoc3
+.nf ___________________________________________________________________________
+This routine is based on the TOOLS routine of the same name by J. Chong.
+The major changes are translation to the IRAF pp language, implementation
+of the "G" format, and some restructuring to avoid duplicated code.
+This procedure is called by the more general routine DTOC, which adds the
+additional format type "H" (sexageximal, or hms format).
+
+Formats:	f	Fixed format.  D == number of decimal places.  If D
+			is -1 (or less), the "." will not be printed.  If the
+			number being printed is too large to fit in F format,
+			"E" format will be used instead.  Nonsignificant
+			digits are returned as zeros.
+
+		e	Exponential format.  D == number of significant digits.
+
+		g	General format.  D == number of significant digits.
+			The actual format used may be either F or E, depending
+			on which is smaller.  If D is negative, the "." will
+			be omitted if possible (abs(D) remains the precision).
+
+If the field width is too small to convert the number, the field will be
+filled with asterisks instead.  If the number being converted is INDEF, the
+string "INDEF" will be returned.  The number is rounded to the desired precision
+before being printed.
+.endhelp ______________________________________________________________________
+
+# DTOC3 --- Convert double precision real to string.
+
+int procedure dtoc3 (val, out, maxch, decpl, a_fmt, width)
+
+double	val			# value to be encoded
+char	out[ARB]		# output string
+int	maxch			# max chars out
+int	decpl			# precision
+int	a_fmt			# type of encoding ('f', 'e', etc.)
+int	width			# field width
+
+double	v
+char	digits[MAX_DIGITS]
+bool	neg, small, exp_format, squeeze
+int	i, w, d, e, j, len, no_digits, max_size, e_size, f_size, fmt
+int	itoc(), gstrcpy()
+
+begin
+	# Set flags indicating whether the number is greater or less that zero,
+	# and whether its absolute value is greater or less than 1.
+
+	v = abs (val)
+	w = abs (width)
+
+	fmt = a_fmt
+	if (IS_UPPER(a_fmt))
+	    fmt = TO_LOWER(a_fmt)
+	squeeze = (fmt == FMT_GENERAL)
+	neg = (val < 0.0)
+	small = (v < 0.1)
+
+	if (squeeze)
+	    d = abs (decpl)
+	else
+	    d = max (0, decpl)
+
+	if (IS_INDEFD (val))			# INDEF is a special case
+	    return (gstrcpy ("INDEF", out, w))
+
+	# Scale number to 0.1 <= v < 1.0
+	call dtcscl (v, e, 1)
+
+	# Start tally for the maximum size of the number to determine if an
+	# error should be returned.
+	if (neg)				# 1 for neg, plus 1 for .
+	    max_size = 2
+	else
+	    max_size = 1
+	no_digits = min (MAX_DIGITS, d)
+
+
+	# Determine exact format for printing.
+
+	len = abs (e)				# base size of E format
+	e_size = 1
+	for (i=10;  i <= 10000;  i=i*10) {
+	    if (len < i)
+		break
+	    e_size = e_size + 1
+	}
+	e_size = e_size + max_size + 1
+	if (e < 0)
+	    e_size = e_size + 1			# allow space for leading '0'
+
+	if (squeeze) {				# G-format: find best format
+	    e_size = e_size + d
+	    if (e > 0)
+	        f_size = max (d, e + 1)
+	    else
+		f_size = d - e
+	    f_size = f_size + max_size
+	} else if (fmt == FMT_FIXED)
+	    f_size = max (e, 1) + max_size + d
+
+
+	if (squeeze) {				# 'G' format
+	    if (f_size <= e_size) {
+		exp_format = false
+		if (e > 0)
+		    no_digits = f_size - max_size
+	        max_size = f_size
+	    } else {
+		exp_format = true
+		max_size = e_size
+	    }
+	    d = w				# deactivate dec-places count
+
+	} else if (fmt == FMT_FIXED) {		# Fortran 'F' format
+	    exp_format = f_size > w
+
+	    if (exp_format) {			# is there too little space?
+		no_digits = max (1, w - e_size)
+		max_size = no_digits + e_size
+	    } else {
+		no_digits = e + d + 1		# negative e is OK here
+		max_size = f_size
+	    }
+
+	} else { 				# Fortran 'E' format
+	    exp_format = true
+	    max_size = e_size + d
+	    d = w
+	}
+
+	# Round the number at digit (no_digits + 1).
+	if (no_digits >= 0)
+	    v = v + 0.5 * 10. ** (-no_digits)
+
+	# Be sure the number of digits is in range.
+	no_digits = max(1, min(MAX_DIGITS, no_digits))
+
+	# Handle the unusual situation of rounding from .999..  up to 1.000.
+	if (v >= 1.0) {
+	    v = v / 10.0
+	    e = e + 1
+	    if (!exp_format) {
+		max_size = max_size + 1
+		no_digits = min (MAX_DIGITS, no_digits + 1)
+	    }
+	}
+
+	# See if the number will fit in 'w' characters
+	if (max_size > w) {
+	    for (i=1;  i <= w;  i=i+1)
+		out[i] = OVFL_CHAR
+	    out[i] = EOS
+	    return (w)
+	}
+
+	# Extract the first <no_digits> digits.  At the start V is normalized
+	# to a value less than 1.0.  The algorithm is to multiply by ten and
+	# take the integer part to get each digit.  
+
+	do i = 1, no_digits {
+	    v = v * 10.0d0
+	    j = int (v + EPSILOND)		# truncate to integer
+	    v = v - j				# lop off the integral part
+
+	    # Make sure the next iteration will produce a decimal J in the
+	    # range 1-9.  On some systems, due to precision problems J=int(V)
+	    # can be off by one compared to V-J and this will result in a J
+	    # of 10 in the next iteration.  The expression below attempts to
+	    # look ahead for J>=10 and adjusts the J for the current iteration
+	    # up by one if this will occur.
+
+	    if (int (v * 10.0d0 + EPSILOND) >= 10) {
+		j = j + 1
+		v = v - 1
+		if (v < 0)
+		    v = 0
+	    }
+
+	    digits[i] = TO_DIGIT(j)
+	}
+
+	# Take digit string and exponent and arrange into desired format.
+	len = 1
+	if (neg) {
+	    out[1] = '-'
+	    len = len + 1
+	}
+
+	if (exp_format) {			# set up exponential format
+	    out[len] = digits[1]
+	    out[len+1] = '.'
+	    len = len + 2
+	    for (i=2;  i <= no_digits;  i=i+1) {
+	        out[len] = digits[i]
+	        len = len + 1
+	    }
+	    out[len] = 'E'
+	    len = len + 1
+	    if (e < 0) {
+		out[len] = '-'
+		len = len + 1
+		e = -e
+	    }
+	    len = len + itoc (e, out[len], w - len + 1)
+
+	} else if (e >= no_digits) {
+	    # Handle numbers >= 1 with dp after figures.
+	    for (i=1;  i <= no_digits;  i=i+1) {
+		out[len] = digits[i]
+		len = len + 1
+	    }
+    	    for (i=no_digits;  i <= e;  i=i+1) {
+		out[len] = '0'
+		len = len + 1
+	    }
+	    if (decpl > 0) {
+	        out[len] = '.'
+	        len = len + 1
+	        if (!squeeze) {
+		    for (i=1;  i <= d;  i=i+1) {
+		        out[len] = '0'
+		        len = len + 1
+		    }
+	        }
+	    }
+
+	} else {
+	    if (e < 0) {
+		# Handle fixed numbers < 1.
+	        if (d == 0 && e == -1 && digits[1] >= '5') 
+		    out[len] = '1'
+	        else
+		    out[len] = '0'
+	        out[len + 1] = '.'
+	        len = len + 2
+	        for (i=1;  i < -e && d > 0;  i=i+1) {
+		    out[len] = '0'
+		    len = len + 1
+		    d = d - 1
+	        }
+		i = 1
+	    } else {
+		# Handle numbers > 1 with dp inside figures.
+	        e = e + 2				# one more zero below
+	        for (i=1;  i < e;  i=i+1) {
+		    out[len] = digits[i]
+		    len = len + 1
+	        }
+		if (decpl > 0) {
+	            out[len] = '.'
+	            len = len + 1
+		}
+	    }
+
+	    for (j=1;  i <= no_digits && j <= d;  j=j+1) {
+		out[len] = digits[i]
+		i = i + 1
+		len = len + 1
+	    }
+	    if (squeeze) {
+	        while (len > 2) {			# skip trailing zeroes
+		    len = len - 1
+		    if (out[len] != '0') {
+		        len = len + 1			# non-digit -- keep it
+		        break
+		    }
+		}
+	    } else {
+		for (i=1;  i < d+e-no_digits && i <= d;  i=i+1) {
+		    out[len] = '0'
+		    len = len + 1
+		}
+	    }
+	}
+
+	out[len] = EOS
+	return (len - 1)
+end
diff --git a/sys/fmtio/eprintf.x b/sys/fmtio/eprintf.x
new file mode 100644
index 00000000..51b2d196
--- /dev/null
+++ b/sys/fmtio/eprintf.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# EPRINTF -- Format output to the standard error output.
+
+procedure eprintf (format_string)
+
+char	format_string[ARB]
+
+begin
+	call flush (STDOUT)
+	call fprntf (STDERR, format_string, REGULAR_FILE)
+end
diff --git a/sys/fmtio/escchars.inc b/sys/fmtio/escchars.inc
new file mode 100644
index 00000000..d3c4d33e
--- /dev/null
+++ b/sys/fmtio/escchars.inc
@@ -0,0 +1,5 @@
+
+# Escape sequences
+
+string	escape_chars "ntfr'\"\\"
+string	mapped_chars "\n\t\f\r'\"\\"
diff --git a/sys/fmtio/evexpr.com b/sys/fmtio/evexpr.com
new file mode 100644
index 00000000..65488986
--- /dev/null
+++ b/sys/fmtio/evexpr.com
@@ -0,0 +1,7 @@
+# EVEXPR common.
+
+pointer	ev_oval				# pointer to expr value operand
+int	ev_getop			# user supplied get operand procedure
+int	ev_ufcn				# user supplied function call procedure
+
+common	/xevcom/ ev_oval, ev_getop, ev_ufcn
diff --git a/sys/fmtio/evexpr.x b/sys/fmtio/evexpr.x
new file mode 100644
index 00000000..4d512a20
--- /dev/null
+++ b/sys/fmtio/evexpr.x
@@ -0,0 +1,1477 @@
+
+# line 2 "evexpr.y"
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<evexpr.h>
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	16		# max args in a function call
+define	yyparse		xev_parse
+
+define	DTOR		(($1)/57.2957795)
+define	RTOD		(($1)*57.2957795)
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|exp|int|log|log10|\
+			 |max|min|mod|nint|real|sin|sqrt|str|tan|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_EXP		08
+define	F_INT		09
+define	F_LOG		10
+define	F_LOG10		11
+	# newline	12
+define	F_MAX		13
+define	F_MIN		14
+define	F_MOD		15
+define	F_NINT		16
+define	F_REAL		17
+define	F_SIN		18
+define	F_SQRT		19
+define	F_STR		20
+define	F_TAN 		21
+
+
+# EVEXPR -- Evaluate an expression.  This is the top level procedure, and the
+# only externally callable entry point.  Input consists of the expression to
+# be evaluated (a string) and, optionally, user procedures for fetching
+# external operands and executing external functions.  Output is a pointer to
+# an operand structure containing the computed value of the expression.
+# The output operand structure is dynamically allocated by EVEXPR and must be
+# freed by the user.
+#
+# N.B.: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.
+
+pointer procedure evexpr (expr, getop_epa, ufcn_epa)
+
+char	expr[ARB]		# expression to be evaluated
+int	getop_epa		# user supplied get operand procedure
+int	ufcn_epa		# user supplied function call procedure
+
+int	junk
+bool	debug
+pointer	sp, ip
+extern	xev_gettok()
+int	strlen(), xev_parse()
+
+errchk	xev_parse, calloc
+include	"evexpr.com"
+data	debug /false/
+
+begin
+	call smark (sp)
+
+	# Set user function entry point addresses.
+	ev_getop = getop_epa
+	ev_ufcn  = ufcn_epa
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XEV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xev_parse (ip, debug, xev_gettok)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+define	CONSTANT		257
+define	IDENTIFIER		258
+define	NEWLINE		259
+define	YYEOS		260
+define	PLUS		261
+define	MINUS		262
+define	STAR		263
+define	SLASH		264
+define	EXPON		265
+define	CONCAT		266
+define	QUEST		267
+define	COLON		268
+define	LT		269
+define	GT		270
+define	LE		271
+define	EQ		272
+define	NE		273
+define	SE		274
+define	AND		275
+define	OR		276
+define	NOT		277
+define	AT		278
+define	GE		279
+define	UMINUS		280
+define	yyclearin	yychar = -1
+define	yyerrok		yyerrflag = 0
+define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
+define	YYERRCODE	256
+
+
+
+# XEV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xev_unop (opcode, in, out)
+
+int	opcode			# operation to be performed
+pointer	in			# input operand
+pointer	out			# output operand
+
+errchk	xev_error
+define	badsw_ 91
+
+begin
+	call xev_initop (out, 0, O_TYPE(in))
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xev_error ("negation of a nonarithmetic operand")
+	    case TY_INT:
+		O_VALI(out) = -O_VALI(in)
+	    case TY_REAL:
+		O_VALR(out) = -O_VALR(in)
+	    default:
+		goto badsw_
+	    }
+
+	case NOT:
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		O_VALB(out) = !O_VALB(in)
+	    case TY_CHAR, TY_INT, TY_REAL:
+		call xev_error ("not of a nonlogical")
+	    default:
+		goto badsw_
+	    }
+
+	default:
+badsw_	    call xev_error ("bad switch in unop")
+	}
+end
+
+
+# XEV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xev_binop (opcode, in1, in2, out)
+
+int	opcode			# operation to be performed
+pointer	in1, in2		# input operands
+pointer	out			# output operand
+
+real	r1, r2
+int	i1, i2, dtype, nchars
+int	xev_newtype(), strlen()
+errchk	xev_newtype
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xev_newtype (O_TYPE(in1), O_TYPE(in2))
+	call xev_initop (out, 0, dtype)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xev_error ("operation illegal for boolean operands")
+	case TY_CHAR:
+	    if (opcode != CONCAT)
+		call xev_error ("operation illegal for string operands")
+	case TY_INT:
+	    i1 = O_VALI(in1)
+	    i2 = O_VALI(in2)
+	case TY_REAL:
+	    if (O_TYPE(in1) == TY_INT)
+		r1 = O_VALI(in1)
+	    else
+		r1 = O_VALR(in1)
+	    if (O_TYPE(in2) == TY_INT)
+		r2 = O_VALI(in2)
+	    else
+		r2 = O_VALR(in2)
+	default:
+	    call xev_error ("unknown datatype code in binop")
+	}
+
+	# Perform the operation.
+	switch (opcode) {
+	case PLUS:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 + i2
+	    else
+		O_VALR(out) = r1 + r2
+
+	case MINUS:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 - i2
+	    else
+		O_VALR(out) = r1 - r2
+
+	case STAR:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 * i2
+	    else
+		O_VALR(out) = r1 * r2
+
+	case SLASH:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 / i2
+	    else
+		O_VALR(out) = r1 / r2
+
+	case EXPON:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 ** i2
+	    else if (O_TYPE(in1) == TY_REAL && O_TYPE(in2) == TY_INT)
+		O_VALR(out) = r1 ** (O_VALI(in2))
+	    else
+		O_VALR(out) = r1 ** r2
+
+	case CONCAT:
+	    if (dtype != TY_CHAR)
+		call xev_error ("concatenation of a nonstring operand")
+	    nchars = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	    call xev_makeop (out, nchars, TY_CHAR)
+	    call strcpy (O_VALC(in1), O_VALC(out), ARB)
+	    call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    call xev_freeop (in1)
+	    call xev_freeop (in2)
+
+	default:
+	    call xev_error ("bad switch in binop")
+	}
+end
+
+
+# XEV_BOOLOP -- Boolean binary operations.  Perform the indicated boolean binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xev_boolop (opcode, in1, in2, out)
+
+int	opcode			# operation to be performed
+pointer	in1, in2		# input operands
+pointer	out			# output operand
+
+bool	result
+real	r1, r2
+int	i1, i2, dtype
+int	xev_newtype(), xev_patmatch(), strncmp()
+errchk	xev_newtype, xev_error
+define	badsw_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xev_newtype (O_TYPE(in1), O_TYPE(in2))
+	call xev_initop (out, 0, dtype)
+
+	switch (opcode) {
+	case AND, OR:
+	    if (dtype != TY_BOOL)
+		call xev_error ("AND or OR of nonlogical")
+	case LT, GT, LE, GE:
+	    if (dtype == TY_BOOL)
+		call xev_error ("order comparison of a boolean operand")
+	}
+
+	if (dtype == TY_INT) {
+	    i1 = O_VALI(in1)
+	    i2 = O_VALI(in2)
+	} else if (dtype == TY_REAL) {
+	    if (O_TYPE(in1) == TY_INT) {
+		i1 = O_VALI(in1)
+		r1 = i1
+	    } else
+		r1 = O_VALR(in1)
+	    if (O_TYPE(in2) == TY_INT) {
+		i2 = O_VALI(in2)
+		r2 = i2
+	    } else
+		r2 = O_VALR(in2)
+	}
+
+	# Perform the operation.
+	switch (opcode) {
+	case AND:
+	    result = O_VALB(in1) && O_VALB(in2)
+	case OR:
+	    result = O_VALB(in1) || O_VALB(in2)
+
+	case LT, GE:
+	    if (dtype == TY_INT)
+		result = i1 < i2
+	    else if (dtype == TY_REAL)
+		result = r1 < r2
+	    else
+		result = strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0
+	    if (opcode == GE)
+		result = !result
+
+	case GT, LE:
+	    if (dtype == TY_INT)
+		result = i1 > i2
+	    else if (dtype == TY_REAL)
+		result = r1 > r2
+	    else
+		result = strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0
+	    if (opcode == LE)
+		result = !result
+
+	case EQ, SE, NE:
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (O_VALB(in1))
+		    result =  O_VALB(in2)
+		else
+		    result = !O_VALB(in2)
+	    case TY_CHAR:
+		if (opcode == SE)
+		    result = xev_patmatch (O_VALC(in1), O_VALC(in2)) > 0
+		else
+		    result = strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0
+	    case TY_INT:
+		result = i1 == i2
+	    case TY_REAL:
+		result = r1 == r2
+	    default:
+		goto badsw_
+	    }
+	    if (opcode == NE)
+		result = !result
+
+	default:
+badsw_	    call xev_error ("bad switch in boolop")
+	}
+
+	call xev_makeop (out, 0, TY_BOOL)
+	O_VALB(out) = result
+
+	# Free storage if there were any string type input operands.
+	call xev_freeop (in1)
+	call xev_freeop (in2)
+end
+
+
+# XEV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xev_patmatch (str, pat)
+
+char	str[ARB]		# operand string
+char	pat[ARB]		# pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XEV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xev_newtype (type1, type2)
+
+int	type1, type2
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/TY_BOOL, TY_CHAR,  TY_INT,  TY_REAL/
+data	(ttbl(i),i=1,4)		/TY_BOOL,       0,       0,        0/
+data	(ttbl(i),i=5,8)		/      0, TY_CHAR,       0,        0/
+data	(ttbl(i),i=9,12)	/      0,       0,  TY_INT,  TY_REAL/
+data	(ttbl(i),i=13,16)	/      0,       0, TY_REAL,  TY_REAL/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xev_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XEV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xev_quest (cond, trueop, falseop, out)
+
+pointer	cond			# pointer to condition operand
+pointer	trueop, falseop		# pointer to true,false operands
+pointer	out			# pointer to output operand
+errchk	xev_error
+
+begin
+	if (O_TYPE(cond) != TY_BOOL)
+	    call xev_error ("nonboolean condition operand")
+
+	if (O_VALB(cond)) {
+	    YYMOVE (trueop, out)
+	    call xev_freeop (falseop)
+	} else {
+	    YYMOVE (falseop, out)
+	    call xev_freeop (trueop)
+	}
+end
+
+
+# XEV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xev_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		# function to be called
+pointer	args[ARB]		# pointer to arglist descriptor
+int	nargs			# number of arguments
+pointer	out			# output operand (function value)
+
+real	rresult, rval[2], rtemp
+int	iresult, ival[2], type[2], optype, oplen, itemp
+int	opcode, v_nargs, i
+pointer	sp, buf, ap
+include	"evexpr.com"
+
+bool	strne()
+int	strdic(), strlen()
+errchk	zcall4, xev_error1, xev_error2, malloc
+string	keywords KEYWORDS
+define	badtype_ 91
+define	free_ 92
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	oplen = 0
+
+	# Lookup the function name in the dictionary.  An exact match is
+	# required (strdic permits abbreviations).
+
+	opcode = strdic (fcn, Memc[buf], SZ_FNAME, keywords)
+	if (opcode > 0 && strne(fcn,Memc[buf]))
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall4 (ev_ufcn, fcn, args, nargs, out)
+		goto free_
+	    } else
+		call xev_error1 ("unknown function `%s' called", fcn)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xev_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xev_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Verify datatypes.
+	if (opcode != F_STR && opcode != F_BOOL) {
+	    optype = TY_REAL
+	    do i = 1, min(2,nargs) {
+		switch (O_TYPE(args[i])) {
+		case TY_INT:
+		    ival[i] = O_VALI(args[i])
+		    rval[i] = ival[i]
+		    type[i] = TY_INT
+		case TY_REAL:
+		    rval[i] = O_VALR(args[i])
+		    ival[i] = nint (rval[i])
+		    type[i] = TY_REAL
+		default:
+		    goto badtype_
+		}
+	    }
+	}
+
+	# Evaluate the function.
+
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    if (type[1] == TY_INT) {
+		iresult = abs (ival[1])
+		optype = TY_INT
+	    } else
+		rresult = abs (rval[1])
+
+	case F_ACOS:
+	    rresult = RTOD (acos (rval[1]))
+	case F_ASIN:
+	    rresult = RTOD (asin (rval[1]))
+	case F_COS:
+	    rresult =   cos (DTOR (rval[1]))
+	case F_EXP:
+	    rresult =   exp (rval[1])
+	case F_LOG:
+	    rresult =   log (rval[1])
+	case F_LOG10:
+	    rresult = log10 (rval[1])
+	case F_SIN:
+	    rresult =   sin (DTOR (rval[1]))
+	case F_SQRT:
+	    rresult =  sqrt (rval[1])
+	case F_TAN:
+	    rresult =   tan (DTOR (rval[1]))
+
+	case F_ATAN, F_ATAN2:
+	    if (nargs == 1)
+		rresult = RTOD (atan (rval[1]))
+	    else
+		rresult = RTOD (atan2 (rval[1], rval[2]))
+
+	case F_MOD:
+	    if (type[1] == TY_REAL || type[2] == TY_REAL)
+		rresult = mod (rval[1], rval[2])
+	    else {
+		iresult = mod (ival[1], ival[2])
+		optype = TY_INT
+	    }
+		
+	case F_NINT:
+	    iresult = nint (rval[1])
+	    optype = TY_INT
+
+	case F_MAX, F_MIN:
+	    # Determine datatype of result.
+	    optype = TY_INT
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) == TY_REAL)
+		    optype = TY_REAL
+		else if (O_TYPE(args[i]) != TY_INT)
+		    goto badtype_
+
+	    # Compute result.
+	    if (optype == TY_INT) {
+		iresult = O_VALI(ap)
+		do i = 2, nargs {
+		    itemp = O_VALI(args[i])
+		    if (opcode == F_MAX)
+			iresult = max (iresult, itemp)
+		    else
+			iresult = min (iresult, itemp)
+		}
+
+	    } else {
+		if (O_TYPE(ap) == TY_INT)
+		    rresult = O_VALI(ap)
+		else
+		    rresult = O_VALR(ap)
+
+		do i = 2, nargs {
+		    if (O_TYPE(args[i]) == TY_INT)
+			rtemp = O_VALI(args[i])
+		    else
+			rtemp = O_VALR(args[i])
+		    if (opcode == F_MAX)
+			rresult = max (rresult, rtemp)
+		    else
+			rresult = min (rresult, rtemp)
+		}
+	    }
+
+	case F_BOOL:
+	    optype = TY_BOOL
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_VALB(ap))
+		    iresult = 1
+		else
+		    iresult = 0
+	    case TY_CHAR:
+		iresult = strlen (O_VALC(ap))
+	    case TY_INT:
+		iresult = O_VALI(ap)
+	    case TY_REAL:
+		if (abs(rval[1]) > .001)
+		    iresult = 1
+		else
+		    iresult = 0
+	    default:
+		goto badtype_
+	    }
+
+	case F_INT:
+	    optype = TY_INT
+	    if (type[1] == TY_INT)
+		iresult = ival[1]
+	    else
+		iresult = rval[1]
+		
+	case F_REAL:
+	    rresult = rval[1]
+
+	case F_STR:
+	    # Convert operand to operand of type string.
+
+	    optype = TY_CHAR
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call malloc (iresult, 3, TY_CHAR)
+		oplen = 3
+		if (O_VALB(ap))
+		    call strcpy ("yes", Memc[iresult], 3)
+		else
+		    call strcpy ("no",  Memc[iresult], 3)
+	    case TY_CHAR:
+		oplen = strlen (O_VALC(ap))
+		call malloc (iresult, oplen, TY_CHAR)
+		call strcpy (O_VALC(ap), Memc[iresult], ARB)
+	    case TY_INT:
+		oplen = MAX_DIGITS
+		call malloc (iresult, oplen, TY_CHAR)
+		call sprintf (Memc[iresult], SZ_FNAME, "%d")
+		    call pargi (O_VALI(ap))
+	    case TY_REAL:
+		oplen = MAX_DIGITS
+		call malloc (iresult, oplen, TY_CHAR)
+		call sprintf (Memc[iresult], SZ_FNAME, "%g")
+		    call pargr (O_VALR(ap))
+	    default:
+		goto badtype_
+	    }
+
+	default:
+	    call xev_error ("bad switch in callfcn")
+	}
+
+	# Write the result to the output operand.  Bool results are stored in
+	# iresult as an integer value, string results are stored in iresult as
+	# a pointer to the output string, and integer and real results are
+	# stored in iresult and rresult without any tricks.
+
+	call xev_initop (out, oplen, optype)
+
+	switch (optype) {
+	case TY_BOOL:
+	    O_VALB(out) = (iresult != 0)
+	case TY_CHAR:
+	    O_VALP(out) = iresult
+	case TY_INT:
+	    O_VALI(out) = iresult
+	case TY_REAL:
+	    O_VALR(out) = rresult
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xev_freeop (args[i])
+
+	call sfree (sp)
+	return
+
+badtype_
+	call xev_error1 ("bad argument to function `%s'", fcn)
+	call sfree (sp)
+	return
+end
+
+
+# XEV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xev_startarglist (arg, out)
+
+pointer	arg			# pointer to first argument, or NULL
+pointer	out			# output operand pointing to arg descriptor
+pointer	ap
+
+errchk	malloc
+
+begin
+	call xev_initop (out, 0, TY_POINTER)
+	call malloc (ap, LEN_ARGSTRUCT, TY_STRUCT)
+	O_VALP(out) = ap
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XEV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xev_addarg (arg, arglist, out)
+
+pointer	arg			# pointer to argument to be added
+pointer	arglist			# pointer to operand pointing to arglist
+pointer	out			# output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xev_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XEV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xev_error1 (fmt, arg)
+
+char	fmt[ARB]		# printf format string
+char	arg[ARB]		# string argument
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xev_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XEV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xev_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		# printf format string
+char	arg1[ARB]		# string argument
+int	arg2			# integer argument
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xev_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XEV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xev_error (errmsg)
+
+char	errmsg[ARB]			# error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XEV_INITOP -- Set up an unintialized operand structure.
+
+procedure xev_initop (o, o_len, o_type)
+
+pointer	o		# pointer to operand structure
+int	o_len		# length of operand (zero if scalar)
+int	o_type		# datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xev_makeop (o, o_len, o_type)
+end
+
+
+# XEV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xev_makeop (o, o_len, o_type)
+
+pointer	o		# pointer to operand structure
+int	o_len		# length of operand (zero if scalar)
+int	o_type		# datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 1) {
+	    call mfree (O_VALP(o), O_TYPE(o))
+	    O_LEN(o) = 0
+	}
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+end
+
+
+# XEV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xev_freeop (o)
+
+pointer	o		# pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 1) {
+	    call mfree (O_VALP(o), O_TYPE(o))
+	    O_LEN(o) = 0
+	}
+
+	# Clear the operand type to mark operand invalid.
+	O_TYPE(o) = 0
+end
+define	YYNPROD		33
+define	YYLAST		303
+# line	1 "/iraf/iraf/lib/yaccpar.x"
+# 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
+
+
+# XEV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall2, xev_error1, xev_unop, xev_binop, xev_boolop
+errchk	xev_quest, xev_callfcn, xev_addarg
+include	"evexpr.com"
+
+short	yyexca[96]
+data	(yyexca(i),i=  1,  8)	/  -1,   1,   0,  -1,  -2,   0,  -1,   4/
+data	(yyexca(i),i=  9, 16)	/  40,  27,  -2,   3,  -1,   5,  40,  26/
+data	(yyexca(i),i= 17, 24)	/  -2,   4,  -1,  61, 269,   0, 270,   0/
+data	(yyexca(i),i= 25, 32)	/ 271,   0, 279,   0,  -2,  16,  -1,  62/
+data	(yyexca(i),i= 33, 40)	/ 269,   0, 270,   0, 271,   0, 279,   0/
+data	(yyexca(i),i= 41, 48)	/  -2,  17,  -1,  63, 269,   0, 270,   0/
+data	(yyexca(i),i= 49, 56)	/ 271,   0, 279,   0,  -2,  18,  -1,  64/
+data	(yyexca(i),i= 57, 64)	/ 269,   0, 270,   0, 271,   0, 279,   0/
+data	(yyexca(i),i= 65, 72)	/  -2,  19,  -1,  65, 272,   0, 273,   0/
+data	(yyexca(i),i= 73, 80)	/ 274,   0,  -2,  20,  -1,  66, 272,   0/
+data	(yyexca(i),i= 81, 88)	/ 273,   0, 274,   0,  -2,  21,  -1,  67/
+data	(yyexca(i),i= 89, 96)	/ 272,   0, 273,   0, 274,   0,  -2,  22/
+short	yyact[303]
+data	(yyact(i),i=  1,  8)	/  12,  13,  14,  15,  16,  17,  27,  71/
+data	(yyact(i),i=  9, 16)	/  20,  21,  22,  24,  26,  25,  18,  19/
+data	(yyact(i),i= 17, 24)	/  51,  16,  23,  11,  12,  13,  14,  15/
+data	(yyact(i),i= 25, 32)	/  16,  17,  27,  28,  20,  21,  22,  24/
+data	(yyact(i),i= 33, 40)	/  26,  25,  18,  19,  31,  49,  23,  12/
+data	(yyact(i),i= 41, 48)	/  13,  14,  15,  16,  17,  27,  10,  20/
+data	(yyact(i),i= 49, 56)	/  21,  22,  24,  26,  25,  18,  19,  10/
+data	(yyact(i),i= 57, 64)	/   9,  23,  12,  13,  14,  15,  16,  17/
+data	(yyact(i),i= 65, 72)	/  10,   1,  20,  21,  22,  24,  26,  25/
+data	(yyact(i),i= 73, 80)	/  18,  14,  15,  16,  23,  12,  13,  14/
+data	(yyact(i),i= 81, 88)	/  15,  16,  17,   0,   0,  20,  21,  22/
+data	(yyact(i),i= 89, 96)	/  24,  26,  25,  69,   0,   0,  70,  23/
+data	(yyact(i),i= 97,104)	/  12,  13,  14,  15,  16,  17,   0,   0/
+data	(yyact(i),i=105,112)	/  20,  21,  22,  12,  13,  14,  15,  16/
+data	(yyact(i),i=113,120)	/  17,   2,  23,  12,  13,  14,  15,  16/
+data	(yyact(i),i=121,128)	/   0,  29,  30,   0,  32,   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,  50,   0,  52,  54,  55,  56,  57/
+data	(yyact(i),i=153,160)	/  58,  59,  60,  61,  62,  63,  64,  65/
+data	(yyact(i),i=161,168)	/  66,  67,  68,   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,  33,   0,   0,   0/
+data	(yyact(i),i=185,192)	/  72,   0,   0,  74,   0,   0,   0,   0/
+data	(yyact(i),i=193,200)	/   0,   0,  34,  35,  36,  37,  38,  39/
+data	(yyact(i),i=201,208)	/  40,  41,  42,  43,  44,  45,  46,  47/
+data	(yyact(i),i=209,216)	/  48,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=217,224)	/   0,   0,   0,   0,   0,   0,   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,  12,  13,  14,  15/
+data	(yyact(i),i=241,248)	/  16,  17,  27,   0,  20,  21,  22,  24/
+data	(yyact(i),i=249,256)	/  26,  25,  18,  19,  73,   0,  23,   0/
+data	(yyact(i),i=257,264)	/   0,   0,   0,   0,   0,   0,   0,   4/
+data	(yyact(i),i=265,272)	/   5,  53,   0,   0,   7,   0,   0,   3/
+data	(yyact(i),i=273,280)	/   4,   5,   0,   0,   0,   7,   0,   0/
+data	(yyact(i),i=281,288)	/   0,   4,   5,   8,   6,   0,   7,   0/
+data	(yyact(i),i=289,296)	/   0,   0,   0,   0,   8,   6,   0,   0/
+data	(yyact(i),i=297,303)	/   0,   0,   0,   0,   0,   8,   6/
+short	yypact[75]
+data	(yypact(i),i=  1,  8)	/  15,-1000,-241,-1000,-1000,-1000,-230,  24/
+data	(yypact(i),i=  9, 16)	/  24,  -4,  24,-1000,-1000,-1000,-1000,-1000/
+data	(yypact(i),i= 17, 24)	/-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000/
+data	(yypact(i),i= 25, 32)	/-1000,-1000,-1000,-1000,-1000,-1000,-1000,  24/
+data	(yypact(i),i= 33, 40)	/ -25,   6,   6,   6,   6,   6,   6,   6/
+data	(yypact(i),i= 41, 48)	/   6,   6,   6,   6,   6,   6,   6,   6/
+data	(yypact(i),i= 49, 56)	/   6,  50,-222,-1000,-190,-1000,-190,-248/
+data	(yypact(i),i= 57, 64)	/-248,-1000,-146,-184,-203,-154,-154,-154/
+data	(yypact(i),i= 65, 72)	/-154,-165,-165,-165,-261,-1000,  24,-1000/
+data	(yypact(i),i= 73, 75)	/-222,   6,-222/
+short	yypgo[6]
+data	(yypgo(i),i=  1,  6)	/   0,  65, 113, 180,  56,  37/
+short	yyr1[33]
+data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   2,   2,   2,   2,   2/
+data	(yyr1(i),i=  9, 16)	/   2,   2,   2,   2,   2,   2,   2,   2/
+data	(yyr1(i),i= 17, 24)	/   2,   2,   2,   2,   2,   2,   2,   2/
+data	(yyr1(i),i= 25, 32)	/   2,   2,   4,   4,   5,   5,   5,   3/
+data	(yyr1(i),i= 33, 33)	/   3/
+short	yyr2[33]
+data	(yyr2(i),i=  1,  8)	/   0,   2,   1,   1,   1,   2,   2,   2/
+data	(yyr2(i),i=  9, 16)	/   4,   4,   4,   4,   4,   4,   4,   4/
+data	(yyr2(i),i= 17, 24)	/   4,   4,   4,   4,   4,   4,   4,   7/
+data	(yyr2(i),i= 25, 32)	/   4,   3,   1,   1,   0,   1,   3,   0/
+data	(yyr2(i),i= 33, 33)	/   2/
+short	yychk[75]
+data	(yychk(i),i=  1,  8)	/-1000,  -1,  -2, 256, 257, 258, 278, 262/
+data	(yychk(i),i=  9, 16)	/ 277,  -4,  40, 260, 261, 262, 263, 264/
+data	(yychk(i),i= 17, 24)	/ 265, 266, 275, 276, 269, 270, 271, 279/
+data	(yychk(i),i= 25, 32)	/ 272, 274, 273, 267, 257,  -2,  -2,  40/
+data	(yychk(i),i= 33, 40)	/  -2,  -3,  -3,  -3,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 41, 48)	/  -3,  -3,  -3,  -3,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 49, 56)	/  -3,  -5,  -2,  41,  -2, 259,  -2,  -2/
+data	(yychk(i),i= 57, 64)	/  -2,  -2,  -2,  -2,  -2,  -2,  -2,  -2/
+data	(yychk(i),i= 65, 72)	/  -2,  -2,  -2,  -2,  -2,  41,  44, 268/
+data	(yychk(i),i= 73, 75)	/  -2,  -3,  -2/
+short	yydef[75]
+data	(yydef(i),i=  1,  8)	/   0,  -2,   0,   2,  -2,  -2,   0,   0/
+data	(yydef(i),i=  9, 16)	/   0,   0,   0,   1,  31,  31,  31,  31/
+data	(yydef(i),i= 17, 24)	/  31,  31,  31,  31,  31,  31,  31,  31/
+data	(yydef(i),i= 25, 32)	/  31,  31,  31,  31,   5,   6,   7,  28/
+data	(yydef(i),i= 33, 40)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 41, 48)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 49, 56)	/   0,   0,  29,  25,   8,  32,   9,  10/
+data	(yydef(i),i= 57, 64)	/  11,  12,  13,  14,  15,  -2,  -2,  -2/
+data	(yydef(i),i= 65, 72)	/  -2,  -2,  -2,  -2,   0,  24,   0,  31/
+data	(yydef(i),i= 73, 75)	/  30,   0,  23/
+
+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) {
+	    
+case 1:
+# line 135 "evexpr.y"
+{
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE (yypvt-YYOPLEN, ev_oval)
+			return (OK)
+		}
+case 2:
+# line 143 "evexpr.y"
+{
+			call error (1, "syntax error")
+		}
+case 3:
+# line 149 "evexpr.y"
+{
+			# Numeric constant.
+			YYMOVE (yypvt, yyval)
+		    }
+case 4:
+# line 153 "evexpr.y"
+{
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xev_initop (yyval, 0, TY_BOOL)
+			if (streq (O_VALC(yypvt), "yes"))
+			    O_VALB(yyval) = true
+			else if (streq (O_VALC(yypvt), "no"))
+			    O_VALB(yyval) = false
+			else if (ev_getop != NULL)
+			    call zcall2 (ev_getop, O_VALC(yypvt), yyval)
+			else
+			    call xev_error1 ("illegal operand `%s'", O_VALC(yypvt))
+			call xev_freeop (yypvt)
+		    }
+case 5:
+# line 168 "evexpr.y"
+{
+			# e.g., @"param"
+			if (ev_getop != NULL)
+			    call zcall2 (ev_getop, O_VALC(yypvt), yyval)
+			else
+			    call xev_error1 ("illegal operand `%s'", O_VALC(yypvt))
+			call xev_freeop (yypvt)
+		    }
+case 6:
+# line 176 "evexpr.y"
+{
+			# Unary arithmetic minus.
+			call xev_unop (MINUS, yypvt, yyval)
+		    }
+case 7:
+# line 180 "evexpr.y"
+{
+			# Boolean not.
+			call xev_unop (NOT, yypvt, yyval)
+		    }
+case 8:
+# line 184 "evexpr.y"
+{
+			# Addition.
+			call xev_binop (PLUS, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 9:
+# line 188 "evexpr.y"
+{
+			# Subtraction.
+			call xev_binop (MINUS, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 10:
+# line 192 "evexpr.y"
+{
+			# Multiplication.
+			call xev_binop (STAR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 11:
+# line 196 "evexpr.y"
+{
+			# Division.
+			call xev_binop (SLASH, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 12:
+# line 200 "evexpr.y"
+{
+			# Exponentiation.
+			call xev_binop (EXPON, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 13:
+# line 204 "evexpr.y"
+{
+			# String concatenation.
+			call xev_binop (CONCAT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 14:
+# line 208 "evexpr.y"
+{
+			# Boolean and.
+			call xev_boolop (AND, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 15:
+# line 212 "evexpr.y"
+{
+			# Boolean or.
+			call xev_boolop (OR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 16:
+# line 216 "evexpr.y"
+{
+			# Boolean less than.
+			call xev_boolop (LT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 17:
+# line 220 "evexpr.y"
+{
+			# Boolean greater than.
+			call xev_boolop (GT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 18:
+# line 224 "evexpr.y"
+{
+			# Boolean less than or equal.
+			call xev_boolop (LE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 19:
+# line 228 "evexpr.y"
+{
+			# Boolean greater than or equal.
+			call xev_boolop (GE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 20:
+# line 232 "evexpr.y"
+{
+			# Boolean equal.
+			call xev_boolop (EQ, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 21:
+# line 236 "evexpr.y"
+{
+			# String pattern-equal.
+			call xev_boolop (SE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 22:
+# line 240 "evexpr.y"
+{
+			# Boolean not equal.
+			call xev_boolop (NE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 23:
+# line 244 "evexpr.y"
+{
+			# Conditional expression.
+			call xev_quest (yypvt-6*YYOPLEN, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 24:
+# line 248 "evexpr.y"
+{
+			# Call an intrinsic or external function.
+			ap = O_VALP(yypvt-YYOPLEN)
+			call xev_callfcn (O_VALC(yypvt-3*YYOPLEN),
+			    A_ARGP(ap,1), A_NARGS(ap), yyval)
+			call mfree (ap, TY_STRUCT)
+			call xev_freeop (yypvt-3*YYOPLEN)
+		    }
+case 25:
+# line 256 "evexpr.y"
+{
+			YYMOVE (yypvt-YYOPLEN, yyval)
+		    }
+case 26:
+# line 262 "evexpr.y"
+{
+			YYMOVE (yypvt, yyval)
+		    }
+case 27:
+# line 265 "evexpr.y"
+{
+			if (O_TYPE(yypvt) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE (yypvt, yyval)
+		    }
+case 28:
+# line 273 "evexpr.y"
+{
+			# Empty.
+			call xev_startarglist (NULL, yyval)
+		    }
+case 29:
+# line 277 "evexpr.y"
+{
+			# First arg; start a nonnull list.
+			call xev_startarglist (yypvt, yyval)
+		    }
+case 30:
+# line 281 "evexpr.y"
+{
+			# Add an argument to an existing list.
+			call xev_addarg (yypvt, yypvt-2*YYOPLEN, yyval)
+		    }	}
+
+	goto yystack_				# stack new state and value
+end
diff --git a/sys/fmtio/evexpr.y b/sys/fmtio/evexpr.y
new file mode 100644
index 00000000..297950bc
--- /dev/null
+++ b/sys/fmtio/evexpr.y
@@ -0,0 +1,1087 @@
+%{
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<evexpr.h>
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	16		# max args in a function call
+define	yyparse		xev_parse
+
+define	DTOR		(($1)/57.2957795)
+define	RTOD		(($1)*57.2957795)
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|exp|int|log|log10|\
+			 |max|min|mod|nint|real|sin|sqrt|str|tan|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_EXP		08
+define	F_INT		09
+define	F_LOG		10
+define	F_LOG10		11
+	# newline	12
+define	F_MAX		13
+define	F_MIN		14
+define	F_MOD		15
+define	F_NINT		16
+define	F_REAL		17
+define	F_SIN		18
+define	F_SQRT		19
+define	F_STR		20
+define	F_TAN 		21
+
+
+# EVEXPR -- Evaluate an expression.  This is the top level procedure, and the
+# only externally callable entry point.  Input consists of the expression to
+# be evaluated (a string) and, optionally, user procedures for fetching
+# external operands and executing external functions.  Output is a pointer to
+# an operand structure containing the computed value of the expression.
+# The output operand structure is dynamically allocated by EVEXPR and must be
+# freed by the user.
+#
+# N.B.: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.
+
+pointer procedure evexpr (expr, getop_epa, ufcn_epa)
+
+char	expr[ARB]		# expression to be evaluated
+int	getop_epa		# user supplied get operand procedure
+int	ufcn_epa		# user supplied function call procedure
+
+int	junk
+bool	debug
+pointer	sp, ip
+extern	xev_gettok()
+int	strlen(), xev_parse()
+
+errchk	xev_parse, calloc
+include	"evexpr.com"
+data	debug /false/
+
+begin
+	call smark (sp)
+
+	# Set user function entry point addresses.
+	ev_getop = getop_epa
+	ev_ufcn  = ufcn_epa
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XEV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xev_parse (ip, debug, xev_gettok)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+%L
+# XEV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall2, xev_error1, xev_unop, xev_binop, xev_boolop
+errchk	xev_quest, xev_callfcn, xev_addarg
+include	"evexpr.com"
+
+%}
+
+%token		CONSTANT IDENTIFIER NEWLINE YYEOS
+%token		PLUS MINUS STAR SLASH EXPON CONCAT QUEST COLON
+%token		LT GT LE GT EQ NE SE AND OR NOT AT
+
+%nonassoc	QUEST
+%left		OR
+%left 		AND
+%nonassoc	EQ NE SE
+%nonassoc	LT GT LE GE
+%left		CONCAT
+%left		PLUS MINUS
+%left		STAR SLASH
+%left		EXPON
+%right		UMINUS NOT
+%right		AT
+
+%%
+
+stmt	:	expr YYEOS {
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE ($1, ev_oval)
+			return (OK)
+		}
+	|	error {
+			call error (1, "syntax error")
+		}
+	;
+
+
+expr	:	CONSTANT {
+			# Numeric constant.
+			YYMOVE ($1, $$)
+		    }
+	|	IDENTIFIER {
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xev_initop ($$, 0, TY_BOOL)
+			if (streq (O_VALC($1), "yes"))
+			    O_VALB($$) = true
+			else if (streq (O_VALC($1), "no"))
+			    O_VALB($$) = false
+			else if (ev_getop != NULL)
+			    call zcall2 (ev_getop, O_VALC($1), $$)
+			else
+			    call xev_error1 ("illegal operand `%s'", O_VALC($1))
+			call xev_freeop ($1)
+		    }
+	|	AT CONSTANT {
+			# e.g., @"param"
+			if (ev_getop != NULL)
+			    call zcall2 (ev_getop, O_VALC($2), $$)
+			else
+			    call xev_error1 ("illegal operand `%s'", O_VALC($2))
+			call xev_freeop ($2)
+		    }
+	|	MINUS expr %prec UMINUS {
+			# Unary arithmetic minus.
+			call xev_unop (MINUS, $2, $$)
+		    }
+	|	NOT expr {
+			# Boolean not.
+			call xev_unop (NOT, $2, $$)
+		    }
+	|	expr PLUS opnl expr {
+			# Addition.
+			call xev_binop (PLUS, $1, $4, $$)
+		    }
+	|	expr MINUS opnl expr {
+			# Subtraction.
+			call xev_binop (MINUS, $1, $4, $$)
+		    }
+	| 	expr STAR opnl expr {
+			# Multiplication.
+			call xev_binop (STAR, $1, $4, $$)
+		    }
+	|	expr SLASH opnl expr {
+			# Division.
+			call xev_binop (SLASH, $1, $4, $$)
+		    }
+	|	expr EXPON opnl expr {
+			# Exponentiation.
+			call xev_binop (EXPON, $1, $4, $$)
+		    }
+	|	expr CONCAT opnl expr {
+			# String concatenation.
+			call xev_binop (CONCAT, $1, $4, $$)
+		    }
+	|	expr AND opnl expr {
+			# Boolean and.
+			call xev_boolop (AND, $1, $4, $$)
+		    }
+	|	expr OR opnl expr {
+			# Boolean or.
+			call xev_boolop (OR, $1, $4, $$)
+		    }
+	|	expr LT opnl expr {
+			# Boolean less than.
+			call xev_boolop (LT, $1, $4, $$)
+		    }
+	|	expr GT opnl expr {
+			# Boolean greater than.
+			call xev_boolop (GT, $1, $4, $$)
+		    }
+	|	expr LE opnl expr {
+			# Boolean less than or equal.
+			call xev_boolop (LE, $1, $4, $$)
+		    }
+	|	expr GE opnl expr {
+			# Boolean greater than or equal.
+			call xev_boolop (GE, $1, $4, $$)
+		    }
+	|	expr EQ opnl expr {
+			# Boolean equal.
+			call xev_boolop (EQ, $1, $4, $$)
+		    }
+	|	expr SE opnl expr {
+			# String pattern-equal.
+			call xev_boolop (SE, $1, $4, $$)
+		    }
+	|	expr NE opnl expr {
+			# Boolean not equal.
+			call xev_boolop (NE, $1, $4, $$)
+		    }
+	|	expr QUEST opnl expr COLON opnl expr {
+			# Conditional expression.
+			call xev_quest ($1, $4, $7, $$)
+		    }
+	|	funct '(' arglist ')' {
+			# Call an intrinsic or external function.
+			ap = O_VALP($3)
+			call xev_callfcn (O_VALC($1),
+			    A_ARGP(ap,1), A_NARGS(ap), $$)
+			call mfree (ap, TY_STRUCT)
+			call xev_freeop ($1)
+		    }
+	|	'(' expr ')' {
+			YYMOVE ($2, $$)
+		    }
+	;
+
+
+funct	:	IDENTIFIER {
+			YYMOVE ($1, $$)
+		    }
+	|	CONSTANT {
+			if (O_TYPE($1) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE ($1, $$)
+		    }
+	;
+
+
+arglist	:	{
+			# Empty.
+			call xev_startarglist (NULL, $$)
+		    }
+	|	expr {
+			# First arg; start a nonnull list.
+			call xev_startarglist ($1, $$)
+		    }
+	|	arglist ',' expr {
+			# Add an argument to an existing list.
+			call xev_addarg ($3, $1, $$)
+		    }
+	;
+
+
+opnl	:	# Empty.
+	|	opnl NEWLINE
+	;
+
+%%
+
+
+# XEV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xev_unop (opcode, in, out)
+
+int	opcode			# operation to be performed
+pointer	in			# input operand
+pointer	out			# output operand
+
+errchk	xev_error
+define	badsw_ 91
+
+begin
+	call xev_initop (out, 0, O_TYPE(in))
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xev_error ("negation of a nonarithmetic operand")
+	    case TY_INT:
+		O_VALI(out) = -O_VALI(in)
+	    case TY_REAL:
+		O_VALR(out) = -O_VALR(in)
+	    default:
+		goto badsw_
+	    }
+
+	case NOT:
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		O_VALB(out) = !O_VALB(in)
+	    case TY_CHAR, TY_INT, TY_REAL:
+		call xev_error ("not of a nonlogical")
+	    default:
+		goto badsw_
+	    }
+
+	default:
+badsw_	    call xev_error ("bad switch in unop")
+	}
+end
+
+
+# XEV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xev_binop (opcode, in1, in2, out)
+
+int	opcode			# operation to be performed
+pointer	in1, in2		# input operands
+pointer	out			# output operand
+
+real	r1, r2
+int	i1, i2, dtype, nchars
+int	xev_newtype(), strlen()
+errchk	xev_newtype
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xev_newtype (O_TYPE(in1), O_TYPE(in2))
+	call xev_initop (out, 0, dtype)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xev_error ("operation illegal for boolean operands")
+	case TY_CHAR:
+	    if (opcode != CONCAT)
+		call xev_error ("operation illegal for string operands")
+	case TY_INT:
+	    i1 = O_VALI(in1)
+	    i2 = O_VALI(in2)
+	case TY_REAL:
+	    if (O_TYPE(in1) == TY_INT)
+		r1 = O_VALI(in1)
+	    else
+		r1 = O_VALR(in1)
+	    if (O_TYPE(in2) == TY_INT)
+		r2 = O_VALI(in2)
+	    else
+		r2 = O_VALR(in2)
+	default:
+	    call xev_error ("unknown datatype code in binop")
+	}
+
+	# Perform the operation.
+	switch (opcode) {
+	case PLUS:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 + i2
+	    else
+		O_VALR(out) = r1 + r2
+
+	case MINUS:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 - i2
+	    else
+		O_VALR(out) = r1 - r2
+
+	case STAR:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 * i2
+	    else
+		O_VALR(out) = r1 * r2
+
+	case SLASH:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 / i2
+	    else
+		O_VALR(out) = r1 / r2
+
+	case EXPON:
+	    if (dtype == TY_INT)
+		O_VALI(out) = i1 ** i2
+	    else if (O_TYPE(in1) == TY_REAL && O_TYPE(in2) == TY_INT)
+		O_VALR(out) = r1 ** (O_VALI(in2))
+	    else
+		O_VALR(out) = r1 ** r2
+
+	case CONCAT:
+	    if (dtype != TY_CHAR)
+		call xev_error ("concatenation of a nonstring operand")
+	    nchars = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	    call xev_makeop (out, nchars, TY_CHAR)
+	    call strcpy (O_VALC(in1), O_VALC(out), ARB)
+	    call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    call xev_freeop (in1)
+	    call xev_freeop (in2)
+
+	default:
+	    call xev_error ("bad switch in binop")
+	}
+end
+
+
+# XEV_BOOLOP -- Boolean binary operations.  Perform the indicated boolean binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xev_boolop (opcode, in1, in2, out)
+
+int	opcode			# operation to be performed
+pointer	in1, in2		# input operands
+pointer	out			# output operand
+
+bool	result
+real	r1, r2
+int	i1, i2, dtype
+int	xev_newtype(), xev_patmatch(), strncmp()
+errchk	xev_newtype, xev_error
+define	badsw_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xev_newtype (O_TYPE(in1), O_TYPE(in2))
+	call xev_initop (out, 0, dtype)
+
+	switch (opcode) {
+	case AND, OR:
+	    if (dtype != TY_BOOL)
+		call xev_error ("AND or OR of nonlogical")
+	case LT, GT, LE, GE:
+	    if (dtype == TY_BOOL)
+		call xev_error ("order comparison of a boolean operand")
+	}
+
+	if (dtype == TY_INT) {
+	    i1 = O_VALI(in1)
+	    i2 = O_VALI(in2)
+	} else if (dtype == TY_REAL) {
+	    if (O_TYPE(in1) == TY_INT) {
+		i1 = O_VALI(in1)
+		r1 = i1
+	    } else
+		r1 = O_VALR(in1)
+	    if (O_TYPE(in2) == TY_INT) {
+		i2 = O_VALI(in2)
+		r2 = i2
+	    } else
+		r2 = O_VALR(in2)
+	}
+
+	# Perform the operation.
+	switch (opcode) {
+	case AND:
+	    result = O_VALB(in1) && O_VALB(in2)
+	case OR:
+	    result = O_VALB(in1) || O_VALB(in2)
+
+	case LT, GE:
+	    if (dtype == TY_INT)
+		result = i1 < i2
+	    else if (dtype == TY_REAL)
+		result = r1 < r2
+	    else
+		result = strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0
+	    if (opcode == GE)
+		result = !result
+
+	case GT, LE:
+	    if (dtype == TY_INT)
+		result = i1 > i2
+	    else if (dtype == TY_REAL)
+		result = r1 > r2
+	    else
+		result = strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0
+	    if (opcode == LE)
+		result = !result
+
+	case EQ, SE, NE:
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (O_VALB(in1))
+		    result =  O_VALB(in2)
+		else
+		    result = !O_VALB(in2)
+	    case TY_CHAR:
+		if (opcode == SE)
+		    result = xev_patmatch (O_VALC(in1), O_VALC(in2)) > 0
+		else
+		    result = strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0
+	    case TY_INT:
+		result = i1 == i2
+	    case TY_REAL:
+		result = r1 == r2
+	    default:
+		goto badsw_
+	    }
+	    if (opcode == NE)
+		result = !result
+
+	default:
+badsw_	    call xev_error ("bad switch in boolop")
+	}
+
+	call xev_makeop (out, 0, TY_BOOL)
+	O_VALB(out) = result
+
+	# Free storage if there were any string type input operands.
+	call xev_freeop (in1)
+	call xev_freeop (in2)
+end
+
+
+# XEV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xev_patmatch (str, pat)
+
+char	str[ARB]		# operand string
+char	pat[ARB]		# pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XEV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xev_newtype (type1, type2)
+
+int	type1, type2
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/TY_BOOL, TY_CHAR,  TY_INT,  TY_REAL/
+data	(ttbl(i),i=1,4)		/TY_BOOL,       0,       0,        0/
+data	(ttbl(i),i=5,8)		/      0, TY_CHAR,       0,        0/
+data	(ttbl(i),i=9,12)	/      0,       0,  TY_INT,  TY_REAL/
+data	(ttbl(i),i=13,16)	/      0,       0, TY_REAL,  TY_REAL/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xev_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XEV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xev_quest (cond, trueop, falseop, out)
+
+pointer	cond			# pointer to condition operand
+pointer	trueop, falseop		# pointer to true,false operands
+pointer	out			# pointer to output operand
+errchk	xev_error
+
+begin
+	if (O_TYPE(cond) != TY_BOOL)
+	    call xev_error ("nonboolean condition operand")
+
+	if (O_VALB(cond)) {
+	    YYMOVE (trueop, out)
+	    call xev_freeop (falseop)
+	} else {
+	    YYMOVE (falseop, out)
+	    call xev_freeop (trueop)
+	}
+end
+
+
+# XEV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xev_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		# function to be called
+pointer	args[ARB]		# pointer to arglist descriptor
+int	nargs			# number of arguments
+pointer	out			# output operand (function value)
+
+real	rresult, rval[2], rtemp
+int	iresult, ival[2], type[2], optype, oplen, itemp
+int	opcode, v_nargs, i
+pointer	sp, buf, ap
+include	"evexpr.com"
+
+bool	strne()
+int	strdic(), strlen()
+errchk	zcall4, xev_error1, xev_error2, malloc
+string	keywords KEYWORDS
+define	badtype_ 91
+define	free_ 92
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	oplen = 0
+
+	# Lookup the function name in the dictionary.  An exact match is
+	# required (strdic permits abbreviations).
+
+	opcode = strdic (fcn, Memc[buf], SZ_FNAME, keywords)
+	if (opcode > 0 && strne(fcn,Memc[buf]))
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall4 (ev_ufcn, fcn, args, nargs, out)
+		goto free_
+	    } else
+		call xev_error1 ("unknown function `%s' called", fcn)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xev_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xev_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Verify datatypes.
+	if (opcode != F_STR && opcode != F_BOOL) {
+	    optype = TY_REAL
+	    do i = 1, min(2,nargs) {
+		switch (O_TYPE(args[i])) {
+		case TY_INT:
+		    ival[i] = O_VALI(args[i])
+		    rval[i] = ival[i]
+		    type[i] = TY_INT
+		case TY_REAL:
+		    rval[i] = O_VALR(args[i])
+		    ival[i] = nint (rval[i])
+		    type[i] = TY_REAL
+		default:
+		    goto badtype_
+		}
+	    }
+	}
+
+	# Evaluate the function.
+
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    if (type[1] == TY_INT) {
+		iresult = abs (ival[1])
+		optype = TY_INT
+	    } else
+		rresult = abs (rval[1])
+
+	case F_ACOS:
+	    rresult = RTOD (acos (rval[1]))
+	case F_ASIN:
+	    rresult = RTOD (asin (rval[1]))
+	case F_COS:
+	    rresult =   cos (DTOR (rval[1]))
+	case F_EXP:
+	    rresult =   exp (rval[1])
+	case F_LOG:
+	    rresult =   log (rval[1])
+	case F_LOG10:
+	    rresult = log10 (rval[1])
+	case F_SIN:
+	    rresult =   sin (DTOR (rval[1]))
+	case F_SQRT:
+	    rresult =  sqrt (rval[1])
+	case F_TAN:
+	    rresult =   tan (DTOR (rval[1]))
+
+	case F_ATAN, F_ATAN2:
+	    if (nargs == 1)
+		rresult = RTOD (atan (rval[1]))
+	    else
+		rresult = RTOD (atan2 (rval[1], rval[2]))
+
+	case F_MOD:
+	    if (type[1] == TY_REAL || type[2] == TY_REAL)
+		rresult = mod (rval[1], rval[2])
+	    else {
+		iresult = mod (ival[1], ival[2])
+		optype = TY_INT
+	    }
+		
+	case F_NINT:
+	    iresult = nint (rval[1])
+	    optype = TY_INT
+
+	case F_MAX, F_MIN:
+	    # Determine datatype of result.
+	    optype = TY_INT
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) == TY_REAL)
+		    optype = TY_REAL
+		else if (O_TYPE(args[i]) != TY_INT)
+		    goto badtype_
+
+	    # Compute result.
+	    if (optype == TY_INT) {
+		iresult = O_VALI(ap)
+		do i = 2, nargs {
+		    itemp = O_VALI(args[i])
+		    if (opcode == F_MAX)
+			iresult = max (iresult, itemp)
+		    else
+			iresult = min (iresult, itemp)
+		}
+
+	    } else {
+		if (O_TYPE(ap) == TY_INT)
+		    rresult = O_VALI(ap)
+		else
+		    rresult = O_VALR(ap)
+
+		do i = 2, nargs {
+		    if (O_TYPE(args[i]) == TY_INT)
+			rtemp = O_VALI(args[i])
+		    else
+			rtemp = O_VALR(args[i])
+		    if (opcode == F_MAX)
+			rresult = max (rresult, rtemp)
+		    else
+			rresult = min (rresult, rtemp)
+		}
+	    }
+
+	case F_BOOL:
+	    optype = TY_BOOL
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_VALB(ap))
+		    iresult = 1
+		else
+		    iresult = 0
+	    case TY_CHAR:
+		iresult = strlen (O_VALC(ap))
+	    case TY_INT:
+		iresult = O_VALI(ap)
+	    case TY_REAL:
+		if (abs(rval[1]) > .001)
+		    iresult = 1
+		else
+		    iresult = 0
+	    default:
+		goto badtype_
+	    }
+
+	case F_INT:
+	    optype = TY_INT
+	    if (type[1] == TY_INT)
+		iresult = ival[1]
+	    else
+		iresult = rval[1]
+		
+	case F_REAL:
+	    rresult = rval[1]
+
+	case F_STR:
+	    # Convert operand to operand of type string.
+
+	    optype = TY_CHAR
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call malloc (iresult, 3, TY_CHAR)
+		oplen = 3
+		if (O_VALB(ap))
+		    call strcpy ("yes", Memc[iresult], 3)
+		else
+		    call strcpy ("no",  Memc[iresult], 3)
+	    case TY_CHAR:
+		oplen = strlen (O_VALC(ap))
+		call malloc (iresult, oplen, TY_CHAR)
+		call strcpy (O_VALC(ap), Memc[iresult], ARB)
+	    case TY_INT:
+		oplen = MAX_DIGITS
+		call malloc (iresult, oplen, TY_CHAR)
+		call sprintf (Memc[iresult], SZ_FNAME, "%d")
+		    call pargi (O_VALI(ap))
+	    case TY_REAL:
+		oplen = MAX_DIGITS
+		call malloc (iresult, oplen, TY_CHAR)
+		call sprintf (Memc[iresult], SZ_FNAME, "%g")
+		    call pargr (O_VALR(ap))
+	    default:
+		goto badtype_
+	    }
+
+	default:
+	    call xev_error ("bad switch in callfcn")
+	}
+
+	# Write the result to the output operand.  Bool results are stored in
+	# iresult as an integer value, string results are stored in iresult as
+	# a pointer to the output string, and integer and real results are
+	# stored in iresult and rresult without any tricks.
+
+	call xev_initop (out, oplen, optype)
+
+	switch (optype) {
+	case TY_BOOL:
+	    O_VALB(out) = (iresult != 0)
+	case TY_CHAR:
+	    O_VALP(out) = iresult
+	case TY_INT:
+	    O_VALI(out) = iresult
+	case TY_REAL:
+	    O_VALR(out) = rresult
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xev_freeop (args[i])
+
+	call sfree (sp)
+	return
+
+badtype_
+	call xev_error1 ("bad argument to function `%s'", fcn)
+	call sfree (sp)
+	return
+end
+
+
+# XEV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xev_startarglist (arg, out)
+
+pointer	arg			# pointer to first argument, or NULL
+pointer	out			# output operand pointing to arg descriptor
+pointer	ap
+
+errchk	malloc
+
+begin
+	call xev_initop (out, 0, TY_POINTER)
+	call malloc (ap, LEN_ARGSTRUCT, TY_STRUCT)
+	O_VALP(out) = ap
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XEV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xev_addarg (arg, arglist, out)
+
+pointer	arg			# pointer to argument to be added
+pointer	arglist			# pointer to operand pointing to arglist
+pointer	out			# output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xev_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XEV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xev_error1 (fmt, arg)
+
+char	fmt[ARB]		# printf format string
+char	arg[ARB]		# string argument
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xev_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XEV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xev_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		# printf format string
+char	arg1[ARB]		# string argument
+int	arg2			# integer argument
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xev_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XEV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xev_error (errmsg)
+
+char	errmsg[ARB]			# error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XEV_INITOP -- Set up an unintialized operand structure.
+
+procedure xev_initop (o, o_len, o_type)
+
+pointer	o		# pointer to operand structure
+int	o_len		# length of operand (zero if scalar)
+int	o_type		# datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xev_makeop (o, o_len, o_type)
+end
+
+
+# XEV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xev_makeop (o, o_len, o_type)
+
+pointer	o		# pointer to operand structure
+int	o_len		# length of operand (zero if scalar)
+int	o_type		# datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 1) {
+	    call mfree (O_VALP(o), O_TYPE(o))
+	    O_LEN(o) = 0
+	}
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+end
+
+
+# XEV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xev_freeop (o)
+
+pointer	o		# pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 1) {
+	    call mfree (O_VALP(o), O_TYPE(o))
+	    O_LEN(o) = 0
+	}
+
+	# Clear the operand type to mark operand invalid.
+	O_TYPE(o) = 0
+end
diff --git a/sys/fmtio/evvexpr.com b/sys/fmtio/evvexpr.com
new file mode 100644
index 00000000..34a98be6
--- /dev/null
+++ b/sys/fmtio/evvexpr.com
@@ -0,0 +1,12 @@
+# EVVEXPR common.
+
+pointer	ev_oval				# pointer to expr value operand
+int	ev_st				# symbol table
+int	ev_getop			# user supplied get operand procedure
+int	ev_getop_data			# client data for above
+int	ev_ufcn				# user supplied function call procedure
+int	ev_ufcn_data			# client data for above
+int	ev_flags			# flag bits
+
+common	/xvvcom/ ev_oval, ev_st, ev_getop, ev_getop_data, ev_ufcn,
+	ev_ufcn_data, ev_flags
diff --git a/sys/fmtio/evvexpr.gy b/sys/fmtio/evvexpr.gy
new file mode 100644
index 00000000..32a91153
--- /dev/null
+++ b/sys/fmtio/evvexpr.gy
@@ -0,0 +1,2680 @@
+%{
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math.h>
+include	<evvexpr.h>
+
+.help evvexpr
+.nf --------------------------------------------------------------------------
+EVVEXPR.GY -- Generic XYacc source for a general vector expression evaluator.
+
+	    o = evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+		evvfree (o)
+
+Client callbacks:
+
+	          getop (client_data, opname, out)
+	           ufcn (client_data, fcn, args, nargs, out)
+
+here "out" is the output operand returned to EVVEXPR.  Client_data is any
+arbitrary integer or pointer value passed in to EVVEXPR when by the client
+when the callback was registered.  "args" is an array of operand structs,
+the arguments for the user function being called.  If the operand or
+function call cannot be completed normally an error exit may be made (call
+error) or an invalid operand may be returned (O_TYPE set to 0).  The client
+should not free the "args" input operands, this will be handled by EVVEXPR.
+
+Operand struct (lib$evvexpr.h):
+
+	struct operand {
+		int	O_TYPE			# operand type (bcsilrd)
+		int	O_LEN			# operand length (0=scalar)
+		int	O_FLAGS			# O_FREEVAL, O_FREEOP
+		union {
+			char*	O_VALC		# string
+			short	O_VALS
+			int	O_VALI		# int or bool
+			long	O_VALL
+			real	O_VALR
+			double	O_VALD
+			pointer	O_VALP		# vector data
+		}
+	}
+
+The macro O_VALC references the string value of a TY_CHAR operand.  The
+flags are O_FREEVAL and O_FREEOP, which tell EVVEXPR and EVVFREE whether or
+not to free any vector operand array or the operand struct when the operand
+is freed.  The client should set these flags on operands returned to EVVEXPR
+if it wants EVVEXPR to free any operand storage.
+
+Supported types are bool, char (string), and SILRD.  Bool is indicated as
+TY_BOOL in the O_TYPE field of the operand struct, but is stored internally
+as an integer and the value field of a boolean operand is given by O_VALI.
+
+Operands may be either scalars or vectors.  A vector is indicated by a O_LEN
+value greater than zero.  For vector operands O_VALP points to the data array.
+A special case is TY_CHAR (string), in which case O_LEN is the allocated
+length of the EOS-terminated string.  A string is logically a scalar value
+even though it is physically stored in the operand as a character vector.
+
+The trig functions operate upon angles in units of radians.  The intrinsic
+functions RAD and DEG are available for converting between radians and
+degrees.  A string can be coerced to a binary value and vice versa, using
+the INT, STR, etc. intrinsic functions.
+
+This is a generalization of the older EVEXPR routine, adding additional
+datatypes, support for vector operands, and numerous minor enhancements.
+.endhelp ---------------------------------------------------------------------
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	17		# max args in a function call
+define	yyparse		xvv_parse
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	LEN_STAB	300		# for symbol table
+define	LEN_SBUF	256
+define	LEN_INDEX	97
+
+define	LEN_SYM		1		# symbol data
+define	SYM_CODE	Memi[$1]
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|cosh|deg|double|\
+			 |exp|hiv|int|len|log|log10|long|lov|max|mean|median|\
+			 |min|mod|nint|rad|real|repl|stddev|shift|short|sin|\
+			 |sinh|sort|sqrt|str|sum|tan|tanh|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_COSH		08
+define	F_DEG		09		# radians to degrees
+define	F_DOUBLE	10
+	# newline	11
+define	F_EXP		12
+define	F_HIV		13		# high value
+define	F_INT		14
+define	F_LEN		15		# vector length
+define	F_LOG		16
+define	F_LOG10		17
+define	F_LONG		18
+define	F_LOV		19		# low value
+define	F_MAX		20
+define	F_MEAN		21
+define	F_MEDIAN	22
+	# newline	23
+define	F_MIN		24
+define	F_MOD		25
+define	F_NINT		26
+define	F_RAD		27		# degrees to radians
+define	F_REAL		28
+define	F_REPL		29		# replicate
+define	F_STDDEV	30		# standard deviation
+define	F_SHIFT		31
+define	F_SHORT		32
+define	F_SIN		33
+	# newline	34
+define	F_SINH		35
+define	F_SORT		36		# sort
+define	F_SQRT		37		# square root
+define	F_STR		38
+define	F_SUM		39
+define	F_TAN 		40
+define	F_TANH 		41
+
+define	T_B		TY_BOOL
+define	T_C		TY_CHAR
+define	T_S		TY_SHORT
+define	T_I		TY_INT
+define	T_L		TY_LONG
+define	T_R		TY_REAL
+define	T_D		TY_DOUBLE
+
+
+# EVVEXPR -- Evaluate a general mixed type vector expression.  Input consists
+# of the expression to be evaluated (a string) and, optionally, user
+# procedures for fetching external operands and executing external functions.
+# Output is a pointer to an operand structure containing the computed value of
+# the expression.  The output operand structure is dynamically allocated by
+# EVVEXPR and must be freed by the user.
+# 
+# NOTE: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.  The main
+# inefficiency is that, since compilation and execution are not broken out as
+# separate steps, when the routine is repeatedly called to evaluate the same
+# expression with different data, all the compile time computation (parsing
+# etc.) has to be repeated.
+
+pointer procedure evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+
+char	expr[ARB]		#I expression to be evaluated
+int	getop			#I user supplied get operand procedure
+int	getop_data		#I client data for above function
+int	ufcn			#I user supplied function call procedure
+int	ufcn_data		#I client data for above function
+int	flags			#I flag bits
+
+int	junk
+pointer	sp, ip
+bool	debug, first_time
+int	strlen(), xvv_parse()
+pointer	xvv_loadsymbols()
+extern	xvv_gettok()
+
+errchk	xvv_parse, calloc
+include	"evvexpr.com"
+data	debug /false/
+data	first_time /true/
+
+begin
+	call smark (sp)
+
+	if (first_time) {
+	    # This creates data which remains for the life of the process.
+	    ev_st = xvv_loadsymbols (KEYWORDS)
+	    first_time = false
+	}
+
+	# Set user function entry point addresses.
+	ev_getop = getop
+	ev_getop_data = getop_data
+	ev_ufcn = ufcn
+	ev_ufcn_data = ufcn_data
+	ev_flags = flags
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XVV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xvv_parse (ip, debug, xvv_gettok)
+	O_FLAGS(ev_oval) = or (O_FLAGS(ev_oval), O_FREEOP)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+
+# EVVFREE -- Free an operand struct such as is returned by EVVEXPR.
+
+procedure evvfree (o)
+
+pointer	o			# operand struct
+
+begin
+	call xvv_freeop (o)
+end
+
+%L
+# XVV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall3, xvv_error1, xvv_unop, xvv_binop, xvv_boolop
+errchk	xvv_quest, xvv_callfcn, xvv_addarg
+include	"evvexpr.com"
+
+%}
+
+# The $/ following causes the generic preprocessor to pass this block of code
+# through unchanged.
+
+$/
+
+%token		CONSTANT IDENTIFIER NEWLINE YYEOS
+%token		PLUS MINUS STAR SLASH EXPON CONCAT QUEST COLON
+%token		LT GT LE GT EQ NE SE LAND LOR LNOT BAND BOR BXOR BNOT AT
+
+%nonassoc	QUEST
+%left		LAND LOR
+%left		BAND BOR BXOR
+%nonassoc	EQ NE SE
+%nonassoc	LT GT LE GE
+%left		CONCAT
+%left		PLUS MINUS
+%left		STAR SLASH
+%right		UMINUS LNOT BNOT
+%left		EXPON
+%right		AT
+
+%%
+
+stmt	:	exprlist YYEOS {
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE ($1, ev_oval)
+			call sfree (yysp)
+			return (OK)
+		}
+	|	error {
+			call error (1, "syntax error")
+		}
+	;
+
+exprlist:	expr {
+			YYMOVE ($1, $$)
+		}
+	|	exprlist ',' opnl expr {
+			YYMOVE ($4, $$)
+			call xvv_freeop ($1)
+		}
+
+
+expr	:	CONSTANT {
+			# Numeric constant.
+			YYMOVE ($1, $$)
+		    }
+	|	IDENTIFIER {
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xvv_initop ($$, 0, TY_BOOL)
+			if (streq (O_VALC($1), "yes")) {
+			    O_VALI($$) = YES
+			} else if (streq (O_VALC($1), "no")) {
+			    O_VALI($$) = NO
+			} else if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($1), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($1))
+			call xvv_freeop ($1)
+		    }
+	|	AT CONSTANT {
+			# e.g., @"param"
+			if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($2), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($2))
+			call xvv_freeop ($2)
+		    }
+	|	MINUS expr %prec UMINUS {
+			# Unary arithmetic minus.
+			call xvv_unop (MINUS, $2, $$)
+		    }
+	|	LNOT expr {
+			# Logical not.
+			call xvv_unop (LNOT, $2, $$)
+		    }
+	|	BNOT expr {
+			# Boolean not.
+			call xvv_unop (BNOT, $2, $$)
+		    }
+	|	expr PLUS opnl expr {
+			# Addition.
+			call xvv_binop (PLUS, $1, $4, $$)
+		    }
+	|	expr MINUS opnl expr {
+			# Subtraction.
+			call xvv_binop (MINUS, $1, $4, $$)
+		    }
+	| 	expr STAR opnl expr {
+			# Multiplication.
+			call xvv_binop (STAR, $1, $4, $$)
+		    }
+	|	expr SLASH opnl expr {
+			# Division.
+			call xvv_binop (SLASH, $1, $4, $$)
+		    }
+	|	expr EXPON opnl expr {
+			# Exponentiation.
+			call xvv_binop (EXPON, $1, $4, $$)
+		    }
+	|	expr CONCAT opnl expr {
+			# Concatenate two operands.
+			call xvv_binop (CONCAT, $1, $4, $$)
+		    }
+	|	expr LAND opnl expr {
+			# Logical and.
+			call xvv_boolop (LAND, $1, $4, $$)
+		    }
+	|	expr LOR opnl expr {
+			# Logical or.
+			call xvv_boolop (LOR, $1, $4, $$)
+		    }
+	|	expr BAND opnl expr {
+			# Boolean and.
+			call xvv_binop (BAND, $1, $4, $$)
+		    }
+	|	expr BOR opnl expr {
+			# Boolean or.
+			call xvv_binop (BOR, $1, $4, $$)
+		    }
+	|	expr BXOR opnl expr {
+			# Boolean xor.
+			call xvv_binop (BXOR, $1, $4, $$)
+		    }
+	|	expr LT opnl expr {
+			# Boolean less than.
+			call xvv_boolop (LT, $1, $4, $$)
+		    }
+	|	expr GT opnl expr {
+			# Boolean greater than.
+			call xvv_boolop (GT, $1, $4, $$)
+		    }
+	|	expr LE opnl expr {
+			# Boolean less than or equal.
+			call xvv_boolop (LE, $1, $4, $$)
+		    }
+	|	expr GE opnl expr {
+			# Boolean greater than or equal.
+			call xvv_boolop (GE, $1, $4, $$)
+		    }
+	|	expr EQ opnl expr {
+			# Boolean equal.
+			call xvv_boolop (EQ, $1, $4, $$)
+		    }
+	|	expr SE opnl expr {
+			# String pattern-equal.
+			call xvv_boolop (SE, $1, $4, $$)
+		    }
+	|	expr NE opnl expr {
+			# Boolean not equal.
+			call xvv_boolop (NE, $1, $4, $$)
+		    }
+	|	expr QUEST opnl expr COLON opnl expr {
+			# Conditional expression.
+			call xvv_quest ($1, $4, $7, $$)
+		    }
+	|	funct '(' arglist ')' {
+			# Call an intrinsic or external function.
+			ap = O_VALP($3)
+			call xvv_callfcn (O_VALC($1),
+			    A_ARGP(ap,1), A_NARGS(ap), $$)
+			call xvv_freeop ($1)
+			call xvv_freeop ($3)
+		    }
+	|	'(' expr ')' {
+			YYMOVE ($2, $$)
+		    }
+	;
+
+
+funct	:	IDENTIFIER {
+			YYMOVE ($1, $$)
+		    }
+	|	CONSTANT {
+			if (O_TYPE($1) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE ($1, $$)
+		    }
+	;
+
+
+arglist	:	{
+			# Empty.
+			call xvv_startarglist (NULL, $$)
+		    }
+	|	expr {
+			# First arg; start a nonnull list.
+			call xvv_startarglist ($1, $$)
+		    }
+	|	arglist ',' opnl expr {
+			# Add an argument to an existing list.
+			call xvv_addarg ($4, $1, $$)
+		    }
+	;
+
+
+opnl	:	# Empty.
+	|	opnl NEWLINE
+	;
+
+%%
+
+# End generic preprocessor escape.
+/
+
+
+# XVV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xvv_unop (opcode, in, out)
+
+int	opcode			#I operation to be performed
+pointer	in			#I input operand
+pointer	out			#I output operand
+
+short	val_s
+long	val_l
+int	val_i, nelem
+errchk	xvv_error, xvv_initop
+string	s_badswitch "unop: bad switch"
+
+begin
+	nelem = O_LEN(in)
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xvv_error ("negation of a nonarithmetic operand")
+$for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call aneg$t (Mem$t[O_VALP(in)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = -O_VAL$T(in)
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case LNOT:
+	    # Logical NOT.
+
+	    call xvv_initop (out, nelem, TY_BOOL)
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		if (nelem > 0)
+		    call abeqki (Memi[O_VALP(in)], NO, Memi[O_VALP(out)], nelem)
+		else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+$for (sil)
+	    case TY_PIXEL:
+		if (nelem > 0) {
+		    val_$t = NO
+		    call abeqk$t (Mem$t[O_VALP(in)], val_$t, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VAL$T(in) == NO)
+			O_VAL$T(out) = YES
+		    else
+			O_VAL$T(out) = NO
+		}
+$endfor
+	    case TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("not of a nonlogical")
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case BNOT:
+	    # Bitwise boolean NOT.
+
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("boolean not of a noninteger operand")
+$for (sil)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call anot$t (Mem$t[O_VALP(in)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = not(O_VAL$T(in))
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+
+	call xvv_freeop (in)
+end
+
+
+# XVV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xvv_binop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+$for (silrd)
+PIXEL	v_$t
+PIXEL	xvv_null$t()
+extern	xvv_null$t()
+$endfor
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+include	"evvexpr.com"
+
+int	xvv_newtype(), strlen()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badswitch "binop: bad case in switch"
+string	s_boolop "binop: bitwise boolean operands must be an integer type"
+define	done_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xvv_error ("binop: operation illegal for boolean operands")
+	case TY_CHAR:
+	    nelem = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	default:
+	    if (opcode == CONCAT)
+		nelem = max (1, O_LEN(in1)) + max (1, O_LEN(in2))
+	    else {
+		if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		    nelem = min (O_LEN(in1), O_LEN(in2))
+		else if (O_LEN(in1) > 0)
+		    nelem = O_LEN(in1)
+		else if (O_LEN(in2) > 0)
+		    nelem = O_LEN(in2)
+		else
+		    nelem = 0
+	    }
+	}
+
+	# Convert input operands to desired type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case PLUS:
+		# Swap operands.
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+	    case CONCAT:
+		; # Do nothing
+
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    v_$t = O_VAL$T(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovk$t (v_$t, Mem$t[O_VALP(in1)], nelem)
+		$endfor
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, dtype)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# The bitwise boolean binary operators a special case since only the
+	# integer datatypes are permitted.  Otherwise the bitwise booleans
+	# are just like arithmetic booleans.
+
+	if (opcode == BAND || opcode == BOR || opcode == BXOR) {
+	    switch (dtype) {
+$for (sil)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = and (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call aandk$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call aand$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = or (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call abork$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call abor$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = xor (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call axork$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call axor$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		}
+$endfor
+	    default:
+		call xvv_error (s_boolop)
+	    }
+
+	    goto done_
+	}
+
+	# Perform an arithmetic binary operation.
+	switch (dtype) {
+	case TY_CHAR:
+	    switch (opcode) {
+	    case CONCAT:
+		call strcpy (O_VALC(in1), O_VALC(out), ARB)
+		call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    default:
+		call xvv_error ("binop: operation illegal for string operands")
+	    }
+$for (silrd)
+	case TY_PIXEL:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VAL$T(out) = O_VAL$T(in1) + O_VAL$T(in2)
+		} else if (len2 <= 0) {
+		    call aaddk$t (Mem$t[p1], O_VAL$T(in2),
+			Mem$t[po], nelem)
+		} else {
+		    call aadd$t (Mem$t[p1], Mem$t[p2],
+			Mem$t[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) - O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call asubk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call asub$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) * O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call amulk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call amul$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VAL$T(out) = O_VAL$T(in1) / O_VAL$T(in2)
+		    else if (len2 <= 0)
+			call adivk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		    else
+			call adiv$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VAL$T(in2) == 0$f)
+			    O_VAL$T(out) = xvv_null$t(0$f)
+			else
+			    O_VAL$T(out) = O_VAL$T(in1) / O_VAL$T(in2)
+		    } else if (len2 <= 0) {
+			if (O_VAL$T(in2) == 0$f)
+			    call amovk$t (xvv_null$t(0$f), Mem$t[po], nelem)
+			else {
+			    call adivk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po],
+				nelem)
+			}
+		    } else {
+			call advz$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem,
+			    xvv_null$t)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) ** O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call aexpk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call aexp$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Mem$t[po] = O_VAL$T(in1)
+		    po = po + 1
+		} else {
+		    call amov$t (Mem$t[p1], Mem$t[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Mem$t[po] = O_VAL$T(in2)
+		else
+		    call amov$t (Mem$t[p2], Mem$t[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+$endfor
+	default:
+	    call xvv_error (s_badswitch)
+	}
+done_
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_BOOLOP -- Boolean (actually logical) binary operations.  Perform the
+# indicated logical operation on the two input operands, returning the result
+# as the output operand.  The opcodes implemented by this routine are
+# characterized by the fact that they all return a logical result (YES or NO
+# physically expressed as an integer).
+
+procedure xvv_boolop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+$for (silrd)
+PIXEL	v_$t
+$endfor
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+int	xvv_newtype(), xvv_patmatch(), strncmp(), btoi()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badop "boolop: illegal operation"
+string	s_badswitch "boolop: illegal switch"
+
+begin
+	# Boolean operands are treated as integer within this routine.
+	if (O_TYPE(in1) == TY_BOOL)
+	    O_TYPE(in1) = TY_INT
+	if (O_TYPE(in2) == TY_BOOL)
+	    O_TYPE(in2) = TY_INT
+
+	# Determine the computation type for the operation, i.e., the type
+	# both input operands must have.  This is not the same as the type
+	# of the output operand, which is always boolean for the operations
+	# implemented by this routine.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	if (dtype == TY_CHAR)
+	    nelem = 0
+	else {
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+	    else
+		nelem = 0
+	}
+
+	# Convert input operands to desired computation type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case EQ, NE:
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    v_$t = O_VAL$T(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovk$t (v_$t, Mem$t[O_VALP(in1)], nelem)
+		$endfor
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, TY_BOOL)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# Perform the operation.
+	if (dtype == TY_CHAR) {
+	    # Character data is a special case.
+
+	    switch (opcode) {
+	    case SE:
+		O_VALI(out) = btoi(xvv_patmatch (O_VALC(in1), O_VALC(in2)) > 0)
+	    case LT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0)
+	    case LE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) <= 0)
+	    case GT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0)
+	    case GE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) >= 0)
+	    case EQ:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0)
+	    case NE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) != 0)
+	    default:
+		call xvv_error (s_badop)
+	    }
+
+	} else if (opcode == LAND || opcode == LOR) {
+	    # Operations supporting only the integer types.
+
+	    switch (dtype) {
+$for (sil)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VAL$T(in1) != 0 && O_VAL$T(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alank$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    } else
+			call alan$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VAL$T(in1) != 0 || O_VAL$T(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alork$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    } else
+			call alor$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	} else {
+	    # Operations supporting any arithmetic type.
+
+	    switch (dtype) {
+$for (silrd)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) < O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abltk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call ablt$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) <= O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call ablek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call able$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) > O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abgtk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abgt$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) >= O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abgek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abge$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) == O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abeqk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abeq$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) != O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abnek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abne$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	}
+
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xvv_patmatch (str, pat)
+
+char	str[ARB]		#I operand string
+char	pat[ARB]		#I pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XVV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xvv_newtype (type1, type2)
+
+int	type1			#I datatype of first operand
+int	type2			#I datatype of second operand
+
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/T_B, T_C, T_S, T_I, T_L, T_R, T_D/
+
+data	(ttbl(i),i= 1, 7)	/T_B,    0,    0,    0,    0,    0,    0/
+data	(ttbl(i),i= 8,14)	/  0,  T_C,    0,    0,    0,    0,    0/
+data	(ttbl(i),i=15,21)	/  0,    0,  T_S,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=22,28)	/  0,    0,  T_I,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=29,35)	/  0,    0,  T_L,  T_L,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=36,42)	/  0,    0,  T_R,  T_R,  T_R,  T_R,  T_D/
+data	(ttbl(i),i=43,49)	/  0,    0,  T_D,  T_D,  T_D,  T_D,  T_D/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xvv_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XVV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xvv_quest (cond, in1, in2, out)
+
+pointer	cond			#I pointer to condition operand
+pointer	in1, in2		#I pointer to true,false operands
+pointer	out			#I pointer to output operand
+
+int	dtype, nelem, i
+pointer	sp, otemp, ip1, ip2, op, sel
+errchk	xvv_error, xvv_newtype, xvv_initop, xvv_chtype
+int	xvv_newtype(), btoi()
+
+begin
+	switch (O_TYPE(cond)) {
+	case TY_BOOL, TY_INT:
+	    ;
+	case TY_SHORT, TY_LONG:
+	    call xvv_chtype (cond, cond, TY_BOOL)
+	default:
+	    call xvv_error ("evvexpr: nonboolean condition operand")
+	}
+
+	if (O_LEN(cond) <= 0 &&
+	    (O_LEN(in1) <= 0 || O_TYPE(in1) == TY_CHAR) &&
+	    (O_LEN(in2) <= 0 || O_TYPE(in2) == TY_CHAR)) {
+
+	    # Both operands and the conditional are scalars; the expression
+	    # type is the type of the selected operand.
+
+	    if (O_VALI(cond) != 0) {
+		YYMOVE (in1, out)
+		call xvv_freeop (in2)
+	    } else {
+		YYMOVE (in2, out)
+		call xvv_freeop (in1)
+	    }
+
+	} else if (O_TYPE(in1) == TY_CHAR || O_TYPE(in2) == TY_CHAR) {
+	    # This combination is not legal.
+	    call xvv_error ("evvexpr: character and vector in cond expr")
+
+	} else {
+	    # Vector/scalar or vector/vector operation.  Both operands must
+	    # be of the same type.
+
+	    dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	    # Compute the size of the output operand.  If both input operands
+	    # are vectors the length of the output vector is the shorter of
+	    # the two.  The condition operand contributes to the dimension of
+	    # the expression result, although not to the datatype.
+
+	    nelem = 0
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+
+	    if (O_LEN(cond) > 0 && nelem > 0)
+		nelem = min (O_LEN(cond), nelem)
+	    else if (O_LEN(cond) > 0)
+		nelem = O_LEN(cond)
+
+	    # If this is a scalar/vector operation make sure the vector is the
+	    # first operand.
+
+	    if (O_LEN(in1) == 0 && O_LEN(in2) > 0) {
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+		# Since we are swapping arguments we need to negate the cond.
+		if (O_LEN(cond) <= 0)
+		    O_VALI(cond) = btoi (O_VALI(cond) == 0)
+		else {
+		    call abeqki (Memi[O_VALP(cond)], NO, Memi[O_VALP(cond)],
+			nelem)
+		}
+	    }
+
+	    # Initialize the output operand.
+	    call xvv_initop (out, nelem, dtype)
+
+	    # Convert input operands to desired computation type.
+	    if (O_TYPE(in1) != dtype)
+		call xvv_chtype (in1, in1, dtype)
+	    if (O_TYPE(in2) != dtype)
+		call xvv_chtype (in2, in2, dtype)
+
+	    ip1 = O_VALP(in1)
+	    ip2 = O_VALP(in2)
+	    op  = O_VALP(out)
+	    sel = O_VALP(cond)
+
+	    # Perform the operation.
+	    switch (dtype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Mem$t[op+i-1] = O_VAL$T(in1)
+			else
+			    Mem$t[op+i-1] = O_VAL$T(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amov$t (Mem$t[ip1], Mem$t[op], nelem)
+			else
+			    call amovk$t (O_VAL$T(in2), Mem$t[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselk$t (Mem$t[ip1], O_VAL$T(in2), Mem$t[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amov$t (Mem$t[ip1], Mem$t[op], nelem)
+			else
+			    call amov$t (Mem$t[ip2], Mem$t[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asel$t (Mem$t[ip1], Mem$t[ip2], Mem$t[op],
+			    Memi[sel], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error ("evvexpr: bad datatype in cond expr")
+	    }
+
+	    call xvv_freeop (in1)
+	    call xvv_freeop (in2)
+	}
+
+	call xvv_freeop (cond)
+end
+
+
+# XVV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xvv_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		#I function to be called
+pointer	args[ARB]		#I pointer to arglist descriptor
+int	nargs			#I number of arguments
+pointer	out			#I output operand (function value)
+
+$for (silrd)
+PIXEL	v_$t
+PIXEL	ahiv$t(), alov$t()
+PIXEL	amed$t()
+int	arav$t()
+$endfor
+
+real	mean_r, sigma_r
+double	mean_d, sigma_d
+real	asums(), asumi(), asumr()
+double	asuml(), asumd()
+
+bool	rangecheck
+int	optype, opcode
+int	chunk, repl, nelem, v_nargs, ch, shift, i, j
+pointer	sp, sym, buf, ap, ip, op, in1, in2
+include	"evvexpr.com"
+
+pointer	stfind()
+int	xvv_newtype(), strlen(), gctod(), btoi()
+errchk	xvv_chtype, xvv_initop, xvv_newtype, xvv_error1, xvv_error2
+errchk	zcall5, malloc
+
+string	s_badtype "%s: illegal operand type"
+define	free_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# Lookup the function name in the symbol table.
+	sym = stfind (ev_st, fcn)
+	if (sym != NULL)
+	    opcode = SYM_CODE(sym)
+	else
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall5 (ev_ufcn, ev_ufcn_data, fcn, args, nargs, out)
+		if (O_TYPE(out) <= 0)
+		    call xvv_error1 ("unrecognized macro or function `%s'", fcn)
+		goto free_
+	    } else
+		call xvv_error1 ("unknown function `%s' called", fcn)
+
+	# Range checking on functions that need it?
+	rangecheck = (and (ev_flags, EV_RNGCHK) != 0)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD, F_REPL, F_SHIFT:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2, F_MEAN, F_STDDEV, F_MEDIAN:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xvv_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xvv_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Some functions require that the input operand be a certain type,
+	# e.g. floating.  Handle the simple cases, converting input operands
+	# to the desired type.
+
+	switch (opcode) {
+	case F_ACOS, F_ASIN, F_ATAN, F_ATAN2, F_COS, F_COSH, F_DEG, F_EXP,
+	     F_LOG, F_LOG10, F_RAD, F_SIN, F_SINH, F_SQRT, F_TAN, F_TANH:
+
+	    # These functions want a floating point input operand.
+	    optype = TY_REAL
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) == TY_DOUBLE || O_TYPE(args[i]) == TY_LONG)
+		    optype = TY_DOUBLE
+	    }
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+	    }
+	    call xvv_initop (out, O_LEN(args[1]), optype)
+
+	case F_MOD, F_MIN, F_MAX, F_MEDIAN:
+	    # These functions may have multiple arguments, all of which
+	    # should be the same type.
+
+	    optype = O_TYPE(args[1])
+	    nelem = O_LEN(args[1])
+	    do i = 2, nargs {
+		optype = xvv_newtype (optype, args[i])
+		if (O_LEN(args[i]) > 0)
+		    if (nelem > 0)
+			nelem = min (nelem, O_LEN(args[i]))
+		    else if (nelem == 0)
+			nelem = O_LEN(args[i])
+	    }
+
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+
+	    if (nargs == 1 && opcode == F_MEDIAN)
+		nelem = 0
+	    call xvv_initop (out, nelem, optype)
+
+	case F_LEN:
+	    # This function always returns an integer scalar value.
+	    nelem = 0
+	    optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_HIV, F_LOV:
+	    # These functions return a scalar value.
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_SUM, F_MEAN, F_STDDEV:
+	    # These functions require a vector argument and return a scalar
+	    # value.
+
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    
+	    if (optype == TY_DOUBLE)
+		call xvv_initop (out, nelem, TY_DOUBLE)
+	    else
+		call xvv_initop (out, nelem, TY_REAL)
+
+	case F_SORT, F_SHIFT:
+	    # Vector to vector, no type conversions.
+	    nelem = O_LEN(args[1])
+	    optype = O_TYPE(args[1])
+	    call xvv_initop (out, nelem, optype)
+
+	default:
+	    optype = 0
+	}
+
+	# Evaluate the function.
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    call xvv_initop (out, O_LEN(ap), O_TYPE(ap))
+	    switch (O_TYPE(ap)) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0) {
+		    call aabs$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VAL$T(out) = abs(O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ACOS:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = acos (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = acos (O_VAL$T(ap))
+	    $endfor
+	case F_ASIN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = asin (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = asin (O_VAL$T(ap))
+	    $endfor
+	case F_COS:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = cos (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = cos (O_VAL$T(ap))
+	    $endfor
+	case F_COSH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = cosh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = cosh (O_VAL$T(ap))
+	    $endfor
+	case F_DEG:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = RADTODEG(Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = RADTODEG (O_VAL$T(ap))
+	    $endfor
+	case F_EXP:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = exp (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = exp (O_VAL$T(ap))
+	    $endfor
+	case F_LOG:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t <= 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = log (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = log (v_$t)
+		}
+	    $endfor
+	case F_LOG10:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t <= 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = log10 (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = log10 (v_$t)
+		}
+	    $endfor
+	case F_RAD:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = DEGTORAD(Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = DEGTORAD (O_VAL$T(ap))
+	    $endfor
+	case F_SIN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = sin (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = sin (O_VAL$T(ap))
+	    $endfor
+	case F_SINH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = sinh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = sinh (O_VAL$T(ap))
+	    $endfor
+	case F_SQRT:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t < 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = sqrt (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = sqrt (v_$t)
+		}
+	    $endfor
+	case F_TAN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = tan (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = tan (O_VAL$T(ap))
+	    $endfor
+	case F_TANH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = tanh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = tanh (O_VAL$T(ap))
+	    $endfor
+
+	case F_LEN:
+	    # Vector length.
+	    O_VALI(out) = O_LEN(ap)
+
+	case F_HIV:
+	    # High value.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    O_VAL$T(out) = ahiv$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VAL$T(out) = O_VAL$T(ap)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+	case F_LOV:
+	    # Low value.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    O_VAL$T(out) = alov$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VAL$T(out) = O_VAL$T(ap)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SUM:
+	    # Vector sum.
+	    switch (optype) {
+	    $for (silr)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    v_r = asum$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VAL$T(ap)
+	    $endfor
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    v_d = asumd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_d = O_VALD(ap)
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (optype == TY_DOUBLE)
+		O_VALD(out) = v_d
+	    else
+		O_VALR(out) = v_r
+
+	case F_MEAN, F_STDDEV:
+	    # Compute the mean or standard deviation of a vector.  An optional
+	    # second argument may be supplied to compute a K-sigma rejection
+	    # mean and sigma.
+
+	    if (nargs == 2) {
+		if (O_LEN(args[2]) > 0)
+		    call xvv_error1 ("%s: ksigma arg must be a scalar" , fcn)
+
+		switch (O_TYPE(args[2])) {
+		case TY_REAL:
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		case TY_DOUBLE:
+		    v_d = O_VALD(args[2])
+		    v_r = v_d
+		default:
+		    call xvv_chtype (args[2], args[2], TY_REAL)
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		}
+	    } else {
+		v_r = 0.0
+		v_d = 0.0
+	    }
+
+	    switch (optype) {
+	    $for (sir)
+	    case TY_PIXEL:
+		v_i = arav$t (Mem$t[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+	    $endfor
+	    $for (ld)
+	    case TY_PIXEL:
+		v_i = arav$t (Mem$t[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (opcode == F_MEAN) {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = mean_r
+		else
+		    O_VALD(out) = mean_d
+	    } else {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = sigma_r
+		else
+		    O_VALD(out) = sigma_d
+	    }
+
+	case F_MEDIAN:
+	    # Compute the median value of a vector, or the vector median
+	    # of 3 or more vectors.
+
+	    switch (nargs) {
+	    case 1:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    O_VAL$T(out) = amed$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 3:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed3$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 4:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed4$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(args[4])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 5:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed5$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(args[4])],
+				  Mem$t[O_VALP(args[5])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    default:
+		call xvv_error1 ("%s: wrong number of arguments", fcn)
+	    }
+
+	case F_REPL:
+	    # Replicate an item to make a longer vector.
+
+	    chunk = O_LEN(ap)
+	    optype = O_TYPE(ap)
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: replication factor must be a scalar", fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    repl = max (1, O_VALI(args[2]))
+
+	    if (chunk <= 0)
+		nelem = repl
+	    else
+		nelem = chunk * repl
+	    call xvv_initop (out, nelem, optype)
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amov$t (Mem$t[ip], Mem$t[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHIFT:
+	    # Vector shift.
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: shift arg must be a scalar" , fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    shift = O_VALI(args[2])
+
+	    if (abs(shift) > nelem) {
+		if (shift > 0)
+		    shift = nelem
+		else
+		    shift = -nelem
+	    }
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Mem$t[O_VALP(out)+i-1] = Mem$t[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VAL$T(out) = (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SORT:
+	    # Sort a vector.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call asrt$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ATAN, F_ATAN2:
+	    $for (rd)
+	    if (optype == TY_PIXEL) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Mem$t[O_VALP(out)+i-1] =
+				atan (Mem$t[O_VALP(ap)+i-1])
+		    } else
+			O_VAL$T(out) = atan (O_VAL$T(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Mem$t[O_VALP(out)+i-1] =
+				atan2 (Mem$t[O_VALP(args[1])+i-1],
+				       Mem$t[O_VALP(args[2])+i-1])
+		    } else
+			O_VAL$T(out) = atan2(O_VAL$T(args[1]), O_VAL$T(args[2]))
+		}
+	    }
+	    $endfor
+
+	case F_MOD:
+	    in1 = args[1]
+	    in2 = args[2]
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(in1) <= 0) {
+		    O_VAL$T(out) = mod (O_VAL$T(in1), O_VAL$T(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodk$t (Mem$t[O_VALP(in1)], O_VAL$T(in2),
+			Mem$t[O_VALP(out)], nelem)
+		} else {
+		    call amod$t (Mem$t[O_VALP(in1)], Mem$t[O_VALP(in2)],
+			Mem$t[O_VALP(out)], nelem)
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MAX:
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+		    else
+			O_VAL$T(out) = O_VAL$T(ap)
+		} else
+		    call amov$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VAL$T(out) = max (O_VAL$T(ap), O_VAL$T(out))
+			else {
+			    call amaxk$t (Mem$t[O_VALP(out)], O_VAL$T(ap),
+				Mem$t[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amax$t (Mem$t[O_VALP(out)], Mem$t[O_VALP(ap)],
+			    Mem$t[O_VALP(out)], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MIN:
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+		    else
+			O_VAL$T(out) = O_VAL$T(ap)
+		} else
+		    call amov$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VAL$T(out) = min (O_VAL$T(ap), O_VAL$T(out))
+			else {
+			    call amink$t (Mem$t[O_VALP(out)], O_VAL$T(ap),
+				Mem$t[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amin$t (Mem$t[O_VALP(out)], Mem$t[O_VALP(ap)],
+			    Mem$t[O_VALP(out)], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_BOOL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_BOOL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ch = O_VALC(ap)
+		O_VALI(out) = btoi (ch == 'y' || ch == 'Y')
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VAL$T(ap) != 0$f)
+		else {
+		    v_$t = 0$f
+		    call abnek$t (Mem$t[O_VALP(ap)], v_$t, Memi[O_VALP(out)],
+			nelem)
+		}
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHORT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_SHORT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALS(out) = 0
+		else
+		    O_VALS(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VAL$T(ap)
+		else
+		    call acht$ts (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_INT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VAL$T(ap)
+		else
+		    call acht$ti (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_LONG:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_LONG)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALL(out) = 0
+		else
+		    O_VALL(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VAL$T(ap)
+		else
+		    call acht$tl (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_NINT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = nint (v_d)
+
+	    $for (sil)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VAL$T(ap)
+		else
+		    call acht$ti (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    $for (rd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VAL$T(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Mem$t[O_VALP(ap)+i-1])
+		}
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_REAL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_REAL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALR(out) = 0
+		else
+		    O_VALR(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VAL$T(ap)
+		else
+		    call acht$tr (Mem$t[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_DOUBLE:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_DOUBLE)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALD(out) = 0
+		else
+		    O_VALD(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VAL$T(ap)
+		else
+		    call acht$td (Mem$t[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_STR:
+	    optype = TY_CHAR
+	    if (O_TYPE(ap) == TY_CHAR)
+		nelem = strlen (O_VALC(ap))
+	    else
+		nelem = MAX_DIGITS
+	    call xvv_initop (out, nelem, TY_CHAR)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call sprintf (O_VALC(out), nelem, "%b")
+		    call pargi (O_VALI(ap))
+	    case TY_CHAR:
+		call sprintf (O_VALC(out), nelem, "%s")
+		    call pargstr (O_VALC(ap))
+	    $for (sil)
+	    case TY_PIXEL:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call parg$t (O_VAL$T(ap))
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call parg$t (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	default:
+	    call xvv_error ("callfcn: unknown function type")
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xvv_freeop (args[i])
+
+	call sfree (sp)
+end
+
+
+# XVV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xvv_startarglist (arg, out)
+
+pointer	arg			#I pointer to first argument, or NULL
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap
+errchk	xvv_initop
+
+begin
+	call xvv_initop (out, LEN_ARGSTRUCT, TY_STRUCT)
+	ap = O_VALP(out)
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XVV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xvv_addarg (arg, arglist, out)
+
+pointer	arg			#I pointer to argument to be added
+pointer	arglist			#I pointer to operand pointing to arglist
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xvv_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XVV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xvv_error1 (fmt, arg)
+
+char	fmt[ARB]		#I printf format string
+char	arg[ARB]		#I string argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xvv_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		#I printf format string
+char	arg1[ARB]		#I string argument
+int	arg2			#I integer argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xvv_error (errmsg)
+
+char	errmsg[ARB]			#I error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XVV_CHTYPE -- Change the datatype of an operand.  The input and output
+# operands may be the same.
+
+procedure xvv_chtype (o1, o2, dtype)
+
+pointer	o1		#I input operand
+pointer	o2		#I output operand
+int	dtype		#I new datatype
+
+short	v_s
+int	v_i
+long	v_l
+real	v_r
+double	v_d
+pointer	vp, ip, op
+bool	float, freeval
+int	old_type, nelem, ch
+
+pointer	coerce()
+int	sizeof(), btoi(), gctod()
+string	s_badtype "chtype: invalid operand type"
+
+begin
+	old_type = O_TYPE(o1)
+	nelem = O_LEN(o1)
+
+	# No type conversion needed?
+	if (old_type == dtype) {
+	    if (o1 != o2) {
+		if (nelem <= 0)
+		    YYMOVE (o1, o2)
+		else {
+		    call xvv_initop (o2, nelem, old_type)
+		    call amovc (O_VALC(o1), O_VALC(o2), nelem * sizeof(dtype))
+		}
+	    }
+	    return
+	}
+
+	if (nelem <= 0) {
+	    # Scalar input operand.
+
+	    O_TYPE(o2) = dtype
+	    O_LEN(o2) = 0
+	    float = false
+
+	    # Read the old value into a local variable of type long or double.
+	    switch (old_type) {
+	    case TY_BOOL:
+		v_l = O_VALI(o1)
+	    case TY_CHAR:
+		v_l = 0  # null string?
+	    $for (sil)
+	    case TY_PIXEL:
+		v_l = O_VAL$T(o1)
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		v_d = O_VAL$T(o1)
+		float = true
+	    $endfor
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Set the value of the output operand.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (float)
+		    O_VALI(o2) = btoi (v_d != 0)
+		else
+		    O_VALI(o2) = btoi (v_l != 0)
+	    case TY_CHAR:
+		call xvv_initop (o2, MAX_DIGITS, TY_CHAR)
+		if (float) {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%g")
+			call pargd (v_d)
+		} else {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%d")
+			call pargl (v_l)
+		}
+	    $for (sil)
+	    case TY_PIXEL:
+		if (float)
+		    O_VAL$T(o2) = v_d
+		else
+		    O_VAL$T(o2) = v_l
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		if (float)
+		    O_VAL$T(o2) = v_d
+		else
+		    O_VAL$T(o2) = v_l
+	    $endfor
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	} else {
+	    # Vector input operand.
+
+	    # Save a pointer to the input operand data vector, to avoid it
+	    # getting clobbered if O1 and O2 are the same operand.
+
+	    vp = O_VALP(o1)
+
+	    # If we have a char string input operand the output numeric
+	    # operand can only be a scalar.  If we have a char string output
+	    # operand nelem is the length of the string.
+
+	    if (old_type == TY_CHAR)
+		nelem = 0
+	    else if (dtype == TY_CHAR)
+		nelem = MAX_DIGITS
+
+	    # Initialize the output operand O2.  The freeval flag is cleared
+	    # cleared to keep the initop from freeing the input operand array,
+	    # inherited when the input operand is copied (or when the input
+	    # and output operands are the same).  We free the old operand
+	    # array manually below.
+
+	    if (o1 != o2)
+		YYMOVE (o1, o2)
+	    freeval = (and (O_FLAGS(o1), O_FREEVAL) != 0)
+	    O_FLAGS(o2) = and (O_FLAGS(o2), not(O_FREEVAL))
+	    call xvv_initop (o2, nelem, dtype)
+
+	    # Write output value.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (old_type == TY_CHAR) {
+		    ch = Memc[vp]
+		    O_VALI(o2) = btoi (ch == 'y' || ch == 'Y')
+		} else {
+		    switch (old_type) {
+		    $for (silrd)
+		    case TY_PIXEL:
+			v_$t = 0$f
+			call abnek$t (Mem$t[vp], v_$t, Memi[O_VALP(o2)], nelem)
+		    $endfor
+		    default:
+			call xvv_error (s_badtype)
+		    }
+		}
+
+	    case TY_CHAR:
+		call xvv_error (s_badtype)
+
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		switch (old_type) {
+		case TY_BOOL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+		case TY_CHAR:
+		    ip = vp
+		    if (gctod (Memc, ip, v_d) <= 0)
+			v_d = 0
+		    switch (dtype) {
+		    $for (silrd)
+		    case TY_PIXEL:
+			O_VAL$T(o2) = v_d
+		    $endfor
+		    }
+		$for (silrd)
+		case TY_PIXEL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call acht$t (Mem$t[vp], Memc[op], nelem, dtype)
+		$endfor
+		default:
+		    call xvv_error (s_badtype)
+		}
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Free old operand value.
+	    if (freeval)
+		call mfree (vp, old_type)
+	}
+end
+
+
+# XVV_INITOP -- Initialize an operand, providing storage for an operand value
+# of the given size and type.
+
+procedure xvv_initop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xvv_makeop (o, o_len, o_type)
+end
+
+
+# XVV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xvv_makeop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    if (o_type == TY_BOOL)
+		call malloc (O_VALP(o), o_len, TY_INT)
+	    else
+		call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+
+	O_FLAGS(o) = O_FREEVAL
+end
+
+
+# XVV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xvv_freeop (o)
+
+pointer	o		#I pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Either free operand struct or clear the operand type to mark
+	# operand invalid.
+
+	if (and (O_FLAGS(o), O_FREEOP) != 0)
+	    call mfree (o, TY_STRUCT)
+	else
+	    O_TYPE(o) = 0
+end
+
+
+# XVV_LOADSYMBOLS -- Load a list of symbol names into a symbol table.  Each
+# symbol is tagged with an integer code corresponding to its sequence number
+# in the symbol list.
+
+pointer procedure xvv_loadsymbols (s)
+
+char	s[ARB]			#I symbol list "|sym1|sym2|...|"
+
+int	delim, symnum, ip
+pointer	sp, symname, st, sym, op
+pointer	stopen(), stenter()
+
+begin
+	call smark (sp)
+	call salloc (symname, SZ_FNAME, TY_CHAR)
+
+	st = stopen ("evvexpr", LEN_INDEX, LEN_STAB, LEN_SBUF)
+	delim = s[1]
+	symnum = 0
+
+	for (ip=2;  s[ip] != EOS;  ip=ip+1) {
+	    op = symname
+	    while (s[ip] != delim && s[ip] != EOS) {
+		Memc[op] = s[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+	    symnum = symnum + 1
+
+	    if (op > symname && IS_ALPHA(Memc[symname])) {
+		sym = stenter (st, Memc[symname], LEN_SYM)
+		SYM_CODE(sym) = symnum
+	    }
+	}
+
+	call sfree (sp)
+	return (st)
+end
+
+
+# XVV_NULL -- Return a null value to be used when a computation cannot be
+# performed and range checking is enabled.  Perhaps we should permit a user
+# specified value here, however this doesn't really work in an expression
+# evaluator since the value generated may be used in subsequent calculations
+# and hence may change.  If more careful treatment of out of range values
+# is needed a conditional expression can be used in which case the value
+# we return here is ignored (but still needed to avoid a hardware exception
+# when computing a vector).
+
+$for (silrd)
+PIXEL procedure xvv_null$t (ignore)
+PIXEL	ignore			#I ignored
+begin
+	return (0$f)
+end
+$endfor
diff --git a/sys/fmtio/evvexpr.x b/sys/fmtio/evvexpr.x
new file mode 100644
index 00000000..19bc4790
--- /dev/null
+++ b/sys/fmtio/evvexpr.x
@@ -0,0 +1,5050 @@
+
+# line 2 "evvexpr.y"
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math.h>
+include	<evvexpr.h>
+
+.help evvexpr
+.nf --------------------------------------------------------------------------
+EVVEXPR.GY -- Generic XYacc source for a general vector expression evaluator.
+
+	    o = evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+		evvfree (o)
+
+Client callbacks:
+
+	          getop (client_data, opname, out)
+	           ufcn (client_data, fcn, args, nargs, out)
+
+here "out" is the output operand returned to EVVEXPR.  Client_data is any
+arbitrary integer or pointer value passed in to EVVEXPR when by the client
+when the callback was registered.  "args" is an array of operand structs,
+the arguments for the user function being called.  If the operand or
+function call cannot be completed normally an error exit may be made (call
+error) or an invalid operand may be returned (O_TYPE set to 0).  The client
+should not free the "args" input operands, this will be handled by EVVEXPR.
+
+Operand struct (lib$evvexpr.h):
+
+	struct operand {
+		int	O_TYPE			# operand type (bcsilrd)
+		int	O_LEN			# operand length (0=scalar)
+		int	O_FLAGS			# O_FREEVAL, O_FREEOP
+		union {
+			char*	O_VALC		# string
+			short	O_VALS
+			int	O_VALI		# int or bool
+			long	O_VALL
+			real	O_VALR
+			double	O_VALD
+			pointer	O_VALP		# vector data
+		}
+	}
+
+The macro O_VALC references the string value of a TY_CHAR operand.  The
+flags are O_FREEVAL and O_FREEOP, which tell EVVEXPR and EVVFREE whether or
+not to free any vector operand array or the operand struct when the operand
+is freed.  The client should set these flags on operands returned to EVVEXPR
+if it wants EVVEXPR to free any operand storage.
+
+Supported types are bool, char (string), and SILRD.  Bool is indicated as
+TY_BOOL in the O_TYPE field of the operand struct, but is stored internally
+as an integer and the value field of a boolean operand is given by O_VALI.
+
+Operands may be either scalars or vectors.  A vector is indicated by a O_LEN
+value greater than zero.  For vector operands O_VALP points to the data array.
+A special case is TY_CHAR (string), in which case O_LEN is the allocated
+length of the EOS-terminated string.  A string is logically a scalar value
+even though it is physically stored in the operand as a character vector.
+
+The trig functions operate upon angles in units of radians.  The intrinsic
+functions RAD and DEG are available for converting between radians and
+degrees.  A string can be coerced to a binary value and vice versa, using
+the INT, STR, etc. intrinsic functions.
+
+This is a generalization of the older EVEXPR routine, adding additional
+datatypes, support for vector operands, and numerous minor enhancements.
+.endhelp ---------------------------------------------------------------------
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	17		# max args in a function call
+define	yyparse		xvv_parse
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	LEN_STAB	300		# for symbol table
+define	LEN_SBUF	256
+define	LEN_INDEX	97
+
+define	LEN_SYM		1		# symbol data
+define	SYM_CODE	Memi[$1]
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|cosh|deg|double|\
+			 |exp|hiv|int|len|log|log10|long|lov|max|mean|median|\
+			 |min|mod|nint|rad|real|repl|stddev|shift|short|sin|\
+			 |sinh|sort|sqrt|str|sum|tan|tanh|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_COSH		08
+define	F_DEG		09		# radians to degrees
+define	F_DOUBLE	10
+	# newline	11
+define	F_EXP		12
+define	F_HIV		13		# high value
+define	F_INT		14
+define	F_LEN		15		# vector length
+define	F_LOG		16
+define	F_LOG10		17
+define	F_LONG		18
+define	F_LOV		19		# low value
+define	F_MAX		20
+define	F_MEAN		21
+define	F_MEDIAN	22
+	# newline	23
+define	F_MIN		24
+define	F_MOD		25
+define	F_NINT		26
+define	F_RAD		27		# degrees to radians
+define	F_REAL		28
+define	F_REPL		29		# replicate
+define	F_STDDEV	30		# standard deviation
+define	F_SHIFT		31
+define	F_SHORT		32
+define	F_SIN		33
+	# newline	34
+define	F_SINH		35
+define	F_SORT		36		# sort
+define	F_SQRT		37		# square root
+define	F_STR		38
+define	F_SUM		39
+define	F_TAN 		40
+define	F_TANH 		41
+
+define	T_B		TY_BOOL
+define	T_C		TY_CHAR
+define	T_S		TY_SHORT
+define	T_I		TY_INT
+define	T_L		TY_LONG
+define	T_R		TY_REAL
+define	T_D		TY_DOUBLE
+
+
+# EVVEXPR -- Evaluate a general mixed type vector expression.  Input consists
+# of the expression to be evaluated (a string) and, optionally, user
+# procedures for fetching external operands and executing external functions.
+# Output is a pointer to an operand structure containing the computed value of
+# the expression.  The output operand structure is dynamically allocated by
+# EVVEXPR and must be freed by the user.
+# 
+# NOTE: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.  The main
+# inefficiency is that, since compilation and execution are not broken out as
+# separate steps, when the routine is repeatedly called to evaluate the same
+# expression with different data, all the compile time computation (parsing
+# etc.) has to be repeated.
+
+pointer procedure evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+
+char	expr[ARB]		#I expression to be evaluated
+int	getop			#I user supplied get operand procedure
+int	getop_data		#I client data for above function
+int	ufcn			#I user supplied function call procedure
+int	ufcn_data		#I client data for above function
+int	flags			#I flag bits
+
+int	junk
+pointer	sp, ip
+bool	debug, first_time
+int	strlen(), xvv_parse()
+pointer	xvv_loadsymbols()
+extern	xvv_gettok()
+
+errchk	xvv_parse, calloc
+include	"evvexpr.com"
+data	debug /false/
+data	first_time /true/
+
+begin
+	call smark (sp)
+
+	if (first_time) {
+	    # This creates data which remains for the life of the process.
+	    ev_st = xvv_loadsymbols (KEYWORDS)
+	    first_time = false
+	}
+
+	# Set user function entry point addresses.
+	ev_getop = getop
+	ev_getop_data = getop_data
+	ev_ufcn = ufcn
+	ev_ufcn_data = ufcn_data
+	ev_flags = flags
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XVV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xvv_parse (ip, debug, xvv_gettok)
+	O_FLAGS(ev_oval) = or (O_FLAGS(ev_oval), O_FREEOP)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+
+# EVVFREE -- Free an operand struct such as is returned by EVVEXPR.
+
+procedure evvfree (o)
+
+pointer	o			# operand struct
+
+begin
+	call xvv_freeop (o)
+end
+
+define	CONSTANT		257
+define	IDENTIFIER		258
+define	NEWLINE		259
+define	YYEOS		260
+define	PLUS		261
+define	MINUS		262
+define	STAR		263
+define	SLASH		264
+define	EXPON		265
+define	CONCAT		266
+define	QUEST		267
+define	COLON		268
+define	LT		269
+define	GT		270
+define	LE		271
+define	EQ		272
+define	NE		273
+define	SE		274
+define	LAND		275
+define	LOR		276
+define	LNOT		277
+define	BAND		278
+define	BOR		279
+define	BXOR		280
+define	BNOT		281
+define	AT		282
+define	GE		283
+define	UMINUS		284
+define	yyclearin	yychar = -1
+define	yyerrok		yyerrflag = 0
+define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
+define	YYERRCODE	256
+
+
+# End generic preprocessor escape.
+
+
+
+# XVV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xvv_unop (opcode, in, out)
+
+int	opcode			#I operation to be performed
+pointer	in			#I input operand
+pointer	out			#I output operand
+
+short	val_s
+long	val_l
+int	val_i, nelem
+errchk	xvv_error, xvv_initop
+string	s_badswitch "unop: bad switch"
+
+begin
+	nelem = O_LEN(in)
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xvv_error ("negation of a nonarithmetic operand")
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call anegs (Mems[O_VALP(in)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = -O_VALS(in)
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call anegi (Memi[O_VALP(in)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = -O_VALI(in)
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call anegl (Meml[O_VALP(in)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = -O_VALL(in)
+
+	    case TY_REAL:
+		if (nelem > 0)
+		    call anegr (Memr[O_VALP(in)], Memr[O_VALP(out)], nelem)
+		else
+		    O_VALR(out) = -O_VALR(in)
+
+	    case TY_DOUBLE:
+		if (nelem > 0)
+		    call anegd (Memd[O_VALP(in)], Memd[O_VALP(out)], nelem)
+		else
+		    O_VALD(out) = -O_VALD(in)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case LNOT:
+	    # Logical NOT.
+
+	    call xvv_initop (out, nelem, TY_BOOL)
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		if (nelem > 0)
+		    call abeqki (Memi[O_VALP(in)], NO, Memi[O_VALP(out)], nelem)
+		else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+
+	    case TY_SHORT:
+		if (nelem > 0) {
+		    val_s = NO
+		    call abeqks (Mems[O_VALP(in)], val_s, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALS(in) == NO)
+			O_VALS(out) = YES
+		    else
+			O_VALS(out) = NO
+		}
+
+	    case TY_INT:
+		if (nelem > 0) {
+		    val_i = NO
+		    call abeqki (Memi[O_VALP(in)], val_i, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+
+	    case TY_LONG:
+		if (nelem > 0) {
+		    val_l = NO
+		    call abeqkl (Meml[O_VALP(in)], val_l, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALL(in) == NO)
+			O_VALL(out) = YES
+		    else
+			O_VALL(out) = NO
+		}
+
+	    case TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("not of a nonlogical")
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case BNOT:
+	    # Bitwise boolean NOT.
+
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("boolean not of a noninteger operand")
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call anots (Mems[O_VALP(in)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = not(O_VALS(in))
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call anoti (Memi[O_VALP(in)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = not(O_VALI(in))
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call anotl (Meml[O_VALP(in)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = not(O_VALL(in))
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+
+	call xvv_freeop (in)
+end
+
+
+# XVV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xvv_binop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+
+short	v_s
+short	xvv_nulls()
+extern	xvv_nulls()
+
+int	v_i
+int	xvv_nulli()
+extern	xvv_nulli()
+
+long	v_l
+long	xvv_nulll()
+extern	xvv_nulll()
+
+real	v_r
+real	xvv_nullr()
+extern	xvv_nullr()
+
+double	v_d
+double	xvv_nulld()
+extern	xvv_nulld()
+
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+include	"evvexpr.com"
+
+int	xvv_newtype(), strlen()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badswitch "binop: bad case in switch"
+string	s_boolop "binop: bitwise boolean operands must be an integer type"
+define	done_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xvv_error ("binop: operation illegal for boolean operands")
+	case TY_CHAR:
+	    nelem = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	default:
+	    if (opcode == CONCAT)
+		nelem = max (1, O_LEN(in1)) + max (1, O_LEN(in2))
+	    else {
+		if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		    nelem = min (O_LEN(in1), O_LEN(in2))
+		else if (O_LEN(in1) > 0)
+		    nelem = O_LEN(in1)
+		else if (O_LEN(in2) > 0)
+		    nelem = O_LEN(in2)
+		else
+		    nelem = 0
+	    }
+	}
+
+	# Convert input operands to desired type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case PLUS:
+		# Swap operands.
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+	    case CONCAT:
+		; # Do nothing
+
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+
+		case TY_SHORT:
+		    v_s = O_VALS(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovks (v_s, Mems[O_VALP(in1)], nelem)
+
+		case TY_INT:
+		    v_i = O_VALI(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovki (v_i, Memi[O_VALP(in1)], nelem)
+
+		case TY_LONG:
+		    v_l = O_VALL(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkl (v_l, Meml[O_VALP(in1)], nelem)
+
+		case TY_REAL:
+		    v_r = O_VALR(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkr (v_r, Memr[O_VALP(in1)], nelem)
+
+		case TY_DOUBLE:
+		    v_d = O_VALD(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkd (v_d, Memd[O_VALP(in1)], nelem)
+
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, dtype)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# The bitwise boolean binary operators a special case since only the
+	# integer datatypes are permitted.  Otherwise the bitwise booleans
+	# are just like arithmetic booleans.
+
+	if (opcode == BAND || opcode == BOR || opcode == BXOR) {
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALS(out) = and (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call aandks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call aands (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALS(out) = or (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call aborks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call abors (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALS(out) = xor (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call axorks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call axors (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALI(out) = and (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call aandki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call aandi (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALI(out) = or (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call aborki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call abori (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALI(out) = xor (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call axorki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call axori (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALL(out) = and (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call aandkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call aandl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALL(out) = or (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call aborkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call aborl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALL(out) = xor (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call axorkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call axorl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error (s_boolop)
+	    }
+
+	    goto done_
+	}
+
+	# Perform an arithmetic binary operation.
+	switch (dtype) {
+	case TY_CHAR:
+	    switch (opcode) {
+	    case CONCAT:
+		call strcpy (O_VALC(in1), O_VALC(out), ARB)
+		call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    default:
+		call xvv_error ("binop: operation illegal for string operands")
+	    }
+
+	case TY_SHORT:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALS(out) = O_VALS(in1) + O_VALS(in2)
+		} else if (len2 <= 0) {
+		    call aaddks (Mems[p1], O_VALS(in2),
+			Mems[po], nelem)
+		} else {
+		    call aadds (Mems[p1], Mems[p2],
+			Mems[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) - O_VALS(in2)
+		else if (len2 <= 0)
+		    call asubks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call asubs (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) * O_VALS(in2)
+		else if (len2 <= 0)
+		    call amulks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call amuls (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALS(out) = O_VALS(in1) / O_VALS(in2)
+		    else if (len2 <= 0)
+			call adivks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		    else
+			call adivs (Mems[p1], Mems[p2], Mems[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALS(in2) == 0)
+			    O_VALS(out) = xvv_nulls(0)
+			else
+			    O_VALS(out) = O_VALS(in1) / O_VALS(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALS(in2) == 0)
+			    call amovks (xvv_nulls(0), Mems[po], nelem)
+			else {
+			    call adivks (Mems[p1], O_VALS(in2), Mems[po],
+				nelem)
+			}
+		    } else {
+			call advzs (Mems[p1], Mems[p2], Mems[po], nelem,
+			    xvv_nulls)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) ** O_VALS(in2)
+		else if (len2 <= 0)
+		    call aexpks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call aexps (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Mems[po] = O_VALS(in1)
+		    po = po + 1
+		} else {
+		    call amovs (Mems[p1], Mems[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Mems[po] = O_VALS(in2)
+		else
+		    call amovs (Mems[p2], Mems[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_INT:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALI(out) = O_VALI(in1) + O_VALI(in2)
+		} else if (len2 <= 0) {
+		    call aaddki (Memi[p1], O_VALI(in2),
+			Memi[po], nelem)
+		} else {
+		    call aaddi (Memi[p1], Memi[p2],
+			Memi[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) - O_VALI(in2)
+		else if (len2 <= 0)
+		    call asubki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call asubi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) * O_VALI(in2)
+		else if (len2 <= 0)
+		    call amulki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call amuli (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALI(out) = O_VALI(in1) / O_VALI(in2)
+		    else if (len2 <= 0)
+			call adivki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call adivi (Memi[p1], Memi[p2], Memi[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALI(in2) == 0)
+			    O_VALI(out) = xvv_nulli(0)
+			else
+			    O_VALI(out) = O_VALI(in1) / O_VALI(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALI(in2) == 0)
+			    call amovki (xvv_nulli(0), Memi[po], nelem)
+			else {
+			    call adivki (Memi[p1], O_VALI(in2), Memi[po],
+				nelem)
+			}
+		    } else {
+			call advzi (Memi[p1], Memi[p2], Memi[po], nelem,
+			    xvv_nulli)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) ** O_VALI(in2)
+		else if (len2 <= 0)
+		    call aexpki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call aexpi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memi[po] = O_VALI(in1)
+		    po = po + 1
+		} else {
+		    call amovi (Memi[p1], Memi[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memi[po] = O_VALI(in2)
+		else
+		    call amovi (Memi[p2], Memi[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_LONG:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALL(out) = O_VALL(in1) + O_VALL(in2)
+		} else if (len2 <= 0) {
+		    call aaddkl (Meml[p1], O_VALL(in2),
+			Meml[po], nelem)
+		} else {
+		    call aaddl (Meml[p1], Meml[p2],
+			Meml[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) - O_VALL(in2)
+		else if (len2 <= 0)
+		    call asubkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call asubl (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) * O_VALL(in2)
+		else if (len2 <= 0)
+		    call amulkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call amull (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALL(out) = O_VALL(in1) / O_VALL(in2)
+		    else if (len2 <= 0)
+			call adivkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		    else
+			call adivl (Meml[p1], Meml[p2], Meml[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALL(in2) == 0)
+			    O_VALL(out) = xvv_nulll(0)
+			else
+			    O_VALL(out) = O_VALL(in1) / O_VALL(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALL(in2) == 0)
+			    call amovkl (xvv_nulll(0), Meml[po], nelem)
+			else {
+			    call adivkl (Meml[p1], O_VALL(in2), Meml[po],
+				nelem)
+			}
+		    } else {
+			call advzl (Meml[p1], Meml[p2], Meml[po], nelem,
+			    xvv_nulll)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) ** O_VALL(in2)
+		else if (len2 <= 0)
+		    call aexpkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call aexpl (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Meml[po] = O_VALL(in1)
+		    po = po + 1
+		} else {
+		    call amovl (Meml[p1], Meml[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Meml[po] = O_VALL(in2)
+		else
+		    call amovl (Meml[p2], Meml[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_REAL:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALR(out) = O_VALR(in1) + O_VALR(in2)
+		} else if (len2 <= 0) {
+		    call aaddkr (Memr[p1], O_VALR(in2),
+			Memr[po], nelem)
+		} else {
+		    call aaddr (Memr[p1], Memr[p2],
+			Memr[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) - O_VALR(in2)
+		else if (len2 <= 0)
+		    call asubkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call asubr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) * O_VALR(in2)
+		else if (len2 <= 0)
+		    call amulkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call amulr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALR(out) = O_VALR(in1) / O_VALR(in2)
+		    else if (len2 <= 0)
+			call adivkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		    else
+			call adivr (Memr[p1], Memr[p2], Memr[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALR(in2) == 0.0)
+			    O_VALR(out) = xvv_nullr(0.0)
+			else
+			    O_VALR(out) = O_VALR(in1) / O_VALR(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALR(in2) == 0.0)
+			    call amovkr (xvv_nullr(0.0), Memr[po], nelem)
+			else {
+			    call adivkr (Memr[p1], O_VALR(in2), Memr[po],
+				nelem)
+			}
+		    } else {
+			call advzr (Memr[p1], Memr[p2], Memr[po], nelem,
+			    xvv_nullr)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) ** O_VALR(in2)
+		else if (len2 <= 0)
+		    call aexpkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call aexpr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memr[po] = O_VALR(in1)
+		    po = po + 1
+		} else {
+		    call amovr (Memr[p1], Memr[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memr[po] = O_VALR(in2)
+		else
+		    call amovr (Memr[p2], Memr[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_DOUBLE:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALD(out) = O_VALD(in1) + O_VALD(in2)
+		} else if (len2 <= 0) {
+		    call aaddkd (Memd[p1], O_VALD(in2),
+			Memd[po], nelem)
+		} else {
+		    call aaddd (Memd[p1], Memd[p2],
+			Memd[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) - O_VALD(in2)
+		else if (len2 <= 0)
+		    call asubkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call asubd (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) * O_VALD(in2)
+		else if (len2 <= 0)
+		    call amulkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call amuld (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALD(out) = O_VALD(in1) / O_VALD(in2)
+		    else if (len2 <= 0)
+			call adivkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		    else
+			call adivd (Memd[p1], Memd[p2], Memd[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALD(in2) == 0.0D0)
+			    O_VALD(out) = xvv_nulld(0.0D0)
+			else
+			    O_VALD(out) = O_VALD(in1) / O_VALD(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALD(in2) == 0.0D0)
+			    call amovkd (xvv_nulld(0.0D0), Memd[po], nelem)
+			else {
+			    call adivkd (Memd[p1], O_VALD(in2), Memd[po],
+				nelem)
+			}
+		    } else {
+			call advzd (Memd[p1], Memd[p2], Memd[po], nelem,
+			    xvv_nulld)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) ** O_VALD(in2)
+		else if (len2 <= 0)
+		    call aexpkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call aexpd (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memd[po] = O_VALD(in1)
+		    po = po + 1
+		} else {
+		    call amovd (Memd[p1], Memd[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memd[po] = O_VALD(in2)
+		else
+		    call amovd (Memd[p2], Memd[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+done_
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_BOOLOP -- Boolean (actually logical) binary operations.  Perform the
+# indicated logical operation on the two input operands, returning the result
+# as the output operand.  The opcodes implemented by this routine are
+# characterized by the fact that they all return a logical result (YES or NO
+# physically expressed as an integer).
+
+procedure xvv_boolop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+
+short	v_s
+
+int	v_i
+
+long	v_l
+
+real	v_r
+
+double	v_d
+
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+int	xvv_newtype(), xvv_patmatch(), strncmp(), btoi()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badop "boolop: illegal operation"
+string	s_badswitch "boolop: illegal switch"
+
+begin
+	# Boolean operands are treated as integer within this routine.
+	if (O_TYPE(in1) == TY_BOOL)
+	    O_TYPE(in1) = TY_INT
+	if (O_TYPE(in2) == TY_BOOL)
+	    O_TYPE(in2) = TY_INT
+
+	# Determine the computation type for the operation, i.e., the type
+	# both input operands must have.  This is not the same as the type
+	# of the output operand, which is always boolean for the operations
+	# implemented by this routine.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	if (dtype == TY_CHAR)
+	    nelem = 0
+	else {
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+	    else
+		nelem = 0
+	}
+
+	# Convert input operands to desired computation type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case EQ, NE:
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+
+		case TY_SHORT:
+		    v_s = O_VALS(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovks (v_s, Mems[O_VALP(in1)], nelem)
+
+		case TY_INT:
+		    v_i = O_VALI(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovki (v_i, Memi[O_VALP(in1)], nelem)
+
+		case TY_LONG:
+		    v_l = O_VALL(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkl (v_l, Meml[O_VALP(in1)], nelem)
+
+		case TY_REAL:
+		    v_r = O_VALR(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkr (v_r, Memr[O_VALP(in1)], nelem)
+
+		case TY_DOUBLE:
+		    v_d = O_VALD(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkd (v_d, Memd[O_VALP(in1)], nelem)
+
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, TY_BOOL)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# Perform the operation.
+	if (dtype == TY_CHAR) {
+	    # Character data is a special case.
+
+	    switch (opcode) {
+	    case SE:
+		O_VALI(out) = btoi(xvv_patmatch (O_VALC(in1), O_VALC(in2)) > 0)
+	    case LT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0)
+	    case LE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) <= 0)
+	    case GT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0)
+	    case GE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) >= 0)
+	    case EQ:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0)
+	    case NE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) != 0)
+	    default:
+		call xvv_error (s_badop)
+	    }
+
+	} else if (opcode == LAND || opcode == LOR) {
+	    # Operations supporting only the integer types.
+
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALS(in1) != 0 && O_VALS(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alanks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    } else
+			call alans (Mems[p1], Mems[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALS(in1) != 0 || O_VALS(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    } else
+			call alors (Mems[p1], Mems[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALI(in1) != 0 && O_VALI(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alanki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    } else
+			call alani (Memi[p1], Memi[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALI(in1) != 0 || O_VALI(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    } else
+			call alori (Memi[p1], Memi[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALL(in1) != 0 && O_VALL(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alankl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    } else
+			call alanl (Meml[p1], Meml[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALL(in1) != 0 || O_VALL(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    } else
+			call alorl (Meml[p1], Meml[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	} else {
+	    # Operations supporting any arithmetic type.
+
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) < O_VALS(in2))
+		    else if (len2 <= 0)
+			call abltks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call ablts (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) <= O_VALS(in2))
+		    else if (len2 <= 0)
+			call ableks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call ables (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) > O_VALS(in2))
+		    else if (len2 <= 0)
+			call abgtks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abgts (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) >= O_VALS(in2))
+		    else if (len2 <= 0)
+			call abgeks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abges (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) == O_VALS(in2))
+		    else if (len2 <= 0)
+			call abeqks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abeqs (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) != O_VALS(in2))
+		    else if (len2 <= 0)
+			call abneks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abnes (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) < O_VALI(in2))
+		    else if (len2 <= 0)
+			call abltki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call ablti (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) <= O_VALI(in2))
+		    else if (len2 <= 0)
+			call ableki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call ablei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) > O_VALI(in2))
+		    else if (len2 <= 0)
+			call abgtki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abgti (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) >= O_VALI(in2))
+		    else if (len2 <= 0)
+			call abgeki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abgei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) == O_VALI(in2))
+		    else if (len2 <= 0)
+			call abeqki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abeqi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) != O_VALI(in2))
+		    else if (len2 <= 0)
+			call abneki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abnei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) < O_VALL(in2))
+		    else if (len2 <= 0)
+			call abltkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abltl (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) <= O_VALL(in2))
+		    else if (len2 <= 0)
+			call ablekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call ablel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) > O_VALL(in2))
+		    else if (len2 <= 0)
+			call abgtkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abgtl (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) >= O_VALL(in2))
+		    else if (len2 <= 0)
+			call abgekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abgel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) == O_VALL(in2))
+		    else if (len2 <= 0)
+			call abeqkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abeql (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) != O_VALL(in2))
+		    else if (len2 <= 0)
+			call abnekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abnel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_REAL:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) < O_VALR(in2))
+		    else if (len2 <= 0)
+			call abltkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abltr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) <= O_VALR(in2))
+		    else if (len2 <= 0)
+			call ablekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abler (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) > O_VALR(in2))
+		    else if (len2 <= 0)
+			call abgtkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abgtr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) >= O_VALR(in2))
+		    else if (len2 <= 0)
+			call abgekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abger (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) == O_VALR(in2))
+		    else if (len2 <= 0)
+			call abeqkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abeqr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) != O_VALR(in2))
+		    else if (len2 <= 0)
+			call abnekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abner (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_DOUBLE:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) < O_VALD(in2))
+		    else if (len2 <= 0)
+			call abltkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abltd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) <= O_VALD(in2))
+		    else if (len2 <= 0)
+			call ablekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abled (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) > O_VALD(in2))
+		    else if (len2 <= 0)
+			call abgtkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abgtd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) >= O_VALD(in2))
+		    else if (len2 <= 0)
+			call abgekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abged (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) == O_VALD(in2))
+		    else if (len2 <= 0)
+			call abeqkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abeqd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) != O_VALD(in2))
+		    else if (len2 <= 0)
+			call abnekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abned (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	}
+
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xvv_patmatch (str, pat)
+
+char	str[ARB]		#I operand string
+char	pat[ARB]		#I pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XVV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xvv_newtype (type1, type2)
+
+int	type1			#I datatype of first operand
+int	type2			#I datatype of second operand
+
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/T_B, T_C, T_S, T_I, T_L, T_R, T_D/
+
+data	(ttbl(i),i= 1, 7)	/T_B,    0,    0,    0,    0,    0,    0/
+data	(ttbl(i),i= 8,14)	/  0,  T_C,    0,    0,    0,    0,    0/
+data	(ttbl(i),i=15,21)	/  0,    0,  T_S,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=22,28)	/  0,    0,  T_I,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=29,35)	/  0,    0,  T_L,  T_L,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=36,42)	/  0,    0,  T_R,  T_R,  T_R,  T_R,  T_D/
+data	(ttbl(i),i=43,49)	/  0,    0,  T_D,  T_D,  T_D,  T_D,  T_D/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xvv_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XVV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xvv_quest (cond, in1, in2, out)
+
+pointer	cond			#I pointer to condition operand
+pointer	in1, in2		#I pointer to true,false operands
+pointer	out			#I pointer to output operand
+
+int	dtype, nelem, i
+pointer	sp, otemp, ip1, ip2, op, sel
+errchk	xvv_error, xvv_newtype, xvv_initop, xvv_chtype
+int	xvv_newtype(), btoi()
+
+begin
+	switch (O_TYPE(cond)) {
+	case TY_BOOL, TY_INT:
+	    ;
+	case TY_SHORT, TY_LONG:
+	    call xvv_chtype (cond, cond, TY_BOOL)
+	default:
+	    call xvv_error ("evvexpr: nonboolean condition operand")
+	}
+
+	if (O_LEN(cond) <= 0 &&
+	    (O_LEN(in1) <= 0 || O_TYPE(in1) == TY_CHAR) &&
+	    (O_LEN(in2) <= 0 || O_TYPE(in2) == TY_CHAR)) {
+
+	    # Both operands and the conditional are scalars; the expression
+	    # type is the type of the selected operand.
+
+	    if (O_VALI(cond) != 0) {
+		YYMOVE (in1, out)
+		call xvv_freeop (in2)
+	    } else {
+		YYMOVE (in2, out)
+		call xvv_freeop (in1)
+	    }
+
+	} else if (O_TYPE(in1) == TY_CHAR || O_TYPE(in2) == TY_CHAR) {
+	    # This combination is not legal.
+	    call xvv_error ("evvexpr: character and vector in cond expr")
+
+	} else {
+	    # Vector/scalar or vector/vector operation.  Both operands must
+	    # be of the same type.
+
+	    dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	    # Compute the size of the output operand.  If both input operands
+	    # are vectors the length of the output vector is the shorter of
+	    # the two.  The condition operand contributes to the dimension of
+	    # the expression result, although not to the datatype.
+
+	    nelem = 0
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+
+	    if (O_LEN(cond) > 0 && nelem > 0)
+		nelem = min (O_LEN(cond), nelem)
+	    else if (O_LEN(cond) > 0)
+		nelem = O_LEN(cond)
+
+	    # If this is a scalar/vector operation make sure the vector is the
+	    # first operand.
+
+	    if (O_LEN(in1) == 0 && O_LEN(in2) > 0) {
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+		# Since we are swapping arguments we need to negate the cond.
+		if (O_LEN(cond) <= 0)
+		    O_VALI(cond) = btoi (O_VALI(cond) == 0)
+		else {
+		    call abeqki (Memi[O_VALP(cond)], NO, Memi[O_VALP(cond)],
+			nelem)
+		}
+	    }
+
+	    # Initialize the output operand.
+	    call xvv_initop (out, nelem, dtype)
+
+	    # Convert input operands to desired computation type.
+	    if (O_TYPE(in1) != dtype)
+		call xvv_chtype (in1, in1, dtype)
+	    if (O_TYPE(in2) != dtype)
+		call xvv_chtype (in2, in2, dtype)
+
+	    ip1 = O_VALP(in1)
+	    ip2 = O_VALP(in2)
+	    op  = O_VALP(out)
+	    sel = O_VALP(cond)
+
+	    # Perform the operation.
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Mems[op+i-1] = O_VALS(in1)
+			else
+			    Mems[op+i-1] = O_VALS(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovs (Mems[ip1], Mems[op], nelem)
+			else
+			    call amovks (O_VALS(in2), Mems[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselks (Mems[ip1], O_VALS(in2), Mems[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovs (Mems[ip1], Mems[op], nelem)
+			else
+			    call amovs (Mems[ip2], Mems[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asels (Mems[ip1], Mems[ip2], Mems[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memi[op+i-1] = O_VALI(in1)
+			else
+			    Memi[op+i-1] = O_VALI(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovi (Memi[ip1], Memi[op], nelem)
+			else
+			    call amovki (O_VALI(in2), Memi[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselki (Memi[ip1], O_VALI(in2), Memi[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovi (Memi[ip1], Memi[op], nelem)
+			else
+			    call amovi (Memi[ip2], Memi[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aseli (Memi[ip1], Memi[ip2], Memi[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Meml[op+i-1] = O_VALL(in1)
+			else
+			    Meml[op+i-1] = O_VALL(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovl (Meml[ip1], Meml[op], nelem)
+			else
+			    call amovkl (O_VALL(in2), Meml[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkl (Meml[ip1], O_VALL(in2), Meml[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovl (Meml[ip1], Meml[op], nelem)
+			else
+			    call amovl (Meml[ip2], Meml[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asell (Meml[ip1], Meml[ip2], Meml[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memr[op+i-1] = O_VALR(in1)
+			else
+			    Memr[op+i-1] = O_VALR(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovr (Memr[ip1], Memr[op], nelem)
+			else
+			    call amovkr (O_VALR(in2), Memr[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkr (Memr[ip1], O_VALR(in2), Memr[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovr (Memr[ip1], Memr[op], nelem)
+			else
+			    call amovr (Memr[ip2], Memr[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselr (Memr[ip1], Memr[ip2], Memr[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memd[op+i-1] = O_VALD(in1)
+			else
+			    Memd[op+i-1] = O_VALD(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovd (Memd[ip1], Memd[op], nelem)
+			else
+			    call amovkd (O_VALD(in2), Memd[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkd (Memd[ip1], O_VALD(in2), Memd[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovd (Memd[ip1], Memd[op], nelem)
+			else
+			    call amovd (Memd[ip2], Memd[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aseld (Memd[ip1], Memd[ip2], Memd[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error ("evvexpr: bad datatype in cond expr")
+	    }
+
+	    call xvv_freeop (in1)
+	    call xvv_freeop (in2)
+	}
+
+	call xvv_freeop (cond)
+end
+
+
+# XVV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xvv_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		#I function to be called
+pointer	args[ARB]		#I pointer to arglist descriptor
+int	nargs			#I number of arguments
+pointer	out			#I output operand (function value)
+
+
+short	v_s
+short	ahivs(), alovs()
+short	ameds()
+int	aravs()
+
+int	v_i
+int	ahivi(), alovi()
+int	amedi()
+int	aravi()
+
+long	v_l
+long	ahivl(), alovl()
+long	amedl()
+int	aravl()
+
+real	v_r
+real	ahivr(), alovr()
+real	amedr()
+int	aravr()
+
+double	v_d
+double	ahivd(), alovd()
+double	amedd()
+int	aravd()
+
+
+real	mean_r, sigma_r
+double	mean_d, sigma_d
+real	asums(), asumi(), asumr()
+double	asuml(), asumd()
+
+bool	rangecheck
+int	optype, opcode
+int	chunk, repl, nelem, v_nargs, ch, shift, i, j
+pointer	sp, sym, buf, ap, ip, op, in1, in2
+include	"evvexpr.com"
+
+pointer	stfind()
+int	xvv_newtype(), strlen(), gctod(), btoi()
+errchk	xvv_chtype, xvv_initop, xvv_newtype, xvv_error1, xvv_error2
+errchk	zcall5, malloc
+
+string	s_badtype "%s: illegal operand type"
+define	free_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# Lookup the function name in the symbol table.
+	sym = stfind (ev_st, fcn)
+	if (sym != NULL)
+	    opcode = SYM_CODE(sym)
+	else
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall5 (ev_ufcn, ev_ufcn_data, fcn, args, nargs, out)
+		if (O_TYPE(out) <= 0)
+		    call xvv_error1 ("unrecognized macro or function `%s'", fcn)
+		goto free_
+	    } else
+		call xvv_error1 ("unknown function `%s' called", fcn)
+
+	# Range checking on functions that need it?
+	rangecheck = (and (ev_flags, EV_RNGCHK) != 0)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD, F_REPL, F_SHIFT:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2, F_MEAN, F_STDDEV, F_MEDIAN:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xvv_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xvv_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Some functions require that the input operand be a certain type,
+	# e.g. floating.  Handle the simple cases, converting input operands
+	# to the desired type.
+
+	switch (opcode) {
+	case F_ACOS, F_ASIN, F_ATAN, F_ATAN2, F_COS, F_COSH, F_DEG, F_EXP,
+	     F_LOG, F_LOG10, F_RAD, F_SIN, F_SINH, F_SQRT, F_TAN, F_TANH:
+
+	    # These functions want a floating point input operand.
+	    optype = TY_REAL
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) == TY_DOUBLE || O_TYPE(args[i]) == TY_LONG)
+		    optype = TY_DOUBLE
+	    }
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+	    }
+	    call xvv_initop (out, O_LEN(args[1]), optype)
+
+	case F_MOD, F_MIN, F_MAX, F_MEDIAN:
+	    # These functions may have multiple arguments, all of which
+	    # should be the same type.
+
+	    optype = O_TYPE(args[1])
+	    nelem = O_LEN(args[1])
+	    do i = 2, nargs {
+		optype = xvv_newtype (optype, O_TYPE(args[i]))
+		if (O_LEN(args[i]) > 0)
+		    if (nelem > 0)
+			nelem = min (nelem, O_LEN(args[i]))
+		    else if (nelem == 0)
+			nelem = O_LEN(args[i])
+	    }
+
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+
+	    if (nargs == 1 && opcode == F_MEDIAN)
+		nelem = 0
+	    call xvv_initop (out, nelem, optype)
+
+	case F_LEN:
+	    # This function always returns an integer scalar value.
+	    nelem = 0
+	    optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_HIV, F_LOV:
+	    # These functions return a scalar value.
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_SUM, F_MEAN, F_STDDEV:
+	    # These functions require a vector argument and return a scalar
+	    # value.
+
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    
+	    if (optype == TY_DOUBLE)
+		call xvv_initop (out, nelem, TY_DOUBLE)
+	    else
+		call xvv_initop (out, nelem, TY_REAL)
+
+	case F_SORT, F_SHIFT:
+	    # Vector to vector, no type conversions.
+	    nelem = O_LEN(args[1])
+	    optype = O_TYPE(args[1])
+	    call xvv_initop (out, nelem, optype)
+
+	default:
+	    optype = 0
+	}
+
+	# Evaluate the function.
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    call xvv_initop (out, O_LEN(ap), O_TYPE(ap))
+	    switch (O_TYPE(ap)) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0) {
+		    call aabss (Mems[O_VALP(ap)], Mems[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALS(out) = abs(O_VALS(ap))
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0) {
+		    call aabsi (Memi[O_VALP(ap)], Memi[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALI(out) = abs(O_VALI(ap))
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0) {
+		    call aabsl (Meml[O_VALP(ap)], Meml[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALL(out) = abs(O_VALL(ap))
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0) {
+		    call aabsr (Memr[O_VALP(ap)], Memr[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALR(out) = abs(O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0) {
+		    call aabsd (Memd[O_VALP(ap)], Memd[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALD(out) = abs(O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ACOS:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = acos (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = acos (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = acos (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = acos (O_VALD(ap))
+
+	case F_ASIN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = asin (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = asin (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = asin (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = asin (O_VALD(ap))
+
+	case F_COS:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = cos (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = cos (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = cos (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = cos (O_VALD(ap))
+
+	case F_COSH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = cosh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = cosh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = cosh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = cosh (O_VALD(ap))
+
+	case F_DEG:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = RADTODEG(Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = RADTODEG (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = RADTODEG(Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = RADTODEG (O_VALD(ap))
+
+	case F_EXP:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = exp (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = exp (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = exp (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = exp (O_VALD(ap))
+
+	case F_LOG:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r <= 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = log (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = log (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d <= 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = log (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = log (v_d)
+		}
+
+	case F_LOG10:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r <= 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = log10 (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = log10 (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d <= 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = log10 (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = log10 (v_d)
+		}
+
+	case F_RAD:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = DEGTORAD(Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = DEGTORAD (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = DEGTORAD(Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = DEGTORAD (O_VALD(ap))
+
+	case F_SIN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = sin (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = sin (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = sin (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = sin (O_VALD(ap))
+
+	case F_SINH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = sinh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = sinh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = sinh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = sinh (O_VALD(ap))
+
+	case F_SQRT:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r < 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = sqrt (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = sqrt (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d < 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = sqrt (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = sqrt (v_d)
+		}
+
+	case F_TAN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = tan (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = tan (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = tan (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = tan (O_VALD(ap))
+
+	case F_TANH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = tanh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = tanh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = tanh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = tanh (O_VALD(ap))
+
+
+	case F_LEN:
+	    # Vector length.
+	    O_VALI(out) = O_LEN(ap)
+
+	case F_HIV:
+	    # High value.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    O_VALS(out) = ahivs (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALS(out) = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    O_VALI(out) = ahivi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALI(out) = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    O_VALL(out) = ahivl (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALL(out) = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    O_VALR(out) = ahivr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALR(out) = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    O_VALD(out) = ahivd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALD(out) = O_VALD(ap)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+	case F_LOV:
+	    # Low value.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    O_VALS(out) = alovs (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALS(out) = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    O_VALI(out) = alovi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALI(out) = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    O_VALL(out) = alovl (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALL(out) = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    O_VALR(out) = alovr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALR(out) = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    O_VALD(out) = alovd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALD(out) = O_VALD(ap)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SUM:
+	    # Vector sum.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    v_r = asums (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    v_r = asumi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    v_r = asuml (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    v_r = asumr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    v_d = asumd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_d = O_VALD(ap)
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (optype == TY_DOUBLE)
+		O_VALD(out) = v_d
+	    else
+		O_VALR(out) = v_r
+
+	case F_MEAN, F_STDDEV:
+	    # Compute the mean or standard deviation of a vector.  An optional
+	    # second argument may be supplied to compute a K-sigma rejection
+	    # mean and sigma.
+
+	    if (nargs == 2) {
+		if (O_LEN(args[2]) > 0)
+		    call xvv_error1 ("%s: ksigma arg must be a scalar" , fcn)
+
+		switch (O_TYPE(args[2])) {
+		case TY_REAL:
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		case TY_DOUBLE:
+		    v_d = O_VALD(args[2])
+		    v_r = v_d
+		default:
+		    call xvv_chtype (args[2], args[2], TY_REAL)
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		}
+	    } else {
+		v_r = 0.0
+		v_d = 0.0
+	    }
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		v_i = aravs (Mems[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+	    case TY_INT:
+		v_i = aravi (Memi[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+	    case TY_REAL:
+		v_i = aravr (Memr[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+
+	    case TY_LONG:
+		v_i = aravl (Meml[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+
+	    case TY_DOUBLE:
+		v_i = aravd (Memd[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (opcode == F_MEAN) {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = mean_r
+		else
+		    O_VALD(out) = mean_d
+	    } else {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = sigma_r
+		else
+		    O_VALD(out) = sigma_d
+	    }
+
+	case F_MEDIAN:
+	    # Compute the median value of a vector, or the vector median
+	    # of 3 or more vectors.
+
+	    switch (nargs) {
+	    case 1:
+		switch (optype) {
+
+		case TY_SHORT:
+		    O_VALS(out) = ameds (Mems[O_VALP(ap)], O_LEN(ap))
+
+		case TY_INT:
+		    O_VALI(out) = amedi (Memi[O_VALP(ap)], O_LEN(ap))
+
+		case TY_LONG:
+		    O_VALL(out) = amedl (Meml[O_VALP(ap)], O_LEN(ap))
+
+		case TY_REAL:
+		    O_VALR(out) = amedr (Memr[O_VALP(ap)], O_LEN(ap))
+
+		case TY_DOUBLE:
+		    O_VALD(out) = amedd (Memd[O_VALP(ap)], O_LEN(ap))
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 3:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed3s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed3i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed3l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed3r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed3d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 4:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed4s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(args[4])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed4i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(args[4])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed4l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(args[4])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed4r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(args[4])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed4d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(args[4])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 5:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed5s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(args[4])],
+				  Mems[O_VALP(args[5])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed5i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(args[4])],
+				  Memi[O_VALP(args[5])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed5l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(args[4])],
+				  Meml[O_VALP(args[5])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed5r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(args[4])],
+				  Memr[O_VALP(args[5])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed5d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(args[4])],
+				  Memd[O_VALP(args[5])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    default:
+		call xvv_error1 ("%s: wrong number of arguments", fcn)
+	    }
+
+	case F_REPL:
+	    # Replicate an item to make a longer vector.
+
+	    chunk = O_LEN(ap)
+	    optype = O_TYPE(ap)
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: replication factor must be a scalar", fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    repl = max (1, O_VALI(args[2]))
+
+	    if (chunk <= 0)
+		nelem = repl
+	    else
+		nelem = chunk * repl
+	    call xvv_initop (out, nelem, optype)
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovs (Mems[ip], Mems[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovi (Memi[ip], Memi[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovl (Meml[ip], Meml[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovr (Memr[ip], Memr[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovd (Memd[ip], Memd[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHIFT:
+	    # Vector shift.
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: shift arg must be a scalar" , fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    shift = O_VALI(args[2])
+
+	    if (abs(shift) > nelem) {
+		if (shift > 0)
+		    shift = nelem
+		else
+		    shift = -nelem
+	    }
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Mems[O_VALP(out)+i-1] = Mems[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALS(out) = (O_VALS(ap))
+
+	    case TY_INT:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memi[O_VALP(out)+i-1] = Memi[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALI(out) = (O_VALI(ap))
+
+	    case TY_LONG:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Meml[O_VALP(out)+i-1] = Meml[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALL(out) = (O_VALL(ap))
+
+	    case TY_REAL:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memr[O_VALP(out)+i-1] = Memr[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALR(out) = (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memd[O_VALP(out)+i-1] = Memd[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALD(out) = (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SORT:
+	    # Sort a vector.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call asrts (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = (O_VALS(ap))
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call asrti (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = (O_VALI(ap))
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call asrtl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = (O_VALL(ap))
+
+	    case TY_REAL:
+		if (nelem > 0)
+		    call asrtr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+		else
+		    O_VALR(out) = (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (nelem > 0)
+		    call asrtd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+		else
+		    O_VALD(out) = (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ATAN, F_ATAN2:
+
+	    if (optype == TY_REAL) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memr[O_VALP(out)+i-1] =
+				atan (Memr[O_VALP(ap)+i-1])
+		    } else
+			O_VALR(out) = atan (O_VALR(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memr[O_VALP(out)+i-1] =
+				atan2 (Memr[O_VALP(args[1])+i-1],
+				       Memr[O_VALP(args[2])+i-1])
+		    } else
+			O_VALR(out) = atan2(O_VALR(args[1]), O_VALR(args[2]))
+		}
+	    }
+
+	    if (optype == TY_DOUBLE) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memd[O_VALP(out)+i-1] =
+				atan (Memd[O_VALP(ap)+i-1])
+		    } else
+			O_VALD(out) = atan (O_VALD(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memd[O_VALP(out)+i-1] =
+				atan2 (Memd[O_VALP(args[1])+i-1],
+				       Memd[O_VALP(args[2])+i-1])
+		    } else
+			O_VALD(out) = atan2(O_VALD(args[1]), O_VALD(args[2]))
+		}
+	    }
+
+
+	case F_MOD:
+	    in1 = args[1]
+	    in2 = args[2]
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(in1) <= 0) {
+		    O_VALS(out) = mod (O_VALS(in1), O_VALS(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodks (Mems[O_VALP(in1)], O_VALS(in2),
+			Mems[O_VALP(out)], nelem)
+		} else {
+		    call amods (Mems[O_VALP(in1)], Mems[O_VALP(in2)],
+			Mems[O_VALP(out)], nelem)
+		}
+
+	    case TY_INT:
+		if (O_LEN(in1) <= 0) {
+		    O_VALI(out) = mod (O_VALI(in1), O_VALI(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodki (Memi[O_VALP(in1)], O_VALI(in2),
+			Memi[O_VALP(out)], nelem)
+		} else {
+		    call amodi (Memi[O_VALP(in1)], Memi[O_VALP(in2)],
+			Memi[O_VALP(out)], nelem)
+		}
+
+	    case TY_LONG:
+		if (O_LEN(in1) <= 0) {
+		    O_VALL(out) = mod (O_VALL(in1), O_VALL(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkl (Meml[O_VALP(in1)], O_VALL(in2),
+			Meml[O_VALP(out)], nelem)
+		} else {
+		    call amodl (Meml[O_VALP(in1)], Meml[O_VALP(in2)],
+			Meml[O_VALP(out)], nelem)
+		}
+
+	    case TY_REAL:
+		if (O_LEN(in1) <= 0) {
+		    O_VALR(out) = mod (O_VALR(in1), O_VALR(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkr (Memr[O_VALP(in1)], O_VALR(in2),
+			Memr[O_VALP(out)], nelem)
+		} else {
+		    call amodr (Memr[O_VALP(in1)], Memr[O_VALP(in2)],
+			Memr[O_VALP(out)], nelem)
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(in1) <= 0) {
+		    O_VALD(out) = mod (O_VALD(in1), O_VALD(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkd (Memd[O_VALP(in1)], O_VALD(in2),
+			Memd[O_VALP(out)], nelem)
+		} else {
+		    call amodd (Memd[O_VALP(in1)], Memd[O_VALP(in2)],
+			Memd[O_VALP(out)], nelem)
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MAX:
+	    switch (optype) {
+
+	    case TY_SHORT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+		    else
+			O_VALS(out) = O_VALS(ap)
+		} else
+		    call amovs (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALS(out) = max (O_VALS(ap), O_VALS(out))
+			else {
+			    call amaxks (Mems[O_VALP(out)], O_VALS(ap),
+				Mems[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxs (Mems[O_VALP(out)], Mems[O_VALP(ap)],
+			    Mems[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+		    else
+			O_VALI(out) = O_VALI(ap)
+		} else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALI(out) = max (O_VALI(ap), O_VALI(out))
+			else {
+			    call amaxki (Memi[O_VALP(out)], O_VALI(ap),
+				Memi[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxi (Memi[O_VALP(out)], Memi[O_VALP(ap)],
+			    Memi[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+		    else
+			O_VALL(out) = O_VALL(ap)
+		} else
+		    call amovl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALL(out) = max (O_VALL(ap), O_VALL(out))
+			else {
+			    call amaxkl (Meml[O_VALP(out)], O_VALL(ap),
+				Meml[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxl (Meml[O_VALP(out)], Meml[O_VALP(ap)],
+			    Meml[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+		    else
+			O_VALR(out) = O_VALR(ap)
+		} else
+		    call amovr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALR(out) = max (O_VALR(ap), O_VALR(out))
+			else {
+			    call amaxkr (Memr[O_VALP(out)], O_VALR(ap),
+				Memr[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxr (Memr[O_VALP(out)], Memr[O_VALP(ap)],
+			    Memr[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+		    else
+			O_VALD(out) = O_VALD(ap)
+		} else
+		    call amovd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALD(out) = max (O_VALD(ap), O_VALD(out))
+			else {
+			    call amaxkd (Memd[O_VALP(out)], O_VALD(ap),
+				Memd[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxd (Memd[O_VALP(out)], Memd[O_VALP(ap)],
+			    Memd[O_VALP(out)], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MIN:
+	    switch (optype) {
+
+	    case TY_SHORT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+		    else
+			O_VALS(out) = O_VALS(ap)
+		} else
+		    call amovs (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALS(out) = min (O_VALS(ap), O_VALS(out))
+			else {
+			    call aminks (Mems[O_VALP(out)], O_VALS(ap),
+				Mems[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amins (Mems[O_VALP(out)], Mems[O_VALP(ap)],
+			    Mems[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+		    else
+			O_VALI(out) = O_VALI(ap)
+		} else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALI(out) = min (O_VALI(ap), O_VALI(out))
+			else {
+			    call aminki (Memi[O_VALP(out)], O_VALI(ap),
+				Memi[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amini (Memi[O_VALP(out)], Memi[O_VALP(ap)],
+			    Memi[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+		    else
+			O_VALL(out) = O_VALL(ap)
+		} else
+		    call amovl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALL(out) = min (O_VALL(ap), O_VALL(out))
+			else {
+			    call aminkl (Meml[O_VALP(out)], O_VALL(ap),
+				Meml[O_VALP(out)], nelem)
+			}
+		    } else {
+			call aminl (Meml[O_VALP(out)], Meml[O_VALP(ap)],
+			    Meml[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+		    else
+			O_VALR(out) = O_VALR(ap)
+		} else
+		    call amovr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALR(out) = min (O_VALR(ap), O_VALR(out))
+			else {
+			    call aminkr (Memr[O_VALP(out)], O_VALR(ap),
+				Memr[O_VALP(out)], nelem)
+			}
+		    } else {
+			call aminr (Memr[O_VALP(out)], Memr[O_VALP(ap)],
+			    Memr[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+		    else
+			O_VALD(out) = O_VALD(ap)
+		} else
+		    call amovd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALD(out) = min (O_VALD(ap), O_VALD(out))
+			else {
+			    call aminkd (Memd[O_VALP(out)], O_VALD(ap),
+				Memd[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amind (Memd[O_VALP(out)], Memd[O_VALP(ap)],
+			    Memd[O_VALP(out)], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_BOOL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_BOOL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ch = O_VALC(ap)
+		O_VALI(out) = btoi (ch == 'y' || ch == 'Y')
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALS(ap) != 0)
+		else {
+		    v_s = 0
+		    call abneks (Mems[O_VALP(ap)], v_s, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALI(ap) != 0)
+		else {
+		    v_i = 0
+		    call abneki (Memi[O_VALP(ap)], v_i, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALL(ap) != 0)
+		else {
+		    v_l = 0
+		    call abnekl (Meml[O_VALP(ap)], v_l, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALR(ap) != 0.0)
+		else {
+		    v_r = 0.0
+		    call abnekr (Memr[O_VALP(ap)], v_r, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALD(ap) != 0.0D0)
+		else {
+		    v_d = 0.0D0
+		    call abnekd (Memd[O_VALP(ap)], v_d, Memi[O_VALP(out)],
+			nelem)
+		}
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHORT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_SHORT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALS(out) = 0
+		else
+		    O_VALS(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALS(ap)
+		else
+		    call achtss (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALL(ap)
+		else
+		    call achtls (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALR(ap)
+		else
+		    call achtrs (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALD(ap)
+		else
+		    call achtds (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_INT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALS(ap)
+		else
+		    call achtsi (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call achtii (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALL(ap)
+		else
+		    call achtli (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALR(ap)
+		else
+		    call achtri (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALD(ap)
+		else
+		    call achtdi (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_LONG:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_LONG)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALL(out) = 0
+		else
+		    O_VALL(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALS(ap)
+		else
+		    call achtsl (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call achtil (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALL(ap)
+		else
+		    call achtll (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALR(ap)
+		else
+		    call achtrl (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALD(ap)
+		else
+		    call achtdl (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_NINT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = nint (v_d)
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALS(ap)
+		else
+		    call achtsi (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call achtii (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALL(ap)
+		else
+		    call achtli (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VALR(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Memr[O_VALP(ap)+i-1])
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VALD(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Memd[O_VALP(ap)+i-1])
+		}
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_REAL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_REAL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALR(out) = 0
+		else
+		    O_VALR(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALS(ap)
+		else
+		    call achtsr (Mems[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALL(ap)
+		else
+		    call achtlr (Meml[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALR(ap)
+		else
+		    call achtrr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALD(ap)
+		else
+		    call achtdr (Memd[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_DOUBLE:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_DOUBLE)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALD(out) = 0
+		else
+		    O_VALD(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALS(ap)
+		else
+		    call achtsd (Mems[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALL(ap)
+		else
+		    call achtld (Meml[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALR(ap)
+		else
+		    call achtrd (Memr[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALD(ap)
+		else
+		    call achtdd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_STR:
+	    optype = TY_CHAR
+	    if (O_TYPE(ap) == TY_CHAR)
+		nelem = strlen (O_VALC(ap))
+	    else
+		nelem = MAX_DIGITS
+	    call xvv_initop (out, nelem, TY_CHAR)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call sprintf (O_VALC(out), nelem, "%b")
+		    call pargi (O_VALI(ap))
+	    case TY_CHAR:
+		call sprintf (O_VALC(out), nelem, "%s")
+		    call pargstr (O_VALC(ap))
+
+	    case TY_SHORT:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargs (O_VALS(ap))
+
+	    case TY_INT:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargi (O_VALI(ap))
+
+	    case TY_LONG:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargl (O_VALL(ap))
+
+
+	    case TY_REAL:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call pargr (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call pargd (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	default:
+	    call xvv_error ("callfcn: unknown function type")
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xvv_freeop (args[i])
+
+	call sfree (sp)
+end
+
+
+# XVV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xvv_startarglist (arg, out)
+
+pointer	arg			#I pointer to first argument, or NULL
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap
+errchk	xvv_initop
+
+begin
+	call xvv_initop (out, LEN_ARGSTRUCT, TY_STRUCT)
+	ap = O_VALP(out)
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XVV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xvv_addarg (arg, arglist, out)
+
+pointer	arg			#I pointer to argument to be added
+pointer	arglist			#I pointer to operand pointing to arglist
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xvv_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XVV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xvv_error1 (fmt, arg)
+
+char	fmt[ARB]		#I printf format string
+char	arg[ARB]		#I string argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xvv_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		#I printf format string
+char	arg1[ARB]		#I string argument
+int	arg2			#I integer argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xvv_error (errmsg)
+
+char	errmsg[ARB]			#I error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XVV_CHTYPE -- Change the datatype of an operand.  The input and output
+# operands may be the same.
+
+procedure xvv_chtype (o1, o2, dtype)
+
+pointer	o1		#I input operand
+pointer	o2		#I output operand
+int	dtype		#I new datatype
+
+short	v_s
+int	v_i
+long	v_l
+real	v_r
+double	v_d
+pointer	vp, ip, op
+bool	float, freeval
+int	old_type, nelem, ch
+
+pointer	coerce()
+int	sizeof(), btoi(), gctod()
+string	s_badtype "chtype: invalid operand type"
+
+begin
+	old_type = O_TYPE(o1)
+	nelem = O_LEN(o1)
+
+	# No type conversion needed?
+	if (old_type == dtype) {
+	    if (o1 != o2) {
+		if (nelem <= 0)
+		    YYMOVE (o1, o2)
+		else {
+		    call xvv_initop (o2, nelem, old_type)
+		    call amovc (O_VALC(o1), O_VALC(o2), nelem * sizeof(dtype))
+		}
+	    }
+	    return
+	}
+
+	if (nelem <= 0) {
+	    # Scalar input operand.
+
+	    O_TYPE(o2) = dtype
+	    O_LEN(o2) = 0
+	    float = false
+
+	    # Read the old value into a local variable of type long or double.
+	    switch (old_type) {
+	    case TY_BOOL:
+		v_l = O_VALI(o1)
+	    case TY_CHAR:
+		v_l = 0  # null string?
+
+	    case TY_SHORT:
+		v_l = O_VALS(o1)
+
+	    case TY_INT:
+		v_l = O_VALI(o1)
+
+	    case TY_LONG:
+		v_l = O_VALL(o1)
+
+
+	    case TY_REAL:
+		v_d = O_VALR(o1)
+		float = true
+
+	    case TY_DOUBLE:
+		v_d = O_VALD(o1)
+		float = true
+
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Set the value of the output operand.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (float)
+		    O_VALI(o2) = btoi (v_d != 0)
+		else
+		    O_VALI(o2) = btoi (v_l != 0)
+	    case TY_CHAR:
+		call xvv_initop (o2, MAX_DIGITS, TY_CHAR)
+		if (float) {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%g")
+			call pargd (v_d)
+		} else {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%d")
+			call pargl (v_l)
+		}
+
+	    case TY_SHORT:
+		if (float)
+		    O_VALS(o2) = v_d
+		else
+		    O_VALS(o2) = v_l
+
+	    case TY_INT:
+		if (float)
+		    O_VALI(o2) = v_d
+		else
+		    O_VALI(o2) = v_l
+
+	    case TY_LONG:
+		if (float)
+		    O_VALL(o2) = v_d
+		else
+		    O_VALL(o2) = v_l
+
+
+	    case TY_REAL:
+		if (float)
+		    O_VALR(o2) = v_d
+		else
+		    O_VALR(o2) = v_l
+
+	    case TY_DOUBLE:
+		if (float)
+		    O_VALD(o2) = v_d
+		else
+		    O_VALD(o2) = v_l
+
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	} else {
+	    # Vector input operand.
+
+	    # Save a pointer to the input operand data vector, to avoid it
+	    # getting clobbered if O1 and O2 are the same operand.
+
+	    vp = O_VALP(o1)
+
+	    # If we have a char string input operand the output numeric
+	    # operand can only be a scalar.  If we have a char string output
+	    # operand nelem is the length of the string.
+
+	    if (old_type == TY_CHAR)
+		nelem = 0
+	    else if (dtype == TY_CHAR)
+		nelem = MAX_DIGITS
+
+	    # Initialize the output operand O2.  The freeval flag is cleared
+	    # cleared to keep the initop from freeing the input operand array,
+	    # inherited when the input operand is copied (or when the input
+	    # and output operands are the same).  We free the old operand
+	    # array manually below.
+
+	    if (o1 != o2)
+		YYMOVE (o1, o2)
+	    freeval = (and (O_FLAGS(o1), O_FREEVAL) != 0)
+	    O_FLAGS(o2) = and (O_FLAGS(o2), not(O_FREEVAL))
+	    call xvv_initop (o2, nelem, dtype)
+
+	    # Write output value.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (old_type == TY_CHAR) {
+		    ch = Memc[vp]
+		    O_VALI(o2) = btoi (ch == 'y' || ch == 'Y')
+		} else {
+		    switch (old_type) {
+
+		    case TY_SHORT:
+			v_s = 0
+			call abneks (Mems[vp], v_s, Memi[O_VALP(o2)], nelem)
+
+		    case TY_INT:
+			v_i = 0
+			call abneki (Memi[vp], v_i, Memi[O_VALP(o2)], nelem)
+
+		    case TY_LONG:
+			v_l = 0
+			call abnekl (Meml[vp], v_l, Memi[O_VALP(o2)], nelem)
+
+		    case TY_REAL:
+			v_r = 0.0
+			call abnekr (Memr[vp], v_r, Memi[O_VALP(o2)], nelem)
+
+		    case TY_DOUBLE:
+			v_d = 0.0D0
+			call abnekd (Memd[vp], v_d, Memi[O_VALP(o2)], nelem)
+
+		    default:
+			call xvv_error (s_badtype)
+		    }
+		}
+
+	    case TY_CHAR:
+		call xvv_error (s_badtype)
+
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		switch (old_type) {
+		case TY_BOOL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+		case TY_CHAR:
+		    ip = vp
+		    if (gctod (Memc, ip, v_d) <= 0)
+			v_d = 0
+		    switch (dtype) {
+
+		    case TY_SHORT:
+			O_VALS(o2) = v_d
+
+		    case TY_INT:
+			O_VALI(o2) = v_d
+
+		    case TY_LONG:
+			O_VALL(o2) = v_d
+
+		    case TY_REAL:
+			O_VALR(o2) = v_d
+
+		    case TY_DOUBLE:
+			O_VALD(o2) = v_d
+
+		    }
+
+		case TY_SHORT:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achts (Mems[vp], Memc[op], nelem, dtype)
+
+		case TY_INT:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+
+		case TY_LONG:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtl (Meml[vp], Memc[op], nelem, dtype)
+
+		case TY_REAL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtr (Memr[vp], Memc[op], nelem, dtype)
+
+		case TY_DOUBLE:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtd (Memd[vp], Memc[op], nelem, dtype)
+
+		default:
+		    call xvv_error (s_badtype)
+		}
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Free old operand value.
+	    if (freeval)
+		call mfree (vp, old_type)
+	}
+end
+
+
+# XVV_INITOP -- Initialize an operand, providing storage for an operand value
+# of the given size and type.
+
+procedure xvv_initop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xvv_makeop (o, o_len, o_type)
+end
+
+
+# XVV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xvv_makeop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    if (o_type == TY_BOOL)
+		call malloc (O_VALP(o), o_len, TY_INT)
+	    else
+		call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+
+	O_FLAGS(o) = O_FREEVAL
+end
+
+
+# XVV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xvv_freeop (o)
+
+pointer	o		#I pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Either free operand struct or clear the operand type to mark
+	# operand invalid.
+
+	if (and (O_FLAGS(o), O_FREEOP) != 0)
+	    call mfree (o, TY_STRUCT)
+	else
+	    O_TYPE(o) = 0
+end
+
+
+# XVV_LOADSYMBOLS -- Load a list of symbol names into a symbol table.  Each
+# symbol is tagged with an integer code corresponding to its sequence number
+# in the symbol list.
+
+pointer procedure xvv_loadsymbols (s)
+
+char	s[ARB]			#I symbol list "|sym1|sym2|...|"
+
+int	delim, symnum, ip
+pointer	sp, symname, st, sym, op
+pointer	stopen(), stenter()
+
+begin
+	call smark (sp)
+	call salloc (symname, SZ_FNAME, TY_CHAR)
+
+	st = stopen ("evvexpr", LEN_INDEX, LEN_STAB, LEN_SBUF)
+	delim = s[1]
+	symnum = 0
+
+	for (ip=2;  s[ip] != EOS;  ip=ip+1) {
+	    op = symname
+	    while (s[ip] != delim && s[ip] != EOS) {
+		Memc[op] = s[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+	    symnum = symnum + 1
+
+	    if (op > symname && IS_ALPHA(Memc[symname])) {
+		sym = stenter (st, Memc[symname], LEN_SYM)
+		SYM_CODE(sym) = symnum
+	    }
+	}
+
+	call sfree (sp)
+	return (st)
+end
+
+
+# XVV_NULL -- Return a null value to be used when a computation cannot be
+# performed and range checking is enabled.  Perhaps we should permit a user
+# specified value here, however this doesn't really work in an expression
+# evaluator since the value generated may be used in subsequent calculations
+# and hence may change.  If more careful treatment of out of range values
+# is needed a conditional expression can be used in which case the value
+# we return here is ignored (but still needed to avoid a hardware exception
+# when computing a vector).
+
+
+short procedure xvv_nulls (ignore)
+short	ignore			#I ignored
+begin
+	return (0)
+end
+
+int procedure xvv_nulli (ignore)
+int	ignore			#I ignored
+begin
+	return (0)
+end
+
+long procedure xvv_nulll (ignore)
+long	ignore			#I ignored
+begin
+	return (0)
+end
+
+real procedure xvv_nullr (ignore)
+real	ignore			#I ignored
+begin
+	return (0.0)
+end
+
+double procedure xvv_nulld (ignore)
+double	ignore			#I ignored
+begin
+	return (0.0D0)
+end
+
+define	YYNPROD		39
+define	YYLAST		303
+# line	1 "/iraf/iraf/lib/yaccpar.x"
+# 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
+
+
+# XVV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall3, xvv_error1, xvv_unop, xvv_binop, xvv_boolop
+errchk	xvv_quest, xvv_callfcn, xvv_addarg
+include	"evvexpr.com"
+
+short	yyexca[96]
+data	(yyexca(i),i=  1,  8)	/  -1,   1,   0,  -1,  -2,   0,  -1,   5/
+data	(yyexca(i),i=  9, 16)	/  40,  33,  -2,   5,  -1,   6,  40,  32/
+data	(yyexca(i),i= 17, 24)	/  -2,   6,  -1,  76, 269,   0, 270,   0/
+data	(yyexca(i),i= 25, 32)	/ 271,   0, 283,   0,  -2,  22,  -1,  77/
+data	(yyexca(i),i= 33, 40)	/ 269,   0, 270,   0, 271,   0, 283,   0/
+data	(yyexca(i),i= 41, 48)	/  -2,  23,  -1,  78, 269,   0, 270,   0/
+data	(yyexca(i),i= 49, 56)	/ 271,   0, 283,   0,  -2,  24,  -1,  79/
+data	(yyexca(i),i= 57, 64)	/ 269,   0, 270,   0, 271,   0, 283,   0/
+data	(yyexca(i),i= 65, 72)	/  -2,  25,  -1,  80, 272,   0, 273,   0/
+data	(yyexca(i),i= 73, 80)	/ 274,   0,  -2,  26,  -1,  81, 272,   0/
+data	(yyexca(i),i= 81, 88)	/ 273,   0, 274,   0,  -2,  27,  -1,  82/
+data	(yyexca(i),i= 89, 96)	/ 272,   0, 273,   0, 274,   0,  -2,  28/
+short	yyact[303]
+data	(yyact(i),i=  1,  8)	/  15,  16,  17,  18,  19,  20,  33,  86/
+data	(yyact(i),i=  9, 16)	/  26,  27,  28,  30,  32,  31,  21,  22/
+data	(yyact(i),i= 17, 24)	/  62,  23,  24,  25,  19,  34,  29,  15/
+data	(yyact(i),i= 25, 32)	/  16,  17,  18,  19,  20,  33,  38,  26/
+data	(yyact(i),i= 33, 40)	/  27,  28,  30,  32,  31,  21,  22,  60/
+data	(yyact(i),i= 41, 48)	/  23,  24,  25,  12,  11,  29,  15,  16/
+data	(yyact(i),i= 49, 56)	/  17,  18,  19,  20,  12,   2,  26,  27/
+data	(yyact(i),i= 57, 64)	/  28,  30,  32,  31,  12,   1,   0,  23/
+data	(yyact(i),i= 65, 72)	/  24,  25,   0,  14,  29,  15,  16,  17/
+data	(yyact(i),i= 73, 80)	/  18,  19,  20,   0,   0,  26,  27,  28/
+data	(yyact(i),i= 81, 88)	/  30,  32,  31,   0,  15,  16,  17,  18/
+data	(yyact(i),i= 89, 96)	/  19,  20,   0,  29,  26,  27,  28,  15/
+data	(yyact(i),i= 97,104)	/  16,  17,  18,  19,  20,  15,  16,  17/
+data	(yyact(i),i=105,112)	/  18,  19,  29,  17,  18,  19,   4,   0/
+data	(yyact(i),i=113,120)	/  84,   0,  40,  85,   0,   0,   0,  35/
+data	(yyact(i),i=121,128)	/  36,  37,   0,  39,   0,   0,   0,   0/
+data	(yyact(i),i=129,136)	/   0,   0,  41,  42,  43,  44,  45,  46/
+data	(yyact(i),i=137,144)	/  47,  48,  49,  50,  51,  52,  53,  54/
+data	(yyact(i),i=145,152)	/  55,  56,  57,  58,  59,  61,   0,  63/
+data	(yyact(i),i=153,160)	/  65,  66,  67,  68,  69,  70,  71,  72/
+data	(yyact(i),i=161,168)	/  73,  74,  75,  76,  77,  78,  79,  80/
+data	(yyact(i),i=169,176)	/  81,  82,  83,   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,  89,  90/
+data	(yyact(i),i=201,208)	/  87,  88,   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,   0,   0,   0,   0,   0,   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,  15,  16,  17,  18/
+data	(yyact(i),i=241,248)	/  19,  20,  33,   0,  26,  27,  28,  30/
+data	(yyact(i),i=249,256)	/  32,  31,  21,  22,   0,  23,  24,  25/
+data	(yyact(i),i=257,264)	/   0,   0,  29,   0,   5,   6,  64,   0/
+data	(yyact(i),i=265,272)	/   0,   8,   0,   0,   3,   5,   6,   0/
+data	(yyact(i),i=273,280)	/   0,   0,   8,   0,   0,   5,   6,   0/
+data	(yyact(i),i=281,288)	/   9,   0,   8,  13,  10,   7,   0,   0/
+data	(yyact(i),i=289,296)	/   0,   9,   0,   0,   0,  10,   7,   0/
+data	(yyact(i),i=297,303)	/   0,   9,   0,   0,   0,  10,   7/
+short	yypact[91]
+data	(yypact(i),i=  1,  8)	/  12,-1000,  23,-1000,-238,-1000,-1000,-236/
+data	(yypact(i),i=  9, 16)	/  20,  20,  20, -10,  20,-1000,-1000,-1000/
+data	(yypact(i),i= 17, 24)	/-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000/
+data	(yypact(i),i= 25, 32)	/-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000/
+data	(yypact(i),i= 33, 40)	/-1000,-1000,-1000,-245,-245,-245,  20, -25/
+data	(yypact(i),i= 41, 48)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yypact(i),i= 49, 56)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yypact(i),i= 57, 64)	/   3,   3,   3,   3,  71,-238,-1000,-238/
+data	(yypact(i),i= 65, 72)	/-1000,-156,-156,-245,-245,-1000,-160,-215/
+data	(yypact(i),i= 73, 80)	/-215,-192,-192,-192,-166,-166,-166,-166/
+data	(yypact(i),i= 81, 88)	/-177,-177,-177,-261,-1000,-1000,-1000,   3/
+data	(yypact(i),i= 89, 91)	/   3,-238,-238/
+short	yypgo[7]
+data	(yypgo(i),i=  1,  7)	/   0,  61,  53, 110, 114,  44,  39/
+short	yyr1[39]
+data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   2,   2,   3,   3,   3/
+data	(yyr1(i),i=  9, 16)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr1(i),i= 17, 24)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr1(i),i= 25, 32)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr1(i),i= 33, 39)	/   5,   5,   6,   6,   6,   4,   4/
+short	yyr2[39]
+data	(yyr2(i),i=  1,  8)	/   0,   2,   1,   1,   4,   1,   1,   2/
+data	(yyr2(i),i=  9, 16)	/   2,   2,   2,   4,   4,   4,   4,   4/
+data	(yyr2(i),i= 17, 24)	/   4,   4,   4,   4,   4,   4,   4,   4/
+data	(yyr2(i),i= 25, 32)	/   4,   4,   4,   4,   4,   7,   4,   3/
+data	(yyr2(i),i= 33, 39)	/   1,   1,   0,   1,   4,   0,   2/
+short	yychk[91]
+data	(yychk(i),i=  1,  8)	/-1000,  -1,  -2, 256,  -3, 257, 258, 282/
+data	(yychk(i),i=  9, 16)	/ 262, 277, 281,  -5,  40, 260,  44, 261/
+data	(yychk(i),i= 17, 24)	/ 262, 263, 264, 265, 266, 275, 276, 278/
+data	(yychk(i),i= 25, 32)	/ 279, 280, 269, 270, 271, 283, 272, 274/
+data	(yychk(i),i= 33, 40)	/ 273, 267, 257,  -3,  -3,  -3,  40,  -3/
+data	(yychk(i),i= 41, 48)	/  -4,  -4,  -4,  -4,  -4,  -4,  -4,  -4/
+data	(yychk(i),i= 49, 56)	/  -4,  -4,  -4,  -4,  -4,  -4,  -4,  -4/
+data	(yychk(i),i= 57, 64)	/  -4,  -4,  -4,  -4,  -6,  -3,  41,  -3/
+data	(yychk(i),i= 65, 72)	/ 259,  -3,  -3,  -3,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 73, 80)	/  -3,  -3,  -3,  -3,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 81, 88)	/  -3,  -3,  -3,  -3,  41,  44, 268,  -4/
+data	(yychk(i),i= 89, 91)	/  -4,  -3,  -3/
+short	yydef[91]
+data	(yydef(i),i=  1,  8)	/   0,  -2,   0,   2,   3,  -2,  -2,   0/
+data	(yydef(i),i=  9, 16)	/   0,   0,   0,   0,   0,   1,  37,  37/
+data	(yydef(i),i= 17, 24)	/  37,  37,  37,  37,  37,  37,  37,  37/
+data	(yydef(i),i= 25, 32)	/  37,  37,  37,  37,  37,  37,  37,  37/
+data	(yydef(i),i= 33, 40)	/  37,  37,   7,   8,   9,  10,  34,   0/
+data	(yydef(i),i= 41, 48)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 49, 56)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 57, 64)	/   0,   0,   0,   0,   0,  35,  31,   4/
+data	(yydef(i),i= 65, 72)	/  38,  11,  12,  13,  14,  15,  16,  17/
+data	(yydef(i),i= 73, 80)	/  18,  19,  20,  21,  -2,  -2,  -2,  -2/
+data	(yydef(i),i= 81, 88)	/  -2,  -2,  -2,   0,  30,  37,  37,   0/
+data	(yydef(i),i= 89, 91)	/   0,  36,  29/
+
+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) {
+	    
+case 1:
+# line 266 "evvexpr.y"
+{
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE (yypvt-YYOPLEN, ev_oval)
+			call sfree (yysp)
+			return (OK)
+		}
+case 2:
+# line 275 "evvexpr.y"
+{
+			call error (1, "syntax error")
+		}
+case 3:
+# line 280 "evvexpr.y"
+{
+			YYMOVE (yypvt, yyval)
+		}
+case 4:
+# line 283 "evvexpr.y"
+{
+			YYMOVE (yypvt, yyval)
+			call xvv_freeop (yypvt-3*YYOPLEN)
+		}
+case 5:
+# line 289 "evvexpr.y"
+{
+			# Numeric constant.
+			YYMOVE (yypvt, yyval)
+		    }
+case 6:
+# line 293 "evvexpr.y"
+{
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xvv_initop (yyval, 0, TY_BOOL)
+			if (streq (O_VALC(yypvt), "yes")) {
+			    O_VALI(yyval) = YES
+			} else if (streq (O_VALC(yypvt), "no")) {
+			    O_VALI(yyval) = NO
+			} else if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC(yypvt), yyval)
+			    if (O_TYPE(yyval) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC(yypvt))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC(yypvt))
+			call xvv_freeop (yypvt)
+		    }
+case 7:
+# line 311 "evvexpr.y"
+{
+			# e.g., @"param"
+			if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC(yypvt), yyval)
+			    if (O_TYPE(yyval) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC(yypvt-YYOPLEN))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC(yypvt))
+			call xvv_freeop (yypvt)
+		    }
+case 8:
+# line 322 "evvexpr.y"
+{
+			# Unary arithmetic minus.
+			call xvv_unop (MINUS, yypvt, yyval)
+		    }
+case 9:
+# line 326 "evvexpr.y"
+{
+			# Logical not.
+			call xvv_unop (LNOT, yypvt, yyval)
+		    }
+case 10:
+# line 330 "evvexpr.y"
+{
+			# Boolean not.
+			call xvv_unop (BNOT, yypvt, yyval)
+		    }
+case 11:
+# line 334 "evvexpr.y"
+{
+			# Addition.
+			call xvv_binop (PLUS, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 12:
+# line 338 "evvexpr.y"
+{
+			# Subtraction.
+			call xvv_binop (MINUS, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 13:
+# line 342 "evvexpr.y"
+{
+			# Multiplication.
+			call xvv_binop (STAR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 14:
+# line 346 "evvexpr.y"
+{
+			# Division.
+			call xvv_binop (SLASH, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 15:
+# line 350 "evvexpr.y"
+{
+			# Exponentiation.
+			call xvv_binop (EXPON, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 16:
+# line 354 "evvexpr.y"
+{
+			# Concatenate two operands.
+			call xvv_binop (CONCAT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 17:
+# line 358 "evvexpr.y"
+{
+			# Logical and.
+			call xvv_boolop (LAND, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 18:
+# line 362 "evvexpr.y"
+{
+			# Logical or.
+			call xvv_boolop (LOR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 19:
+# line 366 "evvexpr.y"
+{
+			# Boolean and.
+			call xvv_binop (BAND, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 20:
+# line 370 "evvexpr.y"
+{
+			# Boolean or.
+			call xvv_binop (BOR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 21:
+# line 374 "evvexpr.y"
+{
+			# Boolean xor.
+			call xvv_binop (BXOR, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 22:
+# line 378 "evvexpr.y"
+{
+			# Boolean less than.
+			call xvv_boolop (LT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 23:
+# line 382 "evvexpr.y"
+{
+			# Boolean greater than.
+			call xvv_boolop (GT, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 24:
+# line 386 "evvexpr.y"
+{
+			# Boolean less than or equal.
+			call xvv_boolop (LE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 25:
+# line 390 "evvexpr.y"
+{
+			# Boolean greater than or equal.
+			call xvv_boolop (GE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 26:
+# line 394 "evvexpr.y"
+{
+			# Boolean equal.
+			call xvv_boolop (EQ, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 27:
+# line 398 "evvexpr.y"
+{
+			# String pattern-equal.
+			call xvv_boolop (SE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 28:
+# line 402 "evvexpr.y"
+{
+			# Boolean not equal.
+			call xvv_boolop (NE, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 29:
+# line 406 "evvexpr.y"
+{
+			# Conditional expression.
+			call xvv_quest (yypvt-6*YYOPLEN, yypvt-3*YYOPLEN, yypvt, yyval)
+		    }
+case 30:
+# line 410 "evvexpr.y"
+{
+			# Call an intrinsic or external function.
+			ap = O_VALP(yypvt-YYOPLEN)
+			call xvv_callfcn (O_VALC(yypvt-3*YYOPLEN),
+			    A_ARGP(ap,1), A_NARGS(ap), yyval)
+			call xvv_freeop (yypvt-3*YYOPLEN)
+			call xvv_freeop (yypvt-YYOPLEN)
+		    }
+case 31:
+# line 418 "evvexpr.y"
+{
+			YYMOVE (yypvt-YYOPLEN, yyval)
+		    }
+case 32:
+# line 424 "evvexpr.y"
+{
+			YYMOVE (yypvt, yyval)
+		    }
+case 33:
+# line 427 "evvexpr.y"
+{
+			if (O_TYPE(yypvt) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE (yypvt, yyval)
+		    }
+case 34:
+# line 435 "evvexpr.y"
+{
+			# Empty.
+			call xvv_startarglist (NULL, yyval)
+		    }
+case 35:
+# line 439 "evvexpr.y"
+{
+			# First arg; start a nonnull list.
+			call xvv_startarglist (yypvt, yyval)
+		    }
+case 36:
+# line 443 "evvexpr.y"
+{
+			# Add an argument to an existing list.
+			call xvv_addarg (yypvt, yypvt-3*YYOPLEN, yyval)
+		    }	}
+
+	goto yystack_				# stack new state and value
+end
diff --git a/sys/fmtio/evvexpr.y b/sys/fmtio/evvexpr.y
new file mode 100644
index 00000000..d6efa629
--- /dev/null
+++ b/sys/fmtio/evvexpr.y
@@ -0,0 +1,4644 @@
+%{
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math.h>
+include	<evvexpr.h>
+
+.help evvexpr
+.nf --------------------------------------------------------------------------
+EVVEXPR.GY -- Generic XYacc source for a general vector expression evaluator.
+
+	    o = evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+		evvfree (o)
+
+Client callbacks:
+
+	          getop (client_data, opname, out)
+	           ufcn (client_data, fcn, args, nargs, out)
+
+here "out" is the output operand returned to EVVEXPR.  Client_data is any
+arbitrary integer or pointer value passed in to EVVEXPR when by the client
+when the callback was registered.  "args" is an array of operand structs,
+the arguments for the user function being called.  If the operand or
+function call cannot be completed normally an error exit may be made (call
+error) or an invalid operand may be returned (O_TYPE set to 0).  The client
+should not free the "args" input operands, this will be handled by EVVEXPR.
+
+Operand struct (lib$evvexpr.h):
+
+	struct operand {
+		int	O_TYPE			# operand type (bcsilrd)
+		int	O_LEN			# operand length (0=scalar)
+		int	O_FLAGS			# O_FREEVAL, O_FREEOP
+		union {
+			char*	O_VALC		# string
+			short	O_VALS
+			int	O_VALI		# int or bool
+			long	O_VALL
+			real	O_VALR
+			double	O_VALD
+			pointer	O_VALP		# vector data
+		}
+	}
+
+The macro O_VALC references the string value of a TY_CHAR operand.  The
+flags are O_FREEVAL and O_FREEOP, which tell EVVEXPR and EVVFREE whether or
+not to free any vector operand array or the operand struct when the operand
+is freed.  The client should set these flags on operands returned to EVVEXPR
+if it wants EVVEXPR to free any operand storage.
+
+Supported types are bool, char (string), and SILRD.  Bool is indicated as
+TY_BOOL in the O_TYPE field of the operand struct, but is stored internally
+as an integer and the value field of a boolean operand is given by O_VALI.
+
+Operands may be either scalars or vectors.  A vector is indicated by a O_LEN
+value greater than zero.  For vector operands O_VALP points to the data array.
+A special case is TY_CHAR (string), in which case O_LEN is the allocated
+length of the EOS-terminated string.  A string is logically a scalar value
+even though it is physically stored in the operand as a character vector.
+
+The trig functions operate upon angles in units of radians.  The intrinsic
+functions RAD and DEG are available for converting between radians and
+degrees.  A string can be coerced to a binary value and vice versa, using
+the INT, STR, etc. intrinsic functions.
+
+This is a generalization of the older EVEXPR routine, adding additional
+datatypes, support for vector operands, and numerous minor enhancements.
+.endhelp ---------------------------------------------------------------------
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	17		# max args in a function call
+define	yyparse		xvv_parse
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	LEN_STAB	300		# for symbol table
+define	LEN_SBUF	256
+define	LEN_INDEX	97
+
+define	LEN_SYM		1		# symbol data
+define	SYM_CODE	Memi[$1]
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|cosh|deg|double|\
+			 |exp|hiv|int|len|log|log10|long|lov|max|mean|median|\
+			 |min|mod|nint|rad|real|repl|stddev|shift|short|sin|\
+			 |sinh|sort|sqrt|str|sum|tan|tanh|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_COSH		08
+define	F_DEG		09		# radians to degrees
+define	F_DOUBLE	10
+	# newline	11
+define	F_EXP		12
+define	F_HIV		13		# high value
+define	F_INT		14
+define	F_LEN		15		# vector length
+define	F_LOG		16
+define	F_LOG10		17
+define	F_LONG		18
+define	F_LOV		19		# low value
+define	F_MAX		20
+define	F_MEAN		21
+define	F_MEDIAN	22
+	# newline	23
+define	F_MIN		24
+define	F_MOD		25
+define	F_NINT		26
+define	F_RAD		27		# degrees to radians
+define	F_REAL		28
+define	F_REPL		29		# replicate
+define	F_STDDEV	30		# standard deviation
+define	F_SHIFT		31
+define	F_SHORT		32
+define	F_SIN		33
+	# newline	34
+define	F_SINH		35
+define	F_SORT		36		# sort
+define	F_SQRT		37		# square root
+define	F_STR		38
+define	F_SUM		39
+define	F_TAN 		40
+define	F_TANH 		41
+
+define	T_B		TY_BOOL
+define	T_C		TY_CHAR
+define	T_S		TY_SHORT
+define	T_I		TY_INT
+define	T_L		TY_LONG
+define	T_R		TY_REAL
+define	T_D		TY_DOUBLE
+
+
+# EVVEXPR -- Evaluate a general mixed type vector expression.  Input consists
+# of the expression to be evaluated (a string) and, optionally, user
+# procedures for fetching external operands and executing external functions.
+# Output is a pointer to an operand structure containing the computed value of
+# the expression.  The output operand structure is dynamically allocated by
+# EVVEXPR and must be freed by the user.
+# 
+# NOTE: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.  The main
+# inefficiency is that, since compilation and execution are not broken out as
+# separate steps, when the routine is repeatedly called to evaluate the same
+# expression with different data, all the compile time computation (parsing
+# etc.) has to be repeated.
+
+pointer procedure evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+
+char	expr[ARB]		#I expression to be evaluated
+int	getop			#I user supplied get operand procedure
+int	getop_data		#I client data for above function
+int	ufcn			#I user supplied function call procedure
+int	ufcn_data		#I client data for above function
+int	flags			#I flag bits
+
+int	junk
+pointer	sp, ip
+bool	debug, first_time
+int	strlen(), xvv_parse()
+pointer	xvv_loadsymbols()
+extern	xvv_gettok()
+
+errchk	xvv_parse, calloc
+include	"evvexpr.com"
+data	debug /false/
+data	first_time /true/
+
+begin
+	call smark (sp)
+
+	if (first_time) {
+	    # This creates data which remains for the life of the process.
+	    ev_st = xvv_loadsymbols (KEYWORDS)
+	    first_time = false
+	}
+
+	# Set user function entry point addresses.
+	ev_getop = getop
+	ev_getop_data = getop_data
+	ev_ufcn = ufcn
+	ev_ufcn_data = ufcn_data
+	ev_flags = flags
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XVV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xvv_parse (ip, debug, xvv_gettok)
+	O_FLAGS(ev_oval) = or (O_FLAGS(ev_oval), O_FREEOP)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+
+# EVVFREE -- Free an operand struct such as is returned by EVVEXPR.
+
+procedure evvfree (o)
+
+pointer	o			# operand struct
+
+begin
+	call xvv_freeop (o)
+end
+
+%L
+# XVV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall3, xvv_error1, xvv_unop, xvv_binop, xvv_boolop
+errchk	xvv_quest, xvv_callfcn, xvv_addarg
+include	"evvexpr.com"
+
+%}
+
+# The $/ following causes the generic preprocessor to pass this block of code
+# through unchanged.
+
+
+
+%token		CONSTANT IDENTIFIER NEWLINE YYEOS
+%token		PLUS MINUS STAR SLASH EXPON CONCAT QUEST COLON
+%token		LT GT LE GT EQ NE SE LAND LOR LNOT BAND BOR BXOR BNOT AT
+
+%nonassoc	QUEST
+%left		LAND LOR
+%left		BAND BOR BXOR
+%nonassoc	EQ NE SE
+%nonassoc	LT GT LE GE
+%left		CONCAT
+%left		PLUS MINUS
+%left		STAR SLASH
+%right		UMINUS LNOT BNOT
+%left		EXPON
+%right		AT
+
+%%
+
+stmt	:	exprlist YYEOS {
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE ($1, ev_oval)
+			call sfree (yysp)
+			return (OK)
+		}
+	|	error {
+			call error (1, "syntax error")
+		}
+	;
+
+exprlist:	expr {
+			YYMOVE ($1, $$)
+		}
+	|	exprlist ',' opnl expr {
+			YYMOVE ($4, $$)
+			call xvv_freeop ($1)
+		}
+
+
+expr	:	CONSTANT {
+			# Numeric constant.
+			YYMOVE ($1, $$)
+		    }
+	|	IDENTIFIER {
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xvv_initop ($$, 0, TY_BOOL)
+			if (streq (O_VALC($1), "yes")) {
+			    O_VALI($$) = YES
+			} else if (streq (O_VALC($1), "no")) {
+			    O_VALI($$) = NO
+			} else if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($1), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($1))
+			call xvv_freeop ($1)
+		    }
+	|	AT CONSTANT {
+			# e.g., @"param"
+			if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($2), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($2))
+			call xvv_freeop ($2)
+		    }
+	|	MINUS expr %prec UMINUS {
+			# Unary arithmetic minus.
+			call xvv_unop (MINUS, $2, $$)
+		    }
+	|	LNOT expr {
+			# Logical not.
+			call xvv_unop (LNOT, $2, $$)
+		    }
+	|	BNOT expr {
+			# Boolean not.
+			call xvv_unop (BNOT, $2, $$)
+		    }
+	|	expr PLUS opnl expr {
+			# Addition.
+			call xvv_binop (PLUS, $1, $4, $$)
+		    }
+	|	expr MINUS opnl expr {
+			# Subtraction.
+			call xvv_binop (MINUS, $1, $4, $$)
+		    }
+	| 	expr STAR opnl expr {
+			# Multiplication.
+			call xvv_binop (STAR, $1, $4, $$)
+		    }
+	|	expr SLASH opnl expr {
+			# Division.
+			call xvv_binop (SLASH, $1, $4, $$)
+		    }
+	|	expr EXPON opnl expr {
+			# Exponentiation.
+			call xvv_binop (EXPON, $1, $4, $$)
+		    }
+	|	expr CONCAT opnl expr {
+			# Concatenate two operands.
+			call xvv_binop (CONCAT, $1, $4, $$)
+		    }
+	|	expr LAND opnl expr {
+			# Logical and.
+			call xvv_boolop (LAND, $1, $4, $$)
+		    }
+	|	expr LOR opnl expr {
+			# Logical or.
+			call xvv_boolop (LOR, $1, $4, $$)
+		    }
+	|	expr BAND opnl expr {
+			# Boolean and.
+			call xvv_binop (BAND, $1, $4, $$)
+		    }
+	|	expr BOR opnl expr {
+			# Boolean or.
+			call xvv_binop (BOR, $1, $4, $$)
+		    }
+	|	expr BXOR opnl expr {
+			# Boolean xor.
+			call xvv_binop (BXOR, $1, $4, $$)
+		    }
+	|	expr LT opnl expr {
+			# Boolean less than.
+			call xvv_boolop (LT, $1, $4, $$)
+		    }
+	|	expr GT opnl expr {
+			# Boolean greater than.
+			call xvv_boolop (GT, $1, $4, $$)
+		    }
+	|	expr LE opnl expr {
+			# Boolean less than or equal.
+			call xvv_boolop (LE, $1, $4, $$)
+		    }
+	|	expr GE opnl expr {
+			# Boolean greater than or equal.
+			call xvv_boolop (GE, $1, $4, $$)
+		    }
+	|	expr EQ opnl expr {
+			# Boolean equal.
+			call xvv_boolop (EQ, $1, $4, $$)
+		    }
+	|	expr SE opnl expr {
+			# String pattern-equal.
+			call xvv_boolop (SE, $1, $4, $$)
+		    }
+	|	expr NE opnl expr {
+			# Boolean not equal.
+			call xvv_boolop (NE, $1, $4, $$)
+		    }
+	|	expr QUEST opnl expr COLON opnl expr {
+			# Conditional expression.
+			call xvv_quest ($1, $4, $7, $$)
+		    }
+	|	funct '(' arglist ')' {
+			# Call an intrinsic or external function.
+			ap = O_VALP($3)
+			call xvv_callfcn (O_VALC($1),
+			    A_ARGP(ap,1), A_NARGS(ap), $$)
+			call xvv_freeop ($1)
+			call xvv_freeop ($3)
+		    }
+	|	'(' expr ')' {
+			YYMOVE ($2, $$)
+		    }
+	;
+
+
+funct	:	IDENTIFIER {
+			YYMOVE ($1, $$)
+		    }
+	|	CONSTANT {
+			if (O_TYPE($1) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE ($1, $$)
+		    }
+	;
+
+
+arglist	:	{
+			# Empty.
+			call xvv_startarglist (NULL, $$)
+		    }
+	|	expr {
+			# First arg; start a nonnull list.
+			call xvv_startarglist ($1, $$)
+		    }
+	|	arglist ',' opnl expr {
+			# Add an argument to an existing list.
+			call xvv_addarg ($4, $1, $$)
+		    }
+	;
+
+
+opnl	:	# Empty.
+	|	opnl NEWLINE
+	;
+
+%%
+
+# End generic preprocessor escape.
+
+
+
+# XVV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xvv_unop (opcode, in, out)
+
+int	opcode			#I operation to be performed
+pointer	in			#I input operand
+pointer	out			#I output operand
+
+short	val_s
+long	val_l
+int	val_i, nelem
+errchk	xvv_error, xvv_initop
+string	s_badswitch "unop: bad switch"
+
+begin
+	nelem = O_LEN(in)
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xvv_error ("negation of a nonarithmetic operand")
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call anegs (Mems[O_VALP(in)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = -O_VALS(in)
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call anegi (Memi[O_VALP(in)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = -O_VALI(in)
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call anegl (Meml[O_VALP(in)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = -O_VALL(in)
+
+	    case TY_REAL:
+		if (nelem > 0)
+		    call anegr (Memr[O_VALP(in)], Memr[O_VALP(out)], nelem)
+		else
+		    O_VALR(out) = -O_VALR(in)
+
+	    case TY_DOUBLE:
+		if (nelem > 0)
+		    call anegd (Memd[O_VALP(in)], Memd[O_VALP(out)], nelem)
+		else
+		    O_VALD(out) = -O_VALD(in)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case LNOT:
+	    # Logical NOT.
+
+	    call xvv_initop (out, nelem, TY_BOOL)
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		if (nelem > 0)
+		    call abeqki (Memi[O_VALP(in)], NO, Memi[O_VALP(out)], nelem)
+		else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+
+	    case TY_SHORT:
+		if (nelem > 0) {
+		    val_s = NO
+		    call abeqks (Mems[O_VALP(in)], val_s, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALS(in) == NO)
+			O_VALS(out) = YES
+		    else
+			O_VALS(out) = NO
+		}
+
+	    case TY_INT:
+		if (nelem > 0) {
+		    val_i = NO
+		    call abeqki (Memi[O_VALP(in)], val_i, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+
+	    case TY_LONG:
+		if (nelem > 0) {
+		    val_l = NO
+		    call abeqkl (Meml[O_VALP(in)], val_l, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VALL(in) == NO)
+			O_VALL(out) = YES
+		    else
+			O_VALL(out) = NO
+		}
+
+	    case TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("not of a nonlogical")
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case BNOT:
+	    # Bitwise boolean NOT.
+
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("boolean not of a noninteger operand")
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call anots (Mems[O_VALP(in)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = not(O_VALS(in))
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call anoti (Memi[O_VALP(in)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = not(O_VALI(in))
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call anotl (Meml[O_VALP(in)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = not(O_VALL(in))
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+
+	call xvv_freeop (in)
+end
+
+
+# XVV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xvv_binop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+
+short	v_s
+short	xvv_nulls()
+extern	xvv_nulls()
+
+int	v_i
+int	xvv_nulli()
+extern	xvv_nulli()
+
+long	v_l
+long	xvv_nulll()
+extern	xvv_nulll()
+
+real	v_r
+real	xvv_nullr()
+extern	xvv_nullr()
+
+double	v_d
+double	xvv_nulld()
+extern	xvv_nulld()
+
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+include	"evvexpr.com"
+
+int	xvv_newtype(), strlen()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badswitch "binop: bad case in switch"
+string	s_boolop "binop: bitwise boolean operands must be an integer type"
+define	done_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xvv_error ("binop: operation illegal for boolean operands")
+	case TY_CHAR:
+	    nelem = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	default:
+	    if (opcode == CONCAT)
+		nelem = max (1, O_LEN(in1)) + max (1, O_LEN(in2))
+	    else {
+		if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		    nelem = min (O_LEN(in1), O_LEN(in2))
+		else if (O_LEN(in1) > 0)
+		    nelem = O_LEN(in1)
+		else if (O_LEN(in2) > 0)
+		    nelem = O_LEN(in2)
+		else
+		    nelem = 0
+	    }
+	}
+
+	# Convert input operands to desired type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case PLUS:
+		# Swap operands.
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+	    case CONCAT:
+		; # Do nothing
+
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+
+		case TY_SHORT:
+		    v_s = O_VALS(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovks (v_s, Mems[O_VALP(in1)], nelem)
+
+		case TY_INT:
+		    v_i = O_VALI(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovki (v_i, Memi[O_VALP(in1)], nelem)
+
+		case TY_LONG:
+		    v_l = O_VALL(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkl (v_l, Meml[O_VALP(in1)], nelem)
+
+		case TY_REAL:
+		    v_r = O_VALR(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkr (v_r, Memr[O_VALP(in1)], nelem)
+
+		case TY_DOUBLE:
+		    v_d = O_VALD(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkd (v_d, Memd[O_VALP(in1)], nelem)
+
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, dtype)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# The bitwise boolean binary operators a special case since only the
+	# integer datatypes are permitted.  Otherwise the bitwise booleans
+	# are just like arithmetic booleans.
+
+	if (opcode == BAND || opcode == BOR || opcode == BXOR) {
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALS(out) = and (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call aandks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call aands (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALS(out) = or (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call aborks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call abors (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALS(out) = xor (O_VALS(in1), O_VALS(in2))
+		    } else if (len2 <= 0) {
+			call axorks (Mems[p1], O_VALS(in2),
+			    Mems[po], nelem)
+		    } else {
+			call axors (Mems[p1], Mems[p2],
+			    Mems[po], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALI(out) = and (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call aandki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call aandi (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALI(out) = or (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call aborki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call abori (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALI(out) = xor (O_VALI(in1), O_VALI(in2))
+		    } else if (len2 <= 0) {
+			call axorki (Memi[p1], O_VALI(in2),
+			    Memi[po], nelem)
+		    } else {
+			call axori (Memi[p1], Memi[p2],
+			    Memi[po], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VALL(out) = and (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call aandkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call aandl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VALL(out) = or (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call aborkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call aborl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VALL(out) = xor (O_VALL(in1), O_VALL(in2))
+		    } else if (len2 <= 0) {
+			call axorkl (Meml[p1], O_VALL(in2),
+			    Meml[po], nelem)
+		    } else {
+			call axorl (Meml[p1], Meml[p2],
+			    Meml[po], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error (s_boolop)
+	    }
+
+	    goto done_
+	}
+
+	# Perform an arithmetic binary operation.
+	switch (dtype) {
+	case TY_CHAR:
+	    switch (opcode) {
+	    case CONCAT:
+		call strcpy (O_VALC(in1), O_VALC(out), ARB)
+		call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    default:
+		call xvv_error ("binop: operation illegal for string operands")
+	    }
+
+	case TY_SHORT:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALS(out) = O_VALS(in1) + O_VALS(in2)
+		} else if (len2 <= 0) {
+		    call aaddks (Mems[p1], O_VALS(in2),
+			Mems[po], nelem)
+		} else {
+		    call aadds (Mems[p1], Mems[p2],
+			Mems[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) - O_VALS(in2)
+		else if (len2 <= 0)
+		    call asubks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call asubs (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) * O_VALS(in2)
+		else if (len2 <= 0)
+		    call amulks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call amuls (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALS(out) = O_VALS(in1) / O_VALS(in2)
+		    else if (len2 <= 0)
+			call adivks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		    else
+			call adivs (Mems[p1], Mems[p2], Mems[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALS(in2) == 0)
+			    O_VALS(out) = xvv_nulls(0)
+			else
+			    O_VALS(out) = O_VALS(in1) / O_VALS(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALS(in2) == 0)
+			    call amovks (xvv_nulls(0), Mems[po], nelem)
+			else {
+			    call adivks (Mems[p1], O_VALS(in2), Mems[po],
+				nelem)
+			}
+		    } else {
+			call advzs (Mems[p1], Mems[p2], Mems[po], nelem,
+			    xvv_nulls)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALS(out) = O_VALS(in1) ** O_VALS(in2)
+		else if (len2 <= 0)
+		    call aexpks (Mems[p1], O_VALS(in2), Mems[po], nelem)
+		else
+		    call aexps (Mems[p1], Mems[p2], Mems[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Mems[po] = O_VALS(in1)
+		    po = po + 1
+		} else {
+		    call amovs (Mems[p1], Mems[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Mems[po] = O_VALS(in2)
+		else
+		    call amovs (Mems[p2], Mems[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_INT:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALI(out) = O_VALI(in1) + O_VALI(in2)
+		} else if (len2 <= 0) {
+		    call aaddki (Memi[p1], O_VALI(in2),
+			Memi[po], nelem)
+		} else {
+		    call aaddi (Memi[p1], Memi[p2],
+			Memi[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) - O_VALI(in2)
+		else if (len2 <= 0)
+		    call asubki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call asubi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) * O_VALI(in2)
+		else if (len2 <= 0)
+		    call amulki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call amuli (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALI(out) = O_VALI(in1) / O_VALI(in2)
+		    else if (len2 <= 0)
+			call adivki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call adivi (Memi[p1], Memi[p2], Memi[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALI(in2) == 0)
+			    O_VALI(out) = xvv_nulli(0)
+			else
+			    O_VALI(out) = O_VALI(in1) / O_VALI(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALI(in2) == 0)
+			    call amovki (xvv_nulli(0), Memi[po], nelem)
+			else {
+			    call adivki (Memi[p1], O_VALI(in2), Memi[po],
+				nelem)
+			}
+		    } else {
+			call advzi (Memi[p1], Memi[p2], Memi[po], nelem,
+			    xvv_nulli)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALI(out) = O_VALI(in1) ** O_VALI(in2)
+		else if (len2 <= 0)
+		    call aexpki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		else
+		    call aexpi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memi[po] = O_VALI(in1)
+		    po = po + 1
+		} else {
+		    call amovi (Memi[p1], Memi[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memi[po] = O_VALI(in2)
+		else
+		    call amovi (Memi[p2], Memi[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_LONG:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALL(out) = O_VALL(in1) + O_VALL(in2)
+		} else if (len2 <= 0) {
+		    call aaddkl (Meml[p1], O_VALL(in2),
+			Meml[po], nelem)
+		} else {
+		    call aaddl (Meml[p1], Meml[p2],
+			Meml[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) - O_VALL(in2)
+		else if (len2 <= 0)
+		    call asubkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call asubl (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) * O_VALL(in2)
+		else if (len2 <= 0)
+		    call amulkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call amull (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALL(out) = O_VALL(in1) / O_VALL(in2)
+		    else if (len2 <= 0)
+			call adivkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		    else
+			call adivl (Meml[p1], Meml[p2], Meml[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALL(in2) == 0)
+			    O_VALL(out) = xvv_nulll(0)
+			else
+			    O_VALL(out) = O_VALL(in1) / O_VALL(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALL(in2) == 0)
+			    call amovkl (xvv_nulll(0), Meml[po], nelem)
+			else {
+			    call adivkl (Meml[p1], O_VALL(in2), Meml[po],
+				nelem)
+			}
+		    } else {
+			call advzl (Meml[p1], Meml[p2], Meml[po], nelem,
+			    xvv_nulll)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALL(out) = O_VALL(in1) ** O_VALL(in2)
+		else if (len2 <= 0)
+		    call aexpkl (Meml[p1], O_VALL(in2), Meml[po], nelem)
+		else
+		    call aexpl (Meml[p1], Meml[p2], Meml[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Meml[po] = O_VALL(in1)
+		    po = po + 1
+		} else {
+		    call amovl (Meml[p1], Meml[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Meml[po] = O_VALL(in2)
+		else
+		    call amovl (Meml[p2], Meml[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_REAL:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALR(out) = O_VALR(in1) + O_VALR(in2)
+		} else if (len2 <= 0) {
+		    call aaddkr (Memr[p1], O_VALR(in2),
+			Memr[po], nelem)
+		} else {
+		    call aaddr (Memr[p1], Memr[p2],
+			Memr[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) - O_VALR(in2)
+		else if (len2 <= 0)
+		    call asubkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call asubr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) * O_VALR(in2)
+		else if (len2 <= 0)
+		    call amulkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call amulr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALR(out) = O_VALR(in1) / O_VALR(in2)
+		    else if (len2 <= 0)
+			call adivkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		    else
+			call adivr (Memr[p1], Memr[p2], Memr[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALR(in2) == 0.0)
+			    O_VALR(out) = xvv_nullr(0.0)
+			else
+			    O_VALR(out) = O_VALR(in1) / O_VALR(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALR(in2) == 0.0)
+			    call amovkr (xvv_nullr(0.0), Memr[po], nelem)
+			else {
+			    call adivkr (Memr[p1], O_VALR(in2), Memr[po],
+				nelem)
+			}
+		    } else {
+			call advzr (Memr[p1], Memr[p2], Memr[po], nelem,
+			    xvv_nullr)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALR(out) = O_VALR(in1) ** O_VALR(in2)
+		else if (len2 <= 0)
+		    call aexpkr (Memr[p1], O_VALR(in2), Memr[po], nelem)
+		else
+		    call aexpr (Memr[p1], Memr[p2], Memr[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memr[po] = O_VALR(in1)
+		    po = po + 1
+		} else {
+		    call amovr (Memr[p1], Memr[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memr[po] = O_VALR(in2)
+		else
+		    call amovr (Memr[p2], Memr[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case TY_DOUBLE:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VALD(out) = O_VALD(in1) + O_VALD(in2)
+		} else if (len2 <= 0) {
+		    call aaddkd (Memd[p1], O_VALD(in2),
+			Memd[po], nelem)
+		} else {
+		    call aaddd (Memd[p1], Memd[p2],
+			Memd[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) - O_VALD(in2)
+		else if (len2 <= 0)
+		    call asubkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call asubd (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) * O_VALD(in2)
+		else if (len2 <= 0)
+		    call amulkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call amuld (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VALD(out) = O_VALD(in1) / O_VALD(in2)
+		    else if (len2 <= 0)
+			call adivkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		    else
+			call adivd (Memd[p1], Memd[p2], Memd[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VALD(in2) == 0.0D0)
+			    O_VALD(out) = xvv_nulld(0.0D0)
+			else
+			    O_VALD(out) = O_VALD(in1) / O_VALD(in2)
+		    } else if (len2 <= 0) {
+			if (O_VALD(in2) == 0.0D0)
+			    call amovkd (xvv_nulld(0.0D0), Memd[po], nelem)
+			else {
+			    call adivkd (Memd[p1], O_VALD(in2), Memd[po],
+				nelem)
+			}
+		    } else {
+			call advzd (Memd[p1], Memd[p2], Memd[po], nelem,
+			    xvv_nulld)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VALD(out) = O_VALD(in1) ** O_VALD(in2)
+		else if (len2 <= 0)
+		    call aexpkd (Memd[p1], O_VALD(in2), Memd[po], nelem)
+		else
+		    call aexpd (Memd[p1], Memd[p2], Memd[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Memd[po] = O_VALD(in1)
+		    po = po + 1
+		} else {
+		    call amovd (Memd[p1], Memd[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Memd[po] = O_VALD(in2)
+		else
+		    call amovd (Memd[p2], Memd[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+done_
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_BOOLOP -- Boolean (actually logical) binary operations.  Perform the
+# indicated logical operation on the two input operands, returning the result
+# as the output operand.  The opcodes implemented by this routine are
+# characterized by the fact that they all return a logical result (YES or NO
+# physically expressed as an integer).
+
+procedure xvv_boolop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+
+short	v_s
+
+int	v_i
+
+long	v_l
+
+real	v_r
+
+double	v_d
+
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+int	xvv_newtype(), xvv_patmatch(), strncmp(), btoi()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badop "boolop: illegal operation"
+string	s_badswitch "boolop: illegal switch"
+
+begin
+	# Boolean operands are treated as integer within this routine.
+	if (O_TYPE(in1) == TY_BOOL)
+	    O_TYPE(in1) = TY_INT
+	if (O_TYPE(in2) == TY_BOOL)
+	    O_TYPE(in2) = TY_INT
+
+	# Determine the computation type for the operation, i.e., the type
+	# both input operands must have.  This is not the same as the type
+	# of the output operand, which is always boolean for the operations
+	# implemented by this routine.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	if (dtype == TY_CHAR)
+	    nelem = 0
+	else {
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+	    else
+		nelem = 0
+	}
+
+	# Convert input operands to desired computation type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case EQ, NE:
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+
+		case TY_SHORT:
+		    v_s = O_VALS(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovks (v_s, Mems[O_VALP(in1)], nelem)
+
+		case TY_INT:
+		    v_i = O_VALI(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovki (v_i, Memi[O_VALP(in1)], nelem)
+
+		case TY_LONG:
+		    v_l = O_VALL(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkl (v_l, Meml[O_VALP(in1)], nelem)
+
+		case TY_REAL:
+		    v_r = O_VALR(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkr (v_r, Memr[O_VALP(in1)], nelem)
+
+		case TY_DOUBLE:
+		    v_d = O_VALD(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovkd (v_d, Memd[O_VALP(in1)], nelem)
+
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, TY_BOOL)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# Perform the operation.
+	if (dtype == TY_CHAR) {
+	    # Character data is a special case.
+
+	    switch (opcode) {
+	    case SE:
+		O_VALI(out) = btoi(xvv_patmatch (O_VALC(in1), O_VALC(in2)) > 0)
+	    case LT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0)
+	    case LE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) <= 0)
+	    case GT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0)
+	    case GE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) >= 0)
+	    case EQ:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0)
+	    case NE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) != 0)
+	    default:
+		call xvv_error (s_badop)
+	    }
+
+	} else if (opcode == LAND || opcode == LOR) {
+	    # Operations supporting only the integer types.
+
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALS(in1) != 0 && O_VALS(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alanks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    } else
+			call alans (Mems[p1], Mems[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALS(in1) != 0 || O_VALS(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    } else
+			call alors (Mems[p1], Mems[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALI(in1) != 0 && O_VALI(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alanki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    } else
+			call alani (Memi[p1], Memi[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALI(in1) != 0 || O_VALI(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    } else
+			call alori (Memi[p1], Memi[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALL(in1) != 0 && O_VALL(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alankl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    } else
+			call alanl (Meml[p1], Meml[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VALL(in1) != 0 || O_VALL(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alorkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    } else
+			call alorl (Meml[p1], Meml[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	} else {
+	    # Operations supporting any arithmetic type.
+
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) < O_VALS(in2))
+		    else if (len2 <= 0)
+			call abltks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call ablts (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) <= O_VALS(in2))
+		    else if (len2 <= 0)
+			call ableks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call ables (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) > O_VALS(in2))
+		    else if (len2 <= 0)
+			call abgtks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abgts (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) >= O_VALS(in2))
+		    else if (len2 <= 0)
+			call abgeks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abges (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) == O_VALS(in2))
+		    else if (len2 <= 0)
+			call abeqks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abeqs (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALS(in1) != O_VALS(in2))
+		    else if (len2 <= 0)
+			call abneks (Mems[p1], O_VALS(in2), Memi[po], nelem)
+		    else
+			call abnes (Mems[p1], Mems[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_INT:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) < O_VALI(in2))
+		    else if (len2 <= 0)
+			call abltki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call ablti (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) <= O_VALI(in2))
+		    else if (len2 <= 0)
+			call ableki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call ablei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) > O_VALI(in2))
+		    else if (len2 <= 0)
+			call abgtki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abgti (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) >= O_VALI(in2))
+		    else if (len2 <= 0)
+			call abgeki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abgei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) == O_VALI(in2))
+		    else if (len2 <= 0)
+			call abeqki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abeqi (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALI(in1) != O_VALI(in2))
+		    else if (len2 <= 0)
+			call abneki (Memi[p1], O_VALI(in2), Memi[po], nelem)
+		    else
+			call abnei (Memi[p1], Memi[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_LONG:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) < O_VALL(in2))
+		    else if (len2 <= 0)
+			call abltkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abltl (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) <= O_VALL(in2))
+		    else if (len2 <= 0)
+			call ablekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call ablel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) > O_VALL(in2))
+		    else if (len2 <= 0)
+			call abgtkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abgtl (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) >= O_VALL(in2))
+		    else if (len2 <= 0)
+			call abgekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abgel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) == O_VALL(in2))
+		    else if (len2 <= 0)
+			call abeqkl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abeql (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALL(in1) != O_VALL(in2))
+		    else if (len2 <= 0)
+			call abnekl (Meml[p1], O_VALL(in2), Memi[po], nelem)
+		    else
+			call abnel (Meml[p1], Meml[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_REAL:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) < O_VALR(in2))
+		    else if (len2 <= 0)
+			call abltkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abltr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) <= O_VALR(in2))
+		    else if (len2 <= 0)
+			call ablekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abler (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) > O_VALR(in2))
+		    else if (len2 <= 0)
+			call abgtkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abgtr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) >= O_VALR(in2))
+		    else if (len2 <= 0)
+			call abgekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abger (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) == O_VALR(in2))
+		    else if (len2 <= 0)
+			call abeqkr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abeqr (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALR(in1) != O_VALR(in2))
+		    else if (len2 <= 0)
+			call abnekr (Memr[p1], O_VALR(in2), Memi[po], nelem)
+		    else
+			call abner (Memr[p1], Memr[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    case TY_DOUBLE:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) < O_VALD(in2))
+		    else if (len2 <= 0)
+			call abltkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abltd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) <= O_VALD(in2))
+		    else if (len2 <= 0)
+			call ablekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abled (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) > O_VALD(in2))
+		    else if (len2 <= 0)
+			call abgtkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abgtd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) >= O_VALD(in2))
+		    else if (len2 <= 0)
+			call abgekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abged (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) == O_VALD(in2))
+		    else if (len2 <= 0)
+			call abeqkd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abeqd (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VALD(in1) != O_VALD(in2))
+		    else if (len2 <= 0)
+			call abnekd (Memd[p1], O_VALD(in2), Memi[po], nelem)
+		    else
+			call abned (Memd[p1], Memd[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	}
+
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xvv_patmatch (str, pat)
+
+char	str[ARB]		#I operand string
+char	pat[ARB]		#I pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XVV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xvv_newtype (type1, type2)
+
+int	type1			#I datatype of first operand
+int	type2			#I datatype of second operand
+
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/T_B, T_C, T_S, T_I, T_L, T_R, T_D/
+
+data	(ttbl(i),i= 1, 7)	/T_B,    0,    0,    0,    0,    0,    0/
+data	(ttbl(i),i= 8,14)	/  0,  T_C,    0,    0,    0,    0,    0/
+data	(ttbl(i),i=15,21)	/  0,    0,  T_S,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=22,28)	/  0,    0,  T_I,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=29,35)	/  0,    0,  T_L,  T_L,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=36,42)	/  0,    0,  T_R,  T_R,  T_R,  T_R,  T_D/
+data	(ttbl(i),i=43,49)	/  0,    0,  T_D,  T_D,  T_D,  T_D,  T_D/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xvv_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XVV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xvv_quest (cond, in1, in2, out)
+
+pointer	cond			#I pointer to condition operand
+pointer	in1, in2		#I pointer to true,false operands
+pointer	out			#I pointer to output operand
+
+int	dtype, nelem, i
+pointer	sp, otemp, ip1, ip2, op, sel
+errchk	xvv_error, xvv_newtype, xvv_initop, xvv_chtype
+int	xvv_newtype(), btoi()
+
+begin
+	switch (O_TYPE(cond)) {
+	case TY_BOOL, TY_INT:
+	    ;
+	case TY_SHORT, TY_LONG:
+	    call xvv_chtype (cond, cond, TY_BOOL)
+	default:
+	    call xvv_error ("evvexpr: nonboolean condition operand")
+	}
+
+	if (O_LEN(cond) <= 0 &&
+	    (O_LEN(in1) <= 0 || O_TYPE(in1) == TY_CHAR) &&
+	    (O_LEN(in2) <= 0 || O_TYPE(in2) == TY_CHAR)) {
+
+	    # Both operands and the conditional are scalars; the expression
+	    # type is the type of the selected operand.
+
+	    if (O_VALI(cond) != 0) {
+		YYMOVE (in1, out)
+		call xvv_freeop (in2)
+	    } else {
+		YYMOVE (in2, out)
+		call xvv_freeop (in1)
+	    }
+
+	} else if (O_TYPE(in1) == TY_CHAR || O_TYPE(in2) == TY_CHAR) {
+	    # This combination is not legal.
+	    call xvv_error ("evvexpr: character and vector in cond expr")
+
+	} else {
+	    # Vector/scalar or vector/vector operation.  Both operands must
+	    # be of the same type.
+
+	    dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	    # Compute the size of the output operand.  If both input operands
+	    # are vectors the length of the output vector is the shorter of
+	    # the two.  The condition operand contributes to the dimension of
+	    # the expression result, although not to the datatype.
+
+	    nelem = 0
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+
+	    if (O_LEN(cond) > 0 && nelem > 0)
+		nelem = min (O_LEN(cond), nelem)
+	    else if (O_LEN(cond) > 0)
+		nelem = O_LEN(cond)
+
+	    # If this is a scalar/vector operation make sure the vector is the
+	    # first operand.
+
+	    if (O_LEN(in1) == 0 && O_LEN(in2) > 0) {
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+		# Since we are swapping arguments we need to negate the cond.
+		if (O_LEN(cond) <= 0)
+		    O_VALI(cond) = btoi (O_VALI(cond) == 0)
+		else {
+		    call abeqki (Memi[O_VALP(cond)], NO, Memi[O_VALP(cond)],
+			nelem)
+		}
+	    }
+
+	    # Initialize the output operand.
+	    call xvv_initop (out, nelem, dtype)
+
+	    # Convert input operands to desired computation type.
+	    if (O_TYPE(in1) != dtype)
+		call xvv_chtype (in1, in1, dtype)
+	    if (O_TYPE(in2) != dtype)
+		call xvv_chtype (in2, in2, dtype)
+
+	    ip1 = O_VALP(in1)
+	    ip2 = O_VALP(in2)
+	    op  = O_VALP(out)
+	    sel = O_VALP(cond)
+
+	    # Perform the operation.
+	    switch (dtype) {
+
+	    case TY_SHORT:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Mems[op+i-1] = O_VALS(in1)
+			else
+			    Mems[op+i-1] = O_VALS(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovs (Mems[ip1], Mems[op], nelem)
+			else
+			    call amovks (O_VALS(in2), Mems[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselks (Mems[ip1], O_VALS(in2), Mems[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovs (Mems[ip1], Mems[op], nelem)
+			else
+			    call amovs (Mems[ip2], Mems[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asels (Mems[ip1], Mems[ip2], Mems[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memi[op+i-1] = O_VALI(in1)
+			else
+			    Memi[op+i-1] = O_VALI(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovi (Memi[ip1], Memi[op], nelem)
+			else
+			    call amovki (O_VALI(in2), Memi[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselki (Memi[ip1], O_VALI(in2), Memi[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovi (Memi[ip1], Memi[op], nelem)
+			else
+			    call amovi (Memi[ip2], Memi[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aseli (Memi[ip1], Memi[ip2], Memi[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Meml[op+i-1] = O_VALL(in1)
+			else
+			    Meml[op+i-1] = O_VALL(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovl (Meml[ip1], Meml[op], nelem)
+			else
+			    call amovkl (O_VALL(in2), Meml[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkl (Meml[ip1], O_VALL(in2), Meml[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovl (Meml[ip1], Meml[op], nelem)
+			else
+			    call amovl (Meml[ip2], Meml[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asell (Meml[ip1], Meml[ip2], Meml[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memr[op+i-1] = O_VALR(in1)
+			else
+			    Memr[op+i-1] = O_VALR(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovr (Memr[ip1], Memr[op], nelem)
+			else
+			    call amovkr (O_VALR(in2), Memr[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkr (Memr[ip1], O_VALR(in2), Memr[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovr (Memr[ip1], Memr[op], nelem)
+			else
+			    call amovr (Memr[ip2], Memr[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselr (Memr[ip1], Memr[ip2], Memr[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Memd[op+i-1] = O_VALD(in1)
+			else
+			    Memd[op+i-1] = O_VALD(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovd (Memd[ip1], Memd[op], nelem)
+			else
+			    call amovkd (O_VALD(in2), Memd[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselkd (Memd[ip1], O_VALD(in2), Memd[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amovd (Memd[ip1], Memd[op], nelem)
+			else
+			    call amovd (Memd[ip2], Memd[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aseld (Memd[ip1], Memd[ip2], Memd[op],
+			    Memi[sel], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error ("evvexpr: bad datatype in cond expr")
+	    }
+
+	    call xvv_freeop (in1)
+	    call xvv_freeop (in2)
+	}
+
+	call xvv_freeop (cond)
+end
+
+
+# XVV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xvv_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		#I function to be called
+pointer	args[ARB]		#I pointer to arglist descriptor
+int	nargs			#I number of arguments
+pointer	out			#I output operand (function value)
+
+
+short	v_s
+short	ahivs(), alovs()
+short	ameds()
+int	aravs()
+
+int	v_i
+int	ahivi(), alovi()
+int	amedi()
+int	aravi()
+
+long	v_l
+long	ahivl(), alovl()
+long	amedl()
+int	aravl()
+
+real	v_r
+real	ahivr(), alovr()
+real	amedr()
+int	aravr()
+
+double	v_d
+double	ahivd(), alovd()
+double	amedd()
+int	aravd()
+
+
+real	mean_r, sigma_r
+double	mean_d, sigma_d
+real	asums(), asumi(), asumr()
+double	asuml(), asumd()
+
+bool	rangecheck
+int	optype, opcode
+int	chunk, repl, nelem, v_nargs, ch, shift, i, j
+pointer	sp, sym, buf, ap, ip, op, in1, in2
+include	"evvexpr.com"
+
+pointer	stfind()
+int	xvv_newtype(), strlen(), gctod(), btoi()
+errchk	xvv_chtype, xvv_initop, xvv_newtype, xvv_error1, xvv_error2
+errchk	zcall5, malloc
+
+string	s_badtype "%s: illegal operand type"
+define	free_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# Lookup the function name in the symbol table.
+	sym = stfind (ev_st, fcn)
+	if (sym != NULL)
+	    opcode = SYM_CODE(sym)
+	else
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall5 (ev_ufcn, ev_ufcn_data, fcn, args, nargs, out)
+		if (O_TYPE(out) <= 0)
+		    call xvv_error1 ("unrecognized macro or function `%s'", fcn)
+		goto free_
+	    } else
+		call xvv_error1 ("unknown function `%s' called", fcn)
+
+	# Range checking on functions that need it?
+	rangecheck = (and (ev_flags, EV_RNGCHK) != 0)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD, F_REPL, F_SHIFT:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2, F_MEAN, F_STDDEV, F_MEDIAN:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xvv_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xvv_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Some functions require that the input operand be a certain type,
+	# e.g. floating.  Handle the simple cases, converting input operands
+	# to the desired type.
+
+	switch (opcode) {
+	case F_ACOS, F_ASIN, F_ATAN, F_ATAN2, F_COS, F_COSH, F_DEG, F_EXP,
+	     F_LOG, F_LOG10, F_RAD, F_SIN, F_SINH, F_SQRT, F_TAN, F_TANH:
+
+	    # These functions want a floating point input operand.
+	    optype = TY_REAL
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) == TY_DOUBLE || O_TYPE(args[i]) == TY_LONG)
+		    optype = TY_DOUBLE
+	    }
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+	    }
+	    call xvv_initop (out, O_LEN(args[1]), optype)
+
+	case F_MOD, F_MIN, F_MAX, F_MEDIAN:
+	    # These functions may have multiple arguments, all of which
+	    # should be the same type.
+
+	    optype = O_TYPE(args[1])
+	    nelem = O_LEN(args[1])
+	    do i = 2, nargs {
+		optype = xvv_newtype (optype, O_TYPE(args[i]))
+		if (O_LEN(args[i]) > 0)
+		    if (nelem > 0)
+			nelem = min (nelem, O_LEN(args[i]))
+		    else if (nelem == 0)
+			nelem = O_LEN(args[i])
+	    }
+
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+
+	    if (nargs == 1 && opcode == F_MEDIAN)
+		nelem = 0
+	    call xvv_initop (out, nelem, optype)
+
+	case F_LEN:
+	    # This function always returns an integer scalar value.
+	    nelem = 0
+	    optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_HIV, F_LOV:
+	    # These functions return a scalar value.
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_SUM, F_MEAN, F_STDDEV:
+	    # These functions require a vector argument and return a scalar
+	    # value.
+
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    
+	    if (optype == TY_DOUBLE)
+		call xvv_initop (out, nelem, TY_DOUBLE)
+	    else
+		call xvv_initop (out, nelem, TY_REAL)
+
+	case F_SORT, F_SHIFT:
+	    # Vector to vector, no type conversions.
+	    nelem = O_LEN(args[1])
+	    optype = O_TYPE(args[1])
+	    call xvv_initop (out, nelem, optype)
+
+	default:
+	    optype = 0
+	}
+
+	# Evaluate the function.
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    call xvv_initop (out, O_LEN(ap), O_TYPE(ap))
+	    switch (O_TYPE(ap)) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0) {
+		    call aabss (Mems[O_VALP(ap)], Mems[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALS(out) = abs(O_VALS(ap))
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0) {
+		    call aabsi (Memi[O_VALP(ap)], Memi[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALI(out) = abs(O_VALI(ap))
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0) {
+		    call aabsl (Meml[O_VALP(ap)], Meml[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALL(out) = abs(O_VALL(ap))
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0) {
+		    call aabsr (Memr[O_VALP(ap)], Memr[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALR(out) = abs(O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0) {
+		    call aabsd (Memd[O_VALP(ap)], Memd[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VALD(out) = abs(O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ACOS:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = acos (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = acos (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = acos (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = acos (O_VALD(ap))
+
+	case F_ASIN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = asin (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = asin (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = asin (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = asin (O_VALD(ap))
+
+	case F_COS:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = cos (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = cos (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = cos (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = cos (O_VALD(ap))
+
+	case F_COSH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = cosh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = cosh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = cosh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = cosh (O_VALD(ap))
+
+	case F_DEG:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = RADTODEG(Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = RADTODEG (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = RADTODEG(Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = RADTODEG (O_VALD(ap))
+
+	case F_EXP:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = exp (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = exp (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = exp (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = exp (O_VALD(ap))
+
+	case F_LOG:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r <= 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = log (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = log (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d <= 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = log (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = log (v_d)
+		}
+
+	case F_LOG10:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r <= 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = log10 (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = log10 (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d <= 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = log10 (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = log10 (v_d)
+		}
+
+	case F_RAD:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = DEGTORAD(Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = DEGTORAD (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = DEGTORAD(Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = DEGTORAD (O_VALD(ap))
+
+	case F_SIN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = sin (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = sin (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = sin (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = sin (O_VALD(ap))
+
+	case F_SINH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = sinh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = sinh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = sinh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = sinh (O_VALD(ap))
+
+	case F_SQRT:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_r = Memr[O_VALP(ap)+i-1]
+			if (rangecheck && v_r < 0)
+			    Memr[op] = 0
+			else
+			    Memr[op] = sqrt (v_r)
+			op = op + 1
+		    }
+		} else {
+		    v_r = O_VALR(ap)
+		    if (rangecheck && v_r <= 0)
+			O_VALR(out) = 0
+		    else
+			O_VALR(out) = sqrt (v_r)
+		}
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_d = Memd[O_VALP(ap)+i-1]
+			if (rangecheck && v_d < 0)
+			    Memd[op] = 0
+			else
+			    Memd[op] = sqrt (v_d)
+			op = op + 1
+		    }
+		} else {
+		    v_d = O_VALD(ap)
+		    if (rangecheck && v_d <= 0)
+			O_VALD(out) = 0
+		    else
+			O_VALD(out) = sqrt (v_d)
+		}
+
+	case F_TAN:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = tan (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = tan (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = tan (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = tan (O_VALD(ap))
+
+	case F_TANH:
+
+	    if (optype == TY_REAL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memr[O_VALP(out)+i-1] = tanh (Memr[O_VALP(ap)+i-1])
+		} else
+		    O_VALR(out) = tanh (O_VALR(ap))
+
+	    if (optype == TY_DOUBLE) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Memd[O_VALP(out)+i-1] = tanh (Memd[O_VALP(ap)+i-1])
+		} else
+		    O_VALD(out) = tanh (O_VALD(ap))
+
+
+	case F_LEN:
+	    # Vector length.
+	    O_VALI(out) = O_LEN(ap)
+
+	case F_HIV:
+	    # High value.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    O_VALS(out) = ahivs (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALS(out) = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    O_VALI(out) = ahivi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALI(out) = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    O_VALL(out) = ahivl (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALL(out) = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    O_VALR(out) = ahivr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALR(out) = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    O_VALD(out) = ahivd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALD(out) = O_VALD(ap)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+	case F_LOV:
+	    # Low value.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    O_VALS(out) = alovs (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALS(out) = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    O_VALI(out) = alovi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALI(out) = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    O_VALL(out) = alovl (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALL(out) = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    O_VALR(out) = alovr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALR(out) = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    O_VALD(out) = alovd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VALD(out) = O_VALD(ap)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SUM:
+	    # Vector sum.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(ap) > 0)
+		    v_r = asums (Mems[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALS(ap)
+
+	    case TY_INT:
+		if (O_LEN(ap) > 0)
+		    v_r = asumi (Memi[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALI(ap)
+
+	    case TY_LONG:
+		if (O_LEN(ap) > 0)
+		    v_r = asuml (Meml[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALL(ap)
+
+	    case TY_REAL:
+		if (O_LEN(ap) > 0)
+		    v_r = asumr (Memr[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VALR(ap)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    v_d = asumd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_d = O_VALD(ap)
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (optype == TY_DOUBLE)
+		O_VALD(out) = v_d
+	    else
+		O_VALR(out) = v_r
+
+	case F_MEAN, F_STDDEV:
+	    # Compute the mean or standard deviation of a vector.  An optional
+	    # second argument may be supplied to compute a K-sigma rejection
+	    # mean and sigma.
+
+	    if (nargs == 2) {
+		if (O_LEN(args[2]) > 0)
+		    call xvv_error1 ("%s: ksigma arg must be a scalar" , fcn)
+
+		switch (O_TYPE(args[2])) {
+		case TY_REAL:
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		case TY_DOUBLE:
+		    v_d = O_VALD(args[2])
+		    v_r = v_d
+		default:
+		    call xvv_chtype (args[2], args[2], TY_REAL)
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		}
+	    } else {
+		v_r = 0.0
+		v_d = 0.0
+	    }
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		v_i = aravs (Mems[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+	    case TY_INT:
+		v_i = aravi (Memi[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+	    case TY_REAL:
+		v_i = aravr (Memr[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+
+
+	    case TY_LONG:
+		v_i = aravl (Meml[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+
+	    case TY_DOUBLE:
+		v_i = aravd (Memd[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (opcode == F_MEAN) {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = mean_r
+		else
+		    O_VALD(out) = mean_d
+	    } else {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = sigma_r
+		else
+		    O_VALD(out) = sigma_d
+	    }
+
+	case F_MEDIAN:
+	    # Compute the median value of a vector, or the vector median
+	    # of 3 or more vectors.
+
+	    switch (nargs) {
+	    case 1:
+		switch (optype) {
+
+		case TY_SHORT:
+		    O_VALS(out) = ameds (Mems[O_VALP(ap)], O_LEN(ap))
+
+		case TY_INT:
+		    O_VALI(out) = amedi (Memi[O_VALP(ap)], O_LEN(ap))
+
+		case TY_LONG:
+		    O_VALL(out) = amedl (Meml[O_VALP(ap)], O_LEN(ap))
+
+		case TY_REAL:
+		    O_VALR(out) = amedr (Memr[O_VALP(ap)], O_LEN(ap))
+
+		case TY_DOUBLE:
+		    O_VALD(out) = amedd (Memd[O_VALP(ap)], O_LEN(ap))
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 3:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed3s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed3i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed3l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed3r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed3d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 4:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed4s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(args[4])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed4i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(args[4])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed4l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(args[4])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed4r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(args[4])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed4d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(args[4])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 5:
+		switch (optype) {
+
+		case TY_SHORT:
+		    call amed5s (Mems[O_VALP(args[1])],
+				  Mems[O_VALP(args[2])],
+				  Mems[O_VALP(args[3])],
+				  Mems[O_VALP(args[4])],
+				  Mems[O_VALP(args[5])],
+				  Mems[O_VALP(out)], nelem)
+
+		case TY_INT:
+		    call amed5i (Memi[O_VALP(args[1])],
+				  Memi[O_VALP(args[2])],
+				  Memi[O_VALP(args[3])],
+				  Memi[O_VALP(args[4])],
+				  Memi[O_VALP(args[5])],
+				  Memi[O_VALP(out)], nelem)
+
+		case TY_LONG:
+		    call amed5l (Meml[O_VALP(args[1])],
+				  Meml[O_VALP(args[2])],
+				  Meml[O_VALP(args[3])],
+				  Meml[O_VALP(args[4])],
+				  Meml[O_VALP(args[5])],
+				  Meml[O_VALP(out)], nelem)
+
+		case TY_REAL:
+		    call amed5r (Memr[O_VALP(args[1])],
+				  Memr[O_VALP(args[2])],
+				  Memr[O_VALP(args[3])],
+				  Memr[O_VALP(args[4])],
+				  Memr[O_VALP(args[5])],
+				  Memr[O_VALP(out)], nelem)
+
+		case TY_DOUBLE:
+		    call amed5d (Memd[O_VALP(args[1])],
+				  Memd[O_VALP(args[2])],
+				  Memd[O_VALP(args[3])],
+				  Memd[O_VALP(args[4])],
+				  Memd[O_VALP(args[5])],
+				  Memd[O_VALP(out)], nelem)
+
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    default:
+		call xvv_error1 ("%s: wrong number of arguments", fcn)
+	    }
+
+	case F_REPL:
+	    # Replicate an item to make a longer vector.
+
+	    chunk = O_LEN(ap)
+	    optype = O_TYPE(ap)
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: replication factor must be a scalar", fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    repl = max (1, O_VALI(args[2]))
+
+	    if (chunk <= 0)
+		nelem = repl
+	    else
+		nelem = chunk * repl
+	    call xvv_initop (out, nelem, optype)
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovs (Mems[ip], Mems[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovi (Memi[ip], Memi[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovl (Meml[ip], Meml[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovr (Memr[ip], Memr[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amovd (Memd[ip], Memd[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHIFT:
+	    # Vector shift.
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: shift arg must be a scalar" , fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    shift = O_VALI(args[2])
+
+	    if (abs(shift) > nelem) {
+		if (shift > 0)
+		    shift = nelem
+		else
+		    shift = -nelem
+	    }
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Mems[O_VALP(out)+i-1] = Mems[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALS(out) = (O_VALS(ap))
+
+	    case TY_INT:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memi[O_VALP(out)+i-1] = Memi[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALI(out) = (O_VALI(ap))
+
+	    case TY_LONG:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Meml[O_VALP(out)+i-1] = Meml[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALL(out) = (O_VALL(ap))
+
+	    case TY_REAL:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memr[O_VALP(out)+i-1] = Memr[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALR(out) = (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Memd[O_VALP(out)+i-1] = Memd[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VALD(out) = (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SORT:
+	    # Sort a vector.
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (nelem > 0)
+		    call asrts (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+		else
+		    O_VALS(out) = (O_VALS(ap))
+
+	    case TY_INT:
+		if (nelem > 0)
+		    call asrti (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+		else
+		    O_VALI(out) = (O_VALI(ap))
+
+	    case TY_LONG:
+		if (nelem > 0)
+		    call asrtl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+		else
+		    O_VALL(out) = (O_VALL(ap))
+
+	    case TY_REAL:
+		if (nelem > 0)
+		    call asrtr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+		else
+		    O_VALR(out) = (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		if (nelem > 0)
+		    call asrtd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+		else
+		    O_VALD(out) = (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ATAN, F_ATAN2:
+
+	    if (optype == TY_REAL) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memr[O_VALP(out)+i-1] =
+				atan (Memr[O_VALP(ap)+i-1])
+		    } else
+			O_VALR(out) = atan (O_VALR(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memr[O_VALP(out)+i-1] =
+				atan2 (Memr[O_VALP(args[1])+i-1],
+				       Memr[O_VALP(args[2])+i-1])
+		    } else
+			O_VALR(out) = atan2(O_VALR(args[1]), O_VALR(args[2]))
+		}
+	    }
+
+	    if (optype == TY_DOUBLE) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memd[O_VALP(out)+i-1] =
+				atan (Memd[O_VALP(ap)+i-1])
+		    } else
+			O_VALD(out) = atan (O_VALD(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Memd[O_VALP(out)+i-1] =
+				atan2 (Memd[O_VALP(args[1])+i-1],
+				       Memd[O_VALP(args[2])+i-1])
+		    } else
+			O_VALD(out) = atan2(O_VALD(args[1]), O_VALD(args[2]))
+		}
+	    }
+
+
+	case F_MOD:
+	    in1 = args[1]
+	    in2 = args[2]
+
+	    switch (optype) {
+
+	    case TY_SHORT:
+		if (O_LEN(in1) <= 0) {
+		    O_VALS(out) = mod (O_VALS(in1), O_VALS(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodks (Mems[O_VALP(in1)], O_VALS(in2),
+			Mems[O_VALP(out)], nelem)
+		} else {
+		    call amods (Mems[O_VALP(in1)], Mems[O_VALP(in2)],
+			Mems[O_VALP(out)], nelem)
+		}
+
+	    case TY_INT:
+		if (O_LEN(in1) <= 0) {
+		    O_VALI(out) = mod (O_VALI(in1), O_VALI(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodki (Memi[O_VALP(in1)], O_VALI(in2),
+			Memi[O_VALP(out)], nelem)
+		} else {
+		    call amodi (Memi[O_VALP(in1)], Memi[O_VALP(in2)],
+			Memi[O_VALP(out)], nelem)
+		}
+
+	    case TY_LONG:
+		if (O_LEN(in1) <= 0) {
+		    O_VALL(out) = mod (O_VALL(in1), O_VALL(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkl (Meml[O_VALP(in1)], O_VALL(in2),
+			Meml[O_VALP(out)], nelem)
+		} else {
+		    call amodl (Meml[O_VALP(in1)], Meml[O_VALP(in2)],
+			Meml[O_VALP(out)], nelem)
+		}
+
+	    case TY_REAL:
+		if (O_LEN(in1) <= 0) {
+		    O_VALR(out) = mod (O_VALR(in1), O_VALR(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkr (Memr[O_VALP(in1)], O_VALR(in2),
+			Memr[O_VALP(out)], nelem)
+		} else {
+		    call amodr (Memr[O_VALP(in1)], Memr[O_VALP(in2)],
+			Memr[O_VALP(out)], nelem)
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(in1) <= 0) {
+		    O_VALD(out) = mod (O_VALD(in1), O_VALD(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodkd (Memd[O_VALP(in1)], O_VALD(in2),
+			Memd[O_VALP(out)], nelem)
+		} else {
+		    call amodd (Memd[O_VALP(in1)], Memd[O_VALP(in2)],
+			Memd[O_VALP(out)], nelem)
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MAX:
+	    switch (optype) {
+
+	    case TY_SHORT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+		    else
+			O_VALS(out) = O_VALS(ap)
+		} else
+		    call amovs (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALS(out) = max (O_VALS(ap), O_VALS(out))
+			else {
+			    call amaxks (Mems[O_VALP(out)], O_VALS(ap),
+				Mems[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxs (Mems[O_VALP(out)], Mems[O_VALP(ap)],
+			    Mems[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+		    else
+			O_VALI(out) = O_VALI(ap)
+		} else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALI(out) = max (O_VALI(ap), O_VALI(out))
+			else {
+			    call amaxki (Memi[O_VALP(out)], O_VALI(ap),
+				Memi[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxi (Memi[O_VALP(out)], Memi[O_VALP(ap)],
+			    Memi[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+		    else
+			O_VALL(out) = O_VALL(ap)
+		} else
+		    call amovl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALL(out) = max (O_VALL(ap), O_VALL(out))
+			else {
+			    call amaxkl (Meml[O_VALP(out)], O_VALL(ap),
+				Meml[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxl (Meml[O_VALP(out)], Meml[O_VALP(ap)],
+			    Meml[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+		    else
+			O_VALR(out) = O_VALR(ap)
+		} else
+		    call amovr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALR(out) = max (O_VALR(ap), O_VALR(out))
+			else {
+			    call amaxkr (Memr[O_VALP(out)], O_VALR(ap),
+				Memr[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxr (Memr[O_VALP(out)], Memr[O_VALP(ap)],
+			    Memr[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+		    else
+			O_VALD(out) = O_VALD(ap)
+		} else
+		    call amovd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALD(out) = max (O_VALD(ap), O_VALD(out))
+			else {
+			    call amaxkd (Memd[O_VALP(out)], O_VALD(ap),
+				Memd[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amaxd (Memd[O_VALP(out)], Memd[O_VALP(ap)],
+			    Memd[O_VALP(out)], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MIN:
+	    switch (optype) {
+
+	    case TY_SHORT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovks (O_VALS(ap), Mems[O_VALP(out)], nelem)
+		    else
+			O_VALS(out) = O_VALS(ap)
+		} else
+		    call amovs (Mems[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALS(out) = min (O_VALS(ap), O_VALS(out))
+			else {
+			    call aminks (Mems[O_VALP(out)], O_VALS(ap),
+				Mems[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amins (Mems[O_VALP(out)], Mems[O_VALP(ap)],
+			    Mems[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_INT:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovki (O_VALI(ap), Memi[O_VALP(out)], nelem)
+		    else
+			O_VALI(out) = O_VALI(ap)
+		} else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALI(out) = min (O_VALI(ap), O_VALI(out))
+			else {
+			    call aminki (Memi[O_VALP(out)], O_VALI(ap),
+				Memi[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amini (Memi[O_VALP(out)], Memi[O_VALP(ap)],
+			    Memi[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_LONG:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkl (O_VALL(ap), Meml[O_VALP(out)], nelem)
+		    else
+			O_VALL(out) = O_VALL(ap)
+		} else
+		    call amovl (Meml[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALL(out) = min (O_VALL(ap), O_VALL(out))
+			else {
+			    call aminkl (Meml[O_VALP(out)], O_VALL(ap),
+				Meml[O_VALP(out)], nelem)
+			}
+		    } else {
+			call aminl (Meml[O_VALP(out)], Meml[O_VALP(ap)],
+			    Meml[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_REAL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkr (O_VALR(ap), Memr[O_VALP(out)], nelem)
+		    else
+			O_VALR(out) = O_VALR(ap)
+		} else
+		    call amovr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALR(out) = min (O_VALR(ap), O_VALR(out))
+			else {
+			    call aminkr (Memr[O_VALP(out)], O_VALR(ap),
+				Memr[O_VALP(out)], nelem)
+			}
+		    } else {
+			call aminr (Memr[O_VALP(out)], Memr[O_VALP(ap)],
+			    Memr[O_VALP(out)], nelem)
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovkd (O_VALD(ap), Memd[O_VALP(out)], nelem)
+		    else
+			O_VALD(out) = O_VALD(ap)
+		} else
+		    call amovd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VALD(out) = min (O_VALD(ap), O_VALD(out))
+			else {
+			    call aminkd (Memd[O_VALP(out)], O_VALD(ap),
+				Memd[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amind (Memd[O_VALP(out)], Memd[O_VALP(ap)],
+			    Memd[O_VALP(out)], nelem)
+		    }
+		}
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_BOOL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_BOOL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ch = O_VALC(ap)
+		O_VALI(out) = btoi (ch == 'y' || ch == 'Y')
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALS(ap) != 0)
+		else {
+		    v_s = 0
+		    call abneks (Mems[O_VALP(ap)], v_s, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALI(ap) != 0)
+		else {
+		    v_i = 0
+		    call abneki (Memi[O_VALP(ap)], v_i, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALL(ap) != 0)
+		else {
+		    v_l = 0
+		    call abnekl (Meml[O_VALP(ap)], v_l, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALR(ap) != 0.0)
+		else {
+		    v_r = 0.0
+		    call abnekr (Memr[O_VALP(ap)], v_r, Memi[O_VALP(out)],
+			nelem)
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VALD(ap) != 0.0D0)
+		else {
+		    v_d = 0.0D0
+		    call abnekd (Memd[O_VALP(ap)], v_d, Memi[O_VALP(out)],
+			nelem)
+		}
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHORT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_SHORT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALS(out) = 0
+		else
+		    O_VALS(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALS(ap)
+		else
+		    call achtss (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALL(ap)
+		else
+		    call achtls (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALR(ap)
+		else
+		    call achtrs (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALD(ap)
+		else
+		    call achtds (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_INT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALS(ap)
+		else
+		    call achtsi (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call achtii (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALL(ap)
+		else
+		    call achtli (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALR(ap)
+		else
+		    call achtri (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALD(ap)
+		else
+		    call achtdi (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_LONG:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_LONG)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALL(out) = 0
+		else
+		    O_VALL(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALS(ap)
+		else
+		    call achtsl (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call achtil (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALL(ap)
+		else
+		    call achtll (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALR(ap)
+		else
+		    call achtrl (Memr[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALD(ap)
+		else
+		    call achtdl (Memd[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_NINT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = nint (v_d)
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALS(ap)
+		else
+		    call achtsi (Mems[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call achtii (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALL(ap)
+		else
+		    call achtli (Meml[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VALR(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Memr[O_VALP(ap)+i-1])
+		}
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VALD(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Memd[O_VALP(ap)+i-1])
+		}
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_REAL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_REAL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALR(out) = 0
+		else
+		    O_VALR(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALS(ap)
+		else
+		    call achtsr (Mems[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALL(ap)
+		else
+		    call achtlr (Meml[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALR(ap)
+		else
+		    call achtrr (Memr[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALD(ap)
+		else
+		    call achtdr (Memd[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_DOUBLE:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_DOUBLE)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALD(out) = 0
+		else
+		    O_VALD(out) = v_d
+
+
+	    case TY_SHORT:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALS(ap)
+		else
+		    call achtsd (Mems[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_INT:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_LONG:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALL(ap)
+		else
+		    call achtld (Meml[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_REAL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALR(ap)
+		else
+		    call achtrd (Memr[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_DOUBLE:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALD(ap)
+		else
+		    call achtdd (Memd[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_STR:
+	    optype = TY_CHAR
+	    if (O_TYPE(ap) == TY_CHAR)
+		nelem = strlen (O_VALC(ap))
+	    else
+		nelem = MAX_DIGITS
+	    call xvv_initop (out, nelem, TY_CHAR)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call sprintf (O_VALC(out), nelem, "%b")
+		    call pargi (O_VALI(ap))
+	    case TY_CHAR:
+		call sprintf (O_VALC(out), nelem, "%s")
+		    call pargstr (O_VALC(ap))
+
+	    case TY_SHORT:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargs (O_VALS(ap))
+
+	    case TY_INT:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargi (O_VALI(ap))
+
+	    case TY_LONG:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call pargl (O_VALL(ap))
+
+
+	    case TY_REAL:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call pargr (O_VALR(ap))
+
+	    case TY_DOUBLE:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call pargd (O_VALD(ap))
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	default:
+	    call xvv_error ("callfcn: unknown function type")
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xvv_freeop (args[i])
+
+	call sfree (sp)
+end
+
+
+# XVV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xvv_startarglist (arg, out)
+
+pointer	arg			#I pointer to first argument, or NULL
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap
+errchk	xvv_initop
+
+begin
+	call xvv_initop (out, LEN_ARGSTRUCT, TY_STRUCT)
+	ap = O_VALP(out)
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XVV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xvv_addarg (arg, arglist, out)
+
+pointer	arg			#I pointer to argument to be added
+pointer	arglist			#I pointer to operand pointing to arglist
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xvv_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XVV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xvv_error1 (fmt, arg)
+
+char	fmt[ARB]		#I printf format string
+char	arg[ARB]		#I string argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xvv_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		#I printf format string
+char	arg1[ARB]		#I string argument
+int	arg2			#I integer argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xvv_error (errmsg)
+
+char	errmsg[ARB]			#I error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XVV_CHTYPE -- Change the datatype of an operand.  The input and output
+# operands may be the same.
+
+procedure xvv_chtype (o1, o2, dtype)
+
+pointer	o1		#I input operand
+pointer	o2		#I output operand
+int	dtype		#I new datatype
+
+short	v_s
+int	v_i
+long	v_l
+real	v_r
+double	v_d
+pointer	vp, ip, op
+bool	float, freeval
+int	old_type, nelem, ch
+
+pointer	coerce()
+int	sizeof(), btoi(), gctod()
+string	s_badtype "chtype: invalid operand type"
+
+begin
+	old_type = O_TYPE(o1)
+	nelem = O_LEN(o1)
+
+	# No type conversion needed?
+	if (old_type == dtype) {
+	    if (o1 != o2) {
+		if (nelem <= 0)
+		    YYMOVE (o1, o2)
+		else {
+		    call xvv_initop (o2, nelem, old_type)
+		    call amovc (O_VALC(o1), O_VALC(o2), nelem * sizeof(dtype))
+		}
+	    }
+	    return
+	}
+
+	if (nelem <= 0) {
+	    # Scalar input operand.
+
+	    O_TYPE(o2) = dtype
+	    O_LEN(o2) = 0
+	    float = false
+
+	    # Read the old value into a local variable of type long or double.
+	    switch (old_type) {
+	    case TY_BOOL:
+		v_l = O_VALI(o1)
+	    case TY_CHAR:
+		v_l = 0  # null string?
+
+	    case TY_SHORT:
+		v_l = O_VALS(o1)
+
+	    case TY_INT:
+		v_l = O_VALI(o1)
+
+	    case TY_LONG:
+		v_l = O_VALL(o1)
+
+
+	    case TY_REAL:
+		v_d = O_VALR(o1)
+		float = true
+
+	    case TY_DOUBLE:
+		v_d = O_VALD(o1)
+		float = true
+
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Set the value of the output operand.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (float)
+		    O_VALI(o2) = btoi (v_d != 0)
+		else
+		    O_VALI(o2) = btoi (v_l != 0)
+	    case TY_CHAR:
+		call xvv_initop (o2, MAX_DIGITS, TY_CHAR)
+		if (float) {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%g")
+			call pargd (v_d)
+		} else {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%d")
+			call pargl (v_l)
+		}
+
+	    case TY_SHORT:
+		if (float)
+		    O_VALS(o2) = v_d
+		else
+		    O_VALS(o2) = v_l
+
+	    case TY_INT:
+		if (float)
+		    O_VALI(o2) = v_d
+		else
+		    O_VALI(o2) = v_l
+
+	    case TY_LONG:
+		if (float)
+		    O_VALL(o2) = v_d
+		else
+		    O_VALL(o2) = v_l
+
+
+	    case TY_REAL:
+		if (float)
+		    O_VALR(o2) = v_d
+		else
+		    O_VALR(o2) = v_l
+
+	    case TY_DOUBLE:
+		if (float)
+		    O_VALD(o2) = v_d
+		else
+		    O_VALD(o2) = v_l
+
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	} else {
+	    # Vector input operand.
+
+	    # Save a pointer to the input operand data vector, to avoid it
+	    # getting clobbered if O1 and O2 are the same operand.
+
+	    vp = O_VALP(o1)
+
+	    # If we have a char string input operand the output numeric
+	    # operand can only be a scalar.  If we have a char string output
+	    # operand nelem is the length of the string.
+
+	    if (old_type == TY_CHAR)
+		nelem = 0
+	    else if (dtype == TY_CHAR)
+		nelem = MAX_DIGITS
+
+	    # Initialize the output operand O2.  The freeval flag is cleared
+	    # cleared to keep the initop from freeing the input operand array,
+	    # inherited when the input operand is copied (or when the input
+	    # and output operands are the same).  We free the old operand
+	    # array manually below.
+
+	    if (o1 != o2)
+		YYMOVE (o1, o2)
+	    freeval = (and (O_FLAGS(o1), O_FREEVAL) != 0)
+	    O_FLAGS(o2) = and (O_FLAGS(o2), not(O_FREEVAL))
+	    call xvv_initop (o2, nelem, dtype)
+
+	    # Write output value.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (old_type == TY_CHAR) {
+		    ch = Memc[vp]
+		    O_VALI(o2) = btoi (ch == 'y' || ch == 'Y')
+		} else {
+		    switch (old_type) {
+
+		    case TY_SHORT:
+			v_s = 0
+			call abneks (Mems[vp], v_s, Memi[O_VALP(o2)], nelem)
+
+		    case TY_INT:
+			v_i = 0
+			call abneki (Memi[vp], v_i, Memi[O_VALP(o2)], nelem)
+
+		    case TY_LONG:
+			v_l = 0
+			call abnekl (Meml[vp], v_l, Memi[O_VALP(o2)], nelem)
+
+		    case TY_REAL:
+			v_r = 0.0
+			call abnekr (Memr[vp], v_r, Memi[O_VALP(o2)], nelem)
+
+		    case TY_DOUBLE:
+			v_d = 0.0D0
+			call abnekd (Memd[vp], v_d, Memi[O_VALP(o2)], nelem)
+
+		    default:
+			call xvv_error (s_badtype)
+		    }
+		}
+
+	    case TY_CHAR:
+		call xvv_error (s_badtype)
+
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		switch (old_type) {
+		case TY_BOOL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+		case TY_CHAR:
+		    ip = vp
+		    if (gctod (Memc, ip, v_d) <= 0)
+			v_d = 0
+		    switch (dtype) {
+
+		    case TY_SHORT:
+			O_VALS(o2) = v_d
+
+		    case TY_INT:
+			O_VALI(o2) = v_d
+
+		    case TY_LONG:
+			O_VALL(o2) = v_d
+
+		    case TY_REAL:
+			O_VALR(o2) = v_d
+
+		    case TY_DOUBLE:
+			O_VALD(o2) = v_d
+
+		    }
+
+		case TY_SHORT:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achts (Mems[vp], Memc[op], nelem, dtype)
+
+		case TY_INT:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+
+		case TY_LONG:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtl (Meml[vp], Memc[op], nelem, dtype)
+
+		case TY_REAL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtr (Memr[vp], Memc[op], nelem, dtype)
+
+		case TY_DOUBLE:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achtd (Memd[vp], Memc[op], nelem, dtype)
+
+		default:
+		    call xvv_error (s_badtype)
+		}
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Free old operand value.
+	    if (freeval)
+		call mfree (vp, old_type)
+	}
+end
+
+
+# XVV_INITOP -- Initialize an operand, providing storage for an operand value
+# of the given size and type.
+
+procedure xvv_initop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xvv_makeop (o, o_len, o_type)
+end
+
+
+# XVV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xvv_makeop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    if (o_type == TY_BOOL)
+		call malloc (O_VALP(o), o_len, TY_INT)
+	    else
+		call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+
+	O_FLAGS(o) = O_FREEVAL
+end
+
+
+# XVV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xvv_freeop (o)
+
+pointer	o		#I pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Either free operand struct or clear the operand type to mark
+	# operand invalid.
+
+	if (and (O_FLAGS(o), O_FREEOP) != 0)
+	    call mfree (o, TY_STRUCT)
+	else
+	    O_TYPE(o) = 0
+end
+
+
+# XVV_LOADSYMBOLS -- Load a list of symbol names into a symbol table.  Each
+# symbol is tagged with an integer code corresponding to its sequence number
+# in the symbol list.
+
+pointer procedure xvv_loadsymbols (s)
+
+char	s[ARB]			#I symbol list "|sym1|sym2|...|"
+
+int	delim, symnum, ip
+pointer	sp, symname, st, sym, op
+pointer	stopen(), stenter()
+
+begin
+	call smark (sp)
+	call salloc (symname, SZ_FNAME, TY_CHAR)
+
+	st = stopen ("evvexpr", LEN_INDEX, LEN_STAB, LEN_SBUF)
+	delim = s[1]
+	symnum = 0
+
+	for (ip=2;  s[ip] != EOS;  ip=ip+1) {
+	    op = symname
+	    while (s[ip] != delim && s[ip] != EOS) {
+		Memc[op] = s[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+	    symnum = symnum + 1
+
+	    if (op > symname && IS_ALPHA(Memc[symname])) {
+		sym = stenter (st, Memc[symname], LEN_SYM)
+		SYM_CODE(sym) = symnum
+	    }
+	}
+
+	call sfree (sp)
+	return (st)
+end
+
+
+# XVV_NULL -- Return a null value to be used when a computation cannot be
+# performed and range checking is enabled.  Perhaps we should permit a user
+# specified value here, however this doesn't really work in an expression
+# evaluator since the value generated may be used in subsequent calculations
+# and hence may change.  If more careful treatment of out of range values
+# is needed a conditional expression can be used in which case the value
+# we return here is ignored (but still needed to avoid a hardware exception
+# when computing a vector).
+
+
+short procedure xvv_nulls (ignore)
+short	ignore			#I ignored
+begin
+	return (0)
+end
+
+int procedure xvv_nulli (ignore)
+int	ignore			#I ignored
+begin
+	return (0)
+end
+
+long procedure xvv_nulll (ignore)
+long	ignore			#I ignored
+begin
+	return (0)
+end
+
+real procedure xvv_nullr (ignore)
+real	ignore			#I ignored
+begin
+	return (0.0)
+end
+
+double procedure xvv_nulld (ignore)
+double	ignore			#I ignored
+begin
+	return (0.0D0)
+end
+
diff --git a/sys/fmtio/fmt.com b/sys/fmtio/fmt.com
new file mode 100644
index 00000000..3f6d2525
--- /dev/null
+++ b/sys/fmtio/fmt.com
@@ -0,0 +1,17 @@
+# Printf common block.
+
+int	fd			# output file
+int	ip			# pointer to next char in format string
+int	width, decpl		# field width, number of decimal places
+int	col			# output column
+int	left_justify		# left or right justify output in field
+int	radix			# output radix
+int	fmt_state		# current state of FPRFMT (gets a format)
+int	ofile_type		# type of output file
+int	format_char 		# format type character (bcdefghmorstuxz#*)
+char	fill_char		# filler char for rt. justification
+char	format[SZ_OBUF]		# format string
+char	obuf[SZ_OBUF]		# for formatting output
+
+common	/fmtcom/  fd,ip,width,decpl,col,left_justify,radix,fmt_state,
+		  ofile_type,format_char,fill_char,format,obuf
diff --git a/sys/fmtio/fmterr.x b/sys/fmtio/fmterr.x
new file mode 100644
index 00000000..7a341764
--- /dev/null
+++ b/sys/fmtio/fmterr.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FMT_ERR -- Print the format string on the standard error output, marking
+# the position within the string to which the error refers.
+
+procedure fmt_err (preamble, format, index)
+
+char	preamble[ARB], format[ARB]
+int	index, ip
+
+begin
+	call putline (STDERR, "(")
+	call putline (STDERR, preamble)
+	call putline (STDERR, "format = \"")
+
+	for (ip=1;  ip < index && format[ip] != EOS;  ip=ip+1)
+	    call putcc (STDERR, format[ip])
+
+	if (format[ip] != EOS) {			# mark position of error
+	    call putline (STDERR, "<>")
+	    for (;  format[ip] != EOS;  ip=ip+1)
+		call putcc (STDERR, format[ip])
+	}
+	call putline (STDERR, "\")\n")
+end
diff --git a/sys/fmtio/fmtinit.x b/sys/fmtio/fmtinit.x
new file mode 100644
index 00000000..0d8ea547
--- /dev/null
+++ b/sys/fmtio/fmtinit.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# FMT_INIT -- The following is called by SPRINTF and CLPRINTF to set a flag to
+# close the mem file or finish the CL command, respectively, when
+# the end of the format string is reached.  This entry is also called
+# by the iraf main at startup time to initialize the printf common.
+
+procedure fmt_init (ftype)
+
+int	ftype
+include	"fmt.com"
+
+begin
+	if (ftype == FMT_INITIALIZE) {
+	    ip = 1
+	    format[ip] = EOS
+	    ofile_type = REGULAR_FILE			# fpradv
+	    fmt_state = FMT_START			# fprfmt
+	} else
+	    ofile_type = ftype
+end
diff --git a/sys/fmtio/fmtread.x b/sys/fmtio/fmtread.x
new file mode 100644
index 00000000..e7506ab9
--- /dev/null
+++ b/sys/fmtio/fmtread.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# FMT_READ -- Read and interpret a format specification.  Called in
+# circumstances where a NOT_DONE_YET return from FPRFMT is certain to
+# indicate a missing PARGI type argument.  If this happens, print warning
+# message, and exhaust format string so that default formats will be used.
+
+procedure fmt_read()
+
+int	fprfmt()
+include	"fmt.com"
+
+begin
+	while (fprfmt(0) != ALL_DONE) {			# read format
+	    call putline (STDERR, "Warning: Missing argument to printf\n")
+	    call fmt_err ("", format, ip)
+	    while (format[ip] != EOS)			# discard rest of format
+		ip = ip + 1
+	    fmt_state = FMT_START			# set defaults
+	}
+end
diff --git a/sys/fmtio/fmtsetcol.x b/sys/fmtio/fmtsetcol.x
new file mode 100644
index 00000000..a8d06855
--- /dev/null
+++ b/sys/fmtio/fmtsetcol.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<printf.h>
+
+# FMT_SETCOL -- Called when a control character is output, to keep track of
+# the column index during output, for the "%nt" (tabulate) format.  Columns
+# are indexed from the start of the printf, rather than in absolute units on
+# the output, unless a \r or \n is output during the print.
+
+procedure fmt_setcol (ch, col)
+
+char	ch
+int	col
+
+begin
+	switch (ch) {
+	case '\t':					# next tab stop
+	    col = ((col + TABSTOP-1) / TABSTOP) * TABSTOP + 1
+	case '\n', '\r', '\f':
+	    col = 1
+	case '\b':
+	    col = col - 1
+	default:
+	    if (IS_PRINT (ch))
+		col = col + 1
+	}
+end
diff --git a/sys/fmtio/fmtstr.x b/sys/fmtio/fmtstr.x
new file mode 100644
index 00000000..197ea2bd
--- /dev/null
+++ b/sys/fmtio/fmtstr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# FMTSTR -- Place a string in a field of the given width, left or right
+# justifying as indicated, and output to the named file.  The length of
+# the text string may exceed the field width, in which case there is no
+# filling.
+
+procedure fmtstr (fd, str, col, fill_char, left_justify, maxch, width)
+		    
+int	fd			# output file
+char	str[ARB]		# string to be output
+int	col			# column: both input and output parameter
+char	fill_char		# fill character, if right justify
+int	left_justify		# YES or NO
+int	maxch			# maximum string chars to output
+int	width			# field width
+int	nchars, nfill, ip
+int	strlen()
+errchk	putc, putci
+
+begin
+	if (fd <= 0)
+	    return
+
+	if (width > 0) {
+	    nchars = min (maxch, strlen(str))
+	    nfill = max (0, width - nchars)
+	} else {
+	    nchars = maxch
+	    nfill = 0						# free format
+	}
+
+	if (left_justify == NO)					# fill at left
+	    for (col=col+nfill;  nfill > 0;  nfill=nfill-1)
+		call putc (fd, fill_char)
+
+	for (ip=1;  str[ip] != EOS && ip <= nchars;  ip=ip+1) {	# put string
+	    call putc (fd, str[ip])
+	    if (IS_PRINT (str[ip]))
+		col = col + 1
+	    else
+		call fmt_setcol (str[ip], col)
+	}
+
+	for (col=col+nfill;  nfill > 0;  nfill=nfill-1)		# fill at right
+	    call putci (fd, ' ')
+end
diff --git a/sys/fmtio/fpradv.x b/sys/fmtio/fpradv.x
new file mode 100644
index 00000000..942c29aa
--- /dev/null
+++ b/sys/fmtio/fpradv.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<printf.h>
+
+# FPRADV -- Copy format chars to output until next "%w.dC" format sequence is
+# encountered, or until EOS is encountered on format string.  When EOS is
+# encountered, return buffer containing format string, and if mem_flag is set,
+# close the output file (a string) as well.  If a format string contains no
+# regular format sequences, and hence requires no PARG_ calls, we are all done.
+
+procedure fpradv()
+
+int	i, junk, ival, ch
+char	cch
+int	ip_save
+int	ctoi(), cctoc()
+include "fmt.com"
+errchk	putci
+
+begin
+	for (ch = format[ip];  ch != EOS;  ch = format[ip]) {
+	    cch = ch
+	    if (ch == ESCAPE) {
+		junk = cctoc (format, ip, cch)
+
+	    } else if (ch == START_OF_FORMAT) {
+		if (format[ip+1] == START_OF_FORMAT)	# '%%' --> '%'
+		    ip = ip + 2
+
+		else if (IS_DIGIT (format[ip+1])) {	# %Nw or %Nt
+		    ip_save = ip			# ip_save --> '%'
+		    ip = ip + 1
+
+		    junk = ctoi (format, ip, ival)
+
+		    switch (format[ip]) {
+		    case FMT_WHITESPACE:		# output blanks
+			do i = 1, ival
+			    call putci (fd, BLANK)
+			col = col + ival
+		    case FMT_TOCOLUMN:			# advance to column
+			for (;  col < ival;  col=col+1)
+			    call putci (fd, BLANK)
+		    default:
+			ip = ip_save			# regular format spec
+			return
+		    }
+
+		    ip = ip + 1				# eat "t" or "w"
+		    next
+
+		} else
+		    return				# regular format spec
+
+	    } else
+		ip = ip + 1
+
+	    call putc (fd, cch)				# output ordinary chars
+	    if (IS_PRINT (cch))				# keep track of column
+		col = col + 1
+	    else
+		call fmt_setcol (cch, col)
+	}
+
+	switch (ofile_type) {				# EOS of format reached
+	case STRING_FILE:
+	    call close (fd)
+	case CL_PARAM:
+	    call putline (CLOUT, "\"\n")
+	}
+
+	ofile_type = REGULAR_FILE			# restore default
+	fd = NULL
+end
diff --git a/sys/fmtio/fprfmt.x b/sys/fmtio/fprfmt.x
new file mode 100644
index 00000000..d5e68fb6
--- /dev/null
+++ b/sys/fmtio/fprfmt.x
@@ -0,0 +1,180 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<printf.h>
+
+.help
+.nf _________________________________________________________________________
+Process a format descriptor, setting the variables "decpl", "fill_char",
+"format_char", and "width" in the fmtio common.  Called from PARG_
+to determine the format specification for printing a variable.
+
+Format: "%[w[.d]]C[n]", where W is the field width, D the number of decimal
+places or precision, C the format type character, and N the radix numeral,
+for format type FMT_RADIX only.  A negative field width signifies left
+justification.  A leading zero in the W field sets the fill character to the
+numeral zero (when right justifying).  Default values will be supplied if
+any of the fields are omitted.  The minimum format is "%C".
+
+If any of the fields (wdCn) have the value GET_FIELD (= "*") the value of
+the field will be taken from the next PARG_ call, rather than from the
+format string.  This makes it easy to vary the format specification at run
+time.  For example, "%10.*g" would print a number in G-floating format,
+with a constant field width of 10, and with the number of digits of precision
+being given by a PARGI call at execution time (followed by a PARG_ call to
+pass the value to be printed).
+.endhelp ____________________________________________________________________
+
+# The following macro marks the position in the FPRFMT procedure (saves the
+# code for the needed field), and returns the not done status to PARG_.
+# A subsequent call to a PARG_ (with the value of the field we are waiting for
+# as argument) causes FPRFMT to be reentered at the point where we left off.
+
+define	(waitfor,	if (ival_already_used) { fmt_state = $1; return (NOT_DONE_YET) } ; $1 ival_already_used = true)
+
+#define	(waitfor,	if (ival_already_used) {
+#			    fmt_state = $1
+#			    return (NOT_DONE_YET)
+#			}
+#			$1 ival_already_used = true)
+
+# FPRFMT -- Process a %W.Dn format specification.  ALL_DONE is returned when
+# the format specification has been fully processed, else NOT_DONE_YET is
+# returned, indicating that an additional PARG call is required to complete
+# the format (which therefore contained one or more "*" specifiers).
+
+int procedure fprfmt (ival)
+
+int	ival					# argument value (from parg_)
+bool	ival_already_used			# wait for next parg
+int	ctoi(), stridx()
+char	ch, chrlwr()
+include "fmt.com"
+
+begin
+	# This routine functions as a coroutine.  If one of the fields in
+	# the format spec is to be given in a pargi call, an early return
+	# is taken.  The routine is later reentered with the value of the
+	# needed field, and execution continues at the point it left off.
+	# (Sorry, I could not think of a simpler way to do it...)
+
+	switch (fmt_state) {				# return from "waitfor"
+	case FMT_START:					# initial state
+	    ival_already_used = false
+	case GET_WIDTH_1:				# "%*.dC"
+	    goto GET_WIDTH_1
+	case GET_WIDTH_2:				# "%-0*.dC"
+	    goto GET_WIDTH_2
+	case GET_DECPL:					# "%w.*C"
+	    goto GET_DECPL
+	case GET_FMTCHAR:				# "%w.d*"
+	    goto GET_FMTCHAR
+	case GET_RADIX:					# "%w.dr*"
+	    goto GET_RADIX
+	case GET_OPERAND:				# used ival for format
+	    goto GET_OPERAND
+	}
+	
+	# It is not an error if there is no format string.
+	if (format[ip] == EOS || format[ip] != START_OF_FORMAT) {
+	    width = USE_DEFAULT
+	    decpl = USE_DEFAULT
+	    format_char = USE_DEFAULT
+	    fill_char = ' '
+	    left_justify = NO
+	    fmt_state = FMT_START
+	    return (ALL_DONE)
+	} else
+	    ip = ip + 1					# eat the "%"
+	    
+	if (format[ip] == GET_FIELD) {			# "%*.dC"
+	    ip = ip + 1
+	    waitfor (GET_WIDTH_1)			# go get field width...
+	    if (ival < 0)				# ...and come back here
+		left_justify = YES
+	    else
+		left_justify = NO
+
+	    fill_char = ' '
+	    width = abs (ival)
+
+	} else {					# "%-0*.dC"
+	    if (format[ip] == '-') {			# left or right justify
+		left_justify = YES
+		ip = ip + 1
+	    } else
+		left_justify = NO
+
+	    fill_char = ' '				# zero or blank fill
+	    if (format[ip] == '0') {
+		if (IS_DIGIT (format[ip+1]) || format[ip+1] == GET_FIELD) {
+		    fill_char = '0'
+		    ip = ip + 1
+		} else
+		    fill_char = ' '
+	    }
+
+	    if (format[ip] == GET_FIELD) {
+		ip = ip + 1
+		waitfor (GET_WIDTH_2)			# go get field width...
+		if (ival < 0)				# ... and come back here
+		    left_justify = YES
+		else
+		    left_justify = NO
+		width = abs (ival)
+
+	    } else if (ctoi (format, ip, width) <= 0)	# "%N.dC"
+		width = USE_DEFAULT
+	}
+
+	if (width == 0)					# make as big as needed
+	    width = USE_DEFAULT
+
+	if (format[ip] == '.') {			# get decpl field
+	    ip = ip + 1
+	    if (format[ip] == GET_FIELD) {		# "%w.*C"
+		ip = ip + 1
+		waitfor (GET_DECPL)
+		decpl = ival
+	    } else if (ctoi (format, ip, decpl) <= 0)	# "%w.NC"
+		decpl = USE_DEFAULT
+	} else
+	    decpl = USE_DEFAULT
+
+	if (format[ip] == GET_FIELD) {			# "%w.d*"
+	    ip = ip + 1
+	    waitfor (GET_FMTCHAR)
+	    format_char = ival
+	} else {
+	    format_char = format[ip]			# "%w.dC"
+	    ip = ip + 1
+	}
+
+	ch = format_char
+	if (stridx (ch, "bcdefghHmMorstuwxz") <= 0) {
+	    call putline (STDERR, "Warning: Unknown format type char\n")
+	    call fmt_err ("", format, ip-1)
+	    format_char = USE_DEFAULT
+
+	} else if (format_char == FMT_RADIX) {		# get radix
+	    ch = chrlwr (format[ip])
+	    ip = ip + 1
+	    if (ch == GET_FIELD) {			# "%w.dr*"
+		waitfor (GET_RADIX)
+		radix = ival
+	    } else if (IS_DIGIT (ch)) {
+		radix = TO_INTEG (ch)
+	    } else if (IS_LOWER (ch)) {
+		radix = ch - 'a' + 10
+	    } else {
+		radix = DECIMAL
+		ip = ip - 1
+	    }
+
+	} else if (format_char == FMT_WHITESPACE || format_char == FMT_TOCOLUMN)
+	    ival_already_used = false			# no operand
+
+	waitfor (GET_OPERAND)				# used ival for format,
+	fmt_state = FMT_START				# need to get another
+	return (ALL_DONE)
+end
diff --git a/sys/fmtio/fprintf.x b/sys/fmtio/fprintf.x
new file mode 100644
index 00000000..dd5304d2
--- /dev/null
+++ b/sys/fmtio/fprintf.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# FPRINTF  -- Format output to a file.
+
+procedure fprintf (fd, format_string)
+
+int	fd
+char	format_string[ARB]
+
+begin
+	call fprntf (fd, format_string, REGULAR_FILE)
+end
diff --git a/sys/fmtio/fprntf.x b/sys/fmtio/fprntf.x
new file mode 100644
index 00000000..095b57b2
--- /dev/null
+++ b/sys/fmtio/fprntf.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# FPRNTF -- Initiate a formatted print.  Called by FPRINTF, SPRINTF, etc.
+# Check that the previous print has completed, initialize the current
+# print, and advance to the first format specification (if any).
+
+procedure fprntf (new_fd, format_string, file_type)
+
+int	new_fd, file_type
+char	format_string[ARB]
+include "fmt.com"
+
+begin
+	# Printf is not reentrant.  An expression in a PARG_ call must not
+	# directly or indirectly call any of the printf entry points.  There
+	# must be a PARG_ for each "%w.dC" format specification in the format
+	# string.  Errors result in lost output, but are otherwise harmless,
+	# and are diagnosed below.
+
+ 	if (format[ip] != EOS) {
+	    call putline (STDERR, "Warning: Incomplete or reentrant printf\n")
+	    call fmt_err ("Old ", format, ip)
+	    call fmt_err ("New ", format_string, ARB)
+
+	    while (format[ip] != EOS)		# discard rest of format string
+		ip = ip + 1
+	    call fpradv()			# possibly close mem file
+	}
+
+	fd = new_fd				# normal initialization
+	ip = 1	
+	col = 1
+	fmt_state = FMT_START			# initialize FPRFMT state
+	ofile_type = file_type
+
+	call strcpy (format_string, format, SZ_OBUF)
+	call fpradv()
+end
diff --git a/sys/fmtio/fscan.x b/sys/fmtio/fscan.x
new file mode 100644
index 00000000..4a76c772
--- /dev/null
+++ b/sys/fmtio/fscan.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FSCAN -- Begin scanning a line from a file.
+
+int procedure fscan (fd)
+
+int	fd
+int	getlline()
+include	"scan.com"
+errchk	getlline
+
+begin
+	if (getlline (fd, sc_scanbuf, SZ_SCANBUF) == EOF)
+	    return (EOF)
+	else {
+	    call reset_scan()
+	    return (OK)
+	}
+end
+
+
+# SCAN -- Scan the standard input.
+
+int procedure scan()
+
+int	fscan()
+
+begin
+	return (fscan (STDIN))
+end
diff --git a/sys/fmtio/gargb.x b/sys/fmtio/gargb.x
new file mode 100644
index 00000000..82d9e0cb
--- /dev/null
+++ b/sys/fmtio/gargb.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# GARGB -- Interpret the next token in the input as a boolean quantity
+# (token "y...." or "n....").
+
+procedure gargb (bval)
+
+bool	bval
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	while (IS_WHITE (sc_scanbuf[sc_ip]))
+	    sc_ip = sc_ip + 1
+
+	switch (sc_scanbuf[sc_ip]) {
+	case 'Y','y':
+	    bval = true
+	case 'N','n':
+	    bval = false
+	default:
+	    sc_stopscan = true
+	    return
+	}
+
+	while (IS_ALPHA(sc_scanbuf[sc_ip]) || sc_scanbuf[sc_ip] == '_')
+	    sc_ip = sc_ip + 1
+	sc_ntokens = sc_ntokens + 1
+end
diff --git a/sys/fmtio/gargc.x b/sys/fmtio/gargc.x
new file mode 100644
index 00000000..e6ce6996
--- /dev/null
+++ b/sys/fmtio/gargc.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGC -- Interpret the next input token as a character constant.
+
+procedure gargc (cval)
+
+char	cval
+int	cctoc()
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	if (cctoc (sc_scanbuf, sc_ip, cval) > 0)
+	    sc_ntokens = sc_ntokens + 1
+	else
+	    sc_stopscan = true
+end
diff --git a/sys/fmtio/gargd.x b/sys/fmtio/gargd.x
new file mode 100644
index 00000000..cb8c4561
--- /dev/null
+++ b/sys/fmtio/gargd.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGD -- Interpret the next input token as a double precision floating
+# number.
+
+procedure gargd (dval)
+
+double	dval
+int	gctod()
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	if (gctod (sc_scanbuf, sc_ip, dval) > 0)
+	    sc_ntokens = sc_ntokens + 1
+	else
+	    sc_stopscan = true
+end
diff --git a/sys/fmtio/gargi.x b/sys/fmtio/gargi.x
new file mode 100644
index 00000000..5b53bba8
--- /dev/null
+++ b/sys/fmtio/gargi.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GARGI -- Interpret the next input token as an integer quantity.
+
+procedure gargi (ival)
+
+int	ival
+double	dval
+
+begin
+	call gargd (dval)
+	if (IS_INDEFD (dval))
+	    ival = INDEFI
+	else if (abs(dval) > MAX_INT)
+	    ival = INDEFI
+	else
+	    ival = dval
+end
diff --git a/sys/fmtio/gargl.x b/sys/fmtio/gargl.x
new file mode 100644
index 00000000..142ac0e1
--- /dev/null
+++ b/sys/fmtio/gargl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GARGL -- Interpret the next input token as an integer quantity.
+
+procedure gargl (lval)
+
+long	lval
+double	dval
+
+begin
+	call gargd (dval)
+	if (IS_INDEFD (dval))
+	    lval = INDEFL
+	else if (abs(dval) > MAX_LONG)
+	    lval = INDEFL
+	else
+	    lval = dval
+end
diff --git a/sys/fmtio/gargr.x b/sys/fmtio/gargr.x
new file mode 100644
index 00000000..4f25d717
--- /dev/null
+++ b/sys/fmtio/gargr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGR -- Interpret the next input token as a single precision floating
+# quantity.
+
+procedure gargr (rval)
+
+real	rval
+double	dval
+
+begin
+	call gargd (dval)
+	if (IS_INDEFD (dval))
+	    rval = INDEFR
+	else
+	    rval = dval
+end
diff --git a/sys/fmtio/gargrad.x b/sys/fmtio/gargrad.x
new file mode 100644
index 00000000..8ff78bf8
--- /dev/null
+++ b/sys/fmtio/gargrad.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGRAD -- Convert the next number using the radix given as the second
+# argument.
+
+procedure gargrad (lval, radix)
+
+long	lval
+int	radix, gctol()
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	if (gctol (sc_scanbuf, sc_ip, lval, radix) > 0)
+	    sc_ntokens = sc_ntokens + 1
+	else
+	    sc_stopscan = true
+end
diff --git a/sys/fmtio/gargs.x b/sys/fmtio/gargs.x
new file mode 100644
index 00000000..193a725f
--- /dev/null
+++ b/sys/fmtio/gargs.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GARGS -- Interpret the next input token as an integer quantity.
+
+procedure gargs (sval)
+
+short	sval
+double	dval
+
+begin
+	call gargd (dval)
+	if (IS_INDEFD (dval))
+	    sval = INDEFS
+	else if (abs(dval) > MAX_SHORT)
+	    sval = INDEFS
+	else
+	    sval = dval
+end
diff --git a/sys/fmtio/gargstr.x b/sys/fmtio/gargstr.x
new file mode 100644
index 00000000..9ae30462
--- /dev/null
+++ b/sys/fmtio/gargstr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGSTR -- Return the remainder of the scanned input line as a string.
+
+procedure gargstr (outstr, maxch)
+
+char	outstr[ARB]
+int	maxch, op
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	for (op=1;  op <= maxch && sc_scanbuf[sc_ip] != EOS;  op=op+1) {
+	    if (sc_scanbuf[sc_ip] == '\n')
+		break					# don't keep newlines
+	    outstr[op] = sc_scanbuf[sc_ip]
+	    sc_ip = sc_ip + 1
+	}
+
+	outstr[op] = EOS
+	sc_ntokens = sc_ntokens + 1			# null strings are ok
+end
diff --git a/sys/fmtio/gargtok.x b/sys/fmtio/gargtok.x
new file mode 100644
index 00000000..b775c7ea
--- /dev/null
+++ b/sys/fmtio/gargtok.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGTOK -- Return the next token from the scanned input line.
+
+procedure gargtok (token, outstr, maxch)
+
+int	token
+char	outstr[ARB]
+int	maxch, ctotok()
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	sc_ntokens = sc_ntokens + 1		# Newline, EOS are legal tokens
+	token = ctotok (sc_scanbuf, sc_ip, outstr, maxch)
+end
diff --git a/sys/fmtio/gargwrd.x b/sys/fmtio/gargwrd.x
new file mode 100644
index 00000000..cc8aa695
--- /dev/null
+++ b/sys/fmtio/gargwrd.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGWRD -- Return the next whitespace delimited token or quoted string from
+# the scan buffer.
+
+procedure gargwrd (outstr, maxch)
+
+char	outstr[ARB]
+int	maxch, ctowrd()
+include	"scan.com"
+
+begin
+	if (sc_stopscan) {
+	    outstr[1] = EOS
+	    return
+	}
+
+	if (ctowrd (sc_scanbuf, sc_ip, outstr, maxch) > 0)
+	    sc_ntokens = sc_ntokens + 1
+	else
+	    sc_stopscan = true
+end
diff --git a/sys/fmtio/gargx.x b/sys/fmtio/gargx.x
new file mode 100644
index 00000000..2a1be607
--- /dev/null
+++ b/sys/fmtio/gargx.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GARGX -- Interpret the next input token as a complex number.
+
+procedure gargx (xval)
+
+complex	xval
+int	gctox()
+include	"scan.com"
+
+begin
+	if (sc_stopscan)
+	    return
+
+	if (gctox (sc_scanbuf, sc_ip, xval) > 0)
+	    sc_ntokens = sc_ntokens + 1
+	else
+	    sc_stopscan = true
+end
diff --git a/sys/fmtio/gctod.x b/sys/fmtio/gctod.x
new file mode 100644
index 00000000..ff58555b
--- /dev/null
+++ b/sys/fmtio/gctod.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<lexnum.h>
+
+define	OCTAL		8
+define	DECIMAL		10
+define	HEX		16
+
+
+# GCTOD -- General character string to double precision real.  Any legal
+# number, e.g., integer, floating point, complex, or character constant,
+# is decoded and returned as a double.
+
+int procedure gctod (str, ip, odval)
+
+char	str[ARB]		# input string
+int	ip			# pointer into input string
+double	odval			# output double
+
+char	ch
+double	dval
+complex	xval
+long	lval
+int	ip_save, radix, nchars, vtype
+int	ctox(), cctoc(), ctod(), gctol(), lexnum()
+
+begin
+	vtype = TY_DOUBLE				# val to be returned
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+
+	ip_save = ip
+	ch = str[ip]					# first nonwhite
+
+	if (ch == '(') {				# complex number?
+	    if (ctox (str, ip, xval) <= 0)
+		return (0)				# not a number
+	    else
+		vtype = TY_COMPLEX
+
+	} else if (ch == SQUOTE || ch == ESCAPE) {
+	    if (cctoc (str, ip, ch) <= 0)		# character constant?
+		return (0)
+	    else
+		dval = ch
+
+	} else {				# determine type of number
+	    switch (lexnum (str, ip, nchars)) {
+	    case LEX_OCTAL:
+		radix = OCTAL
+	    case LEX_DECIMAL:
+		radix = DECIMAL
+	    case LEX_HEX:
+		radix = HEX
+	    case LEX_REAL:
+		radix = TY_REAL
+	    default:
+		return (0)
+	    }
+
+	    if (radix == TY_REAL)		# perform the conversion
+		nchars = ctod (str, ip, dval)
+	    else {
+		nchars = gctol (str, ip, lval, radix)
+		dval = lval
+		if (IS_INDEFL (lval))
+		    dval = INDEFD
+	    }
+	}
+
+	if (vtype == TY_COMPLEX) {
+	    odval = xval
+	    if (IS_INDEFX (xval))
+		odval = INDEFD
+	} else
+	    odval = dval
+
+	return (ip - ip_save)
+end
diff --git a/sys/fmtio/gctol.x b/sys/fmtio/gctol.x
new file mode 100644
index 00000000..f1478ff0
--- /dev/null
+++ b/sys/fmtio/gctol.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+define	OCTAL		8
+define	DECIMAL		10
+define	HEX		16
+
+.help gctol
+.nf _______________________________________________________________________
+GCTOL -- Convert string to long integer (any radix).  The long integer
+value is returned in LVAL, and the pointer IP is left pointing at the
+first character following the number.  IP must be set to the index of
+the character at which conversion is to start before calling GCTOL.
+
+If the conversion radix is octal (hex), and the number is immediately
+followed by the suffix "b|B" ("x|X"), IP will be advanced past the suffix
+character, which is considered to be part of the number.
+.endhelp __________________________________________________________________
+
+
+int procedure gctol (str, ip, lval, radix)
+
+char	str[ARB]		# string to be decoded
+int	ip			# pointer within string
+int	radix			# radix of number
+long	lval			# output variable
+
+int	digit, base, ip_save, first_char
+char	ch
+bool	neg
+
+begin
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+	ip_save = ip
+	
+	neg = (str[ip] == '-')
+	if (neg || str[ip] == '+')		# eat the +/-
+	    ip = ip + 1
+
+	first_char = ip
+	base = abs (radix)
+
+	# The first character (following than the sign character) must be
+	# a digit, regardless of the radix.
+
+	for (lval=0;  str[ip] != EOS;  ip=ip+1) {
+	    ch = str[ip]
+
+	    if (IS_DIGIT (ch))			# cvt char to binary
+		digit = TO_INTEG (ch)
+	    else if (base > DECIMAL) {
+		if (IS_UPPER (ch))
+		    ch = TO_LOWER (ch)
+		else if (! IS_LOWER (ch))
+		    break
+		digit = ch - 'a' + 10		# for radices > 10
+	    } else
+		break
+
+	    if (digit < 0 || digit >= base)
+		break
+	    lval = lval * base + digit
+	}
+	
+ 	if (neg)
+	    lval = -lval
+
+	if (ip == first_char)			# not a number ?
+	    ip = ip_save			# restore pointer
+	else if (radix == OCTAL && ch == 'b' || ch == 'B')
+	    ip = ip + 1
+	else if (radix == HEX && ch == 'x' || ch == 'X')
+	    ip = ip + 1				# eat suffix char
+
+	return (ip - first_char)
+end
diff --git a/sys/fmtio/gctox.x b/sys/fmtio/gctox.x
new file mode 100644
index 00000000..2a23a917
--- /dev/null
+++ b/sys/fmtio/gctox.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<lexnum.h>
+
+define	OCTAL		8
+define	DECIMAL		10
+define	HEX		16
+
+
+# GCTOX -- General character string to complex.  Any legal number, e.g.,
+# integer, floating point, complex, or character constant, is decoded and
+# returned as a complex.
+
+int procedure gctox (str, ip, oxval)
+
+char	str[ARB]		# input string
+int	ip			# pointer into input string
+complex	oxval			# output complex
+
+char	ch
+double	dval
+complex	xval
+long	lval
+int	ip_save, radix, nchars, vtype
+int	ctox(), cctoc(), ctod(), gctol(), lexnum()
+
+begin
+	vtype = TY_DOUBLE				# val to be returned
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+
+	ip_save = ip
+	ch = str[ip]					# first nonwhite
+
+	if (ch == '(') {				# complex number?
+	    if (ctox (str, ip, xval) <= 0)
+		return (0)				# not a number
+	    else
+		vtype = TY_COMPLEX
+
+	} else if (ch == SQUOTE || ch == ESCAPE) {
+	    if (cctoc (str, ip, ch) <= 0)		# character constant?
+		return (0)
+	    else
+		dval = ch
+
+	} else {				# determine type of number
+	    switch (lexnum (str, ip, nchars)) {
+	    case LEX_OCTAL:
+		radix = OCTAL
+	    case LEX_DECIMAL:
+		radix = DECIMAL
+	    case LEX_HEX:
+		radix = HEX
+	    case LEX_REAL:
+		radix = TY_REAL
+	    default:
+		return (0)
+	    }
+
+	    if (radix == TY_REAL)		# perform the conversion
+		nchars = ctod (str, ip, dval)
+	    else {
+		nchars = gctol (str, ip, lval, radix)
+		dval = lval
+		if (IS_INDEFL (lval))
+		    dval = INDEFD
+	    }
+	}
+
+	if (vtype == TY_DOUBLE) {
+	    oxval = dval
+	    if (IS_INDEFD (dval))
+		oxval = INDEFX
+	} else
+	    oxval = xval
+
+	return (ip - ip_save)
+end
diff --git a/sys/fmtio/gltoc.x b/sys/fmtio/gltoc.x
new file mode 100644
index 00000000..eaf47405
--- /dev/null
+++ b/sys/fmtio/gltoc.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+
+define	OCTAL		8
+define	DECIMAL		10
+define	HEX		16
+define	MAX_RADIX	'Z' - 'A' + 11
+
+# GLTOC -- Convert long integer to any radix string.  Returns the
+# number of characters generated.
+
+int procedure gltoc (lval, outstr, maxch, base)
+
+long	lval			# long integer to be encoded
+char	outstr[maxch]		# output buffer
+int	maxch, base		# numeric base (2..16)
+
+int	carry, d, op, radix, n, size, nchars, gstrcpy()
+long	andl(), orl()
+bool	unsigned
+
+begin
+	if (IS_INDEFL(lval) && base > 0)
+	    return (gstrcpy ("INDEF", outstr, maxch))
+	size = maxch
+
+	# Digit string is generated backwards, then reversed.  Unsigned
+	# conversion used if radix negative.
+
+	radix = max(2, min(MAX_RADIX, abs(base)))
+
+	unsigned = (base < 0)			# get raw number
+	if (unsigned) {
+	    n = andl (lval, MAX_LONG) / 2
+	    if (lval < 0)
+		n = orl (n, (MAX_LONG / 2 + 1))
+	    carry = andl (lval, 1)		# get initial carry
+	} else
+	    n = lval
+
+	op = 0
+	repeat {
+	    d = abs (mod (n, radix))		# generate next digit
+	    if (unsigned) {
+		d = 2 * d + carry		# get actual digit value
+		if (d >= radix) {		# check for generated carry
+		    d = d - radix
+		    carry = 1
+	        } else
+		    carry = 0
+	    }
+	    op = op + 1
+	    if (d < 10)				# convert to char and store
+		outstr[op] = TO_DIGIT (d)
+	    else
+		outstr[op] = d - 10 + 'A'
+	    n = n / radix
+	} until (n == 0 || op >= size)
+
+	if (unsigned) {
+	    if (carry != 0 && op < size) {	# check for final carry
+		op = op + 1
+		outstr[op] = '1'
+	    }
+	} else if (lval < 0 && op < size) {	# add sign if needed
+	    op = op + 1
+	    outstr[op] = '-'
+	}
+	nchars = op				# return length of string
+
+	for (d=1;  d < op;  d=d+1) {		# reverse digits
+	    carry = outstr[d]
+	    outstr[d] = outstr[op]
+	    outstr[op] = carry
+	    op = op - 1
+	}
+
+	outstr[nchars+1] = EOS
+	return (nchars)
+end
diff --git a/sys/fmtio/gstrcat.x b/sys/fmtio/gstrcat.x
new file mode 100644
index 00000000..d3f3fa94
--- /dev/null
+++ b/sys/fmtio/gstrcat.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTRCAT -- String concatenation.  String STR is appended to OUTSTR.
+
+int procedure gstrcat (str, outstr, maxch)
+
+char	str[ARB], outstr[ARB]
+int	maxch
+
+int	ip, op, n
+
+begin
+	do op = 0, maxch-1
+	    if (outstr[op+1] == EOS)
+		break
+
+	n = maxch - op
+	do ip = 1, n {
+	    outstr[op+ip] = str[ip]
+	    if (str[ip] == EOS)
+		return (op + ip-1)
+	}
+
+	outstr[maxch+1] = EOS
+	return (maxch)
+end
diff --git a/sys/fmtio/gstrcpy.x b/sys/fmtio/gstrcpy.x
new file mode 100644
index 00000000..e2d6e7b1
--- /dev/null
+++ b/sys/fmtio/gstrcpy.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTRCPY -- Copy string s1 to s2, return the number of characters copied.
+
+int procedure gstrcpy (s1, s2, maxch)
+
+char	s1[ARB], s2[ARB]
+int	maxch, i
+
+begin
+	do i = 1, maxch {
+	    s2[i] = s1[i]
+	    if (s2[i] == EOS)
+		return (i - 1)
+	}
+
+	s2[maxch+1] = EOS
+	return (maxch)
+end
diff --git a/sys/fmtio/itoc.x b/sys/fmtio/itoc.x
new file mode 100644
index 00000000..726fbc40
--- /dev/null
+++ b/sys/fmtio/itoc.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+
+# ITOC -- Integer to character string.  We do not resolve this into a call
+# to GLTOC for reasons of efficiency.
+
+int procedure itoc (ival, str, maxch)
+
+int	ival, maxch
+char	str[ARB]
+
+char	buf[MAX_DIGITS]
+int	b_op, s_op, num, temp
+int	gstrcpy()
+
+begin	
+	s_op = 1
+
+	if (IS_INDEFI (ival)) {
+	    return (gstrcpy ("INDEF", str, maxch))
+	} else if (ival < 0) {
+	    str[1] = '-'
+	    s_op = 2
+	    num = -ival
+	} else
+	    num = ival
+
+	# Encode nonnegative number in BUF, least significant digits first.
+
+	b_op = 0
+	repeat {
+	    temp = num / 10
+	    b_op = b_op + 1
+	    buf[b_op] = TO_DIGIT (num - temp * 10)
+	    num = temp
+	} until (num == 0)
+
+	# Copy encoded number to output string, reversing the order of the
+	# digits so that the most significant digits are first.
+
+	while (b_op > 0) {
+	    if (s_op > maxch)
+		return (gstrcpy ("**********", str, maxch))
+	    str[s_op] = buf[b_op]
+	    s_op = s_op + 1
+	    b_op = b_op - 1
+	}
+
+	str[s_op] = EOS
+	return (s_op - 1)
+end
diff --git a/sys/fmtio/lexdata.inc b/sys/fmtio/lexdata.inc
new file mode 100644
index 00000000..1a1bf3e4
--- /dev/null
+++ b/sys/fmtio/lexdata.inc
@@ -0,0 +1,28 @@
+# Actions of the LEXNUM finite state automaton.
+
+define	Acc	ACCEPT			# special actions
+define	Rvt	REVERT
+
+define	o_o	LEX_OCTAL		# reductions
+define	d_d	LEX_DECIMAL
+define	x_x	LEX_HEX
+define	r_r	LEX_REAL
+define	n__	LEX_NONNUM		# (other actions are new states)
+
+# cc:		+-   0-7  8-9  ACF  ED   :    .    X    B    other
+
+data	action /UNM, ODH, DHR, n__, n__, QRN, QRF, n__, n__, n__,	# start
+		Rvt, ODH, DHR, Rvt, Rvt, Rvt, QRF, Rvt, Rvt, Rvt,	# UNM
+		d_d, Acc, DHR, HEX, QHX, QRN, RFR, x_x, OHN, d_d,	# ODH
+		d_d, Acc, Acc, HEX, QHX, QRN, RFR, x_x, HEX, d_d,	# DHR
+		Rvt, RFR, RFR, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt,	# QRF
+		Rvt, Acc, Acc, Acc, Acc, Rvt, Rvt, x_x, Acc, Rvt,	# HEX
+		QRX, HRX, HRX, HEX, HEX, Rvt, Rvt, x_x, HEX, Rvt,	# QHX
+		Rvt, RNM, RNM, Rvt, Rvt, Acc, Rvt, Rvt, Rvt, Rvt,	# QRN
+		o_o, HEX, HEX, HEX, HEX, o_o, o_o, x_x, HEX, o_o,	# OHN
+		r_r, Acc, Acc, r_r, RRX, r_r, r_r, r_r, r_r, r_r,	# RFR
+		QRX, REX, REX, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt,	# RRX
+		Rvt, REX, REX, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt, Rvt,	# QRX
+		r_r, Acc, Acc, HEX, HEX, r_r, r_r, x_x, r_r, r_r,	# HRX
+		r_r, Acc, Acc, r_r, QRX, Acc, QRF, r_r, r_r, r_r,	# RNM
+		r_r, Acc, Acc, r_r, r_r, r_r, r_r, r_r, r_r, r_r/	# REX
diff --git a/sys/fmtio/lexnum.x b/sys/fmtio/lexnum.x
new file mode 100644
index 00000000..f62b0ed2
--- /dev/null
+++ b/sys/fmtio/lexnum.x
@@ -0,0 +1,190 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<lexnum.h>
+
+# LEXNUM -- Lexically analyse a character string, determine if string is
+# a number, and if so, the type of number, and the number of characters
+# in the number.  The ip_start argument is left pointing at the first char
+# of the number (or other token), and the number of chars in the number is
+# returned as the third argument (0 if not a number).
+#
+# NOTE - See .doc/lexnum.hlp for a description of the states of the automaton.
+
+define	SZ_STACK	15
+
+# Lexical actions.  "Reduce" means exit, returning code identifying lexical
+# type of token.  "Shift" means switch to a new state in the automaton.
+# "Revert" means reduce class "other" in the previous state.
+
+define	ACCEPT		-6		# remain in same state
+define	REVERT		-5		# revert to earlier state
+
+
+# Character classes
+
+define	SIGNCHAR	1		# +-
+define	OCTDIG		2		# 0-7
+define	DECDIG		3		# 8-9
+define	HEXDIG		4		# a-fA-F
+define	REALEXP		5		# eEdD
+define	SEXAG		6		# :
+define	FRACTION	7		# .
+define	HEXSUFFIX	8		# xX
+define	OCTSUFFIX	9		# bB
+define	OTHER		10		# invalid character
+define	NCC		10
+
+
+# States of the automaton
+
+define	START		1		# initial state
+define	UNM		2		# unop or number
+define	ODH		3		# octal, decimal, hex, or real
+define	DHR		4		# decimal, hex, or real
+define	QRF		5		# maybe real fraction
+define	HEX		6		# hex
+define	QHX		7		# maybe hex or real exponent
+define	QRN		8		# maybe real number
+define	OHN		9		# octal or hex number
+define	RFR		10		# real fraction
+define	RRX		11		# real or real exponent
+define	QRX		12		# maybe real exponent
+define	HRX		13		# hex or real exponent
+define	RNM		14		# real number
+define	REX		15		# real exponent
+define	NSTATES		15
+
+
+# LEXNUM -- Determine if the next sequence of characters in the string STR
+# can be interpreted as a number.  Return the numeric type as the function
+# value or LEX_NONNUM if the string is not a number.
+
+int procedure lexnum (str, ip_start, nchars)
+
+char	str[ARB]		# string to be decoded
+int	ip_start		# starting index in string
+int	nchars			# receives nchars in next token
+
+char	ch
+int	stk_ip[SZ_STACK]
+int	ip, sp, cc, state, ip_save, toktype, act
+short	stk_state[SZ_STACK], action[NCC,NSTATES]
+int	strncmp()
+include	"lexdata.inc"
+
+begin
+	while (IS_WHITE (str[ip_start]))
+	    ip_start = ip_start + 1
+	ip = ip_start
+
+	# INDEF is a legal number and is best dealt with as a special case.
+	if (str[ip] == 'I')
+	    if (strncmp (str[ip], "INDEF", 5) == 0) {
+		nchars = 5
+		return (LEX_REAL)
+	    }
+
+	state = START				# initialization
+	ip_save = ip
+	sp = 0
+
+	repeat {
+	    ch = str[ip]
+
+	    repeat {				# determine character class
+		switch (ch) {
+		case '+','-':
+		    cc = SIGNCHAR
+		    break
+		case '0','1','2','3','4','5','6','7':
+		    cc = OCTDIG
+		    break
+		case '8','9':
+		    cc = DECDIG
+		    break
+		case 'B':
+		    cc = OCTSUFFIX
+		    break
+		case 'D','E':
+		    cc = REALEXP
+		    break
+		case 'A','C','F':
+		    cc = HEXDIG
+		    break
+		case ':':
+		    cc = SEXAG
+		    break
+		case '.':
+		    cc = FRACTION
+		    break
+		default:
+		    if (IS_LOWER (ch))
+			ch = TO_UPPER (ch)	# and repeat
+		    else if (ch == 'X') {
+			cc = HEXSUFFIX
+			break
+		    } else {
+			cc = OTHER
+			break
+		    }
+		}
+	    }
+
+#call eprintf ("ip=%2d, sp=%2d, ch=%c, cc=%d, state=%d, action=%d\n")
+#call pargi(ip); call pargi(sp)
+#call pargc(ch); call pargi(cc); call pargi(state)
+#call pargs(action[cc,state])
+
+	    # Perform the action indicated by the action table when this
+	    # class of character is encountered in the current state.
+
+	    act = action[cc,state]
+	    if (act == ACCEPT) {
+		ip = ip + 1			# a simple optimization
+		next
+	    }
+
+	    switch (act) {
+	    case REVERT:
+		repeat {
+		    ip = stk_ip[sp]
+		    state = stk_state[sp]
+		    toktype = action[OTHER,state]
+		    sp = sp - 1
+		} until (toktype != REVERT || sp <= 0)
+
+		break
+
+	    case LEX_OCTAL, LEX_DECIMAL, LEX_HEX, LEX_REAL, LEX_NONNUM:
+		toktype = action[cc,state]
+		if (toktype == LEX_OCTAL && cc == OCTSUFFIX)
+		    ip = ip + 1			# discard suffix char
+		else if (toktype == LEX_HEX && cc == HEXSUFFIX)
+		    ip = ip + 1
+		break
+
+	    default:				# shift to new state
+		sp = sp + 1
+		if (sp > SZ_STACK) {
+		    toktype = LEX_NONNUM
+		    break
+		}
+		stk_ip[sp] = ip
+		stk_state[sp] = state
+
+		ip = ip + 1
+		state = action[cc,state]
+		if (state < 1 || state > NSTATES)
+		    call error (0, "In LEXNUM: cannot happen")
+	    }
+	}
+
+	if (toktype == LEX_NONNUM)
+	    nchars = 0
+	else
+	    nchars = ip - ip_save
+
+	return (toktype)
+end
diff --git a/sys/fmtio/ltoc.x b/sys/fmtio/ltoc.x
new file mode 100644
index 00000000..d2105433
--- /dev/null
+++ b/sys/fmtio/ltoc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DECIMAL		10
+
+# LTOC -- Convert long integer to decimal string.
+# Returns the number of characters generated.
+
+int procedure ltoc (lval, outstr, maxch)
+
+long	lval				# long integer to be encoded
+char	outstr[ARB]			# output buffer
+int	maxch				# size of output buffer
+int	gltoc()
+
+begin
+	return (gltoc (lval, outstr, maxch, DECIMAL))
+end
diff --git a/sys/fmtio/mkpkg b/sys/fmtio/mkpkg
new file mode 100644
index 00000000..b27d6a5f
--- /dev/null
+++ b/sys/fmtio/mkpkg
@@ -0,0 +1,125 @@
+# Formatted i/o (FMTIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+tfiles:
+	$ifnewer (evvexpr.gy, evvexpr.y)
+	    $generic -k evvexpr.gy -o evvexpr.y
+	$endif
+
+	$ifnewer (evvexpr.y, evvexpr.x)
+	    $ifeq (HOSTID, unix)
+		$echo "fmtio/evvexpr.x is out of date; rebuilding with XYACC:"
+		!(xyacc evvexpr.y; mv -f ytab.x evvexpr.x)
+	    $else
+		$echo "fmtio/evvexpr.x is out of date; rebuild with XYACC"
+	    $endif
+	$endif
+
+	$ifnewer (evexpr.y, evexpr.x)
+	    $ifeq (HOSTID, unix)
+		$echo "fmtio/evexpr.x is out of date; rebuilding with XYACC:"
+		!(xyacc evexpr.y; mv -f ytab.x evexpr.x)
+	    $else
+		$echo "fmtio/evexpr.x is out of date; rebuild with XYACC"
+	    $endif
+	$endif
+	;
+
+libsys.a:
+	$ifeq (USE_GENERIC, yes) $call tfiles $endif
+
+	cctoc.x	escchars.inc <chars.h> <ctype.h>
+	chdeposit.x	
+	chfetch.x	
+	chrlwr.x	<ctype.h>
+	chrupr.x	<ctype.h>
+	clprintf.x	<printf.h>
+	clscan.x	scan.com
+	ctocc.x		escchars.inc <ctype.h>
+	ctod.x		<ctype.h> <mach.h>
+	ctoi.x		<ctype.h>
+	ctol.x		<ctype.h>
+	ctor.x		<mach.h>
+	ctotok.x	tokdata.inc <chars.h> <lexnum.h> <ctotok.h> <ctype.h>
+	ctowrd.x	<chars.h> <ctype.h>
+	ctox.x		<ctype.h>
+	dtcscl.x	
+	dtoc.x		<ctype.h> <printf.h>
+	dtoc3.x		<ctype.h> <mach.h> <printf.h>
+	eprintf.x	<printf.h>
+	evexpr.x	evexpr.com <ctype.h> <evexpr.h> <lexnum.h> <mach.h>
+	evvexpr.x	evvexpr.com <ctype.h> <evvexpr.h> <lexnum.h>\
+			<mach.h> <math.h>
+	fmterr.x	
+	fmtinit.x	fmt.com <printf.h>
+	fmtread.x	fmt.com <printf.h>
+	fmtsetcol.x	<ctype.h> <printf.h>
+	fmtstr.x	<ctype.h>
+	fpradv.x	<chars.h> <ctype.h> <printf.h> fmt.com
+	fprfmt.x	<ctype.h> <printf.h> fmt.com
+	fprintf.x	<printf.h>
+	fprntf.x	<printf.h> fmt.com
+	fscan.x		scan.com
+	gargb.x		scan.com <ctype.h>
+	gargc.x		scan.com
+	gargd.x		scan.com
+	gargi.x		<mach.h>
+	gargl.x		<mach.h>
+	gargr.x	
+	gargrad.x	scan.com
+	gargs.x		<mach.h>
+	gargstr.x	scan.com
+	gargtok.x	scan.com
+	gargwrd.x	scan.com
+	gargx.x		scan.com
+	gctod.x		<chars.h> <ctype.h> <lexnum.h>
+	gctol.x		<ctype.h>
+	gctox.x		<chars.h> <ctype.h> <lexnum.h>
+	gltoc.x		<ctype.h> <mach.h>
+	gstrcat.x	
+	gstrcpy.x	
+	itoc.x		<ctype.h> <mach.h>
+	lexnum.x	lexdata.inc <ctype.h> <lexnum.h> <mach.h>
+	ltoc.x	
+	nscan.x		scan.com
+	parg.x		<ctype.h> <mach.h> <printf.h> fmt.com
+	pargb.x		<printf.h>
+	pargstr.x	<printf.h> fmt.com
+	pargx.x		<ctype.h> <mach.h> <printf.h> fmt.com
+	patmatch.x	<chars.h> <ctype.h> <pattern.h>
+	printf.x	<printf.h>
+	resetscan.x	scan.com
+	scanc.x		scan.com
+	sprintf.x	<printf.h>
+	sscan.x		scan.com
+	strcat.x	
+	strcmp.x	
+	strcpy.x	
+	strdic.x	<ctype.h>
+	streq.x	
+	strge.x	
+	strgt.x	
+	stridx.x	
+	stridxs.x	
+	strldx.x	
+	strldxs.x	
+	strle.x	
+	strlen.x	
+	strlt.x	
+	strlwr.x	<ctype.h>
+	strmac.x	<ctype.h>
+	strmatch.x	<ctype.h> <pattern.h>
+	strncmp.x	
+	strne.x	
+	strsearch.x	
+	strsrt.x	
+	strtbl.x	
+	strupr.x	<ctype.h>
+	xevgettok.x	<lexnum.h> <ctype.h> <evexpr.h>
+	xvvgettok.x	<lexnum.h> <ctype.h> <mach.h> <math.h> <evexpr.h>
+	xtoc.x	
+	;
diff --git a/sys/fmtio/nscan.x b/sys/fmtio/nscan.x
new file mode 100644
index 00000000..c9069927
--- /dev/null
+++ b/sys/fmtio/nscan.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NSCAN -- Return the number of tokens successfully converted in the most
+# recent scan.
+
+int procedure nscan()
+
+include	"scan.com"
+
+begin
+	return (sc_ntokens)
+end
diff --git a/sys/fmtio/parg.x b/sys/fmtio/parg.x
new file mode 100644
index 00000000..d65bd3ce
--- /dev/null
+++ b/sys/fmtio/parg.x
@@ -0,0 +1,283 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<printf.h>
+
+.help parg
+.nf ___________________________________________________________________________
+PARG[CSILRDX] -- Pass a numeric argument to printf.  Get the format spec and
+format the number on the output file.  Try to provide reasonable automatic
+type conversions.  Avoid any type coercion of indefinites.
+We try to make the operand fit in the specified field width, decreasing the
+precision if necessary, but if it cannot be made to fit we increase the field
+width until it does.  We feel that it is more important to output a readable
+number than to keep the output columns justified.
+.endhelp ______________________________________________________________________
+
+
+# PARGD -- Pass a double.
+
+procedure pargd (dval)
+
+double	dval
+
+begin
+	call pargg (dval, TY_DOUBLE)
+end
+
+
+# PARGC -- Pass a char.
+
+procedure pargc (cval)
+
+char	cval
+double	dval
+
+begin
+	dval = cval
+	call pargg (dval, TY_CHAR)
+end
+
+
+# PARGS -- Pass a short.
+
+procedure pargs (sval)
+
+short	sval
+double	dval
+
+begin
+	dval = sval
+	if (IS_INDEFS (sval))
+	    dval = INDEFD
+
+	call pargg (dval, TY_SHORT)
+end
+
+
+# PARGI -- Pass an int.
+
+procedure pargi (ival)
+
+int	ival
+double	dval
+
+begin
+	dval = ival
+	if (IS_INDEFI (ival))
+	    dval = INDEFD
+
+	call pargg (dval, TY_INT)
+end
+
+
+# PARGL -- Pass a long.
+
+procedure pargl (lval)
+
+long	lval
+double	dval
+
+begin
+	dval = lval
+	if (IS_INDEFL (lval))
+	    dval = INDEFD
+
+	call pargg (dval, TY_LONG)
+end
+
+
+# PARGR -- Pass a real.
+
+procedure pargr (rval)
+
+real	rval
+double	dval
+
+begin
+	dval = rval
+	if (IS_INDEFR (rval))
+	    dval = INDEFD
+
+	call pargg (dval, TY_REAL)
+end
+
+
+# PARGG -- Generic put argument.  Encode a value of a specific datatype passed
+# as a double precision value.
+
+procedure pargg (value, dtype)
+
+double	value
+int	dtype
+
+char	ch
+long	lnum
+complex	xnum
+int	n, precision, i, junk, ival, nchars, nbits, fmt
+int	ctocc(), gltoc(), dtoc(), xtoc(), fprfmt()
+errchk	putci, fmtstr, fpradv
+include "fmt.com"
+
+begin
+	# Read format.  If format spec contains "*" fields, VALUE is a part of
+	# the format, rather than a true operand.  In that case we return,
+	# and the next call again checks to see if the format spec is complete.
+	# Note that if VALUE is not part of the format but is instead a floating
+	# point value to be printed, it may have an exponent large enough to
+	# cause integer overflow in an INT(VALUE) operation, hence we must
+	# guard against this.  This is easy since only PARGI will be used to
+	# pass format information.
+
+	if (dtype == TY_REAL || dtype == TY_DOUBLE)
+	    ival = 0
+	else if (IS_INDEFD (value))
+	    ival = INDEFI
+	else
+	    ival = nint (value)
+
+	if (fprfmt (ival) == NOT_DONE_YET)
+	    return
+
+ 	if (format_char == USE_DEFAULT || format_char == FMT_STRING)
+	    switch (dtype) {
+	    case TY_CHAR:
+		format_char = FMT_CHAR
+	    case TY_INT:
+		format_char = FMT_DECIMAL
+	    default:
+		format_char = FMT_GENERAL
+	    }
+
+	if (dtype == TY_DOUBLE)				# supply def. precision
+	    precision = NDIGITS_DP
+	else
+	    precision = NDIGITS_RP
+
+	if (width == USE_DEFAULT)			# make as big as needed
+	    width = SZ_OBUF
+
+	# Convert number from binary into character form in OBUF, applying
+	# defaults as needed.
+
+	# Ignore case in testing format type.
+	fmt = format_char
+	if (IS_UPPER (fmt))
+	    fmt = TO_LOWER(fmt)
+
+	switch (fmt) {
+	case FMT_BOOL:
+	    if (IS_INDEFD (value))
+		call strcpy ("INDEF", obuf, SZ_OBUF)
+	    else if (int (value) == 0)
+		call strcpy ("NO", obuf, SZ_OBUF)
+	    else
+		call strcpy ("YES", obuf, SZ_OBUF)
+
+	case FMT_CHAR:
+	    if (IS_INDEFD (value))
+		call strcpy ("INDEF", obuf, SZ_OBUF)
+	    else {
+		ch = nint (value)
+		junk = ctocc (ch, obuf, SZ_OBUF)
+	    }
+
+	case FMT_DECIMAL, FMT_OCTAL, FMT_HEX, FMT_RADIX, FMT_UNSIGNED:
+	    switch (fmt) {
+	    case FMT_DECIMAL:
+		radix = DECIMAL				# signed decimal
+	    case FMT_OCTAL:
+		radix = -OCTAL				# unsigned octal
+	    case FMT_HEX:
+		radix = -HEX				# unsigned hex
+	    case FMT_UNSIGNED:
+		radix = -DECIMAL			# unsigned decimal
+	    default:
+		radix = -abs(radix)			# unsigned radix
+	    }
+
+	    if (IS_INDEFD (value)) {
+		lnum = INDEFL
+		nchars = gltoc (lnum, obuf, SZ_OBUF, radix)
+
+	    } else {
+		lnum = long (value)
+		nchars = gltoc (lnum, obuf, SZ_OBUF, radix)
+
+		# Limit sign extension if negative number, hex or octal.
+		if (lnum < 0 && (dtype == TY_SHORT || dtype == TY_CHAR)) {
+		    nbits = SZB_CHAR * NBITS_BYTE
+		    if (dtype == TY_SHORT)
+			nbits = nbits * SZ_SHORT
+		    if (fmt == FMT_OCTAL) {
+			n = nchars - (nbits + 2) / 3
+			if (n > 0) {
+			    call strcpy (obuf[n+2], obuf[2], SZ_OBUF)
+			    obuf[1] = '1'
+			}
+		    } else if (fmt == FMT_HEX) {
+			n = nchars - (nbits + 3) / 4
+			if (n > 0)
+			    call strcpy (obuf[n+1], obuf[1], SZ_OBUF)
+		    }
+		}
+	    }
+
+	case FMT_EXPON, FMT_FIXED, FMT_GENERAL, FMT_HMS, FMT_MINSEC:
+	    if (decpl == USE_DEFAULT || decpl == 0)
+		switch (fmt) {
+		case FMT_EXPON, FMT_GENERAL:
+		    decpl = precision
+		case FMT_HMS, FMT_MINSEC:
+		    if (decpl == USE_DEFAULT)
+			decpl = 1
+		default:
+		    if (decpl == USE_DEFAULT)
+			decpl = precision
+		}
+	    repeat {
+		# Need the case sensitive format char here.
+		n = dtoc (value, obuf, SZ_OBUF, decpl, format_char, width+1)
+		decpl = decpl - 1
+	    } until (n <= width || decpl <= 0)
+
+	case FMT_TOCOLUMN:				# advance to column
+	    for (i=int(value);  col < i;  col=col+1)
+		call putci (fd, ' ')
+	    call fpradv()
+	    return
+
+	case FMT_WHITESPACE:				# output whitespace
+	    for (i=0;  i < int(value);  i=i+1)
+		call putci (fd, ' ')
+	    col = col + i
+	    call fpradv()
+	    return
+
+	case FMT_COMPLEX:
+	    if (decpl == USE_DEFAULT)			# set defaults
+		decpl = precision
+	    else
+		decpl = abs (decpl)
+
+	    if (IS_INDEFD (value))
+		xnum = INDEFX
+	    else
+		xnum = complex (value)
+
+	    # Convert, decrease precision until it fits in given field width.
+	    repeat {
+		n = xtoc (xnum, obuf, SZ_OBUF, decpl, 'e', SZ_OBUF)
+		decpl = decpl - 1
+	    } until (n <= width || decpl <= 0)
+	}
+	    
+	# Move the string in OBUF to the output file, left or right justifying
+	# as specified.  Advance to the next format spec (or finish up).
+
+	if (width == SZ_OBUF)				# free format?
+	    width = 0
+	call fmtstr (fd, obuf, col, fill_char, left_justify, SZ_OBUF, width)
+	call fpradv ()
+end
diff --git a/sys/fmtio/pargb.x b/sys/fmtio/pargb.x
new file mode 100644
index 00000000..bc3e6eb0
--- /dev/null
+++ b/sys/fmtio/pargb.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# PARGB -- Print a boolean operand (as a string).
+
+procedure pargb (bval)
+
+bool	bval
+
+begin
+	if (bval)
+	    call pargstr ("yes")
+	else
+	    call pargstr ("no")
+end
diff --git a/sys/fmtio/pargstr.x b/sys/fmtio/pargstr.x
new file mode 100644
index 00000000..59fc7433
--- /dev/null
+++ b/sys/fmtio/pargstr.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# PARGSTR -- Pass a string type operand to printf.
+
+procedure pargstr (str)
+
+char	str[ARB]
+int	maxch
+include "fmt.com"
+
+begin
+	call fmt_read()					# get format
+
+	if (decpl == USE_DEFAULT)
+	    maxch = SZ_OBUF
+	else
+	    maxch = abs (decpl)
+
+	if (width == USE_DEFAULT)
+	    width = 0
+
+	call fmtstr (fd, str, col, fill_char, left_justify, maxch, width)
+	call fpradv ()
+end
diff --git a/sys/fmtio/pargx.x b/sys/fmtio/pargx.x
new file mode 100644
index 00000000..d399da29
--- /dev/null
+++ b/sys/fmtio/pargx.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<printf.h>
+
+# PARGX -- Pass a numeric argument of type complex to printf.  Get the format
+# spec and format the number on the output file.  Try to provide reasonable
+# automatic type conversions.  Avoid any type coercion of indefinites.
+
+procedure pargx (xval)
+
+complex	xval			# complex value to be encoded
+double	value
+int	n, xtoc()
+include "fmt.com"
+
+begin
+	call fmt_read()					# read format
+
+	if (format_char == FMT_COMPLEX || format_char == USE_DEFAULT) {
+	    if (width == USE_DEFAULT)			# print as (r,r)
+		width = SZ_OBUF
+
+	    if (decpl == USE_DEFAULT || decpl == 0)
+		decpl = NDIGITS_RP
+	    else
+		decpl = abs (decpl)
+
+	    # Encode number in the available field width, decreasing the
+	    # precision until the number fits.
+
+	    repeat {
+		n = xtoc (xval, obuf, SZ_OBUF, decpl, FMT_EXPON, SZ_OBUF)
+		decpl = decpl - 1
+	    } until (n <= width || decpl <= 0)
+
+	    # Move the string in OBUF to the output file, left or right
+	    # justifying as specified.  Advance to the next format spec
+	    # (or finish up).
+
+	    if (width == SZ_OBUF)				# free format?
+		width = 0
+	    call fmtstr (fd, obuf, col, fill_char, left_justify, SZ_OBUF, width)
+	    call fpradv ()
+
+	} else {
+	    # Print real part of complex number in some format other than
+	    # complex.
+
+	    value = real (xval)
+	    if (IS_INDEFR (real(xval)))
+		value = INDEFD
+
+	    call pargg (value, TY_REAL)
+	}
+end
diff --git a/sys/fmtio/patmatch.x b/sys/fmtio/patmatch.x
new file mode 100644
index 00000000..9972060f
--- /dev/null
+++ b/sys/fmtio/patmatch.x
@@ -0,0 +1,568 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pattern.h>
+include	<ctype.h>
+include	<chars.h>
+
+# PATMATCH.X -- Routines for matching regular expressions (general pattern
+# matching).  Adapted from Software Tools.
+# 
+#	      patsize = patmake (patstr, patbuf, sz_patbuf)
+#	   next_char = patmatch (str, patbuf)
+#	  next_char = gpatmatch (str, patbuf, first_char, last_char)
+#	          ip = patindex (patbuf, index_number)
+#
+# The pattern string must be encoded with PATMAKE before use.  See also
+# STRMATCH, STRNCMP, etc.
+
+# Pattern codes (for encoded patterns).
+
+define	EOP		-1		# end of encoded pattern
+define	CHAR		-2		# match char
+define	UCHAR		-3		# match either case
+define	LCHAR		-4		# match either case
+define	BOL		-5		# match at beginning of line
+define	EOL		-6		# match at end of line
+define	ANY		-7		# "?"
+define	WHITESPACE	-8		# "#"
+define	CCL		-9		# [...
+define	NCCL		-10		# [^...
+define	CLOSURE		-11		# "*"
+define	INDEX		-12		# % (mark index of ^ in pattern)
+
+define	CH_INDEX	'%'		# move to <chars.h> after a while
+
+# Definitions for the closure structure.
+
+define	CLOSIZE		4		# size of closure structure
+define	COUNT		1		# repeat count for matches
+define	PREVCL		2		# index of previous closure in pat
+define	START		3		# index in str where match starts
+
+
+# PATMATCH -- Match pattern anywhere on line.  Returns the index of the
+# first character AFTER the match, or zero if no match.
+
+int procedure patmatch (str, pat)
+
+char	str[ARB]		# string to be scanned
+char	pat[ARB]		# encoded pattern
+
+int	first_char, last_char
+int	gpatmatch()
+
+begin
+	return (gpatmatch (str, pat, first_char, last_char))
+end
+
+
+# GPATMATCH -- Generalized pattern match.  Matches pattern anywhere on
+# line (the first such pattern matched terminates the search).  Function
+# return same as for PATMATCH, but also returns indices of the first and
+# last characters in the matched substring.
+
+int procedure gpatmatch (str, pat, first_char, last_char)
+
+char	str[ARB]		# string to be scanned
+char	pat[ARB]		# encoded pattern
+int	first_char		# index of first char matched (output)
+int	last_char		# index of last  char matched (output)
+
+int	ip, nchars_matched
+int	pat_amatch()				# anchored match
+
+begin
+	nchars_matched = 0
+
+	if (pat[1] == BOL) {
+	    ip = 1
+	    nchars_matched = pat_amatch (str, ip, pat)
+	} else {
+	    for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+		nchars_matched = pat_amatch (str, ip, pat)
+		if (nchars_matched > 0)
+		    break
+	    }
+	}
+
+	if (nchars_matched > 0) {
+	    first_char = ip
+	    last_char = ip + nchars_matched - 1
+	    return (last_char + 1)
+	} else
+	    return (0)
+end
+
+
+# PATINDEX -- Return the index of a marked position in the pattern.  Inclusion
+# of the character % in the pattern causes the index of the character following
+# the % to be saved in the encoded pattern at patmatch time.  We are called
+# after a patmatch operation to scan the pattern and recall the Nth saved index.
+# Zero is returned if N is larger than the number of saved index points.
+
+int procedure patindex (pat, n)
+
+char	pat[ARB]		# encoded pattern
+int	n			# number of index to be returned
+
+int	pp, ix
+int	pat_gsize()
+
+begin
+	ix = 1
+	for (pp=1;  pat[pp] != EOP;  pp=pp+pat_gsize(pat,pp))
+	    if (pat[pp] == INDEX)
+		if (ix >= n)
+		    return (pat[pp+1])
+		else
+		    ix = ix + 1
+
+	return (0)
+end
+
+
+# PAT_AMATCH -- Anchored match.  Look for match starting at the given
+# offset.  Return the number of characters matched.
+
+int procedure pat_amatch (str, from, pat)
+
+char	str[ARB]		# string to be matched
+int	from			# starting at this index
+char	pat[ARB]		# encoded pattern
+
+int	ip, pp, offset, stack
+int	pat_omatch(), pat_gsize()
+
+begin
+	stack = 0
+	offset = from				# next unexamined input char
+
+	for (pp=1;  pat[pp] != EOP;  pp = pp + pat_gsize(pat,pp)) {
+	    if (pat[pp] == CLOSURE) {		# a closure entry
+		stack = pp
+		pp = pp + CLOSIZE	
+		# Match as many characters as possible, save results
+		for (ip=offset;  str[ip] != EOS;  )
+		    if (pat_omatch (str, ip, pat, pp) == NO)
+			break
+		pat[stack+COUNT] = ip - offset
+		pat[stack+START] = offset
+		offset = ip			# character that made us fail
+
+	    } else if (pat_omatch (str, offset, pat, pp) == NO) {
+		for (;  stack > 0;  stack = pat[stack+PREVCL])
+		    if (pat[stack+COUNT] > 0)
+			break
+		if (stack <= 0)			# stack is empty
+		    return (0)			# return failure
+
+		pat[stack+COUNT] = pat[stack+COUNT] - 1
+		pp = stack + CLOSIZE
+		offset = pat[stack+START] + pat[stack+COUNT]
+	    }
+	}
+
+	return (offset-from)			# successful match
+end
+
+
+# PAT_GSIZE -- Returns size of pattern entry at pat[n].
+
+int procedure pat_gsize (pat, n)
+
+char	pat[ARB]		# encoded pattern
+int	n			# pointer into pattern
+int	pattern_size
+
+begin
+	switch (pat[n]) {
+	case CHAR, UCHAR, LCHAR, INDEX:
+	    pattern_size = 2
+	case BOL, EOL, ANY, WHITESPACE:
+	    pattern_size = 1
+	case CCL, NCCL:
+	    pattern_size = pat[n+1] + 2
+	case CLOSURE:					# not used
+	    pattern_size = CLOSIZE
+	default:
+	    call error (0, "In patsize: can't happen.")
+	}
+
+	return (pattern_size)
+end
+
+
+# PAT_OMATCH -- Try to match a single pattern at pat[pp].  If match, bump IP
+# to point to the next unmatched character.  Return OK if match.
+
+int procedure pat_omatch (str, ip, pat, pp)
+
+char	str[ARB]		# string to be scanned
+int	ip			# starting index in string (may be changed)
+char	pat[ARB]		# encoded pattern
+int	pp			# pointer to next pattern element
+
+char	str_ch
+int	bump, pat_locate()
+
+begin
+	if (str[ip] == EOS)
+	    if (pat[pp] == INDEX) {
+		pat[pp+1] = ip
+		return (YES)
+	    } else if (pat[pp] == EOL) {
+		return (YES)
+	    } else
+		return (NO)
+
+	# Treat CHAR (simple character match) as a special case to speed
+	# things up a bit.
+
+	if (pat[pp] == CHAR)
+	    if (str[ip] == pat[pp+1]) {
+		ip = ip + 1
+		return (YES)
+	    } else
+		return (NO)
+
+	# Compare as indicated by encoded pattern opcode.
+	bump = -1
+
+	switch (pat[pp]) {
+	case UCHAR:					# match either case
+	    str_ch = str[ip]
+	    if (IS_LOWER (str_ch))
+		str_ch = TO_UPPER (str_ch)
+	    if (str_ch == pat[pp+1])
+		bump = 1
+	case LCHAR:					# match either case
+	    str_ch = str[ip]
+	    if (IS_UPPER (str_ch))
+		str_ch = TO_LOWER (str_ch)
+	    if (str_ch == pat[pp+1])
+		bump = 1
+	case BOL:					# beg. of line
+	    if (ip == 1)
+		bump = 0
+	case EOL:					# end of line
+	    if (str[ip] == '\n')
+		bump = 0
+	case ANY:					# match any char
+	    if (str[ip] != '\n')
+		bump = 1
+	case WHITESPACE:
+	    for (bump=0;  IS_WHITE (str[ip+bump]);  bump=bump+1)
+		;
+	case CCL:					# char class
+	    if (pat_locate (str[ip], pat, pp + 1) == YES)
+		bump = 1
+	case NCCL:					# not in char class
+	    if (str[ip] != '\n' && pat_locate (str[ip], pat, pp + 1) == NO)
+		bump = 1
+	case INDEX:
+	    pat[pp+1] = ip
+	    bump = 0
+	default:
+	    call error (0, "In omatch: can't happen.")
+	}
+
+	if (bump >= 0) {
+	    ip = ip + bump
+	    return (YES)
+	} else
+	    return (NO)
+end
+
+
+# PAT_LOCATE -- Look for c in char class at pat[offset].
+
+int procedure pat_locate (ch, pat, offset)
+
+char	ch			# char to search for
+char	pat[ARB]		# encoded pattern
+int	offset			# offset of character class in pattern
+
+int	nchars, i
+
+begin
+	# Size of class is at pat[offset], characters follow.
+	nchars = pat[offset]
+	do i = 1, nchars
+	    if (ch == pat[offset+i])
+		return (YES)
+
+	return (NO)
+end
+
+
+# PATMAKE -- Encode pattern specification string.  Returns the size of
+# the encoded pattern string.
+
+int procedure patmake (str, pat, sz_pat)
+
+char	str[ARB]		# pattern to be encoded
+char	pat[ARB]		# encoded pattern (output)
+int	sz_pat			# max size of the pattern string
+int	gpatmake()
+
+begin
+	return (gpatmake (str, 1, EOS, pat, sz_pat))
+end
+
+
+# GPATMAKE -- Make pattern from str[from], terminate at delim.
+
+int procedure gpatmake (patstr, from, delim, patbuf, sz_pat)
+
+char	patstr[ARB]		# pattern to be encoded
+int	from			# starting index
+int	delim			# delimiter character
+char	patbuf[ARB]		# put encoded pattern here
+int	sz_pat			# max chars in encoded pattern
+
+int	ip, op, last_closure, last_op, l_op
+char	cval
+bool	ignore_case
+int	cctoc(), pat_getccl(), pat_stclos()
+
+begin
+	op = 1					      # pat index
+	last_op = 1
+	last_closure = 0
+	ignore_case = false
+
+	for (ip=from;  patstr[ip] != delim && patstr[ip] != EOS;  ip=ip+1) {
+	    l_op = op
+
+	    # If CVAL gets set to nonzero it will be deposited in the output
+	    # buffer at end of switch.
+
+	    cval = 0
+
+	    switch (patstr[ip]) {
+	    case CH_ANY:
+		cval = ANY
+	    case CH_WHITESPACE:
+		cval = WHITESPACE
+
+	    case CH_BOL:
+		if (ip == from)
+		    cval = BOL
+		else {
+		    cval = CHAR
+		    call chdeposit (cval, patbuf, sz_pat, op)
+		    cval = CH_BOL
+		}
+
+	    case CH_EOL:
+		if (patstr[ip+1] == delim)
+		    cval = EOL
+		else {
+		    cval = CHAR
+		    call chdeposit (cval, patbuf, sz_pat, op)
+		    cval = CH_EOL
+		}
+
+	    case CH_IGNORECASE:
+		ignore_case = true
+	    case CH_MATCHCASE:
+		ignore_case = false
+
+	    case CH_CCL:
+		if (pat_getccl (patstr, patbuf, sz_pat, ip, op) == ERR)
+		    return (ERR)
+
+	    case CH_CLOSURE:
+		# The "closure" of a pattern, e.g., "..*".
+
+		l_op = last_op
+		# Convert a pattern such as "*..." into "?*...".
+		if (ip == from)				# closure of nothing
+		    cval = ANY
+		else {
+		    switch (patbuf[l_op]) {
+		    case BOL, EOL, CLOSURE:
+			cval = ANY
+		    }
+		}
+
+		if (cval != 0)
+		    call chdeposit (cval, patbuf, sz_pat, op)
+		cval = 0
+
+		last_closure = pat_stclos (patbuf, sz_pat, op, last_op,
+		    last_closure)
+
+	    case CH_INDEX:
+		# This metacharacter does not match anything, but rather is
+		# used to record the index of the marked position in the
+		# matched pattern.  The index is recorded in the pattern
+		# buffer at match time, to be later recovered with patindex.
+
+		cval = INDEX
+		call chdeposit (cval, patbuf, sz_pat, op)
+		cval = 0
+		call chdeposit (cval, patbuf, sz_pat, op)
+
+	    default:
+		# Ordinary character.
+
+		# Deposit command code.
+		if (ignore_case) {
+		    if (IS_UPPER (patstr[ip]))
+			cval = UCHAR
+		    else
+			cval = LCHAR
+		} else
+		    cval = CHAR
+		call chdeposit (cval, patbuf, sz_pat, op)
+
+		# Set CVAL to actual character value.
+		if (patstr[ip] == CH_ESCAPE) {
+		    if (cctoc (patstr, ip, cval) == 1)
+			cval = patstr[ip]
+		    else
+			ip = ip - 1
+		} else
+		    cval = patstr[ip]
+	    }
+
+	    # Deposit the character left in CVAL by the code above.
+	    if (cval != 0)
+		call chdeposit (cval, patbuf, sz_pat, op)
+
+	    last_op = l_op
+	}
+
+	# Terminate the pattern.
+	cval = EOP
+	call chdeposit (cval, patbuf, sz_pat, op)
+
+	if (patstr[ip] != delim || op >= sz_pat)
+	    return (ERR)
+	else
+	    return (op - 1)				# return size patbuf
+end
+
+
+# PAT_GETCCL -- Expand character class at patstr[i] into patbuf[op].
+
+int procedure pat_getccl (patstr, patbuf, sz_pat, ip, op)
+
+char	patstr[ARB], patbuf[ARB]
+int	sz_pat, ip, op
+char	cval
+int	op_start
+
+begin
+	ip = ip + 1					# skip over [
+	if (patstr[ip] == CH_NOT) {
+	    cval = NCCL
+	    ip = ip + 1
+	} else
+	    cval = CCL
+
+	call chdeposit (cval, patbuf, sz_pat, op)
+
+	op_start = op
+	cval = 0
+	call chdeposit (cval, patbuf, sz_pat, op)	# leave room for count
+	call pat_filset (CH_CCLEND, patstr, ip, patbuf, sz_pat, op)
+	patbuf[op_start] = op - op_start - 1		# fix up count
+
+	if (patstr[ip] == CH_CCLEND)
+	    return (OK)
+	else
+	    return (ERR)
+end
+
+
+# PAT_STCLOS -- Insert closure entry at patbuf[op].
+
+int procedure pat_stclos (patbuf, sz_pat, op, last_op, last_closure)
+
+char	patbuf[ARB]
+int	sz_pat
+int	op
+int	last_op
+int	last_closure
+
+char	cvals[4]
+int	next_closure, jp, jt, i
+
+begin
+	for (jp=op-1;  jp >= last_op;  jp=jp-1) {	# make a hole
+	    jt = min (sz_pat, jp + CLOSIZE)
+	    patbuf[jt] = patbuf[jp]
+	}
+
+	op = op + CLOSIZE
+	next_closure = last_op
+
+	cvals[1] = CLOSURE
+	cvals[2] = 0				# COUNT
+	cvals[3] = last_closure			# PREVCL
+	cvals[4] = 0				# START
+
+	do i = 1, 4
+	    call chdeposit (cvals[i], patbuf, sz_pat, last_op)
+
+	return (next_closure)
+end
+
+
+# PAT_FILSET -- Process a character class into a simple list of characters.
+
+procedure pat_filset (delim, patstr, ip, patbuf, sz_pat, op)
+
+int	delim			# character class delimiter character
+char	patstr[ARB]		# character class characters
+int	ip			# index where they start
+char	patbuf[ARB]		# encode character class in this string
+int	sz_pat			# max chars out
+int	op			# offset into patbuf
+
+char	ch, ch1, ch2
+int	cctoc()
+
+begin
+	for (;  patstr[ip] != delim && patstr[ip] != EOS;  ip=ip+1) {
+	    if (patstr[ip] == ESCAPE) {				# escape seq.
+		if (cctoc (patstr, ip, ch) == 1)
+		    ch = patstr[ip]
+		else
+		    ip = ip - 1
+		call chdeposit (ch, patbuf, sz_pat, op)
+
+	    } else if (patstr[ip] != CH_RANGE) {
+		call chdeposit (patstr[ip], patbuf, sz_pat, op)
+
+	    } else if (op <= 1 || patstr[ip+1] == EOS) {	# literal "-"
+		ch = CH_RANGE
+		call chdeposit (ch, patbuf, sz_pat, op)
+
+	    } else {
+		# Here if char is CH_RANGE, denoting a range of characters to be
+		# included in the character class.  Range is valid only if limit
+		# chars are both digits, both lower case, or both upper case.
+
+		ch1 = patbuf[op-1]		# not same as patstr[ip-1]
+		ch2 = patstr[ip+1]
+
+		if ((IS_DIGIT (ch1) && IS_DIGIT (ch2)) ||
+		    (IS_LOWER (ch1) && IS_LOWER (ch2)) ||
+		    (IS_UPPER (ch1) && IS_UPPER (ch2))) {
+			if (ch1 <= ch2)
+			    for (ch=ch1+1;  ch <= ch2;  ch=ch+1)
+				call chdeposit (ch, patbuf, sz_pat, op)
+			else
+			    for (ch=ch1-1;  ch >= ch2;  ch=ch-1)
+				call chdeposit (ch, patbuf, sz_pat, op)
+			ip = ip + 1
+		} else {
+		    ch = CH_RANGE
+		    call chdeposit (ch, patbuf, sz_pat, op)
+		}
+	    }
+	}
+end
diff --git a/sys/fmtio/printf.x b/sys/fmtio/printf.x
new file mode 100644
index 00000000..e0662d90
--- /dev/null
+++ b/sys/fmtio/printf.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# PRINTF -- Format output to the standard output.
+
+procedure printf (format_string)
+
+char	format_string[ARB]
+
+begin
+	call fprntf (STDOUT, format_string, REGULAR_FILE)
+end
diff --git a/sys/fmtio/resetscan.x b/sys/fmtio/resetscan.x
new file mode 100644
index 00000000..bde3a8f7
--- /dev/null
+++ b/sys/fmtio/resetscan.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# RESET_SCAN -- Initialize the scan common at the start of a scan.  May also
+# be called by the user to rescan a line, following a conversion failure.
+
+procedure reset_scan()
+
+include	"scan.com"
+
+begin
+	sc_ip = 1
+	sc_ntokens = 0
+	sc_stopscan = false
+end
diff --git a/sys/fmtio/scan.com b/sys/fmtio/scan.com
new file mode 100644
index 00000000..cb60824c
--- /dev/null
+++ b/sys/fmtio/scan.com
@@ -0,0 +1,10 @@
+# SCAN.COM -- Global common for the scan family of routines.
+
+define	SZ_SCANBUF	4096
+
+int	sc_ip			# char pointer into lbuf
+int	sc_ntokens		# keep track of successful conversions
+bool	sc_stopscan		# set if conversion is unsuccessful
+char	sc_scanbuf[SZ_SCANBUF]	# line buffer for scan procedures
+
+common	/scncom/ sc_ip, sc_ntokens, sc_stopscan, sc_scanbuf
diff --git a/sys/fmtio/scanc.x b/sys/fmtio/scanc.x
new file mode 100644
index 00000000..1578af42
--- /dev/null
+++ b/sys/fmtio/scanc.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SCANC -- Return the next character from the scanned input.
+
+procedure scanc (cval)
+
+char	cval
+include	"scan.com"
+
+begin
+	cval = sc_scanbuf[sc_ip]
+	if (cval != EOS)
+	    sc_ip = sc_ip + 1
+end
diff --git a/sys/fmtio/sprintf.x b/sys/fmtio/sprintf.x
new file mode 100644
index 00000000..c247d868
--- /dev/null
+++ b/sys/fmtio/sprintf.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<printf.h>
+
+# SPRINTF: Open string as a file, call fprntf.  When the last argument is
+# passed, and EOS is reached, the string will be closed (by fpradv).
+
+procedure sprintf (outstr, maxch, format_string)
+
+char	outstr[maxch]
+int	maxch
+char	format_string[ARB]
+int	mem_fd, stropen()
+errchk	stropen, fprntf
+
+begin
+	mem_fd = stropen (outstr, maxch, WRITE_ONLY)
+	call fprntf (mem_fd, format_string, STRING_FILE)
+end
diff --git a/sys/fmtio/sscan.x b/sys/fmtio/sscan.x
new file mode 100644
index 00000000..6c877dc2
--- /dev/null
+++ b/sys/fmtio/sscan.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SSCAN -- Begin a scan from a string.  Only the first newline terminated
+# line in the string buffer will be scanned.  If a string buffer containing
+# more than a single line must be scanned, MEMOPEN and FSCAN may be used.
+
+procedure sscan (str)
+
+char	str[ARB]
+int	ip, op
+include	"scan.com"
+
+begin
+	op = 1
+	for (ip=1;  str[ip] != EOS && str[ip] != '\n';  ip=ip+1) {
+	    sc_scanbuf[op] = str[ip]
+	    op = op + 1
+	    if (op >= SZ_SCANBUF)
+		break
+	}
+
+	sc_scanbuf[op] = EOS
+	call reset_scan()				# initialize scan
+end
diff --git a/sys/fmtio/strcat.x b/sys/fmtio/strcat.x
new file mode 100644
index 00000000..777174a3
--- /dev/null
+++ b/sys/fmtio/strcat.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRCAT -- String concatenation.  String STR is appended to OUTSTR.
+
+procedure strcat (str, outstr, maxch)
+
+char	str[ARB], outstr[ARB]
+int	maxch, junk, gstrcat()
+
+begin
+	junk = gstrcat (str, outstr, maxch)
+end
diff --git a/sys/fmtio/strcmp.x b/sys/fmtio/strcmp.x
new file mode 100644
index 00000000..67dbc2ba
--- /dev/null
+++ b/sys/fmtio/strcmp.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRCMP -- Compare two strings.  -N is returned if S1 < S2, 0 if S1 == S2,
+# and +N if S1 > S2.
+
+int procedure strcmp (s1, s2)
+
+char	s1[ARB], s2[ARB]		# strings to be compared
+int	i
+
+begin
+	do i = 1, ARB
+	    if (s1[i] != s2[i])
+		return (s1[i] - s2[i])
+	    else if (s1[i] == EOS)
+		return (0)
+end
diff --git a/sys/fmtio/strcpy.x b/sys/fmtio/strcpy.x
new file mode 100644
index 00000000..8892e89d
--- /dev/null
+++ b/sys/fmtio/strcpy.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRCPY -- Copy string s1 to s2.
+
+procedure strcpy (s1, s2, maxch)
+
+char	s1[ARB], s2[ARB]
+int	maxch, i
+
+begin
+	do i = 1, maxch {
+	    s2[i] = s1[i]
+	    if (s2[i] == EOS)
+		return
+	}
+
+	s2[maxch+1] = EOS
+end
diff --git a/sys/fmtio/strdic.x b/sys/fmtio/strdic.x
new file mode 100644
index 00000000..3da4a71b
--- /dev/null
+++ b/sys/fmtio/strdic.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# STRDIC -- Search a dictionary string for a match with an input string.
+# The input string may be an abbreviation of a dictionary entry, however,
+# it is an error if the abbreviation is not unique.  The entries in the
+# dictionary string are separated by a delimiter character which is the first
+# character of the dictionary string.  The full name of the matched dictionary
+# entry found is returned in out_str; the function value is the word index of
+# the dictionary entry.  The output string may be the same as the input string.
+
+int procedure strdic (in_str, out_str, maxchars, dict)
+
+char	in_str[ARB]		# Input string, always lower case
+char	out_str[ARB]		# Output string as found in dictionary
+int	maxchars		# Maximum length of output string
+char	dict[ARB]		# Dictionary string
+
+char	ch, fch
+int	start, len, ip, i, match, entry
+int	strlen(), strncmp()
+
+begin
+	if (dict[1] == EOS)
+	    return (0)
+
+	for (i=1;  IS_WHITE (in_str[i]);  i=i+1)
+	    ;
+
+	start = i
+	match = 0
+	ip    = 2
+	len   = strlen (in_str[start])
+	fch   = in_str[start]
+
+	# Search the dictionary string.  If the input string matches a
+	# dictionary entry it is either an exact match (len = dictionary
+	# entry length) or a legal abbreviation.  If an abbreviation
+	# matches two entries it is ambiguous and an error.
+
+	for (entry=1;  dict[ip] != EOS;  entry=entry+1) {
+	    if (dict[ip] == fch) {
+		if (strncmp (dict[ip], in_str[start], len) == 0) {
+		    for (i=1;  i <= maxchars;  i=i+1) {
+			ch = dict[ip+i-1]
+			if ((ch == dict[1]) || (ch == EOS))
+			    break
+			out_str[i] = ch
+		    }
+		    out_str[i] = EOS
+
+		    if ((dict[ip+len] == dict[1]) || (dict[ip+len] == EOS))
+			return (entry)		# exact match
+		    else {
+			# If we already have a match and the new match is not
+			# exact, then the abbreviation is ambiguous.
+
+			if (match != 0)
+			    return (0)
+			else
+			    match = entry
+		    }
+		}
+	    }
+
+	    repeat {
+		ip = ip + 1
+	    } until (dict[ip-1] == dict[1] || dict[ip] == EOS)
+	}
+
+        return (match)
+end
diff --git a/sys/fmtio/streq.x b/sys/fmtio/streq.x
new file mode 100644
index 00000000..0f394d6d
--- /dev/null
+++ b/sys/fmtio/streq.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STREQ -- Compare two strings for equality.
+
+bool procedure streq (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s1[ip] != s2[ip])
+		return (false)
+	    else if (s1[ip] == EOS)
+		return (s2[ip] == EOS)
+end
diff --git a/sys/fmtio/strge.x b/sys/fmtio/strge.x
new file mode 100644
index 00000000..4fc24c59
--- /dev/null
+++ b/sys/fmtio/strge.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRGE -- Is S1 >= S2.
+
+bool procedure strge (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s2[ip] == EOS)
+		return (true)
+	    else if (s1[ip] != s2[ip])
+		return (s1[ip] > s2[ip])
+end
diff --git a/sys/fmtio/strgt.x b/sys/fmtio/strgt.x
new file mode 100644
index 00000000..720a1397
--- /dev/null
+++ b/sys/fmtio/strgt.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRGT -- Is S1 > S2.
+
+bool procedure strgt (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s1[ip] == EOS)
+		return (false)
+	    else if (s1[ip] != s2[ip])
+		return (s1[ip] > s2[ip])
+end
diff --git a/sys/fmtio/stridx.x b/sys/fmtio/stridx.x
new file mode 100644
index 00000000..dda74f5a
--- /dev/null
+++ b/sys/fmtio/stridx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRIDX -- Return the index of the first occurrence of a character in a
+# string.
+
+int procedure stridx (ch, str)
+
+char	ch, str[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (str[ip] == EOS)
+		return (0)
+	    else if (str[ip] == ch)
+		return (ip)
+end
diff --git a/sys/fmtio/stridxs.x b/sys/fmtio/stridxs.x
new file mode 100644
index 00000000..fef58806
--- /dev/null
+++ b/sys/fmtio/stridxs.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	BIGSET		10
+define	SZ_ASCII	128
+
+# STRIDXS -- Return the index of the first occurrence of any of a set of
+# characters in a string.
+
+int procedure stridxs (set, str)
+
+char	set[ARB]		# set of characters to be searched for
+char	str[ARB]		# string to be searched
+
+int	setlen, ip, i
+char	ch, lut[SZ_ASCII]
+int	strlen()
+
+begin
+	setlen = strlen (set)
+
+	if (setlen > BIGSET) {
+	    # Encode the set in a lookup table.
+	    call aclrc (lut, SZ_ASCII)
+	    do i = 1, setlen
+		lut[set[i]] = 1
+
+	    # Search the string.
+	    for (ip=1;  str[ip] != EOS;  ip=ip+1)
+		if (lut[str[ip]] != 0)
+		    return (ip)
+
+	} else {
+	    # Set is too small to be worth using a lookup table.
+	    for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+		ch = str[ip]
+		do i = 1, setlen
+		    if (ch == set[i])
+			return (ip)
+	    }
+	}
+	
+	return (0)
+end
diff --git a/sys/fmtio/strldx.x b/sys/fmtio/strldx.x
new file mode 100644
index 00000000..0087a208
--- /dev/null
+++ b/sys/fmtio/strldx.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRLDX -- Return the index of the last occurrence of a character in a
+# string.
+
+int procedure strldx (ch, str)
+
+char	ch, str[ARB]
+int	ip, offset
+
+begin
+	offset = 0
+	do ip = 1, ARB
+	    if (str[ip] == EOS)
+		break
+	    else if (str[ip] == ch)
+		offset = ip
+
+	return (offset)
+end
diff --git a/sys/fmtio/strldxs.x b/sys/fmtio/strldxs.x
new file mode 100644
index 00000000..1c583d0f
--- /dev/null
+++ b/sys/fmtio/strldxs.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	BIGSET		10
+define	SZ_ASCII	128
+
+# STRLDXS -- Return the index of the last occurrence of any of a set of
+# characters in a string.
+
+int procedure strldxs (set, str)
+
+char	set[ARB]		# set of characters to be searched for
+char	str[ARB]		# string to be searched
+
+int	setlen, ip, i, last_member
+char	ch, lut[SZ_ASCII]
+int	strlen()
+
+begin
+	setlen = strlen (set)
+	last_member = 0
+
+	if (setlen > BIGSET) {
+	    # Encode the set in a lookup table.
+	    call aclrc (lut, SZ_ASCII)
+	    do i = 1, setlen
+		lut[set[i]] = 1
+
+	    # Search the string.
+	    for (ip=1;  str[ip] != EOS;  ip=ip+1)
+		if (lut[str[ip]] != 0)
+		    last_member = ip
+
+	} else {
+	    # Set is too small to be worth using a lookup table.
+	    for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+		ch = str[ip]
+		do i = 1, setlen
+		    if (ch == set[i]) {
+			last_member = ip
+			break
+		    }
+	    }
+	}
+	
+	return (last_member)
+end
diff --git a/sys/fmtio/strle.x b/sys/fmtio/strle.x
new file mode 100644
index 00000000..34ad7870
--- /dev/null
+++ b/sys/fmtio/strle.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRLE -- Is S1 <= S2.
+
+bool procedure strle (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s1[ip] == EOS)
+		return (true)
+	    else if (s1[ip] != s2[ip])
+		return (s1[ip] < s2[ip])
+end
diff --git a/sys/fmtio/strlen.x b/sys/fmtio/strlen.x
new file mode 100644
index 00000000..4c3e7364
--- /dev/null
+++ b/sys/fmtio/strlen.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRLEN -- Return length of string (EOS not included).
+
+int procedure strlen (str)
+
+char	str[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (str[ip] == EOS)
+		return (ip - 1)
+end
diff --git a/sys/fmtio/strlt.x b/sys/fmtio/strlt.x
new file mode 100644
index 00000000..0a530d4d
--- /dev/null
+++ b/sys/fmtio/strlt.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRLT -- Is S1 < S2.
+
+bool procedure strlt (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s2[ip] == EOS)
+		return (false)
+	    else if (s1[ip] != s2[ip])
+		return (s1[ip] < s2[ip])
+end
diff --git a/sys/fmtio/strlwr.x b/sys/fmtio/strlwr.x
new file mode 100644
index 00000000..318366ac
--- /dev/null
+++ b/sys/fmtio/strlwr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# STRLWR -- Convert string to lower case.
+
+procedure strlwr (a)
+
+char	a[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (a[ip] == EOS)
+		break
+	    else if (IS_UPPER(a[ip]))
+		a[ip] = TO_LOWER (a[ip])
+end
diff --git a/sys/fmtio/strmac.x b/sys/fmtio/strmac.x
new file mode 100644
index 00000000..1f3f3e98
--- /dev/null
+++ b/sys/fmtio/strmac.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+define	MAX_ARGS	9
+
+.help strmac
+.nf ___________________________________________________________________________
+STRMAC -- Expand a macro (nonrecursively) by string substitution.
+The macro string may contain zero or more occurrences of the sequences
+"$1" through "$9".  The substitution strings are passed in the string
+buffer "argstr", wherein successive strings are delimited by the EOS marker.
+A double EOS marks the end of the list.
+
+Macros $1-$9 are replaced by the substitution string.  The sequence $$ is
+replaced by a single $.  If any other character follows the $, both the $
+and the following character are passed to the output unchanged.  An error
+action is taken if there are insufficient arguments or if the output buffer
+overflows.  Bugs: null substitution strings don't work.
+.endhelp ______________________________________________________________________
+
+int procedure strmac (macro, argstr, outstr, maxch)
+
+char	macro[ARB]		# substitution string
+char	argstr[ARB]		# argument strings, if any
+char	outstr[maxch]		# output string
+int	maxch	
+
+short	offset[MAX_ARGS]
+char	ch
+int	i, ip, op, arg, nargs, nchars
+int	strlen()
+
+begin
+	# Determine the offsets of the argument strings.
+	ip = 1
+	for (nargs=1;  nargs <= MAX_ARGS;  nargs=nargs+1) {
+	    nchars = strlen (argstr[ip])
+	    if (nchars > 0) {
+		offset[nargs] = ip
+		ip = ip + nchars + 1
+	    } else
+		break
+	}
+	nargs = nargs - 1
+
+	# Expand the macro. 
+	op = 1
+	for (ip=1;  macro[ip] != EOS;  ip=ip+1) {
+	    ch = macro[ip]
+
+	    if (ch == '$') {			# Process $ arg sequence.
+		ip = ip + 1
+		ch = macro[ip]
+		if (ch >= '1' && ch <= '9') {
+		    arg = TO_INTEG(ch)
+		    if (arg > nargs)
+			call error (1, "Strmac: too few substitution arguments")
+		    for (i = offset[arg];  argstr[i] != EOS;  i=i+1) {
+			outstr[op] = argstr[i]
+			op = op + 1
+		    }
+
+		} else if (ch == '$') {		# "$$" --> "$"
+		    outstr[op] = '$'
+		    op = op + 1
+
+		} else {			# "$?" --> "$?"
+		    outstr[op] = '$'
+		    op = op + 1
+		    outstr[op] = ch
+		    op = op + 1
+		}
+
+	    } else {				# ordinary character
+		outstr[op] = ch
+		op = op + 1
+	    }
+
+	    if (op > maxch)
+		call error (2, "Strmac: output buffer overflow")
+	}
+
+	outstr[op] = EOS
+	return (op - 1)
+end
diff --git a/sys/fmtio/strmatch.x b/sys/fmtio/strmatch.x
new file mode 100644
index 00000000..ad16bef8
--- /dev/null
+++ b/sys/fmtio/strmatch.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include <pattern.h>
+
+.help strmatch, gstrmatch
+.nf ________________________________________________________________________
+STRMATCH -- Find the first occurrence of the string A in the string B.
+If not found, return zero, else return the index of the first character
+following the matched substring.
+
+GSTRMATCH -- More general version of strmatch.  The indices of the
+first and last characters matched are returned as arguments.  The function
+value is the same as for STRMATCH.
+
+STRMATCH recognizes the metacharacters BOL, EOL, ANY, WHITESPACE, IGNORECASE,
+and MATCHCASE (BOL and EOL are special only as the first and last chars
+in the pattern).  The null pattern matches any string.  Metacharacters
+can be escaped.
+.endhelp ___________________________________________________________________
+
+
+# STRMATCH -- Search string STR for pattern PAT.  Return the index of the
+# next character following the matched substring, or 0.
+
+int procedure strmatch (str, pat)
+
+char	pat[ARB], str[ARB]
+int	first_char, last_char
+int	gstrmatch()
+
+begin
+	return (gstrmatch (str, pat, first_char, last_char))
+end
+
+
+# GSTRMATCH -- Generalized string match.  Returns the indices of the first and
+# last characters in the matched substring if a match occurs.
+
+int procedure gstrmatch (str, pat, first_char, last_char)
+
+char	pat[ARB], str[ARB]
+int	first_char, last_char
+bool	ignore_case, bolflag
+char	ch, pch
+int	i, ip, initial_pp, pp
+
+begin
+	ignore_case = false
+	bolflag = false
+	first_char = 1
+	initial_pp = 1
+
+	if (pat[1] == CH_BOL) {			# match at beginning of line?
+	    bolflag = true
+	    initial_pp = 2
+	}
+	    
+	# Try to match pattern starting at each character offset in string.
+	do ip = 1, ARB {
+	    if (str[ip] == EOS)
+		break
+	    i = ip
+
+	    # Compare pattern to string str[ip].
+	    for (pp=initial_pp;  pat[pp] != EOS;  pp=pp+1) {
+		switch (pat[pp]) {
+		case CH_WHITESPACE:
+		    while (IS_WHITE (str[i]))
+			i = i + 1
+		case CH_ANY:
+		    if (str[i] != '\n')
+			i = i + 1
+		case CH_IGNORECASE:
+		    ignore_case = true
+		case CH_MATCHCASE:
+		    ignore_case = false
+		
+		default:
+		    pch = pat[pp]
+		    if (pch == CH_ESCAPE && pat[pp+1] != EOS) {
+			pp = pp + 1
+			pch = pat[pp]
+		    } else if (pch == CH_EOL)
+		        if (pat[pp+1] == EOS && (str[i]=='\n' || str[i]==EOS)) {
+			    first_char = ip
+			    last_char = i
+			    if (str[i] == EOS)
+				last_char = last_char - 1
+			    return (last_char + 1)
+			}
+
+		    ch = str[i]
+		    i = i + 1
+
+		    # Compare ordinary characters.  The comparison is trivial
+		    # unless case insensitivity is required.
+
+		    if (ignore_case) {
+	                if (IS_UPPER (ch)) {
+			    if (IS_UPPER (pch)) {
+				if (pch != ch)
+				    break
+			    } else if (pch != TO_LOWER (ch))
+		                    break
+	                } else if (IS_LOWER (ch)) {
+			    if (IS_LOWER (pch)) {
+		                if (pch != ch)
+		                    break
+			    } else if (pch != TO_UPPER (ch))
+				    break
+	                } else {
+			    if (pch != ch)
+				break
+			}
+		    } else {
+			if (pch != ch)
+			    break
+		    }
+	        }
+	    }
+
+	    # If the above loop was exited before the end of the pattern
+	    # was reached, the pattern did not match.
+
+	    if (pat[pp] == EOS) {
+		first_char = ip
+		last_char = i-1
+		return (i)
+
+	    } else if (bolflag || str[i] == EOS)
+		break
+	}
+
+	return (0)				# no match
+end
diff --git a/sys/fmtio/strncmp.x b/sys/fmtio/strncmp.x
new file mode 100644
index 00000000..515aeaaf
--- /dev/null
+++ b/sys/fmtio/strncmp.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRNCMP -- Compare the first N characters of two strings.  A negative value
+# is returned if S1 < S2, 0 if S1 == S2, and a positive value if S1 > S2.
+
+int procedure strncmp (s1, s2, n)
+
+char	s1[ARB], s2[ARB]		# strings to be compared
+int	n				# number of chars to compare
+int	i
+
+begin
+	do i = 1, n
+	    if (s1[i] != s2[i])
+		return (s1[i] - s2[i])
+	    else if (s1[i] == EOS)
+		return (0)
+
+	return (0)
+end
diff --git a/sys/fmtio/strne.x b/sys/fmtio/strne.x
new file mode 100644
index 00000000..ee95d3fe
--- /dev/null
+++ b/sys/fmtio/strne.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRNE -- Compare two strings for inequality.
+
+bool procedure strne (s1, s2)
+
+char	s1[ARB], s2[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (s1[ip] == EOS)
+		return (s2[ip] != EOS)
+	    else if (s1[ip] != s2[ip])
+		return (true)
+end
diff --git a/sys/fmtio/strsearch.x b/sys/fmtio/strsearch.x
new file mode 100644
index 00000000..e3006ed8
--- /dev/null
+++ b/sys/fmtio/strsearch.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRSEARCH -- Search a string for a substring.  This is the simplest and
+# fastest member of the pattern matching family.  A significant increase in
+# efficiency will result if this procedure is used to search for substrings
+# that do not use any metacharacters.
+
+int procedure strsearch (str, patstr)
+
+char	str[ARB]		# string to be searched
+char	patstr[ARB]		# substring to search for
+
+int	first_char, ch
+int	ip, patlen
+bool	strse1()
+
+begin
+	# The null pattern matches any string.
+	if (patstr[1] == EOS)
+	    return (1)
+
+	first_char = patstr[1]
+
+	do ip = 1, ARB {
+	    ch = str[ip]
+	    if (ch == EOS)
+		break
+	    if (ch == first_char)
+		if (strse1 (str[ip], patstr, patlen))
+		    return (ip + patlen)
+	}
+
+	return (0)
+end
+
+
+# STRSE1 -- Internal routine which compares a substring of the first string
+# with the pattern string.  STREQ cannot be used because it does not give a
+# match unless the two strings have the same length.
+
+bool procedure strse1 (str, patstr, patlen)
+
+char	str[ARB]
+char	patstr[ARB]
+int	patlen
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (patstr[ip] == EOS || str[ip] != patstr[ip])
+		break
+
+	patlen = ip - 1
+	return (patstr[ip] == EOS)
+end
diff --git a/sys/fmtio/strsrt.x b/sys/fmtio/strsrt.x
new file mode 100644
index 00000000..67318f01
--- /dev/null
+++ b/sys/fmtio/strsrt.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	20		# log2(maxpts)  (1e6)
+
+# STRSRT -- Sort a list of strings, given an array of indices pointing into a
+# string buffer (e.g., sbuf=1 is Memc).  The sort is performed by permutation
+# of the index array.
+
+procedure strsrt (x, sb, nstr)
+
+int	x[ARB]			# array of string pointers or indices
+char	sb[ARB]			# string buffer
+int	nstr			# number of strings
+
+int	i, j, k, p, temp
+int	lv[LOGPTR], uv[LOGPTR], pivot
+define	swap {temp=$1;$1=$2;$2=temp}
+int	strcmp()
+
+begin
+	lv[1] = 1
+	uv[1] = nstr
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do-loop to trigger optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the middle of the
+		    # subfile; move it to the end of the range so that the
+		    # for loops below do not have to skip over it.  Selecting
+		    # a pivot near the center of the subfile helps prevent
+		    # quadratic behavior when sorting an already sorted array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (x[j], x[k])
+		    pivot = x[j]
+
+		    while (i < j) {
+			for (i=i+1;  strcmp (sb[x[i]], sb[pivot]) < 0;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (strcmp (sb[x[j]], sb[pivot]) <= 0)
+				break
+			if (i < j)		# out of order pair
+			    swap (x[i], x[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (x[i], x[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/fmtio/strtbl.x b/sys/fmtio/strtbl.x
new file mode 100644
index 00000000..7ec0205d
--- /dev/null
+++ b/sys/fmtio/strtbl.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRTBL -- Print a list of strings on the named file.  If NCOL is zero,
+# the maximum number of columns is calculated based on the maximum
+# string length.  If NCOL is nonzero, it is taken to be the maximum
+# number of columns (the actual number may be less, depending on the
+# maximum string length).  FIRST_COL and LAST_COL define where on the
+# page the table will be placed.
+
+procedure strtbl (fd, buf, strp, nstr, first_col, last_col, maxch, ncol)
+
+int	fd			# output file
+char	buf[ARB]		# buffer containing the strings
+int	strp[ARB]		# array of string pointers
+int	nstr			# number of strings
+int	first_col, last_col	# where to place table on a line
+int	maxch			# maximum chars to print from a string
+int	ncol			# desired number of columns (0 to autoscale)
+
+pointer	sp, obuf, op
+int	row, i, j, p, nspaces, maxlen, colwidth, numcol, numrow, str
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (obuf, last_col + 1, TY_CHAR)
+
+	maxlen = 0
+	do i = 1, nstr
+	    maxlen = max (maxlen, strlen(buf[strp[i]]))
+	if (maxch > 0)
+	    maxlen = min (maxch, maxlen)
+	numcol = max (1, (last_col - first_col + 1) / (maxlen + 2))
+
+	if (ncol > 0)
+	    numcol = min (numcol, ncol)
+	colwidth = (last_col - first_col + 1) / numcol
+	numrow = (nstr + numcol-1) / numcol 
+
+	# For each row in the table:
+	do row = 1, numrow {
+	    op = obuf
+
+	    # Space to the first column.
+	    do i = 2, first_col {
+		Memc[op] = ' '
+		op = op + 1
+	    }
+
+	    # For each string in the row:
+	    do i = 1, numcol {
+		str = row + (i-1) * numrow
+		if (str > nstr)
+		    next
+		p = strp[str]
+
+		# Output the string.
+		for (j=0;  buf[p+j] != EOS && j < maxlen;  j=j+1) {
+		    Memc[op] = buf[p+j]
+		    op = op + 1
+		}
+
+		# Advance to the next column.
+		if (i < numcol) {
+		    nspaces = max (2, colwidth - j)
+		    for (j=1;  j <= nspaces;  j=j+1) {
+			Memc[op] = ' '
+			op = op + 1
+		    }
+		}
+	    }
+
+	    # Terminate this row of the table.
+	    Memc[op] = '\n'
+	    op = op + 1
+	    Memc[op] = EOS
+	    call putline (fd, Memc[obuf])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/fmtio/strupr.x b/sys/fmtio/strupr.x
new file mode 100644
index 00000000..6e80108c
--- /dev/null
+++ b/sys/fmtio/strupr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# STRUPR -- Convert string to upper case.
+
+procedure strupr (str)
+
+char	str[ARB]
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (str[ip] == EOS)
+		return
+	    else if (IS_LOWER (str[ip]))
+		str[ip] = TO_UPPER (str[ip])
+end
diff --git a/sys/fmtio/tokdata.inc b/sys/fmtio/tokdata.inc
new file mode 100644
index 00000000..ceb7c090
--- /dev/null
+++ b/sys/fmtio/tokdata.inc
@@ -0,0 +1,32 @@
+# TOKDATA.INC -- Character classes for ctotok.x.
+# identifier=1, number=2, operator=3, punctuation=4, string=5, unknown=8
+
+#				  !   "   #   $   %   &   '   (   )   *
+data	(class(i),i= 1,10)	/ 3,  5,  3,  1,  3,  3,  5,  4,  4,  3/
+
+#				  +   ,   -   .   /   0   1   2   3   4
+data	(class(i),i=11,20)	/ 3,  4,  3,  1,  3,  1,  1,  1,  1,  1/
+
+#				  5   6   7   8   9   :   ;   <   =   >
+data	(class(i),i=21,30)	/ 1,  1,  1,  1,  1,  4,  4,  3,  3,  3/
+
+#				  ?   @   A   B   C   D   E   F   G   H
+data	(class(i),i=31,40)	/ 3,  3,  1,  1,  1,  1,  1,  1,  1,  1/
+
+#				  I   J   K   L   M   N   O   P   Q   R
+data	(class(i),i=41,50)	/ 1,  1,  1,  1,  1,  1,  1,  1,  1,  1/
+
+#				  S   T   U   V   W   X   Y   Z   [   \
+data	(class(i),i=51,60)	/ 1,  1,  1,  1,  1,  1,  1,  1,  4,  4/
+
+#				  ]   ^   _   `   a   b   c   d   e   f
+data	(class(i),i=61,70)	/ 4,  3,  1,  3,  1,  1,  1,  1,  1,  1/
+
+#				  g   h   i   j   k   l   m   n   o   p
+data	(class(i),i=71,80)	/ 1,  1,  1,  1,  1,  1,  1,  1,  1,  1/
+
+#				  q   r   s   t   u   v   w   x   y   z
+data	(class(i),i=81,90)	/ 1,  1,  1,  1,  1,  1,  1,  1,  1,  1/
+
+#				  {   |   }   ~  DEL
+data	(class(i),i=91,96)	/ 4,  3,  4,  3,  8, EOS/
diff --git a/sys/fmtio/xevgettok.x b/sys/fmtio/xevgettok.x
new file mode 100644
index 00000000..34e6c37e
--- /dev/null
+++ b/sys/fmtio/xevgettok.x
@@ -0,0 +1,208 @@
+include	<lexnum.h>
+include	<ctype.h>
+include	<evexpr.h>
+
+
+
+# Parse definitions.
+define  CONSTANT        257
+define  IDENTIFIER      258
+define  NEWLINE         259
+define  YYEOS           260
+define  PLUS            261
+define  MINUS           262
+define  STAR            263
+define  SLASH           264
+define  EXPON           265
+define  CONCAT          266
+define  QUEST           267
+define  COLON           268
+define  LT              269
+define  GT              270
+define  LE              271
+define  EQ              272
+define  NE              273
+define  SE              274
+define  AND             275
+define  OR              276
+define  NOT             277
+define  AT              278
+define  GE              279
+define  UMINUS          280
+
+
+# XEV_GETTOK -- Lexical analyzer for EVEXPR.  Returns the token code as the
+# function value.  If the token is an operand (identifier or constant) the
+# operand value is returned in OUT.
+
+int procedure xev_gettok (ip, out)
+
+pointer	ip			# pointer into input string (expression)
+pointer	out			# pointer to yacc YYLVAL token value operand
+
+char	ch
+long	lval
+double	dval
+pointer	ip_start
+int	nchars, token, junk
+int	stridx(), lexnum(), gctod(), gctol()
+define	ident_ 91
+
+begin
+	while (IS_WHITE(Memc[ip]))
+	    ip = ip + 1
+
+	ch = Memc[ip]
+	switch (ch) {
+	case 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',      'J', 'K', 'L', 'M',
+	     'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 
+	     'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
+	     'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z': 
+
+	    # Return an identifier.
+ident_
+	    ip_start = ip
+	    while (IS_ALNUM(ch) || stridx (ch, "_.$@#%&;[]\\^{}~") > 0) {
+		ip = ip + 1
+		ch = Memc[ip]
+	    }
+
+	    nchars = ip - ip_start
+	    call xev_initop (out, nchars, TY_CHAR)
+	    call strcpy (Memc[ip_start], O_VALC(out), nchars)
+
+	    return (IDENTIFIER)
+
+	case 'I', '.', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
+	    # Return a numeric constant.  The character I vectors here so
+	    # that we can check for INDEF, a legal number.
+
+	    token = lexnum (Memc, ip, nchars)
+	    switch (token) {
+	    case LEX_OCTAL:
+		junk = gctol (Memc, ip, lval, 8)
+		call xev_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+	    case LEX_DECIMAL:
+		junk = gctol (Memc, ip, lval, 10)
+		call xev_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+	    case LEX_HEX:
+		junk = gctol (Memc, ip, lval, 16)
+		call xev_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+	    case LEX_REAL:
+		junk = gctod (Memc, ip, dval)
+		call xev_initop (out, 0, TY_REAL)
+		if (IS_INDEFD (dval))
+		    O_VALR(out) = INDEFR
+		else
+		    O_VALR(out) = dval
+	    default:
+		goto ident_
+	    }
+
+	    return (CONSTANT)
+
+	case '\'', '"':
+	    # Return a string constant.
+
+	    ip_start = ip + 1
+	    for (ip=ip+1;  Memc[ip] != ch && Memc[ip] != EOS;  ip=ip+1)
+		;
+
+	    nchars = ip - ip_start
+	    if (Memc[ip] == EOS)
+		call xev_error ("missing closing quote in string constant")
+	    else
+		ip = ip + 1
+
+	    call xev_initop (out, nchars, TY_CHAR)
+	    call strcpy (Memc[ip_start], O_VALC(out), nchars)
+
+	    return (CONSTANT)
+
+	case '+':
+	    token = PLUS
+	case '-':
+	    token = MINUS
+	case '*':
+	    if (Memc[ip+1] == '*') {
+		ip = ip + 1
+		token = EXPON
+	    } else
+		token = STAR
+	case '/':
+	    if (Memc[ip+1] == '/') {
+		ip = ip + 1
+		token = CONCAT
+	    } else
+		token = SLASH
+
+	case '?':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = SE
+	    } else
+		token = QUEST
+
+	case ':':
+	    token = COLON
+
+	case '@':
+	    token = AT
+
+	case '<':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = LE
+	    } else
+		token = LT
+	case '>':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = GE
+	    } else
+		token = GT
+	case '!':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = NE
+	    } else
+		token = NOT
+	case '=':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = EQ
+	    } else
+		token = EQ
+	case '&':
+	    if (Memc[ip+1] == '&') {
+		ip = ip + 1
+		token = AND
+	    } else
+		token = AND
+	case '|':
+	    if (Memc[ip+1] == '|') {
+		ip = ip + 1
+		token = OR
+	    } else
+		token = OR
+
+	case '(', ')', ',':
+	    token = ch
+
+	default:
+	    if (ch == '\n')
+		token = NEWLINE
+	    else if (ch == EOS)
+		token = YYEOS
+	    else {
+		# Anything we don't understand is assumed to be an identifier.
+		goto ident_
+	    }
+	}
+
+	ip = ip + 1
+	return (token)
+end
diff --git a/sys/fmtio/xtoc.x b/sys/fmtio/xtoc.x
new file mode 100644
index 00000000..8315b4cd
--- /dev/null
+++ b/sys/fmtio/xtoc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XTOC -- Encode a complex number as a character string in a field width of
+# at most WIDTH characters.
+
+int procedure xtoc (xval, outstr, maxch, decpl, fmt, width)
+
+complex	xval			# value to be formatted
+char	outstr[ARB]		# output string
+int	fmt			# format encoding (f,e,etc.)
+int	maxch			# max chars out
+int	decpl			# precision
+int	width			# field width
+
+int	op, dtoc()
+double	real_part, imag_part
+define	output {outstr[op]=$1;op=op+1;if(op>maxch)goto overflow_}
+define	overflow_ 91
+
+begin
+	if (IS_INDEFX (xval)) {
+	    real_part = INDEFD
+	    imag_part = INDEFD
+	} else {
+	    real_part = real (xval)
+	    imag_part = aimag (xval)
+	}
+
+	op = 1
+	output ('(')
+	op = op + dtoc (real_part, outstr[op], maxch-op+1, decpl, fmt, width)
+	output (',')
+	op = op + dtoc (imag_part, outstr[op], maxch-op+1, decpl, fmt, width)
+	output (')')
+
+overflow_
+	outstr[op] = EOS
+	return (op-1)
+end
diff --git a/sys/fmtio/xvvgettok.x b/sys/fmtio/xvvgettok.x
new file mode 100644
index 00000000..f2a05977
--- /dev/null
+++ b/sys/fmtio/xvvgettok.x
@@ -0,0 +1,234 @@
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math.h>
+include	<evvexpr.h>
+
+
+# Parser definitions.
+define  CONSTANT        257
+define  IDENTIFIER      258
+define  NEWLINE         259
+define  YYEOS           260
+define  PLUS            261
+define  MINUS           262
+define  STAR            263
+define  SLASH           264
+define  EXPON           265
+define  CONCAT          266
+define  QUEST           267
+define  COLON           268
+define  LT              269
+define  GT              270
+define  LE              271
+define  EQ              272
+define  NE              273
+define  SE              274
+define  LAND            275
+define  LOR             276
+define  LNOT            277
+define  BAND            278
+define  BOR             279
+define  BXOR            280
+define  BNOT            281
+define  AT              282
+define  GE              283
+define  UMINUS          284
+
+
+# XVV_GETTOK -- Lexical analyzer for EVVEXPR.  Returns the token code as the
+# function value.  If the token is an operand (identifier or constant) the
+# operand value is returned in OUT.
+
+int procedure xvv_gettok (ip, out)
+
+pointer	ip			#I pointer into input string (expression)
+pointer	out			#I pointer to yacc YYLVAL token value operand
+
+char	ch
+long	lval
+double	dval
+pointer	ip_start
+char	numbuf[MAX_DIGITS]
+int	nchars, token, junk, dtype
+int	stridx(), stridxs(), lexnum(), gctod(), gctol()
+define	ident_ 91
+
+begin
+	while (IS_WHITE(Memc[ip]))
+	    ip = ip + 1
+
+	ch = Memc[ip]
+	switch (ch) {
+	case 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',      'J', 'K', 'L', 'M',
+	     'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 
+	     'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
+	     'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z': 
+
+	    # Return an identifier.
+ident_
+	    ip_start = ip
+	    while (IS_ALNUM(ch) || stridx (ch, "_.$@#%&;[]\\^{}~") > 0) {
+		ip = ip + 1
+		ch = Memc[ip]
+	    }
+
+	    nchars = ip - ip_start
+	    call xvv_initop (out, nchars, TY_CHAR)
+	    call strcpy (Memc[ip_start], O_VALC(out), nchars)
+
+	    return (IDENTIFIER)
+
+	case 'I', '.', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
+	    # Return a numeric constant.  The character I vectors here so
+	    # that we can check for INDEF, a legal number.
+
+	    token = lexnum (Memc, ip, nchars)
+	    switch (token) {
+	    case LEX_OCTAL:
+		junk = gctol (Memc, ip, lval, 8)
+		call xvv_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+	    case LEX_DECIMAL:
+		junk = gctol (Memc, ip, lval, 10)
+		call xvv_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+	    case LEX_HEX:
+		junk = gctol (Memc, ip, lval, 16)
+		call xvv_initop (out, 0, TY_INT)
+		O_VALI(out) = lval
+
+	    case LEX_REAL:
+		ip_start = ip
+		nchars = gctod (Memc, ip, dval)
+		call strcpy (Memc[ip], numbuf, min(nchars,MAX_DIGITS))
+
+		dtype = TY_REAL
+		if (stridxs ("dD", numbuf) > 0 || nchars > NDIGITS_RP+3)
+		    dtype = TY_DOUBLE
+
+		call xvv_initop (out, 0, dtype)
+		if (dtype == TY_REAL) {
+		    if (IS_INDEFD (dval))
+			O_VALR(out) = INDEFR
+		    else
+			O_VALR(out) = dval
+		} else {
+		    if (IS_INDEFD (dval))
+			O_VALD(out) = INDEFD
+		    else
+			O_VALD(out) = dval
+		}
+	    default:
+		goto ident_
+	    }
+
+	    return (CONSTANT)
+
+	case '\'', '"':
+	    # Return a string constant.
+
+	    ip_start = ip + 1
+	    for (ip=ip+1;  Memc[ip] != ch && Memc[ip] != EOS;  ip=ip+1)
+		;
+
+	    nchars = ip - ip_start
+	    if (Memc[ip] == EOS)
+		call xvv_error ("missing closing quote in string constant")
+	    else
+		ip = ip + 1
+
+	    call xvv_initop (out, nchars, TY_CHAR)
+	    call strcpy (Memc[ip_start], O_VALC(out), nchars)
+
+	    return (CONSTANT)
+
+	case '+':
+	    token = PLUS
+	case '-':
+	    token = MINUS
+	case '*':
+	    if (Memc[ip+1] == '*') {
+		ip = ip + 1
+		token = EXPON
+	    } else
+		token = STAR
+	case '/':
+	    if (Memc[ip+1] == '/') {
+		ip = ip + 1
+		token = CONCAT
+	    } else
+		token = SLASH
+
+	case '?':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = SE
+	    } else
+		token = QUEST
+
+	case ':':
+	    token = COLON
+
+	case '@':
+	    token = AT
+
+	case '<':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = LE
+	    } else
+		token = LT
+	case '>':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = GE
+	    } else
+		token = GT
+	case '!':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = NE
+	    } else
+		token = LNOT
+	case '=':
+	    if (Memc[ip+1] == '=') {
+		ip = ip + 1
+		token = EQ
+	    } else
+		token = EQ
+	case '&':
+	    if (Memc[ip+1] == '&') {
+		ip = ip + 1
+		token = LAND
+	    } else
+		token = BAND
+	case '|':
+	    if (Memc[ip+1] == '|') {
+		ip = ip + 1
+		token = LOR
+	    } else
+		token = BOR
+
+	case '^':
+	    token = BXOR
+	case '~':
+	    token = BNOT
+
+	case '(', ')', ',':
+	    token = ch
+
+	default:
+	    if (ch == '\n')
+		token = NEWLINE
+	    else if (ch == EOS)
+		token = YYEOS
+	    else {
+		# Anything we don't understand is assumed to be an identifier.
+		goto ident_
+	    }
+	}
+
+	ip = ip + 1
+	return (token)
+end
diff --git a/sys/fmtio/zzdebug.x b/sys/fmtio/zzdebug.x
new file mode 100644
index 00000000..3729a1ff
--- /dev/null
+++ b/sys/fmtio/zzdebug.x
@@ -0,0 +1,319 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<evexpr.h>
+include	<lexnum.h>
+
+task	ev	= t_ev,
+	lex	= t_lex,
+	eq	= t_eq,
+	ne	= t_ne,
+	lt	= t_lt,
+	le	= t_le,
+	gt	= t_gt,
+	ge	= t_ge,
+	cmp	= t_cmp,
+	ncmp	= t_ncmp,
+	mat	= t_mat,
+	srch	= t_srch,
+	ctowrd	= t_ctowrd
+
+
+# EV -- Text EVEXPR.
+
+procedure t_ev
+
+char	expr[SZ_LINE]
+pointer	o, evexpr()
+int	clglstr()
+
+begin
+	while (clglstr ("expr", expr, SZ_LINE) != EOF) {
+	    o = evexpr (expr, 0, 0)
+
+	    switch (O_TYPE(o)) {
+	    case TY_BOOL:
+		call printf ("%b = %s\n")
+		    call pargb (O_VALB(o))
+		    call pargstr (expr)
+
+	    case TY_CHAR:
+		call printf ("%s = %s\n")
+		    call pargstr (O_VALC(o))
+		    call pargstr (expr)
+
+	    case TY_INT:
+		call printf ("%d = %s\n")
+		    call pargi (O_VALI(o))
+		    call pargstr (expr)
+
+	    case TY_REAL:
+		call printf ("%g = %s\n")
+		    call pargr (O_VALR(o))
+		    call pargstr (expr)
+
+	    default:
+		call error (1, "expression datatype unknown")
+	    }
+	} 
+
+	call printf ("\n")
+end
+
+
+# LEX -- Test LEXNUM.
+
+procedure t_lex()
+
+int	ip, nchars, toktype
+char	token[SZ_FNAME]
+int	lexnum(), strlen()
+
+begin
+	repeat {
+	    call clgstr ("token", token, SZ_FNAME)
+	    if (strlen (token) == 0)
+		break
+
+	    ip = 1
+	    toktype = lexnum (token, ip, nchars)
+
+	    call printf ("tokchars=%d, type = %s\n")
+		call pargi (nchars)
+
+		switch (toktype) {
+		case LEX_OCTAL:
+		    call pargstr ("octal")
+		case LEX_DECIMAL:
+		    call pargstr ("decimal")
+		case LEX_HEX:
+		    call pargstr ("hex")
+		case LEX_REAL:
+		    call pargstr ("real")
+		case LEX_NONNUM:
+		    call pargstr ("nonnumeric")
+		default:
+		    call pargstr ("unknown")
+		}
+	}
+end
+
+
+# EQ -- Test string equals.
+
+procedure t_eq()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	streq()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s == %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (streq (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# NE -- Test string not equals.
+
+procedure t_ne()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	strne()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s != %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (strne (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# LT -- Test string less than.
+
+procedure t_lt()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	strlt()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s < %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (strlt (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# LE -- Test string less than or equals.
+
+procedure t_le()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	strle()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s <= %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (strle (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# GT -- Test string greater than.
+
+procedure t_gt()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	strgt()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s > %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (strgt (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# GE -- Test string greater than or equals.
+
+procedure t_ge()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+bool	strge()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("%s >= %s: %b\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargb (strge (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# CMP -- Test string compare.
+
+procedure t_cmp()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+int	strcmp()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("compare %s, %s: %d\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargi (strcmp (s1, s2))
+	    call flush (STDOUT)
+	}
+end
+
+
+# NCMP -- Test counted string compare.
+
+procedure t_ncmp()
+
+char	s1[SZ_FNAME], s2[SZ_FNAME]
+int	strncmp(), clgeti()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("s2", s2, SZ_FNAME)
+	    call printf ("compare %s, %s: %d\n")
+		call pargstr (s1)
+		call pargstr (s2)
+		call pargi (strncmp (s1, s2, clgeti("nchars")))
+	    call flush (STDOUT)
+	}
+end
+
+
+# MAT -- Test string match.
+
+procedure t_mat()
+
+char	s1[SZ_FNAME], pat[SZ_FNAME]
+int	strmatch()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("pat", pat, SZ_FNAME)
+	    call printf ("match %s, pat=%s: %d\n")
+		call pargstr (s1)
+		call pargstr (pat)
+		call pargi (strmatch (s1, pat))
+	    call flush (STDOUT)
+	}
+end
+
+
+# SRCH -- Test string search.
+
+procedure t_srch()
+
+char	s1[SZ_FNAME], pat[SZ_FNAME]
+int	strsearch()
+
+begin
+	repeat {
+	    call clgstr ("s1", s1, SZ_FNAME)
+	    call clgstr ("pat", pat, SZ_FNAME)
+	    call printf ("search %s, pat=%s: %d\n")
+		call pargstr (s1)
+		call pargstr (pat)
+		call pargi (strsearch (s1, pat))
+	    call flush (STDOUT)
+	}
+end
+
+
+# CTOWRD -- Test ctowrd.
+
+procedure t_ctowrd()
+
+char	buf1[SZ_LINE], buf2[SZ_LINE]
+int	n, ip, ctowrd(), getline()
+
+begin
+	while (getline (STDIN, buf1) != EOF) {
+	    ip = 1
+	    repeat {
+		buf2[1] = EOS
+		n = ctowrd (buf1, ip, buf2, SZ_LINE)
+		call printf ("n=%d, token=%s\n")
+		    call pargi (n)
+		    call pargstr (buf2)
+	    } until (n <= 0)
+	}
+end
diff --git a/sys/gio/README b/sys/gio/README
new file mode 100644
index 00000000..e7db4cdd
--- /dev/null
+++ b/sys/gio/README
@@ -0,0 +1,6 @@
+GIO
+
+    This directory contains the source for the IRAF GIO (graphics i/o)
+interface.  The interface is documented in the file "Gio.hlp".  Source for
+the STDGRAPH kernel will be found in the subdirectory "stdgraph".  Source
+for the NSPP kernel will be found in the subdirectory "nspp".
diff --git a/sys/gio/aelogd.x b/sys/gio/aelogd.x
new file mode 100644
index 00000000..0a3d3b26
--- /dev/null
+++ b/sys/gio/aelogd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AELOGD -- Inverse of the elogd function.
+
+double procedure aelogd (x)
+
+double	x
+
+begin
+	if (x > 1.0D0)
+	    return (10.0D0 ** x)
+	else if (x >= -1.0D0)
+	    return (x * 10.0D0)
+	else
+	    return (- (10.0D0 ** (-x)))
+end
diff --git a/sys/gio/aelogr.x b/sys/gio/aelogr.x
new file mode 100644
index 00000000..81920a9a
--- /dev/null
+++ b/sys/gio/aelogr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AELOGR -- Inverse of the elogr function.
+
+real procedure aelogr (x)
+
+real	x
+
+begin
+	if (x > 1.0)
+	    return (10.0 ** x)
+	else if (x >= -1.0)
+	    return (x * 10.0)
+	else
+	    return (-(10.0 ** (-x)))
+end
diff --git a/sys/gio/calcomp/README b/sys/gio/calcomp/README
new file mode 100644
index 00000000..c3dd017f
--- /dev/null
+++ b/sys/gio/calcomp/README
@@ -0,0 +1,34 @@
+GIO Calcomp kernel
+
+This directory contains source for the IRAF calcomp graphics kernel.
+Specifications may be found in ccpspecs.hlp.  Installation involves
+building the kernel task, which is accomplished using "make" (Makefile)
+with argument "install" to move the executable into lib$.
+
+In addition to the kernel task routines, the vttest.x routine contains code 
+to simulate calcomp software on standard gio graphics devices.  vttest.x
+contains all the source for the simulation, using parameter file vttest.par.
+Here, the calcomp routines "plot", "plots", "newpen", and "symbol" are
+replaced with appropriate gio calls (violating interfaces) and to be used
+mainly for testing text fonts, line type and width simulation.
+
+TODO:
+
+- super-bold font
+- bold + italic
+
+- multiples of dash, dot for linetypes numbered higher than 4
+
+--------------------------------------------------------------------------------
+FUTURE ENHANCEMENTS (much work):
+
+1)  Sophisticated parallel-tracing algorithm that looks at entire array
+    and merges intersections so that all adjacent segments are parallel
+    to each other and do not cross the acute bisector.  Implemented by
+    parallel array segments rather than drawing each parallel segment
+    individually, to avoid pen overtravel on short choppy lines.
+
+2)  Panelling: when plot width exceeds available paper width, wrap graphics
+    to beyond maximum x so that paper can be cut and pasted.
+
+3)  Versatec extension with area-fill.
diff --git a/sys/gio/calcomp/ccp.com b/sys/gio/calcomp/ccp.com
new file mode 100644
index 00000000..d9e9ac69
--- /dev/null
+++ b/sys/gio/calcomp/ccp.com
@@ -0,0 +1,38 @@
+# CCP common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The kernel data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_cc				# kernel graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in				# input file
+real	g_xres				# x resolution of plotter
+real	g_yres				# y resolution of plotter
+real	g_max_x				# maximum x drawn, in plotter units
+real	g_xndcto_p			# x(pltr) = GKI*g_xndcto_p; final scale
+real	g_yndcto_p			# y(pltr) = GKI*g_yndcto_p; final scale
+real	g_xtask_scale			# x scale determined from task params
+real	g_ytask_scale			# y scale determined from task params
+real	g_xdefault_scale		# x scale from graphcap or compile-time
+real	g_ydefault_scale		# y scale from graphcap or compile-time
+int	g_ltype				# line type
+real	g_dashlen			# length of dash in dashed line, p_units
+real	g_gaplen			# width of gap in dash/dot line, p_units
+real	g_plwsep			# polyline width separation for ntracing
+int	g_txquality			# text quality parameter
+bool	g_ltover			# user override of line-type generator
+bool	g_lwover			# user override of line width simulation
+bool	g_lcover			# user override of line color generator
+char	g_lwtype			# line width mode parameter
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/ccpcom/ g_cc, g_tty, g_nframes, g_maxframes, g_ndraw,
+		 g_in, g_xres, g_yres, g_max_x, g_xndcto_p, g_yndcto_p,
+		 g_xtask_scale, g_ytask_scale, 
+		 g_xdefault_scale, g_ydefault_scale,
+		 g_ltype, g_dashlen, g_gaplen, g_plwsep, g_txquality,
+		 g_ltover, g_lwover, g_lcover, g_lwtype, g_device
diff --git a/sys/gio/calcomp/ccp.h b/sys/gio/calcomp/ccp.h
new file mode 100644
index 00000000..037dbc6a
--- /dev/null
+++ b/sys/gio/calcomp/ccp.h
@@ -0,0 +1,92 @@
+# CCP definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	CCP_LDEV	5			# device for "plots(0,0,ldev")
+define	CCP_UP		3			# "pen-up" code
+define	CCP_DOWN	2			# "pen-down" code
+define	PL_SINGLE	1			# rel width of single-width line
+define	MAXTRACES	15			# maximum adjacent bold traces
+define	SEGSIZE		256			# segment buffer size
+define	XSEG		Memr[xseg + $1 - 1]	# segment buffer for ccp_calcseg
+define	YSEG		Memr[yseg + $1 - 1]	# "
+define	DIS		sqrt ((($3)-($1))**2+(($4)-($2))**2) #dis (x1,y1, x2,y2)
+define	XTRAN		($1) * g_xndcto_p	# convert NDC to plotter coords
+define	YTRAN		($1) * g_yndcto_p	# "
+define	FRAME_OFFSET	1.0			# pltr units between [new]frames
+define	MAX_PL_XWIDTH	0.3307			# max pltr x (m) if no graphcap
+define	MAX_PL_YHEIGHT	0.2540			# max pltr y (m) if no graphcap
+define	DEF_MPER_PUNIT	0.0254			# default meters / plotter unit
+define	DEF_DASHLEN	0.1000			# default dash length, pltr unit
+define	DEF_GAPLEN	0.0500			# default gap length, pltr units
+define	DEF_PLWSEP	0.0050			# default ntracing sep. in pu
+
+# CCP state device descriptor:
+
+define	LEN_CCP		81
+
+define	CCP_SBUF	Memi[$1]		# string buffer
+define	CCP_SZSBUF	Memi[$1+1]		# size of string buffer
+define	CCP_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	CCP_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	CCP_POLYLINE	Memi[$1+4]		# device supports polyline
+define	CCP_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	CCP_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	CCP_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	CCP_ZRES	Memi[$1+8]		# device resolution in Z
+define	CCP_FILLSTYLE	Memi[$1+9]		# number of fill styles
+define	CCP_ROAM	Memi[$1+10]		# device supports roam
+define	CCP_ZOOM	Memi[$1+11]		# device supports zoom
+define	CCP_SELERASE	Memi[$1+12]		# device has selective erase
+define	CCP_PIXREP	Memi[$1+13]		# device supports pixel replic.
+define	CCP_STARTFRAME	Memi[$1+14]		# frame advance at metafile BOF
+define	CCP_ENDFRAME	Memi[$1+15]		# frame advance at metafile EOF
+	# extra space
+define	CCP_CURSOR	Memi[$1+20]		# last cursor accessed
+define	CCP_COLOR	Memi[$1+21]		# last color set
+define	CCP_TXSIZE	Memi[$1+22]		# last text size set
+define	CCP_TXFONT	Memi[$1+23]		# last text font set
+define	CCP_LTYPE	Memi[$1+24]		# last line type set
+define	CCP_WIDTH	Memi[$1+25]		# last line width set
+define	CCP_DEVNAME	Memi[$1+26]		# name of open device
+define	CCP_DEVCHAN	Memi[$1+27]		# channel for "plots(0,0,ldev)"
+	# extra space
+define	CCP_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	CCP_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	CCP_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	CCP_PLAP	($1+60)			# polyline attributes
+define	CCP_PMAP	($1+64)			# polymarker attributes
+define	CCP_FAAP	($1+68)			# fill area attributes
+define	CCP_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/calcomp/ccpclear.x b/sys/gio/calcomp/ccpclear.x
new file mode 100644
index 00000000..9ff17c20
--- /dev/null
+++ b/sys/gio/calcomp/ccpclear.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ccp.h"
+
+# CCP_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure ccp_clear (dummy)
+
+int	dummy			# not used at present
+include	"ccp.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_cc == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is by resetting the origin to the last
+	# x-position drawn plus a compile-time offset.
+
+	call plot (g_max_x + FRAME_OFFSET, 0.0, -3)
+	g_max_x = 0.0
+
+	# Init kernel data structures.
+	call ccp_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/calcomp/ccpclose.x b/sys/gio/calcomp/ccpclose.x
new file mode 100644
index 00000000..3d433eb0
--- /dev/null
+++ b/sys/gio/calcomp/ccpclose.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# CCP_CLOSE -- Close the calcomp kernel.  Free up storage.
+
+procedure ccp_close()
+
+include	"ccp.com"
+
+begin
+	# Signal end of plot.
+	call plot (0, 0, 999)
+	# call plots (0, 0, CCP_DEVCHAN(g_cc)) #do we really want to do this?
+	# (calcomp may get into funny state without, but may mess up APPEND
+
+	# Free kernel data structures.
+	call mfree (CCP_SBUF(g_cc), TY_CHAR)
+	call mfree (g_cc, TY_STRUCT)
+
+	g_cc = NULL
+end
diff --git a/sys/gio/calcomp/ccpclws.x b/sys/gio/calcomp/ccpclws.x
new file mode 100644
index 00000000..f536d7ab
--- /dev/null
+++ b/sys/gio/calcomp/ccpclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# include "ccp.h"
+
+# CCP_CLOSEWS -- Close the named workstation.  
+# If the plot were terminated (plot (0, 0, 999)) APPEND mode would not work.
+
+procedure ccp_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+# include "ccp.com"
+
+begin
+	# noop 
+	return 
+end
diff --git a/sys/gio/calcomp/ccpcolor.x b/sys/gio/calcomp/ccpcolor.x
new file mode 100644
index 00000000..98b701d0
--- /dev/null
+++ b/sys/gio/calcomp/ccpcolor.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# Calcomp pen colors
+define	BLACK		1
+define	WHITE		2
+define	RED		3
+define	GREEN		4
+define	BLUE		5
+
+# CCP_COLOR  set pen color
+
+procedure ccp_color(index)
+
+int	index		# index for color switch statement
+include	"ccp.com"
+
+begin
+	if (g_lcover) # CL param lcover, line color override is on; noop
+	    return
+
+	switch (index) {
+
+	case WHITE:
+	    call newpen (WHITE)
+	case RED:
+	    call newpen (RED)
+	case GREEN:
+	    call newpen (GREEN)
+	case BLUE:
+	    call newpen (BLUE)
+	default:
+	    call newpen (BLACK)
+	}
+end
diff --git a/sys/gio/calcomp/ccpcseg.x b/sys/gio/calcomp/ccpcseg.x
new file mode 100644
index 00000000..7b55adc7
--- /dev/null
+++ b/sys/gio/calcomp/ccpcseg.x
@@ -0,0 +1,207 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include <mach.h>
+include	"ccp.h"
+
+# CCP_CALCSEG -- Calculate a contiguous line segment; used to return individual
+# line segments under the various options of line type simulation.  (Width is
+# not simulated here).  Each segment returned is actually drawable, guaranteeing
+# constant-length dashes and gaps along the exact length of the input polyline. 
+# Normally called by ccp_polyline.
+
+procedure ccp_calcseg (p, npts, ltype, curpl_pt, segsize, xseg,yseg, nsegpts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# line type; CCP_CLEAR <= ltype <= CCP_DASHDOT
+int	curpl_pt		# current polyline point; input and output
+int	segsize			# current segment memory size
+pointer	xseg,yseg		# plotter-unit contiguous line segment, output
+int	nsegpts			# number of points in segment, output
+
+int	i, j
+real	lastp_x, lastp_y, x, y, curseglen
+bool	toggle
+
+include	"ccp.com"
+
+begin
+	if (curpl_pt == 1) {	# always start line w/beginning of dash, etc.
+	    lastp_x   = XTRAN(p[1])
+	    lastp_y   = YTRAN(p[2])
+	    curpl_pt  = curpl_pt + 1 
+	    toggle    = false
+	} 
+
+	XSEG(1)   = lastp_x
+	YSEG(1)   = lastp_y
+	nsegpts   = 1
+	curseglen = 0.0
+
+	switch (ltype) {
+	case GL_CLEAR:
+	    nsegpts = 0
+
+	case GL_DASHED:
+	    # Return one contiguous polyline segment worth one dash:
+	    call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, segsize,
+		xseg,yseg, lastp_x,lastp_y)
+
+	    # Now increment internal counters for gap width for next call
+	    call ccx_gap (p, npts, curpl_pt, curseglen, g_dashlen + g_gaplen,
+		lastp_x,lastp_y)
+
+	case GL_DOTTED:
+	    # Since we already built one point, we need only the following gap:
+	    call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen,
+		lastp_x,lastp_y)
+
+	case GL_DOTDASH:
+	    # Implement as dash/gap/dot/gap/:
+	    if (toggle) {			# build dot/gap/
+		x = lastp_x #XTRAN(p[i])
+		y = lastp_y #YTRAN(p[i+1])
+		nsegpts = 0
+		call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize)
+		toggle = false
+	        call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen, 
+		    lastp_x,lastp_y)
+
+	    } else {				# build dash/gap/
+	        call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, 
+		    segsize, xseg,yseg, lastp_x,lastp_y)
+	        call ccx_gap (p, npts, curpl_pt, curseglen,
+		    g_dashlen + g_gaplen, lastp_x,lastp_y)
+		toggle = true
+	    }
+
+	default:				# solid line
+	    do i = curpl_pt, npts {
+		j = (i-1) * 2 + 1
+		x = XTRAN(p[j])
+		y = YTRAN(p[j+1])
+		call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize)
+	    }
+	    curpl_pt = npts
+	}
+end
+
+
+# CCX_DASH -- Do the actual work of building a dashed line segment (no gap)
+
+procedure ccx_dash (p, npts, curpl_pt, curseglen, cursegpt, segsize,
+		    xseg,yseg, lastp_x,lastp_y)
+
+short	p[ARB]		# Input:  points defining line
+int	npts		# Input:  number of points, i.e., (x,y) pairs
+int	curpl_pt	# In/Output: current polyline point
+real	curseglen	# Output: length of current simulated ltype unit (._)
+int	cursegpt	# Output: index of current drawable point in segment
+int	segsize		# In/Output: current segment size
+pointer	xseg,yseg	# Output: plotter-units, contiguous line segment
+real	lastp_x,lastp_y	# Output: last point in segment (visible or invisible)
+
+int	i
+real	temppl_dis, x, y, delx, dely
+real	actual_dis, rem_dashlen
+
+include	"ccp.com"
+
+begin
+	rem_dashlen = g_dashlen
+
+	# Build up current "dash" (may be bent any number of times).
+
+	while (curseglen + EPSILON < g_dashlen && curpl_pt <= npts) {
+	    i = (curpl_pt-1) * 2 + 1
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+	    temppl_dis  = DIS(lastp_x, lastp_y, x, y)
+	    if (temppl_dis >= EPSILON) {
+		actual_dis  = min (temppl_dis, rem_dashlen)
+		rem_dashlen = rem_dashlen - actual_dis
+
+		delx = x - lastp_x
+		dely = y - lastp_y
+		x = lastp_x + delx * actual_dis / temppl_dis
+		y = lastp_y + dely * actual_dis / temppl_dis
+
+		call ccx_addsegpt (x,y, xseg,yseg, cursegpt, segsize)
+		curseglen = curseglen + actual_dis
+		lastp_x   = XSEG(cursegpt)
+		lastp_y   = YSEG(cursegpt)
+	    }
+	    if (curseglen + EPSILON < g_dashlen)
+	        curpl_pt = curpl_pt + 1
+	}
+end
+
+
+# CCX_GAP -- Do the actual work of building an invisible gap along original
+# polyline.
+
+procedure ccx_gap (p, npts, curpl_pt, curseglen, matchlen, lastp_x,lastp_y)
+
+short	p[ARB]		# Input: points defining line
+int	npts		# Input: number of points, i.e., (x,y) pairs
+int	curpl_pt	# In/Output: current polyline point
+real	curseglen	# In/Output: length of current simulated ltype unit (._)
+real	matchlen	# Output: length to build curseglen up to
+real	lastp_x,lastp_y	# Output: last point in segment (visible, invisible)
+
+int	i
+real	x, y, delx, dely
+real	temppl_dis, actual_dis, rem_gaplen
+
+include	"ccp.com"
+
+begin
+	rem_gaplen = g_gaplen
+
+	# Build up current "gap" (may be bent any number of times).
+
+	while ((curseglen + EPSILON < (matchlen)) && (curpl_pt <= npts)) {
+	    i = (curpl_pt-1) * 2 + 1
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+
+	    temppl_dis = DIS(lastp_x, lastp_y, x, y)
+	    if (temppl_dis >= EPSILON) {
+		actual_dis = min (temppl_dis, rem_gaplen)
+		rem_gaplen = rem_gaplen - actual_dis
+
+		delx = x - lastp_x
+		dely = y - lastp_y
+		curseglen = curseglen + actual_dis
+		lastp_x = lastp_x + delx * actual_dis / temppl_dis
+		lastp_y = lastp_y + dely * actual_dis / temppl_dis
+	    }
+	    if (curseglen + EPSILON < matchlen)
+		curpl_pt = curpl_pt + 1
+	}
+end
+
+
+# CCX_ADDSEGPT -- add a point to the segment structure; handle memory needs
+
+procedure ccx_addsegpt (x,y, xseg,yseg, cursegpt,segsize)
+
+real	x,y			# point to be added to output segment
+pointer	xseg,yseg		# NDC-coord contiguous line segment, output
+int	cursegpt		# index of current drawable point in segment
+int	segsize			# current segment size
+
+begin
+	cursegpt = cursegpt + 1
+
+	if (cursegpt > segsize) {
+	    segsize = segsize + SEGSIZE
+	    call realloc (xseg, segsize, TY_REAL)
+	    call realloc (yseg, segsize, TY_REAL)
+	}
+
+	XSEG(cursegpt) = x
+	YSEG(cursegpt) = y
+end
diff --git a/sys/gio/calcomp/ccpdrawch.x b/sys/gio/calcomp/ccpdrawch.x
new file mode 100644
index 00000000..dab89158
--- /dev/null
+++ b/sys/gio/calcomp/ccpdrawch.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"ccp.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+define	MAX_STROKESIZE	32	# max number of vectors making up one stroke
+define	CALCOMP_CHSTART	16	# maximum calcomp special symbol plus 1
+define	SYMBOL_ASPECT	1.17	# calcomp height = 7/6 width for normal spacing.
+define	LOW_REDRAWS	5	# multiple traces for low-quality bold text
+define	HIGH_REDRAWS	9	# multiple traces for high-quality bold text
+
+
+# CCP_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure ccp_drawchar (ch, x, y, xsize, ysize, orien, font, quality)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# char width and height in unscaled GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+int	quality			# quality control -- low(calcomp); other(iraf)
+
+real	px, py, coso, sino, theta, xto_nicesize, yto_nicesize
+real	sx[MAX_STROKESIZE], sy[MAX_STROKESIZE]
+int	stroke, tab1, tab2, i, j, pen
+int	bitupk()
+
+include "ccp.com"
+include	"font.com"
+
+begin
+	# Compute correction factor for absolute physical character size.
+	# This also corrects for distortion of high-qual text if xscale<>yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# Set the font.
+	call ccp_font (font)
+
+	if (quality == GT_LOW) {
+	    # If low text quality requested, draw with Calcomp's SYMBOL call.
+	    # We avoid machine-dependency word-size problems by always
+	    # calling SYMBOL only from here, one char per call.
+	    # Calcomp's SYMBOL expects height as only size; aspect is height
+	    # = 7/6 (width) for normal character spacing.
+
+	    call ccx_intersymbol (XTRAN(x),YTRAN(y), real(xsize) * xto_nicesize,
+	        real(ysize) * yto_nicesize, ch, real(orien))
+
+	} else {
+	    # Text quality requested is not low; draw font either with single-
+	    # width line or bold, via ccp_drawseg.
+
+	    if (ch < CHARACTER_START || ch > CHARACTER_END)
+		i = '?' - CHARACTER_START + 1
+	    else
+		i = ch  - CHARACTER_START + 1
+
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+
+	    if (tab2 - tab1 + 1 > MAX_STROKESIZE) {
+		call eprintf (
+		    "CCP KERNEL WARNING: up-dimension MAX_STROKESIZE\n")
+		call eprintf (
+		    "in module ccp_drawch; new stroke size %d, char %s\n")
+		    call pargi (tab2 - tab1 + 1)
+		    call pargc (ch)
+		tab2 = tab1 + MAX_STROKESIZE - 1
+	    }
+
+	    theta = -DEGTORAD(orien)
+	    coso = cos(theta)
+	    sino = sin(theta)
+
+	    j = 0
+	    do i = tab1, tab2 {
+		stroke = chrtab[i]
+		px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+		py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+		pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+		# Scale size of character in unwarped (xscale == yscale) system.
+		px = px / FONT_WIDTH  * xsize
+		py = py / FONT_HEIGHT * ysize
+
+		# The italic font is implemented applying a tilt.
+		if (font == GT_ITALIC)
+		    px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+		if (pen == 0 && j > 0) {	# new stroke segment; draw last
+		    if (j > 1) 
+			call ccx_interpoly (sx, sy, j, quality)
+		    j = 0
+		} 
+
+		# Rotate, shift (unwarped), then correct for xscale <> yscale.
+		j     = j + 1
+		sx[j] = XTRAN(x + ( px * coso + py * sino) * xto_nicesize)
+		sy[j] = YTRAN(y + (-px * sino + py * coso) * yto_nicesize)
+	    }
+
+	    # last stroke segment:
+	    if (j > 1)
+	        call ccx_interpoly (sx, sy, j, quality)
+	}
+end
+
+
+# CCX_INTERPOLY -- intermediate routine to 1) pass simple draw instruction to 
+# calcomp plot routines if linewidth single or bold method = penchange, or 
+# 2) simulate bold text by offsetting to the four corners and four edges
+# of a box surrounding the character.
+
+procedure ccx_interpoly (x, y, npts, quality)
+
+real	x[ARB],y[ARB] 	# plotter-unit coordinates to be drawn as polyline
+int	npts		# number points in x,y
+int	quality		# text quality (distinguish between medium and high)
+
+int	i, j, num_redraws, twidth
+real	xp, yp
+real	xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS]
+
+include	"ccp.com"
+
+data	xoff/0., 1., 0., -1.,  0.,    1., -1., -1.,  1./
+data	yoff/0., 0., 1.,  0., -1.,    1.,  1., -1., -1./
+
+begin
+	if (npts <= 0) 
+	    return
+
+	# If line width override is on, or linewidth is single, do simple move
+	# and draws.
+
+	num_redraws = 1
+	twidth = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc)))
+	if (!g_lwover)
+	    if (g_lwtype == 'p' && twidth >= 1)
+		call ccp_lwidth (twidth)
+	    else if (twidth > 1 && quality == GT_HIGH)
+		num_redraws = HIGH_REDRAWS
+	    else
+		num_redraws = LOW_REDRAWS
+
+	if (num_redraws == 1) {
+	    call plot (x[1], y[1], CCP_UP)
+	    g_max_x = max (x[1], g_max_x)
+
+	    if (npts == 1) {	# single pt is special case; drop pen
+		call plot (x[1], y[1], CCP_DOWN)
+	    } else {		# draw normally
+		do i = 2, npts {
+		    call plot (x[i], y[i], CCP_DOWN)
+		    g_max_x = max (x[i], g_max_x)
+		}
+	    }
+	} else {
+	    do i = 1, num_redraws {
+		xp = x[1] + xoff[i] * g_plwsep
+		yp = y[1] + yoff[i] * g_plwsep
+		call plot (xp, yp, CCP_UP)
+		g_max_x = max (xp, g_max_x)
+
+		if (npts == 1) {	# single pt is special case; drop pen
+		    call plot (xp, yp, CCP_DOWN)
+		} else {		# draw normally
+		    do j = 2, npts {
+			xp = x[j] + xoff[i] * g_plwsep
+			yp = y[j] + yoff[i] * g_plwsep
+			call plot (xp, yp, CCP_DOWN)
+			g_max_x = max (xp, g_max_x)
+		    }
+		}
+	    }
+	}
+end
+
+
+# CCX_INTERSYMBOL -- routine intermediate to Calcomp SYMBOL routine; handles
+# bold text.
+
+procedure ccx_intersymbol (x,y, xsize,ysize, ch, orien)
+
+real	x,y		# plotter-unit coords of lower left of character
+real	xsize,ysize	# char width, height in GKI units scaled to "nice" sizes
+char	ch		# character to be drawn
+real	orien		# degrees counterclockwise from +x axis to text path
+
+int	i, nsym, symchar, num_redraws
+real	xp,yp, xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS], csize
+
+include	"ccp.com"
+
+data	xoff/0., 1., 0., -1.,  0.,    1., -1., -1.,  1./
+data	yoff/0., 0., 1.,  0., -1.,    1.,  1., -1., -1./
+
+begin
+	symchar = int (ch)
+	nsym    = 1
+
+	if (ch < CALCOMP_CHSTART && ch >= 0) {
+	    nsym = -1
+	} else if (ch < ' ' || ch > '~')
+	    ch = '~'
+
+	# Since we are only called if text_quality == low, implement
+	# bold text with only the center and edge positions (LOW_REDRAWS).
+	num_redraws = 1
+	if (!g_lwover && nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc))) > 1)
+	    num_redraws = LOW_REDRAWS
+
+	# Set the size as the height of the character in device units; we
+	# start with the width to avoid overlapping, and we use the default
+	# scale, which results in reasonable-sized characters; the specified
+	# scale would produce strange results as orien passes from 0 to 90.
+
+	csize = min (xsize * g_xndcto_p * SYMBOL_ASPECT, ysize * g_yndcto_p)
+
+	do i = 1, num_redraws {
+	    xp = x + xoff[i] * g_plwsep
+	    yp = y + yoff[i] * g_plwsep
+	    call symbol (xp, yp, csize, symchar, orien, nsym)
+	    g_max_x = max (xp + csize, g_max_x)
+	}
+end
diff --git a/sys/gio/calcomp/ccpdseg.x b/sys/gio/calcomp/ccpdseg.x
new file mode 100644
index 00000000..2d5d1c76
--- /dev/null
+++ b/sys/gio/calcomp/ccpdseg.x
@@ -0,0 +1,208 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+include "ccp.h"
+
+define	DIAGSEP	(g_plwsep / 0.8660254)	# distance to vertex of hexagon
+define	PIOVER3	(PI / 3.0)
+define	PIOVER6 (PI / 6.0)
+define	SIN_MIN_HALFBISECTOR	0.1	# sine of minimum half-bisector
+
+
+# CCP_DRAWSEG -- Draw a polyline segment, optionally simulating variable
+# widths.
+
+procedure ccp_drawseg (xseg, yseg, nsegpts, lwidth)
+
+real	xseg[ARB]		# plotter coordinate array of contiguous points
+real	yseg[ARB]
+int	nsegpts			# number of pts in array
+int	lwidth			# line width relative to single width
+
+int	i, j
+real	pleft_x[MAXTRACES], pleft_y[MAXTRACES]
+real	pright_x[MAXTRACES], pright_y[MAXTRACES], lastp_x,lastp_y
+real	ahp2p1, theta, delx,dely, dx,dy, tx,ty
+real	rptheta4 ()
+include	"ccp.com"
+data	lastp_x/0.0/, lastp_y/0.0/
+
+begin
+	if (nsegpts < 1) 
+	    return
+	if (lwidth > MAXTRACES) {
+	    call eprintf ("WARNING: line width > MAXTRACES in ccp_drawseg\n")
+	    call eprintf ("         line width reset to %d\n")
+		call pargi (MAXTRACES)
+	    lwidth = MAXTRACES
+	}
+
+	if (nsegpts == 1) {					# 1 pt spcl bold
+
+	    # Draw a single point as a hexagon lined up in the direction from 
+	    # the preceding point.  Start bounding hexagon 60 degrees cc from 
+	    # projection of last point drawn (0,0 initially) through current pt.
+	    # 'ahp2p1' = Angle from Horizontal at P1 to line P1 -> P2, etc.
+
+	    ahp2p1  = rptheta4 (xseg[1], yseg[1], lastp_x, lastp_y)
+	    lastp_x = xseg[1]
+	    lastp_y = yseg[1]
+	    theta   = ahp2p1 - PIOVER6
+
+	    # do even a single, interior point as a hexagon, up to lwidth times
+	    do i = 1, lwidth {
+		tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta)
+		ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta)
+		call plot (tx, ty, CCP_UP)
+
+		# draw a bounding hexagon around point:
+		do j = 1, 6 {
+		    theta = theta + PIOVER3
+		    tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta)
+		    ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta)
+		    call plot (tx, ty, CCP_DOWN)
+
+		    # Store maximum-x plotted for a "newframe" in ccp_clear.
+		    g_max_x = max (tx, g_max_x)
+		}
+
+		# fill in a diagonal line across hexagon:
+		tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta + PI)
+		ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta + PI)
+		call plot (tx, ty, CCP_DOWN)
+		theta = theta + PIOVER3				# rotate spokes
+	    }
+
+	} else {						# nsegpts > 1
+
+	    if (g_lwover || lwidth == PL_SINGLE) {
+		call plot (xseg[1], yseg[1], CCP_UP)
+		g_max_x = max (xseg[1], g_max_x)
+
+		do i = 2, nsegpts {
+		    call plot (xseg[i], yseg[i], CCP_DOWN)
+		    g_max_x = max (xseg[i], g_max_x)
+		}
+	    } else if (lwidth > PL_SINGLE) {
+
+		# compute flanking points; by definition +-90 deg. from p1-p2,
+		# so first point is special case; do for all thicknesses:
+
+		call ccx_offsets (xseg[1]-xseg[2]+xseg[1], 
+		    yseg[1]-yseg[2]+yseg[1], xseg[1],yseg[1], 
+		    xseg[2],yseg[2], delx,dely)
+
+		do i = 1, lwidth - 1 {
+		    pleft_x[i]  = xseg[1] + i * delx
+		    pleft_y[i]  = yseg[1] + i * dely
+		    pright_x[i] = xseg[1] - i * delx
+		    pright_y[i] = yseg[1] - i * dely
+		}
+
+		# must draw each segment individually, to make flanks meet.
+	        do i = 1, nsegpts - 2 {
+
+		    # actual line segment in data:
+		    call plot (xseg[i], yseg[i], CCP_UP)
+		    call plot (xseg[i+1], yseg[i+1], CCP_DOWN)
+		    g_max_x = max (xseg[i], g_max_x)
+
+		    call ccx_offsets (xseg[i],yseg[i], xseg[i+1],yseg[i+1],
+			xseg[i+2],yseg[i+2], delx,dely)
+
+		    # for each flanking line; p2 in middle, at temp origin
+		    do j = 1, lwidth - 1 {
+
+			# point to left of p1-p2, facing p2:
+			dx = j * delx
+			dy = j * dely
+			tx = xseg[i+1] + dx
+			ty = yseg[i+1] + dy
+			call plot (pleft_x[j], pleft_y[j], CCP_UP)
+			call plot (tx, ty, CCP_DOWN)
+			pleft_x[j] = tx
+			pleft_y[j] = ty
+
+			# point to right of p1-p2, facing p2:
+			tx = xseg[i+1] - dx
+			ty = yseg[i+1] - dy
+			call plot (pright_x[j], pright_y[j], CCP_UP)
+			call plot (tx, ty, CCP_DOWN)
+			pright_x[j] = tx
+			pright_y[j] = ty
+		    }
+		}
+		
+		# last point:
+		call plot (xseg[nsegpts-1], yseg[nsegpts-1], CCP_UP)
+		call plot (xseg[nsegpts], yseg[nsegpts], CCP_DOWN)
+		g_max_x = max (xseg[nsegpts-1], g_max_x)
+		g_max_x = max (xseg[nsegpts], g_max_x)
+
+		# save this point for a possible following dotted line segment:
+		lastp_x = xseg[nsegpts]
+		lastp_y = yseg[nsegpts]
+
+		# square the flanking lines:
+		call ccx_offsets (xseg[nsegpts-1], yseg[nsegpts-1],
+		    xseg[nsegpts], yseg[nsegpts],
+		    xseg[nsegpts] * 2.0 - xseg[nsegpts-1],
+		    yseg[nsegpts] * 2.0 - yseg[nsegpts-1],
+		    delx, dely)
+
+		do i = 1, lwidth - 1 {
+		    tx = xseg[nsegpts] + i * delx
+		    ty = yseg[nsegpts] + i * dely
+		    call plot (pleft_x[i], pleft_y[i], CCP_UP)
+		    call plot (tx, ty, CCP_DOWN)
+		    tx = xseg[nsegpts] - i * delx
+		    ty = yseg[nsegpts] - i * dely
+		    call plot (pright_x[i], pright_y[i], CCP_UP)
+		    call plot (tx, ty, CCP_DOWN)
+		}
+	    }
+	}
+end
+
+
+# CCX_OFFSETS -- return offsets in x, y from point 2 to one level of line width
+# simulation, given points 1, 2, 3.
+
+procedure ccx_offsets (p1x,p1y, p2x,p2y, p3x,p3y, delx,dely)
+
+real	p1x,p1y		# input:  point 1 is previous point
+real	p2x,p2y		# input:  point 2 is current point (middle of the three)
+real	p3x,p3y		# input:  point 3 is succeeding point
+real	delx,dely	# output: offsets from point 2 to one flanking point
+
+real	ahp2p1		# Angle from Horizontal to line p2-->p1, etc.
+real	ahp2p3, ap1p2p3, ahbisector, sintheta, r
+real	rptheta4 ()
+include	"ccp.com"
+
+begin
+	# convention is that p2 is current point, at temporary origin; p1
+	# is "behind", and p3 is "ahead" of the current point, p2.
+	# "ahp2p1"  = angle from horizontal to segment p2->p1
+	# "ap1p2p3" = angle from p1 to p2 to p3
+	# "ahbisector" = angle from horizontal (+x) to bisector of p1->p2->p3
+
+	ahp2p1     = rptheta4 (p2x,p2y, p1x,p1y)
+	ahp2p3	   = rptheta4 (p2x,p2y, p3x,p3y)
+	ap1p2p3    = ahp2p1 - ahp2p3
+	ahbisector = ahp2p3 + 0.5 * ap1p2p3
+	sintheta   = sin (ahp2p1 - ahbisector)
+
+	# very small angles cause extremely exaggerated vertices; truncate
+	# at arbitrary multiple of plwsep; 10*plwsep is eqv. to 11.5 deg. bisect
+
+	if (abs (sintheta) < SIN_MIN_HALFBISECTOR) {
+	    r = g_plwsep / SIN_MIN_HALFBISECTOR
+	    if (sintheta < 0.0)
+		r = -r
+	} else
+	    r = g_plwsep / sintheta
+	
+	delx = r * cos (ahbisector)
+	dely = r * sin (ahbisector)
+end
diff --git a/sys/gio/calcomp/ccpescape.x b/sys/gio/calcomp/ccpescape.x
new file mode 100644
index 00000000..37e81972
--- /dev/null
+++ b/sys/gio/calcomp/ccpescape.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gescape.h>
+include "ccp.h"
+
+# CCP_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# used for passing exact scaling factors through gki metacode
+
+procedure ccp_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+int	ip
+real	tempr
+char	scale_str[SZ_LINE]
+int	ctod ()
+
+include "ccp.com"
+
+string	warnx	"Warning: ccpkern unable to convert gki_escape xscale\n"
+string	warny	"Warning: ccpkern unable to convert gki_escape yscale\n"
+
+begin
+	call achtsc (instruction, scale_str, nwords)
+	scale_str[nwords+1] = EOS
+	ip = 1
+
+	switch (fn) {
+
+	case GSC_X_GKITODEV:
+
+	    # if kernel task scale params were not specified, set actual scale
+	    # params to those passed from metacode if translatable, set to
+	    # default scale from ccp_init/graphcap if untranslatable.  If 
+	    # kernel task did specify scale, this is a no op.
+
+	    if (IS_INDEF (g_xtask_scale)) {
+		if (ctod (scale_str, ip, tempr) < 1) {
+		    g_xndcto_p = g_xdefault_scale
+		    call eprintf (warnx)
+		    call eprintf ("scale string: %s\n")
+			call pargstr (scale_str)
+		    call eprintf ("new (graphcap-default) x scale: %f\n")
+			call pargr (g_xndcto_p)
+		} else 
+		    g_xndcto_p = tempr
+	    }
+
+	case GSC_Y_GKITODEV:
+
+	    if (IS_INDEF (g_ytask_scale)) {
+		if (ctod (scale_str, ip, tempr) < 1) {
+		    g_yndcto_p = g_ydefault_scale
+		    call eprintf (warny)
+		    call eprintf ("scale string: %s\n")
+			call pargstr (scale_str)
+		    call eprintf ("new (graphcap-default) y scale: %f\n")
+			call pargr (g_yndcto_p)
+		} else
+		    g_yndcto_p = tempr
+	    }
+	}
+end
diff --git a/sys/gio/calcomp/ccpfa.x b/sys/gio/calcomp/ccpfa.x
new file mode 100644
index 00000000..cf54861d
--- /dev/null
+++ b/sys/gio/calcomp/ccpfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# CCP_FILLAREA -- Fill a closed area.
+
+procedure ccp_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"ccp.com"
+
+begin
+	# Not implemented yet.
+	call ccp_polyline (p, npts)
+end
diff --git a/sys/gio/calcomp/ccpfaset.x b/sys/gio/calcomp/ccpfaset.x
new file mode 100644
index 00000000..228669f9
--- /dev/null
+++ b/sys/gio/calcomp/ccpfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_FASET -- Set the fillarea attributes.
+
+procedure ccp_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"ccp.com"
+
+begin
+	fa = CCP_FAAP(g_cc)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/calcomp/ccpfont.x b/sys/gio/calcomp/ccpfont.x
new file mode 100644
index 00000000..0e7ad9a4
--- /dev/null
+++ b/sys/gio/calcomp/ccpfont.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"ccp.h"
+
+# CCP_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set CCP_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure ccp_font (font)
+
+int	font			# code for font to be set
+int	pk1, pk2, width
+include	"ccp.com"
+
+begin
+	pk1 = GKI_PACKREAL(1.0)
+	pk2 = GKI_PACKREAL(2.0)
+
+	width = CCP_WIDTH(g_cc)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) 
+		width = pk2
+	} else {
+	    if (GKI_UNPACKREAL(width) > 1.5) 
+		width = pk1
+	}
+
+	CCP_WIDTH(g_cc) = width
+end
diff --git a/sys/gio/calcomp/ccpinit.x b/sys/gio/calcomp/ccpinit.x
new file mode 100644
index 00000000..1ae558c7
--- /dev/null
+++ b/sys/gio/calcomp/ccpinit.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_INIT -- Initialize the CCP data structures from the graphcap entry
+# for the plotter.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine CCP_RESET initializes the attribute
+# packets.
+
+procedure ccp_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size, xres, yres, xwidth, yheight
+real	mper_punit
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"ccp.com"
+
+begin
+	# Allocate the CCP descriptor, string buffer, and x,y segment buffers.
+	if (g_cc == NULL) {
+	    call calloc (g_cc, LEN_CCP, TY_STRUCT)
+	    call malloc (CCP_SBUF(g_cc), SZ_SBUF, TY_CHAR)
+	}
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	CCP_SZSBUF(g_cc) = SZ_SBUF
+	CCP_NEXTCH(g_cc) = CCP_SBUF(g_cc) + 1
+	Memc[CCP_SBUF(g_cc)] = EOS
+
+	# Get the device resolution, dimensions in meters, and meter-to-pltr
+	# unit conversion factor from graphcap; if none are specified, use
+	# compile-time constants.
+
+	xres = ttygeti (tty, "xr")
+	if (xres <= 0)
+	    xres = GKI_MAXNDC
+	yres = ttygeti (tty, "yr")
+	if (yres <= 0)
+	    yres = GKI_MAXNDC
+
+	xwidth  = ttygetr (tty, "xs")
+	if (xwidth <= 0.0)
+	    xwidth = MAX_PL_XWIDTH
+	yheight = ttygetr (tty, "ys")
+	if (yheight <= 0.0)
+	    yheight = MAX_PL_YHEIGHT
+
+	mper_punit = ttygetr (tty, "MP")
+	if (mper_punit <= 0.0)
+	    mper_punit = DEF_MPER_PUNIT
+	
+	# Set up coordinate transformation if not explicitly specified to 
+	# kernel task at run time.  Scale determined from graphcap is saved 
+	# in case ccp_escape gets a metacode scale it cannot translate.
+	# Set up default scale such that a full max_gki_ndc plot will fit in y.
+
+	g_ydefault_scale = yheight / (mper_punit * GKI_MAXNDC)
+	if (IS_INDEF (g_ytask_scale))
+	    g_yndcto_p = g_ydefault_scale
+
+	g_xdefault_scale = xwidth / (mper_punit * GKI_MAXNDC)
+	if (IS_INDEF (g_xtask_scale)) 
+	    g_xndcto_p = g_xdefault_scale
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the plotter has a set of discrete character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	CCP_NCHARSIZES(g_cc) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = CCP_NEXTCH(g_cc)
+
+	if (CCP_NCHARSIZES(g_cc) <= 0) {
+	    CCP_NCHARSIZES(g_cc) = 1
+	    CCP_CHARSIZE(g_cc,1) = 1.0
+	    CCP_CHARHEIGHT(g_cc,1) = char_height
+	    CCP_CHARWIDTH(g_cc,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= CCP_NCHARSIZES(g_cc);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		CCP_CHARSIZE(g_cc,i)   = char_size
+		CCP_CHARHEIGHT(g_cc,i) = char_height * char_size
+		CCP_CHARWIDTH(g_cc,i)  = char_width  * char_size
+	    }
+	}
+
+	# Get dash length, gap length, and n-tracing separation width:
+	if (IS_INDEF (g_dashlen)) {
+	    g_dashlen = ttygetr (tty, "DL")
+	    if (g_dashlen <= 0.0)
+		g_dashlen = DEF_DASHLEN
+	}
+	if (IS_INDEF (g_gaplen)) {
+	    g_gaplen = ttygetr (tty, "GL")
+	    if (g_gaplen <= 0.0)
+		g_gaplen = DEF_GAPLEN
+	}
+	if (IS_INDEF (g_plwsep)) {
+	    g_plwsep = ttygetr (tty, "PW")
+	    if (g_plwsep <= 0.0)
+		g_plwsep = DEF_PLWSEP
+	}
+		
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the CCP
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	CCP_POLYLINE(g_cc)   = btoi (ttygetb (tty, "pl"))
+	CCP_POLYMARKER(g_cc) = btoi (ttygetb (tty, "pm"))
+	CCP_FILLAREA(g_cc)   = btoi (ttygetb (tty, "fa"))
+	CCP_FILLSTYLE(g_cc)  =       ttygeti (tty, "fs")
+	CCP_ROAM(g_cc)	     = btoi (ttygetb (tty, "ro"))
+	CCP_ZOOM(g_cc)	     = btoi (ttygetb (tty, "zo"))
+	CCP_ZRES(g_cc)	     =       ttygeti (tty, "zr")
+	CCP_SELERASE(g_cc)   = btoi (ttygetb (tty, "se"))
+	CCP_PIXREP(g_cc)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	CCP_CURSOR(g_cc)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = CCP_NEXTCH(g_cc)
+	CCP_DEVNAME(g_cc) = nextch
+	CCP_DEVCHAN(g_cc) = CCP_LDEV
+	maxch = CCP_SBUF(g_cc) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	CCP_NEXTCH(g_cc) = nextch
+
+	# Initialize maximum-x tracker, used for "newframe" in ccp_clear.
+	g_max_x = 0.0
+end
diff --git a/sys/gio/calcomp/ccpltype.x b/sys/gio/calcomp/ccpltype.x
new file mode 100644
index 00000000..e5325ddd
--- /dev/null
+++ b/sys/gio/calcomp/ccpltype.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"ccp.h"
+
+# CCP_LINETYPE -- Set the line type option in the nspp world.
+
+procedure ccp_linetype (index)
+
+int	index		# index for line type switch statement
+
+include	"ccp.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    g_ltype = 0
+	case GL_DASHED:
+	    g_ltype = 2
+	case GL_DOTTED:
+	    g_ltype = 3
+	case GL_DOTDASH:
+	    g_ltype = 4
+	default:
+	    g_ltype = 1		# GL_SOLID and default
+	}
+end
diff --git a/sys/gio/calcomp/ccplwidth.x b/sys/gio/calcomp/ccplwidth.x
new file mode 100644
index 00000000..bda9c33b
--- /dev/null
+++ b/sys/gio/calcomp/ccplwidth.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# Calcomp pen widths
+define	SINGLE	1	# ***** site dependence!!	[MACHDEP]
+define	DOUBLE	2	# 
+
+# CCP_LWIDTH  set pen width; see ccp_color, which also sets pens.
+# We should only be called if task param "lwtype" was explicitly set to
+# "p" for pen method; normally bold lines are handled by ntracing.
+
+procedure ccp_lwidth (index)
+
+int	index		# index for width switch statement
+include	"ccp.com"
+
+begin
+	if (g_lwover)	# CL param lwover, line width override is on; noop
+	    return
+
+	# ***** site dependence; add other pen numbers here; if pen numbers
+	# for multiple widths are monotonic, make single call to newpen(index).
+
+	switch (index) {
+
+	case DOUBLE:
+	    call newpen (DOUBLE)
+	default:
+	    call newpen (SINGLE)
+	}
+end
diff --git a/sys/gio/calcomp/ccpopen.x b/sys/gio/calcomp/ccpopen.x
new file mode 100644
index 00000000..f900b95b
--- /dev/null
+++ b/sys/gio/calcomp/ccpopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_OPEN -- Install the calcomp kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  The table entry for non-implemented procedures is
+# set to zero, causing the interpreter to ignore the instruction.
+
+procedure ccp_open (devname, dd)
+
+char	devname[ARB]		# ignored if only one plotter on system
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	ccp_openws(), ccp_closews(), ccp_clear()
+extern	ccp_polyline(), ccp_polymarker(), ccp_text()
+extern	ccp_plset()
+extern	ccp_pmset(), ccp_txset()
+extern	ccp_escape()
+include	"ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_cc = NULL
+	g_ndraw = 0 #????? may not need; also used in ccp_openws,ccp_clear,
+		    # ccp_polyline, ccp_polymarker, ccp_text; may want for
+		    # debug etc.
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (ccp_openws)
+	dd[GKI_CLOSEWS]		= locpr (ccp_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (ccp_clear)
+	dd[GKI_CANCEL]		= 0
+	dd[GKI_FLUSH]		= 0
+	dd[GKI_POLYLINE]	= locpr (ccp_polyline)
+	dd[GKI_POLYMARKER]	= locpr (ccp_polymarker)
+	dd[GKI_TEXT]		= locpr (ccp_text)
+	dd[GKI_FILLAREA]	= 0
+	dd[GKI_PUTCELLARRAY]	= 0
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (ccp_plset)
+	dd[GKI_PMSET]		= locpr (ccp_pmset)
+	dd[GKI_TXSET]		= locpr (ccp_txset)
+	dd[GKI_FASET]		= 0
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (ccp_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call ccp_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/ccpopenws.x b/sys/gio/calcomp/ccpopenws.x
new file mode 100644
index 00000000..aec063cf
--- /dev/null
+++ b/sys/gio/calcomp/ccpopenws.x
@@ -0,0 +1,87 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"ccp.h"
+
+# CCP_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure ccp_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+bool	need_open, same_dev
+include	"ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# If a particular plotter was named when the kernel was opened then 
+	# output will always go to that plotter (g_device) regardless of the 
+	# plotter named in the OPENWS instruction.  If no plotter was named 
+	# (null string) then unpack the plotter name, passed as a short integer 
+	# array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_cc == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_cc != NULL) {			# not first time
+	    same_dev = (streq (Memc[CCP_DEVNAME(g_cc)], Memc[buf]))
+	    if (!same_dev) {
+		# close previous plotter, initialize new one.
+		call plot (0, 0, 999)
+		call plots (0, 0, CCP_DEVCHAN(g_cc))
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if ((g_cc != NULL) && !same_dev)
+		call ttycdes (g_tty)			# close prev tty
+	    if (!same_dev) {
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+		g_ndraw = 0
+	    }
+	}
+
+	# Initialize data structures if we had to open a new device.
+	if (!same_dev) {
+	    call ccp_init (g_tty, Memc[buf])
+	    call ccp_reset()
+	    call plots (0, 0, CCP_DEVCHAN(g_cc))
+	}
+
+	# Advance a frame if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will advance
+	# the paper if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call ccp_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/ccppl.x b/sys/gio/calcomp/ccppl.x
new file mode 100644
index 00000000..2b1712bd
--- /dev/null
+++ b/sys/gio/calcomp/ccppl.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"ccp.h"
+
+# CCP_POLYLINE -- Set up a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted unless it is the only point, but rather defines the start of
+# the polyline.  The remaining points define line segments to be drawn.
+
+procedure ccp_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl, xseg,yseg
+int	i, curpl_pt, nsegpts
+int	len_p, segsize, lsize
+
+include	"ccp.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of number of drawing instructions since last frame clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = CCP_PLAP(g_cc)
+
+	if (CCP_LTYPE(g_cc) != PL_LTYPE(pl)) {
+	    call ccp_linetype (PL_LTYPE(pl))		# set g_ltype in ccp.com
+	    CCP_LTYPE(g_cc) = PL_LTYPE(pl)
+	}
+	if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) {
+		CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE)
+	    } else 
+	        CCP_WIDTH(g_cc) = PL_WIDTH(pl)
+	}
+	if (CCP_COLOR(g_cc) != PL_COLOR(pl)) {
+	    call ccp_color (PL_COLOR(pl))
+	    CCP_COLOR(g_cc) = PL_COLOR(pl)
+	}
+
+	# If the overrides are on, or linetype is solid and linewidth is single,
+	# do simple move and draws:
+
+	if ((g_ltover && g_lwover) || (!g_lwover && g_lwtype == 'p') ||
+	    (g_ltype == GL_SOLID && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE))
+	    || (g_ltover && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE)) ||
+	    (g_ltype == GL_SOLID && g_lwover)) {
+
+	    if (g_lwtype == 'p') 
+		call newpen (PL_WIDTH(pl))
+
+	    call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_UP)
+	    if (npts == 1) {
+		call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_DOWN)
+	    } else {		# draw normally
+		do i = 3, len_p, 2 
+		    call plot (XTRAN(p[i]), YTRAN(p[i+1]), CCP_DOWN)
+	    }
+
+	    # Store maximum-x point plotted for a "newframe" in ccp_clear.
+	    do i = 1, len_p, 2
+		g_max_x = max (XTRAN(p[i]), g_max_x)
+
+
+	# Otherwise, must calculate individual segments of dashes and dots,
+	# keeping their lengths constant along polyline (ccp_calcseg), before 
+	# optionally simulating bold and drawing (ccp_drawseg):
+
+	} else {		# vector polyline; simulate linetype, linewidth
+
+	    segsize = SEGSIZE
+	    call malloc (xseg, segsize, TY_REAL)
+	    call malloc (yseg, segsize, TY_REAL)
+
+	    curpl_pt = 1
+	    lsize    = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc)))
+	    if (!g_ltover && (g_ltype >= GL_DASHED && g_ltype <= GL_DOTDASH)) {
+
+		while (curpl_pt <= npts) {
+		    call ccp_calcseg (p, npts, g_ltype, curpl_pt, segsize,
+		    		      xseg,yseg, nsegpts)
+		    call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize)
+		}
+
+	    } else {	# either (ltype override or solid line), not single wid.
+
+		call ccp_calcseg (p, npts, GL_SOLID, curpl_pt, segsize, xseg,
+		    yseg, nsegpts)
+		call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize)
+	    }
+
+	    call mfree (xseg, TY_REAL)
+	    call mfree (yseg, TY_REAL)
+	}
+
+end
diff --git a/sys/gio/calcomp/ccpplset.x b/sys/gio/calcomp/ccpplset.x
new file mode 100644
index 00000000..c118f93e
--- /dev/null
+++ b/sys/gio/calcomp/ccpplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure ccp_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"ccp.com"
+
+begin
+	pl = CCP_PLAP(g_cc)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/calcomp/ccppm.x b/sys/gio/calcomp/ccppm.x
new file mode 100644
index 00000000..bb6c783f
--- /dev/null
+++ b/sys/gio/calcomp/ccppm.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <math.h>
+include	"ccp.h"
+
+define	DIAGSEP	(1.0 * g_plwsep / 0.7071068)	# dis at 40 degrees from plwsep
+
+# CCP_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure ccp_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, j, len_p
+real	theta, x, y, tx, ty
+include	"ccp.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = CCP_PMAP(g_cc)
+
+	if (CCP_LTYPE(g_cc) != PM_LTYPE(pm)) {
+	    call ccp_linetype (PM_LTYPE(pm))
+	    CCP_LTYPE(g_cc) = PM_LTYPE(pm)
+	}
+	if (CCP_WIDTH(g_cc) != PM_WIDTH(pm)) 
+		CCP_WIDTH(g_cc) = PM_WIDTH(pm)
+
+	if (CCP_COLOR(g_cc) != PM_COLOR(pm)) {
+	    call ccp_color (PM_COLOR(pm))
+	    CCP_COLOR(g_cc) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	do i = 1, len_p, 2 {
+	    # Draw the single point as a box with a diagonal
+	    # through it.
+
+	    theta = 0.5 * HALFPI
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+	    tx = x + DIAGSEP * cos (theta)
+	    ty = y + DIAGSEP * sin (theta)
+	    call plot (tx, ty, CCP_UP)
+	    g_max_x = max (tx, g_max_x)
+
+	    do j = 1, 4 {
+		theta = theta + HALFPI
+		tx = x + DIAGSEP * cos (theta)
+		ty = y + DIAGSEP * sin (theta)
+		call plot (tx, ty, CCP_DOWN)
+	    }
+
+	    # Fill in diagonal.
+	    tx = x + DIAGSEP * cos (theta + PI)
+	    ty = y + DIAGSEP * sin (theta + PI)
+	    call plot (tx, ty, CCP_DOWN)
+	}
+end
diff --git a/sys/gio/calcomp/ccppmset.x b/sys/gio/calcomp/ccppmset.x
new file mode 100644
index 00000000..2f3f5534
--- /dev/null
+++ b/sys/gio/calcomp/ccppmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_PMSET -- Set the polymarker attributes.
+
+procedure ccp_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"ccp.com"
+
+begin
+	pm = CCP_PMAP(g_cc)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/calcomp/ccpreset.x b/sys/gio/calcomp/ccpreset.x
new file mode 100644
index 00000000..7d4514f6
--- /dev/null
+++ b/sys/gio/calcomp/ccpreset.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"ccp.h"
+
+# CCP_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure ccp_reset()
+
+pointer	pl, pm, fa, tx
+include	"ccp.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = CCP_PLAP(g_cc)
+	pm = CCP_PMAP(g_cc)
+	fa = CCP_FAAP(g_cc)
+	tx = CCP_TXAP(g_cc)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= GL_SOLID
+	PL_WIDTH(pl)	= GKI_PACKREAL(PL_SINGLE)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= GL_SOLID
+	PM_WIDTH(pm)	= GKI_PACKREAL(PL_SINGLE)
+	PM_COLOR(pm)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	CCP_LTYPE(g_cc)		= -1
+	CCP_WIDTH(g_cc)		= -1
+	CCP_COLOR(g_cc)		= -1
+	CCP_TXSIZE(g_cc)	= -1
+	CCP_TXFONT(g_cc)	= -1
+end
diff --git a/sys/gio/calcomp/ccptx.x b/sys/gio/calcomp/ccptx.x
new file mode 100644
index 00000000..b93b5223
--- /dev/null
+++ b/sys/gio/calcomp/ccptx.x
@@ -0,0 +1,463 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"ccp.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# CCP_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure ccp_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	g_dx, g_dy			# scale GKI to window coords
+int	g_x1, g_y1			# origin of device window
+int	g_x2, g_y2			# upper right corner of device window
+real	x, y, dx, dy, tsz, xto_nicesize, yto_nicesize
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, quality
+pointer	sp, seg, ip, op, tx, first, pl
+int	ccx_segment()
+include	"ccp.com"
+
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = CCP_TXAP(g_cc)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by ccp_txset, and is just a scaling factor.
+
+	CCP_TXSIZE(g_cc) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != CCP_COLOR(g_cc)) {
+	    call ccp_color (TX_COLOR(tx))
+	    CCP_COLOR(g_cc) = TX_COLOR(tx)
+	}
+
+	# Set the character-generator quality.  Only low (Calcomp "symbol")
+	# and other (ccp_font; see NSPP doc. on its font) are supported.
+	if (g_txquality == 0) {
+	    quality = TX_QUALITY(tx)	# param was specified "normal" to task
+	} else
+	    quality = g_txquality	# param was explicit to task
+
+	# Set the linetype to a solid line, and invalidate last setting.
+	call ccp_linetype (GL_SOLID)	# for use in ccp_polyline
+	CCP_LTYPE(g_cc) = -1		# PL_LTYPE still contains current settng
+
+	# Set pointer to polyline attribute structure and set line width
+	# if necessary.
+	pl = CCP_PLAP(g_cc)
+
+	if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) {
+		CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE)
+	    } else
+	        CCP_WIDTH(g_cc) = PL_WIDTH(pl)
+	}
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = ccx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call ccx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# Scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = CCP_CHARHEIGHT(g_cc,1) * tsz
+	cw = CCP_CHARWIDTH(g_cc,1) * tsz
+
+	# Compute correction factors for absolute physical character sizes.
+	# This also corrects for distortion of high-qual text if xscale<>yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x
+		    x2 = x1 + cw * xto_nicesize
+		    y1 = y
+		    y2 = y1 + ch * yto_nicesize
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x
+		    x2 = x1 + cw * xto_nicesize
+		    y1 = y
+		    y2 = y1 + ch * yto_nicesize
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call ccp_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font, quality)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# CCX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure ccx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# CCX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure ccx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space, xto_nicesize, yto_nicesize
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q, xtmp, ytmp
+include	"ccp.com"
+
+begin
+	tx = CCP_TXAP(g_cc)
+
+	# Compute correction factors for absolute physical character sizes.
+	# This also removes any warping due to different xscale, yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# Get character sizes in GKI(plotter) coords; scale y (ch) dimension
+	# to that of x for absolute scale systems that are different in x,y.
+
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = CCP_CHARHEIGHT(g_cc,1) * sz
+	cw = CCP_CHARWIDTH(g_cc,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated and unscaled).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation, scaling differences, and absolute size.
+	dx = ( p * cosv + q * sinv) * xto_nicesize 
+	dy = (-p * sinv + q * cosv) * yto_nicesize
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character size in X and Y.
+	xsize = abs ( cw * cosv + ch * sinv) * xto_nicesize
+	ysize = abs (-cw * sinv + ch * cosv) * yto_nicesize
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	xtmp = ( p * cosv + q * sinv) * xto_nicesize 
+	ytmp = (-p * sinv + q * cosv) * yto_nicesize
+
+	x0 = x0 + xtmp
+	y0 = y0 + ytmp
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/calcomp/ccptxset.x b/sys/gio/calcomp/ccptxset.x
new file mode 100644
index 00000000..f2f4f040
--- /dev/null
+++ b/sys/gio/calcomp/ccptxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_TXSET -- Set the text drawing attributes.
+
+procedure ccp_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"ccp.com"
+
+begin
+	tx = CCP_TXAP(g_cc)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/calcomp/doc/ccpspecs.hlp b/sys/gio/calcomp/doc/ccpspecs.hlp
new file mode 100644
index 00000000..fae12e4e
--- /dev/null
+++ b/sys/gio/calcomp/doc/ccpspecs.hlp
@@ -0,0 +1,384 @@
+.help
+\fBSpecifications for IRAF Calcomp kernel -- (CCP package)\fR
+
+
+The Calcomp kernel (package prefix "ccp") will implement selected GKI 
+instructions, using only calls to the Calcomp routines \fBplots\fR, 
+\fBplot\fR, \fBnewpen\fR and \fBsymbol\fR.
+
+
+There are two sub-components of the CCP package:  1) the kernel driver
+task allowing a user to send a specified graphics metafile to the plotter, and
+2) the low-level kernel routines which implement specific GKI instructions,
+and which make the only calls to the Calcomp library.
+
+
+.nh
+\fBCL interface -- task CALCOMP\fR
+
+
+The driver task, \fBcalcomp\fR, allows a user to direct an existing GKI metacode
+file to a particular Calcomp plotter under control of a set of CL parameters.
+The task is loaded either by being run directly from the CL as a task, or by
+being invoked through inter-process control following a write-to-pseudofile
+containing the GKI_OPENWS metacode instruction.  The task may 
+optionally control certain kinds of debug output.
+
+.nf
+CL parameters to the kernel driver task \fBcalcomp\fR:
+
+input,s,a,,,,"input metacode file"
+device,s,h,"calcomp",,,"output device"
+generic,b,h,no,,,"ignore remaining kernel dependent parameters"
+debug,b,h,no,,,"print decoded graphics instructions during processing"
+verbose,b,h,no,,,"print elements of polylines, etc. in debug mode"
+gkiunits,b,h,no,,,"print coordinates in GKI rather than NDC units"
+xscale,r,h,INDEF,0.0,,"plotter x = GKI_NDC_X * xscale"
+yscale,r,h,INDEF,0.0,,"plotter y = GKI_NDC_Y * yscale"
+txquality,s,h,"normal","normal|low|high",,"character quality; n=from metacode"
+lwtype,s,h,"ntracing","ntracing|penchange",,"bold line/text implementation"
+ltover,b,h,no,,,"override line type simulation"
+lwover,b,h,no,,,"override line width simulation"
+lcover,b,h,no,,,"override line color implementation by penchange"
+dashlen,r,h,INDEF,0.0,,"dashed line dash length, pltr units; 0.5 reasonable"
+gaplen,r,h,INDEF,0.0,,"dashed line gap length, pltr units; 0.1 reasonable"
+plwsep,r,hl,INDEF,0.,,"polyline width separation for ntracing; 0.005 reasonable"
+
+.fi
+
+
+.nh
+\fBSuggested GRAPHCAP entry for calcomp plotter\fR
+
+.nf
+
+    p5|calcomp|calcomp pen plotter:\
+	    :kf=xcalcomp.e:tn=calcomp:co#132:li#66:xr#32767:yr#5375:\
+	    :ch#.0294:cw#.0125:xs#1.664564:ys#0.27305:\
+	    :PU=inches:MP#.0254:DL#.50:GL#.10:PW#.005:\
+	    :DD=plot!calcomp,/tmp/gcaXXXXXX,\
+	    !{ cd /tmp; nice /local/bin/plotX -Tcalcomp -W=1 $F |\
+	    nice /usr/bin/plot  -Tcalcomp; rm $F; }&:
+
+    #xs	1.664564	# maximum x in meters; max at .002 inches step size
+    #ys	.27305000	# maximum y in meters; 10.75 inch paper
+    #xr	32767		# max resolution in x; limited by GKI short int coords
+    #yr	5375		# max resolution in y; 10.75 inches at .002 inches step
+    #PU	inches		# plotter units
+    #MP	0.0254		# meters per plotter unit 
+    #DL	0.5000		# dash length in plotter units
+    #GL	0.1000		# gap length in plotter units
+    #PW	0.0050		# n-tracing (bold line simul.) width sep. in pltr units
+    #if yscale not set by kernel, g_yndcto_p = GKI_MAXNDC/(MP*yr); 32767/10.75"
+    #if xscale not set by kernel, g_xndcto_p = g_yndcto_p; square aspect ratio
+
+.fi
+
+
+.nh
+\fBInterface between CALCOMP task and lower-level kernel routines\fR
+
+
+Two kernel routines will normally be called from outside the GKI
+instruction-stream decoding facility (as from the driver task):
+
+.nf
+     ccp_open (devname, dd)
+
+          devname:    device name of desired Calcomp plotter (must have 
+                      entry in graphcap file)
+
+          dd:         array of entry point addresses to lower-level kernel 
+                      routines 
+
+          discussion: linking to multiple Calcomp plotters is a 
+		      site-dependent function.  Ordinarily devname is 
+		      ignored; if this kernel is called, output will go 
+		      to the device initialized by the Calcomp library.  
+		      See ccp_openws.
+
+
+     ccp_close ()
+
+	  discussion: causes a Calcomp "newframe" -- resets origin to 
+		      right of last previously-plotted point.
+
+
+.fi
+.nh
+\fBLow-level kernel routines\fR
+
+
+All remaining kernel routines will normally be called either by ccp_open or
+by gki_execute, or by each other.  Following are descriptions of the 
+implementation of GKI instructions:
+.nf
+
+     GKI_EOF
+
+          Not implemented; it should be trapped outside the kernel, as in
+          \fBgki_execute\fR.
+
+     GKI_OPENWS
+
+          ccp_openws (devname, len_devname, mode)
+
+               devname; len_devname:
+
+                    name of plotter, name length, if not present in metafile
+
+               mode:
+
+                    file access mode for gki metafile; if NEWFILE, a Calcomp
+		    "newframe" (reorigin to right of previous plot) will
+		    occur; if APPEND mode, no newframe.
+
+               discussion:
+
+                    There is no output metafile; device connection and any 
+		    site-specific spooling is handled below this level.  
+		    Note that there must be a graphcap entry for devname.
+
+     GKI_CLOSEWS
+
+          ccp_closews ()
+
+               discussion:
+
+                    As there is no output metafile, this is a noop.
+
+     GKI_REACTIVATEWS
+
+          Not implemented.
+
+     GKI_DEACTIVATEWS
+
+          Not implemented.
+
+     GKI_MFTITLE
+
+          Not implemented.
+
+     GKI_CLEARWS
+
+          ccp_clear ()
+
+               discussion:
+
+                    Implemented only by a Calcomp "newframe"; there is no 
+		    output metacode file for spooling at this level.
+
+     GKI_CANCEL
+
+          Not implemented, since there is no buffered output.
+
+     GKI_FLUSH
+
+          Not implemented.
+
+     GKI_POLYLINE
+
+          ccp_polyline (p, npts)
+
+               p:          array of points (x1, y1, x2, y2, ...)
+
+               npts:       number of pairs
+
+               discussion: 
+
+		    To GKI, ccp_polyline will appear pretty normal; due to 
+		    the lack of settable parameters like dashed-line in 
+		    Calcomp, such features are implemented in further layers
+		    between ccp_polyline and the actual Calcomp vector-draw 
+		    routine.  See kernel task parameters lwtype, lwover, and
+		    ltover for line width and type control.
+
+     GKI_POLYMARKER
+
+          ccp_polymarker (p, npts)
+
+               arguments:  same as above
+
+               discussion: 
+
+		    Ccp_polymarker will merely dot the location at the
+		    coordinate passed in; more complicated marker 
+		    symbols will be assumed to have been handled above, for 
+		    purposes of clipping, and will be drawn with ccp_polyline 
+		    at this level.
+
+     GKI_TEXT
+
+          ccp_text (x, y, text, nchar)
+
+               x, y:
+
+                    NDC coordinates of text stream; note that the JUSTIFY 
+		    parameters in GSET determine where these coordinates are 
+		    relative to the text characters.
+
+               text: array of type short characters
+
+               nchar: number of chars in text
+
+               discussion:
+
+		    The same levels of text quality will be supported as in
+		    the stdgraph kernel; normal is taken from the metacode
+		    request, medium and high fonts are stroke text, while low 
+		    quality is Calcomp hardware text.  Depending on the
+		    particular plotter controller at each site, low quality
+		    text may or may not be significantly faster than stroke
+		    text.
+		    
+		    The special Calcomp symbols numbered 0 - 15 in the 
+		    Calcomp symbol library are invoked by characters with 
+		    ASCII values 0 - 15.  When using hardware text generation,
+		    the ASCII symbol requested will be mapped to the Calcomp 
+		    set if possible; otherwise, a default "indefinite" character
+		    will appear.
+
+     GKI_FILLAREA
+
+          ccp_fillarea (p, npts)
+
+               p, npts: same as above for ccp_polyline
+
+               discussion:
+
+                    With Calcomp, fillarea could only be implemented by 
+		    simulating with hatching patterns, a time-consuming 
+		    process for a pen plotter.  We may or may not choose 
+		    to do this, depending upon users' needs.  For the 
+		    very similar Versaplot kernel which may follow, it 
+		    should definitely be implemented, using Versaplot's 
+		    \fBtone\fR call.  Initially, it will only be implemented
+		    here with a call to ccp_polyline for the border.
+
+     GKI_PUTCELLARRAY
+
+	  Not implemented.
+
+     GKI_SETCURSOR
+
+          Not implemented.
+
+     GKI_PLSET
+
+          ccp_plset (gki)
+
+               gki: attribute structure decoded by gki
+
+               discussion:
+
+		    Line types documented in the GIO manual will be 
+		    implemented in software except for "erase", unless the 
+		    CL parameter to the CALCOMP task "ltover" is on, in 
+		    which case all lines drawn will be solid.  See task 
+		    parameters dash and gap.  In the future, line types
+		    numbered higher than 4 may be implemented using various
+		    combinations of dashes and dots as in Morse code.  Line
+		    width and color may be similarly implemented or overridden;
+		    if not overridden, line width will be done by default using
+		    n-tracing (n = nearest integer value of line width) or by a
+		    penchange, under control of task parameter "lwtype".
+
+     GKI_PMSET
+
+          ccp_pmset (gki)
+
+               gki, discussion: Same as for ccp_plset.
+
+     GKI_TXSET
+
+          ccp_txset (gki)
+
+               gki, discussion:
+
+                    Internal flags are set from structure gki controlling 
+		    text up vector, path relative to up vector, horizontal 
+		    and vertical justification, font, quality, color, 
+		    spacing, and size.  For high-quality text, all flags are
+		    implemented (color by a pen change, with optional 
+                    override); see GKI_TEXT discussion.
+
+     GKI_FASET
+
+          ccp_faset (gki)
+
+               gki, discussion:
+
+                    Internal flags are set for fill area style and color.  
+		    If we decide to implement fill area in software (the only
+		    way for Calcomp), we will use GKS conventions wherever
+		    possible.
+
+     GKI_GETCURSOR
+
+	  Not implemented.  The Calcomp \fBwhere\fR routine would only 
+	  duplicate GCURPOS in GIO.
+
+     GKI_CURSORVALUE
+
+          Not implemented; not an interactive device.
+
+     GKI_GETCELLARRAY
+
+          Not implemented; not a storage device.
+
+     GKI_CELLARRAY
+
+          Not implemented.
+
+     GKI_ESCAPE
+
+          ccp_escape (fn, instruction, nwords)
+
+               fn: escape function code
+
+               instruction, nwords:
+
+                    Nwords-long array of short integers containing the 
+		    instruction sequence.
+
+               discussion:
+
+		    A high-level task may pass the NDC-to-plotter units
+		    coordinate scaling factor down into the kernel to 
+		    permit exact scaling.  The scale factors will be 
+		    set in common to allow fast access by the ccp_draw 
+		    routine.
+                    
+		    GKI_ESCAPE = BOI 25 L FN N DC
+			
+			L(i)	5 + N
+			FN(i)	escape function code
+			N(i)	number of escape data words
+			DC(i)	escape data words
+
+			1) xndc_to_plotter:
+
+			   FN = ESC_XNDCTO_P (currently = 1 in ccp.h)
+			   N  = number of characters in the scale specification
+			   DC = array of N short integers containing character-
+				packed scale (must be achtsc'd then ctod'd to 
+				get x scale)
+
+			2) yndc_to_plotter:
+
+			   FN = ESC_YNDCTO_P (currently = 2 in ccp.h)
+			   N  = same as in (1)
+			   DC = same as in (1)
+
+		    The macros ESC_*NDCTO_P, currently defined in ccp.h, should
+		    probably be defined in a gki-public place like gki.h.
+
+
+     GKI_SETWCS
+
+          Not implemented.
+
+     GKI_GETWCS
+
+          Not implemented.
+.fi
diff --git a/sys/gio/calcomp/font.com b/sys/gio/calcomp/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/calcomp/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/calcomp/font.h b/sys/gio/calcomp/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/calcomp/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/calcomp/mkpkg b/sys/gio/calcomp/mkpkg
new file mode 100644
index 00000000..f4b7f8b9
--- /dev/null
+++ b/sys/gio/calcomp/mkpkg
@@ -0,0 +1,52 @@
+# Make the CALCOMP GIO graphics kernel.  Requires the host system library
+# LIB_CALCOMP, which must be callable from an IRAF program (which is not the
+# same as a Fortran program).
+
+$checkout libccp.a lib$
+$update   libccp.a
+$checkin  libccp.a lib$
+$call     relink
+$exit
+
+update:					# update lib$x_calcomp.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_calcomp.e in local directory
+	$omake  x_calcomp.x
+	$link	x_calcomp.o -lccp $(LIB_CALCOMP)
+	;
+
+install:				# install in system library
+	$move	x_calcomp.e bin$
+	;
+
+libccp.a:
+	ccpclear.x	ccp.com ccp.h <mach.h>
+	ccpclose.x	ccp.com ccp.h
+	ccpclws.x	ccp.com ccp.h
+	ccpcolor.x	ccp.com ccp.h
+	ccpcseg.x	ccp.com ccp.h <gki.h> <gset.h> <mach.h>
+	ccpdrawch.x	ccp.com ccp.h font.com font.h <gki.h> <gset.h>\
+			<math.h>
+	ccpdseg.x	ccp.com ccp.h <math.h>
+	ccpescape.x	ccp.com ccp.h <gescape.h>
+	ccpfa.x		ccp.com ccp.h
+	ccpfaset.x	ccp.com ccp.h <gki.h>
+	ccpfont.x	ccp.com ccp.h <gki.h> <gset.h>
+	ccpinit.x	ccp.com ccp.h <ctype.h> <gki.h> <mach.h>
+	ccpltype.x	ccp.com ccp.h <gset.h>
+	ccplwidth.x	ccp.com ccp.h
+	ccpopen.x	ccp.com ccp.h <gki.h>
+	ccpopenws.x	ccp.com ccp.h <error.h> <gki.h> <mach.h>
+	ccppl.x		ccp.com ccp.h <gki.h> <gset.h>
+	ccpplset.x	ccp.com ccp.h <gki.h>
+	ccppm.x		ccp.com ccp.h <gki.h> <math.h>
+	ccppmset.x	ccp.com ccp.h <gki.h>
+	ccpreset.x	ccp.com ccp.h <gset.h> <gki.h>
+	ccptx.x		ccp.com ccp.h <gki.h> <gset.h> <math.h>
+	ccptxset.x	ccp.com ccp.h <gki.h> <gset.h>
+	rptheta4.x	<math.h>
+	t_calcomp.x	<error.h> <gki.h> ccp.com ccp.h <gset.h> <mach.h>
+	;
diff --git a/sys/gio/calcomp/rptheta4.x b/sys/gio/calcomp/rptheta4.x
new file mode 100644
index 00000000..b2ee42b7
--- /dev/null
+++ b/sys/gio/calcomp/rptheta4.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+
+define	PIOVER4		(0.25 * PI)
+define	THREEPIOVER4	(0.75 * TWOPI)
+
+# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y):
+# angle between line segment p1-p2 and horizontal +x axis centered on p1; 
+# returned in radians; single precision (see pdtheta4).
+
+real procedure rptheta4 (p1x, p1y, p2x, p2y)
+
+real	p1x,p1y, p2x,p2y	# x,y of each point
+real	dx, dy, ang
+
+begin
+	dx = p2x - p1x
+	dy = p2y - p1y
+
+	if (dx == 0.0) {
+	    if (dy >= 0.0) {
+		ang = HALFPI
+	    } else {
+		ang = THREEPIOVER4
+	    }
+	} else {
+	    ang = atan (dy / dx)
+	    if (dx < 0.0) {		# 2nd or 3rd quadrant
+		ang = ang + PI
+	    } else if (dy < 0.0) {	# 4th quadrant
+		ang = ang + TWOPI
+	    }
+	}
+
+	return (ang)
+end
diff --git a/sys/gio/calcomp/t_calcomp.x b/sys/gio/calcomp/t_calcomp.x
new file mode 100644
index 00000000..0164d043
--- /dev/null
+++ b/sys/gio/calcomp/t_calcomp.x
@@ -0,0 +1,125 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+include <gset.h>
+include <mach.h>
+include "ccp.h"
+
+define	SZ_TXQUALITY	1
+
+# CALCOMP -- Graphics kernel for Calcomp pen plotter output.  The whole
+# package is copied as much as possible from the NSPP kernel.
+
+procedure t_calcomp()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+char	txquality[SZ_TXQUALITY]
+bool	clgetb()
+char	clgetc()
+real	clgetr()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+include "ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+
+	if (clgetb ("generic")) {
+	    debug 	  = NO
+	    verbose 	  = NO
+	    gkiunits 	  = NO
+	    g_xtask_scale = INDEF
+	    g_xndcto_p 	  = INDEF
+	    g_ytask_scale = INDEF
+	    g_yndcto_p 	  = INDEF
+	    g_txquality   = 0
+	    g_lwtype	  = 'n'
+	    g_ltover      = false
+	    g_lwover      = true
+	    g_lcover      = false
+	    g_dashlen     = INDEF
+	    g_gaplen      = INDEF
+	    g_plwsep      = INDEF
+
+	} else {
+	    debug      = btoi (clgetb ("debug"))
+	    verbose    = btoi (clgetb ("verbose"))
+	    gkiunits   = btoi (clgetb ("gkiunits"))
+
+	    # scale precedence: calcomp.par->metacode->graphcap->compile_time
+	    g_xtask_scale = clgetr ("xscale")
+	    if (!IS_INDEF (g_xtask_scale))
+		g_xndcto_p = g_xtask_scale
+	    g_ytask_scale = clgetr ("yscale")
+	    if (!IS_INDEF (g_ytask_scale))
+		g_yndcto_p = g_ytask_scale
+
+	    # Get the quality parameter for the text generator.
+	    call clgstr ("txquality", txquality, SZ_TXQUALITY)
+	    switch (txquality[1]) {
+	    case 'l':
+		g_txquality = GT_LOW
+	    case 'm':
+		g_txquality = GT_MEDIUM
+	    case 'h':
+		g_txquality = GT_HIGH
+	    default:
+		g_txquality = 0			# .par default is "normal"
+	    }
+
+	    # Method of line width implementation:
+	    g_lwtype    = clgetc ("lwtype")
+
+	    # The overrides:
+	    g_ltover    = clgetb ("ltover")
+	    g_lwover    = clgetb ("lwover")
+	    g_lcover    = clgetb ("lcover")
+
+	    # Plotter line type, width control:
+	    g_dashlen   = clgetr ("dashlen")
+	    g_gaplen    = clgetr ("gaplen")
+	    g_plwsep    = clgetr ("plwsep")
+	}
+
+	# Open the graphics kernel.
+	call ccp_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call ccp_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/vttest.par b/sys/gio/calcomp/vttest.par
new file mode 100644
index 00000000..fcbcb2ad
--- /dev/null
+++ b/sys/gio/calcomp/vttest.par
@@ -0,0 +1,10 @@
+lname,s,hl,"ltest1.dat",,,"input polyline test file name"
+tname,s,hl,"ttest3.dat",,,"input text test file name"
+ltype,i,hl,1,1,6,"line type"
+lwidth,i,hl,1,1,15,"line width"
+mtype,i,hl,0,0,1023,"polymarker type code"
+dashlen,r,hl,10000.,0.,,"length of dash in plotter units"
+gaplen,r,hl,5000.,0.,,"width of gap in plotter units"
+plwsep,r,hl,50.,0.,,"polyline width separation for ntracing"
+option,s,hl,"l",,,"test option: {l-line; t-text; m-marker}"
+device,s,hl,"vt640",,,"output device for test program"
diff --git a/sys/gio/calcomp/vttest.x b/sys/gio/calcomp/vttest.x
new file mode 100644
index 00000000..ceff7c7a
--- /dev/null
+++ b/sys/gio/calcomp/vttest.x
@@ -0,0 +1,608 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <gki.h>
+include	<gset.h>
+include	<gio.h>
+include <ctype.h>
+include <math.h>
+include "ccp.h"
+
+define	SZ_BUF 2048
+define	PIOVER4		(0.25 * PI)
+define	THREEPIOVER4	(0.75 * TWOPI)
+define	MAXCH	15
+
+# X_VTTEST -- testing task for simulating calcomp kernel routines on vt640
+
+task vttest = t_vttest
+
+# T_VTTEST -- test low-level Calcomp graphics simulation routines on vt640
+
+procedure t_vttest ()
+
+char	lname[SZ_FNAME], tname[SZ_FNAME], devname[SZ_FNAME]
+int	ltype, lwidth, npts, n, mtype, i
+char	testoption
+pointer	x, y, gp, sim_gp
+short	p[ARB]
+
+pointer	sp, nambuf, pl, pm
+int	clgeti (), strlen ()
+real	clgetr ()
+char	clgetc ()
+pointer	ttygdes (), gopen ()
+
+include "ccp.com"
+common	/simulate/ sim_gp
+
+string	fdevice	"vt640"
+
+begin
+	call smark (sp)
+	call salloc (nambuf, SZ_FNAME, TY_CHAR)
+
+	testoption= clgetc ("option")
+	if (testoption == 'l') {
+	    call clgstr ("lname", lname, SZ_FNAME)
+	    ltype = clgeti ("ltype")
+	    lwidth = clgeti ("lwidth")			# width in rel. units
+	    g_dashlen = clgetr ("dashlen")
+	    g_gaplen  = clgetr ("gaplen")
+	    g_plwsep  = clgetr ("plwsep")
+	} else if (testoption == 't') {
+	    call clgstr ("tname", tname, SZ_FNAME)
+	    g_plwsep  = clgetr ("plwsep")
+	} else if (testoption == 'm') {
+	    mtype  = clgeti ("mtype")
+	}
+	call clgstr ("device", devname, SZ_FNAME)
+
+	n = strlen (devname)
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[nambuf], n)
+	    Memc[nambuf+n] = EOS
+	}
+	iferr (g_tty = ttygdes (Memc[nambuf]))
+	    call erract (EA_ERROR)
+	g_cc = NULL
+	call ccp_init (g_tty, Memc[nambuf])
+	call ccp_reset ()
+
+	g_xndcto_p = 1.0	# for testing, raw data is NDC-space (0-32767)
+	g_yndcto_p = 1.0	# (that is, after passing through to_short())
+	g_ltover   = false
+	g_lwover   = true
+
+	pl = CCP_PLAP(g_cc)
+	pm = CCP_PMAP(g_cc)
+
+	PL_LTYPE(pl) = ltype
+	PL_WIDTH(pl) = GKI_PACKREAL(lwidth)
+	PM_LTYPE(pm) = mtype
+
+	gp = gopen (devname, NEW_FILE, STDGRAPH)
+	sim_gp = gp
+	call gsview (gp, 0.0, 0.63, 0.0, 1.0)		# square viewport
+	call gswind (gp, 0.0, 32767.0, 0.0, 32767.0)
+
+	switch (testoption) {
+
+	case 'l':					# polyline
+
+	    call rddata (lname, x, y, npts)		# range 0.0-1.0
+	    call to_short (Memr[x], Memr[y], npts, p)	# range 0-32767
+	    call ccp_polyline (p, npts)
+
+	case 't':					# text
+
+	    call testtext (gp, tname)			# read, calc, call ccppl
+
+	case 'm':					# polymarker
+
+	    call rddata (lname, x, y, npts)		# x,y array of mrkr pos.
+	    do i = 1, npts {
+		call calcmarker (32767 * Memr[x+i-1], 32767 * Memr[y+i-1], 
+		    mtype, p, npts)
+		call ccp_polymarker (p, npts)
+	    }
+	}
+			 
+	call gclose (gp)
+	call ccp_close ()				# free g descriptors
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+	call sfree (sp)
+end
+
+# TO_SHORT -- convert x, y real arrays to short integers as NDC coords
+
+procedure to_short (x, y, npts, p)
+
+real	x[ARB], y[ARB]
+int	npts
+short	p[ARB]
+
+int	i, j
+
+begin
+	do i = 1, npts, 1 {
+	    j = (i - 1) * 2 + 1
+	    p[j]   = x[i] * 32767
+	    p[j+1] = y[i] * 32767
+	}
+	return
+end
+
+# CALCMARKER -- calculate and return a pattern of points representing a
+# polymarker of the specified type, origined at x, y.
+
+procedure calcmarker (x, y, marktype, p, npts)
+
+real	x,y		# GKI_NDC coordinates of marker origin
+int	marktype	# polymarker type, specified in GIO specs
+short	p[ARB]		# output array of points defining marker, in GKI_NDC
+int	npts		# no. of points; x,y pairs (= 1/2 elements in p)
+
+int	i, j, m, fill
+real	xsize, ysize
+pointer	tx
+int	and()
+
+include "ccp.com"
+include	"/iraf/sys/gio/markers.dat"
+
+begin
+	tx    = CCP_TXAP(g_cc)
+	xsize = CCP_CHARHEIGHT(g_cc,1) * GKI_UNPACKREAL(TX_SIZE(tx))
+	ysize = xsize	# for now
+	# The point marker type cannot be combined with the other types and
+	# is treated as a special case.  The remaining markers are drawn
+	# using GUMARK, which draws marks represented as polygons
+
+	if (marktype == GM_POINT || (xsize == 0 && ysize == 0)) {
+	    p[1] = x
+	    p[2] = y
+	    npts = 1
+
+	} else {
+
+	    # The polylines for the standard marks are stored in MPX and MPY 
+	    # at offsets MXO and MYO.
+	    fill = NO
+	    npts = 0
+	    do i = GM_FIRSTMARK, GM_LASTMARK
+		if (and (marktype, 2 ** i) != 0) {
+		    m = i - GM_FIRSTMARK + 1
+		    do j = 1, mnpts[m] {
+			npts = npts + 1
+			p[npts*2-1] = x - 0.5 * xsize + xsize * mpx[moff[m]+j-1]
+			p[npts*2]   = y - 0.5 * ysize + ysize * mpy[moff[m]+j-1]
+		    }
+		}
+	}
+end
+
+
+procedure rddata (fname, x, y, npts)
+
+char	fname[ARB]
+pointer	x, y
+int	npts
+
+int	buflen, n, fd, ncols, lineno, i, status, testint
+pointer	sp, lbuf, ip
+real	xval, yval, maxy
+int	getline(), nscan(), open()
+errchk	open, sscan, getline, malloc
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	buflen = SZ_BUF
+	iferr {
+	    call malloc (x, buflen, TY_REAL)
+	    call malloc (y, buflen, TY_REAL)
+	} then
+	    call erract (EA_FATAL)
+
+	n = 0
+	ncols = 0
+	lineno = 0
+
+	status = 0
+	while (status != EOF) {
+	    iferr (status = getline (fd, Memc[lbuf])) {
+		call eprintf ("getline error from rddata: status=%d\n")
+		    call pargi (status)
+		call erract (EA_FATAL)
+	    }
+	    if (status == EOF) 
+		next
+	    # Skip comment lines and blank lines.
+	    lineno = lineno + 1
+	    if (Memc[lbuf] == '#')
+		next
+	    for (ip=lbuf;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '\n' || Memc[ip] == EOS)
+		next
+
+	    # Decode the points to be plotted.
+	    call sscan (Memc[ip])
+		call gargr (xval)
+		call gargr (yval)
+
+	    # The first line determines whether we have an x,y list or a
+	    # y-list.  It is an error if only one value can be decoded when
+	    # processing a two column list.
+
+	    if (ncols == 0 && nscan() > 0)
+		ncols = nscan()
+	    
+	    switch (nscan()) {
+	    case 0:
+		call eprintf ("no args; %s, line %d: %s\n")
+		    call pargstr (fname)
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+		next
+	    case 1:
+		yval = xval
+	    default:	# normally, ncols=2
+		if (ncols != 2) {
+		    call eprintf ("weird data; file %s, line %d: %s\n")
+			call pargstr (fname)
+			call pargi (lineno)
+			call pargstr (Memc[lbuf])
+		    next
+		}
+	    }
+
+	    n = n + 1
+	    if (n > buflen) {
+		buflen = buflen + SZ_BUF
+		call realloc (x, buflen, TY_REAL)
+		call realloc (y, buflen, TY_REAL)
+	    }
+
+	    Memr[x+n-1] = xval
+	    Memr[y+n-1] = yval
+	    testint = x+n-1
+	}
+
+	if (ncols == 1) {
+	    maxy = 0.0
+	    do i = 1, n 
+		maxy = max (Memr[y+i-1], maxy)
+	    do i = 1, n
+		Memr[x+i-1] = maxy * real(i) / real(n)
+	}
+	call realloc (x, n, TY_REAL)
+	call realloc (y, n, TY_REAL)
+
+	call close (fd)
+	call sfree (sp)
+	npts = n
+end
+
+
+# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y):
+# angle between line segment p1-p2 and horizontal +x axis centered on p1; 
+# returned in radians; single precision (see pdtheta4).
+
+real procedure rptheta4 (p1x, p1y, p2x, p2y)
+
+real p1x,p1y, p2x,p2y	# x,y of each point
+
+real	dx, dy, ang
+
+begin
+	dx = p2x - p1x
+	dy = p2y - p1y
+	if (dx == 0.0) {
+	    if (dy >= 0.0) {
+		ang = HALFPI
+	    } else {
+		ang = THREEPIOVER4
+	    }
+	} else {
+	    ang = atan (dy / dx)
+	    if (dx < 0.0) {		# 2nd or 3rd quadrant
+		ang = ang + PI
+	    } else if (dy < 0.0) {	# 4th quadrant
+		ang = ang + TWOPI
+	    }
+	}
+	return (ang)
+end
+
+# PLOT -- simulate Calcomp's PLOT routine for testing development version of
+# calcomp kernel
+
+procedure plot (x, y, pencode)
+
+real	x,y	# plotter coords (ndc in simulation)
+int	pencode
+
+real	lastp_x, lastp_y
+
+pointer	gp
+common	/simulate/ gp
+
+begin
+	if (pencode == CCP_DOWN) 
+	    call gline (gp, lastp_x, lastp_y, x, y)
+	if (pencode == CCP_DOWN || pencode == CCP_UP) {
+	    lastp_x = x
+	    lastp_y = y
+	}
+end
+
+# PLOTS -- simulate calcomp plots routine for testing ccp code on vt640
+
+procedure plots (dum1, dum2, ldev)
+
+int	dum1, dum2, ldev
+
+begin
+	return
+end
+
+
+# NEWPEN -- temporary dummy routine for simulating Calcomp
+
+procedure newpen (whichpen)
+
+int	whichpen
+
+begin
+	return
+end
+
+# SYMBOL -- simulate Calcomp's SYMBOL routine for testing development version of
+# calcomp kernel
+
+procedure symbol (xp, yp, size, ch, orien, nchar)
+
+real	xp,yp	# plotter coords (ndc in simulation)
+real	size	# char size in plotter coords
+char	ch[ARB]	# chars to be drawn
+real	orien	# degrees counterclockwise from +x to rightward vector
+int	nchar	# number of chars
+
+pointer	gp
+common	/simulate/ gp
+
+string	format ""
+
+begin
+	ch[nchar+1] = EOS
+	call gseti (gp, G_TXUP, 90 + int(orien))
+	call gsetr (gp, G_TXSIZE, size)
+	call gtext (gp, xp, yp, ch, format)
+end
+
+
+# TESTTEXT -- read sequential lines from designated file and call ccp_text to
+# draw text at specified coordinates in specified format.
+
+procedure testtext (gp, fname) 
+
+pointer	gp			# graphics device 
+char	fname[SZ_FNAME]		# name of file from which to extract table
+
+int	fd, textlen, restlen, ip, op
+char	lbuf[SZ_LINE], ttext[SZ_LINE], rest[SZ_LINE], tformat[SZ_LINE], quote
+short	sttext[SZ_LINE]
+real	x,y
+int	open (), strlen (), getline (), nscan ()
+
+string	errmsg "unable to open table file                     "
+data	quote/34/
+
+begin
+	iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) {
+	    call sprintf (errmsg[27], SZ_FNAME, "%s")
+		call pargstr (fname)
+	    call fatal (EA_FATAL, errmsg)
+	}
+
+	while (getline (fd, lbuf) != EOF) {
+	    # Skip comment lines and blank lines.
+	    if (lbuf[1] == '#')
+		next
+	    for (ip=1;  IS_WHITE(lbuf[ip]);  ip=ip+1)
+		;
+	    if (lbuf[ip] == '\n' || lbuf[ip] == EOS)
+		next
+
+	    # Decode.
+	    call sscan (lbuf[ip])
+		call gargr (x)
+		call gargr (y)
+		call gargstr (rest, SZ_LINE)
+
+	    if (nscan() < 3)	# insufficient fields; ignore line, not nice.
+		next
+	    
+	    restlen = strlen (rest)
+
+	    # Pull out text buffer:
+	    for (ip=1; rest[ip] != quote && ip < restlen; ip=ip+1)	#->1st "
+		;
+	    op = 0
+	    for (ip=ip+1; rest[ip] != quote && ip < restlen; ip=ip+1) {
+		op        = op + 1
+		ttext[op] = rest[ip];
+	    }
+	    textlen       = op
+	    ttext[op+1]   = EOS
+
+	    # Pull out format string:
+	    for (ip=ip+1; IS_WHITE(rest[ip]); ip=ip+1)		#-> past whitesp
+		;
+	    op = 0
+	    for (; ip <= restlen && !IS_WHITE(rest[ip]); ip=ip+1) {
+		op          = op + 1
+		tformat[op] = rest[ip];
+	    }
+	    tformat[op+1]   = EOS
+		
+	    # set ccp descriptor text attributes if specified:
+	    if (tformat[1] != EOS)
+		call testxset (tformat)
+	    call achtcs (ttext, sttext, textlen) # ccp_text expects short text
+	    sttext[textlen+1] = EOS
+	    call ccp_text (nint(x), nint(y), sttext, textlen)
+	}
+	call close (fd)
+end
+
+
+# TESTXSET -- Parse a text drawing format string and set the values of the text
+# attributes in the TX (g_cc) output structure.
+
+procedure testxset (format)
+
+char	format[ARB]		# text attribute format string
+
+pointer tx
+char	attribute[MAXCH], value[MAXCH]
+real	tempsize
+int	ip, op, tip, temp, ch
+int	h_v[4], v_v[4], f_v[4], q_v[4], p_v[4]
+int	ctoi(), ctor(), stridx()
+
+include	"ccp.com"
+
+define	badformat_ 91
+
+string	h_c	"nclr"
+data	h_v	/GT_NORMAL,	GT_CENTER,	GT_LEFT,	GT_RIGHT/
+string	v_c	"nctb"
+data	v_v	/GT_NORMAL,	GT_CENTER,	GT_TOP,		GT_BOTTOM/
+string	f_c	"rgib"
+data	f_v	/GT_ROMAN,	GT_GREEK,	GT_ITALIC,	GT_BOLD/
+string	q_c	"nlmh"
+data	q_v	/GT_NORMAL,	GT_LOW,		GT_MEDIUM,	GT_HIGH/
+string	p_c	"lrud"
+data	p_v	/GT_LEFT,	GT_RIGHT,	GT_UP,		GT_DOWN/
+
+begin
+	# ccp kernel text descriptor:
+	tx = CCP_TXAP(g_cc)
+
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	for (ip=1;  format[ip] != EOS;  ip=ip+1) {
+	    # Extract the next "attribute=value" construct.
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+
+	    op = 1
+	    for (ch=format[ip];  ch != EOS && ch != '=';  ch=format[ip]) {
+		if (op <= MAXCH) {
+		    attribute[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+	    }
+	    attribute[op] = EOS
+
+	    if (ch == '=')
+		ip = ip + 1
+
+	    op = 1
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+	    ch = format[ip]
+	    while (ch != EOS && ch != ';' && ch != ',') {
+		if (op <= MAXCH) {
+		    value[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+		ch = format[ip]
+	    }
+	    value[op] = EOS
+
+	    if (attribute[1] == EOS || value[1] == EOS)
+		break
+
+	    # Decode the assignment and set the corresponding text attribute
+	    # in the graphics descriptor.
+
+	    switch (attribute[1]) {
+	    case 'u':				# character up vector
+		tip = 1
+		if (ctoi (value, tip, TX_UP(tx)) <= 0) {
+		    TX_UP(tx) = 90
+		    goto badformat_
+		}
+
+	    case 'p':				# path
+		temp = stridx (value[1], p_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_PATH(tx) = p_v[temp]
+
+	    case 'c':				# color
+		tip = 1
+		if (ctoi (value, tip, TX_COLOR(tx)) <= 0) {
+		    TX_COLOR(tx) = 1
+		    goto badformat_
+		}
+
+	    case 's':				# character size scale factor
+		tip = 1
+		if (ctor (value, tip, tempsize) <= 0) {
+		    TX_SIZE(tx) = GKI_PACKREAL(1.0)
+		    goto badformat_
+		} 
+		TX_SIZE(tx) = GKI_PACKREAL(tempsize)
+
+	    case 'h':				# horizontal justification
+		temp = stridx (value[1], h_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_HJUSTIFY(tx) = h_v[temp]
+
+	    case 'v':				# vertical justification
+		temp = stridx (value[1], v_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_VJUSTIFY(tx) = v_v[temp]
+
+	    case 'f':				# font
+		temp = stridx (value[1], f_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_FONT(tx) = f_v[temp]
+		
+	    case 'q':				# font quality
+		temp = stridx (value[1], q_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_QUALITY(tx) = q_v[temp]
+
+	    default:
+badformat_	call eprintf ("Warning (testtxset): bad gtext format '%s'\n")
+		    call pargstr (format)
+	    }
+
+	    if (format[ip] == EOS)
+		break
+	}
+end
diff --git a/sys/gio/calcomp/x_calcomp.x b/sys/gio/calcomp/x_calcomp.x
new file mode 100644
index 00000000..32c82aa2
--- /dev/null
+++ b/sys/gio/calcomp/x_calcomp.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	calcomp = t_calcomp
diff --git a/sys/gio/cursor/README b/sys/gio/cursor/README
new file mode 100644
index 00000000..6534b497
--- /dev/null
+++ b/sys/gio/cursor/README
@@ -0,0 +1,9 @@
+This directory contains the source for GIOTR and cursor mode, i.e., the code
+required to process the graphics output of a graphics task, spooling and/or
+applying the workstation transformation and passing the transformed metacode
+instructions on to the builtin STDGRAPH kernel or to an external kernel.  The
+procedure RCURSOR is the main entry point for cursor mode.  RCURSOR is called
+by the CL to service a query for a cursor type parameter when query mode is
+in effect.  The workstation transformation is used to zoom and pan on a frame
+buffer and consists of a viewport transformation in GKI coordinates with
+clipping at the viewport boundary.
diff --git a/sys/gio/cursor/doc/cursor.hlp b/sys/gio/cursor/doc/cursor.hlp
new file mode 100644
index 00000000..d9912607
--- /dev/null
+++ b/sys/gio/cursor/doc/cursor.hlp
@@ -0,0 +1,194 @@
+.help GIO Mar85 "Cursor Mode"
+.nh 3
+Cursor Mode
+
+    In cursor mode, i.e., after a call to \fBclgcur\fR or after typing "=gcur",
+a number of special keystrokes shall be recognized for interactive display
+control.  All graphics output to stdgraph and stdimage is routed through the
+CL on the way to the graphics kernel.  The CL will optionally spool in an
+internal buffer all graphics instructions output to an interactive device.
+This internal buffer is emptied whenever the device screen is cleared.
+In cursor mode, special keystrokes may be used to redraw all or any portion
+of the spooled graphics, e.g., one may zoom in on a portion of the plot and
+then roam about on the plot at high magnification.  Since the spooled graphics
+vectors typically contain more information than can be displayed at normal
+magnification, zooming in on a feature may bring out additional detail
+(the maximum resolution is 32768 points in either axis).  Increasing the
+magnification will increase the precision of the cursor by the same factor.
+
+Cursor mode is implemented by performing coordinate transformation and
+clipping on each GKI instruction in the frame buffer, passing the transformed
+and clipped instructions on to the graphics kernel.
+The cursor mode operations perform a simple geometric transformation on
+the spooled graphics frame, mapping a rectangular window of the spooled
+frame onto the device screen.  The graphics frame itself is not modified,
+hence zoom out or reset and redraw will restore the original display.
+
+If the graphics frame is a typical vector plot with drawn and labeled
+axes, magnifying a portion of the plot may cause the axes to be lost.
+If this is not what is desired a keystroke is provided to draw and label
+the axes of the displayed window.  The axes will be overplotted on the
+current display and will not be saved in the frame buffer, hence they
+will be lost when the frame is redrawn.  In cursor mode the viewport is
+the full display area of the output device, hence the tick mark labels
+of the drawn axes will be drawn inside the viewport.  This form of axes
+labeling is used because it is simple and because it is appropriate for
+both vector graphics and image display output devices (and cursor mode
+must serve both).
+
+The cursor mode keystrokes are all upper case letters, reserving lower case
+for applications programs.  The terminal shift lock key may be used to
+minimize typing.  The recognized cursor mode keystrokes are shown below.
+
+
+.ks
+.nf
+(*X* means not yet implemented)
+
+	?	print list of keystrokes
+       *A*	draw and label the axes of current viewport
+	C	print the cursor position as it moves
+       *D*	draw a line by marking the endpoints
+	E	expand plot by setting window corners
+	F	set fast cursor (for HJKL)
+	H	step cursor left
+	J	step cursor down
+	K	step cursor up
+	L	step cursor right
+	M	move point under cursor to center of screen
+	P	zoom out (restore previous expansion)
+       *S*	select WCS at current position of cursor
+       *T*	draw a text string
+       *U*	undo (delete) the last instruction in the frame buffer
+	V	set slow cursor (for HJKL)
+	X	zoom in, X only
+	Y	zoom in, Y only
+	Z	zoom in, both X and Y
+	<	set lower limit of plot to the cursor y value
+	>	set upper limit of plot to the cursor y value
+       *\*	escape next character
+	:	set cursor mode options
+	:!	send a command to the host system
+	0	reset and redraw
+       1-9	roam
+
+.fi
+.ce
+Figure 2. Cursor Mode Keystrokes
+.ke
+
+
+The numeric keypad of the terminal (if it has one) is used for directional
+roaming.  The directional significance of the numeric keys for roaming
+is obvious if the terminal has a keypad, and is illustrated below.
+
+
+.ks
+.nf
+	7   8   9	135 090 045
+
+	4   5   6	180 000 000
+
+	1   2   3	225 -90 -45
+.fi
+.ke
+
+
+If the character : is typed while in cursor mode the alpha cursor will appear
+at the bottom of the screen, allowing a command line to be entered.  If the
+command \fIbegins with a period it is interpreted as a cursor mode command\fR,
+otherwise the command is passed as a string to the applications program.
+Multiple commands may be entered on a line delimited by semicolons.
+The command set currently recognized is shown below.  Minimum match
+abbreviations are permitted.
+
+.ls 4
+.ls 15 help
+Print a list of the cursor mode commands.
+.le
+.ls case[+-]
+Ignore case when interpreting keystrokes.  If this option is selected the cursor
+mode keystrokes may conflict with those of the applications program.  
+.le
+.ls clear
+Clear the alpha screen (but not the graphics screen).  This is done by writing
+sufficient blank lines to scroll any text off the screen.  Does not work if
+terminal has only one memory.
+.le
+.ls markcur[+-]
+Draw a small graphics mark at the position of the cursor whenever the cursor
+is read, i.e., when cursor mode exits.  The default is to not mark.
+.le
+.ls off [keys]
+Disable all cursor mode keystrokes except : (colon).  If followed by a list
+of keys, e.g., ":.off 0-9IC", only the listed keys are disabled.
+.le
+.ls on [keys]
+Renable all cursor mode keystrokes, or just the listed keystrokes.
+.le
+.ls page[+-]
+Clear the screen when large blocks of text are to be printed, e.g., for '?',
+show, and so on.  If paging is disabled the text will overwrite the graphics
+display.
+.le
+.ls read <file>
+Load the graphics frame from the named metafile.
+The current graphics frame is discarded.
+.le
+.ls reset
+Disconnect any connected graphics kernels and free all file descriptors and
+memory used by the graphics system.  Exit cursor mode.
+.le
+.ls show
+Print the values of all cursor mode parameters, show the status of any
+connected graphics kernels, summarize memory utilization, etc.
+.le
+.ls snap [device]
+Dispose of the graphics frame to the standard plotter or to the named device.
+A magnified graph will be plotted as it appears on the screen.
+.le
+.ls txset [size] [up]
+Set the text drawing parameters (character size and character up vector).
+For example, ".tx 2 180" would set the character size to 2.0 and character
+up to 180 degrees for a vertical string drawn upwards.
+.le
+.ls write <file>
+Save the graphics frame in (or append to) the named metafile.
+If an exclamation is appended to the command (e.g., "w! file") the output
+file, if any, will be overwritten.  If a plus sign is appended the entire
+frame will be saved regardless of any plot expansion.
+.le
+.ls xres=N
+Set the (soft) device resolution in X.  A decrease in resolution will generally
+yield an increase in plotting speed.  Only plots generated on the graphics
+terminal are affected.
+.le
+.ls yres=N
+Set the (soft) device resolution in Y.
+.le
+.ls zero
+Equivalent to the numeric key 0, i.e., restore the unitary workstation
+transformation and redraw the screen.
+.le
+.le
+
+
+For example, to set the X and Y resolutions to 250 and 100, respectively,
+one could enter the following command (the computer will type the ':' at
+the bottom of the screen when the ':' key is pressed):
+
+	:.xres=250;yres=100
+
+Cursor mode may be initialized at login time by supplying a CL environment
+variable named "cminit".  For example,
+
+	cl> set cminit = off
+
+would disable cursor mode, and
+
+	cl> set cminit = "mark;case-;xres=100;yres=50"
+
+would enable marking, turn off case sensitivity, and set the plotting
+resolution to 100x50.  Initialization is performed only once, when cursor
+mode is first entered.
+.sh
diff --git a/sys/gio/cursor/doc/giotr.notes b/sys/gio/cursor/doc/giotr.notes
new file mode 100644
index 00000000..a9221445
--- /dev/null
+++ b/sys/gio/cursor/doc/giotr.notes
@@ -0,0 +1,330 @@
+.help GIO Feb85 "Graphics I/O"
+.nh
+Graphics I/O Dataflow
+
+    The GIO procedures are resident in an external applications task which
+does graphics.  GIO writes a GKI instruction stream which, if not sent directly
+to a metafile, is sent to one of the standard graphics streams STDGRAPH,
+STDIMAGE, or STDPLOT, much as output is sent to STDOUT or STDERR.
+The procedure \fBprfilbuf\fR (directory etc$), which reads the command
+stream from a subprocess, is resident in the CL and executes all pseudofile
+i/o instructions from a subprocess.  Note that \fBprfilbuf\fR is part of the
+i/o system of IRAF and operates transparently to the CL.
+
+
+.ks
+.nf
+	     GIO(task) ---ipc--> PRFILBUF(CL) --> file (or pipe)
+				     |
+				     v             external
+				   GIOTR ---ipc--> graphics
+				     |              kernel
+				     v
+			       stdgraph kernel
+				     |
+				     v
+				  (zfioty)
+			      graphics terminal
+
+
+		   task     |        cl       |     task
+.fi
+
+.ce
+Graphics Output Dataflow
+.ke
+
+
+The \fBprfilbuf\fR procedure passes record read or write requests for the
+pseudofiles STDIN, STDOUT or STDERR on to file descriptors assigned by the
+CL with the \fBprredir\fR procedure at task execution time.  The sole function
+of the CL in graphics i/o is to control the redirection of the graphics
+i/o streams with \fBprredir\fR.  The CL may redirect any of the graphics
+streams, i.e., the user may redirect any graphics stream on the command line
+when a command is entered, but by default output is directed to a filter
+resident in the CL process.  This filter is a procedure named \fBgiotr\fR.
+
+	giotr (stream, buffer, nchars)
+
+The primary function of GIOTR is to pass metacode instructions on to a kernel.
+The instruction stream is scanned and special actions are taken for some of
+the GKI control instructions.  In particular, GIOTR must spawn graphics kernel
+subprocesses upon demand.  GIOTR is also capabable of performing an
+additional transformation upon the drawing instructions before they are passed
+to the kernel.  This transformation, known as the \fBworkstation
+transformation\fR, maps a rectangular portion of the NDC space into the full
+device screen, clipping at the boundary of the viewport into NDC space.
+The workstation transformation provides a zoom and pan capability and is
+controlled interactively by the user in \fBcursor mode\fR (section 3.3).
+
+As noted earlier, the \fBstdgraph kernel\fR ("fast" kernel) is resident in
+the CL process.  This is necessary for efficiency reasons and is desirable
+in any case because the CL process owns the graphics device, i.e., the
+graphics terminal.  All devices except the user's graphics terminal are
+controlled by external graphics kernel processes.  The STDGRAPH kernel is
+itself available as an external process and may be called as such to drive
+a graphics terminal other than the user terminal (or even to drive the user
+terminal if one is willing to shuffle output back through IPC).  A graphics
+kernel may support an arbitrary number of devices, and may write to more
+than one device simultaneously.  In addition to being called by GIOTR,
+a graphics kernel may be called directly as a CL task to process metacode from
+either a file or the standard input, e.g., from a pipe.  This offers
+additional flexibility as the CL parameter mechanism may then be used to
+gain control over metacode translation.
+
+.nh 2
+Graphics Stream I/O
+
+    The functions performed by GIOTR are summarized in pseudocode below.
+GIOTR maintains a separate descriptor for each of the three graphics streams
+and is capable of servicing intermixed i/o requests for all streams
+simultaneously.  The information stored in the descriptor
+includes the workstation name, process information, WCS storage for
+the SETWCS and GETWCS instructions, the workstation transformation,
+and the frame buffer, used to spool GKI instructions for cursor mode.
+
+
+.tp 6
+.nf
+procedure giotr (fd, buffer, nchars)
+
+fd		graphics stream (STDGRAPH, etc.)
+buffer[]	buffer containing GKI metacode instructions
+nchars		number of chars to be read or written
+
+begin
+	# Note that a GKI instruction may span a buffer boundary.
+	# The code which gets the next instruction from the buffer
+	# must always return a full instruction, hence some local
+	# buffering is required therein to reconstruct instructions.
+
+	while (get next instruction != buffer empty) {
+
+	    # Handle special instructions.
+	    switch (instruction) {
+
+	    case GKI_OPENWS:
+		if (device not already open) {
+		    read graphcap entry for device
+		    get process name from graphcap entry
+		    if (process not already connected) {
+			if (some other process is connected)
+			    disconnect current kernel process
+			connect new kernel process
+		    }
+		}
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_CLOSEWS, GKI_FLUSH:
+		output instruction
+		flush output
+
+	    case GKI_CANCEL:
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_SETWCS:
+		save WCS in descriptor
+
+	    case GKI_GETWCS:
+		write saved WCS to fd
+		flush (fd)
+
+	    default:
+		append unmodified instruction to frame buffer
+		perform workstation transformation upon instruction
+		output transformed instruction
+	    }
+	}
+end
+.fi
+
+
+The action implied by "output instruction" above is the following:
+
+
+.ks
+.nf
+	if (kernel is resident in this process)
+	    call gki_execute to execute the instruction
+	else
+	    call write (process, instruction, nchars)
+.fi
+.ke
+
+
+The frame buffer (required for cursor mode) will be dynamically allocated and
+will be no larger than it has to be, but will have a fixed (user defined)
+upper limit, e.g., 128Kb.  The median size for a plot is typically 5-10Kb.
+Instructions will be silently discarded if the buffer grows too large.
+Buffering can be turned off completely if desired, and will always be turned
+off for STDPLOT.
+
+.nh 2
+Cursor Mode Details
+
+    Most of the functionality required to implement cursor mode is provided
+by GIOTR.  The primary functions of the cursor mode code are to read the
+cursor and keystroke, modify the workstation transformation, and redraw the
+contents of the frame buffer subject to the new workstation transformation.
+Cursor mode does not modify the contents of the frame buffer, except for
+possibly appending new graphics instructions to the frame buffer.
+A workstation transformation set with cursor mode remains in effect until
+the frame buffer is cleared, hence any additional graphics output from the
+task which initiated the cursor read (and cursor mode) will undergo the
+workstation transformation when drawn.
+
+
+.nf
+# PR_FILBUF -- Fill FIO buffer from an IPC channel subject to the CL/IPC
+# protocol for multiplexing pseudofile data streams with the command stream.
+# Each process has an associated set of pseudofile streams.  Each pseudofile
+# stream is connected to one, and only one, file or pseudofile of another
+# process.  I/O requests to XMIT or XFER to an ordinary file are straightforward
+# to satisfy.  An i/o request from one pseudofile to another is satisfied
+# by posting the request (pushing it on a stack) and redirecting our input
+# to the process owning the pseudofile being read or written.  Pseudofile
+# requests are then processed from the second process until a request is
+# received which satisfies the posted request from the original process.
+# When the original request is satisfied it is popped from the stack and input
+# will again be taken from the original process.  Note that we cannot write
+# directly to the output process since that would violate the IPC protocol
+# (the second process may wish to write to its stdout or stderr rather than
+# read, etc.: the process must be allowed to complete the original request
+# itself).
+#
+# Request Packet (pushed onto stack for IPC to IPC i/o).
+# 
+# 	pr		process slot number of process placing the request
+# 	iomode		request is a read or a write
+# 	count		number of chars to be transferred
+# 	ps_server	pseudofile number in server process
+# 	ps_receiver	pseudofile number in receiver process
+#
+# The request packet describes a pending pseudofile i/o request.  The named
+# pseudofile in the server process is either reading from or writing to the
+# named pseudofile in the receiver process.
+
+int procedure pr_filbuf (fd)
+
+begin
+	input = fd (the IPC input channel of a process)
+
+	repeat {
+	    get a line from the input file
+	    if (neither XMIT nor XFER directive)
+		if (request pending)
+		    error: IPC protocol corrupted
+		else
+		    return command
+
+	    if (line is an XMIT directive) {
+		if (destination is a file) {
+		    # Write from pseudofile to an ordinary file.
+		    get data record from input
+		    write data record to file
+
+		} else {
+		    # Write from pseudofile to another pseudofile.
+		    if (XMIT satisfies XFER request on top of stack)
+			get data record from input
+			write record to stacked process
+			restore input to stacked process
+			pop request from stack
+
+		    } else {
+			# If writing to local kernel GIOTR will return a null
+			# length record and we are done.
+
+			get data record from input
+			if (writing to a graphics stream)
+			    call giotr filter to transform record
+			if (anything left to output) {
+			    push request on stack
+			    switch input to IPC input of receiver process
+			}
+		    }
+		}
+
+	    } else if (line is an XFER directive) {
+		if (source is an ordinary file) {
+		    # Read from a file.
+		    read data record from file
+		    write to active process
+
+		} else if (source is another process) {
+		    # Read from another pseudofile.
+		    if (XFER satisfies XMIT request on top of stack) {
+			read record from stacked process
+			write to active process
+			restore input to stacked process
+			pop request from stack
+		    } else {
+			push request on stack
+			switch input to IPC input channel of receiver process
+		    }
+		}
+	    }
+	}
+end
+
+
+# GIOTR -- Graphics i/o filter.
+
+procedure giotr (fd, buffer, nchars)
+
+fd		graphics stream (STDGRAPH, etc.)
+buffer[]	buffer containing GKI metacode instructions
+nchars		number of chars to be read or written
+
+begin
+	# Note that a GKI instruction may span a buffer boundary.
+	# The code which gets the next instruction from the buffer
+	# must always return a full instruction, hence some local
+	# buffering is required therein to reconstruct instructions.
+
+	while (buffer not empty) {
+
+	    # Handle special instructions.
+	    switch (next_instruction) {
+
+	    case GKI_OPENWS:
+		if (device not already open) {
+		    read graphcap entry for device
+		    get process name from graphcap entry
+		    if (process not already connected) {
+			if (some other process is connected)
+			    disconnect current kernel process
+			connect new kernel process
+		    }
+		}
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_CLOSEWS, GKI_FLUSH:
+		output instruction
+		flush output
+
+	    case GKI_CANCEL:
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_SETWCS:
+		save WCS in descriptor
+
+	    case GKI_GETWCS:
+		write saved WCS to fd
+		flush (fd)
+
+	    default:
+		append unmodified instruction to frame buffer
+		perform workstation transformation upon instruction
+		output transformed instruction
+	    }
+	}
+end
diff --git a/sys/gio/cursor/giotr.x b/sys/gio/cursor/giotr.x
new file mode 100644
index 00000000..cfc8f706
--- /dev/null
+++ b/sys/gio/cursor/giotr.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<xwhen.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GIOTR -- A graphics filter, called by PR_PSIO (during normal graphics output)
+# and RCURSOR (when in cursor mode) to perform the workstation transformation
+# on a block of metacode instructions, writing the individual instructions to
+# either the inline stdgraph kernel or to an external kernel.  Input is taken
+# from the frame buffer for the stream.  All full instructions starting at the
+# input pointer IP and ending at the output pointer OP are processed, leaving
+# the input pointer positioned to BOI of the last (and incomplete) instruction
+# in the frame buffer.  If output is to an inline kernel the kernel is called
+# to execute each instruction as it is extracted.  If output is to an external
+# kernel instructions are written to the named stream, i.e., into the FIO
+# buffer associated with the stream, and later transferred to the kernel in the
+# external process when the process requests input from the named stream in an
+# XFER directive (see PR_PSIO).
+
+procedure giotr (stream)
+
+int	stream			# graphics stream
+
+pointer	tr, gki
+int	jmpbuf[LEN_JUMPBUF], fn
+int	mode, xint, status, junk, nwords
+common	/gtrvex/ jmpbuf
+
+pointer	gtr_init(), coerce()
+extern	giotr_onint(), gtr_delete()
+int	gtr_fetch_next_instruction(), locpr()
+errchk	gtr_init, gtr_fetch_next_instruction, gki_write
+data	status /OK/, xint /NULL/
+include	"gtr.com"
+
+begin
+	tr = gtr_init (stream)
+
+	# If an interrupt occurs while GIOTR is executing output is cancelled
+	# and further processing is disabled until the next frame begins.
+
+	if (xint == NULL)
+	    call xwhen (X_INT, locpr(giotr_onint), xint)
+
+	call zsvjmp (jmpbuf, status)
+	if (status != OK) {
+	    call gki_cancel (stream)
+	    call gki_deactivatews (stream, 0)
+	}
+
+	# Fetch, optionally transform, and execute each metacode instruction
+	# in the frame buffer.
+
+	while (gtr_fetch_next_instruction (tr, gki) != EOF) {
+	    switch (Mems[gki+GKI_HDR_OPCODE-1]) {
+
+	    case GKI_OPENWS:
+		mode = Mems[gki+GKI_OPENWS_M-1]
+		if (mode != APPEND)
+		    status = OK
+
+		if (status == OK) {
+		    # If the open instruction has already been passed to the
+		    # kernel by gtr_control, do not do so again here.
+
+		    if (TR_SKIPOPEN(tr) == YES)
+			TR_SKIPOPEN(tr) = NO
+		    else
+			call gki_write (stream, Mems[gki])
+
+		    # gtr_control does not call gki_escape so always do this.
+		    call gki_escape (stream, GKI_OPENWS, 0, 0)
+
+		    # Discard frame buffer contents up to and including the
+		    # openws instruction, so that it will only be executed
+		    # once.
+
+		    if (Mems[gki+GKI_OPENWS_M-1] == NEW_FILE)
+			call gtr_frame (tr, TR_IP(tr), stream)
+		}
+
+	    case GKI_CLOSEWS, GKI_DEACTIVATEWS, GKI_REACTIVATEWS:
+		# These instructions are passed directly to the kernel via
+		# the PSIOCTRL stream at runtime, but are ignored in metacode
+		# to avoid unnecessary mode switching of the terminal.
+		;
+
+	    case GKI_CANCEL:
+		# Cancel any buffered graphics data.
+		call gki_write (stream, Mems[gki])
+		call gtr_frame (tr, TR_IP(tr), stream)
+
+	    case GKI_FLUSH, GKI_GETCURSOR, GKI_GETCELLARRAY:
+		# Do not buffer these instructions.
+		call gki_write (stream, Mems[gki])
+		call gtr_delete (tr, gki)
+
+	    case GKI_CLEAR:
+		# Clear is special because it initializes things.
+		if (status != OK) {
+		    call gki_reactivatews (stream, 0)
+		    status = OK
+		}
+		# Execute the instruction.
+		call gki_write (stream, Mems[gki])
+		call gki_escape (stream, GKI_CLEAR, 0, 0)
+
+		# Discard frame buffer contents up to and including the clear.
+		call gtr_frame (tr, TR_IP(tr), stream)
+
+	    case GKI_SETWCS:
+		call gki_write (stream, Mems[gki])
+		nwords = Mems[gki+GKI_SETWCS_N-1]
+		call amovs (Mems[gki+GKI_SETWCS_WCS-1],
+		    Mems[coerce (TR_WCSPTR(tr,1), TY_STRUCT, TY_SHORT)],
+		    min (nwords, LEN_WCS * MAX_WCS * SZ_STRUCT / SZ_SHORT))
+
+	    case GKI_ESCAPE:
+		if (status == OK) {
+		    fn = Mems[gki+GKI_ESCAPE_FN-1]
+
+		    # Execute the escape instruction.
+		    if (wstranset == YES) {
+			call sge_wstran (fn, Mems[gki+GKI_ESCAPE_DC-1],
+			    vx1,vy1, vx2,vy2)
+		    } else
+			call gki_write (stream, Mems[gki])
+
+		    # Allow the kernel escape handling code to preserve,
+		    # delete, or edit the instruction.
+
+		    call sge_spoolesc (tr, gki, fn, Mems[gki+GKI_ESCAPE_DC-1],
+			TR_FRAMEBUF(tr), TR_OP(tr), locpr(gtr_delete))
+		}
+
+	    default:
+		if (status == OK)
+		    if (wstranset == YES) {
+			# Perform the workstation transformation and output the
+			# transformed instruction, if there is anything left.
+			call gtr_wstran (Mems[gki])
+		    } else
+			call gki_write (stream, Mems[gki])
+	    }
+	}
+
+	# Clear the frame buffer if spooling is disabled.  This is done by
+	# moving the upper part of the buffer to the beginning of the buffer,
+	# starting with the word pointed to by the second argument, preserving
+	# the partial instruction likely to be found at the end of the buffer.
+	# Truncate the buffer if it grows too large by the same technique of
+	# shifting data backwards, but in this case without destroying all
+	# of the data.
+
+	if (TR_SPOOLDATA(tr) == NO)
+	    call gtr_frame (tr, TR_IP(tr), stream)
+	else if (TR_OP(tr) - TR_FRAMEBUF(tr) > TR_MAXLENFRAMEBUF(tr))
+	    call gtr_truncate (tr, TR_IP(tr))
+
+	# Pop the interrupt handler.
+	if (xint != NULL) {
+	    call xwhen (X_INT, xint, junk)
+	    xint = NULL
+	}
+end
+
+
+# GIOTR_ONINT -- Interrupt handler for GIOTR.
+
+procedure giotr_onint (vex, next_handler)
+
+int	vex			# virtual exception
+int	next_handler		# next exception handler in chain
+int	jmpbuf[LEN_JUMPBUF]
+common	/gtrvex/ jmpbuf
+
+begin
+	call xer_reset()
+	call zdojmp (jmpbuf, vex)
+end
diff --git a/sys/gio/cursor/grc.h b/sys/gio/cursor/grc.h
new file mode 100644
index 00000000..35af451f
--- /dev/null
+++ b/sys/gio/cursor/grc.h
@@ -0,0 +1,20 @@
+# GRC.H -- Global definitions and data structures for the RCURSOR (cursor read)
+# procedures.
+
+define	KEYSFILE	"lib$scr/cursor.key"
+define	KEYSTROKES	"ABCDEFHJKLMPRTUVWXYZ<>0123456789:="
+define	MAX_KEYS	128
+define	LEN_RCSTRUCT	(10+(128/SZ_STRUCT))
+
+define	RC_CASE		Memi[$1]		# case sensitive
+define	RC_MARKCUR	Memi[$1+1]		# mark cursor
+define	RC_PHYSOPEN	Memi[$1+2]		# physical open by rcursor
+define	RC_AXES		Memi[$1+3]		# draw axes if screen redrawn
+			# (open)
+define	RC_KEYS		Memc[P2C($1+10)+$2]	# keystroke mappings
+
+define	LEN_CT		2,4
+define	CT_TRAN		1
+define	CT_SCALE	2
+define	CT_WORIGIN	3
+define	CT_MORIGIN	4
diff --git a/sys/gio/cursor/grcaxes.x b/sys/gio/cursor/grcaxes.x
new file mode 100644
index 00000000..f2f69e4f
--- /dev/null
+++ b/sys/gio/cursor/grcaxes.x
@@ -0,0 +1,402 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	LEN_POLYLINE	128		# polyline for axes and ticks
+define	NTICKS		6		# default rough ticks on an axis
+define	SZ_TICKFORMAT	6		# "%0.Xg"
+define	SZ_TICKLABEL	10		# encoded tick label
+define	TICKLEN		0.03		# tick length, ndc units
+define	LABELOFFSET	1.5		# offset to tick label in ticklen units
+
+
+# GRC_AXES -- Draw and label the axes of the viewport.  This is a simple
+# routine not intended to be competitive with GLABAX.  We draw a box around
+# the edge of the screen, find and label the ticks within the plotting area.
+
+procedure grc_axes (stream, sx, sy, raster, rx, ry)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+char	tickformat[SZ_TICKFORMAT], ticklabel[SZ_TICKLABEL]
+pointer tr, w, ap, save_op
+int	xt, yt, nwords, nticks, wcs, lt_save
+real	xb, xe, x1, dx, x, y, lw_save
+real	yb, ye, y1, dy, aspect_ratio, xticklen, yticklen
+
+int	gt_ndigits()
+pointer	gtr_init()
+real	ttygetr()
+
+errchk	gtr_init, ttygetr, realloc, gax_start
+include	"gtr.com"
+
+begin
+	tr = gtr_init (stream)
+
+	# Draw the axes with a solid polyline of width 2.0.
+	ap = TR_PLAP(tr)
+	lt_save = PL_LTYPE(ap);	PL_LTYPE(ap) = GL_SOLID
+	lw_save = PL_WIDTH(ap);	PL_WIDTH(ap) = 2.0
+
+	# Select a WCS.
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, x1, y1, wcs)
+	w = TR_WCSPTR(tr,wcs)
+
+	# Get the coordinates of the axes corners and the tick parameters.
+	call gax_findticks (w, xb,xe,yb,ye, x1,dx,xt, y1,dy,yt)
+
+	# Mark the position in the frame buffer.  The axes drawing instructions
+	# will be appended to the frame buffer by the drawing routines.  When
+	# we get all done we will move these instructions to the scratch buffer
+	# and reset the frame buffer pointers, since we do not want the axes
+	# to be a permanent part of the plot.
+
+	save_op = TR_OP(tr)
+
+	# Compute the X and Y tick lengths in NDC coordinates, corrected for
+	# the aspect ratio and workstation transformation.
+
+	aspect_ratio = ttygetr (TR_TTY(tr), "ar")
+	if (aspect_ratio < .001)
+	    aspect_ratio = 1.0
+	xticklen = TICKLEN / xscale * aspect_ratio
+	yticklen = TICKLEN / yscale
+
+	# Construct the polyline to draw the first two axes and ticks.  We
+	# start at the lower left and draw to the lower right then upper right.
+
+	nticks = int ((xe - xb) / dx)			# Bottom axis.
+	call gax_start (xb, yb)
+	call gax_draw (x1, yb)
+	call gax_tick (0., yticklen)
+
+	for (x=x1+dx;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (min(x,xe), yb)
+	    call gax_tick (0., yticklen)
+	    x = x + dx
+	}
+
+	nticks = int ((ye - yb) / dy)			# Right axis.
+	call gax_draw (xe, yb)
+	call gax_draw (xe, y1)
+	call gax_tick (-xticklen, 0.)
+
+	for (y=y1+dy;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (xe, min(y,ye))
+	    call gax_tick (-xticklen, 0.)
+	    y = y + dy
+	}
+
+	call gax_draw (xe, ye)
+	call gax_flush (stream)
+
+	# Construct the polyline to draw the second two axes and ticks.  We
+	# start at the lower left and draw to the upper left then upper right.
+
+	nticks = int ((ye - yb) / dy)			# Left axis.
+	call gax_start (xb, yb)
+	call gax_draw (xb, y1)
+	call gax_tick (xticklen, 0.)
+
+	for (y=y1+dy;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (xb, min(y,ye))
+	    call gax_tick (xticklen, 0.)
+	    y = y + dy
+	}
+
+	nticks = int ((xe - xb) / dx)			# Top axis.
+	call gax_draw (xb, ye)
+	call gax_draw (x1, ye)
+	call gax_tick (0., -yticklen)
+
+	for (x=x1+dx;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (min(x,xe), ye)
+	    call gax_tick (0., -yticklen)
+	    x = x + dx
+	}
+
+	call gax_draw (xe, ye)
+	call gax_flush (stream)
+
+	# Label the ticks on the bottom axis.  The tick labels are centered
+	# just above each tick.
+
+	nticks = int ((xe - xb) / dx) + 1
+	call sprintf (tickformat, SZ_TICKFORMAT, "%%0.%dg")
+	    call pargi (max (1, gt_ndigits (xb, xe, dx)) + 1)
+
+	for (x=x1;  nticks > 0;  nticks=nticks-1) {
+	    call glb_encode (x, ticklabel, SZ_TICKLABEL, tickformat, dx)
+	    call gax_ndc (x, yb, sx, sy)
+	    call gax_text (stream, sx, sy + (yticklen * LABELOFFSET),
+		ticklabel, GT_CENTER, GT_BOTTOM)
+	    x = x + dx
+	}
+
+	# Label the ticks on the left axis.  The tick labels are left justified
+	# just to the right of each tick.
+
+	nticks = int ((ye - yb) / dy) + 1
+	call sprintf (tickformat, SZ_TICKFORMAT, "%%0.%dg")
+	    call pargi (max (1, gt_ndigits (yb, ye, dy)) + 1)
+
+	for (y=y1;  nticks > 0;  nticks=nticks-1) {
+	    call glb_encode (y, ticklabel, SZ_TICKLABEL, tickformat, dy)
+	    call gax_ndc (xb, y, sx, sy)
+	    call gax_text (stream, sx + (xticklen * LABELOFFSET), sy,
+		ticklabel, GT_LEFT, GT_CENTER)
+	    y = y + dy
+	}
+
+	# Restore the default polyline attributes.
+	PL_LTYPE(ap) = lt_save
+	PL_WIDTH(ap) = lw_save
+
+	# Move the axes drawing and labelling instructions to the scratch
+	# buffer and fix up the frame buffer pointers.
+
+	nwords = TR_OP(tr) - save_op
+	if (nwords > TR_LENSCRATCHBUF(tr)) {
+	    call realloc (TR_SCRATCHBUF(tr), nwords, TY_SHORT)
+	    TR_LENSCRATCHBUF(tr) = nwords
+	}
+
+	call amovs (Mems[save_op], Mems[TR_SCRATCHBUF(tr)], nwords)
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr) + nwords
+	TR_OP(tr) = save_op
+	TR_IP(tr) = save_op
+	TR_LASTOP(tr) = save_op
+end
+
+
+# GAX_FINDTICKS -- Get the coordinates of the endpoints of the axes, the first
+# tick on each axis, and the tick spacing on each axis.  If log scaling is in
+# use on an axis we shall work in log coordinate units, which are linear.
+
+procedure gax_findticks (w, wx1,wx2,wy1,wy2, x1,dx,xt, y1,dy,yt)
+
+pointer	w			# window descriptor
+real	wx1,wx2,wy1,wy2		# endpoints of axes
+real	x1,dx			# tick start and spacing in X
+int	xt			# type of scaling in X
+real	y1,dy			# tick start and spacing in Y
+int	yt			# type of scaling in Y
+
+pointer	wp
+real	ct[LEN_CT]
+common	/ftkgcm/ wp, ct
+
+real	sx1, sx2, sy1, sy2
+real	elogr()
+
+begin
+	wp = w
+
+	# Set up WCS/NDC coordinate transformations.
+	call grc_settran (w, ct)
+
+	# Get NDC coords of the corners of the screen.
+	call grc_scrtondc (0.001, 0.001, sx1, sy1)
+	call grc_scrtondc (0.999, 0.999, sx2, sy2)
+
+	# Move in a bit if the graphics viewport lies within the screen area.
+	# This depends upon the workstation transformation, of course.
+	sx1 = max (WCS_SX1(w), sx1)
+	sx2 = min (WCS_SX2(w), sx2)
+	sy1 = max (WCS_SY1(w), sy1)
+	sy2 = min (WCS_SY2(w), sy2)
+
+	# Compute world coordinates of the viewport (of the axes to be drawn).
+	call grc_ndctowcs (ct, sx1, sy1, wx1, wy1)
+	call grc_ndctowcs (ct, sx2, sy2, wx2, wy2)
+
+	# Find the ticks.  If log scaling is in use on an axis we shall find
+	# and draw the ticks in log coordinates.
+
+	switch (WCS_XTRAN(w)) {
+	case GW_LOG:
+	    wx1 = log10 (wx1)
+	    wx2 = log10 (wx2)
+	case GW_ELOG:
+	    wx1 = elogr (wx1)
+	    wx2 = elogr (wx2)
+	}
+	call gtickr (wx1, wx2, NTICKS, NO, x1, dx)
+
+	switch (WCS_YTRAN(w)) {
+	case GW_LOG:
+	    wy1 = log10 (wy1)
+	    wy2 = log10 (wy2)
+	case GW_ELOG:
+	    wy1 = elogr (wy1)
+	    wy2 = elogr (wy2)
+	}
+	call gtickr (wy1, wy2, NTICKS, NO, y1, dy)
+
+	xt = WCS_XTRAN(w)
+	yt = WCS_YTRAN(w)
+end
+
+
+# GAX_NDC -- Convert a pair of world or log-world coordinates to NDC
+# coordinates.  GAX_FINDTICKS must be called first to set up transformation.
+
+procedure gax_ndc (wx, wy, sx, sy)
+
+real	wx, wy			# world coords (input)
+real	sx, sy			# ndc coords (output)
+
+pointer	wp
+real	ct[LEN_CT]
+common	/ftkgcm/ wp, ct
+
+real	x, y
+real	aelogr()
+
+begin
+	# Get X in world coordinates.
+	switch (WCS_XTRAN(wp)) {
+	case GW_LOG:
+	    x = 10.0 ** wx
+	case GW_ELOG:
+	    x = aelogr (wx)
+	default:
+	    x = wx
+	}
+
+	# Get Y in world coordinates.
+	switch (WCS_YTRAN(wp)) {
+	case GW_LOG:
+	    y = 10.0 ** wy
+	case GW_ELOG:
+	    y = aelogr (wy)
+	default:
+	    y = wy
+	}
+
+	# Transform to NDC coordinates and return.
+	call grc_wcstondc (ct, x, y, sx, sy)
+end
+
+
+# GAX_DRAW -- Add a point to the output polyline for an axis.  The polyline
+# is built up in NDC coordinates for output to GTR_POLYLINE.  In addition to
+# the draw routine, entry points are provided for start, flush, and tick
+# drawing.
+
+procedure gax_draw (wx, wy)
+
+real	wx, wy			# world or log-world coords to draw to
+real	sx, sy
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	# Transform to NDC coords and add the point to the polyline.
+	call gax_ndc (wx, wy, sx, sy)
+	Memr[op] = sx
+	op = op + 1
+	Memr[op] = sy
+	op = op + 1
+end
+
+
+# GAX_TICK -- Draw a tick at the current position.  The offsets to draw the
+# tick are given in NDC coordinates.
+
+procedure gax_tick (dx, dy)
+
+real	dx, dy			# tick offset in NDC coords for gax_tick
+real	x, y
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	x = Memr[op-2]
+	y = Memr[op-1]
+
+	Memr[op] = x + dx
+	op = op + 1
+	Memr[op] = y + dy
+	op = op + 1
+
+	Memr[op] = x
+	op = op + 1
+	Memr[op] = y
+	op = op + 1
+end
+
+
+# GAX_START -- Start a new polyline at the indicated point in world coords.
+# The polyline buffer is of a fixed length with no bounds checking.
+
+procedure gax_start (wx, wy)
+
+real	wx, wy			# world or log-world coords to draw to
+pointer	polyline, op
+
+errchk	malloc
+common	/gaxdcm/ polyline, op
+
+begin
+	call malloc (polyline, LEN_POLYLINE, TY_REAL)
+	op = polyline
+	call gax_draw (wx, wy)
+end
+
+
+# GAX_FLUSH -- Flush the buffered polyline and free space on the heap.
+
+procedure gax_flush (stream)
+
+int	stream			# graphics stream
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	call grc_polyline (stream, Memr[polyline], (op - polyline) / 2)
+	call mfree (polyline, TY_REAL)
+end
+
+
+# GAX_TEXT -- Draw a text string (tick label) of size 1.0 with the indicated
+# justification.
+
+procedure gax_text (stream, sx, sy, text, hjustify, vjustify)
+
+int	stream			# graphics stream
+real	sx, sy			# text coordinates, NDC
+char	text[ARB]		# text string to be drawn
+int	hjustify		# horizontal justification
+int	vjustify		# vertical justification
+
+pointer	tr, tx
+int	save_tx[LEN_TX]
+errchk	gtr_init
+pointer	gtr_init()
+
+begin
+	tr = gtr_init (stream)
+	tx = TR_TXAP(tr)
+	call amovi (Memi[tx], save_tx, LEN_TX)
+
+	TX_UP(tx) = 90
+	TX_SIZE(tx) = 1.0
+	TX_PATH(tx) = GT_RIGHT
+	TX_SPACING(tx) = 0
+	TX_HJUSTIFY(tx) = hjustify
+	TX_VJUSTIFY(tx) = vjustify
+	TX_FONT(tx) = GT_BOLD
+	TX_QUALITY(tx) = GT_NORMAL
+	TX_COLOR(tx) = 1
+
+	call grc_text (stream, sx, sy, text)
+	call amovi (save_tx, Memi[tx], LEN_TX)
+end
diff --git a/sys/gio/cursor/grcclose.x b/sys/gio/cursor/grcclose.x
new file mode 100644
index 00000000..304a0904
--- /dev/null
+++ b/sys/gio/cursor/grcclose.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_CLOSE -- Close the workstation (kernel).  Called by RCURSOR to close the
+# kernel after a cursor read.  Note that a cursor read may occur while the
+# workstation is open, i.e., after gopen but before gclose, or after the
+# workstation has been closed, i.e., after a plotting program terminates.
+# If the workstation was already open (GKI_OPENWS) by the application when
+# the cursor read occurred we must leave things as they were.
+
+procedure grc_close (fd, rc)
+
+int	fd			# graphics stream
+pointer	rc			# rcursor descriptor
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (fd)
+
+	# Decrement the logical OPENWS count and issue the actual CLOSEWS
+	# only if the counter goes to zero.  If the workstation was open
+	# but deactivated when grc_open() was called (WS_ACTIVE == NO),
+	# restore it to its former (deactivated) state.
+
+	TR_WSOPEN(tr) = TR_WSOPEN(tr) - 1
+	if (TR_WSOPEN(tr) <= 0) {
+	    call gki_closews (fd, TR_DEVNAME(tr))
+	    TR_WSOPEN(tr) = 0
+	    TR_WSACTIVE(tr) = NO
+	} else if (TR_WSACTSAVE(tr) == NO) {
+	    call gki_deactivatews (fd, 0)
+	    TR_WSACTIVE(tr) = NO
+	}
+
+	call gki_fflush (fd)
+end
diff --git a/sys/gio/cursor/grccmd.x b/sys/gio/cursor/grccmd.x
new file mode 100644
index 00000000..5aca0f84
--- /dev/null
+++ b/sys/gio/cursor/grccmd.x
@@ -0,0 +1,533 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	MAX_KWLEN	10
+
+# Assign opcodes to the recognized keywords.
+
+define	KW_AXES		1
+define	KW_CASE		2
+define	KW_CLEAR	3
+define	KW_CURSOR	4
+define	KW_GFLUSH	5
+define	KW_HELP		6
+define	KW_INIT		7
+define	KW_MARKCUR	8
+define	KW_OFF		9
+define	KW_ON		10
+define	KW_PAGE		11
+define	KW_READ		12
+define	KW_SHOW		13
+define	KW_SNAP		14
+define	KW_TXQUALITY	15
+define	KW_TXSET	16
+define	KW_VIEWPORT	17
+define	KW_WRITE	18
+define	KW_XRES		19
+define	KW_YRES		20
+define	KW_ZERO		21
+
+
+# GRC_COMMAND -- Process a ":." cursor mode option string.  The RC structure
+# contains the current values of the cursor mode options.  Some option strings
+# are commands that do something, others set options, and still others show
+# the status of the program.
+
+int procedure grc_command (rc, stream, sx, sy, raster, rx, ry, opstr)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+char	opstr[ARB]		#I options string excluding the leading ":.".
+
+pointer	tr, p_tr, sp, fname, lbuf, tty
+bool	clobber, fullframe, auto_gflush
+int	ip, op, ch, opcode, cursor
+int	save1, save2, i, xres, yres, quality
+char	kwname[MAX_KWLEN]
+
+pointer	gtr_init(), grc_open(), ttyodes()
+int	strdic(), grc_boolval(), ttygeti(), ttystati()
+real	grc_realval()
+string	keywords "|axes|case|clear|cursor|gflush|help|init|markcur|off|on|page|\
+read|show|snap|txquality|txset|viewport|write|xres|yres|zero|"
+errchk	gtr_redraw, gki_flush, gtr_init
+define	exit_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# The terminal is left in graphics mode when the user types return to
+	# enter the command.  Echo the user command to the terminal without
+	# the newline to leave the terminal in status line mode, so that any
+	# output directly to the terminal from the lower level code in the CL
+	# goes into the status line.
+
+	call strcpy (":.", Memc[lbuf], SZ_LINE)
+	op = lbuf + 2
+	for (ip=1;  opstr[ip] != EOS && opstr[ip] != '\n';  ip=ip+1) {
+	    Memc[op] = opstr[ip]
+	    op = op + 1
+	}
+	Memc[op] = EOS
+	call stg_putline (STDERR, Memc[lbuf])
+
+	tr = gtr_init (stream)
+	ip = 1
+
+	while (ip == 1 || opstr[ip] != EOS) {
+	    while (IS_WHITE(opstr[ip]))
+		ip = ip + 1
+
+	    # If EOS and not first command, all done.  If first command do
+	    # not quit, rather assume ":.help" (see below).
+
+	    if (ip > 1 && opstr[ip] == EOS)
+		break
+
+	    # Extract the keyword into the KWNAME buffer.  Leave the input
+	    # pointer positioned to the first char following the keyword.
+
+	    for (op=1;  opstr[ip] != EOS;  ip=ip+1) {
+		ch = opstr[ip]
+		if (IS_ALNUM(ch)) {
+		    kwname[op] = ch
+		    op = op + 1
+		} else
+		    break
+	    }
+	    kwname[op] = EOS
+
+	    # Look up the keyword in the dictionary.  If not found ring the bell
+	    # but do not return EOF (do not quit cursor mode).
+
+	    if (op == 1)
+		opcode = KW_HELP
+	    else {
+		opcode = strdic (kwname, kwname, MAX_KWLEN, keywords)
+		if (opcode <= 0) {
+		    call fprintf (STDERR, "\7")
+		    goto exit_
+		}
+	    }
+
+	    # Process the command.
+
+	    switch (opcode) {
+	    case KW_AXES:
+		# Set flag to draw axes of viewport when screen readrawn.
+		RC_AXES(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CASE:
+		# Enable/disable case sensitivity.
+		RC_CASE(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CLEAR:
+		# Clear the alpha screen.
+		iferr (tty = ttyodes ("terminal"))
+		    call grc_warn (STDERR)
+		else {
+		    do i = 1, ttystati (tty, TTY_NLINES) {
+			call ttygoto (STDOUT, tty, 1, i)
+			call ttyclearln (STDOUT, tty)
+		    }
+		    call flush (STDOUT)
+		    call ttycdes (tty)
+		}
+
+	    case KW_CURSOR:
+		# Select the cursor to be referenced in all subsequent reads
+		# and writes.
+
+		ip = ip + 1
+		cursor = max (0, nint (grc_realval (opstr, ip)))
+		call stg_lockcursor (cursor)
+
+	    case KW_GFLUSH:
+		# Flush any buffered graphics output (dispose of spooled
+		# plotter output).
+
+		call stg_putline (STDERR, " - ")
+		call gtr_gflush (STDPLOT)
+
+	    case KW_HELP:
+		# Print help text for cursor mode.
+		call gtr_page (STDERR, stream)
+		iferr (call pagefile (KEYSFILE, "cursor mode help"))
+		    call grc_warn (STDERR)
+		ip = ip + 1
+
+	    case KW_INIT:
+		# Disconnect all kernels and free memory.  Exits cursor mode
+		# with an EOF.
+
+		call stg_putline (STDERR, " - ")
+		call gtr_reset (OK)
+		call sfree (sp)
+		return (EOF)
+
+	    case KW_MARKCUR:
+		# Enable marking of the cursor position when the cursor is read.
+		RC_MARKCUR(rc) = grc_boolval (opstr, ip)
+
+	    case KW_OFF:
+		# Disable the listed keys.
+		call grc_keys (rc, opstr, ip, 0)
+
+	    case KW_ON:
+		# Enable or set the listed keys.
+		call grc_keys (rc, opstr, ip, 1)
+
+	    case KW_PAGE:
+		# Enable screen clear when ?, show, etc. print text.
+		TR_PAGE(tr) = grc_boolval (opstr, ip)
+
+	    case KW_READ:
+		# Fill the frame buffer from a metacode spool file.
+
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		call grc_read (tr, stream, Memc[fname])
+
+	    case KW_SHOW:
+		# Show status of RCURSOR and GIOTR.
+
+		call gtr_page (STDERR, stream)
+		call fprintf (STDERR, "Cursor Mode Parameters:\n\n")
+		call grc_status (STDERR, rc)
+
+		call fprintf (STDERR, "\n\nGraphics Kernel Status:\n\n")
+		call gtr_status (STDERR)
+
+	    case KW_SNAP:
+		# Write a snapshot of the screen to a plotter.  Open a subkernel
+		# on STDPLOT, redraw the screen into the STDPLOT fio buffer,
+		# flush the buffered metacode to the kernel, then restore
+		# everything.  NOTE: should restore things automatically if an
+		# interrupt occurs.
+
+		call stg_putline (STDERR, " - ")
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		iferr (p_tr = grc_open (Memc[fname], NEW_FILE, STDPLOT, rc)) {
+		    call grc_warn (STDERR)
+		    goto exit_
+		}
+
+		call gki_redir (stream, STDPLOT, save1, save2)
+		call fseti (STDPLOT, F_CANCEL, OK)
+
+		iferr {
+		    call gtr_redraw (stream)
+		    call gki_flush (STDPLOT)
+		} then
+		    call grc_warn (STDERR)
+
+		call gki_redir (stream, 0, save1, save2)
+
+		auto_gflush = (ttygeti (TR_TTY(p_tr), "MF") <= 1)
+		call grc_close (STDPLOT, rc)
+
+		if (auto_gflush)
+		    call gtr_gflush (STDPLOT)
+
+		call stg_putline (STDERR, " done")
+
+	    case KW_VIEWPORT:
+		# Set the viewport in world coordinates.
+		call grc_viewport (tr, stream,
+		    sx, sy, raster, rx, ry, opstr, ip)
+
+	    case KW_WRITE:
+		# Save the contents of the frame buffer in a file.
+		# "w!" clobbers any existing file and "w+" writes the
+		# full frame.  By default the frame is appended to the
+		# output file.
+
+		if (opstr[ip] == '!') {
+		    clobber = true
+		    ip = ip + 1
+		} else
+		    clobber = false
+
+		if (opstr[ip] == '+') {
+		    fullframe = true
+		    ip = ip + 1
+		} else
+		    fullframe = false
+
+		# Extract the filename.
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+
+		# Write to the spoolfile.
+		call grc_write (tr, stream, Memc[fname], clobber, fullframe)
+
+	    case KW_XRES:
+		# Set the stdgraph X resolution.
+		xres = nint (grc_realval (opstr, ip))
+		yres = 0
+		call stg_resolution (xres, yres)
+
+	    case KW_YRES:
+		# Set the stdgraph Y resolution.
+		xres = 0
+		yres = nint (grc_realval (opstr, ip))
+		call stg_resolution (xres, yres)
+
+	    case KW_TXQUALITY:
+		# Set character generator quality.
+
+		while (IS_WHITE(opstr[ip]))
+		    ip = ip + 1
+
+		switch (opstr[ip]) {
+		case 'l':
+		    quality = GT_LOW
+		case 'm':
+		    quality = GT_MEDIUM
+		case 'h':
+		    quality = GT_HIGH
+		default:
+		    quality = 0
+		}
+		call stg_txquality (quality)
+
+	    case KW_TXSET:
+		# Set the text drawing attributes.
+		call gtxset (TR_TXAP(tr), opstr, ip)
+
+	    case KW_ZERO:
+		# Reset and redraw.
+		call gtr_ptran (stream, 0., 1., 0., 1.)
+		call gtr_writecursor (stream, .5, .5)
+		call gtr_redraw (stream)
+	    }
+
+	    # Advance to the next statement or the end of string.  Any unused
+	    # characters in the statement just processed are discarded.
+
+	    while (opstr[ip] != ';' && opstr[ip] != EOS)
+		ip = ip + 1
+	    while (opstr[ip] == ';' || opstr[ip] == '.')
+		ip = ip + 1
+	}
+exit_
+	# Restore the terminal to graphics mode if gtr_page was not called to
+	# deactivate the ws. (this leaves the waitpage flag set).
+
+	if (TR_WAITPAGE(tr) == NO)
+	    call stg_putline (STDERR, "\n")
+
+	# Leave the graphics descriptor set up as we found it.
+	tr = gtr_init (stream)
+
+	call flush (STDERR)
+	call sfree (sp)
+	return (OK)
+end
+
+
+# GRC_WORD -- Extract the next whitespace delimited word from the command line.
+
+procedure grc_word (opstr, ip, outstr, maxch)
+
+char	opstr[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+int	op
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	op = 1
+	while (!IS_WHITE (opstr[ip]) && opstr[ip] != EOS) {
+	    outstr[op] = opstr[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+
+	outstr[op] = EOS
+end
+
+
+# GRC_BOOL -- Get the boolean value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+
+int procedure grc_boolval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+int	value
+int	btoi()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (opstr[ip] == '=') {
+	    ip = ip + 1
+	    while (IS_WHITE (opstr[ip]))
+		ip = ip + 1
+	    value = btoi (opstr[ip] != 'n' && opstr[ip] != 'N')
+	    while (IS_ALPHA (opstr[ip]))
+		ip = ip + 1
+	} else
+	    value = btoi (opstr[ip] != '-')
+
+	return (value)
+end
+
+
+# GRC_REALVAL -- Get the real value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+# Zero is returned if no value is given.
+
+real procedure grc_realval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+real	value
+int	ctor()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+	if (opstr[ip] == '=')
+	    ip = ip + 1
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (ctor (opstr, ip, value) <= 0)
+	    value = 0
+
+	return (value)
+end
+
+
+# GRC_KEYS -- Enable the listed keys or ranges of keys.  The operation is
+# additive, i.e., only the named keys are affected.
+
+procedure grc_keys (rc, opstr, ip, onoff)
+
+pointer	rc			# rcursor descriptor
+char	opstr[ARB]		# command string
+int	ip			# next char in opstr
+int	onoff			# set keys on (1) or off (0)
+
+int	new_value
+int	ch, ch1, ch2, ip_start, i
+string	keys KEYSTROKES
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	ip_start = ip
+	for (ch=opstr[ip];  ch != EOS;  ch=opstr[ip]) {
+	    if (ch == ';' || ch == '\n' || IS_WHITE(ch))
+		break
+
+	    ch1 = ch
+	    if (opstr[ip+1] == '-' && opstr[ip+2] != EOS) {
+		# Enable a range of keys.
+		ip  = ip + 2
+		ch2 = opstr[ip]
+	    } else if (opstr[ip+1] == '=' && opstr[ip+2] != EOS) {
+		# Assign the value of a key.
+		ip = ip + 3
+		RC_KEYS(rc,ch) = opstr[ip]
+		next
+	    } else
+		ch2 = ch
+
+	    for (ch=ch1;  ch <= ch2;  ch=ch+1) {
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+
+	    ip = ip + 1
+	}
+
+	# If no keys were listed, set all cursor mode keys.
+	if (ip == ip_start)
+	    for (i=1;  keys[i] != EOS;  i=i+1) {
+		ch = keys[i]
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+		
+	# The ":" key cannot be mapped or disabled.
+	RC_KEYS(rc,':') = ':'
+end
+
+
+# GRC_VIEWPORT -- Set the viewport in world coordinates.  Use the current
+# cursor position to determine the WCS, then convert the world coordinates
+# of the viewport given by the user into NDC coordinates and set the work-
+# station transformation.
+
+procedure grc_viewport (tr, stream, sx, sy, raster, rx, ry, opstr, ip)
+
+pointer	tr			#I giotr descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coordinates of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coordinates of cursor
+char	opstr[ARB]		#I command string
+int	ip			#I input pointer
+
+pointer	w
+int	i, wcs
+real	wx, wy, value
+real	vn[4], vw[4], ct[LEN_CT]
+int	ctor()
+
+begin
+	# Select a WCS.  We are not otherwise interested in the cursor value.
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+	w = TR_WCSPTR(tr,wcs)
+	call grc_settran (w, ct)
+
+	# Start with the current viewport.
+	call gtr_gtran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Transform to world coordinates.
+	call grc_ndctowcs (ct, vn[1], vn[3], vw[1], vw[3])
+	call grc_ndctowcs (ct, vn[2], vn[4], vw[2], vw[4])
+
+	# Get the new viewport (world) coordinates.
+	do i = 1, 4
+	    if (ctor (opstr, ip, value) <= 0)
+		break
+	    else
+		vw[i] = value
+
+	# Transform to NDC coordinates.
+	call grc_wcstondc (ct, vw[1], vw[3], vn[1], vn[3])
+	call grc_wcstondc (ct, vw[2], vw[4], vn[2], vn[4])
+
+	# Set the new workstation transformation.
+	call gtr_ptran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Redraw the screen.
+	call gtr_redraw (stream)
+end
diff --git a/sys/gio/cursor/grcinit.x b/sys/gio/cursor/grcinit.x
new file mode 100644
index 00000000..3160203c
--- /dev/null
+++ b/sys/gio/cursor/grcinit.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"grc.h"
+
+# GRC_INIT -- Initialize the rcursor descriptor.  Allocate storage for the
+# descriptor and initialize all variables and the keystroke mapping.
+
+procedure grc_init (rc)
+
+pointer	rc			#U grc descriptor (pointer)
+
+int	ip, ch
+string	keys KEYSTROKES
+errchk	malloc
+
+begin
+	if (rc == NULL)
+	    call malloc (rc, LEN_RCSTRUCT, TY_STRUCT)
+	call aclri (Memi[rc], LEN_RCSTRUCT)
+
+	# Initialize variables.
+	RC_CASE(rc) = YES
+	RC_MARKCUR(rc) = NO
+	RC_PHYSOPEN(rc) = NO
+
+	# Initialize keystrokes.
+	for (ip=1;  keys[ip] != EOS;  ip=ip+1) {
+	    ch = keys[ip]
+	    RC_KEYS(rc,keys[ip]) = ch
+	}
+end
diff --git a/sys/gio/cursor/grcopen.x b/sys/gio/cursor/grcopen.x
new file mode 100644
index 00000000..8a39d191
--- /dev/null
+++ b/sys/gio/cursor/grcopen.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_OPEN -- Open the workstation.  Most commonly used to reopen the
+# workstation for a cursor read after plotting.
+
+pointer procedure grc_open (device, mode, stream, rc)
+
+char	device[ARB]		# device name (optional)
+int	mode			# desired access mode
+int	stream			# graphics stream
+pointer	rc			# rcursor descriptor
+
+pointer	sp, devname, envvar, tr
+int	envgets()
+bool	streq()
+pointer	gtr_init()
+
+include	"gtr.com"
+string	stdgraph "stdgraph"
+string	stdimage "stdimage"
+string	stdplot  "stdplot"
+errchk	syserrs, gtr_openws, gki_openws, gtr_init
+
+begin
+	call smark (sp)
+	call salloc (envvar,  SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	tr = gtr_init (stream)
+
+	# If the workstation is already connected and the kernel is open
+	# issue the openws directive if it has not already been issued.
+
+	if (TR_DEVNAME(tr) != EOS)
+	    if (device[1] == EOS || streq (device, TR_DEVNAME(tr))) {
+		# Kernel is already physically open on this stream.  Activate
+		# it if necessary; record whether or not is was active when
+		# we were called, so that we can restore the original state
+		# when grc_close() is called.
+
+		if (TR_WSOPEN(tr) <= 0) {
+		    call gki_openws (stream, TR_DEVNAME(tr), mode)
+		    TR_WSACTIVE(tr) = YES
+		    TR_WSACTSAVE(tr) = NO
+		} else {
+		    TR_WSACTSAVE(tr) = TR_WSACTIVE(tr)
+		    call gki_reactivatews (stream, 0)
+		    TR_WSACTIVE(tr) = YES
+		}
+
+		call gki_fflush (stream)
+
+		TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+		call sfree (sp)
+		return (tr)
+	    }
+
+	# If no device name given fetch the device name from the environment.
+
+	if (device[1] == EOS) {
+	    switch (stream) {
+	    case STDGRAPH:
+		call strcpy (stdgraph, Memc[envvar], SZ_FNAME)
+	    case STDIMAGE:
+		call strcpy (stdimage, Memc[envvar], SZ_FNAME)
+	    default:
+		call strcpy (stdplot,  Memc[envvar], SZ_FNAME)
+	    }
+
+	    # Convert environment variable name into device name.  Indirection
+	    # and assumption of the value of "terminal" are allowed.
+
+	    repeat {
+		if (envgets (Memc[envvar], Memc[devname], SZ_FNAME) <= 0)
+		    call syserrs (SYS_ENVNF, Memc[envvar])
+		if (Memc[devname] == '@') {
+		    # Indirection in environment variable name.
+		    call strcpy (Memc[devname+1], Memc[envvar], SZ_FNAME)
+		} else if (streq (Memc[devname], "terminal")) {
+		    call strcpy (Memc[devname], Memc[envvar], SZ_FNAME)
+		} else
+		    break
+	    }
+	} else
+	    call strcpy (device, Memc[devname], SZ_FNAME)
+
+	# Open the workstation (kernel) on stream FD.
+	call gtr_openws (Memc[devname], mode, stream, NULL)
+
+	TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+	TR_WSACTSAVE(tr) = NO
+	TR_WSACTIVE(tr) = YES
+
+	call gki_openws (stream, Memc[devname], mode)
+	call gki_fflush (stream)
+
+	call sfree (sp)
+	return (tr)
+end
diff --git a/sys/gio/cursor/grcpl.x b/sys/gio/cursor/grcpl.x
new file mode 100644
index 00000000..7768bf85
--- /dev/null
+++ b/sys/gio/cursor/grcpl.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include "grc.h"
+
+# GRC_POLYLINE -- Draw a solid polyline.  The instruction is encoded and
+# appended to the frame buffer and GIOTR is called to draw the line,
+# possibly applying the workstation transformation in the process.
+
+procedure grc_polyline (stream, v, npts)
+
+int	stream			# graphics stream
+real	v[ARB]			# polyline, NDC units
+int	npts			# number of points (coord pairs) in polyline
+
+pointer	tr, sp, p, pl, op, last_op
+int	nwords, fd, save1, save2, i
+int	stropen()
+pointer	gtr_init(), gtr_writep()
+errchk	gtr_init, gtr_writep, gki_redir
+
+begin
+	call smark (sp)
+	call salloc (p, npts * 2, TY_SHORT)
+
+	tr = gtr_init (stream)
+
+	# Transform the type real, NDC polyline to GKI units, type short.
+	do i = 1, npts * 2, 2 {
+	    Mems[p+i-1] = v[i  ] * GKI_MAXNDC
+	    Mems[p+i  ] = v[i+1] * GKI_MAXNDC
+	}
+
+	# Allocate space in the frame buffer for the polyline set attribute
+	# and line drawing instructions.  Set the last op for undo to undo
+	# the line.  This is also set by writep, hence we must wait to set
+	# TR_LASTOP until after the call to writep.
+
+	last_op = TR_OP(tr)
+	nwords = GKI_PLSET_LEN + GKI_POLYLINE_LEN + (npts * 2)
+	op = gtr_writep (stream, nwords)
+	TR_LASTOP(tr) = last_op
+
+	# Open the frame buffer as a file and redirect the graphics stream
+	# output into the buffer.
+
+	fd = stropen (Mems[op], nwords, NEW_FILE) 
+	call gki_redir (stream, fd, save1, save2)
+
+	# Output a polyline set attribute instruction to ensure that a solid
+	# line is drawn.  Output the polyline.
+
+	pl = TR_PLAP(tr)
+	call gki_plset (stream, pl)
+	call gki_polyline (stream, Mems[p], npts)
+
+	# Restore the normal output for the stream.
+	call gki_redir (stream, 0, save1, save2)
+	call close (fd)
+
+	# Call giotr to send the new instructions off the to the kernel,
+	# optionally applying the workstation transformation in the process.
+
+	call giotr (stream)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcread.x b/sys/gio/cursor/grcread.x
new file mode 100644
index 00000000..ce95fc07
--- /dev/null
+++ b/sys/gio/cursor/grcread.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GRC_READ -- Fill the frame buffer from a metacode spool file and redraw
+# the screen.  The contents of the frame buffer are overwritten.
+
+procedure grc_read (tr, stream, fname)
+
+pointer	tr			# graphics descriptor
+int	stream			# graphics stream
+char	fname[ARB]		# metacode file
+
+pointer	sp, lbuf, op
+int 	fd, nchars, filelen
+long	fstatl()
+pointer	gtr_writep()
+int	open(), read()
+errchk	read
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	iferr (fd = open (fname, READ_ONLY, BINARY_FILE)) {
+	    call grc_message (stream, " - cannot open file")
+	    call sfree (sp)
+	    return
+	}
+
+	filelen = fstatl (fd, F_FILESIZE)
+	call sprintf (Memc[lbuf], SZ_LINE, " - file size %d chars")
+	    call pargi (filelen)
+	call grc_message (stream, Memc[lbuf])
+
+	# Discard the current frame.
+	call gtr_frame (tr, TR_FRAMEBUF(tr), stream)
+
+	# Read new frame buffer.
+	nchars = filelen
+	if (nchars <= 0)
+	    goto err_
+	op = gtr_writep (stream, nchars)
+	if (read (fd, Mems[op], nchars) < nchars)
+	    goto err_
+
+	# Redraw the new frame buffer.
+	call gtr_redraw (stream)
+
+	call close (fd)
+	call sfree (sp)
+	return
+err_
+	call close (fd)
+	call grc_message (stream, " [READ ERROR]")
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcredraw.x b/sys/gio/cursor/grcredraw.x
new file mode 100644
index 00000000..4317db96
--- /dev/null
+++ b/sys/gio/cursor/grcredraw.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"grc.h"
+
+# GRC_REDRAW -- Redraw the screen, and, if the "axes" flag is set, draw the axes
+# of the plot.
+
+procedure grc_redraw (rc, stream, sx, sy, raster, rx, ry)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+begin
+	call gtr_redraw (stream)
+	if (RC_AXES(rc) == YES)
+	    call grc_axes (stream, sx, sy, raster, rx, ry)
+end
diff --git a/sys/gio/cursor/grcscr.x b/sys/gio/cursor/grcscr.x
new file mode 100644
index 00000000..add322b4
--- /dev/null
+++ b/sys/gio/cursor/grcscr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GRC_SCRTONDC -- Coordinate transformation from screen coordinates to NDC
+# coordinates.  Screen coordinates physically address the device screen and
+# range from 0 to 1 in either axis.  NDC coordinates also range from 0 to 1
+# in either axis but differ from screen coordinates when the workstation
+# transformation is non unitary.  The workstation transformation parameters
+# are cached in the GTR common.  We assume that GTR_INIT has already been
+# called to initialize the common for a graphics stream.
+
+procedure grc_scrtondc (sx, sy, mx, my)
+
+real	sx, sy			# screen coordinates (input)
+real	mx, my			# NDC coordinates (output)
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    mx = ((sx * GKI_MAXNDC - xorigin) / xscale + mx1) / GKI_MAXNDC
+	    my = ((sy * GKI_MAXNDC - yorigin) / yscale + my1) / GKI_MAXNDC
+	} else {
+	    mx = sx
+	    my = sy
+	}
+end
+ 
+
+# GRC_NDCTOSCR -- Coordinate transformation from NDC coordinates to screen
+# coordinates.
+
+procedure grc_ndctoscr (mx, my, sx, sy)
+
+real	mx, my			# NDC coordinates (input)
+real	sx, sy			# screen coordinates (output)
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    sx = ((mx * GKI_MAXNDC - mx1) * xscale + xorigin) / GKI_MAXNDC
+	    sy = ((my * GKI_MAXNDC - my1) * yscale + yorigin) / GKI_MAXNDC
+	} else {
+	    sx = mx
+	    sy = my
+	}
+end
diff --git a/sys/gio/cursor/grcstatus.x b/sys/gio/cursor/grcstatus.x
new file mode 100644
index 00000000..55f44f18
--- /dev/null
+++ b/sys/gio/cursor/grcstatus.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_STATUS -- Called by ":.show" to print the values of the cursor mode
+# parameters.
+
+procedure grc_status (fd, rc)
+
+int	fd			# output file
+pointer	rc			# rcursor descriptor
+
+int	ip, ch
+string	keys KEYSTROKES
+include	"gtr.com"
+
+begin
+	call fprintf (fd, "\tcase\t= %b\n")
+	    call pargi (RC_CASE(rc))
+	call fprintf (fd, "\tmarkcur\t= %b\n")
+	    call pargi (RC_MARKCUR(rc))
+	call fprintf (fd, "\taxes\t= %b\n")
+	    call pargi (RC_AXES(rc))
+
+	if (wstranset == YES) {
+	    call fprintf (fd, "\tview\t= %5.3f %5.3f %5.3f %5.3f\n")
+		call pargr (vx1)
+		call pargr (vx2)
+		call pargr (vy1)
+		call pargr (vy2)
+	} else
+	    call fprintf (fd, "\tview\t= full screen\n")
+
+	call fprintf (fd, "\tkeys\t= %s\n")
+	    call pargstr (keys)
+	call fprintf (fd, "\t\t->")
+	    
+	for (ip=1;  keys[ip] != EOS;  ip=ip+1) {
+	    ch = RC_KEYS(rc,keys[ip])
+	    if (ch != 0)
+		call putci (fd, ch)
+	    else
+		call putci (fd, ' ')
+	}
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/cursor/grctext.x b/sys/gio/cursor/grctext.x
new file mode 100644
index 00000000..5bee9b34
--- /dev/null
+++ b/sys/gio/cursor/grctext.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include "grc.h"
+
+# GRC_TEXT -- Draw a text string.  The instruction is encoded and appended to
+# the frame buffer and GIOTR is called to draw the new instructions.
+
+procedure grc_text (stream, x, y, text)
+
+int	stream			# graphics stream
+real	x, y			# NDC coordinates of ll corner of first char
+char	text[ARB]		# text string
+
+pointer	tr, op, last_op
+int	fd, save1, save2, nwords
+int	stropen(), strlen()
+pointer	gtr_init(), gtr_writep()
+errchk	gtr_init, stropen, gki_redir
+
+begin
+	tr = gtr_init (stream)
+
+	# Allocate space in the frame buffer for the text set attribute
+	# and text drawing instructions.  Set the last op for undo to undo
+	# the line.  This is also set by writep, hence we must wait to set
+	# TR_LASTOP until after the call to writep.
+
+	last_op = TR_OP(tr)
+	nwords = GKI_TXSET_LEN + GKI_TEXT_LEN + strlen(text)
+	op = gtr_writep (stream, nwords)
+	TR_LASTOP(tr) = last_op
+
+	# Open the frame buffer as a file and redirect the graphics stream
+	# output into the buffer.
+
+	fd = stropen (Mems[op], nwords, NEW_FILE) 
+	call gki_redir (stream, fd, save1, save2)
+
+	# Output the set text attribute instruction and the text drawing
+	# instruction.
+
+	call gki_txset (stream, TR_TXAP(tr))
+	call gki_text (stream, nint(x*GKI_MAXNDC), nint(y*GKI_MAXNDC), text)
+
+	# Restore the normal output for the stream.
+	call gki_redir (stream, 0, save1, save2)
+	call close (fd)
+
+	# Call giotr to send the new instructions off to the kernel, optionally
+	# applying the workstation transformation in the process.
+
+	call giotr (stream)
+end
diff --git a/sys/gio/cursor/grcwarn.x b/sys/gio/cursor/grcwarn.x
new file mode 100644
index 00000000..ba9fcb0e
--- /dev/null
+++ b/sys/gio/cursor/grcwarn.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GRC_WARN -- Called in an error handler to intercept an error message string
+# and write it to the workstation in the status line.
+
+procedure grc_warn (fd)
+
+int	fd			# output stream
+
+int	errcode
+pointer	sp, msg, ip
+int	errget()
+
+begin
+	call smark (sp)
+	call salloc (msg, SZ_LINE, TY_CHAR)
+
+	errcode = errget (Memc[msg], SZ_LINE)
+	for (ip=msg;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+	    ;
+	Memc[ip] = EOS
+
+	call stg_putline (fd, " - ")
+	call stg_putline (fd, Memc[msg])
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcwcs.x b/sys/gio/cursor/grcwcs.x
new file mode 100644
index 00000000..7c73657a
--- /dev/null
+++ b/sys/gio/cursor/grcwcs.x
@@ -0,0 +1,282 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_SCRTOWCS -- Transform screen coordinates (raw cursor coordinates) to
+# world coordinates.  This is not terribly efficient, but it does not matter
+# for cursor mode applications which do not involve many coordinate
+# transformations.
+
+procedure grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coordinates
+int	raster			#I raster number
+real	rx, ry			#I raster coordinates
+real	wx, wy			#O world coordinates
+int	wcs			#O world coordinate system
+
+pointer	w, tr
+real	mx, my
+real	ct[LEN_CT]
+int	grc_selectwcs()
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	# Convert screen (raster 0) to NDC coordinates, undoing the effects
+	# of the workstation transformation.  This is not done for raster
+	# coordinates since these are already raster-normalized coordinates
+	# as returned by the server.
+
+	if (raster == 0)
+	    call grc_scrtondc (rx, ry, mx, my)
+	else {
+	    mx = rx
+	    my = ry
+	}
+
+	# Select a WCS.  The TR_WCS variable is set only if the user
+	# explicitly fixes the WCS to override automatic selection.  The
+	# best WCS for the raster is used if there is one, otherwise the
+	# best screen WCS is used.
+
+	if (TR_WCS(tr) == NULL) {
+	    wcs = grc_selectwcs (tr, raster, mx, my)
+	    if (wcs == 0) {
+		call grc_scrtondc (sx, sy, mx, my)
+		wcs = grc_selectwcs (tr, 0, mx, my)
+	    }
+	} else
+	    wcs = TR_WCS(tr)
+
+	# Set up the coordinate transformation.
+	w = TR_WCSPTR(tr,wcs)
+	call grc_settran (w, ct)
+
+	# Transform NDC coordinates to WCS coordinates.
+	call grc_ndctowcs (ct, mx, my, wx, wy)
+end
+
+
+# GRC_SETTRAN -- Set up the coordinate transformation parameters for a given
+# world coordinate system.
+
+procedure grc_settran (w, ct)
+
+pointer	w				# window descriptor
+real	ct[LEN_CT]			# transformation descriptor
+
+real	worigin, scale
+real	m1, m2, w1, w2
+int	transformation, ax
+bool	fp_equalr()
+real	elogr()
+
+begin
+	# Compute world -> NDC coordinate transformation.
+
+	do ax = 1, 2 {
+	    if (ax == 1) {
+		transformation = WCS_XTRAN(w)
+		w1 = WCS_WX1(w)
+		w2 = WCS_WX2(w)
+		m1 = WCS_SX1(w)
+		m2 = WCS_SX2(w)
+	    } else {
+		transformation = WCS_YTRAN(w)
+		w1 = WCS_WY1(w)
+		w2 = WCS_WY2(w)
+		m1 = WCS_SY1(w)
+		m2 = WCS_SY2(w)
+	    }
+
+	    if (transformation == LINEAR) {
+		worigin = w1
+		if (fp_equalr (w1, w2))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (w2 - w1)
+	    } else if (transformation == LOG && w1 > 0 && w2 > 0) {
+		worigin = log10 (w1)
+		if (fp_equalr (log10(w2), worigin))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (log10(w2) - worigin)
+	    } else {
+		worigin = elogr (w1)
+		if (fp_equalr (elogr(w2), worigin))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (elogr(w2) - worigin)
+	    }
+
+	    ct[ax,CT_TRAN]    = transformation
+	    ct[ax,CT_SCALE]   = scale
+	    ct[ax,CT_WORIGIN] = worigin
+	    ct[ax,CT_MORIGIN] = m1
+	}
+end
+
+
+# GRC_WCSTONDC -- Transform world coordinates to NDC coordinates using the
+# computed transformation parameters.
+
+procedure grc_wcstondc (ct, wx, wy, mx, my)
+
+real	ct[LEN_CT]		# coordinate transformation descriptor
+real	wx, wy			# world coordinates of point
+real	mx, my			# ndc coordinates of point
+
+real	v
+int	transformation, ax
+real	elogr()
+
+begin
+	do ax = 1, 2 {
+	    transformation = nint (ct[ax,CT_TRAN])
+	    if (ax == 1)
+		v = wx
+	    else
+		v = wy
+
+	    if (transformation == LINEAR)
+		;
+	    else if (transformation == LOG)
+		v = log10 (v)
+	    else
+		v = elogr (v)
+
+	    v = ((v - ct[ax,CT_WORIGIN]) * ct[ax,CT_SCALE]) + ct[ax,CT_MORIGIN]
+	    if (ax == 1)
+		mx = v
+	    else
+		my = v
+	}
+end
+
+
+# GRC_NDCTOWCS -- Transform NDC coordinates to world coordinates using the
+# computed transformation parameters.
+
+procedure grc_ndctowcs (ct, mx, my, wx, wy)
+
+real	ct[LEN_CT]		# coordinate transformation descriptor
+real	mx, my			# ndc coordinates of point
+real	wx, wy			# world coordinates of point
+
+real	v
+int	transformation, ax
+real	aelogr()
+
+begin
+	do ax = 1, 2 {
+	    transformation = nint (ct[ax,CT_TRAN])
+	    if (ax == 1)
+		v = mx
+	    else
+		v = my
+
+	    v = ((v - ct[ax,CT_MORIGIN]) / ct[ax,CT_SCALE]) + ct[ax,CT_WORIGIN]
+	    if (transformation == LINEAR)
+		;
+	    else if (transformation == LOG)
+		v = 10.0 ** v
+	    else
+		v = aelogr (v)
+
+	    if (ax == 1)
+		wx = v
+	    else
+		wy = v
+	}
+end
+
+
+# GRC_SELECTWCS -- Select the WCS nearest to the given position in NDC
+# coordinates.  If the point falls within a single WCS then that WCS is
+# selected.  If the point falls within multiple WCS then the closest WCS
+# is selected.  If multiple (non unitary) WCS are defined at the same
+# distance, e.g., when the WCS share the same viewport, then the highest
+# numbered WCS is selected.
+
+int procedure grc_selectwcs (tr, raster, mx, my)
+
+pointer	tr			#I GTR descriptor
+int	raster			#I raster number
+real	mx, my			#I NDC coordinates of point
+
+pointer	w
+int	wcs, closest_wcs, flags
+real	tol, sx1, sx2, sy1, sy2
+real	distance, old_distance, xcen, ycen
+int	nin, in[MAX_WCS]
+
+begin
+	nin = 0
+	closest_wcs = 0
+	old_distance = 1.0
+	tol = EPSILON * 10.0
+
+	# Inspect each WCS.  All WCS are passed even though only one or two
+	# WCS will be set to nonunitary values for a given plot.  Omitting
+	# the unitary WCS, determine the closest WCS and make a list of the
+	# WCS containing the given point.
+
+	do wcs = 1, MAX_WCS {
+	    w = TR_WCSPTR(tr,wcs)
+
+	    # Cache WCS params in local storage.
+	    sx1 = WCS_SX1(w)
+	    sx2 = WCS_SX2(w)
+	    sy1 = WCS_SY1(w)
+	    sy2 = WCS_SY2(w)
+	    flags = WCS_FLAGS(w)
+	    xcen = (sx1 + sx2) / 2.0
+	    ycen = (sy1 + sy2) / 2.0
+
+	    # Skip to next WCS if the raster number doesn't match.
+	    if (WF_RASTER(flags) != raster)
+		next
+
+	    # Skip to next WCS if this one is not defined.
+	    if (and (flags, WF_NEWFORMAT) == 0) {
+		# Preserve old semantics if passed old format WCS.
+		if (sx1 == 0 && sx2 == 0 || sy1 == 0 && sy2 == 0)
+		    next
+		if (abs ((sx2-sx1) - 1.0) < tol && abs ((sy2-sy1) - 1.0) < tol)
+		    next
+	    } else if (and (flags, WF_DEFINED) == 0)
+		next
+
+	    # Determine closest WCS to point (mx,my).
+	    distance = ((mx - xcen) ** 2) + ((my - ycen) ** 2)
+	    if (distance <= old_distance) {
+		closest_wcs = wcs
+		old_distance = distance
+	    }
+
+	    # Check if point is inside this WCS.
+	    if (mx >= sx1 && mx <= sx2 && my >= sy1 && my <= sy2) {
+		nin = nin + 1
+		in[nin] = wcs
+	    }
+	}
+
+	# If point is inside exactly one non-unitary WCS then select that WCS.
+	if (nin == 1)
+	    return (in[1])
+
+	# If point is inside more than one WCS, or if point is not inside any
+	# WCS, select the closest WCS.  If multiple WCS are at the same
+	# distance we have already selected the higher numbered WCS due to
+	# the way the distance test is conducted, above.
+
+	return (closest_wcs)
+end
diff --git a/sys/gio/cursor/grcwrite.x b/sys/gio/cursor/grcwrite.x
new file mode 100644
index 00000000..c0a602a9
--- /dev/null
+++ b/sys/gio/cursor/grcwrite.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_WRITE -- Write the contents of the frame buffer to a file, with or
+# without applying the workstation transformation, optionally clobbering
+# any existing file of the same name.
+
+procedure grc_write (tr, stream, fname, clobber, fullframe)
+
+pointer	tr			# graphics stream descriptor
+int	stream			# graphics stream
+char	fname[ARB]		# file name
+bool	clobber			# clobber existing file
+bool	fullframe		# write full frame (no workstation transform)
+
+pointer	sp, lbuf
+long	size1, size2
+int	save1, save2, fd, nchars
+long	fstatl()
+int	open()
+errchk	write, gtr_redraw
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# Delete existing file if clobber requested.
+	if (clobber)
+	    iferr (call delete (fname))
+		;
+
+	# Open metacode spool file for appending.
+	iferr (fd = open (fname, APPEND, BINARY_FILE)) {
+	    call grc_message (stream, " - cannot open file for appending")
+	    call sfree (sp)
+	    return
+	}
+
+	# Write either the full frame or the displayed frame into spool file.
+
+	size1 = fstatl (fd, F_FILESIZE)
+	if (fullframe) {
+	    nchars = (TR_OP(tr) - TR_FRAMEBUF(tr)) * SZ_SHORT
+	    call write (fd, Mems[TR_FRAMEBUF(tr)], nchars)
+	} else {
+	    call gki_redir  (stream, fd, save1, save2)
+	    call gtr_redraw (stream)
+	    call gki_redir  (stream,  0, save1, save2)
+	}
+
+	size2 = fstatl (fd, F_FILESIZE)
+	call sprintf (Memc[lbuf], SZ_LINE, " - %d chars %s")
+	    call pargi (size2 - size1)
+	if (size1 > 0)
+	    call pargstr ("appended")
+	else
+	    call pargstr ("")
+	call grc_message (stream, Memc[lbuf])
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtr.com b/sys/gio/cursor/gtr.com
new file mode 100644
index 00000000..ae5c3ac6
--- /dev/null
+++ b/sys/gio/cursor/gtr.com
@@ -0,0 +1,25 @@
+# GTR.COM -- Polyline clipping common for the workstation transformation.
+# The length of this common in integer units from startcom to endcom inclusive
+# is a defined parameter in giotr.h.  Values within the save area are saved
+# in the TR descriptor for a device and loaded into the common (which serves
+# as a cache) when GIOTR or RCURSOR is called for a device.  LENGTH=28
+
+pointer	trdes[MAX_PSEUDOFILES]	# pointers to giotr descriptors
+int	tr_stream		# graphics stream currently in the cache
+int	startcom		# dummy entry marking start of common
+int	pl_op			# index of next cell in polyline array
+bool	last_point_inbounds	# last point was inbounds
+int	pl_type			# type of instruction (polyline, polymarker,...)
+int	wstranset		# workstation transformation has been set
+real	xscale, yscale		# scale factor, world to GKI, for transform
+real	xorigin, yorigin	# origins in GKI coords, for transform
+long	cx, cy			# current pen position, GKI coords
+long	mx1, mx2, my1, my2	# clipping viewport, GKI coords
+real	vx1, vx2, vy1, vy2	# NDC viewport, may extend beyond boundary
+long	xs[4], ys[4]		# last point plotted (for clipping code)
+int	endcom			# dummy entry marking end of saved area
+short	pl[LEN_PLBUF+5]		# output polyline buffer (plus GKI header)
+
+common	/gtrcom/ trdes, tr_stream, startcom, pl_op, last_point_inbounds,
+	pl_type, wstranset, xscale, yscale, xorigin, yorigin, cx, cy,
+	mx1, mx2, my1, my2, vx1, vx2, vy1, vy2, xs, ys, endcom, pl
diff --git a/sys/gio/cursor/gtr.h b/sys/gio/cursor/gtr.h
new file mode 100644
index 00000000..3fbf93f5
--- /dev/null
+++ b/sys/gio/cursor/gtr.h
@@ -0,0 +1,51 @@
+# GIOTR.H -- Global definitions for the GIOTR graphics i/o workstation
+# transformation and i/o program unit.  Note: requires <gio.h>.
+
+define	DEF_MAXLENFRAMEBUF	128000
+define	DEF_LENFRAMEBUF		8192
+define	INC_LENFRAMEBUF		4096
+define	DEF_LENSCRATCHBUF	256
+define	INC_LENSCRATCHBUF	256
+define	MAX_PSEUDOFILES		10
+define	SZ_TRDEVNAME		229
+define	SZ_KERNFNAME		259
+define	LEN_GTRCOM		28	# see "gtr.com"
+define	KSHIFT			10000	# encode pr ("etc$prpsio.x") such that
+					#
+					#    ((pr*KSHIFT)+stream) > LAST_FD
+					#
+					# see also <gio.h>
+
+define	LEN_TRSTRUCT	(564+204)
+
+define	TR_PID		Memi[$1]		# process id of kernel
+define	TR_IN		Memi[$1+1]		# input from process
+define	TR_OUT		Memi[$1+2]		# output to process
+define	TR_TTY		Memi[$1+3]		# graphcap descriptor
+define	TR_SPOOLDATA	Memi[$1+4]		# spool metacode instructions
+define	TR_FRAMEBUF	Memi[$1+5]		# pointer to frame buffer
+define	TR_LENFRAMEBUF	Memi[$1+6]		# length of the frame buffer
+define	TR_MAXLENFRAMEBUF Memi[$1+7]		# max length of the frame buffer
+define	TR_IP		Memi[$1+8]		# input pointer into frame buf
+define	TR_OP		Memi[$1+9]		# output pointer into frame buf
+define	TR_LASTOP	Memi[$1+10]		# last OP (for undo)
+define	TR_SCRATCHBUF	Memi[$1+11]		# for annotating plots
+define	TR_LENSCRATCHBUF Memi[$1+12]		# length of the scratch buffer
+define	TR_OPSB		Memi[$1+13]		# output pointer, scratch buf
+define	TR_NOPEN	Memi[$1+14]		# number of opens
+define	TR_REDIR	Memi[$1+15]		# redirection information
+define	TR_WCS		Memi[$1+16]		# WCS selected, 0 if none
+define	TR_PAGE		Memi[$1+17]		# clear screen for text
+define	TR_WAITPAGE	Memi[$1+18]		# grc_waitpage flag
+define	TR_WSOPEN	Memi[$1+19]		# workstation open count
+define	TR_SKIPOPEN	Memi[$1+20]		# skip wsopen in metacode
+define	TR_WSACTIVE	Memi[$1+21]		# workstation activated?
+define	TR_WSACTSAVE	Memi[$1+22]		# save old wsactive state
+define	TR_INTERACTIVE	Memi[$1+23]		# the user graphics terminal?
+			# (open)
+define	TR_TXAP		($1+30)			# text drawing attributes
+define	TR_PLAP		($1+40)			# text drawing attributes
+define	TR_DEVNAME	Memc[P2C($1+44)]	# device name
+define	TR_KERNFNAME	Memc[P2C($1+274)]	# name of kernel file (or "cl")
+define	TR_GTRCOM	Memi[$1+534]		# storage for the gtr common
+define	TR_WCSPTR	(($1)+564+($2)*LEN_WCS)	# WCS storage (0=not used)
diff --git a/sys/gio/cursor/gtrbackup.x b/sys/gio/cursor/gtrbackup.x
new file mode 100644
index 00000000..9ab13c0b
--- /dev/null
+++ b/sys/gio/cursor/gtrbackup.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_BACKUP -- Backup one drawing instruction in the frame buffer.  Erase
+# the graphics if possible.  The effects of this function may be undone by
+# the UNDO operator.
+
+procedure gtr_backup (stream)
+
+int	stream				# graphics stream
+
+int	opcode
+pointer	tr, op, bp, sp, ap
+pointer	gtr_init()
+errchk	gtr_init
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_PL, TY_STRUCT)
+
+	tr = gtr_init (stream)
+
+	# Scan backward to the beginning of the last drawing instruction in the
+	# frame buffer.
+
+	op = TR_OP(tr)
+	bp = TR_FRAMEBUF(tr)
+	if (op <= bp) {
+	    call sfree (sp)
+	    return
+	}
+
+	repeat {
+	    op = op - 1
+	    while (Mems[op] != BOI)
+		if (op <= bp) {
+		    TR_OP(tr) = bp
+		    TR_IP(tr) = bp
+		    call sfree (sp)
+		    return
+		} else
+		    op = op - 1
+	    opcode = Mems[op+GKI_HDR_OPCODE-1]
+	} until (opcode >= GKI_POLYLINE && opcode <= GKI_PUTCELLARRAY)
+
+	# Redraw the last instruction to erase it (device permitting).
+	if (opcode == GKI_POLYLINE) {
+	    PL_LTYPE(ap) = GL_CLEAR
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+	    call gki_plset (stream, ap)
+
+	    if (wstranset == YES)
+		call gtr_wstran (Mems[op])
+	    else
+		call gki_write (stream, Mems[op])
+
+	    PL_LTYPE(ap) = GL_SOLID
+	    call gki_plset (stream, ap)
+	    call gki_fflush (stream)
+	}
+
+	# Return the space in the buffer.
+	TR_LASTOP(tr) = TR_OP(tr)
+	TR_OP(tr) = op
+	TR_IP(tr) = min (op, TR_IP(tr))
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrconn.x b/sys/gio/cursor/gtrconn.x
new file mode 100644
index 00000000..c2e6fb47
--- /dev/null
+++ b/sys/gio/cursor/gtrconn.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# GTR_CONNECT -- Connect a subprocess containing a graphics kernel task to a
+# graphics stream.  The graphics kernel task is a conventional IRAF task 
+# linked into the kernel process.  After spawning the subprocess, we command
+# the process to run the named kernel task, then service the parameter
+# requests from the task as it begins running.  Graphics i/o will be via one
+# of the graphics streams, leaving STDIN, STDOUT, and STDERR free to access
+# the corresponding streams in the parent (the CL).  A kernel may be opened
+# either to drive a particular device (if devname is specified) or to drive
+# a device selected at runtime.  If the kernel is opened to drive a particular
+# device the device name in the OPENWS instruction will be ignored.  We require
+# that the graphics kernel begin processing metacode immediately after
+# receiving "yes" for the value of the parameter "generic", signifying that
+# the caller wishes a generic kernel, i.e., cannot return the values of any
+# kernel dependent parameters.
+
+int procedure gtr_connect (kernfname, taskname, devname, stream, in, out)
+
+char	kernfname[ARB]		# name of executable kernel file
+char	taskname[ARB]		# name of kernel task
+char	devname[ARB]		# device name or null string
+int	stream			# graphics stream to connect process to
+int	in, out			# input and output streams to process
+
+pointer	sp, lbuf
+int	pid
+bool	streq()
+int	propen(), getline()
+errchk	propen, flush, getline, syserr
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	pid = propen (kernfname, in, out)
+	call fprintf (out, "%s\n")
+	    call pargstr (taskname)
+	call flush (out)
+
+	# Pass values of the kernel parameters.  For a kernel run as
+	# part of the graphics system there are only three parameters,
+	# the input file name (STDGRAPH, etc. for a connected kernel)
+	# the device name if the kernel is to ignore device names in
+	# OPENWS instructions, and "generic=yes", signifying that the
+	# kernel dependent parameters are not to be requested.
+
+	while (getline (in, Memc[lbuf]) != EOF) {
+	    if (streq (Memc[lbuf], "=input\n")) {
+		call fprintf (out, "%s\n")
+		    switch (stream) {
+		    case STDGRAPH:
+			call pargstr ("STDGRAPH")
+		    case STDIMAGE:
+			call pargstr ("STDIMAGE")
+		    case STDPLOT:
+			call pargstr ("STDPLOT")
+		    }
+		call flush (out)
+	    } else if (streq (Memc[lbuf], "=device\n")) {
+		call fprintf (out, "%s\n")
+		    call pargstr (devname)
+		call flush (out)
+	    } else if (streq (Memc[lbuf], "=generic\n")) {
+		call putline (out, "yes\n")
+		call flush (out)
+		break
+	    } else {
+		call putline (STDERR, Memc[lbuf])
+		call syserr (SYS_GKERNPARAM)
+	    }
+	}
+
+	call sfree (sp)
+	return (pid)
+end
diff --git a/sys/gio/cursor/gtrctrl.x b/sys/gio/cursor/gtrctrl.x
new file mode 100644
index 00000000..8de08ccb
--- /dev/null
+++ b/sys/gio/cursor/gtrctrl.x
@@ -0,0 +1,122 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<prstat.h>
+include	<config.h>
+include	<fset.h>
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_CONTROL -- Execute a graphics control instruction, e.g., connect a
+# graphics kernel to a graphics stream and set or get the WCS for a frame.
+# The control instructions are GKI encoded instructions transmitted to the
+# pseudofile GIOCONTROL.  The PR_PSIO procedure (which processes the pseudofile
+# directives from a subprocess) calls us whenever data is sent to this
+# special pseudofile.
+
+procedure gtr_control (stream, gki, source_pid)
+
+int	stream			# graphics stream
+short	gki[ARB]		# encoded graphics control instruction
+int	source_pid		# pid of requesting process
+
+bool	redirected
+pointer	tr, sp, devname, gki_out
+int	flags, mode, nwords, fd, p_fd
+int	prstati(), pr_getredir()
+pointer	gtr_init(), coerce()
+errchk	gtr_init, gtr_openws, write, flush, gki_write
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (devname, SZ_TRDEVNAME, TY_CHAR)
+
+	nwords = gki[GKI_HDR_LENGTH]
+	call salloc (gki_out, nwords, TY_SHORT)
+	call amovs (gki, Mems[gki_out], nwords)
+
+	tr = gtr_init (stream)
+	p_fd = abs (pr_getredir (source_pid, stream))
+	redirected = (p_fd >= FIRST_FD && p_fd <= LAST_FD)
+
+	switch (gki[GKI_HDR_OPCODE]) {
+	case GKI_OPENWS:
+	    mode   = gki[GKI_OPENWS_M]
+	    nwords = gki[GKI_OPENWS_N]
+
+	    # Unpack the device name, passed as a short integer array.
+	    call achtsc (gki[GKI_OPENWS_D], Memc[devname], nwords)
+	    Memc[devname+nwords] = EOS
+
+	    # Connect the kernel.
+	    call fseti (stream, F_CANCEL, OK)
+	    call gtr_openws (Memc[devname], mode, stream, source_pid)
+
+	    # Count the logical openws.
+	    TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+	    TR_WSACTIVE(tr) = YES
+	    TR_WSACTSAVE(tr) = NO
+
+	    # Due to a call to F_CANCEL in prpsio the openws instruction
+	    # spooled by gki_write below is being lost for subkernels,
+	    # so don't set the skipopen flag.  This causes giotr to pass
+	    # the openws on to the subkernel.  For inline kernels setting
+	    # skipopen prevents the openws from being executed twice.
+
+	    if (TR_INTERACTIVE(tr) == YES)
+		TR_SKIPOPEN(tr) = YES
+
+	    # If opening NEW_FILE, discard any previous WCS and clear the
+	    # frame buffer.
+
+	    if (mode == NEW_FILE) {
+		call aclri (Memi[TR_WCSPTR(tr,1)], LEN_WCS * MAX_WCS)
+		call gtr_frame (tr, TR_FRAMEBUF(tr), stream)
+	    }
+
+	case GKI_CLOSEWS:
+	    # Count the logical closews.
+	    TR_WSOPEN(tr) = TR_WSOPEN(tr) - 1
+	    TR_WSACTIVE(tr) = NO
+
+	case GKI_DEACTIVATEWS:
+	    TR_WSACTIVE(tr) = NO
+	    if (TR_INTERACTIVE(tr) == YES && TR_PAGE(tr) == NO) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		if (and (flags, AW_CLEAR) != 0)
+		    Mems[gki_out+GKI_REACTIVATEWS_F-1] = flags - AW_CLEAR
+	    }
+
+	case GKI_REACTIVATEWS:
+	    TR_WSACTIVE(tr) = YES
+	    if (TR_INTERACTIVE(tr) == YES) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		if (and (flags, AW_PAUSE) != 0)
+		    call gtr_waitpage (STDERR, stream)
+	    }
+
+	case GKI_SETWCS:
+	    nwords = gki[GKI_SETWCS_N]
+	    call amovs (gki[GKI_SETWCS_WCS],
+		Mems[coerce (TR_WCSPTR(tr,1), TY_STRUCT, TY_SHORT)],
+		min (nwords, LEN_WCS * MAX_WCS * SZ_STRUCT / SZ_SHORT))
+
+	case GKI_GETWCS:
+	    nwords = gki[GKI_GETWCS_N]
+	    fd = prstati (source_pid, PR_OUTFD)
+
+	    call write (fd, Memi[TR_WCSPTR(tr,1)], nwords * SZ_SHORT)
+	    call flush (fd)
+	}
+
+	# Pass the (possibly modified) instruction on to the kernel.
+	# We must NOT call gki_flush or gki_fflush here, as this would
+	# result in a reentrant call to prpsio when writing to a subkernel.
+
+	if (!redirected)
+	    call gki_write (stream, Mems[gki_out])
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrdelete.x b/sys/gio/cursor/gtrdelete.x
new file mode 100644
index 00000000..97f418a0
--- /dev/null
+++ b/sys/gio/cursor/gtrdelete.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_DELETE -- Delete an instruction from the frame buffer.  This prevents
+# the instruction from being executed if the frame is redrawn.
+
+procedure gtr_delete (tr, gki)
+
+pointer	tr			#I giotr descriptor
+pointer	gki			#I instruction to be deleted
+
+pointer	inext
+int	nwords, shift, ilen
+
+begin
+	ilen = Mems[gki+GKI_HDR_LENGTH-1]
+	inext = gki + ilen
+
+	if (inext >= TR_OP(tr)) {
+	    # Instruction is the last one in the buffer.
+	    TR_OP(tr) = gki
+	    TR_LASTOP(tr) = TR_OP(tr)
+	    if (TR_IP(tr) >= gki)
+		TR_IP(tr) = gki
+
+	} else {
+	    # If the instruction is small and would be expensive to delete
+	    # just change the opcode to disable it, otherwise shift the
+	    # buffer contents back to overwrite the deleted instruction.
+
+	    nwords = TR_OP(tr) - inext
+	    if (ilen < 32 && nwords > 2048)
+		Mems[gki+GKI_HDR_OPCODE-1] = GKI_UNKNOWN
+	    else {
+		call amovs (Mems[inext], Mems[gki], nwords)
+		shift = inext - gki
+		TR_IP(tr) = TR_IP(tr) - shift
+		TR_OP(tr) = TR_OP(tr) - shift
+		TR_LASTOP(tr) = TR_OP(tr)
+	    }
+	}
+end
diff --git a/sys/gio/cursor/gtrdiscon.x b/sys/gio/cursor/gtrdiscon.x
new file mode 100644
index 00000000..5eba23f4
--- /dev/null
+++ b/sys/gio/cursor/gtrdiscon.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GTR_DISCONNECT -- Disconnect from a kernel subprocess.  To achieve an orderly
+# shutdown we process any outstanding XMIT or XFER requests, then transmit an
+# end of file (zero length record) to the kernel task when it reads from the
+# graphics stream.  The kernel should then shutdown and eventually we will
+# receive "bye" from the process.  We then call PRCLOSE to shutdown the
+# process for good.  Note: we do not expect anything but an XFER (read) request
+# on the graphics stream, but it seems prudent to do something reasonable if
+# some other request is received.
+
+procedure gtr_disconnect (pid, in, out, stream)
+
+int	pid			# process id of subprocess
+int	in, out			# command i/o streams of the subprocess
+int	stream			# graphics stream used by kernel
+
+pointer	sp, sp2, lbuf, buf
+int	pseudofile, nchars, junk
+bool	streq()
+int	getline(), read(), strncmp(), psio_isxmit(), prclose(), pr_findproc()
+errchk	getline, prclose, read, write
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	while (getline (in, Memc[lbuf]) != EOF) {
+	    if (streq (Memc[lbuf], "bye\n") ||
+		strncmp (Memc[lbuf], "ERROR", 5) == 0) {
+
+		junk = prclose (pid)
+		break
+
+	    } else if (Memc[lbuf] == '!') {
+		# OS escape.
+		call proscmd (pr_findproc(pid), Memc[lbuf+1])
+
+	    } else {
+		call smark (sp2)
+
+		switch (psio_isxmit (Memc[lbuf], pseudofile, nchars)) {
+		case XMIT:
+		    call salloc (buf, nchars, TY_CHAR)
+		    nchars = read (in, Memc[buf], nchars)
+		    if (nchars > 0)
+			if (pseudofile == STDOUT || pseudofile == STDERR)
+			    call write (pseudofile, Memc[buf], nchars)
+
+		case XFER:
+		    call salloc (buf, nchars, TY_CHAR)
+		    if (pseudofile == STDIN)
+			nchars = read (pseudofile, Memc[buf], nchars)
+		    else
+			nchars = 0		# this is the EOF
+		    call psio_xfer (out, Memc[buf], nchars)
+		}
+
+		call sfree (sp2)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrfetch.x b/sys/gio/cursor/gtrfetch.x
new file mode 100644
index 00000000..44ccfe60
--- /dev/null
+++ b/sys/gio/cursor/gtrfetch.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_FETCH_NEXT_INSTRUCTION -- Return a pointer to the next GKI metacode
+# instruction in the input buffer.  Only complete instructions resident in
+# a contiguous section of memory are returned.  EOF is returned when the
+# end of the current buffer is reached, or when the last instruction in the
+# frame buffer is not yet complete.  EOF does not signify the end of the
+# metacode stream.
+
+int procedure gtr_fetch_next_instruction (tr, gki)
+
+pointer	tr			# pointer to giotr descriptor
+pointer	gki			# pointer to next instruction (output)
+
+int	nleft, length
+pointer	ip, itop
+
+begin
+	ip   = TR_IP(tr)
+	itop = TR_OP(tr)
+
+	# Search for the beginning of the next instruction.
+	while (Mems[ip] != BOI && ip < itop)
+	    ip = ip + 1
+
+	nleft = itop - ip
+	if (nleft < 3) {
+	    # The length field of the next instruction is not yet present.
+	    TR_IP(tr) = ip
+	    return (EOF)
+	} else {
+	    length = Mems[ip+GKI_HDR_LENGTH-1]
+	    if (length > nleft) {
+		# Entire instruction is not yet present in buffer.
+		TR_IP(tr) = ip
+		return (EOF)
+	    } else {
+		# Entire instruction is present in buffer.
+		TR_IP(tr) = ip + length
+		gki = ip
+		return (length)
+	    }
+	}
+end
diff --git a/sys/gio/cursor/gtrframe.x b/sys/gio/cursor/gtrframe.x
new file mode 100644
index 00000000..baf68ffb
--- /dev/null
+++ b/sys/gio/cursor/gtrframe.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_FRAME -- Clear the frame buffer, used to spool the metacode instructions
+# required to draw a graphics frame.  This is done by moving the metacode data
+# at the end of the buffer (beginning with the word pointed to by gki) to the
+# beginning of the buffer and adjusting the input and output pointers
+# accordingly.  The workstation transformation is also reset to the unitary
+# transformation when the frame is cleared, i.e., zoom is cancelled.
+
+procedure gtr_frame (tr, gki, stream)
+
+pointer	tr			# giotr descriptor
+pointer	gki			# pointer to first word to be preserved
+int	stream			# graphics stream
+
+pointer	bp
+int	nwords, shift
+
+begin
+	bp = TR_FRAMEBUF(tr)
+
+	if (gki > bp) {
+	    nwords = TR_OP(tr) - gki
+	    call amovs (Mems[gki], Mems[bp], nwords)
+	    shift = gki - bp
+	    TR_IP(tr) = TR_IP(tr) - shift
+	    TR_OP(tr) = TR_OP(tr) - shift
+	} else {
+	    TR_IP(tr) = bp
+	    TR_OP(tr) = bp
+	}
+
+	call gtr_ptran (stream, 0., 1., 0., 1.)
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+	TR_LASTOP(tr) = TR_OP(tr)
+	TR_WCS(tr) = NULL
+end
diff --git a/sys/gio/cursor/gtrgflush.x b/sys/gio/cursor/gtrgflush.x
new file mode 100644
index 00000000..5681e234
--- /dev/null
+++ b/sys/gio/cursor/gtrgflush.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_GFLUSH -- Dispose of any buffered output on the stream STDPLOT.  The last
+# plot sent to stdplot cannot be disposed of at CLOSEWS time due to the need
+# to permit APPEND mode in the next OPENWS call.  We are called to dispose
+# of all output to the plotter device.  Logging out or doing a reset will have
+# the same effect.
+
+procedure gtr_gflush (stream)
+
+int	stream
+pointer	tr
+bool	streq()
+include	"gtr.com"
+
+begin
+	tr = trdes[stream]
+	if (tr == NULL)
+	    return
+
+	# Disconnect the kernel.
+	iferr {
+	    if (streq (TR_KERNFNAME(tr), "cl"))
+		call stg_close()
+	    else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		call gtr_disconnect (TR_PID(tr), TR_IN(tr), TR_OUT(tr),
+		    stream)
+		TR_PID(tr) = NULL
+	    }
+	} then
+	    call erract (EA_WARN)
+
+	# Free all storage.
+	call mfree (TR_FRAMEBUF(tr), TY_SHORT)
+	call mfree (TR_SCRATCHBUF(tr), TY_SHORT)
+	call mfree (tr, TY_STRUCT)
+
+	trdes[stream] = NULL
+	if (tr_stream == stream)
+	    tr_stream = NULL
+end
diff --git a/sys/gio/cursor/gtrgtran.x b/sys/gio/cursor/gtrgtran.x
new file mode 100644
index 00000000..c83c83aa
--- /dev/null
+++ b/sys/gio/cursor/gtrgtran.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_GTRAN -- Get the workstation transformation.
+
+procedure gtr_gtran (fd, x1, x2, y1, y2)
+
+int	fd			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    x1 = vx1
+	    x2 = vx2
+	    y1 = vy1
+	    y2 = vy2
+	} else {
+	    x1 = 0
+	    x2 = 1.0
+	    y1 = 0
+	    y2 = 1.0
+	}
+end
diff --git a/sys/gio/cursor/gtrgtty.x b/sys/gio/cursor/gtrgtty.x
new file mode 100644
index 00000000..0e67a1fd
--- /dev/null
+++ b/sys/gio/cursor/gtrgtty.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_GTTY -- Get the graphcap descriptor for a stream.
+
+pointer procedure gtr_gtty (stream)
+
+int	stream			# graphics stream of interest
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+	return (TR_TTY(tr))
+end
diff --git a/sys/gio/cursor/gtrinit.x b/sys/gio/cursor/gtrinit.x
new file mode 100644
index 00000000..734d8202
--- /dev/null
+++ b/sys/gio/cursor/gtrinit.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_INIT -- Initialize the GIOTR data structures for a graphics stream.  These
+# data structures are initialized only once, when the first i/o occurs on the
+# stream.  Thereafter our only function is to fault the workstation
+# transformation parameters into the cache (the gtr common).
+
+pointer procedure gtr_init (stream)
+
+int	stream			# graphics stream
+
+int	i, len_fb, len_sb
+pointer	tr, tx, ap, w
+bool	first_time
+int	btoi(), envgeti()
+data	first_time /true/
+errchk	calloc, malloc
+include	"gtr.com"
+
+begin
+	if (first_time) {
+	    call amovki (NULL, trdes, MAX_PSEUDOFILES)
+	    tr_stream = NULL
+	    first_time = false
+	}
+
+	tr = trdes[stream]
+
+	if (tr == NULL) {
+	    # This is the first time the stream has been accessed.
+
+	    # Allocate descriptor.
+	    call calloc (tr, LEN_TRSTRUCT, TY_STRUCT)
+
+	    # Don't need a frame buffer for STDPLOT, but make a dummy one
+	    # anyhow so that the stream looks like the interactive ones.
+
+	    if (stream == STDPLOT) {
+		len_fb = 1
+		len_sb = 1
+	    } else {
+		len_fb = DEF_LENFRAMEBUF
+		len_sb = DEF_LENSCRATCHBUF
+	    }
+
+	    call malloc (TR_FRAMEBUF(tr),   len_fb, TY_SHORT)
+	    call malloc (TR_SCRATCHBUF(tr), len_sb, TY_SHORT)
+
+	    trdes[stream] = tr
+	    TR_IP(tr) = TR_FRAMEBUF(tr)
+	    TR_OP(tr) = TR_FRAMEBUF(tr)
+	    TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+	    TR_LENFRAMEBUF(tr) = len_fb
+	    TR_LENSCRATCHBUF(tr) = len_sb
+	    TR_SPOOLDATA(tr) = btoi (stream != STDPLOT)
+	    TR_WAITPAGE(tr) = NO
+	    TR_PAGE(tr) = YES
+
+	    # Set text drawing attributes for annotating plots.
+	    tx = TR_TXAP(tr)
+	    TX_UP(tx) = 90
+	    TX_SIZE(tx) = 1.0
+	    TX_PATH(tx) = GT_RIGHT
+	    TX_SPACING(tx) = 0
+	    TX_HJUSTIFY(tx) = GT_LEFT
+	    TX_VJUSTIFY(tx) = GT_BOTTOM
+	    TX_FONT(tx) = GT_ROMAN
+	    TX_QUALITY(tx) = GT_NORMAL
+	    TX_COLOR(tx) = 1
+
+	    # Set default polyline attributes for axis drawing.
+	    ap = TR_PLAP(tr)
+	    PL_LTYPE(ap) = GL_SOLID
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+
+	    # The user can override the default maximum frame buffer length
+	    # if they wish, permitting spooling of frames of any size.
+
+	    iferr (TR_MAXLENFRAMEBUF(tr) = envgeti ("cmbuflen"))
+		TR_MAXLENFRAMEBUF(tr) = DEF_MAXLENFRAMEBUF
+
+	    if (tr_stream != NULL) {
+		# Save the workstation transformation parameters for the
+		# stream currently in the cache, if any.
+
+		call amovi (startcom, TR_GTRCOM(trdes[tr_stream]), LEN_GTRCOM)
+		call amovi (TR_GTRCOM(tr), startcom, LEN_GTRCOM)
+	    }
+
+	    # Initialize the transformation parameters for the new stream.
+	    tr_stream = stream
+	    xscale = 1.0
+	    yscale = 1.0
+	    mx2 = GKI_MAXNDC
+	    my2 = GKI_MAXNDC
+	    vx2 = 1.0
+	    vy2 = 1.0
+
+	    # Initialize the WCS in case someone tries to read the cursor
+	    # before there are any graphics.
+
+	    do i = 1, MAX_WCS {
+		w = TR_WCSPTR(tr,i)
+		WCS_SX1(w) = 0.0
+		WCS_SX2(w) = 1.0
+		WCS_SY1(w) = 0.0
+		WCS_SY2(w) = 1.0
+
+		WCS_WX1(w) = 0.0
+		WCS_WX2(w) = 1.0
+		WCS_WY1(w) = 0.0
+		WCS_WY2(w) = 1.0
+	    }
+
+	} else if (stream != tr_stream) {
+	    # The stream has already been initialized.
+
+	    # If the cache is currently validated for some different stream
+	    # move the data for that stream out into its descriptor.
+
+	    if (tr_stream != NULL)
+		call amovi (startcom, TR_GTRCOM(trdes[tr_stream]), LEN_GTRCOM)
+
+	    # Load the data for the new stream into the cache.
+	    call amovi (TR_GTRCOM(tr), startcom, LEN_GTRCOM)
+	    tr_stream = stream
+	}
+
+	return (tr)
+end
diff --git a/sys/gio/cursor/gtropenws.x b/sys/gio/cursor/gtropenws.x
new file mode 100644
index 00000000..27a3072a
--- /dev/null
+++ b/sys/gio/cursor/gtropenws.x
@@ -0,0 +1,206 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<error.h>
+include	<prstat.h>
+include	<fset.h>
+include	<fio.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_OPENWS -- Called by gtr_control(pr_psio) to connect a kernel to a
+# graphics stream and to initialize the datapath to the kernel.
+# The workstation is not physically opened until the GKI open workstation
+# directive has been sent to the kernel.  There are two types of kernels,
+# the builtin (STDGRAPH) kernel, and all external kernels.  The external
+# kernels reside in connected subprocesses communicating via the central
+# process (the CL process) with the graphics task in another subprocess.
+
+procedure gtr_openws (devspec, mode, stream, source_pid)
+
+char	devspec[ARB]		#I device specification
+int	mode			#I access mode
+int	stream			#I graphics stream
+int	source_pid		#I process which issued the openws directive
+
+int	redir_code, dd[LEN_GKIDD], ip
+pointer	sp, op, tr, tty, kernfname, taskname, device
+
+bool	streq()
+pointer	ttygdes()
+int	pr_getredir(), ttygets(), gtr_connect(), pr_findproc(), locpr()
+extern	gtr_reset(), prpsio()
+
+errchk	syserr, syserrs, fseti, ttygdes, ttycdes, pr_redir, stg_close, stg_open
+errchk	gtr_connect, gtr_disconnect
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (kernfname, SZ_FNAME, TY_CHAR)
+	call salloc (taskname, SZ_FNAME, TY_CHAR)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+
+	tr = trdes[stream]
+
+	# Extract the device name field from the device specification.
+	op = device
+	for (ip=1;  devspec[ip] != EOS;  ip=ip+1)
+	    if (devspec[ip] == ',')
+		break
+	    else {
+		Memc[op] = devspec[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# We only connect up the i/o channels, and do not issue the OPENWS
+	# to the gio kernel, so reset the counter to zero to indicate that
+	# the workstation has not yet been (logically) opened.
+
+	TR_WSOPEN(tr) = 0
+
+	# If the stream has been redirected into a file, do not connect a
+	# kernel.
+
+	redir_code = pr_getredir (source_pid, stream)
+	if (redir_code >= FIRST_FD && redir_code <= LAST_FD) {
+	    call sfree (sp)
+	    return
+	}
+
+	# The graphics stream is a spoolfile in this process (the CL process).
+	# Spoolfiles are files that are fully buffered in memory and never
+	# get written to disk.  Data is written into the spoolfile and then
+	# read back out by a different part of the program.
+
+	call fseti (stream, F_TYPE, SPOOL_FILE)
+	call fseti (stream, F_CANCEL, OK)
+
+	# If the device is already connected to the stream (or we are
+	# appending to a connected device) all we need do is reset the
+	# redirection code for the graphics stream.  This code is reset to
+	# the default value (the code for the stream itself) by the CL when
+	# a task is spawned.
+
+	if (TR_DEVNAME(tr) != EOS && mode == APPEND ||
+		streq (devspec, TR_DEVNAME(tr))) {
+	    call pr_redir (source_pid, stream, TR_REDIR(tr))
+	    call sfree (sp)
+	    return
+	}
+
+	# Connect the named kernel, i.e., disconnect the old kernel if any
+	# and connect the new one.  Set the redirection information for the
+	# named stream of the source process.
+
+	iferr {
+	    # Close device graphcap descriptor.
+	    if (TR_TTY(tr) != NULL)
+		call ttycdes (TR_TTY(tr))
+
+	    # Disconnect old kernel.
+	    if (streq (TR_KERNFNAME(tr), "cl"))
+		call stg_close()
+	    else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		call gtr_disconnect (TR_PID(tr), TR_IN(tr), TR_OUT(tr), stream)
+		TR_PID(tr) = NULL
+		TR_IN(tr) = NULL
+		TR_OUT(tr) = NULL
+	    }
+	} then {
+	    TR_DEVNAME(tr) = EOS
+	    call erract (EA_ERROR)
+	} else
+	    TR_DEVNAME(tr) = EOS
+
+	# Get graphcap entry for the new device.  The special device name
+	# "none" indicates that there is no suitable stdgraph device.
+
+	if (streq (devspec, "none")) {
+	    switch (stream) {
+	    case STDGRAPH:
+		call syserr (SYS_GGNONE)
+	    case STDIMAGE:
+		call syserr (SYS_GINONE)
+	    case STDPLOT:
+		call syserr (SYS_GPNONE)
+	    default:
+		call syserr (SYS_GGNONE)
+	    }
+	} else {
+	    tty = ttygdes (Memc[device])
+	    TR_TTY(tr) = tty
+	}
+
+	# Get the name of the executable file containing the kernel for the
+	# device.  The special name "cl" signifies the builtin STDGRAPH kernel.
+
+	if (ttygets (tty, "kf", Memc[kernfname], SZ_FNAME) <= 0) {
+	    call ttycdes (tty)
+	    call syserrs (SYS_GNOKF, Memc[device])
+	} else if (ttygets (tty, "tn", Memc[taskname], SZ_FNAME) <= 0)
+	    ;
+
+	# Connect the new kernel.
+	call strcpy (Memc[kernfname], TR_KERNFNAME(tr), SZ_KERNFNAME)
+
+	if (streq (Memc[kernfname], "cl")) {
+	    # Open the stdgraph kernel.  Connect the referenced GKI stream to
+	    # the stdgraph kernel.  Set a negative redirection code value to
+	    # flag that GIOTR is to be called to filter graphics output from
+	    # the process.
+
+	    call stg_open (devspec, dd, STDIN, STDOUT, 0, 0, 0)
+	    call gki_inline_kernel (stream, dd)
+	    if (source_pid != NULL)
+		call pr_redir (source_pid, stream, -stream)
+	    TR_REDIR(tr) = -stream
+	    TR_INTERACTIVE(tr) = YES
+
+	} else {
+	    # Spawn subprocess and start up kernel task.
+	    TR_PID(tr) = gtr_connect (Memc[kernfname], Memc[taskname],
+		devspec, stream, TR_IN(tr), TR_OUT(tr))
+
+	    # Encode the process slot number of the kernel process in the
+	    # redirection code for the source process (the process which
+	    # issued the openws).  If the stream is STDGRAPH or STDIMAGE
+	    # make the redirection code negative to flag that graphics
+	    # output is to be processed through GIOTR (the workstation
+	    # transformation).
+
+	    if (source_pid != NULL) {
+		redir_code = (pr_findproc(TR_PID(tr)) * KSHIFT) + stream
+		if (stream == STDGRAPH || stream == STDIMAGE)
+		    redir_code = -redir_code
+		call pr_redir (source_pid, stream, redir_code)
+		TR_REDIR(tr) = redir_code
+
+		# Mark the process busy.  This flags it it as busy executing
+		# some subprotocol (in this case processing GKI metacode) and
+		# prevents commands such as chdir/set from being sent to the
+		# process and corrupting the IPC protocol.
+
+		call prseti (TR_PID(tr), PR_STATUS, P_BUSY)
+	    }
+
+	    call gki_subkernel (stream, TR_PID(tr), locpr(prpsio))
+	    TR_INTERACTIVE(tr) = NO
+	}
+
+	# Do not change value of DEVNAME until the new kernel has been
+	# successfully connected, since this variable is used to test if
+	# the kernel is already connected.
+
+	call strcpy (devspec, TR_DEVNAME(tr), SZ_TRDEVNAME)
+
+	# Post the gtr_reset procedure to be executed upon process shutdown,
+	# to close down any connected graphics subkernels in an orderly way.
+
+	call onexit (gtr_reset)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrpage.x b/sys/gio/cursor/gtrpage.x
new file mode 100644
index 00000000..2caa53cb
--- /dev/null
+++ b/sys/gio/cursor/gtrpage.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_PAGE -- Prepare the workstation for output of one or more pages of text.
+# Whether or not the terminal is paged is optional.  On terminals where the
+# text and graphics are overlaid, it is possible to run the text by beneath
+# the plot without affecting the plot.
+
+procedure gtr_page (fd, stream)
+
+int	fd			# output file
+int	stream			# graphics stream
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	if (TR_PAGE(tr) == YES)
+	    call gki_deactivatews (stream, AW_CLEAR)
+	else
+	    call gki_deactivatews (stream, 0)
+
+	TR_WAITPAGE(tr) = YES
+end
diff --git a/sys/gio/cursor/gtrptran.x b/sys/gio/cursor/gtrptran.x
new file mode 100644
index 00000000..eba3075e
--- /dev/null
+++ b/sys/gio/cursor/gtrptran.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_PTRAN -- Set the workstation transformation.  The workstation
+# transformation is automatically zeroed whenever the screen is cleared
+# or when a workstation is opened.
+
+procedure gtr_ptran (stream, x1, x2, y1, y2)
+
+int	stream			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+
+pointer	tr
+real	tol, min_width, dx, dy
+real	cx1, cx2, cy1, cy2
+include	"gtr.com"
+
+begin
+	tr = trdes[stream]
+	tol = 5.0 * EPSILON
+
+	if (abs(x1) < tol && abs (x2 - 1.0) < tol &&
+	    abs(y1) < tol && abs (y2 - 1.0) < tol) {
+
+	    wstranset = NO
+
+	} else {
+	    # Save viewport.
+	    vx1 = x1
+	    vx2 = x2
+	    vy1 = y1
+	    vy2 = y2
+
+	    # Clip viewport at NDC boundary.
+	    cx1 = max (0., min (1., x1))
+	    cx2 = max (0., min (1., x2))
+	    cy1 = max (0., min (1., y1))
+	    cy2 = max (0., min (1., y2))
+
+	    # Make sure the viewport does not have a zero extent in either
+	    # axis after clipping.
+	    min_width = 1E-4
+	    if (cx2 - cx1 < min_width)
+		cx2 = cx1 + min_width
+	    if (cy2 - cy1 < min_width)
+		cy2 = cy1 + min_width
+
+	    # Set clipping viewport in input GKI space.
+	    mx1 = nint (cx1 * GKI_MAXNDC)
+	    mx2 = nint (cx2 * GKI_MAXNDC)
+	    my1 = nint (cy1 * GKI_MAXNDC)
+	    my2 = nint (cy2 * GKI_MAXNDC)
+
+	    # Set transformation upon the clipped GKI coordinates.
+	    dx = max (min_width, (x2 - x1))
+	    dy = max (min_width, (y2 - y1))
+	    xorigin = (cx1 - x1) / dx * GKI_MAXNDC
+	    yorigin = (cy1 - y1) / dy * GKI_MAXNDC
+	    xscale = 1. / dx
+	    yscale = 1. / dy
+
+	    wstranset = YES
+	}
+
+	# Clear the scratch buffer whenever the workstation viewport is
+	# changed.
+
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+end
diff --git a/sys/gio/cursor/gtrrcur.x b/sys/gio/cursor/gtrrcur.x
new file mode 100644
index 00000000..495117a3
--- /dev/null
+++ b/sys/gio/cursor/gtrrcur.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GTR_READCURSOR -- Read the graphics cursor position in NDC coordinates.
+# By the time we are called the plot has already been drawn and the
+# workstation closed, hence we must reopen the workstation to read the
+# cursor (the graphics terminal will not be in graphics mode otherwise).
+
+int procedure gtr_readcursor (fd, key, sx, sy, raster, rx, ry)
+
+int	fd			#I graphics stream
+int	key			#O keystroke value
+real	sx, sy			#O NDC screen coords of cursor
+int	raster			#O raster number
+real	rx, ry			#O NDC raster coords of cursor
+
+int	cn
+int	m_sx, m_sy
+int	m_rx, m_ry
+
+begin
+	call gki_getcursor (fd, 0,
+	    cn, key, m_sx, m_sy, raster, m_rx, m_ry)
+
+	sx = real(m_sx) / GKI_MAXNDC
+	sy = real(m_sy) / GKI_MAXNDC
+	rx = real(m_rx) / GKI_MAXNDC
+	ry = real(m_ry) / GKI_MAXNDC
+
+	return (key)
+end
diff --git a/sys/gio/cursor/gtrredraw.x b/sys/gio/cursor/gtrredraw.x
new file mode 100644
index 00000000..ca2191b3
--- /dev/null
+++ b/sys/gio/cursor/gtrredraw.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_REDRAW -- Redraw the screen from the metacode spooled in the frame
+# buffer.
+
+procedure gtr_redraw (stream)
+
+int	stream			# graphics stream to be redrawn
+
+pointer	tr, ip_save, op_save
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	if (TR_SPOOLDATA(tr) == YES && TR_OP(tr) > TR_FRAMEBUF(tr)) {
+	    # Rewind the input pointer into the frame buffer.
+	    TR_IP(tr) = TR_FRAMEBUF(tr)
+
+	    # Redraw frame buffer.
+	    call gki_clear (stream)
+	    call giotr (stream)
+
+	    # Redraw scratch buffer (axes).  Set i/o pointers to the scratch
+	    # buffer and draw its contents.  Turn off interrupts to prevent
+	    # an interrupt from leaving the pointers pointing to the wrong
+	    # buffer.
+
+	    if (TR_OPSB(tr) > TR_SCRATCHBUF(tr)) {
+		call intr_disable()
+		ip_save = TR_IP(tr);	TR_IP(tr) = TR_SCRATCHBUF(tr)
+		op_save = TR_OP(tr);	TR_OP(tr) = TR_OPSB(tr)
+
+		call giotr (stream)
+
+		TR_IP(tr) = ip_save
+		TR_OP(tr) = op_save
+		call intr_enable()
+	    }
+
+	    # Flush graphics output.
+	    call gki_flush (stream)
+	}
+end
diff --git a/sys/gio/cursor/gtrreset.x b/sys/gio/cursor/gtrreset.x
new file mode 100644
index 00000000..36c55a9a
--- /dev/null
+++ b/sys/gio/cursor/gtrreset.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_RESET -- Reset the graphics system.  Disconnect all connected subkernels
+# and free all file descriptors and memory.
+
+procedure gtr_reset (status)
+
+int	status				# not used (req. for ONEXIT)
+
+pointer	tr
+int	stream
+bool	streq()
+include	"gtr.com"
+
+begin
+	do stream = STDGRAPH, STDPLOT {
+	    tr = trdes[stream]
+	    if (tr == NULL)
+		next
+
+	    iferr {
+		# Close device graphcap descriptor.
+		if (TR_TTY(tr) != NULL)
+		    call ttycdes (TR_TTY(tr))
+
+		# Disconnect old kernel.
+		if (streq (TR_KERNFNAME(tr), "cl"))
+		    call stg_close()
+		else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		    call gtr_disconnect (TR_PID(tr),
+			TR_IN(tr), TR_OUT(tr), stream)
+		    TR_PID(tr) = NULL
+		    TR_IN(tr) = NULL
+		    TR_OUT(tr) = NULL
+		}
+	    } then {
+		TR_DEVNAME(tr) = EOS
+		call erract (EA_WARN)
+	    } else
+		TR_DEVNAME(tr) = EOS
+
+	    # Free all storage.
+	    call mfree (TR_FRAMEBUF(tr), TY_SHORT)
+	    call mfree (TR_SCRATCHBUF(tr), TY_SHORT)
+	    call mfree (tr, TY_STRUCT)
+
+	    trdes[stream] = NULL
+	}
+end
diff --git a/sys/gio/cursor/gtrset.x b/sys/gio/cursor/gtrset.x
new file mode 100644
index 00000000..629ef097
--- /dev/null
+++ b/sys/gio/cursor/gtrset.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTRSET -- Set the workstation transformation.  The workstation transformation
+# is automatically zeroed whenever the screen is cleared or when a workstation
+# is opened.
+
+procedure gtrset (fd, x1, x2, y1, y2)
+
+int	fd			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+include	"gtr.com"
+
+begin
+	mx1 = x1 * GKI_MAXNDC
+	mx2 = x2 * GKI_MAXNDC
+	my1 = y1 * GKI_MAXNDC
+	my2 = y2 * GKI_MAXNDC
+
+	xscale = GKI_MAXNDC / (mx2 - mx1)
+	yscale = GKI_MAXNDC / (my2 - my1)
+
+	wstranset = YES
+end
diff --git a/sys/gio/cursor/gtrstatus.x b/sys/gio/cursor/gtrstatus.x
new file mode 100644
index 00000000..45b5731c
--- /dev/null
+++ b/sys/gio/cursor/gtrstatus.x
@@ -0,0 +1,100 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+
+define	LEN_NAME	10
+
+
+# GTR_STATUS -- Print information summarizing the utilization of resources
+# by each of the three graphics streams.
+
+procedure gtr_status (fd)
+
+int	fd			# output file
+int	stream, ip
+string	names "STDGRAPH:,STDIMAGE:,STDPLOT: "
+include	"gtr.com"
+
+begin
+	for (ip=1;  names[ip] != EOS;  ip=ip+1)
+	    if (names[ip] == ',')
+		names[ip] = EOS
+
+	do stream = STDGRAPH, STDPLOT {
+	    ip = (stream - STDGRAPH) * LEN_NAME + 1
+	    if (trdes[stream] == NULL) {
+		call fprintf (fd, "\t%s disconnected\n")
+		    call pargstr (names[ip])
+	    } else
+		call gtr_memusage (fd, stream, names[ip])
+	}
+
+	call fprintf (fd, "\n")
+	call flush (fd)
+end
+
+
+# GTR_MEMUSAGE -- Print information summarizing the utilization of memory and
+# other resources by a graphics stream.
+
+procedure gtr_memusage (fd, stream, name)
+
+int	fd			# output file
+int	stream			# graphics stream to be described
+char	name[ARB]		# name of graphics stream
+
+pointer	tr, tx
+int	bufsize
+int	fstati()
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	call fprintf (fd, "\t%s kernel=%s, device=%s, page %s\n")
+	    call pargstr (name)
+	    call pargstr (TR_KERNFNAME(tr))
+	    call pargstr (TR_DEVNAME(tr))
+	    if (TR_PAGE(tr) == YES)
+		call pargstr ("enabled")
+	    else
+		call pargstr ("disabled")
+
+	bufsize = fstati (stream, F_BUFSIZE)
+	call fprintf (fd,
+	    "\t\tmemory=%d (%dfb+%dsb+%dfio), frame=%d+%d words\n")
+	    call pargi (TR_LENFRAMEBUF(tr) + TR_LENSCRATCHBUF(tr) + bufsize)
+	    call pargi (TR_LENFRAMEBUF(tr))
+	    call pargi (TR_LENSCRATCHBUF(tr))
+	    call pargi (bufsize)
+	    call pargi (TR_OP(tr) - TR_FRAMEBUF(tr))
+	    call pargi (TR_OPSB(tr) - TR_SCRATCHBUF(tr))
+
+	call fprintf (fd,
+	    "\t\tspool=%s, nopen=%d, pid=%d, in=%d, out=%d, redir=%d, wcs=%d\n")
+	    if (TR_SPOOLDATA(tr) == YES)
+		call pargstr ("yes")
+	    else
+		call pargstr ("no")
+	    call pargi (TR_NOPEN(tr))
+	    call pargi (TR_PID(tr))
+	    call pargi (TR_IN(tr))
+	    call pargi (TR_OUT(tr))
+	    call pargi (TR_REDIR(tr))
+	    call pargi (TR_WCS(tr))
+
+	tx = TR_TXAP(tr)
+	call fprintf (fd,
+	    "\t\ttext size=%g, up=%d, path=%s, hj=%s, vj=%s, color=%d\n")
+	    call pargr (TX_SIZE(tx))
+	    call pargi (TX_UP(tx))
+	    call gkp_txparg (TX_PATH(tx))
+	    call gkp_txparg (TX_HJUSTIFY(tx))
+	    call gkp_txparg (TX_VJUSTIFY(tx))
+	    call pargi (TX_COLOR(tx))
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/cursor/gtrtrunc.x b/sys/gio/cursor/gtrtrunc.x
new file mode 100644
index 00000000..6abda3ba
--- /dev/null
+++ b/sys/gio/cursor/gtrtrunc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_TRUNCATE -- Truncate the frame buffer, which has grown larger than
+# the limit set by the user (or the system default).  This is done by moving
+# the metacode data at the end of the buffer (beginning with the word pointed
+# to by gki) to the maximum upper limit of the buffer and adjusting the input
+# and output pointers accordingly.
+
+procedure gtr_truncate (tr, gki)
+
+pointer	tr			# giotr descriptor
+pointer	gki			# pointer to first word to be preserved
+pointer	top
+int	nwords
+
+begin
+	# Find the first instruction preceding the soft upper limit on the
+	# size of the buffer.
+
+	top = TR_FRAMEBUF(tr) + TR_MAXLENFRAMEBUF(tr)
+	while (Mems[top] != BOI && top > TR_FRAMEBUF(tr))
+	    top = top - 1
+
+	# Move the partial instruction likely to be at the end of the buffer
+	# to the new "top".  Note that we can only truncate (discard)
+	# instructions which have already been executed, hence the partial
+	# instruction at the end of the buffer must be preserved.
+
+	if (gki != top) {
+	    nwords = TR_OP(tr) - gki
+	    call amovs (Mems[gki], Mems[top], nwords)
+	    TR_IP(tr) = top
+	    TR_OP(tr) = top + nwords
+	}
+end
diff --git a/sys/gio/cursor/gtrundo.x b/sys/gio/cursor/gtrundo.x
new file mode 100644
index 00000000..5b8d3e02
--- /dev/null
+++ b/sys/gio/cursor/gtrundo.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_UNDO -- Undo the last frame buffer edit.  Successive pairs of undos leave
+# the frame buffer unchanged.
+
+procedure gtr_undo (stream)
+
+int	stream				# graphics stream
+int	opcode
+pointer	tr, op, new_op, old_op, sp, ap
+
+pointer	gtr_init()
+errchk	gtr_init
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_PL, TY_STRUCT)
+
+	tr = gtr_init (stream)
+
+	old_op = TR_OP(tr)
+	new_op = TR_LASTOP(tr)
+	if (new_op == old_op || new_op <= TR_FRAMEBUF(tr)) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Edit the frame buffer.
+	TR_LASTOP(tr) = old_op
+	TR_OP(tr) = new_op
+	TR_IP(tr) = min (new_op, TR_IP(tr))
+
+	# Redraw the last drawing instruction to erase it (device permitting),
+	# if we are backing up one instruction.  Note that it may be necessary
+	# to skip one or more control instructions.  We assume that the undo
+	# only has to undo one drawing instruction.
+
+	if (new_op < old_op) {
+	    op = new_op
+	    repeat {
+		opcode = Mems[op+GKI_HDR_OPCODE-1]
+		if (opcode == GKI_POLYLINE)
+		    break
+		else
+		    op = op + Mems[op+GKI_HDR_LENGTH-1]
+	    } until (op >= old_op)
+
+	    if (opcode == GKI_POLYLINE && op < old_op) {
+		PL_LTYPE(ap) = GL_CLEAR
+		PL_WIDTH(ap) = 1.0
+		PL_COLOR(ap) = 1
+		call gki_plset (stream, ap)
+
+		if (wstranset == YES)
+		    call gtr_wstran (Mems[op])
+		else
+		    call gki_write (stream, Mems[op])
+
+		PL_LTYPE(ap) = GL_SOLID
+		call gki_plset (stream, ap)
+	    }
+
+	} else if (new_op > old_op) {
+	    # Call giotr to redraw the recovered instructions.
+	    call giotr (stream)
+	}
+
+	call gki_flush (stream)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrwaitp.x b/sys/gio/cursor/gtrwaitp.x
new file mode 100644
index 00000000..67f46dd8
--- /dev/null
+++ b/sys/gio/cursor/gtrwaitp.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<error.h>
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GTR_WAITPAGE -- Print the "hit return to continue" message on the terminal
+# screen and wait for the user to respond before returning to graphics mode.
+# Redrawing of the graphics frame is optional.
+
+procedure gtr_waitpage (fd, stream)
+
+int	fd			# output file
+int	stream			# graphics stream
+
+int	key, i
+pointer	tty, tr
+int	getci(), ttystati()
+pointer	ttyodes(), gtr_init()
+errchk	gtr_init, ttyodes
+
+begin
+	tr = gtr_init (stream)
+	tty = ttyodes ("terminal")
+
+	repeat {
+	    # Print prompt in standout mode.
+	    call ttyclearln (fd, tty)
+	    call ttyso (fd, tty, YES)
+	    call fprintf (fd,
+		"[space=cmhelp,return=quit+redraw,q=quit+noredraw]")
+	    call ttyso (fd, tty, NO)
+	    call flush (fd)
+
+	    # Wait for user to hit a key.  This is done in text mode via
+	    # a raw getc rather than via a cursor read to avoid switching to
+	    # graphics mode.  On some terminals with separate text and
+	    # graphics planes a switch to graphics mode turns off the text
+	    # plane.
+
+	    call fseti (STDIN, F_RAW, YES)
+	    if (getci (STDIN, key) == EOF)
+		key = '\r'
+	    call fseti (STDIN, F_RAW, NO)
+
+	    # Take the action commanded by the user.  At present the morehelp
+	    # option merely prints cursor mode help; this is appropriate
+	    # because the first waitpage call occurs after printing user help
+	    # in response to ? (or after a :.show).
+
+	    switch (key) {
+	    case 'q':
+		# Quit, do not clear graphics and redraw.
+		if (TR_PAGE(tr) == NO) {
+		    # If screen paging is disabled (text drawn underneath
+		    # transparent graphics overlay), clear the text frame
+		    # only, using the clear line function.
+
+		    do i = 1, ttystati (tty, TTY_NLINES) {
+			call ttygoto (fd, tty, 1, i)
+			call ttyclearln (fd, tty)
+		    }
+		} else
+		    call ttyclearln (fd, tty)
+
+		call flush (fd)
+		call gki_reactivatews (stream, 0)
+		break
+
+	    case '\r', '\n':
+		# Quit, clear graphics and redraw.
+		call ttyclearln (fd, tty)
+		call flush (fd)
+		call gki_reactivatews (stream, 0)
+		call gtr_redraw (stream)
+		break
+
+	    case ' ':
+		# Print cursor mode help.
+		iferr (call pagefile (KEYSFILE, "cursor mode help"))
+		    call erract (EA_WARN)
+
+	    default:
+		# Illegal keystroke.
+		call printf ("\007")
+		call flush (STDOUT)
+	    }
+	}
+
+	call ttycdes (tty)
+end
diff --git a/sys/gio/cursor/gtrwcur.x b/sys/gio/cursor/gtrwcur.x
new file mode 100644
index 00000000..9def0a67
--- /dev/null
+++ b/sys/gio/cursor/gtrwcur.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GTR_WRITECURSOR -- Write the graphics cursor position in NDC coordinates.
+
+procedure gtr_writecursor (fd, x, y)
+
+int	fd			# graphics stream
+real	x, y			# NDC coords of cursor
+
+int	mx, my
+
+begin
+	mx = max(0, min(GKI_MAXNDC, nint (x * GKI_MAXNDC)))
+	my = max(0, min(GKI_MAXNDC, nint (y * GKI_MAXNDC)))
+
+	call gki_setcursor (fd, mx, my, 0)
+end
diff --git a/sys/gio/cursor/gtrwritep.x b/sys/gio/cursor/gtrwritep.x
new file mode 100644
index 00000000..d1a3fd4a
--- /dev/null
+++ b/sys/gio/cursor/gtrwritep.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<gio.h>
+include	<gki.h>
+include "gtr.h"
+
+# GTR_WRITEP -- Virtually write (append) to the graphics frame buffer.  Return a
+# pointer to the start of the area reserved for the data and advance the
+# output pointer beyond the new data area.  The use of a buffer pointer here
+# yields a very efficient graphics i/o dataflow.  For the stdgraph kernel,
+# XMIT (pr_psio) places a block of metacode directly in the frame buffer at
+# the memory location we point to.  GIOTR is then called to process the new
+# data block.  GIOTR calls GTR_FETCH, which "fetches" the next instruction
+# by merely returning a pointer into the frame buffer.  The stdgraph kernel
+# is then called to execute the instruction.  Hence in the simple case, there
+# are no memory to memory copies and the contents of an instruction are
+# touched only by the kernel.
+
+pointer procedure gtr_writep (fd, nchars)
+
+int	fd			# graphics stream
+int	nchars			# nchars to reserve at end of buffer
+
+pointer	tr, bufp, top, segp
+int	blen, nwords, ip_offset, op_offset
+errchk	syserr, realloc
+include	"gtr.com"
+
+begin
+	tr = trdes[fd]
+	if (tr == NULL)
+	    call syserr (SYS_GWRITEP)
+
+	nwords = nchars / SZ_SHORT
+	bufp = TR_FRAMEBUF(tr)
+	blen = TR_LENFRAMEBUF(tr)
+	segp = TR_OP(tr)			# pointer to next segment
+	top  = bufp + blen
+
+	# Make space available in the buffer.  We must always allocate the
+	# requested space, even if the result is a buffer larger than the
+	# (soft) maximum size permitted.  Buffer space will be returned
+	# after GIOTR processes the new instructions if the buffer grows
+	# too large.
+
+	if (nwords > top - segp) {
+	    # Note that realloc may move the buffer, hence we must adjust any
+	    # pointers into the buffer after the call to realloc.
+	    
+	    ip_offset = TR_IP(tr) - bufp
+	    op_offset = segp - bufp
+	    blen = blen + max (INC_LENFRAMEBUF, nwords)
+
+	    call realloc (bufp, blen, TY_SHORT)
+
+	    TR_FRAMEBUF(tr) = bufp
+	    TR_LENFRAMEBUF(tr) = blen
+	    TR_IP(tr) = bufp + ip_offset
+	    segp = bufp + op_offset
+	} 
+
+	TR_OP(tr) = segp + nwords
+	TR_LASTOP(tr) = TR_OP(tr)
+
+	return (segp)
+end
diff --git a/sys/gio/cursor/gtrwsclip.x b/sys/gio/cursor/gtrwsclip.x
new file mode 100644
index 00000000..3a0a384b
--- /dev/null
+++ b/sys/gio/cursor/gtrwsclip.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTR_POLYCLIP -- Clip a convex polygon to a box.  If the polygon is entirely
+# outside the box 0 is returned; if the polygon is entirely within the box 1
+# is returned, otherwise the polygon is clipped and a value other than 0 or 1
+# is returned.  This is based on code by Paul Heckbert from Graphics Gems,
+# 1985/1989.
+
+int procedure gtr_polyclip (pv, npts, x1, x2, y1, y2)
+
+short	pv[ARB]			#U polygon to be clipped
+int	npts			#U number of points in polygon
+int	x1,x2,y1,y2		#I clipping box
+
+pointer	sp, p1, p2, pt
+int	x1out, x2out, y1out, y2out, i
+int	gtr_cliptoplane()
+define	nopts_ 91
+
+begin
+	x1out = 0;  x2out = 0
+	y1out = 0;  y2out = 0
+
+	# Count vertices which are outside with respect to each of the
+	# four planes.
+
+	do i = 1, npts*2, 2 {
+	    if (pv[i+0] < x1)  x1out = x1out + 1
+	    if (pv[i+0] > x2)  x2out = x2out + 1
+	    if (pv[i+1] < y1)  y1out = y1out + 1
+	    if (pv[i+1] > y2)  y2out = y2out + 1
+	}
+
+	# Is the polygon entirely inside the clipping box?
+	if (x1out + x2out + y1out + y2out == 0)
+	    return (1)
+
+	# Is the polygon entirely outside the clipping box?
+	if (x1out == npts || x2out == npts || y1out == npts || y2out == npts)
+	    return (0)
+
+	# If we get here the polygon partially intersects the clipping box.
+	# Clip against each of the planes that might cut the polygon, clipping
+	# the previously clipped polygon in each step.  This is done in
+	# floating point to minimize accumulation of error when interpolating
+	# to the clipping plane to compute a new polygon vertex when the plane
+	# is crossed.
+
+	call smark (sp)
+	call salloc (p1, npts * 4, TY_REAL)
+	p2 = p1 + npts * 2
+
+	call achtsr (pv, Memr[p1], npts * 2)
+
+	if (x1out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 0, -1.0, real(x1)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (x2out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 0,  1.0, real(x2)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (y1out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 1, -1.0, real(y1)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (y2out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 1,  1.0, real(y2)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+
+	call achtrs (Memr[p1], pv, npts * 2)
+	call sfree (sp)
+	return (npts)
+
+nopts_
+	call sfree (sp)
+	return (0)
+end
+
+
+# GTR_CLIPTOPLANE --  Clip the convex polygon P1 against a plane, copying
+# the inbounds portion to the output polygon P2.
+
+int procedure gtr_cliptoplane (p1, p2, npts, index, s, ref)
+
+pointer	p1			#I pointer to input polygon
+pointer	p2			#I pointer to output polygon
+int	npts			#U number of polygon points or vertices
+int	index			#I index of coordinate to be tested
+real	s			#I sign for comparison
+real	ref			#I value to compare against
+
+int	nout, i
+pointer	op, u, v
+real	tu, tv, t
+
+begin
+	nout = 0
+	op = p2
+
+	u = p1 + (npts - 1) * 2
+	tu = s * Memr[u+index] - ref
+	v = p1
+
+	do i = 1, npts {
+	    # On old polygon P1, U is previous vertex, V is current vertex,
+	    # TV is negative if vertex V is in.
+
+	    tv = s * Memr[v+index] - ref
+
+	    if (! ((tu <= 0 && tv <= 0) || (tu > 0 && tv > 0))) {
+		# Edge crosses plane; add intersection point to P2.
+		t = tu / (tu - tv)
+		Memr[op+0] = Memr[u+0] + t * (Memr[v+0] - Memr[u+0])
+		Memr[op+1] = Memr[u+1] + t * (Memr[v+1] - Memr[u+1])
+		nout = nout + 1
+		op = op + 2
+	    }
+
+	    if (tv <= 0) {
+		# Vertex V is in, copy it out.
+		Memr[op+0] = Memr[v+0]
+		Memr[op+1] = Memr[v+1]
+		nout = nout + 1
+		op = op + 2
+	    }
+
+	    u = v
+	    tu = tv
+	    v = v + 2
+	}
+
+	npts = nout
+	return (nout)
+end
diff --git a/sys/gio/cursor/gtrwstran.x b/sys/gio/cursor/gtrwstran.x
new file mode 100644
index 00000000..9262e00a
--- /dev/null
+++ b/sys/gio/cursor/gtrwstran.x
@@ -0,0 +1,490 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+define	MOVE		0
+define	DRAW		1
+define	LEFT		0
+define	RIGHT		1
+define	BELOW		0
+define	ABOVE		1
+define	INSIDE		2
+define	FIRSTPT		GKI_POLYLINE_P
+
+
+# GTR_WSTRAN -- Apply the workstation transformation to an instruction and
+# write the transformed instruction to the graphics kernel.  The transformation
+# parameters etc. should have been initialized in the gtr common before we
+# are called.
+
+procedure gtr_wstran (gki)
+
+short	gki[ARB]		#I metacode instruction to be spooled
+
+long	x, y
+pointer	sp, buf
+int	length, npts, data
+int	gtr_polyclip()
+bool	sge_wsenable()
+include	"gtr.com"
+
+begin
+	# Check with the graphics kernel to see if scaling of graphics
+	# instructions is enabled (it is disabled if the graphics device is
+	# already doing it for us).
+
+	if (!sge_wsenable()) {
+	    call gki_write (tr_stream, gki)
+	    return
+	}
+
+	switch (gki[GKI_HDR_OPCODE]) {
+	case GKI_FILLAREA:
+	    npts = gki[GKI_FILLAREA_N]
+	    data = GKI_FILLAREA_P
+	    length = gki[GKI_HDR_LENGTH]
+	    call amovs (gki, pl, length)
+
+	    switch (gtr_polyclip (pl[data], npts, mx1, mx2, my1, my2)) {
+	    case 0:
+		# Entire instruction out of bounds.
+	    case 1:
+		# Entire instruction in bounds.
+		pl_op = GKI_POLYLINE_P + npts * 2
+		call gpt_flush()
+	    default:
+		# Instruction has been clipped.
+		pl_op = GKI_POLYLINE_P + npts * 2
+		call gpt_flush()
+	    }
+
+	case GKI_POLYLINE, GKI_POLYMARKER:
+	    call gtr_polytran (gki)
+
+	case GKI_SETCURSOR:
+	    length = gki[GKI_HDR_LENGTH]
+	    call smark (sp)
+	    call salloc (buf, length, TY_SHORT)
+
+	    # Move cursor to edge of screen if point referenced is out of
+	    # bounds.
+
+	    call amovs (gki, Mems[buf], length)
+	    x = gki[GKI_SETCURSOR_POS]
+	    y = gki[GKI_SETCURSOR_POS+1]
+	    call gtr_ctran (x, y, x, y)
+	    Mems[buf+GKI_SETCURSOR_POS-1] = x
+	    Mems[buf+GKI_SETCURSOR_POS]   = y
+	    call gki_write (tr_stream, Mems[buf])
+
+	    call sfree (sp)
+
+	case GKI_TEXT:
+	    length = gki[GKI_HDR_LENGTH]
+	    call smark (sp)
+	    call salloc (buf, length, TY_SHORT)
+
+	    # Discard text drawing instruction if the point referenced is
+	    # out of bounds.  If in bounds, transform coordinates and draw
+	    # at the transformed point.
+
+	    call amovs (gki, Mems[buf], length)
+	    x = gki[GKI_TEXT_P]
+	    y = gki[GKI_TEXT_P+1]
+	    if (x >= mx1 && x <= mx2 && y >= my1 && y <= my2) {
+		call gtr_ctran (x, y, x, y)
+		Mems[buf+GKI_TEXT_P-1] = x
+		Mems[buf+GKI_TEXT_P]   = y
+		call gki_write (tr_stream, Mems[buf])
+	    }
+
+	    call sfree (sp)
+
+	case GKI_PUTCELLARRAY:
+	    # Just filter these out for now.
+
+	default:
+	    call gki_write (tr_stream, gki)
+	}
+end
+
+
+# GTR_CTRAN -- Apply the workstation transform to a set of GKI coordinates,
+# i.e., transform raw GKI coords to screen coords in GKI units.
+
+procedure gtr_ctran (mx, my, sx, sy)
+
+int	mx, my			# raw GKI coordinates
+int	sx, sy			# screen coordinates in GKI units
+include	"gtr.com"
+
+begin
+	sx = max(0, min(GKI_MAXNDC, nint ((mx - mx1) * xscale + xorigin)))
+	sy = max(0, min(GKI_MAXNDC, nint ((my - my1) * yscale + yorigin)))
+end
+
+
+# GTR_POLYTRAN -- Scale a polyline, polymarker, or fill area instruction
+# by applying the workstation transformation.  The workstation transformation
+# scales vectors in a viewport defined in NDC(GKI) space to fit the full
+# device screen.  Vectors or segments of vectors lying outside the viewport
+# are clipped at the screen boundary.
+
+procedure gtr_polytran (gki)
+
+short	gki[ARB]		# gki instruction to be transformed
+long	mx, my
+int	last_ip, opcode, i, ip
+bool	inbounds, otherside, points
+int	gpt_firstpt()
+include	"gtr.com"
+
+begin
+	last_ip = gki[GKI_HDR_LENGTH]
+	opcode  = gki[GKI_HDR_OPCODE]
+	points  = (opcode == GKI_POLYMARKER)
+
+	# In the process of clipping a polyline may be broken into several
+	# smaller polylines (or polymarkers or fillareas, all of which are
+	# very similar at the instruction level).  We store the GKI header
+	# in the first few words of the PL array so that when the transformed
+	# polyline is broken it is ready for execution.
+
+	do i = 1, GKI_POLYLINE_P - 1
+	    pl[i] = gki[i]
+	pl_op = GKI_POLYLINE_P
+
+	# Clip all points until either a point is encountered which is inbounds
+	# or which is on the other side of the viewport (in either axis).  This
+	# is a fast way of clipping polylines which are mostly out of bounds.
+	# Return immediately if the entire vector is out of bounds.
+
+	otherside = true
+	ip = FIRSTPT
+	if (gpt_firstpt (gki, ip, last_ip) <= 0)
+	    return
+
+	# Set initial position.
+	cx = gki[ip]
+	cy = gki[ip+1]
+
+	# Clip the remaining points.  Clipping is performed in GKI coordinates.
+	# The workstation transformation is not applied until the clipped
+	# vector is output.
+
+	for (ip=ip+2;  ip < last_ip;  ip=ip+2) {
+	    mx = gki[ip]
+	    my = gki[ip+1]
+
+	    # Check to see if this is the first point of a new polyline.
+	    # If so we must set the first physical point in the output
+	    # polyline to the current position, making the current point
+	    # the second physical point of the output polyline.
+
+	    if (pl_op <= GKI_POLYLINE_P) {
+		# Place the current pen position in the polyline as the
+		# first point if it is inbounds.
+
+		if (cy <= my2 && cy >= my1 && cx <= mx2 && cx >= mx1) {
+		    last_point_inbounds = true
+		    pl[pl_op] = cx
+		    pl_op = pl_op + 1
+		    pl[pl_op] = cy
+		    pl_op = pl_op + 1
+		} else {
+		    last_point_inbounds = false
+		    do i = 1, 4 {
+			xs[i] = cx
+			ys[i] = cy
+		    }
+		}
+	    }
+
+	    # Update the current position.
+
+	    cx = mx
+	    cy = my
+
+	    # Clip at the edge of the device screen.
+
+	    inbounds = (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1)
+
+	    if (inbounds && (last_point_inbounds || points)) {
+		# Add point to polyline (the fast way).
+		pl[pl_op] = mx
+		pl_op = pl_op + 1
+		pl[pl_op] = my
+		pl_op = pl_op + 1
+
+	    } else if ((inbounds||last_point_inbounds||otherside) && !points) {
+		# Clip at viewport boundary.
+
+		if (last_point_inbounds) {
+		    # Update coords of last point drawn (necessary since we did
+		    # not use the clipping code for inbounds points).
+		    do i = 1, 4 {
+			xs[i] = pl[pl_op-2]
+			ys[i] = pl[pl_op-1]
+		    }
+		}
+		call gpt_clipl (DRAW, mx, my)
+		otherside = false
+
+	    } else {
+		# Both points are out of bounds.  Scan along until a point is
+		# found which is again in bounds, or which is on the other side
+		# of the viewport, requiring clipping across the viewport.
+
+		if (gpt_firstpt (gki, ip, last_ip) > 0) {
+		    do i = 1, 4 {
+			xs[i] = gki[ip]
+			ys[i] = gki[ip+1]
+		    }
+		    cx = gki[ip]
+		    cy = gki[ip+1]
+		}
+
+		otherside = true
+		inbounds = false
+	    }
+
+	    last_point_inbounds = inbounds
+	}
+
+	call gpt_flush()
+end
+
+
+# GPT_FIRSTPT -- Scan a vector and return the index of the next good point.
+# A good point is a point which is either inbounds or which preceeds a point
+# which is either inbounds or on the other side of the viewport, necessitating
+# clipping across the viewport.
+
+int procedure gpt_firstpt (gki, ip, last_ip)
+
+short	gki[ARB]			# vector being clipped
+int	last_ip				# last legal value of ip
+int	ip				# starting index
+
+int	mx, my, i
+int	first_ip, new_ip
+include	"gtr.com"
+
+begin
+	mx = gki[ip]
+	my = gki[ip+1]
+	first_ip = ip
+	new_ip = last_ip
+
+	if (mx < mx1) {
+	    do i=ip+2, last_ip, 2
+		if (gki[i] >= mx1) {
+		    new_ip = i
+		    break
+		}
+	} else if (mx > mx2) {
+	    do i=ip+2, last_ip, 2
+		if (gki[i] <= mx2) {
+		    new_ip = i
+		    break
+		}
+	} else if (my < my1) {
+	    do i=ip+3, last_ip, 2
+		if (gki[i] >= my1) {
+		    new_ip = i - 1
+		    break
+		}
+	} else if (my > my2) {
+	    do i=ip+3, last_ip, 2
+		if (gki[i] <= my2) {
+		    new_ip = i - 1
+		    break
+		}
+	} else
+	    return (ip)
+
+	if (new_ip >= last_ip)
+	    return (0)			# entire vector is indefinite
+	else
+	    ip = max (first_ip, new_ip - 2)
+
+	return (ip)
+end
+
+
+# GPT_CLIPL -- Clip at left boundary.
+
+procedure gpt_clipl (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_my
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx >= mx1 && xs[1] < mx1) || (mx <= mx1 && xs[1] > mx1)) {
+	    if (mx >= mx1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_my = real(my - ys[1]) * real(mx1 - mx) / real(mx - xs[1]) +
+		my + 0.5
+	    call gpt_clipr (newpen, mx1, new_my)
+	}
+
+	xs[1] = mx
+	ys[1] = my
+
+	if (mx >= mx1)
+	    call gpt_clipr (pen, mx, my)
+end
+
+
+# GPT_CLIPR -- Clip at right boundary.
+
+procedure gpt_clipr (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_my
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx <= mx2 && xs[2] > mx2) || (mx >= mx2 && xs[2] < mx2)) {
+	    if (mx <= mx2)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_my = real(my - ys[2]) * real(mx2 - mx) / real(mx - xs[2]) +
+		my + 0.5
+	    call gpt_clipb (newpen, mx2, new_my)
+	}
+
+	xs[2] = mx
+	ys[2] = my
+
+	if (mx <= mx2)
+	    call gpt_clipb (pen, mx, my)
+end
+
+
+# GPT_CLIPB -- Clip at bottom boundary.
+
+procedure gpt_clipb (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_mx
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((my >= my1 && ys[3] < my1) || (my <= my1 && ys[3] > my1)) {
+	    if (my >= my1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_mx = real(mx - xs[3]) * real(my1 - my) / real(my - ys[3]) +
+		mx + 0.5
+	    call gpt_clipt (newpen, new_mx, my1)
+	}
+
+	xs[3] = mx
+	ys[3] = my
+
+	if (my >= my1)
+	    call gpt_clipt (pen, mx, my)
+end
+
+
+# GPT_CLIPT -- Clip at top boundary and put the final clipped point(s) in
+# the output polyline.  Note that a "move" at this level does not affect
+# the current position (cx,cy), since the vector endpoints have been clipped
+# and the current position vector follows the unclipped vector points input
+# by the user.
+
+procedure gpt_clipt (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((my <= my2 && ys[4] > my2) || (my >= my2 && ys[4] < my2)) {
+	    if (my <= my2 || pen == MOVE)
+		call gpt_flush()
+	    pl[pl_op] = real(mx - xs[4]) * real(my2 - my) / real(my - ys[4]) +
+		mx + 0.5
+	    pl_op = pl_op + 1
+	    pl[pl_op] = my2
+	    pl_op = pl_op + 1
+	}
+
+	xs[4] = mx
+	ys[4] = my
+
+	if (my <= my2) {
+	    if (pen == MOVE)
+		call gpt_flush()
+	    pl[pl_op] = mx
+	    pl_op = pl_op + 1
+	    pl[pl_op] = my
+	    pl_op = pl_op + 1
+	}
+end
+
+
+# GPT_FLUSH -- Flush the buffered "polyline", i.e., array of transformed and
+# clipped points.  For a polyline or fill area polygon there must be at least
+# two points (4 cells) or it will be discarded.  A single point polymarker is
+# permitted.
+
+procedure gpt_flush()
+
+int	npts, i
+long	mx, my
+include	"gtr.com"
+
+begin
+	if (pl_op >= GKI_POLYLINE_P + 2) {
+	    npts = (pl_op - GKI_POLYLINE_P) / 2
+
+	    # Apply the workstation transformation.
+	    do i = GKI_POLYLINE_P, pl_op, 2 {
+		mx = nint ((pl[i]   - mx1) * xscale + xorigin)
+		my = nint ((pl[i+1] - my1) * yscale + yorigin)
+		pl[i]   = max(0, min(GKI_MAXNDC, mx))
+		pl[i+1] = max(0, min(GKI_MAXNDC, my))
+	    }
+
+	    switch (pl[GKI_HDR_OPCODE]) {
+	    case GKI_POLYMARKER:
+		pl[GKI_POLYMARKER_L] = pl_op - 1
+		pl[GKI_POLYMARKER_N] = npts
+		call gki_write (tr_stream, pl)
+
+	    case GKI_FILLAREA:
+		pl[GKI_FILLAREA_L] = pl_op - 1
+		pl[GKI_FILLAREA_N] = npts
+		call gki_write (tr_stream, pl)
+
+	    default:
+		if (npts >= 2) {
+		    pl[GKI_POLYLINE_L] = pl_op - 1
+		    pl[GKI_POLYLINE_N] = npts
+		    call gki_write (tr_stream, pl)
+		}
+	    }
+
+	    pl_op = GKI_POLYLINE_P
+	}
+end
diff --git a/sys/gio/cursor/mkpkg b/sys/gio/cursor/mkpkg
new file mode 100644
index 00000000..f6a79332
--- /dev/null
+++ b/sys/gio/cursor/mkpkg
@@ -0,0 +1,57 @@
+# Make the CURSOR package.
+
+$checkout libcur.a lib$
+$update   libcur.a
+$checkin  libcur.a lib$
+$exit
+
+libcur.a:
+	# $set xflags = "$(xflags) -qfx"
+
+	giotr.x		gtr.com gtr.h <config.h> <gio.h> <gki.h> <xwhen.h>
+	grcaxes.x	grc.h gtr.com gtr.h <gio.h> <gset.h>
+	grcclose.x	grc.h gtr.h <gio.h>
+	grccmd.x	grc.h gtr.h <ctype.h> <fset.h> <gio.h> <gki.h>\
+			<gset.h> <mach.h> <ttyset.h>
+	grcinit.x	grc.h <gio.h>
+	grcopen.x	grc.h gtr.com gtr.h <gio.h> <gki.h>
+	grcpl.x		gtr.h <gio.h> <gki.h> <gset.h> grc.h
+	grcread.x	gtr.h <fset.h> <gio.h>
+	grcredraw.x	grc.h <gio.h>
+	grcscr.x	gtr.com gtr.h <gio.h> <gki.h>
+	grcstatus.x	grc.h gtr.com gtr.h <gio.h>
+	grctext.x	gtr.h <gio.h> <gki.h> <gset.h> grc.h
+	grcwarn.x	
+	grcwcs.x	grc.h gtr.h <gio.h> <gki.h> <mach.h>
+	grcwrite.x	grc.h gtr.h <fset.h> <gio.h>
+	gtrbackup.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtrconn.x	
+	gtrctrl.x	gtr.com gtr.h <fset.h> <gio.h> <gki.h> <gset.h>\
+			<prstat.h> <config.h>
+	gtrdelete.x	gtr.h <gio.h> <gki.h>
+	gtrdiscon.x	<gio.h>
+	gtrfetch.x	gtr.h <gio.h> <gki.h>
+	gtrframe.x	gtr.h <gio.h> <gki.h>
+	gtrgflush.x	gtr.com gtr.h <error.h> <gio.h>
+	gtrgtran.x	gtr.com gtr.h <gio.h> <gki.h>
+	gtrgtty.x	gtr.h <gio.h> <gki.h>
+	gtrinit.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtropenws.x	gtr.com gtr.h <config.h> <error.h> <fio.h> <prstat.h>\
+			<fset.h> <gio.h> <gki.h>
+	gtrpage.x	gtr.h <gio.h> <gset.h>
+	gtrptran.x	gtr.com gtr.h <gio.h> <gki.h> <mach.h>
+	gtrrcur.x	<gki.h>
+	gtrredraw.x	gtr.h <gio.h>
+	gtrreset.x	gtr.com gtr.h <error.h> <gio.h>
+	gtrset.x	gtr.com gtr.h <gio.h> <gki.h>
+	gtrstatus.x	gtr.com gtr.h <fset.h> <gio.h>
+	gtrtrunc.x	gtr.h <gio.h> <gki.h>
+	gtrundo.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtrwaitp.x	grc.h gtr.h <error.h> <fset.h> <gio.h> <ttyset.h>
+	gtrwcur.x	<gki.h>
+	gtrwritep.x	gtr.com <error.h> <gio.h> <gki.h> gtr.h
+	gtrwstran.x	gtr.com gtr.h <gio.h> <gki.h> <mach.h>
+	gtrwsclip.x
+	prpsinit.x
+	rcursor.x	grc.h gtr.com gtr.h <ctype.h> <gio.h> <gki.h> <ttset.h>
+	;
diff --git a/sys/gio/cursor/prpsinit.x b/sys/gio/cursor/prpsinit.x
new file mode 100644
index 00000000..4959deff
--- /dev/null
+++ b/sys/gio/cursor/prpsinit.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PRPSINIT -- Load the gio.cursor graphics driver for pseudofile i/o to the
+# graphics streams.
+
+procedure prpsinit()
+
+extern	giotr()
+extern	gtr_control(), gtr_gflush(), gtr_writep()
+extern	stg_readtty(), stg_writetty()
+
+begin
+	call prpsload (giotr, gtr_control, gtr_gflush, gtr_writep,
+	    stg_readtty, stg_writetty)
+end
diff --git a/sys/gio/cursor/rcursor.x b/sys/gio/cursor/rcursor.x
new file mode 100644
index 00000000..cc7dc739
--- /dev/null
+++ b/sys/gio/cursor/rcursor.x
@@ -0,0 +1,692 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<ttset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	SZ_CHARCON	5
+define	MARKLEN		0.01
+
+# Cursor step algorithm parameters.
+
+define	MAX_STEP	0.1		# max cursor step size, cursor motions
+define	MIN_STEP	0.002		# min cursor step size, cursor motions
+define	LARGER_STEP	2.0		# factor by which step size is increased
+define	SMALLER_STEP	0.5		# factor by step size is decreased
+define	NSTEP		2		# number of steps before larger step
+define	MANUAL_STEP	5.0		# gear ratio for F/V cursor control
+define	SLOW		1		# for fast/slow algorithm
+define	FAST		2
+
+# Zoom parameters.
+
+define	X_ZOOMFACTOR	0.5		# zoom factors
+define	Y_ZOOMFACTOR	0.5
+#define	X_ZOOMFACTOR	0.666		# zoom factors
+#define	Y_ZOOMFACTOR	0.666
+
+# Roam factors.
+
+define	X_ROAM		0.333		# fraction of the current window
+define	Y_ROAM		0.333		# fraction of the current window
+
+
+# RCURSOR -- Read the position of a cursor.  This is the main entry point to
+# cursor mode/cursor input from the CL; we are called by the QUERY procedure
+# of the CL when a cursor type parameter is read.  The cursor position is
+# returned as a string of the form
+#
+#	x y wcs key stringval
+#
+# where the "stringval" field may be absent if not appropriate for a given key.
+# If EOF is returned the cursor value string is undefined.
+
+int procedure rcursor (stream, outstr, maxch)
+
+int	stream			# graphics stream
+char	outstr[ARB]		# encoded cursor value (output)
+int	maxch
+
+bool	cminit
+int	xroam[9], yroam[9]
+pointer	rc, tr, sp, lbuf, ip
+char	charcon[SZ_CHARCON], ch
+real	x1, x2, y1, y2, xt, yt, v[10]
+real	lx1, lx2, ly1, ly2, aspect_ratio
+real	x, y, rx, ry, xw, yw, dx, dy, xc, yc
+int	junk, key, nukey, last_zoom, i, wcs, ppos, ucasein, raster
+
+bool	ttygetb()
+pointer	grc_open()
+int	envfind(), ctocc(), oscmd(), gtr_readcursor(), grc_readtty()
+int	grc_cursor(), grc_command(), grc_selectwcs(), grc_mapkey(), ttstati()
+real	ttygetr()
+
+errchk	grc_text, grc_readtty, grc_writecursor
+errchk	grc_init, grc_open, grc_command, grc_cursor, grc_message
+errchk	grc_readcursor, grc_mapkey, grc_redraw, envfind
+
+data	xroam /1,0,-1,1,0,-1,1,0,-1/
+data	yroam /1,1,1,0,0,0,-1,-1,-1/
+data	rc /NULL/
+define	done_ 91
+define	coloncmd_ 92
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_COMMAND, TY_CHAR)
+
+	# Allocate and initialize the RCURSOR descriptor.
+	if (rc == NULL) {
+	    call grc_init (rc)
+	    cminit = true
+	} else
+	    cminit = false
+
+	# Open or reopen the graphics kernel.
+	tr = grc_open ("", APPEND, stream, rc)
+
+	# Process CMINIT command string, if present in environment.  This is
+	# only done once.
+
+	if (cminit) {
+	    if (envfind ("cminit", Memc[lbuf], SZ_COMMAND) > 0) {
+		ip = lbuf
+		while (IS_WHITE(Memc[ip]) || Memc[ip] == '.')
+		    ip = ip + 1
+		junk = grc_command (rc, stream, 0.,0.,0,0.,0., Memc[ip])
+	    }
+	    cminit = false
+	}
+
+	# If the graphics device does not permit input, i.e., does not have
+	# a cursor, return EOF.
+
+	if (!ttygetb (TR_TTY(tr), "in")) {
+	    x = 0; y = 0
+	    key = EOF
+	    goto done_
+	}
+
+	# Determine if input keys are to be mapped to lower case by default,
+	# i.e., ucasein mode has been set for the terminal driver.
+
+	ucasein = ttstati (STDIN, TT_UCASEIN)
+
+	last_zoom = 3
+	ppos = NO
+
+	# Enter cursor mode loop.  The loop terminates when a non cursor mode
+	# keystroke is typed.
+
+	while (grc_cursor (rc, stream, key,x,y, raster,rx,ry, ppos) != EOF) {
+	    Memc[lbuf] = EOS
+
+	    # As a rule, no processing is performed on escaped keys.  The only
+	    # exception is when ucasein mode is set in the terminal driver,
+	    # causing upper case input to be mapped to lower case.  This mapping
+	    # is disabled in a raw mode cursor read, hence we must perform the
+	    # mapping explicitly here, returning a lower case key to the
+	    # applications program.  Unescaped upper case input keystrokes will
+	    # be intercepted by cursor mode when ucasein mode is in effect.
+
+	    if (key == '\\') {
+		junk = gtr_readcursor (stream, key, x, y, raster, rx, ry)
+		if (ucasein == YES && IS_UPPER(key))
+		    key = TO_LOWER (key)
+		break
+	    }
+
+	    # Map keystroke.  If the keystroke maps to a null value the key
+	    # is not recognized as a cursor mode keystroke and we exit.
+
+	    if (grc_mapkey (rc, key, nukey) == NULL)
+		break
+
+	    switch (nukey) {
+	    case 'M':
+		# Move the feature under the cursor to the center of the
+		# screen without changing the scaling.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) / 2.
+		yw = (y2 - y1) / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+
+	    case 'Z':
+		# Zoom in in both X and Y.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) * X_ZOOMFACTOR / 2.
+		yw = (y2 - y1) * Y_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 3
+
+	    case 'X':
+		# Zoom in in X.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) * X_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, y1, y2)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 1
+
+	    case 'Y':
+		# Zoom in in Y.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		yw = (y2 - y1) * Y_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, x1, x2, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 2
+
+	    case '>':
+		# Zoom in in Y by setting the upper limit of the viewport
+		# to the cursor Y position.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call gtr_ptran (stream, lx1, lx2, ly1,  yc)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, x, 0.5)
+		last_zoom = 'E'
+
+	    case '<':
+		# Zoom in in Y by setting the lower limit of the viewport
+		# to the cursor Y position.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call gtr_ptran (stream, lx1, lx2,  yc, ly2)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, x, 0.5)
+		last_zoom = 'E'
+
+	    case 'E':
+		# Expand by marking corners of new viewport.  If the range is
+		# small in either X or Y only the other axis will be expanded.
+
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call grc_scrtondc (x, y, x1, y1)
+		call grc_message (stream, "again:")
+		junk = grc_cursor (rc, stream, key,x2,y2, raster,rx,ry, ppos)
+		call grc_scrtondc (x2, y2, x2, y2)
+
+		if (x1 > x2)
+		    { xt = x2;  x2 = x1;  x1 = xt }
+		if (y1 > y2)
+		    { yt = y2;  y2 = y1;  y1 = yt }
+
+		if (abs (x1 - x2) < .01)
+		    call gtr_ptran (stream, lx1, lx2, y1, y2)
+		else if (abs (y1 - y2) < .01)
+		    call gtr_ptran (stream, x1, x2, ly1, ly2)
+		else
+		    call gtr_ptran (stream, x1, x2, y1, y2)
+
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, 0.5, 0.5)
+		last_zoom = 'E'
+
+	    case 'P':
+		# Zoom out.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+
+		if (last_zoom == 'E') {
+		    call gtr_ptran (stream, lx1, lx2, ly1, ly2)
+		    lx1 = x1; lx2 = x2; ly1 = y1; ly2 = y2
+		} else {
+		    if (last_zoom == 1 || last_zoom == 3) {
+			xw = (x2 - x1) / X_ZOOMFACTOR / 2.
+			x1 = xc - xw
+			x2 = xc + xw
+		    }
+		    if (last_zoom == 2 || last_zoom == 3) {
+			yw = (y2 - y1) / Y_ZOOMFACTOR / 2.
+			y1 = yc - yw
+			y2 = yc + yw
+		    }
+		    call gtr_ptran (stream, x1, x2, y1, y2)
+		}
+
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+
+	    case 'W':
+		# Select and fix WCS to be used for scr->wcs coordinate
+		# transformations.
+
+		call grc_scrtondc (x, y, xc, yc)
+		TR_WCS(tr) = grc_selectwcs (tr, raster, xc, yc)
+
+	    case 'C':
+		# Running tally of cursor position.
+		#if (ppos == NO) {
+		#    call grc_pcursor (stream, x, y, raster, rx, ry)
+		#    ppos = YES
+		#} else {
+		#    call grc_message (stream, "\n\n")
+		#    ppos = NO
+		#}
+
+		call grc_pcursor (stream, x, y, raster, rx, ry)
+
+	    case 'D':
+		# Draw a line by marking the endpoints.
+		call grc_scrtondc (x, y, v[1], v[2])
+		call grc_message (stream, "again:")
+		junk = grc_cursor (rc, stream, key,x2,y2, raster,rx,ry, ppos)
+		call grc_scrtondc (x2, y2, v[3], v[4])
+		call grc_polyline (stream, v, 2)
+
+	    case 'T':
+		# Draw a text string.
+		if (grc_readtty (stream, "text: ", Memc[lbuf], SZ_COMMAND) <= 0)
+		    next
+		call grc_scrtondc (x, y, xc, yc)
+		call grc_text (stream, xc, yc, Memc[lbuf])
+
+	    case 'A':
+		# Draw and label the axes of the viewport.
+		call grc_axes (stream, x, y, raster, rx, ry)
+
+	    case 'B':
+		# Backup one instruction in the frame buffer.
+		call gtr_backup (stream)
+
+	    case 'U':
+		# Undo the last frame buffer edit.
+		call gtr_undo (stream)
+
+	    case 'R':
+		# Redraw the screen.
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '0':
+		# Reset and redraw.
+		call gtr_ptran (stream, 0., 1., 0., 1.)
+		call gtr_writecursor (stream, .5, .5)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '5':
+		# Redraw (null roam request).
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '1','2','3','4','6','7','8','9':
+		# Roam.
+		i = TO_INTEG (key)
+		if (xroam[i] != 0 || yroam[i] != 0) {
+		    call gtr_gtran (stream, x1, x2, y1, y2)
+		    dx = (x2 - x1) * X_ROAM * xroam[i]
+		    dy = (y2 - y1) * Y_ROAM * yroam[i]
+		    call gtr_ptran (stream, x1+dx, x2+dx, y1+dy, y2+dy)
+		    call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		}
+
+	    case ':':
+		# Enter a colon command string and terminate cursor mode.
+
+		# Get the string value.
+		if (grc_readtty (stream, ":", Memc[lbuf], SZ_COMMAND) <= 0)
+		    next
+
+		# All cursor mode commands must begin with a ".".  An osescape
+		# begins with an "!".
+
+		if (Memc[lbuf] == '!') {
+		    call gtr_page (STDERR, stream)
+		    if (oscmd (Memc[lbuf+1], "", "", "") == ERR)
+			call fprintf (STDERR, "\7")
+		    call gtr_waitpage (STDERR, stream)
+		    
+		} else if (Memc[lbuf] == '.') {
+		    # Save viewport for 'P'.
+coloncmd_
+		    call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		    last_zoom = 'E'
+
+		    TR_WAITPAGE(tr) = NO
+		    if (grc_command (rc, stream, x, y, raster, rx, ry,
+			    Memc[lbuf+1]) == EOF) {
+			key = EOF
+			goto done_
+		    }
+
+		    # The following is a no-op for most colon commands.
+		    if (TR_WAITPAGE(tr) == YES)
+			call gtr_waitpage (STDERR, stream)
+		} else
+		    break
+
+	    case '=':
+		# Shorthand for :.snap.  The latter must be used once to
+		# set the plotter device, else the default stdplot device
+		# will be used.
+
+		call strcpy (".snap", Memc[lbuf], SZ_COMMAND)
+		goto coloncmd_
+
+	    default:
+		call fprintf (STDERR, "\007")
+	    }
+	}
+
+	# Mark the cursor position if markcur enabled.
+	if (RC_MARKCUR(rc) == YES && key != EOF) {
+	    call grc_scrtondc (x, y, xc, yc)
+	    aspect_ratio = ttygetr (TR_TTY(tr), "ar")
+	    if (aspect_ratio < .001)
+		aspect_ratio = 1.0
+
+	    v[1]  = xc - MARKLEN * aspect_ratio
+	    v[2]  = yc
+	    v[3]  = xc + MARKLEN * aspect_ratio
+	    v[4]  = yc
+	    v[5]  = xc
+	    v[6]  = yc
+	    v[7]  = xc
+	    v[8]  = yc - MARKLEN
+	    v[9]  = xc
+	    v[10] = yc + MARKLEN
+	    call grc_polyline (stream, v, 5)
+	}
+
+	# Close the workstation, leave graphics mode, position alpha cursor to
+	# lower left corner of graphics terminal.
+
+	call grc_close (stream, rc)
+
+	# Encode the cursor value as a string for the CL.
+done_
+	if (key != EOF) {
+	    if (key == ' ')
+		call strcpy ("\\40", charcon, SZ_CHARCON)
+	    else {
+		ch = char (key)
+		junk = ctocc (ch, charcon, SZ_CHARCON)
+	    }
+	    call grc_scrtowcs (stream, x, y, raster, rx, ry, xc, yc, wcs)
+
+	    call sprintf (outstr, maxch, "%g %g %d %s %s\n")
+		call pargr (xc)
+		call pargr (yc)
+		call pargi (wcs)
+		call pargstr (charcon)
+		call pargstr (Memc[lbuf])
+	} else
+	    outstr[1] = EOS
+
+	call sfree (sp)
+	return (key)
+end
+
+
+# GRC_CURSOR -- Read the position of a cursor in screen coordinates.  Recognizes
+# the cursor movement keystrokes H, J, K, and L, exiting only when some other
+# keystroke is received.  The cursor movement algorithm is initialized upon
+# entry.  Two algorithms are provided for controlling the cursor step size.
+# The first algorithm (automatic control) starts with a large initial step
+# size.  In the vicinity of a feature the cursor will overshoot the feature
+# and the user will step back in the opposite direction, causing the step size
+# to be decreased, rapidly converging to the desired position.  Several steps
+# in the same direction cause the large step size to be restored.  The second
+# algorithm (manual control) uses the F and V keys to directly control the step
+# size.
+
+int procedure grc_cursor (rc, stream, key, x, y, raster, rx, ry, ppos)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+int	key			#O keystroke typed
+real	x, y			#O cursor screen coordinates
+int	raster			#O raster number
+real	rx, ry			#O cursor raster coordinates
+int	ppos			#I print cursor position flag
+
+int	speed
+int	xdir, ydir, nukey
+real	xstep, ystep, newx, newy
+
+bool	ttygetb()
+pointer	gtr_gtty()
+int	gtr_readcursor(), grc_mapkey()
+errchk	gtr_readcursor, gtr_writecursor
+
+begin
+	# Reset the cursor step size to the default.
+	xstep = MAX_STEP
+	ystep = MAX_STEP
+	xdir  = 0
+	ydir  = 0
+	speed = 0
+
+	while (gtr_readcursor (stream, key, x, y, raster, rx, ry) != EOF) {
+	    if (grc_mapkey (rc, key, nukey) == NULL)
+		break
+
+	    newx = x
+	    newy = y
+
+	    switch (nukey) {
+	    case 'F':
+		# Faster.
+		xstep = min (MAX_STEP, xstep * MANUAL_STEP)
+		ystep = min (MAX_STEP, ystep * MANUAL_STEP)
+		speed = FAST
+
+	    case 'V':
+		# Slower.
+		xstep = max (MIN_STEP, xstep / MANUAL_STEP)
+		ystep = max (MIN_STEP, ystep / MANUAL_STEP)
+		speed = SLOW
+
+	    case 'H':
+		# Step cursor left.
+		if (speed == 0)
+		    if (xdir < -NSTEP) {
+			xstep = MAX_STEP
+			xdir = -1
+		    } else if (xdir > 0) {
+			xstep = max (MIN_STEP, xstep * SMALLER_STEP)
+			xdir = -1
+		    } else
+			xdir = xdir - 1
+		newx = newx - xstep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'J':
+		# Step cursor down.
+		if (speed == 0)
+		    if (ydir < -NSTEP) {
+			ystep = MAX_STEP
+			ydir = -1
+		    } else if (ydir > 0) {
+			ystep = max (MIN_STEP, ystep * SMALLER_STEP)
+			ydir = -1
+		    } else
+			ydir = ydir - 1
+		newy = newy - ystep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'K':
+		# Step cursor up.
+		if (speed == 0)
+		    if (ydir > NSTEP) {
+			ystep = MAX_STEP
+			ydir = 1
+		    } else if (ydir < 0) {
+			ystep = max (MIN_STEP, ystep * SMALLER_STEP)
+			ydir = 1
+		    } else
+			ydir = ydir + 1
+		newy = newy + ystep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'L':
+		# Step cursor right.
+		if (speed == 0)
+		    if (xdir > NSTEP) {
+			xstep = MAX_STEP
+			xdir = 1
+		    } else if (xdir < 0) {
+			xstep = max (MIN_STEP, xstep * SMALLER_STEP)
+			xdir = 1
+		    } else
+			xdir = xdir + 1
+		newx = newx + xstep
+		call gtr_writecursor (stream, newx, newy)
+	    
+	    default:
+		break
+	    }
+
+	    # We assume the cursor may have moved if the WC capability exists
+	    # for this device.
+
+	    if (ttygetb (gtr_gtty (stream), "WC")) {
+		x = newx
+		y = newy
+	    }
+
+	    # Print the cursor position.
+	    if (ppos == YES)
+		call grc_pcursor (stream, x, y, raster, rx, ry)
+	}
+
+	return (key)
+end
+
+
+# GRC_MAPKEY -- Map keystroke.  If the keystroke maps to a null value the key
+# is not recognized as a cursor mode keystroke and we exit.  Note that if case
+# sensitivity is disabled, KEYS comparisions must be made in upper case but
+# only lower case is to be returned to the calling program.
+
+int procedure grc_mapkey (rc, key, nukey)
+
+pointer	rc			#I rcursor descriptor
+int	key			#U raw key value
+int	nukey			#O mapped key value
+
+begin
+	nukey = max(1, min(MAX_KEYS, key))
+	if (RC_CASE(rc) == NO && IS_LOWER(nukey))
+	    nukey = TO_UPPER(nukey)
+
+	nukey = RC_KEYS(rc,nukey)
+	if (nukey == NULL) {
+	    # Not a cursor mode key.
+	    if (RC_CASE(rc) == NO && IS_UPPER(nukey))
+		key = TO_LOWER(key)
+	} else if (IS_LOWER(nukey))
+	    nukey = TO_UPPER(nukey)
+
+	return (nukey)
+end
+
+
+# GRC_RESTORECURPOS -- Restore the cursor position in NDC coordinates
+# regardless of the current workstation transformation.
+
+procedure grc_restorecurpos (stream, x, y)
+
+int	stream			# graphics stream
+real	x, y			# new cursor position in NDC coords
+real	sx, sy
+include	"gtr.com"
+
+begin
+	call grc_ndctoscr (x, y, sx, sy)
+	call gtr_writecursor (stream, sx, sy)
+end
+
+
+# GRC_READTTY -- Read from the terminal via the graphics kernel.  If the
+# kernel already has message data buffered we merely return that data,
+# otherwise we issue the prompt given and interactively read the data.
+
+int procedure grc_readtty (stream, prompt, obuf, maxch)
+
+int	stream			#I graphics stream
+char	prompt[ARB]		#I prompt, if read is interactive
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars out
+
+bool	issue_prompt
+int	nchars, index
+int	stg_msglen(), stg_readtty()
+int	stridxs(), strlen()
+
+begin
+	issue_prompt = (stg_msglen(STDIN) <= 0)
+	if (issue_prompt)
+	    call stg_putline (STDERR, prompt)
+
+	nchars = stg_readtty (STDIN, obuf, maxch)
+	index = stridxs ("\n", obuf)
+	if (index > 0)
+	    obuf[index] = EOS
+	nchars = strlen (obuf)
+
+	if (issue_prompt && nchars == 0)
+	    call grc_message (stream, "\n\n")
+
+	return (nchars)
+end
+
+
+# GRC_MESSAGE -- Write a message on the status line at the bottom of the
+# screen.  If the string is not newline terminated the terminal is left in
+# status line text mode.  To clear the status line and force the terminal
+# back into graphics mode, output the string "\n\n".
+
+procedure grc_message (stream, message)
+
+int	stream			# graphics stream
+char	message[ARB]		# message to be printed
+
+begin
+	call stg_putline (STDERR, message)
+end
+
+
+# GRC_PCURSOR -- Convert the cursor position in screen coordinates to world
+# coordinates and print on the standard output.
+
+procedure grc_pcursor (stream, sx, sy, raster, rx, ry)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+int	wcs
+real	xc, yc
+pointer	sp, lbuf
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, xc, yc, wcs)
+	if (abs(xc) > 1 && abs(xc) < 10000 && abs(yc) > 1 && abs(yc) < 10000)
+	    call sprintf (Memc[lbuf], SZ_LINE, "%10.3f %10.3f  \n")
+	else
+	    call sprintf (Memc[lbuf], SZ_LINE, "%12.7g %12.7g  \n")
+	call pargr (xc)
+	call pargr (yc)
+
+	call stg_putline (STDERR, Memc[lbuf])
+	call sfree (sp)
+end
diff --git a/sys/gio/doc/gio.hlp b/sys/gio/doc/gio.hlp
new file mode 100644
index 00000000..f8749c23
--- /dev/null
+++ b/sys/gio/doc/gio.hlp
@@ -0,0 +1,3498 @@
+.help gio Dec84 "Graphics I/O"
+.ce
+\fBGraphics I/O Design\fR
+.ce
+Doug Tody
+.ce
+December 1984
+.ce
+(revised October 1987)
+.sp 3
+.nh
+Introduction
+
+    The graphics i/o (GIO) interface is a library of SPP or Fortran callable
+procedures for interactive vector graphics.  The interface is designed primarily
+for scientific applications (graphing 1-dimensional data vectors).  Limited
+support is also provided for displaying 2-dimensional image data.  GIO is fully
+integrated into the IRAF system and is not intended for use in systems other
+than IRAF.  The principal design objectives of GIO are outlined below.
+
+.ls
+.ls o
+Simple and efficient interactive graphics.  For interactive data analysis
+applications speed is typically much more important than the quality of
+the plot.
+.le
+.ls o
+Ease of use.  The interface must be easy to use for scientific data analysis
+applications.  Ease of use for interactive graphics in scientific applications
+is considered more important than the flexibility required to produce
+publication quality graphics.
+.le
+.ls o
+Compact size.  That portion of the graphics system required for interactive
+graphics must be small enough to be linked into every process which performs
+interactive graphics.
+.le
+.ls o
+Device independence.  The interface must be device independent without
+compromising compactness and speed.  True device independence means that
+an applications program that normally uses interactive graphics can be run
+noninteractively or from a nongraphics workstation.
+.le
+.le
+
+
+IRAF needs its own graphics interface partly because no existing graphics
+interface meets all of the above requirements, and partly because we do not
+want our applications to be dependent upon any particular external graphics
+package.  The existing large graphics interfaces such as GKS and CORE are
+likely to make it easier to interface GIO to new graphics devices, but to
+be completely and directly dependent on any one such interface is unwise since
+implementations are sometimes hard to come by.  Furthermore, packages such
+as GKS and CORE were designed to serve as the kernel of a graphics system
+and are cumbersome to use directly in applications software.  GIO will serve
+as a front end to the graphics kernel, providing a higher level interface
+for applications software and isolating the IRAF applications from the kernel,
+making it possible to switch to a different kernel without rewriting the
+applications packages.
+
+.nh
+Conceptual Design
+
+    GIO is intended to be used either as a self contained interface to a
+graphics device, with GIO writing device instructions directly to the device,
+or as an interface to a more general device independent graphics kernel.
+For maximum speed in interactive applications GIO will use a special builtin
+kernel capable of driving only the interactive graphics devices in use at
+a particular site (e.g., tektronix compatible graphics terminals).
+Other devices will be driven by a device independent graphics kernel resident
+in a separate process.  GIO will select the data path to be used for a
+particular device transparently to the calling program.  Thus, the overhead
+of process initiation and IPC will be eliminated in common interactive
+applications without sacrificing device independence.  The builtin kernel
+will be table driven using a \fBtermcap\fR format graphics device database,
+allowing maximum flexibility for adapting GIO to new graphics devices.
+
+The device independent graphics kernel may be GKS, CORE, NSPP, or any other
+reasonably capable kernel.  GIO will be designed to require only a few simple
+graphics primitives at the bottom end, making it straightforward to interface
+to different graphics kernels.  Any application which requires a more
+sophisticated graphics interface than that provided by GIO may bypass GIO
+and talk directly to the underlying graphics kernel, but doing so will
+render the application usable only with that particular graphics kernel.
+
+Placing the device independent graphics kernel in a separate process makes
+it possible to use a large, sophisticated graphics kernel without linking
+enormous libraries of subroutines into applications processes.  Bugs can be
+fixed and new features and devices added without relinking applications
+processes.  In principle it is even possible to interface simultaneously
+to more than one graphics kernel, e.g., one might drive some devices with
+an NSPP kernel and others with a GKS kernel.  On a different host CORE might
+be the only thing available and GIO would have to be interfaced to CORE on
+such a host.
+
+
+.ks
+.nf
+	        __________
+	       /          \
+	       | graphics |
+	       | terminal |
+	       \__________/
+		   |  ^
+		   |  |(device codes)
+		   v  |                           _________
+		+--------+     +-----------+     /         \
+		|   CL+  |<----| graphics  |<----|         |
+		|  fast  |     |  kernel   |     | gdevice |
+		| kernel |---->|   task    |---->|         |
+		+--------+     +-----------+     \_________/
+		   |  ^                 |
+		   |  |(gki metacode)   |          (core metacode)
+		   v  |                 +--------> (nspp metacode)
+		+--------+                         (gks vdm)
+		|  user  |
+		|  task  |-----------------------> (gki metacode)
+		+--------+
+
+
+	          simple                   plotters
+	  |---  interactive ---|------     metafile    ------|
+		 graphics               special devices
+
+
+.fi
+.ce
+Figure 1. Graphics Task Structure
+.ke
+
+
+The IRAF command language (CL) is the user interface to IRAF programs and
+as such moderates all interaction with the user, including interaction via
+graphics devices.  GIO is primarily a graphics \fIoutput\fR interface;
+graphics input (other than pixel readback) is decoupled from graphics output
+and is controlled by the CL.  Often the task requesting cursor input will
+differ from that which produced the graphics.  The CL, under control of the
+user, may set the default graphics input and output devices, redirect graphics
+input and/or output to devices other than the default, and control whether
+a graphics task is used interactively or in batch mode.
+
+.nh
+Specifications
+
+    The GIO graphics output procedures draw various flavors of vectors and
+fill or color two dimensional areas.  Cursor input is a way of interacting
+with the user and is therefore handled by CLIO (the command language
+interface).  We first define important terms and define the coordinate
+systems used by GIO.  Next follows an overview of the input and output
+procedures.  Finally, we describe in detail the individual procedures and
+the interface to the graphics kernel.
+
+.nh 2
+Coordinate Systems
+
+    The full plotting surface of a device defines the domain of definition
+of the coordinate systems used by GIO.
+GIO supports up to sixteen user defined \fBworld coordinate systems\fR
+(WCS) per open device, numbered 1 through 16.
+One additional coordinate system (WCS 0) with values ranging from 0 to 1 in
+either axis is predefined for every device; this \fBnormalized device
+coordinate system\fR (NDC) spans the full plotting surface of the device.  
+
+The mapping of world coordinates to device coordinates is
+defined by a \fBwindow\fR into world space and a corresponding \fBviewport\fR
+into device space.  Each window-viewport pair defines one of the 16 world
+coordinate systems.  At \fBgopen\fR time GIO is initialized to WCS 1,
+which has both window and viewport set to NDC coordinates.  A subsequent
+call to either \fBgswind\fR or \fBgscale\fR will set the window and a
+subsequent call to \fBgsview\fR will set the viewport.  The WCS is not fixed
+to the device until a plotting operation occurs which requires use of the WCS.
+Hence, multiple calls to \fBgscale\fR to determine the range of data values
+in X and Y for a family of curves are possible before fixing the WCS to the
+device, e.g. in a call to \fBglabax\fR.
+
+A \fBviewport\fR is any rectangular plotting area lying entirely within the
+plotting area of the device.  The viewport defines the area in which data
+can be plotted, i.e., the boundary at which \fBclipping\fR will occur if
+enabled.  The viewport is the area framed by \fBglabax\fR; the tick and axis
+labels will be plotted in the area just outside the viewport.
+A square viewport need not have the same resolution in both X and Y.
+Devices with variable resolution, e.g. pen plotters, have a default
+resolution in either axis which can be overridden when the plot is drawn.
+The aspect ratio of the device is the ratio of the physical size of a
+device pixel in Y to that in X.  Most devices have an aspect ratio of
+unity, but it is common for the resolution to be different in X and Y.
+The aspect ratio of the device is available via a \fBgget\fR inquiry,
+as is the device resolution in either axis.
+
+A \fBwindow\fR is the range of world coordinates which GIO will map to the
+corresponding viewport.  The world coordinates must be cartesian and
+either linear or logarithmic (base 10) in either axis.
+There are no restrictions on the range of world coordinates other than
+those imposed by the single precision floating point hardware of the
+host computer, provided that the WCS is not degenerate
+(zero range in either axis).
+
+Most applications will use only a single WCS, hence the WCS number is not
+included explicitly in the argument lists of the GIO procedures.
+A call to \fBgset\fR is required to change to a different WCS.
+Thereafter all graphics output and cursor input will refer to the new WCS.
+Multiple WCS are useful when plotting in several distinct (nonoverlapping)
+viewports on a device, or when overplotting curves within the same viewport
+but with different world coordinate windows.
+
+.nh 2
+Graphics Output Procedures
+
+    The GIO output procedures range from \fBgplotv\fR and \fBgploto\fR,
+which can draw an entire plot with autoscaling and axis labeling in one call,
+to the polyline, polymarker, move, draw, and text drawing primitives at
+the low end.
+
+
+.ks
+.nf
+	       gplotv (v, npts, x1, x2, title)
+	       gploto (gp, v, npts, x1, x2, title)
+	    gpagefile (gp, fname, prompt)
+		
+	   gp = gopen (device, mode, fd)
+	       gclose (gp)
+	  gdeactivate (gp, flags)
+	  greactivate (gp, flags)
+	      gcancel (gp)
+	       gflush (gp)
+	       gclear (gp)
+	       gframe (gp)
+	       greset (gp, flags)
+	     gmftitle (gp, metafile_title)
+
+	        gscan (gp, text)
+	    gset[irs] (gp, param, value)
+     val = gstat[irs] (gp, param[, outstr, maxch])
+     val = gget[birs] (gp, devcap[, outstr, maxch])
+	    g[sg]view (gp, x1, x2, y1, y2)
+	    g[sg]wind (gp, x1, x2, y1, y2)
+	   g[ar]scale (gp, v, npts, axis)
+	      ggscale (gp, x, y, dx, dy)
+	       gctran (gp, x1, y1, x2, y2, wcs1, wcs2)
+	      gcurpos (gp, x, y)
+	      gescape (gp, fn, instruction, nwords)
+
+	       glabax (gp, title, xlabel, ylabel)
+	        gline (gp, x1, y1, x2, y2)
+	       gpline (gp, x, y, npts)
+	       gvline (gp, v, npts, x1, x2)
+	        gmark (gp, x, y, marktype, xsize, ysize)
+	       gpmark (gp, x, y, npts, marktype, xsize, ysize)
+	       gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+	       gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+	    g[ar]move (gp, x, y)
+	    g[ar]draw (gp, x, y)
+		gtext (gp, x, y, text, format)
+		gfill (gp, x, y, npts, style)
+	    g[pg]cell (gp, m, nx, ny, x1, y1, x2, y2)
+
+	        gscur (gp, x, y)
+	 stat = ggcur (gp, x, y, key)
+.fi
+.ke
+
+
+All coordinates are given in world coordinates (user coordinates)
+except the viewport coordinates and the marker sizes, which are given in
+device coordinates.  Low level graphics i/o requires that the graphics
+device first be opened with \fBgopen\fR and later closed with \fBgclose\fR.
+Several graphics devices may be open simultaneously.
+
+When a graphics device is opened with \fBgopen\fR all internal parameters
+are initialized to their default values, unless the device is opened in
+APPEND mode.  The default values of these internal parameters may be changed
+via explicit \fBgset\fR, \fBgswind\fR, \fBgscale\fR, or \fBgscan\fR calls.
+Most powerful is \fBgscan\fR, which interprets graphics commands passed
+either as an explicit string or in a text file.
+
+Much of the flexibility of GIO derives from its parameter defaulting
+mechanism.  The interface may be expanded indefinitely by adding new
+internal parameters accessed via \fBgset\fR calls, without changing the
+basic interface.
+
+.nh 2
+Graphics Input Procedures
+
+    The most commonly used type of graphics input is cursor readback.
+Two forms of cursor input are supported: cursor input via the CLIO procedure
+\fBclgcur\fR, and cursor input via the GIO procedure \fBggcur\fR.
+CLIO based cursor input should be used whenever possible, i.e., when writing
+to \fBstdgraph\fR or \fBstdimage\fR.  The advantage of cursor input via the
+CL is that input may come from a list file or the terminal as well as from
+a physical cursor read, allowing programs to be used either interactively
+or in batch mode.  Furthermore, WCS selection and conversion of NDC cursor
+coordinates to WCS and cursor mode interaction are only available with
+\fBclgcur\fR.  Programs which do not produce any graphics output may read
+the cursor via CLIO without using any part of the GIO interface.
+The lower level GIO cursor read procedure always reads the physical device
+cursor in NDC coordinates and is device dependent (it is what is called by
+\fBclgcur\fR).
+
+Cursors are implemented as abstract datatypes within the CL.  A user task
+accesses a cursor by reading the value of a CL parameter of type \fBgcur\fR
+(stdgraph cursor) or \fBimcur\fR (stdimage cursor).  Multiple cursors may
+be implemented using multiple cursor type parameters.  A cursor parameter
+is assumed to have a \fIlist\fR of values; EOF is returned when the end of
+the list is reached.  Reading the cursor automatically causes any graphics
+output to be flushed.
+
+        stat = clgcur (param, wx, wy, wcs, key, strval, maxch)
+
+The CLIO function \fBclgcur\fR reads the next cursor value from the named
+cursor parameter, returning as output arguments the cursor position in world
+coordinates, the index of the referenced WCS, the keystroke value (character
+typed) of the cursor event, and a string value if the key was ':', the
+cursor mode set option escape character.
+A cursor read sequence begins with a prompt, i.e., the cursor lights up
+or starts blinking.  The user is then free to move the cursor about;
+the cursor position is not read until a key is typed on the user terminal.
+Using a keystroke on the user terminal to terminate both \fBstdgraph\fR
+and \fBstdimage\fR cursor reads provides a rich and device independent set of
+keystroke values for identifying the action to be performed (imaging devices
+are typically very limited in this area).
+
+GIO always returns the cursor position in world coordinates, along with
+the index of the WCS selected.  Typically there will be exactly one world
+coordinate system (excluding WCS 0) and the WCS value may be ignored.
+If no world coordinate systems are defined for the device the cursor
+position will be returned in NDC coordinates with WCS=0.
+
+If multiple world coordinate systems are defined GIO will select the WCS
+closest to the position of the cursor, i.e., the cursor may lie outside the
+viewport and GIO will still return WCS coordinates.  If the cursor lies
+within two or more overlapping viewports GIO will select the WCS with the
+highest number.  The cursor read protocol will allow the user to force
+the selection of a particular viewport by first placing the cursor on a
+nonoverlapping portion of the viewport and typing a special code,
+e.g., W (see next section), and then continuing with the normal cursor read.
+If the application wishes to override the automatic WCS selection it may
+do so by calling \fBgctran\fR to transform the cursor coordinates returned
+by \fBclgcur\fR to a different world coordinate system.
+
+.nh 3
+Cursor Mode
+
+    In cursor mode, i.e., after a call to \fBclgcur\fR or after typing "=gcur",
+a number of special keystrokes shall be recognized for interactive display
+control.  All graphics output to stdgraph and stdimage is routed through the
+CL on the way to the graphics kernel.  The CL will optionally spool in an
+internal buffer all graphics instructions output to an interactive device.
+This internal buffer is emptied whenever the device screen is cleared.
+In cursor mode, special keystrokes may be used to redraw all or any portion
+of the spooled graphics, e.g., one may zoom in on a portion of the plot and
+then roam about on the plot at high magnification.  Since the spooled graphics
+vectors typically contain more information than can be displayed at normal
+magnification, zooming in on a feature may bring out additional detail
+(the maximum resolution is 32768 points in either axis).  Increasing the
+magnification will increase the precision of the cursor by the same factor.
+
+Cursor mode is implemented by performing coordinate transformation and
+clipping on each GKI instruction in the frame buffer, passing the transformed
+and clipped instructions on to the graphics kernel.
+The cursor mode operations perform a simple geometric transformation on
+the spooled graphics frame, mapping a rectangular window of the spooled
+frame onto the device screen.  The graphics frame itself is not modified,
+hence zoom out or reset and redraw will restore the original display.
+
+If the graphics frame is a typical vector plot with drawn and labeled
+axes, magnifying a portion of the plot may cause the axes to be lost.
+If this is not what is desired a keystroke is provided to draw and label
+the axes of the displayed window.  The axes will be overplotted on the
+current display and will not be saved in the frame buffer, hence they
+will be lost when the frame is redrawn.  In cursor mode the viewport is
+the full display area of the output device, hence the tick mark labels
+of the drawn axes will be drawn inside the viewport.  This form of axes
+labeling is used because it is simple and because it is appropriate for
+both vector graphics and image display output devices (and cursor mode
+must serve both).
+
+
+.ks
+.nf
+	A 			draw and label the axes of current viewport
+	B			backup over last instruction in frame buffer
+	C			print the cursor position as it moves
+	D 			draw a line by marking the endpoints
+	E			expand plot by setting window corners
+	F			set fast cursor (for HJKL)
+	H			step cursor left
+	J			step cursor down
+	K			step cursor up
+	L			step cursor right
+	M			move point under cursor to center of screen
+	P			zoom out (restore previous expansion)
+	R			redraw the screen
+	T 			draw a text string
+	U 			undo last frame buffer edit
+	V			set slow cursor (for HJKL)
+	W 			select WCS at current position of cursor
+	X			zoom in, X only
+	Y			zoom in, Y only
+	Z			zoom in, both X and Y
+	<			set lower limit of plot to the cursor y value
+	>			set upper limit of plot to the cursor y value
+	\ 			escape next character
+	:			set cursor mode options
+	:!			send a command to the host system
+	=			shorthand for :.snap (make graphics hardcopy)
+	0			reset and redraw
+       1-9			roam
+.fi
+.ce
+Figure 2. Cursor Mode Keystrokes
+.ke
+
+
+By default the cursor mode keystrokes are all upper case letters, reserving
+lower case for applications programs.  The terminal shift lock key may be
+used to simplify typing in lengthy interactive cursor mode sessions.
+The cursor motions are decoupled from roam since zoom and roam are often used
+merely to increase the precision of a cursor read.  Special keystrokes are
+provided for stepwise cursor motions to increase the speed of cursor setting
+on terminals that do not have fast cursor motions (e.g., the retro-graphics
+enhanced VT100).  The recognized keystrokes are shown in Figure 2.
+
+If the character : is typed while in cursor mode the alpha cursor will appear
+at the bottom of the screen, allowing a command line to be entered.  Commands
+which begin with a period, e.g., ":." are interpreted by the graphics system;
+any other command will terminate the cursor read, returning the character ':'
+as the key value, and the command string as the string value of the cursor
+read.  The commands recognized by the graphics system are summarized in
+figure 3.
+
+
+.ks
+.nf
+	:.axes[+-]		draw axes of viewport whenever screen is redrawn
+	:.case[+-]		enable case sensitivity for keystrokes
+	:.clear			clear alpha memory (e.g, this text)
+	:.cursor n		select cursor (0=normal,1=crosshair,2=lightpen)
+	:.gflush		flush plotter output
+	:.help			print help text for cursor mode
+	:.init			initialize the graphics system
+	:.markcur[+-]		mark cursor position after each cursor read
+	:.off [keys]		disable selected cursor mode keys
+	:.on [keys]		enable selected cursor mode keys
+	:.page[+-]		enable screen clear before printing help text
+	:.read file		fill frame buffer from a file
+	:.show			print cursor mode and graphics kernel status
+	:.snap [device]		make hardcopy of graphics display
+	:.txqual qual		set character generator quality (normal,l,m,h)
+	:.txset format		set text drawing parameters (size,up,hj,vj,etc)
+	:.xres=value		set X resolution (stdgraph only)
+	:.yres=value		set Y resolution (stdgraph only)
+	:.viewport x1 x2 y1 y2	set workstation viewport in world coordinates
+	:.write[!][+] file	save frame buffer in a spool file
+	:.zero			reset viewport and redraw frame
+.fi
+
+
+.ce
+Figure 3. Cursor Mode Commands
+.ke
+
+
+Minimum match abbreviations are permitted for cursor mode command names.
+Multiple commands may be given on one line, delimited by semicolons.
+If the CL environment variable \fBcminit\fR is defined when cursor mode is
+first entered, the string value will be interpreted as a cursor mode command
+and used for initialization.  For example, to disable the numeric keys and
+set the graphics resolution to 200 points in X and 100 points in Y, one
+could add the following \fBset\fR declaration to their "login.cl" file:
+
+	set cminit = "xres=200; yres=150; off 0-9"
+
+The numeric keypad of the terminal (if it has one) is used to roam about
+when the zoom factor is greater than one.  If the magnification is normal
+the numeric keys are not recognized as special keystrokes, i.e., typing
+a numeric key will exit cursor mode, returning the character typed to the
+applications program.  In roam mode a numeric key must be escaped to exit
+cursor mode.  The directional significance of the numeric keys in roam
+mode is obvious if the terminal has a keypad, and is illustrated below.
+
+
+.ks
+.nf
+	7   8   9	135 090 045
+
+	4   5   6	180 000 000
+
+	1   2   3	225 -90 -45
+.fi
+.ke
+
+
+There is a fixed upper limit on the size of the cursor mode frame buffer.
+If the frame data overflows the frame buffer while plotting the plot will
+still come out correctly, but only the final plotting instructions will be
+retained in the buffer.  Redisplay of the frame in cursor mode will thus
+result in only a portion of the full frame being drawn.  If this is a problem
+the user can increase the upper limit on the size of the frame buffer by
+setting the value of the environment variable \fBcmbuflen\fR, e.g.,
+
+	gflush; set cmbuflen = 512000
+
+would initialize the graphics system (freeing the old frame buffer) and set
+the upper limit on the size of the frame buffer to 512K words or 1Mb.
+
+.nh 2
+Example
+
+    At this point a brief example may help to illustrate the use of the GIO
+procedures.  The following procedure will plot a data vector (pixel array)
+and then repeatedly read the cursor, drawing a mark at successive positions
+of the cursor.  The procedure exits if the user types either the character
+'q' or EOF, e.g., <ctrl/z> or carriage return.
+
+
+.ks
+.nf
+	include	<gset.h>
+
+	# MARKPLOT -- Plot a data array and then enter a loop, drawing
+	# circles at successive cursor positions.
+
+	procedure markplot (data, npts, x1, x2)
+
+	real	data[npts]		# data vector to be plotted
+	int	npts			# length of array
+	real	x1, x2			# world X-coords of vector
+
+	pointer	gp
+	int	wcs, key
+	char	str[32]
+	real	wx, wy
+	pointer	gopen()
+	int	clgcur()
+
+	begin
+		gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+		call gploto (gp, data, npts, x1, x2, "data")
+
+		while (clgcur ("points", wx, wy, wcs, key, str, 32) != EOF)
+		    if (key == 'q')
+			break
+		    else
+			call gmark (gp, wx, wy, GM_CIRCLE, 1., 1.)
+
+		call gclose (gp)
+	end
+.fi
+.ke
+
+.nh 2
+Graphics Output Devices
+
+    While the graphics output device may be specified explicitly by name,
+more often graphics output devices will be specified by one of the logical
+device names shown below.  Examples of the installation dependent device name
+associated with each logical name are also shown.
+
+
+.ks
+.nf
+	stdgraph	= "gterm"
+	stdimage	= "deanza"
+	stdplot		= "qms"
+	stdvdm		= "uparm$vdm"
+.fi
+.ke
+
+
+Interaction (via the CL) is supported only for \fBstdgraph\fR and
+\fBstdimage\fR.  The standard batch plotter device is \fBstdplot\fR,
+and the standard metafile (for spooling graphics output) is \fBstdvdm\fR.
+
+The user should not normally set the value of \fBstdgraph\fR directly with
+\fIset\fR, rather they should set the terminal type with \fIstty\fR and let
+the latter specify the value of \fBstdgraph\fR.  If the terminal specified
+is not a graphics terminal (no ":gd" capability in the termcap entry for the
+device) the value of \fBstdgraph\fR will be set to "none", otherwise
+\fBstdgraph\fR will be set to the name of the stdgraph device entry for the
+graphics terminal.
+
+The device name associated with a logical graphics output
+device must have an associated entry in the \fBgraphcap\fR file,
+a text file used to describe the characteristics of each device.
+New graphcap entries may easily be added by the user to interface to
+special graphics devices.
+System privledge is not required to modify graphcap, since the name
+of the graphcap file is taken from a CL environment variable of the
+same name (which can be redefined by the user to point to a file in a
+private directory).  The graphcap entries for the most commonly used
+devices at a given site may be precompiled by the system manager to
+eliminate the overhead of searching the graphcap file at \fBgopen\fR time.
+
+The graphcap parameters (device \fIcapabilities\fR) are too involved to
+be presented here and will be described in a later section.
+Examples of device capabilities are the device resolution, whether a frame
+advance is required before or after a plot, indication of device capabilities
+such as the ability to generate text, and the name of the executable
+graphics kernel file associated with the device.  Many additional parameters
+are defined for interactive devices.  The graphcap device capabilities
+may be inspected with the \fBgget[birs]\fR procedures, which resolve into
+calls to the TTY interface, used to access both graphcap and termcap files.
+
+The sequence of actions taken by GIO to access the graphcap entry for a
+device is summarized below.
+
+
+.ks
+.nf
+	if (standard graphics output device)
+	    get device name from environment
+
+	if (device name is actually a filename) {
+	    load graphics device descriptor using the first device entry
+		from the named graphcap format file
+	} else {
+	    get filename of graphcap file from environment
+	    load graphics device descriptor by searching the graphcap file
+		for the named device
+	}
+.fi
+.ke
+
+.nh 2
+Graphics Input Devices
+
+    The technique used to associate an input source with a graphics cursor
+is similar to that used for output devices.  A CL environment variable is
+associated with each cursor type.  The names and default values of the
+environment variables are shown below.
+
+
+.ks
+.nf
+	stdgcur		= "stdgraph"
+	stdimcur	= "stdimage"
+.fi
+.ke
+
+
+The default input source for a cursor is the graphics output device associated
+with the graphics output stream.  If the cursor device is "stdgraph" or
+"stdimage" the graphics kernel is called to read the physical device cursor
+for \fIstdgraph\fR or \fIstdimage\fR.  If the cursor device is "text"
+the cursor value is a line of text read from the user terminal.
+In this mode the user enters at least two of the fields defining
+a cursor value.  Missing fields are assigned the value zero (the user
+presumably will know that the program does not use the extra fields).
+
+
+.ks
+.nf
+	cl> set stdgcur = "text"
+	cl> = gcur
+	gcur: 345.33 23.22 1 c
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+An example of a cursor read request entered interactively by the user,
+taking input from the terminal and sending output to the terminal,
+is shown above (the CL typed the "gcur: " query and the user entered the
+remainder of that line).  If the cursor device were "stdgraph" a real
+cursor read would occur and the equivalent interaction might appear as
+shown below.  The cursor position is returned in world coordinates,
+where the world coordinate system was defined by the last plot output to
+the device.  For an imaging device the world coordinates will typically
+be the pixel coordinates of the image section being displayed.
+
+
+.ks
+.nf
+	cl> = gcur
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+Redirecting cursor input to the terminal is useful when working from a
+nongraphics workstation and when debugging programs.  ASCII cursor queries
+are the only type supported when running an IRAF program outside the CL.
+Cursor input may also be taken from a list file by assigning a filename
+to a cursor parameter, i.e., by assigning a list file to a list structured
+parameter and overriding query mode:
+
+
+.ks
+.nf
+	cl> gcur = filename
+	cl> = gcur
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+This last mechanism is a standard technique used with CL list structured
+parameters and will not be discussed further here.
+
+.NH 2
+Mixed Terminal and Graphics I/O
+
+    Interactive graphics programs are normally (but not necessarily) executed
+on a graphics terminal or workstation supporting both ordinary terminal i/o
+and vector graphics.  IRAF is designed to use a single terminal for both text
+and graphics; text and graphics on separate devices is also supported but is
+not the norm.  By text we refer here to ordinary line or screen oriented
+terminal i/o (e.g., for \fIhelp\fR or \fIeparam\fR), not the use of text in
+the graphics plane to annotate plots.
+
+.NH 3
+Text and Graphics Mode
+
+    Most modern graphics terminals provide separate memory planes for text
+and graphics.  Depending upon the device, these planes may be displayed
+simultaneously, displayed alternately, or only a single memory plane may be
+available for both terminal modes, in which case a mode switch is destructive.
+The graphics device model implemented by GIO and the STDGRAPH kernel is
+flexible enough to deal with all or nearly all such devices.
+
+The normal mode for the terminal or workstation is text mode.  Activating the
+workstation causes a switch to graphics mode; deactivating the workstation
+restores the terminal to text mode.  Activation is implied whenever a device
+is opened with \fBgopen\fR, unless the AW_DEFER mode bit is set to defer the
+activate workstation until graphics i/o is actually done to the device.
+Closing the workstation automatically deactivates the workstation.  The GIO
+procedures \fBgreactivate\fR and \fBgdeactivate\fR are provided to simplify
+mode switching while a device is open on a graphics stream.
+
+Occasionally it is necessary to print out a large amount of text in response
+to a user command entered in a cursor loop while in graphics mode.  If the
+text is in a file this is done most easily by calling \fBgpagefile\fR to page
+the file in text mode, restoring graphics mode when the operation is completed.
+If the application generates the output text dynamically then the workstation
+must be explicitly deactivated and later reactivated before resuming graphics
+i/o, e.g.,
+
+.ks
+.nf
+	while (clgcur (gp, ...) != EOF) {
+	    switch (key) {
+	    case XXX:
+		call gdeactivate (gp, AW_CLEAR)
+		    <write the text to STDOUT>
+		call greactivate (gp, AW_PAUSE)
+	    case YYY:
+		...
+	    }
+	}
+.fi
+.ke
+
+The sequence shown will switch to text mode, clear the screen, output the
+text, and pause for the user to read the text before restoring graphics mode
+and initiating another cursor read.
+
+.NH 3
+Status Line I/O
+
+    The deactivate/reactivate workstation technique is fine for outputting
+large amounts of text, but is not well suited for small amounts of text,
+e.g., single line commands to interactively set internal parameters,
+output of single lines of text to prompt the user, print the value of a
+calculation or some variable, and so on.  The so-called "status line"
+interface is provided for this purpose.  Status line i/o makes it possible
+to interact directly with the user without interfering with the contents of
+the graphics frame, and without leaving graphics mode.
+
+What the status line actually is determined by the graphcap entry for the
+device and the characteristics or limitations of the actual device.
+On most devices, the status line is a single line at the bottom of the screen.
+This only works, however, if the device can dynamically erase the status line;
+if this is not possible the status "line" may actually be the entire screen,
+with successive output lines being drawn on top of the graph.
+
+To output text to the status line while in graphics mode one merely writes to
+STDOUT or STDERR in the usual way, e.g., in a call to \fBprintf\fR.  When
+newline is seen a flag is set which causes the status line to be cleared when
+the next output character is received.  Output lines may be built up in
+successive calls to output procedures, outputting a single newline to terminate
+the line and start a new one.  After a newline delimited line of text has been
+output, output of a single newline (blank line) will clear the status line.
+
+It is also possible to read from the status line.  This is most commonly done
+after writing a prompt string to the status line.  The prompt should be
+terminated with a colon (e.g., "enter value: ") rather than a newline,
+to signal to the user that input is expected, and to avoid having the
+subsequent status line read clear the prompt string.  In many cases such
+explicit prompting and decoding of the return string can be avoided by using
+the standard CLIO parameter prompting mechanism for interactive input.
+CL parameter prompts are also permitted in graphics mode, and will interact
+with the user on the status line in the expected way, without interfering
+with the graphics state of the device.
+
+When mixing status line i/o and graphics i/o one must be careful to flush any
+buffered graphics or textual output before switching modes.  In many cases the
+system will do this for you automatically, but there are exceptions where
+explicitly flushing of buffered output is necessary (e.g., STDOUT and STDERR
+are low level facilities with no knowledge of GIO, and output to one of these
+streams will not automatically cause any graphics output to be flushed).
+
+.NH 2
+User Interface Conventions
+
+    While different interactive (cursor driven) graphics programs will differ
+in many ways, there are certain operations which are common to all such
+programs.  In order to present a more consistent interface to the user,
+conventions have been defined for these common operations.
+
+.NH 3
+On Line Help
+
+    All interactive graphics programs should respond to the key '?' with a
+description of the keystrokes and colon commands recognized by the program
+(or submenu, in the case of a menu structured interface).  This is normally
+done by calling \fBgpagefile\fR to interactively page the ".key" keystrokes
+help file for the program.  The keystroke files for system programs are
+stored in the directory lib$scr; non-system programs keep their keys files
+either in the package directory, or in a global package library.
+
+.NH 3
+Cursor and Device Names
+
+    In general, applications programs should not read directly from \fBgcur\fR
+or \fBimcur\fR (the global cursor parameters), nor should the open the
+"stdgraph", "stdimage", or "stdplot" device directly by these explicit string
+values.  This works, but is inflexible.  To make it easy for the user to
+run an otherwise interactive program in batch mode, taking input from a cursor
+list file, the task should include a cursor type parameter in its parameter
+set.  Likewise, to make it easy for the user to temporarily redirect the
+output of the program to a device other than the current stdgraph, stdplot,
+etc., device, the device name should be parameterized as a string type CL
+parameter.
+
+For example, if task \fBplotit\fR  has cursor and device parameters named
+"cursor" and "device", the command
+
+	cl> plotit cursor=listfile device=qms
+
+would run the task taking cursor input from the text file "listfile", with
+stdgraph graphics output directed to the plotter device "qms".
+
+.NH 3
+Exiting an Interactive Cursor Loop
+
+    The following standards have been defined for dealing with EOF/quit in
+interactive cursor loops.
+.ls
+.ls EOF	
+End of file is indicated for a cursor list either by an actual
+end of file in the case of a true cursor list, or by typing the EOF character
+(e.g., <ctrl/z>, <ctrl/d>, or the interrupt character) in an interactive
+cursor read.  EOF on the cursor list should be taken seriously by the
+applications program, and not treated as just another key, hence it should
+not be something that the user is expected to type routinely to exit a cursor
+loop.  If a program gets EOF back as the value of \fBclgcur\fR it should exit
+immediately, without any verification queries etc, since it may well have
+been run in batch mode with input redirected to a cursor list file.
+.le
+.ls q
+The standard interactive cursor loop exit character is 'q'.  
+All interactive graphics programs should recognize this character
+and take some action to exit the cursor loop, e.g.:
+
+.ks
+.nf
+	while (clgcur (...) != EOF)
+	    switch (key) {
+	    case 'q':
+		break
+	    case ...
+.fi
+.ke
+
+The 'q' character is intended to be handled directly by the application
+program, rather than mapped into EOF by the system (like Q was, and CR and
+the gt_gcur 'q' before that in old versions of IRAF),
+to distinguish this case from a hard-EOF and to provide maximum
+flexibility in how the program treats a request from the user to exit.
+If the user would suffer from an accidental program exit then the 'q' key
+action should do something before exiting, e.g., ask that the user first
+update the database, ask that CR be hit to verify the quit, and so on.
+In general, if it would take the user more than a minute to recover after
+an accidental program exit, one should consider coding some sort of
+verification action to be executed before exiting when 'q' is typed (but not
+when EOF is seen on the list).
+.le
+.le
+
+The GIO procedure \fBgqverify\fR is provided for programming convenience in
+cases where only simple verification is desired.  Note that lightweight tasks
+or submenus which can easily be reentered should not bother even with this,
+but should simply exit.  For example:
+
+.ks
+.nf
+	case 'q':
+	    if (gqverify() == YES)
+		break
+.fi
+.ke
+
+As a more complex example, suppose the program is used to edit or
+create a database which could be lost or damaged in an accidental
+exit, if not updated first.  We do not want to update the database
+automatically because this would overwrite the former contents of
+the database.  The program might be set up as follows.
+
+.ks
+.nf
+	'q'		program prints error message on status line, e.g.,
+			  "No write since last change (:quit! overrides)"
+	:w[rite]	updates the database; q will execute silently
+	:q[uit]!	force a quit w/o an update; discard changes
+.fi
+.ke
+
+.nh 2
+Detailed Procedure Specifications
+
+    The graphics output procedures provided by GIO fall into four main
+groups.  First are the high level "plot at a time" procedures,
+used to plot entire data vectors.  Second are the control procedures,
+used to open and close a device, to flush output and clear the screen,
+and to cancel output in the event of an interrupt.
+Third are the procedures used to set and stat (inquire) the GIO
+internal parameters, e.g. to define a WCS, change pens, select axis labeling
+options, or inquire the device resolution.  Fourth and last are the output
+procedures, used to draw and label the axes of a viewport, set the cursor,
+draw lines or marks, plot text, or fill areas.
+
+.nh 3
+High Level Procedures
+.ls 4
+.tp 8
+.ls gplotv (v, npts, x1, x2, title)
+
+.nf
+real	v[npts]		# data vector
+int	npts		# number of data points
+real	x1, x2		# WC assigned v[1] and v[npts]
+char	title[ARB]	# plot title
+.fi
+
+Open GIO, clear the screen, autoscale and plot the data vector, then close GIO.
+A default viewport is used.  The axes are drawn, tick marks are selected,
+marked, and labeled, and the plot title is printed.  The data is plotted
+using solid line segments.  The X values of the data points are evenly
+distributed from X1 to X2.
+.le
+
+.tp 8
+.ls gploto (gp, v, npts, x1, x2, title)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# data vector
+int	npts		# number of data points
+real	x1, x2		# WC assigned v[1] and v[npts]
+char	title[ARB]	# plot title
+.fi
+
+A more flexible version of \fBgplotv\fR.  The graphics device must already
+have been opened with an explicit call to \fBgopen\fR.  The explicit open
+call makes it possible to append to an existing plot or to change plotting
+options with calls to \fBgset\fR before calling \fBgploto\fR to autoscale,
+draw the axes, and plot the data vector.  Annotation of the plot via calls
+to the low level output primitives is possible before a final call to
+\fBgclose\fR to close the device and free the graphics descriptor.
+.le
+
+.tp 8
+.ls gpagefile (gp, fname, prompt)
+
+.nf
+pointer	gp		# graphics descriptor
+char	fname[ARB]	# file to be paged
+char	prompt[ARB]	# end of page prompt string
+.fi
+
+Interactively page through a file on the terminal in text mode, e.g., to
+display help text in response to the '?' standard help query key.
+The workstation is deactivated, the screen is cleared and the file is paged,
+with the usual file pager prompt being displayed at the bottom of each page
+of text.  When the pager is exited the workstation is reactivated if it was
+active when the pager was called.  If the prompt string is null the file
+name is used.
+.le
+.le
+
+.nh 3
+Control Procedures
+.ls
+.tp 8
+.ls gopen (device, mode, fd)
+
+.nf
+char	device[ARB]	# name of device to be opened
+int	mode		# access mode
+int	fd		# graphics stream to be written
+.fi
+
+The named graphics device is opened for graphics i/o.  A pointer to the GIO
+graphics descriptor assigned to the device is returned as the function value.
+The device name may be the name of one of the standard logical graphics
+devices, i.e., \fBstdgraph\fR, \fBstdimage\fR, \fBstdplot\fR, or \fBstdvdm\fR,
+or the actual name of a physical device.
+
+The only meaningful device access modes at present are NEW_FILE and APPEND.
+In NEW_FILE mode all WCS are initialized to NDC coordinates.
+Opening the stdgraph device in NEW_FILE mode causes a screen clear on the next
+call to \fIgflush\fR.  In APPEND mode the WCS are restored to the values they
+had when the device was last accessed.
+The GIO internal state variables are initialized to their default values
+at \fBgopen\fR time regardless of the access mode for the device.
+
+Opening the stdgraph device causes an implicit reactivate workstation unless
+the AW_DEFER flag (<gset.h>) is set in the access mode, e.g.,
+
+	gp = gopen (device, NEW_FILE+AW_DEFER, fd)
+
+Defer mode allows the graphics descriptor to be opened once, e.g., during task
+startup, before any graphics output is required.  This is sometimes useful in
+applications which switch back and forth between text and graphics mode often,
+by bracketing each graphics sequence with calls to \fIgreactivate\fR to enter
+graphics mode, and \fIgdeactivate\fR to return to text mode.  Defer mode may
+be combined with any normal access mode code.
+
+Graphics output will be written to the stream \fIfd\fR, which may be one
+of the standard streams STDGRAPH, STDIMAGE, or STDPLOT, or to a binary file
+opened explicitly by the user before calling \fBgopen\fR.
+.le
+
+.tp 5
+.ls gclose (gp)
+
+The graphics device associated with graphics descriptor \fBgp\fR is closed,
+freeing all resources allocated to the device.  Any buffered graphics output
+is automatically flushed before closing the device.
+.le
+
+.tp 4
+.ls gdeactivate (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# AW_CLEAR, AW_PAUSE (see <gset.h>)
+.fi
+
+The graphics workstation is deactivated, i.e., restored to the normal terminal
+(text drawing) mode, the state the terminal was in prior to \fIgopen\fR, and to
+which it will be restored after a \fIgclose\fR.  This function is intended for
+interactive graphics applications and may be may be ignored by some graphics
+kernels.  If the AW_PAUSE flag bit is set the user will be asked to type a
+key before the terminal is restored to text mode.  If the AW_CLEAR flag bit
+is set the terminal (text) screen will be cleared after the workstation is
+deactivated.
+
+.le
+
+.tp 4
+.ls greactivate (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# AW_CLEAR, AW_PAUSE (see <gset.h>)
+.fi
+
+The graphics workstation is reactivated, i.e., restored to graphics mode from
+the normal terminal (text drawing) mode.  This function is intended for
+interactive graphics applications and may be may be ignored by some graphics
+kernels.  If the AW_PAUSE flag bit is set the user will be asked to type a
+key before the terminal is restored to graphics mode.  If the AW_CLEAR flag
+bit is set the graphics frame will be cleared.
+.le
+
+.tp 4
+.ls gcancel (gp)
+
+Any buffered graphics output is discarded and any output operation currently
+in progress is aborted.  Used to recover from an interrupt.
+.le
+
+.tp 3
+.ls gflush (gp)
+
+Any buffered graphics output is flushed to the output device.
+.le
+
+.tp 4
+.ls gclear (gp)
+
+If the output device is a CRT the screen is erased (including all viewports).
+If the output device is a plotter a formfeed is issued, advancing to the next
+page of output (whether or not any graphics output has occurred).
+All WCS are initialized to NDC coordinates and the internal state of GIO
+is initialized, i.e., the state of each drawing instruction attribute packet
+is set to UNSET to force retransmission to the graphics kernel as i/o occurs,
+and the current settings of the \fIgset\fR options, e.g., line style and width,
+\fIglabax\fR options, etc., are all initialized to their default (\fBgopen\fR)
+values.
+.le
+
+.tp 4
+.ls gframe (gp)
+
+Issue a screen clear or frame advance.  This call is equivalent to \fBgclear\fR
+except that the internal state of GIO is not initialized.  An application
+might want to call \fBgframe\fR and \fBgreset\fR directly rather than using
+\fBgclear\fR, if the full initialization implied by \fBgclear\fR is not what
+is desired.
+.le
+
+.tp 4
+.ls greset (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# bitflags noting what to reset (0 is a no-op)
+.fi
+
+The \fBgreset\fR may be used to reset all or parts of the internal state of
+GIO, without actually doing any i/o to the graphics device.  The \fIflags\fR
+argument is used to specify what is to be reset.  The bitflags (defined in
+<gset.h>) are enumerated below.
+
+.nf
+	GR_RESETALL		reset everything
+	GR_RESETGIO		reset only GIO drawing parameters
+	GR_RESETWCS		reset the WCS to wcs=1, all NDC
+	GR_RESETGLABAX		reset the GLABAX parameters
+.fi
+
+A \fBgclear\fR is equivalent to a \fBgframe\fR followed by a
+greset(gp,GR_RESETALL).
+.le
+
+.tp 8
+.ls gmftitle (gp, mftitle)
+
+.nf
+pointer	gp		# graphics descriptor
+char	mftitle[ARB]	# comment (metafile title string)
+.fi
+
+Place a comment describing the graphics being generated in the output
+stream.  Useful primarily when the output is expected to be saved in a
+metafile.  No graphics is generated.
+.le
+.le
+
+.nh 3
+Set and Stat Procedures
+.ls
+.tp 8
+.ls gscan (gp, text)  [NOT YET IMPLEMENTED]
+
+.nf
+pointer	gp		# graphics descriptor
+char	text[ARB]	# graphics commands
+.fi
+
+The string \fBtext\fR, consisting of an arbitrary length sequence of
+printable ASCII graphics commands delimited by semicolons or newlines,
+is interpreted and executed by GIO.  Each GIO procedure has a corresponding
+command of the same syntax, minus the parenthesis, commas, and the argument
+\fBgp\fR.  The syntax of a \fBgset\fR command is "param=value".
+File inclusion is provided by the operator "@" followed by the filename
+of the file to be included.
+The include operator may appear anywhere a token is expected and includes
+may be nested up to some maximum depth.
+The sequence "@STDIN" is especially useful for entering commands or data
+interactively.
+.le
+
+.tp 8
+.ls gset[irs] (gp, param, value)
+
+.nf
+pointer	gp		# graphics descriptor
+int	param		# parameter to be set
+[irs]	value		# new value for parameter
+.fi
+
+Set the value of the indicated parameter.  A separate procedure is used for
+integer, real, and string valued parameters, i.e., gseti, gsetr, gsets.
+GIO parameters may be either internal state variables (e.g. the number of
+ticks on an axis) or device parameters (e.g. the number of the pen to be
+used to draw lines).
+The GIO parameters are defined in the global include file \fB<gset.h>\fR.
+.le
+
+.tp 10
+.sp
+.nf
+gstati (gp, param)
+gstatr (gp, param)
+gstats (gp, param, outstr, maxch)
+.fi
+.ls
+.nf
+pointer	gp		# graphics descriptor
+int	param		# parameter to be set
+char	outstr[maxch]	# output string
+.fi
+
+Inquire the value of the indicated GIO internal parameter.
+The integer and real functions \fBgstati\fR and \fBgstatr\fR return
+the parameter value as the function value, whereas \fBgstats\fR is
+a procedure returning the string value of a parameter as an output argument.
+The GIO parameters are defined in the global include file \fB<gset.h>\fR.
+.le
+
+.tp 11
+.sp
+.nf
+ggetb (gp, cap)
+ggeti (gp, cap)
+ggetr (gp, cap)
+ggets (gp, cap, outstr, maxch)
+.fi
+.ls
+.nf
+pointer	gp		# graphics descriptor
+char	cap[2]		# device capability
+char	outstr[maxch]	# output string
+.fi
+
+Inquire the value of the indicated graphics device capability.
+The device capability \fIcap\fR is the two character name of the capability
+as it appears in the \fIgraphcap\fR file.  Aside from the device capabilities
+required by GIO, GIO itself knows nothing about the graphcap device
+capabilities.  New capabilities may be added without modifying GIO.
+The \fBgget\fR procedures call the corresponding procedures in the TTY
+interface.  If more control over device capabilities is required than
+that provided by GIO, the TTY interface may be used directly, following a
+call to \fBgstati\fR to get the pointer to the TTY descriptor for the device.
+
+The boolean function \fBggetb\fR tests whether the device has the named
+capability.  The integer and real functions \fBggeti\fR and \fBggetr\fR return
+the capability value as the function value, or zero if the capability is
+not defined for the device.  String valued capabilities are returned by
+\fBggets\fR as an output argument; the null string is returned if the
+device does not have the indicated capability.
+.le
+
+.tp 8
+.ls g[sg]view (gp, x1, x2, y1, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, x2		# range of NDC coordinates in X
+real	y1, y2		# range of NDC coordinates in Y
+.fi
+
+Set or get the NDC coordinates of the viewport associated with the current WCS.
+The default viewport is the full display area of the device.
+.le
+
+.tp 8
+.ls g[sg]wind (gp, x1, x2, y1, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, x2		# range of world coordinates in X
+real	y1, y2		# range of world coordinates in Y
+.fi
+
+Set or get the world coordinates of the window associated with the current WCS.
+The default window ranges from 0 to 1 in both X and Y, i.e., the default
+window associates a normalized coordinate system with the associated viewport.
+Any window limits passed as INDEF will be ignored, i.e., those window
+parameters will not be modified.
+.le
+
+.tp 9
+.ls g[ar]scale (gp, v, npts, axis)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# data vector window is to be scaled to
+int	npts		# length of data vector
+int	axis		# axis to be scaled (1=X, 2=Y).
+.fi
+
+Set absolute (\fIgascale\fR) or rescale (\fBgrscale\fR) the minimum and
+maximum world coordinates of the indicated axis of the current window,
+i.e., scale the window to fit a data vector.
+May be called repeatedly if overplotting several curves.  The current minimum
+and maximum values for either axis may be obtained at any time by calling
+\fBggwind\fR.  To scale the window to fit a family of curves,
+call \fBgascale\fR for the first curve and \fBgrscale\fR for the remaining
+curves, thereby computing the range in X and or Y of all curves.
+.le
+
+.tp 9
+.ls ggscale (gp, x, y, dx, dy)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# point at which scale is desired (wc)
+real	dx, dy		# scale, wcs units per ndc unit
+.fi
+
+Determine the scale in world coordinate units at the point (x,y).  Useful
+for computing the size of an object in world coordinates given its size
+in ndc coordinates, or vice versa.  An approximation is used to determine
+the scale if log scaling is in use.  Note that the scale is a function of
+position for the nonlinear coordinate systems.
+.le
+
+.tp 9
+.ls gctran (gp, x1, y1, x2, y2, wcs1, wcs2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, y1		# input point in WCS1 coords
+real	x2, y2		# output point in WCS2 coords
+int	wcs1, wcs2	# input, output world coordinate systems
+.fi
+
+Transform a point in world coordinate system \fIwcs1\fR to world coordinate
+system \fIwcs2\fR.  If \fIwcs1\fR is zero the transformation is from NDC
+coordinates to WCS coordinates.  If \fIwcs2\fR is zero the transformation is
+from WCS coordinates to NDC coordinates.  Otherwise the transformation is
+between two user defined world coordinate systems.  The point need not fall
+within the viewports of the two world coordinate systems.  World coordinate
+systems which were never set are equivalent to WCS=0.
+.le
+
+.tp 9
+.ls gcurpos (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# current pen position in world coordinates
+.fi
+
+Return the "current pen position" in the current world coordinate system.
+The current pen position is the position set by the last move or draw
+command.
+.le
+
+.tp 10
+.ls gescape (gp, fn, instruction, nwords)
+
+.nf
+pointer	gp		# graphics descriptor
+int	fn		# function code
+short	instruction[nwords]	# instruction sequence to be passed
+int	nwords		# length of instruction sequence
+.fi
+
+Send a device dependent instruction sequence to the graphics kernel.
+Escape functions are ignored by GIO and by graphics kernels that do
+not recognize the function code.
+.le
+.le
+
+.nh 3
+Output Procedures
+
+    Data passed to the polyline or polymarker output procedures may contain
+embedded INDEF (indefinite) values in the X, Y, or V arrays.  Indefinite valued
+points appear as gaps in the plot and are ignored when autoscaling.
+Indefinite valued pixels are not permitted in a cell array since GIO does
+not look at the values of the pixels.
+
+.ls
+.tp 9
+.ls glabax (gp, title, xlabel, ylabel)
+
+.nf
+pointer	gp		# graphics descriptor
+char	title[ARB]	# plot title
+char	xlabel[ARB]	# X axis label
+char	ylabel[ARB]	# Y axis label
+.fi
+
+Draw and label the axes of the viewport.
+If the WCS has not yet been fixed it will be fixed by this call.
+If desired, \fBglabax\fR may modify the window slightly to place
+simple values on the tick marks.  Numerous \fBgset\fR options are
+available for controlling the number and sizes of the tick marks,
+the format of tick labels, the axes on which tick labels appear,
+and so on.  If the device viewport has not yet been set and axis labeling
+is enabled, \fBglabax\fR will set a default size viewport which allows room
+for the label text outside the viewport.
+.le
+
+.tp 8
+.ls gline (gp, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, y1		# start of line
+real	x2, y2		# end of line
+.fi
+
+Draw a line connecting the point (x1,y1) to the point (x2,y2) (WCS coordinates).
+The linetype, linewidth, and color may be changed beforehand with a call
+to \fBgset\fR.  The relevant parameters and their possible values are shown
+below.  Linetype zero (clear) may be used to erase lines drawn with any of the
+other linetypes (device permitting).
+
+.ks
+.nf
+	G_PLTYPE	0=clear, 1=solid, 2=dashed, 3=dotted,
+			    4=dotdash, >4=device dependent
+	G_PLWIDTH	relative line width (default 1.0)
+	G_PLCOLOR	color index
+.fi
+.ke
+.le
+
+.tp 8
+.ls gpline (gp, x, y, npts)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# X coordinates of the line endpoints
+real	y[npts]		# Y coordinates of the line endpoints
+int	npts		# number of line endpoints
+.fi
+
+Polyline.  Draw a line connecting the points (WCS coordinates).
+The linetype, linewidth, and color may be changed beforehand with a call
+to \fBgset\fR.
+.le
+
+.tp 8
+.ls gvline (gp, v, npts, x1, x2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# vector to be plotted (Y values)
+int	npts		# number of line endpoints
+real	x1, x2		# range of vector in X 
+.fi
+
+Vector polyline.  Draw a polyline wherein the Y values of the polyline are
+taken from V and the X values are evenly distributed along the X-axis,
+ranging from X1 at point V[1] to X2 at point V[npts] (WCS coordinates).
+.le
+
+.tp 9
+.ls gmark (gp, x, y, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates of marker
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Mark drawing primitive.  Draw a mark of type \fImarktype\fR and size
+\fImarksize\fR at the given position in WCS coordinates.
+The marker type codes recognized are shown below and are defined in <gset.h>.
+Marktype codes may be summed to make composite marks, e.g.,
+
+	call gmark (gp, x, y, GM_PLUS+GM_CROSS, 1.)
+
+is an asterisk.  The pseudo-mark GM_FILL may be combined with GM_CIRCLE,
+GM_BOX, or GM_DIAMOND to output the mark as a filled area, using the current
+fill area attributes.  A positive \fImarksize\fR specifies the mark size in NDC
+coordinates, whereas negative signifies WCS coordinates.
+The positive marksizes 1., 2., 3., and 4. signify default size marks of
+increasing size.
+
+.ks
+.nf
+    typecode      name                symbol
+
+	0 	GM_POINT	smallest plottable point
+        1	GM_FILL		fill interior of mark
+	2	GM_BOX		square box
+        4	GM_PLUS		plus
+	8	GM_CROSS	cross
+       16	GM_DIAMOND	diamond
+       32	GM_HLINE	horizontal line
+       64	GM_VLINE	vertical line
+      128	GM_HEBAR	horizontal error bar
+      256	GM_VEBAR	vertical error bar
+      512	GM_CIRCLE	circle
+.fi
+.ke
+
+The linetype for a mark is set by the parameter G_PMLTYPE.  A mark may
+be erased (device permitting) by setting the marker linetype to clear and
+redrawing the mark.  The color index used for marks is controlled by the
+\fBgset\fR parameter G_PMCOLOR.
+.le
+
+.tp 9
+.ls gpmark (gp, x, y, npts, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# WCS X coordinates of markers
+real	y[npts]		# WCS Y coordinates of markers
+int	npts		# number of markers
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Polymarker.  Plot a sequence of \fInpts\fR markers at the positions given
+by successive WCS coordinate pairs (x[i],y[i]).  All markers will be of
+the same type and size.  The significance of the marker type and size codes
+is the same as for \fBgmark\fR.
+.le
+
+.tp 9
+.ls gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# WCS Y coordinates of markers
+int	npts		# number of markers
+real	x1, x2		# range of WCS X coordinates
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Vector polymarker.  Plot a sequence of \fInpts\fR markers at the positions given
+by successive WCS coordinate pairs (x[i],y[i]), where the x[i] are evenly
+distributed from X1 at V[1] to X2 at V[npts].  All markers will be of the same
+type and size.  The significance of the marker type and size codes is the same
+as for \fBgmark\fR.
+.le
+
+.tp 11
+.ls gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts],y[npts]	# normalized polyline defining marker
+int	npts		# number of points in polyline
+real	xcen, xcen	# world coordinates of center of marker
+real	xsize, ysize	# marker size in X and Y
+int	fill		# draw mark using area fill
+.fi
+
+Draw a user defined marker.  The marker is defined by the polyline (X[i],Y[i]),
+normalized to the unit square.  The marker polyline is scaled to fit the
+window defined by \fIxcen\fR, \fIycen\fR, \fIxsize\fR, and \fIysize\fR,
+where the center is always defined in world coordinates but the marker sizes
+may be defined in any of a number of ways (see \fBgmark\fR).  If \fIfill\fR
+is YES the marker will be drawn using area fill rather than as a polyline.
+.le
+
+.tp 8
+.ls g[ar]move (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates to move or shift
+.fi
+
+Move absolute (\fBgamove\fR) or move relative (\fBgrmove\fR),
+with the "pen up".  A move relative should be preceded by a move absolute
+to unambiguously define the "current pen position" in WCS coordinates.
+Only the move, draw, and mark primitives leave the pen in a defined position.
+Calls to \fBgset\fR may be intermixed with move and draw commands without
+affecting the current pen position.
+.le
+
+.tp 8
+.ls g[ar]draw (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates to move or shift
+.fi
+
+Move absolute (\fBgadraw\fR) or move relative (\fBgrdraw\fR),
+with the "pen down".  Draws a line segment.
+The type of line drawn (linetype or "pen number") defaults to solid but
+may be changed beforehand with a call to \fBgset\fR.
+Calls to \fBgset\fR may be intermixed with move and draw commands without
+affecting the current pen position.
+.le
+
+.tp 9
+.ls gtext (gp, x, y, text, format)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates of text string
+char	text[ARB]	# text to be plotted
+char	format[ARB]	# text characteristics
+.fi
+
+Plot the string \fItext\fR at the position (x,y) in WCS coordinates.
+The default size, orientation, and justification of the generated string 
+may be set by a prior call to \fBgset\fR or overridden for the duration
+of the current call by the \fIformat\fR string.  A null format string
+is permtted.
+
+
+.ks
+.nf
+          keyword               values                 default
+
+        up	        degrees ccw, zero = +x          90
+        size            character size scale factor	1.0
+        path	        left,right,up,down              r
+        hjustify        normal,center,left,right	l
+        vjustify        normal,center,top,bottom        b
+	font		roman,greek,italic,bold		r
+	quality		normal,low,medium,high		n
+	color		integers greater than one	1
+.fi
+.ke
+
+
+The attributes controlling how text is generated are shown above.
+The character up vector (attribute \fIup\fR) defines the horizontal and
+vertical axes (the horizontal axis is perpendicular to the character up
+vector).  Directions left and right, up and down are relative to these axes.
+The attribute \fIpath\fR defines the direction in which characters are
+to be plotted.  The attribute \fBquality\fR makes it possible to choose
+between low or medium quality (fast) and high quality (expensive) character
+generation techniques, e.g., hardware versus software character generation.
+This attribute is normally best set to "normal" and then overridden at
+metafile translation time.
+
+The attributes are set in the format string by a semicolon delimited list of
+keyword=value constructs.  Only the first character of keyword and value
+strings is significant, i.e., keywords and values may be abbreviated to as
+little as one character if desired.  For example, the format "p=d;v=c"
+would plot characters downward in a vertical string centered at the position
+given.
+
+The default font is set by the font attribute at the beginning of each call.
+Font changes may also be signaled by placing the sequence "\fF" in the text,
+where F is one of the characters RGIB, denoting the fonts roman, greek,
+italic, and bold.  In this manner the font may change from character
+to character within a single line of text.  Additional escape sequences may
+be added to represent special symbols.
+.le
+
+.tp 10
+.ls gfill (gp, x, y, npts, style)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# X coordinates of polygon
+real	y[npts]		# Y coordinates of polygon
+int	npts		# number of vertices of polygon
+int	style		# type of fill
+.fi
+
+Area fill.  The points (x[i],y[i]) define a closed area which will be filled
+in the indicated \fIstyle\fR.  The recognized style codes, defined in <gset.h>,
+are:
+
+.ks
+.nf
+	0	GF_CLEAR	clear area
+	1	GF_HOLLOW	draw only outline of area
+	2	GF_SOLID	fill area with a color
+       3-6	GF_HATCH[1234]	fill area with a pattern
+       7-N			device dependent
+.fi
+.ke
+
+If the device can support multiple colors the color index for area fill may
+be set beforehand with a call to \fBgset\fR to set the parameter G_FILLCOLOR.
+.le
+
+.tp 10
+.ls gpcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+short	m[nx,ny]	# greylevels or colors (pixels)
+int	nx, ny		# number of pixels in X and Y
+real	x1, y1		# lower left corner of output area
+real	x2, y2		# upper right corner of output area
+.fi
+
+Output a cell array.
+Map each pixel in the input array into the corresponding area
+of the output device.  For maximum efficiency the resolution of M should
+match that of the area of the output device defined by the window (x1,y1)
+and (x2,y2), otherwise M is subsampled or replicated to best fill the output
+area.  The aspect ratio of a pixel need not be preserved in the mapping.
+The pixel values (greylevels or color indices) are passed on to the kernel
+without modification.
+.le
+
+.tp 7
+.ls gscur (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# new cursor position
+.fi
+
+Move the device cursor to the indicated position (WCS coordinates).
+.le
+.le
+
+.nh 3
+Input Procedures
+
+    Input procedures are available for cursor and pixel input.  Inquiry of GIO
+parameters and device capabilities is handled by the \fBgstat\fR and \fBgget\fR
+procedures and is not considered graphics input.
+
+.ls
+.tp 8
+.ls clgcur (param, wx, wy, wcs, key, strval, maxch)
+
+.nf
+char	param[ARB]	# CL parameter to be input
+real	wx, wy		# world coordinates of cursor event
+int	wcs		# index of WCS selected
+int	key		# keystroke value of cursor event
+char	strval[maxch]	# string value if set option (key = ':')
+int	maxch		# max chars to be returned in strval
+.fi
+
+The next value of the list structured CL cursor type parameter \fIparam\fR
+is read and the cursor coordinates in WCS units are decoded and returned
+as output arguments, along with the WCS number and the keystroke value,
+i.e., the character typed by the user causing the cursor to be read.
+The range of keystroke values is the full ASCII character set, minus a system
+dependent subset of control codes (if a physical cursor is read, the read is
+always terminated by the user typing a key on the user terminal).
+No GIO device need be open to read the cursor.  EOF is returned as the
+function value when the end of the cursor list is reached.
+The number of output arguments successfully decoded is returned as the
+function value for a normal read.  Values not converted are set to zero.
+.le
+
+.tp 8
+.ls ggcur (gp, sx, sy, key)
+
+.nf
+pointer	gp		# graphics descriptor
+real	sx, sy		# NDC coordinates of cursor event
+int	key		# keystroke value of cursor event
+.fi
+
+The physical cursor of the graphics device associated with graphics
+descriptor \fIgp\fR is read and the cursor coordinates in NDC units are
+returned as output arguments, along with the keystroke value, i.e.,
+the character typed or button pushed causing the cursor to be read.
+On many devices the cursor read will be instantaneous (the cursor position
+will be sampled), and the keystroke value will always be zero.  The range
+of possible keystroke values is device dependent.  EOF is returned as the
+function value when the end of the cursor list is reached.  An error action
+is taken if the device is not readable.  The GIO device must have previously
+been opened with \fBgopen\fR.
+
+Use of this low level procedure is not recommended since it forces a program
+to be used interactively, operation is device dependent, and cursor mode
+interaction is not supported.  The main uses for \fBggcur\fR are cursor input
+from special graphics devices, i.e., devices other than \fBstdgraph\fR or
+\fBstdimage\fR, and continuous sampling of the cursor position on devices
+which support it.  The characteristics of the device cursors are described
+in the graphcap entry for the device.
+.le
+
+.tp 10
+.ls ggcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+short	m[nx,ny]	# output pixel array
+int	nx, ny		# number of pixels out in X and Y
+real	x1, y1		# lower left corner of input area
+real	x2, y2		# upper right corner of input area
+.fi
+
+Input a cell array.  The cell array defined by the rectangular window
+from point (x1,y1) to (x2,y2) is read into the output array M of size
+NX columns by NY lines.
+For maximum efficiency the resolution of the output array should match
+that of the device area defined by the input window.
+If the resolution of the output array does not match that of the device
+output lines will be subsampled or replicated to best fit the output array.
+Unaddressable pixels are returned as negative values.  An error action is
+taken if the device is not readable.
+.le
+.le
+
+.nh 2
+GIO Internal Parameters
+
+    The GIO internal parameters may be set with either a \fBgset\fR or
+\fBgscan\fR call, and inspected with a \fBgstat\fR function call.
+Parameters are identified to \fBgset\fR and \fBgscan\fR by an integer
+code.  Each integer code is assigned a symbolic name of the form G_PARAM
+in the include file <gset.h>.  In input to \fBgscan\fR, parameters are
+referred to by name in lower case, without the "g_" prefix.  The parameters
+and their default values are shown below.
+
+
+.tp 5
+.nf
+        \fBparameter     default            description\fR
+
+	wcs		1	index of current WCS
+	xtran		linear	linear, log, or nlog (WCS attribute)
+	ytran		linear	linear, log, or nlog (WCS attribute)
+	clip		yes	clip at viewport boundary (WCS attribute)
+	cursor		1	current cursor number
+	pltype		1	polyline linetype
+	plwidth		1.0	polyline relative line width
+	plcolor		1	polyline color index
+	pmltype		1	polymarker linetype
+	pmcolor		1	polymarker color index
+	szmarker[1-4] (.5:2)*ch	standard marker sizes, NDC coordinates
+	fastyle		1	fill area interior style
+	facolor		1	fill area color index
+	txsize		1.0	relative character size
+	txup		90	character up vector
+	txpath		right	direction in which characters are drawn
+	txspacing	0.0	character spacing relative to height
+	txhjustify	left	horizontal justification (n,c,l,r)
+	txvjustify	bottom	vertical justification (n,c,t,b)
+	txfont		roman	text font (roman,greek,italic,bold)
+	txquality	normal	text generator precision (n,l,m,h)
+	txcolor		1	text color index
+.fi
+
+.tp 9
+.nf
+	    (axis labeling parameters)
+
+	drawtitle	yes	draw plot title if given
+	titlesize	1.0	character size for plot title
+	titlejust	center	horizontal justification of title
+	ntitlelines	1	number of lines in title block
+	aspect		0.0	aspect ratio of viewport (0=dontcare)	
+
+	    (the following are duplicated for the Y axis)
+
+	xdrawaxes	3	draw X axis 1, 2, both (3), none (0)
+	xsetaxispos	no	set world coords of X axes
+	xaxispos1	0.0	world coord of X axis 1 (default wx1)
+	xaxispos2	0.0	world coord of X axis 2 (default wx2)
+	xdrawgrid	yes	draw grid marks connecting X ticks
+	xround		no	extend WCS to end at a tick mark
+	xlabelaxis	yes	draw axis label string if given
+	xaxislabelsize	1.0	character size for X axis label
+	xdrawticks	yes	draw and label X ticks
+	xlabelticks	yes	label X ticks
+	xnmajor		6	number of major ticks in X
+	xnminor		4	number of minor ticks in X
+	xmajorlength	0.8ch	length of a major tick, X
+	xminorlength	0.4ch	length of a minor tick, X
+	xmajorwidth	1.0	linewidth of a major tick, X
+	xminorwidth	1.0	linewidth of a minor tick, X
+	xaxiswidth	1.0	linewidth of the axis
+	xticklabelsize	1.0	character size for X tick labels
+	xtickformat	""	override format for X tick labels
+.fi
+
+.tp 4
+.nf
+	    (read only variables)
+
+	tty		-	pointer to TTY graphcap descriptor
+	fd		-	file descriptor of output stream
+	devname		-	device name as passed to gopen
+.fi
+
+
+The Y axis parameters have names equivalent to those shown with the
+X prefix replaced by a Y.  If the prefix is omitted entirely then the
+parameters for both axes will be set or queried.
+The \fBglabax\fR code and parameters are built upon the GIO graphics
+primitives and may be replaced by a more sophisticated user program
+if desired.
+
+Drawing and labeling of the X and Y axes is parameterized independently
+in X and Y.  If drawing and labeling of an axis is disabled, tick drawing
+and labeling is automatically disabled.  Drawing and labeling of an axis
+may be disabled on only one side of the viewport (useful when a single viewport
+is used simultaneously for two different world coordinate systems).
+If tick drawing is disabled tick labeling is automatically disabled.
+The tick marks, if drawn, may be connected by dotted lines within the
+interior of the plot.
+
+Given the approximate number of major ticks, GIO will compute the nearest
+number of tick marks resulting in round numbers for the tick mark labels.
+If rounding is enabled the window will be enlarged to the nearest tick
+outward on either end of an axis, otherwise an axis will end at the window
+boundary, which need not fall on a tick mark.
+If linear scaling is indicated \fInminor\fR minor ticks will be drawn
+between each pair of major ticks.  If log scaling is indicated the
+\fInmajor\fR and \fInminor\fR parameters are ignored and
+major ticks will be placed at powers of ten with eight minor ticks
+(e.g., 2,3,4,5,6,7,8,9) between each pair of major ticks.
+Tick lengths are given in NDC coordinates.  The default tick lengths
+are parameterized in terms of the character height for the device.
+
+
+.nh 2
+Graphcap Parameters
+
+    Each logical graphics device accessible to GIO must have an entry
+in the \fBgraphcap\fR (graphics capabilities) file.  The name of the
+device entry in the graphcap file must agree with that specified in the
+\fBgopen\fR call when the device is opened.  Multiple logical device
+entries may be given for a single physical device, each with slightly
+different parameters.  The name of the graphcap file is parameterized
+by the CL environment variable "graphcap", making it easy for the user
+to customize or extend the graphcap file.  The graphcap entries for
+common devices may be precompiled by the system manager to eliminate
+the overhead of searching the graphcap file at run time.
+
+The format of the graphcap file is identical to that of a UNIX \fBtermcap\fR
+file, and indeed the same interface (TTY) is used to access both types of files.
+The set of capabilities defined for a graphics device is however quite
+different than that defined for a terminal.  Capabilities are typed 
+parameters referred to by a two character internal name.  The restriction to
+two characters is perhaps unfortunate but is desirable for efficiency reasons
+(as well as for compatablity with the original termcap) and may be alleviated
+at some point in the future by the use of macro defines.
+
+Graphcap parameters fall into two classes, those parameters which are
+common to all devices, and those parameters which are required only for
+devices accessed with a particular graphics kernel.  GIO is capable
+of supporting any number of quite different kernels, each of which may
+support any number of devices.  These kernels are free to add parameters
+to their graphcap entries provided they do not conflict with the standard
+parameters.  An example is the "fast" or \fBstdgraph\fR kernel, discussed
+in detail in a later section.  If a device is to be accessed by more than
+one kernel each kernel must typically have its own graphcap entry for the
+device, with selection of the graphcap entry (logical device name)
+specifying the kernel to be used.
+
+In the discussion which follows the reader is assumed to already be familiar
+with the syntax and usage of \fBtermcap\fR format files.  This is documented,
+for example, in section 5 of the UNIX manuals.  A sample termcap entry for
+the devices "vt100-nam" and "vt100-am" is included below as an example of
+a typical termcap entry.
+
+
+.tp 5
+.nf
+d1|vt100|vt100-nam|vt100 w/no am:\
+	:am@:xn@:tc=vt100-am:
+d0|vt100|vt100-am|vt100|dec vt100:\
+	:cr=^M:do=^J:nl=^J:bl=^G:co#80:li#24:cl=50\E[;H\E[2J:\
+	:le=^H:bs:am:cm=5\E[%i%d;%dH:nd=2\E[C:up=2\E[A:\
+	:ce=3\E[K:cd=50\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
+	:md=2\E[1m:mr=2\E[7m:mb=2\E[5m:me=2\E[m:is=\E[1;24r\E[24;1H:\
+	:rs=\E>\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h:\
+	:if=/usr/lib/tabset/vt100:ku=\EOA:kd=\EOB:kr=\EOC:kl=\EOD:kb=^H:\
+	:ho=\E[H:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:ta=^I:pt:sr=5\EM:vt#3:xn:\
+	:k5=\EOp:k6=\EOx:k7=\EOr:k8=\EOm:k9=\EOl:k0=\EOq:\
+	:sc=\E7:rc=\E8:cs=\E[%i%d;%dr:ks=\E[?1h\E=:ke=\E[?1l\E>:
+.fi
+
+
+Note that each device may be known by several names.  The device capabilities
+are delimited by colons, e.g., ":xx=...:yy=...:".  The special capability "tc"
+allows an entry to include another entry recursively.  Escape is represented
+as either "\E" or "^[", <ctrl/h> is "^H".  If a delay of so many milliseconds
+is required after transmission of a string, the number of milliseconds
+appears as the first few chars in an entry, e.g., "cl=50..." causes a
+delay of 50 milliseconds following a screen clear.  Numeric capabilities are
+prefaced by a sharp, e.g., ":co#80:" (screen has 80 columns).
+
+
+.nh 3
+Generic GRAPHCAP Parameters
+
+    To make the distinction between the generic and kernel graphcap parameters
+clear and to eliminate the possibility of redefinitions, the generic
+parameters have lower case names and the kernel parameters have upper case
+names.  Only the standard graphcap parameters should be accessed from within
+applications programs.  The standard parameters are listed and defined below.
+These parameters should be included in the graphcap entry for every device.
+
+.ls 4
+.ls 15 ar   real
+Aspect ratio dY/dX, i.e., the ratio of the size of the device screen in Y to
+that in X (equivalent to ys/xs).
+.le
+.ls ca   bool
+Device implements cellarray plotting in hardware, i.e, the \fIzr\fR greylevels
+are displayed by the hardware rather than emulated by software in the kernel.
+.le
+.ls ch   real
+Height in NDC units of a character of size 1.0.
+.le
+.ls co   int
+Number of columns of text displayable on the device screen at character
+size 1.0.
+.le
+.ls cw   real
+Width in NDC units of a character of size 1.0.
+.le
+.ls fa   bool
+Device implements fill area in hardware.
+.le
+.ls fs   int
+Number of fill area styles supported by the device.
+.le
+.ls in   bool
+Device supports at least one input function, i.e., cursor readback or cell
+array input.
+.le
+.ls k1   int
+Minimum possible key value in a cursor read.
+.le
+.ls k2   int
+Maximum possible key value in a cursor read.
+.le
+.ls kf   str
+Filename of the executable graphics kernel file for the device.
+If this is given as "cl", the kernel is assumed to be resident in the
+CL process.  Should be a virtual filename, e.g., "dev$x_device.e".
+See also parameter \fItn\fR.
+.le
+.ls li   int
+Number of lines of text displayable on the device screen at character
+size 1.0.
+.le
+.ls lt   int
+Number of linetypes supported by the device.
+.le
+.ls lw   int
+Number of linewidths supported by the device.
+.le
+.ls nc   int
+Number of cursors supported by the device.
+.le
+.ls nk   int
+Number of possible key values in a cursor read.
+.le
+.ls pl   bool
+Device implements polyline drawing in hardware.
+.le
+.ls pm   bool
+Device implements polymarker drawing in hardware.
+.le
+.ls ro   bool
+Device supports roam at the hardware level (used in cursor mode).
+.le
+.ls se   bool
+Device supports selective erase of portions of the screen.
+.le
+.ls tf   int
+Number of text fonts supported by the device.
+.le
+.ls th   int
+Number of text heights or sizes supported by the device.  If absent or zero
+it is assumed that characters may be freely scaled in size.  If only a number
+of discreet character sizes are available the sizes are given by the
+parameters \fItN\fR.
+.le
+.ls tn   str
+Taskname, i.e., name of the logical task within the kernel file \fIkf\fR
+to be run to exercise a kernel.
+.le
+.ls tq   int
+Number of text quality or precision levels supported by the device.
+.le
+.ls tN   real
+Sizes of the \fIth\fR possible character sizes, relative to a character
+of size 1.0 (expands to the set of parameters t1,t2,...,tN).
+.le
+.ls tx   bool
+Device implements text generation in hardware.
+.le
+.ls wc   bool
+Reading the cursor implies a wait, i.e., a cursor read is triggered by
+the user.
+.le
+.ls xr   int
+Device resolution in X.
+.le
+.ls xs   real
+Device scale in X, i.e., the width of the display area in meters.
+.le
+.ls yr   int
+Device resolution in Y.
+.le
+.ls ys   real
+Device scale in Y, i.e., the height of the display area in meters.
+.le
+.ls zo   bool
+Device supports zoom at the hardware level (used in cursor mode).
+.le
+.ls zr   int
+Device resolution in Z, i.e., the number of greylevels or colors displayable
+at each point using the cell array primitive.
+.le
+.le
+
+
+The graphcap parameters are accessed by name via \fBgget\fR calls.
+For example,
+
+	xr = ggetr (gp, "xr")
+
+would assign the value of the parameter "xr" into the local variable of
+the same name.
+
+.nh 3
+STDGRAPH Graphcap Parameters
+
+    The \fBstdgraph\fR kernel is the "fast" kernel, i.e., the graphics kernel
+resident in the CL process.  This kernel is capable of driving almost any
+modern graphics terminals given only a graphcap entry for the device,
+providing the graphics terminal is data driven and provides both character
+and vector generation in hardware.
+
+.nh 4
+Classes of Parameters
+
+    The stdgraph parameters fall into a number of classes which we shall
+describe separately.  An alphabetical summary of all parameters is given in
+a later section.
+
+The open and close workstation sequences are sent to the device whenever the
+workstation is activated (OW) or deactivated (CW), e.g., when the STDGRAPH
+kernel receives the open workstation or close workstation directive, or when
+the open workstation is explicitly deactivated and later reactivated by the
+applications program.
+
+The primary function of the open and close workstation sequences is to
+effect a mode switch from text mode to graphics mode and back again,
+but the sequences may also contain instructions used only for initialization
+or mode setting.  For example, OW might initialize user defined line types
+or enable the graphics board.  The close string CW might disable the graphics
+board and set the alpha cursor to a standard place on the screen.
+
+The graphics enable and disable strings (GE,GD) are sent to the terminal
+by the STDGRAPH kernel when status line i/o occurs.  The GD sequence should
+clear the status line, leaving the terminal in status line mode, with the
+text cursor positioned to the start of the status line.  The GE sequence
+restores the terminal to graphics mode, and is often the same as the OW
+sequence.  Note that GD should not cause the graphics frame to disappear,
+as the status line is supposed to be visible at the same time as the plot.
+
+The status line is normally the line at the bottom of the screen.  On terminals
+with separate text and graphics memories which can both be displayed at the
+same time, the status line is normally written into the text memory.  If the
+terminal has both text and graphics memories but can only display one at a time
+the graphics memory should be used, provided the status line can be erased in
+the graphics memory.  If the graphics plane must be used but erase is not
+possible, the best approach is probably to write successive lines of status
+line text on top of the plot, starting at the upper left corner and advancing
+downward for each line of output text (see the 4012 entry in dev$graphcap).
+
+The parameters X1, X2, Y1, and Y2 define the range of device coordinates
+to be output.  Normally these will span the full screen of the device,
+but in general they may define any rectangular window on the device screen.
+The fill area and font tables are array valued parameters mapping the GKI
+fill area and font indices into device codes (if the device should happen
+to support such niceties).
+
+
+.ks
+.nf
+	OW		open (reactivate) workstation
+	IF		initialization file, if OW string is large
+	CW		close (deactivate) workstation
+	GE		graphics enable (exit status line mode)
+	GD		graphics disable (enter status line mode)
+	CL		screen clear
+	LR		load registers (see "binary encoding")
+
+	X1,X2		range of device X coordinates
+	Y1,Y2		range of device Y coordinates
+.fi
+.ke
+
+
+The set attribute parameters are format strings used to encode set attribute
+commands, each of which has a single integer argument.  The format string is
+similar to a \fBprintf\fR format string with the addition of a notation for
+binary encoding (described below).
+
+
+.ks
+.nf
+	TH(i)		set text height
+	TC(i)		set text color
+	TF(i)		set text font
+	LT(i)		set line type
+	LC(i)		set line color
+	LW(i)		set line width
+	MC(i)		set marker color
+	FT(i)		set fill area type
+	FC(i)		set fill area color
+.fi
+.ke
+
+
+Polyline generation, i.e., vector drawing, is more difficult to parameterize.
+We assume that polylines, polymarkers, fill areas, etc. are all similar enough
+to be described by the same coordinate encoding format, but we allow each
+such instruction to have different head and tail strings.
+
+.ks
+.nf
+	PL		polyline flag
+	VS		move start
+	VE		move end
+	DS		draw start
+	DE		draw end
+	MS		marker start
+	ME		marker end
+	FS		fillarea start
+	FE		fillarea end
+	XY(i,j)		coord format
+.fi
+.ke
+
+
+A polyline command consists of a number of subcommands, as outlined in the
+drawing below.  The polyline is a move followed by one or more draws.
+The polyline flag PL is set to indicate that multiple coordinate pairs
+can be output between the DS and DE commands.  If PL is false (or omitted)
+each coordinate pair in the GKI polyline will be output surrounded by DS
+and DE commands.  The encoding of each coordinate pair is defined by the
+parameter XY.
+
+
+.ks
+.nf
+	set attributes if necessary
+	move start
+	    x, y
+	move end
+	draw start
+	    x, y
+		...
+	    x, y
+	draw end
+.fi
+.ke
+
+
+The polymarker and fillarea parameters are optional.  The kernel will
+emulate markers and fill area if not supported by the hardware.
+Recall that GIO handles all mark drawing except GM_POINT (point mode),
+hence sophisticated mark drawing facilities are not required.
+
+Text generation is handled by the kernel a character at a time.
+If character up is 90 degrees and the path is to the right, the kernel
+will assume that it can output a number of characters between a TS
+and a TE.  Otherwise each character will be output preceded by a TS
+and followed by a TE.  The TS parameter is a format string with two
+arguments, the device coordinates of the lower left corner of the
+character to be drawn.  The encoding of these coordinates is defined
+by the TS format string.  It is possible to perform a coordinate
+transformation using the binary encoding facilities, if such is necessary.
+If characters are not addressed at the lower left corner an offset
+may be applied to the given coordinates using the binary encoding
+facilities.
+
+
+.ks
+.nf
+	TS(i,j)		text start
+	TE		text end
+.fi
+.ke
+
+
+Cursor output is controlled by the parameter WC.
+Cursor input is initiated by output of the sequence defined by the format RC.
+RC has one integer argument, the number of the cursor to be read.
+The UC capability, if defined, will cause the cursor position to be updated
+(with WC) to the position at the last cursor read.  This is desirable if the
+device cannot maintain the cursor position, i.e., if unrelated graphics
+output commands affect the cursor position as an unwanted side effect.
+
+
+.ks
+.nf
+	UC		update cursor pos before read
+	WC(x,y,i)	write cursor 
+	RC(i)		read cursor start
+	RE		read cursor end
+	CN		cursor value length
+	CD		cursor value delimiter
+	SC		scan cursor (-> x,y,key)
+.fi
+.ke
+
+
+Following transmission of the RC sequence the kernel will read the
+response as defined by the parameters CN and CD.  At least one of CN or CD
+must be given.  If CN is given but not CD exactly CN characters will be
+read.  If CD is given then characters will be read until the delimiter string
+is matched (and until at least CN characters have been read).  If possible
+a delimiter string should be specified to permit recovery from bad cursor
+reads, e.g., when the user types something before the cursor is displayed.
+When a satisfactory cursor response string has been obtained the format SC
+will be used to decode the string into the output values X, Y, and KEY.
+The RE sequence is transmitted once the cursor read has successfully
+completed.
+
+.nh 4
+Binary Encoding
+
+    Graphics devices vary widely in the techniques used to encode numeric
+data such as a line type or color index, or the coordinate pairs of a
+polyline.  Our approach to the encoding problem is a generalization of the
+\fBprintf\fR format string.  The encoder is driven by a format string
+taken from the graphcap entry for the device.  A number of standard formats
+are recognized with encoding provided internally for these standard formats
+by the encoder.  To permit encoding of special formats the encoder provides
+a very general yet efficient RPN virtual machine capable of computing bit
+patterns according to a user supplied program embedded in the format string.
+
+A format string is a sequence of ASCII characters.  Any ASCII character,
+including all control characters, is permitted in the string.
+The significance of a character depends on the context in which it appears.
+Initially characters are simply copied to the output.  Three special
+characters are recognized in \fBcopy mode\fR (excluding the characters
+already counted as special by termcap):
+
+
+.ks
+.nf
+	'	escape next character (literal)
+	%	begin a formatted output string
+	(	begin an executable expression
+.fi
+.ke
+
+
+The encoder is a table driven interpreter which is programmed by the format
+given in the graphcap file.  Programming the encoder is rather
+like programming in assembler or microcode (its fun but easy to screw up).
+The encoder provides a set of 12 integer registers, an integer stack with a
+capacity of 50 values, and a dozen or so instructions.  It is fundamentally
+assumed that the character set is ASCII (this is guaranteed by the IRAF
+programming environment).
+
+Upon entry one or more of the registers 1 through 3 are initialized to the
+values of the input arguments, leaving the remaining registers, i.e., R4-R9
+and R0 (R10) available for general use.  Registers R11 and R12 are reserved
+for internal use.
+The interpreter is activated when an unescaped ( is encountered in the input.
+In \fBexecute mode\fR the following characters have special meanings
+(excluding :, ^, and \, which are special characters to termcap/TTY):
+
+.ks
+.nf
+	'	escape next character (recognized everywhere)
+	%	conventional formatted output
+	)	revert to copy mode
+	#nnn	push signed decimal integer number nnn
+	$ 	switch case construct
+	.	pop number from stack and place in output string
+	,	get next character from input string and push on stack
+	&	modulus (similar to AND of low bits)
+	+	add (similar to OR)
+	-	subtract (similar to AND)
+	*	multiply (shift left if pwr of 2)
+	/	divide (shift right if pwr of 2)
+	<	less than (0=false, 1=true)
+	> 	greater than (0=false, 1=true)
+	=	equals (0=false, 1=true)
+	;	branch if: <bool> <offset> ;.  The ; is at offset=0.
+       0-9	push contents of register 0 through 9
+	!N	pop stack into register N
+	!!	generate a N millisecond delay, where N is on the stack
+.fi
+.ke
+
+
+Any other character encountered in execute mode is interpreted as an integer
+number and pushed on the stack.  Hence, the character "@" is equivalent to
+"#64", i.e., octal 100.  A blank is the integer constant 40B.
+
+The output format directive % will format and output the number on the top
+of the stack, popping the stack in the process.  The format specification
+may be any legal \fBprintf\fR format.  The case construct is used to process
+set attribute commands, e.g., set linetype 0, 1, 2, text size 1, 2, 3, etc,
+and also provides a rudimentary conditional processing capability.  The branch
+if operator ; provides a rudimentary branching and looping capability.
+Beware that sequences like "^N" and "\E" compile as a single character in
+the format string.
+
+.nh 4
+Examples
+
+    As a simple example consider the encoding of the ANSI command to set
+the cursor of a nongraphics terminal.  The required sequence is the
+following:
+
+	ESC [ line ; col H
+
+Assuming that the column number is designated as X and the line number as
+Y, in registers 1 and 2 respectively, the format would be as follows
+(the quotes are not part of the format):
+
+	"\E[(2)%d;(1)%dH"
+
+Now assume that the output sequence is the same but the line and column
+numbers are one-indexed while the terminal requires zero-indexed
+coordinates:
+
+	"\E[(2#1-)%d;(1#1-)%dH"
+
+Thus far the examples have been pretty trivial and do not warrant the
+complexity of the RPN interpreter proposed here.  For our next example
+consider the encoding of a polyline coordinate pair for a Tektronix
+compatible graphics terminal and for an AED512, two quite different
+graphics terminals.  The Tektronix format for encoding an (X,Y) coordinate
+pair is as follows:
+
+
+.ks
+.nf
+	0 1 YA Y9 Y8 Y7 Y6
+	1 1 Y5 Y4 Y3 Y2 Y1
+	0 1 XA X9 X8 X7 X6
+	1 0 X5 X4 X3 X2 X1
+.fi
+.ke
+
+
+Since the Tektronix device is so common the special format %t is provided
+for encoding register 1 and 2 (X and Y) in this format, and writing out
+the result.  The format string
+
+	"%t"
+
+is all that is required.  The more general solution is provided by the
+following format.
+
+	"(2 / +.2 &`+.1 / +.1 &@+."
+
+To understand this last example one must look up the octal values of
+the characters " " (40B), "`" (140B), and "@" (100B).  The notation is
+admittedly rather cryptic but it is also concise and efficient, and works
+for a wide range of devices.
+
+Now consider the AED512 in binary mode (this is courtesy of NCAR; I do not
+have access to such a terminal).  The output encoding of a coordinate pair
+is as follows:
+
+
+.ks
+.nf
+	XA X9 X8 YB YA Y9 Y8
+	X7 X6 X5 X4 X3 X2 X1
+	Y7 Y6 Y5 Y4 Y3 Y2 Y1
+.fi
+.ke
+
+
+The format required to generate this is shown below.  Note the use of
+register 9 to store the constant 200B.  The "^N" signifies <ctrl/n>,
+i.e., 16B, used to effect a left shift of four bits.
+
+	"(#128!919/^N*29/+.19&.29&."
+
+This format could be further optimized by preloading register 9 at
+\fBopenws\fR time by moving the "(#128!9" to parameter LR.  The encoder
+registers maintain their values indefinitely.  Using LR the two parameters
+might appear in the graphcap entry as follows.
+
+	":LR=(#128!9:XY=(19/^N*29/+.19&.29&.:"
+
+The case construct makes it possible to generate output conditionally based
+on the value of an integer switch.  The syntax of a case statement is as
+follows:
+
+	$1 ... $2-5 ... $6 ... $D ... $$
+
+When the first $ is encountered the switch value is popped off the stack
+and converted into a character by addition of the constant '0' (60B).
+The interpreter will then scan forward until it finds the indicated case,
+at which point it resumes execution in case mode.  If the indicated case
+is not found scanning will stop at $D (the default case) or $$, whichever
+comes first.  When the next $ is seen the interpreter skips forward until
+it finds $$, which marks the end of the case.  Case constructs are not
+nestable.
+
+The case construct is used primarily for set attribute formats.
+For example, the GKI linetype codes are integers greater than or equal to zero,
+with case zero being the line clear and the other cases actual linetypes.
+For the VT640 there are nine possible linetypes, i.e., line clear,
+five builtin linetypes, and 3 user defined linetypes.  The strings to be
+output for the cases 0 through 5 are the following:
+
+
+.ks
+.nf
+	linetype		     string
+
+	    0			ESC / 1 d ESC `
+	    1			ESC / 0 d ESC `
+	    2			ESC / 0 d ESC a
+	    3			ESC / 0 d ESC b
+	  (etc)			     (etc)
+.fi
+.ke
+
+
+We could encode linetypes 0, 1 through 5, and everything else with the
+following format (linetype code in register 1):
+
+	"\E/(1$0)0d\E`($1-5)1d\E(1_+.$D)0d\E`($$"
+
+Note that case searching is a simple string matching operation that ignores
+operators such as ( and ).  Only $, ' (escape), and EOS are recognized when
+searching for a case.
+
+.nh 4
+Efficiency
+
+    The interpreter approach to solving the general encoding problem
+presented here is not the only solution to the problem.  Before adopting
+this approach several alternatives were considered.  One such alternative
+was the bitfield packing and unpacking scheme used by NCAR to solve the
+same problem.  The third alternative considered was to hand code a
+subroutine for each encoding required for each device.  Benchmarks run
+to compare the three alternatives yielded the following times in
+cpu seconds required to plot a 1000 point array with Tektronix encoding:
+
+
+.ks
+.nf
+	bitfields	approximately 30 seconds
+	interpreter	0.82 - 2.0 seconds
+	hand coded	0.78 seconds (mostly i/o)
+.fi
+.ke
+
+
+The time required for character output is included in the figures shown.
+The bitfields benchmark is an extrapolation from an actual timing of the
+prototype NCAR software as ported to the UNIX VAX by Cliff Stoll.
+The GBYTE and SBYTE primitives used to implement bitfields in the NCAR
+software were written in portable C by Cliff and did not use the VAX bitfield
+instructions, which would have helped significantly (but which would not
+have yielded a fair test: all IRAF target machines may not have bitfield
+instructions).  The two timings shown for the interpreter are for the "%t"
+format and the general format.  The clock time required by the hardware
+(VT100 with VT640 retrographics board) to draw the vectors was about 7 seconds.
+
+We conclude that the execution time overhead of the interpreter for encoding
+polyline points is acceptable and the use of hand coded, device dependent
+procedures is neither warranted nor desirable.  The bitfields technique
+is too inefficient to use in a production interface.
+
+.nh 4
+Decoding Cursor Input
+
+    Decoding of the cursor value string returned by the device into
+X, Y, and KEY (keystroke) values is carried out using the table driven
+interpreter for decoding rather than for encoding.  In this mode characters
+are input with "," and the decoded output values X, Y, and KEY are returned
+in registers 1 through 3.  The % format encoding operator is not used.
+If the cursor value is returned in ASCII X and Y must be converted to
+binary the hard way (e.g., "ch1 '0' - 100 * ch2 '0' - 10 * +", etc.).
+
+To verify that this scheme will work consider the cursor value returned
+by a Tektronix compatible terminal.  The return value is 6 characters,
+consisting of the character typed followed by the encoded X and Y in
+the next four characters, and lastly a CR terminator:
+
+
+.ks
+.nf
+	C7 C6 C5 C4 C3 C2 C1
+	 0  1 XA X9 X8 X7 X6
+	 0  1 X5 X4 X3 X2 X1
+	 0  1 YA Y9 Y8 Y7 Y6
+	 0  1 Y5 Y4 Y3 Y2 Y1
+	 0  0  0  1  1  0  1
+.fi
+.ke
+
+
+The required decoding format is shown below.
+
+	",!3, & *, &+!1, & *, &+!2"
+
+.nh 4
+Summary of STDGRAPH Graphcap Parameters
+
+    An alphabetical summary of the graphcap parameters used by the STDGRAPH
+kernel is given below.
+
+
+.tp 3
+.nf
+	CD		cursor value delimiter
+	CL		screen clear
+	CN		cursor response length
+	CW		close (deactivate) workstation
+	DE		draw end
+	DS		draw start
+	FC(i)		set fill area color
+	FE		fillarea end
+	FS		fillarea start
+	FT(i)		set fill area type
+	GD		graphics disable (exit status line mode)
+	GE		graphics enable (enter status line mode)
+	IF		initialization file, if OP string is large
+	LC(i)		set line color
+	LR		load registers
+	LT(i)		set line type
+	LW(i)		set line width
+	MC(i)		set marker color
+	ME		marker end
+	MS		marker start
+	OW		open (reactivate) workstation
+	PL		polyline flag
+	RC(i)		read cursor start
+	RE		read cursor end
+	SC		scan cursor (-> x,y,key)
+	TC(i)		set text color
+	TE		text end
+	TF(i)		set text font
+	TH(i)		set text height
+	TS(i,j)		text start
+	VE		move end
+	VS		move start
+	WC(x,y,i)	write cursor 
+	X1		first device X coordinate
+	X2		last device X coordinate
+	XY(i,j)		coordinate format
+	Y1		first device Y coordinate
+	Y2		last device Y coordinate
+.fi
+
+
+As a final example, the actual graphcap entry for the vt640 terminal
+(DEC VT100 with retrographics) is reproduced below.
+
+
+.ks
+.nf
+vt640|vt640g|vt100 with Retrographics:\
+    :RC=(1$2)^X\E[24;65H\E[7mLIGHT PEN READY\E[0m($$)^]\E"(1$2)5($D)4($$)g:\
+    :WC=^]%t\E/f:OW=150^]^_:CW=^X\E[24;0H\E[K:GE=150^]^_:GD=^X\E[24;0H\E[K:\
+    :lt#5:nc#2:se:CL=50^]\E^L:xr#640:yr#480:ar#.57:xs#.23:ys#.13:tc=4012:
+
+4012|tek4012|tektronix 4012:\
+    :ar#.70:ch#.0294:co#80:cw#.0125:in:k1#1:k2#127:kf=cl:li#35:\
+    :lt#5:nc#1:nk#127:pl:pm:th#4:t1#1:t2#2:t3#3:t4#4:tx:\
+    :wc:xr#1024:yr#780:xs#.20:ys#.14:\
+    :CD=^M:CN#6:LT=^]\E/(1$0)1d\E`($1-5)0d\E(1_+.$D)0d\E`($$:\
+    :MS=\034:PL:RC=\E^Z:SC=(,!3, & *, &+!1, & *, &+!2:\
+    :TH=\E(1#47+.:TS=^]%t^_:VS=^]:X1#0:X2#1023:XY=%t:Y1#0:Y2#779:\
+    :OW=^]^_:CW=(#682!2#0!1)^]%t^_:GE=^]^_:\
+    :CL=1000(#32!9)\E^L:\
+    :LR=(#32!9:GD=(9#1-!99$0#31!9$$9#22*!2#0!1)^]%t^_:
+.fi
+.ke
+
+.NH 3
+TERMCAP and GRAPHCAP
+
+    Every graphics terminal entry in the graphcap file should have a
+corresponding terminal capability entry in the termcap file.  When the user
+sets the terminal type with the \fBstty\fR task in the CL, the termcap entry
+tells whether or not the terminal supports vector graphics, and the value
+of the \fBstdgraph\fR environment variable is set to "none" for a non-graphics
+terminal, or to the graphcap name of the device for a graphics terminal.
+For a terminal to be recognized by the system as a graphics terminal the
+termcap entry must include the ":gd" capability.  If the graphcap name for
+the device is different than the termcap name then the form ":gd=gcname:"
+should be used.
+
+For example, the minimal termcap entry for the vt640 graphics terminal would
+be as follows.  Note that it makes no sense to set the terminal type to
+"vt100", since a standard vt100 does not support vector graphics.
+
+.ks
+.nf
+	vt640|Retrographics enhanced VT100:\
+	:gd:tc=vt100:
+.fi
+.ke
+
+The "gd" capability is not standard termcap, but will be ignored by non-IRAF
+programs which do not recognize the capability.
+
+.nh 2
+Graphics Kernel Interface
+
+    The graphics kernel interface (GKI) is the interface between GIO and the
+underlying graphics kernel or kernels.  The GKI is a data driven interface,
+i.e., GIO communicates with the graphics kernel via bidirectional streams
+of control instructions and data.  The functionality assumed by the GKI is
+simple enough to permit use of a variety of graphics kernels, e.g., the builtin
+GIO kernel for interactive graphics terminals, GKS, CORE, NSPP, and so on.
+To understand the level of functionality expected from the kernel we first
+summarize the functions the kernel is \fInot\fR expected to perform, i.e.,
+the functions performed by GIO before output to the kernel:
+
+.ls 4
+.ls o
+All WCS coordinate transformations and clipping at the viewport boundary.
+The kernel sees only NDC coordinates.
+.le
+.ls o
+Axis drawing and labeling.  GIO processes a \fBglabax\fR call into a
+sequence of polylines in NDC coordinates.
+.le
+.ls o
+Mark drawing.  GIO processes all mark drawing commands into polyline
+instructions.
+.le
+.ls o
+Move and draw commands.  GIO processes all absolute and relative move and draw
+commands into sequences of polyline instructions.
+.le
+.le
+
+
+The main functions of the kernel are the control and attribute set functions,
+set cursor, polyline, polymarker (GM_POINT only), text generation, fill area,
+cell array, and cursor read.  A kernel need not implement all such functions,
+but it must at least recognize and ignore the corresponding GKI instructions.
+The GKI kernel instructions are easily implemented for modern intelligent
+graphics terminals.  The fast kernel will let the terminal handle polyline
+drawing, point mode polymarker drawing, dashed lines, and character generation.
+
+The GKI format is a sequence of variable length binary control and
+output instructions.  Each instruction consists of the beginning of instruction
+sentinel (BOI), an integer binary opcode identifying the instruction,
+an integer giving the length of the instruction in metacode words,
+and an arbitrary number of parameter and data words.
+The BOI word aids in the detection of and recovery from botched instructions,
+e.g., if an interrupt occurs while writing an instruction.
+
+
+.ks
+.nf
+	 \fBfield\fR                          \fBdescription\fR
+
+	BOI		beginning of instruction (magic value = 100000B)
+	opcode		unique instruction identification code (1-27)
+	length		length of entire of instruction in metacode
+			    words (includes all four fields)
+	data		variable length part of instruction
+.fi
+
+.ce
+Figure 3. GKI Instruction Format
+.ke
+
+
+The instruction format chosen for GKI is basically a direct mapping of the
+required low level functions into binary opcodes.
+Various standard formats were considered and rejected,
+in particular the GKS VDM (virtual device metafile) format.
+GKS VDM turned out to be far to complex to be worth using at this level
+in the system.  The GKS VDI format might have been better suited,
+but I could not find any information describing this format
+(my understanding was that, although there are numerous implementations of VDI,
+there is no formal standard as yet).
+
+The GKI format may be extended at some point in the future to provide
+a binary instruction for each procedure in the GKS Fortran binding.
+This will make it possible for applications to use either GIO or GKS,
+provided a GKS kernel is available.  This will make it easier to
+import applications which are already written to use GKS (alternatively a
+mini-GKS might be built upon GIO, since the primitive functions are almost
+identical).  Since IRAF itself is transportable and it is desirable for IRAF
+applications to have full access to the IRAF i/o facilities, new IRAF
+applications are not being written with transport to another data reduction
+system in mind.  New IRAF applications will use only GIO whenever the
+facilities provided by GIO are adequate.  Applications which use only GIO
+will continue to be usable with any graphics kernel.
+
+.nh 3
+GKI Instructions
+
+    The GKI instruction stream transmitted between processes on the same or
+compatible machines will be a sequence of SPP short integer metacode words.
+The machine independent GKI metafile format will be the equivalent stream
+encoded as 16 bit twos complement signed integer metacode words, blocked 
+1440 words per block, with conversion between the internal and external
+metacode formats being provided by the IRAF MII (machine independent integer)
+interface (MII takes care of byte swapping, etc.).  GKI metafiles in MII
+format will be easily read and written by different machines, offloading most
+of the work to the graphics kernel on the reader machine.  The GKI instruction
+format is designed for maximum efficiency on modern minicomputers, i.e.,
+the internal format (SPP short integer) is an atomic datatype and no bit
+operations are required to generate or interpret metacode.
+
+NDC coordinates (0.0 to 1.0) will be represented in GKI as integers in the
+range 0-32767.  Character data will be packed one 7 bit ASCII character per
+metacode word.  Floating point is required only for certain output attributes,
+e.g., the linewidth and character height (size) scale factors.
+To avoid the problems of machine dependent floating point formats we shall
+represent the low precision real numbers by converting them to integer
+metacode words scaled according to the following relation:
+
+	I = int (R * 1E2)
+
+Specifications for the GKI metafile instructions follow.  The datatype and
+size of each field of the instruction is given in parenthesis.
+The datatype "p" denotes a coordinate pair (x,y) of type (m,m),
+where "m" denotes an NDC coordinate.
+
+The OPENWS instruction marks the start of an instruction stream or
+\fBmetafile\fR for a particular device.
+A subsequent CLOSEWS (or physical end of file) marks the end of a metafile.
+An OPENWS in APPEND mode requires that GIO recall the WCS defined when the
+device was last accessed.
+A physical file may consist of any number of independent metafiles.
+Although there is no explicit connection between OPENWS and screen clear
+(CLEARWS), a screen clear is implied for some devices when opened in
+new file mode.
+The MFTITLE instruction is optional and is provided only for documenting
+the contents of a metafile.
+
+
+.ks
+.nf
+			GKI_EOF = BOI  0 L
+		     GKI_OPENWS = BOI  1 L M N D
+		    GKI_CLOSEWS = BOI  2 L N D
+	       GKI_REACTIVATEWS = BOI  3 L
+	       GKI_DEACTIVATEWS = BOI  4 L
+		    GKI_MFTITLE = BOI  5 L N T
+		    GKI_CLEARWS = BOI  6 L
+		     GKI_CANCEL = BOI  7 L
+		      GKI_FLUSH = BOI  8 L
+		   GKI_POLYLINE = BOI  9 L N P
+		 GKI_POLYMARKER = BOI 10 L N P
+		       GKI_TEXT = BOI 11 L P N T
+		   GKI_FILLAREA = BOI 12 L N P
+	       GKI_PUTCELLARRAY = BOI 13 L LL UR NC NL P
+		  GKI_SETCURSOR = BOI 14 L CN POS
+		      GKI_PLSET = BOI 15 L LT LW CI
+		      GKI_PMSET = BOI 16 L MT MW CI
+		      GKI_TXSET = BOI 17 L UP SZ SP P HJ VJ F Q CI
+		      GKI_FASET = BOI 18 L FS CI
+		  GKI_GETCURSOR = BOI 19 L CN
+		GKI_CURSORVALUE = BOI 19 L CN POS KEY
+	       GKI_GETCELLARRAY = BOI 20 L LL UR NC NL
+		  GKI_CELLARRAY = BOI 20 L NP P
+		     GKI_ESCAPE = BOI 25 L FN N DC
+		     GKI_SETWCS = BOI 26 L N WCS
+		     GKI_GETWCS = BOI 27 L N
+.fi
+
+.ce
+The GKI Instruction Set
+.ke
+
+.nh 4
+Control Instructions
+
+    The NULL instruction is unique in that it consists of a single metacode
+word with value zero.  The BOI and length fields are omitted.  Any number
+of null words may be inserted between regular metacode instructions, e.g.,
+to pad a block of metacode to be written to an MII format metafile.
+The EOF instruction is used internally by GIO to stop metacode translation
+on a pseudofile stream, as if end of file had been encountered.
+
+The open workstation instruction should start a new frame unless the access
+mode is APPEND, in which case graphics is to be added to the last frame.
+An OPENWS implies an REACTIVATEWS.  CLOSEWS does little more than deactivate
+the workstation, since the last frame must in some sense remain open for
+APPEND mode to be possible.  Normal termination of the kernel process
+will or an open workstation in a mode other than append will cause the last
+frame to be terminated.
+
+
+.ls
+.tp 4
+GKI_EOF = BOI 0 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 6
+GKI_OPENWS = BOI 1 L M N D
+.ls
+.nf
+L(i)		5 + N
+M(i)		access mode (APPEND=4, NEW_FILE=5, TEE=6)
+N(i)		number of characters in field D
+D(Nc)		device name as in \fBgraphcap\fR file
+.fi
+.le
+
+
+.tp 5
+GKI_CLOSEWS = BOI 2 L N D
+.ls
+.nf
+L(i)		4 + N
+N(i)		number of characters in field D
+D(Nc)		device name as in \fBgraphcap\fR file
+.fi
+.le
+
+
+.tp 5
+GKI_REACTIVATEWS = BOI 3 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 5
+GKI_DEACTIVATEWS = BOI 4 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 5
+.rj (optional)
+GKI_MFTITLE = BOI 5 L N T
+.ls
+.nf
+L(i)		4 + N
+N(i)		number of characters in field T
+T(Nc)		title string identifying metafile
+.fi
+.le
+
+
+.tp 3
+GKI_CLEARWS = BOI 6 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+
+
+.tp 3
+GKI_CANCEL = BOI 7 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+
+
+.tp 3
+GKI_FLUSH = BOI 8 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+.le
+
+.nh 4
+Output Instructions
+
+    All data points in the GKI output instructions have been transformed into
+NDC coordinates and clipped at the viewport boundary (if clipping is enabled).
+In the process GIO will translate any INDEF valued points by breaking large
+polylines into smaller polylines, hence the semantics of plotting polylines and
+polymarkers is quite simple at the graphics kernel level.
+
+CELLARRAY is processed into a series of one dimensional cell array instructions,
+one for each line in the two dimensional array supplied by the user.  Fewer or
+shorter lines will be output if clipping is necessary.  Arrays larger than 32767
+pixels may be output since each line is passed as a separate instruction.
+The maximum number of lines and columns in a cell array is 32767 and 32761,
+respectively (more lines can be input but they will not be resolved).
+The kernel is expected to scale cell arrays to fit the output device via some
+combination of pixel replication or subsampling, if there is not a one to one
+correspondence between cell array pixels and device pixels.
+
+.ls
+.tp 5
+GKI_POLYLINE = BOI 9 L N P
+.ls
+.nf
+L(i)		4 + N * 2
+N(i)		number of points in the polyline
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 5
+GKI_POLYMARKER = BOI 10 L N P
+.ls
+.nf
+L(i)		4 + N * 2
+N(i)		number of points in the polymarker
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 6
+GKI_TEXT = BOI 11 L P N T
+.ls
+.nf
+L(i)		6 + N
+P(p)		starting point of character string
+N(i)		number of characters in string T
+T(Nc)		string of N ASCII characters
+.fi
+.le
+
+
+.tp 5
+GKI_FILLAREA = BOI 12 L N P
+.ls
+.nf
+L(i)		4 + (N * 2)
+N(i)		number of points defining the polygon to be filled
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 8
+GKI_PUTCELLARRAY = BOI 13 L LL UR NC NL P
+.ls
+.nf
+L(i)		9 + (N * M)
+LL(p)		coordinates of lower left corner of output area
+UR(p)		coordinates of upper right corner of output area
+NC(i)		number of columns in array
+NL(i)		number of lines in array
+P(NCNLi)	array of color indices (pixels) stored by row
+.fi
+.le
+
+
+.tp 5
+GKI_SETCURSOR = BOI 14 L CN POS
+.ls
+.nf
+L(i)		6
+CN(i)		cursor number
+POS(p)		new cursor position
+.fi
+.le
+.le
+
+.nh 4
+Set Attribute Instructions
+
+    The set polyline, polymarker, text, and fillarea instructions change
+the attributes used to generate graphics output.  These instructions need be
+issued only when one of the attributes in an instruction packet changes, i.e.,
+the kernel is assumed to remember the attributes while a device is open.
+
+.ls
+.tp 6
+GKI_PLSET = BOI 15 L LT LW CI
+.ls
+.nf
+L(i)		6
+LT(i)		linetype number
+LW(r)		linewidth scale factor
+CI(i)		polyline color index
+.fi
+.le
+
+
+.tp 6
+GKI_PMSET = BOI 16 L MT MW CI
+.ls
+.nf
+L(i)		6
+MT(i)		marktype (not used at present)
+MW(i)		marksize, NDC coords (not used at present)
+CI(i)		marker color index
+.fi
+.le
+
+
+.tp 9
+GKI_TXSET = BOI 17 L UP SZ SP P HJ VJ F Q CI
+.ls
+.nf
+L(i)		12
+UP(i)		character up vector (degrees)
+SZ(r)		character size scale factor
+SP(r)		character spacing
+P(i)		path (0,2=left,3=right,4=up,5=down)
+HJ(i)		horizontal justification
+		    (0=normal,1=center,2=left,3=right)
+VJ(i)		vertical justification
+		    (0=normal,1=center,6=top,7=bottom)
+F(i)		font (8=roman,9=greek,10=italic,11=bold)
+Q(i)		quality (0=normal,12=low,13=medium,14=high)
+CI(i)		text color index
+.fi
+.le
+
+
+.tp 5
+GKI_FASET = BOI 18 L FS CI
+.ls
+.nf
+L(i)		5
+FS(i)		fill style (0=clear,1=hollow,2=solid,3-6=hatch)
+CI(i)		fill area color index
+.fi
+.le
+.le
+
+
+The attributes for the output primitives are assumed to be set to their
+default values when OPENWS is issued.
+
+.nh 4
+Input Instructions
+
+    The primary input instruction is the cursor read instruction, used to read
+the cursor position in NDC coordinates.  The device cursor read may be either
+event driven or instantaneous.  If the cursor read is event driven a nonzero
+keystroke value may be returned, the range of possible keystroke values being
+device dependent.  The instantaneous type of cursor read is preferred at the
+GKI level since it offers the maximum flexibility (\fBclgcur\fR may then be
+used to provide an optional device independent keystroke driven cursor read).
+Devices which support both forms of cursor read may provide both as separate
+logical cursors.  The graphics kernel should return a null cursor value if
+the output device does not have a cursor.
+
+.ls
+.tp 6
+GKI_GETCURSOR = BOI 19 L CN
+.ls
+.nf
+L(i)		4
+CN(i)		cursor number
+.fi
+
+The kernel reads graphics cursor number CN and returns the keystroke value
+(if any) and the cursor position in NDC coordinates.  The cursor attributes
+are returned in the following format:
+
+	GKI_CURSORVALUE = BOI 19 L CN POS KEY
+
+where
+
+.nf
+	L(i)		7
+	CN(i)		cursor number
+	POS(r)		NDC coordinates of cursor
+	KEY(i)		keystroke value (>= 0 or EOF)
+.fi
+.le
+
+
+.tp 8
+GKI_GETCELLARRAY = BOI 20 L LL UR NC NL
+.ls
+.nf
+L(i)		9
+LL(p)		coordinates of lower left corner of input area
+UR(p)		coordinates of upper right corner of input area
+NC(i)		number of columns in output array
+NL(i)		number of lines in output array
+.fi
+
+The GETCELLARRAY instruction is the converse of the PUTCELLARRAY instruction.
+The cell array is returned in the following format:
+
+	GKI_CELLARRAY = BOI 20 L NP P
+
+where
+
+.nf
+	L(i)		4 + NP
+	NP(i)		number of pixels (0 if noread)
+	P(NPi)		array of pixels
+.fi
+.le
+
+
+(instruction codes 19-24 are reserved for future use)
+.le
+
+.nh 4
+Escape Instruction
+
+    The escape instruction is used to pass device dependent information or
+commands to the graphics kernel via GKI.  The graphics kernel will ignore
+unrecognized escape functions.  Function codes 1 through 100 are reserved
+for use by GIO.
+
+.ls
+.tp 5
+GKI_ESCAPE = BOI 25 L FN N DC
+.ls
+.nf
+L(i)		5 + N
+FN(i)		escape function code
+N(i)		number of escape data words
+DC(i)		escape data words
+.fi
+.le
+.le
+
+.nh 4
+Pseudo-GKI Instructions
+
+    Since the CL must be able to read the device cursor and convert NDC
+coordinates to WCS coordinates, the WCS must be passed to the CL when they
+are "fixed" to the device.  The most natural and efficient way to do this
+is via the GKI instruction stream, hence several additional instructions
+are used internally in GIO to communicate with the portion of GIO resident
+in the CL process.  These instructions are filtered out and executed by the
+CL process and their existence may therefore be ignored by the graphics kernels.
+
+The SETWCS instruction is used to pass WCS information to the CL process.
+The GETWCS instruction is used to recall the WCS for a device opened in APPEND
+mode (the WCS are returned in SETWCS format).  Since these instructions
+are passed only between two closely coupled processes on a single cpu,
+floating point numbers are passed in machine dependent format.
+The length of this instruction is machine dependent.
+Only the fields L and WCS are truely part of the instruction; the remaining
+fields are a binary copy of the GIO internal WCS structure.
+
+.ls
+.tp 6
+GKI_SETWCS = BOI 26 L N WCS
+.ls
+.nf
+L(i)		4 + 17 * sizeof (struct wcs)
+N(i)		length of WCS structure, words
+WCS		binary copy of the 17 WCS structures, transmitted
+		    in a single call to WRITE
+.fi
+.le
+
+
+.tp 5
+GKI_GETWCS = BOI 27 L N
+.ls
+.nf
+L(i)		4
+N(i)		maximum number of words to read
+.fi
+.le
+.le
+
+.nh 3
+Encoding GKI Instructions
+
+    The GKI instruction opcodes and fields are defined in the global include
+file lib$gki.h.  To avoid direct knowledge of the binary format of the GKI
+instructions, GIO uses a subpackage called GKI to encode the GKI instructions.
+The GKI procedures each encode and transmit a single GKI instruction on the
+output stream.  Although the GIO and GKI procedures have similar names, they
+should not be confused.  The GIO \fBgpline\fR, for example, performs conversion
+from a WCS to GKI coordinates with clipping at the viewport boundary, checking
+that the polyline attributes are up to date before transmitting the polyline
+instruction.  In contrast the GKI \fBgki_polyline\fR merely encodes and
+transmits the GKI_POLYLINE metacode instruction.
+
+The GKI procedures are self contained with the exception of the set attribute
+instructions, which reference attribute packet structures (argument \fIap\fR)
+defined in the include file gio.h.
+The GKI instruction encoding procedures are shown below.
+
+.ks
+.nf
+	     gki_openws (fd, device, mode)
+	    gki_closews (fd, device)
+       gki_reactivatews (fd, flags)
+       gki_deactivatews (fd, flags)
+	    gki_mftitle (fd, title)
+	    gki_clearws (fd)
+	     gki_cancel (fd)
+	      gki_flush (fd)
+	   gki_polyline (fd, points, npts)
+	 gki_polymarker (fd, points, npts)
+	       gki_text (fd, x, y, text)
+	   gki_fillarea (fd, points, npts)
+       gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+       gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+              gki_plset (fd, ap)
+              gki_pmset (fd, ap)
+	      gki_txset (fd, ap)
+              gki_faset (fd, ap)
+	  gki_setcursor (fd, x, y, cursor)
+	  gki_getcursor (fd, x, y, key, cursor)
+	     gki_escape (fd, fn, instruction, nwords)
+	     gki_setwcs (fd, wcsdata, len_wcsdata)
+	     gki_getwcs (fd, wcsdata, len_wcsdata)
+
+	     gki_fflush (fd)	# not GKI instruction; flushes GKI stream
+.fi
+.ke
+
+
+.nh 3
+Decoding GKI Instructions
+
+    The following additional procedures are provided for decoding and executing
+GKI metacode, e.g., in a graphics kernel.  In what follows, \fIinstruction\fR
+is a short integer array containing the encoded GKI instruction, and \fIdd\fR
+is the device driver table, i.e., array of \fBzlocpr\fR entry point addresses
+of the standard kernel procedures.
+
+
+.ks
+.nf
+	 stat = gki_fetch_next_instruction (fd, instruction_ptr)
+		gki_execute (instruction, dd)
+		gkp_install (dd, out_fd, verbose_output)
+.fi
+.ke
+
+
+The \fBfetch\fR procedure extracts the next instruction from the input metacode
+stream, returning a short integer pointer to the instruction as an output
+argument.  EOF is returned as the function value when end of file is detected.
+The \fBexecute\fR procedure decodes an instruction and calls a graphics device
+driver procedure to execute the instruction.  If the entry point address
+of the driver procedure is NULL \fBgki_execute\fR will ignore the corresponding
+GKI instruction.  The fields of the metacode instruction are passed to the
+driver procedure as distinct arguments, hence the device driver need not
+understand the GKI format.
+
+A standard kernel is provided for decoding GKI instructions, printing the
+decoded instructions in text form on the output stream.  The driver for this
+kernel is installed with \fBgkp_install\fR, setting the output file and
+verbose output flag in the process.
+
+.nh 3
+Example
+
+    To illustrate the use of GKI as well as the output of the GKI decoding
+kernel, consider the simple \fBgplotv\fR style plot of the following function:
+
+	y = x ** 2
+
+over the range
+
+	x = 1 to 5, y = 1 to 25
+
+The decoded GKI metacode produced by GIO to graph this function is
+shown below.  The "verbose" mode of output (shown) lists the values
+of the data points in the polyline, etc. output functions.  If verbose
+output is disabled only the statistics of the output polylines
+(computed by the decoder) will be printed.  All coordinates are printed
+in NDC units.  The redundant points appearing in the output metacode
+are expected to be filtered out by the kernel, which should not plot
+points separated by less than the device resolution in NDC units.
+
+
+.tp 4
+.nf
+open_workstation 'vt640', mode=new_file
+set_wcs nwords=352
+	 1 1. 5. 1. 25.  0.19 0.81 0.33 0.96  0 0 1
+set_polyline ltype=1, lwidth=2.00, color=1
+polyline np=3, xmin=0.19,xmax=0.19,xavg=0.19, ymin=0.33,ymax=0.37,yavg=0.34
+	0.188 0.334  0.188 0.334  0.188 0.367  
+set_text up=90, path=right, hjustify=center, vjustify=top, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.19, 0.31, '1'
+polyline np=15, xmin=0.19,xmax=0.34,xavg=0.27, ymin=0.33,ymax=0.37,yavg=0.34
+	0.188 0.334  0.219 0.334  0.219 0.350  0.219 0.334  0.250 0.334  
+	0.250 0.350  0.250 0.334  0.281 0.334  0.281 0.350  0.281 0.334  
+	0.313 0.334  0.313 0.350  0.313 0.334  0.344 0.334  0.344 0.367  
+text 0.34, 0.31, '2'
+polyline np=15, xmin=0.34,xmax=0.50,xavg=0.43, ymin=0.33,ymax=0.37,yavg=0.34
+	0.344 0.334  0.375 0.334  0.375 0.350  0.375 0.334  0.406 0.334  
+	0.406 0.350  0.406 0.334  0.437 0.334  0.437 0.350  0.437 0.334  
+	0.469 0.334  0.469 0.350  0.469 0.334  0.500 0.334  0.500 0.367  
+text 0.50, 0.31, '3'
+polyline np=15, xmin=0.50,xmax=0.66,xavg=0.58, ymin=0.33,ymax=0.37,yavg=0.34
+	0.500 0.334  0.531 0.334  0.531 0.350  0.531 0.334  0.562 0.334  
+	0.562 0.350  0.562 0.334  0.593 0.334  0.593 0.350  0.593 0.334  
+	0.625 0.334  0.625 0.350  0.625 0.334  0.656 0.334  0.656 0.367  
+text 0.66, 0.31, '4'
+polyline np=15, xmin=0.66,xmax=0.81,xavg=0.74, ymin=0.33,ymax=0.37,yavg=0.34
+	0.656 0.334  0.687 0.334  0.687 0.350  0.687 0.334  0.718 0.334  
+	0.718 0.350  0.718 0.334  0.750 0.334  0.750 0.350  0.750 0.334  
+	0.781 0.334  0.781 0.350  0.781 0.334  0.812 0.334  0.812 0.367  
+text 0.81, 0.31, '5'
+polyline np=2, xmin=0.81,xmax=0.81,xavg=0.81, ymin=0.33,ymax=0.33,yavg=0.33
+	0.812 0.334  0.812 0.334  
+polyline np=77, xmin=0.78,xmax=0.81,xavg=0.81, ymin=0.33,ymax=0.96,yavg=0.65
+	0.812 0.334  0.812 0.334  0.796 0.334  0.812 0.334  0.812 0.360  
+	0.796 0.360  0.812 0.360  0.812 0.386  0.796 0.386  0.812 0.386  
+	0.812 0.412  0.796 0.412  0.812 0.412  0.812 0.438  0.779 0.438  
+	0.812 0.438  0.812 0.464  0.795 0.464  0.812 0.464  0.812 0.490  
+	0.795 0.490  0.812 0.490  0.812 0.516  0.795 0.516  0.812 0.516  
+	0.812 0.542  0.795 0.542  0.812 0.542  0.812 0.568  0.779 0.568  
+	0.812 0.568  0.812 0.594  0.795 0.594  0.812 0.594  0.812 0.620  
+	0.795 0.620  0.812 0.620  0.812 0.646  0.795 0.646  0.812 0.646  
+	0.812 0.672  0.795 0.672  0.812 0.672  0.812 0.698  0.779 0.698  
+	0.812 0.698  0.812 0.724  0.795 0.724  0.812 0.724  0.812 0.750  
+	0.795 0.750  0.812 0.750  0.812 0.776  0.795 0.776  0.812 0.776  
+	0.812 0.802  0.795 0.802  0.812 0.802  0.812 0.828  0.778 0.828  
+	0.812 0.828  0.812 0.854  0.795 0.854  0.812 0.854  0.812 0.880  
+	0.795 0.880  0.812 0.880  0.812 0.906  0.795 0.906  0.812 0.906  
+	0.812 0.932  0.795 0.932  0.812 0.932  0.812 0.958  0.778 0.958  
+	0.812 0.958  0.812 0.958  
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.33,ymax=0.44,yavg=0.38
+	0.188 0.334  0.188 0.334  0.204 0.334  0.188 0.334  0.188 0.360  
+	0.204 0.360  0.188 0.360  0.188 0.386  0.204 0.386  0.188 0.386  
+	0.188 0.412  0.204 0.412  0.188 0.412  0.188 0.438  0.221 0.438  
+set_text up=90, path=right, hjustify=right, vjustify=center, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.19, 0.44, '5'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.44,ymax=0.57,yavg=0.51
+	0.188 0.438  0.188 0.464  0.204 0.464  0.188 0.464  0.188 0.490  
+	0.204 0.490  0.188 0.490  0.188 0.516  0.204 0.516  0.188 0.516  
+	0.188 0.542  0.204 0.542  0.188 0.542  0.188 0.568  0.221 0.568  
+text 0.19, 0.57, '10'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.57,ymax=0.70,yavg=0.64
+	0.188 0.568  0.188 0.594  0.204 0.594  0.188 0.594  0.188 0.620  
+	0.204 0.620  0.188 0.620  0.188 0.646  0.204 0.646  0.188 0.646  
+	0.188 0.672  0.204 0.672  0.188 0.672  0.188 0.698  0.221 0.698  
+text 0.19, 0.70, '15'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.70,ymax=0.83,yavg=0.77
+	0.188 0.698  0.188 0.724  0.204 0.724  0.188 0.724  0.188 0.750  
+	0.204 0.750  0.188 0.750  0.188 0.776  0.204 0.776  0.188 0.776  
+	0.188 0.802  0.204 0.802  0.188 0.802  0.188 0.828  0.221 0.828  
+text 0.19, 0.83, '20'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.83,ymax=0.96,yavg=0.90
+	0.188 0.828  0.188 0.854  0.204 0.854  0.188 0.854  0.188 0.880  
+	0.204 0.880  0.188 0.880  0.188 0.906  0.204 0.906  0.188 0.906  
+	0.188 0.932  0.204 0.932  0.188 0.932  0.188 0.958  0.221 0.958  
+text 0.19, 0.96, '25'
+polyline np=2, xmin=0.19,xmax=0.19,xavg=0.19, ymin=0.96,ymax=0.96,yavg=0.96
+	0.188 0.958  0.188 0.958  
+polyline np=65, xmin=0.19,xmax=0.81,xavg=0.50, ymin=0.92,ymax=0.96,yavg=0.95
+	0.188 0.958  0.188 0.958  0.188 0.925  0.188 0.958  0.219 0.958  
+	0.219 0.942  0.219 0.958  0.250 0.958  0.250 0.942  0.250 0.958  
+	0.281 0.958  0.281 0.941  0.281 0.958  0.313 0.958  0.313 0.941  
+	0.313 0.958  0.344 0.958  0.344 0.925  0.344 0.958  0.375 0.958  
+	0.375 0.941  0.375 0.958  0.406 0.958  0.406 0.941  0.406 0.958  
+	0.437 0.958  0.437 0.941  0.437 0.958  0.469 0.958  0.469 0.941  
+	0.469 0.958  0.500 0.958  0.500 0.925  0.500 0.958  0.531 0.958  
+	0.531 0.941  0.531 0.958  0.562 0.958  0.562 0.941  0.562 0.958  
+	0.593 0.958  0.593 0.941  0.593 0.958  0.625 0.958  0.625 0.941  
+	0.625 0.958  0.656 0.958  0.656 0.924  0.656 0.958  0.687 0.958  
+	0.687 0.941  0.687 0.958  0.718 0.958  0.718 0.941  0.718 0.958  
+	0.750 0.958  0.750 0.941  0.750 0.958  0.781 0.958  0.781 0.941  
+	0.781 0.958  0.812 0.958  0.812 0.924  0.812 0.958  0.812 0.958  
+set_text up=90, path=right, hjustify=center, vjustify=bottom, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.50, 0.96, 'title'
+set_polyline ltype=1, lwidth=1.00, color=1
+polyline np=5, xmin=0.19,xmax=0.69,xavg=0.44, ymin=0.33,ymax=0.96,yavg=0.59
+	0.188 0.334  0.313 0.412  0.438 0.542  0.562 0.724  0.687 0.958  
+flush
+close_workstation 'vt640'
+.fi
+
+
+.nh 2
+Graphics Kernel Parameters
+
+    The translation from GKI codes to device codes should ideally be
+parameterized to permit variable device resolution, font substitution,
+and so on at translation time.  In general this is best handled by
+spooling the metacode and later processing it via an explicit call to
+a metacode translator program, using CL parameters to control the translation.
+Some control over translation may also be achieved by modifying the
+\fBgraphcap\fR entry for a device, provided the graphics kernel uses
+the graphics capability database.
+
+One of the most useful translation time parameters is the device resolution.
+On some devices, e.g. pen plotters, it is necessary to be able to change
+the device resolution at translation time to permit plotting of large vectors
+without loss of resolution.  Changing the device resolution is also a valuable
+technique for speeding up graphics when working remotely via a modem.
+
+.nh
+GKS Emulation
+
+    The basic graphics primitives provided by GIO (polyline, polymarker, etc.)
+are functionally identical to those provided by GKS (the Graphics Kernel
+System).  The basic drawing primitives of GKS are therefore easily emulated
+using GIO.  A subset of the Fortran binding of GKS has already been emulated,
+sufficient to run the NCAR utilities recently converted by NCAR for use with
+GKS.  In principle it should be possible to expand the GKS emulation to a
+full level 0b or 1b interface, although we have no plans to do so at present.
diff --git a/sys/gio/elogd.x b/sys/gio/elogd.x
new file mode 100644
index 00000000..b910a80c
--- /dev/null
+++ b/sys/gio/elogd.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ELOGD -- Extended range log function.  Logarithmic scaling function for
+# negative or partially negative data.  The function is piecewise, continuous,
+# monotonic, reasonably smooth, and most importantly, is defined for all x.
+#
+#			     10.0 < X		y = log(x)
+#	       -10.0 <= X <= 10.0		y = x / 10.0
+#	   X < -10.0				y = -log(-x)
+#
+# Axes scaled with this function should have ticks labelled, e.g., 10**3,
+# 10**2, 10**1, 0, -10**1, -10**2, -10**3.  The corresponding ticks for
+# the normal log function would have values like 10**-2 rather than -10**2,
+# hence it is not difficult to distinguish between the two functions.
+
+double procedure elogd (x)
+
+double	x
+
+begin
+	if (x > 10.0D0)
+	    return (log10 (x))
+	else if (x >= -10.0D0)
+	    return (x / 10.0D0)
+	else
+	    return (-log10 (-x))
+end
diff --git a/sys/gio/elogr.x b/sys/gio/elogr.x
new file mode 100644
index 00000000..3dfb26ee
--- /dev/null
+++ b/sys/gio/elogr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ELOGR -- Extended range log function.  Logarithmic scaling function for
+# negative or partially negative data.  The function is piecewise, continuous,
+# monotonic, reasonably smooth, and most importantly, is defined for all x.
+#
+#			     10.0 < X		y = log(x)
+#	       -10.0 <= X <= 10.0		y = x / 10.0
+#	   X < -10.0				y = -log(-x)
+#
+# Axes scaled with this function should have ticks labelled, e.g., 10**3,
+# 10**2, 10**1, 0, -10**1, -10**2, -10**3.  The corresponding ticks for
+# the normal log function would have values like 10**-2 rather than -10**2,
+# hence it is not difficult to distinguish between the two functions.
+
+real procedure elogr (x)
+
+real	x
+
+begin
+	if (x > 10.0)
+	    return (log10 (x))
+	else if (x >= -10.0)
+	    return (x / 10.0)
+	else
+	    return (-log10 (-x))
+end
diff --git a/sys/gio/fonts/README b/sys/gio/fonts/README
new file mode 100644
index 00000000..8b657b76
--- /dev/null
+++ b/sys/gio/fonts/README
@@ -0,0 +1,42 @@
+
+FONT Generation Utilities  (August 1997)
+----------------------------------------
+
+This directory contains utilities for building font tables for the GIO
+system executables.  For reference we include here the font tables for
+the standard and greek fonts currently installed in the system:
+
+	font.com		standard text font (Roman)
+	greek.com		greek character font
+	
+These table were built from the Hershey stroke data using the following 
+files:
+
+	mkfont.c		task to build font table
+	hershey.dat		Hershey stroke data table
+
+Once compiled the MKFONT task can be used to build the table with a command
+such as
+
+		% mkfont < romant.txt > font.com
+
+Note that by default the tables are created with a "chr" prefix for the
+index, width, and character tables in the .com file.  When building a new
+Greek or other symbolic font these should be changed appropriately.
+	
+
+Addition input files for fonts supplied here include:
+
+	futural.txt	Futura (light)
+	futuram.txt	Futura (medium)
+	gotheng.txt	Gothic (english)
+	gothger.txt	Gothic (german)
+	gothita.txt	Gothic (italian)
+	greekc.txt	Greek (complex)			(current greek.com)
+	greeks.txt	Greek (simple)
+	math.txt	Math symbols
+	meteor.txt	Meteorological symbols
+	romans.txt	Roman (simple)
+	romant.txt	Roman (Times)			(current font.com)
+	scripts.txt	Script text font
+	timesr.txt	Times-Roman
diff --git a/sys/gio/fonts/font.com b/sys/gio/fonts/font.com
new file mode 100644
index 00000000..c26af8d6
--- /dev/null
+++ b/sys/gio/fonts/font.com
@@ -0,0 +1,746 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   chridx[97]	# character index in chrtab
+short   chrwid[97]	# character width table
+short   chrtab[3363]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (chridx(i), i=001,005) /    1,    3,   32,   49,   58/
+data    (chridx(i), i=006,010) /  110,  140,  207,  228,  253/
+data    (chridx(i), i=011,015) /  278,  309,  322,  343,  350/
+data    (chridx(i), i=016,020) /  365,  372,  418,  438,  494/
+data    (chridx(i), i=021,025) /  563,  583,  632,  696,  733/
+data    (chridx(i), i=026,030) /  803,  867,  896,  931,  935/
+data    (chridx(i), i=031,035) /  948,  952,  999, 1052, 1077/
+data    (chridx(i), i=036,040) / 1139, 1174, 1223, 1281, 1330/
+data    (chridx(i), i=041,045) / 1381, 1436, 1463, 1500, 1547/
+data    (chridx(i), i=046,050) / 1583, 1626, 1653, 1703, 1748/
+data    (chridx(i), i=051,055) / 1818, 1881, 1923, 1962, 1997/
+data    (chridx(i), i=056,060) / 2021, 2060, 2097, 2131, 2160/
+data    (chridx(i), i=061,065) / 2169, 2172, 2181, 2190, 2193/
+data    (chridx(i), i=066,070) / 2214, 2263, 2303, 2335, 2378/
+data    (chridx(i), i=071,075) / 2415, 2447, 2527, 2575, 2606/
+data    (chridx(i), i=076,080) / 2640, 2682, 2704, 2778, 2826/
+data    (chridx(i), i=081,085) / 2868, 2916, 2961, 2994, 3033/
+data    (chridx(i), i=086,090) / 3052, 3086, 3108, 3140, 3173/
+data    (chridx(i), i=091,095) / 3204, 3233, 3271, 3274, 3312/
+data    (chridx(i), i=096,096) / 3335/
+
+
+# Width data.
+
+data    (chrwid(i), i=001,005) /   21,   16,   23,   26,   25/
+data    (chrwid(i), i=006,010) /   29,   31,   16,   19,   19/
+data    (chrwid(i), i=011,015) /   21,   30,   16,   30,   16/
+data    (chrwid(i), i=016,020) /   28,   25,   25,   25,   25/
+data    (chrwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (chrwid(i), i=026,030) /   25,   16,   16,   29,   30/
+data    (chrwid(i), i=031,035) /   29,   24,   32,   25,   27/
+data    (chrwid(i), i=036,040) /   26,   27,   26,   25,   28/
+data    (chrwid(i), i=041,045) /   29,   17,   21,   27,   23/
+data    (chrwid(i), i=046,050) /   31,   29,   27,   27,   27/
+data    (chrwid(i), i=051,055) /   27,   25,   25,   29,   25/
+data    (chrwid(i), i=056,060) /   29,   25,   27,   25,   19/
+data    (chrwid(i), i=061,065) /   19,   19,   21,   21,   16/
+data    (chrwid(i), i=066,070) /   25,   26,   24,   26,   24/
+data    (chrwid(i), i=071,075) /   19,   24,   28,   17,   18/
+data    (chrwid(i), i=076,080) /   27,   17,   32,   28,   25/
+data    (chrwid(i), i=081,085) /   26,   25,   22,   22,   20/
+data    (chrwid(i), i=086,090) /   28,   23,   29,   25,   24/
+data    (chrwid(i), i=091,095) /   23,   19,   13,   19,   29/
+data    (chrwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (chrtab(i), i=0001,0005) /    35,     0,   220,  4251,  4249/
+data    (chrtab(i), i=0006,0010) /  4305,   220,  4302,  4366,   220/
+data    (chrtab(i), i=0011,0015) /  4380,  4366,   284,  4443,  4441/
+data    (chrtab(i), i=0016,0020) /  4369,   202,  4233,  4232,  4295/
+data    (chrtab(i), i=0021,0025) /  4359,  4424,  4425,  4362,  4298/
+data    (chrtab(i), i=0026,0030) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0031,0035) /     0,   220,  4251,  4245,   219/
+data    (chrtab(i), i=0036,0040) /  4245,   220,  4379,  4245,   796/
+data    (chrtab(i), i=0041,0045) /  4827,  4821,   795,  4821,   796/
+data    (chrtab(i), i=0046,0050) /  4955,  4821,     0,   604,  4224/
+data    (chrtab(i), i=0051,0055) /   988,  4608,   145,  5137,    75/
+data    (chrtab(i), i=0056,0060) /  5067,     0,   416,  4483,   672/
+data    (chrtab(i), i=0061,0065) /  4739,   919,  5016,  4952,  4950/
+data    (chrtab(i), i=0066,0070) /  5078,  5080,  5018,  4955,  4764/
+data    (chrtab(i), i=0071,0075) /  4508,  4315,  4185,  4182,  4244/
+data    (chrtab(i), i=0076,0080) /  4434,  4816,  4943,  5005,  5002/
+data    (chrtab(i), i=0081,0085) /  4936,   150,  4308,  4435,  4817/
+data    (chrtab(i), i=0086,0090) /  4944,  5006,   219,  4249,  4247/
+data    (chrtab(i), i=0091,0095) /  4309,  4436,  4818,  5008,  5070/
+data    (chrtab(i), i=0096,0100) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0101,0105) /  4296,  4233,  4171,  4173,  4301/
+data    (chrtab(i), i=0106,0110) /  4299,  4235,  4236,     0,  1244/
+data    (chrtab(i), i=0111,0115) /  4167,   412,  4634,  4632,  4566/
+data    (chrtab(i), i=0116,0120) /  4437,  4309,  4183,  4185,  4251/
+data    (chrtab(i), i=0121,0125) /  4380,  4508,  4635,  4826,  5018/
+data    (chrtab(i), i=0126,0130) /  5211,  5340,   974,  4941,  4875/
+data    (chrtab(i), i=0131,0135) /  4873,  4999,  5127,  5256,  5322/
+data    (chrtab(i), i=0136,0140) /  5324,  5198,  5070,     0,  1299/
+data    (chrtab(i), i=0141,0145) /  5396,  5332,  5330,  5458,  5460/
+data    (chrtab(i), i=0146,0150) /  5397,  5333,  5268,  5202,  5069/
+data    (chrtab(i), i=0151,0155) /  4938,  4808,  4679,  4423,  4296/
+data    (chrtab(i), i=0156,0160) /  4234,  4237,  4303,  4691,  4821/
+data    (chrtab(i), i=0161,0165) /  4887,  4889,  4827,  4700,  4571/
+data    (chrtab(i), i=0166,0170) /  4505,  4502,  4563,  4688,  4939/
+data    (chrtab(i), i=0171,0175) /  5128,  5255,  5383,  5449,  5450/
+data    (chrtab(i), i=0176,0180) /   264,  4298,  4301,  4367,  4432/
+data    (chrtab(i), i=0181,0185) /   725,  4889,   791,  4827,   475/
+data    (chrtab(i), i=0186,0190) /  4503,   468,  4689,  4940,  5129/
+data    (chrtab(i), i=0191,0195) /  5256,   455,  4424,  4362,  4365/
+data    (chrtab(i), i=0196,0200) /  4431,  4691,   409,  4565,  4753/
+data    (chrtab(i), i=0201,0205) /  5004,  5193,  5320,  5384,  5449/
+data    (chrtab(i), i=0206,0210) /     0,   346,  4377,  4313,  4250/
+data    (chrtab(i), i=0211,0215) /  4251,  4316,  4380,  4443,  4440/
+data    (chrtab(i), i=0216,0220) /  4374,  4245,   219,  4314,  4378/
+data    (chrtab(i), i=0221,0225) /  4379,  4315,   281,  4440,   346/
+data    (chrtab(i), i=0226,0230) /  4374,     0,   544,  4510,  4379/
+data    (chrtab(i), i=0231,0235) /  4247,  4178,  4174,  4233,  4357/
+data    (chrtab(i), i=0236,0240) /  4482,  4608,   282,  4311,  4243/
+data    (chrtab(i), i=0241,0245) /  4237,  4297,  4358,   414,  4444/
+data    (chrtab(i), i=0246,0250) /  4377,  4307,  4301,  4359,  4420/
+data    (chrtab(i), i=0251,0255) /  4482,     0,   160,  4382,  4507/
+data    (chrtab(i), i=0256,0260) /  4631,  4690,  4686,  4617,  4485/
+data    (chrtab(i), i=0261,0265) /  4354,  4224,   410,  4567,  4627/
+data    (chrtab(i), i=0266,0270) /  4621,  4553,  4486,   286,  4444/
+data    (chrtab(i), i=0271,0275) /  4505,  4563,  4557,  4487,  4420/
+data    (chrtab(i), i=0276,0280) /  4354,     0,   412,  4443,  4561/
+data    (chrtab(i), i=0281,0285) /  4496,   412,  4496,   412,  4571/
+data    (chrtab(i), i=0286,0290) /  4433,  4496,    89,  4249,  4755/
+data    (chrtab(i), i=0291,0295) /  4819,    89,  4819,    89,  4184/
+data    (chrtab(i), i=0296,0300) /  4820,  4819,   729,  4761,  4243/
+data    (chrtab(i), i=0301,0305) /  4179,   729,  4179,   729,  4824/
+data    (chrtab(i), i=0306,0310) /  4180,  4179,     0,   665,  4744/
+data    (chrtab(i), i=0311,0315) /  4808,   665,  4825,  4808,   145/
+data    (chrtab(i), i=0316,0320) /  5329,  5328,   145,  4240,  5328/
+data    (chrtab(i), i=0321,0325) /     0,   328,  4359,  4295,  4232/
+data    (chrtab(i), i=0326,0330) /  4233,  4298,  4362,  4425,  4422/
+data    (chrtab(i), i=0331,0335) /  4356,  4227,   201,  4296,  4360/
+data    (chrtab(i), i=0336,0340) /  4361,  4297,   263,  4422,   328/
+data    (chrtab(i), i=0341,0345) /  4356,     0,   145,  5329,  5328/
+data    (chrtab(i), i=0346,0350) /   145,  4240,  5328,     0,   202/
+data    (chrtab(i), i=0351,0355) /  4233,  4232,  4295,  4359,  4424/
+data    (chrtab(i), i=0356,0360) /  4425,  4362,  4298,   201,  4296/
+data    (chrtab(i), i=0361,0365) /  4360,  4361,  4297,     0,  1184/
+data    (chrtab(i), i=0366,0370) /  4096,  4160,  1184,  5344,  4160/
+data    (chrtab(i), i=0371,0375) /     0,   476,  4379,  4248,  4179/
+data    (chrtab(i), i=0376,0380) /  4176,  4235,  4360,  4551,  4679/
+data    (chrtab(i), i=0381,0385) /  4872,  5003,  5072,  5075,  5016/
+data    (chrtab(i), i=0386,0390) /  4891,  4700,  4572,   282,  4312/
+data    (chrtab(i), i=0391,0395) /  4244,  4239,  4299,  4361,   777/
+data    (chrtab(i), i=0396,0400) /  4939,  5007,  5012,  4952,  4890/
+data    (chrtab(i), i=0401,0405) /   476,  4443,  4377,  4308,  4303/
+data    (chrtab(i), i=0406,0410) /  4362,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=0411,0415) /  4874,  4943,  4948,  4889,  4827/
+data    (chrtab(i), i=0416,0420) /  4700,     0,   474,  4551,   538/
+data    (chrtab(i), i=0421,0425) /  4616,   604,  4679,   604,  4505/
+data    (chrtab(i), i=0426,0430) /  4376,   199,  4935,   456,  4423/
+data    (chrtab(i), i=0431,0435) /   457,  4487,   585,  4743,   584/
+data    (chrtab(i), i=0436,0440) /  4807,     0,   152,  4247,  4311/
+data    (chrtab(i), i=0441,0445) /  4312,  4248,   153,  4313,  4376/
+data    (chrtab(i), i=0446,0450) /  4375,  4310,  4246,  4183,  4184/
+data    (chrtab(i), i=0451,0455) /  4250,  4315,  4508,  4764,  4955/
+data    (chrtab(i), i=0456,0460) /  5018,  5080,  5078,  5012,  4818/
+data    (chrtab(i), i=0461,0465) /  4496,  4367,  4237,  4170,  4167/
+data    (chrtab(i), i=0466,0470) /   858,  5016,  5014,  4948,   668/
+data    (chrtab(i), i=0471,0475) /  4891,  4952,  4950,  4884,  4754/
+data    (chrtab(i), i=0476,0480) /  4496,    73,  4234,  4362,  4681/
+data    (chrtab(i), i=0481,0485) /  4937,  5066,   266,  4680,  4936/
+data    (chrtab(i), i=0486,0490) /  5001,   266,  4679,  4935,  5000/
+data    (chrtab(i), i=0491,0495) /  5066,  5068,     0,   152,  4247/
+data    (chrtab(i), i=0496,0500) /  4311,  4312,  4248,   153,  4313/
+data    (chrtab(i), i=0501,0505) /  4376,  4375,  4310,  4246,  4183/
+data    (chrtab(i), i=0506,0510) /  4184,  4250,  4315,  4508,  4764/
+data    (chrtab(i), i=0511,0515) /  4955,  5017,  5014,  4948,  4755/
+data    (chrtab(i), i=0516,0520) /   795,  4953,  4950,  4884,   604/
+data    (chrtab(i), i=0521,0525) /  4827,  4889,  4886,  4820,  4691/
+data    (chrtab(i), i=0526,0530) /   467,  4755,  4882,  5008,  5070/
+data    (chrtab(i), i=0531,0535) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0536,0540) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0541,0545) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0546,0550) /   848,  5006,  5003,  4937,   595/
+data    (chrtab(i), i=0551,0555) /  4818,  4881,  4942,  4939,  4872/
+data    (chrtab(i), i=0556,0560) /  4743,   140,  4235,  4299,  4300/
+data    (chrtab(i), i=0561,0565) /  4236,     0,   601,  4679,   666/
+data    (chrtab(i), i=0566,0570) /  4744,   732,  4807,   732,  4109/
+data    (chrtab(i), i=0571,0575) /  5133,   391,  4999,   584,  4551/
+data    (chrtab(i), i=0576,0580) /   585,  4615,   713,  4871,   712/
+data    (chrtab(i), i=0581,0585) /  4935,     0,   220,  4178,  4308/
+data    (chrtab(i), i=0586,0590) /  4501,  4693,  4884,  5010,  5071/
+data    (chrtab(i), i=0591,0595) /  5069,  5002,  4872,  4679,  4487/
+data    (chrtab(i), i=0596,0600) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0601,0605) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0606,0610) /   850,  5008,  5004,  4938,   597/
+data    (chrtab(i), i=0611,0615) /  4820,  4883,  4944,  4940,  4873/
+data    (chrtab(i), i=0616,0620) /  4808,  4679,   140,  4235,  4299/
+data    (chrtab(i), i=0621,0625) /  4300,  4236,   220,  4956,   219/
+data    (chrtab(i), i=0626,0630) /  4827,   218,  4570,  4827,  4956/
+data    (chrtab(i), i=0631,0635) /     0,   793,  4888,  4952,  4953/
+data    (chrtab(i), i=0636,0640) /  4889,   858,  4890,  4825,  4824/
+data    (chrtab(i), i=0641,0645) /  4887,  4951,  5016,  5017,  4955/
+data    (chrtab(i), i=0646,0650) /  4828,  4636,  4443,  4313,  4247/
+data    (chrtab(i), i=0651,0655) /  4179,  4173,  4234,  4360,  4551/
+data    (chrtab(i), i=0656,0660) /  4679,  4872,  5002,  5069,  5070/
+data    (chrtab(i), i=0661,0665) /  5009,  4883,  4692,  4564,  4435/
+data    (chrtab(i), i=0666,0670) /  4370,  4304,   281,  4311,  4243/
+data    (chrtab(i), i=0671,0675) /  4237,  4298,  4361,   842,  5004/
+data    (chrtab(i), i=0676,0680) /  5007,  4945,   540,  4507,  4442/
+data    (chrtab(i), i=0681,0685) /  4376,  4308,  4301,  4362,  4424/
+data    (chrtab(i), i=0686,0690) /  4551,   583,  4808,  4873,  4940/
+data    (chrtab(i), i=0691,0695) /  4943,  4882,  4819,  4692,     0/
+data    (chrtab(i), i=0696,0700) /    92,  4182,   988,  5081,  5014/
+data    (chrtab(i), i=0701,0705) /  4753,  4687,  4619,  4615,   592/
+data    (chrtab(i), i=0706,0710) /  4622,  4555,  4551,   918,  4689/
+data    (chrtab(i), i=0711,0715) /  4558,  4491,  4487,  4615,    88/
+data    (chrtab(i), i=0716,0720) /  4250,  4380,  4508,  4825,  4953/
+data    (chrtab(i), i=0721,0725) /  5018,  5084,   218,  4379,  4507/
+data    (chrtab(i), i=0726,0730) /  4634,    88,  4249,  4378,  4506/
+data    (chrtab(i), i=0731,0735) /  4825,     0,   412,  4315,  4249/
+data    (chrtab(i), i=0736,0740) /  4246,  4308,  4499,  4755,  4948/
+data    (chrtab(i), i=0741,0745) /  5014,  5017,  4955,  4764,  4508/
+data    (chrtab(i), i=0746,0750) /   283,  4313,  4310,  4372,   788/
+data    (chrtab(i), i=0751,0755) /  4950,  4953,  4891,   412,  4443/
+data    (chrtab(i), i=0756,0760) /  4377,  4374,  4436,  4499,   659/
+data    (chrtab(i), i=0761,0765) /  4820,  4886,  4889,  4827,  4764/
+data    (chrtab(i), i=0766,0770) /   403,  4306,  4241,  4175,  4171/
+data    (chrtab(i), i=0771,0775) /  4233,  4296,  4487,  4743,  4936/
+data    (chrtab(i), i=0776,0780) /  5001,  5067,  5071,  5009,  4946/
+data    (chrtab(i), i=0781,0785) /  4755,   209,  4239,  4235,  4297/
+data    (chrtab(i), i=0786,0790) /   841,  5003,  5007,  4945,   403/
+data    (chrtab(i), i=0791,0795) /  4370,  4303,  4299,  4360,  4487/
+data    (chrtab(i), i=0796,0800) /   647,  4872,  4939,  4943,  4882/
+data    (chrtab(i), i=0801,0805) /  4755,     0,   203,  4298,  4362/
+data    (chrtab(i), i=0806,0810) /  4363,  4299,   851,  4881,  4816/
+data    (chrtab(i), i=0811,0815) /  4687,  4559,  4368,  4242,  4181/
+data    (chrtab(i), i=0816,0820) /  4182,  4249,  4379,  4572,  4700/
+data    (chrtab(i), i=0821,0825) /  4891,  5017,  5078,  5072,  5004/
+data    (chrtab(i), i=0826,0830) /  4938,  4808,  4615,  4423,  4296/
+data    (chrtab(i), i=0831,0835) /  4234,  4235,  4300,  4364,  4427/
+data    (chrtab(i), i=0836,0840) /  4426,  4361,  4297,   210,  4244/
+data    (chrtab(i), i=0841,0845) /  4247,  4313,   794,  4953,  5014/
+data    (chrtab(i), i=0846,0850) /  5008,  4940,  4874,   463,  4432/
+data    (chrtab(i), i=0851,0855) /  4369,  4308,  4311,  4378,  4443/
+data    (chrtab(i), i=0856,0860) /  4572,   604,  4827,  4889,  4950/
+data    (chrtab(i), i=0861,0865) /  4943,  4875,  4809,  4744,  4615/
+data    (chrtab(i), i=0866,0870) /     0,   213,  4244,  4243,  4306/
+data    (chrtab(i), i=0871,0875) /  4370,  4435,  4436,  4373,  4309/
+data    (chrtab(i), i=0876,0880) /   212,  4307,  4371,  4372,  4308/
+data    (chrtab(i), i=0881,0885) /   202,  4233,  4232,  4295,  4359/
+data    (chrtab(i), i=0886,0890) /  4424,  4425,  4362,  4298,   201/
+data    (chrtab(i), i=0891,0895) /  4296,  4360,  4361,  4297,     0/
+data    (chrtab(i), i=0896,0900) /   213,  4244,  4243,  4306,  4370/
+data    (chrtab(i), i=0901,0905) /  4435,  4436,  4373,  4309,   212/
+data    (chrtab(i), i=0906,0910) /  4307,  4371,  4372,  4308,   328/
+data    (chrtab(i), i=0911,0915) /  4359,  4295,  4232,  4233,  4298/
+data    (chrtab(i), i=0916,0920) /  4362,  4425,  4422,  4356,  4227/
+data    (chrtab(i), i=0921,0925) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0926,0930) /   263,  4422,   328,  4356,     0/
+data    (chrtab(i), i=0931,0935) /  1177,  4240,  5255,     0,   149/
+data    (chrtab(i), i=0936,0940) /  5333,  5332,   149,  4244,  5332/
+data    (chrtab(i), i=0941,0945) /   141,  5325,  5324,   141,  4236/
+data    (chrtab(i), i=0946,0950) /  5324,     0,   153,  5264,  4231/
+data    (chrtab(i), i=0951,0955) /     0,   151,  4248,  4312,  4310/
+data    (chrtab(i), i=0956,0960) /  4182,  4184,  4250,  4315,  4444/
+data    (chrtab(i), i=0961,0965) /  4700,  4891,  4954,  5016,  5014/
+data    (chrtab(i), i=0966,0970) /  4948,  4883,  4625,   794,  4953/
+data    (chrtab(i), i=0971,0975) /  4949,  4884,   604,  4827,  4889/
+data    (chrtab(i), i=0976,0980) /  4885,  4819,  4754,   465,  4558/
+data    (chrtab(i), i=0981,0985) /  4622,  4625,  4561,   458,  4489/
+data    (chrtab(i), i=0986,0990) /  4488,  4551,  4615,  4680,  4681/
+data    (chrtab(i), i=0991,0995) /  4618,  4554,   457,  4552,  4616/
+data    (chrtab(i), i=0996,1000) /  4617,  4553,     0,  1044,  5078/
+data    (chrtab(i), i=1001,1005) /  4951,  4759,  4630,  4565,  4498/
+data    (chrtab(i), i=1006,1010) /  4495,  4557,  4684,  4876,  5005/
+data    (chrtab(i), i=1011,1015) /  5071,   663,  4629,  4562,  4559/
+data    (chrtab(i), i=1016,1020) /  4621,  4684,  1047,  5071,  5069/
+data    (chrtab(i), i=1021,1025) /  5196,  5324,  5454,  5521,  5523/
+data    (chrtab(i), i=1026,1030) /  5462,  5400,  5274,  5147,  4956/
+data    (chrtab(i), i=1031,1035) /  4764,  4571,  4442,  4312,  4246/
+data    (chrtab(i), i=1036,1040) /  4179,  4176,  4237,  4299,  4425/
+data    (chrtab(i), i=1041,1045) /  4552,  4743,  4935,  5128,  5257/
+data    (chrtab(i), i=1046,1050) /  5322,  1111,  5135,  5133,  5196/
+data    (chrtab(i), i=1051,1055) /     0,   540,  4168,   473,  4935/
+data    (chrtab(i), i=1056,1060) /   537,  4999,   540,  5063,   205/
+data    (chrtab(i), i=1061,1065) /  4877,     7,  4423,   647,  5191/
+data    (chrtab(i), i=1066,1070) /    72,  4103,    72,  4295,   840/
+data    (chrtab(i), i=1071,1075) /  4807,   841,  4871,   905,  5127/
+data    (chrtab(i), i=1076,1080) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1081,1085) /   348,  4423,    28,  4892,  5083/
+data    (chrtab(i), i=1086,1090) /  5146,  5208,  5206,  5140,  5075/
+data    (chrtab(i), i=1091,1095) /  4882,   986,  5144,  5142,  5076/
+data    (chrtab(i), i=1096,1100) /   796,  5019,  5081,  5077,  5011/
+data    (chrtab(i), i=1101,1105) /  4882,   338,  4882,  5073,  5136/
+data    (chrtab(i), i=1106,1110) /  5198,  5195,  5129,  5064,  4871/
+data    (chrtab(i), i=1111,1115) /  4103,   976,  5134,  5131,  5065/
+data    (chrtab(i), i=1116,1120) /   786,  5009,  5071,  5066,  5000/
+data    (chrtab(i), i=1121,1125) /  4871,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1126,1130) /   412,  4442,   476,  4443,   200/
+data    (chrtab(i), i=1131,1135) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=1136,1140) /   328,  4551,     0,   985,  5148/
+data    (chrtab(i), i=1141,1145) /  5142,  5081,  4955,  4828,  4636/
+data    (chrtab(i), i=1146,1150) /  4443,  4313,  4247,  4180,  4175/
+data    (chrtab(i), i=1151,1155) /  4236,  4298,  4424,  4615,  4807/
+data    (chrtab(i), i=1156,1160) /  4936,  5066,  5132,   281,  4311/
+data    (chrtab(i), i=1161,1165) /  4244,  4239,  4300,  4362,   540/
+data    (chrtab(i), i=1166,1170) /  4507,  4376,  4308,  4303,  4363/
+data    (chrtab(i), i=1171,1175) /  4488,  4615,     0,   220,  4295/
+data    (chrtab(i), i=1176,1180) /   283,  4360,   348,  4423,    28/
+data    (chrtab(i), i=1181,1185) /  4764,  4955,  5081,  5143,  5204/
+data    (chrtab(i), i=1186,1190) /  5199,  5132,  5066,  4936,  4743/
+data    (chrtab(i), i=1191,1195) /  4103,   921,  5079,  5140,  5135/
+data    (chrtab(i), i=1196,1200) /  5068,  5002,   668,  4891,  5016/
+data    (chrtab(i), i=1201,1205) /  5076,  5071,  5003,  4872,  4743/
+data    (chrtab(i), i=1206,1210) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1211,1215) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1216,1220) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1221,1225) /  4551,     0,   220,  4295,   283/
+data    (chrtab(i), i=1226,1230) /  4360,   348,  4423,    28,  5148/
+data    (chrtab(i), i=1231,1235) /  5142,   338,  4818,   726,  4814/
+data    (chrtab(i), i=1236,1240) /     7,  5127,  5133,    92,  4315/
+data    (chrtab(i), i=1241,1245) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1246,1250) /  4443,   732,  5147,   860,  5146/
+data    (chrtab(i), i=1251,1255) /   924,  5145,   988,  5142,   726/
+data    (chrtab(i), i=1256,1260) /  4754,  4814,   724,  4690,  4816/
+data    (chrtab(i), i=1261,1265) /   723,  4562,  4817,   200,  4167/
+data    (chrtab(i), i=1266,1270) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1271,1275) /  4551,   711,  5128,   839,  5129/
+data    (chrtab(i), i=1276,1280) /   903,  5130,   967,  5133,     0/
+data    (chrtab(i), i=1281,1285) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1286,1290) /  4423,    28,  5148,  5142,   338/
+data    (chrtab(i), i=1291,1295) /  4818,   726,  4814,     7,  4615/
+data    (chrtab(i), i=1296,1300) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1301,1305) /  4442,   476,  4443,   732,  5147/
+data    (chrtab(i), i=1306,1310) /   860,  5146,   924,  5145,   988/
+data    (chrtab(i), i=1311,1315) /  5142,   726,  4754,  4814,   724/
+data    (chrtab(i), i=1316,1320) /  4690,  4816,   723,  4562,  4817/
+data    (chrtab(i), i=1321,1325) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1326,1330) /  4487,   328,  4551,     0,   985/
+data    (chrtab(i), i=1331,1335) /  5148,  5142,  5081,  4955,  4828/
+data    (chrtab(i), i=1336,1340) /  4636,  4443,  4313,  4247,  4180/
+data    (chrtab(i), i=1341,1345) /  4175,  4236,  4298,  4424,  4615/
+data    (chrtab(i), i=1346,1350) /  4807,  4936,  5064,  5127,  5135/
+data    (chrtab(i), i=1351,1355) /   281,  4311,  4244,  4239,  4300/
+data    (chrtab(i), i=1356,1360) /  4362,   540,  4507,  4376,  4308/
+data    (chrtab(i), i=1361,1365) /  4303,  4363,  4488,  4615,   974/
+data    (chrtab(i), i=1366,1370) /  5065,   911,  5001,  4936,   719/
+data    (chrtab(i), i=1371,1375) /  5327,   783,  5006,   847,  5005/
+data    (chrtab(i), i=1376,1380) /  1103,  5133,  1167,  5134,     0/
+data    (chrtab(i), i=1381,1385) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1386,1390) /  4423,   988,  5063,  1051,  5128/
+data    (chrtab(i), i=1391,1395) /  1116,  5191,    28,  4636,   796/
+data    (chrtab(i), i=1396,1400) /  5404,   338,  5074,     7,  4615/
+data    (chrtab(i), i=1401,1405) /   775,  5383,    92,  4315,   156/
+data    (chrtab(i), i=1406,1410) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1411,1415) /   860,  5083,   924,  5082,  1180/
+data    (chrtab(i), i=1416,1420) /  5210,  1244,  5211,   200,  4167/
+data    (chrtab(i), i=1421,1425) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1426,1430) /  4551,   968,  4935,   969,  4999/
+data    (chrtab(i), i=1431,1435) /  1097,  5255,  1096,  5319,     0/
+data    (chrtab(i), i=1436,1440) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1441,1445) /  4423,    28,  4636,     7,  4615/
+data    (chrtab(i), i=1446,1450) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1451,1455) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1456,1460) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1461,1465) /  4551,     0,   476,  4555,  4488/
+data    (chrtab(i), i=1466,1470) /  4423,   539,  4619,  4552,   604/
+data    (chrtab(i), i=1471,1475) /  4683,  4616,  4423,  4295,  4168/
+data    (chrtab(i), i=1476,1480) /  4106,  4108,  4173,  4237,  4300/
+data    (chrtab(i), i=1481,1485) /  4299,  4234,  4170,    76,  4171/
+data    (chrtab(i), i=1486,1490) /  4235,  4236,  4172,   284,  4892/
+data    (chrtab(i), i=1491,1495) /   348,  4571,   412,  4570,   668/
+data    (chrtab(i), i=1496,1500) /  4698,   732,  4699,     0,   220/
+data    (chrtab(i), i=1501,1505) /  4295,   283,  4360,   348,  4423/
+data    (chrtab(i), i=1506,1510) /  1051,  4432,   530,  5063,   594/
+data    (chrtab(i), i=1511,1515) /  5127,   596,  5191,    28,  4636/
+data    (chrtab(i), i=1516,1520) /   860,  5340,     7,  4615,   775/
+data    (chrtab(i), i=1521,1525) /  5319,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1526,1530) /   412,  4442,   476,  4443,   988/
+data    (chrtab(i), i=1531,1535) /  5147,  1180,  5147,   200,  4167/
+data    (chrtab(i), i=1536,1540) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1541,1545) /  4551,   969,  4935,   969,  5255/
+data    (chrtab(i), i=1546,1550) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1551,1555) /   348,  4423,    28,  4636,     7/
+data    (chrtab(i), i=1556,1560) /  5063,  5069,    92,  4315,   156/
+data    (chrtab(i), i=1561,1565) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1566,1570) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1571,1575) /  4487,   328,  4551,   647,  5064/
+data    (chrtab(i), i=1576,1580) /   775,  5065,   839,  5066,   903/
+data    (chrtab(i), i=1581,1585) /  5069,     0,   220,  4296,   220/
+data    (chrtab(i), i=1586,1590) /  4743,   284,  4746,   348,  4810/
+data    (chrtab(i), i=1591,1595) /  1116,  4743,  1116,  5191,  1179/
+data    (chrtab(i), i=1596,1600) /  5256,  1244,  5319,    28,  4444/
+data    (chrtab(i), i=1601,1605) /  1116,  5532,     7,  4487,   903/
+data    (chrtab(i), i=1606,1610) /  5511,    92,  4315,  1308,  5338/
+data    (chrtab(i), i=1611,1615) /  1372,  5339,   200,  4167,   200/
+data    (chrtab(i), i=1616,1620) /  4423,  1096,  5063,  1097,  5127/
+data    (chrtab(i), i=1621,1625) /  1225,  5383,  1224,  5447,     0/
+data    (chrtab(i), i=1626,1630) /   220,  4296,   220,  5191,   284/
+data    (chrtab(i), i=1631,1635) /  5130,   348,  5194,  1115,  5191/
+data    (chrtab(i), i=1636,1640) /    28,  4444,   924,  5404,     7/
+data    (chrtab(i), i=1641,1645) /  4487,    92,  4315,   988,  5211/
+data    (chrtab(i), i=1646,1650) /  1244,  5211,   200,  4167,   200/
+data    (chrtab(i), i=1651,1655) /  4423,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1656,1660) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1661,1665) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1666,1670) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1671,1675) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1676,1680) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1681,1685) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1686,1690) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1691,1695) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1696,1700) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1701,1705) /  4764,     0,   220,  4295,   283/
+data    (chrtab(i), i=1706,1710) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1711,1715) /  5083,  5146,  5208,  5205,  5139/
+data    (chrtab(i), i=1716,1720) /  5074,  4881,  4433,   986,  5144/
+data    (chrtab(i), i=1721,1725) /  5141,  5075,   796,  5019,  5081/
+data    (chrtab(i), i=1726,1730) /  5076,  5010,  4881,     7,  4615/
+data    (chrtab(i), i=1731,1735) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1736,1740) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1741,1745) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1746,1750) /  4551,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1751,1755) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1756,1760) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1761,1765) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1766,1770) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1771,1775) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1776,1780) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1781,1785) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1786,1790) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1791,1795) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1796,1800) /  4764,   330,  4492,  4621,  4685/
+data    (chrtab(i), i=1801,1805) /  4812,  4874,  4932,  4994,  5122/
+data    (chrtab(i), i=1806,1810) /  5188,  5190,   838,  4996,  5059/
+data    (chrtab(i), i=1811,1815) /  5123,   778,  4997,  5060,  5124/
+data    (chrtab(i), i=1816,1820) /  5189,     0,   220,  4295,   283/
+data    (chrtab(i), i=1821,1825) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1826,1830) /  5083,  5146,  5208,  5206,  5140/
+data    (chrtab(i), i=1831,1835) /  5075,  4882,  4434,   986,  5144/
+data    (chrtab(i), i=1836,1840) /  5142,  5076,   796,  5019,  5081/
+data    (chrtab(i), i=1841,1845) /  5077,  5011,  4882,   594,  4817/
+data    (chrtab(i), i=1846,1850) /  4879,  5001,  5063,  5191,  5257/
+data    (chrtab(i), i=1851,1855) /  5259,   907,  5065,  5128,  5192/
+data    (chrtab(i), i=1856,1860) /   721,  4880,  5066,  5129,  5193/
+data    (chrtab(i), i=1861,1865) /  5258,     7,  4615,    92,  4315/
+data    (chrtab(i), i=1866,1870) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1871,1875) /  4443,   200,  4167,   201,  4231/
+data    (chrtab(i), i=1876,1880) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=1881,1885) /   921,  5084,  5078,  5017,  4891/
+data    (chrtab(i), i=1886,1890) /  4700,  4508,  4315,  4185,  4182/
+data    (chrtab(i), i=1891,1895) /  4244,  4434,  4816,  4943,  5005/
+data    (chrtab(i), i=1896,1900) /  5002,  4936,   150,  4308,  4435/
+data    (chrtab(i), i=1901,1905) /  4817,  4944,  5006,   219,  4249/
+data    (chrtab(i), i=1906,1910) /  4247,  4309,  4436,  4818,  5008/
+data    (chrtab(i), i=1911,1915) /  5070,  5067,  5001,  4936,  4743/
+data    (chrtab(i), i=1916,1920) /  4551,  4360,  4234,  4173,  4167/
+data    (chrtab(i), i=1921,1925) /  4234,     0,    28,  4118,   476/
+data    (chrtab(i), i=1926,1930) /  4551,   539,  4616,   604,  4679/
+data    (chrtab(i), i=1931,1935) /  1052,  5142,    28,  5148,   263/
+data    (chrtab(i), i=1936,1940) /  4871,    92,  4118,   156,  4121/
+data    (chrtab(i), i=1941,1945) /   220,  4122,   348,  4123,   732/
+data    (chrtab(i), i=1946,1950) /  5147,   860,  5146,   924,  5145/
+data    (chrtab(i), i=1951,1955) /   988,  5142,   456,  4423,   457/
+data    (chrtab(i), i=1956,1960) /  4487,   585,  4743,   584,  4807/
+data    (chrtab(i), i=1961,1965) /     0,   220,  4301,  4362,  4488/
+data    (chrtab(i), i=1966,1970) /  4679,  4807,  5000,  5130,  5197/
+data    (chrtab(i), i=1971,1975) /  5211,   283,  4364,  4426,   348/
+data    (chrtab(i), i=1976,1980) /  4428,  4489,  4552,  4679,    28/
+data    (chrtab(i), i=1981,1985) /  4636,   924,  5404,    92,  4315/
+data    (chrtab(i), i=1986,1990) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1991,1995) /  4443,   988,  5211,  1244,  5211/
+data    (chrtab(i), i=1996,2000) /     0,    92,  4615,   156,  4618/
+data    (chrtab(i), i=2001,2005) /  4615,   220,  4682,   987,  4615/
+data    (chrtab(i), i=2006,2010) /    28,  4508,   732,  5212,    28/
+data    (chrtab(i), i=2011,2015) /  4250,   284,  4314,   348,  4315/
+data    (chrtab(i), i=2016,2020) /   860,  5083,  1052,  5083,     0/
+data    (chrtab(i), i=2021,2025) /   156,  4487,   220,  4492,  4487/
+data    (chrtab(i), i=2026,2030) /   284,  4556,   668,  4556,  4487/
+data    (chrtab(i), i=2031,2035) /   668,  4999,   732,  5004,  4999/
+data    (chrtab(i), i=2036,2040) /   796,  5068,  1179,  5068,  4999/
+data    (chrtab(i), i=2041,2045) /    28,  4572,   668,  4892,   988/
+data    (chrtab(i), i=2046,2050) /  5468,    28,  4315,    92,  4314/
+data    (chrtab(i), i=2051,2055) /   348,  4378,   412,  4379,  1052/
+data    (chrtab(i), i=2056,2060) /  5275,  1308,  5275,     0,    92/
+data    (chrtab(i), i=2061,2065) /  4935,   156,  4999,   220,  5063/
+data    (chrtab(i), i=2066,2070) /   923,  4232,    28,  4508,   732/
+data    (chrtab(i), i=2071,2075) /  5212,     7,  4423,   647,  5191/
+data    (chrtab(i), i=2076,2080) /    28,  4314,   284,  4314,   348/
+data    (chrtab(i), i=2081,2085) /  4315,   796,  5019,  1052,  5019/
+data    (chrtab(i), i=2086,2090) /   136,  4103,   136,  4359,   840/
+data    (chrtab(i), i=2091,2095) /  4807,   841,  4871,   841,  5127/
+data    (chrtab(i), i=2096,2100) /     0,    92,  4625,  4615,   156/
+data    (chrtab(i), i=2101,2105) /  4689,  4680,   220,  4753,  4743/
+data    (chrtab(i), i=2106,2110) /  1051,  4753,    28,  4508,   860/
+data    (chrtab(i), i=2111,2115) /  5340,   327,  4935,    28,  4251/
+data    (chrtab(i), i=2116,2120) /   348,  4315,   924,  5147,  1180/
+data    (chrtab(i), i=2121,2125) /  5147,   520,  4487,   521,  4551/
+data    (chrtab(i), i=2126,2130) /   649,  4807,   648,  4871,     0/
+data    (chrtab(i), i=2131,2135) /   988,  4188,  4182,   860,  4167/
+data    (chrtab(i), i=2136,2140) /   924,  4231,   988,  4295,    71/
+data    (chrtab(i), i=2141,2145) /  5063,  5069,   156,  4182,   220/
+data    (chrtab(i), i=2146,2150) /  4185,   284,  4186,   412,  4187/
+data    (chrtab(i), i=2151,2155) /   647,  5064,   775,  5065,   839/
+data    (chrtab(i), i=2156,2160) /  5066,   903,  5069,     0,   160/
+data    (chrtab(i), i=2161,2165) /  4224,   224,  4288,   160,  4704/
+data    (chrtab(i), i=2166,2170) /   128,  4672,     0,    28,  4868/
+data    (chrtab(i), i=2171,2175) /     0,   480,  4544,   544,  4608/
+data    (chrtab(i), i=2176,2180) /    96,  4640,    64,  4608,     0/
+data    (chrtab(i), i=2181,2185) /   278,  4505,  4630,    83,  4504/
+data    (chrtab(i), i=2186,2190) /  4819,   408,  4487,     0,     5/
+data    (chrtab(i), i=2191,2195) /  4997,     0,   348,  4315,  4249/
+data    (chrtab(i), i=2196,2200) /  4246,  4309,  4373,  4438,  4439/
+data    (chrtab(i), i=2201,2205) /  4376,  4312,  4247,   215,  4310/
+data    (chrtab(i), i=2206,2210) /  4374,  4375,  4311,   219,  4247/
+data    (chrtab(i), i=2211,2215) /   153,  4312,     0,   210,  4307/
+data    (chrtab(i), i=2216,2220) /  4371,  4369,  4241,  4243,  4308/
+data    (chrtab(i), i=2221,2225) /  4437,  4693,  4820,  4883,  4945/
+data    (chrtab(i), i=2226,2230) /  4938,  5000,  5063,   723,  4881/
+data    (chrtab(i), i=2231,2235) /  4874,  4936,   597,  4756,  4818/
+data    (chrtab(i), i=2236,2240) /  4810,  4872,  5063,  5127,   720/
+data    (chrtab(i), i=2241,2245) /  4751,  4430,  4237,  4171,  4170/
+data    (chrtab(i), i=2246,2250) /  4232,  4423,  4615,  4744,  4810/
+data    (chrtab(i), i=2251,2255) /   205,  4235,  4234,  4296,   655/
+data    (chrtab(i), i=2256,2260) /  4494,  4365,  4299,  4298,  4360/
+data    (chrtab(i), i=2261,2265) /  4423,     0,   220,  4295,  4360/
+data    (chrtab(i), i=2266,2270) /  4488,   283,  4361,    28,  4444/
+data    (chrtab(i), i=2271,2275) /  4424,   338,  4500,  4629,  4757/
+data    (chrtab(i), i=2276,2280) /  4948,  5074,  5135,  5133,  5066/
+data    (chrtab(i), i=2281,2285) /  4936,  4743,  4615,  4488,  4426/
+data    (chrtab(i), i=2286,2290) /   914,  5072,  5068,  5002,   661/
+data    (chrtab(i), i=2291,2295) /  4884,  4947,  5008,  5004,  4937/
+data    (chrtab(i), i=2296,2300) /  4872,  4743,    92,  4315,   156/
+data    (chrtab(i), i=2301,2305) /  4314,     0,   849,  4946,  4882/
+data    (chrtab(i), i=2306,2310) /  4880,  5008,  5010,  4884,  4757/
+data    (chrtab(i), i=2311,2315) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2316,2320) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2321,2325) /  5002,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2326,2330) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2331,2335) /  4361,  4424,  4551,     0,   796/
+data    (chrtab(i), i=2336,2340) /  4871,  5191,   859,  4936,   604/
+data    (chrtab(i), i=2341,2345) /  5020,  4999,   786,  4820,  4693/
+data    (chrtab(i), i=2346,2350) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2351,2355) /  4234,  4360,  4551,  4679,  4808/
+data    (chrtab(i), i=2356,2360) /  4874,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2361,2365) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2366,2370) /  4361,  4424,  4551,   668,  4891/
+data    (chrtab(i), i=2371,2375) /   732,  4890,   905,  5063,   904/
+data    (chrtab(i), i=2376,2380) /  5127,     0,   207,  5007,  5009/
+data    (chrtab(i), i=2381,2385) /  4947,  4884,  4693,  4565,  4372/
+data    (chrtab(i), i=2386,2390) /  4242,  4175,  4173,  4234,  4360/
+data    (chrtab(i), i=2391,2395) /  4551,  4679,  4872,  5002,   848/
+data    (chrtab(i), i=2396,2400) /  4945,  4883,   210,  4240,  4236/
+data    (chrtab(i), i=2401,2405) /  4298,   783,  4882,  4820,  4693/
+data    (chrtab(i), i=2406,2410) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2411,2415) /  4361,  4424,  4551,     0,   666/
+data    (chrtab(i), i=2416,2420) /  4763,  4699,  4697,  4825,  4827/
+data    (chrtab(i), i=2421,2425) /  4764,  4572,  4443,  4378,  4311/
+data    (chrtab(i), i=2426,2430) /  4295,   346,  4375,  4360,   476/
+data    (chrtab(i), i=2431,2435) /  4507,  4441,  4423,    21,  4693/
+data    (chrtab(i), i=2436,2440) /     7,  4615,   200,  4167,   201/
+data    (chrtab(i), i=2441,2445) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2446,2450) /     0,   852,  5011,  5076,  5013/
+data    (chrtab(i), i=2451,2455) /  4949,  4820,  4755,   405,  4372/
+data    (chrtab(i), i=2456,2460) /  4307,  4241,  4239,  4301,  4364/
+data    (chrtab(i), i=2461,2465) /  4491,  4619,  4748,  4813,  4879/
+data    (chrtab(i), i=2466,2470) /  4881,  4819,  4756,  4629,  4501/
+data    (chrtab(i), i=2471,2475) /   275,  4305,  4303,  4365,   653/
+data    (chrtab(i), i=2476,2480) /  4815,  4817,  4755,   405,  4436/
+data    (chrtab(i), i=2481,2485) /  4370,  4366,  4428,  4491,   523/
+data    (chrtab(i), i=2486,2490) /  4684,  4750,  4754,  4692,  4629/
+data    (chrtab(i), i=2491,2495) /   205,  4236,  4170,  4169,  4231/
+data    (chrtab(i), i=2496,2500) /  4294,  4485,  4741,  4932,  4995/
+data    (chrtab(i), i=2501,2505) /   199,  4486,  4742,  4933,    73/
+data    (chrtab(i), i=2506,2510) /  4232,  4423,  4743,  4934,  4996/
+data    (chrtab(i), i=2511,2515) /  4995,  4929,  4736,  4352,  4161/
+data    (chrtab(i), i=2516,2520) /  4099,  4100,  4166,  4359,   256/
+data    (chrtab(i), i=2521,2525) /  4225,  4163,  4164,  4230,  4359/
+data    (chrtab(i), i=2526,2530) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2531,2535) /    28,  4444,  4423,   337,  4499/
+data    (chrtab(i), i=2536,2540) /  4564,  4693,  4885,  5012,  5075/
+data    (chrtab(i), i=2541,2545) /  5136,  5127,   915,  5072,  5064/
+data    (chrtab(i), i=2546,2550) /   789,  4948,  5009,  4999,     7/
+data    (chrtab(i), i=2551,2555) /  4615,   711,  5319,    92,  4315/
+data    (chrtab(i), i=2556,2560) /   156,  4314,   200,  4167,   201/
+data    (chrtab(i), i=2561,2565) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2566,2570) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2571,2575) /  5191,  1032,  5255,     0,   220/
+data    (chrtab(i), i=2576,2580) /  4314,  4442,  4444,  4316,   284/
+data    (chrtab(i), i=2581,2585) /  4378,   219,  4443,   213,  4295/
+data    (chrtab(i), i=2586,2590) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2591,2595) /     7,  4615,    85,  4308,   149/
+data    (chrtab(i), i=2596,2600) /  4307,   200,  4167,   201,  4231/
+data    (chrtab(i), i=2601,2605) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=2606,2610) /   348,  4442,  4570,  4572,  4444/
+data    (chrtab(i), i=2611,2615) /   412,  4506,   347,  4571,   341/
+data    (chrtab(i), i=2616,2620) /  4420,  4353,  4288,   404,  4485/
+data    (chrtab(i), i=2621,2625) /  4418,   149,  4565,  4549,  4482/
+data    (chrtab(i), i=2626,2630) /  4417,  4288,  4096,  4097,  4099/
+data    (chrtab(i), i=2631,2635) /  4163,  4161,  4097,  4098,   213/
+data    (chrtab(i), i=2636,2640) /  4436,   277,  4435,     0,   220/
+data    (chrtab(i), i=2641,2645) /  4295,   283,  4360,    28,  4444/
+data    (chrtab(i), i=2646,2650) /  4423,   916,  4427,   591,  5127/
+data    (chrtab(i), i=2651,2655) /   590,  5063,   526,  4999,   725/
+data    (chrtab(i), i=2656,2660) /  5269,     7,  4615,   711,  5255/
+data    (chrtab(i), i=2661,2665) /    92,  4315,   156,  4314,   789/
+data    (chrtab(i), i=2666,2670) /  5012,  1109,  5012,   200,  4167/
+data    (chrtab(i), i=2671,2675) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2676,2680) /  4551,   905,  4871,   841,  5191/
+data    (chrtab(i), i=2681,2685) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2686,2690) /    28,  4444,  4423,     7,  4615/
+data    (chrtab(i), i=2691,2695) /    92,  4315,   156,  4314,   200/
+data    (chrtab(i), i=2696,2700) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2701,2705) /   328,  4551,     0,   213,  4295/
+data    (chrtab(i), i=2706,2710) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2711,2715) /   337,  4499,  4564,  4693,  4885/
+data    (chrtab(i), i=2716,2720) /  5012,  5075,  5136,  5127,   915/
+data    (chrtab(i), i=2721,2725) /  5072,  5064,   789,  4948,  5009/
+data    (chrtab(i), i=2726,2730) /  4999,  1041,  5203,  5268,  5397/
+data    (chrtab(i), i=2731,2735) /  5589,  5716,  5779,  5840,  5831/
+data    (chrtab(i), i=2736,2740) /  1619,  5776,  5768,  1493,  5652/
+data    (chrtab(i), i=2741,2745) /  5713,  5703,     7,  4615,   711/
+data    (chrtab(i), i=2746,2750) /  5319,  1415,  6023,    85,  4308/
+data    (chrtab(i), i=2751,2755) /   149,  4307,   200,  4167,   201/
+data    (chrtab(i), i=2756,2760) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2761,2765) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2766,2770) /  5191,  1032,  5255,  1608,  5575/
+data    (chrtab(i), i=2771,2775) /  1609,  5639,  1737,  5895,  1736/
+data    (chrtab(i), i=2776,2780) /  5959,     0,   213,  4295,   276/
+data    (chrtab(i), i=2781,2785) /  4360,    21,  4437,  4423,   337/
+data    (chrtab(i), i=2786,2790) /  4499,  4564,  4693,  4885,  5012/
+data    (chrtab(i), i=2791,2795) /  5075,  5136,  5127,   915,  5072/
+data    (chrtab(i), i=2796,2800) /  5064,   789,  4948,  5009,  4999/
+data    (chrtab(i), i=2801,2805) /     7,  4615,   711,  5319,    85/
+data    (chrtab(i), i=2806,2810) /  4308,   149,  4307,   200,  4167/
+data    (chrtab(i), i=2811,2815) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2816,2820) /  4551,   904,  4871,   905,  4935/
+data    (chrtab(i), i=2821,2825) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=2826,2830) /   469,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2831,2835) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2836,2840) /  5002,  5069,  5071,  5010,  4884/
+data    (chrtab(i), i=2841,2845) /  4693,  4565,   210,  4240,  4236/
+data    (chrtab(i), i=2846,2850) /  4298,   842,  5004,  5008,  4946/
+data    (chrtab(i), i=2851,2855) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2856,2860) /  4361,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=2861,2865) /  4873,  4940,  4944,  4883,  4820/
+data    (chrtab(i), i=2866,2870) /  4693,     0,   213,  4288,   276/
+data    (chrtab(i), i=2871,2875) /  4353,    21,  4437,  4416,   338/
+data    (chrtab(i), i=2876,2880) /  4500,  4629,  4757,  4948,  5074/
+data    (chrtab(i), i=2881,2885) /  5135,  5133,  5066,  4936,  4743/
+data    (chrtab(i), i=2886,2890) /  4615,  4488,  4426,   914,  5072/
+data    (chrtab(i), i=2891,2895) /  5068,  5002,   661,  4884,  4947/
+data    (chrtab(i), i=2896,2900) /  5008,  5004,  4937,  4872,  4743/
+data    (chrtab(i), i=2901,2905) /     0,  4608,    85,  4308,   149/
+data    (chrtab(i), i=2906,2910) /  4307,   193,  4160,   194,  4224/
+data    (chrtab(i), i=2911,2915) /   322,  4480,   321,  4544,     0/
+data    (chrtab(i), i=2916,2920) /   788,  4864,   851,  4929,   724/
+data    (chrtab(i), i=2921,2925) /  4948,  5013,  4992,   786,  4820/
+data    (chrtab(i), i=2926,2930) /  4693,  4565,  4372,  4242,  4175/
+data    (chrtab(i), i=2931,2935) /  4173,  4234,  4360,  4551,  4679/
+data    (chrtab(i), i=2936,2940) /  4808,  4874,   210,  4240,  4236/
+data    (chrtab(i), i=2941,2945) /  4298,   469,  4436,  4371,  4304/
+data    (chrtab(i), i=2946,2950) /  4300,  4361,  4424,  4551,   576/
+data    (chrtab(i), i=2951,2955) /  5184,   769,  4736,   770,  4800/
+data    (chrtab(i), i=2956,2960) /   898,  5056,   897,  5120,     0/
+data    (chrtab(i), i=2961,2965) /   213,  4295,   276,  4360,    21/
+data    (chrtab(i), i=2966,2970) /  4437,  4423,   787,  4884,  4820/
+data    (chrtab(i), i=2971,2975) /  4818,  4946,  4948,  4885,  4757/
+data    (chrtab(i), i=2976,2980) /  4628,  4498,  4431,     7,  4615/
+data    (chrtab(i), i=2981,2985) /    85,  4308,   149,  4307,   200/
+data    (chrtab(i), i=2986,2990) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2991,2995) /   328,  4551,     0,   723,  4885/
+data    (chrtab(i), i=2996,3000) /  4881,  4819,  4756,  4629,  4373/
+data    (chrtab(i), i=3001,3005) /  4244,  4179,  4177,  4239,  4366/
+data    (chrtab(i), i=3006,3010) /  4685,  4812,  4873,   148,  4177/
+data    (chrtab(i), i=3011,3015) /   144,  4367,  4686,  4813,   780/
+data    (chrtab(i), i=3016,3020) /  4808,    83,  4241,  4368,  4687/
+data    (chrtab(i), i=3021,3025) /  4814,  4876,  4873,  4808,  4679/
+data    (chrtab(i), i=3026,3030) /  4423,  4296,  4233,  4171,  4167/
+data    (chrtab(i), i=3031,3035) /  4233,     0,   218,  4300,  4361/
+data    (chrtab(i), i=3036,3040) /  4424,  4551,  4679,  4808,  4874/
+data    (chrtab(i), i=3041,3045) /   282,  4363,  4425,   218,  4444/
+data    (chrtab(i), i=3046,3050) /  4427,  4488,  4551,    21,  4693/
+data    (chrtab(i), i=3051,3055) /     0,   213,  4300,  4361,  4424/
+data    (chrtab(i), i=3056,3060) /  4551,  4743,  4872,  4937,  5003/
+data    (chrtab(i), i=3061,3065) /   276,  4363,  4425,    21,  4437/
+data    (chrtab(i), i=3066,3070) /  4427,  4488,  4551,   917,  4999/
+data    (chrtab(i), i=3071,3075) /  5319,   980,  5064,   725,  5141/
+data    (chrtab(i), i=3076,3080) /  5127,    85,  4308,   149,  4307/
+data    (chrtab(i), i=3081,3085) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=3086,3090) /    85,  4551,   149,  4553,   213/
+data    (chrtab(i), i=3091,3095) /  4617,   852,  4617,  4551,    21/
+data    (chrtab(i), i=3096,3100) /  4501,   597,  5077,    21,  4307/
+data    (chrtab(i), i=3101,3105) /   341,  4308,   725,  4948,   917/
+data    (chrtab(i), i=3106,3110) /  4948,     0,   149,  4487,   213/
+data    (chrtab(i), i=3111,3115) /  4490,   277,  4554,   661,  4554/
+data    (chrtab(i), i=3116,3120) /  4487,   661,  4999,   725,  5002/
+data    (chrtab(i), i=3121,3125) /   661,  4885,  5066,  1172,  5066/
+data    (chrtab(i), i=3126,3130) /  4999,    21,  4565,   981,  5461/
+data    (chrtab(i), i=3131,3135) /    21,  4308,   405,  4372,  1045/
+data    (chrtab(i), i=3136,3140) /  5268,  1301,  5268,     0,   149/
+data    (chrtab(i), i=3141,3145) /  4871,   213,  4935,   277,  4999/
+data    (chrtab(i), i=3146,3150) /   852,  4296,    21,  4565,   661/
+data    (chrtab(i), i=3151,3155) /  5141,     7,  4487,   583,  5127/
+data    (chrtab(i), i=3156,3160) /    85,  4308,   405,  4372,   725/
+data    (chrtab(i), i=3161,3165) /  4948,   981,  4948,   200,  4167/
+data    (chrtab(i), i=3166,3170) /   200,  4423,   776,  4743,   840/
+data    (chrtab(i), i=3171,3175) /  5063,     0,   149,  4615,   213/
+data    (chrtab(i), i=3176,3180) /  4617,   277,  4681,   916,  4681/
+data    (chrtab(i), i=3181,3185) /  4483,  4353,  4224,  4096,  4097/
+data    (chrtab(i), i=3186,3190) /  4099,  4163,  4161,  4097,  4098/
+data    (chrtab(i), i=3191,3195) /    21,  4565,   661,  5141,    85/
+data    (chrtab(i), i=3196,3200) /  4371,   405,  4372,   789,  5012/
+data    (chrtab(i), i=3201,3205) /   981,  5012,     0,   725,  4167/
+data    (chrtab(i), i=3206,3210) /   789,  4231,   853,  4295,   853/
+data    (chrtab(i), i=3211,3215) /  4181,  4177,    71,  4935,  4939/
+data    (chrtab(i), i=3216,3220) /   149,  4177,   213,  4178,   277/
+data    (chrtab(i), i=3221,3225) /  4179,   405,  4180,   519,  4936/
+data    (chrtab(i), i=3226,3230) /   647,  4937,   711,  4938,   775/
+data    (chrtab(i), i=3231,3235) /  4939,     0,   480,  4447,  4382/
+data    (chrtab(i), i=3236,3240) /  4316,  4314,  4376,  4439,  4501/
+data    (chrtab(i), i=3241,3245) /  4499,  4369,   351,  4381,  4379/
+data    (chrtab(i), i=3246,3250) /  4441,  4504,  4566,  4564,  4498/
+data    (chrtab(i), i=3251,3255) /  4240,  4494,  4556,  4554,  4488/
+data    (chrtab(i), i=3256,3260) /  4423,  4357,  4355,  4417,   271/
+data    (chrtab(i), i=3261,3265) /  4493,  4491,  4425,  4360,  4294/
+data    (chrtab(i), i=3266,3270) /  4292,  4354,  4417,  4544,     0/
+data    (chrtab(i), i=3271,3275) /   160,  4224,     0,   224,  4447/
+data    (chrtab(i), i=3276,3280) /  4510,  4572,  4570,  4504,  4439/
+data    (chrtab(i), i=3281,3285) /  4373,  4371,  4497,   351,  4509/
+data    (chrtab(i), i=3286,3290) /  4507,  4441,  4376,  4310,  4308/
+data    (chrtab(i), i=3291,3295) /  4370,  4624,  4366,  4300,  4298/
+data    (chrtab(i), i=3296,3300) /  4360,  4423,  4485,  4483,  4417/
+data    (chrtab(i), i=3301,3305) /   399,  4365,  4363,  4425,  4488/
+data    (chrtab(i), i=3306,3310) /  4550,  4548,  4482,  4417,  4288/
+data    (chrtab(i), i=3311,3315) /     0,    77,  4175,  4242,  4371/
+data    (chrtab(i), i=3316,3320) /  4499,  4626,  4879,  5006,  5134/
+data    (chrtab(i), i=3321,3325) /  5263,  5329,    79,  4241,  4370/
+data    (chrtab(i), i=3326,3330) /  4498,  4625,  4878,  5005,  5133/
+data    (chrtab(i), i=3331,3335) /  5262,  5329,  5331,     0,   284/
+data    (chrtab(i), i=3336,3340) /  4251,  4185,  4183,  4245,  4372/
+data    (chrtab(i), i=3341,3345) /  4500,  4629,  4695,  4697,  4635/
+data    (chrtab(i), i=3346,3350) /  4508,  4380,   284,  4185,  4245/
+data    (chrtab(i), i=3351,3355) /  4500,  4695,  4635,  4380,   412/
+data    (chrtab(i), i=3356,3360) /  4251,  4183,  4372,  4629,  4697/
+data    (chrtab(i), i=3361,3362) /  4508,     0/
diff --git a/sys/gio/fonts/greek.com b/sys/gio/fonts/greek.com
new file mode 100644
index 00000000..82c5fe34
--- /dev/null
+++ b/sys/gio/fonts/greek.com
@@ -0,0 +1,501 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   gchidx[97]	# character index in gchtab
+short   gchwid[97]	# character width table
+short   gchtab[2140]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (gchidx(i), i=001,005) /    1,    3,   16,   29,   38/
+data    (gchidx(i), i=006,010) /   77,  107,  154,  162,  181/
+data    (gchidx(i), i=011,015) /  200,  205,  212,  233,  240/
+data    (gchidx(i), i=016,020) /  246,  259,  297,  306,  348/
+data    (gchidx(i), i=021,025) /  392,  402,  437,  483,  510/
+data    (gchidx(i), i=026,030) /  568,  614,  645,  658,  666/
+data    (gchidx(i), i=031,035) /  673,  681,  688,  741,  767/
+data    (gchidx(i), i=036,040) /  793,  795,  806,  821,  863/
+data    (gchidx(i), i=041,045) /  874,  883,  888,  899,  901/
+data    (gchidx(i), i=046,050) /  912,  921,  930,  972,  987/
+data    (gchidx(i), i=051,055) / 1037, 1067, 1083, 1088, 1117/
+data    (gchidx(i), i=056,060) / 1143, 1182, 1207, 1242, 1244/
+data    (gchidx(i), i=061,065) / 1253, 1256, 1265, 1267, 1276/
+data    (gchidx(i), i=066,070) / 1284, 1321, 1373, 1394, 1436/
+data    (gchidx(i), i=071,075) / 1465, 1500, 1525, 1554, 1568/
+data    (gchidx(i), i=076,080) / 1610, 1635, 1655, 1679, 1699/
+data    (gchidx(i), i=081,085) / 1729, 1746, 1788, 1817, 1849/
+data    (gchidx(i), i=086,090) / 1862, 1891, 1893, 1934, 1975/
+data    (gchidx(i), i=091,095) / 2006, 2036, 2074, 2079, 2117/
+data    (gchidx(i), i=096,096) / 2126/
+
+
+# Width data.
+
+data    (gchwid(i), i=001,005) /   21,   15,   15,   26,   25/
+data    (gchwid(i), i=006,010) /   29,   30,   15,   19,   19/
+data    (gchwid(i), i=011,015) /   27,   29,   30,   29,   15/
+data    (gchwid(i), i=016,020) /   31,   25,   25,   25,   25/
+data    (gchwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (gchwid(i), i=026,030) /   25,   29,   15,   29,   31/
+data    (gchwid(i), i=031,035) /   29,   31,   32,   25,   30/
+data    (gchwid(i), i=036,040) /   21,   25,   29,   26,   23/
+data    (gchwid(i), i=041,045) /   26,   19,   25,   21,   25/
+data    (gchwid(i), i=046,050) /   21,   21,   27,   29,   27/
+data    (gchwid(i), i=051,055) /   29,   26,   19,   24,   25/
+data    (gchwid(i), i=056,060) /   27,   27,   28,   21,   19/
+data    (gchwid(i), i=061,065) /   19,   19,   21,   31,   27/
+data    (gchwid(i), i=066,070) /   28,   26,   23,   24,   23/
+data    (gchwid(i), i=071,075) /   27,   25,   27,   17,   24/
+data    (gchwid(i), i=076,080) /   25,   25,   28,   25,   23/
+data    (gchwid(i), i=081,085) /   27,   28,   24,   26,   25/
+data    (gchwid(i), i=086,090) /   25,   21,   28,   22,   28/
+data    (gchwid(i), i=091,095) /   23,   19,   19,   19,   31/
+data    (gchwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (gchtab(i), i=0001,0005) /    35,     0,   220,  4250,  4302/
+data    (gchtab(i), i=0006,0010) /  4378,  4316,   218,  4308,   201/
+data    (gchtab(i), i=0011,0015) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0016,0020) /   213,  4244,  4307,  4372,  4309/
+data    (gchtab(i), i=0021,0025) /   199,  4232,  4297,  4360,  4358/
+data    (gchtab(i), i=0026,0030) /  4292,  4227,     0,   604,  4224/
+data    (gchtab(i), i=0031,0035) /   988,  4608,   145,  5137,    75/
+data    (gchtab(i), i=0036,0040) /  5067,     0,   416,  4483,   672/
+data    (gchtab(i), i=0041,0045) /  4739,   921,  4952,  5015,  5080/
+data    (gchtab(i), i=0046,0050) /  5081,  4955,  4764,  4508,  4315/
+data    (gchtab(i), i=0051,0055) /  4185,  4183,  4245,  4308,  4435/
+data    (gchtab(i), i=0056,0060) /  4817,  4944,  5070,    87,  4309/
+data    (gchtab(i), i=0061,0065) /  4436,  4818,  4945,  5008,  5070/
+data    (gchtab(i), i=0066,0070) /  5066,  4936,  4743,  4487,  4296/
+data    (gchtab(i), i=0071,0075) /  4170,  4171,  4236,  4299,  4234/
+data    (gchtab(i), i=0076,0080) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=0081,0085) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=0086,0090) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=0091,0095) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=0096,0100) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=0101,0105) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=0106,0110) /     0,  1236,  5267,  5330,  5395/
+data    (gchtab(i), i=0111,0115) /  5396,  5333,  5269,  5204,  5138/
+data    (gchtab(i), i=0116,0120) /  5005,  4874,  4744,  4615,  4423/
+data    (gchtab(i), i=0121,0125) /  4232,  4170,  4173,  4239,  4627/
+data    (gchtab(i), i=0126,0130) /  4757,  4823,  4825,  4763,  4636/
+data    (gchtab(i), i=0131,0135) /  4507,  4441,  4439,  4500,  4625/
+data    (gchtab(i), i=0136,0140) /  4938,  5064,  5255,  5319,  5384/
+data    (gchtab(i), i=0141,0145) /  5385,   327,  4296,  4234,  4237/
+data    (gchtab(i), i=0146,0150) /  4303,  4433,   343,  4501,  5002/
+data    (gchtab(i), i=0151,0155) /  5128,  5255,     0,   218,  4251/
+data    (gchtab(i), i=0156,0160) /  4316,  4379,  4377,  4311,  4246/
+data    (gchtab(i), i=0161,0165) /     0,   608,  4574,  4443,  4311/
+data    (gchtab(i), i=0166,0170) /  4242,  4238,  4297,  4421,  4546/
+data    (gchtab(i), i=0171,0175) /  4672,   478,  4442,  4375,  4306/
+data    (gchtab(i), i=0176,0180) /  4302,  4361,  4422,  4546,     0/
+data    (gchtab(i), i=0181,0185) /    96,  4318,  4443,  4567,  4626/
+data    (gchtab(i), i=0186,0190) /  4622,  4553,  4421,  4290,  4160/
+data    (gchtab(i), i=0191,0195) /   222,  4442,  4503,  4562,  4558/
+data    (gchtab(i), i=0196,0200) /  4489,  4422,  4290,     0,   151/
+data    (gchtab(i), i=0201,0205) /  5129,  1047,  4233,     0,   664/
+data    (gchtab(i), i=0206,0210) /  4743,   144,  5264,   135,  5255/
+data    (gchtab(i), i=0211,0215) /     0,  1227,  5195,  5068,  4942/
+data    (gchtab(i), i=0216,0220) /  4754,  4691,  4564,  4436,  4307/
+data    (gchtab(i), i=0221,0225) /  4241,  4239,  4301,  4428,  4556/
+data    (gchtab(i), i=0226,0230) /  4685,  4750,  4946,  5076,  5205/
+data    (gchtab(i), i=0231,0235) /  5333,     0,   664,  4743,   152/
+data    (gchtab(i), i=0236,0240) /  5272,   144,  5264,     0,   201/
+data    (gchtab(i), i=0241,0245) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0246,0250) /   729,  4760,  4823,  4888,  4825/
+data    (gchtab(i), i=0251,0255) /   144,  5392,   713,  4744,  4807/
+data    (gchtab(i), i=0256,0260) /  4872,  4809,     0,   476,  4379/
+data    (gchtab(i), i=0261,0265) /  4248,  4179,  4176,  4235,  4360/
+data    (gchtab(i), i=0266,0270) /  4551,  4679,  4872,  5003,  5072/
+data    (gchtab(i), i=0271,0275) /  5075,  5016,  4891,  4700,  4572/
+data    (gchtab(i), i=0276,0280) /   476,  4443,  4378,  4312,  4243/
+data    (gchtab(i), i=0281,0285) /  4240,  4299,  4361,  4424,  4551/
+data    (gchtab(i), i=0286,0290) /   583,  4808,  4873,  4939,  5008/
+data    (gchtab(i), i=0291,0295) /  5011,  4952,  4890,  4827,  4700/
+data    (gchtab(i), i=0296,0300) /     0,   280,  4505,  4700,  4679/
+data    (gchtab(i), i=0301,0305) /   539,  4615,   263,  4935,     0/
+data    (gchtab(i), i=0306,0310) /   152,  4311,  4246,  4183,  4184/
+data    (gchtab(i), i=0311,0315) /  4250,  4315,  4508,  4764,  4955/
+data    (gchtab(i), i=0316,0320) /  5018,  5080,  5078,  5012,  4818/
+data    (gchtab(i), i=0321,0325) /  4496,  4367,  4237,  4170,  4167/
+data    (gchtab(i), i=0326,0330) /   668,  4891,  4954,  5016,  5014/
+data    (gchtab(i), i=0331,0335) /  4948,  4754,  4496,    73,  4234/
+data    (gchtab(i), i=0336,0340) /  4362,  4680,  4872,  5001,  5066/
+data    (gchtab(i), i=0341,0345) /   266,  4679,  4935,  5000,  5066/
+data    (gchtab(i), i=0346,0350) /  5068,     0,   152,  4311,  4246/
+data    (gchtab(i), i=0351,0355) /  4183,  4184,  4250,  4315,  4508/
+data    (gchtab(i), i=0356,0360) /  4764,  4955,  5017,  5014,  4948/
+data    (gchtab(i), i=0361,0365) /  4755,  4563,   668,  4891,  4953/
+data    (gchtab(i), i=0366,0370) /  4950,  4884,  4755,   659,  4882/
+data    (gchtab(i), i=0371,0375) /  5008,  5070,  5067,  5001,  4936/
+data    (gchtab(i), i=0376,0380) /  4743,  4487,  4296,  4233,  4171/
+data    (gchtab(i), i=0381,0385) /  4172,  4237,  4300,  4235,   849/
+data    (gchtab(i), i=0386,0390) /  5006,  5003,  4937,  4872,  4743/
+data    (gchtab(i), i=0391,0395) /     0,   666,  4743,   732,  4807/
+data    (gchtab(i), i=0396,0400) /   732,  4109,  5133,   455,  4999/
+data    (gchtab(i), i=0401,0405) /     0,   220,  4178,    82,  4308/
+data    (gchtab(i), i=0406,0410) /  4501,  4693,  4884,  5010,  5071/
+data    (gchtab(i), i=0411,0415) /  5069,  5002,  4872,  4679,  4487/
+data    (gchtab(i), i=0416,0420) /  4296,  4233,  4171,  4172,  4237/
+data    (gchtab(i), i=0421,0425) /  4300,  4235,   597,  4820,  4946/
+data    (gchtab(i), i=0426,0430) /  5007,  5005,  4938,  4808,  4679/
+data    (gchtab(i), i=0431,0435) /   220,  4956,   219,  4635,  4956/
+data    (gchtab(i), i=0436,0440) /     0,   857,  4888,  4951,  5016/
+data    (gchtab(i), i=0441,0445) /  5017,  4955,  4828,  4636,  4443/
+data    (gchtab(i), i=0446,0450) /  4313,  4247,  4179,  4173,  4234/
+data    (gchtab(i), i=0451,0455) /  4360,  4551,  4679,  4872,  5002/
+data    (gchtab(i), i=0456,0460) /  5069,  5070,  5009,  4883,  4692/
+data    (gchtab(i), i=0461,0465) /  4628,  4435,  4305,  4238,   540/
+data    (gchtab(i), i=0466,0470) /  4507,  4377,  4311,  4243,  4237/
+data    (gchtab(i), i=0471,0475) /  4298,  4424,  4551,   583,  4808/
+data    (gchtab(i), i=0476,0480) /  4938,  5005,  5006,  4945,  4819/
+data    (gchtab(i), i=0481,0485) /  4692,     0,    92,  4182,    88/
+data    (gchtab(i), i=0486,0490) /  4250,  4380,  4508,  4825,  4953/
+data    (gchtab(i), i=0491,0495) /  5018,  5084,   154,  4379,  4507/
+data    (gchtab(i), i=0496,0500) /  4825,   988,  5081,  5014,  4753/
+data    (gchtab(i), i=0501,0505) /  4687,  4620,  4615,   918,  4689/
+data    (gchtab(i), i=0506,0510) /  4623,  4556,  4551,     0,   412/
+data    (gchtab(i), i=0511,0515) /  4315,  4249,  4246,  4308,  4499/
+data    (gchtab(i), i=0516,0520) /  4755,  4948,  5014,  5017,  4955/
+data    (gchtab(i), i=0521,0525) /  4764,  4508,   412,  4379,  4313/
+data    (gchtab(i), i=0526,0530) /  4310,  4372,  4499,   659,  4884/
+data    (gchtab(i), i=0531,0535) /  4950,  4953,  4891,  4764,   403/
+data    (gchtab(i), i=0536,0540) /  4306,  4241,  4175,  4171,  4233/
+data    (gchtab(i), i=0541,0545) /  4296,  4487,  4743,  4936,  5001/
+data    (gchtab(i), i=0546,0550) /  5067,  5071,  5009,  4946,  4755/
+data    (gchtab(i), i=0551,0555) /   403,  4370,  4305,  4239,  4235/
+data    (gchtab(i), i=0556,0560) /  4297,  4360,  4487,   647,  4872/
+data    (gchtab(i), i=0561,0565) /  4937,  5003,  5007,  4945,  4882/
+data    (gchtab(i), i=0566,0570) /  4755,     0,   917,  4946,  4816/
+data    (gchtab(i), i=0571,0575) /  4623,  4559,  4368,  4242,  4181/
+data    (gchtab(i), i=0576,0580) /  4182,  4249,  4379,  4572,  4700/
+data    (gchtab(i), i=0581,0585) /  4891,  5017,  5078,  5072,  5004/
+data    (gchtab(i), i=0586,0590) /  4938,  4808,  4615,  4423,  4296/
+data    (gchtab(i), i=0591,0595) /  4234,  4235,  4300,  4363,  4298/
+data    (gchtab(i), i=0596,0600) /   463,  4432,  4306,  4245,  4246/
+data    (gchtab(i), i=0601,0605) /  4313,  4443,  4572,   604,  4827/
+data    (gchtab(i), i=0606,0610) /  4953,  5014,  5008,  4940,  4874/
+data    (gchtab(i), i=0611,0615) /  4744,  4615,     0,  1247,  5278/
+data    (gchtab(i), i=0616,0620) /  5341,  5406,  5407,  5344,  5216/
+data    (gchtab(i), i=0621,0625) /  5087,  4957,  4891,  4824,  4756/
+data    (gchtab(i), i=0626,0630) /  4616,  4548,  4482,   926,  4956/
+data    (gchtab(i), i=0631,0635) /  4888,  4748,  4680,  4613,  4547/
+data    (gchtab(i), i=0636,0640) /  4417,  4288,  4160,  4097,  4098/
+data    (gchtab(i), i=0641,0645) /  4163,  4226,  4161,     0,   213/
+data    (gchtab(i), i=0646,0650) /  4244,  4307,  4372,  4309,   199/
+data    (gchtab(i), i=0651,0655) /  4232,  4297,  4360,  4358,  4292/
+data    (gchtab(i), i=0656,0660) /  4227,     0,  1180,  4245,  5262/
+data    (gchtab(i), i=0661,0665) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0666,0670) /   149,  5397,   144,  5392,   139/
+data    (gchtab(i), i=0671,0675) /  5387,     0,   156,  5269,  4238/
+data    (gchtab(i), i=0676,0680) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0681,0685) /  1177,  4359,   147,  5395,   141/
+data    (gchtab(i), i=0686,0690) /  5389,     0,  1044,  5078,  4951/
+data    (gchtab(i), i=0691,0695) /  4759,  4630,  4565,  4498,  4495/
+data    (gchtab(i), i=0696,0700) /  4557,  4684,  4876,  5005,  5071/
+data    (gchtab(i), i=0701,0705) /   663,  4629,  4562,  4559,  4621/
+data    (gchtab(i), i=0706,0710) /  4684,  1047,  5071,  5069,  5196/
+data    (gchtab(i), i=0711,0715) /  5324,  5454,  5521,  5523,  5462/
+data    (gchtab(i), i=0716,0720) /  5400,  5274,  5147,  4956,  4764/
+data    (gchtab(i), i=0721,0725) /  4571,  4442,  4312,  4246,  4179/
+data    (gchtab(i), i=0726,0730) /  4176,  4237,  4299,  4425,  4552/
+data    (gchtab(i), i=0731,0735) /  4743,  4935,  5128,  5257,  5322/
+data    (gchtab(i), i=0736,0740) /  1111,  5135,  5133,  5196,     0/
+data    (gchtab(i), i=0741,0745) /   473,  4167,   601,  5063,   537/
+data    (gchtab(i), i=0746,0750) /  4999,   205,  4877,     7,  4423/
+data    (gchtab(i), i=0751,0755) /   711,  5191,   480,  4447,  4381/
+data    (gchtab(i), i=0756,0760) /  4379,  4441,  4568,  4696,  4825/
+data    (gchtab(i), i=0761,0765) /  4891,  4893,  4831,  4704,  4576/
+data    (gchtab(i), i=0766,0770) /     0,  1295,  5325,  5196,  5068/
+data    (gchtab(i), i=0771,0775) /  4941,  4878,  4690,  4627,  4500/
+data    (gchtab(i), i=0776,0780) /  4372,  4243,  4177,  4175,  4237/
+data    (gchtab(i), i=0781,0785) /  4364,  4492,  4621,  4686,  4882/
+data    (gchtab(i), i=0786,0790) /  4947,  5076,  5204,  5331,  5393/
+data    (gchtab(i), i=0791,0795) /  5391,     0,    35,     0,   540/
+data    (gchtab(i), i=0796,0800) /  4103,   540,  5127,   537,  5063/
+data    (gchtab(i), i=0801,0805) /    72,  5064,     7,  5127,     0/
+data    (gchtab(i), i=0806,0810) /  1176,  4824,  4567,  4438,  4308/
+data    (gchtab(i), i=0811,0815) /  4241,  4239,  4300,  4426,  4553/
+data    (gchtab(i), i=0816,0820) /  4808,  5256,   144,  5008,     0/
+data    (gchtab(i), i=0821,0825) /   540,  4615,   604,  4679,   407/
+data    (gchtab(i), i=0826,0830) /  4310,  4245,  4179,  4176,  4238/
+data    (gchtab(i), i=0831,0835) /  4301,  4492,  4812,  5005,  5070/
+data    (gchtab(i), i=0836,0840) /  5136,  5139,  5077,  5014,  4823/
+data    (gchtab(i), i=0841,0845) /  4503,   407,  4374,  4309,  4243/
+data    (gchtab(i), i=0846,0850) /  4240,  4302,  4365,  4492,   716/
+data    (gchtab(i), i=0851,0855) /  4941,  5006,  5072,  5075,  5013/
+data    (gchtab(i), i=0856,0860) /  4950,  4823,   348,  4892,   327/
+data    (gchtab(i), i=0861,0865) /  4871,     0,   220,  4295,   284/
+data    (gchtab(i), i=0866,0870) /  4359,    28,  5084,  5078,  5020/
+data    (gchtab(i), i=0871,0875) /     7,  4551,     0,   608,  4224/
+data    (gchtab(i), i=0876,0880) /   992,  4608,   147,  5139,    77/
+data    (gchtab(i), i=0881,0885) /  5069,     0,   160,  4224,   544/
+data    (gchtab(i), i=0886,0890) /  4608,     0,    28,  4615,    92/
+data    (gchtab(i), i=0891,0895) /  4617,  1052,  4615,    28,  5148/
+data    (gchtab(i), i=0896,0900) /    91,  5083,     0,    35,     0/
+data    (gchtab(i), i=0901,0905) /   540,  4167,   540,  5063,   537/
+data    (gchtab(i), i=0906,0910) /  4999,     7,  4423,   711,  5191/
+data    (gchtab(i), i=0911,0915) /     0,   278,  4505,  4630,    83/
+data    (gchtab(i), i=0916,0920) /  4504,  4819,   408,  4487,     0/
+data    (gchtab(i), i=0921,0925) /   266,  4487,  4618,    77,  4488/
+data    (gchtab(i), i=0926,0930) /  4813,   409,  4488,     0,   540/
+data    (gchtab(i), i=0931,0935) /  4443,  4313,  4247,  4179,  4176/
+data    (gchtab(i), i=0936,0940) /  4236,  4298,  4424,  4615,  4743/
+data    (gchtab(i), i=0941,0945) /  4936,  5066,  5132,  5200,  5203/
+data    (gchtab(i), i=0946,0950) /  5143,  5081,  4955,  4764,  4636/
+data    (gchtab(i), i=0951,0955) /   540,  4507,  4377,  4311,  4243/
+data    (gchtab(i), i=0956,0960) /  4240,  4300,  4362,  4488,  4615/
+data    (gchtab(i), i=0961,0965) /   647,  4872,  5002,  5068,  5136/
+data    (gchtab(i), i=0966,0970) /  5139,  5079,  5017,  4891,  4764/
+data    (gchtab(i), i=0971,0975) /     0,   220,  4295,   284,  4359/
+data    (gchtab(i), i=0976,0980) /  1052,  5127,  1116,  5191,    28/
+data    (gchtab(i), i=0981,0985) /  5404,     7,  4551,   839,  5383/
+data    (gchtab(i), i=0986,0990) /     0,   540,  4443,  4313,  4247/
+data    (gchtab(i), i=0991,0995) /  4179,  4176,  4236,  4298,  4424/
+data    (gchtab(i), i=0996,1000) /  4615,  4743,  4936,  5066,  5132/
+data    (gchtab(i), i=1001,1005) /  5200,  5203,  5143,  5081,  4955/
+data    (gchtab(i), i=1006,1010) /  4764,  4636,   540,  4507,  4377/
+data    (gchtab(i), i=1011,1015) /  4311,  4243,  4240,  4300,  4362/
+data    (gchtab(i), i=1016,1020) /  4488,  4615,   647,  4872,  5002/
+data    (gchtab(i), i=1021,1025) /  5068,  5136,  5139,  5079,  5017/
+data    (gchtab(i), i=1026,1030) /  4891,  4764,   405,  4494,   789/
+data    (gchtab(i), i=1031,1035) /  4878,   402,  4882,   401,  4881/
+data    (gchtab(i), i=1036,1040) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=1041,1045) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=1046,1050) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=1051,1055) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=1056,1060) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=1061,1065) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=1066,1070) /     0,    92,  4626,  4103,    28/
+data    (gchtab(i), i=1071,1075) /  4562,    28,  5084,  5142,  5020/
+data    (gchtab(i), i=1076,1080) /    72,  5000,     7,  5063,  5133/
+data    (gchtab(i), i=1081,1085) /  4999,     0,   160,  4224,   544/
+data    (gchtab(i), i=1086,1090) /  4608,     0,    23,  4121,  4187/
+data    (gchtab(i), i=1091,1095) /  4252,  4380,  4443,  4505,  4565/
+data    (gchtab(i), i=1096,1100) /  4551,    25,  4251,  4379,  4505/
+data    (gchtab(i), i=1101,1105) /   983,  5081,  5019,  4956,  4828/
+data    (gchtab(i), i=1106,1110) /  4763,  4697,  4629,  4615,   985/
+data    (gchtab(i), i=1111,1115) /  4955,  4827,  4697,   263,  4807/
+data    (gchtab(i), i=1116,1120) /     0,   473,  4167,   601,  5063/
+data    (gchtab(i), i=1121,1125) /   537,  4999,   205,  4877,     7/
+data    (gchtab(i), i=1126,1130) /  4423,   711,  5191,   480,  4447/
+data    (gchtab(i), i=1131,1135) /  4381,  4379,  4441,  4568,  4696/
+data    (gchtab(i), i=1136,1140) /  4825,  4891,  4893,  4831,  4704/
+data    (gchtab(i), i=1141,1145) /  4576,     0,    74,  4231,  4487/
+data    (gchtab(i), i=1146,1150) /  4363,  4239,  4178,  4182,  4249/
+data    (gchtab(i), i=1151,1155) /  4379,  4572,  4828,  5019,  5145/
+data    (gchtab(i), i=1156,1160) /  5206,  5202,  5135,  5003,  4871/
+data    (gchtab(i), i=1161,1165) /  5127,  5194,   267,  4302,  4242/
+data    (gchtab(i), i=1166,1170) /  4246,  4313,  4443,  4572,   732/
+data    (gchtab(i), i=1171,1175) /  4955,  5081,  5142,  5138,  5070/
+data    (gchtab(i), i=1176,1180) /  5003,   136,  4424,   840,  5128/
+data    (gchtab(i), i=1181,1185) /     0,   157,  4184,  1117,  5144/
+data    (gchtab(i), i=1186,1190) /   404,  4431,   852,  4879,   139/
+data    (gchtab(i), i=1191,1195) /  4166,  1099,  5126,   155,  5147/
+data    (gchtab(i), i=1196,1200) /   154,  5146,   402,  4882,   401/
+data    (gchtab(i), i=1201,1205) /  4881,   137,  5129,   136,  5128/
+data    (gchtab(i), i=1206,1210) /     0,   604,  4679,   668,  4743/
+data    (gchtab(i), i=1211,1215) /    21,  4182,  4309,  4369,  4431/
+data    (gchtab(i), i=1216,1220) /  4494,  4621,    86,  4245,  4305/
+data    (gchtab(i), i=1221,1225) /  4367,  4430,  4621,  4813,  5006/
+data    (gchtab(i), i=1226,1230) /  5071,  5137,  5205,  5270,   717/
+data    (gchtab(i), i=1231,1235) /  4942,  5007,  5073,  5141,  5270/
+data    (gchtab(i), i=1236,1240) /  5333,   412,  4956,   391,  4935/
+data    (gchtab(i), i=1241,1245) /     0,    35,     0,   160,  4224/
+data    (gchtab(i), i=1246,1250) /   224,  4288,   160,  4704,   128/
+data    (gchtab(i), i=1251,1255) /  4672,     0,    28,  4868,     0/
+data    (gchtab(i), i=1256,1260) /   480,  4544,   544,  4608,    96/
+data    (gchtab(i), i=1261,1265) /  4640,    64,  4608,     0,    35/
+data    (gchtab(i), i=1266,1270) /     0,  1106,  5392,  5198,   917/
+data    (gchtab(i), i=1271,1275) /  5328,  5003,   144,  5328,     0/
+data    (gchtab(i), i=1276,1280) /    85,  4437,  4809,   277,  4807/
+data    (gchtab(i), i=1281,1285) /  1312,  4807,     0,   533,  4436/
+data    (gchtab(i), i=1286,1290) /  4306,  4240,  4173,  4170,  4232/
+data    (gchtab(i), i=1291,1295) /  4423,  4551,  4680,  4875,  5006/
+data    (gchtab(i), i=1296,1300) /  5138,  5205,   533,  4500,  4370/
+data    (gchtab(i), i=1301,1305) /  4304,  4237,  4234,  4296,  4423/
+data    (gchtab(i), i=1306,1310) /   533,  4757,  4884,  4946,  5066/
+data    (gchtab(i), i=1311,1315) /  5128,  5191,   661,  4820,  4882/
+data    (gchtab(i), i=1316,1320) /  5002,  5064,  5191,  5255,     0/
+data    (gchtab(i), i=1321,1325) /   732,  4635,  4505,  4373,  4306/
+data    (gchtab(i), i=1326,1330) /  4238,  4168,  4096,   732,  4699/
+data    (gchtab(i), i=1331,1335) /  4569,  4437,  4370,  4302,  4232/
+data    (gchtab(i), i=1336,1340) /  4160,   732,  4956,  5083,  5146/
+data    (gchtab(i), i=1341,1345) /  5143,  5077,  5012,  4819,  4563/
+data    (gchtab(i), i=1346,1350) /   860,  5082,  5079,  5013,  4948/
+data    (gchtab(i), i=1351,1355) /  4819,   467,  4818,  4944,  5006/
+data    (gchtab(i), i=1356,1360) /  5003,  4937,  4872,  4679,  4551/
+data    (gchtab(i), i=1361,1365) /  4424,  4361,  4300,   467,  4754/
+data    (gchtab(i), i=1366,1370) /  4880,  4942,  4939,  4873,  4808/
+data    (gchtab(i), i=1371,1375) /  4679,     0,    21,  4245,  4372/
+data    (gchtab(i), i=1376,1380) /  4434,  4739,  4801,  4864,   149/
+data    (gchtab(i), i=1381,1385) /  4308,  4370,  4675,  4737,  4864/
+data    (gchtab(i), i=1386,1390) /  4992,   981,  5011,  4880,  4229/
+data    (gchtab(i), i=1391,1395) /  4098,  4096,     0,   724,  4693/
+data    (gchtab(i), i=1396,1400) /  4565,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1401,1405) /  4233,  4296,  4423,  4551,  4744/
+data    (gchtab(i), i=1406,1410) /  4875,  4942,  4945,  4883,  4632/
+data    (gchtab(i), i=1411,1415) /  4570,  4572,  4637,  4765,  4892/
+data    (gchtab(i), i=1416,1420) /  5018,   469,  4436,  4305,  4238/
+data    (gchtab(i), i=1421,1425) /  4234,  4296,   455,  4680,  4811/
+data    (gchtab(i), i=1426,1430) /  4878,  4882,  4820,  4695,  4633/
+data    (gchtab(i), i=1431,1435) /  4635,  4700,  4828,  5018,     0/
+data    (gchtab(i), i=1436,1440) /   850,  4820,  4693,  4437,  4308/
+data    (gchtab(i), i=1441,1445) /  4306,  4432,  4623,   341,  4372/
+data    (gchtab(i), i=1446,1450) /  4370,  4496,  4623,   527,  4302/
+data    (gchtab(i), i=1451,1455) /  4172,  4170,  4232,  4423,  4615/
+data    (gchtab(i), i=1456,1460) /  4744,  4874,   527,  4366,  4236/
+data    (gchtab(i), i=1461,1465) /  4234,  4296,  4423,     0,   404/
+data    (gchtab(i), i=1466,1470) /  4371,  4241,  4174,  4171,  4233/
+data    (gchtab(i), i=1471,1475) /  4296,  4423,  4615,  4808,  5002/
+data    (gchtab(i), i=1476,1480) /  5133,  5200,  5203,  5077,  4949/
+data    (gchtab(i), i=1481,1485) /  4819,  4687,  4554,  4352,    75/
+data    (gchtab(i), i=1486,1490) /  4297,  4424,  4616,  4809,  5003/
+data    (gchtab(i), i=1491,1495) /  5133,  1107,  5076,  4948,  4818/
+data    (gchtab(i), i=1496,1500) /  4687,  4553,  4416,     0,    18/
+data    (gchtab(i), i=1501,1505) /  4180,  4309,  4437,  4564,  4627/
+data    (gchtab(i), i=1506,1510) /  4688,  4684,  4616,  4416,    19/
+data    (gchtab(i), i=1511,1515) /  4244,  4500,  4627,  1045,  5074/
+data    (gchtab(i), i=1516,1520) /  5008,  4681,  4484,  4352,   981/
+data    (gchtab(i), i=1521,1525) /  5010,  4944,  4681,     0,    17/
+data    (gchtab(i), i=1526,1530) /  4115,  4245,  4437,  4500,  4498/
+data    (gchtab(i), i=1531,1535) /  4430,  4295,   277,  4436,  4434/
+data    (gchtab(i), i=1536,1540) /  4366,  4231,   334,  4562,  4692/
+data    (gchtab(i), i=1541,1545) /  4821,  4949,  5076,  5139,  5136/
+data    (gchtab(i), i=1546,1550) /  5067,  4864,   853,  5075,  5072/
+data    (gchtab(i), i=1551,1555) /  5003,  4800,     0,   277,  4238/
+data    (gchtab(i), i=1556,1560) /  4170,  4168,  4231,  4423,  4553/
+data    (gchtab(i), i=1561,1565) /  4619,   341,  4302,  4234,  4232/
+data    (gchtab(i), i=1566,1570) /  4295,     0,   848,  4883,  4820/
+data    (gchtab(i), i=1571,1575) /  4693,  4565,  4372,  4241,  4174/
+data    (gchtab(i), i=1576,1580) /  4171,  4233,  4296,  4423,  4551/
+data    (gchtab(i), i=1581,1585) /  4744,  4874,  4941,  5010,  5015/
+data    (gchtab(i), i=1586,1590) /  4954,  4891,  4764,  4572,  4443/
+data    (gchtab(i), i=1591,1595) /  4378,  4377,  4441,  4442,   469/
+data    (gchtab(i), i=1596,1600) /  4436,  4305,  4238,  4234,  4296/
+data    (gchtab(i), i=1601,1605) /   455,  4680,  4810,  4877,  4946/
+data    (gchtab(i), i=1606,1610) /  4951,  4890,  4764,     0,   277/
+data    (gchtab(i), i=1611,1615) /  4103,   341,  4167,   917,  5076/
+data    (gchtab(i), i=1616,1620) /  5140,  5077,  4949,  4820,  4560/
+data    (gchtab(i), i=1621,1625) /  4431,  4303,   335,  4558,  4680/
+data    (gchtab(i), i=1626,1630) /  4743,   335,  4494,  4616,  4679/
+data    (gchtab(i), i=1631,1635) /  4807,  4936,  5067,     0,    92/
+data    (gchtab(i), i=1636,1640) /  4316,  4443,  4506,  4568,  4938/
+data    (gchtab(i), i=1641,1645) /  5000,  5063,   220,  4442,  4504/
+data    (gchtab(i), i=1646,1650) /  4874,  4936,  5063,  5127,   533/
+data    (gchtab(i), i=1651,1655) /  4103,   533,  4167,     0,   341/
+data    (gchtab(i), i=1656,1660) /  4096,   405,  4096,   338,  4364/
+data    (gchtab(i), i=1661,1665) /  4361,  4487,  4615,  4744,  4874/
+data    (gchtab(i), i=1666,1670) /  5005,  1045,  4938,  4936,  4999/
+data    (gchtab(i), i=1671,1675) /  5191,  5321,  5387,  1109,  5002/
+data    (gchtab(i), i=1676,1680) /  5000,  5063,     0,   277,  4231/
+data    (gchtab(i), i=1681,1685) /   341,  4367,  4298,  4231,   981/
+data    (gchtab(i), i=1686,1690) /  5009,  4877,  1045,  5074,  5008/
+data    (gchtab(i), i=1691,1695) /  4877,  4747,  4553,  4424,  4231/
+data    (gchtab(i), i=1696,1700) /    85,  4437,     0,   469,  4372/
+data    (gchtab(i), i=1701,1705) /  4241,  4174,  4171,  4233,  4296/
+data    (gchtab(i), i=1706,1710) /  4423,  4551,  4744,  4875,  4942/
+data    (gchtab(i), i=1711,1715) /  4945,  4883,  4820,  4693,  4565/
+data    (gchtab(i), i=1716,1720) /   469,  4436,  4305,  4238,  4234/
+data    (gchtab(i), i=1721,1725) /  4296,   455,  4680,  4811,  4878/
+data    (gchtab(i), i=1726,1730) /  4882,  4820,     0,   468,  4295/
+data    (gchtab(i), i=1731,1735) /   468,  4359,   852,  4935,   852/
+data    (gchtab(i), i=1736,1740) /  4999,    18,  4244,  4437,  5269/
+data    (gchtab(i), i=1741,1745) /    18,  4243,  4436,  5268,     0/
+data    (gchtab(i), i=1746,1750) /    17,  4115,  4245,  4437,  4500/
+data    (gchtab(i), i=1751,1755) /  4498,  4429,  4426,  4488,  4551/
+data    (gchtab(i), i=1756,1760) /   277,  4436,  4434,  4365,  4362/
+data    (gchtab(i), i=1761,1765) /  4424,  4551,  4679,  4808,  4938/
+data    (gchtab(i), i=1766,1770) /  5069,  5136,  5205,  5209,  5147/
+data    (gchtab(i), i=1771,1775) /  5020,  4892,  4762,  4760,  4821/
+data    (gchtab(i), i=1776,1780) /  4946,  5072,  5262,   712,  4939/
+data    (gchtab(i), i=1781,1785) /  5005,  5072,  5141,  5145,  5083/
+data    (gchtab(i), i=1786,1790) /  5020,     0,   140,  4297,  4360/
+data    (gchtab(i), i=1791,1795) /  4487,  4615,  4808,  4939,  5006/
+data    (gchtab(i), i=1796,1800) /  5009,  4947,  4884,  4757,  4629/
+data    (gchtab(i), i=1801,1805) /  4436,  4305,  4238,  4096,   519/
+data    (gchtab(i), i=1806,1810) /  4744,  4875,  4942,  4946,  4884/
+data    (gchtab(i), i=1811,1815) /   533,  4500,  4369,  4302,  4096/
+data    (gchtab(i), i=1816,1820) /     0,  1109,  4565,  4372,  4241/
+data    (gchtab(i), i=1821,1825) /  4174,  4171,  4233,  4296,  4423/
+data    (gchtab(i), i=1826,1830) /  4551,  4744,  4875,  4942,  4945/
+data    (gchtab(i), i=1831,1835) /  4883,  4820,  4693,   469,  4436/
+data    (gchtab(i), i=1836,1840) /  4305,  4238,  4234,  4296,   455/
+data    (gchtab(i), i=1841,1845) /  4680,  4811,  4878,  4882,  4820/
+data    (gchtab(i), i=1846,1850) /   724,  5204,     0,   596,  4487/
+data    (gchtab(i), i=1851,1855) /   596,  4551,    18,  4244,  4437/
+data    (gchtab(i), i=1856,1860) /  5141,    18,  4243,  4436,  5140/
+data    (gchtab(i), i=1861,1865) /     0,    17,  4115,  4245,  4437/
+data    (gchtab(i), i=1866,1870) /  4500,  4498,  4364,  4361,  4487/
+data    (gchtab(i), i=1871,1875) /   277,  4436,  4434,  4300,  4297/
+data    (gchtab(i), i=1876,1880) /  4360,  4487,  4551,  4744,  4874/
+data    (gchtab(i), i=1881,1885) /  5005,  5072,  5075,  5013,  4948/
+data    (gchtab(i), i=1886,1890) /  5011,  5072,   909,  5075,     0/
+data    (gchtab(i), i=1891,1895) /    35,     0,   145,  4371,  4564/
+data    (gchtab(i), i=1896,1900) /  4501,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1901,1905) /  4232,  4295,  4423,  4552,  4683/
+data    (gchtab(i), i=1906,1910) /  4750,    75,  4233,  4296,  4424/
+data    (gchtab(i), i=1911,1915) /  4553,  4683,   590,  4683,  4744/
+data    (gchtab(i), i=1916,1920) /  4807,  4935,  5064,  5195,  5262/
+data    (gchtab(i), i=1921,1925) /  5265,  5204,  5141,  5076,  5203/
+data    (gchtab(i), i=1926,1930) /  5265,   587,  4745,  4808,  4936/
+data    (gchtab(i), i=1931,1935) /  5065,  5195,     0,   604,  4571/
+data    (gchtab(i), i=1936,1940) /  4506,  4505,  4568,  4759,  4951/
+data    (gchtab(i), i=1941,1945) /   663,  4502,  4373,  4307,  4305/
+data    (gchtab(i), i=1946,1950) /  4431,  4622,  4814,   663,  4566/
+data    (gchtab(i), i=1951,1955) /  4437,  4371,  4369,  4495,  4622/
+data    (gchtab(i), i=1956,1960) /   526,  4365,  4236,  4170,  4168/
+data    (gchtab(i), i=1961,1965) /  4294,  4612,  4675,  4673,  4544/
+data    (gchtab(i), i=1966,1970) /  4416,   526,  4429,  4300,  4234/
+data    (gchtab(i), i=1971,1975) /  4232,  4358,  4612,     0,   860/
+data    (gchtab(i), i=1976,1980) /  4544,   924,  4480,    17,  4115/
+data    (gchtab(i), i=1981,1985) /  4245,  4437,  4500,  4498,  4429/
+data    (gchtab(i), i=1986,1990) /  4426,  4552,  4744,  4873,  5068/
+data    (gchtab(i), i=1991,1995) /  5199,   277,  4436,  4434,  4365/
+data    (gchtab(i), i=1996,2000) /  4362,  4424,  4551,  4743,  4872/
+data    (gchtab(i), i=2001,2005) /  5002,  5133,  5199,  5333,     0/
+data    (gchtab(i), i=2006,2010) /   604,  4571,  4506,  4505,  4568/
+data    (gchtab(i), i=2011,2015) /  4759,  5079,  5080,  4887,  4629/
+data    (gchtab(i), i=2016,2020) /  4435,  4240,  4173,  4171,  4233/
+data    (gchtab(i), i=2021,2025) /  4423,  4613,  4675,  4673,  4608/
+data    (gchtab(i), i=2026,2030) /  4480,  4417,   662,  4499,  4304/
+data    (gchtab(i), i=2031,2035) /  4237,  4235,  4297,  4423,     0/
+data    (gchtab(i), i=2036,2040) /   480,  4447,  4382,  4316,  4314/
+data    (gchtab(i), i=2041,2045) /  4376,  4439,  4501,  4499,  4369/
+data    (gchtab(i), i=2046,2050) /   351,  4381,  4379,  4441,  4504/
+data    (gchtab(i), i=2051,2055) /  4566,  4564,  4498,  4240,  4494/
+data    (gchtab(i), i=2056,2060) /  4556,  4554,  4488,  4423,  4357/
+data    (gchtab(i), i=2061,2065) /  4355,  4417,   271,  4493,  4491/
+data    (gchtab(i), i=2066,2070) /  4425,  4360,  4294,  4292,  4354/
+data    (gchtab(i), i=2071,2075) /  4417,  4544,     0,   160,  4224/
+data    (gchtab(i), i=2076,2080) /   544,  4608,     0,   224,  4447/
+data    (gchtab(i), i=2081,2085) /  4510,  4572,  4570,  4504,  4439/
+data    (gchtab(i), i=2086,2090) /  4373,  4371,  4497,   351,  4509/
+data    (gchtab(i), i=2091,2095) /  4507,  4441,  4376,  4310,  4308/
+data    (gchtab(i), i=2096,2100) /  4370,  4624,  4366,  4300,  4298/
+data    (gchtab(i), i=2101,2105) /  4360,  4423,  4485,  4483,  4417/
+data    (gchtab(i), i=2106,2110) /   399,  4365,  4363,  4425,  4488/
+data    (gchtab(i), i=2111,2115) /  4550,  4548,  4482,  4417,  4288/
+data    (gchtab(i), i=2116,2120) /     0,   338,  4240,  4430,   533/
+data    (gchtab(i), i=2121,2125) /  4304,  4619,   208,  5392,     0/
+data    (gchtab(i), i=2126,2130) /   284,  4251,  4185,  4183,  4245/
+data    (gchtab(i), i=2131,2135) /  4372,  4500,  4629,  4695,  4697/
+data    (gchtab(i), i=2136,2139) /  4635,  4508,  4380,     0/
diff --git a/sys/gio/fonts/greekc.txt b/sys/gio/fonts/greekc.txt
new file mode 100644
index 00000000..3dbbf454
--- /dev/null
+++ b/sys/gio/fonts/greekc.txt
@@ -0,0 +1,96 @@
+2199
+2214
+2213
+2275
+2274
+2271
+2272
+2251
+2221
+2222
+8004
+8002
+8063
+8003
+2210
+8089
+2200
+2201
+2202
+2203
+2204
+2205
+2206
+2207
+2208
+2209
+8081
+2213
+8007
+8033
+8008
+8032
+2273
+2078
+8064
+2199
+2030
+8073
+2047
+2029
+733
+8090
+8079
+2199
+2037
+8075
+8077
+2041
+2042
+2034
+2271
+2044
+8090
+2046
+2078
+2050
+2040
+2049
+2199
+2223
+804
+2224
+2199
+8074
+8067
+2127
+2128
+2148
+2130
+2131
+2147
+2129
+2133
+2135
+8078
+2136
+2137
+2138
+2139
+2141
+2142
+2134
+2143
+2144
+2145
+2146
+2199
+2150
+2140
+2149
+2132
+2225
+8090
+2226
+8076
+2218
diff --git a/sys/gio/fonts/mkfont.c b/sys/gio/fonts/mkfont.c
new file mode 100644
index 00000000..841d99f5
--- /dev/null
+++ b/sys/gio/fonts/mkfont.c
@@ -0,0 +1,199 @@
+#include <stdio.h>
+
+#define	DEBUG		0
+#define	MASK		0x3F
+#define	SCALE		1.0
+
+#define max(a,b)		(a > b ? a : b)
+#define min(a,b)		(a < b ? a : b)
+/*
+#define	XCOORD()		((*dp - 'R') + 9)
+#define	YCOORD()		(('R' - *dp) + 14)
+#define	XCOORD()	(max(0,min(20,((int)(((*dp - 'R') + 9)*SCALE+0.5)))))
+#define	XCOORD()	(max(0,min(20,((int)(((*dp - 'R') - minx)*SCALE+0.5)))))
+#define	YCOORD()	((int)((('R' - *dp) + 13) * SCALE + 0.5))
+#define	XCOORD()	((int)(((*dp - 'R') - minx) * SCALE + 0.5))
+#define	YCOORD()	(max(0,min(32,(((int)(('R' - *dp) + 13)*SCALE+0.5)))))
+*/
+#define	XCOORD()	(max(0,((int)(((*dp - 'R') - minx - 2) * SCALE + 0.5))))
+#define	YCOORD()	(max(0,min(35,(((int)(('R' - *dp) + 16)*SCALE+0.5)))))
+#define ENCODE(pen,x,y) ((int)(((pen<<12)|((x&MASK)<<6))|(y&MASK)))
+
+int 	chridx[200];		/* Character index table	*/
+int 	chrwid[200];		/* Character width table	*/
+int 	chrtab[5000];		/* Character stroke table	*/
+
+
+struct hershey_tab {
+    int   num;                  /* hershey number       */
+    int   length;               /* length               */
+    char  *code;                /* stroke data string   */
+} htab[] = {
+#include "hershey.dat"
+};
+
+int	encode();
+
+
+main (argc, argv)
+int	argc;
+char 	*argv[];
+{
+	register int i=0;
+	int	minx, maxx, charnum=0, idx=0, hnum, hindex, hlength;
+	short	x, y, pen, xspace, yspace;
+	char 	ch, *dp, *data;
+
+	/* Read all the hershey numbers from standard input and build up a
+	 * table of stroke data.
+	 */
+	ch = 32;
+	while (scanf ("%d", &hnum) != EOF) {
+
+	    chridx[charnum] = idx + 1;
+
+	    /* Get the index for the given number. */
+	    for (hindex=0; hnum != htab[hindex].num; hindex++)
+		;
+
+	    hlength = htab[hindex].length;
+	    dp = data = htab[hindex].code;
+
+	    if (DEBUG)
+		printf ("'%c' %4d: index=%4d len=%3d dlen=%3d %s\n",
+		    ch, hnum, hindex, hlength, strlen(data),
+		    (strlen(data) % 2) ? "ERROR" : "");
+
+	    /* Now decode the stroke data into X-Y pairs, first pair is for
+	     * proportional spacing.
+	     */
+	    minx = (*dp - 'R'); dp++;
+	    maxx = (*dp - 'R'); dp++;
+	    chrwid[charnum++] = min (32, maxx - minx + 5);
+
+	    if (DEBUG) printf("\twidth (%02d) (%d,%d)\n", maxx-minx,minx,maxx);
+
+	    /* Next pair is the initial move.  The Y coords are flipped
+	     * for what we need so fix that every place we get a Yval.
+	     */
+	    pen = 0;
+	    x = XCOORD(); dp++;
+x = (ch == '1' ? x-3: x);
+	    y = YCOORD(); dp++;
+	    chrtab[idx++] = ENCODE(pen, x, y);
+
+	    if (DEBUG) printf ("\tmove (%3d,%3d) '%s'\n", x, y, dp);
+
+	    /* The remainder of the codes are move/draw strokes.
+	     */
+	    for (i=0; i < (hlength-2); i++) {
+		if (*dp == ' ') {
+		    pen = 0;
+		    x = XCOORD(); dp++;	/* skip pen-up coords */
+x = (ch == '1' ? x-3: x);
+		    y = YCOORD(); dp++;
+		    i++;
+		} else
+		    pen = 1;
+		x = XCOORD(); dp++;
+x = (ch == '1' ? x-3: x);
+		y = YCOORD(); dp++;
+
+		chrtab[idx++] = ENCODE(pen, x, y);
+
+	        if (DEBUG) 
+		    printf("\t%s (%3d,%3d) => %6d\n",
+			pen?"draw":"move", x, y, ENCODE(pen,x,y));
+	    }
+	    chrtab[idx++] = ENCODE(0, 0, 0);
+	    ch++;
+	}
+
+	print_prologue (charnum, idx);
+	print_index (chridx, charnum);
+	printf ("\n\n# Width data.\n\n");
+	print_widths (chrwid, charnum);
+	printf ("\n\n# Stroke data.\n\n");
+	print_strokes (chrtab, idx);
+}
+
+
+print_index (idxtab, N)
+int	*idxtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chridx(i), i=%03d,%03d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%5d%c", idxtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_widths (wtab, N)
+int	*wtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chrwid(i), i=%03d,%03d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%5d%c", wtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_strokes (strtab, N)
+int	*strtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chrtab(i), i=%04d,%04d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%6d%c", strtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_prologue(nidx, nchar)
+int	nidx;
+int	nchar;
+{
+
+printf ("# CHRTAB -- Table of strokes for the printable ASCII characters.  Each\n");
+printf ("# character is encoded as a series of strokes.  Each stroke is ex-\n");
+printf ("# pressed by a single integer containing the following bitfields:\n");
+printf ("#\n");
+printf ("#       2                   1\n");
+printf ("#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1\n");
+printf ("#                 | | | |         | |         |\n");
+printf ("#                 | | | +---------+ +---------+\n");
+printf ("#                 | | |      |           |\n");
+printf ("#                 | | |      X           Y\n");
+printf ("#                 | | |\n");
+printf ("#                 | | +-- pen up/down\n");
+printf ("#                 | +---- begin paint (not used at present)\n");
+printf ("#                 +------ end paint (not used at present)\n");
+printf ("#\n");
+printf ("#----------------------------------------------------------------------------\n");
+printf ("\n");
+printf ("# Define the database.\n");
+printf ("\n");
+printf ("short   chridx[%d]\t# character index in chrtab\n", nidx+1);
+printf ("short   chrwid[%d]\t# character width table\n", nidx+1);
+printf ("short   chrtab[%d]\t# stroke data to draw the characters\n", nchar+1);
+printf ("\n");
+printf ("# Index into CHRTAB of each printable character (starting with SP)\n");
+printf ("\n");
+}
diff --git a/sys/gio/fpequald.x b/sys/gio/fpequald.x
new file mode 100644
index 00000000..ba6f75a2
--- /dev/null
+++ b/sys/gio/fpequald.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_EQUALD -- The following procedure is used to compare two double precision
+# numbers for equality to within the machine precision for doubles.  A simple
+# comparison of the difference of the two numbers with the machine epsilon
+# does not suffice unless the numbers are first normalized to near 1.0, the
+# constant used to compute the machine epsilon (epsilon is the smallest number
+# such that 1.0 + epsilon > 1.0).
+
+bool procedure fp_equald (x, y)
+
+double	x, y
+double	x1, x2, normx, normy, tol
+int	ex, ey
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normd (x, normx, ex)
+	call fp_normd (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILOND * 32.0D0
+	    x1 = 1.0D0 + abs (normx - normy)
+	    x2 = 1.0D0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/gio/fpequalr.x b/sys/gio/fpequalr.x
new file mode 100644
index 00000000..8e9a9354
--- /dev/null
+++ b/sys/gio/fpequalr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_EQUALR -- The following procedure is used to compare two single precision
+# numbers for equality to within the machine precision for single.  A simple
+# comparison of the difference of the two numbers with the machine epsilon
+# does not suffice unless the numbers are first normalized to near 1.0, the
+# constant used to compute the machine epsilon (epsilon is the smallest number
+# such that 1.0 + epsilon > 1.0).
+
+bool procedure fp_equalr (x, y)
+
+real	x, y
+real	x1, x2, normx, normy, tol
+int	ex, ey
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normr (x, normx, ex)
+	call fp_normr (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILONR * 32.0
+	    x1 = 1.0E0 + abs (normx - normy)
+	    x2 = 1.0E0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/gio/fpfixd.x b/sys/gio/fpfixd.x
new file mode 100644
index 00000000..64a2f544
--- /dev/null
+++ b/sys/gio/fpfixd.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_FIXD -- The following procedure is equivalent to "int(x)", except that
+# it preserves the most significant digits of x, when x is greater than the
+# largest integer.  For example, if an integer is 32 bits and X has a 58 bit
+# mantissa, "int(x)" would cause nearly half the precision to be lost.
+# 
+# Algorithm (x is assumed nonnegative):
+#    (1) find high, low x such that  x = highx + lowx
+#	and highx contains the extra digits of precision.
+#    (2) subtract highx from x, and truncate the residual by assignment
+#	into a long integer.
+#    (3) add truncated lowx and highx to get high precision truncated
+#	double result.
+
+double procedure fp_fixd (x)
+
+double	x
+double	absx, highx, scaledx
+int	expon
+long	longx, lowx
+
+begin
+	absx = abs (x)
+	scaledx = absx
+	expon = 0
+
+	while (scaledx > MAX_LONG) {
+	    scaledx = scaledx / 10.0D0
+	    expon = expon + 1
+	}
+
+	longx = scaledx
+	highx = longx * (10.0D0 ** expon)
+	lowx = absx - highx
+
+	if (x > 0)
+	    return (highx + lowx)
+	else
+	    return (-highx - lowx)
+end
diff --git a/sys/gio/fpfixr.x b/sys/gio/fpfixr.x
new file mode 100644
index 00000000..fe67c5b8
--- /dev/null
+++ b/sys/gio/fpfixr.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_FIXR -- The following procedure is equivalent to "int(x)", except that
+# it preserves the most significant digits of x, when x is greater than the
+# largest integer.  For example, if an integer is 32 bits and X has a 58 bit
+# mantissa, "int(x)" would cause nearly half the precision to be lost.
+# 
+# Algorithm (x is assumed nonnegative):
+#    (1) find high, low x such that  x = highx + lowx
+#	and highx contains the extra digits of precision.
+#    (2) subtract highx from x, and truncate the residual by assignment
+#	into a long integer.
+#    (3) add truncated lowx and highx to get high precision truncated
+#	real or double result.
+
+real procedure fp_fixr (x)
+
+real	x
+real	absx, highx, scaledx
+int	expon
+long	longx, lowx
+
+begin
+	absx = abs (x)
+	scaledx = absx
+	expon = 0
+
+	while (scaledx > MAX_LONG) {
+	    scaledx = scaledx / 10.0E0
+	    expon = expon + 1
+	}
+
+	longx = scaledx
+	highx = longx * (10.0E0 ** expon)
+	lowx = absx - highx
+
+	if (x > 0)
+	    return (highx + lowx)
+	else
+	    return (-highx - lowx)
+end
diff --git a/sys/gio/fpndgr.x b/sys/gio/fpndgr.x
new file mode 100644
index 00000000..ae471e34
--- /dev/null
+++ b/sys/gio/fpndgr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FP_NONDEGENR -- If two floating point numbers are equivalent to within the
+# machine epsilon, adjust their values until a nondegenerate range is obtained.
+# The boolean function returns true if it has to MAKE the range nondegenerate,
+# i.e., if it modifies their values.
+
+bool procedure fp_nondegenr (x1, x2)
+
+real	x1, x2			# range to be adjusted
+int	n
+bool	fp_equalr()
+
+begin
+	for (n=0;  fp_equalr(x1,x2);  n=n+1) {
+	    x1 = x1 - max (abs(x1) * 0.01, 0.01)
+	    x2 = x2 + max (abs(x2) * 0.01, 0.01)
+	}
+
+	return (n > 0)
+end
diff --git a/sys/gio/fpnormd.x b/sys/gio/fpnormd.x
new file mode 100644
index 00000000..067ef1e0
--- /dev/null
+++ b/sys/gio/fpnormd.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_NORMD -- Normalize a double precision number x to the value NORMX, in the
+# range [1-10).  EXPON is returned such that  x = normx * (10.0d0 ** expon).
+
+procedure fp_normd (x, normx, expon)
+
+double	x			# number to be normalized
+double	normx			# X normalized to the range 1-10 (output)
+int	expon			# exponent of normalized X
+double	absx, tol
+
+begin
+	tol = EPSILOND * 10.0D0
+	absx = abs (x)
+	expon = 0
+
+	if (absx > 0) {
+	    while (absx < (1.0D0 - tol)) {
+		absx = absx * 10.0D0
+		expon = expon - 1
+		if (absx == 0.0D0) {	# check for underflow to zero
+		    normx = 0
+		    expon = 0
+		    return
+		}
+	    }
+	    while (absx >= (10.0D0 + tol)) {
+		absx = absx / 10.0D0
+		expon = expon + 1
+	    }
+	}
+
+	if (x < 0)
+	    normx = -absx
+	else
+	    normx = absx
+end
diff --git a/sys/gio/fpnormr.x b/sys/gio/fpnormr.x
new file mode 100644
index 00000000..45ad3f2a
--- /dev/null
+++ b/sys/gio/fpnormr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_NORMR -- Normalize a single precision number x to the value NORMX, in the
+# range [1-10).  EXPON is returned such that  x = normx * (10.0E0 ** expon).
+
+procedure fp_normr (x, normx, expon)
+
+real	x			# number to be normalized
+real	normx			# X normalized to the range 1-10 (output)
+int	expon			# exponent of normalized X
+real	absx, tol
+
+begin
+	tol = EPSILONR * 10.0
+	absx = abs (x)
+	expon = 0
+
+	if (absx > 0) {
+	    while (absx < (1.0E0 - tol)) {
+		absx = absx * 10.0E0
+		expon = expon - 1
+		if (absx == 0.0) {	# check for underflow to zero
+		    normx = 0
+		    expon = 0
+		    return
+		}
+	    }
+	    while (absx >= (10.0E0 + tol)) {
+		absx = absx / 10.0E0
+		expon = expon + 1
+	    }
+	}
+
+	if (x < 0)
+	    normx = -absx
+	else
+	    normx = absx
+end
diff --git a/sys/gio/gactivate.x b/sys/gio/gactivate.x
new file mode 100644
index 00000000..6d3c8da7
--- /dev/null
+++ b/sys/gio/gactivate.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<fset.h>
+include <gset.h>
+include <gio.h>
+
+# GACTIVATE -- Perform the initial activation of the workstation, i.e.,
+# connect to the graphics kernel and issue the GKI_OPENWS instruction to
+# the kernel to physically open the workstation.
+
+procedure gactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# AW_ bit flags; zero if no flags
+
+int	junk, fd
+pointer	w, sp, devname
+
+extern	zardbf()
+int	fstati(), grdwcs(), and(), locpr()
+errchk	gki_openws, gki_getwcs, gki_reactivatews
+
+begin
+	# If WS has already been opened, just make sure it is activated.
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) == 0) {
+		call gki_reactivatews (GP_FD(gp), flags)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) + GF_WSACTIVE
+	    }
+	    return
+	}
+
+	call smark (sp)
+	call salloc (devname, SZ_PATHNAME, TY_CHAR)
+
+	fd = GP_FD(gp)
+
+	# Physically open and activate the workstation.  NOTE - the flags
+	# argument is currently ignored; this should be fixed at some point.
+	# The UI specification file name, if any, is passed as part of the
+	# logical device specification (a bit of a kludge, but it avoids
+	# changing the GKI datastream prototcol and hence obsoleting all the
+	# old graphics kernels).
+
+	if (GP_UIFNAME(gp) != EOS) {
+	    # gki_openws device = devname,uifname.
+	    call sprintf (Memc[devname], SZ_PATHNAME, "%s,%s")
+		call pargstr (GP_DEVNAME(gp))
+		call pargstr (GP_UIFNAME(gp))
+	} else
+	    call strcpy (GP_DEVNAME(gp), Memc[devname], SZ_PATHNAME)
+
+	call gki_openws (fd, Memc[devname], GP_ACMODE(gp))
+
+	# If the device is being opened in APPEND mode retrieve the WCS
+	# from either the GIO code in the CL process (if talking to a
+	# process the FIO driver will not be the standard binary file
+	# driver) or from an auxiliary file if the device output is being
+	# spooled in a metafile.
+
+	if (GP_ACMODE(gp) == APPEND) {
+	    w = GP_WCSPTR(gp,1)
+	    if (fstati (fd, F_DEVICE) != locpr (zardbf))
+		call gki_getwcs (fd, Memi[w], LEN_WCSARRAY)
+	    else iferr (junk = grdwcs(GP_DEVNAME(gp), Memi[w], LEN_WCSARRAY))
+		;
+	}
+
+	GP_GFLAGS(gp) = GP_GFLAGS(gp) + (GF_WSOPEN+GF_WSACTIVE)
+	call sfree (sp)
+end
diff --git a/sys/gio/gadraw.x b/sys/gio/gadraw.x
new file mode 100644
index 00000000..4d8ac8b8
--- /dev/null
+++ b/sys/gio/gadraw.x
@@ -0,0 +1,284 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+define	MOVE		0
+define	DRAW		1
+
+# GADRAW -- Draw absolute.  This is the primary line drawing primitive, used
+# to transform and clip polylines, polymarkers, and polygons (fill area).
+# Our function is to handle INDEFS, the normalization transformation, and
+# clipping, building up a polyline in GKI coordinates.  Each call processes
+# a point of the input polyline, adding zero, one, or two points to the output
+# clipped polyline, which is buffered internally in the static polyline buffer
+# PL.  Plotting an INDEF terminates the polyline and starts a new one, causing
+# a gap to appear in the plotted polyline.  Long polylines are broken up into
+# shorter polylines to simplify buffering.  The transformation parameters are
+# computed and cached in the GPL common for maximum efficiency.
+
+procedure gadraw (gp, wx, wy)
+
+pointer	gp			# graphics descriptor
+real	wx, wy			# absolute world coordinates of next point
+
+int	i
+real	x, y
+long	mx, my
+bool	inbounds
+include	"gpl.com"
+
+begin
+	# Update cached transformation parameters if device changes or cache
+	# is invalidated by setting gp_out to null.  If the WCS changes it
+	# is not necessary to flush the polyline but we must update the
+	# cached transformation parameters.
+
+	if (gp != gp_out) {
+	    call gpl_flush()
+	    call gpl_cache (gp)
+	} else if (GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Break polyline (visible break in the plotted line) if point is
+	# indefinite.
+
+	if (IS_INDEFR(wx) || IS_INDEFR(wy)) {
+	    call gamove (gp, wx, wy)
+	    return
+	}
+
+	# Transform point (wx,wy) to long integer NDC coordinates in the range
+	# 0 to GKI_MAXNDC.  This combines the WCS->NDC->GKI transformations into
+	# a single transformation and permits use of integer arithmetic for
+	# clipping.  Long integer arithmetic is necessary to provide sufficient
+	# precision to represent GKI_MAXNDC**2, the largest possible integer
+	# value in an expression.
+
+	if (xtran == LINEAR && ytran == LINEAR) {
+	    # Optimize the case linear.
+            x = max (0.0, min (real(GKI_MAXNDC),
+                ((wx - wxorigin) * xscale) + mxorigin))
+            y = max (0.0, min (real(GKI_MAXNDC),
+                ((wy - wyorigin) * yscale) + myorigin))
+	} else {
+	    # General case.
+	    call gpl_wcstogki (gp, wx, wy, x, y)
+	}
+
+	# Check to see if this is the first point of a new polyline.  If so we
+	# must set the first physical point in the output polyline to the
+	# current position, making the current point the second physical point
+	# of the output polyline.  If the current position is indefinite
+	# then we take the current point to define the current position and
+	# it is put into the polyline on the next call.
+
+	if (op == 1) {
+	    if (IS_INDEF(cx) || IS_INDEF(cy)) {
+		cx = x
+		cy = y
+		return
+
+	    } else {
+		# Place the current pen position in the polyline as the
+		# first point if it is inbounds.
+
+		mx = cx
+		my = cy
+		if (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1) {
+		    last_point_inbounds = true
+		    pl[op] = mx
+		    op = op + 1
+		    pl[op] = my
+		    op = op + 1
+		} else {
+		    last_point_inbounds = false
+		    do i = 1, 4 {
+			xs[i] = cx
+			ys[i] = cy
+		    }
+		}
+	    }
+	}
+
+	# Update the current position, maintained in GKI coordinates to make
+	# the current position invariant with respect to changes in the
+	# current WCS.  The current position is maintained in floating point
+	# to minimize the accumulation of errors in relative moves and draws.
+
+	cx = x
+	cy = y
+
+	# Convert to long integer metacode coords for clipping.
+
+	mx = x
+	my = y
+
+	# Clip at either the viewport boundary or the edge of the device screen,
+	# if clipping is "disabled".  Clipping is performed in NDC space rather
+	# than world space because NDC space is simpler (mx1 < mx2, my1 < my2,
+	# no log scaling), and because we need to clip at the device screen
+	# boundary anyhow.  If the boundary is crossed the polyline is broken.
+	# A line segment may lie entirely outside the viewport, entirely inside,
+	# may cross from inside to outside, from outside to inside, or may
+	# cross twice (cross two different boundaries).  The clipping algorithm
+	# used (Harrington, 1983; Sutherland and Hodgman, 1974) clips at each
+	# of the four boundaries in sequence, using the clipped point from the
+	# previous iteration as input to the next.  It isn't simple but neither
+	# is the problem.  The code is optimized for the usual inbounds case.
+	# Clipped points are discarded.
+
+	inbounds = (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1)
+
+	if (inbounds && (last_point_inbounds || pl_pointmode == YES)) {
+	    # Add point to polyline (the fast way).
+	    pl[op] = mx
+	    op = op + 1
+	    pl[op] = my
+	    op = op + 1
+
+	} else if (pl_pointmode == NO)  {
+	    if (last_point_inbounds) {
+		# Update coords of last point drawn (necessary since we did
+		# not use the clipping code for inbounds points).
+		do i = 1, 4 {
+		    xs[i] = pl[op-2]
+		    ys[i] = pl[op-1]
+		}
+	    }
+	    call gpl_clipl (DRAW, mx, my)
+	}
+
+	last_point_inbounds = inbounds
+
+	# Break long polylines to avoid overflowing the polyline output
+	# buffer.  The output buffer contains two cells for each output
+	# point (x,y pair).  There must be space for at least two points
+	# (four cells) left in the buffer, since a single clip operation
+	# can add up to two points to the polyline.  OP points to the next
+	# available cell.
+
+	if (op > LEN_PLBUF - 2)
+	    call gpl_flush()
+end
+
+
+# GPL_CLIPL -- Clip at left boundary.
+
+procedure gpl_clipl (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx >= mx1 && xs[1] < mx1) || (mx <= mx1 && xs[1] > mx1)) {
+	    if (mx >= mx1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipr (newpen, mx1,
+		(my - ys[1]) * (mx1 - mx) / (mx - xs[1]) + my)
+	}
+
+	xs[1] = mx
+	ys[1] = my
+
+	if (mx >= mx1)
+	    call gpl_clipr (pen, mx, my)
+end
+
+
+# GPL_CLIPR -- Clip at right boundary.
+
+procedure gpl_clipr (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx <= mx2 && xs[2] > mx2) || (mx >= mx2 && xs[2] < mx2)) {
+	    if (mx <= mx2)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipb (newpen, mx2,
+		(my - ys[2]) * (mx2 - mx) / (mx - xs[2]) + my)
+	}
+
+	xs[2] = mx
+	ys[2] = my
+
+	if (mx <= mx2)
+	    call gpl_clipb (pen, mx, my)
+end
+
+
+# GPL_CLIPB -- Clip at bottom boundary.
+
+procedure gpl_clipb (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((my >= my1 && ys[3] < my1) || (my <= my1 && ys[3] > my1)) {
+	    if (my >= my1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipt (newpen, 
+		(mx - xs[3]) * (my1 - my) / (my - ys[3]) + mx, my1)
+	}
+
+	xs[3] = mx
+	ys[3] = my
+
+	if (my >= my1)
+	    call gpl_clipt (pen, mx, my)
+end
+
+
+# GPL_CLIPT -- Clip at top boundary and put the final clipped point(s) in
+# the output polyline.  Note that a "move" at this level does not affect
+# the current position (cx,cy), since the vector endpoints have been clipped
+# and the current position vector follows the unclipped vector points input
+# by the user.
+
+procedure gpl_clipt (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((my <= my2 && ys[4] > my2) || (my >= my2 && ys[4] < my2)) {
+	    if (my <= my2 || pen == MOVE)
+		call gpl_flush()
+	    pl[op] = (mx - xs[4]) * (my2 - my) / (my - ys[4]) + mx
+	    op = op + 1
+	    pl[op] = my2
+	    op = op + 1
+	}
+
+	xs[4] = mx
+	ys[4] = my
+
+	if (my <= my2) {
+	    if (pen == MOVE)
+		call gpl_flush()
+	    pl[op] = mx
+	    op = op + 1
+	    pl[op] = my
+	    op = op + 1
+	}
+end
diff --git a/sys/gio/gamove.x b/sys/gio/gamove.x
new file mode 100644
index 00000000..7c40d1b7
--- /dev/null
+++ b/sys/gio/gamove.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GAMOVE -- Absolute move.  Move the pen to the indicated position in
+# preparation for a draw.
+
+procedure gamove (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# new position of pen
+include	"gpl.com"
+
+begin
+	if (op > 1)
+	    call gpl_flush()
+
+	if (IS_INDEF(x) || IS_INDEF(y)) {
+	    # Set current position to indefinite.
+	    cx = INDEF
+	    cy = INDEF
+	} else {
+	    # Set current position to (x,y) in GKI coordinates.
+	    call gpl_wcstogki (gp, x, y, cx, cy)
+	}
+end
diff --git a/sys/gio/gascale.x b/sys/gio/gascale.x
new file mode 100644
index 00000000..f2b29926
--- /dev/null
+++ b/sys/gio/gascale.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+
+# GASCALE -- Scale the world coordinates of either the X or Y axis to fit the
+# data vector.  This is done by setting the WCS limits to the minimum and
+# maximum pixel values of the data vector.  The original WCS limits are
+# overwritten.
+
+procedure gascale (gp, v, npts, axis)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# length of data vector
+int	axis			# asis to be scaled (1=X, 2=Y)
+
+int	start, i
+real	minval, maxval, pixval
+pointer	w
+
+begin
+	# Find first definite valued pixel.  If entire data vector is
+	# indefinite we cannot perform our function and must abort.
+
+	for (start=1;  start <= npts;  start=start+1)
+	    if (!IS_INDEF (v[start]))
+		break
+	if (start > npts)
+	    call syserr (SYS_GINDEF)
+
+	minval = v[start]
+	maxval = minval
+
+	# Compute min and max values of data vector.
+	do i = start+1, npts {
+	    pixval = v[i]
+	    if (!IS_INDEF(pixval))
+		if (pixval < minval)
+		    minval = pixval
+		else if (pixval > maxval)
+		    maxval = pixval
+	}
+
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Set the window limits.
+	switch (axis) {
+	case 1:
+	    WCS_WX1(w) = minval
+	    WCS_WX2(w) = maxval
+	case 2:
+	    WCS_WY1(w) = minval
+	    WCS_WY2(w) = maxval
+	default:
+	    call syserr (SYS_GSCALE)
+	}
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gcancel.x b/sys/gio/gcancel.x
new file mode 100644
index 00000000..30e53ce5
--- /dev/null
+++ b/sys/gio/gcancel.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCANCEL -- Cancel any buffered graphics output (as far as possible).  Should
+# be called by interrupt handlers to avoid leaving GIO in a funny state
+# following an interrupt.
+#
+# As far as possible, GKI instructions are built up in internal storage and
+# written to the output file in a single write.  This decreases the likliehood
+# of leaving a botched instruction in the output stream in response to an
+# interrupt.  Do not call FSETI to cancel the file output because that will
+# almost certainly guarantee a botched instruction.  Instead, we discard any
+# partially built polylines still in GPL storage and append the GKI_CANCEL to
+# the output instruction stream.  The cancel instruction is passed on to the
+# graphics kernel which eventually calls FSETI to cancel its output file
+# buffer (containing device instructions).  If a metacode reader does detect
+# a botched instruction it will scan forward for the next BOI to try to resync
+# the instruction stream.
+
+procedure gcancel (gp)
+
+pointer	gp			# graphics descriptor
+int	and()
+
+begin
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gki_cancel (GP_FD(gp))
+	    call gki_fflush (GP_FD(gp))
+	}
+	call gfrinit (gp)
+end
diff --git a/sys/gio/gclear.x b/sys/gio/gclear.x
new file mode 100644
index 00000000..a3a5d895
--- /dev/null
+++ b/sys/gio/gclear.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gset.h>
+
+# GCLEAR -- Clear the screen and initialize all internal state variables to
+# the original GOPEN state.  Plots separated by calls to GCLEAR cannot affect
+# each other.  See also GFRAME and GRESET if a full state reset is not
+# desired.
+
+procedure gclear (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gactivate (gp, 0)
+	call gpl_flush()
+	call gki_clear (GP_FD(gp))
+	call greset (gp, GR_RESETALL)
+end
diff --git a/sys/gio/gclose.x b/sys/gio/gclose.x
new file mode 100644
index 00000000..a6802a0a
--- /dev/null
+++ b/sys/gio/gclose.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCLOSE -- Close a graphics stream previously opened with GOPEN.  Flush any
+# buffered polyline output, output the close worstation metacode instruction,
+# close the output stream, close the graphcap descriptor, and return all
+# buffer space.
+
+procedure gclose (gp)
+
+pointer	gp			# graphics descriptor
+
+int	fd
+int	and()
+
+begin
+	fd = GP_FD(gp)
+
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gflush (gp)
+	    call gki_closews (fd, GP_DEVNAME(gp))
+
+	    # If the output stream is a file rather than a standard graphics
+	    # stream, write a WCS savefile to permit restoration of the WCS if
+	    # the device is subsequently opened in APPEND mode.
+
+	    if (fd > STDPLOT)
+		call gwrwcs (GP_DEVNAME(gp),
+		    Memi[GP_WCSPTR(gp,1)], LEN_WCSARRAY)
+
+	    # If the output file was opened by GOPEN (as indicated by the
+	    # CLOSEFD flag), close the file.
+
+	    if (and (GP_GFLAGS(gp), GF_CLOSEFD) != 0)
+		call close (fd)
+	    else
+		call flush (fd)
+	}
+
+	call ttycdes (GP_TTY(gp))
+	call mfree (gp, TY_STRUCT)
+	call gki_redir (fd, NULL, NULL, NULL)
+	call gexfls_clear (fd)
+end
diff --git a/sys/gio/gctran.x b/sys/gio/gctran.x
new file mode 100644
index 00000000..3c804dc8
--- /dev/null
+++ b/sys/gio/gctran.x
@@ -0,0 +1,138 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCTRAN -- Transform a point in world coordinate system WCS_A to world
+# coordinate system WCS_B.  The transformation is performed by transforming
+# from WCS_A to NDC, followed by a transformation from NDC to WCS_B.  The
+# transformation parameters are cached for efficiency when transforming
+# multiple points in the same pairs of coordinate systems.  Three types of
+# transformations are supported: linear, log, and "elog".  The latter is
+# a logarithmic function defined for all X, i.e., for negative as well as
+# positive X.
+
+procedure gctran (gp, x1,y1, x2,y2, wcs_a, wcs_b)
+
+pointer	gp			# graphics descriptor
+real	x1, y1			# coords of point in WCS_A (input)
+real	x2, y2			# coords of point in WCS_B (output)
+int	wcs_a			# input WCS
+int	wcs_b			# output WCS
+
+int	w, a
+int	wcsord, tran[2,2], wcs[2]
+real	morigin[2,2], worigin[2,2], scale[2,2], ds
+real	w1[2,2], w2[2,2], s1[2,2], s2[2,2], p1[2], p2[2]
+pointer	wp
+
+bool	fp_nondegenr()
+real	elogr(), aelogr()
+
+begin
+	# Verify that the WCS has not changed since we were last called.
+	# WCSORD is a unique integer (ordinal) assigned by GIO each time a
+	# WCS is fixed.
+
+	if (GP_WCSSTATE(gp) != FIXED || GP_WCSORD(gp) != wcsord)
+	    wcs[1] = -1
+
+	# Verify that cached transformation parameters are up to date, and if
+	# not, recompute them.
+
+	if (wcs[1] != wcs_a || wcs[2] != wcs_b) {
+	    wcsord = GP_WCSORD(gp)
+	    wcs[1] = wcs_a
+	    wcs[2] = wcs_b
+
+	    # Copy the WCS parameters into 2-dim arrays so that we can use the
+	    # same code for both axes.
+
+	    do w = 1, 2 {
+		wp = GP_WCSPTR (gp, wcs[w])
+		tran[1,w] = WCS_XTRAN(wp)
+		tran[2,w] = WCS_YTRAN(wp)
+
+		# If the window is degenerate enlarge the window until there
+		# is enough range to make a plot.
+
+		if (fp_nondegenr (WCS_WX1(wp), WCS_WX2(wp)))
+		    GP_WCSSTATE(gp) = MODIFIED
+		if (fp_nondegenr (WCS_WY1(wp), WCS_WY2(wp)))
+		    GP_WCSSTATE(gp) = MODIFIED
+
+		w1[1,w] = WCS_WX1(wp)
+		w2[1,w] = WCS_WX2(wp)
+		w1[2,w] = WCS_WY1(wp)
+		w2[2,w] = WCS_WY2(wp)
+
+		s1[1,w] = WCS_SX1(wp)
+		s2[1,w] = WCS_SX2(wp)
+		s1[2,w] = WCS_SY1(wp)
+		s2[2,w] = WCS_SY2(wp)
+	    }
+
+	    # Compute the transformation parameters for both axes and both
+	    # world coordinate systems.
+
+	    do w = 1, 2				# w = wcs index
+		do a = 1, 2 {			# a = axis
+		    morigin[a,w] = s1[a,w]
+		    ds = s2[a,w] - s1[a,w]
+
+		    if (tran[a,w] == LINEAR) {
+			worigin[a,w] = w1[a,w]
+			scale[a,w] = ds / (w2[a,w] - w1[a,w])
+		    } else if (tran[a,w] == LOG && w1[a,w] > 0 && w2[a,w] > 0) {
+			worigin[a,w] = log10 (w1[a,w])
+			scale[a,w] = ds / (log10(w2[a,w]) - worigin[a,w])
+		    } else {
+			worigin[a,w] = elogr (w1[a,w])
+			scale[a,w] = ds / (elogr(w2[a,w]) - worigin[a,w])
+		    }
+		}
+	}
+
+	p1[1] = x1
+	p1[2] = y1
+
+	# Forward Transformation.  Transform P1 (point-A) in wcs_a to NDC
+	# coordinates, if the input WCS is not number zero (the NDC coordinate
+	# system).
+
+	if (wcs_a != 0)
+	    do a = 1, 2 {
+		if (tran[a,1] != LINEAR)
+		    if (tran[a,1] == LOG) {
+			if (p1[a] <= 0)
+			    p1[a] = INDEF
+			else
+			    p1[a] = log10 (p1[a])
+		    } else
+			p1[a] = elogr (p1[a])
+		p1[a] = ((p1[a] - worigin[a,1]) * scale[a,1]) + morigin[a,1]
+	    }
+
+	# Inverse Transformation.  Transform point P1, now in NDC coordinates,
+	# to WCS-B.  If WCS-B is zero (NDC), we need only copy the points.
+
+	if (wcs_b == 0) {
+	    p2[1] = p1[1]
+	    p2[2] = p1[2]
+	} else {
+	    do a = 1, 2 {
+		if (IS_INDEF (p1[a]))
+		    p2[a] = INDEF
+		else {
+		    p2[a] = (p1[a] - morigin[a,2]) / scale[a,2] + worigin[a,2]
+		    if (tran[a,2] != LINEAR)
+			if (tran[a,2] == LOG)
+			    p2[a] = 10.0 ** p2[a]
+			else
+			    p2[a] = aelogr (p2[a])
+		}
+	    }
+	}
+
+	x2 = p2[1]
+	y2 = p2[2]
+end
diff --git a/sys/gio/gcurpos.x b/sys/gio/gcurpos.x
new file mode 100644
index 00000000..a0d4cb4d
--- /dev/null
+++ b/sys/gio/gcurpos.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GCURPOS -- Get the current position in world coordinates.  The current
+# position is maintained internally in GKI coordinates to make it invariant
+# with respect to changes in the current WCS.
+
+procedure gcurpos (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# current position in current WCS (output)
+
+real	aelogr()
+include	"gpl.com"
+
+begin
+	if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	if (IS_INDEF(cx) || IS_INDEF(cy)) {
+	    x = INDEF
+	    y = INDEF
+
+	} else {
+	    x = (cx - mxorigin) / xscale + wxorigin
+	    if (xtran != LINEAR)
+		if (xtran == LOG)
+		    x = 10.0 ** x
+		else
+		    x = aelogr (x)
+
+	    y = (cy - myorigin) / yscale + wyorigin
+	    if (ytran != LINEAR)
+		if (ytran == LOG)
+		    y = 10.0 ** y
+		else
+		    y = aelogr (y)
+	}
+end
diff --git a/sys/gio/gdeact.x b/sys/gio/gdeact.x
new file mode 100644
index 00000000..f61f4133
--- /dev/null
+++ b/sys/gio/gdeact.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gset.h>
+
+# GDEACTIVATE -- Deactivate the workstation, i.e., for an interactive device
+# (graphics terminal) restore the terminal to text mode.  This is similar to
+# closing the workstation will gclose, except that the graphics state is
+# retained and graphics i/o may be resumed following a subsequent call to
+# greactivate.  These calls are generally no-ops for noninteractive devices.
+
+procedure gdeactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# action flags
+
+int	and()
+errchk	gflush
+errchk	gki_deactivatews
+
+begin
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gflush (gp)
+	    call gki_deactivatews (GP_FD(gp), flags)
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) != 0)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) - GF_WSACTIVE
+	}
+end
diff --git a/sys/gio/gescape.x b/sys/gio/gescape.x
new file mode 100644
index 00000000..c6a1bf63
--- /dev/null
+++ b/sys/gio/gescape.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GESCAPE -- Pass a device dependent instruction on to the graphics kernel.
+# A unique function code should be assigned each escape function.  The graphics
+# kernel will ignore escapes with unrecognized function codes.
+
+procedure gescape (gp, fn, instruction, nwords)
+
+pointer	gp			# graphics descriptor
+int	fn			# function code (1 - 32767)
+short	instruction[ARB]	# instruction to be transmitted
+int	nwords			# length of instruction
+
+begin
+	call gpl_flush()
+	call gki_escape (GP_FD(gp), fn, instruction, nwords)
+end
diff --git a/sys/gio/gfill.x b/sys/gio/gfill.x
new file mode 100644
index 00000000..4db5d117
--- /dev/null
+++ b/sys/gio/gfill.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFILL -- Fill area.  Fill the area defined by the polygon (X[i],Y[i]) in the
+# indicated style.
+
+procedure gfill (gp, x, y, npts, style)
+
+pointer gp			# graphics descriptor
+real	x[ARB], y[ARB]		# polygon
+int	npts			# npts in polygon
+int	style			# style for area fill
+
+pointer	ap
+
+begin
+	call gpl_flush()
+
+	ap = GP_FAAP(gp)
+	if (style != FA_STYLE(ap) || FA_STATE(ap) != FIXED) {
+	    FA_STYLE(ap) = style
+	    call gki_faset (GP_FD(gp), ap)
+	    FA_STATE(ap) = FIXED
+	}
+
+	call gpl_settype (gp, FILLAREA)
+	call gpline (gp, x, y, npts)
+	call gpl_settype (gp, POLYLINE)
+end
diff --git a/sys/gio/gflush.x b/sys/gio/gflush.x
new file mode 100644
index 00000000..ef597da8
--- /dev/null
+++ b/sys/gio/gflush.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFLUSH -- Flush the graphics output.  A simple call to the FIO flush does not
+# suffice since the graphics data stream may be spread over three or more
+# processes.  Flush any buffered polyline output, append the GKI_FLUSH metacode
+# instruction, and flush the FIO buffered metacode output.  The other processes
+# will take similar actions upon receipt of the GKI_FLUSH instruction.
+
+procedure gflush (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gpl_flush()
+	call gki_flush (GP_FD(gp))
+end
diff --git a/sys/gio/gframe.x b/sys/gio/gframe.x
new file mode 100644
index 00000000..02a1e41e
--- /dev/null
+++ b/sys/gio/gframe.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFRAME -- Clear the screen, but do not modify the internal state of GIO,
+# other than to reset the WCS and attribute packet states to UNSET, to force
+# retranmission to the graphics kernel.
+
+procedure gframe (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gactivate (gp, 0)
+	call gpl_flush()
+	call gki_clear (GP_FD(gp))
+	call gfrinit (gp)
+end
diff --git a/sys/gio/gfrinit.x b/sys/gio/gfrinit.x
new file mode 100644
index 00000000..bf8181ed
--- /dev/null
+++ b/sys/gio/gfrinit.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFRINIT -- Initialize the internal state variables of GIO for a new frame.
+# The state of all the attribute packets is set to UNSET to force them to be
+# retransmitted to the graphics kernel when i/o occurs.
+
+procedure gfrinit (gp)
+
+pointer gp			# graphics descriptor
+pointer	ap
+
+begin
+	# Force retransmission of the WCS.
+	GP_WCSSTATE(gp) = UNSET
+
+	# Force retransmission of the attribute packets.
+	ap = GP_PLAP(gp);	PL_STATE(ap) = UNSET
+	ap = GP_PMAP(gp);	PM_STATE(ap) = UNSET
+	ap = GP_FAAP(gp);	FA_STATE(ap) = UNSET
+	ap = GP_TXAP(gp);	TX_STATE(ap) = UNSET
+	ap = GP_TXAPCUR(gp);	TX_STATE(ap) = UNSET
+
+	call gpl_reset()
+end
diff --git a/sys/gio/ggcell.x b/sys/gio/ggcell.x
new file mode 100644
index 00000000..1dfd7a40
--- /dev/null
+++ b/sys/gio/ggcell.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGCELL -- Get a cell array, i.e., a two dimensional array of pixels.  If the
+# resolution of the graphics device does not match that of the cell array the
+# kernel is expected to compute the coordinates of each cell array pixel in 
+# device coordinates and return the value of the nearest device pixel as the
+# cell array value.  This equates to either subsampling or block replication
+# depending on the relative scale of the two devices.  See put cell array for
+# additional information.
+
+procedure ggcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+pointer	gp			# device descriptor
+int	nx, ny			# size of pixel array
+short	m[nx,ny]		# pixels
+real	x1, y1			# lower left corner of input window
+real	x2, y2			# upper right corner of input window
+
+real	dy
+int	ly1, ly2, i
+int	sx1, sx2, sy1, sy2
+include	"gpl.com"
+
+begin
+	# Flush any buffered polyline output.  Make sure the wcs transformation
+	# in the cache is up to date.
+
+	if (op > 1)
+	    call gpl_flush()
+	else if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Transform cell window to GKI coordinates.  The coordinate
+	# transformation must be linear.
+
+	sx1 = (x1 - wxorigin) * xscale + mxorigin
+	sx2 = (x2 - wxorigin) * xscale + mxorigin
+	sy1 = (y1 - wyorigin) * yscale + myorigin
+	sy2 = (y2 - wyorigin) * yscale + myorigin
+
+	dy = real (sy2 - sy1) / ny	# height of a line in GKI coords
+
+	# Read the cell array into M, one line at a time.  Take care that the
+	# GKI integer value of ly1 of one line is the same as the ly2 value
+	# of the previous line, or there will be a blank line in the output
+	# image.
+
+	do i = 1, ny {
+	    ly1 = (i-1) * dy + sy1
+	    ly2 = (i  ) * dy + sy1
+	    call gki_getcellarray (GP_FD(gp), m[1,i], nx,1, sx1,ly1, sx2,ly2)
+	}
+end
diff --git a/sys/gio/ggcur.x b/sys/gio/ggcur.x
new file mode 100644
index 00000000..40da0a0f
--- /dev/null
+++ b/sys/gio/ggcur.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GGCUR -- Perform a graphics cursor read.  The current graphics cursor is
+# read and the cursor value is returned.  On output, CN is the cursor number
+# which was read, KEY is the key typed to terminate the cursor read, SX,SY
+# are the NDC screen coordinates of the cursor, RASTER is the raster number
+# or zero, and RX,RY are the raster-relative coordinates of the cursor.  If
+# the device does not support rasters or if the cursor is not in a rasters
+# when read, RASTER is zero on output and RX,RY are the same as SX,SY.
+
+int procedure ggcur (gp, cn, key, sx, sy, raster, rx, ry)
+
+pointer gp			#I graphics descriptor
+int	cn			#O cursor which was read
+int	key			#O key typed or EOF
+real	sx, sy			#O screen position of cursor in NDC coordinates
+int	raster			#O raster number
+real	rx, ry			#O raster position of cursor in NDC coordinates
+
+int	m_sx, m_sy
+int	m_rx, m_ry
+
+begin
+	call gflush (gp)
+	call gki_getcursor (GP_FD(gp), GP_CURSOR(gp),
+	    cn, key, m_sx, m_sy, raster, m_rx, m_ry)
+
+	sx = real(m_sx) / GKI_MAXNDC
+	sy = real(m_sy) / GKI_MAXNDC
+	rx = real(m_rx) / GKI_MAXNDC
+	ry = real(m_ry) / GKI_MAXNDC
+
+	return (key)
+end
diff --git a/sys/gio/ggetb.x b/sys/gio/ggetb.x
new file mode 100644
index 00000000..790da996
--- /dev/null
+++ b/sys/gio/ggetb.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETB -- Get a boolean device parameter from the graphcap entry for the
+# device.  A boolean graphcap query tests if the named parameter exists.
+# Boolean queries are permitted for any capability, regardless of its actual
+# datatype.
+
+bool procedure ggetb (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+bool	ttygetb()
+
+begin
+	return (ttygetb (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggeti.x b/sys/gio/ggeti.x
new file mode 100644
index 00000000..31f81bb2
--- /dev/null
+++ b/sys/gio/ggeti.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETI -- Get the integer value of an device parameter from the graphcap
+# entry for the device.  Zero is returned if the device does not have the
+# named parameter.
+
+int procedure ggeti (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+int	ttygeti()
+
+begin
+	return (ttygeti (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggetr.x b/sys/gio/ggetr.x
new file mode 100644
index 00000000..b595793c
--- /dev/null
+++ b/sys/gio/ggetr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETR -- Get the real value of an device parameter from the graphcap entry
+# for the device.  Zero is returned if the device does not have the
+# named parameter.
+
+real procedure ggetr (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+real	ttygetr()
+
+begin
+	return (ttygetr (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggets.x b/sys/gio/ggets.x
new file mode 100644
index 00000000..d82c7090
--- /dev/null
+++ b/sys/gio/ggets.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETS -- Get the string value of a device parameter from the graphcap entry
+# for the device.  The null string is returned if no entry is found for the
+# named capability, or if the capability exists but the value field is null.
+# The value of any parameter may be returned as a string, regardless of its
+# datatype.  Escape sequences are converted to control codes in the output
+# string.
+
+int procedure ggets (gp, cap, outstr, maxch)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+char	outstr[ARB]		# output string
+int	maxch
+int	ttygets()
+
+begin
+	return (ttygets (GP_TTY(gp), cap, outstr, maxch))
+end
diff --git a/sys/gio/ggscale.x b/sys/gio/ggscale.x
new file mode 100644
index 00000000..76dffa2a
--- /dev/null
+++ b/sys/gio/ggscale.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGSCALE -- Get the WCS scale in world coords per NDC at the point (x,y).
+# Used to convert offsets or sizes in NDC coordinates into world coordinates,
+# and vice versa.  If log scaling is in use we can only locally approximate
+# the scale.
+
+procedure ggscale (gp, x, y, dx, dy)
+
+pointer	gp			# graphics descriptor
+real	x, y			# point for which scale is desired
+real	dx, dy			# scale wcs/nds (output)
+
+pointer	w
+real	x1, x2, y1, y2, xs, ys, elog_scale
+real	log10e, elogr()
+data	log10e /0.434294482/
+
+begin
+	w = GP_WCSPTR(gp,GP_WCS(gp))
+
+	x1 = WCS_WX1(w)
+	x2 = WCS_WX2(w)
+	y1 = WCS_WY1(w)
+	y2 = WCS_WY2(w)
+	xs = WCS_SX2(w) - WCS_SX1(w)
+	ys = WCS_SY2(w) - WCS_SY1(w)
+
+	switch (WCS_XTRAN(w)) {
+	case LOG:
+	    dx = (x / log10e) * log10 (x2 / x1) / xs
+	case ELOG:
+	    # The following is an approximation.
+	    elog_scale = (elogr(x2) - elogr(x1)) / xs
+	    if (x < 10.0)
+		dx = (-x / log10e) * elog_scale
+	    else if (x > 10.0)
+		dx = (x / log10e) * elog_scale
+	    else
+		dx = (10. / log10e) * elog_scale
+	default:
+	    # LINEAR
+	    dx = (x2 - x1) / xs
+	}
+
+	switch (WCS_YTRAN(w)) {
+	case LOG:
+	    dy = (y / log10e) * log10 (y2 / y1) / ys
+	case ELOG:
+	    # The following is an approximation.
+	    elog_scale = (elogr(y2) - elogr(y1)) / ys
+	    if (y < 10.0)
+		dy = (-y / log10e) * elog_scale
+	    else if (y > 10.0)
+		dy = (y / log10e) * elog_scale
+	    else
+		dy = (10. / log10e) * elog_scale
+	default:
+	    # LINEAR
+	    dy = (y2 - y1) / ys
+	}
+end
diff --git a/sys/gio/ggview.x b/sys/gio/ggview.x
new file mode 100644
index 00000000..486035b6
--- /dev/null
+++ b/sys/gio/ggview.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGVIEW -- Get the viewport of the current WCS.
+
+procedure ggview (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of NDC in X (output)
+real	y1, y2			# range of NDC in Y (output)
+pointer	w
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	x1 = WCS_SX1(w)
+	x2 = WCS_SX2(w)
+	y1 = WCS_SY1(w)
+	y2 = WCS_SY2(w)
+end
diff --git a/sys/gio/ggwind.x b/sys/gio/ggwind.x
new file mode 100644
index 00000000..4972fb75
--- /dev/null
+++ b/sys/gio/ggwind.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGWIND -- Get the window into world coordinates of the current WCS.
+
+procedure ggwind (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of world coords in X (output)
+real	y1, y2			# range of world coords in Y (output)
+pointer	w
+
+begin
+	call gactivate (gp, 0)
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	x1 = WCS_WX1(w)
+	x2 = WCS_WX2(w)
+	y1 = WCS_WY1(w)
+	y2 = WCS_WY2(w)
+end
diff --git a/sys/gio/gim/README b/sys/gio/gim/README
new file mode 100644
index 00000000..3c98b736
--- /dev/null
+++ b/sys/gio/gim/README
@@ -0,0 +1,215 @@
+GIM -- GIO graphics imaging library.  This is a developmental library based
+on GIO escapes, providing IRAF applications with access to the Gterm widget
+imaging functions.  This library is tied directly to the Gterm widget and is
+expected to be replaced by a more general imaging library in the future.
+
+This library is intended only for clients that need to directly access the
+imaging functions in the Gterm widget for full control over the imaging
+capabilities of the Gterm widget.  Applications which merely need to display
+an image as part of a more complex graphic would probably be better off
+using the more device independent gpcell (put cell-array) and gpcmap (put
+colormap) calls.
+
+
+The following functions are direct RPC calls to the corresponding Gt-prefixed
+imaging functions in the Gterm widget.
+
+            gim_rasterinit (gp)
+          gim_createraster (gp, raster, type, width, height, depth)
+         gim_destroyraster (gp, raster)
+  exists = gim_queryraster (gp, raster, type, width, height, depth)
+	     gim_setraster (gp, raster)		# see gseti(gp,G_RASTER,n)
+
+           gim_writepixels (gp, raster, data, nbits, x1, y1, nx, ny)
+            gim_readpixels (gp, raster, data, nbits, x1, y1, nx, ny)
+	    gim_refreshpix (gp, raster, ct, x1, y1, nx, ny)
+	     gim_setpixels (gp, raster, ct, x1, y1, nx, ny, color, rop)
+
+         gim_writecolormap (gp, colormap, first, nelem, r, g, b)
+  nelem = gim_readcolormap (gp, colormap, first, maxelem, r, g, b)
+          gim_loadcolormap (gp, colormap, offset, slope)
+          gim_freecolormap (gp, colormap)
+	    gim_iomapwrite (gp, iomap, first, nelem)
+	     gim_iomapread (gp, iomap, first, nelem)
+
+          gim_initmappings (gp)
+	   gim_freemapping (gp, mapping)
+            gim_copyraster (gp, rop, src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+            gim_setmapping (gp, mapping, rop, 
+				src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+   status = gim_getmapping (gp, mapping, rop,
+			        src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+         gim_enablemapping (gp, mapping, refresh)
+        gim_disablemapping (gp, mapping, erase)
+        gim_refreshmapping (gp, mapping)
+
+The following Gterm widget imaging functions have no analogue in the GIM
+imaging interface, but can be called from within GUI code.  These functions
+are not implemented at the GIM level either because they are not essential
+and would be too inefficient to be worth using via RPC, or because they
+access resources available only to GUI code.
+
+            GtAssignRaster (gt, raster, drawable)
+  pixmap = GtExtractPixmap (gt, src, ct, x, y, width, height)
+            GtInsertPixmap (gt, pixmap, dst, ct, x, y, width, height)
+   raster = GtSelectRaster (gt, dras, dt, dx, dy, rt, rx, ry, mapping)
+     raster = GtNextRaster (gt)
+      raster = GtGetRaster (gt)
+            n = GtNRasters (gt)
+  pixel = GtGetClientPixel (gt, gterm_pixel)
+   mapping = GtNextMapping (gt)
+  active = GtActiveMapping (gt, mapping)
+
+
+The following messaging routines are also defined by the GIO interface.
+These are used to set the values of UI parameters (i.e., send messages to
+the user interface).
+
+		      gmsg (gp, object, message)
+	    gmsg[bcsilrdx] (gp, object, value)
+		  gmprintf (gp, object, format)
+
+
+The imaging model of the Gterm widget defines the following key object or
+data types: rasters, mappings, and colors.
+
+    raster	A raster is a MxN array of pixels.  At present pixels are 8
+		bits deep but hooks are built in to the interface to expand
+		this in the future.  Pixel values are indices into the Gterm
+		virtual colormap, with values starting at zero.  A raster
+		may be any size.  A raster is merely a two-dimensional array
+		in the graphics server; it is not displayed unless mapped.
+		An exception is raster zero, which is the graphics window.
+		Rasters are referred to by number, starting with zero.
+		Initially only raster zero exists; new rasters are created
+		with gim_createraster.  Space for rasters may be allocated
+		either in the graphics server, or in the X server.  This has
+		implications on performance but is otherwise transparent to
+		the client.  By default rasters are allocated in the
+		graphics server, i.e., in the X client.
+
+    mapping	A mapping defines a projection of a rectangle of the source
+		raster onto a rectangle of the destination raster.  Mappings
+		may be either enabled (active) or disabled.  When a mapping
+		is enabled, any change to a pixel in the source rect will
+		cause the corresponding pixels in the destination rect to be
+		updated.  Mappings are referred to by number starting with
+		one.  Initially no mappings are defined.  If the size of the
+		input and output rect is not the same the input rect will be
+		scaled by pixel replication or subsampling to fill the
+		output rect.  If the argument DW or DH of the destination
+		rect is negative, the image will be flipped around the
+		corresponding axis when copied to the destination; the
+		region of the destination drawn into is the same in either
+		case.  Multiple mappings may reference the same source or
+		destination raster.  Mappings are refreshed in order by the
+		mapping number.  Modifying a mapping causes the changed
+		regions of the destination rect to be refreshed.
+
+    color	The gterm widget provides a fixed number of preassigned colors
+		corresponding to pixel values 0 through 9.  0 is the background
+		color, 1 is the foreground color, and 2-9 (8 colors) are
+		arbitrary colors defined by Gterm widget resources.  These
+		static colors are normally used to draw the background, frame,
+		axes, titles, etc. of a plot, or to draw color graphics within
+		the drawing area.  The advantage of static colors is that they
+		are shared with other X clients, and the values of these
+		colors may be assigned by the user to personalize the way
+		plots look.
+
+		The gterm widget also allows any number (up to about 200 or
+		so) additional colors to be defined at runtime by the client
+		application.  These color values start at pixel value 10 and
+		go up to the maximum pixel value assigned by the client.  The
+		client application allocates colors with gim_writecolormap.
+		Attempts to overwrite the values of the static colors are
+		ignored.  The values of already allocated colors may be
+		changed dynamically at runtime using gim_writecolormap to
+		write the desired range of color values.
+
+		Applications should not assume that there are 10 static
+		colors and 200 or so allocatable colors.  The graphcap entry
+		for the logical device in use defines these parameters for
+		the device.  Alternatively, the readcolormap call may be
+		used to dynamically determine how many colors the server has
+		preallocated when the application starts up.
+
+		An image may use either static and dyamic pixel values or
+		both types of values, but in most cases imaging applications
+		involve smoothly shaded surfaces hence will require
+		dyamically assigned private colors.
+
+		If for some reason the client application cannot use the
+		gterm widget color model, the IOMAP feature can be used to
+		make the widget appear to have some externally defined
+		(i.e., client defined) color model.
+
+
+The maximum number of rasters and maximum number of mappings is defined by
+Gterm widget resources (e.g. in the GUI file) when the graphics application
+starts up.  The maximum values should be much larger than most applications
+require.  Applications should allocate raster or mapping numbers
+sequentially starting at 1 (more or less) to avoid running out of raster or
+mapping descriptors.
+
+The {read|write}pixels routines in the GIM interface operate directly on
+raster pixels.  The mapping routines support two alternative coordinate
+systems, raster pixels and NDC (normalized device coordinates), as indicated
+by the ST or DT argument (source or destination coordinate type).  Note
+that the origin of the pixel coordinate system is the upper left corner of
+the display window (consistent with most graphics systems), whereas the origin
+of the NDC coordinate system is the lower left corner (consistent with IRAF).
+
+Pixel coordinates allow precise control of imaging but require the
+application to know the window size, and may result in complications e.g. if
+the window is resized.  NDC coordinates pretty much guarantee that a mapping
+will involve sampling, hence are not the most efficient, but the graphics
+will be drawn correctly no matter how the window is resized and for most
+applications the performance difference is negligible.  Most applications
+should use NDC coordinates for raster 0 (the display window), and pixel
+coordinates for rasters 1-N.
+
+Although the size of rasters 1 and higher are defined by the client
+application, the size of raster zero, the actual gterm display window, is
+subject to the constraints of the window system.  The client can attempt to
+reset the size of the gterm window using gim_createraster with raster=0,
+however the Gterm widget, UI containing the gterm widget, and the window
+manager are all free to deny such a request.  gim_queryraster should be
+called to determine the actual size of the window one will be drawing into.
+
+
+EXAMPLE
+
+    A simple example of an imaging application might download an image and
+display it in the gterm window, filling the window.  This could be done as
+follows (following a GOPEN and other GIO calls to prepare the drawing surface).
+
+	gim_createraster	Create raster 1 the size of the pixel array
+				to be displayed.  This need not be the same
+				as the size of the gterm display window.
+
+	gim_setmapping		Define a mapping between raster 1 and raster 0,
+				the display window, using NDC coordinates to
+				define the region of the display window to be
+				filled.  The mapping number is arbitrary but
+				mappings should normally be allocated starting
+				with 1.  The mapping is automatically enabled
+				when first defined.
+
+	gim_writecolormap	(Optional).  Define the pixel value to RGB
+				color assignments for the image pixels.
+
+	gim_writepixels		This routine is called one or more times to
+				write pixels into raster 1.  At most 32K
+				pixels (minus a bit for the GKI headers) can
+				be written in each call.  As each write is
+				made the affected region of the display
+				window will be updated.
+
+Alternatively, one could write the pixels and then define the mapping, to
+cause the entire image to be displayed at once.
+
+Note that the GIM calls can be combined with normal GIO graphics to draw text
+and graphics around or on top of an image region.  The order in which drawing
+operations occur is important, e.g., to draw graphics or text on top of an
+image the image should be drawn first.
diff --git a/sys/gio/gim/gimcpras.x b/sys/gio/gim/gimcpras.x
new file mode 100644
index 00000000..ea1ab32f
--- /dev/null
+++ b/sys/gio/gim/gimcpras.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_COPYRASTER -- Copy a portion of the source raster to a rectangular
+# region of the destination raster.
+
+procedure gim_copyraster (gp, rop, src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	rop			#I rasterop
+int	src			#I source raster
+int	st			#I coordinate type for source raster
+real	sx,sy,sw,sh		#I source rect
+int	dst			#I destination raster
+int	dt			#I coordinate type for destination raster
+real	dx,dy,dw,dh		#I destination rect
+
+short	gim[GIM_COPYRASTER_LEN]
+
+begin
+	gim[GIM_COPYRASTER_OP] = rop
+	gim[GIM_COPYRASTER_SR] = src
+	gim[GIM_COPYRASTER_ST] = st
+
+	if (st == CT_PIXEL) {
+	    gim[GIM_COPYRASTER_SX] = sx
+	    gim[GIM_COPYRASTER_SY] = sy
+	    gim[GIM_COPYRASTER_SW] = sw
+	    gim[GIM_COPYRASTER_SH] = sh
+	} else {
+	    gim[GIM_COPYRASTER_SX] = sx * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_SY] = sy * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_SW] = nint (sw * GKI_MAXNDC)
+	    gim[GIM_COPYRASTER_SH] = nint (sh * GKI_MAXNDC)
+	}
+
+	gim[GIM_COPYRASTER_DR] = dst
+	gim[GIM_COPYRASTER_DT] = dt
+
+	if (dt == CT_PIXEL) {
+	    gim[GIM_COPYRASTER_DX] = dx
+	    gim[GIM_COPYRASTER_DY] = dy
+	    gim[GIM_COPYRASTER_DW] = dw
+	    gim[GIM_COPYRASTER_DH] = dh
+	} else {
+	    gim[GIM_COPYRASTER_DX] = dx * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_DY] = dy * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_DW] = nint (dw * GKI_MAXNDC)
+	    gim[GIM_COPYRASTER_DH] = nint (dh * GKI_MAXNDC)
+	}
+
+	call gescape (gp, GIM_COPYRASTER, gim, GIM_COPYRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimcrras.x b/sys/gio/gim/gimcrras.x
new file mode 100644
index 00000000..9372f85f
--- /dev/null
+++ b/sys/gio/gim/gimcrras.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_CREATERASTER -- Create, recreate, or resize a raster.
+
+procedure gim_createraster (gp, raster, type, width, height, depth)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	type			#I raster type (normal,ximage,pixmap)
+int	width			#I raster width in pixels
+int	height			#I raster height in pixels
+int	depth			#I raster depth, bits per pixel
+
+short	gim[GIM_CREATERASTER_LEN]
+
+begin
+	gim[GIM_CREATERASTER_RN] = raster
+	gim[GIM_CREATERASTER_RT] = type
+	gim[GIM_CREATERASTER_NX] = width
+	gim[GIM_CREATERASTER_NY] = height
+	gim[GIM_CREATERASTER_BP] = depth
+
+	call gescape (gp, GIM_CREATERASTER, gim, GIM_CREATERASTER_LEN)
+end
diff --git a/sys/gio/gim/gimderas.x b/sys/gio/gim/gimderas.x
new file mode 100644
index 00000000..9a492759
--- /dev/null
+++ b/sys/gio/gim/gimderas.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_DESTROYRASTER -- Destroy a raster.
+
+procedure gim_destroyraster (gp, raster)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+
+short	gim[GIM_DESTROYRASTER_LEN]
+
+begin
+	gim[GIM_DESTROYRASTER_RN] = raster
+	call gescape (gp, GIM_DESTROYRASTER, gim, GIM_DESTROYRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimdsmap.x b/sys/gio/gim/gimdsmap.x
new file mode 100644
index 00000000..a1618413
--- /dev/null
+++ b/sys/gio/gim/gimdsmap.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_DISABLEMAPPING -- Disable a previously defined mapping.  Disabling a
+# mapping does not automatically erase the mapping unless the erase flag
+# is set.
+
+procedure gim_disablemapping (gp, mapping, erase)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	erase			#I erase flag
+
+short	gim[GIM_DISABLEMAPPING_LEN]
+
+begin
+	gim[GIM_DISABLEMAPPING_MP] = mapping
+	gim[GIM_DISABLEMAPPING_FL] = erase
+	call gescape (gp, GIM_DISABLEMAPPING, gim, GIM_DISABLEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimenmap.x b/sys/gio/gim/gimenmap.x
new file mode 100644
index 00000000..02e9af3b
--- /dev/null
+++ b/sys/gio/gim/gimenmap.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_ENABLEMAPPING -- Enable a previously defined mapping.  Enabling a 
+# mapping does not automatically refresh the destination unless the refresh
+# flag is set (refresh=YES).
+
+procedure gim_enablemapping (gp, mapping, refresh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	refresh			#I refresh flag
+
+short	gim[GIM_ENABLEMAPPING_LEN]
+
+begin
+	gim[GIM_ENABLEMAPPING_MP] = mapping
+	gim[GIM_ENABLEMAPPING_FL] = refresh
+	call gescape (gp, GIM_ENABLEMAPPING, gim, GIM_ENABLEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimfcmap.x b/sys/gio/gim/gimfcmap.x
new file mode 100644
index 00000000..9194e9bf
--- /dev/null
+++ b/sys/gio/gim/gimfcmap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_FREECOLORMAP -- Free a colormap.
+
+procedure gim_freecolormap (gp, colormap)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number
+
+short	gim[GIM_FREECMAP_LEN]
+
+begin
+	gim[GIM_FREECMAP_MP] = colormap
+	call gescape (gp, GIM_FREECMAP, gim, GIM_FREECMAP_LEN)
+end
diff --git a/sys/gio/gim/gimfmap.x b/sys/gio/gim/gimfmap.x
new file mode 100644
index 00000000..f69355a4
--- /dev/null
+++ b/sys/gio/gim/gimfmap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_FREEMAPPING -- Free a mapping.
+
+procedure gim_freemapping (gp, mapping)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping number
+
+short	gim[GIM_FREEMAPPING_LEN]
+
+begin
+	gim[GIM_FREEMAPPING_MP] = mapping
+	call gescape (gp, GIM_FREEMAPPING, gim, GIM_FREEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimgetmap.x b/sys/gio/gim/gimgetmap.x
new file mode 100644
index 00000000..c58bae0d
--- /dev/null
+++ b/sys/gio/gim/gimgetmap.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_GETMAPPING -- Get the parameters defining a mapping.  The function value
+# is YES if the mapping is defined and enabled and NO if the mapping is
+# defined but not enabled.  If the mapping is not defined ERR is returned.
+
+int procedure gim_getmapping (gp, mapping, rop,
+	src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be queried
+int	rop			#O rasterop
+int     src			#O source raster
+int     st			#O coordinate type for source raster
+int     sx,sy,sw,sh		#O source rect
+int     dst			#O destination raster
+int     dt			#O coordinate type for destination raster
+int     dx,dy,dw,dh		#O destination rect
+
+int	nchars, nread
+short	gim[GIM_GETMAPPING_LEN]
+short	retval[GIM_RET_GMAP_LEN]
+errchk	gescape, flush, read, syserrs
+int	read(), btoi()
+
+begin
+	call gpl_flush()
+	gim[GIM_GETMAPPING_MP] = mapping
+	call gescape (gp, GIM_GETMAPPING, gim, GIM_GETMAPPING_LEN)
+	call flush (GP_FD(gp))
+
+	# This assumes a normal stream type GKI connection.
+	nchars = GIM_RET_GMAP_LEN * SZ_SHORT
+	nread = read (GP_FD(gp), retval, nchars)
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (nread != nchars)
+	    call syserrs (SYS_FREAD, "gim_getmapping")
+
+	# EN=0 not defined, EN=1 defined not enabled, EN=2 defined enabled.
+	if (retval[GIM_RET_GMAP_EN] == 0)
+	    return (ERR)
+	else {
+	    rop = retval[GIM_RET_GMAP_OP]
+
+	    src = retval[GIM_RET_GMAP_SR]
+	    st  = retval[GIM_RET_GMAP_ST]
+
+	    if (st == CT_PIXEL) {
+		sx = retval[GIM_RET_GMAP_SX]
+		sy = retval[GIM_RET_GMAP_SY]
+		sw = retval[GIM_RET_GMAP_SW]
+		sh = retval[GIM_RET_GMAP_SH]
+	    } else {
+		sx = real (retval[GIM_RET_GMAP_SX]) / GKI_MAXNDC
+		sy = real (retval[GIM_RET_GMAP_SY]) / GKI_MAXNDC
+		sw = real (retval[GIM_RET_GMAP_SW]) / GKI_MAXNDC
+		sh = real (retval[GIM_RET_GMAP_SH]) / GKI_MAXNDC
+	    }
+
+	    dst = retval[GIM_RET_GMAP_SR]
+	    dt  = retval[GIM_RET_GMAP_DT]
+
+	    if (dt == CT_PIXEL) {
+		dx = retval[GIM_RET_GMAP_DX]
+		dy = retval[GIM_RET_GMAP_DY]
+		dw = retval[GIM_RET_GMAP_DW]
+		dh = retval[GIM_RET_GMAP_DH]
+	    } else {
+		dx = real (retval[GIM_RET_GMAP_DX]) / GKI_MAXNDC
+		dy = real (retval[GIM_RET_GMAP_DY]) / GKI_MAXNDC
+		dw = real (retval[GIM_RET_GMAP_DW]) / GKI_MAXNDC
+		dh = real (retval[GIM_RET_GMAP_DH]) / GKI_MAXNDC
+	    }
+
+	}
+
+	return (btoi (retval[GIM_RET_GMAP_EN] == 2))
+end
diff --git a/sys/gio/gim/gimimap.x b/sys/gio/gim/gimimap.x
new file mode 100644
index 00000000..2c4a5d28
--- /dev/null
+++ b/sys/gio/gim/gimimap.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_INITMAPPINGS -- Initialize the Gterm widget raster mappings.
+
+procedure gim_initmappings (gp)
+
+pointer	gp			#I graphics descriptor
+
+begin
+	call gescape (gp, GIM_INITMAPPINGS, 0, GIM_INITMAPPINGS_LEN)
+end
diff --git a/sys/gio/gim/gimlcmap.x b/sys/gio/gim/gimlcmap.x
new file mode 100644
index 00000000..afcd9045
--- /dev/null
+++ b/sys/gio/gim/gimlcmap.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<mach.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_LOADCOLORMAP -- Load a colormap into the display (hardware) colormap.
+# Any number of colormaps may be defined, but only one may be loaded at a
+# time.  A linear transformation may optionally be applied to the (normalized)
+# colormap when it is loaded.  Set offset=0.5, slope=1.0 to load the colormap
+# without scaling.  A negative slope inverts the image.
+#
+# The offset refers to the center of the mapped region of the transfer
+# function, which is why the center value is at 0.5.  For example, if the
+# range of raster pixel intensities is normalized to the range 0.0 to 1.0,
+# then a transfer function of [offset=0.3,slope=3.0] will display the region
+# of intenstities centered around the normalized intenstity of 0.3, with a
+# contrast of 3.0 (the screen intensity changes 3 units for a unit change in
+# raster pixel intensity).  The transfer function [offset=0.3,slope=-3.0]
+# will display the same range of pixel intensitites, but with a negative
+# contrast.  The transfer function [offset=0.5,slope=1.0] has intercepts
+# of [0,0] and [1,1] hence it displays the full range of raster pixel
+# intensities - the input colormap is used as is, without resampling.
+
+procedure gim_loadcolormap (gp, colormap, offset, slope)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0 is display colormap)
+real	offset, slope		#I linear transformation on colormap
+
+real	veclen, scale
+short	gim[GIM_LOADCMAP_LEN]
+
+begin
+	scale = GIM_LOADCMAP_SCALE
+	gim[GIM_LOADCMAP_MP] = colormap
+	gim[GIM_LOADCMAP_OF] = ((GKI_MAXNDC + 1) / scale) *
+	    max(-scale, min(scale, offset))
+
+	if (abs(slope) < EPSILONR)
+	    veclen = GKI_MAXNDC
+	else {
+	    veclen = GKI_MAXNDC + 1
+	    veclen = min (veclen / 2, veclen / abs(slope) / 2)
+	}
+	gim[GIM_LOADCMAP_DX] = veclen
+	gim[GIM_LOADCMAP_DY] = veclen * slope
+
+	call gescape (gp, GIM_LOADCMAP, gim, GIM_LOADCMAP_LEN)
+end
diff --git a/sys/gio/gim/gimqras.x b/sys/gio/gim/gimqras.x
new file mode 100644
index 00000000..fa8f5909
--- /dev/null
+++ b/sys/gio/gim/gimqras.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_QUERYRASTER -- Query a raster.  The function value (YES/NO) indicates
+# whether or not the raster exists.  If the raster exists, the raster type
+# and size are returned as output arguments.
+
+int procedure gim_queryraster (gp, raster, type, width, height, depth)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	type			#O raster type (ximage,pixmap)
+int	width			#O raster width in pixels
+int	height			#O raster height in pixels
+int	depth			#O raster depth, bits per pixel
+
+int	nchars, nread
+short	gim[GIM_QUERYRASTER_LEN]
+short	retval[GIM_RET_QRAS_LEN]
+errchk	gescape, flush, read, syserrs
+int	read()
+
+begin
+	call gpl_flush()
+	gim[GIM_QUERYRASTER_RN] = raster
+	call gescape (gp, GIM_QUERYRASTER, gim, GIM_QUERYRASTER_LEN)
+	call flush (GP_FD(gp))
+
+	# This assumes a normal stream type GKI connection.
+	nchars = GIM_RET_QRAS_LEN * SZ_SHORT
+	nread = read (GP_FD(gp), retval, nchars)
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (nread != nchars)
+	    call syserrs (SYS_FREAD, "gim_queryraster")
+
+	type   = retval[GIM_RET_QRAS_RT]
+	width  = retval[GIM_RET_QRAS_NX]
+	height = retval[GIM_RET_QRAS_NY]
+	depth  = retval[GIM_RET_QRAS_BP]
+
+	return (retval[GIM_RET_QRAS_EX])
+end
diff --git a/sys/gio/gim/gimrasini.x b/sys/gio/gim/gimrasini.x
new file mode 100644
index 00000000..56914746
--- /dev/null
+++ b/sys/gio/gim/gimrasini.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_RASTERINIT -- Initialize the Gterm widget imaging subsystem.  Destroys
+# any existing rasters, mappings, and dynamic colors.
+
+procedure gim_rasterinit (gp)
+
+pointer	gp			#I graphics descriptor
+
+begin
+	call gescape (gp, GIM_RASTERINIT, 0, GIM_RASTERINIT_LEN)
+end
diff --git a/sys/gio/gim/gimrcmap.x b/sys/gio/gim/gimrcmap.x
new file mode 100644
index 00000000..8fb9f4d2
--- /dev/null
+++ b/sys/gio/gim/gimrcmap.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_READCOLORMAP -- Read a segment of a colormap.  The number of cells
+# read is returned.  The number of cells read may be less than the request
+# size if the cells have not yet been allocated.
+
+int procedure gim_readcolormap (gp, colormap, first, maxelem, r, g, b)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0=screen)
+int	first			#I first colormap entry to be read
+int	maxelem			#I number of elements to read
+int	r[ARB],g[ARB],b[ARB]	#O RGB color values (0-255)
+
+pointer	sp, cm, ip
+int	ncells, nret, nchars, i
+short	gim[GIM_READCMAP_LEN]
+short	retval[GIM_RET_RCMAP_LEN]
+int	read()
+
+string	s_readcmap "gim_readcolormap"
+errchk	flush, read, syserrs
+
+begin
+	call smark (sp)
+	call gpl_flush()
+
+	gim[GIM_READCMAP_MP] = colormap
+	gim[GIM_READCMAP_FC] = first
+	gim[GIM_READCMAP_NC] = maxelem
+	call gescape (gp, GIM_READCMAP, gim, GIM_READCMAP_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RCMAP_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readcmap)
+	}
+
+        ncells = retval[GIM_RET_RCMAP_NC]
+	call salloc (cm, ncells * 3, TY_SHORT)
+	nret = min (ncells, maxelem)
+
+	# Get the colormap data.
+	nchars = (ncells * 3) * SZ_SHORT
+        if (read (GP_FD(gp), Mems[cm], nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readcmap)
+	}
+	
+	do i = 1, nret {
+	    ip = cm + (i - 1) * 3
+	    r[i] = Mems[ip+0]
+	    g[i] = Mems[ip+1]
+	    b[i] = Mems[ip+2]
+	}
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	call sfree (sp)
+
+	return (nret)
+end
diff --git a/sys/gio/gim/gimref.x b/sys/gio/gim/gimref.x
new file mode 100644
index 00000000..dd3085d4
--- /dev/null
+++ b/sys/gio/gim/gimref.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_REFRESHMAPPING -- Refresh a previously defined mapping, i.e., repaint
+# the destination rect.
+
+procedure gim_refreshmapping (gp, mapping)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+
+short	gim[GIM_REFRESHMAPPING_LEN]
+
+begin
+	gim[GIM_REFRESHMAPPING_MP] = mapping
+	call gescape (gp, GIM_REFRESHMAPPING, gim, GIM_REFRESHMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimrefpix.x b/sys/gio/gim/gimrefpix.x
new file mode 100644
index 00000000..1d906a1a
--- /dev/null
+++ b/sys/gio/gim/gimrefpix.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_REFRESHPIX -- Update any mappings defined upon the given region of
+# the given source raster, as if the pixel values had been set with a write
+# pixels call.
+
+procedure gim_refreshpix (gp, raster, ct, x1, y1, width, height)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	ct			#I coordinate type
+real	x1, y1			#I region to be refreshed
+real	width, height		#I region to be refreshed
+
+short	gim[GIM_REFRESHPIXELS_LEN]
+
+begin
+	gim[GIM_REFRESHPIXELS_RN] = raster
+	gim[GIM_REFRESHPIXELS_CT] = ct
+
+        if (ct == CT_PIXEL) {
+            gim[GIM_REFRESHPIXELS_X1] = x1
+            gim[GIM_REFRESHPIXELS_Y1] = y1
+            gim[GIM_REFRESHPIXELS_NX] = width
+            gim[GIM_REFRESHPIXELS_NY] = height
+        } else {
+            gim[GIM_REFRESHPIXELS_X1] = x1 * GKI_MAXNDC
+            gim[GIM_REFRESHPIXELS_Y1] = y1 * GKI_MAXNDC
+            gim[GIM_REFRESHPIXELS_NX] = nint (width * GKI_MAXNDC)
+            gim[GIM_REFRESHPIXELS_NY] = nint (height * GKI_MAXNDC)
+        }
+
+	call gescape (gp, GIM_REFRESHPIXELS, gim, GIM_REFRESHPIXELS_LEN)
+end
diff --git a/sys/gio/gim/gimriomap.x b/sys/gio/gim/gimriomap.x
new file mode 100644
index 00000000..0f152ca5
--- /dev/null
+++ b/sys/gio/gim/gimriomap.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_IOMAPREAD -- Read a segment of the gterm widget iomap.
+
+procedure gim_iomapread (gp, iomap, first, nelem)
+
+pointer	gp			#I graphics descriptor
+int	iomap[ARB]		#o iomap data
+int	first			#I first iomap cell to be read
+int	nelem			#I number of elements to read
+
+int	nchars
+pointer	sp, data
+short	gim[GIM_READIOMAP_LEN]
+short	retval[GIM_RET_RIOMAP_LEN]
+int	read()
+
+string	s_readiomap "gim_iomapread"
+errchk	flush, read, syserrs
+
+begin
+	call smark (sp)
+	call gpl_flush()
+
+	gim[GIM_READIOMAP_FC] = first
+	gim[GIM_READIOMAP_NC] = nelem
+	call gescape (gp, GIM_READIOMAP, gim, GIM_READIOMAP_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RIOMAP_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readiomap)
+	}
+
+        if (retval[GIM_RET_RIOMAP_NC] != nelem)
+            call syserrs (SYS_FREAD, s_readiomap)
+
+	# Get the iomap data.
+	call salloc (data, nelem, TY_SHORT)
+	nchars = nelem * SZ_SHORT
+        if (read (GP_FD(gp), Mems[data], nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readiomap)
+	} else
+	    call achtsi (Mems[data], iomap, nelem)
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimrpix.x b/sys/gio/gim/gimrpix.x
new file mode 100644
index 00000000..4b6c7e9b
--- /dev/null
+++ b/sys/gio/gim/gimrpix.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gio.h>
+include	<fset.h>
+include	<gescape.h>
+
+# GIM_READPIXELS -- Read from a rectangular region of a raster.
+
+procedure gim_readpixels (gp, raster, data, nbits, x1, y1, nx, ny)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+short	data[ARB]		#O returned pixel data
+int	nbits			#I nbits per raster pixel (1,8,16,32)
+int	x1, y1			#I first pixel to be written
+int	nx, ny			#I size of region to be written
+
+int	npix, nchars, nwords
+short	gim[GIM_READPIXELS_LEN]
+short	retval[GIM_RET_RPIX_LEN]
+errchk	gpl_flush, gflush, read, syserrs
+string	s_readpixels "gim_readpixels"
+int	read()
+
+begin
+	call gpl_flush()
+	npix = nx * ny
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+	nwords = (nchars + SZ_SHORT-1) / SZ_SHORT
+
+	gim[GIM_READPIXELS_RN] = raster
+	gim[GIM_READPIXELS_EC] = 0
+	gim[GIM_READPIXELS_X1] = x1
+	gim[GIM_READPIXELS_Y1] = y1
+	gim[GIM_READPIXELS_NX] = nx
+	gim[GIM_READPIXELS_NY] = ny
+	gim[GIM_READPIXELS_BP] = nbits
+
+	call gki_escape (gp, GIM_READPIXELS, gim, GIM_READPIXELS_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RPIX_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readpixels)
+	}
+
+	# Get the pixel data.
+        npix = retval[GIM_RET_RPIX_NP]
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+        if (read (GP_FD(gp), data, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readpixels)
+	}
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (npix != nx * ny)
+            call syserrs (SYS_IMNOPIX, s_readpixels)
+end
diff --git a/sys/gio/gim/gimsetmap.x b/sys/gio/gim/gimsetmap.x
new file mode 100644
index 00000000..2cf5f7b6
--- /dev/null
+++ b/sys/gio/gim/gimsetmap.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_SETMAPPING -- Define a mapping between a source rect and a destination
+# rect.  While the mapping is enabled, any changes to the source rect will
+# be automatically propagated to the destination rect.  If the source and
+# destination rects are not the same size the source rect will be scaled to
+# fit the output rect.  A negative DW or DH causes the X or Y axis to be
+# flipped during the mapping.  Setmapping automatically enables a new
+# mapping, but no data is copied until the source rect is subsequently
+# modified or the mapping is modified or refreshed.  Setmapping may be called
+# on an already existing mapping to edit the mapping.  If the mapping is
+# enabled the effect of the edit will be visible immediately.  Only the
+# modified regions of the destination rect will be updated by a mapping.
+
+procedure gim_setmapping (gp, mapping, rop,
+	src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	rop			#I rasterop
+int	src			#I source raster
+int	st			#I coordinate type for source raster
+real	sx,sy,sw,sh		#I source rect
+int	dst			#I destination raster
+int	dt			#I coordinate type for destination raster
+real	dx,dy,dw,dh		#I destination rect
+
+short	gim[GIM_SETMAPPING_LEN]
+errchk	gpl_flush, gpl_cache
+include "../gpl.com"
+
+begin
+        # Flush any buffered polyline output.  Make sure the wcs transformation
+        # in the cache is up to date.
+
+        if (op > 1)
+            call gpl_flush()
+        else if (gp != gp_out || GP_WCS(gp) != wcs)
+            call gpl_cache (gp)
+
+	# Output the setmapping escape.
+	gim[GIM_SETMAPPING_MP] = mapping
+	gim[GIM_SETMAPPING_OP] = rop
+	gim[GIM_SETMAPPING_SR] = src
+	gim[GIM_SETMAPPING_ST] = st
+
+	if (st == CT_PIXEL) {
+	    gim[GIM_SETMAPPING_SX] = sx
+	    gim[GIM_SETMAPPING_SY] = sy
+	    gim[GIM_SETMAPPING_SW] = sw
+	    gim[GIM_SETMAPPING_SH] = sh
+	} else {
+	    gim[GIM_SETMAPPING_SX] = sx * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_SY] = sy * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_SW] = nint (sw * GKI_MAXNDC)
+	    gim[GIM_SETMAPPING_SH] = nint (sh * GKI_MAXNDC)
+	}
+
+	gim[GIM_SETMAPPING_DR] = dst
+	gim[GIM_SETMAPPING_DT] = dt
+
+	if (dt == CT_PIXEL) {
+	    gim[GIM_SETMAPPING_DX] = dx
+	    gim[GIM_SETMAPPING_DY] = dy
+	    gim[GIM_SETMAPPING_DW] = dw
+	    gim[GIM_SETMAPPING_DH] = dh
+	} else {
+	    gim[GIM_SETMAPPING_DX] = dx * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_DY] = dy * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_DW] = nint (dw * GKI_MAXNDC)
+	    gim[GIM_SETMAPPING_DH] = nint (dh * GKI_MAXNDC)
+	}
+
+	call gescape (gp, GIM_SETMAPPING, gim, GIM_SETMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimsetpix.x b/sys/gio/gim/gimsetpix.x
new file mode 100644
index 00000000..09250221
--- /dev/null
+++ b/sys/gio/gim/gimsetpix.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_SETPIX -- Set the pixels in a region of a raster to a solid color.
+# If width=height=0 the entire raster will be written.
+
+procedure gim_setpix (gp, raster, ct, x1, y1, width, height, color, rop)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	ct			#I coordinate type
+real	x1, y1			#I region to be refreshed
+real	width, height		#I region to be refreshed
+int	color			#I pixel value
+int	rop			#I rasterop
+
+short	gim[GIM_SETPIXELS_LEN]
+
+begin
+	gim[GIM_SETPIXELS_RN] = raster
+	gim[GIM_SETPIXELS_CT] = ct
+	gim[GIM_SETPIXELS_CO] = color
+	gim[GIM_SETPIXELS_OP] = rop
+
+        if (ct == CT_PIXEL) {
+            gim[GIM_SETPIXELS_X1] = x1
+            gim[GIM_SETPIXELS_Y1] = y1
+            gim[GIM_SETPIXELS_NX] = width
+            gim[GIM_SETPIXELS_NY] = height
+        } else {
+            gim[GIM_SETPIXELS_X1] = x1 * GKI_MAXNDC
+            gim[GIM_SETPIXELS_Y1] = y1 * GKI_MAXNDC
+            gim[GIM_SETPIXELS_NX] = nint (width * GKI_MAXNDC)
+            gim[GIM_SETPIXELS_NY] = nint (height * GKI_MAXNDC)
+        }
+
+	call gescape (gp, GIM_SETPIXELS, gim, GIM_SETPIXELS_LEN)
+end
diff --git a/sys/gio/gim/gimsetras.x b/sys/gio/gim/gimsetras.x
new file mode 100644
index 00000000..efb5add5
--- /dev/null
+++ b/sys/gio/gim/gimsetras.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_SETRASTER -- Set the raster to be used as the coordinate system for
+# graphics drawing operations.  A setraster for raster N causes subsequent
+# drawing operations to be drawn using any raster-to-screen mappings defined
+# for raster N.  A setraster to raster=0 restores the normal semantics of
+# drawing directly to the screen with no additional transformations.
+# Applications which use gim_setraster to draw graphics or text overlays on
+# a raster should always restore the raster to zero when done so that
+# subsequent drawing operations (e.g., in cursor mode) behave normally.
+# The setraster is not reset automatically except in a screen clear.
+#
+# NOTE - Most applications should use gseti(gp,G_RASTER,n) instead of the
+# lower level gim_setraster.
+
+procedure gim_setraster (gp, raster)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number
+
+short	gim[GIM_SETRASTER_LEN]
+
+begin
+	gim[GIM_SETRASTER_RN] = raster
+	call gescape (gp, GIM_SETRASTER, gim, GIM_SETRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimwcmap.x b/sys/gio/gim/gimwcmap.x
new file mode 100644
index 00000000..54a6d3f2
--- /dev/null
+++ b/sys/gio/gim/gimwcmap.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_WRITECOLORMAP -- Write to a colormap.
+
+procedure gim_writecolormap (gp, colormap, first, nelem, r, g, b)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0=screen)
+int	first			#I first colormap entry to be written
+int	nelem			#I number of elements to write
+int	r[ARB],g[ARB],b[ARB]	#I RGB color values (0-255)
+
+int	i
+pointer	sp, cm, op
+short	gim[GIM_WRITECMAP_LEN]
+errchk	gpl_flush
+
+begin
+	call gpl_flush()
+
+	call smark (sp)
+	call salloc (cm, nelem * 3, TY_SHORT)
+
+	gim[GIM_WRITECMAP_MP] = colormap
+	gim[GIM_WRITECMAP_FC] = first
+	gim[GIM_WRITECMAP_NC] = nelem
+
+	do i = 1, nelem {
+	    op = cm + (i - 1) * 3
+	    Mems[op+0] = r[i]
+	    Mems[op+1] = g[i]
+	    Mems[op+2] = b[i]
+	}
+
+	call gki_wescape (GP_FD(gp), GIM_WRITECMAP,
+	    gim, GIM_WRITECMAP_LEN, Mems[cm], nelem * 3)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimwiomap.x b/sys/gio/gim/gimwiomap.x
new file mode 100644
index 00000000..a756a235
--- /dev/null
+++ b/sys/gio/gim/gimwiomap.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_IOMAPWRITE -- Write to the iomap.  The iomap maps client pixel values
+# (colors) to gterm widget pixel value (widget colormap indices).  The iomap
+# should be set only if the client application does not use the gterm widget
+# color model.  iomap[i] gives the widget colormap index corresponding to
+# client pixel I.
+
+procedure gim_iomapwrite (gp, iomap, first, nelem)
+
+pointer	gp			#I graphics descriptor
+int	iomap[ARB]		#I iomap data
+int	first			#I first iomap entry to be written
+int	nelem			#I number of elements to write
+
+pointer	sp, data
+short	gim[GIM_WRITEIOMAP_LEN]
+errchk	gpl_flush
+
+begin
+	call gpl_flush()
+
+	call smark (sp)
+	call salloc (data, nelem, TY_SHORT)
+
+	gim[GIM_WRITEIOMAP_FC] = first
+	gim[GIM_WRITEIOMAP_NC] = nelem
+
+	call achtis (iomap, Mems[data], nelem)
+	call gki_wescape (GP_FD(gp), GIM_WRITEIOMAP,
+	    gim, GIM_WRITEIOMAP_LEN, Mems[data], nelem)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimwpix.x b/sys/gio/gim/gimwpix.x
new file mode 100644
index 00000000..fc55a55b
--- /dev/null
+++ b/sys/gio/gim/gimwpix.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_WRITEPIXELS -- Write to a rectangular region of a raster.
+
+procedure gim_writepixels (gp, raster, data, nbits, x1, y1, nx, ny)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+short	data[ARB]		#I output pixel data
+int	nbits			#I nbits per raster pixel (1,8,16,32)
+int	x1, y1			#I first pixel to be written
+int	nx, ny			#I size of region to be written
+
+int	npix, nchars, nwords
+short	gim[GIM_WRITEPIXELS_LEN]
+errchk	gpl_flush, gpl_cache
+include "../gpl.com"
+
+begin
+        # Flush any buffered polyline output.  Make sure the wcs transformation
+        # in the cache is up to date.
+
+        if (op > 1)
+            call gpl_flush()
+        else if (gp != gp_out || GP_WCS(gp) != wcs)
+            call gpl_cache (gp)
+
+	# Output the writepixels escape.
+	npix = nx * ny
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+	nwords = (nchars + SZ_SHORT-1) / SZ_SHORT
+
+	gim[GIM_WRITEPIXELS_RN] = raster
+	gim[GIM_WRITEPIXELS_EC] = 0
+	gim[GIM_WRITEPIXELS_X1] = x1
+	gim[GIM_WRITEPIXELS_Y1] = y1
+	gim[GIM_WRITEPIXELS_NX] = nx
+	gim[GIM_WRITEPIXELS_NY] = ny
+	gim[GIM_WRITEPIXELS_BP] = nbits
+
+	call gki_wescape (GP_FD(gp), GIM_WRITEPIXELS,
+	    gim, GIM_WRITEPIXELS_LEN, data, nwords)
+end
diff --git a/sys/gio/gim/mkpkg b/sys/gio/gim/mkpkg
new file mode 100644
index 00000000..9aab719b
--- /dev/null
+++ b/sys/gio/gim/mkpkg
@@ -0,0 +1,32 @@
+# Make the GIM (graphics imaging) interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	gimcpras.x	<gescape.h> <gim.h> <gki.h>
+	gimcrras.x	<gescape.h>
+	gimderas.x	<gescape.h>
+	gimdsmap.x	<gescape.h>
+	gimenmap.x	<gescape.h>
+	gimfcmap.x	<gescape.h>
+	gimfmap.x	<gescape.h>
+	gimgetmap.x	<fset.h> <gescape.h> <gim.h> <gio.h> <gki.h>
+	gimimap.x	<gescape.h>
+	gimlcmap.x	<gescape.h> <gim.h> <gki.h> <mach.h>
+	gimqras.x	<fset.h> <gescape.h> <gio.h>
+	gimrasini.x	<gescape.h>
+	gimrcmap.x	<fset.h> <gescape.h> <gio.h>
+	gimref.x	<gescape.h>
+	gimrefpix.x	<gescape.h> <gim.h> <gki.h>
+	gimriomap.x	<fset.h> <gescape.h> <gio.h>
+	gimrpix.x	<fset.h> <gescape.h> <gio.h> <mach.h>
+	gimsetmap.x	<gescape.h> <gim.h> <gio.h> <gki.h> ../gpl.com
+	gimsetpix.x	<gescape.h> <gim.h> <gki.h>
+	gimsetras.x	<gescape.h>
+	gimwcmap.x	<gescape.h> <gio.h>
+	gimwiomap.x	<gescape.h> <gio.h>
+	gimwpix.x	<gescape.h> <gio.h> <mach.h> ../gpl.com
+	;
diff --git a/sys/gio/gki/README b/sys/gio/gki/README
new file mode 100644
index 00000000..171de8d9
--- /dev/null
+++ b/sys/gio/gki/README
@@ -0,0 +1,84 @@
+GKI -- The graphics kernel interface.
+
+    The GKI package is used to encode and decode the GKI instructions used to
+communicate with a graphics kernel.  The kernel may be resident in the same
+process, in the CL process, or in a subprocess of the CL.  Output may also
+be spooled in a metafile.  The purposes of the GKI interface are to isolate GIO
+from the kernel, to hide the details of packing and unpacking GKI metacode
+from both GIO and the kernels, and to hide the details of the communications
+protocols required to communicate with the different types of kernels.
+
+    Before any i/o can be done on a GKI graphics stream, GKI must be informed
+of the residency of the kernel associated with the stream.  Three calls are
+provided for this purpose:
+
+	    gki_redir (stream, fd, old_type, old_fd)		[1]
+	   gki_inline (stream, dd)				[2]
+	gki_subkernel (stream, pid, epa_prpsio)			[3]
+
+Use [1] in the normal case of GIO talking to the CL or to a metafile.  The
+first call will set, rather than redirect, the FD for a stream.  Subsequent
+calls may be made to truely redirect a stream and then restore its normal
+dataflow.  Use [2] when the graphics kernel is in the same process.  The
+kernel must already have been opened with the driver for the kernel in the
+DD array.  This is the most efficient mode of operation if a high data
+bandwidth is required.  Kernel type [2] is used by GIOTR in the CL process
+to communicate with external kernels.  A slightly different protocol is
+required in this case since the input must be switched to the subprocess
+before it can read or write the graphics stream.
+
+
+			Summary Of Procedures
+
+1. Initialize GKI
+
+		      gki_redir (stream, fd, old_fd, old_type)
+	      gki_inline_kernel (stream, dd)
+		  gki_subkernel (stream, pid, prpsio_epa)
+
+
+2. Metacode interpretation
+
+     gki_fetch_next_instruction (fd, instruction)		(EOF|nwords)
+		    gki_execute (gki, dd)
+		      gki_write (fd, gki)
+
+
+3. Instructions
+
+		     gki_cancel (fd)
+		      gki_clear (fd)
+		    gki_closews (fd, device)
+	       gki_deactivatews (fd)
+		        gki_eof (fd)
+		     gki_escape (fd, fn, instruction, nwords)
+		      gki_faset (fd, ap)
+		   gki_fillarea (fd, points, npts)
+		      gki_flush (fd)
+	       gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+		  gki_getcursor (fd, x, y, key, cursor)
+		     gki_getwcs (fd, wcs, len_wcs)
+		    gki_mftitle (fd, title)
+		     gki_openws (fd, device, mode)
+		      gki_plset (fd, ap)
+		      gki_pmset (fd, ap)
+		   gki_polyline (fd, points, npts)
+		 gki_polymarker (fd, points, npts)
+	       gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+	       gki_reactivatews (fd)
+		  gki_setcursor (fd, x, y, cursor)
+		     gki_setwcs (fd, wcs, len_wcs)
+		       gki_text (fd, x, y, text)
+		      gki_txset (fd, ap)
+
+
+4. Instructions for encoding return values
+
+	       gki_retcellarray (fd, m, np)
+	     gki_retcursorvalue (fd, x, y, key, cursor)
+
+
+5. Initialization of the GKIPRINT kernel
+
+		    gkp_install (dd, out_fd, verbose_output)
+		      gkp_close ()
diff --git a/sys/gio/gki/gki.com b/sys/gio/gki/gki.com
new file mode 100644
index 00000000..4c5e3152
--- /dev/null
+++ b/sys/gio/gki/gki.com
@@ -0,0 +1,8 @@
+# Common for the GKI (graphics kernel interface) package.
+
+int	gk_type[LAST_FD]		# type of output
+int	gk_fd[LAST_FD]			# output file descriptor
+int	gk_dd[LEN_GKIDD]		# local device driver
+int	gk_prpsio			# EPA of pr_psio procedure
+
+common	/gkicom/ gk_type, gk_fd, gk_dd, gk_prpsio
diff --git a/sys/gio/gki/gkicancel.x b/sys/gio/gki/gkicancel.x
new file mode 100644
index 00000000..ff2bc5f4
--- /dev/null
+++ b/sys/gio/gki/gkicancel.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CANCEL -- Cancel graphics output and reset internal parameters.
+#
+# BOI GKI_CANCEL 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_cancel (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_CANCEL_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CANCEL/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CANCEL]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else
+	    call write (gk_fd[fd], gki, GKI_CANCEL_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiclear.x b/sys/gio/gki/gkiclear.x
new file mode 100644
index 00000000..ac1e5961
--- /dev/null
+++ b/sys/gio/gki/gkiclear.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CLEAR -- Clear the workstation screen.
+#
+# BOI GKI_CLEAR 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_clear (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_CLEAR_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CLEAR/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CLEAR]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else
+	    call write (gk_fd[fd], gki, GKI_CLEAR_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiclose.x b/sys/gio/gki/gkiclose.x
new file mode 100644
index 00000000..e7ceea15
--- /dev/null
+++ b/sys/gio/gki/gkiclose.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CLOSEWS -- Close workstation.
+#
+# BOI GKI_CLOSEWS L N D
+#    
+#        L(i)            4 + N
+#        N(i)            number of characters in field D
+#        D(Nc)           device name as in graphcap file
+
+procedure gki_closews (fd, device)
+
+int	fd			# output file
+char	device[ARB]		# device name
+
+int	epa
+int	ip, nchars, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (device)
+	call salloc (gki, GKI_CLOSEWS_LEN + n, TY_SHORT)
+
+	# Pack the device name as a SHORT integer array.
+	op = gki + GKI_CLOSEWS_D - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = device[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CLOSEWS]
+	    if (epa != 0)
+		call zcall2 (epa, Mems[gki+GKI_CLOSEWS_D-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_CLOSEWS
+	    Mems[gki+2] = GKI_CLOSEWS_LEN + n
+	    Mems[gki+GKI_CLOSEWS_N-1] = n
+
+	    # Send a copy of the close workstation directive to PSIOCTRL in
+	    # the CL process to connect the graphics stream to a kernel,
+	    # before writing to the graphics stream.  The GKI instruction
+	    # must be preceded by the integer value of the stream number.
+
+	    nchars = (GKI_CLOSEWS_LEN + n) * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, Mems[gki], nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], Mems[gki], nchars)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkideact.x b/sys/gio/gki/gkideact.x
new file mode 100644
index 00000000..b742f7ed
--- /dev/null
+++ b/sys/gio/gki/gkideact.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_DEACTIVATEWS -- Deactivate the workstation (disable graphics).
+#
+# BOI GKI_DEACTIVATEWS L F
+#    
+#        L(i)            4
+#        F               flags (0,AW_PAUSE,AW_CLEAR)
+
+procedure gki_deactivatews (fd, flags)
+
+int	fd			# output file
+int	flags			# action modifier flags
+
+int	epa, nchars
+short	gki[GKI_DEACTIVATEWS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_DEACTIVATEWS/, gki[3] /GKI_DEACTIVATEWS_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_DEACTIVATEWS]
+	    if (epa != 0)
+		call zcall1 (epa, flags)
+
+	} else {
+	    # Send a copy to the pseudofile i/o controller.
+	    gki[GKI_DEACTIVATEWS_F] = flags
+	    nchars = GKI_DEACTIVATEWS_LEN * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], gki, nchars)
+	}
+end
diff --git a/sys/gio/gki/gkieof.x b/sys/gio/gki/gkieof.x
new file mode 100644
index 00000000..05700156
--- /dev/null
+++ b/sys/gio/gki/gkieof.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_EOF -- Signal end of file on a metacode stream.
+#
+# BOI GKI_EOF 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_eof (fd)
+
+int	fd			# output file
+
+short	gki[GKI_EOF_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_EOF/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (!IS_INLINE(fd))
+	    call write (gk_fd[fd], gki, GKI_EOF_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiesc.x b/sys/gio/gki/gkiesc.x
new file mode 100644
index 00000000..a33c769d
--- /dev/null
+++ b/sys/gio/gki/gkiesc.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_ESCAPE -- Pass a device dependent instruction on to the kernel.
+#
+# BOI GKI_ESCAPE L FN N DC
+#
+#        L(i)            5 + N
+#        FN(i)           escape function code
+#        N(i)            number of escape data words
+#        DC(i)           escape data words
+
+procedure gki_escape (fd, fn, instruction, nwords)
+
+int	fd			# output file
+int	fn			# function code
+short	instruction[ARB]	# instruction sequence of unknown format
+int	nwords			# number of shorts in instruction
+
+int	epa
+short	gki[GKI_ESCAPE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_ESCAPE/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_ESCAPE]
+	    if (epa != 0)
+		call zcall3 (epa, fn, instruction, nwords)
+	} else {
+	    gki[GKI_ESCAPE_L]  = GKI_ESCAPE_LEN + nwords
+	    gki[GKI_ESCAPE_N]  = nwords
+	    gki[GKI_ESCAPE_FN] = fn
+
+	    call write (gk_fd[fd], gki, GKI_ESCAPE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], instruction, nwords * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiexe.x b/sys/gio/gki/gkiexe.x
new file mode 100644
index 00000000..05e8ec8d
--- /dev/null
+++ b/sys/gio/gki/gkiexe.x
@@ -0,0 +1,178 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_EXECUTE -- Execute a metacode instruction.  The instruction is decoded
+# and a graphics kernel driver subroutine is called to execute the instruction.
+# If the device driver does not include a procedure for the instruction the
+# instruction is discarded.  Integer and real parameters are unpacked from
+# their short integer metacode representation.  Character data is passed by
+# reference, i.e., as a SHORT integer array (not EOS delimited char!!), along
+# with the character count.  Attribute packets are passed to the set attribute
+# procedure by reference as a short integer array.
+
+procedure gki_execute (gki, dd)
+
+short	gki[ARB]		# graphics kernel instruction
+int	dd[ARB]			# device driver
+
+int	kp			# kernel procedure
+int	m, n, cn, fn, dummy, flags
+int	x, y, x1, y1, x2, y2
+
+begin
+	switch (gki[GKI_HDR_OPCODE]) {
+
+	case GKI_OPENWS:
+	    kp = dd[GKI_OPENWS]
+	    if (kp != NULL) {
+		m = gki[GKI_OPENWS_M]
+		n = gki[GKI_OPENWS_N]
+		call zcall3 (kp, gki[GKI_OPENWS_D], n, m)
+	    }
+	case GKI_CLOSEWS:
+	    kp = dd[GKI_CLOSEWS]
+	    if (kp != NULL) {
+		n = gki[GKI_CLOSEWS_N]
+		call zcall2 (kp, gki[GKI_CLOSEWS_D], n)
+	    }
+	case GKI_REACTIVATEWS:
+	    kp = dd[GKI_REACTIVATEWS]
+	    if (kp != NULL) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		call zcall1 (kp, flags)
+	    }
+	case GKI_DEACTIVATEWS:
+	    kp = dd[GKI_DEACTIVATEWS]
+	    if (kp != NULL) {
+		flags = gki[GKI_DEACTIVATEWS_F]
+		call zcall1 (kp, flags)
+	    }
+	case GKI_MFTITLE:
+	    kp = dd[GKI_MFTITLE]
+	    if (kp != NULL) {
+		n = gki[GKI_MFTITLE_N]
+		call zcall2 (kp, gki[GKI_MFTITLE_T], n)
+	    }
+	case GKI_CLEAR:
+	    kp = dd[GKI_CLEAR]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_CANCEL:
+	    kp = dd[GKI_CANCEL]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_FLUSH:
+	    kp = dd[GKI_FLUSH]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_POLYLINE:
+	    kp = dd[GKI_POLYLINE]
+	    if (kp != 0) {
+		n = gki[GKI_POLYLINE_N]
+		call zcall2 (kp, gki[GKI_POLYLINE_P], n)
+	    }
+	case GKI_POLYMARKER:
+	    kp = dd[GKI_POLYMARKER]
+	    if (kp != 0) {
+		n = gki[GKI_POLYMARKER_N]
+		call zcall2 (kp, gki[GKI_POLYMARKER_P], n)
+	    }
+	case GKI_TEXT:
+	    kp = dd[GKI_TEXT]
+	    if (kp != NULL) {
+		x = gki[GKI_TEXT_P]
+		y = gki[GKI_TEXT_P+1]
+		n = gki[GKI_TEXT_N]
+		call zcall4 (kp, x, y, gki[GKI_TEXT_T], n)
+	    }
+	case GKI_FILLAREA:
+	    kp = dd[GKI_FILLAREA]
+	    if (kp != 0) {
+		n = gki[GKI_FILLAREA_N]
+		call zcall2 (kp, gki[GKI_FILLAREA_P], n)
+	    }
+	case GKI_PUTCELLARRAY:
+	    kp = dd[GKI_PUTCELLARRAY]
+	    if (kp != NULL) {
+		x1 = gki[GKI_PUTCELLARRAY_LL]
+		y1 = gki[GKI_PUTCELLARRAY_LL+1]
+		x2 = gki[GKI_PUTCELLARRAY_UR]
+		y2 = gki[GKI_PUTCELLARRAY_UR+1]
+		m  = gki[GKI_PUTCELLARRAY_NC]
+		n  = gki[GKI_PUTCELLARRAY_NL]
+		call zcall7 (kp, gki[GKI_PUTCELLARRAY_P], m, n, x1,y1, x2,y2)
+	    }
+	case GKI_SETCURSOR:
+	    kp = dd[GKI_SETCURSOR]
+	    if (kp != NULL) {
+		cn = gki[GKI_SETCURSOR_CN]
+		x  = gki[GKI_SETCURSOR_POS]
+		y  = gki[GKI_SETCURSOR_POS+1]
+		call zcall3 (kp, x, y, cn)
+	    }
+	case GKI_PLSET:
+	    kp = dd[GKI_PLSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_PMSET:
+	    kp = dd[GKI_PMSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_TXSET:
+	    kp = dd[GKI_TXSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_FASET:
+	    kp = dd[GKI_FASET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_GETCURSOR:
+	    kp = dd[GKI_GETCURSOR]
+	    if (kp != NULL) {
+		cn = gki[GKI_GETCURSOR_CN]
+		call zcall1 (kp, cn)
+	    }
+	case GKI_GETCELLARRAY:
+	    kp = dd[GKI_GETCELLARRAY]
+	    if (kp != NULL) {
+		x1 = gki[GKI_GETCELLARRAY_LL]
+		y1 = gki[GKI_GETCELLARRAY_LL+1]
+		x2 = gki[GKI_GETCELLARRAY_UR]
+		y2 = gki[GKI_GETCELLARRAY_UR+1]
+		m  = gki[GKI_GETCELLARRAY_NC]
+		n  = gki[GKI_GETCELLARRAY_NL]
+		call zcall6 (kp, m, n, x1,y1, x2,y2)
+	    }
+	case GKI_ESCAPE:
+	    kp = dd[GKI_ESCAPE]
+	    if (kp != NULL) {
+		fn = gki[GKI_ESCAPE_FN]
+		n  = gki[GKI_ESCAPE_N]
+		call zcall3 (kp, fn, gki[GKI_ESCAPE_DC], n)
+	    }
+	case GKI_SETWCS:
+	    kp = dd[GKI_SETWCS]
+	    if (kp != NULL) {
+		n = gki[GKI_SETWCS_N]
+		call zcall2 (kp, gki[GKI_SETWCS_WCS], n)
+	    }
+	case GKI_GETWCS:
+	    kp = dd[GKI_SETWCS]
+	    if (kp != NULL) {
+		n = gki[GKI_SETWCS_N]
+		call zcall2 (kp, gki[GKI_SETWCS_WCS], n)
+	    }
+	default:
+	    kp = dd[GKI_UNKNOWN]
+	    if (kp != NULL)
+		call zcall1 (kp, gki)
+	}
+end
diff --git a/sys/gio/gki/gkifa.x b/sys/gio/gki/gkifa.x
new file mode 100644
index 00000000..328ec7cc
--- /dev/null
+++ b/sys/gio/gki/gkifa.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_FILLAREA -- Output the fill area instruction.
+#
+# BOI GKI_FILLAREA L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points defining the polygon to be filled
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_fillarea (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polygon defining area to be filled
+int	npts			# number of (x,y) points in polygon
+
+int	epa
+short	gki[GKI_FILLAREA_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FILLAREA/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FILLAREA]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_FILLAREA_L] = GKI_FILLAREA_LEN + (npts * 2)
+	    gki[GKI_FILLAREA_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_FILLAREA_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkifaset.x b/sys/gio/gki/gkifaset.x
new file mode 100644
index 00000000..7531be73
--- /dev/null
+++ b/sys/gio/gki/gkifaset.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_FASET -- Set the fill area attributes.
+#
+# BOI GKI_FASET L FS CI
+#
+#        L(i)            5
+#        FS(i)           fill style (0=clear,1=hollow,2=solid,3-6=hatch)
+#        CI(i)           fill area color index
+
+procedure gki_faset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to fillarea attribute structure
+
+int	epa
+short	gki[GKI_FASET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FASET/, gki[3] /GKI_FASET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_FASET_FS] = FA_STYLE(ap)
+	gki[GKI_FASET_CI] = FA_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FASET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_FASET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkifetch.x b/sys/gio/gki/gkifetch.x
new file mode 100644
index 00000000..53fa315b
--- /dev/null
+++ b/sys/gio/gki/gkifetch.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+define	LEN_DEFIBUF	2048
+define	ONEWORD		SZ_SHORT
+define	TWOWORDS	(2*SZ_SHORT)
+
+# Header fields of a GKI instruction.
+define	I_BOI		Mems[$1+GKI_HDR_BOI-1]
+define	I_OPCODE	Mems[$1+GKI_HDR_OPCODE-1]
+define	I_LENGTH	Mems[$1+GKI_HDR_LENGTH-1]
+define	I_DATA		Mems[$1+GKI_DATAFIELDS-1]
+
+# GKI_FETCH_NEXT_INSTRUCTION -- Fetch the next GKI metacode instruction from the
+# input stream.  A pointer to a short integer buffer containing the instruction
+# is returned as an output argument.  EOF is returned as the function value
+# when EOF is seen on the input stream.  The instruction buffer may be
+# deallocated by our caller at any time, if desired.  A new buffer will be
+# created automatically when next we are called.
+
+int procedure gki_fetch_next_instruction (fd, instruction)
+
+int	fd			# input file containing metacode
+pointer	instruction		# pointer to instruction (output)
+
+int	len_ibuf, nchars
+pointer	ibuf
+int	read()
+errchk	read, malloc, realloc
+data	ibuf /NULL/
+
+begin
+	# Allocate a default sized instruction buffer.  We can reallocate
+	# a larger buffer later if necessary.
+
+	if (ibuf == NULL) {
+	    call malloc (ibuf, LEN_DEFIBUF, TY_SHORT)
+	    len_ibuf = LEN_DEFIBUF
+	}
+
+	# Advance to the next instruction.  Nulls and botched portions of
+	# instructions are ignored.  Read the instruction header to determine
+	# the length of the instruction, and then read the rest of instruction
+	# into buffer.  If the entire instruction cannot be read we have a
+	# botched instruction and must try again.
+
+	repeat {
+	    repeat {
+		if (read (fd, I_BOI(ibuf), ONEWORD) == EOF)
+		    return (EOF)
+	    } until (I_BOI(ibuf) == BOI)
+
+	    if (read (fd, I_OPCODE(ibuf), TWOWORDS) == EOF)
+		return (EOF)
+	    
+	    # Make instruction buffer large enough to hold instruction.
+	    # Compute length of remainder of instruction in chars.
+
+	    if (I_LENGTH(ibuf) > len_ibuf) {
+		len_ibuf = I_LENGTH(ibuf)
+		call realloc (ibuf, len_ibuf, TY_SHORT)
+	    }
+
+	    nchars = (I_LENGTH(ibuf) - LEN_GKIHDR) * SZ_SHORT
+	    if (nchars == 0)
+		break
+
+	} until (read (fd, I_DATA(ibuf), nchars) == nchars)
+
+	instruction = ibuf
+
+	# Check for a soft end of file, otherwise return the length of the
+	# instruction as the function value.
+
+	if (I_OPCODE(ibuf) == GKI_EOF)
+	    return (EOF)
+	else
+	    return (I_LENGTH(ibuf))
+end
diff --git a/sys/gio/gki/gkifflush.x b/sys/gio/gki/gkifflush.x
new file mode 100644
index 00000000..9eebf406
--- /dev/null
+++ b/sys/gio/gki/gkifflush.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_FFLUSH -- Flush a graphics stream.  This does not issue the GKI_FLUSH
+# graphics instruction to the graphics kernel, it merely flushes any buffered
+# data in the output stream, and is a no-op in the case of an inline kernel.
+
+procedure gki_fflush (fd)
+
+int	fd			# output file
+
+errchk	seek
+include	"gki.com"
+
+begin
+	if (IS_SUBKERNEL(fd)) {
+	    call seek (fd, BOFL)
+	    call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_WRITE)
+	} else if (!IS_INLINE(fd))
+	    call flush (gk_fd[fd])
+end
diff --git a/sys/gio/gki/gkiflush.x b/sys/gio/gki/gkiflush.x
new file mode 100644
index 00000000..878502d4
--- /dev/null
+++ b/sys/gio/gki/gkiflush.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_FLUSH -- Flush any buffered output.
+#
+# BOI GKI_FLUSH 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_flush (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_FLUSH_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FLUSH/, gki[3] /LEN_GKIHDR/
+errchk	write, seek
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FLUSH]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else {
+	    call write (gk_fd[fd], gki, GKI_FLUSH_LEN * SZ_SHORT)
+
+	    # If writing to a subkernel we must call PR_PSIO to give the
+	    # kernel a chance to read the spooled metacode.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_WRITE)
+	    } else
+		call flush (gk_fd[fd])
+	}
+end
diff --git a/sys/gio/gki/gkigca.x b/sys/gio/gki/gkigca.x
new file mode 100644
index 00000000..07abf9d3
--- /dev/null
+++ b/sys/gio/gki/gkigca.x
@@ -0,0 +1,87 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_GETCELLARRAY -- Input a cell array (pixel array).
+#
+# BOI GKI_GETCELLARRAY L LL UR NC NL
+#    
+#        L(i)            9
+#        LL(p)           coordinates of lower left corner of input area
+#        UR(p)           coordinates of upper right corner of input area
+#        NC(i)           number of columns in array
+#        NL(i)           number of lines in array
+
+procedure gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+
+int	fd			# output file
+int	nx, ny			# number of columns and lines in M
+short	m[nx,ny]		# output array
+int	x1, y1			# lower left corner of window to be read
+int	x2, y2			# upper right corner of window to be read
+
+int	epa, nchars, npts
+short	ca[GKI_CELLARRAY_LEN]
+short	gki[GKI_GETCELLARRAY_LEN]
+int	read()
+data	gki[1] /BOI/, gki[2] /GKI_GETCELLARRAY/, gki[3] /GKI_GETCELLARRAY_LEN/
+errchk	write, seek, flush, read
+include	"gki.com"
+
+begin
+	# If the kernel is inline it will return the cell array value in the
+	# graphics stream FIO buffer just as if the kernel were resident
+	# in another process.  We rewind the buffer after the kernel writes
+	# into it in preparation for the read below.
+
+	if (IS_INLINE(fd)) {
+	    call fseti (fd, F_CANCEL, OK)
+	    epa = gk_dd[GKI_GETCELLARRAY]
+	    if (epa != 0)
+		call zcall6 (epa, nx,ny, x1,y1, x2,y2)
+	    call seek (fd, BOFL)
+
+	} else {
+	    # Write get cell array instruction to the kernel.
+
+	    gki[GKI_GETCELLARRAY_LL]   = x1
+	    gki[GKI_GETCELLARRAY_LL+1] = y1
+	    gki[GKI_GETCELLARRAY_UR]   = x2
+	    gki[GKI_GETCELLARRAY_UR+1] = y2
+	    gki[GKI_GETCELLARRAY_NC]   = nx
+	    gki[GKI_GETCELLARRAY_NL]   = ny
+
+	    call write (gk_fd[fd], gki, GKI_GETCELLARRAY_LEN)
+
+	    # If the kernel is a subprocess we must call PR_PSIO to allow the
+	    # kernel to read the instruction and return the cell array value.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_READ)
+		call seek (fd, BOFL)
+	    } else
+		call flush (gk_fd[fd])
+	}
+
+	# Read and decode the cell array value.
+
+	nchars = GKI_CELLARRAY_LEN * SZ_SHORT
+	if (read (fd, ca, nchars) < nchars) {
+	    call syserr (SYS_GGCELL)
+	} else if (ca[1] != BOI || ca[2] != GKI_CELLARRAY ||
+	    ca[GKI_CELLARRAY_NP] <= 0) {
+	    call syserr (SYS_GGCELL)
+	} else {
+	    npts = ca[GKI_CELLARRAY_NP]
+	    nchars = min (nx * ny, npts) * SZ_SHORT
+	    if (read (fd, m, nchars) < nchars)
+		call syserr (SYS_GGCELL)
+	}
+
+	call fseti (fd, F_CANCEL, OK)
+end
diff --git a/sys/gio/gki/gkigcur.x b/sys/gio/gki/gkigcur.x
new file mode 100644
index 00000000..e87e030e
--- /dev/null
+++ b/sys/gio/gki/gkigcur.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_GETCURSOR -- Read the cursor position in device coordinates.
+#
+# BOI GKI_GETCURSOR L CN
+#
+#        L(i)            4
+#        CN(i)           cursor number
+#
+#        The kernel reads graphics  cursor  number  CN  and  returns  the
+#        keystroke  value  (if  any)  and  the  cursor  position  in  NDC 
+#        coordinates.   The  cursor  attributes  are  returned   in   the 
+#        following format:
+#
+#                BOI GKI_CURSORVALUE L CN KEY SX SY RN RX RY
+#
+#        where
+#
+#                L(i)            10
+#                CN(i)           cursor number
+#                KEY(i)          keystroke value (>= 0 or EOF)
+#                SX(i)           NDC X screen coordinate of cursor
+#                SY(i)           NDC Y screen coordinate of cursor
+#                RN(i)           raster number or zero
+#                RX(i)           NDC X raster coordinate of cursor
+#                RY(i)           NDC Y raster coordinate of cursor
+#
+# The screen or display window coordinates SX and SY of the cursor are
+# returned for all devices.  Only some devices support multiple rasters.
+# If the device supports rasters and the cursor is in a rasters when read, the
+# rasters number and rasters coordinates are returned in RN,RX,RY.  This is in
+# addition to the screen coordinates SX,SY.  If rasters coordinates are not
+# returned, the rasters number will be set to zero and RX,RY will be the same
+# as SX,SY.
+
+procedure gki_getcursor (fd, cursor, cn, key, sx, sy, raster, rx, ry)
+
+int	fd			#I output file
+int	cursor			#I cursor to be read
+int	cn			#O cursor number actually read
+int	key			#O keystroke value or EOF
+int	sx, sy			#O screen coordinates of cursor
+int	raster			#O raster number
+int	rx, ry			#O raster coordinates of cursor
+
+int	epa
+int	nchars, read()
+short	gki[GKI_GETCURSOR_LEN]
+short	cur[GKI_CURSORVALUE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_GETCURSOR/, gki[3] /GKI_GETCURSOR_LEN/
+include	"gki.com"
+errchk	write, flush, read
+
+begin
+	# If the kernel is inline it will return the cursor value in the
+	# graphics stream FIO buffer just as if the kernel were resident
+	# in another process.  We rewind the buffer after the kernel writes
+	# into it in preparation for the read below.
+
+	if (IS_INLINE(fd)) {
+	    call fseti (fd, F_CANCEL, OK)
+	    epa = gk_dd[GKI_GETCURSOR]
+	    if (epa != 0)
+		call zcall1 (epa, cursor)
+	    call seek (fd, BOFL)
+
+	} else {
+	    # Write cursor read instruction to the kernel.
+	    gki[GKI_GETCURSOR_CN] = cursor
+	    call write (gk_fd[fd], gki, GKI_GETCURSOR_LEN * SZ_SHORT)
+
+	    # If the kernel is a subprocess we must call PR_PSIO to allow the
+	    # kernel to read the instruction and return the cursor value.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_READ)
+		call seek (fd, BOFL)
+	    } else
+		call flush (gk_fd[fd])
+	}
+
+	# Read and decode the cursor value instruction.
+	nchars = GKI_CURSORVALUE_LEN * SZ_SHORT
+	if (read (fd, cur, nchars) < nchars)
+	    key = EOF
+	else if (cur[1] != BOI || cur[2] != GKI_CURSORVALUE)
+	    call syserr (SYS_GGCUR)
+	else {
+	    cn     = cur[GKI_CURSORVALUE_CN]
+	    key    = cur[GKI_CURSORVALUE_KEY]
+	    sx     = cur[GKI_CURSORVALUE_SX]
+	    sy     = cur[GKI_CURSORVALUE_SY]
+	    raster = cur[GKI_CURSORVALUE_RN]
+	    rx     = cur[GKI_CURSORVALUE_RX]
+	    ry     = cur[GKI_CURSORVALUE_RY]
+	}
+
+	call fseti (fd, F_CANCEL, OK)
+end
diff --git a/sys/gio/gki/gkigetwcs.x b/sys/gio/gki/gkigetwcs.x
new file mode 100644
index 00000000..f6aa07c2
--- /dev/null
+++ b/sys/gio/gki/gkigetwcs.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<gki.h>
+
+# GKI_GETWCS -- Retrieve the WCS from the CL process.  Used when opening a
+# (non-metafile) device in append mode.
+#
+# BOI GKI_GETWCS L N
+#
+#        L(i)           3
+#	 N(i)		number of words of WCS data to be read
+
+procedure gki_getwcs (fd, wcs, len_wcs)
+
+int	fd			# input/output file
+int	wcs[ARB]		# array of WCS structures (output)
+int	len_wcs			# number of ints (struct units) in array
+
+int	nchars, nwords, read()
+short	gki[GKI_GETWCS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_GETWCS/, gki[3] /GKI_GETWCS_LEN/
+errchk	syserr, read, write, flush
+include	"gki.com"
+
+begin
+	nwords = (len_wcs * SZ_INT / SZ_SHORT)
+	gki[GKI_GETWCS_N] = nwords
+
+	# Request CL to send SETWCS instruction back to us.  The directive
+	# must be sent on the pseudofile control stream.
+
+	call write (PSIOCTRL, fd, SZ_INT32)
+	call write (PSIOCTRL, gki, GKI_GETWCS_LEN * SZ_SHORT)
+	call flush (PSIOCTRL)
+
+	# Read the wcs data.  This is returned on the process CLIN channel 
+	# by the CL.
+
+	nchars = nwords * SZ_SHORT
+	if (read (CLIN, wcs, nchars) != nchars)
+	    call syserr (SYS_GGETWCS)
+end
diff --git a/sys/gio/gki/gkiinit.x b/sys/gio/gki/gkiinit.x
new file mode 100644
index 00000000..0813a708
--- /dev/null
+++ b/sys/gio/gki/gkiinit.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_INIT -- Initialize GKI i/o on a graphics stream.  Called by GOPEN to
+# make the connection to either a metacode stream file or an inline kernel.
+# If the stream has already been directed to a kernel we do nothing, else
+# we initialize the stream as for a metacode file or remote kernel.  If
+# gki_inline is called before gopen then this procedure is a nop.
+
+procedure gki_init (stream)
+
+int	stream			# graphics stream to be redirected
+include	"gki.com"
+
+begin
+	if (gk_type[stream] == NULL) {
+	    gk_type[stream] = TY_FILE
+	    gk_fd[stream] = stream
+	}
+end
diff --git a/sys/gio/gki/gkiinline.x b/sys/gio/gki/gkiinline.x
new file mode 100644
index 00000000..87fc1f29
--- /dev/null
+++ b/sys/gio/gki/gkiinline.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_INLINE_KERNEL -- Identify a graphics stream for use with an inline
+# kernel, i.e., with a kernel linked into the same process as the high level
+# code which calls the GKI procedures.  At present there may be at most one
+# inline kernel at a time.  The entry point addresses of the kernel procedures
+# are passed in the array DD.  Subsequent GKI calls for the named stream will
+# result in direct calls to the inline kernel without encoding and decoding
+# GKI instructions, hence this is the most efficient mode of operation.
+
+procedure gki_inline_kernel (stream, dd)
+
+int	stream			# graphics stream to be redirected
+int	dd[ARB]			# device driver for the kernel
+include	"gki.com"
+
+begin
+	gk_type[stream] = TY_INLINE
+	call amovi (dd, gk_dd, LEN_GKIDD)
+end
diff --git a/sys/gio/gki/gkikern.x b/sys/gio/gki/gkikern.x
new file mode 100644
index 00000000..95c8e648
--- /dev/null
+++ b/sys/gio/gki/gkikern.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SUBKERNEL -- Identify a graphics stream for use with a kernel in a
+# connected subprocess of the current process.  This type of kernel is
+# equivalent to a file for all of the output instructions, but the input
+# instructions (e.g., read cursor) must fiddle with process i/o and need
+# additional information to do so, i.e., the process id number of the kernel
+# process, and the entry point address of the PR_PSIO procedure.  We do not
+# wish to directly reference the latter procedure as this would require
+# all processes which use GKI to link in the process control code, even if
+# they never talk directly to a process.  Note that processes which talk to
+# an external kernel via the CL do so with the normal file interface, hence
+# do not need to call us.  We are called by the GIOTR (cursor mode) code in
+# the CL process when an external kernel is spawned.
+
+procedure gki_subkernel (stream, pid, prpsio_epa)
+
+int	stream			# graphics stream to be redirected
+int	pid			# process id of kernel process
+int	prpsio_epa		# epa of the etc$prpsio procedure.
+include	"gki.com"
+
+begin
+	gk_type[stream] = pid
+	gk_fd[stream] = stream
+	gk_prpsio = prpsio_epa
+end
diff --git a/sys/gio/gki/gkiopen.x b/sys/gio/gki/gkiopen.x
new file mode 100644
index 00000000..562ed8c3
--- /dev/null
+++ b/sys/gio/gki/gkiopen.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_OPENWS -- Open workstation.
+#
+# BOI GKI_OPENWS L M N D
+#    
+#        L(i)            5 + N
+#        M(i)            access mode (APPEND=4, NEW_FILE=5, TEE=6)
+#        N(i)            number of characters in field D
+#        D(Nc)           device name as in graphcap file
+
+procedure gki_openws (fd, device, mode)
+
+int	fd			# output file
+char	device[ARB]		# device name
+int	mode			# access mode
+
+int	ip, n, epa, nchars
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (device)
+	call salloc (gki, GKI_OPENWS_LEN + n, TY_SHORT)
+
+	# Pack the device name as a SHORT integer array.
+	op = gki + GKI_OPENWS_D - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = device[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_OPENWS]
+	    if (epa != 0)
+		call zcall3 (epa, Mems[gki+GKI_OPENWS_D-1], n, mode)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_OPENWS
+	    Mems[gki+2] = GKI_OPENWS_LEN + n
+	    Mems[gki+GKI_OPENWS_M-1] = mode
+	    Mems[gki+GKI_OPENWS_N-1] = n
+
+	    # Send a copy of the open workstation directive to PSIOCTRL in
+	    # the CL process to connect the graphics stream to a kernel,
+	    # before writing to the graphics stream.  The GKI instruction
+	    # must be preceded by the integer value of the stream number.
+
+	    nchars = (GKI_OPENWS_LEN + n) * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, Mems[gki], nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], Mems[gki], nchars)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkipca.x b/sys/gio/gki/gkipca.x
new file mode 100644
index 00000000..b2cf30ab
--- /dev/null
+++ b/sys/gio/gki/gkipca.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_PUTCELLARRAY -- Output a cell array (pixel array).
+#
+# BOI GKI_PUTCELLARRAY L LL UR NC NL P
+#    
+#        L(i)            9 + (NC * NL)
+#        LL(p)           coordinates of lower left corner of output area
+#        UR(p)           coordinates of upper right corner of output area
+#        NC(i)           number of columns in array
+#        NL(i)           number of lines in array
+#        P(NCNLi)        array of color indices (pixels) stored by row
+
+procedure gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+
+int	fd			# output file
+int	nx, ny			# number of columns and lines in M
+short	m[nx,ny]		# pixel array
+int	x1, y1			# lower left corner of window to be written
+int	x2, y2			# upper right corner of window to be written
+
+int	epa
+short	gki[GKI_PUTCELLARRAY_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PUTCELLARRAY/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PUTCELLARRAY]
+	    if (epa != 0)
+		call zcall7 (epa, m, nx,ny, x1,y1, x2,y2)
+	} else {
+	    gki[GKI_PUTCELLARRAY_L]    = GKI_PUTCELLARRAY_LEN + (nx * ny)
+	    gki[GKI_PUTCELLARRAY_LL]   = x1
+	    gki[GKI_PUTCELLARRAY_LL+1] = y1
+	    gki[GKI_PUTCELLARRAY_UR]   = x2
+	    gki[GKI_PUTCELLARRAY_UR+1] = y2
+	    gki[GKI_PUTCELLARRAY_NC]   = nx
+	    gki[GKI_PUTCELLARRAY_NL]   = ny
+
+	    call write (gk_fd[fd], gki, GKI_PUTCELLARRAY_LEN)
+	    call write (gk_fd[fd], m, (nx * ny) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkipl.x b/sys/gio/gki/gkipl.x
new file mode 100644
index 00000000..7d36b749
--- /dev/null
+++ b/sys/gio/gki/gkipl.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_POLYLINE -- Output a polyline.
+#
+# BOI GKI_POLYLINE L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points in the polyline
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_polyline (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polyline
+int	npts			# number of (x,y) points in polyline
+
+int	epa
+short	gki[GKI_POLYLINE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_POLYLINE/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_POLYLINE]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_POLYLINE_L] = GKI_POLYLINE_LEN + (npts * 2)
+	    gki[GKI_POLYLINE_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_POLYLINE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiplset.x b/sys/gio/gki/gkiplset.x
new file mode 100644
index 00000000..1a7b092f
--- /dev/null
+++ b/sys/gio/gki/gkiplset.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_PLSET -- Set the polyline attributes.
+#
+# BOI GKI_PLSET L LT LW CI
+#
+#        L(i)            6
+#        LT(i)           linetype number
+#        LW(r)           linewidth scale factor
+#        CI(i)           polyline color index
+
+procedure gki_plset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to polyline attribute structure
+
+int	epa
+short	gki[GKI_PLSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PLSET/, gki[3] /GKI_PLSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_PLSET_LT] = PL_LTYPE(ap)
+	gki[GKI_PLSET_LW] = GKI_PACKREAL (PL_WIDTH(ap))
+	gki[GKI_PLSET_CI] = PL_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PLSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_PLSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkipm.x b/sys/gio/gki/gkipm.x
new file mode 100644
index 00000000..ea493b54
--- /dev/null
+++ b/sys/gio/gki/gkipm.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_POLYMARKER -- Output a polymarker.
+#
+# BOI GKI_POLYMARKER L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points in the polymarker
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_polymarker (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polymarker
+int	npts			# number of (x,y) points in polymarker
+
+int	epa
+short	gki[GKI_POLYMARKER_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_POLYMARKER/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_POLYMARKER]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_POLYMARKER_L] = GKI_POLYMARKER_LEN + (npts * 2)
+	    gki[GKI_POLYMARKER_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_POLYMARKER_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkipmset.x b/sys/gio/gki/gkipmset.x
new file mode 100644
index 00000000..7bdc27ac
--- /dev/null
+++ b/sys/gio/gki/gkipmset.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_PMSET -- Set the polymarker attributes.
+#
+# BOI GKI_PMSET L MT MW CI
+#
+#        L(i)            6
+#        MT(i)           marktype (not used at present)
+#        MW(i)           marksize, NDC coords (not used at present)
+#        CI(i)           marker color index
+
+procedure gki_pmset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to polymarker attribute structure
+
+int	epa
+short	gki[GKI_PMSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PMSET/, gki[3] /GKI_PMSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_PMSET_MT] = PM_LTYPE(ap)
+	gki[GKI_PMSET_MW] = GKI_PACKREAL (PM_WIDTH(ap))
+	gki[GKI_PMSET_CI] = PM_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PMSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_PMSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiprint.x b/sys/gio/gki/gkiprint.x
new file mode 100644
index 00000000..14e623bd
--- /dev/null
+++ b/sys/gio/gki/gkiprint.x
@@ -0,0 +1,820 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+
+.help gkiprint
+.nf __________________________________________________________________________
+GKIPRINT -- Graphics kernel for decoding metacode.  This graphics kernel
+formats metacode instructions into readable form and prints them on the output
+file.  The gkiprint kernel is useful for examining metafiles and for
+debugging kernels which drive specific devices.  The driver consists of the
+following procedures:
+
+	     gkp_openws (devname, n, mode)
+	    gkp_closews (devname, n)
+       gkp_deactivatews (flags)
+       gkp_reactivatews (flags)
+	    gkp_mftitle (title, n)			**
+	      gkp_clear (dummy)
+	     gkp_cancel (dummy)
+	      gkp_flush (dummy)
+	   gkp_polyline (p, npts)
+	 gkp_polymarker (p, npts)
+	       gkp_text (x, y, text, n)
+	   gkp_fillarea (p, npts)
+       gkp_getcellarray (m, nx, ny, x1,y1, x2,y2)
+       gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+	  gkp_setcursor (x, y, cursor)
+	      gkp_plset (gki)
+	      gkp_pmset (gki)
+	      gkp_txset (gki)
+	      gkp_faset (gki)
+	  gkp_getcursor (cursor)
+	     gkp_escape (fn, instruction, nwords)	**
+	     gkp_setwcs (wcs, nwords)			**
+	     gkp_getwcs (wcs, nwords)			**
+	    gkp_unknown (gki)				**
+
+A GKI driven device driver may implement any subset of these procedures.
+The starred procedures should be omitted by most drivers.  In particular,
+the SETWCS and GETWCS instructions are internal instructions which should
+be ignored by ordinary device drivers.  The procedure names may be anything,
+but the arguments lists must be as shown.  All coordinates are in GKI units,
+0 to 32767.  Character strings are passed in ASCII, one character per metacode
+word.  Whenever a GKI character string appears as an array argument in the
+argument list of a procedure, the count N of the number of characters in the
+string follows as the next argument.  GKI character strings are not EOS
+delimited.  Polyline, polymarker, and fillarea data is passed as an array
+of (x,y) points P, in GKI coordinates, defining the polyline or polygon to
+be plotted.
+
+One additional procedure, GKP_INSTALL, is called by the main program of the
+graphics kernel task to install the debugging driver, i.e., to fill the DD
+array with the entry point addresses of the driver procedures.  For a normal
+driver this function is performed by a user supplied procedure named
+GKOPEN (graphics kernel open).  The user supplied kernel procedures will
+be called to execute each instruction as the instructions are decoded by the
+main routine.  The user supplied procedure GKCLOSE will be called when
+interpretation ends and the task is about to exit.
+
+		 gkopen (dd)
+		gkclose ()
+
+Do not confuse GKOPEN and GKCLOSE, which open and close the graphics kernel,
+with GKI_OPENWS and GKI_CLOSEWS, the metacode instructions used to direct
+an opened kernel to open and close workstations.
+.endhelp ___________________________________________________________________
+
+
+# GKP_INSTALL -- Install the GKI debugging kernel as a graphics kernel
+# device driver.  The device table DD consists of an array of the entry
+# point addresses for the driver procedures.  If a driver does not implement
+# a particular instruction the table entry for that procedure may be set
+# to zero, causing the interpreter to ignore the instruction.
+
+procedure gkp_install (dd, out_fd, verbose_output, use_gkiunits)
+
+int	dd[ARB]			# device table to be initialized
+int	out_fd			# output file
+int	verbose_output		# verbose output desired
+int	use_gkiunits		# print coords in GKI units rather than NDC
+
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+extern	gkp_openws(), gkp_closews(), gkp_mftitle(), gkp_clear(), gkp_cancel()
+extern	gkp_flush(), gkp_polyline(), gkp_polymarker(), gkp_text()
+extern	gkp_fillarea(), gkp_putcellarray(), gkp_setcursor(), gkp_plset()
+extern	gkp_pmset(), gkp_txset(), gkp_faset(), gkp_getcursor()
+extern	gkp_getcellarray(), gkp_escape(), gkp_setwcs(), gkp_getwcs()
+extern	gkp_unknown(), gkp_reactivatews(), gkp_deactivatews()
+
+begin
+	# Set the GDC internal parameters.
+	fd = out_fd
+	stream = NULL
+	gkiunits = use_gkiunits
+	verbose = verbose_output
+
+	# Install the device driver.
+	call zlocpr (gkp_openws,	dd[GKI_OPENWS])
+	call zlocpr (gkp_closews,	dd[GKI_CLOSEWS])
+	call zlocpr (gkp_reactivatews,	dd[GKI_REACTIVATEWS])
+	call zlocpr (gkp_deactivatews,	dd[GKI_DEACTIVATEWS])
+	call zlocpr (gkp_mftitle,	dd[GKI_MFTITLE])
+	call zlocpr (gkp_clear,		dd[GKI_CLEAR])
+	call zlocpr (gkp_cancel,	dd[GKI_CANCEL])
+	call zlocpr (gkp_flush,		dd[GKI_FLUSH])
+	call zlocpr (gkp_polyline,	dd[GKI_POLYLINE])
+	call zlocpr (gkp_polymarker,	dd[GKI_POLYMARKER])
+	call zlocpr (gkp_text,		dd[GKI_TEXT])
+	call zlocpr (gkp_fillarea,	dd[GKI_FILLAREA])
+	call zlocpr (gkp_putcellarray,	dd[GKI_PUTCELLARRAY])
+	call zlocpr (gkp_setcursor,	dd[GKI_SETCURSOR])
+	call zlocpr (gkp_plset,		dd[GKI_PLSET])
+	call zlocpr (gkp_pmset,		dd[GKI_PMSET])
+	call zlocpr (gkp_txset,		dd[GKI_TXSET])
+	call zlocpr (gkp_faset,		dd[GKI_FASET])
+	call zlocpr (gkp_getcursor,	dd[GKI_GETCURSOR])
+	call zlocpr (gkp_getcellarray,	dd[GKI_GETCELLARRAY])
+	call zlocpr (gkp_escape,	dd[GKI_ESCAPE])
+	call zlocpr (gkp_setwcs,	dd[GKI_SETWCS])
+	call zlocpr (gkp_getwcs,	dd[GKI_GETWCS])
+	call zlocpr (gkp_unknown,	dd[GKI_UNKNOWN])
+end
+
+
+# GKP_CLOSE -- Close the GKP kernel.
+
+procedure gkp_close()
+begin
+end
+
+
+# GKP_GRSTREAM -- Set the FD of the graphics stream, from which we shall read
+# metacode instructions and to which we shall return cell arrays and cursor
+# values.
+
+procedure gkp_grstream (graphics_stream)
+
+int	graphics_stream		# FD of the new graphics stream
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	stream = graphics_stream
+end
+
+
+# GKP_OPENWS -- Open the named workstation.
+
+procedure gkp_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+int	junk
+pointer	sp, buf
+int	itoc()
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	call achtsc (devname, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "open_workstation '%s', mode=%s\n")
+	    call pargstr (Memc[buf])
+	    switch (mode) {
+	    case NEW_FILE:
+		call pargstr ("new_file")
+	    case APPEND:
+		call pargstr ("append")
+	    default:
+		junk = itoc (mode, Memc[buf], SZ_FNAME)
+	    }
+	
+	call sfree (sp)
+end
+
+
+# GKP_CLOSEWS -- Close the named workstation.
+
+procedure gkp_closews (devname, n)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (devname, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "close_workstation '%s'\n")
+	    call pargstr (Memc[buf])
+	call flush (fd)
+	
+	call sfree (sp)
+end
+
+
+# GKP_REACTIVATEWS -- Reactivate the workstation (enable graphics).
+
+procedure gkp_reactivatews (flags)
+
+int	flags			# action flags
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "reactivatews %d\n")
+	    call pargi (flags)
+end
+
+
+# GKP_DEACTIVATEWS -- Deactivate the workstation (disable graphics).
+
+procedure gkp_deactivatews (flags)
+
+int	flags			# action flags
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "deactivatews %d\n")
+	    call pargi (flags)
+	call flush (fd)
+end
+
+
+# GKP_MFTITLE -- Metafile title or comment.  A nonfunctional instruction used
+# to document a metafile.
+
+procedure gkp_mftitle (title, n)
+
+short	title[ARB]		# title string
+int	n			# length of title string
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (title, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "title '%s'\n")
+	    call pargstr (Memc[buf])
+	
+	call sfree (sp)
+end
+
+
+# GKP_CLEAR -- Clear the workstation screen.
+
+procedure gkp_clear (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "clear\n")
+end
+
+
+# GKP_CANCEL -- Cancel output.
+
+procedure gkp_cancel (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "cancel\n")
+	call flush (fd)
+end
+
+
+# GKP_FLUSH -- Flush output.
+
+procedure gkp_flush (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "flush\n")
+	call flush (fd)
+end
+
+
+# GKP_POLYLINE -- Draw a polyline.
+
+procedure gkp_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on polyline.
+	call gkp_pstat (fd, p, npts, "polyline", verbose, gkiunits)
+end
+
+
+# GKP_POLYMARKER -- Draw a polymarker.
+
+procedure gkp_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on polymarker.
+	call gkp_pstat (fd, p, npts, "polymarker", verbose, gkiunits)
+end
+
+
+# GKP_FILLAREA -- Fill a closed area.
+
+procedure gkp_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on the fillarea polygon.
+	call gkp_pstat (fd, p, npts, "fillarea", verbose, gkiunits)
+end
+
+
+# GKP_TEXT -- Draw a text string.
+
+procedure gkp_text (x, y, text, n)
+
+int	x, y			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (text, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "text %5d, %5d, '%s'\n")
+		call pargi (x)
+		call pargi (y)
+		call pargstr (Memc[buf])
+	} else {
+	    call fprintf (fd, "text %4.2f, %4.2f, '%s'\n")
+		call pargr (real(x) / GKI_MAXNDC)
+		call pargr (real(y) / GKI_MAXNDC)
+		call pargstr (Memc[buf])
+	}
+	
+	call sfree (sp)
+end
+
+
+# GKP_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+short	m[nx,ny]		# cell array
+int	x1, y1			# lower left corner of output window
+int	x2, y2			# lower left corner of output window
+
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "put_cellarray nx=%d, ny=%d, ")
+	    call pargi (nx)
+	    call pargi (ny)
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "x1=%5d, y1=%5d, x2=%5d, y2=%5d\n")
+		call pargi (x1)
+		call pargi (y1)
+		call pargi (x2)
+		call pargi (y2)
+	} else {
+	    call fprintf (fd, "x1=%4.2f, y1=%4.2f, x2=%4.2f, y2=%4.2f\n")
+		call pargr (real(x1) / GKI_MAXNDC)
+		call pargr (real(y1) / GKI_MAXNDC)
+		call pargr (real(x2) / GKI_MAXNDC)
+		call pargr (real(y2) / GKI_MAXNDC)
+	}
+
+	if (verbose == YES)
+	    call gkp_dump (fd, m, (nx * ny))
+end
+
+
+# GKP_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkp_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_cellarray nx=%d, ny=%d, ")
+	    call pargi (nx)
+	    call pargi (ny)
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "x1=%5d, y1=%5d, x2=%5d, y2=%5d\n")
+		call pargi (x1)
+		call pargi (y1)
+		call pargi (x2)
+		call pargi (y2)
+	} else {
+	    call fprintf (fd, "x1=%4.2f, y1=%4.2f, x2=%4.2f, y2=%4.2f\n")
+		call pargr (real(x1) / GKI_MAXNDC)
+		call pargr (real(y1) / GKI_MAXNDC)
+		call pargr (real(x2) / GKI_MAXNDC)
+		call pargr (real(y2) / GKI_MAXNDC)
+	}
+
+	if (stream == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (buf, nx * ny, TY_SHORT)
+	call amovks (short(-1), Mems[buf], nx * ny)
+
+	call flush (fd)
+	iferr {
+	    call gki_retcellarray (stream, Mems[buf], nx * ny) 
+	    call flush (stream)
+	} then
+	    ;
+	
+	call sfree (sp)
+end
+
+
+# GKP_SETCURSOR -- Set the position of a cursor.
+
+procedure gkp_setcursor (x, y, cursor)
+
+int	x, y			# new position of cursor
+int	cursor			# cursor to be set
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	if (gkiunits == YES) {
+	    call fprintf (fd, "set_cursor %5d, %5d, cursor=%d\n")
+		call pargi (x)
+		call pargi (y)
+		call pargi (cursor)
+	} else {
+	    call fprintf (fd, "set_cursor %4.2f, %4.2f, cursor=%d\n")
+		call pargr (real(x) / GKI_MAXNDC)
+		call pargr (real(y) / GKI_MAXNDC)
+		call pargi (cursor)
+	}
+end
+
+
+# GKP_GETCURSOR -- Get the position of a cursor.
+
+procedure gkp_getcursor (cursor)
+
+int	cursor
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_cursor cursor=%d\n")
+	    call pargi (cursor)
+	call flush (fd)
+
+	if (stream != NULL)
+	    iferr {
+		# gki_retcursorvalue (stream, cn, key, sx, sy, rn, rx, ry)
+		call gki_retcursorvalue (stream, 0, EOF, 0, 0, 0, 0, 0)
+		call flush (stream)
+	    } then
+		;
+end
+
+
+# GKP_PLSET -- Set the polyline attributes.
+
+procedure gkp_plset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_polyline ltype=%d, lwidth=%0.2f, color=%d\n")
+	    call pargs (gki[GKI_PLSET_LT])
+	    call pargr (GKI_UNPACKREAL (gki[GKI_PLSET_LW]))
+	    call pargs (gki[GKI_PLSET_CI])
+end
+
+
+# GKP_PMSET -- Set the polymarker attributes.
+
+procedure gkp_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_polymarker mtype=%d, mwidth=%0.2f, color=%d\n")
+	    call pargs (gki[GKI_PMSET_MT])
+	    call pargr (GKI_UNPACKREAL (gki[GKI_PMSET_MW]))
+	    call pargs (gki[GKI_PMSET_CI])
+end
+
+
+# GKP_FASET -- Set the fillarea attributes.
+
+procedure gkp_faset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_fillarea style=%d, color=%d\n")
+	    call pargs (gki[GKI_FASET_FS])
+	    call pargs (gki[GKI_FASET_CI])
+end
+
+
+# GKP_TXSET -- Set the text drawing attributes.
+
+procedure gkp_txset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_text up=%d, path=%d, hjustify=%s, ")
+	    call pargs (gki[GKI_TXSET_UP])
+	    call gkp_txparg (gki[GKI_TXSET_P])
+	    call gkp_txparg (gki[GKI_TXSET_HJ])
+	call fprintf (fd, "vjustify=%s, font=%s,\n")
+	    call gkp_txparg (gki[GKI_TXSET_VJ])
+	    call gkp_txparg (gki[GKI_TXSET_F])
+
+	call fprintf (fd, "\tsize=%0.2f, spacing=%0.2f, color=%d, quality=%s\n")
+	    call pargr (GKI_UNPACKREAL (gki[GKI_TXSET_SZ]))
+	    call pargr (GKI_UNPACKREAL (gki[GKI_TXSET_SP]))
+	    call pargs (gki[GKI_TXSET_CI])
+	    call gkp_txparg (gki[GKI_TXSET_Q])
+end
+
+
+# GKP_ESCAPE -- Device dependent instruction.
+
+procedure gkp_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "escape %d, nwords=%d\n")
+	    call pargi (fn)
+	    call pargi (nwords)
+
+	# Dump the instruction.
+	if (verbose == YES)
+	    call gkp_dump (fd, instruction, nwords)
+end
+
+
+# GKP_SETWCS -- Set the world coordinate systems.  Internal GIO instruction.
+
+procedure gkp_setwcs (wcs, nwords)
+
+short	wcs[ARB]		# WCS data
+int	nwords			# number of words of data
+
+int	i, nwcs
+pointer	sp, wcs_temp, w
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (wcs_temp, LEN_WCSARRAY, TY_STRUCT)
+
+	call fprintf (fd, "set_wcs nwords=%d\n")
+	    call pargi (nwords)
+
+	nwcs = nwords * SZ_SHORT / SZ_STRUCT / LEN_WCS
+	if (verbose == YES && nwcs > 1) {
+	    call amovi (wcs, Memi[wcs_temp], nwcs * LEN_WCS)
+
+	    do i = 1, nwcs {
+		w = ((i - 1) * LEN_WCS) + wcs_temp
+		if ((WCS_WX1(w) > EPSILON) ||
+		    (abs(1.0 - WCS_WX2(w)) > EPSILON) ||
+		    (WCS_WY1(w) > EPSILON) ||
+		    (abs(1.0 - WCS_WY2(w)) > EPSILON)) {
+
+		    call fprintf (fd, "\t%2d %g %g %g %g  ")
+			call pargi (i)
+			call pargr (WCS_WX1(w))
+			call pargr (WCS_WX2(w))
+			call pargr (WCS_WY1(w))
+			call pargr (WCS_WY2(w))
+
+		    call fprintf (fd, "%4.2f %4.2f %4.2f %4.2f  ")
+			call pargr (WCS_SX1(w))
+			call pargr (WCS_SX2(w))
+			call pargr (WCS_SY1(w))
+			call pargr (WCS_SY2(w))
+
+		    call fprintf (fd, "%d %d %d\n")
+			call pargi (WCS_XTRAN(w))
+			call pargi (WCS_YTRAN(w))
+			call pargi (WCS_CLIP(w))
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# GKP_GETWCS -- Get the world coordinate systems.  Internal GIO instruction.
+
+procedure gkp_getwcs (wcs, nwords)
+
+short	wcs[ARB]		# WCS data
+int	nwords			# number of words of data
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_wcs nwords=%d\n")
+	    call pargi (nwords)
+end
+
+
+# GKP_UNKNOWN -- The unknown instruction.  Called by the interpreter whenever
+# an unrecognized opcode is encountered.  Should never be called.
+
+procedure gkp_unknown (gki)
+
+short	gki[ARB]		# the GKI instruction
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "unknown\n")
+end
+
+
+# GKP_PSTAT -- Compute and print on the standard error output a statistical
+# summary of a sequence of (x,y) points.  If verbose mode is enabled, follow
+# this by the values of the points themselves.
+
+procedure gkp_pstat (fd, p, npts, label, verbose, gkiunits)
+
+int	fd			# output file
+short	p[npts]			# array of points, i.e., (x,y) pairs
+int	npts			# number of points
+char	label[ARB]		# type of instruction
+int	verbose			# verbose output desired
+int	gkiunits		# print coords in GKI rather than NDC units
+
+int	i
+real	x, y, xsum, xmin, xmax, ysum, ymin, ymax, scale
+
+begin
+	if (gkiunits == YES)
+	    scale = 1.0
+	else
+	    scale = 1.0 / GKI_MAXNDC
+
+	xsum = 0
+	xmin = 1.0
+	xmax = 0
+	ysum = 0
+	ymin = 1.0
+	ymax = 0
+
+	# Compute mean, minimum, and maximum values.
+	do i = 1, npts * 2, 2 {
+	    x = real (p[i]) * scale
+	    xsum = xsum + x
+	    if (x < xmin)
+		xmin = x
+	    if (x > xmax)
+		xmax = x
+
+	    y = real (p[i+1]) * scale
+	    ysum = ysum + y
+	    if (y < ymin)
+		ymin = y
+	    if (y > ymax)
+		ymax = y
+	}
+
+	# Print summary of statistics.
+	call fprintf (fd, "%s np=%d, ")
+	    call pargstr (label)
+	    call pargi (npts)
+
+	if (gkiunits == YES)
+	    call fprintf (fd, "xmin=%d,xmax=%d,xavg=%d, ")
+	else
+	    call fprintf (fd, "xmin=%4.2f,xmax=%4.2f,xavg=%4.2f, ")
+	    if (npts == 0) {
+		do i = 1, 3
+		    call pargr (INDEF)
+	    } else {
+		call pargr (xmin)
+		call pargr (xmax)
+		call pargr (xsum / npts)
+	    }
+
+	if (gkiunits == YES)
+	    call fprintf (fd, "ymin=%d,ymax=%d,yavg=%d\n")
+	else
+	    call fprintf (fd, "ymin=%4.2f,ymax=%4.2f,yavg=%4.2f\n")
+	    if (npts == 0) {
+		do i = 1, 3
+		    call pargr (INDEF)
+	    } else {
+		call pargr (ymin)
+		call pargr (ymax)
+		call pargr (ysum / npts)
+	    }
+
+	# Dump the points if verbose output is enabled.
+	if (verbose == NO && npts > 0)
+	    return
+
+	call fprintf (fd, "\t")
+	for (i=1;  i <= npts * 2;  i=i+2) {
+	    if (i > 1 && mod (i-1, 10) == 0)
+		call fprintf (fd, "\n\t")
+	    if (gkiunits == YES)
+		call fprintf (fd, "%5d %5d  ")
+	    else
+		call fprintf (fd, "%5.3f %5.3f  ")
+		call pargr (real(p[i])   * scale)
+		call pargr (real(p[i+1]) * scale)
+	}
+	call fprintf (fd, "\n")
+end
+
+
+# GKP_DUMP -- Print a sequence of metacode words as a table, formatted eight
+# words per line, in decimal.
+
+procedure gkp_dump (fd, data, nwords)
+
+int	fd			# output file
+short	data[ARB]		# metacode data
+int	nwords			# number of words of data
+int	i
+
+begin
+	if (nwords <= 0)
+	    return
+
+	call fprintf (fd, "\t")
+
+	for (i=1;  i <= nwords;  i=i+1) {
+	    if (i > 1 && mod (i-1, 8) == 0)
+		call fprintf (fd, "\n\t")
+	    call fprintf (fd, "%7d")
+		call pargs (data[i])
+	}
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/gki/gkirca.x b/sys/gio/gki/gkirca.x
new file mode 100644
index 00000000..54b38813
--- /dev/null
+++ b/sys/gio/gki/gkirca.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_RETCELLARRAY -- Return a cell array (pixel array).  Used by a graphics
+# kernel to return a cell array to GIO in response to a GETCELLARRAY
+# instruction.
+#
+# BOI GKI_CELLARRAY L NP P
+#    
+#        L(i)            4 + NP
+#        NP(i)           number of pixels in cell array
+#        P(NPi)          cell array
+
+procedure gki_retcellarray (fd, m, np)
+
+int	fd			# output file
+short	m[ARB]			# cell array
+int	np			# number of pixels in cell array
+
+short	gki[GKI_CELLARRAY_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CELLARRAY/
+
+begin
+	gki[GKI_CELLARRAY_L] = GKI_CELLARRAY_LEN + np
+	gki[GKI_CELLARRAY_NP] = np
+
+	call write (fd, gki, GKI_CELLARRAY_LEN * SZ_SHORT)
+	call write (fd, m, np * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkircval.x b/sys/gio/gki/gkircval.x
new file mode 100644
index 00000000..9bfb3052
--- /dev/null
+++ b/sys/gio/gki/gkircval.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_RETCURSORVALUE -- Return a cursor value.  Used by a graphics kernel to
+# return a cursor value to GIO in response to a GETCURSOR instruction.
+#
+#                BOI GKI_CURSORVALUE L CN KEY SX SY RN RX RY
+#
+#        where
+#
+#                L(i)            10
+#                CN(i)           cursor number
+#                KEY(i)          keystroke value (>= 0 or EOF)
+#                SX(i)           NDC X screen coordinate of cursor
+#                SY(i)           NDC Y screen coordinate of cursor
+#                RN(i)           raster number or zero
+#                RX(i)           NDC X raster coordinate of cursor
+#                RY(i)           NDC Y raster coordinate of cursor
+#
+# The screen or display window coordinates SX and SY of the cursor are
+# returned for all devices.  Only some devices support multiple rasters.
+# If the device supports rasters and the cursor is in a raster when read, the
+# raster number and raster coordinates are returned in RN,RX,RY.  This is in
+# addition to the screen coordinates SX,SY.  If raster coordinates are not
+# returned, the raster number will be set to zero and RX,RY will be the same
+# as SX,SY.
+
+procedure gki_retcursorvalue (fd, cn, key, sx, sy, raster, rx, ry)
+
+int	fd			#I output file
+int	cn			#I cursor number
+int	key			#I keystroke value
+int	sx, sy			#I screen coordinates of cursor (GKI coords)
+int	raster			#I raster number
+int	rx, ry			#I raster coordinates of cursor (GKI coords)
+
+short	gki[GKI_CURSORVALUE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CURSORVALUE/, gki[3] /GKI_CURSORVALUE_LEN/
+
+begin
+	gki[GKI_CURSORVALUE_CN ] = cn
+	gki[GKI_CURSORVALUE_KEY] = key
+	gki[GKI_CURSORVALUE_SX ] = sx
+	gki[GKI_CURSORVALUE_SY ] = sy
+	gki[GKI_CURSORVALUE_RN ] = raster
+	gki[GKI_CURSORVALUE_RX ] = rx
+	gki[GKI_CURSORVALUE_RY ] = ry
+
+	call write (fd, gki, GKI_CURSORVALUE_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkireact.x b/sys/gio/gki/gkireact.x
new file mode 100644
index 00000000..a84ad95d
--- /dev/null
+++ b/sys/gio/gki/gkireact.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_REACTIVATEWS -- Reactivate the workstation (enable graphics).
+#
+# BOI GKI_REACTIVATEWS L F
+#    
+#        L(i)            4
+#        F               flags (0,AW_PAUSE,AW_CLEAR)
+
+procedure gki_reactivatews (fd, flags)
+
+int	fd			# output file
+int	flags			# action modifier flags
+
+int	epa, nchars
+short	gki[GKI_REACTIVATEWS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_REACTIVATEWS/, gki[3] /GKI_REACTIVATEWS_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_REACTIVATEWS]
+	    if (epa != 0)
+		call zcall1 (epa, flags)
+
+	} else {
+	    # Send a copy to the pseudofile i/o controller.
+	    gki[GKI_REACTIVATEWS_F] = flags
+	    nchars = GKI_REACTIVATEWS_LEN * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], gki, nchars)
+	}
+end
diff --git a/sys/gio/gki/gkiredir.x b/sys/gio/gki/gkiredir.x
new file mode 100644
index 00000000..3e204bf0
--- /dev/null
+++ b/sys/gio/gki/gkiredir.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_REDIR -- Redirect (or set) a graphics stream.  All i/o will be to the
+# file FD until the graphics stream is reset in another call to GKI_REDIR.
+# The current encoded value for a stream is retured so that a subsequent call
+# (with FD=0) may be made to undo the redirection.  A call with FD<0 may be
+# used to stat the stream without changing anything.  NOTE: This procedure
+# (or either GKI_INLINE_KERNEL or GKI_SUBKERNEL) must be called before using
+# the GKI package for a graphics stream.
+
+procedure gki_redir (stream, fd, old_fd, old_type)
+
+int	stream			# graphics stream to be redirected
+int	fd			# file to be connected to the stream
+int	old_fd, old_type	# old values for later restoration
+
+include	"gki.com"
+
+begin
+	if (fd == NULL) {
+	    gk_type[stream] = old_type
+	    gk_fd[stream]   = old_fd
+	} else {
+	    old_type = gk_type[stream]
+	    old_fd   = gk_fd[stream]
+	    if (fd > 0) {
+		gk_type[stream] = TY_FILE
+		gk_fd[stream] = fd
+	    }
+	}
+end
diff --git a/sys/gio/gki/gkiscur.x b/sys/gio/gki/gkiscur.x
new file mode 100644
index 00000000..f3ca7c53
--- /dev/null
+++ b/sys/gio/gki/gkiscur.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SETCURSOR -- Set the position of a device cursor.
+#
+# BOI GKI_SETCURSOR L CN POS
+#
+#        L(i)            6
+#        CN(i)           cursor number
+#        POS(p)          new cursor position
+
+procedure gki_setcursor (fd, x, y, cursor)
+
+int	fd			# output file
+int	x, y			# new cursor position
+int	cursor			# cursor to be set
+
+int	epa
+short	gki[GKI_SETCURSOR_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_SETCURSOR/, gki[3] /GKI_SETCURSOR_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_SETCURSOR]
+	    if (epa != 0)
+		call zcall3 (epa, x, y, cursor)
+	} else {
+	    gki[GKI_SETCURSOR_CN]    = cursor
+	    gki[GKI_SETCURSOR_POS]   = x
+	    gki[GKI_SETCURSOR_POS+1] = y
+
+	    call write (gk_fd[fd], gki, GKI_SETCURSOR_LEN * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkisetwcs.x b/sys/gio/gki/gkisetwcs.x
new file mode 100644
index 00000000..f8d0e896
--- /dev/null
+++ b/sys/gio/gki/gkisetwcs.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SETWCS -- Copy the set of 16 WCS to the graphics controller in the CL
+# process.  The WCS are transmitted as a binary array of WCS structures.
+#
+# BOI GKI_SETWCS L N WCS
+#
+#        L(i)            4 + N
+#	 N(i)		 length of WCS field in words
+#        WCS             binary copy of the 16 WCS structures, transmitted
+#                            in a single call to WRITE
+
+procedure gki_setwcs (fd, wcs, len_wcs)
+
+int	fd			# output file
+int	wcs[ARB]		# array of WCS structures
+int	len_wcs			# number of ints (struct units) in array
+
+int	nshorts
+short	gki[GKI_SETWCS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_SETWCS/
+include	"gki.com"
+
+begin
+	if (IS_FILE(fd)) {
+	    nshorts = (len_wcs * SZ_INT) / SZ_SHORT
+	    gki[GKI_SETWCS_L] = GKI_SETWCS_LEN + nshorts
+	    gki[GKI_SETWCS_N] = nshorts
+
+	    if (fd >= STDGRAPH && fd <= STDPLOT) {
+		# Send a copy of the WCS information to the PSIO control
+		# stream if the graphics output is a standard graphics stream.
+
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, GKI_SETWCS_LEN * SZ_SHORT)
+		call write (PSIOCTRL, wcs, nshorts * SZ_SHORT)
+		call flush (PSIOCTRL)
+	    }
+
+	    call write (gk_fd[fd], gki, GKI_SETWCS_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], wcs, nshorts * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkititle.x b/sys/gio/gki/gkititle.x
new file mode 100644
index 00000000..397bd50a
--- /dev/null
+++ b/sys/gio/gki/gkititle.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_MFTITLE -- Write the metafile title.
+#
+# BOI GKI_MFTITLE L N T
+#    
+#        L(i)            4 + N
+#        N(i)            number of characters in field T
+#        T(Nc)           title string identifying metafile
+
+procedure gki_mftitle (fd, title)
+
+int	fd			# output file
+char	title[ARB]		# title string
+
+int	epa
+int	ip, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (title)
+	call salloc (gki, GKI_MFTITLE_LEN + n, TY_SHORT)
+
+	# Pack the title name as a SHORT integer array.
+	op = gki + GKI_MFTITLE_T - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = title[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_MFTITLE]
+	    if (epa != 0)
+		call zcall2 (epa, Mems[gki+GKI_MFTITLE_T-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_MFTITLE
+	    Mems[gki+2] = GKI_MFTITLE_LEN + n
+	    Mems[gki+3] = n
+	    call write (gk_fd[fd], Mems[gki], (GKI_MFTITLE_LEN + n) * SZ_SHORT)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkitx.x b/sys/gio/gki/gkitx.x
new file mode 100644
index 00000000..7cc616ba
--- /dev/null
+++ b/sys/gio/gki/gkitx.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_TEXT -- Text drawing instruction.
+#
+# BOI GKI_TEXT L P N T
+#    
+#        L(i)            6 + N
+#        P(p)            starting point of character string
+#        N(i)            number of characters in string T
+#        T(Nc)           string of N ASCII characters
+
+procedure gki_text (fd, x, y, text)
+
+int	fd			# output file
+int	x, y			# position at which text is to be drawn
+char	text[ARB]		# text string to be drawn
+
+int	epa
+int	ip, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (text)
+	call salloc (gki, GKI_TEXT_LEN + n, TY_SHORT)
+
+	# Pack the text string as a SHORT integer array.
+	op = gki + GKI_TEXT_T - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = text[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_TEXT]
+	    if (epa != 0)
+		call zcall4 (epa, x, y, Mems[gki+GKI_TEXT_T-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_TEXT
+	    Mems[gki+2] = GKI_TEXT_LEN + n
+	    Mems[gki+GKI_TEXT_L-1]   = GKI_TEXT_LEN + n
+	    Mems[gki+GKI_TEXT_P-1]   = x
+	    Mems[gki+GKI_TEXT_P-1+1] = y
+	    Mems[gki+GKI_TEXT_N-1]   = n
+
+	    call write (gk_fd[fd], Mems[gki], (GKI_TEXT_LEN + n) * SZ_SHORT)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkitxset.x b/sys/gio/gki/gkitxset.x
new file mode 100644
index 00000000..93f427b9
--- /dev/null
+++ b/sys/gio/gki/gkitxset.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_TXSET -- Set the text drawing attributes.
+#
+# BOI GKI_TXSET L UP SZ SP P HJ VJ F Q CI
+#
+#        L(i)            12
+#        UP(i)           character up vector (degrees)
+#        SZ(r)           character size scale factor
+#        SP(r)           character spacing
+#        P(i)            path (0,1=right,2=left,3=up,4=down)
+#        HJ(i)           horizontal justification
+#                            (0=normal,1=center,2=left,3=right)
+#        VJ(i)           vertical justification
+#                            (0=normal,1=center,2=up,3=down)
+#        F(i)            font (0,1=roman,2=greek,3=italic,4=bold)
+#        Q(i)            quality (0=normal,1=low,2=medium,3=high)
+#        CI(i)           text color index
+
+procedure gki_txset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to attribute structure
+
+int	epa
+short	gki[GKI_TXSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_TXSET/, gki[3] /GKI_TXSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_TXSET_UP] = TX_UP(ap)
+	gki[GKI_TXSET_SZ] = GKI_PACKREAL (TX_SIZE(ap))
+	gki[GKI_TXSET_SP] = GKI_PACKREAL (TX_SPACING(ap))
+	gki[GKI_TXSET_P ] = TX_PATH(ap)
+	gki[GKI_TXSET_HJ] = TX_HJUSTIFY(ap)
+	gki[GKI_TXSET_VJ] = TX_VJUSTIFY(ap)
+	gki[GKI_TXSET_F ] = TX_FONT(ap)
+	gki[GKI_TXSET_Q ] = TX_QUALITY(ap)
+	gki[GKI_TXSET_CI] = TX_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_TXSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_TXSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiwesc.x b/sys/gio/gki/gkiwesc.x
new file mode 100644
index 00000000..bd4c8571
--- /dev/null
+++ b/sys/gio/gki/gkiwesc.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_WESCAPE -- Write a GKI escape instruction, used to pass device
+# dependent instructions on to a graphics kernel.  This version of gki_escape
+# is used in cases where the escape instruction consists of the escape header
+# followed by a block of data, and it is inconvenient to have to combine the
+# header and the data into one array.
+#
+# BOI GKI_ESCAPE L FN N DC
+#
+#        L(i)            5 + N
+#        FN(i)           escape function code
+#        N(i)            number of escape data words
+#        DC(i)           escape data words
+
+procedure gki_wescape (fd, fn, hdr, hdrlen, data, datalen)
+
+int	fd		#I output file
+int	fn		#I escape function code
+short	hdr[ARB]	#I escape instruction header
+int	hdrlen		#I header length, shorts
+short	data[ARB]	#I escape instruction data
+int	datalen		#I data length, shorts
+
+pointer	sp, buf
+int	epa, nwords
+short	gki[GKI_ESCAPE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_ESCAPE/
+include	"gki.com"
+
+begin
+	nwords = hdrlen + datalen
+
+	if (IS_INLINE(fd)) {
+	    call smark (sp)
+	    call salloc (buf, nwords, TY_SHORT)
+
+	    call amovs (hdr, Mems[buf], hdrlen)
+	    call amovs (data, Mems[buf+hdrlen], datalen)
+
+	    epa = gk_dd[GKI_ESCAPE]
+	    if (epa != 0)
+		call zcall3 (epa, fn, Mems[buf], nwords)
+
+	    call sfree (sp)
+
+	} else {
+	    gki[GKI_ESCAPE_L]  = GKI_ESCAPE_LEN + nwords
+	    gki[GKI_ESCAPE_N]  = nwords
+	    gki[GKI_ESCAPE_FN] = fn
+
+	    call write (gk_fd[fd], gki, GKI_ESCAPE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], hdr, hdrlen * SZ_SHORT)
+	    call write (gk_fd[fd], data, datalen * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiwrite.x b/sys/gio/gki/gkiwrite.x
new file mode 100644
index 00000000..65d911b1
--- /dev/null
+++ b/sys/gio/gki/gkiwrite.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_WRITE -- Write a GKI metacode instruction to a graphics kernel.  If the
+# kernel is inline the kernel is directly called to execute the instruction,
+# otherwise the instruction is written into the graphics stream for the
+# kernel.  This procedure is functionally equivalent to GKI_EXECUTE, but works
+# for both inline and external kernels.
+
+procedure gki_write (fd, gki)
+
+int	fd			# graphics stream
+short	gki[ARB]		# encoded instruction
+int	length
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd))
+	    call gki_execute (gki, gk_dd)
+	else {
+	    length = gki[GKI_HDR_LENGTH]
+	    call write (gk_fd[fd], gki, length * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkptxparg.x b/sys/gio/gki/gkptxparg.x
new file mode 100644
index 00000000..75d7325a
--- /dev/null
+++ b/sys/gio/gki/gkptxparg.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GKP_TXPARG -- Convert a short integer text attribute code into a string
+# and pass the string to FMTIO.
+
+procedure gkp_txparg (code)
+
+short	code			# defined in <gset.h>
+
+begin
+	switch (code) {
+	case GT_NORMAL:
+	    call pargstr ("normal")
+	case GT_CENTER:
+	    call pargstr ("center")
+	case GT_LEFT:
+	    call pargstr ("left")
+	case GT_RIGHT:
+	    call pargstr ("right")
+	case GT_UP:
+	    call pargstr ("up")
+	case GT_DOWN:
+	    call pargstr ("down")
+	case GT_TOP:
+	    call pargstr ("top")
+	case GT_BOTTOM:
+	    call pargstr ("bottom")
+	case GT_ROMAN:
+	    call pargstr ("roman")
+	case GT_GREEK:
+	    call pargstr ("greek")
+	case GT_ITALIC:
+	    call pargstr ("italic")
+	case GT_BOLD:
+	    call pargstr ("bold")
+	case GT_LOW:
+	    call pargstr ("low")
+	case GT_MEDIUM:
+	    call pargstr ("medium")
+	case GT_HIGH:
+	    call pargstr ("high")
+	default:
+	    call pargstr ("??")
+	}
+end
diff --git a/sys/gio/gki/mkpkg b/sys/gio/gki/mkpkg
new file mode 100644
index 00000000..c71f2e71
--- /dev/null
+++ b/sys/gio/gki/mkpkg
@@ -0,0 +1,46 @@
+# Make the GKI (graphics kernel interface) package.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	gkicancel.x	gki.com <config.h> <gki.h>
+	gkiclear.x	gki.com <config.h> <gki.h>
+	gkiclose.x	gki.com <config.h> <gki.h>
+	gkideact.x	gki.com <config.h> <gki.h>
+	gkieof.x	gki.com <config.h> <gki.h>
+	gkiesc.x	gki.com <config.h> <gki.h>
+	gkiexe.x	<gki.h>
+	gkifa.x		gki.com <config.h> <gki.h>
+	gkifaset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkifetch.x	<gki.h>
+	gkifflush.x	gki.com <config.h> <fio.h> <gki.h>
+	gkiflush.x	gki.com <config.h> <fio.h> <gki.h>
+	gkigca.x	gki.com <config.h> <fio.h> <fset.h> <gki.h>
+	gkigcur.x	gki.com <config.h> <fio.h> <fset.h> <gki.h>
+	gkigetwcs.x	gki.com <config.h> <gki.h>
+	gkiinit.x	gki.com <config.h> <gki.h>
+	gkiinline.x	gki.com <config.h> <gki.h>
+	gkikern.x	gki.com <config.h> <gki.h>
+	gkiopen.x	gki.com <config.h> <gki.h>
+	gkipca.x	gki.com <config.h> <gki.h>
+	gkipl.x		gki.com <config.h> <gki.h>
+	gkiplset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkipm.x		gki.com <config.h> <gki.h>
+	gkipmset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkiprint.x	<config.h> <gio.h> <gki.h> <gset.h> <mach.h>
+	gkirca.x	<gki.h>
+	gkircval.x	<gki.h>
+	gkireact.x	gki.com <config.h> <gki.h>
+	gkiredir.x	gki.com <config.h> <gki.h>
+	gkiscur.x	gki.com <config.h> <gki.h>
+	gkisetwcs.x	gki.com <config.h> <gki.h>
+	gkititle.x	gki.com <config.h> <gki.h>
+	gkitx.x		gki.com <config.h> <gki.h>
+	gkitxset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkiwesc.x	gki.com <config.h> <gki.h>
+	gkiwrite.x	gki.com <config.h> <gki.h>
+	gkptxparg.x	<gset.h>
+	;
diff --git a/sys/gio/gki/zzdebug.x b/sys/gio/gki/zzdebug.x
new file mode 100644
index 00000000..e56c5cc0
--- /dev/null
+++ b/sys/gio/gki/zzdebug.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+include <fio.h>
+include <gki.h>
+
+task	ggcur	= t_ggcur
+
+
+# GGCUR -- Debug cursor read in inline graphics kernel.
+
+procedure t_ggcur()
+
+pointer	gp
+char	device[SZ_FNAME]
+
+real	cx, cy
+int	key, xres, yres, hardchar
+int	dd[LEN_GKIDD]
+pointer	gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	hardchar = YES
+	xres = 0
+	yres = 0
+
+	call fseti (STDGRAPH, F_TYPE, SPOOL_FILE)
+	call fseti (STDGRAPH, F_CANCEL, OK)
+
+	call stg_open (device, dd, STDIN, STDOUT, xres, yres, hardchar)
+	call gki_inline_kernel (STDGRAPH, dd)
+
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call ggcur (gp, cx, cy, key)
+
+	call gclose (gp)
+	call stg_close()
+
+	call printf ("cx=%f, cy=%f, key=%d\n")
+	    call pargr (cx)
+	    call pargr (cy)
+	    call pargi (key)
+end
diff --git a/sys/gio/gks/README b/sys/gio/gks/README
new file mode 100644
index 00000000..fc3307c7
--- /dev/null
+++ b/sys/gio/gks/README
@@ -0,0 +1,50 @@
+GKS - This directory contains code for a partial implementation of the Fortran
+binding of GKS level OA.  The GKS functions are layered upon GIO.  The functions
+provided are:
+
+	gacwk	---	activate workstation
+	gca	---	output (integer) cell array
+	gcas	---	output (short) cell array
+	gclks	---	close GKS
+	gclrwk	---	clear workstation
+	gclwk	---	close workstation
+	gdawk	---	deactivate workstation
+	gfa	---	fill area
+	gopks	---	open GKS
+	gopwk	---	open workstation
+	gpl	---	polyline
+	gpm	---	polymarker
+	gqasf	---	query aspect source flag
+	gqchh	---	query character height
+	gqchup	---	query character up vector
+	gqcntn	---	query current transformation number
+	gqnt	---	query normalization transformation (window and viewport)
+	gqopwk	---	query open workstations
+	gqplci	---	query polyline color index
+	gqpmi   ---     query polymarker index
+	gqtxal	---	query text alignment
+	gqtxci	---	query text color index
+	gqtxp	---	query text path
+	gqwks	---	query workstation state
+	qsasf	--- 	query aspect source flag
+	gschh	---	set character height
+	gschup	---	set character up vector
+	gscr    ---     set color representation
+	gselnt	---	set normalization transformation
+	gsfaci  ---     set fill area color index
+	gsfais	---	set fill area interior style
+	gslwsc  ---     set line width scale factor
+	gsmk	---	set marker type
+	gsplci	---	set polyline color index
+	gspmci	---	set polymarker color index
+	gspmi   ---     set polymarker index
+	gstxal	---	set text alignment
+	gstxci	---	set text color index
+	gstxp	---	set text path
+	gsvp	---	set viewport
+	gswn	---	set window
+	gtx	---	text (gtx.f, gxgtx.x)
+
+Two functions were added 8Sep86:
+	gsclip	---	set clipping flag
+	gqclip	---	query clipping flag
diff --git a/sys/gio/gks/gacwk.x b/sys/gio/gks/gacwk.x
new file mode 100644
index 00000000..c9393d07
--- /dev/null
+++ b/sys/gio/gks/gacwk.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GACWK -- Activate workstation.
+
+procedure gacwk (wkid)
+
+int	wkid 		# Workstation identifier
+include	"gks.com"
+
+begin
+	# This procedure sets the active flag for a particular workstation.
+	gk_status[wkid] = ACTIVE
+
+	# Also, set gk_std to be the first activated workstation.  Once
+	# gk_std has been set, it will no longer = NULL.
+	if (gk_std == NULL)
+	    gk_std = wkid
+end
diff --git a/sys/gio/gks/gca.x b/sys/gio/gks/gca.x
new file mode 100644
index 00000000..918c3e37
--- /dev/null
+++ b/sys/gio/gks/gca.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCA -- Cell array.  Output a cell array to the specified output device
+# area.
+
+procedure gca (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+int	colia[dimx,dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	# Extract subraster and convert to type short.
+	call smark (sp)
+	call salloc (pixels, dx * dy, TY_SHORT)
+	do j = 1, dy {
+	    off = (j - 1) * dx
+	    call achtis (colia[ncs,nrs+j-1], Mems[pixels+off], dx)
+	}
+
+	# Output color array to all active workstations.
+	do i = 1, NDEV 
+	    if (gk_status[i] == ACTIVE)
+		call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gks/gcas.x b/sys/gio/gks/gcas.x
new file mode 100644
index 00000000..3ab44f99
--- /dev/null
+++ b/sys/gio/gks/gcas.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCAS -- Cell array.  Output a cell array to the specified output device
+# area.  This version of GCA intended for input color array of type short.
+
+procedure gcas (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+short	colia[dimx, dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	if (ncs == 1 && nrs == 1) {
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+	
+	} else {
+	    # Cell array is subraster of a larger array
+	    call smark (sp)
+	    call salloc (pixels, dx * dy, TY_SHORT)
+
+	    # Extract subraster
+	    do j = 1, dy {
+		off = (j - 1) * dx
+		call amovs (colia[ncs,nrs+j-1], Mems[off], dx)
+	    }
+
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/gio/gks/gclks.x b/sys/gio/gks/gclks.x
new file mode 100644
index 00000000..a82b760d
--- /dev/null
+++ b/sys/gio/gks/gclks.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GCLKS -- Close GKS.
+
+procedure gclks ()
+
+begin
+	# This procedure performs no function in the GKS emulator.
+end
diff --git a/sys/gio/gks/gclrwk.x b/sys/gio/gks/gclrwk.x
new file mode 100644
index 00000000..7f92bc91
--- /dev/null
+++ b/sys/gio/gks/gclrwk.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLRWK -- Clear workstation.
+
+procedure gclrwk (wkid, cofl)
+
+int	wkid		# Workstation identifier
+int	cofl		# Control flags (GCONDI, GALWAY)
+include	"gks.com"
+
+begin
+	# Clear the screen or advance film on the specified workstation.  GKS
+	# allows this to be done conditionally, dependent on whether or not
+	# something has been drawn.
+
+	call gclear (gp[wkid])
+end
diff --git a/sys/gio/gks/gclwk.x b/sys/gio/gks/gclwk.x
new file mode 100644
index 00000000..6fc3c16a
--- /dev/null
+++ b/sys/gio/gks/gclwk.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLWK -- Close workstation.
+
+procedure gclwk (wkid)
+
+int	wkid		# Workstation identifier
+include	"gks.com"
+
+begin
+	call gclose (gp[wkid])
+end
diff --git a/sys/gio/gks/gdawk.x b/sys/gio/gks/gdawk.x
new file mode 100644
index 00000000..23eaff14
--- /dev/null
+++ b/sys/gio/gks/gdawk.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GDAWK -- Deactivate workstation.
+
+procedure gdawk (wkid)
+
+int	wkid		# Workstation identifier
+int	i
+include	"gks.com"
+
+begin
+	# This procedure sets the status flag to INACTIVE for a particular
+	# device.  Because this workstation may have been the reference
+	# workstation, gk_std, it may also necessary to update gk_std.
+	# In this case, the reference workstation will be the one with the
+	# lowest workstation id number.
+
+	gk_status[wkid] = INACTIVE
+
+	if (wkid == gk_std) {
+	    gk_std = NULL
+	    # Find next activated workstation, if any
+	    do i = 1, NDEV {
+	        if (gk_status[i] == ACTIVE) {
+		    gk_std = i
+		    break
+		}
+	    }
+	}
+end
diff --git a/sys/gio/gks/gfa.x b/sys/gio/gks/gfa.x
new file mode 100644
index 00000000..9eb612b2
--- /dev/null
+++ b/sys/gio/gks/gfa.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GFA -- Fill area.  The style of fill has already been set and is read
+# from gio.com.
+
+procedure gfa (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include "gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gfill (gp[i], px, py, n, gk_style)
+	}
+end
diff --git a/sys/gio/gks/gks.com b/sys/gio/gks/gks.com
new file mode 100644
index 00000000..63c20568
--- /dev/null
+++ b/sys/gio/gks/gks.com
@@ -0,0 +1,10 @@
+# Common for GKS emulator.
+
+pointer	gp[NDEV]	# Graphics file descriptor for gio calls
+int	gk_status[NDEV]	# Active bit = INACTIVE or ACTIVE
+int	gk_std		# Index of gp array used for reference in set/get calls
+int	gk_style	# Fill area type of fill - set by GSFAIS
+int	gk_marker	# Marker type for use by GPM
+int	gk_asf[NASF]	# Array for maintaining aspect source flags
+
+common /gksemu/ gp, gk_status, gk_std, gk_style, gk_marker, gk_asf
diff --git a/sys/gio/gks/gks.h b/sys/gio/gks/gks.h
new file mode 100644
index 00000000..2373c55f
--- /dev/null
+++ b/sys/gio/gks/gks.h
@@ -0,0 +1,40 @@
+# Definitions for the gks emulator.
+
+define	NDEV		10	# Maximum number of open devices possible
+define	INACTIVE	0
+define	ACTIVE		1
+define	MAX_WCS		16	# Maximum number of world coordinate systems
+define	NASF		13	# Number of aspect source flags
+
+# Following are emuneration types used by the GKS emulator.
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GAHNOR		0
+define	GALEFT		1
+define	GACENT		2
+define	GARITE		3
+define	GAVNOR		0
+define	GATOP		1
+define	GACAP		2
+define	GAHALF		3
+define	GABASE		4
+define	GABOTT		5
+define	GPOINT		1
+define	GPLUS		2
+define	GAST		3
+define	GOMARK		4
+define	GXMARK		5
+define	GHOLLO		0
+define	GSOLID		1
+define	GPATTR		2
+define	GHATCH		3
+define	GBUNDL		0
+define	GINDIV		1
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GCONDI		0
+define	GALWAY		1
diff --git a/sys/gio/gks/gopks.x b/sys/gio/gks/gopks.x
new file mode 100644
index 00000000..48f39de0
--- /dev/null
+++ b/sys/gio/gks/gopks.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPKS -- Open GKS.  In the GIO implementation, this routine sets the
+# file to receive error output to STDERR and initializes all possible
+# workstations to inactive.  It also initializes the ASF array to GINDIV.
+
+procedure gopks (errfil)
+
+int	errfil		# Unit number for error output
+int	i
+include	"gks.com"
+
+begin
+	# This procedure initializes the gk_status and gk_std variables.
+	do i = 1, NDEV 
+	    gk_status[i] = INACTIVE
+	
+	gk_std = NULL
+
+	do i = 1, NASF
+	    gk_asf[i] = GINDIV
+end
diff --git a/sys/gio/gks/gopwk.x b/sys/gio/gks/gopwk.x
new file mode 100644
index 00000000..baa040e3
--- /dev/null
+++ b/sys/gio/gks/gopwk.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPWK -- Open workstation.
+
+procedure gopwk (wkid, conid, wtype)
+
+int	wkid		# Workstation identifier
+int	conid		# Connection identifier, not used.
+int	wtype		# Workstation type 
+
+include	"gks.com"
+
+
+begin
+	# This procedure sets "gp[wkid]" to be the "gp" of workstation "wkid".
+	# Procedure gopen has been called by the calling routine.  The wkid
+	# runs sequentially from 1 to the maximum allowable number of open
+	# workstations.  Parameter wtype is the gp returned from gopen.
+
+	gp[wkid] = wtype
+end
diff --git a/sys/gio/gks/gpl.x b/sys/gio/gks/gpl.x
new file mode 100644
index 00000000..ea5b880f
--- /dev/null
+++ b/sys/gio/gks/gpl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GPL -- Polyline.  Draw a line connecting the points.
+
+procedure gpl (n, px, py)
+
+int	n	 	# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gpline (gp[i], px, py, n)
+	}
+end
diff --git a/sys/gio/gks/gpm.x b/sys/gio/gks/gpm.x
new file mode 100644
index 00000000..1a7d8ac7
--- /dev/null
+++ b/sys/gio/gks/gpm.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GPM -- Polymarker.  Draw marks of type "gk_marker" and size 2.0
+# at the given positions.  Marker type has already been set.
+
+procedure gpm (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+real	size
+include	"gks.com"
+
+begin
+	# Marker size is a constant.
+	size = 2.0
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+    	        call gpmark (gp[i], px, py, n, gk_marker, size, size)
+	}
+end
diff --git a/sys/gio/gks/gqasf.x b/sys/gio/gks/gqasf.x
new file mode 100644
index 00000000..828ddef0
--- /dev/null
+++ b/sys/gio/gks/gqasf.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQASF -- Inquire aspect source flags. 
+
+procedure gqasf (ierror, lasf)
+
+int	lasf[13]		# Array of source aspect flags
+int	ierror			# Error indicator, where ierror = 0 for no error
+int	i
+include	"gks.com"
+
+begin
+	ierror = 0
+	do i = 1, NASF
+	    lasf[i] = gk_asf[i]
+end
diff --git a/sys/gio/gks/gqchh.x b/sys/gio/gks/gqchh.x
new file mode 100644
index 00000000..733d0a2a
--- /dev/null
+++ b/sys/gio/gks/gqchh.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHH - Inquire character height.
+
+procedure gqchh (ierror, chh)
+
+int	ierror			# Error indicator
+real	chh			# Character height, in world coordinates
+
+real	dx, dy
+real	gstatr()
+include	"gks.com"
+errchk	gstatr, ggscale
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chh = -1.0
+	    return
+	} else 
+	    ierror = 0
+
+	iferr {
+	    chh = gstatr (gp[gk_std], G_CHARSIZE)
+
+	    # The character height is expressed in NDC units.  It must be 
+	    # converted to world coordinates before returning.
+
+	    call ggscale (gp[gk_std], 0., 0., dx, dy)
+	    chh = chh * dy
+	} then {
+	    ierror = 1
+	    chh = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqchup.x b/sys/gio/gks/gqchup.x
new file mode 100644
index 00000000..3f12d8c4
--- /dev/null
+++ b/sys/gio/gks/gqchup.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHUP -- Inquire character up vector.
+
+procedure gqchup (ierror, chupx, chupy)
+
+int	ierror			# Error code; ierror = 0 for no error 
+real	chupx, chupy		# Character up vector x and y components
+
+int	angle
+real	txup
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chupx = 0.0
+	    chupy = 0.0
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    angle = gstati (gp[gk_std], G_TXUP) 
+
+	    txup = real (angle) * 3.1415926 / 180.
+	    chupx = cos (txup)
+	    chupy = sin (txup)
+	} then {
+	    ierror = 1
+	    chupx = 0.0
+	    chupy = 0.0
+	}
+end
diff --git a/sys/gio/gks/gqclip.x b/sys/gio/gks/gqclip.x
new file mode 100644
index 00000000..5694b353
--- /dev/null
+++ b/sys/gio/gks/gqclip.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCLIP -- Inquire value of clipping flag
+
+procedure gqclip (errind, iclip, iar)
+
+int	errind			# Error indicator
+int	iclip			# Clipping flag - returned value
+real	iar[4]			# Clipping array 
+
+int	gstati()
+include	"gks.com"
+
+begin
+	# Until I know what this argument is, set iar to full viewport.  
+	# Consulting with NCAR was not enlightning.  This argument (iar) 
+	# is not documented in the GKS level 0A standard.
+	iar[1] = 0.0
+	iar[2] = 1.0
+	iar[3] = 0.0
+	iar[4] = 1.0
+
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    iclip = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    iclip = gstati (gp[gk_std], G_CLIP)
+	} then {
+	    errind = 1
+	    iclip = -1
+	}
+end
diff --git a/sys/gio/gks/gqcntn.x b/sys/gio/gks/gqcntn.x
new file mode 100644
index 00000000..aaaa79bf
--- /dev/null
+++ b/sys/gio/gks/gqcntn.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCNTN -- Inquire current normalization transformation number (WCS).
+
+procedure gqcntn (errind, cntr)
+
+int	errind		# Error indicator; errind = 0 means no error
+int	cntr		# Current normalization transformation  number
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    cntr = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    cntr = gstati (gp[gk_std], G_WCS)
+	} then {
+	    errind = 1
+	    cntr = -1
+	}
+end
diff --git a/sys/gio/gks/gqmk.x b/sys/gio/gks/gqmk.x
new file mode 100644
index 00000000..0e90fbe7
--- /dev/null
+++ b/sys/gio/gks/gqmk.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQMK -- Query marker type.  Integer variable "marker" is read from
+# "gks.com" and returned.  
+
+procedure gqmk (ierr, mtype)
+
+int	ierr			# Error indicator - no way it can be set
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	ierr = 0
+	switch (gk_marker) {
+	case GM_POINT:
+	    mtype = GPOINT
+	case GM_PLUS:
+	    mtype = GPLUS
+	case GM_BOX:
+	    mtype = GAST
+	case GM_DIAMOND:
+	    mtype = GOMARK
+	case GM_CROSS:
+	    mtype = GXMARK
+	default:
+	    mtype = GPOINT
+	}
+end
diff --git a/sys/gio/gks/gqnt.x b/sys/gio/gks/gqnt.x
new file mode 100644
index 00000000..c172647f
--- /dev/null
+++ b/sys/gio/gks/gqnt.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQNT -- Inquire normalization transformation (window and vport).  Note
+# that this procedure gets the information for WCS ntnr, then resets to
+# the current WCS before returning.
+
+procedure gqnt (ntnr, errind, window, vport)
+
+int	ntnr			# Normalization transformation number to query
+int	errind			# Error indicator; errind = 0 means no error
+real	window[4]		# Window coordinates for WCS ntnr
+real	vport[4]		# Viewport coordinates for WCS ntnr
+
+int	current_wcs
+int	gstati()
+include	"gks.com"
+errchk	gstati, gseti, ggwind, ggview
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	} else
+	    errind = 0
+
+	if (ntnr < 0 || ntnr > MAX_WCS) {
+	    errind = 50
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	}
+
+	iferr {
+	    current_wcs = gstati (gp[gk_std], G_WCS)
+
+	    call gseti  (gp[gk_std], G_WCS, ntnr)
+	    call ggwind (gp[gk_std], window[1], window[2], window[3], window[4])
+	    call ggview (gp[gk_std], vport[1], vport[2], vport[3], vport[4])
+
+	    call gseti  (gp[gk_std], G_WCS, current_wcs)
+	} then {
+	    errind = 1
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqopwk.x b/sys/gio/gks/gqopwk.x
new file mode 100644
index 00000000..cf297f45
--- /dev/null
+++ b/sys/gio/gks/gqopwk.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQOPWK -- Inquire number of open work stations.  From looking at how this
+# procedure is called, it seems to have two functions, depending on the value
+# of "n".  It returns either the number of active workstations (n=0), or the
+# wkid for nth open workstation.
+
+procedure gqopwk (n, errind, ol, wkid)
+
+int	n			# Number of workstation to query
+int	errind			# Error indicator; errind = 0 means no error
+int	ol			# Returned value (number of open workstations)
+int	wkid			# WKID of nth open workstation - returned
+
+int	i, this_wkstation
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    wkid = -1
+	    return
+	} else
+	    errind = 0
+
+	if (n < 0 || n > NDEV) {
+	    # Invalid workstation identifier
+	    wkid = -1
+	    errind = 502
+	    return
+	} else {
+	    ol = 0
+	    if (n == 0) {
+	        # return the number of active workstations
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE)
+		        ol = ol + 1
+	        }
+	    } else {
+	        # Find the nth open workstation and return its wkid
+	        this_wkstation = 0
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE) {
+		        this_wkstation = this_wkstation + 1
+		        if (this_wkstation == n) {
+			    wkid = i
+			    break
+		        }
+		    }
+	        }
+	    }
+	}
+end
diff --git a/sys/gio/gks/gqplci.x b/sys/gio/gks/gqplci.x
new file mode 100644
index 00000000..23858491
--- /dev/null
+++ b/sys/gio/gks/gqplci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPLCI -- Inquire Polyline color index.
+
+procedure gqplci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PLWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmci.x b/sys/gio/gks/gqpmci.x
new file mode 100644
index 00000000..d1760d15
--- /dev/null
+++ b/sys/gio/gks/gqpmci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMCI -- Inquire Polymarker color index.
+
+procedure gqpmci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PMWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmi.x b/sys/gio/gks/gqpmi.x
new file mode 100644
index 00000000..b1332b54
--- /dev/null
+++ b/sys/gio/gks/gqpmi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMI -- Inquire Polymarker index.
+
+procedure gqpmi (errind, index)
+
+real	index                   # Polymarker index - returned value.
+int	errind			# Error indicator
+include	"gks.com"
+
+begin
+	errind = 0
+	index = 1.0
+end
diff --git a/sys/gio/gks/gqtxal.x b/sys/gio/gks/gqtxal.x
new file mode 100644
index 00000000..36a90186
--- /dev/null
+++ b/sys/gio/gks/gqtxal.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXAL -- Inquire text alignment.
+
+procedure gqtxal (ierror, txalh, txalv)
+
+int	ierror			# Error indicator; ierror = 0 means no error
+int	txalh			# Horizontal text alignment
+int	txalv			# Vertical text alignment
+
+int	justify
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    txalh = -1
+	    txalv = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    # Get value of horizontal text justification
+	    justify = gstati (gp[gk_std], G_TXHJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+	        txalh = GAHNOR
+	    case GT_CENTER:
+	        txalh = GACENT
+	    case GT_LEFT:
+	        txalh = GALEFT
+	    case GT_RIGHT:
+	        txalh = GARITE
+	    default:
+	        txalh = GAHNOR
+	    }
+
+	    # Get value of vertical text justification
+	    justify =  gstati (gp[gk_std], G_TXVJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+		txalv = GAVNOR
+	    case GT_CENTER:
+		txalv = GAHALF
+	    case GT_TOP:
+		txalv = GATOP
+	    case GT_BOTTOM:
+		txalv = GABOTT
+	    default:
+		txalv = GAVNOR
+	    }
+	} then {
+	    ierror = 1
+	    txalv = -1
+	    txalh = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxci.x b/sys/gio/gks/gqtxci.x
new file mode 100644
index 00000000..e327660b
--- /dev/null
+++ b/sys/gio/gks/gqtxci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXCI -- Inquire text color index.
+
+procedure gqtxci (ierror, coli)
+
+int	ierror			# Error indicator
+int	coli			# Color index - returned value.
+int	gstati ()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    coli = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    coli = gstati (gp[gk_std], G_TXCOLOR)
+	} then {
+	    ierror = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxp.x b/sys/gio/gks/gqtxp.x
new file mode 100644
index 00000000..53dfd1af
--- /dev/null
+++ b/sys/gio/gks/gqtxp.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXP -- Inquire text path.
+
+procedure gqtxp (ierror, path)
+
+int	ierror			# Error indicator
+int	path			# Text path - returned value.
+
+int	text_path
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    path = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    text_path =  gstati (gp[gk_std], G_TXPATH)
+
+	    switch (text_path) {
+	    case (GT_LEFT):
+	        path = GLEFT
+	    case (GT_RIGHT):
+	        path = GRIGHT
+	    case (GT_UP):
+	        path = GUP
+	    case (GT_DOWN):
+	        path = GDOWN
+	    default:
+	        path = GRIGHT
+	    }
+	} then {
+	    ierror = 1
+	    path = -1
+	}
+end
diff --git a/sys/gio/gks/gqwks.x b/sys/gio/gks/gqwks.x
new file mode 100644
index 00000000..b555fee0
--- /dev/null
+++ b/sys/gio/gks/gqwks.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQWKS -- Inquire workstation state.  State is either ACTIVE or INACTIVE;
+# this information has been stored in gks.com by GACWK.
+
+procedure gqwks (wkid, errind, state)
+
+int	wkid			# Workstation id for inquire
+int	errind			# Error indicator
+int	state			# Returned state value: ACTIVE or INACTIVE
+include	"gks.com"
+
+begin
+	errind = 0
+	if (wkid > NDEV)
+	    errind = 1
+	else
+	    state = gk_status[wkid]
+end
diff --git a/sys/gio/gks/gsasf.x b/sys/gio/gks/gsasf.x
new file mode 100644
index 00000000..be321060
--- /dev/null
+++ b/sys/gio/gks/gsasf.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "gks.h"
+
+# GSASF -- Set aspect source flags.  Aspect source flags allow the following 
+# elements to be set to either GBUNDL or GINDIV:
+#	 1	linetype ASF
+#	 2	linewidth scale factor ASF
+#	 3	polyline colour index ASF
+#	 4	marker type ASF
+#	 5	marker size scale factor ASF
+#	 6	polymarker colout index ASF
+#	 7	text font and precision factor ASF
+#	 8	character expansion factor ASF
+#	 9	character spacing ASF
+#	 10	text colour index ASF
+#	 11	fill area interior style ASF
+#	 12	fill area style index ASF
+#	 13	fill area colout index ASF
+
+procedure gsasf (lasf)
+
+int	lasf[13]	# List of aspect source flags
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NASF
+	    gk_asf[i] = lasf[i]
+end
diff --git a/sys/gio/gks/gsaw.x b/sys/gio/gks/gsaw.x
new file mode 100644
index 00000000..dbbc0190
--- /dev/null
+++ b/sys/gio/gks/gsaw.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSAW[IR] -- Sets integer or real parameters for all active workstations.
+
+procedure gsawi (param, value)
+
+int	param		# Parameter to be set
+int	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gseti (gp[i], param, value)
+	}
+end
+
+
+procedure gsawr (param, value)
+
+int	param		# Parameter to be set
+real	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsetr (gp[i], param, value)
+	}
+end
diff --git a/sys/gio/gks/gschh.x b/sys/gio/gks/gschh.x
new file mode 100644
index 00000000..172af231
--- /dev/null
+++ b/sys/gio/gks/gschh.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCHH -- Set character height.
+
+procedure gschh (chh)
+
+real	chh		# Character height in world coordinates
+
+real	dx, dy, ndc_chh
+include	"gks.com"
+
+begin
+	# Input chh is in world coordinates; it must be transformed to NDC.
+	# Assuming spatial transformation is linear, input coordinates to
+	# ggscale are not used and so are set to 0.0.
+
+	call ggscale (gp[gk_std], 0.0, 0.0, dx, dy)
+	if (dy != 0) {
+	    ndc_chh = chh / dy
+	    call gsawr (G_CHARSIZE, ndc_chh)
+	} else
+	    call gsawr (G_CHARSIZE, chh)
+end
diff --git a/sys/gio/gks/gschup.x b/sys/gio/gks/gschup.x
new file mode 100644
index 00000000..d7698c41
--- /dev/null
+++ b/sys/gio/gks/gschup.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCHUP -- Set character up vector.
+
+procedure gschup (chux, chuy)
+
+real	chux, chuy		# Character up vector, in world coordinates
+int	char_up
+bool	fp_equalr()
+
+begin
+	# Find the angle normal to the text baseline.  The angle is stored
+	# in degrees between -180 and +180.
+
+	if (fp_equalr (chux, 0.0))
+	    char_up = 90
+	else
+	    char_up = nint (atan2 (chuy, chux) * 180. / 3.1415926)
+
+	call gsawi (G_TXUP, char_up)
+end
diff --git a/sys/gio/gks/gsclip.x b/sys/gio/gks/gsclip.x
new file mode 100644
index 00000000..80fe32c0
--- /dev/null
+++ b/sys/gio/gks/gsclip.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCLIP -- Set clipping flag.
+
+procedure gsclip (iclip)
+
+int	iclip		# New value of clipping flag
+
+begin
+	call gsawi (G_CLIP, iclip)
+end
diff --git a/sys/gio/gks/gscr.x b/sys/gio/gks/gscr.x
new file mode 100644
index 00000000..39a248e1
--- /dev/null
+++ b/sys/gio/gks/gscr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCR -- Set color representation.  Currently implemented as a no-op.
+
+procedure gscr (wkstation, color_index, rgb)
+
+int	wkstation		# Workstation id
+int	color_index
+real	rgb[3]
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gselnt.x b/sys/gio/gks/gselnt.x
new file mode 100644
index 00000000..dfe39a3b
--- /dev/null
+++ b/sys/gio/gks/gselnt.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSELNT -- Select normalization transformation (same as world coord sys)
+
+procedure gselnt (wcs)
+
+int	wcs		# Transformation number
+
+begin
+	call gsawi (G_WCS, wcs)
+end
diff --git a/sys/gio/gks/gsfaci.x b/sys/gio/gks/gsfaci.x
new file mode 100644
index 00000000..620b0bca
--- /dev/null
+++ b/sys/gio/gks/gsfaci.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFACI -- Set fill area color index.  Currently implemented as a no-op.
+
+procedure gsfaci (index)
+
+int	index		# Fill area color index.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsfais.x b/sys/gio/gks/gsfais.x
new file mode 100644
index 00000000..461cab8d
--- /dev/null
+++ b/sys/gio/gks/gsfais.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFAIS -- Set fill area interior style.  Integer variable "gk_style" is
+# set and stored in "gks.com".  Procedure GFA will use this value.
+
+procedure gsfais (ints)
+
+int	ints		# Fill area interior style
+
+include	"gks.com"
+
+begin
+	switch (ints) {
+	case GHOLLO:
+	    gk_style = GF_HOLLOW
+	case GSOLID:
+	    gk_style = GF_SOLID
+	case GPATTR:
+	    gk_style = GF_HATCH4
+	case GHATCH:
+	    gk_style = GF_HATCH1
+	default:
+	    gk_style = GF_HOLLOW
+	}
+end
diff --git a/sys/gio/gks/gslwsc.x b/sys/gio/gks/gslwsc.x
new file mode 100644
index 00000000..b6f75963
--- /dev/null
+++ b/sys/gio/gks/gslwsc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSLWSC -- Set linewidth scale.  Currently implemented as a no-op.
+
+procedure gslwsc (width)
+
+real	width		# Linewidth scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsmk.x b/sys/gio/gks/gsmk.x
new file mode 100644
index 00000000..41a7b05d
--- /dev/null
+++ b/sys/gio/gks/gsmk.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMK -- Set marker type.  Integer variable "marker" is set and
+# stored in "gks.com".  Procedure gpm uses this value.
+
+procedure gsmk (mtype)
+
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	switch (mtype) {
+	case GPOINT:
+	    gk_marker = GM_POINT
+	case GPLUS:
+	    gk_marker = GM_PLUS
+	case GAST:
+	    gk_marker = GM_BOX
+	case GOMARK:
+	    gk_marker = GM_DIAMOND
+	case GXMARK:
+	    gk_marker = GM_CROSS
+	default:
+	    gk_marker = GM_POINT
+	}
+end
diff --git a/sys/gio/gks/gsmksc.x b/sys/gio/gks/gsmksc.x
new file mode 100644
index 00000000..4936d7ea
--- /dev/null
+++ b/sys/gio/gks/gsmksc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMKSC -- Set marker scale.  Currently implemented as a no-op.
+
+procedure gsmksc (width)
+
+real	width		# Marker scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsplci.x b/sys/gio/gks/gsplci.x
new file mode 100644
index 00000000..afb74b4d
--- /dev/null
+++ b/sys/gio/gks/gsplci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPLC -- Set polyline colour index.  This function is currently 
+# implemented as setting the polyline width, not color.
+
+procedure gsplci (coli)
+
+int	coli		# Polyline colour index
+
+begin
+	call gsawr (G_PLWIDTH, real (coli))
+end
diff --git a/sys/gio/gks/gspmci.x b/sys/gio/gks/gspmci.x
new file mode 100644
index 00000000..909800cf
--- /dev/null
+++ b/sys/gio/gks/gspmci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMCI -- Set polymarker colour index.  This function is currently
+# implemented as setting the polymarker width, not color.
+
+procedure gspmci (coli)
+
+int	coli		# Polymarker colour index.
+
+begin
+	call gsawr (G_PMCOLOR, real (coli))
+end
diff --git a/sys/gio/gks/gspmi.x b/sys/gio/gks/gspmi.x
new file mode 100644
index 00000000..e238fc10
--- /dev/null
+++ b/sys/gio/gks/gspmi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMI -- Set polymarker index.  This function is currently
+# implemented as a no-op.
+
+procedure gspmi (index)
+
+int	index		# Polymarker index. (whatever that is)
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gstxal.x b/sys/gio/gks/gstxal.x
new file mode 100644
index 00000000..aecae88f
--- /dev/null
+++ b/sys/gio/gks/gstxal.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXAL -- Set format alignment.  
+
+procedure gstxal (txalh, txalv)
+
+int	txalh		# Horizontal alignment
+int	txalv		# Vertical alignment
+
+begin
+	switch (txalh) {
+	case GAHNOR:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	case GALEFT:
+	    call gsawi (G_TXHJUSTIFY, GT_LEFT)
+	case GACENT:
+	    call gsawi (G_TXHJUSTIFY, GT_CENTER)
+	case GARITE:
+	    call gsawi (G_TXHJUSTIFY, GT_RIGHT)
+	default:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	}
+
+	switch (txalv) {
+	case GAVNOR:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	case GATOP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GACAP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GAHALF:
+	    call gsawi (G_TXVJUSTIFY, GT_CENTER)
+	case GABASE:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	case GABOTT:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	default:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	}
+end
diff --git a/sys/gio/gks/gstxci.x b/sys/gio/gks/gstxci.x
new file mode 100644
index 00000000..ec04132c
--- /dev/null
+++ b/sys/gio/gks/gstxci.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSTXCI -- Set colour index.  This function is currently implemented
+# by setting the text font to bold when the color index > 1, and to
+# the default (roman) otherwise.
+
+procedure gstxci (coli)
+
+int	coli		# Text colour index
+
+begin
+	if (coli > 1)
+	    call gsawi (G_TXFONT, GT_BOLD)
+	else 
+	    call gsawi (G_TXFONT, GT_ROMAN)
+end
diff --git a/sys/gio/gks/gstxp.x b/sys/gio/gks/gstxp.x
new file mode 100644
index 00000000..cf87e4f2
--- /dev/null
+++ b/sys/gio/gks/gstxp.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXP -- Set text path.
+
+procedure gstxp (txp)
+
+int	txp		# Text path to be set
+
+begin
+	switch (txp) {
+	case GRIGHT:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	case GLEFT:
+	    call gsawi (G_TXPATH, GT_LEFT)
+	case GUP:
+	    call gsawi (G_TXPATH, GT_UP)
+	case GDOWN:
+	    call gsawi (G_TXPATH, GT_DOWN)
+	default:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	}
+end
diff --git a/sys/gio/gks/gsvp.x b/sys/gio/gks/gsvp.x
new file mode 100644
index 00000000..f2a61711
--- /dev/null
+++ b/sys/gio/gks/gsvp.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSVP -- Set viewport.  This procedure sets the viewport for world coord
+# sys "wcs", which may not be the current WCS.
+
+procedure gsvp (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system
+real	x1, x2		# Range of viewport coordinate in x (NDC)
+real	y1, y2		# Range of viewport coordinate in y (NDC)
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsview (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to the current WCS
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gswn.x b/sys/gio/gks/gswn.x
new file mode 100644
index 00000000..713ae487
--- /dev/null
+++ b/sys/gio/gks/gswn.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSWN -- Set window.  Window of world coord system "wcs" is set, which
+# is not necessarily the current WCS.
+
+procedure gswn (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system (transformation)
+real	x1, x2		# Range of world coordinates in x
+real	y1, y2		# Range of world coordinates in y
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+	    call gswind (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to current WCS before returning
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gtx.f b/sys/gio/gks/gtx.f
new file mode 100644
index 00000000..c09ef7c4
--- /dev/null
+++ b/sys/gio/gks/gtx.f
@@ -0,0 +1,16 @@
+c GTX -- Text.  Unpack an f77 string and call gx_gtx to output the string.
+c
+	subroutine gtx (px, py, f77chars)
+c
+	real		px, py
+	character*(*) 	f77chars
+	integer*2     	sppchars(161)
+c
+c
+c	Unpack characters from packed input array
+c
+	call f77upk (f77chars, sppchars, min (len(f77chars), 161))
+	call gxgtx (px, py, sppchars)
+c
+c
+	end
diff --git a/sys/gio/gks/gxgtx.x b/sys/gio/gks/gxgtx.x
new file mode 100644
index 00000000..0ca39bb5
--- /dev/null
+++ b/sys/gio/gks/gxgtx.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GXGTX -- Text.  Ouptut an spp string with gtext.  The string has already
+# been unpacked from an f77 to spp string.
+
+procedure gxgtx (px, py, chars)
+
+real	px, py		# Text position in world coordinates
+char	chars[ARB]	# String of characters
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gtext (gp[i], px, py, chars, "")
+	}
+end
diff --git a/sys/gio/gks/mkpkg b/sys/gio/gks/mkpkg
new file mode 100644
index 00000000..864c3ba7
--- /dev/null
+++ b/sys/gio/gks/mkpkg
@@ -0,0 +1,58 @@
+# Make the GKS emulator.
+
+$checkout libgks.a lib$
+$update	  libgks.a
+$checkin  libgks.a lib$
+$exit
+
+libgks.a:
+	gacwk.x		gks.com gks.h
+	gca.x		gks.com gks.h <gset.h>
+	gcas.x		gks.com gks.h <gset.h>
+	gclks.x
+	gclrwk.x	gks.com gks.h
+	gclwk.x		gks.com gks.h
+	gdawk.x		gks.com gks.h
+	gfa.x		gks.h <gset.h> gks.com
+	gopks.x		gks.com gks.h
+	gopwk.x		gks.com gks.h
+	gpl.x		gks.com gks.h
+	gpm.x		gks.com gks.h <gset.h>
+	gqasf.x		gks.com gks.h
+	gqchh.x		gks.com gks.h <gset.h>
+	gqchup.x	gks.com gks.h <gset.h>
+	gqclip.x 	gks.com gks.h <gset.h> 
+	gqcntn.x	gks.com gks.h <gset.h>
+	gqmk.x		gks.com gks.h <gset.h>
+	gqnt.x		gks.com gks.h <gset.h>
+	gqopwk.x	gks.com gks.h
+	gqplci.x	gks.com gks.h <gset.h>
+	gqpmci.x	gks.com gks.h <gset.h>
+	gqpmi.x		gks.com gks.h <gset.h>
+	gqtxal.x	gks.com gks.h <gset.h>
+	gqtxci.x	gks.com gks.h <gset.h>
+	gqtxp.x		gks.com gks.h <gset.h>
+	gqwks.x		gks.com gks.h
+	gsasf.x		gks.com gks.h
+	gsaw.x		gks.com gks.h <gset.h>
+	gschh.x		gks.com gks.h <gset.h>
+	gschup.x	<gset.h>
+	gsclip.x	<gset.h>
+	gscr.x		gks.com gks.h <gset.h>
+	gselnt.x	<gset.h>
+	gsfaci.x	gks.com gks.h <gset.h>
+	gsfais.x	gks.com gks.h <gset.h>
+	gslwsc.x	gks.com gks.h <gset.h>
+	gsmk.x		gks.com gks.h <gset.h>
+	gsmksc.x	gks.com gks.h <gset.h>
+	gsplci.x	<gset.h>
+	gspmci.x	<gset.h>
+	gspmi.x		<gset.h>
+	gstxal.x	gks.h <gset.h>
+	gstxci.x	<gset.h>
+	gstxp.x		gks.h <gset.h>
+	gsvp.x		gks.com gks.h <gset.h>
+	gswn.x		gks.com gks.h <gset.h>
+	gtx.f
+	gxgtx.x		gks.com gks.h <gset.h>
+	;
diff --git a/sys/gio/glabax/README b/sys/gio/glabax/README
new file mode 100644
index 00000000..4c9f9ad5
--- /dev/null
+++ b/sys/gio/glabax/README
@@ -0,0 +1 @@
+GLABAX -- GIO axis drawing and labelling package.
diff --git a/sys/gio/glabax/glabax.h b/sys/gio/glabax/glabax.h
new file mode 100644
index 00000000..070918ec
--- /dev/null
+++ b/sys/gio/glabax/glabax.h
@@ -0,0 +1,46 @@
+# GLABAX.H -- Axis drawing and labelling.
+
+define	SZ_FORMAT		19
+define	SZ_LABEL		19
+define	MAX_LINEARITY		1.0			# no log scaling if gt
+define	LEFT_BORDER		9			# nchars at l|r edge
+define	BOTTOM_BORDER		5			# nlines at bottom edge
+define	Y_LABELOFFSET		7			# Y label dist from axis
+define	MAX_SZTITLEBLOCK	0.5			# max sztitleblock, NDC
+define	MIN_NTITLELINES		2			# min lines in titleblk
+define	TOL			(EPSILONR*10.0)
+
+define	LEN_AX			85
+define	AX_POS			Memd[P2D($1)+$2-1]	# tick coords
+define	AX_DRAWME		Memi[$1+4]		# draw this axis
+define	AX_HORIZONTAL		Memi[$1+5]		# axis is horizontal
+define	AX_SCALING		Memi[$1+6]		# type of scaling
+define	AX_DRAWTICKS		Memi[$1+7]		# draw the ticks
+define	AX_START		Memr[P2R($1+8+$2-1)]	# axis starts here
+define	AX_END			Memr[P2R($1+10+$2-1)]	# axis ends here
+define	AX_TICK1		Memr[P2R($1+12+$2-1)]	# first tick is here
+define	AX_STEP			Memr[P2R($1+14+$2-1)]	# offset between ticks
+define	AX_ISTEP		Memr[P2R($1+16+$2-1)]	# intial offset
+define	AX_KSTEP		Memr[P2R($1+18)]	# step scalar at majors
+define	AX_IKSTEP		Memr[P2R($1+19)]	# initial kstep
+define	AX_NMINOR		Memi[$1+20]		# nminor ticks
+define	AX_NLEFT		Memi[$1+21]		# nminor to next major
+define	AX_INLEFT		Memi[$1+22]		# initial nleft
+define	AX_NDIGITS		Memi[$1+23]		# ndigits of precision
+define	AX_MINORTICK		Memr[P2R($1+24+$2-1)]	# offset to draw minor
+define	AX_MAJORTICK		Memr[P2R($1+26+$2-1)]	# offset to draw major
+define	AX_MINORWIDTH		Memr[P2R($1+28)]	# minor tick linewidth
+define	AX_MAJORWIDTH		Memr[P2R($1+29)]	# major tick linewidth
+define	AX_LABELTICKS		Memi[$1+30]		# draw tick labels
+define	AX_TICKLABELOFFSET	Memr[P2R($1+31+$2-1)]	# offset to ticklabel
+define	AX_TICKLABELSIZE	Memr[P2R($1+33)]	# char size of ticklabel
+define	AX_TICKLABELCOLOR	Memi[$1+34]		# char size of ticklabel
+define	AX_TICKCOLOR		Memi[$1+35]		# grid between ticks
+define	AX_AXISLABELSIZE	Memr[P2R($1+36)]	# char size axislabel
+define	AX_AXISLABELCOLOR	Memi[$1+37]		# char size axislabel
+define	AX_AXISWIDTH		Memr[P2R($1+38)]	# axis linewidth
+define	AX_AXISCOLOR		Memi[$1+39]		# axis linewidth
+define	AX_GRIDCOLOR		Memi[$1+40]		# grid between ticks
+
+define	AX_TICKLABELPOS		Memc[P2C($1+45)]	# gtext format
+define	AX_TICKFORMAT		Memc[P2C($1+65)]	# numeric format
diff --git a/sys/gio/glabax/glabax.x b/sys/gio/glabax/glabax.x
new file mode 100644
index 00000000..0c30021b
--- /dev/null
+++ b/sys/gio/glabax/glabax.x
@@ -0,0 +1,264 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLABAX -- Draw and label the axes of the plot (normally the viewport
+# boundary).  This is done in two steps.  First we compute all the required
+# parameters, and then we draw and label the axes.  Up to four axes can be
+# drawn.  To simplify matters, all four axes are treated equally and
+# independently.  The axes are drawn a tick at a time in world coordinates.
+
+procedure glabax (gp, title, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+char	title[ARB]		# plot title (may be more than one line)
+char	xlabel[ARB]		# X axis label
+char	ylabel[ARB]		# Y axis label
+
+char	label[SZ_LABEL]
+int	axis, wcs, ntitlelines, ip, major_tick
+int	save_plcolor, save_txcolor, save_facolor
+int	save_pltype, save_clip, save_txfont
+real	xv[4], yv[4], x1, x2, y1, y2
+real	save_plwidth, save_txsize
+real	dx, dy, x, y, sx, sy, scalar, wc, wstep
+pointer	sp, axes[4], ax, w
+
+real	gstatr()
+bool	ttygetb()
+int	gstati(), glb_gettick()
+errchk	glb_setup, gadraw, grdraw, gamove, gtext
+errchk	glb_label_axis, glb_plot_title, glb_gettick
+
+begin
+	call smark (sp)
+	call salloc (axes[1], LEN_AX, TY_STRUCT)
+	call salloc (axes[2], LEN_AX, TY_STRUCT)
+	call salloc (axes[3], LEN_AX, TY_STRUCT)
+	call salloc (axes[4], LEN_AX, TY_STRUCT)
+
+	wcs = GP_WCS(gp)
+	w   = GP_WCSPTR(gp,wcs)
+
+	# Count the number of lines in the title block.
+	ntitlelines = 0
+	if (title[1] != EOS) {
+	    for (ip=1;  title[ip] != EOS;  ip=ip+1)
+		if (title[ip] == '\n' && title[ip+1] != EOS)
+		    ntitlelines = ntitlelines + 1
+	    ntitlelines = ntitlelines + 1
+	}
+	ntitlelines = max (ntitlelines, GP_NTITLELINES(gp))
+
+	# Fix the coordinates systems and set the axis drawing parameters.
+	# The number of lines in the title block is needed to determine how
+	# much space to allow at the top of the screen.
+
+	call glb_setup (gp, axes, ntitlelines, xlabel, ylabel)
+
+	# Save the values of any user parameters we must change while drawing
+	# the axes.
+
+	save_pltype  = gstati (gp, G_PLTYPE)
+	save_plwidth = gstatr (gp, G_PLWIDTH)
+	save_plcolor = gstati (gp, G_PLCOLOR)
+	save_txfont  = gstati (gp, G_TXFONT)
+	save_txsize  = gstatr (gp, G_TXSIZE)
+	save_txcolor = gstati (gp, G_TXCOLOR)
+	save_facolor = gstati (gp, G_FACOLOR)
+	save_clip    = WCS_CLIP(w)
+
+	# Prepare the background.
+	if (ttygetb (GP_TTY(gp), "fa") &&
+	    GP_FRAMECOLOR(gp) != 0 && GP_FRAMEDRAWN(gp) == NO) {
+
+	    call ggview (gp, x1, x2, y1, y2)
+	    call gseti (gp, G_WCS, 0)
+	    call gseti (gp, G_CLIP, NO)
+
+	    xv[1] = 0.0;  yv[1] = 0.0
+	    xv[2] = 1.0;  yv[2] = 0.0
+	    xv[3] = 1.0;  yv[3] = 1.0
+	    xv[4] = 0.0;  yv[4] = 1.0
+	    call gseti (gp, G_FACOLOR, GP_FRAMECOLOR(gp))
+	    call gfill (gp, xv, yv, 4, GF_SOLID)
+
+	    xv[1] = x1;  yv[1] = y1
+	    xv[2] = x2;  yv[2] = y1
+	    xv[3] = x2;  yv[3] = y2
+	    xv[4] = x1;  yv[4] = y2
+	    call gseti (gp, G_FACOLOR, 0)
+	    call gfill (gp, xv, yv, 4, GF_SOLID)
+
+	    call gseti (gp, G_CLIP, save_clip)
+	    call gseti (gp, G_WCS, wcs)
+	    GP_FRAMEDRAWN(gp) = YES
+	}
+
+	# Draw and label the four axes.  First set the linetype and linewidth
+	# to be used to draw the axes and ticks; these may be different than
+	# that used to plot the data.  Draws are preferred to moves to minimize
+	# the number of polylines needed to draw the axis.  An axis is drawn
+	# by moving to the start of the axis, drawing each tick in sequence,
+	# and then moving to the end of the axis.  Tick labels are drawn at
+	# the major ticks if required.  The axes and ticks must be drawn in
+	# world coords to get the proper scaling.  Clipping is turned off while
+	# drawing the axes to avoid clipping portions of the axes due to small
+	# floating point errors.
+
+	call gseti (gp, G_PLTYPE, 1)
+	call gseti (gp, G_CLIP, NO)
+	call gseti (gp, G_TXFONT, GT_BOLD)
+
+	do axis = 1, 4 {
+	    ax = axes[axis]
+	    if (AX_DRAWME(ax) == NO)
+		next
+
+#  call eprintf ("axis %d: tick1=(%g,%g) istep=(%g,%g) kstep=%g\n")
+#  call pargi (axis)
+#  call pargr (AX_TICK1(ax,1)); call pargr (AX_TICK1(ax,2))
+#  call pargr (AX_ISTEP(ax,1)); call pargr (AX_ISTEP(ax,2))
+#  call pargr (AX_IKSTEP(ax))
+#  call eprintf ("\tstart=(%g,%g) end=(%g,%g)\n")
+#  call pargr (AX_START(ax,1)); call pargr (AX_START(ax,2))
+#  call pargr (AX_END(ax,1)); call pargr (AX_END(ax,2))
+#  call eprintf ("nminor=%d, inleft=%d, minortick=(%g,%g), majortick=(%g,%g)\n")
+#  call pargi (AX_NMINOR(ax)); call pargi (AX_INLEFT(ax))
+#  call pargr (AX_MINORTICK(ax,1)); call pargr (AX_MINORTICK(ax,2))
+#  call pargr (AX_MAJORTICK(ax,1)); call pargr (AX_MAJORTICK(ax,2))
+
+	    # Set the axis linewidth and move to the start of the axis.
+	    call gsetr (gp, G_PLWIDTH, AX_AXISWIDTH(ax))
+	    call gseti (gp, G_PLCOLOR, AX_AXISCOLOR(ax))
+	    call gamove (gp, AX_START(ax,1), AX_START(ax,2))
+
+	    # Draw the axis and label the major ticks if so indicated.
+	    # First set flag to initialize glb_gettick.
+
+	    AX_NLEFT(ax) = -1
+	    while (glb_gettick (gp, ax, x, y, major_tick) != EOF) {
+
+		# Advance to the next tick.
+		call gsetr (gp, G_PLWIDTH, AX_AXISWIDTH(ax))
+		call gseti (gp, G_PLCOLOR, AX_AXISCOLOR(ax))
+		call gadraw (gp, x, y)
+
+		if (major_tick == YES) {
+		    # Draw a major tick.
+
+		    call gsetr (gp, G_PLWIDTH, AX_MAJORWIDTH(ax))
+		    call gseti (gp, G_PLCOLOR, AX_TICKCOLOR(ax))
+		    dx = AX_MAJORTICK(ax,1)
+		    dy = AX_MAJORTICK(ax,2)
+		    call grdraw (gp, dx, dy)
+		    call grdraw (gp, -dx, -dy)
+
+		    if (AX_LABELTICKS(ax) == YES) {
+			# Get the tick label position in NDC coords.  World
+			# coords cannot be used for an offset outside the
+			# viewport as the coords might be indefinite if log
+			# scaling.
+
+			call gseti (gp, G_WCS, 0)
+			call gcurpos (gp, sx, sy)
+			dx = AX_TICKLABELOFFSET(ax,1)
+			dy = AX_TICKLABELOFFSET(ax,2)
+
+			# Format the numeric tick label string.  The scalar
+			# multiplier is used to compute the step size between
+			# major ticks.
+
+			scalar = AX_NMINOR(ax) + 1.0
+			if (AX_HORIZONTAL(ax) == YES) {
+			    wc = x
+			    wstep = AX_STEP(ax,1) * scalar
+			} else {
+			    wc = y
+			    wstep = AX_STEP(ax,2) * scalar
+			}
+
+			# Draw the label string.
+			call gsetr (gp, G_TXSIZE, AX_TICKLABELSIZE(ax))
+			call gseti (gp, G_TXCOLOR, AX_TICKLABELCOLOR(ax))
+
+			# If log scaling, label the ticks in log units.
+			if (AX_SCALING(ax) == LINEAR) {
+			    call glb_encode (wc, label, SZ_LABEL,
+				AX_TICKFORMAT(ax), wstep)
+			    call gtext (gp, sx + dx, sy + dy, label,
+				AX_TICKLABELPOS(ax))
+			} else {
+			    call glb_loglab (gp, sx+dx, sy+dy, wc,
+				AX_TICKLABELPOS(ax), AX_SCALING(ax))
+			}
+
+			# Leave the pen back at the base of the tick.
+			call gamove (gp, sx, sy)
+			call gseti (gp, G_WCS, wcs)
+		    } 
+
+		} else {
+		    # Draw a minor tick.
+
+		    dx = AX_MINORTICK(ax,1)
+		    dy = AX_MINORTICK(ax,2)
+
+		    call gsetr (gp, G_PLWIDTH, AX_MINORWIDTH(ax))
+		    call gseti (gp, G_PLCOLOR, AX_TICKCOLOR(ax))
+		    call grdraw (gp, dx, dy)
+		    call grdraw (gp, -dx, -dy)
+		}
+	    }
+
+	    # Draw line segment from last tick to the end of the axis.
+	    call gadraw (gp, AX_END(ax,1), AX_END(ax,2))
+
+	    # Flush the graphics output.  When working interactively, this
+	    # gives the user something to watch while we generate the rest
+	    # of the plot.
+
+	    if (AX_NMINOR(ax) > 0)
+		call gflush (gp)
+	}
+
+	# Draw grid between major ticks.
+	if (GL_DRAWGRID (GP_XAP(gp)) == YES) {
+	    call gseti (gp, G_PLCOLOR, AX_GRIDCOLOR(axes[3]))
+	    call glb_drawgrid (gp, axes[3], axes[2])
+	}
+	if (GL_DRAWGRID (GP_YAP(gp)) == YES) {
+	    call gseti (gp, G_PLCOLOR, AX_GRIDCOLOR(axes[1]))
+	    call glb_drawgrid (gp, axes[1], axes[4])
+	}
+
+	# Label the X and Y axes.
+	do axis = 1, 4 {
+	    ax = axes[axis]
+	    if (AX_DRAWME(ax) == YES && AX_LABELTICKS(ax) == YES) {
+		call gseti (gp, G_TXCOLOR, AX_AXISLABELCOLOR(ax))
+		call glb_label_axis (gp, ax, xlabel, ylabel)
+	    }
+	}
+
+	# Draw plot title block.
+	call gseti (gp, G_TXCOLOR, GP_TITLECOLOR(gp))
+	call glb_plot_title (gp, title, ntitlelines)
+
+	# Restore the parameters we were originally called with.
+	call gseti (gp, G_WCS, wcs)
+	call gseti (gp, G_CLIP,    save_clip)
+	call gseti (gp, G_PLTYPE,  save_pltype)
+	call gsetr (gp, G_PLWIDTH, save_plwidth)
+	call gseti (gp, G_PLCOLOR, save_plcolor)
+	call gsetr (gp, G_TXSIZE,  save_txsize)
+	call gseti (gp, G_TXFONT,  save_txfont)
+	call gseti (gp, G_TXCOLOR, save_txcolor)
+	call gseti (gp, G_FACOLOR, save_facolor)
+
+	call gflush (gp)
+	call sfree (sp)
+end
diff --git a/sys/gio/glabax/glbencode.x b/sys/gio/glabax/glbencode.x
new file mode 100644
index 00000000..cbed6875
--- /dev/null
+++ b/sys/gio/glabax/glbencode.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"glabax.h"
+
+# GLB_ENCODE -- Encode a floating point number as a character string for a
+# tick label.  We have to be careful how we do this, since on the one hand
+# we want the most concise label possible (e.g., 500 not 500.00) but on the
+# other we must provide enough precision to discriminate between ticks that
+# are close together (e.g., 500.02 and 500.04).  The extra information is
+# given by the "ndigits" argument, which was calculated knowing the range
+# and step at setup time.
+
+procedure glb_encode (x, out, maxch, format, step)
+
+real	x			# number to be encoded
+char	out[ARB]		# output string
+int	maxch			# max chars out
+char	format[ARB]		# sprintf format
+real	step			# tick spacing
+
+int	ip, op
+real	nicex
+define	trim_ 91
+
+begin
+	# Test for the zero tick, to avoid tick labels that look like the
+	# machine epsilon.
+
+	if (abs (x / step) < TOL)
+	    nicex = 0
+	else
+	    nicex = x
+
+	# Encode number.
+	call sprintf (out, maxch, format)
+	    call pargr (nicex)
+
+	# Lop off any insignificant trailing zeros or periods.  Watch out for
+	# trailing zeros in exponential format, e.g., "1.0E10".
+
+	for (ip=1;  out[ip] != EOS;  ip=ip+1)
+	    if (out[ip] == 'E' || out[ip] == 'D')
+		goto trim_
+
+	for (ip=ip-1;  ip > 1 && out[ip] == '0';  ip=ip-1)
+	    ;
+	if (ip > 1 && out[ip] == '.')
+	    ip = ip - 1
+	if (ip >= 1)
+	    out[ip+1] = EOS
+
+	# Lop off any insignificant leading zeros, but be sure to leave at
+	# least one digit.
+trim_
+	for (op=1;  out[op] == '-' || out[op] == '+';  op=op+1)
+	    ;
+	for (ip=op;  out[ip] == '0' && out[ip+1] != EOS;  ip=ip+1)
+	    ;
+	while (out[ip] != EOS) {
+	    out[op] = out[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	out[op] = EOS
+end
diff --git a/sys/gio/glabax/glbfind.x b/sys/gio/glabax/glbfind.x
new file mode 100644
index 00000000..b9ff3975
--- /dev/null
+++ b/sys/gio/glabax/glbfind.x
@@ -0,0 +1,339 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_FIND_TICKS -- Find the optimal positions for the tick marks on an axis.
+# If rounding is enabled, extend the WCS out to the next tick outside the
+# boundary on either end of the axis.  Since this routine may modify the WCS
+# it must be called before any other routines (e.g., glb_setaxes).  Our task
+# is to position the major ticks in world coordinates at round numbers, e.g.,
+# 10, 20, 30 for a linear scale or 10, 100, 1000 for a log scale.  The minor
+# ticks are evenly distributed over the range between the major ticks.  If
+# log scaling is in use the step size between ticks will change by an order
+# of magnitude (by the factor KSTEP) in each decade of the log scale, i.e.,
+# at each major tick.  All tick positions and offsets are output in world
+# coordinates.
+
+procedure glb_find_ticks (gp, ap, ax1, ax2, angle)
+
+pointer	gp			# graphics descriptor
+pointer	ap			# axis parameters (from graphics descriptor)
+pointer	ax1, ax2		# axis descriptors (output)
+int	angle			# axis orientation, 0 or 90 degrees
+
+pointer	w
+int	logflag, nminor, scaling, t1, t2
+real	char_height, char_width, wctick, tval
+real	p1, p2, tp1, tp2, wcp1, tick1, step, minor_step, length
+
+bool	fp_equalr()
+int	gt_ndigits()
+real	ggetr(), elogr(), aelogr(), glb_minorstep()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Start by zeroing the AX structures so that we do not have to zero
+	# fields explicitly.  This is a bit tricky because we are implicitly
+	# setting fields that are not named, but it saves time and space.
+
+	call aclri (Memi[ax1], LEN_AX)
+	call aclri (Memi[ax2], LEN_AX)
+
+	# If ticks are not to be drawn or if there are fewer than 2 ticks then
+	# we are done.
+
+	if (GL_NMAJOR(ap) <= 2)
+	    return
+
+	# Call the tick placement algorithm to determine where to put the major
+	# tick marks.  The output of this block are the variables P1 and P1,
+	# the world coords of the ends of the axis, and TICK1 and STEP, the
+	# world coords of the first tick and separation in world coords between
+	# major ticks.
+
+	if (angle == 0) {
+	    p1 = WCS_WX1(w)
+	    p2 = WCS_WX2(w)
+	    scaling = WCS_XTRAN(w)
+	} else {
+	    p1 = WCS_WY1(w)
+	    p2 = WCS_WY2(w)
+	    scaling = WCS_YTRAN(w)
+	}
+
+	AX_SCALING(ax1) = scaling
+	AX_SCALING(ax2) = scaling
+
+	if (scaling == LOG) {
+	    p1 = log10 (p1)
+	    p2 = log10 (p2)
+	    logflag = YES
+	} else if (scaling == ELOG) {
+	    p1 = elogr (p1)
+	    p2 = elogr (p2)
+	    logflag = YES
+	} else
+	    logflag = NO
+
+	# Call the tick placement algorithm.
+	call gtickr (p1, p2, GL_NMAJOR(ap), logflag, tick1, step)
+
+	# If rounding is enabled, extend the WCS out to the next major tick
+	# position outward on either end.  Always round if log scaling.
+
+	if (GL_ROUND(ap) == YES || scaling != LINEAR) {
+	    if (!fp_equalr (p1, tick1)) {
+		tick1 = tick1 - step
+		p1 = tick1
+	    }
+
+	    length = (p2 - p1) / step
+	    if (!fp_equalr (p1 + int(length) * step, p2))
+		p2 = p1 + (int(length) + 1) * step
+
+	    if (scaling == ELOG) {
+		tp1 = aelogr (p1)
+		tp2 = aelogr (p2)
+	    } else if (scaling == LOG) {
+		tp1 = 10.0 ** p1
+		tp2 = 10.0 ** p2
+	    } else {
+		tp1 = p1
+		tp2 = p2
+	    }
+
+	    if (angle == 0) {
+		WCS_WX1(w) = tp1
+		WCS_WX2(w) = tp2
+	    } else {
+		WCS_WY1(w) = tp1
+		WCS_WY2(w) = tp2
+	    }
+
+	    GP_WCSSTATE(gp) = MODIFIED
+	}
+
+	# Compute the coords of the axis endpoint and of the first tick in world
+	# coords.
+
+	if (scaling == LINEAR) {
+	    wctick = tick1
+	    wcp1 = p1
+	} else if (scaling == LOG) {
+	    wctick = 10.0 ** tick1
+	    wcp1 = 10.0 ** p1
+	} else {
+	    wctick = aelogr (tick1)
+	    wcp1 = aelogr (p1)
+	}
+
+	# Compute the number of minor ticks.  If we are log scaling there
+	# are either no minor ticks or 8 minor ticks.  If the scaling is
+	# linear the tick placement algorithm is used to compute the best
+	# number of minor ticks, using GL_NMINOR as a close estimate.  If
+	# NMINOR is negative automatic tick selection is disabled and exactly
+	# abs(NMINOR) ticks will be drawn.  If NMINOR is zero no minor ticks
+	# are drawn.
+
+	if (GL_NMINOR(ap) == 0)			# no minor ticks
+	    nminor = 0
+	else if (logflag == YES)		# log scaling
+	    nminor = 8
+	else {
+	    minor_step = glb_minorstep (tick1, tick1+step, GL_NMINOR(ap))
+	    nminor = nint (abs (step / minor_step)) - 1
+	}
+
+	AX_NMINOR(ax1) = nminor
+	AX_NMINOR(ax2) = nminor
+
+	# Compute the step size in world coords between minor ticks and the
+	# number of minor ticks to be drawn initially until the first major
+	# tick (tick1) is reached.  Note that for ELOG scaling the minor
+	# step size and number of minor ticks are different in the range
+	# +-10 (which is linear) than elsewhere, but we ignore that here.
+
+	if (scaling == LINEAR) {
+	    minor_step = step / (nminor + 1)
+	    AX_INLEFT(ax1) = abs (int ((wctick - wcp1) / minor_step))
+	} else {
+	    t1 = nint (tick1)
+	    t2 = nint (tick1 + step)
+	    if (scaling == LOG)
+		minor_step = (10.0 ** t2 - 10.0 ** t1) / 9.
+	    else
+		minor_step = (aelogr(real(t2)) - aelogr(real(t1))) / 9.
+	    if (nminor == 0)
+		minor_step = minor_step * 9.
+	    AX_INLEFT(ax1) = 0
+	}
+
+	AX_INLEFT(ax2) = AX_INLEFT(ax1)
+
+	# Set KSTEP, the adjustment to the step size at each major tick.  This
+	# is always 1.0 if the scale is linear.  Set KSTEP to negative if ELOG
+	# scaling, to tell the drawing code to invert kstep (.1->10 or 10->.1)
+	# when passing through the origin (necessary for ELOG scaling).  The
+	# sign is not otherwise significant.  If heading toward the origin
+	# initially then KSTEP is inverted for ELOG scaling vs LOG scaling.
+
+	if (scaling == LINEAR) {
+	    AX_IKSTEP(ax1) = 1.0
+	} else if (scaling == ELOG) {
+	    tval = p1
+	    if (abs (tval + step) > abs(t1))
+		AX_IKSTEP(ax1) = -10.0
+	    else
+		AX_IKSTEP(ax1) = -0.1
+	} else
+	    AX_IKSTEP(ax1) = 10.0 ** step
+	AX_IKSTEP(ax2) = AX_IKSTEP(ax1)
+
+	# Set those parameters which differ depending on whether the axis is
+	# horizontal or vertical.
+
+	if (angle == 0) {
+	    AX_TICK1(ax1,1) = wctick - (AX_INLEFT(ax1) * minor_step)
+	    AX_TICK1(ax2,1) = wctick - (AX_INLEFT(ax2) * minor_step)
+
+	    if (GL_SETAXISPOS(ap) == YES) {
+		AX_TICK1(ax1,2) = GL_AXISPOS1(ap)
+		AX_TICK1(ax2,2) = GL_AXISPOS2(ap)
+	    } else {
+		AX_TICK1(ax1,2) = WCS_WY1(w)
+		AX_TICK1(ax2,2) = WCS_WY2(w)
+	    }
+
+	    AX_ISTEP(ax1,1) = minor_step
+	    AX_ISTEP(ax2,1) = minor_step
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    char_height = char_height * GL_TICKLABELSIZE(ap)
+
+	    AX_TICKLABELOFFSET(ax2,2) = 0.5 * char_height
+	    AX_TICKLABELOFFSET(ax1,2) = -AX_TICKLABELOFFSET(ax2,2)
+
+	    # Set gtext format for tick labels.
+	    call strcpy ("hj=c,vj=t", AX_TICKLABELPOS(ax1), SZ_FORMAT)
+	    call strcpy ("hj=c,vj=b", AX_TICKLABELPOS(ax2), SZ_FORMAT)
+
+	} else {
+	    if (GL_SETAXISPOS(ap) == YES) {
+		AX_TICK1(ax1,1) = GL_AXISPOS1(ap)
+		AX_TICK1(ax2,1) = GL_AXISPOS2(ap)
+	    } else {
+		AX_TICK1(ax1,1) = WCS_WX1(w)
+		AX_TICK1(ax2,1) = WCS_WX2(w)
+	    }
+
+	    AX_TICK1(ax1,2) = wctick - (AX_INLEFT(ax1) * minor_step)
+	    AX_TICK1(ax2,2) = wctick - (AX_INLEFT(ax2) * minor_step)
+
+	    AX_ISTEP(ax1,2) = minor_step
+	    AX_ISTEP(ax2,2) = minor_step
+
+	    char_width = ggetr (gp, "cw")
+	    if (char_width < EPSILON)
+		char_width = DEF_CHARWIDTH
+	    char_width = char_width * GL_TICKLABELSIZE(ap)
+
+	    AX_TICKLABELOFFSET(ax2,1) = 0.5 * char_width
+	    AX_TICKLABELOFFSET(ax1,1) = -AX_TICKLABELOFFSET(ax2,1)
+
+	    call strcpy ("hj=r,vj=c", AX_TICKLABELPOS(ax1), SZ_FORMAT)
+	    call strcpy ("hj=l,vj=c", AX_TICKLABELPOS(ax2), SZ_FORMAT)
+	}
+
+	# Set the tick parameters that are identical for the two axes and
+	# which do not depend on whether the axis is horizontal or vertical.
+
+	AX_DRAWTICKS(ax1)	= GL_DRAWTICKS(ap)
+	AX_DRAWTICKS(ax2)	= GL_DRAWTICKS(ap)
+	AX_TICKLABELSIZE(ax1)	= GL_TICKLABELSIZE(ap)
+	AX_TICKLABELSIZE(ax2)	= GL_TICKLABELSIZE(ap)
+	AX_TICKLABELCOLOR(ax1)	= GL_TICKLABELCOLOR(ap)
+	AX_TICKLABELCOLOR(ax2)	= GL_TICKLABELCOLOR(ap)
+	AX_TICKCOLOR(ax1)	= GL_TICKCOLOR(ap)
+	AX_TICKCOLOR(ax2)	= GL_TICKCOLOR(ap)
+	AX_GRIDCOLOR(ax1)	= GL_GRIDCOLOR(ap)
+	AX_GRIDCOLOR(ax2)	= GL_GRIDCOLOR(ap)
+	AX_AXISLABELSIZE(ax1)	= GL_AXISLABELSIZE(ap)
+	AX_AXISLABELSIZE(ax2)	= GL_AXISLABELSIZE(ap)
+	AX_AXISLABELCOLOR(ax1)	= GL_AXISLABELCOLOR(ap)
+	AX_AXISLABELCOLOR(ax2)	= GL_AXISLABELCOLOR(ap)
+	AX_AXISWIDTH(ax1)	= GL_AXISWIDTH(ap)
+	AX_AXISWIDTH(ax2)	= GL_AXISWIDTH(ap)
+	AX_AXISCOLOR(ax1)	= GL_AXISCOLOR(ap)
+	AX_AXISCOLOR(ax2)	= GL_AXISCOLOR(ap)
+	AX_MINORWIDTH(ax1)	= GL_MINORWIDTH(ap)
+	AX_MINORWIDTH(ax2)	= GL_MINORWIDTH(ap)
+	AX_MAJORWIDTH(ax1)	= GL_MAJORWIDTH(ap)
+	AX_MAJORWIDTH(ax2)	= GL_MAJORWIDTH(ap)
+
+	# Compute the number of digits of precision needed for the tick labels.
+	AX_NDIGITS(ax1) = max (1, gt_ndigits (p1, p2, step))
+	AX_NDIGITS(ax2) = AX_NDIGITS(ax1)
+
+	# If both axes are to be drawn label ticks if enabled.  If only one
+	# axis is to be drawn that is the axis that must be labelled.
+
+	if (GL_DRAWAXES(ap) > 0) {
+	    AX_LABELTICKS(ax1) = GL_LABELTICKS(ap)
+	    AX_LABELTICKS(ax2) = GL_LABELTICKS(ap)
+	}
+	if (GL_DRAWAXES(ap) == 1 || GL_DRAWAXES(ap) == 3)
+	    AX_LABELTICKS(ax2) = NO
+	else if (GL_DRAWAXES(ap) == 2)
+	    AX_LABELTICKS(ax1) = NO
+
+	# The user may override the tick label format if desired.
+	if (GL_TICKFORMAT(ap) == EOS) {
+	    call sprintf (AX_TICKFORMAT(ax1), SZ_FORMAT, "%%0.%dg")
+		call pargi (AX_NDIGITS(ax1) + 1)
+	} else
+	    call strcpy (GL_TICKFORMAT(ap), AX_TICKFORMAT(ax1), SZ_FORMAT)
+	call strcpy (AX_TICKFORMAT(ax1), AX_TICKFORMAT(ax2), SZ_FORMAT)
+end
+
+
+# GLB_MINORSTEP -- Determine the step size for the minor ticks.  Adapted
+# from a routine by J. Eisenhamer (STScI) which was based on some MONGO code.
+
+real procedure glb_minorstep (x1, x2, nminor)
+
+real	x1, x2		#I interval between major ticks
+int	nminor		#I suggested number of minor ticks, or actual# if neg
+
+int	iexp
+real	amant, diff, num, range
+
+begin
+	range = abs (x2 - x1)
+	if (nminor < 0)
+	    return (range / real (-nminor + 1))
+	else {
+	    # Determine magnitude of the intervals.
+	    diff = log10 (range / nminor)
+	    iexp = int (diff)
+	    if (diff < 0)
+		iexp = iexp - 1
+	    amant = diff - real(iexp)
+
+	    # Determine an appropriate step size.
+	    if (amant < 0.15)
+		num = 1.0
+	    else if (amant < 0.50)
+		num = 2.0
+	    else if (amant < 0.85)
+		num = 5.0
+	    else
+		num = 10.0
+
+	    return (num * 10.0**iexp)
+	}
+end
diff --git a/sys/gio/glabax/glbgrid.x b/sys/gio/glabax/glbgrid.x
new file mode 100644
index 00000000..ecb24ffb
--- /dev/null
+++ b/sys/gio/glabax/glbgrid.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_DRAWGRID -- Draw a grid across the plotting surface, i.e., draw
+# dotted lines between the major tick marks.
+
+procedure glb_drawgrid (gp, ax1, ax2)
+
+pointer	gp			# graphics descriptor
+pointer	ax1			# descriptor for first axis
+pointer	ax2			# descriptor for second axis
+
+int	wcs, major_tick
+real	x, y, tolerance
+real	x1, y1, x2, y2, sx, sy
+int	glb_gettick()
+errchk	glb_gettick, gseti, gsetr, gline, gctran
+
+begin
+	tolerance = TOL
+	wcs = GP_WCS(gp)
+
+	# Cache the NDC coordinates of the ends of an axis.
+	call gctran (gp, AX_START(ax1,1), AX_START(ax1,2), x1,y1, wcs, 0)
+	call gctran (gp,   AX_END(ax1,1),   AX_END(ax1,2), x2,y2, wcs, 0)
+
+	# Set polyline linetype for a dotted line.
+	call gseti (gp, G_PLTYPE, GL_DOTTED)
+	call gsetr (gp, G_PLWIDTH, 1.0)
+
+	AX_NLEFT(ax1) = -1
+	while (glb_gettick (gp, ax1, x, y, major_tick) != EOF) {
+	    if (major_tick == NO)
+		next
+
+	    # Draw grid line if we are at a major tick, provided the tick
+	    # is not at the end of the axis.
+
+	    call gctran (gp, x,y, sx,sy, wcs, 0)
+	    if (AX_HORIZONTAL(ax1) == YES) {
+		if (sx - x1 > tolerance && sx - x2 < tolerance)
+		    call gline (gp, x, AX_END(ax1,2), x, AX_END(ax2,2))
+	    } else {
+		if (sy - y1 > tolerance && sy - y2 < tolerance)
+		    call gline (gp, AX_END(ax1,1), y, AX_END(ax2,1), y)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, GL_SOLID)
+end
diff --git a/sys/gio/glabax/glbgtick.x b/sys/gio/glabax/glbgtick.x
new file mode 100644
index 00000000..cc70fd3a
--- /dev/null
+++ b/sys/gio/glabax/glbgtick.x
@@ -0,0 +1,252 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_GETTICK -- Get the position and type of the next tick on an axis.
+# Ticks are accessed sequentially.  There are three types of tick scalings,
+# LINEAR, LOG, and ELOG.  The tick scaling need not necessarily agree with
+# the WCS scaling, hence linear tick scaling might be used on a nonlinear
+# coordinate system.  If the scaling is linear then the first tick need not
+# fall at the endpoint of the axis.  If log (or elog) scaling is in use then
+# the axis will have been rounded out to a decade and the first tick will
+# necessarily fall on the axis endpoint.  The scalings are described by the
+# following parameters:
+#
+#			(variables)
+#	nleft			number of minor ticks left to next major tick
+#	step(x,y)		displacement between minor ticks (world coords)
+#
+#			(constants)
+#	tick1(x,y)		world coords of the first tick on an axis
+#	nminor			number of minor ticks between major ticks
+#	istep(x,y)		initial step (actual step may differ)
+#	kstep(x,y)		adjustment to step at major ticks
+# 
+# KSTEP is unity if the scaling is linear.  The log scalings have a KSTEP of
+# either 10.0 or 0.1.  A negative KSTEP value is used to flag ELOG scaling.
+# ELOG, or extended range log scaling, is a log scaling which is defined for
+# X <=0 as well as x > 0.  This function is logarithmic for values less than
+# -10 or greater than 10, and linear in the range [-10:+10].  This complicates
+# tick computation because the usual 8 minor ticks per decade characteristic
+# of log scaling are not appropriate in the linear regime.  If the scaling
+# is ELOG then we ignore NMINOR and ISTEP in the linear range, changing the
+# values of these parameters temporarily to reflect 4 minor ticks with a tick
+# spacing of 2.0.
+#
+# (Note to the reader: don't feel discouraged if you don't understand this
+# (stuff, it is so complicated I don't understand it either!  Having to deal
+# (with linear, log, and elog scaling with both major and minor ticks,
+# (sometimes no minor ticks, with the axis starting at any part of the scale
+# (seems an inherently difficult problem to program compactly.  Barring
+# (programming each case separately, the best approach I could come up with was
+# (to walkthrough the code separately for each case, from all initial
+# (conditions, until it works for all cases.  If you have problems determine
+# (the initial conditions (the case) and do a similar walkthough.  Of course,
+# (if you make a change affecting one case, you may well make the code fail for
+# (a different case.
+
+int procedure glb_gettick (gp, ax, x, y, major_tick)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+real	x, y			# coordinates of next tick (output)
+int	major_tick		# YES if next tick is a major tick
+
+int	i, axis, wcs, w, scaling, nminor, expon
+real	kstep, step, astep, ten, sx, sy, tolerance, pos, norm_pos
+bool	glb_eq()
+define	logscale_ 91
+
+begin
+	if (AX_DRAWTICKS(ax) == NO)
+	    return (EOF)
+
+	tolerance = TOL
+	scaling = AX_SCALING(ax)
+	nminor  = AX_NMINOR(ax)
+	kstep   = AX_KSTEP(ax)
+
+	if (AX_HORIZONTAL(ax) == YES)
+	    axis = 1
+	else
+	    axis = 2
+
+	# Count down a minor tick.  If nleft is negative then we are being
+	# called for the first time for this axis.
+
+	if (AX_NLEFT(ax) < 0) {
+
+	    # Initialize everything and return coords of the first tick.
+	    AX_KSTEP(ax) = AX_IKSTEP(ax)
+	    AX_NLEFT(ax) = AX_INLEFT(ax)
+	    do i = 1, 2 {
+		AX_POS(ax,i)  = AX_TICK1(ax,i)
+		AX_STEP(ax,i) = AX_ISTEP(ax,i)
+	    }
+
+	    step  = AX_STEP(ax,axis)
+	    astep = abs (step)
+
+	    if (AX_NLEFT(ax) == 0) {
+		# Note that there may not be any minor ticks.
+		major_tick = YES
+		AX_NLEFT(ax) = nminor
+		if (nminor > 0)
+		    if (scaling == ELOG && (astep >= .99 && astep < 2.0)) {
+			# Elog scaling in linear region.
+			AX_NLEFT(ax) = 4
+			if (step < 0)
+			    step = -2.0
+			else
+			    step =  2.0
+			AX_STEP(ax,axis) = step
+		    }
+	    } else {
+		AX_NLEFT(ax) = AX_NLEFT(ax) - 1
+		major_tick = NO
+	    }
+
+	    # Elog scaling in linear region.  KSTEP must be inverted as we
+	    # pass through the origin.  This normally occurs upon entry to the
+	    # linear region, but if we start out at +/- 10 we must set KSTEP
+	    # to its linear value during setup.
+
+	    if (scaling == ELOG && glb_eq(step,2.0))
+		AX_KSTEP(ax) = -10.0
+
+	} else {
+	    # All ticks after the first tick.
+	    do i = 1, 2
+		AX_POS(ax,i) = AX_POS(ax,i) + AX_STEP(ax,i)
+	    AX_NLEFT(ax) = AX_NLEFT(ax) - 1
+
+	    # If we are log scaling the ticks will never have more than 2
+	    # digits of precision.  Try to correct for the accumulation of
+	    # error by rounding.  When log scaling the error increases by
+	    # a factor of ten in each decade and can get quite large if
+	    # the log scale covers a large range.
+
+	    if (scaling != LINEAR) {
+		pos = AX_POS(ax,axis)
+		call fp_normr (pos, norm_pos, expon)
+		pos = nint (norm_pos * 10.0) / 10.0
+		pos = pos * (10.0 ** expon)
+		AX_POS(ax,axis) = pos
+	    }
+
+	    if (AX_NLEFT(ax) < 0) {
+		# Next tick is a major tick.  If log scaling we must reset
+		# the tick parameters for the next decade.
+
+		major_tick = YES
+		AX_NLEFT(ax) = nminor
+
+		# The following handles the special case of ELOG scaling in
+		# the linear regime when the number of minor ticks is zero.
+		# The step size in such a case is 9 to some power in the log
+		# region and +/- 10 in the linear region.
+
+		if (scaling == ELOG && nminor == 0) {
+		    pos = AX_POS(ax,axis)
+		    if (step < 0)
+			ten = -10.
+		    else
+			ten = 10.
+
+		    if (glb_eq (pos, 10.0)) {
+			if (glb_eq (step, 10.0)) {
+			    if (step < 0)
+				AX_STEP(ax,axis) = -9.
+			    else
+				AX_STEP(ax,axis) = 9.
+			    goto logscale_
+			} else
+			    step = ten
+		    } else if (glb_eq (pos, 0.0)) {
+			step = ten
+			if (pos / step < 0)
+			    AX_KSTEP(ax) = -0.1
+			else
+			    AX_KSTEP(ax) = -10.0
+		    } else
+			goto logscale_
+		    AX_STEP(ax,axis) = step
+
+		} else if (scaling != LINEAR) {
+		    # Adjust the tick step by the kstep factor, provided we
+		    # are not at the origin in ELOG scaling (the step is 1
+		    # on either side of the origin for ELOG scaling).  Reset
+		    # the step size to 1.0 if ELOG scaling and just coming out
+		    # of the linear regime.
+logscale_
+		    step = AX_STEP(ax,axis)
+		    if (scaling != ELOG || abs(AX_POS(ax,axis)) > 0.1) {
+			if (scaling == ELOG && glb_eq (step, 2.0))
+			    AX_STEP(ax,axis) = step / 2.0
+
+			do i = 1, 2
+			    AX_STEP(ax,i) = AX_STEP(ax,i) * abs (AX_KSTEP(ax))
+		    }
+
+		    # Adjust the step size to 2.0 if ELOG scaling and in the
+		    # linear regime (initial step size of 1).
+
+		    step = AX_STEP(ax,axis)
+		    if (scaling == ELOG && glb_eq(step,1.0)) {
+			if (step < 0)
+			    step = -2.0
+			else
+			    step =  2.0
+			AX_STEP(ax,axis) = step
+		    }
+
+		    # If elog scaling and we have just entered the linear
+		    # regime, adjust the number of ticks and the KSTEP factor.
+
+		    if (scaling == ELOG && glb_eq(step,2.0)) {
+			# Elog scaling in linear region.  KSTEP must be
+			# inverted as we pass through the origin.
+
+			if (abs(AX_POS(ax,axis)) > 0.1)
+			    AX_KSTEP(ax) = -10.0
+
+			if (nminor > 0)
+			    AX_NLEFT(ax) = 4
+		    }
+		}
+	    } else
+		major_tick = NO
+	}
+
+	x = AX_POS(ax,1)
+	y = AX_POS(ax,2)
+
+	# Return EOF if tick falls beyond end of axis.  The comparison is made
+	# in NDC coords to avoid having to check if the WCS is increasing or
+	# decreasing and to avoid the problems of comparing unnormalized
+	# floating point numbers.
+
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR(gp,wcs)
+
+	call gctran (gp, x,y, sx,sy, wcs, 0)
+	if (sx - WCS_SX2(w) > tolerance || sy - WCS_SY2(w) > tolerance)
+	    return (EOF)
+	else
+	    return (OK)
+end
+
+
+# GLB_EQ -- Compare two (near normalized) floating point numbers for
+# equality, using the absolute value of the first argument.
+
+bool procedure glb_eq (a, b)
+
+real	a			# compare absolute value of this number
+real	b			# to this positive number
+
+begin
+	return (abs (abs(a) - b) < 0.1)
+end
diff --git a/sys/gio/glabax/glblabel.x b/sys/gio/glabax/glblabel.x
new file mode 100644
index 00000000..ecf57c94
--- /dev/null
+++ b/sys/gio/glabax/glblabel.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_LABEL_AXIS -- Label an axis.  If both axes were drawn only the first is
+# labelled, otherwise the label is placed on withever axis was drawn.  This is
+# done by drawing the axis labels just outside the tick mark labels, wherever
+# those happened to be.  The axis label offset is in the same direction as the
+# tick label offset and is centered on each axis.  The distance from the axis
+# is a function of the size of the tick labels.
+
+procedure glb_label_axis (gp, ax, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+char	xlabel[ARB]		# X axis label
+char	ylabel[ARB]		# Y axis label
+
+int	wcs
+real	x1, x2, y1, y2, x, y, dx, dy
+real	char_height, char_width
+int	strlen()
+real	ggetr()
+
+begin
+	wcs = GP_WCS(gp)
+
+	# Get character height and width in NDC coords.
+	char_height = ggetr (gp, "ch")
+	char_width  = ggetr (gp, "cw")
+
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+
+	# Compute axis center in NDC coords.
+	call gctran (gp, AX_START(ax,1), AX_START(ax,2), x1,y1, wcs, 0)
+	call gctran (gp,   AX_END(ax,1),   AX_END(ax,2), x2,y2, wcs, 0)
+	x = (x1 + x2) / 2.0
+	y = (y1 + y2) / 2.0
+
+	# Set relative text size and get device character size for a text
+	# size of 1.0.  Set WCS to NDC coords since the offset to the
+	# tick label is in NDC coordinates.
+
+	call gsetr (gp, G_TXSIZE, AX_AXISLABELSIZE(ax))
+	call gseti (gp, G_WCS, 0)
+
+	# Draw the axis label.
+
+	if (AX_HORIZONTAL(ax) == YES) {
+	    # Axis is horizontal.  Tick label vector tells us whether to
+	    # draw axis label above or below axis.
+
+	    if (strlen (xlabel) > 0) {
+		dy = 2.0 * AX_TICKLABELSIZE(ax) * char_height +
+		     0.5 * AX_AXISLABELSIZE(ax) * char_height
+		if (AX_TICKLABELOFFSET(ax,2) < 0)
+		    dy = -dy
+		call gtext (gp, x, y + dy, xlabel, "hj=c;vj=c")
+	    }
+	} else {
+	    # Axis is vertical.  Always put label fixed distance from axis
+	    # regardless of size of tick labels (for consistency and to
+	    # avoid clipping at the device screen boundary).  Label runs
+	    # bottom to top in a vertical field with char up pointing to
+	    # the left.
+
+	    if (strlen (ylabel) > 0) {
+		dx = (Y_LABELOFFSET * char_width * AX_TICKLABELSIZE(ax)) + 
+		    0.5 * AX_AXISLABELSIZE(ax) * char_height
+		    
+		if (AX_TICKLABELOFFSET(ax,1) < 0)
+		    dx = -dx
+		call gtext (gp, x + dx, y, ylabel, "up=180;hj=c;vj=c")
+	    }
+	}
+
+	call gseti (gp, G_WCS, wcs)
+end
diff --git a/sys/gio/glabax/glbloglab.x b/sys/gio/glabax/glbloglab.x
new file mode 100644
index 00000000..6e7ec1cc
--- /dev/null
+++ b/sys/gio/glabax/glbloglab.x
@@ -0,0 +1,139 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+define	SZ_MANTISSA	3		# "10" or "-10"
+define	SZ_EXPONENT	4		# largest is "-999"
+
+
+# GLB_LOGLAB -- Draw a tick label in log units at the given position.
+# A log tick is a power of ten, e.g.  10^2, where the ^ signifies that
+# the 2 is to be drawn one half character height higher than the 10.
+
+procedure glb_loglab (gp, sx, sy, val, fmt, scaling)
+
+pointer	gp			# graphics descriptor
+real	sx, sy			# NDC coords of label
+real	val			# value to be encoded (not the log of)
+char	fmt[ARB]		# tick label gtext format (justification)
+int	scaling			# type of scaling on axis
+
+bool	zero
+char	mantissa[SZ_MANTISSA]
+char	exponent[SZ_EXPONENT]
+int	len_mantissa, len_exponent, ip, hj, vj
+real	logval, char_height, char_width, left, xpos, ypos, txsize
+
+bool	fp_equalr()
+real	elogr(), gstatr(), ggetr()
+int	strlen(), strmatch(), itoc()
+
+begin
+	# Compute the log value to be encoded.
+	if (scaling == LOG)
+	    logval = log10 (val)
+	else {
+	    logval = elogr (val)
+	    zero = fp_equalr (logval, 0.0)
+	}
+
+	txsize = gstatr (gp, G_TXSIZE)
+
+	# Get char height and width in NDC coords.
+	char_height = ggetr (gp, "ch")
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+	char_height = char_height * txsize
+
+	char_width = ggetr (gp, "cw")
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+	char_width = char_width * txsize
+
+	# Encode the mantissa and exponent strings.
+	if (zero) {
+	    call strcpy ("0", mantissa, SZ_MANTISSA)
+	} else if (logval < 0 && scaling == ELOG) {
+	    call strcpy ("-10", mantissa, SZ_MANTISSA)
+	    logval = abs (logval)
+	} else
+	    call strcpy ("10", mantissa, SZ_MANTISSA)
+
+	len_mantissa = strlen (mantissa)
+	if (zero)
+	    len_exponent = 0
+	else
+	    len_exponent = itoc (nint(logval), exponent, SZ_EXPONENT)
+
+	# Determine type of horizontal justification required.
+	ip = strmatch (fmt, "hj=")
+	if (ip <= 0)
+	    hj = 'c'
+	else
+	    hj = fmt[ip]
+
+	# Determine type of vertical justification required.
+	ip = strmatch (fmt, "vj=")
+	if (ip <= 0)
+	    vj = 'c'
+	else
+	    vj = fmt[ip]
+
+	# On devices with adjustable character sizes the most pleasing results
+	# are obtained if the digits "10" are nicely aligned on the vertical
+	# axis, regardless of the actual number of characters in the exponent
+	# string, minus signs etc (this type of alignment is more natural
+	# because the exponent is printed at half size).  Hence if we are on
+	# a vertical axis (hj != c) fix the number of characters in the two
+	# strings so that the alignment comes out the same regardless of the
+	# actual number of chars in either field.  The length of the exponent
+	# field is not completely fixed, rather we allow a little more space
+	# if the exponent is large.  For small exponents len_exponent=1.
+
+	if (hj != 'c') {
+	    len_mantissa = 2
+	    len_exponent = (len_exponent + 1) / 2
+	}
+
+	# Compute XPOS, the NDC X coord of the point halfway between the
+	# last char of the mantissa and the first char of the exponent.
+
+	switch (hj) {
+	case 'l':
+	    left = sx
+	case 'r':
+	    left = sx - (len_mantissa + len_exponent) * char_width
+	default:
+	    left = sx - ((len_mantissa + len_exponent) * char_width) / 2.0
+	}
+
+	xpos = left + len_mantissa * char_width
+
+	# Compute YPOS, the NDC Y coord of the center of a mantissa character
+	# and of the bottom of an exponent character.  Using the same coordinate
+	# to address both positions makes the label come out the same regardless
+	# of the plot magnification, even on a device where the character size
+	# is fixed by the hardware.
+
+	switch (vj) {
+	case 'b':
+	    ypos = sy + char_height / 2.0
+	case 't':
+	    ypos = sy - char_height / 2.0
+	default:
+	    ypos = sy
+	}
+
+	# Draw the mantissa.
+	call gtext (gp, xpos, ypos, mantissa, "hj=r,vj=c")
+
+	# Draw the exponent if there is one.
+	if (!zero) {
+	    call gsetr (gp, G_TXSIZE, txsize / 2.0)
+	    call gtext (gp, xpos, ypos, exponent, "hj=l;vj=b")
+	    call gsetr (gp, G_TXSIZE, txsize)
+	}
+end
diff --git a/sys/gio/glabax/glbsetax.x b/sys/gio/glabax/glbsetax.x
new file mode 100644
index 00000000..f0c9aa29
--- /dev/null
+++ b/sys/gio/glabax/glbsetax.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_SET_AXES -- Set all axis descriptor parameters not pertaining to the
+# ticks.  The WCS has already been fixed by the time we get here.
+
+procedure glb_set_axes (gp, ap, ax1, ax2, angle)
+
+pointer	gp			# graphics descriptor
+pointer	ap			# axis parameters (from graphics descriptor)
+pointer	ax1, ax2		# axis descriptors (output)
+int	angle			# axis orientation, 0 or 90 degrees
+
+pointer	w
+int	axis
+real	p1, p2
+real	x1, x2, y1, y2
+real	glb_ticklen()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# If the window was rounded in Y in the second call to find_ticks,
+	# then the Y positions of the first ticks set in the first call will
+	# be in error and must be corrected.  If the user has elected to set
+	# the axis position explicitly, however, then we must leave it alone.
+
+	if (angle == 0 && GL_SETAXISPOS(GP_XAP(gp)) == NO) {
+	    AX_TICK1(ax1,2) = WCS_WY1(w)
+	    AX_TICK1(ax2,2) = WCS_WY2(w)
+	}
+
+	# Set the tick lengths.  This is done here rather than in findticks
+	# due to rounding, as noted above.  The tick offsets in world
+	# coordinates.  The GL values are given in NDC coordinates.
+
+	if (angle == 0) {
+	    axis = 2
+	    AX_HORIZONTAL(ax1) = YES
+	    AX_HORIZONTAL(ax2) = YES
+	} else {
+	    axis = 1
+	    AX_HORIZONTAL(ax1) = NO
+	    AX_HORIZONTAL(ax2) = NO
+	}
+
+	AX_MAJORTICK(ax1,axis) = glb_ticklen (gp, ax1,  GL_MAJORLENGTH(ap))
+	AX_MINORTICK(ax1,axis) = glb_ticklen (gp, ax1,  GL_MINORLENGTH(ap))
+	AX_MAJORTICK(ax2,axis) = glb_ticklen (gp, ax2, -GL_MAJORLENGTH(ap))
+	AX_MINORTICK(ax2,axis) = glb_ticklen (gp, ax2, -GL_MINORLENGTH(ap))
+
+	# Select none, either, or both axes to be drawn.  If only the second
+	# axis is drawn then that is the side we must draw the tick and axis
+	# labels on.
+
+	switch (GL_DRAWAXES(ap)) {
+	case 0:
+	    AX_DRAWME(ax1) = NO
+	    AX_DRAWME(ax2) = NO
+	    return
+	case 1:
+	    AX_DRAWME(ax1) = YES
+	    AX_DRAWME(ax2) = NO
+	case 2:
+	    AX_DRAWME(ax1) = NO
+	    AX_DRAWME(ax2) = YES
+	default:
+	    AX_DRAWME(ax1) = YES
+	    AX_DRAWME(ax2) = YES
+	}
+
+	# Determine the endpoints of the axis.  These default to the corners of
+	# the viewport (in world coordinates), but the positions may be
+	# overriden by the user if desired.
+
+	# First get the positions of the two axes.
+	if (GL_SETAXISPOS(ap) == YES) {
+	    p1 = GL_AXISPOS1(ap)
+	    p2 = GL_AXISPOS2(ap)
+	} else if (angle == 0) {
+	    p1 = WCS_WY1(w)
+	    p2 = WCS_WY2(w)
+	} else {
+	    p1 = WCS_WX1(w)
+	    p2 = WCS_WX2(w)
+	}
+
+	# Convert these positions into the world coordinates of the endpoints.
+	if (angle == 0) {
+	    x1 = WCS_WX1(w)
+	    x2 = WCS_WX2(w)
+	    y1 = p1
+	    y2 = p2
+	} else {
+	    x1 = p1
+	    x2 = p2
+	    y1 = WCS_WY1(w)
+	    y2 = WCS_WY2(w)
+	}
+
+	if (angle == 0) {
+	    # Set the left and right endpoints of the axes.
+
+	    AX_START(ax1,1) = x1
+	    AX_START(ax1,2) = y1
+	    AX_END(ax1,1)   = x2
+	    AX_END(ax1,2)   = y1
+
+	    AX_START(ax2,1) = x1
+	    AX_START(ax2,2) = y2
+	    AX_END(ax2,1)   = x2
+	    AX_END(ax2,2)   = y2
+
+	} else {
+	    # Set the lower and upper endpoints of the axes.
+
+	    AX_START(ax1,1) = x1
+	    AX_START(ax1,2) = y1
+	    AX_END(ax1,1)   = x1
+	    AX_END(ax1,2)   = y2
+
+	    AX_START(ax2,1) = x2
+	    AX_START(ax2,2) = y1
+	    AX_END(ax2,1)   = x2
+	    AX_END(ax2,2)   = y2
+	}
+end
diff --git a/sys/gio/glabax/glbsetup.x b/sys/gio/glabax/glbsetup.x
new file mode 100644
index 00000000..a609d2ad
--- /dev/null
+++ b/sys/gio/glabax/glbsetup.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GLB_SETUP -- Set up the axis drawing and labelling parameters.  These are
+# the coordinate transformations, i.e., log scaling, window and viewport
+# coordinates, plus the parameters which pertain only to axis drawing and
+# labelling.  The order in which the subprocedures are called is significant.
+
+procedure glb_setup (gp, axes, ntitlelines, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+pointer	axes[4]			# array of pointers to axis descriptors
+int	ntitlelines		# number of lines in title block
+char	xlabel[ARB]		# x axis label
+char	ylabel[ARB]		# y axis label
+
+pointer	w
+bool	fp_nondegenr()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Verify that there is sufficient range in the wcs X and Y.
+	if (fp_nondegenr (WCS_WX1(w), WCS_WX2(w)))
+	    GP_WCSSTATE(gp) = MODIFIED
+	if (fp_nondegenr (WCS_WY1(w), WCS_WY2(w)))
+	    GP_WCSSTATE(gp) = MODIFIED
+
+	# If log scaling is in effect on either axis, verify that log scaling
+	# is sensible and if so select either LOG or ELOG scaling.
+
+	call glb_verify_log_scaling (gp)
+
+	# Set the viewport if not already set.
+	call glb_set_viewport (gp, ntitlelines, xlabel, ylabel)
+
+	# Find the best positions for the tick marks, and if rounding is
+	# enabled, extend the WCS outward to the next tick mark on either
+	# end.
+
+	call glb_find_ticks (gp, GP_XAP(gp), axes[1], axes[4],  0)
+	call glb_find_ticks (gp, GP_YAP(gp), axes[3], axes[2], 90)
+
+	# Set the remaining parameters in the axis drawing descriptors.
+	# Must not be called until the window and viewport coordinates are
+	# fixed.
+
+	call glb_set_axes (gp, GP_XAP(gp), axes[1], axes[4],  0)
+	call glb_set_axes (gp, GP_YAP(gp), axes[3], axes[2], 90)
+end
diff --git a/sys/gio/glabax/glbsview.x b/sys/gio/glabax/glbsview.x
new file mode 100644
index 00000000..1b099b1a
--- /dev/null
+++ b/sys/gio/glabax/glbsview.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_SET_VIEWPORT -- If the viewport has not yet been set, i.e., if the
+# viewport is still [0:1,0:1], compute the size of the largest viewport which
+# leaves sufficient room around the border for the axis labels and plot title.
+# If a nonzero aspect ratio is specified make the viewport have that aspect
+# ratio.
+
+procedure glb_set_viewport (gp, ntitlelines, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+int	ntitlelines		# number of lines to reserve for title block
+char	xlabel[ARB]		# x axis label
+char	ylabel[ARB]		# y axis label
+
+pointer	w, xap, yap
+bool	draw_title, draw_xlabel, draw_ylabel, draw_xticks, draw_yticks
+real	char_height, char_width
+real	aspect, cur_aspect, dev_aspect, dx, dy
+real	xwidth, ywidth, yreserve
+real	ggetr()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+	xap = GP_XAP(gp)
+	yap = GP_YAP(gp)
+
+	if ((WCS_SX1(w) > EPSILON) || (abs(1.0 - WCS_SX2(w)) > EPSILON) ||
+	    (WCS_SY1(w) > EPSILON) || (abs(1.0 - WCS_SY2(w)) > EPSILON))
+	    return
+
+	draw_title  = (ntitlelines > 0 && GP_DRAWTITLE(gp) == YES)
+	draw_xticks = (GL_DRAWAXES(xap) > 0 && GL_LABELTICKS(xap) == YES)
+	draw_xlabel =
+	    (draw_xticks && xlabel[1] != EOS && GL_LABELAXIS(xap) == YES)
+	draw_yticks = (GL_DRAWAXES(yap) > 0 && GL_LABELTICKS(yap) == YES)
+	draw_ylabel =
+	    (draw_yticks && ylabel[1] != EOS && GL_LABELAXIS(yap) == YES)
+
+	char_width  = ggetr (gp, "cw")
+	char_height = ggetr (gp, "ch")
+
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+
+	# X axis.
+	if (draw_yticks && draw_ylabel)
+	    xwidth = max (4, LEFT_BORDER + 2)
+	else if (draw_yticks)
+	    xwidth = max (4, LEFT_BORDER)
+	else
+	    xwidth = 0
+	xwidth = xwidth * char_width * GL_TICKLABELSIZE(xap)
+	    
+	# Y axis.
+	if (draw_xticks && draw_xlabel)
+	    ywidth = BOTTOM_BORDER
+	else if (draw_xticks)
+	    ywidth = max (2, (BOTTOM_BORDER - 2))
+	else
+	    ywidth = 0
+	ywidth = ywidth * char_height * GL_TICKLABELSIZE(yap)
+
+	# Compute amount of extra space to allow for the title block, which
+	# may contain more than one line.
+
+	if (!draw_title && !draw_xticks && !draw_yticks)
+	    yreserve = 0
+	else if (!draw_title && GP_ASPECT(gp) > 0.9)
+	    yreserve = 0
+	else {
+	    yreserve = min (MAX_SZTITLEBLOCK,
+		max (MIN_NTITLELINES, ntitlelines + 1) *
+		char_height * GP_TITLESIZE(gp))
+	}
+
+	# Set the viewport.  The viewport is the largest area yielding the
+	# desired borders.  The viewport is centered in X and positioned just
+	# below the title block in Y.
+
+	WCS_SX1(w) = xwidth
+	WCS_SX2(w) = 1.0 - xwidth
+	WCS_SY1(w) = ywidth
+	WCS_SY2(w) = 1.0 - yreserve
+
+	# Adjust the viewport to achieve the specified aspect ratio, if a
+	# nonzero aspect ratio was given.
+
+	dev_aspect = GP_DEVASPECT(gp)		# device aspect ratio
+	aspect     = GP_ASPECT(gp)		# user desired aspect ratio
+
+	if (aspect > EPSILON) {
+	    dx = WCS_SX2(w) - WCS_SX1(w)
+	    dy = WCS_SY2(w) - WCS_SY1(w)
+	    cur_aspect = dy / dx * dev_aspect
+
+	    if (cur_aspect > aspect) {
+		# Viewport is taller than desired.
+		dy = aspect / dev_aspect * dx
+		WCS_SY1(w) = (1.0 - dy) / 2.0
+		WCS_SY2(w) = 1.0 - WCS_SY1(w)
+	    } else {
+		# Viewport is not as wide as desired.
+		dx = dev_aspect * dy / aspect
+		WCS_SX1(w) = (1.0 - dx) / 2.0
+		WCS_SX2(w) = 1.0 - WCS_SX1(w)
+	    }
+	}
+
+	GP_WCSSTATE(gp) = MODIFIED
+end
diff --git a/sys/gio/glabax/glbticlen.x b/sys/gio/glabax/glbticlen.x
new file mode 100644
index 00000000..de557757
--- /dev/null
+++ b/sys/gio/glabax/glbticlen.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_TICKLEN -- Compute the length of a tick in world coordinates.  All tick
+# drawing is performed in world coordinates since the ticks show the world
+# coordinate system.  The position of a tick must be computed in world coords
+# when the axis is drawn to reflect log scaling (or any other nonlinear
+# scaling.  Less obviously, the tick offset should be given in world coords
+# so that when the tick is drawn by a GRDRAW the tick will follow a line of
+# constant X or Y in world coordinates, and this line will not necessarily be
+# a line of constant X or Y in NDC coordinates.
+
+real procedure glb_ticklen (gp, ax, ndc_length)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+real	ndc_length		# length of tick in NDC units
+
+int	wcs
+real	x, y, wx, wy
+
+begin
+	wcs = GP_WCS(gp)
+	call gctran (gp, AX_TICK1(ax,1), AX_TICK1(ax,2), x, y, wcs, 0)
+
+	if (AX_HORIZONTAL(ax) == YES)
+	    y = y + ndc_length
+	else
+	    x = x + ndc_length
+
+	call gctran (gp, x, y, wx, wy, 0, wcs)
+	if (AX_HORIZONTAL(ax) == YES) {
+	    call pargr (wy - AX_TICK1(ax,2))
+	    return (wy - AX_TICK1(ax,2))
+	} else {
+	    call pargr (wx - AX_TICK1(ax,1))
+	    return (wx - AX_TICK1(ax,1))
+	}
+end
diff --git a/sys/gio/glabax/glbtitle.x b/sys/gio/glabax/glbtitle.x
new file mode 100644
index 00000000..d8c43c67
--- /dev/null
+++ b/sys/gio/glabax/glbtitle.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_PLOT_TITLE -- Draw plot title block.  The block may contain several lines.
+# Lines are plotted with center, left, or right justification, immediately
+# above the top viewport boundary (not immediately above the drawn axis,
+# which need not be at the viewport boundary).
+
+procedure glb_plot_title (gp, title, ntitlelines)
+
+pointer	gp			# graphics descriptor
+char	title[ARB]		# title block
+int	ntitlelines		# number of lines in title block
+
+int	lineno, ip, wcs
+real	char_height, x, y, dy
+pointer sp, op, lbuf, format, w
+real	ggetr()
+
+begin
+	if (title[1] == EOS || ntitlelines < 1)
+	    return
+
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (format, SZ_FORMAT, TY_CHAR)
+
+	char_height = ggetr (gp, "ch")
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT * GP_TITLESIZE(gp)
+
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR (gp, wcs)
+	y = min (1.0 - char_height,
+	    WCS_SY2(w) + (ntitlelines - 1 + 0.5) * char_height)
+
+	call sprintf (Memc[format], SZ_FORMAT, "hj=%c,vj=b")
+	    switch (GP_TITLEJUST(gp)) {
+	    case GT_LEFT:
+		call pargi ('l')
+		x = WCS_SX1(w)
+	    case GT_RIGHT:
+		call pargi ('r')
+		x = WCS_SX2(w)
+	    default:
+		call pargi ('c')
+		x = (WCS_SX1(w) + WCS_SX2(w)) / 2.0
+	    }
+
+	call gsetr (gp, G_TXSIZE, GP_TITLESIZE(gp))
+	call gseti (gp, G_WCS, 0)
+	lineno = 1
+	op = lbuf
+
+	for (ip=1;  title[ip] != EOS;  ip=ip+1)
+	    if (title[ip] == '\n' || (title[ip+1] == EOS && op > lbuf)) {
+		if (title[ip] != '\n') {
+		    Memc[op] = title[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+		dy = (lineno - 1) * char_height
+		call gtext (gp, x, y - dy, Memc[lbuf], Memc[format])
+		lineno = lineno + 1
+		op = lbuf
+	    } else {
+		Memc[op] = title[ip]
+		op = op + 1
+	    }
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/glabax/glbverify.x b/sys/gio/glabax/glbverify.x
new file mode 100644
index 00000000..6666b06a
--- /dev/null
+++ b/sys/gio/glabax/glbverify.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_VERIFY_LOG_SCALING -- Verify that log scaling makes sense, i.e., that
+# the range covered by an axis compared to its distance from the origin is
+# large enough to permit log scaling.  If log scaling is reasonable check if
+# the window goes negative, and switch to ELOG scaling if such is the case.
+
+procedure glb_verify_log_scaling (gp)
+
+pointer	gp			# graphics descriptor
+pointer	w
+
+begin
+	w  = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Force ELOG scaling if any data <= 0.
+
+	if (WCS_XTRAN(w) != LINEAR)
+	    if (WCS_WX1(w) <= 0 || WCS_WX2(w) <= 0)
+		WCS_XTRAN(w) = ELOG
+
+	if (WCS_YTRAN(w) != LINEAR)
+	    if (WCS_WY1(w) <= 0 || WCS_WY2(w) <= 0)
+		WCS_YTRAN(w) = ELOG
+
+	# Set the WCS state to modified even if it wasn't.  This is safe
+	# and in any case the WCS is changed in the main glabax routine
+	# shortly after we are called.
+
+	GP_WCSSTATE(gp) = MODIFIED
+end
diff --git a/sys/gio/glabax/mkpkg b/sys/gio/glabax/mkpkg
new file mode 100644
index 00000000..c8990e1a
--- /dev/null
+++ b/sys/gio/glabax/mkpkg
@@ -0,0 +1,22 @@
+# Make the GLABAX axis drawing and labelling package.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	glabax.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbencode.x	glabax.h <mach.h>
+	glbfind.x	glabax.h <gio.h> <mach.h>
+	glbgrid.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbgtick.x	glabax.h <gio.h> <mach.h>
+	glblabel.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbloglab.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbsetax.x	glabax.h <gio.h> <mach.h>
+	glbsetup.x	<gio.h>
+	glbsview.x	glabax.h <gio.h> <mach.h>
+	glbticlen.x	glabax.h <gio.h> <mach.h>
+	glbtitle.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbverify.x	glabax.h <gio.h> <gset.h> <mach.h>
+	;
diff --git a/sys/gio/gline.x b/sys/gio/gline.x
new file mode 100644
index 00000000..ee346527
--- /dev/null
+++ b/sys/gio/gline.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GLINE -- Draw a line connecting two points.
+
+procedure gline (gp, x1, y1, x2, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, y1			# first point
+real	x2, y2			# second point
+
+begin
+	call gamove (gp, x1, y1)
+	call gadraw (gp, x2, y2)
+end
diff --git a/sys/gio/gmark.x b/sys/gio/gmark.x
new file mode 100644
index 00000000..a9517b79
--- /dev/null
+++ b/sys/gio/gmark.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GMARK -- Draw a marker of the indicated type and size.  A mark is represented
+# as a polyline normalized to the unit square.  Drawing a mark is a simple
+# matter of drawing this normalized polyline in a window the size and position
+# of the mark.  While the mark window defines the transformation upon the
+# normalized marker polyline, clipping is performed on the WCS viewport boundary
+# (if enabled), independently of the size and position of the mark.  Redrawing
+# a mark with a linetype of clear will erase the mark, device permitting.
+# Drawing is carried out in world coordinates, hence the marker shape will
+# relect logarithmic scaling if in effect.
+
+procedure gmark (gp, x, y, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x, y			# world coordinates of center of marker
+int	marktype		# type of marker to be drawn
+real	xsize, ysize		# marker size in X and Y
+
+int	i, m, fill
+int	and()
+include	"markers.inc"
+
+begin
+	# The point marker type cannot be combined with the other types and
+	# is treated as a special case.  The remaining markers are drawn
+	# using GUMARK, which draws marks represented as polygons
+
+	if (marktype == GM_POINT || (xsize == 0 && ysize == 0)) {
+	    call gpl_settype (gp, POLYMARKER)
+	    call gamove (gp, x, y)
+	    call gadraw (gp, x, y)
+	    call gpl_settype (gp, POLYLINE)
+
+	} else {
+	    # Some marks can be drawn using area fill.
+	    if (and (marktype, GM_FILL) != 0)
+		fill = YES
+	    else
+		fill = NO
+
+	    # Draw and overlay each mark.  The polylines for the standard
+	    # marks are stored in MPX and MPY at offsets MXO and MYO.
+
+	    do i = GM_FIRSTMARK, GM_LASTMARK
+		if (and (marktype, 2 ** i) != 0) {
+		    m = i - GM_FIRSTMARK + 1
+		    call gumark (gp, mpx[moff[m]], mpy[moff[m]], mnpts[m],
+			x, y, xsize, ysize, fill)
+		}
+	}
+end
diff --git a/sys/gio/gmftitle.x b/sys/gio/gmftitle.x
new file mode 100644
index 00000000..0e7d0322
--- /dev/null
+++ b/sys/gio/gmftitle.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GMFTITLE -- Insert a title (comment) into the output metacode instruction
+# stream.  No graphics output is generated.  The purpose of the metafile
+# title is to document the contents of metafiles.
+
+procedure gmftitle (gp, mftitle)
+
+pointer	gp			# graphics descriptor
+char	mftitle[ARB]		# metafile title
+
+begin
+	call gpl_flush()
+	call gki_mftitle (GP_FD(gp), mftitle)
+end
diff --git a/sys/gio/gmprintf.x b/sys/gio/gmprintf.x
new file mode 100644
index 00000000..9353b483
--- /dev/null
+++ b/sys/gio/gmprintf.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GMPRINTF -- Formatted write a string value to a UI (user interface)
+# parameter.
+#
+# NOTE - I don't think this code works yet.  Don't use it, use gmsg.
+
+procedure gmprintf (gp, object, format)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	format[ARB]		#I print format
+
+pointer	sp, fmt
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[fmt], SZ_LINE, "\031%s %s\035\037")
+	    call pargstr (object)
+	    call pargstr (format)
+
+	call flush (STDOUT)
+	call printf (Memc[fmt])
+	call sfree (sp)
+end
diff --git a/sys/gio/gmsg.x b/sys/gio/gmsg.x
new file mode 100644
index 00000000..360996be
--- /dev/null
+++ b/sys/gio/gmsg.x
@@ -0,0 +1,232 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<fset.h>
+include	<chars.h>
+include	<mach.h>
+
+# GMSG -- Write a string value to a UI (user interface) parameter.  Another
+# way to look at this is that we are sending a message to a UI object, hence
+# this is called a message facility.
+#
+# NOTE -- This routine quotes the string with curly braces { } and prefaces
+# the string with a "setValue", as required to set the value of a GUI client
+# state variable.  This is done here rather than build knowledge into the
+# lower level i/o system about the requirements for sending messages to UI
+# parameters.  The low level i/o system just sends arbitrary messages to
+# named UI objects; setting the value of a UI parameter object is a higher
+# level abstraction layered upon the general i/o mechanism.
+#
+# One limitation of the UI parameter mechanism as it currently stands is that
+# if the message contains curly braces, they must match up to avoid having
+# the message be prematurely delimited (fortunately curly braces tend to
+# match up in any valid text that uses them).  So far I haven't found a way
+# around this.  The problem is that while Tcl allows braces to be backslash
+# escaped to avoid being treated as delimiters, the backslashes are not
+# removed, they are left in the message as data.  Hence they cannot be
+# inserted in an arbitrary string without changing the string.
+#
+# Messages may be arbitrarily large and may extend over multiple lines.  The
+# only restriction is that if the messages contain curly braces they must
+# match up.
+
+procedure gmsg (gp, object, message)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	message[ARB]		#I message text
+
+int	flushnl, control_stream
+int	fstati()
+bool	ttygetb()
+
+begin
+	call gflush (gp)
+	call flush (STDOUT)
+	call flush (STDERR)
+
+	control_stream = STDERR
+
+	if (ttygetb (GP_TTY(gp), "EM")) {
+	    flushnl = fstati (control_stream, F_FLUSHNL)
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, NO)
+
+	    call putci (control_stream, EM)
+	    call putline (control_stream, object)
+	    call putci (control_stream, ' ')
+	    call putline (control_stream, "setValue ")
+
+	    call putci (control_stream, '{')
+	    call putline (control_stream, message)
+	    call putci (control_stream, '}')
+
+	    call putci (control_stream, GS)
+	    call putci (control_stream, US)
+	    call flush (control_stream)
+
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, YES)
+	}
+end
+
+
+# GMSGB -- Set the value of a boolean UI parameter.
+
+procedure gmsgb (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+bool	value			#I value
+
+begin
+	if (value)
+	    call gmsg (gp, object, "yes")
+	else
+	    call gmsg (gp, object, "no")
+end
+
+
+# GMSGC -- Set the value of a character UI parameter.
+
+procedure gmsgc (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	value			#I value
+
+char	buf[10]
+int	junk, ctocc()
+
+begin
+	junk = ctocc (value, buf, 10)
+	call gmsg (gp, object, buf)
+end
+
+
+# GMSGS -- Set the value of a short integer UI parameter.
+
+procedure gmsgs (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+short	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFS (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGI -- Set the value of an integer UI parameter.
+
+procedure gmsgi (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+int	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFI (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGL -- Set the value of a long integer UI parameter.
+
+procedure gmsgl (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+long	value			#I value
+
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFL (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = ltoc (value, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGR -- Set the value of a type real UI parameter.
+
+procedure gmsgr (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+real	value			#I value
+
+double	dval
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    dval = value
+	    junk = dtoc (dval, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGD -- Set the value of a type double UI parameter.
+
+procedure gmsgd (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+double	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = dtoc (value, buf, MAX_DIGITS, NDIGITS_DP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGX -- Set the value of a type complex UI parameter.
+
+procedure gmsgx (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+complex	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, xtoc()
+
+begin
+	junk = xtoc (value, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS/2)
+	call gmsg (gp, object, buf)
+end
diff --git a/sys/gio/gopen.x b/sys/gio/gopen.x
new file mode 100644
index 00000000..7f973016
--- /dev/null
+++ b/sys/gio/gopen.x
@@ -0,0 +1,187 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<knet.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+
+# GOPENUI -- Open a graphics stream for output to the named device on file FD.
+# If a logical device name is given the actual device name is fetched from the
+# environment.   If a UI file is specified the named user interface definition
+# file is downloaded to the graphics server.  The device parameters are then
+# retrieved from the graphcap entry for the device.  GIO is initialized, and
+# if the device is being opened in APPEND mode, the WCS set when the device
+# was last read are retrieved from the CL (if output is to a standard stream)
+# or from the WCS savefile for the device.
+
+pointer procedure gopenui (device, mode, uifname, fd)
+
+char	device[ARB]		#I logical or physical device name
+int	mode			#I access mode: NEW_FILE or APPEND
+char	uifname[ARB]		#I user interface specification file
+int	fd			#I metacode output file
+
+pointer	gp, tty
+int	outfd, stream_type, junk
+bool	close_at_end, kf_ok, vdm_device, std_stream
+pointer	sp, devname, envname, kfname
+
+bool	streq()
+extern	gflush()
+pointer	ttygdes()
+int	envgets(), envfind(), open(), locpr(), access(), ttygets()
+errchk	syserr, syserrs, ttygdes
+errchk	greset, gki_openws, calloc
+
+string	stdgraph "stdgraph"
+string	stdimage "stdimage"
+string	stdplot  "stdplot"
+string	vdm 	 "vdm"
+string	stdvdm 	 "stdvdm"
+
+begin
+	call smark (sp)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (envname, SZ_FNAME, TY_CHAR)
+	call salloc (kfname,  SZ_FNAME, TY_CHAR)
+
+	call flush (STDOUT)
+
+	# If one of the logical devices STDGRAPH, STDIMAGE, or STDPLOT is
+	# named look up the actual device name in the environment.  The
+	# standard metafile "device", STDVDM, is implemented as an actual
+	# device with an actual graphcap entry, so we do not have to map
+	# its name.
+
+	if (streq (device, stdgraph) || streq (device, stdimage) ||
+	    streq (device, stdplot)) {
+	    if (envgets (device, Memc[devname], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, device)
+	} else
+	    call strcpy (device, Memc[devname], SZ_FNAME)
+
+	# The special name "none" indicates that graphics is not supported
+	# on this stream for the local site or workstation (e.g., when using
+	# a nongraphics terminal).
+
+	if (streq (Memc[devname], "none"))
+	    switch (fd) {
+	    case STDGRAPH:
+		call syserr (SYS_GGNONE)
+	    case STDIMAGE:
+		call syserr (SYS_GINONE)
+	    case STDPLOT:
+		call syserr (SYS_GPNONE)
+	    default:
+		call syserr (SYS_GPNONE)
+	    }
+
+	# Fetch the graphcap entry for the device.
+	tty = ttygdes (Memc[devname])
+
+	# If the output device is "stdvdm" or "vdm" and the FD supplied by the
+	# user is that of a standard stream, open the standard metafile and
+	# append output directly to that.  The metafile is always opened in
+	# APPEND mode regardless of the mode in which the graphics device is
+	# opened.
+
+	outfd = fd
+	close_at_end = false
+	call gki_redir (fd, -1, junk, stream_type)
+	std_stream = (fd == STDGRAPH || fd == STDIMAGE || fd == STDPLOT)
+	vdm_device = (streq(device,stdvdm) || streq(device,vdm))
+
+	if (vdm_device && std_stream) {
+	    # Get filename of virtual device metafile.
+	    call strcpy (stdvdm, Memc[devname], SZ_DEVNAME)
+	    if (envfind (stdvdm, Memc[envname], SZ_FNAME) <= 0)
+		call strcpy ("uparm$vdm", Memc[envname], SZ_FNAME)
+
+	    # Open VDM for appending.
+	    iferr (outfd = open (Memc[envname], APPEND, BINARY_FILE)) {
+		call ttycdes (tty)
+		call erract (EA_ERROR)
+	    }
+	    close_at_end = true
+
+	} else if (std_stream && stream_type != TY_INLINE) {
+	    # Verify that there is a GIO kernel specified for the device before
+	    # trying to open it via PSIOCTRL, since the latter does not return
+	    # an error status if it fails to connect a kernel, causing the error
+	    # to go undetected until the CL fails to connect a kernel, which
+	    # causes an error which cannot be caught in an IFERR in the current
+	    # process.  Catching the error here is faster and works with IFERR.
+	    # No checking for a kernel is performed if the metacode output is
+	    # being directed to a user opened stream.
+
+	    kf_ok = false
+	    if (ttygets (tty, "kf", Memc[kfname], SZ_FNAME) > 0)
+		if (streq (Memc[kfname], "cl"))
+		    kf_ok = true
+		else if (access (Memc[kfname], 0,0) == YES)
+		    kf_ok = true
+
+	    if (!kf_ok) {
+		call ttycdes (tty)
+		call syserrs (SYS_GNOKF, Memc[devname])
+	    }
+	}
+
+	# Allocate and initialize the GIO graphics descriptor.  Initialize
+	# GKI (the graphics kernel interface) on the stream, if the stream
+	# has not already been directed to a kernel.
+
+	call calloc (gp, LEN_GDES, TY_STRUCT)
+
+	GP_FD(gp) = outfd
+	GP_TTY(gp) = tty
+	if (close_at_end)
+	    GP_GFLAGS(gp) = GF_CLOSEFD
+
+	# Set the access mode; default to NEW_FILE if not specified.
+	GP_ACMODE(gp) = mod (mode, AW_DEFER)
+	if (GP_ACMODE(gp) == 0)
+	    GP_ACMODE(gp) = NEW_FILE
+
+	call greset (gp, GR_RESETALL)
+	call gki_init (outfd)
+	call strcpy (Memc[devname], GP_DEVNAME(gp), SZ_DEVNAME)
+	call strcpy (uifname, GP_UIFNAME(gp), SZ_UIFNAME)
+
+	# Set up info for GEXFLS, called by CLGCUR to flush the graphics
+	# output prior to a cursor read.
+
+	call gexfls_set (outfd, gp, locpr(gflush))
+
+	# Activate (physically open) the workstation, unless the defer flag
+	# is set, eg., mode = NEW_FILE+AW_DEFER.
+
+	if (mode < AW_DEFER)
+	    iferr (call gactivate (gp, 0)) {
+		call ttycdes (tty)
+		call gexfls_clear (outfd)
+		call mfree (gp, TY_STRUCT)
+		call erract (EA_ERROR)
+	    }
+
+	call sfree (sp)
+	return (gp)
+end
+
+
+# GOPEN -- Open a graphics stream for output to the named device on file FD.
+# Identical to GOPENUI except that the default UI is used.
+
+pointer procedure gopen (device, mode, fd)
+
+char	device[ARB]		#I logical or physical device name
+int	mode			#I access mode: NEW_FILE or APPEND
+int	fd			#I metacode output file
+
+pointer	gopenui()
+
+begin
+	return (gopenui (device, mode, "", fd))
+end
diff --git a/sys/gio/gpagefile.x b/sys/gio/gpagefile.x
new file mode 100644
index 00000000..df950e71
--- /dev/null
+++ b/sys/gio/gpagefile.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gio.h>
+
+# GPAGEFILE -- File pager which works in or out of cursor mode.  If in graphics
+# mode, the workstation is deactivated, the file paged, and graphics mode later
+# restored.
+
+procedure gpagefile (gp, fname, prompt)
+
+pointer	gp			# graphics descriptor
+char	fname[ARB]		# name of file to be paged
+char	prompt[ARB]		# user prompt string
+
+bool	wsactive
+int	and()
+
+begin
+	wsactive = (and (GP_GFLAGS(gp), GF_WSACTIVE) != 0)
+
+	if (wsactive)
+	    call gdeactivate (gp, 0)
+	iferr (call pagefile (fname, prompt))
+	    call erract (EA_WARN)
+	if (wsactive)
+	    call greactivate (gp, AW_PAUSE)
+end
diff --git a/sys/gio/gpcell.x b/sys/gio/gpcell.x
new file mode 100644
index 00000000..17588647
--- /dev/null
+++ b/sys/gio/gpcell.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPCELL -- Put a cell array.  Display a two dimensional array of pixels in the
+# given window, scaling as necessary to fit the window.  For maximum efficiency
+# no clipping is performed.  Only linear coordinate transformations are
+# permitted.  The cell array is defined by (x1,y1) and (x2,y2), the NDC coords
+# of the corners of the display area.  The graphics kernel is expected to
+# map cell array pixels into device pixels by mapping the coordinates of a
+# device pixel into the cell array and assigning the value of the nearest
+# cell array pixel to the device pixel.  In other words, the cell array is
+# sampled or block replicated as necessary to fit the device window.  The kernel
+# is not expected to perform area integration or filtering (interpolation)
+# to map cell array pixels into device pixels.  In the limiting case M may
+# contain a single pixel which will be replicated to fill the specified window,
+# e.g., nx=ny=1, (x1,y1)=(0,0), and (x2,y2)=(1,1).
+#
+#		+--+--+--+--Q (x2,y2)
+#	      4	|  |  |  |  |
+#		+--+--+--+--+
+#	      3	|  |  |  |  |		Sample Cell Array
+#	  Y	+--+--+--+--+		   nx = ny = 4
+#	      2	|  |  |  |  |
+#		+--+--+--+--+
+#	      1	|  |  |  |  |
+#	(x1,y1)	P--+--+--+--+
+#
+#	         1  2  3  4	X
+#
+# A sample 4 by 4 cell array is shown above.  The coordinates of the device
+# window into which the cell array is to be mapped refer to the corners P and
+# Q of the first and last pixels in the cell array.
+
+procedure gpcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+pointer	gp			# device descriptor
+short	m[nx,ny]		# pixels
+int	nx, ny			# size of pixel array
+real	x1, y1			# lower left corner of output window
+real	x2, y2			# upper right corner of output window
+
+real	dy
+int	ly1, ly2, i
+int	sx1, sx2, sy1, sy2
+include	"gpl.com"
+
+begin
+	# Flush any buffered polyline output.  Make sure the wcs transformation
+	# in the cache is up to date.
+
+	if (op > 1)
+	    call gpl_flush()
+	else if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Transform cell window to GKI coordinates.  The coordinate
+	# transformation must be linear.
+
+	sx1 = (x1 - wxorigin) * xscale + mxorigin
+	sx2 = (x2 - wxorigin) * xscale + mxorigin
+	sy1 = (y1 - wyorigin) * yscale + myorigin
+	sy2 = (y2 - wyorigin) * yscale + myorigin
+
+	dy = real (sy2 - sy1) / ny	# height of a line in GKI coords
+
+	# Write out the cell array, one line at a time.  Take care that the
+	# GKI integer value of ly1 of one line is the same as the ly2 value
+	# of the previous line, or there will be a blank line in the output
+	# image.
+
+	do i = 1, ny {
+	    ly1 = (i-1) * dy + sy1
+	    ly2 = (i  ) * dy + sy1
+	    call gki_putcellarray (GP_FD(gp), m[1,i], nx,1, sx1,ly1, sx2,ly2)
+	}
+end
diff --git a/sys/gio/gpl.com b/sys/gio/gpl.com
new file mode 100644
index 00000000..76d0d5c7
--- /dev/null
+++ b/sys/gio/gpl.com
@@ -0,0 +1,20 @@
+# GPL.COM -- Polyline generator common.
+
+bool	last_point_inbounds	# last point was inbounds
+int	xtran, ytran		# scaling function for X, Y axes (linear,log,,)
+int	op			# index of next cell in polyline array
+int	pl_type			# type of instruction (polyline, polymarker,...)
+int	pl_pointmode		# plotting points (polymarker), not vectors
+int	wcs			# WCS for which cache is valid
+long	mxorigin, myorigin	# origin in world coordinates for transform
+real	wxorigin, wyorigin	# origin in world coordinates for transform
+real	xscale, yscale		# scale factor, world to GKI, for transform
+real	cx, cy			# current pen position, world coords
+long	mx1, mx2, my1, my2	# clipping viewport, GKI coords
+long	xs[4], ys[4]		# last point plotted (for clipping code)
+pointer	gp_out			# device which owns current polyline
+short	pl[LEN_PLBUF]		# output polyline buffer
+
+common	/gplcom/ last_point_inbounds, xtran, ytran, op, pl_type, pl_pointmode,
+	mxorigin, myorigin, wxorigin, wyorigin, xscale, yscale, cx, cy,
+	mx1, mx2, my1, my2, xs, ys, gp_out, wcs, pl
diff --git a/sys/gio/gplcache.x b/sys/gio/gplcache.x
new file mode 100644
index 00000000..88201365
--- /dev/null
+++ b/sys/gio/gplcache.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_CACHE -- Cache the transformation parameters for a device in the GADRAW
+# common.  Must be called whenever the current WCS changes.  We need only
+# check that the WCS has not changed because anything more serious than a
+# change current WCS call will cause the cache to be invalidated.
+
+procedure gpl_cache (gp)
+
+pointer	gp			# graphics descriptor
+pointer	w
+real	wx1, wx2, wy1, wy2
+bool	fp_nondegenr()
+real	elogr()
+
+int	wcsord
+data	wcsord /0/
+include	"gpl.com"
+
+begin
+	gp_out = gp
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR (gp, wcs)
+
+	# The WCS must be fixed to the output device (kernel) when used for
+	# coordinate transformations in metacode output.
+
+	if (GP_WCSSTATE(gp) != FIXED) {
+	    call gactivate (gp, 0)
+	    call gpl_flush()
+	    call gki_setwcs (GP_FD(gp), Memi[GP_WCSPTR(gp,1)],
+		LEN_WCS * MAX_WCS)
+	    GP_WCSSTATE(gp) = FIXED
+	    wcsord = wcsord + 1
+	    GP_WCSORD(gp) = wcsord
+	}
+
+	mx1 = WCS_SX1(w) * GKI_MAXNDC
+	mx2 = WCS_SX2(w) * GKI_MAXNDC
+	my1 = WCS_SY1(w) * GKI_MAXNDC
+	my2 = WCS_SY2(w) * GKI_MAXNDC
+
+	# Compute world -> GKI coordinate transformation.  If log scaling is
+	# indicated but one or both window coords are negative, use ELOG
+	# scaling instead.
+
+	mxorigin = mx1
+	xtran = WCS_XTRAN(w)
+
+	wx1 = WCS_WX1(w)
+	wx2 = WCS_WX2(w)
+
+	# Ensure that the window is nondegenerate.
+	if (fp_nondegenr (wx1, wx2))
+	    ;
+
+	if (xtran == LINEAR) {
+	    wxorigin = wx1
+	    xscale = (mx2 - mx1) / (wx2 - wx1)
+	} else if (xtran == LOG && wx1 > 0 && wx2 > 0) {
+	    wxorigin = log10 (wx1)
+	    xscale = (mx2 - mx1) / (log10(wx2) - wxorigin)
+	} else {
+	    wxorigin = elogr (wx1)
+	    xscale = (mx2 - mx1) / (elogr(wx2) - wxorigin)
+	}
+
+	myorigin = my1
+	ytran = WCS_YTRAN(w)
+
+	wy1 = WCS_WY1(w)
+	wy2 = WCS_WY2(w)
+
+	# Ensure that the window is nondegenerate.
+	if (fp_nondegenr (wy1, wy2))
+	    ;
+
+	if (ytran == LINEAR) {
+	    wyorigin = wy1
+	    yscale = (my2 - my1) / (wy2 - wy1)
+	} else if (ytran == LOG && wy1 > 0 && wy2 > 0) {
+	    wyorigin = log10 (wy1)
+	    yscale = (my2 - my1) / (log10(wy2) - wyorigin)
+	} else {
+	    wyorigin = elogr (wy1)
+	    yscale = (my2 - my1) / (elogr(wy2) - wyorigin)
+	}
+
+	# If clipping is disabled move the clipping viewport out to the
+	# boundary of the device.
+
+	if (and (WCS_FLAGS(w), WF_CLIP) == 0) {
+	    mx1 = 0
+	    mx2 = GKI_MAXNDC
+	    my1 = 0
+	    my2 = GKI_MAXNDC
+	}
+end
diff --git a/sys/gio/gplcancel.x b/sys/gio/gplcancel.x
new file mode 100644
index 00000000..416bd787
--- /dev/null
+++ b/sys/gio/gplcancel.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_CANCEL -- Cancel any buffered polyline output.
+
+procedure gpl_cancel()
+
+include	"gpl.com"
+
+begin
+	op = 1
+end
diff --git a/sys/gio/gplflush.x b/sys/gio/gplflush.x
new file mode 100644
index 00000000..403adc9c
--- /dev/null
+++ b/sys/gio/gplflush.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_FLUSH -- Flush the buffered "polyline", i.e., array of transformed and
+# clipped points.  For a polyline or fill area polygon there must be at least
+# two points (4 cells) or it will be discarded.  A single point polymarker is
+# permitted.
+
+procedure gpl_flush()
+
+int	fd
+pointer	ap
+include	"gpl.com"
+
+begin
+	if (op > 2 && gp_out != NULL) {
+	    fd = GP_FD(gp_out)
+
+	    switch (pl_type) {
+	    case POLYMARKER:
+		ap = GP_PMAP(gp_out)
+		if (PM_STATE(ap) != FIXED) {
+		    call gki_pmset (fd, ap)
+		    PM_STATE(ap) = FIXED
+		}
+		call gki_polymarker (fd, pl, op / 2)
+
+	    case FILLAREA:
+		ap = GP_FAAP(gp_out)
+		if (FA_STATE(ap) != FIXED) {
+		    call gki_faset (fd, ap)
+		    FA_STATE(ap) = FIXED
+		}
+		if (op > 4)
+		    call gki_fillarea (fd, pl, op / 2)
+
+	    default:					# (case POLYLINE)
+		ap = GP_PLAP(gp_out)
+		if (PL_STATE(ap) != FIXED) {
+		    call gki_plset (fd, ap)
+		    PL_STATE(ap) = FIXED
+		}
+		if (op > 4)
+		    call gki_polyline (fd, pl, op / 2)
+	    }
+
+	    op = 1
+	}
+end
diff --git a/sys/gio/gpline.x b/sys/gio/gpline.x
new file mode 100644
index 00000000..ed0e8439
--- /dev/null
+++ b/sys/gio/gpline.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLINE -- Polyline.  Draw a line connecting the points (X[i],Y[i]), i.e.,
+# move to the first point and draw a straight line from there to the second
+# point, from the second to the third, and so on.
+
+procedure gpline (gp, x, y, npts)
+
+pointer	gp			# graphics descriptor
+real	x[ARB], y[ARB]		# points defining the polyline
+int	npts
+int	i
+
+begin
+	call gamove (gp, x[1], y[1])
+	do i = 2, npts
+	    call gadraw (gp, x[i], y[i])
+end
diff --git a/sys/gio/gploto.x b/sys/gio/gploto.x
new file mode 100644
index 00000000..a76de4fd
--- /dev/null
+++ b/sys/gio/gploto.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLOTV -- Plot a vector on an open graphics device.  This routine is
+# provided for the convenience of the user who does not need to exercise
+# fine control over the details of how the plot is generated, but who may
+# wish to select an output device other than stdgraph or who may wish to
+# leave the device open for annotation.
+
+procedure gploto (gp, v, npts, x1, x2, title)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# number of data points
+real	x1, x2			# range of X in data vector
+char	title[ARB]		# plot title
+errchk	gswind, gascale, glabax
+
+begin
+	call gswind (gp, x1, x2, INDEF, INDEF)
+	call gascale (gp, v, npts, 2)
+	call glabax (gp, title, "", "")
+	call gvline (gp, v, npts, x1, x2)
+end
diff --git a/sys/gio/gplotv.x b/sys/gio/gplotv.x
new file mode 100644
index 00000000..1d9239e5
--- /dev/null
+++ b/sys/gio/gplotv.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLOTV -- Plot a vector.  This routine is provided for the convenience of
+# the user who does not need to exercise fine control over the details of
+# how the plot is generated.
+
+procedure gplotv (v, npts, x1, x2, title)
+
+real	v[ARB]			# data vector
+int	npts			# number of data points
+real	x1, x2			# range of X in data vector
+char	title[ARB]		# plot title
+
+pointer	gp
+pointer	gopen()
+errchk	gopen, gploto
+
+begin
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	call gploto (gp, v, npts, x1, x2, title)
+	call gclose (gp)
+end
diff --git a/sys/gio/gplreset.x b/sys/gio/gplreset.x
new file mode 100644
index 00000000..888fd99e
--- /dev/null
+++ b/sys/gio/gplreset.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_RESET -- Reset the state of the GPL common, forcing a call to
+# re-initialize the cache in the next GADRAW call.  Should be called at
+# GOPEN time and thereafter whenever the a WCS is modified or an polyline,
+# polymarker, etc. attribute is set.
+
+procedure gpl_reset()
+
+bool	first_time
+include	"gpl.com"
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    op = 1
+	    first_time = false
+	} else
+	    call gpl_flush()
+
+	wcs = -1
+	gp_out = NULL
+	pl_type = POLYLINE
+	last_point_inbounds = false
+end
diff --git a/sys/gio/gplstype.x b/sys/gio/gplstype.x
new file mode 100644
index 00000000..68056abd
--- /dev/null
+++ b/sys/gio/gplstype.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_SETTYPE -- Set type (polyline, polymarker, fillarea) of point array PL.
+# Determines instruction type generated when PL is flushed.
+
+procedure gpl_settype (gp, type)
+
+pointer	gp			# graphics descriptor
+int	type			# type of instruction
+include	"gpl.com"
+
+begin
+	if (op > 1 && pl_type != type)
+	    call gpl_flush()
+
+	if (type == POINTMODE) {
+	    pl_type = POLYMARKER
+	    pl_pointmode = YES
+	} else {
+	    pl_type = type
+	    pl_pointmode = NO
+	}
+end
diff --git a/sys/gio/gpmark.x b/sys/gio/gpmark.x
new file mode 100644
index 00000000..dbe0b362
--- /dev/null
+++ b/sys/gio/gpmark.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GPMARK -- Polymarker.  Output at sequence of markers at the vertices of a
+# polygon, all markers the same type and size.  The marker type GM_POINT is
+# a special case.
+
+procedure gpmark (gp, x, y, npts, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x[ARB], y[ARB]		# vertices of polygon
+int	npts			# number of points
+int	marktype		# marker type
+real	xsize, ysize		# marker size
+int	i
+
+begin
+	if (marktype == GM_POINT) {
+	    call gpl_settype (gp, POINTMODE)
+	    call gpline (gp, x, y, npts)
+	    call gpl_settype (gp, POLYLINE)
+	} else {
+	    do i = 1, npts
+		call gmark (gp, x[i], y[i], marktype, xsize, ysize)
+	}
+end
diff --git a/sys/gio/gqverify.x b/sys/gio/gqverify.x
new file mode 100644
index 00000000..7f081f3b
--- /dev/null
+++ b/sys/gio/gqverify.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+
+define	QUERY	"Type `q' to verify quit, `return' to return to cursor loop:"
+
+# GQVERIFY -- Print a message in the status line asking the user if they really
+# want to quit, returning YES if they really want to quit, NO otherwise.
+
+int procedure gqverify()
+
+int	ch
+int	getci()
+
+begin
+	call printf (QUERY)
+	call flush (STDOUT)
+
+	call fseti (STDIN, F_RAW, YES)
+	while (getci (STDIN, ch) != EOF)
+	    if (ch == 'q' || ch == '\r' || ch == '\n')
+		break
+
+	call printf ("\n\n")
+	call flush (STDOUT)
+	call fseti (STDIN, F_RAW, NO)
+
+	if (ch == 'q')
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/gio/grdraw.x b/sys/gio/grdraw.x
new file mode 100644
index 00000000..7cd44a74
--- /dev/null
+++ b/sys/gio/grdraw.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GRDRAW -- Relative draw, i.e., move the pen to the specified offset from the
+# current position.
+
+procedure grdraw (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# offset from current position
+real	cx, cy
+
+begin
+	if (IS_INDEF(x) || IS_INDEF(y))
+	    call gadraw (gp, x, y)
+	else {
+	    call gcurpos (gp, cx, cy)
+	    if (IS_INDEF(cx) || IS_INDEF(cy))
+		call gadraw (gp, INDEF, INDEF)
+	    else
+		call gadraw (gp, cx + x, cy + y)
+	}
+end
diff --git a/sys/gio/grdwcs.x b/sys/gio/grdwcs.x
new file mode 100644
index 00000000..3ded4e9e
--- /dev/null
+++ b/sys/gio/grdwcs.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+.help savewcs
+.nf __________________________________________________________________________
+SAVEWCS -- A package for saving the WCS in a file for later restoration when
+a device is opened in append mode.
+
+	gwrwcs (devname, wcs, len_wcs)		save wcs in file
+  len = grdwcs (devname, wcs, len_wcs)		read wcs from file
+
+Only the 16+1 WCS structures are currently saved.  There is no provision for
+saving the WCSSTATE and the index of the current WCS.
+.endhelp _____________________________________________________________________
+
+
+# GWRWCS -- Save the WCS in a binary file in the user directory UPARM.
+# Any existing file is overwritten.
+
+procedure gwrwcs (devname, wcs, len_wcs)
+
+char	devname[ARB]			# device name
+int	wcs[ARB]			# array to be saved
+int	len_wcs
+
+pointer	sp, fname
+int	fd
+int	open()
+errchk	open, write
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call gwcs_mkfilename (devname, Memc[fname], SZ_FNAME)
+	iferr (call delete (Memc[fname]))
+	    ;
+	fd = open (Memc[fname], NEW_FILE, BINARY_FILE)
+	call write (fd, wcs, len_wcs * SZ_INT)
+	call close (fd)
+
+	call sfree (sp)
+end
+
+
+# GRDWCS -- Read the WCS from a binary file in the user directory UPARM.
+# The actual number of size int elements read is returned as the function
+# value.  It is not an error if there is no file or the file cannot be read.
+
+int procedure grdwcs (devname, wcs, len_wcs)
+
+char	devname[ARB]			# device name
+int	wcs[ARB]			# array to be returned
+int	len_wcs				# max ints to read
+
+pointer	sp, fname
+int	fd, nchars
+int	open(), read()
+errchk	read
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call gwcs_mkfilename (devname, Memc[fname], SZ_FNAME)
+	iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE))
+	    nchars = 0
+	else {
+	    nchars = read (fd, wcs, len_wcs * SZ_INT)
+	    call close (fd)
+	}
+
+	call sfree (sp)
+	return (nchars / SZ_INT)
+end
+
+
+# GWCS_MKFILENAME -- Make the filename of the WCS savefile for the named
+# device.  The filename is "uparm$fname.gd", where the "fname" is the
+# device name with any illegal filename characters deleted.  The mapping
+# is not necessarily unique.
+
+procedure gwcs_mkfilename (devname, fname, maxch)
+
+char	devname[ARB]		# device name
+char	fname[ARB]		# generated filename (output)
+int	maxch
+
+int	ip, op, ch
+int	gstrcpy()
+
+begin
+	# Leave OP pointing to last char output.
+	op = gstrcpy ("uparm$", fname, maxch)
+
+	for (ip=1;  devname[ip] != EOS;  ip=ip+1) {
+	    ch = devname[ip]
+	    if (IS_ALNUM(ch) || ch == '.' || ch == '_') {
+		op = min (maxch, op + 1)
+		fname[op] = ch
+	    }
+	}
+
+	fname[op+1] = EOS
+end
diff --git a/sys/gio/greact.x b/sys/gio/greact.x
new file mode 100644
index 00000000..e201d543
--- /dev/null
+++ b/sys/gio/greact.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GREACTIVATE -- Reactivate the workstation, i.e., for an interactive device
+# (graphics terminal) restore the terminal to graphics mode, following a call
+# to gdeactivate to do some normal terminal mode text i/o.
+
+procedure greactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# action flags
+
+int	and()
+errchk	gki_reactivatews, gactivate
+
+begin
+	call flush (STDOUT)
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    # The workstation is already open - just reactivate it.
+	    call gki_reactivatews (GP_FD(gp), flags)
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) == 0)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) + GF_WSACTIVE
+	} else {
+	    # Open the workstation (implies an automatic reactivatews).
+	    call gactivate (gp, flags)
+	}
+
+	if (and (flags, AW_CLEAR) != 0)
+	    call gfrinit (gp)
+end
diff --git a/sys/gio/greset.x b/sys/gio/greset.x
new file mode 100644
index 00000000..1002e2b9
--- /dev/null
+++ b/sys/gio/greset.x
@@ -0,0 +1,238 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GRESET -- Initialize the internal state variables of GIO to their default
+# values.  Called upon startup and by GCANCEL and GCLEAR.
+
+procedure greset (gp, flags)
+
+pointer gp			#I graphics descriptor
+int	flags			#I flags indicating what to reset
+
+int	color, ch, i
+real	char_height, aspect
+bool	reset_wcs, reset_gio, reset_glabax
+pointer	sp, glbcolor, param, w, ap, ax, ax1, ax2, ip, op
+
+bool	streq()
+real	ggetr()
+int	envfind(), ctoi(), strncmp()
+define	next_ 91
+errchk	ggetr
+
+begin
+	call smark (sp)
+	call salloc (glbcolor, SZ_LINE, TY_CHAR)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+
+	# Initialize for a new frame; this is always done.
+	call gfrinit (gp)
+
+	reset_glabax = (and (flags, GR_RESETGLABAX) != 0)
+	reset_wcs    = (and (flags, GR_RESETWCS)    != 0)
+	reset_gio    = (and (flags, GR_RESETGIO)    != 0)
+
+	# Reset general GIO device and drawing parameters?
+	if (reset_gio) {
+	    GP_CURSOR(gp) = 1
+
+	    # All default sizes in NDC units are scaled to the height of a
+	    # device character.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    aspect = ggetr (gp, "ar")
+	    if (aspect < EPSILON)
+		aspect = 1.0
+	    GP_DEVASPECT(gp) = aspect
+
+	    # Set default marker sizes.
+	    do i = 1, 4
+		GP_SZMARKER(gp,i) = (char_height * i) / 4.0
+
+	    # Set polyline attributes.
+	    ap = GP_PLAP(gp)
+	    PL_LTYPE(ap) = 1
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+
+	    # Set polymarker attributes.
+	    ap = GP_PMAP(gp)
+	    PM_LTYPE(ap) = 1
+	    PM_WIDTH(ap) = 1.0
+	    PM_COLOR(ap) = 1
+
+	    # Set fill area attributes.
+	    ap = GP_FAAP(gp)
+	    FA_STYLE(ap) = 1
+	    FA_COLOR(ap) = 1
+
+	    # Set default text attributes.
+	    ap = GP_TXAP(gp)
+	    TX_UP(ap) = 90
+	    TX_SIZE(ap) = 1.0
+	    TX_PATH(ap) = GT_RIGHT
+	    TX_SPACING(ap) = 0.0
+	    TX_HJUSTIFY(ap) = GT_LEFT
+	    TX_VJUSTIFY(ap) = GT_DOWN
+	    TX_FONT(ap) = GT_ROMAN
+	    TX_QUALITY(ap) = GT_NORMAL
+	    TX_COLOR(ap) = 1
+	}
+
+	# Reset GLABAX parameters?
+	if (reset_glabax) {
+	    # Set general GLABAX parameters.
+	    GP_DRAWTITLE(gp) = YES
+	    GP_TITLESIZE(gp) = 1.0
+	    GP_TITLECOLOR(gp) = 1
+	    GP_TITLEJUST(gp) = GT_CENTER
+	    GP_NTITLELINES(gp) = 0
+	    GP_FRAMECOLOR(gp) = 0
+	    GP_FRAMEDRAWN(gp) = 0
+
+	    # Set GLABAX parameters for the X and Y axes.
+	    do i = 1, 2 {
+		if (i == 1)
+		    ax = GP_XAP(gp)
+		else
+		    ax = GP_YAP(gp)
+
+		GL_DRAWAXES(ax) = 3
+		GL_SETAXISPOS(ax) = NO 
+		GL_AXISPOS1(ax) = 0.0
+		GL_AXISPOS2(ax) = 0.0
+		GL_DRAWGRID(ax) = NO
+		GL_GRIDCOLOR(ax) = 1
+		GL_ROUND(ax) = NO
+		GL_LABELAXIS(ax) = YES
+		GL_AXISLABELSIZE(ax) = 1.0
+		GL_AXISLABELCOLOR(ax) = 1
+		GL_DRAWTICKS(ax) = YES
+		GL_LABELTICKS(ax) = YES
+		GL_NMAJOR(ax) = 6
+		GL_NMINOR(ax) = 4
+		GL_MAJORLENGTH(ax) = 0.6 * char_height
+		GL_MINORLENGTH(ax) = 0.3 * char_height
+		GL_MAJORWIDTH(ax) = 2.0
+		GL_MINORWIDTH(ax) = 2.0
+		GL_AXISWIDTH(ax) = 2.0
+		GL_AXISCOLOR(ax) = 1
+		GL_TICKLABELSIZE(ax) = 1.0
+		GL_TICKLABELCOLOR(ax) = 1
+		GL_TICKCOLOR(ax) = 1
+		GL_TICKFORMAT(ax) = EOS
+	    }
+
+	    # Correct the default tick length for the aspect ratio.
+	    ax = GP_XAP(gp)
+	    GL_MAJORLENGTH(ax) = GL_MAJORLENGTH(ax) / aspect
+	    GL_MINORLENGTH(ax) = GL_MINORLENGTH(ax) / aspect
+
+	    # Set user color defaults if specified.  This is a simple string
+	    # parameter of the form "pt=i,fr=i,ax=i,..." where I is the color
+	    # index.  The actual color corresponding to this index is defined
+	    # externally, e.g. by the graphics server.
+
+	    if (envfind ("glbcolor", Memc[glbcolor], SZ_LINE) > 0) {
+		ax1 = GP_XAP(gp)
+		ax2 = GP_YAP(gp)
+
+		for (ip=glbcolor;  Memc[ip] != EOS;  ) {
+		    # Get color parameter code.
+		    for (op=param;  Memc[ip] != EOS &&
+			Memc[ip] != '=' && Memc[ip] != ':';  ip=ip+1) {
+			Memc[op] = Memc[ip]
+			op = op + 1
+		    }
+		    Memc[op] = EOS
+		    ch = Memc[param+2]
+
+		    # Get color index.
+		    if (Memc[ip] == '=' || Memc[ip] == ':')
+			ip = ip + 1
+		    if (ctoi (Memc, ip, color) <= 0)
+			goto next_
+
+		    # Set parameter.  The two character parameter name may
+		    # have an "x" or "y" appended to set only one axis.  For
+		    # example, "pt=4,fr=3,ax=1,tk=1,al=5,tl=6".  The color
+		    # parameter code names are as follows:
+		    #
+		    #   pt	plot title
+		    #   fr	viewport frame
+		    #   gr[xy]	grid between tick marks
+		    #	ax[xy]	axis
+		    #	al[xy]	axis label
+		    #	tk[xy]	tick
+		    #	tl[xy]	tick label
+		    #
+		    # The color codes are simple integers corresponding to
+		    # graphics device color codes, e.g. 0, 1, 2, and so on.
+
+		    if (streq (Memc[param], "pt")) {
+			GP_TITLECOLOR(gp) = color
+		    } else if (streq (Memc[param], "fr")) {
+			GP_FRAMECOLOR(gp) = color
+		    } else if (strncmp (Memc[param], "gr", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_GRIDCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_GRIDCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "ax", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_AXISCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_AXISCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "al", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_AXISLABELCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_AXISLABELCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "tk", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_TICKCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_TICKCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "tl", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_TICKLABELCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_TICKLABELCOLOR(ax2) = color
+		    }
+next_
+		while (Memc[ip] != EOS && Memc[ip] != ',')
+		    ip = ip + 1
+		if (Memc[ip] == ',')
+		    ip = ip + 1
+		}
+	    }
+	}
+
+	# Reset the WCS?
+	if (reset_wcs) {
+	    GP_WCS(gp) = 1
+
+	    # Initialize the WCS to NDC coordinates.
+	    do i = 0, MAX_WCS {
+		w = GP_WCSPTR(gp,i)
+		WCS_WX1(w) = 0.0
+		WCS_WX2(w) = 1.0
+		WCS_WY1(w) = 0.0
+		WCS_WY2(w) = 1.0
+		WCS_SX1(w) = 0.0
+		WCS_SX2(w) = 1.0
+		WCS_SY1(w) = 0.0
+		WCS_SY2(w) = 1.0
+		WCS_XTRAN(w) = LINEAR
+		WCS_YTRAN(w) = LINEAR
+		WCS_FLAGS(w) = WF_NEWFORMAT+WF_CLIP
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/grmove.x b/sys/gio/grmove.x
new file mode 100644
index 00000000..aa4e5b45
--- /dev/null
+++ b/sys/gio/grmove.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GRMOVE -- Relative move, i.e., move the pen to the specified offset from the
+# current position (without generating any output).
+
+procedure grmove (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# offset from current position
+real	cx, cy
+
+begin
+	call gpl_flush()
+	if (IS_INDEF(x) || IS_INDEF(y))
+	    call gadraw (gp, x, y)
+	else {
+	    call gcurpos (gp, cx, cy)
+	    if (!(IS_INDEF(cx) || IS_INDEF(cy)))
+		call gamove (gp, cx + x, cy + y)
+	}
+end
diff --git a/sys/gio/grscale.x b/sys/gio/grscale.x
new file mode 100644
index 00000000..76c06ebc
--- /dev/null
+++ b/sys/gio/grscale.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+
+# GRSCALE -- Rescale the world coordinates of either the X or Y axis to fit the
+# data vector.  This is done by taking the minimum and maximum of the current
+# WCS limits and the data vector.  May be called repeatedly to find the range
+# of a family of vectors.
+
+procedure grscale (gp, v, npts, axis)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# length of data vector
+int	axis			# asis to be scaled (1=X, 2=Y)
+
+int	start, i
+real	minval, maxval, pixval
+pointer	w
+
+begin
+	# Find first definite valued pixel.  If entire data vector is
+	# indefinite we merely ignore it, since the window is presumably
+	# already set.
+
+	for (start=1;  start <= npts;  start=start+1)
+	    if (!IS_INDEF (v[start]))
+		break
+	if (start > npts)
+	    return
+
+	minval = v[start]
+	maxval = minval
+
+	# Compute min and max values of data vector.
+	do i = start+1, npts {
+	    pixval = v[i]
+	    if (!IS_INDEF(pixval))
+		if (pixval < minval)
+		    minval = pixval
+		else if (pixval > maxval)
+		    maxval = pixval
+	}
+
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Update the window limits.
+	switch (axis) {
+	case 1:
+	    WCS_WX1(w) = min (WCS_WX1(w), minval)
+	    WCS_WX2(w) = max (WCS_WX2(w), maxval)
+	case 2:
+	    WCS_WY1(w) = min (WCS_WY1(w), minval)
+	    WCS_WY2(w) = max (WCS_WY2(w), maxval)
+	default:
+	    call syserr (SYS_GSCALE)
+	}
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gscan.x b/sys/gio/gscan.x
new file mode 100644
index 00000000..ac8f82bd
--- /dev/null
+++ b/sys/gio/gscan.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSCAN -- Scan commands from a string or a file.
+
+procedure gscan (gp, command)
+
+pointer	gp			# graphics descriptor
+char	command[ARB]		# command to be scanned
+
+begin
+end
diff --git a/sys/gio/gscur.x b/sys/gio/gscur.x
new file mode 100644
index 00000000..2892e397
--- /dev/null
+++ b/sys/gio/gscur.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSCUR -- Set the current graphics cursor to the position (x,y) in world
+# coordinates.
+
+procedure gscur (gp, x, y)
+
+pointer gp			# graphics descriptor
+real	x, y			# new position for cursor
+real	mx, my
+
+begin
+	call gpl_flush()
+	call gpl_wcstogki (gp, x, y, mx, my)
+	call gki_setcursor (GP_FD(gp), nint(mx), nint(my), GP_CURSOR(gp))
+end
diff --git a/sys/gio/gseti.x b/sys/gio/gseti.x
new file mode 100644
index 00000000..f3517358
--- /dev/null
+++ b/sys/gio/gseti.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSETI -- Set any GIO parameter of type integer or real.  Precision may be
+# lost if the actual parameter is of type real (call GSETR instead in such
+# a case).
+
+procedure gseti (gp, param, value)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+int	value			# new value for parameter
+
+begin
+	call gsetr (gp, param, real(value))
+end
diff --git a/sys/gio/gsetr.x b/sys/gio/gsetr.x
new file mode 100644
index 00000000..9358f046
--- /dev/null
+++ b/sys/gio/gsetr.x
@@ -0,0 +1,276 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSETR -- Set any GIO parameter of type integer or real.  Real values are
+# silently coerced to integer if the actual parameter value is integer.
+
+procedure gsetr (gp, param, rval)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+real	rval			# new value for parameter
+
+real	char_height
+int	wcs, axes, field, ax[2], wflags, i
+pointer	w, p, pl, pm, tx, fa
+real	ggetr()
+
+begin
+	# Compute pointers to substructures once, here, to save space later.
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR(gp,wcs)
+	wflags = WCS_FLAGS(w)
+
+	pl = GP_PLAP(gp)
+	pm = GP_PMAP(gp)
+	tx = GP_TXAP(gp)
+	fa = GP_FAAP(gp)
+
+	switch (param) {
+
+	# General GIO parameters.
+
+	case G_FD:
+	    GP_FD(gp) = nint(rval)
+	case G_TTY:
+	    GP_TTY(gp) = nint(rval)
+	case G_WCS:
+	    GP_WCS(gp) = nint(rval)
+	case G_CURSOR:
+	    GP_CURSOR(gp) = nint(rval)
+
+	# These parameters affect the current WCS.
+
+	case G_XTRAN:
+	    WCS_XTRAN(w) = nint(rval)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_YTRAN:
+	    WCS_YTRAN(w) = nint(rval)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_CLIP:
+	    if (nint(rval) == 0)
+		WCS_FLAGS(w) = and (wflags, not(WF_CLIP))
+	    else
+		WCS_FLAGS(w) = or (wflags, WF_CLIP)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_RASTER:
+	    WCS_FLAGS(w) = WF_SETRASTER (wflags, nint(rval))
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+
+	# Default marker sizes (NDC coords).
+
+	case G_SZMARKER1:
+	    GP_SZMARKER(gp,1) = rval
+	case G_SZMARKER2:
+	    GP_SZMARKER(gp,2) = rval
+	case G_SZMARKER3:
+	    GP_SZMARKER(gp,3) = rval
+	case G_SZMARKER4:
+	    GP_SZMARKER(gp,4) = rval
+
+	# Polyline attributes.
+
+	case G_PLTYPE:
+	    call gst_set_attribute_i (nint(rval), PL_LTYPE(pl), PL_STATE(pl))
+	case G_PLWIDTH:
+	    call gst_set_attribute_r (rval, PL_WIDTH(pl), PL_STATE(pl))
+	case G_PLCOLOR:
+	    call gst_set_attribute_i (nint(rval), PL_COLOR(pl), PL_STATE(pl))
+
+	# Polymarker attributes.
+
+	case G_PMLTYPE:
+	    call gst_set_attribute_i (nint(rval), PM_LTYPE(pm), PM_STATE(pm))
+	case G_PMWIDTH:
+	    call gst_set_attribute_r (rval, PM_WIDTH(pm), PM_STATE(pm))
+	case G_PMCOLOR:
+	    call gst_set_attribute_i (nint(rval), PM_COLOR(pm), PM_STATE(pm))
+
+	# Text drawing attributes.
+
+	case G_TXUP:
+	    call gst_set_attribute_i (nint(rval), TX_UP(tx), TX_STATE(tx))
+	case G_TXSIZE:
+	    call gst_set_attribute_r (rval, TX_SIZE(tx), TX_STATE(tx))
+	case G_TXPATH:
+	    call gst_set_attribute_i (nint(rval), TX_PATH(tx), TX_STATE(tx))
+	case G_TXSPACING:
+	    call gst_set_attribute_r (rval, TX_SPACING(tx), TX_STATE(tx))
+	case G_TXHJUSTIFY:
+	    call gst_set_attribute_i (nint(rval), TX_HJUSTIFY(tx), TX_STATE(tx))
+	case G_TXVJUSTIFY:
+	    call gst_set_attribute_i (nint(rval), TX_VJUSTIFY(tx), TX_STATE(tx))
+	case G_TXFONT:
+	    call gst_set_attribute_i (nint(rval), TX_FONT(tx), TX_STATE(tx))
+	case G_TXQUALITY:
+	    call gst_set_attribute_i (nint(rval), TX_QUALITY(tx), TX_STATE(tx))
+	case G_TXCOLOR:
+	    call gst_set_attribute_i (nint(rval), TX_COLOR(tx), TX_STATE(tx))
+
+	# Fill area attributes.
+
+	case G_FASTYLE:
+	    call gst_set_attribute_i (nint(rval), FA_STYLE(fa), FA_STATE(fa))
+	case G_FACOLOR:
+	    call gst_set_attribute_i (nint(rval), FA_COLOR(fa), FA_STATE(fa))
+
+	# Axis labelling parameters affecting more than one axis.
+
+	case G_DRAWTITLE:
+	    GP_DRAWTITLE(gp) = nint(rval)
+	case G_TITLESIZE:
+	    GP_TITLESIZE(gp) = rval
+	case G_TITLECOLOR:
+	    GP_TITLECOLOR(gp) = nint(rval)
+	case G_TITLEJUST:
+	    GP_TITLEJUST(gp) = nint(rval)
+	case G_NTITLELINES:
+	    GP_NTITLELINES(gp) = nint(rval)
+	case G_FRAMECOLOR:
+	    GP_FRAMECOLOR(gp) = nint(rval)
+	case G_ASPECT:
+	    GP_ASPECT(gp) = rval
+
+	case G_CHARSIZE:
+	    # Set the character size (height) in NDC units.  This can also be
+	    # done by querying for "ch" and setting the relative size, but the
+	    # function is fundamental enough to be worth implementing as a
+	    # single call.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    call gst_set_attribute_r (rval / char_height, TX_SIZE(tx),
+		TX_STATE(tx))
+
+	default:
+	    # The GLABAX parameters for the X and Y axes may be set separately
+	    # for each axis or simultaneously for both.  The parameter codes
+	    # are encoded as 100 (X only) 200 (Y only) or 300 (both) plus the
+	    # code for the field in the lower digits.
+
+	    if (param < FIRST_GLABAX_PARAM || param > LAST_GLABAX_PARAM)
+		call syserr (SYS_GSET)
+
+	    axes = param / 100
+	    field = mod (param, 100) + 300
+
+	    ax[1] = 0
+	    ax[2] = 0
+	    if (axes == 1 || axes == 3)
+		ax[1] = YES
+	    if (axes == 2 || axes == 3)
+		ax[2] = YES
+
+	    do i = 1, 2 {
+		if (ax[i] == YES) {
+		    if (i == 1)
+			p = GP_XAP(gp)
+		    else
+			p = GP_YAP(gp)
+
+		    switch (field) {
+		    case G_DRAWAXES:
+			GL_DRAWAXES(p) = nint(rval)
+		    case G_SETAXISPOS:
+			GL_SETAXISPOS(p) = nint(rval)
+		    case G_AXISPOS1:
+			GL_AXISPOS1(p) = rval
+		    case G_AXISPOS2:
+			GL_AXISPOS2(p) = rval
+		    case G_DRAWGRID:
+			GL_DRAWGRID(p) = nint(rval)
+		    case G_GRIDCOLOR:
+			GL_GRIDCOLOR(p) = nint(rval)
+		    case G_ROUND:
+			GL_ROUND(p) = nint(rval)
+		    case G_LABELAXIS:
+			GL_LABELAXIS(p) = nint(rval)
+		    case G_AXISLABELSIZE:
+			GL_AXISLABELSIZE(p) = rval
+		    case G_AXISLABELCOLOR:
+			GL_AXISLABELCOLOR(p) = nint(rval)
+		    case G_DRAWTICKS:
+			GL_DRAWTICKS(p) = nint(rval)
+		    case G_LABELTICKS:
+			GL_LABELTICKS(p) = nint(rval)
+		    case G_NMAJOR:
+			GL_NMAJOR(p) = nint(rval)
+		    case G_NMINOR:
+			GL_NMINOR(p) = nint(rval)
+		    case G_MAJORLENGTH:
+			GL_MAJORLENGTH(p) = rval
+		    case G_MINORLENGTH:
+			GL_MINORLENGTH(p) = rval
+		    case G_MAJORWIDTH:
+			GL_MAJORWIDTH(p) = rval
+		    case G_MINORWIDTH:
+			GL_MINORWIDTH(p) = rval
+		    case G_AXISWIDTH:
+			GL_AXISWIDTH(p) = rval
+		    case G_AXISCOLOR:
+			GL_AXISCOLOR(p) = nint(rval)
+		    case G_TICKLABELSIZE:
+			GL_TICKLABELSIZE(p) = rval
+		    case G_TICKLABELCOLOR:
+			GL_TICKLABELCOLOR(p) = nint(rval)
+		    case G_TICKCOLOR:
+			GL_TICKCOLOR(p) = nint(rval)
+		    # case G_TICKFORMAT:
+			# not a real parameter
+		    default:
+			call syserr (SYS_GSET)
+		    }
+		}
+	    }
+	}
+end
+
+
+# GST_SET_ATTRIBUTE_I -- Compare the new value of an attribute to the current
+# value.  If the new value is not different, exit without modifying the
+# attribute packet, making no-op GSET calls efficient.  If the packet must
+# be modified, flush any buffered polyline output first else it will be
+# written using the new attribute (this is not necessary for text attributes,
+# but is harmless and it is unlikely that GSET will be called to modify a
+# text attribute while in the midst of building a polyline).  Set the
+# parameter and flag the attribute packet as modified.
+
+procedure gst_set_attribute_i (new_value, value, state)
+
+int	new_value		# value in GSET argument list
+int	value			# current value in GP struct
+int	state			# packet state
+
+begin
+	if (new_value != value) {
+	    call gpl_flush()
+	    value = new_value
+	    state = MODIFIED
+	}
+end
+
+
+# GST_SET_ATTRIBUTE_R -- Ditto, for real valued parameters.
+
+procedure gst_set_attribute_r (new_value, value, state)
+
+real	new_value		# value in GSET argument list
+real	value			# current value in GP struct
+int	state			# packet state
+
+begin
+	if (abs (new_value - value) > EPSILON) {
+	    call gpl_flush()
+	    value = new_value
+	    state = MODIFIED
+	}
+end
diff --git a/sys/gio/gsets.x b/sys/gio/gsets.x
new file mode 100644
index 00000000..ad72d000
--- /dev/null
+++ b/sys/gio/gsets.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSETS -- Set a string valued GIO parameter.
+
+procedure gsets (gp, param, value)
+
+pointer	gp			# graphics descriptor
+int	param			# parmeter to be set
+char	value[ARB]		# new value of parameter
+int	i
+pointer	gl[2]
+
+begin
+	gl[1] = GP_XAP(gp)
+	gl[2] = GP_YAP(gp)
+
+	switch (param) {
+	case G_XTICKFORMAT:
+	    call strcpy (value, GL_TICKFORMAT(gl[1]), SZ_TICKFORMAT)
+	case G_YTICKFORMAT:
+	    call strcpy (value, GL_TICKFORMAT(gl[2]), SZ_TICKFORMAT)
+	case G_TICKFORMAT:
+	    do i = 1, 2
+		call strcpy (value, GL_TICKFORMAT(gl[i]), SZ_TICKFORMAT)
+	default:
+	    call syserr (SYS_GSET)
+	}
+end
diff --git a/sys/gio/gstati.x b/sys/gio/gstati.x
new file mode 100644
index 00000000..2298b39b
--- /dev/null
+++ b/sys/gio/gstati.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTATI -- Get any GIO parameter of type integer or real.  Precision may be
+# lost if the actual parameter is of type real (call GSTATR instead in such
+# a case).
+
+int procedure gstati (gp, param)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be inspected
+
+real	gstatr()
+
+begin
+	return (gstatr (gp, param))
+end
diff --git a/sys/gio/gstatr.x b/sys/gio/gstatr.x
new file mode 100644
index 00000000..d0ba3d8b
--- /dev/null
+++ b/sys/gio/gstatr.x
@@ -0,0 +1,215 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSTATR -- Get any GIO parameter of type integer or real.  Integer values are
+# silently coerced to real if the actual parameter value is integer.
+
+real procedure gstatr (gp, param)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+
+real	char_height
+int	wcs, axes, field, ax[2], i
+pointer	w, p, pl, pm, tx, fa
+real	ggetr()
+
+begin
+	# Compute pointers to substructures once, here, to save space later.
+	wcs = GP_WCS(gp)
+	w   = GP_WCSPTR(gp,wcs)
+	pl  = GP_PLAP(gp)
+	pm  = GP_PMAP(gp)
+	tx  = GP_TXAP(gp)
+	fa  = GP_FAAP(gp)
+
+	switch (param) {
+
+	# General GIO parameters.
+
+	case G_FD:
+	    return (GP_FD(gp))
+	case G_TTY:
+	    return (GP_TTY(gp))
+	case G_WCS:
+	    return (GP_WCS(gp))
+	case G_CURSOR:
+	    return (GP_CURSOR(gp))
+
+	# These parameters affect the current WCS.
+
+	case G_XTRAN:
+	    return (WCS_XTRAN(w))
+	case G_YTRAN:
+	    return (WCS_YTRAN(w))
+	case G_CLIP:
+	    return (and (WCS_FLAGS(w), WF_CLIP))
+	case G_RASTER:
+	    return (WF_RASTER (WCS_FLAGS(w)))
+
+	# Default marker sizes (NDC coords).
+
+	case G_SZMARKER1:
+	    return (GP_SZMARKER(gp,1))
+	case G_SZMARKER2:
+	    return (GP_SZMARKER(gp,2))
+	case G_SZMARKER3:
+	    return (GP_SZMARKER(gp,3))
+	case G_SZMARKER4:
+	    return (GP_SZMARKER(gp,4))
+
+	# Polyline attributes.
+
+	case G_PLTYPE:
+	    return (PL_LTYPE(pl))
+	case G_PLWIDTH:
+	    return (PL_WIDTH(pl))
+	case G_PLCOLOR:
+	    return (PL_COLOR(pl))
+
+	# Polymarker attributes.
+
+	case G_PMLTYPE:
+	    return (PM_LTYPE(pm))
+	case G_PMWIDTH:
+	    return (PM_WIDTH(pm))
+	case G_PMCOLOR:
+	    return (PM_COLOR(pm))
+
+	# Text drawing attributes.
+
+	case G_TXUP:
+	    return (TX_UP(tx))
+	case G_TXSIZE:
+	    return (TX_SIZE(tx))
+	case G_TXPATH:
+	    return (TX_PATH(tx))
+	case G_TXSPACING:
+	    return (TX_SPACING(tx))
+	case G_TXHJUSTIFY:
+	    return (TX_HJUSTIFY(tx))
+	case G_TXVJUSTIFY:
+	    return (TX_VJUSTIFY(tx))
+	case G_TXFONT:
+	    return (TX_FONT(tx))
+	case G_TXQUALITY:
+	    return (TX_QUALITY(tx))
+	case G_TXCOLOR:
+	    return (TX_COLOR(tx))
+
+	# Fill area attributes.
+
+	case G_FASTYLE:
+	    return (FA_STYLE(fa))
+	case G_FACOLOR:
+	    return (FA_COLOR(fa))
+
+	# Axis labelling parameters affecting more than one axis.
+
+	case G_DRAWTITLE:
+	    return (GP_DRAWTITLE(gp))
+	case G_TITLESIZE:
+	    return (GP_TITLESIZE(gp))
+	case G_TITLECOLOR:
+	    return (GP_TITLECOLOR(gp))
+	case G_NTITLELINES:
+	    return (GP_NTITLELINES(gp))
+	case G_FRAMECOLOR:
+	    return (GP_FRAMECOLOR(gp))
+	case G_ASPECT:
+	    return (GP_ASPECT(gp))
+
+	case G_CHARSIZE:
+	    # Return the current character size in NDC units.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    return (char_height * TX_SIZE(tx))
+
+	default:
+	    # The GLABAX parameters for the X and Y axes may be set separately
+	    # for each axis or simultaneously for both.  The parameter codes
+	    # are encoded as 100 (X only) 200 (Y only) or 300 (both) plus the
+	    # code for the field in the lower digits.
+
+	    if (param < FIRST_GLABAX_PARAM || param > LAST_GLABAX_PARAM)
+		call syserr (SYS_GSTAT)
+
+	    axes = param / 100
+	    field = mod (param, 100) + 300
+
+	    ax[1] = 0
+	    ax[2] = 0
+	    if (axes == 1 || axes == 3)
+		ax[1] = YES
+	    if (axes == 2 || axes == 3)
+		ax[2] = YES
+
+	    do i = 1, 2 {
+		if (ax[i] == YES) {
+		    if (i == 1)
+			p = GP_XAP(gp)
+		    else
+			p = GP_YAP(gp)
+
+		    switch (field) {
+		    case G_DRAWAXES:
+			return (GL_DRAWAXES(p))
+		    case G_SETAXISPOS:
+			return (GL_SETAXISPOS(p))
+		    case G_AXISPOS1:
+			return (GL_AXISPOS1(p))
+		    case G_AXISPOS2:
+			return (GL_AXISPOS2(p))
+		    case G_DRAWGRID:
+			return (GL_DRAWGRID(p))
+		    case G_GRIDCOLOR:
+			return (GL_GRIDCOLOR(p))
+		    case G_ROUND:
+			return (GL_ROUND(p))
+		    case G_LABELAXIS:
+			return (GL_LABELAXIS(p))
+		    case G_AXISLABELSIZE:
+			return (GL_AXISLABELSIZE(p))
+		    case G_AXISLABELCOLOR:
+			return (GL_AXISLABELCOLOR(p))
+		    case G_DRAWTICKS:
+			return (GL_DRAWTICKS(p))
+		    case G_LABELTICKS:
+			return (GL_LABELTICKS(p))
+		    case G_NMAJOR:
+			return (GL_NMAJOR(p))
+		    case G_NMINOR:
+			return (GL_NMINOR(p))
+		    case G_MAJORLENGTH:
+			return (GL_MAJORLENGTH(p))
+		    case G_MINORLENGTH:
+			return (GL_MINORLENGTH(p))
+		    case G_MAJORWIDTH:
+			return (GL_MAJORWIDTH(p))
+		    case G_MINORWIDTH:
+			return (GL_MINORWIDTH(p))
+		    case G_AXISWIDTH:
+			return (GL_AXISWIDTH(p))
+		    case G_AXISCOLOR:
+			return (GL_AXISCOLOR(p))
+		    case G_TICKLABELSIZE:
+			return (GL_TICKLABELSIZE(p))
+		    case G_TICKLABELCOLOR:
+			return (GL_TICKLABELCOLOR(p))
+		    case G_TICKCOLOR:
+			return (GL_TICKCOLOR(p))
+		    # case G_TICKFORMAT:
+			# not a real parameter
+		    default:
+			call syserr (SYS_GSTAT)
+		    }
+		}
+	    }
+	}
+end
diff --git a/sys/gio/gstats.x b/sys/gio/gstats.x
new file mode 100644
index 00000000..14fd7c35
--- /dev/null
+++ b/sys/gio/gstats.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSTATS -- Get the value of a string valued GIO parameter.
+
+int procedure gstats (gp, param, outstr, maxch)
+
+pointer	gp			# graphics descriptor
+int	param			# parmeter to be set
+char	outstr[ARB]		# output string
+int	maxch
+int	gstrcpy()
+
+int	i, value
+pointer	p[2]
+
+begin
+	p[1] = GP_XAP(gp)
+	p[2] = GP_XAP(gp)
+
+	switch (param) {
+	case G_XTICKFORMAT:
+	    return (gstrcpy (GL_TICKFORMAT(p[1]), value, maxch))
+	case G_YTICKFORMAT:
+	    return (gstrcpy (GL_TICKFORMAT(p[2]), value, maxch))
+	case G_TICKFORMAT:
+	    do i = 1, 2
+		return (gstrcpy (GL_TICKFORMAT(p[i]), value, maxch))
+	default:
+	    call syserr (SYS_GSTAT)
+	}
+end
diff --git a/sys/gio/gsview.x b/sys/gio/gsview.x
new file mode 100644
index 00000000..7ed83b31
--- /dev/null
+++ b/sys/gio/gsview.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSVIEW -- Set the viewport of the current WCS.
+
+procedure gsview (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of NDC in X
+real	y1, y2			# range of NDC in Y
+pointer	w
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	WCS_SX1(w) = x1
+	WCS_SX2(w) = x2
+	WCS_SY1(w) = y1
+	WCS_SY2(w) = y2
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gswind.x b/sys/gio/gswind.x
new file mode 100644
index 00000000..81f7b6a3
--- /dev/null
+++ b/sys/gio/gswind.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSWIND -- Set the window into world coordinates of the current WCS.
+
+procedure gswind (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of world coords in X
+real	y1, y2			# range of world coords in Y
+pointer	w
+
+begin
+	call gpl_flush()
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	if (!IS_INDEF(x1))
+	    WCS_WX1(w) = x1
+	if (!IS_INDEF(x2))
+	    WCS_WX2(w) = x2
+	if (!IS_INDEF(y1))
+	    WCS_WY1(w) = y1
+	if (!IS_INDEF(y2))
+	    WCS_WY2(w) = y2
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gtext.x b/sys/gio/gtext.x
new file mode 100644
index 00000000..abb26ef4
--- /dev/null
+++ b/sys/gio/gtext.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GTEXT -- Draw text.  All textual output via GIO is via this primitive.  Unlike
+# polyline, polymarker, fill area, and cell array output, textual output is not
+# subjected to clipping by GIO.  Clipping may be performed at the kernel level
+# if a workstation viewport is defined.  Our task here is principally to parse
+# the format string and set up the text attributes, then insert the text drawing
+# instruction into the GKI instruction stream.  The real work of text generation
+# is very device dependent and is therefore left to the kernel.
+
+procedure gtext (gp, x, y, text, format)
+
+pointer	gp			# graphics descriptor
+real	x, y			# position at which text is to be drawn
+char	text[ARB]		# text to be drawn
+char	format[ARB]		# text drawing parameters
+
+int	ip, i
+real	mx, my
+pointer	sp, ap, tx
+bool	text_attributes_modified
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_TX, TY_STRUCT)
+
+	# Set up pointers to text attribute packets and initialize the
+	# new packet to the default values.  Two text attribute packets
+	# are maintained in GP: TXAP, the default packet, and TXAPCUR,
+	# the packet last sent to the device.  In what follows, AP is
+	# the new packet and TX is the packet last sent to the device.
+	# We start by initializing the new packet at AP to the default
+	# text drawing parameters.
+
+	call amovi (Memi[GP_TXAP(gp)], Memi[ap], LEN_TX)
+	tx = GP_TXAPCUR(gp)
+
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	ip = 1
+	call gtxset (ap, format, ip)
+
+	# If the old text attribute packet was never fixed always fix the
+	# new packet, otherwise determine whether or not any text attributes
+	# were actually modified and only fix the new packet if it is
+	# different.
+
+	text_attributes_modified = false
+	for (i=2;  i <= LEN_TX;  i=i+1)
+	    if (Memi[ap+i-1] != Memi[tx+i-1]) {
+		text_attributes_modified = true
+		break
+	    }
+
+	# Flush any buffered polyline output, and transform the text coordinates
+	# to GKI device coordinates.
+
+	call gpl_flush()
+	call gpl_wcstogki (gp, x, y, mx, my)
+
+	# Update text attributes if necessary.
+	if (text_attributes_modified || TX_STATE(tx) != FIXED) {
+	    call amovi (Memi[ap], Memi[tx], LEN_TX)
+	    call gki_txset (GP_FD(gp), tx)
+	    TX_STATE(tx) = FIXED
+	}
+
+	# Output text drawing instruction.
+	call gki_text (GP_FD(gp), nint(mx), nint(my), text)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gtick.gx b/sys/gio/gtick.gx
new file mode 100644
index 00000000..157fae1e
--- /dev/null
+++ b/sys/gio/gtick.gx
@@ -0,0 +1,192 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTICK -- Determine the best number and placement of ticks for the interval
+# [x1:x2].  If log scaling is in use we try to put the ticks at positions which
+# are 1.0 times some power of ten, otherwise we divide the interval an integral
+# number of times and place the ticks at the interval boundaries.  The basic
+# algorithm is simple, but implementation is tricky due to the quirks of
+# floating point computations and the desire to have the algorithm work for all
+# X, and all ranges of X.  For example, we might want to plot a large range
+# near zero, or a small range where both X1 and X2 have a very large exponent.
+#
+# N.B.: this is a generic source; it may be preprocessed with the IRAF "generic"
+# preprocessor to produce either a single or double precision SPP source file.
+
+procedure gtick$t (x1, x2, rough_nticks, logflag, x_tick1, step)
+
+PIXEL	x1, x2			# range for which ticks are desired
+int	rough_nticks		# approximate number of ticks desired
+int	logflag			# nonzero if log scaling in use
+PIXEL	x_tick1			# x coord of first tick (output)
+PIXEL	step			# tick spacing along X (output)
+
+PIXEL	x, tol
+int	ndiv
+int	log
+#int	nticks
+int	expon
+PIXEL	gt_distance()
+
+begin
+	log = logflag
+	tol = EPSILON$T * 10.0
+
+	# If log, decrease ndiv until an x of 1.0 is obtained.  If an x of 1.0
+	# cannot be produced, repeat the calculation once more with ndiv fixed.
+
+	repeat {
+	    ndiv = max (1, rough_nticks - 1)
+
+	    repeat {
+		if (log == YES)
+		    x = 1.0
+		else
+		    x = abs ((x2 - x1) / ndiv)
+
+		# Scale approximate tick spacing to the range [1-10).  Select
+		# a logical tick spacing, given calculated and scaled spacing.
+
+		call fp_norm$t (x, x, expon)
+		if (x < 1.5)
+		    x = 1.0
+		else if (x < 2.5)
+		    x = 2.0
+		else if (x < 4.0)
+		    x = 2.5
+		else if (x < 7.5)
+		    x = 5.0
+		else {
+		    x = 1.0
+		    expon = expon + 1
+		}
+
+		# Calculate the first tick and the tick increment (step size).
+		if (log == YES)
+		    step = 1.0
+		else
+		    step = x * (10.0 ** expon)
+
+		if (gt_distance (x1, step, x_tick1) / step < tol)
+		    # x_tick1 = x1
+		else if (x1 < x2 && x_tick1 < x1)
+		    x_tick1 = x_tick1 + step
+		else if (x1 > x2 && x_tick1 > x1)
+		    x_tick1 = x_tick1 - step
+
+		if (x1 > x2)
+		    step = -step
+		ndiv = ndiv - 1
+
+	    } until (abs(abs(x) - 1.0) < tol || log == NO || ndiv == 0)
+
+	    # Terminate if not in log mode, if the tick separation is a power
+	    # of ten and there are ndivisions tick marks, or if the tick
+	    # separation is one magnitude and there are at least two tick marks
+	    # within the range x1:x2.
+
+		#    if (log == NO) {
+		#	return
+		#    } else if (step == 1.0 || x == 1.0) {
+		#	if (step == 1.0)
+		#	    nticks = 1
+		#	else
+		#	    nticks = max (2, rough_nticks - 1)
+
+		#	if (x1 > x2 && x_tick1 + nticks * step >= x2)
+		#	    return
+		#	else if (x1 < x2 && x_tick1 + nticks * step <= x2)
+		#	    return
+		#	else
+		#	    log = NO
+		#    } else
+		#	log = NO
+
+	    return
+	}
+end
+
+
+# GT_NDIGITS -- Calculate the number of digits of precision needed to label
+# ticks in the range x1 to x2 (i.e., if x1=100000 and x2=100001, 7 digits
+# will be required, whereas in many cases 1 or 2 is enough).
+
+int procedure gt_ndigits (x1, x2, step)
+
+PIXEL	x1, x2			# range covered by numbers
+PIXEL	step			# tick separation
+PIXEL	ratio
+int	n
+
+begin
+	if (x1 == x2)
+	    n = 2
+	else {
+	    ratio = abs ((x1+x2) / (x1-x2)) 
+	    n = log10 (max (1.0, ratio)) + 2.0
+	}
+
+	return (n)
+end
+
+
+# GT_LINEARITY -- The following function returns a large number if there is
+# little difference between a log scale and a linear scale for the range X1
+# to X2.  if the linearity of the interval is large, there is no point in
+# using a logarithmic scale.
+
+PIXEL procedure gt_linearity (x1, x2)
+
+PIXEL	x1, x2
+PIXEL	linearity, difflog
+PIXEL	elog$t()
+
+begin
+	if (x1 <= 0 || x2 <= 0)
+	    difflog = abs (elog$t(x1) - elog$t(x2))
+	else
+	    difflog = abs (log10(x1) - log10(x2))
+
+	if (difflog == 0.0)
+	    linearity = 1E10
+	else
+	    linearity =  1.0 / difflog
+
+	return (linearity)
+end
+
+
+# GT_DISTANCE -- Compute the distance of X from the nearest integral multiple
+# of "step".
+
+PIXEL procedure gt_distance (x, step, nearest_tick)
+
+PIXEL	x			# number to be tested
+PIXEL	step			# tick separation
+PIXEL	nearest_tick		# X coord of tick nearest X
+
+PIXEL	ltick, rtick, absx
+PIXEL	fp_fix$t()
+
+begin
+	absx = abs (x)
+
+	ltick = fp_fix$t (absx / step) * step
+	rtick = ltick + step
+
+	if (abs(absx - ltick) < abs(rtick - absx)) {
+	    if (x < 0)
+		nearest_tick = -ltick
+	    else
+		nearest_tick = ltick
+	    return (absx - ltick)
+
+	} else {
+	    if (x < 0)
+		nearest_tick = -rtick
+	    else
+		nearest_tick = rtick
+	    return (rtick - absx)
+	}
+end
diff --git a/sys/gio/gtickr.x b/sys/gio/gtickr.x
new file mode 100644
index 00000000..cd227363
--- /dev/null
+++ b/sys/gio/gtickr.x
@@ -0,0 +1,192 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTICK -- Determine the best number and placement of ticks for the interval
+# [x1:x2].  If log scaling is in use we try to put the ticks at positions which
+# are 1.0 times some power of ten, otherwise we divide the interval an integral
+# number of times and place the ticks at the interval boundaries.  The basic
+# algorithm is simple, but implementation is tricky due to the quirks of
+# floating point computations and the desire to have the algorithm work for all
+# X, and all ranges of X.  For example, we might want to plot a large range
+# near zero, or a small range where both X1 and X2 have a very large exponent.
+#
+# N.B.: this is a generic source; it may be preprocessed with the IRAF "generic"
+# preprocessor to produce either a single or double precision SPP source file.
+
+procedure gtickr (x1, x2, rough_nticks, logflag, x_tick1, step)
+
+real	x1, x2			# range for which ticks are desired
+int	rough_nticks		# approximate number of ticks desired
+int	logflag			# nonzero if log scaling in use
+real	x_tick1			# x coord of first tick (output)
+real	step			# tick spacing along X (output)
+
+real	x, tol
+int	ndiv
+int	log
+#int	nticks
+int	expon
+real	gt_distance()
+
+begin
+	log = logflag
+	tol = EPSILONR * 10.0
+
+	# If log, decrease ndiv until an x of 1.0 is obtained.  If an x of 1.0
+	# cannot be produced, repeat the calculation once more with ndiv fixed.
+
+	repeat {
+	    ndiv = max (1, rough_nticks - 1)
+
+	    repeat {
+		if (log == YES)
+		    x = 1.0
+		else
+		    x = abs ((x2 - x1) / ndiv)
+
+		# Scale approximate tick spacing to the range [1-10).  Select
+		# a logical tick spacing, given calculated and scaled spacing.
+
+		call fp_normr (x, x, expon)
+		if (x < 1.5)
+		    x = 1.0
+		else if (x < 2.5)
+		    x = 2.0
+		else if (x < 4.0)
+		    x = 2.5
+		else if (x < 7.5)
+		    x = 5.0
+		else {
+		    x = 1.0
+		    expon = expon + 1
+		}
+
+		# Calculate the first tick and the tick increment (step size).
+		if (log == YES)
+		    step = 1.0
+		else
+		    step = x * (10.0 ** expon)
+
+		if (gt_distance (x1, step, x_tick1) / step < tol)
+		    # x_tick1 = x1
+		else if (x1 < x2 && x_tick1 < x1)
+		    x_tick1 = x_tick1 + step
+		else if (x1 > x2 && x_tick1 > x1)
+		    x_tick1 = x_tick1 - step
+
+		if (x1 > x2)
+		    step = -step
+		ndiv = ndiv - 1
+
+	    } until (abs(abs(x) - 1.0) < tol || log == NO || ndiv == 0)
+
+	    # Terminate if not in log mode, if the tick separation is a power
+	    # of ten and there are ndivisions tick marks, or if the tick
+	    # separation is one magnitude and there are at least two tick marks
+	    # within the range x1:x2.
+
+		#    if (log == NO) {
+		#	return
+		#    } else if (step == 1.0 || x == 1.0) {
+		#	if (step == 1.0)
+		#	    nticks = 1
+		#	else
+		#	    nticks = max (2, rough_nticks - 1)
+
+		#	if (x1 > x2 && x_tick1 + nticks * step >= x2)
+		#	    return
+		#	else if (x1 < x2 && x_tick1 + nticks * step <= x2)
+		#	    return
+		#	else
+		#	    log = NO
+		#    } else
+		#	log = NO
+
+	    return
+	}
+end
+
+
+# GT_NDIGITS -- Calculate the number of digits of precision needed to label
+# ticks in the range x1 to x2 (i.e., if x1=100000 and x2=100001, 7 digits
+# will be required, whereas in many cases 1 or 2 is enough).
+
+int procedure gt_ndigits (x1, x2, step)
+
+real	x1, x2			# range covered by numbers
+real	step			# tick separation
+real	ratio
+int	n
+
+begin
+	if (x1 == x2)
+	    n = 2
+	else {
+	    ratio = abs ((x1+x2) / (x1-x2)) 
+	    n = log10 (max (1.0, ratio)) + 2.0
+	}
+
+	return (n)
+end
+
+
+# GT_LINEARITY -- The following function returns a large number if there is
+# little difference between a log scale and a linear scale for the range X1
+# to X2.  if the linearity of the interval is large, there is no point in
+# using a logarithmic scale.
+
+real procedure gt_linearity (x1, x2)
+
+real	x1, x2
+real	linearity, difflog
+real	elogr()
+
+begin
+	if (x1 <= 0 || x2 <= 0)
+	    difflog = abs (elogr(x1) - elogr(x2))
+	else
+	    difflog = abs (log10(x1) - log10(x2))
+
+	if (difflog == 0.0)
+	    linearity = 1E10
+	else
+	    linearity =  1.0 / difflog
+
+	return (linearity)
+end
+
+
+# GT_DISTANCE -- Compute the distance of X from the nearest integral multiple
+# of "step".
+
+real procedure gt_distance (x, step, nearest_tick)
+
+real	x			# number to be tested
+real	step			# tick separation
+real	nearest_tick		# X coord of tick nearest X
+
+real	ltick, rtick, absx
+real	fp_fixr()
+
+begin
+	absx = abs (x)
+
+	ltick = fp_fixr (absx / step) * step
+	rtick = ltick + step
+
+	if (abs(absx - ltick) < abs(rtick - absx)) {
+	    if (x < 0)
+		nearest_tick = -ltick
+	    else
+		nearest_tick = ltick
+	    return (absx - ltick)
+
+	} else {
+	    if (x < 0)
+		nearest_tick = -rtick
+	    else
+		nearest_tick = rtick
+	    return (rtick - absx)
+	}
+end
diff --git a/sys/gio/gtxset.x b/sys/gio/gtxset.x
new file mode 100644
index 00000000..de386a69
--- /dev/null
+++ b/sys/gio/gtxset.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<gset.h>
+include	<gio.h>
+
+define	MAXCH	15
+
+# GTXSET -- Parse a text drawing format string and set the values of the text
+# attributes in the TX output structure.
+
+procedure gtxset (tx, format, ip)
+
+pointer	tx			# text attribute structure
+char	format[ARB]		# text attribute format string
+int	ip			# pointer into format string
+
+char	attribute[MAXCH], value[MAXCH]
+int	op, tip, temp, ch
+int	h_v[4], v_v[4], f_v[4], q_v[4], p_v[4]
+int	ctoi(), ctor(), stridx()
+define	badformat_ 91
+
+string	h_c	"nclr"
+data	h_v	/GT_NORMAL,	GT_CENTER,	GT_LEFT,	GT_RIGHT/
+string	v_c	"nctb"
+data	v_v	/GT_NORMAL,	GT_CENTER,	GT_TOP,		GT_BOTTOM/
+string	f_c	"rgib"
+data	f_v	/GT_ROMAN,	GT_GREEK,	GT_ITALIC,	GT_BOLD/
+string	q_c	"nlmh"
+data	q_v	/GT_NORMAL,	GT_LOW,		GT_MEDIUM,	GT_HIGH/
+string	p_c	"lrud"
+data	p_v	/GT_LEFT,	GT_RIGHT,	GT_UP,		GT_DOWN/
+
+begin
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	for (;  format[ip] != EOS;  ip=ip+1) {
+	    # Extract the next "attribute=value" construct.
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+
+	    op = 1
+	    for (ch=format[ip];  ch != EOS && ch != '=';  ch=format[ip]) {
+		if (op <= MAXCH) {
+		    attribute[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+	    }
+	    attribute[op] = EOS
+
+	    if (ch == '=')
+		ip = ip + 1
+
+	    op = 1
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+	    ch = format[ip]
+	    while (ch != EOS && ch != ';' && ch != ',') {
+		if (op <= MAXCH) {
+		    value[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+		ch = format[ip]
+	    }
+	    value[op] = EOS
+
+	    if (attribute[1] == EOS || value[1] == EOS)
+		break
+
+	    # Decode the assignment and set the corresponding text attribute
+	    # in the graphics descriptor.
+
+	    switch (attribute[1]) {
+	    case 'u':				# character up vector
+		tip = 1
+		if (ctoi (value, tip, TX_UP(tx)) <= 0) {
+		    TX_UP(tx) = 90
+		    goto badformat_
+		}
+
+	    case 'p':				# path
+		temp = stridx (value[1], p_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_PATH(tx) = p_v[temp]
+
+	    case 'c':				# color
+		tip = 1
+		if (ctoi (value, tip, TX_COLOR(tx)) <= 0) {
+		    TX_COLOR(tx) = 1
+		    goto badformat_
+		}
+
+	    case 's':				# character size scale factor
+		tip = 1
+		if (ctor (value, tip, TX_SIZE(tx)) <= 0) {
+		    TX_SIZE(tx) = 1.0
+		    goto badformat_
+		}
+
+	    case 'h':				# horizontal justification
+		temp = stridx (value[1], h_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_HJUSTIFY(tx) = h_v[temp]
+
+	    case 'v':				# vertical justification
+		temp = stridx (value[1], v_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_VJUSTIFY(tx) = v_v[temp]
+
+	    case 'f':				# font
+		temp = stridx (value[1], f_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_FONT(tx) = f_v[temp]
+		
+	    case 'q':				# font quality
+		temp = stridx (value[1], q_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_QUALITY(tx) = q_v[temp]
+
+	    default:
+badformat_	call eprintf ("Warning (GIO): bad gtext format '%s'\n")
+		    call pargstr (format)
+	    }
+
+	    if (format[ip] == EOS)
+		break
+	}
+end
diff --git a/sys/gio/gumark.x b/sys/gio/gumark.x
new file mode 100644
index 00000000..cafb42bc
--- /dev/null
+++ b/sys/gio/gumark.x
@@ -0,0 +1,108 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+
+# GUMARK -- Draw a user defined mark.  The mark is defined by the polygon
+# (x[i],y[i], i=1,npts), normalized to the unit square.  This mark is mapped
+# into the window at (XCEN,YCEN) of size XSIZE, YSIZE, where the mark center
+# is always given in world coordinates but the size may be given in any of a
+# number of ways, independently in X and Y.
+
+procedure gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+
+pointer	gp			# graphics descriptor
+real	x[ARB]			# X coordinates of marker polygon (unit square)
+real	y[ARB]			# Y coordinates of marker polygon (unit square)
+int	npts			# number of points in marker polygon
+real	xcen, ycen		# world coordinates of center of marker
+real	xsize, ysize		# marker size in X and Y
+int	fill			# draw marker using area fill
+
+pointer	plap, pmap
+bool	scale_unset
+int	save_linetype, index, i
+real	x1, y1, xs, ys, dx, dy
+real	size[2], ndc_size[2], wcs_size[2]
+
+begin
+	plap = GP_PLAP(gp)
+	pmap = GP_PMAP(gp)
+
+	# Determine the marker size in world coordinates.  Marksizes 1:4 are
+	# "standard size" markers.  A marksize of [0-1) is an explicit marker
+	# size in NDC coordinates, while a negative marksize is an explicit
+	# marker size in world coordinates.
+
+	size[1] = xsize
+	size[2] = ysize
+	scale_unset = true
+
+	do i = 1, 2
+	    if (size[i] > 0) {
+		if (size[i] - 1.0 > -EPSILON) {
+		    # Use a default marker size.
+		    index = min (MAX_SZMARKER, int(size[i]))
+		    ndc_size[i] = GP_SZMARKER (gp, index)
+
+		    # Correct for the aspect ratio.
+		    if (i == 1)
+			ndc_size[1] = ndc_size[1] * GP_DEVASPECT(gp)
+		} else
+		    ndc_size[i] = size[i]
+
+		# Convert to size in world coords.
+		if (scale_unset) {
+		    # Get the scale in wcs units per ndc unit at (x,y).
+		    call ggscale (gp, xcen, ycen, dx, dy)
+		    scale_unset = false
+		}
+		if (i == 1)
+		    wcs_size[1] = ndc_size[1] * abs(dx)
+		else
+		    wcs_size[2] = ndc_size[2] * abs(dy)
+
+	    } else
+		wcs_size[i] = -size[i]
+
+	# Set fill area instruction type if filling, otherwise set linetype
+	# if marker will be drawn as a polyline.  Do nothing if polymarker
+	# linetype is same as polyline linetype.
+
+	if (fill == YES)
+	    call gpl_settype (gp, FILLAREA)
+	else {
+	    save_linetype = PL_LTYPE(plap)
+	    if (save_linetype != PM_LTYPE(pmap)) {
+		call gpl_flush()
+		PL_LTYPE(plap) = PM_LTYPE(pmap)
+		PL_STATE(plap) = MODIFIED
+	    }
+	}
+
+	# Draw the marker, scaling as necessary to fit the mark window.  Final
+	# mark need not have the same aspect ratio as the normalized mark.
+	# Leave the pen positioned to the center of the marker.
+
+	xs = wcs_size[1]
+	ys = wcs_size[2]
+	x1 = xcen - (xs / 2.0)
+	y1 = ycen - (ys / 2.0)
+
+	call gamove (gp, x[1] * xs + x1, y[1] * ys + y1)
+	do i = 2, npts
+	    call gadraw (gp, x[i] * xs + x1, y[i] * ys + y1)
+	call gamove (gp, xcen, ycen)
+
+	# If the polyline linetype was modified restore the original value.
+	# Do not need to do anything if polymarker linetype was same as
+	# polyline linetype.
+
+	if (fill == YES)
+	    call gpl_settype (gp, POLYLINE)
+	else if (save_linetype != PM_LTYPE(pmap)) {
+	    call gpl_flush()
+	    PL_LTYPE(plap) = save_linetype
+	    PL_STATE(plap) = MODIFIED
+	}
+end
diff --git a/sys/gio/gvline.x b/sys/gio/gvline.x
new file mode 100644
index 00000000..929fab44
--- /dev/null
+++ b/sys/gio/gvline.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GVLINE -- Vector polyline.  Draw a line connecting the points (X[i],V[i]),
+# where the X[i] are evenly distributed from X1 to X2.
+
+procedure gvline (gp, v, npts, x1, x2)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# Y coordinates of the polyline
+int	npts			# number of polyline points
+real	x1, x2			# range of X coordinates of the polyline
+
+int	i
+real	dx
+
+begin
+	if (npts > 1) {
+	    dx = (x2 - x1) / (npts - 1)
+	    call gamove (gp, x1, v[1])
+	    do i = 2, npts
+		call gadraw (gp, (i-1) * dx + x1, v[i])
+	}
+end
diff --git a/sys/gio/gvmark.x b/sys/gio/gvmark.x
new file mode 100644
index 00000000..219f8bae
--- /dev/null
+++ b/sys/gio/gvmark.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GVMARK -- Vector polymarker.  Output at sequence of markers at the vertices
+# of a polygon, all markers the same type and size.  The polygon is given by
+# the set of points (X[i],V[i]), where the X[i] are evenly distributed from X1
+# to X2.  The marker type GM_POINT is a special case.
+
+procedure gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# Y[i] polygon
+int	npts			# number of points
+real	x1, x2			# range of X[i]
+int	marktype		# marker type
+real	xsize, ysize		# marker size
+
+int	i
+real	dx
+
+begin
+	if (npts > 1)
+	    if (marktype == GM_POINT) {
+		call gpl_settype (gp, POLYMARKER)
+		call gvline (gp, v, npts, x1, x2)
+		call gpl_settype (gp, POLYLINE)
+	    } else {
+		dx = (x2 - x1) / (npts - 1)
+		do i = 1, npts
+		    call gmark (gp, (i-1) * dx + x1, v[i], marktype,
+			xsize, ysize)
+	    }
+end
diff --git a/sys/gio/imdkern/README b/sys/gio/imdkern/README
new file mode 100644
index 00000000..da041be0
--- /dev/null
+++ b/sys/gio/imdkern/README
@@ -0,0 +1,85 @@
+IMDKERN -
+
+This directory contains the source for the simple GIO/IMD kernel, used to
+draw graphics in a display frame buffer.  It uses the data stream
+interface to open the frame buffer and uses code from SGI to rasterize
+the graphics.
+
+Special graphcap entries used by this kernel:
+
+	CI	Color index of graphics pixels
+	FN	Display frame buffer
+	LO	Width in pixels of line size 1.0
+	LS	Difference in pixels between line sizes
+	DB	Print debug messages?
+
+
+Revision notes...
+----------------
+IMDKERN notes		20 December 1989	Z. G. Levay, STScI
+
+
+  o Make private copy idskern of gio/sgikern.
+
+  o Change "sgi" filename and procedure prefixes to "imd" throughout
+    the code.  Change sgk.x to idk.x.  Changed imd_open to imd_fopen to
+    aviod conflict with a procedure in libds.  The files are:
+
+    font.com, font.h, idk.com, idk.h, idk.x, imd.com, imd.h,
+    imdcancel.x, imdclear.x, imdclose.x, imdclws.x, imdcolor.x,
+    imddrawch.x, imdescape.x, imdfa.x, imdfaset.x, imdflush.x,
+    imdfont.x, imdfopen.x, imdgcell.x, imdinit.x, imdipl.x,
+    imdkern.par, imdline.x, imdopenws.x, imdpcell.x, imdpl.x,
+    imdplset.x, imdpm.x, imdpmset.x, imdreset.x, imdtx.x, imdtxset.x,
+    ltype.dat, mkpkg, t_imdkern.x, x_imdkern.x,
+
+  o Modify mkpkg to build the task locally without updating the system
+    library or install the task.
+
+  o Add global parameters "frame" and "color" to task imdkern.
+    Modified imd_fopen to read task parameters and pass as arguments to
+    imd_openws.  Added these parameters to imd_openws and the call to
+    idk_open.
+
+  o In idk_open, added frame and color to the calling sequence.  Added
+    a call to imd_mapframe to open the frame buffer as an image,
+    changed setting the bitmap size to use the frame buffer size (via
+    IMIO) instead of graphcap parameters.  Set the bits per bitmap word
+    to 8.  Set the maximum bitmap size to 2048x2048 pixels.  Ripped out
+    the code for opening the SGI metacode file, DD string manipulation,
+    etc.  Added ttygeti calls to read the frame and color from the
+    graphcap in case they were passed as INDEF.
+
+    In idk_frame, changed the code to map an input and output section
+    of the frame buffer (via IMIO), read the bitmap line by line,
+    testing each word for any on bits, and writing the color index
+    value to the frame buffer pixel for each on bitmap bit.  Set the
+    I/O buffer sizes to 64 lines (somewhat arbitrarily).
+
+    In idk_open, Changed the code to compute the x and y max (right and
+    top edges) of the bitmap by one pixel to draw to the edge.  In
+    idk_linewidth, changed the code to compute the gap at the frame
+    edges by one pixel.
+
+    Removed sections of code dealing with non-bitmap format, rotated or
+    flipped bitmaps.
+
+
+----------------
+Installation and checkout.  (12/21/89 dct)
+
+Installed code in gio/imdkern.
+Put hooks for new task IMDKERN in the PLOT package.
+Moved imdkern.par to plot, moved frame,color params to after "generic".
+Deleted file imdipl.x, identical to imdpl.x.
+Renamed imdfopen.x to imdopen.x for consistency with other kernels;
+    changed procedure name to imd_opendev to avoid name collision with imdopen.
+Deleted idk.h, contains only SGI metecode defs not used in idk.x.
+In t_imdkern.x, moved the clgeti's for color,frame to after the clgeti for
+    "generic" (required by startup protocol for graphics subkernel).  For the
+    generic case, added initializers to set values to -1 to flag not set.
+    Got rid of the IS_INDEFs in idk.x.  Nothing wrong with these, I just try
+    to avoid using INDEF in low level system code.
+mkpkg - link xx_imdkern.e, not x_imdkern.e, rename in the install (this is
+    necessary to permit local testing of new versions, else the installed BIN
+    version is used).
diff --git a/sys/gio/imdkern/font.com b/sys/gio/imdkern/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/imdkern/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/imdkern/font.h b/sys/gio/imdkern/font.h
new file mode 100644
index 00000000..eb2e72f4
--- /dev/null
+++ b/sys/gio/imdkern/font.h
@@ -0,0 +1,29 @@
+# FONT.H -- Font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/imdkern/idk.com b/sys/gio/imdkern/idk.com
new file mode 100644
index 00000000..62e4eaf7
--- /dev/null
+++ b/sys/gio/imdkern/idk.com
@@ -0,0 +1,50 @@
+# IDK.COM -- The common for the IDK kernel.  A common is used here for maximum
+# efficiency (minimum indirection) when rasterizing vectors and encoding
+# metacode.  The maximum bitmap size is set at compile time in idk.h.
+
+# Booleans put here to avoid possible alignment problems.
+
+bool	mf_bitmap			# metafile type, metacode or bitmap
+bool	mf_rotate			# rotate (swap x and y)
+bool	mf_yflip			# flip y axis end for end
+bool	mf_update			# update bitmap
+bool	mf_delete			# delete metacode file after dispose
+bool	mf_debug			# print kernel debugging messages
+bool	mf_swap2			# swap every 2 bytes on output
+bool	mf_swap4			# swap every 4 bytes on output
+bool	mf_oneperfile			# store each frame in a new file
+
+common	/idkboo/ mf_bitmap, mf_rotate, mf_yflip, mf_update, mf_delete, mf_debug,
+	mf_swap2, mf_swap4, mf_oneperfile
+
+# Everything else goes here.
+
+int	mf_fd				# image descriptor of frame buffer
+int	mf_frame			# frame counter
+char	mf_fname[SZ_PATHNAME]		# metafile filename
+char	mf_dispose[SZ_OSCMD]		# host dispose command
+
+int	mf_op				# [MCODE] index into obuf
+short	mf_obuf[LEN_OBUF]		# metacode buffer
+
+int	mf_cx, mf_cy			# [BITMAPS] current pen position
+int	mf_nbpb				# packing factor, bits per byte
+int	mf_pxsize, mf_pysize		# physical x, y size of bitmap, bits
+int	mf_wxsize, mf_wysize		# x, y size of bitmap window, bits
+int	mf_xorigin, mf_yorigin		# origin of bitmap window
+real	mf_xscale, mf_yscale		# to convert from NDC to device coords
+int	mf_xmin, mf_xmax		# x clipping limits
+int	mf_ymin, mf_ymax		# y clipping limits
+int	mf_lenframe			# frame size, words
+int	mf_linewidth			# relative line width
+int	mf_lworigin			# device width of line size 1.0
+real	mf_lwslope			# device pixels per line size increment
+int	mf_fbuf[LEN_FBUF]		# frame buffer (BIG)
+int	mf_bitmask[BPW]			# bit mask table
+int	mf_color			# color index
+
+common	/idkcom/ mf_fd, mf_frame, mf_op, mf_cx, mf_cy, mf_nbpb, mf_pxsize,
+	mf_pysize, mf_wxsize, mf_wysize, mf_xorigin, mf_yorigin, mf_xscale,
+	mf_yscale, mf_xmin, mf_xmax, mf_ymin, mf_ymax, mf_lenframe,
+	mf_linewidth, mf_lworigin, mf_lwslope, mf_fbuf, mf_bitmask, mf_color,
+	mf_obuf, mf_fname, mf_dispose
diff --git a/sys/gio/imdkern/idk.x b/sys/gio/imdkern/idk.x
new file mode 100644
index 00000000..4d711e12
--- /dev/null
+++ b/sys/gio/imdkern/idk.x
@@ -0,0 +1,509 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <chars.h>
+include <imhdr.h>
+include <gki.h>
+
+.help idk
+.nf ---------------------------------------------------------------------------
+IDK -- Simple image display graphics interface.  The purpose of this
+interface is to provide a means of drawing into a graphics overlay in
+an image display server via the IRAF data stream interface.  The
+interface works by rasterizing the GKI metacode, reading the display
+frame buffer, merging the graphics raster with the frame buffer, and
+writing back the raster to the frame buffer.
+
+       g_out = idk_open (frame, color, tty)	# device open
+	      idk_close (g_out)			# device close
+	      idk_flush (g_out)			# flush output
+
+	      idk_frame (g_out)			# start a new frame
+	       idk_move (g_out, x, y)		# move to (x,y)
+	       idk_draw (g_out, x, y)		# draw a vector to (x,y)
+	  idk_linewidth (g_out, width)		# set line width (>=1)
+
+The procedures comprising the top end of the IDK interface are summarized
+above and the code is included in this file.  These procedures could be
+rewritten by the user to talk directly to a graphics device if desired,
+although the metacode file interface is likely to be simpler in most cases.
+
+The size of the bitmap is taken from the size of the display frame
+buffer.  Values of the frame buffer are set to the specified color index
+for each set bitmap pixel.  The final displayed color depends on the
+display server.
+
+The following graphcap fields apply:
+
+	DB	have the kernel print debug messages during execution
+	LO	width in device pixels of a line of size 1.0
+	LS	difference in device pixels between line sizes
+	CI	color index, i.e., the frame buffer pixel value
+	FN	display frame number
+
+.endhelp ----------------------------------------------------------------------
+
+# NOTE -- The mf_physbit lookup table, used to map logical screen bits into
+# physical bits in the bitmap (for NB != 8) is equivalenced to the mf_obuf
+# array which is not otherwise used for bitmap devices.  The length of the
+# mf_obuf array must therefore be >= PX.
+
+define	mf_physbit	mf_obuf		# union these two arrays [[[NOTE]]]
+define	BPW		32		# nbits in an integer
+define	LEN_FBUF	(8192*8192/BPW)	# max size bitmap / frame buffer
+define	LEN_OBUF	8192		# max size of buffer line
+define	SZ_DDSTR	256		# max size graphcap.DD
+define	SZ_OSCMD	256		# OS dispose command from graphcap.DD
+define	IOLINES		64		# image lines per i/o transfer
+
+
+# IDK_OPEN -- Open the metacode file.  Open the frame buffer as an image.
+# Initialize the bitmap based on the size of the frame.
+
+int procedure idk_open (a_frame, a_color, tty)
+
+int	a_color			#I display device color index
+int	a_frame			#I display buffer frame number
+pointer	tty			#I pointer to graphcap descriptor
+
+real	x, y
+char	strval[1]
+int	byte, off, i, j
+int	wcs, key, frame, color
+
+bool	ttygetb()
+real	ttygetr()
+int	imd_mapframe(), ttygeti(), shifti(), imdrcur()
+errchk	imd_mapframe, ttygetr, ttygeti, ttygetb
+include	"idk.com"
+
+begin
+	frame = a_frame
+	color = a_color
+
+	# The DB flag may be set in the graphcap entry for an IMD device to
+	# print debug messages during execution.
+
+	mf_debug = ttygetb (tty, "DB")
+	if (mf_debug) {
+	    call eprintf ("idk: open frame %d, color = %d\n")
+		call pargi (frame)
+		call pargi (color)
+	}
+
+	mf_update = false
+	
+	# If the frame number was not specified as a parameter see if it is
+	# specified in the graphcap, else try to query the display to determine
+	# the current display frame and plot into that.
+
+	if (frame <= 0)
+	    iferr (frame = ttygeti (tty, "FN"))
+		frame = 0
+	if (frame <= 0)
+	    if (imdrcur ("stdimage", x, y, wcs, key, strval, 1, 0, NO) >= 0)
+		frame = max (1, wcs / 100)
+	    else
+		frame = 1
+
+	# Find the color index in graphcap?
+	if (color < 0)
+	    color = max(0, ttygeti (tty, "CI"))
+
+	# Map the frame buffer as an image.
+	mf_fd = imd_mapframe (frame, READ_WRITE, YES)
+
+	# Initialize bitmap parameters.
+	mf_pxsize   = IM_LEN(mf_fd, 1)
+	mf_pysize   = IM_LEN(mf_fd, 2)
+	mf_xorigin  = 0
+	mf_yorigin  = 0
+	mf_wxsize   = IM_LEN(mf_fd, 1) - 1
+	mf_wysize   = IM_LEN(mf_fd, 2) - 1
+	mf_nbpb     = 8
+
+	# Line width parameters.
+	mf_lworigin = max (1, ttygeti (tty, "LO"))
+	mf_lwslope  = ttygetr (tty, "LS")
+
+	# Size of the frame buffer.
+	mf_lenframe = (mf_pxsize * mf_pysize + BPW-1) / BPW
+
+	mf_color = color
+	mf_linewidth = mf_lworigin
+
+	# Initial "pen" position.
+	mf_cx = 0
+	mf_cy = 0
+
+	mf_xmin = mf_xorigin
+	mf_ymin = mf_yorigin
+	mf_xmax = mf_xmin + mf_wxsize
+	mf_ymax = mf_ymin + mf_wysize
+
+	mf_xscale = real(mf_wxsize) / real(GKI_MAXNDC)
+	mf_yscale = real(mf_wysize) / real(GKI_MAXNDC)
+
+	if (mf_lenframe > LEN_FBUF)
+	    call error (1, "imdkern: bitmap too large")
+
+	# Initialize the bit mask table.
+	do j = 1, (BPW/NBITS_BYTE)
+	    do i = 1, NBITS_BYTE {
+		off = (j - 1) * NBITS_BYTE
+		mf_bitmask[off+i] = shifti (1, off + NBITS_BYTE - i)
+	    }
+
+	# Initialize the bit offset lookup table.  This gives the physical
+	# x-offset into the lookup table of each addressable x-coordinate
+	# on the device.  If NB is NBITS_BYTE the mapping is one-to-one.
+	# Note that the table contains zero-indexed bit offsets.
+
+	do i = 1, mf_pxsize {
+	    byte = (i - 1) / mf_nbpb
+	    mf_physbit[i] = min (mf_pxsize,
+		byte * NBITS_BYTE + (i - (byte * mf_nbpb))) - 1
+	}
+
+	if (mf_debug) {
+	    call eprintf ("bitmap [%d,%d] origin=[%d,%d] wsize=[%d,%d]\n")
+		call pargi (mf_pxsize);  call pargi (mf_pysize)
+		call pargi (mf_xorigin); call pargi (mf_yorigin)
+		call pargi (mf_wxsize);  call pargi (mf_wysize)
+	}
+
+	return (mf_fd)
+end
+
+
+# IDK_CLOSE -- Update the display frame buffer and close the display.
+
+procedure idk_close (fd)
+
+int	fd			# output stream [NOT USED]
+
+errchk	idk_frame, imunmap
+include	"idk.com"
+
+begin
+	if (mf_debug)
+	    call eprintf ("close device\n")
+
+	call idk_frame (mf_fd)
+
+	if (mf_fd != NULL) {
+	    call imunmap (mf_fd)
+	    mf_fd = NULL
+	}
+end
+
+
+# IDK_FLUSH -- Flush any buffered metacode output.
+
+procedure idk_flush (fd)
+
+int	fd			# output stream [NOT USED]
+include	"idk.com"
+
+begin
+	if (mf_fd != NULL)
+	    call imflush (mf_fd)
+end
+
+
+# IDK_FRAME -- Output a frame.  Overlay the bitmap on the frame buffer.
+# Map the display frame as an image section and process the bitmap line by
+# line.
+
+procedure idk_frame (fd)
+
+int	fd			# output stream [NOT USED]
+
+int	x1, x2, y1, y2
+int	bmw			# Bitmap word offset
+int	npix			# Pixels in local I/O buffer
+int	fbp			# Frame buffer section offset
+int	fbp0
+int	i, j
+int	line
+pointer	ob, ib
+
+pointer	imps2s(), imgs2s()
+include	"idk.com"
+
+begin
+	# Ignore frame commands if frame is empty.
+	if (!mf_update)
+	    return
+
+	if (mf_debug) {
+	    call eprintf ("Write the frame, color = %d\n")
+		call pargi (mf_color)
+	}
+
+	# Write the bitmap to the output frame buffer.
+
+	y2 = 0
+	for (y1=1;  y2 < mf_pysize;  y1=y1+IOLINES) {
+	    # For each buffer section of the frame.
+	    y2 = min (y1 + IOLINES-1, mf_pysize)
+	    x1 = 1
+	    x2 = mf_pxsize
+
+	    # Map the frame section.
+	    ob = imps2s (mf_fd, x1, x2, y1, y2)
+	    ib = imgs2s (mf_fd, x1, x2, y1, y2)
+
+	    npix = mf_pxsize * (y2 - y1 + 1)
+
+	    if (ob != ib)
+		# Copy the input buffer to the output buffer
+		call amovs (Mems[ib], Mems[ob], npix)
+
+	    do line = y1, y2 {
+		# Each line in the local frame buffer section
+		fbp0 = (line - y1) * mf_pxsize
+
+		do i = 1, mf_pxsize / BPW {
+		    # Each word in the bitmap line.
+		    bmw = (line - 1) * mf_pxsize / BPW + i
+
+		    if (mf_fbuf[bmw] != 0) {
+			do j = 1, BPW {
+			    # Each bit in the bitmap word.
+
+			    if (and (mf_fbuf[bmw], mf_bitmask[j]) != 0) {
+				# An ON bit.
+				fbp = fbp0 + (i-1) * BPW + j
+				Mems[ob+fbp-1] = mf_color
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	mf_update = false
+end
+
+
+# IDK_MOVE -- Output a pen move instruction.
+
+procedure idk_move (fd, x, y)
+
+int	fd			# output stream [NOT USED]
+int	x, y			# point to move to
+
+include	"idk.com"
+
+begin
+	mf_cx = x
+	mf_cy = y
+
+	# Convert to zero indexed coordinates and clip at boundary.
+	# Allow room for line width shift near boundary.
+
+	mf_cx = max (mf_xmin, min (mf_xmax,
+	    int (mf_cx * mf_xscale) + mf_xorigin))
+	mf_cy = max (mf_ymin, min (mf_ymax,
+	    int (mf_cy * mf_yscale) + mf_yorigin))
+end
+
+
+# IDK_DRAW -- Output a pen draw instruction.
+
+procedure idk_draw (fd, a_x, a_y)
+
+int	fd			# output stream [NOT USED]
+int	a_x, a_y		# point to draw to
+
+int	xshift, yshift, dx, dy
+int	new_x, new_y, x1, y1, x2, y2, n, i
+include	"idk.com"
+
+begin
+	new_x = a_x
+	new_y = a_y
+
+	if (!mf_update) {
+	    # We are called when the first drawing instruction is output for a
+	    # new frame.  We clear the bitmap.
+
+	    # Zero out all the bits in a bitmap.
+	    call aclri (mf_fbuf, mf_lenframe)
+
+	    mf_update = true
+	}
+
+	# Convert to zero indexed coordinates and clip at boundary.
+	# Allow room for line width shift near boundary.
+
+	new_x = max (mf_xmin, min (mf_xmax,
+	    int (new_x * mf_xscale) + mf_xorigin))
+	new_y = max (mf_ymin, min (mf_ymax,
+	    int (new_y * mf_yscale) + mf_yorigin))
+
+	if (mf_linewidth <= 1)
+	    call idk_vector (mf_cx, mf_cy, new_x, new_y)
+	else {
+	    # Redraw the vector several times with small normal shifts to
+	    # produce a wider line.
+
+	    xshift = 0
+	    yshift = 0
+
+	    if (abs (new_x - mf_cx) > abs (new_y - mf_cy)) {
+		dx = 0
+		dy = 1
+	    } else {
+		dx = 1
+		dy = 0
+	    }
+
+	    do i = 1, mf_linewidth {
+		x1 = mf_cx + xshift
+		y1 = mf_cy + yshift
+		x2 = new_x + xshift
+		y2 = new_y + yshift
+
+		call idk_vector (x1, y1, x2, y2)
+
+		n = (i + 1) / 2
+		if (and (i, 1) == 0) {
+		    xshift =  dx * n
+		    yshift =  dy * n
+		} else {
+		    xshift = -dx * n
+		    yshift = -dy * n
+		}
+	    }
+	}
+
+	# Update the current pen position, and set the update flag so that
+	# the bitmap will be written to the output file.
+
+	mf_cx = new_x
+	mf_cy = new_y
+end
+
+
+# IDK_VECTOR -- Write a vector (line) of unit width into the bitmap.  The line
+# endpoints are expressed in physical device coordinates.
+
+procedure idk_vector (a_x1, a_y1, a_x2, a_y2)
+
+int	a_x1, a_y1			# start point of line
+int	a_x2, a_y2			# end point of line
+
+real	dydx, dxdy
+long	fbit, wbit, word
+int	wpln, mask, dx, dy, x, y, x1, y1, x2, y2, or()
+include	"idk.com"
+
+begin
+	x1 = a_x1; y1 = a_y1
+	x2 = a_x2; y2 = a_y2
+
+	dx = x2 - x1
+	dy = y2 - y1
+
+	if (abs(dx) > abs(dy)) {
+	    if (x1 > x2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dy == 0 && mf_nbpb == NBITS_BYTE) {
+		# Somewhat optimized code for the case of a horiz. vector.
+
+		fbit = y1 * mf_pxsize + x1
+		word = fbit / BPW
+		wbit = and (fbit, BPW-1)
+
+		do x = x1, x2 {
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		    wbit = wbit + 1
+		    if (wbit >= BPW) {
+			wbit = 0
+			word = word + 1
+		    }
+		}
+
+	    } else {
+		# The general case for a mostly-X vector.
+
+		dydx = real(dy) / real(dx)
+		do x = x1, x2 {
+		    y = int ((x - x1) * dydx) + y1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else if (dy != 0) {
+	    if (y1 > y2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dx == 0) {
+		# Optimized code for the case of a vertical vector.
+
+		fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+		word = fbit / BPW + 1
+		wbit = and (fbit, BPW-1)
+		wpln = (mf_pxsize + BPW-1) / BPW
+		mask = mf_bitmask[wbit+1]
+
+		do y = y1, y2 {
+		    mf_fbuf[word] = or (mf_fbuf[word], mask)
+		    word = word + wpln
+		}
+
+	    } else {
+		# The general case of a mostly-Y vector.
+
+		dxdy = real(dx) / real(dy)
+		do y = y1, y2 {
+		    x = int ((y - y1) * dxdy) + x1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else {
+	    # Plot a single point (dx=dy=0).
+
+	    fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+	    word = fbit / BPW
+	    wbit = and (fbit, BPW-1)
+	    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+	}
+end
+
+
+# IDK_LINEWIDTH -- Output a line width set instruction.
+
+procedure idk_linewidth (fd, width)
+
+int	fd			# output stream [NOT USED]
+int	width			# new line width
+
+int	gap
+include	"idk.com"
+
+begin
+	# Set the line width in device pixels.
+	mf_linewidth = max (1, mf_lworigin + int ((width-1) * mf_lwslope))
+
+	# Set the clipping limits.  Allow for shifting to widen lines.
+	gap = mf_linewidth / 2
+	mf_xmin = mf_xorigin + gap
+	mf_ymin = mf_yorigin + gap
+	mf_xmax = mf_xorigin + mf_wxsize - gap
+	mf_ymax = mf_yorigin + mf_wysize - gap
+end
diff --git a/sys/gio/imdkern/imd.com b/sys/gio/imdkern/imd.com
new file mode 100644
index 00000000..12cba65e
--- /dev/null
+++ b/sys/gio/imdkern/imd.com
@@ -0,0 +1,18 @@
+# IMD common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+int	g_frame, g_color		# display frame and graphics color
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/gioimd/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_frame, g_color, g_device
diff --git a/sys/gio/imdkern/imd.h b/sys/gio/imdkern/imd.h
new file mode 100644
index 00000000..a0e5d2d5
--- /dev/null
+++ b/sys/gio/imdkern/imd.h
@@ -0,0 +1,77 @@
+# IMD global definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The IMD state/device descriptor.
+
+define	LEN_IMD		81
+
+define	IMD_SBUF	Memi[$1]		# string buffer
+define	IMD_SZSBUF	Memi[$1+1]		# size of string buffer
+define	IMD_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	IMD_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	IMD_POLYLINE	Memi[$1+4]		# device supports polyline
+define	IMD_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	IMD_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	IMD_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	IMD_XRES	Memi[$1+8]		# device resolution in X
+define	IMD_YRES	Memi[$1+9]		# device resolution in Y
+define	IMD_ZRES	Memi[$1+10]		# device resolution in Z
+define	IMD_FILLSTYLE	Memi[$1+11]		# number of fill styles
+define	IMD_ROAM	Memi[$1+12]		# device supports roam
+define	IMD_ZOOM	Memi[$1+13]		# device supports zoom
+define	IMD_SELERASE	Memi[$1+14]		# device has selective erase
+define	IMD_PIXREP	Memi[$1+15]		# device supports pixel replic.
+define	IMD_STARTFRAME	Memi[$1+16]		# frame advance at metafile BOF
+define	IMD_ENDFRAME	Memi[$1+17]		# frame advance at metafile EOF
+	# extra space
+define	IMD_CURSOR	Memi[$1+20]		# last cursor accessed
+define	IMD_COLOR	Memi[$1+21]		# last color set
+define	IMD_TXSIZE	Memi[$1+22]		# last text size set
+define	IMD_TXFONT	Memi[$1+23]		# last text font set
+define	IMD_TYPE	Memi[$1+24]		# last line type set
+define	IMD_WIDTH	Memi[$1+25]		# last line width set
+define	IMD_DEVNAME	Memi[$1+26]		# name of open device
+define	IMD_FRAME	Memi[$1+27]		# frame buffer number
+	# extra space
+define	IMD_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	IMD_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	IMD_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	IMD_PLAP	($1+60)			# polyline attributes
+define	IMD_PMAP	($1+64)			# polymarker attributes
+define	IMD_FAAP	($1+68)			# fill area attributes
+define	IMD_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/imdkern/imdcancel.x b/sys/gio/imdkern/imdcancel.x
new file mode 100644
index 00000000..68832ae4
--- /dev/null
+++ b/sys/gio/imdkern/imdcancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CANCEL -- Cancel any buffered output.
+
+procedure imd_cancel (dummy)
+
+int	dummy			# not used at present
+include	"imd.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+	call imd_reset()
+end
diff --git a/sys/gio/imdkern/imdclear.x b/sys/gio/imdkern/imdclear.x
new file mode 100644
index 00000000..bf471998
--- /dev/null
+++ b/sys/gio/imdkern/imdclear.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"imd.h"
+
+# IMD_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure imd_clear (dummy)
+
+int	dummy			# not used at present
+
+int	idk_open()
+errchk	idk_open
+include	"imd.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by issuing the frame advance
+	# instruction or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (IMD_ENDFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+
+	    g_nframes = 0
+	    call idk_close (g_out)
+	    #g_out = idk_open (Memc[IMD_DEVNAME(g_kt)], g_tty)
+	    g_out = idk_open (g_frame, g_color, g_tty)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (IMD_STARTFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+
+	} else {
+	    # Merely output frame instruction to start a new frame in the same
+	    # metafile.
+
+	    call idk_frame (g_out)
+	}
+
+	# Init kernel data structures.
+	call imd_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/imdkern/imdclose.x b/sys/gio/imdkern/imdclose.x
new file mode 100644
index 00000000..7283f5db
--- /dev/null
+++ b/sys/gio/imdkern/imdclose.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CLOSE -- Close the IMD translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure imd_close()
+
+include	"imd.com"
+
+begin
+	# Check for a redundant imd_close call.
+	if (g_kt == NULL)
+	    return
+
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (IMD_ENDFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call idk_close (g_out)
+
+	# Return tty descriptor.
+	call ttycdes (g_tty)
+
+	# Free kernel data structures.
+	call mfree (IMD_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/imdkern/imdclws.x b/sys/gio/imdkern/imdclws.x
new file mode 100644
index 00000000..45072697
--- /dev/null
+++ b/sys/gio/imdkern/imdclws.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure imd_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "imd.com"
+
+begin
+	# For the IMD kernel, all display graphics writes are in append mode,
+	# so we may as well shutdown completely for closews (this also ensures
+	# that the display is updated at closews time).
+
+	#call idk_flush (g_out)
+	call imd_close()
+end
diff --git a/sys/gio/imdkern/imdcolor.x b/sys/gio/imdkern/imdcolor.x
new file mode 100644
index 00000000..581af9a2
--- /dev/null
+++ b/sys/gio/imdkern/imdcolor.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_COLOR -- Set line drawing color.
+
+procedure imd_color (index)
+
+int	index		# index for color switch statement
+include	"imd.com"
+
+begin
+	# switch (index) {
+	# case WHITE:
+	# case RED:
+	# case GREEN:
+	# case BLUE:
+	# default:
+	# }
+end
diff --git a/sys/gio/imdkern/imddrawch.x b/sys/gio/imdkern/imddrawch.x
new file mode 100644
index 00000000..17327563
--- /dev/null
+++ b/sys/gio/imdkern/imddrawch.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"imd.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# IMD_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure imd_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+int	mx, my
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+include	"imd.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call imd_font (font)
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call idk_move (g_out, mx, my)
+	    else
+		call idk_draw (g_out, mx, my)
+	}
+end
diff --git a/sys/gio/imdkern/imdescape.x b/sys/gio/imdkern/imdescape.x
new file mode 100644
index 00000000..2c2c3a26
--- /dev/null
+++ b/sys/gio/imdkern/imdescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMD_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The IDK kernel does not have any escape functions at present.
+
+procedure imd_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/imdkern/imdfa.x b/sys/gio/imdkern/imdfa.x
new file mode 100644
index 00000000..03bf446e
--- /dev/null
+++ b/sys/gio/imdkern/imdfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_FILLAREA -- Fill a closed area.
+
+procedure imd_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"imd.com"
+
+begin
+	# Not implemented yet.
+	call imd_polyline (p, npts)
+end
diff --git a/sys/gio/imdkern/imdfaset.x b/sys/gio/imdkern/imdfaset.x
new file mode 100644
index 00000000..b790cef9
--- /dev/null
+++ b/sys/gio/imdkern/imdfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_FASET -- Set the fillarea attributes.
+
+procedure imd_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"imd.com"
+
+begin
+	fa = IMD_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/imdkern/imdflush.x b/sys/gio/imdkern/imdflush.x
new file mode 100644
index 00000000..d22f04c9
--- /dev/null
+++ b/sys/gio/imdkern/imdflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_FLUSH -- Flush output.
+
+procedure imd_flush (dummy)
+
+int	dummy			# not used at present
+include	"imd.com"
+
+begin
+	call idk_flush (g_out)
+end
diff --git a/sys/gio/imdkern/imdfont.x b/sys/gio/imdkern/imdfont.x
new file mode 100644
index 00000000..3117258b
--- /dev/null
+++ b/sys/gio/imdkern/imdfont.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"imd.h"
+
+# IMD_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set IMD_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure imd_font (font)
+
+int	font			# code for font to be set
+int	pk2, width
+include	"imd.com"
+
+begin
+	width = IMD_WIDTH(g_kt)
+	pk2   = GKI_PACKREAL(2.0)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call idk_linewidth (g_out, 2)
+		width = pk2
+	    }
+	} else
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(width)))
+
+	IMD_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/imdkern/imdgcell.x b/sys/gio/imdkern/imdgcell.x
new file mode 100644
index 00000000..0c384d70
--- /dev/null
+++ b/sys/gio/imdkern/imdgcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMD_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure imd_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/imdkern/imdinit.x b/sys/gio/imdkern/imdinit.x
new file mode 100644
index 00000000..ceed3948
--- /dev/null
+++ b/sys/gio/imdkern/imdinit.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"imd.h"
+
+# IMD_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine IMD_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure imd_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"imd.com"
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_IMD, TY_STRUCT)
+	    call malloc (IMD_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile.
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	IMD_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	IMD_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	IMD_SZSBUF(g_kt) = SZ_SBUF
+	IMD_NEXTCH(g_kt) = IMD_SBUF(g_kt) + 1
+	Memc[IMD_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	IMD_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = IMD_NEXTCH(g_kt)
+
+	if (IMD_NCHARSIZES(g_kt) <= 0) {
+	    IMD_NCHARSIZES(g_kt) = 1
+	    IMD_CHARSIZE(g_kt,1) = 1.0
+	    IMD_CHARHEIGHT(g_kt,1) = char_height
+	    IMD_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= IMD_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		IMD_CHARSIZE(g_kt,i)   = char_size
+		IMD_CHARHEIGHT(g_kt,i) = char_height * char_size
+		IMD_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	IMD_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	IMD_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	IMD_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	IMD_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	IMD_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	IMD_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	IMD_XRES(g_kt)	     =       ttygeti (tty, "xr")
+	IMD_YRES(g_kt)	     =       ttygeti (tty, "yr")
+	IMD_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	IMD_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	IMD_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	IMD_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	IMD_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = IMD_NEXTCH(g_kt)
+	IMD_DEVNAME(g_kt) = nextch
+	maxch = IMD_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	IMD_NEXTCH(g_kt) = nextch
+end
+
+
+# IMD_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure imd_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"imd.com"
+
+begin
+	nextch = IMD_NEXTCH(g_kt)
+	maxch = IMD_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = IMD_SBUF(g_kt)
+
+	IMD_NEXTCH(g_kt) = nextch
+	return (strp)
+end
diff --git a/sys/gio/imdkern/imdline.x b/sys/gio/imdkern/imdline.x
new file mode 100644
index 00000000..86f32c0a
--- /dev/null
+++ b/sys/gio/imdkern/imdline.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"imd.h"
+
+# IMD_LINETYPE -- Set the line type option.
+
+procedure imd_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"imd.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    linetype = 0
+	case GL_DASHED:
+	    linetype = 2
+	case GL_DOTTED:
+	    linetype = 3
+	case GL_DOTDASH:
+	    linetype = 4
+	default:
+	    linetype = 1		# solid
+	}
+
+	# This will be done in software in a future version of the IMD kernel.
+	# call idk_linetype (g_out, linetype)
+end
diff --git a/sys/gio/imdkern/imdopen.x b/sys/gio/imdkern/imdopen.x
new file mode 100644
index 00000000..2a563360
--- /dev/null
+++ b/sys/gio/imdkern/imdopen.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_OPENDEV -- Install the IMD kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure imd_opendev (devname, frame, color, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	frame			# display frame buffer number
+int	color			# graphics overlay color index
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	imd_openws(), imd_closews(), imd_clear(), imd_cancel()
+extern	imd_flush(), imd_polyline(), imd_polymarker(), imd_text()
+extern	imd_fillarea(), imd_putcellarray(), imd_plset()
+extern	imd_pmset(), imd_txset(), imd_faset()
+extern	imd_escape()
+include	"imd.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	g_frame = frame
+	g_color = color
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (imd_openws)
+	dd[GKI_CLOSEWS]		= locpr (imd_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (imd_clear)
+	dd[GKI_CANCEL]		= locpr (imd_cancel)
+	dd[GKI_FLUSH]		= locpr (imd_flush)
+	dd[GKI_POLYLINE]	= locpr (imd_polyline)
+	dd[GKI_POLYMARKER]	= locpr (imd_polymarker)
+	dd[GKI_TEXT]		= locpr (imd_text)
+	dd[GKI_FILLAREA]	= locpr (imd_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (imd_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (imd_plset)
+	dd[GKI_PMSET]		= locpr (imd_pmset)
+	dd[GKI_TXSET]		= locpr (imd_txset)
+	dd[GKI_FASET]		= locpr (imd_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (imd_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call imd_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/imdopenws.x b/sys/gio/imdkern/imdopenws.x
new file mode 100644
index 00000000..cdfaeee0
--- /dev/null
+++ b/sys/gio/imdkern/imdopenws.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"imd.h"
+
+# IMD_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure imd_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	idk_open()
+bool	need_open, same_dev
+include	"imd.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[IMD_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (IMD_ENDFRAME(g_kt) == YES)
+		    call idk_frame (g_out)
+		call idk_close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call imd_init (g_tty, Memc[buf])
+		call imd_reset()
+	    }
+
+	    # Open the output file.  Metacode output to the device will be
+	    # spooled and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = idk_open (g_frame, g_color, g_tty)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (IMD_STARTFRAME(g_kt) == YES)
+		    call idk_frame (g_out)
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call imd_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/imdpcell.x b/sys/gio/imdkern/imdpcell.x
new file mode 100644
index 00000000..deb61d18
--- /dev/null
+++ b/sys/gio/imdkern/imdpcell.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+define	DEF_YRES	8192	# default height of device pixel in GKI units
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# IMD_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure imd_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+bool	ttygetb()
+include	"imd.com"
+
+begin
+	if (ttygetb (g_tty, "BI"))
+	    call imd_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+	else
+	    call imd_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+end
+
+
+# IMD_BCELL -- Put cell array, optimized for a bitmap device.  In this case,
+# to get the maximum resolution at maximum efficiency it is desirable for the
+# main loop to be over device pixels, mapping the device pixel into the
+# nearest line of the input cell array.
+
+procedure imd_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"imd.com"
+int	and()
+
+begin
+	# Count drawing instruction, set polyline width to 1 for max y-res.
+	g_ndraw = g_ndraw + 1
+	call idk_linewidth (g_out, 1)
+	IMD_WIDTH(g_kt) = 0
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	if (IMD_YRES(g_kt) <= 0)
+	    dy = GKI_MAXNDC / DEF_YRES
+	else
+	    dy = max (1.0, real(GKI_MAXNDC) / real(IMD_YRES(g_kt)))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call idk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call idk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
+
+
+# IMD_MCELL -- Put cell array, optimized for a metafile device.  In this case,
+# it is prohibitively expensive to draw into each resolvable line of the
+# output device.  It is better to set the linewidth to the width of a cell
+# array pixel, output the minimum number of drawing instructions, and let the
+# metafile device widen the lines.
+
+procedure imd_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	yres, my, i1, i2, v, i, j
+include	"imd.com"
+int	and()
+
+begin
+	# Count drawing instruction, clobber saved polyline width.
+	g_ndraw = g_ndraw + 1
+	IMD_WIDTH(g_kt) = 0
+
+	# Determine the width and height of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+	dy = real (ay2 - ay1) / ny
+
+	# Set the IDK line width to the height of a pixel in the cell array.
+	yres = IMD_YRES(g_kt)
+	if (yres <= 0)
+	    yres = DEF_YRES
+	call idk_linewidth (g_out,
+	    max (1, nint (dy / (real(GKI_MAXNDC) / real(yres)))))
+
+	# Process the cell array.  The outer loop runs over lines of the input
+	# cell array; each iteration writes only one line of the output raster,
+	# but the width of the line is adjusted to the height of a pixel in
+	# the cell array (the resolution of the cell array should not exceed
+	# that of the device).
+
+	for (j=1;  j <= ny;  j=j+1) {
+	    my = int ((j - 0.5) * dy) + ay1
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call idk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call idk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+	}
+end
diff --git a/sys/gio/imdkern/imdpl.x b/sys/gio/imdkern/imdpl.x
new file mode 100644
index 00000000..7c94f7d2
--- /dev/null
+++ b/sys/gio/imdkern/imdpl.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"imd.h"
+
+define	MAX_LTYPES	3	# max software line type patterns (excl. solid)
+define	MAX_LSEGMENTS	4	# max line segments per pattern
+define	LT_OFFSET	1	# offset to be subtracted from ltype code
+
+
+# IMD_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure imd_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	x, y
+int	len_p, i
+include	"imd.com"
+
+begin
+	if (npts < 2)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = IMD_PLAP(g_kt)
+
+	if (IMD_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(PL_WIDTH(pl))))
+	    IMD_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (IMD_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call imd_color (PL_COLOR(pl))
+	    IMD_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	if (PL_LTYPE(pl) == GL_CLEAR) {
+	    # Ignore clear (erase) polylines.
+	    ;
+
+	} else if (PL_LTYPE(pl) != GL_SOLID) {
+	    # Draw a dashed or dotted polyline of the indicated type.
+	    call imd_dashline (g_out, p, npts, PL_LTYPE(pl))
+
+	} else {
+	    # Draw a solid polyline (usual case, optimized).
+
+	    # Move to the first point.
+	    x = p[1]
+	    y = p[2]
+	    call idk_move (g_out, x, y)
+
+	    # Draw the polyline.
+	    for (i=3;  i <= len_p;  i=i+2) {
+		x = p[i]
+		y = p[i+1]
+		call idk_draw (g_out, x, y)
+	    }
+	}
+end
+
+
+# IMD_DASHLINE -- Draw a dashed or dotted polyline using the indicated line
+# style.
+
+procedure imd_dashline (g_out, p, npts, ltype)
+
+int	g_out			# output file
+short	p[ARB]			# the polyline points
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# desired line type
+
+bool	penup
+int	len_p, i
+real	vlen, vpos, seglen, dx, dy
+int	oldx, oldy, newx, newy, penx, peny
+int	imd_getseg()
+
+begin
+	len_p = npts * 2
+
+	oldx = p[1]; oldy = p[2]
+	call idk_move (g_out, oldx, oldy)
+
+	# Process each line segment in the polyline.
+	do i = 3, len_p, 2 {
+	    newx = p[i]
+	    newy = p[i+1]
+
+	    # Compute VLEN, the length of the polyline line segment to be
+	    # drawn, VPOS, the relative position along the line segment,
+	    # and DX and DY, the scale factors to be applied to VPOS to get
+	    # the x and y coordinates of a point along the line segment.
+
+	    dx = newx - oldx
+	    dy = newy - oldy
+	    vlen = sqrt (dx*dx + dy*dy)
+	    if (vlen < 1.0)			# GKI units
+		next
+
+	    dx = dx / vlen
+	    dy = dy / vlen
+	    vpos = 0.0
+
+	    # For each line segment, get segments of the line type pattern
+	    # until all of the current line segment has been drawn.  The pattern
+	    # wraps around indefinitely, following the polyline around the
+	    # vertices with concern only for the total length traversed.
+
+	    while (vlen - vpos >= 1.0) {
+		seglen = imd_getseg (int (vlen - vpos), penup, ltype)
+		if (seglen < 1.0)
+		    break
+
+		vpos = vpos + seglen
+		penx = oldx + vpos * dx
+		peny = oldy + vpos * dy
+
+		if (penup)
+		    call idk_move (g_out, penx, peny)
+		else
+		    call idk_draw (g_out, penx, peny)
+	    }
+
+	    oldx = newx
+	    oldy = newy
+	}
+end
+
+
+# IMD_GETSEG -- Get a segment of a line style pattern.  The segment extends
+# from the current position in the pattern to either the next penup/pendown
+# breakpoint in the pattern, or to the point MAXLEN units further along in
+# the pattern.  When the end of the pattern is reached wrap around and
+# duplicate the pattern indefinitely.
+
+int procedure imd_getseg (maxlen, penup, ltype)
+
+int	maxlen			# max length segment to be returned
+bool	penup			# [out] pen up or pen down type segment?
+int	ltype			# line type code
+
+int	seglen, seg, lt
+int	p_seg[MAX_LTYPES]
+int	p_nseg[MAX_LTYPES]
+int	p_segleft[MAX_LTYPES]
+bool	p_penup[MAX_LTYPES,MAX_LSEGMENTS]
+int	p_seglen[MAX_LTYPES,MAX_LSEGMENTS]
+include	"ltype.dat"
+
+begin
+	lt = max (1, min (MAX_LTYPES, ltype - LT_OFFSET))
+	seg = p_seg[lt]
+	penup = p_penup[lt,seg]
+
+	repeat {
+	    if (maxlen < p_segleft[lt]) {
+		seglen = maxlen
+		p_segleft[lt] = p_segleft[lt] - seglen
+	    } else {
+		seglen = p_segleft[lt]
+		seg = seg + 1
+		if (seg > p_nseg[lt])
+		    seg = 1
+		p_seg[lt] = seg
+		p_segleft[lt] = p_seglen[lt,seg]
+	    }
+	} until (seglen > 0)
+
+	return (seglen)
+end
diff --git a/sys/gio/imdkern/imdplset.x b/sys/gio/imdkern/imdplset.x
new file mode 100644
index 00000000..22743178
--- /dev/null
+++ b/sys/gio/imdkern/imdplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure imd_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"imd.com"
+
+begin
+	pl = IMD_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/imdkern/imdpm.x b/sys/gio/imdkern/imdpm.x
new file mode 100644
index 00000000..d7bcddac
--- /dev/null
+++ b/sys/gio/imdkern/imdpm.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"imd.h"
+
+# IMD_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure imd_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"imd.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = IMD_PMAP(g_kt)
+
+	if (IMD_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call imd_linetype (PM_LTYPE(pm))
+	    IMD_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (IMD_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(PM_WIDTH(pm))))
+	    IMD_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (IMD_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call imd_color (PM_COLOR(pm))
+	    IMD_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	oldx = 0; oldy = 0
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx || y != oldy) {
+		call idk_move (g_out, x, y)
+		call idk_draw (g_out, x, y)
+	    }
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/imdkern/imdpmset.x b/sys/gio/imdkern/imdpmset.x
new file mode 100644
index 00000000..6912ef97
--- /dev/null
+++ b/sys/gio/imdkern/imdpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_PMSET -- Set the polymarker attributes.
+
+procedure imd_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"imd.com"
+
+begin
+	pm = IMD_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/imdkern/imdreset.x b/sys/gio/imdkern/imdreset.x
new file mode 100644
index 00000000..fa830e4d
--- /dev/null
+++ b/sys/gio/imdkern/imdreset.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"imd.h"
+
+# IMD_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure imd_reset()
+
+pointer	pl, pm, fa, tx
+include	"imd.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = IMD_PLAP(g_kt)
+	pm = IMD_PMAP(g_kt)
+	fa = IMD_FAAP(g_kt)
+	tx = IMD_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	IMD_TYPE(g_kt)		= -1
+	IMD_WIDTH(g_kt)		= -1
+	IMD_COLOR(g_kt)		= -1
+	IMD_TXSIZE(g_kt)	= -1
+	IMD_TXFONT(g_kt)	= -1
+end
diff --git a/sys/gio/imdkern/imdtx.x b/sys/gio/imdkern/imdtx.x
new file mode 100644
index 00000000..afe6c50c
--- /dev/null
+++ b/sys/gio/imdkern/imdtx.x
@@ -0,0 +1,430 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"imd.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# IMD_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure imd_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen 
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment()
+include	"imd.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = IMD_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by imd_txset, and is just a scaling factor.
+
+	IMD_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != IMD_COLOR(g_kt)) {
+	    call imd_color (TX_COLOR(tx))
+	    IMD_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line.
+	if (IMD_TYPE(g_kt) != GL_SOLID) {
+	    call imd_linetype (GL_SOLID)
+	    IMD_TYPE(g_kt) = GL_SOLID
+	}
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# No discreet character sizes, so just scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = IMD_CHARHEIGHT(g_kt,1) * tsz
+	cw = IMD_CHARWIDTH(g_kt,1) * tsz
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call imd_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"imd.com"
+
+begin
+	tx = IMD_TXAP(g_kt)
+
+	# Get character sizes in GKI coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = IMD_CHARHEIGHT(g_kt,1) * sz
+	cw = IMD_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/imdkern/imdtxset.x b/sys/gio/imdkern/imdtxset.x
new file mode 100644
index 00000000..9479fbdd
--- /dev/null
+++ b/sys/gio/imdkern/imdtxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"imd.h"
+
+# IMD_TXSET -- Set the text drawing attributes.
+
+procedure imd_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"imd.com"
+
+begin
+	tx = IMD_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/imdkern/ltype.dat b/sys/gio/imdkern/ltype.dat
new file mode 100644
index 00000000..caae0c18
--- /dev/null
+++ b/sys/gio/imdkern/ltype.dat
@@ -0,0 +1,28 @@
+# LTYPE.DAT -- Initialize the builtin line types for the IMD kernel.  Data
+# is given in GKI units (1.0 = 32768 units).  A segment of 32 GKI units is
+# resolved on a device with 1024 resolved pixels.
+
+data	p_seg		/1, 1, 1/
+data	p_segleft	/320, 32, 512/
+
+data	p_nseg[1]	/2/		# PL_DASHED
+data	p_penup[1,1]	/false/
+data	p_penup[1,2]	/true/
+data	p_seglen[1,1]	/320/
+data	p_seglen[1,2]	/128/
+
+data	p_nseg[2]	/2/		# PL_DOTTED
+data	p_penup[2,1]	/false/
+data	p_penup[2,2]	/true/
+data	p_seglen[2,1]	/32/
+data	p_seglen[2,2]	/128/
+
+data	p_nseg[3]	/4/		# PL_DOTDASH
+data	p_penup[3,1]	/false/
+data	p_penup[3,2]	/true/
+data	p_penup[3,3]	/false/
+data	p_penup[3,4]	/true/
+data	p_seglen[3,1]	/512/
+data	p_seglen[3,2]	/128/
+data	p_seglen[3,3]	/32/
+data	p_seglen[3,4]	/128/
diff --git a/sys/gio/imdkern/mkpkg b/sys/gio/imdkern/mkpkg
new file mode 100644
index 00000000..03581bff
--- /dev/null
+++ b/sys/gio/imdkern/mkpkg
@@ -0,0 +1,50 @@
+# Make the GIO/IMDKERN image display device graphics kernel.
+
+$checkout libimd.a lib$
+$update   libimd.a
+$checkin  libimd.a lib$
+$call     relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:	
+	$omake  x_imdkern.x
+	$link	x_imdkern.o -limd -lds -lstg -o xx_imdkern.e
+	;
+
+install:
+	$move	xx_imdkern.e bin$x_imdkern.e
+	;
+
+libimd.a:
+	idk.x		idk.com <chars.h> <gki.h> <imhdr.h> <mach.h>
+	imdcancel.x	imd.com imd.h
+	imdclear.x	imd.com imd.h <mach.h>
+	imdclose.x	imd.com imd.h
+	imdclws.x	imd.h imd.com
+	imdcolor.x	imd.com imd.h
+	imddrawch.x	font.com font.h imd.com imd.h <gki.h> <gset.h> <math.h>
+	imdescape.x	
+	imdfa.x		imd.com imd.h
+	imdfaset.x	imd.com imd.h <gki.h>
+	imdflush.x	imd.com imd.h
+	imdfont.x	imd.com imd.h <gki.h> <gset.h>
+	imdgcell.x	
+	imdinit.x	imd.com imd.h <ctype.h> <gki.h> <mach.h>
+	imdline.x	imd.com imd.h <gset.h>
+	imdopen.x	imd.com imd.h <gki.h>
+	imdopenws.x	imd.com imd.h <error.h> <gki.h> <mach.h>
+	imdpcell.x	imd.com imd.h <gki.h>
+	imdpl.x		imd.com imd.h ltype.dat <gki.h> <gset.h>
+	imdplset.x	imd.com imd.h <gki.h>
+	imdpm.x		imd.com imd.h <gki.h>
+	imdpmset.x	imd.com imd.h <gki.h>
+	imdreset.x	imd.com imd.h <gset.h> <gki.h>
+	imdtx.x		imd.com imd.h <gki.h> <gset.h> <math.h>
+	imdtxset.x	imd.com imd.h <gki.h> <gset.h>
+	t_imdkern.x	<error.h> <gki.h>
+	;
diff --git a/sys/gio/imdkern/t_imdkern.x b/sys/gio/imdkern/t_imdkern.x
new file mode 100644
index 00000000..ebca44bf
--- /dev/null
+++ b/sys/gio/imdkern/t_imdkern.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# IMDKERN -- Graphics kernel for an image display frame buffer using the
+# data stream interface.  The package is based on the SGI kernel.
+
+procedure t_imdkern()
+
+int	fd, list, dbfd
+pointer	gki, sp, fname, devname, dbfname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+int	color, frame
+
+bool	clgetb()
+int	clgeti(), envfind()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (dbfname, SZ_PATHNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Set parameter defaults.
+	debug = NO
+	verbose = NO
+	gkiunits = NO
+	frame = -1
+	color = -1
+
+	# Check for global kernel debug flag.
+	if (envfind ("idkdebug", Memc[dbfname], SZ_PATHNAME) > 0)
+	    iferr (dbfd = open (Memc[dbfname], APPEND, TEXT_FILE)) {
+		debug = NO
+		dbfd = 0
+	    } else
+		debug = YES
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (!clgetb ("generic")) {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	    frame = clgeti ("frame")
+	    color = clgeti ("color")
+	}
+
+	if (debug == YES && dbfd == 0)
+	    dbfd = STDERR
+
+	# Open the graphics kernel.
+	call imd_opendev (Memc[devname], frame, color, dev)
+	call gkp_install (deb, dbfd, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES) {
+		    call gki_execute (Mems[gki], deb)
+		    call flush (dbfd)
+		}
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call imd_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/x_imdkern.x b/sys/gio/imdkern/x_imdkern.x
new file mode 100644
index 00000000..3cc14388
--- /dev/null
+++ b/sys/gio/imdkern/x_imdkern.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	imdkern		= t_imdkern
diff --git a/sys/gio/markers.inc b/sys/gio/markers.inc
new file mode 100644
index 00000000..ef3a540f
--- /dev/null
+++ b/sys/gio/markers.inc
@@ -0,0 +1,71 @@
+# Data declarations for the standard markers.
+
+real	mpx[86], mpy[86]	# marker polyline points
+int	moff[9]	 		# offsets of the markers in mpx and mpy
+int	mnpts[9]		# number of points in each polyline
+int	k			# implied do-loop dummy index
+
+# Box.
+data	(mpx(k),k=01,05) /0.0, 1.0, 1.0, 0.0, 0.0/
+data	(mpy(k),k=01,05) /0.0, 0.0, 1.0, 1.0, 0.0/
+data	moff[1] /1/, mnpts[1] /5/
+
+# Plus.
+data	(mpx(k),k=06,10) /0.5, 0.5, 0.5, 0.0, 1.0/
+data	(mpy(k),k=06,10) /0.0, 1.0, 0.5, 0.5, 0.5/
+data	moff[2] /6/, mnpts[2] /5/
+
+# Cross.
+data	(mpx(k),k=11,15) /0.0, 1.0, 0.5, 0.0, 1.0/
+data	(mpy(k),k=11,15) /0.0, 1.0, 0.5, 1.0, 0.0/
+data	moff[3] /11/, mnpts[3] /5/
+
+# Diamond.
+data	(mpx(k),k=16,20) /0.5, 1.0, 0.5, 0.0, 0.5/
+data	(mpy(k),k=16,20) /0.0, 0.5, 1.0, 0.5, 0.0/
+data	moff[4] /16/, mnpts[4] /5/
+
+# Horizonal line.
+data	(mpx(k),k=21,22) /0.0, 1.0/
+data	(mpy(k),k=21,22) /0.5, 0.5/
+data	moff[5] /21/, mnpts[5] /2/
+
+# Vertical line.
+data	(mpx(k),k=23,24) /0.5, 0.5/
+data	(mpy(k),k=23,24) /0.0, 1.0/
+data	moff[6] /23/, mnpts[6] /2/
+
+# Horizontal error bar.
+data	(mpx(k),k=25,30) /0.0, 0.0, 0.0, 1.0, 1.0, 1.0/
+data	(mpy(k),k=25,30) /0.0, 1.0, 0.5, 0.5, 1.0, 0.0/
+data	moff[7] /25/, mnpts[7] /6/
+
+# Vertical error bar.
+data	(mpx(k),k=31,36) /0.0, 1.0, 0.5, 0.5, 1.0, 0.0/
+data	(mpy(k),k=31,36) /0.0, 0.0, 0.0, 1.0, 1.0, 1.0/
+data	moff[8] /31/, mnpts[8] /6/
+
+# Circle.
+data	(mpx(k),k=37,41) /1.000, 0.996, 0.984, 0.963, 0.936/	# X
+data	(mpx(k),k=42,46) /0.901, 0.859, 0.812, 0.759, 0.702/
+data	(mpx(k),k=47,51) /0.642, 0.580, 0.516, 0.452, 0.389/
+data	(mpx(k),k=52,56) /0.327, 0.269, 0.214, 0.164, 0.119/
+data	(mpx(k),k=57,61) /0.081, 0.050, 0.025, 0.009, 0.001/
+data	(mpx(k),k=62,66) /0.001, 0.009, 0.025, 0.050, 0.081/
+data	(mpx(k),k=67,71) /0.119, 0.164, 0.214, 0.269, 0.327/
+data	(mpx(k),k=72,76) /0.389, 0.452, 0.516, 0.580, 0.642/
+data	(mpx(k),k=77,81) /0.702, 0.759, 0.812, 0.859, 0.901/
+data	(mpx(k),k=82,86) /0.936, 0.963, 0.984, 0.996, 1.000/
+
+data	(mpy(k),k=37,41) /0.500, 0.564, 0.627, 0.688, 0.745/	# Y
+data	(mpy(k),k=42,46) /0.799, 0.848, 0.891, 0.928, 0.957/
+data	(mpy(k),k=47,51) /0.979, 0.994, 1.000, 0.998, 0.987/
+data	(mpy(k),k=52,56) /0.969, 0.943, 0.910, 0.870, 0.824/
+data	(mpy(k),k=57,61) /0.773, 0.717, 0.658, 0.596, 0.532/
+data	(mpy(k),k=62,66) /0.468, 0.404, 0.342, 0.283, 0.227/
+data	(mpy(k),k=67,71) /0.176, 0.130, 0.090, 0.057, 0.031/
+data	(mpy(k),k=72,76) /0.013, 0.002, 0.000, 0.006, 0.021/
+data	(mpy(k),k=77,81) /0.043, 0.072, 0.109, 0.152, 0.201/
+data	(mpy(k),k=82,86) /0.255, 0.312, 0.373, 0.436, 0.500/
+
+data	moff[9] /37/, mnpts[9] /50/
diff --git a/sys/gio/mkpkg b/sys/gio/mkpkg
new file mode 100644
index 00000000..b09ae3cd
--- /dev/null
+++ b/sys/gio/mkpkg
@@ -0,0 +1,140 @@
+# Make the GIO package.
+
+$checkout libex.a lib$			# default: update libex.a
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+# UPDATE --  Relink and install all graphics kernels.
+
+update:
+	@stdgraph
+	@sgikern
+	@imdkern
+	$ifeq (USE_NSPP,    yes) @nsppkern $endif
+	$ifeq (USE_CALCOMP, yes) @calcomp  $endif
+	;
+
+
+# The following redirect sys$mkpkg to the appropriate subdirectories to
+# update the libraries therein.
+
+libcur.a:
+	@cursor
+	;
+libgks.a:
+	@gks
+	;
+libncar.a:
+	@ncarutil
+	;
+libnspp.a:
+	@nspp
+	;
+libstg.a:
+	@stdgraph
+	;
+libsgi.a:
+	@sgikern
+	;
+libimd.a:
+	@imdkern
+	;
+libgkt.a:
+	@nsppkern
+	;
+libccp.a:
+	@calcomp
+	;
+
+
+# GIO portion of LIBEX.
+
+libex.a:
+	$ifeq (USE_GENERIC, yes)
+	    $ifolder (gtickr.x, gtick.gx)
+		$generic -k -t r gtick.gx
+	    $endif
+	$endif
+
+	@glabax
+	@gki
+	@gim
+
+	aelogd.x	
+	aelogr.x	
+	elogd.x	
+	elogr.x	
+	fpequald.x	<mach.h>
+	fpequalr.x	<mach.h>
+	fpfixd.x	<mach.h>
+	fpfixr.x	<mach.h>
+	fpndgr.x	
+	fpnormd.x	<mach.h>
+	fpnormr.x	<mach.h>
+	gactivate.x	<fset.h> <knet.h> <gio.h> <gset.h>
+	gadraw.x	gpl.com <gio.h> <gki.h>
+	gamove.x	gpl.com <gio.h> <gki.h>
+	gascale.x	<gio.h>
+	gcancel.x	<gio.h>
+	gclear.x	<gio.h> <gset.h>
+	gclose.x	<gio.h>
+	gctran.x	<gio.h>
+	gcurpos.x	gpl.com <gio.h> <gki.h>
+	gdeact.x	<gio.h> <gset.h>
+	gescape.x	<gio.h>
+	gfill.x		<gio.h>
+	gflush.x	<gio.h>
+	gframe.x	<gio.h>
+	gfrinit.x	<gio.h>
+	ggcell.x	gpl.com <gio.h>
+	ggcur.x		<gio.h> <gki.h>
+	ggetb.x		<gio.h>
+	ggeti.x		<gio.h>
+	ggetr.x		<gio.h>
+	ggets.x		<gio.h>
+	ggscale.x	<gio.h>
+	ggview.x	<gio.h>
+	ggwind.x	<gio.h>
+	gline.x	
+	gmark.x		markers.inc <gio.h> <gset.h>
+	gmftitle.x	<gio.h>
+	gmprintf.x
+	gmsg.x		<gio.h> <chars.h> <fset.h> <mach.h>
+	gopen.x		<error.h> <gio.h> <gset.h> <knet.h> <gki.h>
+	gpagefile.x	<error.h> <gset.h> <gio.h>
+	gpcell.x	gpl.com <gio.h>
+	gplcache.x	gpl.com <gio.h> <gki.h>
+	gplcancel.x	gpl.com <gio.h>
+	gplflush.x	gpl.com <gio.h> <gki.h>
+	gpline.x	
+	gploto.x	
+	gplotv.x	
+	gplreset.x	gpl.com <gio.h>
+	gplstype.x	gpl.com <gio.h>
+	gpmark.x	<gio.h> <gset.h>
+	gqverify.x	<fset.h>
+	grdraw.x	<gio.h>
+	grdwcs.x	<ctype.h>
+	greact.x	<gio.h> <gset.h>
+	greset.x	<gio.h> <gset.h> <mach.h>
+	grmove.x	<gio.h>
+	grscale.x	<gio.h>
+	gscan.x	
+	gscur.x		<gio.h>
+	gseti.x	
+	gsetr.x		<gio.h> <gset.h> <mach.h>
+	gsets.x		<gio.h> <gset.h>
+	gstati.x	
+	gstatr.x	<gio.h> <gset.h> <mach.h>
+	gstats.x	<gio.h> <gset.h>
+	gsview.x	<gio.h>
+	gswind.x	<gio.h>
+	gtext.x		<gio.h>
+	gtickr.x	<mach.h>
+	gtxset.x	<ctype.h> <gio.h> <gset.h>
+	gumark.x	<gio.h> <mach.h>
+	gvline.x	
+	gvmark.x	<gio.h> <gset.h>
+	wcstogki.x	gpl.com <gio.h> <gki.h>
+	;
diff --git a/sys/gio/ncarutil/README b/sys/gio/ncarutil/README
new file mode 100644
index 00000000..6ae35023
--- /dev/null
+++ b/sys/gio/ncarutil/README
@@ -0,0 +1,219 @@
+Directory gio$ncarutil, with subdirectories conlib, autograph and sysint, 
+contains the source code for the GKS based NCAR plotting utilities library.
+The first public release of this software was installed in IRAF 10SEP86.
+(The 3 previous installations of the NCAR Utilities were the result of NOAO
+serving as a Beta release test site.)  What follows is the Notes files from
+the installation :
+
+******************************************************************************
+Notes for installation of the NCAR GKS based plotting utilities.  This
+release marks the end of NCAR's beta testing and is the first public release
+of the new software.  The changes made at NOAO have been merged into the
+new source code; these changes have are marked with "+/- NOAO."  The IRAF
+installed NCAR library differs from the version released on tape as documented
+below.  Installation was begun September 2, 1986.  (S. Hammond)
+
+Subdirectory AUTOGRAPH --
+
+autograph/agback.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agcurv.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agdflt.f:
+    This is the block data, which has been completely rewritten as
+    initialization statements instead of data statements.
+autograph/agexax.f:
+    A ftn write statement has been commented out.
+autograph/agppid.f:
+    A string is written with f77upk/pstr instead of a ftn write statement.
+autograph/agrstr.f:
+    Binary read, completely commented out.
+autograph/agsave.f:
+    Binary write (opposite of agrstr.f), completely commented out.
+autograph/agscan.f:
+    Calls blockdata agdflt as run time subroutine.
+    A ftn write statement has been commented out.
+autograph/agsetp.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agstup.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/ezmxy.f, ezmy.f, ezxy.f, ezy.f:
+    These four subroutines require identical changes:
+	Call blockdata agdflt as run time subroutine upon entering;
+	Call subroutine initag before returning.
+autograph/idiot.f:
+    Call blockdata adgflt as run time subroutine.
+    Call plotit and initut to reinitialize before returning.
+autograph/pstr.x:
+    This file is not on the distribution tape, it was written to
+    output strings that have been unpacked by f77upk.
+
+Subdirectory CONLIB --
+
+conlib/conecd.f:
+    Character variables IT and CHTMP are not used and so are commented out.
+    The FTN internal writes are rewritten as calls to encode.
+conlib/congen.f:
+    FTN internal write replaced with call to encode.
+conlib/conop1.f,conop2.f,conop3.f,conop4.f:
+    These four routines now call blockdata conbdn as run time initialization.
+conlib/conout.f, conot2.f:
+    Both these routines are no-ops in IRAF.  All statements have been commented
+    out.
+conlib/conpdv.f:
+    FTN internal write replaced with a call to encode.
+conlib/conssd.f:
+    FTN write and format statement commented out.
+conlib/contng.f:
+    FTN internal writes rewritten as calls to encode.
+
+
+Directory NCARUTIL --
+
+conran.f:
+    Changed values of iabove, ibelow and ibel2 to improve label placement.
+    Blockdata condbn rewritten as run time initialization. (conbdn.f)
+    Internal writes rewritten as calls to encode.
+
+conrec.f:
+    Value of NCRT changed from 4 to 2.
+    The contour plot labelling has been improved, with the titles being
+    centered in the current viewport, and the large spaces between
+    fields eliminated.  This change involves:
+	1. common block noaolb added; also used in spp calling routine.
+	2. Values of LNGTHS array modified.
+	3. Character*25 variable string[5] added.
+	4. Default plot position is centered on current viewport.
+    All internal writes have been replaced with calls to encode.
+    Error message concerning "overflow in STLINE" is now written only
+        to stderr, not to stdgraph as well.
+    EZCNTR no longer calls frame.
+    Block data CONBD deleted from conrec.f source, rewritten as conbd.f
+
+dashsmth.f:
+    In two places, the blockdata DASHBD is called as an initializing subroutine.
+    Subroutines kurv1s and kurv2s are used for both the dashsmth and
+    isosrf utilities.  The code is duplicated in the two fortran files.  I
+    have put it in a separate file (kurv.f) and deleted it from both original
+    locations.
+
+gridal.f:
+    In two places, blockdata GRIDT is called as an initializing subroutine.
+    All internal FTN writes changed to calls to encode.
+    FTN write and format statements for error reporting deleted - used seter.
+    Blockdata deleted from gridal.f; rewritten in gridt.f.
+
+hafton.f:
+    Blockdata hfinit rewritten and called as run time initializing subroutine.
+    One internal write rewritten as call to encode.
+    Call to FRAME removed from EZHFTN.
+
+isosrf.f:
+    Call to FRAME removed from EZISOS
+    Blockdata isosrb was rewritten as run time initialization isosrb.f
+    Source for subroutines kurv1s and kurv2s has been deleted from isosrf.f.
+    (It is shared with the dashsmth utility, and has been moved to kurv.f.)
+
+pwrity.f:
+    Blockdata PWRYBD rewritten as subroutine.
+    FTN writes and format statements commented out.
+
+pwrzs.f:
+    Common block noaovp added, so user can control viewport.  Calls to
+    plotit and set had to be changed because they assumed the full
+    viewport [1-1024] was being used for srface plots.
+
+srface.f:
+    Because user changes viewport when labelling is selected, mods had
+    to be made.  Common block noaovp has been added, and calls to set
+    and plotit no longer assume the full viewport [1-1024] is being used.
+    Blockdata SRFABD has been rewritten as a run time initialization.
+
+strmln.f:
+    The value of uvmsg changed from 1.0E+36 to 1.0E+16 in an attempt
+    to make this routine run on a VAX.
+
+threed.f:
+    Blockdata threbd rewritten as run time initialization.
+    Subroutine pwrz completely commented out.
+
+velvct.f:
+    Blockdata veldat rewritten as run time initialization.
+    FTN internal write rewritten as call to encode.
+
+
+Subdirectory SYSINT (system interface) --
+
+sysint/support.f:
+    1. The character size calculated by WTSTR is doubled to be readable
+       with the IRAF font.
+    2. Subroutines SETER and E9RIN both used FTN write statements to
+       output information.  This is now handled by passing the error 
+       message to ULIBER, where the string gets unpacked with f77upk
+       and written to stderr.
+    3. Blockdata UERRBD was rewritten as a run time initialization.
+    4. Block data UTILBD was rewritten as a run time initialization.
+       A logical flag (first) was added to insure that the internal
+       parameters were initialized only once per load; subroutine
+       utilbd can be called at several points.  An entry point 'utinit'
+       was added to reset the 'first' flag to true.
+    5. In an attempt to mimic the organization of the release tape, file
+       support.f contains the following fortran subroutines: 
+       SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+       SUBROUTINE ENCODE (NCHARS, FTNFMT, FTNOUT, RVAL)
+       SUBROUTINE ENTSR(IROLD,IRNEW)
+       SUBROUTINE RETSR(IROLD)
+       SUBROUTINE ERROF
+       SUBROUTINE SETER(MESSG,NERR,IOPT)
+       SUBROUTINE EPRIN
+       SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+       SUBROUTINE FDUM
+       SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+       INTEGER FUNCTION NERRO(NERR)
+       INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+       SUBROUTINE WTSTR (PX,PY,CH,IS,IO,IC)
+       subroutine uerrbd
+       subroutine uliber (errcode, pkerrmsg, msglen)
+
+sysint/spps.f:
+    1. Subroutine FLUSH has been renamed MCFLSH because of a name conflict.
+    2. FRAME calls initut to initialize the 'first' flag in utilbd.
+    3. Subroutines OPNGKS and CLSGKS have been commented out.
+    4. In PLOTIT and PLOTIF the block data utilbd is called as a run time 
+       initialization subroutine.
+
+****************************************************************************
+
+gio$ncarutil/conrec.f Dec 23, 1986 S. Hammond
+        Moved the call to gsplci that set up major contours.  This
+    statement was not being executed until after the first major line
+    had been drawn, resulting in the first major line not being bold.
+
+
+***************************************************************************
+On June 1, 1987 the following copywright notice was inserted into all 
+FORTRAN files in the ncarutil directory tree.  
+
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+February 12, 1988.  During Steve Rooke's port of IRAF to the HP RISC computer
+several Fortran errors were caught by the HP compiler.  These have been
+fixed as shown:
+sys/gio/ncarutil/conbdn.f
+    The data statement at line 244 had not been commented out.  It is now.
+
+June 10, 1988.  Made a mod to conbd.f (and in the comments to conrec.f) that
+resets the point at which contour decides an image aspect ratio is "extreme".
+Previously if the image axes ratio exceeded 1:4 the contour plot was square.
+This limit was too restrictive and has been changed to 1:16.  See related 
+change in pkg$plot.vport.x.  
diff --git a/sys/gio/ncarutil/autograph/README b/sys/gio/ncarutil/autograph/README
new file mode 100644
index 00000000..befb5e42
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/README
@@ -0,0 +1,46 @@
+AUTOGRAPH -- This directory contains the contents of the NCAR file
+autograph.f, unpacked one subroutine per file.  Here is the revision file 
+supplied by NCAR for the autograph package.  For NOAO specific enhancements, 
+see gio$ncarutil/README.
+
+ Revision history:
+
+ February, 1979   Added a revision history and enhanced machine
+                  independency.
+
+ September, 1979  Fixed a couple of problems which caused the code to
+                  bomb when core was pre-set to indefinites and the
+                  1st graph drawn was peculiar in some way and another
+                  which caused it to set the default dashed-line-speci-
+                  fier length wrong.  Added new documentation.
+
+ October, 1979    Changed the way IDIOT behaves when NPTS is negative.
+
+ March, 1980      Fixed a couple of small errors, one which prevented
+                  an error exit in AGSETP from ever being reached and
+                  another which caused AUTOGRAPH to blow up when given
+                  a zero or negative on a logarithmic axis.  Changed
+                  the way in which NBPF is computed by AGSTR1.
+
+ August, 1981     Removed all calls setting the plotter intensity and
+                  made the computation of the variable SMRL portable.
+
+ April, 1984      Made the code strictly FORTRAN-77 compatible, taking
+                  out all dependency on support routines (such as LOC).
+                  This required some changes in the user interface.
+
+ February, 1985   Put code in AGSETP to reclaim character-store space
+                  used by character-string dash patterns when they are
+                  redefined using binary patterns.  Also changed AGGTCH
+                  to return a single blank for a non-existent string.
+
+ August, 1985     Put code in AGGETP so that the label-name identifier
+                  is now returned properly.  Among other things, this
+                  cures a problem which caused the character-storage
+                  space to be eaten up.
+
+ December, 1985   Fixed AGSETP to zero the current-line pointer when
+                  the current-label pointer is changed.
+
+ January, 1986    Fixed AGAXIS to respond properly to the zeroing of
+                  NCIM by AGCHNL.
diff --git a/sys/gio/ncarutil/autograph/agaxis.f b/sys/gio/ncarutil/autograph/agaxis.f
new file mode 100644
index 00000000..4c3bec73
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agaxis.f
@@ -0,0 +1,1851 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C A   B R I E F   D E S C R I P T I O N   O F   A U T O G R A P H
+C ---------------------------------------------------------------------
+C
+C Following is a brief description of the AUTOGRAPH package.  For a
+C complete write-up, see the document "AUTOGRAPH - THE UNABRIDGED
+C WRITE-UP".
+C
+C
+C PACKAGE AUTOGRAPH
+C
+C LATEST REVISION        January, 1986
+C
+C PURPOSE                To draw graphs, each with a labelled background
+C                        and each displaying one or more curves.
+C
+C ACCESS (ON THE CRAY)   To use AUTOGRAPH routines on the Cray, simply
+C                        call them; they are in the binary library
+C                        $NCARLB, which is automatically searched.
+C
+C                        To get smoother curves, drawn using spline
+C                        interpolation, compile DASHSMTH, from ULIB,
+C                        to replace DASHCHAR, from $NCARLB:
+C
+C                          GETSRC,LIB=ULIB,FILE=DASHSMTH,L=DSMTH.
+C                          CFT,I=DSMTH,L=0.
+C
+C                        AUTOGRAPH contains a routine AGPWRT, which it
+C                        calls to draw labels.  This routine just passes
+C                        its arguments on to the system-plot-package
+C                        routine PWRIT.  To use one of the fancier
+C                        character-drawers, like PWRITX or PWRITY,
+C                        just compile a routine AGPWRT to replace the
+C                        default version; it has the same arguments as
+C                        PWRIT and may either draw the character string
+C                        itself, or just pass the arguments on to a
+C                        desired character-drawer.  The AUTOGRAPH
+C                        specialist has some "standard" versions of
+C                        AGPWRT and should be consulted for help in
+C                        avoiding pitfalls.  One standard version,
+C                        which calls PWRITX, may be obtained using the
+C                        following JCL:
+C
+C                          GETSRC,LIB=XLIB,FILE=AGUPWRITX,L=UPWRTX.
+C                          CFT,I=UPWRTX,L=0.
+C
+C USAGE                  Following this indented preamble are given two
+C                        lists:  one describing the AUTOGRAPH routines
+C                        and another describing the arguments of those
+C                        routines.
+C
+C                        "AUTOGRAPH - THE UNABRIDGED WRITE-UP" gives
+C                        a complete write-up of AUTOGRAPH, in great
+C                        detail and with a set of helpful examples.
+C
+C ENTRY POINTS           Except for seven routines which are included
+C                        in the package for historical reasons (EZY,
+C                        EZXY, EZMY, EZMXY, IDIOT, ANOTAT, and DISPLA),
+C                        the AUTOGRAPH routines have six-character names
+C                        beginning with the characters 'AG'.  An alpha-
+C                        betized list follows:
+C
+C                          AGAXIS AGBACK AGBNCH AGCHAX AGCHCU AGCHIL
+C                          AGCHNL AGCTCS AGCTKO AGCURV AGDASH AGDFLT
+C                          AGDLCH AGDSHN AGEXAX AGEXUS AGEZSU AGFPBN
+C                          AGFTOL AGGETC AGGETF AGGETI AGGETP AGGTCH
+C                          AGINIT AGKURV AGLBLS AGMAXI AGMINI AGNUMB
+C                          AGPPID AGPWRT AGQURV AGRPCH AGRSTR AGSAVE
+C                          AGSCAN AGSETC AGSETF AGSETI AGSETP AGSRCH
+C                          AGSTCH AGSTUP AGUTOL
+C
+C                        NOTE:  The "routine" AGDFLT is a block-data
+C                        routine specifying the default values of
+C                        AUTOGRAPH control parameters.
+C
+C SPECIAL CONDITIONS     Under certain conditions, AUTOGRAPH may print
+C                        an error message (via the routine SETER) and
+C                        stop.  Each error message includes the name of
+C                        the routine which issued it.  A description of
+C                        the condition which caused the error may be
+C                        found in the AUTOGRAPH write-up in the NCAR
+C                        graphics manual; look in the write-up of the
+C                        routine which issued the error message, under
+C                        the heading 'SPECIAL CONDITIONS'.
+C
+C                        For error messages issued by the routine
+C                        AGNUMB, see the write-up of the routine AGSTUP.
+C
+C                        If you get an error in the routine ALOG10, it
+C                        probably means that you are using a logarithmic
+C                        axis and some of the coordinate data along that
+C                        axis are zero or negative.
+C
+C COMMON BLOCKS          The AUTOGRAPH common blocks are AGCONP, AGORIP,
+C                        AGOCHP, AGCHR1, and AGCHR2.  AGCONP contains
+C                        the AUTOGRAPH "control parameters", primary and
+C                        secondary, all of which are real, AGORIP other
+C                        real and/or integer parameters, AGOCHP other
+C                        character parameters, AGCHR1 and AGCHR2 the
+C                        variables implementing the character-storage-
+C                        and-retrieval scheme of AUTOGRAPH.
+C
+C I/O                    Lower-level plotting routines are called to
+C                        produce graphical output and, when errors
+C                        occur, error messages may be written to the
+C                        system error file, as defined by I1MACH(4),
+C                        either directly or by way of a call to SETER.
+C
+C REQUIRED ULIB          AUTOGRAPH uses the software dashed-line package
+C ROUTINES               DASHCHAR.  Of course, either of the packages
+C                        DASHSMTH or DASHSUPR may be used instead, to
+C                        get smoother curves.
+C
+C SPECIALIST             Dave Kennison, Scientific Computing Division,
+C                        National Center for Atmospheric Research
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                Dave Robertson wrote the original routine
+C                        IDIOT, which was intended to provide a simple,
+C                        quick-and-dirty, x-y graph-drawing capability.
+C                        In time, as it became obvious that many users
+C                        were adapting IDIOT to more sophisticated
+C                        tasks, Dan Anderson wrote the first AUTOGRAPH
+C                        package, based on IDIOT.  It allowed the user
+C                        to put more than one curve on a graph, to use
+C                        more sophisticated backgrounds, to specify
+C                        coordinate data in a variety of ways, and to
+C                        more easily control the scaling and positioning
+C                        of graphs.  Eventually, this package, too, was
+C                        found wanting.  In 1977, Dave Kennison entirely
+C                        re-wrote AUTOGRAPH, with the following goals:
+C                        to maintain the ease of use for simple graphs
+C                        which had been the principal virtue of the
+C                        package, to provide the user with as much
+C                        control as possible, to incorporate desirable
+C                        new features, and to make the package as
+C                        portable as possible.  In 1984, the package
+C                        was again worked over by Dave Kennison, to
+C                        make it compatible with FORTRAN-77 and
+C                        to remove any dependency on the LOC function,
+C                        which had proved to cause difficulties on
+C                        certain machines.  The user interface was
+C                        changed somewhat and some new features were
+C                        added.  A GKS-compatible version was written.
+C
+C SPACE REQUIRED         AUTOGRAPH is big; one pays a price for its
+C                        capabilities.  On the Cray, it occupies a
+C                        little under 30000 (octal) locations.  The
+C                        required plot package routines take about
+C                        another 7000 (octal), the (modified) PORT
+C                        support routines about another 1000 (octal),
+C                        and system routines (math, I/O, miscellany)
+C                        another 30000 (octal).
+C
+C PORTABILITY            AUTOGRAPH may be ported with few modifications
+C                        to most systems having a FORTRAN-77 compiler.
+C
+C                        The labelled common blocks may have to be
+C                        declared in a part of the user program which
+C                        is always core-resident so that variables
+C                        in them will maintain their values from one
+C                        AUTOGRAPH-routine call to the next.  Such a
+C                        problem may arise when AUTOGRAPH is placed in
+C                        an overlay or when some sort of memory-paging
+C                        scheme is used.
+C
+C REQUIRED RESIDENT      AUTOGRAPH uses the DASHCHAR routines DASHDB,
+C ROUTINES               DASHDC, FRSTD, LASTD, LINED, AND VECTD, the
+C                        system-plot-package routines FRAME, GETSET,
+C                        GETSI, LINE, PWRIT, and SET, the support
+C                        routines ISHIFT and IOR, the (modified)
+C                        PORT utilities SETER and I1MACH, and the
+C                        FORTRAN-library routines ALOG10, ATAN2, COS,
+C                        SIN, AND SQRT.
+C
+C ---------------------------------------------------------------------
+C U S E R - C A L L A B L E   A U T O G R A P H   R O U T I N E S
+C ---------------------------------------------------------------------
+C
+C Following is a list of AUTOGRAPH routines to be called by the user
+C (organized by function).  Each routine is described briefly.  The
+C arguments of the routines are described in the next section.
+C
+C Each of the following routines draws a complete graph with one call.
+C Each is implemented by a set of calls to the lower-level AUTOGRAPH
+C routines AGSTUP, AGCURV, and AGBACK (which see, below).
+C
+C -- EZY (YDRA,NPTS,GLAB) - draws a graph of the curve defined by the
+C    data points ((I,YDRA(I)),I=1,NPTS), with a graph label specified
+C    by GLAB.
+C
+C -- EZXY (XDRA,YDRA,NPTS,GLAB) - draws a graph of the curve defined by
+C    the data points ((XDRA(I),YDRA(I)),I=1,NPTS), with a graph label
+C    specified by GLAB.
+C
+C -- EZMY (YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the family of
+C    curves defined by data points (((I,YDRA(I,J)),I=1,NPTS),J=1,MANY),
+C    with a graph label specified by GLAB.  The order of the subscripts
+C    of YDRA may be reversed - see the routine DISPLA, argument LROW.
+C
+C -- EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the
+C    family of curves defined by the data points (((XDRA(I),YDRA(I,J)),
+C    I=1,NPTS),J=1,MANY), with a graph label specified by GLAB.  XDRA
+C    may be doubly-subscripted and the order of the subscripts of XDRA
+C    and YDRA may be reversed - see the routine DISPLA, argument LROW.
+C
+C -- IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA) - implements
+C    the routine from which AUTOGRAPH grew - not recommended - provided
+C    for antique lovers.
+C
+C The following routines provide user access to the AUTOGRAPH control
+C parameters (in the labelled common block AGCONP).
+C
+C -- ANOTAT (XLAB,YLAB,LBAC,LSET,NDSH,DSHL) - may be used to change the
+C    x- and y-axis (non-numeric) labels, the background type, the way
+C    in which graphs are positioned and scaled, and the type of dash
+C    patterns to be used in drawing curves.
+C
+C -- DISPLA (LFRA,LROW,LTYP) - may be used to specify when, if ever,
+C    the EZ... routines do a frame advance, how input arrays for EZMY
+C    and EZMXY are dimensioned, and the linear/log nature of graphs.
+C
+C -- AGSETP (TPGN,FURA,LURA) - a general-purpose parameter-setting
+C    routine, used to set the group of parameters specified by TPGN,
+C    using values obtained from the array (FURA(I),I=1,LURA).
+C
+C -- AGSETF (TPGN,FUSR) - used to set the single parameter specified by
+C    TPGN, giving it the floating-point value FUSR.
+C
+C -- AGSETI (TPGN,IUSR) - used to set the single parameter specified by
+C    TPGN, giving it the floating-point value FLOAT(IUSR).
+C
+C -- AGSETC (TPGN,CUSR) - the character string CUSR is stashed in an
+C    array inside AUTOGRAPH and the floating-point equivalent of an
+C    identifier which may be used for later retrieval of the string is
+C    stored as the value of the single parameter specified by TPGN.  The
+C    single parameter must be a label name, a dash pattern, the text of
+C    a label line, or the line-terminator character.
+C
+C -- AGGETP (TPGN,FURA,LURA) - a general-purpose parameter-getting
+C    routine, used to get the group of parameters specified by TPGN,
+C    putting the result in the array (FURA(I),I=1,LURA).
+C
+C -- AGGETF (TPGN,FUSR) - used to get, in FUSR, the floating-point
+C    value of the single parameter specified by TPGN.
+C
+C -- AGGETI (TPGN,IUSR) - used to get, in IUSR, the integer equivalent
+C    of the value of the single parameter specified by TPGN.
+C
+C -- AGGETC (TPGN,CUSR) - used to get, in CUSR, the character string
+C    whose identifier is specified by the integer equivalent of the
+C    single parameter specified by TPGN.  The single parameter must
+C    be a label name, a dash pattern, the text of a label line, or the
+C    line-terminator character.
+C
+C The following are lower-level routines, which may be used to draw
+C graphs of many different kinds.  The EZ... routines call these.  They
+C are intended to be called by user programs, as well.
+C
+C -- AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY) - this
+C    routine must be called prior to the first call to either of the
+C    two routines AGBACK and AGCURV, to force the set-up of secondary
+C    parameters controlling the behavior of those routines.  After any
+C    parameter-setting call, AGSTUP must be called again before calling
+C    either AGBACK or AGCURV again.  AGSTUP calls the routine "SET", in
+C    the plot package, so that user x/y coordinates in subsequent calls
+C    will map properly into the plotter space.
+C
+C -- AGBACK - draws the background defined by the current state of the
+C    AUTOGRAPH control parameters.
+C
+C -- AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH) - draws the curve defined
+C    by the arguments, positioning it as specified by the current state
+C    of the AUTOGRAPH control parameters.
+C
+C The following utility routines are called by the user.
+C
+C -- AGSAVE (IFNO) - used to save the current state of AUTOGRAPH by
+C    writing the appropriate information to a specified file.  Most
+C    commonly used to save the default state for later restoration.
+C    This routine should be used instead of AGGETP when the object
+C    is to save the whole state of AUTOGRAPH, since it saves not only
+C    the primary control parameters, but all of the character strings
+C    pointed to by the primary control parameters.  It is the user's
+C    responsibility to position the file before calling AGSAVE.
+C
+C -- AGRSTR (IFNO) - used to restore a saved state of AUTOGRAPH by
+C    reading the appropriate information from a specified file.  Most
+C    commonly used to restore AUTOGRAPH to its default state.  It is
+C    the user's responsibility to position the file before calling
+C    AGRSTR.
+C
+C -- AGBNCH (IDSH) - a function, of type CHARACTER*16 (it must be
+C    declared as such in a user routine referencing it), whose value,
+C    given a 16-bit binary dash pattern, is the equivalent character
+C    dash pattern.
+C
+C -- AGDSHN (IDSH) - a function, of type CHARACTER*16 (it must be
+C    declared as such in a user routine referencing it), whose value,
+C    given an integer "n" (typically between 1 and 26) is the character
+C    string 'DASH/ARRAY/nnnn.', which is the name of the nth dash
+C    pattern parameter.  To set the 13th dash pattern, for example,
+C    one might use "CALL AGSETC (AGDSHN(13),'$$$$$$CURVE 13$$$$$$')".
+C
+C The following utility routines are called by AUTOGRAPH.  The versions
+C included in AUTOGRAPH itself are dummies; they do nothing but RETURN.
+C The user may replace one or more of these routines with versions to
+C accomplish specific purposes.
+C
+C -- AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP) - called by AUTOGRAPH to perform
+C    the mapping from user-system values along an axis to label-system
+C    values along the axis and vice-versa.  This routine may be replaced
+C    by the user to create a desired graph.
+C
+C -- AGCHAX (IFLG,IAXS,IPRT,VILS) - called by AUTOGRAPH just before and
+C    just after the various parts of the axes are drawn.
+C
+C -- AGCHCU (IFLG,KDSH) - called by AUTOGRAPH just before and just after
+C    each curve is drawn.
+C
+C -- AGCHIL (IFLG,LBNM,LNNO) - called by AUTOGRAPH just before and just
+C    after each line of an informational label is drawn.
+C
+C -- AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE) - called by
+C    AUTOGRAPH just after the character strings defining a numeric label
+C    have been generated.
+C
+C ---------------------------------------------------------------------
+C D E S C R I P T I O N S   O F   A R G U M E N T S
+C ---------------------------------------------------------------------
+C
+C In calls to the routines EZY, EZXY, EZMY, and EZMXY:
+C
+C -- XDRA is an array of x coordinates, dimensioned as implied by the
+C    current value of the AUTOGRAPH control parameter 'ROW.' (see the
+C    description of the argument LROW, below).  The value of the
+C    AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as an
+C    x coordinate, implies a missing data point; the curve segments
+C    on either side of such a point are not drawn.
+C
+C -- YDRA is an array of y coordinates, dimensioned as implied by the
+C    current value of the AUTOGRAPH control parameter 'ROW.' (see the
+C    description of the argument LROW, below).  The value of the
+C    AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as a
+C    y coordinate, implies a missing data point; the curve segments
+C    on either side of such a point are not drawn.
+C
+C -- IDXY is the first dimension of the arrays XDRA (if it has two
+C    dimensions) and YDRA.
+C
+C -- MANY is the number of curves to be drawn by the call to EZ... -
+C    normally, the second dimension of XDRA (if it has two dimensions)
+C    and YDRA.
+C
+C -- NPTS is the number of points defining each curve to be drawn by
+C    the routine EZ... - normally, the first (or only) dimension of
+C    XDRA and YDRA.
+C
+C -- GLAB is a character constant or a character variable, defining a
+C    label to be placed at the top of the graph.  The string may not be
+C    more than 40 characters long - if it is fewer than 40 characters
+C    long, its last character must be a dollar sign.  (The dollar sign
+C    is not a part of the label - it is stripped off.)  The character
+C    string "CHAR(0)" may be used to indicate that the previous label,
+C    whatever it was, should continue to be used.  The initial graph
+C    label consists of blanks.
+C
+C In calls to the routine ANOTAT:
+C
+C -- XLAB and YLAB resemble GLAB (see above) and define labels for the
+C    x and y axes.  The default x-axis label is the single character
+C    X, the default y-axis label the single character Y.  Note that one
+C    may use the string "CHAR(0)" to indicate that the x-axis (y-axis)
+C    label is not to be changed from what it was previously.
+C
+C -- LBAC, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'BACKGROUND.', as follows:
+C
+C       1 - a perimeter background
+C
+C       2 - a grid background
+C
+C       3 - an axis background
+C
+C       4 - no background
+C
+C    The default value of 'BACKGROUND.' is 1.
+C
+C -- LSET, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'SET.'.  This parameter may be negated to suspend the
+C    drawing of curves by the EZ... routines, so that a call to one of
+C    them will produce only a background.  The absolute value of 'SET.'
+C    affects the way in which AUTOGRAPH determines the position and
+C    shape of the graph and the scaling of the axes, as follows:
+C
+C       1 - Restores the default values of the AUTOGRAPH parameters
+C           in question.  AUTOGRAPH will set up an appropriate call
+C           to the plot-package routine "SET", over-riding any prior
+C           call to that routine.
+C
+C       2 - Tells AUTOGRAPH to use arguments 1-4 and 9 of the last
+C           "SET" call.  Arguments 1-4 specify where the graph should
+C           fall on the plotter frame, argument 9 whether the graph
+C           is linear/linear, linear/log, etc.
+C
+C       3 - Tells AUTOGRAPH to use arguments 5-8 and 9 of the last
+C           "SET" call.  Arguments 5-8 specify the scaling of the
+C           axes, argument 9 whether the graph is linear/linear,
+C           linear/log, etc.
+C
+C       4 - A combination of 2 and 3.  Arguments 1-4 of the last "SET"
+C           call specify the position, arguments 5-8 the scaling, and
+C           argument 9 the linear/log nature, of the graph.
+C
+C    (The plot-package routine "SET" is described in the NCAR Graphics
+C    Manual; it is not a part of AUTOGRAPH.)
+C
+C    If the routine DISPLA is called with its argument LTYP non-zero,
+C    the linear/log nature of the graph will be that specified by LTYP,
+C    not that specified by the last "SET" call, no matter what the value
+C    of the control parameter 'SET.'.
+C
+C    The default value of 'SET.' is 1.
+C
+C -- NDSH, if non-zero, specifies a new value of the AUTOGRAPH control
+C    parameter 'DASH/SELECTOR.' (and therefore a new set of dashed-line
+C    patterns), as described below.  Note:  The default value of the
+C    dashed-line parameters is such that all curves will be drawn using
+C    solid lines; if that is what you want, use a zero for NDSH.
+C
+C       If the value of 'DASH/SELECTOR.' is negative, curves produced
+C       by subsequent calls to EZMY or EZMXY will be drawn using a
+C       set of alphabetic dashed-line patterns.  The first curve drawn
+C       by a given call will be labelled 'A', the second 'B', ..., the
+C       twenty-sixth 'Z', the twenty-seventh 'A' again, and so on.
+C       Curves drawn by calls to EZY and EZXY will be unaffected.
+C
+C       If the value of 'DASH/SELECTOR.' is positive, it must be less
+C       than or equal to 26.  The next argument, DSHL, is an array
+C       containing NDSH dashed-line patterns.  All curves produced by
+C       subsequent calls to EZY, EZXY, EZMY, and EZMXY will be drawn
+C       using the dashed-line patterns in (DSHL(I),I=1,NDSH) - the
+C       first curve produced by a given call will have the pattern
+C       specified by DSHL(1), the second that specified by DSHL(2),
+C       the third that specified by DSHL(3), . . . the NDSH+1st that
+C       specified by DSHL(1), . . . etc.  Each element of DSHL must
+C       be a character string, in which a dollar sign stands for a
+C       solid-line segment, a quote stands for a gap, and other
+C       characters stand for themselves.  See the write-up of the
+C       package "DASHCHAR".  Binary dashed-line patterns may not be
+C       defined by means of a call to ANOTAT, only by means of calls
+C       to lower-level routines.
+C
+C -- DSHL (if NDSH is greater than zero) is an array of dashed-line
+C    patterns, as described above.
+C
+C In calls to the routine DISPLA:
+C
+C -- LFRA, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'FRAME.'.  Possible values are as follows:
+C
+C       1 - The EZ... routines do a frame advance after drawing.
+C
+C       2 - No frame advance is done by the EZ... routines.
+C
+C       3 - The EZ... routines do a frame advance before drawing.
+C
+C    The default value of 'FRAME.' is 1.
+C
+C -- LROW, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'ROW.'.  This parameter tells AUTOGRAPH how the argument
+C    arrays XDRA and YDRA, in calls to the routines EZMY and EZMXY, are
+C    subscripted, as follows:
+C
+C       If 'ROW.' is positive, this implies that the first subscript
+C       of YDRA is a point number and the second subscript is a curve
+C       number.  If 'ROW.' is negative, the order is reversed.
+C
+C       If the absolute value of 'ROW.' is 1, this implies that XDRA
+C       is singly-subscripted, by point number only.  If the absolute
+C       value of 'ROW.' is 2 or greater, this implies that XDRA is
+C       doubly-subscripted, just like YDRA.
+C
+C    The default value of 'ROW.' is 1, spicifying that XDRA is singly-
+C    subscripted and that YDRA is doubly-subscripted by point number
+C    and curve number, in that order.
+C
+C -- LTYP, if non-zero, specifies new values for the AUTOGRAPH control
+C    parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.', which determine
+C    whether the X and Y axes are linear or logarithmic.  Possible
+C    values are as follows:
+C
+C       1 - x axis linear, y axis linear
+C
+C       2 - x axis linear, y axis logarithmic
+C
+C       3 - x axis logarithmic, y axis linear
+C
+C       4 - x axis logarithmic, y axis logarithmic
+C
+C    The default values of these parameters make both axes linear.
+C
+C    If the parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.' are reset
+C    by the routine DISPLA, they are given values which make them
+C    immune to being reset when 'SET.' = 2, 3, or 4 (see the discussion
+C    of the argument LSET, above).
+C
+C In calls to the routines AGSETP, AGSETF, AGSETI AGSETC, AGGETP,
+C AGGETF, AGGETI, and AGGETC:
+C
+C -- TPGN is a character string identifying a group of AUTOGRAPH
+C    control parameters.  It is of the form 'K1/K2/K3/ . . . /Kn.'.
+C    Each Ki is a keyword.  The keyword K1 specifies a group of control
+C    parameters, K2 a subgroup of that group, K3 a subgroup of that
+C    subgroup, etc.  See the AUTOGRAPH write-up in the graphics manual
+C    for a more complete description of these parameter-group names and
+C    the ways in which they may be abbreviated.
+C
+C -- FURA is an array, from which control-parameter values are to be
+C    taken (the routine AGSETP) or into which they are to be stored
+C    (the routine AGGETP).  Note that the array is real; all of the
+C    AUTOGRAPH parameters are stored internally as reals.
+C
+C -- LURA is the length of the user array FURA.
+C
+C -- FUSR is a variable, from which a single control parameter value is
+C    to be taken (the routine AGSETF) or in which it is to be returned
+C    (the routine AGGETF).  Note that the variable is real.
+C
+C -- IUSR is a variable, from which a single-control parameter value is
+C    to be taken (the routine AGSETI) or in which it is to be returned
+C    (the routine AGGETI).  Note that, since the control parameters are
+C    stored internally as reals, each of the routines AGSETI and AGGETI
+C    does a conversion - from integer to real or vice-versa.  Note also
+C    that AGSETI and AGGETI should only be used for parameters which
+C    have intrinsically integral values.
+C
+C -- CUSR is a character variable from which a character string is to
+C    be taken (the routine AGSETC) or into which it is to be retrieved
+C    (the routine AGGETC).  The control parameter affected by the call
+C    contains the floating-point equivalent of an integer identifier
+C    returned by the routine which stashes the character string and
+C    tendered to the routine which retrieves it (sort of the automated
+C    equivalent of a hat check).  Note that AGSETC and AGGETC should
+C    only be used for parameters which intrinsically represent character
+C    strings.
+C
+C In calls to the routine AGSTUP:
+C
+C -- XDRA is an array of x coordinates of user data - usually, but not
+C    necessarily, the same data which will later be used in calls to
+C    the routine AGCURV.
+C
+C -- NVIX is the number of vectors of data in XDRA - if XDRA is doubly-
+C    dimensioned, NVIX would normally have the value of its second
+C    dimension, if XDRA is singly-dimensioned, a 1.
+C
+C -- IIVX is the index increment between vectors in XDRA - if XDRA is
+C    doubly-dimensioned, IIVX would normally have the value of its
+C    first dimension, if XDRA is singly-dimensioned, a dummy value.
+C
+C -- NEVX is the number of elements in each data vector in XDRA - if
+C    XDRA is doubly-dimensioned, NEVX would normally have the value of
+C    its first dimension, if XDRA is singly-dimensioned, the value of
+C    that single dimension.
+C
+C -- IIEX is the index increment between elements of a data vector in
+C    XDRA - normally a 1.
+C
+C -- YDRA, NVIY, IIVY, NEVY, and IIEY are analogous to XDRA, NVIX,
+C    IIVX, NEVX, and IIEX, but define y-coordinate data.
+C
+C In calls to the routine AGCURV:
+C
+C -- XVEC is a vector of x coordinate data.
+C
+C -- IIEX is the index increment between elements in XVEC.  AGCURV will
+C    use XVEC(1), XVEC(1+IIEX), XVEC(1+2*IIEX), etc.
+C
+C -- YVEC is a vector of y coordinate data.
+C
+C -- IIEY is the index increment between elements in YVEC.  AGCURV will
+C    use YVEC(1), YVEC(1+IIEY), YVEC(1+2*IIEY), etc.
+C
+C -- NEXY is the number of points defining the curve to be drawn.
+C
+C -- KDSH is a dashed-line selector.  Possible values are as follows:
+C
+C       If KDSH is zero, AUTOGRAPH will assume that the user has
+C       called the routine DASHD (in the DASHCHAR package, which see)
+C       to define the dashed-line pattern to be used.
+C
+C       If KDSH is less than zero and has absolute value M, AUTOGRAPH
+C       will use the Mth (modulo 26) alphabetic dashed-line pattern.
+C       Each of these patterns defines a solid line interrupted every
+C       so often by a letter of the alphabet.
+C
+C       If KDSH is greater than zero and has the value M, AUTOGRAPH
+C       will use the Mth (modulo N) dashed-line pattern in the group
+C       of N dashed-line patterns defined by the AUTOGRAPH control
+C       parameters in the group named 'DASH/PATTERNS.'.  The default
+C       values of these parameters specify solid lines.
+C
+C In calls to the routines AGSAVE and AGRSTR:
+C
+C -- IFNO is the unit number associated with a file to which a single
+C    unformatted logical record of data is to be written, or from which
+C    such a record is to be read, by AUTOGRAPH.  The file is not rewound
+C    before being written or read; positioning it properly is the user's
+C    responsibility.
+C
+C In calls to the function AGBNCH:
+C
+C -- IDSH is a 16-bit binary dash pattern, the character equivalent of
+C    which is to be returned as the value of AGBNCH.
+C
+C In calls to the function AGDSHN:
+C
+C -- IDSH is the number of the dash pattern parameter whose name is to
+C    be returned as the value of the function AGDSHN.
+C
+C In calls to the routine AGUTOL:
+C
+C -- IAXS is the number of the axis.  The values 1, 2, 3, and 4 imply
+C    the left, right, bottom, and top axes, respectively.
+C
+C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.' which may be
+C    used to select the desired mapping function for axis IAXS.  It is
+C    recommended that the default value (zero) be used to specify the
+C    identity mapping.  A non-zero value may be integral (1., 2., etc.)
+C    and serve purely to select the code to be executed or it may be the
+C    value of a real parameter in the equations defining the mapping.
+C
+C -- IDMA specifies the direction of the mapping.  A value greater than
+C    zero indicates that VINP is a value in the user system and that
+C    VOTP is to be a value in the label system, a value less than zero
+C    the opposite.
+C
+C -- VINP is an input value in one coordinate system along the axis.
+C
+C -- VOTP is an output value in the other coordinate system along the
+C    axis.
+C
+C In calls to the routine AGCHAX:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- IAXS is the number of the axis being drawn.  The values 1, 2, 3,
+C    and 4 indicate the left, right, bottom, and top axes, respectively.
+C
+C -- IPRT indicates the part of the axis being drawn.  Possible values
+C    are as follows:
+C
+C    -- 1 implies the line of the axis.
+C
+C    -- 2 implies a major tick.
+C
+C    -- 3 implies a minor tick.
+C
+C    -- 4 implies the mantissa of a numeric label.
+C
+C    -- 5 implies the exponent of a numeric label.
+C
+C -- VILS is the value in the label system at the point where the part
+C    is being drawn.  For IPRT = 1, VILS is zero.
+C
+C In calls to the routine AGCHCU:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- KDSH is the value with which AGCURV was called, as follows:
+C
+C       AGCURV called by   Value of KDSH
+C       ----------------   ----------------------------------------
+C       EZY                1
+C       EZXY               1
+C       EZMY               "n" or "-n", where n is the curve number
+C       EZMXY              "n" or "-n", where n is the curve number
+C       the user program   the user value
+C
+C In calls to the routine AGCHIL:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- LBNM is a character variable containing the name of the label being
+C    drawn.
+C
+C -- LNNO is the number of the line being drawn.
+C
+C In calls to the routine AGCHNL:
+C
+C -- IAXS is the number of the axis being drawn.  The values 1, 2, 3,
+C    and 4 imply the left, right, bottom, and top axes, respectively.
+C
+C -- VILS is the value to be represented by the numeric label, in the
+C    label system for the axis.  The value of VILS must not be altered.
+C
+C -- CHRM, on entry, is a character string containing the mantissa of
+C    the numeric label, as it will appear if AGCHNL makes no changes.
+C    If the numeric label includes a "times" symbol, it is represented
+C    by a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C -- MCIM is the length of CHRM - the maximum number of characters that
+C    it will hold.  The value of MCIM must not be altered.
+C
+C -- NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C    CHRM is changed, NCIM should be changed accordingly.
+C
+C -- IPXM, on entry, is zero if there is no "times" symbol in CHRM; if
+C    it is non-zero, it is the index of a character position in CHRM.
+C    If AGCHNL changes the position of the "times" symbol in CHRM,
+C    removes it, or adds it, the value of IPXM must be changed.
+C
+C -- CHRE, on entry, is a character string containing the exponent of
+C    the numeric label, as it will appear if AGCHNL makes no changes.
+C    CHRE may be modified.
+C
+C -- MCIE is the length of CHRE - the maximum number of characters that
+C    it will hold.  The value of MCIE must not be altered.
+C
+C -- NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C    CHRE is changed, NCIE should be changed accordingly.
+C
+C ---------------------------------------------------------------------
+C T H E   A U T O G R A P H   C O D E
+C ---------------------------------------------------------------------
+C
+C Following is the AUTOGRAPH code.  Routines appear in alphabetic order.
+C
+      SUBROUTINE AGAXIS (IAXS,QTST,QSPA,WCWP,HCWP,XBGA,YBGA,XNDA,YNDA,
+     +                   QLUA,UBGA,UNDA,FUNS,QBTP,BASE,QJDP,WMJL,WMJR,
+     +                   QMNT,QNDP,WMNL,WMNR,QLTP,QLEX,QLFL,QLOF,QLOS,
+     +                   DNLA,WCLM,WCLE,RFNL,QCIM,QCIE,WNLL,WNLR,WNLB,
+     +                                                           WNLE)
+C
+C The routine AGAXIS is used to draw, tick-mark, and label an axis or,
+C if ITST is non-zero, to pre-compute the amount of space which will be
+C required for numeric labels when the axis is actually drawn.  AGAXIS
+C assumes that the last call to the plot-package routine SET was as
+C follows (or the equivalent thereof):
+C
+C    CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1)
+C
+C where XLCW, XRCW, YBCW, and YTCW are the coordinates of the left,
+C right, bottom, and top edges of the curve window, stated as fractions
+C of the appropriate edge of the plotter frame.
+C
+C The arguments of AGAXIS are as follows:
+C
+C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4, meaning
+C    the left, right, bottom, and top axes, respectively.
+C
+C -- ITST is an integer specifying what the caller wishes AGAXIS to do,
+C    as follows:
+C
+C    -- If ITST .LT. 0, AGAXIS is to draw only the axis, nothing else.
+C
+C    -- If ITST .EQ. 0, AGAXIS is to draw, tick, and label the axis.
+C
+C    -- If ITST .GT. 0, AGAXIS is to pre-compute the amount of space
+C       which will be required for numeric labels.  If the labels will
+C       not fit in the space provided, AGAXIS is instructed to take
+C       action as follows:
+C
+C       -- ITST .EQ. 1 - no action.
+C
+C       -- ITST .EQ. 2 - shrink the labels.
+C
+C       -- ITST .EQ. 3 - re-orient the labels.
+C
+C       -- ITST .EQ. 4 - shrink and/or re-orient the labels.
+C
+C -- ISPA is a 0 or a 1, specifying whether or not the axis itself is
+C    to be drawn.  If ISPA .NE. 0, the axis is suppressed.  Tick marks
+C    and/or labels may still be drawn.
+C
+C -- WCWP is the width of the curve window, in plotter units.
+C
+C -- HCWP is the height of the curve window, in plotter units.
+C
+C -- XBGA, YBGA, XNDA, and YNDA are the x and y coordinates of the ends
+C    of the axis.  X coordinates are stated as fractions of the width,
+C    y coordinates as fractions of the height, of the curve window.  The
+C    axis to be drawn must be either horizontal or vertical (at an angle
+C    of 0, 90, 180, or 270 degrees).  The left side, right side, begin-
+C    ning, and end of the axis are defined from the viewpoint of a demon
+C    standing at (XBGA,YBGA) and staring balefully toward (XNDA,YNDA).
+C
+C -- LLUA, UBGA, and UNDA define the mapping of the "user" coordinate
+C    system (used for data-point coordinates) onto the axis.  If LLUA
+C    is zero, the mapping is linear; if LLUA is non-zero, the mapping
+C    is logarithmic.  UBGA is the user-system value at the beginning of
+C    the axis, UNDA the value at the end of the axis.  The subroutine
+C    AGFTOL, which needs these parameters, is actually passed LLUA,
+C    UBEG=F(UBGA), and UDIF=F(UNDA)-F(UBGA), where F is the function
+C    F(X)=X or the function F(X)=ALOG10(X), depending on LLUA.
+C
+C -- FUNS is a function-selector, to be used in calls to AGUTOL, which
+C    defines the mappings from the user system to the label system and
+C    vice-versa for each of the four axes.  The functions defined must
+C    be continuous, monotonic, and bounded within the user-system range
+C    (UBGA,UNDA) and a little bit outside that range.  The positions
+C    of numeric labels and tick marks are chosen in the label system,
+C    mapped to the user system, and then onto the axis.
+C
+C -- NBTP and BASE specify how major ticks are to be positioned in the
+C    label coordinate system.  See the routine AGNUMB (arguments NBTP,
+C    SBSE, and EXMU) for a description of these arguments.  Note that
+C    NBTP .EQ. 0 or BASE .EQ. 0. suppresses both major tick marks and
+C    their labels.  Note:  SBSE .EQ. +BASE or -BASE, as needed.
+C
+C -- QJDP is the major-tick-mark dash pattern (0. .LE. QJDP .LE. 65535.)
+C    QJDP .LE. 0 suppresses major ticks.
+C
+C -- WMJL and WMJR are the distances to the left and right ends of the
+C    major tick marks, stated as fractions of the shortest side of the
+C    curve window.  Values .EQ. 0 may be used to suppress one or both
+C    portions.  Values .GE. 1 may be used to extend a given portion all
+C    the way to the edge of the curve window.  (See routine AGCTKO.)
+C
+C -- NMNT is the number of minor tick marks to be placed between each
+C    pair of consecutive major tick marks.  NMNT .EQ. 0 suppresses them.
+C
+C -- QNDP, WMNL, and WMNR are analogous to QJDP, WMJL, and WMJR, but
+C    specify minor-tick-mark characteristics.
+C
+C -- NLTP, NLEX, and NLFL specify the graphic form of numeric labels, as
+C    described in the routine AGNUMB (which see).  Note that NLTP .LE. 0
+C    suppresses numeric labels.
+C
+C -- NLOF and NLOS are first and second choices for the numeric label
+C    orientation.  Both must be multiples of 90, specifying an angle
+C    measured in degrees counter-clockwise from a vector running from
+C    left to right in the curve window.  If ITST .EQ. 0, AGAXIS uses
+C    NLOF if it is .GE. 0, NLOS otherwise, for the label orientation.
+C    If ITST .NE. 0, AGAXIS initially makes both NLOF and NLOS positive.
+C    Then, if ITST .GE. 3, NLOF may or may not be made negative.  (To
+C    set the sign of NLOF or NLOS, AGAXIS adds or subtracts 360*K.)
+C
+C -- DNLA is the desired distance of numeric labels from the axis,
+C    positive to the left, negative to the right, of the axis.  The
+C    magnitude of DNLA is the size of the gap between the axis and the
+C    nearest edge of a label, expressed as a fraction of the smaller
+C    dimension of the curve window.  See also RFNL, below.
+C
+C -- WCLM and WCLE are the desired widths of characters in the mantissa
+C    or the exponent, respectively, of numeric labels, expressed as a
+C    fraction of the smaller dimension of the curve window.  See also
+C    RFNL, below.
+C
+C -- RFNL is a reduction factor, used as a multiplier for DNLA, WCLM,
+C    and WCLE.  If ITST .NE. 0, RFNL is initially set to 1. - then, if
+C    ITST .EQ. 2 or 4, it is reset as necessary to shrink the labels.
+C
+C -- MCIM and MCIE specify the maximum number of characters in the
+C    mantissa and exponent, respectively, of a numeric label.  These
+C    are input parameters if ITST .EQ. 0, output parameters otherwise.
+C
+C -- WNLL, WNLR, WNLB, and WNLE are the widths of numeric-label strips
+C    on the left side, on the right side, at the beginning, and at the
+C    end, of the axis.  These are both input and output parameters of
+C    AGAXIS.  On input, they specify the amount of space available for
+C    numeric labels - on output, they specify the amount of space used
+C    (if ITST .EQ. 0) or required (if ITST .NE. 0).  Each is stated as
+C    a fraction of either the width or the height of the curve window,
+C    depending on the orientation of the axis in the curve window.
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only ones
+C actually used here are ISLD, MWCM, MWCE, and MDLA.  ISLD is a solid-
+C line dash pattern (sixteen one bits).  MWCM, MWCE, and MDLA specify
+C the minimum allowed values of the width of a character in a label
+C mantissa, the width of a character in a label exponent, and the
+C distance of a label from the axis.  All are in plotter coordinate
+C units.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The AUTOGRAPH function AGFPBN is of type integer.
+C
+      INTEGER AGFPBN
+C
+C Local data required are as follows:
+C
+C BFRM is a buffer in which the routine AGNUMB returns the characters of
+C a label mantissa.  CTMP holds a sub-string from an AGPWRT call.
+C
+      CHARACTER*40 BFRM
+      CHARACTER*40 CTMP
+C
+C BFRE is a buffer in which the routine AGNUMB returns the characters of
+C a label exponent.
+C
+      CHARACTER*5 BFRE
+C
+C XMJT, YMJT, XMNT, and YMNT are used to hold x and y offsets to the
+C endpoints of left-of-label and right-of-label portions of major and
+C minor tick marks.
+C
+      DIMENSION XMJT(4),YMJT(4),XMNT(4),YMNT(4)
+C
+C SMJP is the minimum distance allowed between major tick marks, in
+C plotter coordinate units.
+C
+      DATA SMJP / 4. /
+C
+C FBGM, FBGP, FNDM, and FNDP are the coordinates of points a little on
+C either side of the beginning and end of the axis, as fractions of the
+C distance along the axis.
+C
+      DATA FBGM / -0.000001 /
+      DATA FBGP / +0.000001 /
+      DATA FNDM / +0.999999 /
+      DATA FNDP / +1.000001 /
+C
+C HCFW is an arithmetic statement function specifying the height of a
+C character as a function of its width (not counting "white space").
+C The value of the multiplier was determined heuristically, by trying
+C various values and seeing which gave the best results.
+C
+      HCFW(WDTH)=1.25*WDTH
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the initialization section of AGAXIS.
+C
+C Unpack integer values from floating-point arguments.
+C
+      ITST=IFIX(QTST)
+      ISPA=IFIX(QSPA)
+      LLUA=IFIX(QLUA)
+      NBTP=IFIX(QBTP)
+      NMNT=IFIX(QMNT)
+      NLTP=IFIX(QLTP)
+      NLEX=IFIX(QLEX)
+      NLFL=IFIX(QLFL)
+      NLOF=IFIX(QLOF)
+      NLOS=IFIX(QLOS)
+      MCIM=IFIX(QCIM)
+      MCIE=IFIX(QCIE)
+C
+C Initialize the local flags which specify what entities to draw, using
+C values appropriate for the following quick exit.
+C
+      LDAX=1-ISPA
+      LDNL=0
+      LDMN=0
+C
+C If AGAXIS is to draw only the axis, exit immediately.
+C
+      IF (ITST.LT.0) GO TO 800
+C
+C If either NBTP or BASE is zeroed, exit immediately.
+C
+      IF (NBTP.EQ.0.OR.BASE.EQ.0.) GO TO 800
+C
+C Re-initialize the flag controlling the drawing of numeric labels.
+C
+      IF (NLTP.NE.0) LDNL=1
+C
+C If this is not a test run, skip.
+C
+      IF (ITST.EQ.0) GO TO 101
+C
+C This is a test run - exit if there are no numeric labels.
+C
+      IF (LDNL.EQ.0) GO TO 800
+C
+C This is a test run and the axis is to have numeric labels - initialize
+C the numeric-label orientation and sizing parameters.  Clobber drawing.
+C
+      NLOF=MOD(NLOF+3600,360)
+      NLOS=MOD(NLOS+3600,360)
+      RFNL=1.
+      MCIM=0
+      MCIE=0
+      LDMJ=0
+      LDMN=0
+C
+C The main body of the initialization follows.
+C
+C Compute the length of the smaller side of the curve window, in the
+C plotter coordinate system.
+C
+  101 SCWP=AMIN1(WCWP,HCWP)
+C
+C Compute a set of direction numbers for the axis, in the curve-window
+C coordinate system (the change in x and y from the beginning to the
+C end of the axis).
+C
+      XDNA=XNDA-XBGA
+      YDNA=YNDA-YBGA
+C
+C Compute the length of the axis in the plotter coordinate system and
+C its direction cosines.
+C
+      XDNP=XDNA*WCWP
+      YDNP=YDNA*HCWP
+      AXLP=SQRT(XDNP*XDNP+YDNP*YDNP)
+      XDCA=XDNP/AXLP
+      YDCA=YDNP/AXLP
+C
+C Compute the axis orientation angle, in degrees counter-clockwise.
+C
+      IAOR=MOD(IFIX(57.2957795130823*ATAN2(YDCA,XDCA)+3600.5),360)
+C
+C Compute the multiplicative constants required to convert a fraction of
+C the axis length to a fraction of the width or height of the curve
+C window (a distance in x or y).
+C
+      CFAX=AXLP/WCWP
+      CFAY=AXLP/HCWP
+C
+C Compute the multiplicative constants required to convert a fraction of
+C the axis length to a fraction of the along-axis and perpendicular-to-
+C axis sides of the curve window.
+C
+      CFAA=ABS(XDCA*CFAX+YDCA*CFAY)
+      CFAP=ABS(XDCA*CFAY+YDCA*CFAX)
+C
+C Compute the quantities (UBEG) and (UDIF) for AGFTOL.
+C
+      IF (LLUA.NE.0) GO TO 102
+C
+      UBEG=UBGA
+      UDIF=UNDA-UBGA
+      GO TO 103
+C
+  102 UBEG=ALOG10(UBGA)
+      UDIF=ALOG10(UNDA)-UBEG
+C
+C SMJT and SMNT are fractions of the axis length and specify the minimum
+C space which must be available between two major ticks before the major
+C ticks themselves or the minor ticks between them, respectively, may be
+C drawn.
+C
+  103 SMJT=SMJP/AXLP
+      SMNT=SMJT*FLOAT(NMNT+1)
+C
+C Initialize the fractional numeric-label character heights.
+C
+      FHCM=0.
+      FHCE=0.
+C
+C If the axis has no numeric labels, skip the following code.
+C
+      IF (LDNL.EQ.0) GO TO 104
+C
+C Zero the numeric-label offset.
+C
+      FNLO=0.
+C
+C The numeric-label parameters are computed by an internal procedure
+C (which see, below).
+C
+      ASSIGN 104 TO JMP3
+      GO TO 500
+C
+C If this is a test run, skip the following code.
+C
+  104 IF (ITST.NE.0) GO TO 200
+C
+C This is not a test run.  First, set up the tick-mark parameters.
+C
+C Compute the multiplicative constant required to convert a fraction of
+C the smaller dimension of the grid to a fraction of the axis length.
+C
+      CSFA=SCWP/AXLP
+C
+C Compute the widths of the left and right portions of the numeric-label
+C space as fractions of the axis length, affixing an appropriate sign.
+C
+      FNLL=-WNLL/CFAP
+      FNLR=+WNLR/CFAP
+C
+C Compute a jump parameter to sort out the axis orientations.
+C
+      JAOR=1+IAOR/90
+C
+C The routine AGCTKO is used to compute the rest of the tick parameters.
+C
+      CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,   1,QJDP,
+     +             WMJL,WMJR,FNLL,FNLR,MJ12,MJ34,XMJT,YMJT)
+C
+      CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMNT,QNDP,
+     +             WMNL,WMNR,FNLL,FNLR,MN12,MN34,XMNT,YMNT)
+C
+C Set the flags controlling the drawing of tick marks.
+C
+      LDMJ=MJ12+MJ34
+      LDMN=MN12+MN34
+      LDLR=-(LDMJ+LDMN)
+C
+C If no numeric labels are to be drawn, skip the following code.
+C
+      IF (LDNL.EQ.0) GO TO 117
+C
+C Numeric labels are to be drawn.  Precompute parameters which will be
+C used to position labels relative to the axis.
+C
+C Compute the widths and heights of the longest possible label mantissa
+C and exponent, as fractions of the length of the axis.
+C
+      FWLM=FLOAT(MCIM)*FWCM
+      FWLE=FLOAT(MCIE)*FWCE
+      FHLM=FHCM
+      FHLE=FHCE
+      IF (MCIE.EQ.0) FHLE=0.
+C
+C Jump on the label-to-axis orientation.
+C
+      GO TO (105,106,107,108) , JLAO
+C
+C Label is at a 0-degree angle to the axis.
+C
+  105 FBLP=-FHLM
+      GO TO 109
+C
+C Label is at a 90-degree angle to the axis.
+C
+  106 FBLA=0.
+      FBLQ=-FWLM-FWLE
+      GO TO 110
+C
+C Label is at a 180-degree angle to the axis.
+C
+  107 FBLP=FHLM+FHLE
+      GO TO 109
+C
+C Label is at a 270-degree angle to the axis.
+C
+  108 FBLA=0.
+      FBLQ=FWLM+FWLE
+      GO TO 110
+C
+C Label is parallel to the axis.
+C
+  109 FNLW=FHLM+.5*FHLE
+      FBLQ=0.
+      GO TO 111
+C
+C Label is perpendicular to the axis.
+C
+  110 FNLW=FWLM+FWLE
+      FBLP=0.
+C
+C If the labels will not fit in the space provided, clobber them.
+C
+  111 IF (.999999*FNLW.LT.FNLR-FNLL) GO TO 112
+C
+      LDNL=0
+      GO TO 117
+C
+C Jump on the signed value of the numeric-label distance from the axis.
+C
+  112 IF (DNLA) 113,114,115
+C
+C Labels are to the right of the axis.
+C
+  113 FNLC=FDLA+.5*FNLW
+      FBLP=FDLA+.5*ABS(FBLP-FHLE)
+      FBLQ=FDLA+.5*ABS(FBLQ+FWLM-FWLE)
+      GO TO 116
+C
+C Labels are centered on the axis.
+C
+  114 FNLC=0.
+      FBLP=0.
+      FBLQ=0.
+      GO TO 116
+C
+C Labels are to the left of the axis.
+C
+  115 FNLC=-(FDLA+.5*FNLW)
+      FBLP=-(FDLA+.5*ABS(FBLP))
+      FBLQ=-(FDLA+.5*ABS(FBLQ-FWLM+FWLE))
+C
+  116 FNLO=.5*(FNLL+FNLR)-FNLC
+C
+C If the axis would pass through the offset labels, clobber it.
+C
+      IF (FNLL*FNLR.LT.0.) LDAX=0
+C
+C Jump to draw numeric labels and/or tick marks.
+C
+      GO TO 200
+C
+C No numeric labels are to be drawn.  If no tick marks are to be drawn
+C either, exit.
+C
+  117 IF (LDLR.EQ.0) GO TO 800
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following code directs the process of tick-marking and labelling
+C the axis, using the internal procedures which follow it.  If the
+C label-coordinate-system value 0 maps onto the axis, tick-marking and
+C labelling are done in two passes, one starting at 0 and proceeding
+C in a positive direction and the other starting at 0 and proceeding
+C in a negative direction.  If the label-coordinate-system value 0 does
+C not map onto the axis, only one pass is required.
+C
+C First, determine the label-coordinate-system values VBGM and VNDP at
+C the points FBGM and FNDP, a little beyond the ends of the axis.
+C
+  200 CALL AGFTOL (IAXS,1,FBGM,VBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+      CALL AGFTOL (IAXS,1,FNDP,VNDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+C
+C If zero falls on the axis, jump to the two-pass section of the code.
+C
+      IF (VBGM*VNDP.LE.0.) GO TO 201
+C
+C We may tick-mark and label the axis in a single pass.  Compute an
+C appropriate starting value for the exponent/multiplier EXMU.
+C
+      SBSE=SIGN(BASE,VBGM)
+      CALL AGFTOL (IAXS,2,FBGM,EBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      CALL AGFTOL (IAXS,2,FNDP,ENDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      EXMU=AMIN1(EBGM,ENDP)
+      EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU)
+C
+C Set the numeric-label-space limits for the beginning and end of the
+C axis.
+C
+      FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE)
+      FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE)
+C
+C Jump to an internal procedure to tick-mark and label the axis.  Return
+C from there to the termination section of AGAXIS.
+C
+      ASSIGN 800 TO JMP1
+      GO TO 300
+C
+C Tick marks and labels must be done in two passes.  First, draw the
+C tick mark and/or label at the zero position in the label system, using
+C an internal procedure below.  A number of parameters must be preset.
+C
+  201 CALL AGFTOL (IAXS,-1,0.,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+C
+C Determine whether label is to be drawn or not.
+C
+      LDLB=0
+      IF (LDNL.EQ.0) GO TO 202
+      LDLB=1
+C
+C The mantissa portion of the label consists of the single character 0.
+C
+      BFRM(1:1)='0'
+      NCIM=1
+      IPXM=0
+C
+C The label has no exponent portion.
+C
+      NCIE=0
+C
+C Allow the user to change the numeric label.
+C
+      CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE)
+C
+C Compute the length of the mantissa, the exponent, and the whole label.
+C
+      FLLM=FLOAT(NCIM)*FWCM
+      FLLE=FLOAT(NCIE)*FWCE
+      FLLB=FLLM+FLLE
+C
+C The numeric-label space begins and ends at impossible values.
+C
+      FNLB=-10.
+      FNLE=+10.
+C
+C Force the labeler to update FNLB, rather than FNLE.
+C
+      FDIR=1.
+C
+C Jump to an internal procedure to draw the label and/or the tick mark.
+C
+  202 ASSIGN 203 TO JMP2
+      GO TO 400
+C
+C Save the position of the zero-point (FRAX, expressed as a fraction of
+C the axis length) and preset the parameter DZRT, which is the minimum
+C distance from the zero-point at which a major tick mark could occur,
+C and the parameter DZRL, which is the minimum distance from the zero-
+C point at which a label could occur.  Set the label-space limit FNLE.
+C Preset the internal-procedure exit parameter JMP1.
+C
+  203 ASSIGN 205 TO JMP1
+      FZRO=FRAX
+      DZRT=AMAX1(SMJT,1.6*FLOAT(LDNL)*FHCM)
+      IF (LDNL.EQ.0) GO TO 204
+      DZRL=FNLB-FZRO
+      FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE)
+C
+C Do the portion of the axis lying in the direction specified by DZRT.
+C If it is too short, skip it entirely.
+C
+  204 FRAX=FZRO+DZRT
+      IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800)
+C
+C Find out whether BASE must be negated for this portion.
+C
+      CALL AGFTOL (IAXS,1,FRAX,VLCS,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+      SBSE=SIGN(BASE,VLCS)
+C
+C Compute a starting value of the exponent/multiplier EXMU.
+C
+      CALL AGFTOL (IAXS,2,FRAX,EXMU,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU)
+C
+C Jump to an internal procedure to draw the tick marks and/or labels.
+C
+      GO TO 300
+C
+C Set up to do the second portion of the axis, then go do it.
+C
+  205 ASSIGN 800 TO JMP1
+      DZRT=-DZRT
+      IF (LDNL.EQ.0) GO TO 204
+      FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE)
+      FNLE=FZRO-DZRL
+      GO TO 204
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP1.  Its purpose is to tick-mark and label a portion of the
+C axis (perhaps the entire axis) at positions determined by consecutive
+C values of the parameter EXMU.  It prevents tick marks from piling up
+C or passing through the label space and prevents overlapping of labels.
+C Tick marks are drawn alternately from left to right or vice-versa.
+C
+C The caller has provided an initial value of EXMU, but we must consider
+C possible minor tick marks in the interval (EXMU-1.,EXMU).
+C
+  300 EXMU=EXMU-1.
+C
+C Compute FRAX, which is the fractional distance along the axis, and
+C VLCS, which is the value in the label coordinate system corresponding
+C to the current value of EXMU.
+C
+      CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+C
+C Move the current values of EXMU, FRAX, and VLCS to ELST, FLST, and
+C VLST, specifying the last values of these parameters.  Then increment
+C EXMU by 1. and recompute FRAX and VLCS.  (The loop through consecutive
+C values of EXMU begins here.)
+C
+  301 ELST=EXMU
+      FLST=FRAX
+      VLST=VLCS
+C
+      EXMU=EXMU+1.
+      CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+C
+C FDIR indicates the direction, FDST the magnitude, of step along axis.
+C
+      FDIR=FRAX-FLST
+      FDST=ABS(FDIR)
+C
+C Draw minor tick marks, if any, in the interval (FLST,FRAX).
+C
+      IF (LDMN.EQ.0.OR.FDST.LT.SMNT) GO TO 304
+C
+C Use the dashed-line pattern for minor tick marks.
+C
+      CALL DASHDB (AGFPBN(QNDP))
+C
+C Minor tick marks are equally spaced in the label-coordinate system.
+C
+      VINC=(VLCS-VLST)/FLOAT(NMNT+1)
+C
+      DO 303 I=1,NMNT
+        VMNT=VLST+VINC*FLOAT(I)
+        CALL AGFTOL (IAXS,-1,VMNT,FMNT,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,
+     +                                                             SBSE)
+        IF (FMNT.LT.FBGP.OR.FMNT.GT.FNDM) GO TO 303
+        XPAX=XBGA+FMNT*XDNA
+        YPAX=YBGA+FMNT*YDNA
+        LDLR=-LDLR
+        IF (LDLR.LT.0) GO TO 302
+        CALL AGCHAX (0,IAXS,3,VMNT)
+        IF (MN12.NE.0) CALL LINED (XPAX+XMNT(1),YPAX+YMNT(1),
+     +                             XPAX+XMNT(2),YPAX+YMNT(2))
+        IF (MN34.NE.0) CALL LINED (XPAX+XMNT(3),YPAX+YMNT(3),
+     +                             XPAX+XMNT(4),YPAX+YMNT(4))
+        CALL AGCHAX (1,IAXS,3,VMNT)
+        GO TO 303
+  302   CALL AGCHAX (0,IAXS,3,VMNT)
+        IF (MN34.NE.0) CALL LINED (XPAX+XMNT(4),YPAX+YMNT(4),
+     +                             XPAX+XMNT(3),YPAX+YMNT(3))
+        IF (MN12.NE.0) CALL LINED (XPAX+XMNT(2),YPAX+YMNT(2),
+     +                             XPAX+XMNT(1),YPAX+YMNT(1))
+        CALL AGCHAX (1,IAXS,3,VMNT)
+  303 CONTINUE
+C
+C If the end of the axis has been reached, return to caller.
+C
+  304 IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800)
+C
+C Draw the major tick mark and/or the numeric label at FRAX.
+C
+      IF (FDST.LT.SMJT) GO TO 301
+      LDLB=0
+      IF (LDNL.EQ.0) GO TO 305
+      CALL AGNUMB (NBTP,SBSE,EXMU,NLTP,NLEX,NLFL,BFRM,40,NCIM,IPXM,BFRE,
+     +                                                           5,NCIE)
+      CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE)
+C
+C If this is not a test run, mantissa and exponent length are checked.
+C
+      IF (ITST.EQ.0.AND.(NCIM.GT.MCIM.OR.NCIE.GT.MCIE)) GO TO 305
+      LDLB=1
+      FLLM=FLOAT(NCIM)*FWCM
+      FLLE=FLOAT(NCIE)*FWCE
+      FLLB=FLLM+FLLE
+C
+C Use the next internal procedure to draw the major tick and/or label.
+C
+  305 ASSIGN 301 TO JMP2
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP2.  Its purpose is to draw the major tick mark and/or the
+C numeric label at a specified point on the axis or, if ITST is .NE. 0,
+C to predict the amount of space which will be required for such items.
+C
+C Jump if no label is to be drawn.
+C
+  400 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 410
+C
+C See if the label will fit without overlapping another label.  To do
+C this, first compute its fractional length along the axis (FLAA).
+C
+      GO TO (401,402,401,402) , JLAO
+C
+C Label is parallel to the axis.  Allow for inter-label spacing.
+C
+  401 FLAA=FLLB+FWCM
+      GO TO 403
+C
+C Label is perpendicular to the axis.  Ignore exponent portion.
+C
+  402 FLAA=1.6*FHCM
+C
+C Compute the fractional coordinates of the endpoints of the label
+C (along the axis) and see if it will fit in the available label space.
+C
+  403 FLBB=FRAX-.5*FLAA
+      FLBE=FRAX+.5*FLAA
+C
+      IF (FLBB.GE.FNLB.AND.FLBE.LE.FNLE) GO TO 407
+C
+C Label will not fit.  Omit it or, if this is a test run, see if any
+C remedial action is to be taken.
+C
+      LDLB=0
+      IF (ITST.EQ.0) GO TO 411
+C
+C This is a test run and we have two consecutive labels which overlap.
+C See what can be done about it.
+C
+      GO TO (424,404,406,404) , ITST
+C
+C We are allowed to shrink the labels.  See if they are minimum-size
+C already.  If so, the only other possibility is to re-orient them.
+C
+  404 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 405
+C
+C If not, shrink them by an amount based on the extent of the overlap,
+C reset the parameters affected, and start from square one.
+C
+      RFNL=AMIN1(.9,FDST/(FDST+AMAX1(FNLB-FLBB,FLBE-FNLE)))*RFNL
+      MCIM=0
+      MCIE=0
+      ASSIGN 200 TO JMP3
+      GO TO 500
+C
+C If labels have already been shrunk to minimum size, see if we can
+C re-orient them.  If not, at least continue with finding the maximum
+C mantissa and exponent lengths.
+C
+  405 IF (ITST.NE.4) GO TO 424
+C
+C Try re-orienting the labels.  If this has already been tried, or it it
+C would be pointless, skip it, but continue with finding the maximum
+C mantissa and exponent lengths.
+C
+  406 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.2.OR.JLAO.EQ.4) GO TO 424
+C
+C If re-orienting makes sense, reset the appropriate parameters and
+C start from square one.
+C
+      NLOF=NLOF-360
+      RFNL=1.
+      MCIM=0
+      MCIE=0
+      ASSIGN 200 TO JMP3
+      GO TO 500
+C
+C Label will fit.  Update the label space limits for next time.
+C
+  407 IF (FDIR.GE.0.) GO TO 408
+      FNLE=FLBB
+      GO TO 409
+  408 FNLB=FLBE
+C
+C If this is not just a test shot, go off and draw the tick mark/label.
+C
+  409 IF (ITST.EQ.0) GO TO 411
+C
+C If this is a test shot, update the maximum mantissa and exponent
+C lengths being generated and exit from this internal procedure.
+C
+      MCIM=MAX0(MCIM,NCIM)
+      MCIE=MAX0(MCIE,NCIE)
+      GO TO 424
+C
+C No label is to be drawn.  If this is a test shot, exit from this
+C internal procedure without drawing the tick mark.
+C
+  410 IF (ITST.NE.0) GO TO 424
+C
+C Compute x and y coordinates of current axis point.
+C
+  411 XPAX=XBGA+FRAX*XDNA
+      YPAX=YBGA+FRAX*YDNA
+C
+C Jump if no major tick-mark is to be drawn.  Otherwise, set up the
+C dash pattern for major tick-marks.
+C
+      IF (LDMJ.EQ.0) GO TO 414
+      CALL DASHDB (AGFPBN(QJDP))
+C
+C Flip the left-to-right/right-to-left direction flag.
+C
+      LDLR=-LDLR
+C
+C Draw the first portion of the tick mark.
+C
+      IF (LDLR) 413,414,412
+C
+  412 IF (MJ12.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(1),YPAX+YMJT(1),XPAX+XMJT(2),YPAX+YMJT(2))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+      GO TO 414
+C
+  413 IF (MJ34.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(4),YPAX+YMJT(4),XPAX+XMJT(3),YPAX+YMJT(3))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+C
+C Draw the label, if any.
+C
+  414 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 421
+C
+C Compute the distances from (XPAX,YPAX) to the beginning of the label -
+C along the axis (FBLA) and perpendicular to the axis (FBLP).  Each is a
+C directed distance whose magnitude represents a fraction of the length
+C of the axis.  The values depend on the label/axis orientation and the
+C distance of the label from the axis.  In some cases, these quantities,
+C or portions of them, have already been computed.
+C
+      GO TO (415,416,417,418) , JLAO
+C
+C Label is at a 0-degree angle to the axis.
+C
+  415 FBLA=-.5*FLLB
+      GO TO 419
+C
+C Label is at a 90-degree angle to the axis.
+C
+  416 FBLP=FBLQ+FLLM
+      IF (DNLA.EQ.0.) FBLP=.5*FLLB
+      GO TO 419
+C
+C Label is at a 180-degree angle to the axis.
+C
+  417 FBLA=.5*FLLB
+      GO TO 419
+C
+C Label is at a 270-degree angle to the axis.
+C
+  418 FBLP=FBLQ-FLLM
+      IF (DNLA.EQ.0.) FBLP=-.5*FLLB
+C
+C Draw the mantissa portion of the label (excluding the "X", if any).
+C
+  419 DEEX=FBLA*XDCA+(FBLP+FNLO)*YDCA
+      DEEY=FBLA*YDCA-(FBLP+FNLO)*XDCA
+      CALL AGCHAX (0,IAXS,4,VLCS)
+      IF (IPXM.EQ.0) THEN
+        CALL AGPWRT (XPAX+CFAX*DEEX,
+     +               YPAX+CFAY*DEEY,BFRM,NCIM,IWCM,NLOR,-1)
+      ELSE
+        CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-3.*FWCM)*XDCL),
+     +               YPAX+CFAY*(DEEY+(FLLM-3.*FWCM)*YDCL),
+     +               BFRM,IPXM-1,IWCM,NLOR,+1)
+        CTMP=BFRM(IPXM+1:NCIM)
+        CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-2.*FWCM)*XDCL),
+     +               YPAX+CFAY*(DEEY+(FLLM-2.*FWCM)*YDCL),
+     +               CTMP,NCIM-IPXM,IWCM,NLOR,-1)
+      END IF
+      DEEX=DEEX+FLLM*XDCL
+      DEEY=DEEY+FLLM*YDCL
+C
+C Draw the "X" portion of the mantissa, if it was left out above.
+C
+      IF (IPXM.EQ.0) GO TO 420
+      DEEX=DEEX-2.5*FWCM*XDCL
+      DEEY=DEEY-2.5*FWCM*YDCL
+      CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL-YDCL)),
+     +           YPAX+CFAY*(DEEY-.3*FWCM*(YDCL+XDCL)),
+     +           XPAX+CFAX*(DEEX+.3*FWCM*(XDCL-YDCL)),
+     +           YPAX+CFAY*(DEEY+.3*FWCM*(YDCL+XDCL)))
+      CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL+YDCL)),
+     +           YPAX+CFAY*(DEEY-.3*FWCM*(YDCL-XDCL)),
+     +           XPAX+CFAX*(DEEX+.3*FWCM*(XDCL+YDCL)),
+     +           YPAX+CFAY*(DEEY+.3*FWCM*(YDCL-XDCL)))
+      DEEX=DEEX+2.5*FWCM*XDCL
+      DEEY=DEEY+2.5*FWCM*YDCL
+  420 CALL AGCHAX (1,IAXS,4,VLCS)
+C
+C Draw the exponent portion of the label (if it has one).
+C
+      IF (NCIE.EQ.0) GO TO 421
+      DEEX=DEEX-.5*FHCM*YDCL
+      DEEY=DEEY+.5*FHCM*XDCL
+      CALL AGCHAX (0,IAXS,5,VLCS)
+      CALL AGPWRT (XPAX+CFAX*DEEX,YPAX+CFAY*DEEY,BFRE,NCIE,IWCE,NLOR,-1)
+      CALL AGCHAX (1,IAXS,5,VLCS)
+C
+C Draw the second portion of the tick mark, if any.
+C
+  421 IF (LDLR) 423,424,422
+C
+  422 IF (MJ34.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(3),YPAX+YMJT(3),XPAX+XMJT(4),YPAX+YMJT(4))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+      GO TO 424
+C
+  423 IF (MJ12.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(2),YPAX+YMJT(2),XPAX+XMJT(1),YPAX+YMJT(1))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+C
+C Exit from internal procedure.
+C
+  424 GO TO JMP2 , (203,301)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP3.  Its purpose is to compute all numeric-label parameters
+C required by AGAXIS.
+C
+C Compute the desired label orientation and its direction cosines.
+C
+  500 NLOR=NLOF
+      IF (NLOR.LT.0) NLOR=NLOS
+C
+      XDCL=COS(.017453292519943*FLOAT(NLOR))
+      YDCL=SIN(.017453292519943*FLOAT(NLOR))
+C
+C Compute JLAO, which is a computed-go-to jump parameter specifying the
+C label-to-axis orientation.
+C
+      JLAO=1+MOD(NLOR-IAOR+3600,360)/90
+C
+C Compute the width of a character in the label mantissa, the width of a
+C character in the label exponent, and the distance of a label from the
+C axis, in the plotter coordinate system.
+C
+      IWCM=MAX0(MWCM,IFIX(RFNL*ABS(WCLM)*SCWP+.5))
+      IWCE=MAX0(MWCE,IFIX(RFNL*ABS(WCLE)*SCWP+.5))
+      IDLA=MAX0(MDLA,IFIX(RFNL*ABS(DNLA)*SCWP+.5))
+C
+C Compute the same quantities as fractions of the axis length.
+C
+      FWCM=FLOAT(IWCM)/AXLP
+      FWCE=FLOAT(IWCE)/AXLP
+      FDLA=FLOAT(IDLA)/AXLP
+C
+C Compute character heights as fractions of the axis length.
+C
+      FHCM=HCFW(FWCM)
+      FHCE=HCFW(FWCE)
+C
+C Return to internal-procedure caller.
+C
+      GO TO JMP3 , (104,200,801)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the termination section of AGAXIS.
+C
+C Update the parameters WNLL and WNLR to reflect the amount of space
+C used/needed for numeric labels to the left and right of the axis.
+C
+  800 IF (LDNL.NE.0) GO TO 801
+C
+C No numeric labels occur on the axis.  Zero WNLL and WNLR and jump.
+C
+      WNLL=0.
+      WNLR=0.
+      GO TO 815
+C
+C Numeric labels do occur on the axis.  Compute the space required.
+C
+  801 GO TO (802,803,802,803) , JLAO
+C
+C Labels are parallel to the axis.
+C
+  802 FNLW=FHCM
+      IF (MCIE.NE.0) FNLW=FNLW+.5*FHCE
+      GO TO 804
+C
+C Labels are perpendicular to the axis.
+C
+  803 FNLW=FLOAT(MCIM)*FWCM+FLOAT(MCIE)*FWCE
+C
+C Jump on the numeric-label-distance-from-axis parameter DNLA.
+C
+  804 IF (DNLA) 805,806,807
+C
+C Labels are to the right of the axis.
+C
+  805 FNLL=-FDLA
+      FNLR=+FDLA+FNLW
+      GO TO 808
+C
+C Labels are centered on the axis.
+C
+  806 FNLL=+.5*FNLW
+      FNLR=+.5*FNLW
+      GO TO 808
+C
+C Labels are to the left of the axis.
+C
+  807 FNLL=+FDLA+FNLW
+      FNLR=-FDLA
+C
+C Adjust FNLL and FNLR as implied by the numeric-label offset.
+C
+  808 FNLL=FNLL-FNLO
+      FNLR=FNLR+FNLO
+C
+C If this is not a test run, jump to reset WNLL and WNLR.
+C
+      IF (ITST.EQ.0) GO TO 814
+C
+C If this is a test run, see if the labels will fit.  Jump if so.
+C
+      IF (CFAP*FNLL.LE.WNLL.AND.CFAP*FNLR.LE.WNLR) GO TO 814
+C
+C If the labels will not fit, we have a problem.  We may or may not be
+C able to do anything about it, depending on ITST.
+C
+      GO TO (814,809,813,809) , ITST
+C
+C We are allowed to shrink the labels.  See if they are minimum-size
+C already.  If so, the only other possibility is to re-orient them.
+C
+  809 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 812
+C
+C If not, shrink them by an amount based on the extent of the problem,
+C reset the parameters affected and see if the problem is solved.
+C
+      IF (WNLR+WNLL.GT.0.) GO TO 810
+C
+      RFNL=.000001*RFNL
+      GO TO 811
+C
+  810 RFNL=AMIN1(.9,(WNLL+WNLR)/(CFAP*(FNLL+FNLR)))*RFNL
+C
+  811 ASSIGN 801 TO JMP3
+      GO TO 500
+C
+C If labels have already been shrunk to minimum size, see if we can
+C re-orient them.  If not, give up.
+C
+  812 IF (ITST.NE.3) GO TO 814
+C
+C Try re-orienting the labels.  If this has already been tried, or if it
+C would be pointless, give up.
+C
+  813 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.1.OR.JLAO.EQ.3) GO TO 814
+C
+C If re-orienting makes sense, reset the parameters affected and see if
+C the problem is solved.
+C
+      NLOF=NLOF-360
+      RFNL=1.
+      ASSIGN 801 TO JMP3
+      GO TO 500
+C
+C Reset WNLL and WNLR for caller.
+C
+  814 WNLL=FNLL*CFAP
+      WNLR=FNLR*CFAP
+C
+C If this is a test run, we are now done.
+C
+  815 IF (ITST.GT.0) GO TO 816
+C
+C Draw the axis, if it is to be drawn.
+C
+      IF (LDAX.EQ.0) GO TO 816
+C
+      CALL DASHDB (ISLD)
+      CALL AGCHAX (0,IAXS,1,0.)
+      CALL LINED (XBGA,YBGA,XNDA,YNDA)
+      CALL AGCHAX (1,IAXS,1,0.)
+C
+C Pack up integer values which might have been changed into the
+C corresponding floating-point arguments.
+C
+  816 QLOF=FLOAT(NLOF)
+      QLOS=FLOAT(NLOS)
+      QCIM=FLOAT(MCIM)
+      QCIE=FLOAT(MCIE)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agback.f b/sys/gio/ncarutil/autograph/agback.f
new file mode 100644
index 00000000..108d2b66
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agback.f
@@ -0,0 +1,152 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGBACK
+C
+C The subroutine AGBACK is used to draw a graph background, as directed
+C by the current contents of the parameter list.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Declare the block data routine external to force it to load.
+C
+C +NOAO - Block data replaced with run time initialization subroutine.
+C
+C     EXTERNAL AGDFLT
+      call agdflt
+C     
+C -NOAO
+C
+C Do an appropriate SET call for the following routines.  The call is
+C equivalent to "CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1)", but
+C makes the viewport cover the whole plotter frame, which avoids the
+C problems resulting from clipping by GKS.
+C
+      CALL SET (0.,1.,0.,1.,-XLCW/(XRCW-XLCW),(1.-XLCW)/(XRCW-XLCW),
+     +                      -YBCW/(YTCW-YBCW),(1.-YBCW)/(YTCW-YBCW),1)
+C
+C Draw the labels, if any, first.
+C
+      IDLB=IFIX(QDLB)
+      IF (IDLB.EQ.0) GO TO 101
+C
+      LBIM=IFIX(QBIM)
+      CALL AGLBLS (IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+C Now draw each of the four axes.
+C
+  101 I=0
+C
+  102 I=I+1
+C
+      IF (I.EQ.5) GO TO 108
+C
+      IF (QDAX(I).EQ.0.) GO TO 102
+C
+      GO TO (103,104,105,106) , I
+C
+C Y axis - left.
+C
+  103 WNLB(1)=0.-YBGW
+      IF (XBGA(1)-WNLL(1).LT.DBOX(3,2).AND.
+     +                XBGA(1)+WNLR(1).GT.DBOX(3,1)) WNLB(1)=0.-DBOX(3,4)
+C
+      WNLE(1)=YTGW-1.
+      IF (XBGA(1)-WNLL(1).LT.DBOX(4,2).AND.
+     +                XBGA(1)+WNLR(1).GT.DBOX(4,1)) WNLE(1)=DBOX(4,3)-1.
+C
+      GO TO 107
+C
+C Y axis - right.
+C
+  104 WNLB(2)=YTGW-1.
+      IF (XBGA(2)-WNLR(2).LT.DBOX(4,2).AND.
+     +                XBGA(2)+WNLL(2).GT.DBOX(4,1)) WNLB(2)=DBOX(4,3)-1.
+C
+      WNLE(2)=0.-YBGW
+      IF (XBGA(2)-WNLR(2).LT.DBOX(3,2).AND.
+     +                XBGA(2)+WNLL(2).GT.DBOX(3,1)) WNLE(2)=0.-DBOX(3,4)
+C
+      GO TO 107
+C
+C X axis - bottom.
+C
+  105 WNLB(3)=XRGW-1.
+      IF (YBGA(3)-WNLL(3).LT.DBOX(2,4).AND.
+     +                YBGA(3)+WNLR(3).GT.DBOX(2,3)) WNLB(3)=DBOX(2,1)-1.
+C
+      WNLE(3)=0.-XLGW
+      IF (YBGA(3)-WNLL(3).LT.DBOX(1,4).AND.
+     +                YBGA(3)+WNLR(3).GT.DBOX(1,3)) WNLE(3)=0.-DBOX(1,2)
+C
+      GO TO 107
+C
+C X axis - top.
+C
+  106 WNLB(4)=0.-XLGW
+      IF (YBGA(4)-WNLR(4).LT.DBOX(1,4).AND.
+     +                YBGA(4)+WNLL(4).GT.DBOX(1,3)) WNLB(4)=0.-DBOX(1,2)
+C
+      WNLE(4)=XRGW-1.
+      IF (YBGA(4)-WNLR(4).LT.DBOX(2,4).AND.
+     +                YBGA(4)+WNLL(4).GT.DBOX(2,3)) WNLE(4)=DBOX(2,1)-1.
+C
+  107 Q=AMIN1(0.,QDAX(I))
+C
+      CALL AGAXIS (I,Q,
+     +             QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I),XNDA(I),YNDA(I),
+     +             QLUA(I),UBGA(I),UNDA(I),FUNS(I),QBTP(I),BASE(I),
+     +             QJDP(I),WMJL(I),WMJR(I),QMNT(I),QNDP(I),WMNL(I),
+     +             WMNR(I),QLTP(I),QLEX(I),QLFL(I),QLOF(I),QLOS(I),
+     +             DNLA(I),WCLM(I),WCLE(I),RFNL(I),QCIM(I),QCIE(I),
+     +             WNLL(I),WNLR(I),WNLB(I),WNLE(I))
+C
+      GO TO 102
+C
+C Do set call for user and return.
+C
+  108 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agbnch.f b/sys/gio/ncarutil/autograph/agbnch.f
new file mode 100644
index 00000000..4aee636a
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agbnch.f
@@ -0,0 +1,35 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      CHARACTER*16 FUNCTION AGBNCH (IDSH)
+C
+C The value of this function is the character-dash-pattern equivalent of
+C the integer dash pattern IDSH, a string of quotes and/or dollar signs.
+C Note that the support routines IAND and ISHIFT are used.
+C
+      KDSH=IDSH
+C
+      DO 101 I=16,1,-1
+        IF (IAND(KDSH,1).EQ.0) THEN
+          AGBNCH(I:I)=''''
+        ELSE
+          AGBNCH(I:I)='$'
+        END IF
+        KDSH=ISHIFT(KDSH,-1)
+  101 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchax.f b/sys/gio/ncarutil/autograph/agchax.f
new file mode 100644
index 00000000..451bce5c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchax.f
@@ -0,0 +1,41 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHAX (IFLG,IAXS,IPRT,VILS)
+C
+C The routine AGCHAX is called by AGAXIS just before and just after each
+C of a selected set of objects on the axes are drawn.  A user may supply
+C a version to change the appearance of these objects.  The arguments
+C are as follows:
+C
+C - IFLG is zero if a particular object is about to be drawn, non-zero
+C   if it has just been drawn.
+C
+C - IAXS is the number of the axis in question.  The values 1, 2, 3, and
+C   4 imply the right, left, bottom, and top axes, respectively.
+C
+C - IPRT is an integer implying which part of the axis is being drawn.
+C   The value 1 implies the line itself, 2 a major tick, 3 a minor tick,
+C   4 the mantissa of a label, and 5 the exponent of a label.
+C
+C - VILS is the value, in the label coordinate system along the axis,
+C   associated with the position of the object being drawn.  IPRT=1
+C   implies VILS=0.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchcu.f b/sys/gio/ncarutil/autograph/agchcu.f
new file mode 100644
index 00000000..1364ad28
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchcu.f
@@ -0,0 +1,44 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHCU (IFLG,KDSH)
+C
+C The routine AGCHCU is called by AGCURV just before and just after each
+C curve is drawn.  The default version does nothing.  A user may supply
+C a version to change the appearance of the curves.  The arguments are
+C as follows:
+C
+C - IFLG is zero if a curve is about to be drawn, non-zero if a curve
+C   has just been drawn.
+C
+C - KDSH is the last argument of AGCURV, as follows:
+C
+C      AGCURV called by   Value of KDSH
+C      ----------------   ----------------------------------------
+C      EZY                1
+C      EZXY               1
+C      EZMY               "n" or "-n", where n is the curve number
+C      EZMXY              "n" or "-n", where n is the curve number
+C      the user program   the user value
+C
+C   The sign of KDSH, when AGCURV is called by EZMY or EZMXY, indicates
+C   whether the "user" dash patterns or the "alphabetic" dash patterns
+C   were selected for use.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchil.f b/sys/gio/ncarutil/autograph/agchil.f
new file mode 100644
index 00000000..1952cf68
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchil.f
@@ -0,0 +1,36 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHIL (IFLG,LBNM,LNNO)
+C
+      CHARACTER*(*) LBNM
+C
+C The routine AGCHIL is called by AGLBLS just before and just after each
+C informational-label line of text is drawn.  The default version does
+C nothing.  A user may supply a version to change the appearance of the
+C text lines.  The arguments are as follows:
+C
+C - IFLG is zero if a text line is about to be drawn, non-zero if one
+C   has just been drawn.
+C
+C - LBNM is the name of the label containing the line in question.
+C
+C - LNNO is the number of the line.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchnl.f b/sys/gio/ncarutil/autograph/agchnl.f
new file mode 100644
index 00000000..3b42a5f6
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchnl.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE)
+C
+      CHARACTER*(*) CHRM,CHRE
+C
+C The routine AGCHNL is called by AGAXIS just after it has set up the
+C character strings comprising a numeric label along an axis.  The
+C default version does nothing.  A user may supply his own version to
+C change the numeric labels.  For each numeric label, this routine is
+C called twice by AGAXIS - once to determine how much space will be
+C required when the label is actually drawn and once just before it
+C is actually drawn.  The arguments are as follows:
+C
+C - IAXS is the number of the axis being drawn.  Its value is 1, 2, 3,
+C   or 4, implying the left, right, bottom, or top axes, respectively.
+C   The value of IAXS must not be altered.
+C
+C - VILS is the value to be represented by the numeric label, in the
+C   label system for the axis.  The value of VILS must not be altered.
+C
+C - CHRM, on entry, is a character string containing the mantissa of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  If the
+C   numeric label includes a "times" symbol, it will be represented by
+C   a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C - MCIM is the length of CHRM - the maximum number of characters that
+C   it will hold.  The value of MCIM must not be altered.
+C
+C - NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C   CHRM is changed, NCIM should be changed accordingly.
+C
+C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it
+C   is non-zero, it is the index of the appropriate character position
+C   in CHRM.  If AGCHNL changes the position of the "times" symbol in
+C   CHRM, removes it, or adds it, the value of IPXM must be changed.
+C
+C - CHRE, on entry, is a character string containing the exponent of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  CHRE
+C   may be modified.
+C
+C - MCIE is the length of CHRE - the maximum number of characters that
+C   it will hold.  The value of MCIE must not be altered.
+C
+C - NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C   CHRE is changed, NCIE should be changed accordingly.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agctcs.f b/sys/gio/ncarutil/autograph/agctcs.f
new file mode 100644
index 00000000..d9f67d5f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agctcs.f
@@ -0,0 +1,79 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCTCS (TPID,ITCS)
+C
+      CHARACTER*(*) TPID
+C
+C The routine AGCTCS is called by the routines AGGETC and AGSETC to
+C check what type of character-string parameter is implied by the
+C parameter identifier TPID and return an appropriate value of ITCS, as
+C follows:
+C
+C -- ITCS = 0 implies that the parameter is not intrinsically of type
+C    character and that AGGETC/AGSETC should not have been called in
+C    the way that it was.
+C
+C -- ITCS = 1 implies a dash-pattern parameter.
+C
+C -- ITCS = 2 implies a label name.
+C
+C -- ITCS = 3 implies the line-end character.
+C
+C -- ITCS = 4 implies the text of some line of some label.
+C
+C Find out where in the parameter list the requested parameter lies.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C See if it's a dash pattern.
+C
+      CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP)
+      IF (LOPA.GE.LODP.AND.LOPA.LE.LODP+NIDP-1) THEN
+        ITCS=1
+        RETURN
+      END IF
+C
+C See if it's a label name.
+C
+      CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN) THEN
+        ITCS=2
+        RETURN
+      END IF
+C
+C See if it's the line-end character.
+C
+      CALL AGSCAN ('LINE/END .',LOLE,NILE,IILE)
+      IF (LOPA.EQ.LOLE) THEN
+        ITCS=3
+        RETURN
+      END IF
+C
+C See if it's the text of some label line.
+C
+      CALL AGSCAN ('LINE/BUFF/CONT.',LOLB,NILB,IILB)
+      IF (LOPA.GE.LOLB.AND.LOPA.LE.LOLB+NILB-1.AND.
+     +                                       MOD(LOPA-LOLB,6).EQ.3) THEN
+        ITCS=4
+        RETURN
+      END IF
+C
+C Error - type not recognizable.
+C
+      ITCS=0
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agctko.f b/sys/gio/ncarutil/autograph/agctko.f
new file mode 100644
index 00000000..105438cc
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agctko.f
@@ -0,0 +1,150 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMMT,
+     +                   QMDP,WMML,WMMR,FNLL,FNLR,MM12,MM34,XMMT,YMMT)
+C
+      DIMENSION XMMT(4),YMMT(4)
+C
+C The routine AGCTKO is used to compute the x and y offsets to the end-
+C points of the left-of-label and right-of-label portions of the major
+C and minor tick marks.  See AGAXIS for definitions of the arguments.
+C
+C A note about WMML and WMMR:  Each is a positive number, of the form
+C (E) or (1+E), where E (=EPSILON) is .LT. 1. and is expressed as a
+C fraction of the smaller side of the curve window.  If the form (E) is
+C used, it implies just a tick of length E; if the form (1+E) is used,
+C it implies a tick long enough to reach the edge of the curve window,
+C plus the length E.
+C
+C If the tick-mark count NMMT .EQ. 0 or the tick-mark dash pattern QMDP
+C .EQ. 0 or both the left-of-axis and right-of-axis tick-mark lengths
+C WMML and WMMR .EQ. 0, then no tick marks are to be drawn.
+C
+      IF (NMMT.EQ.0.OR.QMDP.EQ.0..OR.(WMML.EQ.0..AND.WMMR.EQ.0.))
+     *                                                         GO TO 115
+C
+C Compute the distances of the tick mark ends from the axis as fractions
+C of the axis length, using only the (EPSILON) portion of WMML and WMMR.
+C
+      FMML=-CSFA*AMOD(WMML,1.)
+      FMMR=+CSFA*AMOD(WMMR,1.)
+C
+C If the labels overlap the axis and the (EPSILON) form was used for
+C WMML or WMMR, move the tick mark to the end of the label.
+C
+      IF (FNLL*FNLR.GE.0.) GO TO 101
+C
+      IF (WMML.LT.1.) FMML=FMML+FNLL
+C
+      IF (WMMR.LT.1.) FMMR=FMMR+FNLR
+C
+C Compute the x and y offsets to the ends of the tick mark.
+C
+  101 XMML=+CFAX*FMML*YDCA
+      YMML=-CFAY*FMML*XDCA
+      XMMR=+CFAX*FMMR*YDCA
+      YMMR=-CFAY*FMMR*XDCA
+C
+C If the (1+EPSILON) form was used for WMML or WMMR, adjust XMML, YMML,
+C XMMR, and YMMR as implied by the current axis orientation.
+C
+      IF (WMML.LT.1.) GO TO 107
+C
+      GO TO (102,103,104,105) , JAOR
+C
+C Axis at 0 degrees (left to right).
+C
+  102 YMML=YMML+1.-YBGA
+      GO TO 106
+C
+C Axis at 90 degrees (bottom to top).
+C
+  103 XMML=XMML-XBGA
+      GO TO 106
+C
+C Axis at 180 degrees (right to left).
+C
+  104 YMML=YMML-YBGA
+      GO TO 106
+C
+C Axis at 270 degrees (top to bottom).
+C
+  105 XMML=XMML+1.-XBGA
+C
+  106 FMML=(XMML+YMML)/(CFAX*YDCA-CFAY*XDCA)
+C
+  107 IF (WMMR.LT.1.) GO TO 113
+C
+      GO TO (108,109,110,111) , JAOR
+C
+C Axis at 0 degrees (left to right).
+C
+  108 YMMR=YMMR-YBGA
+      GO TO 112
+C
+C Axis at 90 degrees (bottom to top).
+C
+  109 XMMR=XMMR+1.-XBGA
+      GO TO 112
+C
+C Axis at 180 degrees (right to left).
+C
+  110 YMMR=YMMR+1.-YBGA
+      GO TO 112
+C
+C Axis at 270 degrees (top to bottom).
+C
+  111 XMMR=XMMR-XBGA
+C
+  112 FMMR=(XMMR+YMMR)/(CFAX*YDCA-CFAY*XDCA)
+C
+C Now split the tick mark into two portions - one to the left, and one
+C to the right, of the numeric label space.
+C
+  113 XMMT(1)=XMML
+      YMMT(1)=YMML
+      XMMT(2)=XMMR
+      YMMT(2)=YMMR
+      MM12=1
+      MM34=0
+      IF (FMMR.LE.FNLL.OR.FNLL.GE.FNLR) RETURN
+C
+      MM12=0
+      IF (FMML.GE.FNLL) GO TO 114
+      MM12=1
+      XMMT(2)=+CFAX*(FNLL-.005*CSFA)*YDCA
+      YMMT(2)=-CFAY*(FNLL-.005*CSFA)*XDCA
+C
+  114 IF (FMMR.LE.FNLR) RETURN
+C
+      MM34=1
+      XMMT(4)=XMMR
+      YMMT(4)=YMMR
+      XMMT(3)=XMML
+      YMMT(3)=YMML
+C
+      IF (FMML.GE.FNLR) RETURN
+      XMMT(3)=+CFAX*(FNLR+.005*CSFA)*YDCA
+      YMMT(3)=-CFAY*(FNLR+.005*CSFA)*XDCA
+      RETURN
+C
+C No ticks to be drawn - zero the flags MM12 and MM34 to indicate this.
+C
+  115 MM12=0
+      MM34=0
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agcurv.f b/sys/gio/ncarutil/autograph/agcurv.f
new file mode 100644
index 00000000..47624321
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agcurv.f
@@ -0,0 +1,149 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGCURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where, if the primary parameter 'INVERT.' is zero,
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If 'INVERT.' is non-zero, the definitions are interchanged, so that
+C
+C    X(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case X(I)=I), and
+C    Y(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C If the primary parameter 'WINDOW.' is zero, AGKURV is called; it does
+C no windowing.  If 'WINDOW.' is non-zero, AGQURV is called; it omits
+C portions of the curve which fall outside the current curve window.
+C
+C The argument KDSH specifies the dash pattern to be used.  If KDSH is
+C negative, the function MOD(IABS(KDSH),26) is used to select a solid
+C line interrupted by one of the alphabetic characters.  If KDSH is
+C zero, the user is assumed to have done his own DASHD call.  If KDSH
+C is positive, the function MOD(KDSH,NODP) is used to select one of the
+C dash patterns in the parameter group 'DASH/PATTERNS.'.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C Declare the block data routine external to force it to load.
+C
+C +NOAO
+C     EXTERNAL AGDFLT
+C -NOAO
+C
+C DASH receives alphabetic dash patterns.
+C
+      CHARACTER*10 DASH
+C
+C ALPH contains an alphabet.
+C
+      CHARACTER*26 ALPH
+C
+      DATA ALPH / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
+C
+C +NOAO - replace blockdata with run time initialization.
+      call agdflt
+C -NOAO
+C
+C Check for an alphabetic dash pattern.
+C
+      IF (KDSH.LT.0) THEN
+        IDSH=MOD(-KDSH-1,26)+1
+        IPSN=MOD(3*IDSH-1,10)+1
+        DASH='$$$$$$$$$$'
+        DASH(IPSN:IPSN)=ALPH(IDSH:IDSH)
+        CALL AGSTCH (DASH,10,IDCS)
+        CALL AGDASH (FLOAT(IDCS),WODQ,WOCD,SCWP)
+        CALL AGDLCH (IDCS)
+C
+C Check for a dash pattern from the group "DASH/PATTERNS."
+C
+      ELSE IF (KDSH.GT.0) THEN
+        IDSH=MOD(KDSH-1,IFIX(QODP))+1
+        CALL AGDASH (QDSH(IDSH),WODQ,WOCD,SCWP)
+C
+      END IF
+C
+C Now that the dash pattern is determined, do the SET call.
+C
+      CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+C Give the user a chance to modify the curve (by changing line style,
+C color, etc.).
+C
+      CALL AGCHCU (0,KDSH)
+C
+C Decide whether AGKURV or AGQURV is to draw the curve.
+C
+      IF (QWND.EQ.0.) THEN
+C
+C No windowing requested - AGKURV is used.
+C
+        IF (QIXY.EQ.0.) THEN
+          CALL AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1))
+        ELSE
+          CALL AGKURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1))
+        END IF
+C
+      ELSE
+C
+C Windowing requested - AGQURV is used.
+C
+        IF (QIXY.EQ.0.) THEN
+          CALL AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1))
+        ELSE
+          CALL AGQURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1))
+        END IF
+C
+      END IF
+C
+C Give the user a chance to change back what he changed above.
+C
+      CALL AGCHCU (1,KDSH)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdash.f b/sys/gio/ncarutil/autograph/agdash.f
new file mode 100644
index 00000000..243eb808
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdash.f
@@ -0,0 +1,69 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGDASH (DASH,WODQ,WOCD,SCWP)
+C
+C AGDASH sets up the DASHD call required to establish the dash pattern
+C desired for the next curve.  The arguments are as follows:
+C
+C -- DASH specifies the desired dash pattern.  A positive value implies
+C    that a binary dash pattern is to be used, a negative value that a
+C    character-string dash pattern is to be used.
+C
+C -- WODQ is the width of the solid-line segment specified by a dollar
+C    sign and the gap specified by a quote, expressed as a fraction of
+C    the smaller side of the curve window.
+C
+C -- WOCD is the width of a character which is to be a part of the dash
+C    pattern, expressed in the same units as WODQ.
+C
+C -- SCWP is the length of the smaller side of the curve window, in
+C    plotter coordinate units.
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only ones
+C used here are MWCD and MWDQ - the minimum widths of characters and
+C spaces, respectively, in the dash pattern.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C The AUTOGRAPH function AGFPBN is of type integer.
+C
+      INTEGER AGFPBN
+C
+      IWCD=MAX0(MWCD,IFIX(WOCD*SCWP))
+      IWDQ=MAX0(MWDQ,IFIX(WODQ*SCWP))
+C
+      IF (DASH.GE.0.) THEN
+        CALL DASHDB (AGFPBN(DASH))
+      ELSE
+        CALL AGGTCH (IFIX(DASH),CHS1,LNC1)
+        CALL DASHDC (CHS1(1:LNC1),IWDQ,IWCD)
+      END IF
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdflt.bd b/sys/gio/ncarutil/autograph/agdflt.bd
new file mode 100644
index 00000000..ddbde9a1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdflt.bd
@@ -0,0 +1,414 @@
+C +NOAO  
+C         This block data has been rewritten as a run time initialization
+C         subroutine (see file agdflt.f).  This original block data file
+C         is retained for reference only.
+C -NOAO
+C
+C ---------------------------------------------------------------------
+C
+      BLOCK DATA AGDFLT
+C
+C The block data subroutine AGDFLT defines the default values of those
+C AUTOGRAPH parameters which can be declared in a DATA statement.  See
+C AGINIT for code initializing other AUTOGRAPH parameters.
+C
+C Following are declarations of all the AUTOGRAPH common blocks.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of
+C type character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+      CHARACTER*504 CHS1,CHS2
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C ---------------------------------------------------------------------
+C
+C Following are declarations of default values of variables in the
+C AUTOGRAPH common blocks.
+C
+C ---------------------------------------------------------------------
+C
+C QFRA defines the control parameter 'FRAME.', which specifies when, if
+C ever, the EZ... routines are to call FRAME to advance to a new frame.
+C
+      DATA QFRA / 1. /
+C
+C QSET defines the control parameter 'SET.', which determines how the
+C last call to the plot-package routine "SET" is to affect AUTOGRAPH.
+C
+      DATA QSET / 1. /
+C
+C QROW defines the control parameter 'ROW.', which determines how the x
+C and y input arrays (in calls to AGSTUP and AGCURV) are to be used.
+C
+      DATA QROW / 1. /
+C
+C QIXY defines the control parameter 'INVERT.', which, if set non-zero,
+C causes the routines AGSTUP and AGCURV to behave as if the arguments
+C defining the x and y data had been interchanged.
+C
+      DATA QIXY / 0. /
+C
+C QWND defines the control parameter 'WINDOW.', which, if set non-zero,
+C causes curves drawn to be scissored by the edge of the curve window.
+C
+      DATA QWND / 0. /
+C
+C QBAC defines the control parameter 'BACKGROUND.', which can be given
+C any of four values to set up four specific types of plot background.
+C
+      DATA QBAC / 1. /
+C
+C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are
+C used in various ways by AUTOGRAPH.
+C
+      DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 /
+C
+C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they
+C specify the position of the graph window within the plotter frame.
+C
+      DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. /
+C
+C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the
+C group 'GRID.'; they specify the position of the grid window within
+C the graph window.
+C
+      DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 /
+C
+C SOGD defines the control parameter 'GRID/SHAPE.', which defines the
+C shape of the grid window.
+C
+      DATA SOGD / 0. /
+C
+C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.',
+C which determine how minimum and maximum values of x are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+      DATA XMIN / 1E36 / , XMAX / 1E36 /
+C
+C QLUX defines the control parameter 'X/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+      DATA QLUX / 0. /
+C
+C QOVX defines the control parameter 'X/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+      DATA QOVX / 0. /
+C
+C QCEX defines the control parameter 'X/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+      DATA QCEX / -1. /
+C
+C XLOW and XHGH define the control parameters 'X/SMALLEST.' and
+C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null
+C and they are non-null, in which case they set limits on the range of
+C x data to be considered when choosing the minimum and/or maximum.
+C
+      DATA XLOW / 1E36 / , XHGH / 1E36 /
+C
+C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.',
+C which determine how minimum and maximum values of y are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+      DATA YMIN / 1E36 / , YMAX / 1E36 /
+C
+C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+      DATA QLUY / 0. /
+C
+C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+      DATA QOVY / 0. /
+C
+C QCEY defines the control parameter 'Y/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+      DATA QCEY / -1. /
+C
+C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and
+C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null
+C and they are non-null, in which case they set limits on the range of
+C y data to be considered when choosing the minimum and/or maximum.
+C
+      DATA YLOW / 1E36 / , YHGH / 1E36 /
+C
+C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies
+C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies
+C s='TOP').  Each of these specifies whether or not a given axis will
+C be drawn or not and what liberties may be taken with numeric labels
+C on the axis.
+C
+      DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. /
+C
+C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says
+C whether or not the line portion of a particular axis is to be drawn.
+C
+      DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. /
+C
+C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.',
+C which may be used to move a particular axis to a specified position.
+C
+      DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/
+C
+C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.',
+C which may be used to move a particular axis to a specified position.
+C
+      DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/
+C
+C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is
+C used within a user-supplied version of AGUTOL to select a particular
+C uset-system-to-label-system mapping for a particular axis.  The
+C default value selects the identity mapping.
+C
+      DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. /
+C
+C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i)
+C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.',
+C which determines the positioning and appearance of the major ticks on
+C a particular axis.
+C
+      DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/
+      DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/
+      DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. /
+      DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/
+      DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. /
+      DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/
+C
+C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define
+C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines
+C the positioning and appearance of the major ticks on a particular
+C axis.
+C
+      DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/
+      DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/
+      DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. /
+      DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/
+C
+C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i),
+C WCLM(i), and WCLE(i) together define the control-parameter group
+C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of
+C the numeric labels on a particular axis.
+C
+      DATA QLTD(1)/1E36/ , QLTD(2)/  0./ , QLTD(3)/1E36/ , QLTD(4)/  0./
+      DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/
+      DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/
+      DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. /
+      DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./
+      DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/
+      DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/
+      DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/
+C
+C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which
+C determines which set of dash patterns is used by EZMY and EZMXY (the
+C alphabetic set or the user-specified set); if the user-specified set
+C is selected, the magnitude of QODP determines how many of them are to
+C be used.
+C
+      DATA QODP / 1. /
+C
+C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the
+C assumed length of dash patterns tendered to AUTOGRAPH.
+C
+      DATA QCDP / 8. /
+C
+C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and
+C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in
+C character-string dash patterns.
+C
+      DATA WOCD / .010 / , WODQ / .010 /
+C
+C QDSH defines the control-parameter group 'DASH/PATTERN.'.  Each value,
+C if positive, defines a binary dash pattern, and, if negative, serves
+C as an identifier in retrieving a character-string dash pattern.
+C
+      DATA QDSH / 26*65535. /
+C
+C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies
+C what may be done with informational labels in response to overlap
+C problems.
+C
+      DATA QDLB /2./
+C
+C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must
+C be equal to the second dimension of the array FLLB.
+C
+      DATA QBIM / 8. /
+C
+C QBAN defines the control parameter 'LABEL/NAME.'; its value is really
+C a pointer into the label list.  The default value, zero, means that
+C the pointer has not been set.
+C
+      DATA QBAN / 0. /
+C
+C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed
+C maximum length of character strings intended for use as the text of a
+C line of a label.
+C
+      DATA QLLN /40./
+C
+C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used
+C to mark the end of character strings intended for use as the text of a
+C line of a label.  It is initialized in AGINIT.
+C
+C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be
+C equal to the second dimension of FLLN.
+C
+      DATA QNIM / 16. /
+C
+C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really
+C a pointer into the line list.  The default value, zero, says that the
+C pointer has not been set.
+C
+      DATA QNAN / 0. /
+C
+C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left
+C of the grid.  The name, in FLLB(1,1), and the line text, in FLLN(4,1),
+C must be filled in by AGINIT.
+C
+      DATA FLLB( 1,1)/   0./ , FLLB( 2,1)/   0./ , FLLB( 3,1)/   0./ ,
+     +     FLLB( 4,1)/   .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/   0./ ,
+     +     FLLB( 7,1)/  90./ , FLLB( 8,1)/   0./ , FLLB( 9,1)/   1./ ,
+     +     FLLB(10,1)/   1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/   0./ ,
+     +     FLLN( 3,1)/ .015/ , FLLN( 4,1)/  -2./ , FLLN( 5,1)/   1./ ,
+     +     FLLN( 6,1)/   0./
+C
+C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right
+C of the grid.  The name, in FLLB(1,2), and the line text, in FLLN(4,2),
+C must be filled in by AGINIT.
+C
+      DATA FLLB( 1,2)/   0./ , FLLB( 2,2)/   0./ , FLLB( 3,2)/   1./ ,
+     +     FLLB( 4,2)/   .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/   0./ ,
+     +     FLLB( 7,2)/  90./ , FLLB( 8,2)/   0./ , FLLB( 9,2)/   1./ ,
+     +     FLLB(10,2)/   2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/   0./ ,
+     +     FLLN( 3,2)/ .015/ , FLLN( 4,2)/  -3./ , FLLN( 5,2)/   0./ ,
+     +     FLLN( 6,2)/   0./
+C
+C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the
+C grid.  The name, in FLLB(1,3), and the line text, in FLLN(4,3), must
+C be filled in by AGINIT.
+C
+      DATA FLLB( 1,3)/   0./ , FLLB( 2,3)/   0./ , FLLB( 3,3)/   .5/ ,
+     +     FLLB( 4,3)/   0./ , FLLB( 5,3)/   0./ , FLLB( 6,3)/-.015/ ,
+     +     FLLB( 7,3)/   0./ , FLLB( 8,3)/   0./ , FLLB( 9,3)/   1./ ,
+     +     FLLB(10,3)/   3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/   0./ ,
+     +     FLLN( 3,3)/ .015/ , FLLN( 4,3)/  -1./ , FLLN( 5,3)/   1./ ,
+     +     FLLN( 6,3)/   0./
+C
+C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the
+C grid.  The name, in FLLB(1,4), and the line text, in FLLN(4,4), must
+C be filled in by AGINIT.
+C
+      DATA FLLB( 1,4)/   0./ , FLLB( 2,4)/   0./ , FLLB( 3,4)/   .5/ ,
+     +     FLLB( 4,4)/   1./ , FLLB( 5,4)/   0./ , FLLB( 6,4)/+.020/ ,
+     +     FLLB( 7,4)/   0./ , FLLB( 8,4)/   0./ , FLLB( 9,4)/   1./ ,
+     +     FLLB(10,4)/   4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/   0./ ,
+     +     FLLN( 3,4)/ .020/ , FLLN( 4,4)/  -3./ , FLLN( 5,4)/   0./ ,
+     +     FLLN( 6,4)/   0./
+C
+C Certain secondary parameters must be initialized to prevent bombing.
+C
+      DATA QBTP(1)/  0./ , QBTP(2)/  0./ , QBTP(3)/  0./ , QBTP(4)/  0./
+      DATA BASE(1)/  0./ , BASE(2)/  0./ , BASE(3)/  0./ , BASE(4)/  0./
+      DATA QMNT(1)/  0./ , QMNT(2)/  0./ , QMNT(3)/  0./ , QMNT(4)/  0./
+      DATA QLTP(1)/  0./ , QLTP(2)/  0./ , QLTP(3)/  0./ , QLTP(4)/  0./
+      DATA QLEX(1)/  0./ , QLEX(2)/  0./ , QLEX(3)/  0./ , QLEX(4)/  0./
+      DATA QLFL(1)/  0./ , QLFL(2)/  0./ , QLFL(3)/  0./ , QLFL(4)/  0./
+      DATA QCIM(1)/  0./ , QCIM(2)/  0./ , QCIM(3)/  0./ , QCIM(4)/  0./
+      DATA QCIE(1)/  0./ , QCIE(2)/  0./ , QCIE(3)/  0./ , QCIE(4)/  0./
+      DATA RFNL(1)/  0./ , RFNL(2)/  0./ , RFNL(3)/  0./ , RFNL(4)/  0./
+      DATA QLUA(1)/  0./ , QLUA(2)/  0./ , QLUA(3)/  0./ , QLUA(4)/  0./
+C
+C SMRL and ISLD are set by the routine AGINIT (which see, below).
+C
+C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label
+C characters, mantissa characters, exponent characters, label-to-axis
+C distances, dash-pattern characters, and dash-pattern spaces, respect-
+C ively (in the plotter coordinate system).
+C
+      DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/
+C
+C INIF is an initialization flag, set non-zero to indicate that the
+C routine AGINIT has been executed to set the values of AUTOGRAPH
+C parameters which, for one reason or another, cannot be preset by
+C this block data routine.
+C
+      DATA INIF / 0 /
+C
+C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character
+C strings retrieved by calls to AGGTCH.  They need not be preset.
+C
+C LNIC is the second dimension of the array (INCH) which holds an index
+C of the character strings stored by AGSTCH.
+C
+      DATA LNIC / 50 /
+C
+C INCH is an index of character strings currently stored in CHRA.  Each
+C entry has the following format:
+C
+C    INCH(1,I), if non-zero, is the index, in the array CHRA, of the
+C    first character of the Ith character string.
+C
+C    INCH(2,I) is the length of the Ith character string.
+C
+      DATA (INCH(1,I),I=1,50) / 50*0 /
+      DATA (INCH(2,I),I=1,50) / 50*0 /
+C
+C LNCA is the size of the array (CHRA) in which AGSTCH stores character
+C strings.
+C
+      DATA LNCA / 2000 /
+C
+C INCA is the index of the last character used in CHRA.
+C
+      DATA INCA / 0 /
+C
+C CHRA holds character strings stored by AGSTCH.  It need not be pre-set
+C to anything.
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdflt.f b/sys/gio/ncarutil/autograph/agdflt.f
new file mode 100644
index 00000000..87b0ca45
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdflt.f
@@ -0,0 +1,690 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+c +noao:  blockdata rewritten to be run time initialization
+c     BLOCK DATA AGDFLT
+      subroutine agdflt
+C
+C The block data subroutine AGDFLT defines the default values of those
+C AUTOGRAPH parameters which can be declared in a DATA statement.  See
+C AGINIT for code initializing other AUTOGRAPH parameters.
+C
+C Following are declarations of all the AUTOGRAPH common blocks.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of
+C type character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+c +noao:  logical flag added to prevent "over-initialization"
+      logical first
+      data first /.true./
+      call utilbd
+      if (.not. first) return
+      first = .false.
+c -noao
+C ---------------------------------------------------------------------
+C
+C Following are declarations of default values of variables in the
+C AUTOGRAPH common blocks.
+C
+C ---------------------------------------------------------------------
+C
+C QFRA defines the control parameter 'FRAME.', which specifies when, if
+C ever, the EZ... routines are to call FRAME to advance to a new frame.
+C
+c     DATA QFRA / 1. /
+      QFRA = 1. 
+C
+C QSET defines the control parameter 'SET.', which determines how the
+C last call to the plot-package routine "SET" is to affect AUTOGRAPH.
+C
+c     DATA QSET / 1. /
+      QSET = 1.
+C
+C QROW defines the control parameter 'ROW.', which determines how the x
+C and y input arrays (in calls to AGSTUP and AGCURV) are to be used.
+C
+c     DATA QROW / 1. /
+      QROW = 1.
+C
+C QIXY defines the control parameter 'INVERT.', which, if set non-zero,
+C causes the routines AGSTUP and AGCURV to behave as if the arguments
+C defining the x and y data had been interchanged.
+C
+c     DATA QIXY / 0. /
+      QIXY = 0.
+C
+C QWND defines the control parameter 'WINDOW.', which, if set non-zero,
+C causes curves drawn to be scissored by the edge of the curve window.
+C
+c     DATA QWND / 0. /
+      QWND = 0.
+C
+C QBAC defines the control parameter 'BACKGROUND.', which can be given
+C any of four values to set up four specific types of plot background.
+C
+c     DATA QBAC / 1. /
+      QBAC = 1.
+C
+C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are
+C used in various ways by AUTOGRAPH.
+C
+c     DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 /
+      SVAL(1) = 1E36 
+      SVAL(2) = 2E36
+C
+C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they
+C specify the position of the graph window within the plotter frame.
+C
+c     DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. /
+      XLGF = 0. 
+      XRGF = 1.
+      YBGF = 0.
+      YTGF = 1.
+C
+C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the
+C group 'GRID.'; they specify the position of the grid window within
+C the graph window.
+C
+c     DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 /
+      XLGD = .15
+      XRGD = .95 
+      YBGD = .15 
+      YTGD = .95
+C
+C SOGD defines the control parameter 'GRID/SHAPE.', which defines the
+C shape of the grid window.
+C
+c     DATA SOGD / 0. /
+      SOGD = 0.
+C
+C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.',
+C which determine how minimum and maximum values of x are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+c     DATA XMIN / 1E36 / , XMAX / 1E36 /
+      XMIN = 1E36
+      XMAX = 1E36
+C
+C QLUX defines the control parameter 'X/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+c     DATA QLUX / 0. /
+      QLUX = 0.
+C
+C QOVX defines the control parameter 'X/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+c     DATA QOVX / 0. /
+      QOVX = 0.
+C
+C QCEX defines the control parameter 'X/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+c     DATA QCEX / -1. /
+      QCEX = -1.
+C
+C XLOW and XHGH define the control parameters 'X/SMALLEST.' and
+C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null
+C and they are non-null, in which case they set limits on the range of
+C x data to be considered when choosing the minimum and/or maximum.
+C
+c     DATA XLOW / 1E36 / , XHGH / 1E36 /
+      XLOW = 1E36
+      XHGH = 1E36
+C
+C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.',
+C which determine how minimum and maximum values of y are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+c     DATA YMIN / 1E36 / , YMAX / 1E36 /
+      YMIN = 1E36
+      YMAX = 1E36
+C
+C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+c     DATA QLUY / 0. /
+      QLUY = 0.
+C
+C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+c     DATA QOVY / 0. /
+      QOVY = 0.
+C
+C QCEY defines the control parameter 'Y/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+c     DATA QCEY / -1. /
+      QCEY = -1.
+C
+C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and
+C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null
+C and they are non-null, in which case they set limits on the range of
+C y data to be considered when choosing the minimum and/or maximum.
+C
+c     DATA YLOW / 1E36 / , YHGH / 1E36 /
+      YLOW = 1E36
+      YHGH = 1E36
+C
+C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies
+C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies
+C s='TOP').  Each of these specifies whether or not a given axis will
+C be drawn or not and what liberties may be taken with numeric labels
+C on the axis.
+C
+c     DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. /
+      QDAX(1) = 4.
+      QDAX(2) = 4.
+      QDAX(3) = 4.
+      QDAX(4) = 4.
+C
+C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says
+C whether or not the line portion of a particular axis is to be drawn.
+C
+c     DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. /
+      QSPA(1) = 0.
+      QSPA(2) = 0.
+      QSPA(3) = 0.
+      QSPA(4) = 0.
+C
+C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.',
+C which may be used to move a particular axis to a specified position.
+C
+c     DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/
+      PING(1) = 1E36
+      PING(2) = 1E36
+      PING(3) = 1E36
+      PING(4) = 1E36
+C
+C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.',
+C which may be used to move a particular axis to a specified position.
+C
+c     DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/
+      PINU(1) = 1E36
+      PINU(2) = 1E36
+      PINU(3) = 1E36
+      PINU(4) = 1E36
+C
+C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is
+C used within a user-supplied version of AGUTOL to select a particular
+C uset-system-to-label-system mapping for a particular axis.  The
+C default value selects the identity mapping.
+C
+c     DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. /
+      FUNS(1) =  0.
+      FUNS(2) =  0.
+      FUNS(3) =  0.
+      FUNS(4) =  0.
+C
+C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i)
+C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.',
+C which determines the positioning and appearance of the major ticks on
+C a particular axis.
+C
+c     DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/
+c     DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/
+c     DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. /
+c     DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/
+c     DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. /
+c     DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/
+      QBTD(1) = 1E36
+      QBTD(2) = 1E36
+      QBTD(3) = 1E36
+      QBTD(4) = 1E36
+      BASD(1) = 1E36
+      BASD(2) = 1E36
+      BASD(3) = 1E36
+      BASD(4) = 1E36
+      QMJD(1) =  6. 
+      QMJD(2) =  6. 
+      QMJD(3) =  6. 
+      QMJD(4) =  6. 
+      QJDP(1) = 1E36
+      QJDP(2) = 1E36
+      QJDP(3) = 1E36
+      QJDP(4) = 1E36
+      WMJL(1) =  0. 
+      WMJL(2) =  0. 
+      WMJL(3) =  0. 
+      WMJL(4) =  0. 
+      WMJR(1) = .015
+      WMJR(2) = .015
+      WMJR(3) = .015
+      WMJR(4) = .015
+C
+C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define
+C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines
+C the positioning and appearance of the major ticks on a particular
+C axis.
+C
+c     DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/
+c     DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/
+c     DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. /
+c     DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/
+      QMND(1) = 1E36
+      QMND(2) = 1E36
+      QMND(3) = 1E36
+      QMND(4) = 1E36
+      QNDP(1) = 1E36
+      QNDP(2) = 1E36
+      QNDP(3) = 1E36
+      QNDP(4) = 1E36
+      WMNL(1) =  0. 
+      WMNL(2) =  0. 
+      WMNL(3) =  0. 
+      WMNL(4) =  0. 
+      WMNR(1) = .010
+      WMNR(2) = .010
+      WMNR(3) = .010
+      WMNR(4) = .010
+C
+C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i),
+C WCLM(i), and WCLE(i) together define the control-parameter group
+C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of
+C the numeric labels on a particular axis.
+C
+c     DATA QLTD(1)/1E36/ , QLTD(2)/  0./ , QLTD(3)/1E36/ , QLTD(4)/  0./
+c     DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/
+c     DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/
+c     DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. /
+c     DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./
+c     DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/
+c     DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/
+c     DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/
+      QLTD(1) = 1E36
+      QLTD(2) =   0.
+      QLTD(3) = 1E36
+      QLTD(4) =   0.
+      QLED(1) = 1E36
+      QLED(2) = 1E36
+      QLED(3) = 1E36
+      QLED(4) = 1E36
+      QLFD(1) = 1E36
+      QLFD(2) = 1E36
+      QLFD(3) = 1E36
+      QLFD(4) = 1E36
+      QLOF(1) =  0. 
+      QLOF(2) =  0. 
+      QLOF(3) =  0. 
+      QLOF(4) =  0. 
+      QLOS(1) =  90.
+      QLOS(2) =  90.
+      QLOS(3) =  90.
+      QLOS(4) =  90.
+      DNLA(1) = .015
+      DNLA(2) = .015
+      DNLA(3) = .015
+      DNLA(4) = .015
+      WCLM(1) = .015
+      WCLM(2) = .015
+      WCLM(3) = .015
+      WCLM(4) = .015
+      WCLE(1) = .010
+      WCLE(2) = .010
+      WCLE(3) = .010
+      WCLE(4) = .010
+C
+C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which
+C determines which set of dash patterns is used by EZMY and EZMXY (the
+C alphabetic set or the user-specified set); if the user-specified set
+C is selected, the magnitude of QODP determines how many of them are to
+C be used.
+C
+c     DATA QODP / 1. /
+      QODP = 1. 
+C
+C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the
+C assumed length of dash patterns tendered to AUTOGRAPH.
+C
+c     DATA QCDP / 8. /
+      QCDP =  8. 
+C
+C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and
+C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in
+C character-string dash patterns.
+C
+c     DATA WOCD / .010 / , WODQ / .010 /
+      WOCD = .010 
+      WODQ = .010
+C
+C QDSH defines the control-parameter group 'DASH/PATTERN.'.  Each value,
+C if positive, defines a binary dash pattern, and, if negative, serves
+C as an identifier in retrieving a character-string dash pattern.
+C
+c     DATA QDSH / 26*65535. /
+      do 20, ijk = 1, 26
+  20      QDSH(ijk) = 65535.
+C
+C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies
+C what may be done with informational labels in response to overlap
+C problems.
+C
+c     DATA QDLB /2./
+      QDLB = 2.
+C
+C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must
+C be equal to the second dimension of the array FLLB.
+C
+c     DATA QBIM / 8. /
+      QBIM =  8.
+C
+C QBAN defines the control parameter 'LABEL/NAME.'; its value is really
+C a pointer into the label list.  The default value, zero, means that
+C the pointer has not been set.
+C
+c     DATA QBAN / 0. /
+      QBAN =  0.
+C
+C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed
+C maximum length of character strings intended for use as the text of a
+C line of a label.
+C
+c     DATA QLLN /40./
+      QLLN = 40.
+C
+C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used
+C to mark the end of character strings intended for use as the text of a
+C line of a label.  It is initialized in AGINIT.
+C
+C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be
+C equal to the second dimension of FLLN.
+C
+c     DATA QNIM / 16. /
+      QNIM =  16.
+C
+C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really
+C a pointer into the line list.  The default value, zero, says that the
+C pointer has not been set.
+C
+c     DATA QNAN / 0. /
+      QNAN =  0.
+C
+C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left
+C of the grid.  The name, in FLLB(1,1), and the line text, in FLLN(4,1),
+C must be filled in by AGINIT.
+C
+c     DATA FLLB( 1,1)/   0./ , FLLB( 2,1)/   0./ , FLLB( 3,1)/   0./ ,
+c    +     FLLB( 4,1)/   .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/   0./ ,
+c    +     FLLB( 7,1)/  90./ , FLLB( 8,1)/   0./ , FLLB( 9,1)/   1./ ,
+c    +     FLLB(10,1)/   1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/   0./ ,
+c    +     FLLN( 3,1)/ .015/ , FLLN( 4,1)/  -2./ , FLLN( 5,1)/   1./ ,
+c    +     FLLN( 6,1)/   0./
+           FLLB( 1,1) = 0.
+           FLLB( 2,1) = 0.
+           FLLB( 3,1) = 0.
+           FLLB( 4,1) = .5
+           FLLB( 5,1) = -.015
+           FLLB( 6,1) = 0.
+           FLLB( 7,1) = 90.
+           FLLB( 8,1) = 0.
+           FLLB( 9,1) = 1.
+           FLLB(10,1) = 1.
+           FLLN( 1,1) = +100.
+           FLLN( 2,1) = 0.
+           FLLN( 3,1) = .015
+           FLLN( 4,1) = -2.
+           FLLN( 5,1) = 1.
+           FLLN( 6,1) = 0.
+C
+C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right
+C of the grid.  The name, in FLLB(1,2), and the line text, in FLLN(4,2),
+C must be filled in by AGINIT.
+C
+c     DATA FLLB( 1,2)/   0./ , FLLB( 2,2)/   0./ , FLLB( 3,2)/   1./ ,
+c    +     FLLB( 4,2)/   .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/   0./ ,
+c    +     FLLB( 7,2)/  90./ , FLLB( 8,2)/   0./ , FLLB( 9,2)/   1./ ,
+c    +     FLLB(10,2)/   2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/   0./ ,
+c    +     FLLN( 3,2)/ .015/ , FLLN( 4,2)/  -3./ , FLLN( 5,2)/   0./ ,
+c    +     FLLN( 6,2)/   0./
+           FLLB( 1,2) =  0.
+           FLLB( 2,2) =  0.
+           FLLB( 3,2) =  1.
+           FLLB( 4,2) =  .5
+           FLLB( 5,2) = +.015
+           FLLB( 6,2) =  0.
+           FLLB( 7,2) = 90.
+           FLLB( 8,2) =  0.
+           FLLB( 9,2) =  1.
+           FLLB(10,2) =  2.
+           FLLN( 1,2) = -100.
+           FLLN( 2,2) =  0.
+           FLLN( 3,2) =  .015
+           FLLN( 4,2) =  -3.
+           FLLN( 5,2) =  0.
+           FLLN( 6,2) =  0.
+C
+C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the
+C grid.  The name, in FLLB(1,3), and the line text, in FLLN(4,3), must
+C be filled in by AGINIT.
+C
+c     DATA FLLB( 1,3)/   0./ , FLLB( 2,3)/   0./ , FLLB( 3,3)/   .5/ ,
+c    +     FLLB( 4,3)/   0./ , FLLB( 5,3)/   0./ , FLLB( 6,3)/-.015/ ,
+c    +     FLLB( 7,3)/   0./ , FLLB( 8,3)/   0./ , FLLB( 9,3)/   1./ ,
+c    +     FLLB(10,3)/   3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/   0./ ,
+c    +     FLLN( 3,3)/ .015/ , FLLN( 4,3)/  -1./ , FLLN( 5,3)/   1./ ,
+c    +     FLLN( 6,3)/   0./
+           FLLB( 1,3) =  0.
+           FLLB( 2,3) =  0.
+           FLLB( 3,3) = .5
+           FLLB( 4,3) =  0.
+           FLLB( 5,3) =  0.
+           FLLB( 6,3) = -.015
+           FLLB( 7,3) =  0.
+           FLLB( 8,3) =  0.
+           FLLB( 9,3) =  1.
+           FLLB(10,3) =  3.
+           FLLN( 1,3) = -100.
+           FLLN( 2,3) =  0.
+           FLLN( 3,3) =  .015
+           FLLN( 4,3) =   -1.
+           FLLN( 5,3) =  1.
+           FLLN( 6,3) =  0.
+C
+C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the
+C grid.  The name, in FLLB(1,4), and the line text, in FLLN(4,4), must
+C be filled in by AGINIT.
+C
+c     DATA FLLB( 1,4)/   0./ , FLLB( 2,4)/   0./ , FLLB( 3,4)/   .5/ ,
+c    +     FLLB( 4,4)/   1./ , FLLB( 5,4)/   0./ , FLLB( 6,4)/+.020/ ,
+c    +     FLLB( 7,4)/   0./ , FLLB( 8,4)/   0./ , FLLB( 9,4)/   1./ ,
+c    +     FLLB(10,4)/   4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/   0./ ,
+c    +     FLLN( 3,4)/ .020/ , FLLN( 4,4)/  -3./ , FLLN( 5,4)/   0./ ,
+c    +     FLLN( 6,4)/   0./
+           FLLB( 1,4) =  0.
+           FLLB( 2,4) =  0.
+           FLLB( 3,4) =  .5
+           FLLB( 4,4) =  1.
+           FLLB( 5,4) =  0.
+           FLLB( 6,4) = +.020
+           FLLB( 7,4) =  0.
+           FLLB( 8,4) =  0.
+           FLLB( 9,4) =  1.
+           FLLB(10,4) =  4.
+           FLLN( 1,4) = +100.
+           FLLN( 2,4) =  0.
+           FLLN( 3,4) =  .020
+           FLLN( 4,4) =  -3.
+           FLLN( 5,4) =  0.
+           FLLN( 6,4) =  0.
+C
+C Certain secondary parameters must be initialized to prevent bombing.
+C
+c     DATA QBTP(1)/  0./ , QBTP(2)/  0./ , QBTP(3)/  0./ , QBTP(4)/  0./
+c     DATA BASE(1)/  0./ , BASE(2)/  0./ , BASE(3)/  0./ , BASE(4)/  0./
+c     DATA QMNT(1)/  0./ , QMNT(2)/  0./ , QMNT(3)/  0./ , QMNT(4)/  0./
+c     DATA QLTP(1)/  0./ , QLTP(2)/  0./ , QLTP(3)/  0./ , QLTP(4)/  0./
+c     DATA QLEX(1)/  0./ , QLEX(2)/  0./ , QLEX(3)/  0./ , QLEX(4)/  0./
+c     DATA QLFL(1)/  0./ , QLFL(2)/  0./ , QLFL(3)/  0./ , QLFL(4)/  0./
+c     DATA QCIM(1)/  0./ , QCIM(2)/  0./ , QCIM(3)/  0./ , QCIM(4)/  0./
+c     DATA QCIE(1)/  0./ , QCIE(2)/  0./ , QCIE(3)/  0./ , QCIE(4)/  0./
+c     DATA RFNL(1)/  0./ , RFNL(2)/  0./ , RFNL(3)/  0./ , RFNL(4)/  0./
+c     DATA QLUA(1)/  0./ , QLUA(2)/  0./ , QLUA(3)/  0./ , QLUA(4)/  0./
+      QBTP(1) =   0.
+      QBTP(2) =   0.
+      QBTP(3) =   0.
+      QBTP(4) =   0.
+      BASE(1) =   0.
+      BASE(2) =   0.
+      BASE(3) =   0.
+      BASE(4) =   0.
+      QMNT(1) =   0.
+      QMNT(2) =   0.
+      QMNT(3) =   0.
+      QMNT(4) =   0.
+      QLTP(1) =   0.
+      QLTP(2) =   0.
+      QLTP(3) =   0.
+      QLTP(4) =   0.
+      QLEX(1) =   0.
+      QLEX(2) =   0.
+      QLEX(3) =   0.
+      QLEX(4) =   0.
+      QLFL(1) =   0.
+      QLFL(2) =   0.
+      QLFL(3) =   0.
+      QLFL(4) =   0.
+      QCIM(1) =   0.
+      QCIM(2) =   0.
+      QCIM(3) =   0.
+      QCIM(4) =   0.
+      QCIE(1) =   0.
+      QCIE(2) =   0.
+      QCIE(3) =   0.
+      QCIE(4) =   0.
+      RFNL(1) =   0.
+      RFNL(2) =   0.
+      RFNL(3) =   0.
+      RFNL(4) =   0.
+      QLUA(1) =   0.
+      QLUA(2) =   0.
+      QLUA(3) =   0.
+      QLUA(4) =   0.
+C
+C SMRL and ISLD are set by the routine AGINIT (which see, below).
+C
+C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label
+C characters, mantissa characters, exponent characters, label-to-axis
+C distances, dash-pattern characters, and dash-pattern spaces, respect-
+C ively (in the plotter coordinate system).
+C
+c     DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/
+      MWCL = 8
+      MWCM = 8
+      MWCE = 8
+      MDLA = 8
+      MWCD = 8
+      MWDQ = 8
+C
+C INIF is an initialization flag, set non-zero to indicate that the
+C routine AGINIT has been executed to set the values of AUTOGRAPH
+C parameters which, for one reason or another, cannot be preset by
+C this block data routine.
+C
+c     DATA INIF / 0 /
+      INIF =  0 
+C
+C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character
+C strings retrieved by calls to AGGTCH.  They need not be preset.
+C
+C LNIC is the second dimension of the array (INCH) which holds an index
+C of the character strings stored by AGSTCH.
+C
+c     DATA LNIC / 50 /
+      LNIC = 50 
+C
+C INCH is an index of character strings currently stored in CHRA.  Each
+C entry has the following format:
+C
+C    INCH(1,I), if non-zero, is the index, in the array CHRA, of the
+C    first character of the Ith character string.
+C
+C    INCH(2,I) is the length of the Ith character string.
+C
+c     DATA (INCH(1,I),I=1,50) / 50*0 /
+c     DATA (INCH(2,I),I=1,50) / 50*0 /
+      do 10, ijk = 1, 50
+        inch (1, ijk) = 0
+        inch (2, ijk) = 0
+  10  continue
+C
+C LNCA is the size of the array (CHRA) in which AGSTCH stores character
+C strings.
+C
+c     DATA LNCA / 2000 /
+      LNCA =  2000 
+C
+C INCA is the index of the last character used in CHRA.
+C
+c     DATA INCA / 0 /
+      INCA =  0 
+C
+C CHRA holds character strings stored by AGSTCH.  It need not be pre-set
+C to anything.
+C
+      return
+c 
+      entry initag
+      first = .true.
+      END
diff --git a/sys/gio/ncarutil/autograph/agdlch.f b/sys/gio/ncarutil/autograph/agdlch.f
new file mode 100644
index 00000000..78a96c8f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdlch.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGDLCH (IDCS)
+C
+C This routine deletes character strings previously stored by the
+C routine AGSTCH (which see).  It has the following argument:
+C
+C -- IDCS is the identifying integer returned by AGSTCH when the string
+C    was stored.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C Only if the identifier is between -LNIC and -1, inclusive, was the
+C string ever stored, so that it needs to be deleted.  If the string is
+C the last one in CHRA, we can just set INCA to point to the position
+C preceding it; otherwise, we zero out the string but don't bother to
+C collapse CHRA, which will happen in AGSTCH when the space is needed
+C again.  In either case, the index entry in INCH is zeroed.
+C
+      IF (IDCS.GE.(-LNIC).AND.IDCS.LE.(-1)) THEN
+        I=-IDCS
+        J=INCH(1,I)
+        IF (J.GT.0) THEN
+          K=J+INCH(2,I)-1
+          IF (K.EQ.INCA) THEN
+            INCA=J-1
+          ELSE
+            DO 101 L=J,K
+              CHRA(L)=CHAR(0)
+  101       CONTINUE
+          END IF
+          INCH(1,I)=0
+        END IF
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdshn.f b/sys/gio/ncarutil/autograph/agdshn.f
new file mode 100644
index 00000000..a20a5dfd
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdshn.f
@@ -0,0 +1,34 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      CHARACTER*16 FUNCTION AGDSHN (IDSH)
+C
+C The value of this function is the name of the dash pattern numbered
+C IDSH - that is to say, the character string 'DASH/PATTERN/n.', where
+C n is an integer between 1 and 99, equal to MAX0(1,MIN0(99,IDSH)).
+C
+      AGDSHN='DASH/PATTERN/  .'
+C
+      KDSH=MAX0(1,MIN0(99,IDSH))
+C
+      DO 101 I=15,14,-1
+        AGDSHN(I:I)=CHAR(ICHAR('0')+MOD(KDSH,10))
+        IF (KDSH.LE.9) GO TO 102
+        KDSH=KDSH/10
+  101 CONTINUE
+C
+  102 RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agexax.f b/sys/gio/ncarutil/autograph/agexax.f
new file mode 100644
index 00000000..b16e2319
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agexax.f
@@ -0,0 +1,415 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEXAX (IAXS,SVAL,UMIN,UMAX,NICE,QLUA,FUNS,QBTP,BASD,
+     +                   BASE,QMJD,QMND,QMNT,QLTD,QLTP,QLED,QLEX,QLFD,
+     +                   QLFL,QMIN,QMAX)
+C
+      DIMENSION SVAL(2)
+C
+C The routine AGEXAX is used by AGSTUP to examine the parameters which
+C determine how a given axis is tick-marked and labelled and to provide
+C default values for missing ones.  Its arguments are as follows:
+C
+C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4.
+C
+C -- SVAL is the array of special values.
+C
+C -- UMIN and UMAX are the minimum and maximum values along the axis, in
+C    the user coordinate system.  Rounded values of UMIN and UMAX are
+C    returned in QMIN and QMAX if the following argument (NICE) is zero.
+C
+C -- NICE is a flag indicating whether rounded values of UMIN and UMAX
+C    are to be returned (NICE.EQ.0) or not (NICE.NE.0).
+C
+C -- LLUA and FUNS specify the user-system-to-label-system mapping along
+C    the axis.  See the routine AGAXIS for a discussion of them.
+C
+C -- NBTP, BASD, BASE, and NMJD are used to determine the positioning of
+C    major tick marks in the label coordinate system.  NBTP and BASE are
+C    described in the routine AGNUMB.  BASD is the desired value of BASE
+C    supplied by the user.  If BASD has a null value, BASE is computed
+C    by AGEXAX.  NMJD is a user-supplied-or-defaulted parameter giving
+C    the approximate number of major ticks (and therefore the number of
+C    numeric labels) to be placed on the axis.
+C
+C -- NMND and NMNT are the desired and actual (to be determined) number
+C    of minor ticks per major division.  See discussion in AGAXIS.
+C
+C -- NLTD, NLTP, NLED, NLEX, NLFD, and NLFL are desired and actual (to
+C    be determined) values of the parameters describing the form to be
+C    used for numeric labels.  See discussion in AGNUMB.
+C
+C -- QMIN and QMAX are rounded values of UMIN and UMAX, returned only if
+C    NICE.EQ.0.
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The arrays BASP and NMNP specify possible default values for BASE and
+C NMNT when NBTP.EQ.1.
+C
+      DIMENSION BASP(5),NMNP(5)
+C
+      DATA BASP(1) / 10. / , NMNP(1) / 1 / ,
+     *     BASP(2) /  5. / , NMNP(2) / 4 / ,
+     *     BASP(3) /  2. / , NMNP(3) / 1 / ,
+     *     BASP(4) /  1. / , NMNP(4) / 1 / ,
+     *     BASP(5) /  .5 / , NMNP(5) / 4 /
+C
+C If the parameter NBTP is zero, tick marks and labels are suppressed.
+C
+      NBTP=IFIX(QBTP)
+      IF (NBTP.EQ.0) RETURN
+C
+C Unpack integer values from floating-point arguments.
+C
+      LLUA=IFIX(QLUA)
+      NMJD=IFIX(QMJD)
+      IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMND=IFIX(QMND)
+      NMNT=0
+      IF (QLTD.NE.SVAL(1).AND.QLTD.NE.SVAL(2)) NLTD=IFIX(QLTD)
+      NLTP=0
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) NLED=IFIX(QLED)
+      NLEX=0
+      IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) NLFD=IFIX(QLFD)
+      NLFL=0
+C
+C Compute label-coordinate-system values at the ends of the axis.
+C
+      CALL AGUTOL (IAXS,FUNS,1,UMIN,VMIN)
+      CALL AGUTOL (IAXS,FUNS,1,UMAX,VMAX)
+C
+C Error if the label-coordinate-system values are equal.
+C
+      IF (VMIN.EQ.VMAX) GO TO 901
+C
+C If a special value is specified for the parameter BASD, AGEXAX must
+C pick a value for the parameter BASE.
+C
+      IF (BASD.EQ.SVAL(1).OR.BASD.EQ.SVAL(2)) GO TO 101
+C
+C The user has specified a value for the parameter BASE.  If that value
+C is less than or equal to zero, tick marks and labels are suppressed.
+C
+      BASE=AMAX1(0.,BASD)
+      IF (BASE.EQ.0.) RETURN
+      NMNT=0
+      GO TO 108
+C
+C Pick a value for the parameter BASE, depending on the number type.
+C
+  101 GO TO (102,105,106) , NBTP
+C
+C Major ticks and labels are at numbers of the form (-) BASE * EXMU.
+C
+  102 NMJD=MAX0(0,NMJD)
+C
+C Compute an approximate value for BASE.
+C
+      FTMP=ABS(VMAX-VMIN)/FLOAT(NMJD+1)
+C
+C Reduce the approximate value to the form FTMP * 10 ** ITMP.
+C
+      ASSIGN 103 TO JMP1
+      GO TO 200
+C
+C Pick a reasonable value for BASE (1., 2., OR 5. * 10**ITMP).
+C
+  103 DO 104 I=1,5
+        IF (FTMP.LT.BASP(I)) GO TO 104
+        BASE=BASP(I)*SNGL(10.D0**ITMP)
+        NMNT=NMNP(I)
+        GO TO 107
+  104 CONTINUE
+C
+C Major ticks and labels are at numbers of the form (-) BASE * 10**EXMU.
+C
+  105 BASE=1.
+      NMNT=8
+      GO TO 107
+C
+C Major ticks and labels are at numbers of the form (-) BASE**EXMU.
+C
+  106 BASE=10.
+      NMNT=8
+C
+  107 IF (BASD.EQ.SVAL(2)) BASD=BASE
+C
+  108 IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMNT=MAX0(0,NMND)
+      IF (QMND.EQ.SVAL(2)) QMND=FLOAT(NMNT)
+C
+C If the user wants nice values at the axis ends, reset UMIN and UMAX.
+C
+      IF (NICE.NE.0) GO TO 115
+C
+      LOOP=0
+C
+      WMIN=VMIN
+      WMAX=VMAX
+C
+      GO TO (109,110,112) , NBTP
+C
+  109 EMIN=VMIN/BASE+.5+SIGN(.5,VMIN-VMAX)
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN-VMAX)
+      WMIN=BASE*(EMIN-AMOD(EMIN,1.))
+      EMAX=VMAX/BASE+.5+SIGN(.5,VMAX-VMIN)
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX-VMIN)
+      WMAX=BASE*(EMAX-AMOD(EMAX,1.))
+      GO TO 114
+C
+  110 IF (VMIN.EQ.0.) GO TO 111
+      EMIN=ALOG10(ABS(VMIN)/BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX))
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX))
+      WMIN=SIGN(BASE,VMIN)*10.**(EMIN-AMOD(EMIN,1.))
+  111 IF (VMAX.EQ.0.) GO TO 114
+      EMAX=ALOG10(ABS(VMAX)/BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN))
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN))
+      WMAX=SIGN(BASE,VMAX)*10.**(EMAX-AMOD(EMAX,1.))
+      GO TO 114
+C
+  112 IF (BASE.EQ.1.) GO TO 115
+      IF (VMIN.EQ.0.) GO TO 113
+      EMIN=ALOG10(ABS(VMIN))/ALOG10(BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX))
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX))
+      WMIN=SIGN(1.,VMIN)*BASE**(EMIN-AMOD(EMIN,1.))
+  113 IF (VMAX.EQ.0.) GO TO 114
+      EMAX=ALOG10(ABS(VMAX))/ALOG10(BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN))
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN))
+      WMAX=SIGN(1.,VMAX)*BASE**(EMAX-AMOD(EMAX,1.))
+C
+C Re-compute the user-coordinate-system minimum and maximum values.
+C
+  114 CALL AGUTOL (IAXS,FUNS,-1,WMIN,QMIN)
+      CALL AGUTOL (IAXS,FUNS,-1,WMAX,QMAX)
+C
+C Test for problems with nice values chosen.
+C
+      IF (QMIN.LT.QMAX) GO TO 140
+      IF (QMIN.GT.QMAX) GO TO 901
+C
+C We have a pathological case - user values are clustered very close to
+C a label position.  See what can be done about it.
+C
+      LOOP=LOOP+1
+      IF (LOOP.GT.1) GO TO 901
+C
+      GO TO (137,138,139) , NBTP
+C
+  137 VMIN=VMIN+SIGN(BASE,VMIN-VMAX)
+      VMAX=VMAX+SIGN(BASE,VMAX-VMIN)
+      GO TO 109
+C
+  138 VMIN=VMIN*10.**SIGN(1.,VMIN*(VMIN-VMAX))
+      VMAX=VMAX*10.**SIGN(1.,VMAX*(VMAX-VMIN))
+      GO TO 110
+C
+  139 VMIN=VMIN*BASE**SIGN(1.,VMIN*(VMIN-VMAX))
+      VMAX=VMAX*BASE**SIGN(1.,VMAX*(VMAX-VMIN))
+      GO TO 112
+C
+  140 VMIN=WMIN
+      VMAX=WMAX
+C
+C Now we examine the parameters defining the appearance of the numeric
+C labels.  If the numeric-label type is zero, there is no more to do.
+C
+  115 IF (QLTD.EQ.SVAL(1).OR.QLTD.EQ.SVAL(2)) GO TO 116
+      NLTP=MAX0(0,MIN0(3,NLTD))
+      IF (NLTP.EQ.0) GO TO 136
+C
+C The numeric-label type (NLTP) is specified.  If both the numeric-label
+C exponent and numeric-label fraction-length are also specified, quit.
+C
+      NLEX=NLED
+      NLFL=NLFD
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2).AND.
+     +    QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)       ) GO TO 136
+      GO TO 117
+C
+C We must pick a value for the numeric-label type.  Start with the dummy
+C value 4 so as to jump to the proper piece of code.
+C
+  116 NLTP=4
+C
+C Reduce the value of BASE to the form RBSE * 10**KBSE, where RBSE is
+C in the range (1,10) and KBSE is an integer.
+C
+  117 FTMP=BASE
+      ASSIGN 118 TO JMP1
+      GO TO 200
+C
+  118 RBSE=FTMP
+      KBSE=ITMP
+C
+C Compute LBSE = the number of significant digits in RBSE.
+C
+      ASSIGN 119 TO JMP2
+      GO TO 300
+C
+  119 LBSE=1+ITMP
+C
+C Jump depending on the value of the numeric-label type.
+C
+      GO TO (120,128,131,132) , NLTP
+C
+C Scientific notation is to be used.  Estimate the number of significant
+C digits that are likely to be required, depending on the number type.
+C
+  120 GO TO (121,123,124) , NBTP
+C
+  121 FTMP=AMAX1(ABS(VMIN),ABS(VMAX))/BASE
+      ASSIGN 122 TO JMP1
+      GO TO 200
+C
+  122 NSIG=MAX0(1,ITMP+1+LBSE)
+      GO TO 125
+C
+  123 NSIG=LBSE
+      GO TO 125
+C
+  124 NSIG=10
+C
+C NLEX + NLFL should be equal to NSIG.  Make that the case.
+C
+  125 IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 127
+      IF (QLFD.EQ.SVAL(1).OR. QLFD.EQ.SVAL(2)) GO TO 126
+      NLEX=NSIG-MAX0(0,NLFL)
+      GO TO 135
+  126 NLEX=1
+  127 NLFL=NSIG-NLEX
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C Exponential notation is to be used.  Compute the exponent NEXP such
+C that BASE / 10**NEXP is an integer.
+C
+  128 NEXP=KBSE-LBSE+1
+C
+C NLEX - NLFL should be equal to NEXP.  Make that the case.  (Note that,
+C if NBTP is 3, NLEX is forced to zero.)
+C
+      IF (NBTP.EQ.3) NLEX=0
+C
+      IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 129
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 130
+      NLFL=-1
+  129 NLEX=MAX0(0,NLFL)+NEXP
+      GO TO 135
+  130 NLFL=NLEX-NEXP
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C No-exponent notation is to be used.  NLFL is the only parameter we
+C need to worry about.  If it is already set, quit.
+C
+  131 IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 136
+C
+C Set NLFL to the actual number of digits in the fractional portion of
+C BASE.
+C
+      NLFL=LBSE-KBSE-1
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C We must pick a value for the numeric-label type, depending on the
+C number type.
+C
+  132 GO TO (133,134,134) , NBTP
+C
+C Nunbers are of the form (-) BASE * EXMU.  Use labels with no exponent
+C unless the use of an exponent would result in shorter labels.
+C
+  133 IF (MAX0(KBSE+1-LBSE,-KBSE-1).GT.4) GO TO 134
+      NLTP=3
+      NLFL=LBSE-KBSE-1
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C Exponential notation is used.
+C
+  134 NLTP=2
+      NLEX=KBSE-LBSE+1
+      NLFL=-1
+C
+C Back-store the computed parameters, if requested, and return.
+C
+  135 IF (QLTD.EQ.SVAL(2)) QLTD=FLOAT(NLTP)
+      IF (QLED.EQ.SVAL(2)) QLED=FLOAT(NLEX)
+      IF (QLFD.EQ.SVAL(2)) QLFD=FLOAT(NLFL)
+C
+C Pack up integer values to floating-point arguments and return.
+C
+  136 QMNT=FLOAT(NMNT)
+      QLTP=FLOAT(NLTP)
+      QLEX=FLOAT(NLEX)
+      QLFL=FLOAT(NLFL)
+      RETURN
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure reduces the number (FTMP) to the range (1,10),
+C returning (FTMP) and (ITMP) such that (FTMP) * 10**(ITMP) is equal to
+C the original value of (FTMP).  (FTMP) must be positive.
+C
+  200 FTM1=ALOG10(FTMP+SMRL*FTMP)
+      IF (FTM1.LT.0.) FTM1=FTM1-1.
+      ITMP=IFIX(FTM1)
+      FTMP=AMAX1(1.,FTMP*SNGL(10.D0**(-ITMP)))
+      GO TO JMP1 , (103,118,122)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure counts the number of digits in the fractional
+C portion of (FTMP), returning the count as the value of (ITMP).
+C
+  300 FTM1=AMOD(FTMP+SMRL*FTMP,1.)
+      FTM2=10.*SMRL*FTMP
+      ITMP=0
+C
+  301 IF (FTM1.LT.FTM2) GO TO 302
+      ITMP=ITMP+1
+      IF (ITMP.GE.10) GO TO 302
+      FTM1=AMOD(10.*FTM1,1.)
+      FTM2=10.*FTM2
+      GO TO 301
+C
+  302 GO TO JMP2 , (119)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C Error exit.
+C
+C +NOAO - Comment out FTN write and format statement, SETER is okay.
+C
+  901 CONTINUE
+C 901 WRITE (I1MACH(4),9001) IAXS
+      CALL SETER ('AGEXAX (CALLED BY AGSTUP) - USER-SYSTEM-TO-LABEL-SYST
+     +EM MAPPING IS NOT MONOTONIC',1,2)
+C
+C Formats.
+C
+C9001 FORMAT ('0PROBLEM WITH AXIS NUMBER',I2,
+C    +        ' (1, 2, 3, AND 4 IMPLY LEFT, RIGHT, BOTTOM, AND TOP)')
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agexus.f b/sys/gio/ncarutil/autograph/agexus.f
new file mode 100644
index 00000000..7d4a274e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agexus.f
@@ -0,0 +1,89 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEXUS (SVAL,ZMIN,ZMAX,ZLOW,ZHGH,
+     +                               ZDRA,NVIZ,IIVZ,NEVZ,IIEZ,UMIN,UMAX)
+C
+      DIMENSION SVAL(2),ZDRA(1)
+C
+C The routine AGEXUS is used by AGSTUP to determine tentative values of
+C the user-window edge coordinates.  Its arguments are as follows:
+C
+C -- SVAL is the array of special values.
+C
+C -- ZMIN and ZMAX are user-supplied minimum and maximum values of the
+C    data x (or y) coordinates.
+C
+C -- ZLOW and ZHGH are, respectively, the smallest and largest data
+C    values to be considered in choosing the minimum and maximum, if
+C    those values, as given by the user, are null.
+C
+C -- ZDRA, NVIZ, IIVZ, NEVZ, and IIEZ specify the array of x (or y)
+C    data coordinates (see AGMAXI or AGMINI for complete description).
+C
+C -- UMIN and UMAX are returned with tentative minimum and maximum
+C    values for use at the appropriate user-window edges (left/right
+C    or bottom/top).
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Assume initially that the user has provided actual values to be used.
+C
+      UMIN=ZMIN
+      UMAX=ZMAX
+C
+C If either of the values is null, replace it by a data-based value.
+C
+      IF (UMIN.EQ.SVAL(1).OR.UMIN.EQ.SVAL(2))
+     +                UMIN=AGMINI(SVAL(1),ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+      IF (UMAX.EQ.SVAL(1).OR.UMAX.EQ.SVAL(2))
+     +                UMAX=AGMAXI(SVAL(1),ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+C Either or both values might still be null (if the user data was null).
+C
+      IF (UMIN.EQ.SVAL(1)) UMIN=UMAX
+      IF (UMAX.EQ.SVAL(1)) UMAX=UMIN
+C
+C Check the relative values of UMIN and UMAX for problems.
+C
+      IF (ABS(UMIN-UMAX).LT.50.*SMRL*(ABS(UMIN)+ABS(UMAX))) GO TO 102
+      IF (UMAX-UMIN) 101,102,103
+  101 IF (ZMIN.NE.SVAL(1).AND.ZMIN.NE.SVAL(2)) UMAX=UMIN
+      IF (ZMAX.NE.SVAL(1).AND.ZMAX.NE.SVAL(2)) UMIN=UMAX
+C
+  102 UMIN=UMIN-.5*ABS(UMIN)
+      UMAX=UMAX+.5*ABS(UMAX)
+      IF (UMIN.NE.UMAX) GO TO 103
+      UMIN=-1.
+      UMAX=+1.
+C
+C If the user wanted these values back-stored, do it.
+C
+  103 IF (ZMIN.EQ.SVAL(2)) ZMIN=UMIN
+      IF (ZMAX.EQ.SVAL(2)) ZMAX=UMAX
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agezsu.f b/sys/gio/ncarutil/autograph/agezsu.f
new file mode 100644
index 00000000..535e1811
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agezsu.f
@@ -0,0 +1,104 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEZSU (ITOC,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,
+     +                                                      IIVY,IIEY)
+C
+      REAL XDRA(1),YDRA(1)
+      CHARACTER*(*) LABG
+C
+C The routine AGEZSU is used by the AUTOGRAPH routines EZY, EZXY, EZMY,
+C EZMXY, and IDIOT to examine those parameters which are peculiar to the
+C old version of AUTOGRAPH and to do the appropriate call to AGSTUP.
+C The arguments are as follows:
+C
+C -- ITOC indicates which routine is calling AGEZSU, as follows:
+C
+C     -- ITOC .EQ. 1 - call by EZY
+C     -- ITOC .EQ. 2 - call by EZXY
+C     -- ITOC .EQ. 3 - call by EZMY
+C     -- ITOC .EQ. 4 - call by EZMXY
+C     -- ITOC .EQ. 5 - call by IDIOT
+C
+C -- XDRA is an array of x-coordinate data.
+C
+C -- YDRA is an array of y-coordinate data.
+C
+C -- IDXY is the first dimension of YDRA.
+C
+C -- MANY is the number of curves defined by XDRA and YDRA.
+C
+C -- NPTS is the number of points per curve.
+C
+C -- LABG is a new header label (or the single character CHAR(0), if the
+C    header label is to be unchanged).
+C
+C -- IIVX, IIEX, IIVY, and IIEY are indexing controls for the x and y
+C    data arrays, computed and returned by AGEZSU for use in setting up
+C    calls to the routine AGCURV.
+C
+C Examine the frame-advance parameter.  Do frame advance as appropriate.
+C
+      CALL AGGETI ('FRAM.',IFRA)
+      IFRA=MAX0(1,MIN0(3,IFRA))
+C
+      IF (IFRA.EQ.3) CALL FRAME
+C
+C Set up the header label.
+C
+      IF (ICHAR(LABG(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'T')
+        CALL AGSETI ('LINE/NUMB.', 100)
+        CALL AGSETC ('LINE/TEXT.',LABG)
+      END IF
+C
+C Set up the AGSTUP arguments defining the coordinate-data arrays.
+C
+      CALL AGGETI ('ROW .',IROW)
+      IROW=MAX0(-2,MIN0(+2,IROW))
+C
+      NVIY=MANY
+      IIVY=IDXY
+      NEVY=NPTS
+      IIEY=1
+C
+      IF (IROW.LE.0.AND.ITOC.GE.3.AND.ITOC.LE.4) THEN
+        IIVY=1
+        IIEY=IDXY
+      END IF
+C
+      NVIX=NVIY
+      IIVX=IIVY
+      NEVX=NEVY
+      IIEX=IIEY
+C
+      IF (IABS(IROW).LE.1) THEN
+        NVIX=1
+        IIVX=0
+        NEVX=NPTS
+        IIEX=1
+      END IF
+C
+      IF (ITOC.EQ.1.OR.ITOC.EQ.3) IIEX=0
+C
+C Do the AGSTUP call.
+C
+      CALL AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agfpbn.f b/sys/gio/ncarutil/autograph/agfpbn.f
new file mode 100644
index 00000000..f4900b60
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agfpbn.f
@@ -0,0 +1,37 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      INTEGER FUNCTION AGFPBN (FPDP)
+C
+C The value of AGFPBN(FPDP) is a binary dash pattern, obtained from the
+C floating-point dash pattern FPDP.  On machines having a word length
+C greater than 16 bits, AGFPBN(FPDP) = IFIX(FPDP).  On machines having
+C a word length of 16 bits, this is not true.  For example, when FPDP =
+C 65535. (2 to the 16th minus 1), the equivalent binary dash pattern
+C does not have the value 65535, but the value -1 (assuming integers
+C are represented in a ones' complement format).  So, the functions
+C ISHIFT and IOR must be used to generate the dash pattern.
+C
+      TEMP=FPDP
+      AGFPBN=0
+C
+      DO 101 I=1,16
+        IF (AMOD(TEMP,2.).GE.1.) AGFPBN=IOR(AGFPBN,ISHIFT(1,I-1))
+        TEMP=TEMP/2.
+  101 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agftol.f b/sys/gio/ncarutil/autograph/agftol.f
new file mode 100644
index 00000000..b685f913
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agftol.f
@@ -0,0 +1,119 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGFTOL (IAXS,IDMA,VINP,VOTP,VLCS,LLUA,UBEG,UDIF,FUNS,
+     +                                                        NBTP,SBSE)
+C
+C The routine AGFTOL is used by AGAXIS to map a fractional distance
+C along the axis to a value in the label coordinate system or vice-
+C versa.  Its arguments are as follows:
+C
+C -- IAXS specifies which axis is being drawn.  It is passed to the
+C    routine AGUTOL.  See AGAXIS for a complete description of IAXS.
+C
+C -- IDMA specifies the direction of the mapping - from the fractional
+C    system to the label system if IDMA .GT. 0 or from the label system
+C    to the fractional system if IDMA .LT. 0.  IDMA also specifies how
+C    the label-system value is given to or returned by AGFTOL.
+C
+C     -- If ABSV(IDMA) .EQ. 1, an actual value in the label coordinate
+C        system (VLCS) is given to or returned by AGFTOL.
+C
+C     -- If ABSV(IDMA) .NE. 1, a value of the exponent/multiplier EXMU
+C        corresponding to VLCS is given to or returned by AGFTOL.
+C
+C -- VINP is an input value in one coordinate system.
+C
+C -- VOTP is an output value in the other coordinate system.
+C
+C -- VLCS is an output value in the label coordinate system, returned
+C    no matter what the value of IDMA.
+C
+C -- LLUA, UBGA, and UDFA specify the mapping from the user coordinate
+C    system to the fractional system and vice-versa.  See the routine
+C    AGAXIS for a complete description of these parameters.
+C
+C -- FUNS is a function-selector, to be used in calls to AGUTOL.  It
+C    selects the mapping from the user coordinate system to the label
+C    coordinate system and vice-versa.  See the routine AGAXIS for a
+C    complete description of this parameter.
+C
+C -- NBTP and SBSE specify the mapping of label-coordinate-system values
+C    to exponent/multiplier values and vice-versa.  See the routine
+C    AGNUMB for a complete dexcription of these parameters.
+C
+C Determine desired direction of mapping.
+C
+      IF (IDMA.GT.0) THEN
+C
+C Map axis fraction VINP to a label-coordinate-system value VLCS.
+C
+        VUCS=UBEG+VINP*UDIF
+        IF (LLUA.NE.0) VUCS=10.**VUCS
+        CALL AGUTOL (IAXS,FUNS,1,VUCS,VLCS)
+C
+C If IDMA .EQ. 1, caller wants VLCS - otherwise, map VLCS to the
+C appropriate exponent/multiplier value EXMU - return value in VOTP.
+C
+        IF (IDMA.EQ.1) THEN
+          VOTP=VLCS
+          RETURN
+        END IF
+C
+        GO TO (101,102,103) , NBTP
+C
+  101   VOTP=VLCS/SBSE
+        RETURN
+C
+  102   VOTP=ALOG10(VLCS/SBSE)
+        RETURN
+C
+  103   VOTP=ALOG10(ABS(VLCS))/ALOG10(ABS(SBSE))
+        RETURN
+C
+      ELSE
+C
+C If IDMA .EQ. -1, caller has provided VINP .EQ. VLCS, a value in the
+C label coordinate system - otherwise, VINP .EQ. EXMU, the exponent/
+C multiplier needed to generate VLCS.
+C
+        IF (IDMA.EQ.(-1)) THEN
+          VLCS=VINP
+          GO TO 107
+        END IF
+C
+        GO TO (104,105,106) , NBTP
+C
+  104   VLCS=SBSE*VINP
+        GO TO 107
+C
+  105   VLCS=SBSE*10.**VINP
+        GO TO 107
+C
+  106   VLCS=SIGN(1.,SBSE)*ABS(SBSE)**VINP
+C
+C Map label-system value VLCS to a user-system value VUCS.
+C
+  107   CALL AGUTOL (IAXS,FUNS,-1,VLCS,VUCS)
+C
+C Map user-system value VUCS to an axis fraction VOTP and return.
+C
+        IF (LLUA.NE.0) VUCS=ALOG10(VUCS)
+        VOTP=(VUCS-UBEG)/UDIF
+        RETURN
+C
+      END IF
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetc.f b/sys/gio/ncarutil/autograph/aggetc.f
new file mode 100644
index 00000000..caf9f357
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetc.f
@@ -0,0 +1,51 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETC (TPID,CUSR)
+C
+      CHARACTER*(*) TPID,CUSR
+C
+      DIMENSION FURA(1)
+C
+C The routine AGGETC is used to get the character strings represented
+C by the values of certain individual AUTOGRAPH parameters.  TPID is a
+C parameter identifier (from the caller).  CUSR is a character string
+C (returned to the caller).
+C
+C See what kind of parameter is being gotten.
+C
+      CALL AGCTCS (TPID,ITCS)
+C
+C If the parameter is not intrinsically of type character, log an error.
+C
+      IF (ITCS.EQ.0) GO TO 901
+C
+C Otherwise, get the integer value of the parameter and use that to get
+C the desired character string.
+C
+      CALL AGGETP (TPID,FURA,1)
+      CALL AGGTCH (IFIX(FURA(1)),CUSR,LNCS)
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGGETC - PARAMETER TO GET IS NOT INTRINSICALLY OF TYP
+     +E CHARACTER',2,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetf.f b/sys/gio/ncarutil/autograph/aggetf.f
new file mode 100644
index 00000000..6391222b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetf.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETF (TPID,FUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETF may be used to get the real (floating-point) value
+C of any single AUTOGRAPH control parameter.
+C
+      CALL AGGETP (TPID,FURA,1)
+      FUSR=FURA(1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggeti.f b/sys/gio/ncarutil/autograph/aggeti.f
new file mode 100644
index 00000000..31841826
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggeti.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETI (TPID,IUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETI may be used to get the integer-equivalent value of
+C any single AUTOGRAPH control parameter.
+C
+      CALL AGGETP (TPID,FURA,1)
+      IUSR=IFIX(FURA(1))
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetp.f b/sys/gio/ncarutil/autograph/aggetp.f
new file mode 100644
index 00000000..ac44085e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetp.f
@@ -0,0 +1,104 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETP (TPID,FURA,LURA)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETP returns to the user the AUTOGRAPH parameter(s)
+C specified by the parameter identifier TPID.  The arguments are as
+C follows:
+C
+C -- TPID is the parameter identifier, a string of keywords separated
+C    from each other by slashes and followed by a period.
+C
+C -- FURA is the user array which is to receive the desired parameter(s)
+C    specified by TPID.
+C
+C -- LURA is the length of the user array FURA.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Define the array DUMI, which allows access to the parameter list as
+C an array.
+C
+      DIMENSION DUMI(1)
+      EQUIVALENCE (QFRA,DUMI)
+C
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C The routine AGSCAN is called to scan the parameter identifier and to
+C return three quantities describing the AUTOGRAPH parameters desired.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C Determine the number of elements to transfer.
+C
+      NURA=MAX0(1,MIN0(LURA,NIPA))
+C
+C Transfer the desired parameters to the user array.
+C
+      IDMI=LOPA-IIPA
+C
+      DO 101 IURA=1,NURA
+        IDMI=IDMI+IIPA
+        FURA(IURA)=DUMI(IDMI)
+  101 CONTINUE
+C
+C If the current label name is being gotten, return its identifier.
+C
+      CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN.AND.NIPA.EQ.NILN.AND.QBAN.NE.0.) THEN
+        LBAN=IFIX(QBAN)
+        FURA(1)=FLLB(1,LBAN)
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggtch.f b/sys/gio/ncarutil/autograph/aggtch.f
new file mode 100644
index 00000000..7591c670
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggtch.f
@@ -0,0 +1,78 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGTCH (IDCS,CHST,LNCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine gets character strings previously stored by the routine
+C AGSTCH (which see).  It has the following arguments:
+C
+C -- IDCS is the identifying integer returned by AGSTCH when the string
+C    was stored.
+C
+C -- CHST is the character string returned.
+C
+C -- LNCS is the length of the character string returned in CHST.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C First, blank-fill the character variable to be returned.
+C
+      CHST=' '
+C
+C If the identifier is less than -LNIC, the (one-character) string is
+C retrieved from it.
+C
+      IF (IDCS.LT.(-LNIC)) THEN
+        CHST=CHAR(-IDCS-LNIC-1)
+        LNCS=1
+C
+C If the identifier is between -LNIC and -1, its absolute value is the
+C index, in INCH, of the descriptor of the character string stored in
+C CHRA.
+C
+      ELSE IF (IDCS.LE.(-1)) THEN
+        I=-IDCS
+        J=INCH(1,I)-1
+        IF (J.GE.0) THEN
+          LNCS=MIN0(LEN(CHST),INCH(2,I))
+          DO 101 K=1,LNCS
+            J=J+1
+            CHST(K:K)=CHRA(J)
+  101     CONTINUE
+        ELSE
+          LNCS=0
+        END IF
+C
+C In all other cases, return a single blank.
+C
+      ELSE
+        LNCS=1
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aginit.f b/sys/gio/ncarutil/autograph/aginit.f
new file mode 100644
index 00000000..e863e01f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aginit.f
@@ -0,0 +1,113 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGINIT
+C
+C This routine is called to initialize some machine-dependent constants.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Fill in the names of the four pre-defined labels.
+C
+      CALL AGSTCH ('L',1,IDCS)
+      FLLB(1,1)=FLOAT(IDCS)
+      CALL AGSTCH ('R',1,IDCS)
+      FLLB(1,2)=FLOAT(IDCS)
+      CALL AGSTCH ('B',1,IDCS)
+      FLLB(1,3)=FLOAT(IDCS)
+      CALL AGSTCH ('T',1,IDCS)
+      FLLB(1,4)=FLOAT(IDCS)
+C
+C Declare the rest of the label-definition slots to be available.
+C
+      LBIM=IFIX(QBIM)
+C
+      DO 101 J=5,LBIM
+        FLLB(1,J)=0.
+  101 CONTINUE
+C
+C Fill in the text of the four pre-defined lines.
+C
+      CALL AGSTCH ('Y',1,IDCS)
+      FLLN(4,1)=FLOAT(IDCS)
+      CALL AGSTCH (' ',1,IDCS)
+      FLLN(4,2)=FLOAT(IDCS)
+      CALL AGSTCH ('X',1,IDCS)
+      FLLN(4,3)=FLOAT(IDCS)
+      CALL AGSTCH (' ',1,IDCS)
+      FLLN(4,4)=FLOAT(IDCS)
+C
+C Declare the rest of the line-definition slots to be available.
+C
+      LNIM=IFIX(QNIM)
+C
+      DO 102 J=5,LNIM
+        FLLN(1,J)=SVAL(1)
+  102 CONTINUE
+C
+C Set the value of 'LINE/TERMINATOR.'
+C
+      CALL AGSTCH ('$',1,IDCS)
+      TCLN=FLOAT(IDCS)
+C
+C SMRL is used by AUTOGRAPH for rounding operations.
+C
+      SMRL=10.**(3-IFIX(ALOG10(FLOAT(I1MACH(10)))*FLOAT(I1MACH(11))))
+C
+C ISLD is an integer containing 16 one bits (right-justified with zero
+C fill to the left).  It is used to direct the DASHCHAR package to draw
+C solid lines.  To generate it, we start with a 15-bit mask and then
+C add another bit.
+C
+      ISLD = 32767
+      ISLD = ISHIFT(ISLD,1)
+      ISLD = IOR(ISLD,1)
+C
+C Set the initialization flag to indicate initialization has been done.
+C
+      INIF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agkurv.f b/sys/gio/ncarutil/autograph/agkurv.f
new file mode 100644
index 00000000..d93f0659
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agkurv.f
@@ -0,0 +1,145 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGKURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C No windowing is performed.
+C
+C Check first whether the number of curve points is properly specified.
+C
+      IF (NEXY.LE.0) GO TO 901
+C
+C Initialization.  Pretend that the last point was point number zero.
+C Set the indices for the x and y vectors accordingly.  Clear the line-
+C drawn-to-last-point flag.
+C
+      INDP=0
+      INDX=1-IIEX
+      INDY=1-IIEY
+      LDLP=0
+C
+C Initialization.  Retrieve the current curve window, user window, and
+C x/y linear/logarithmic flags.
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C x-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN
+        LLUX=0
+        XLLW=XLUW
+        XRLW=XRUW
+      ELSE
+        LLUX=1
+        XLLW=ALOG10(XLUW)
+        XRLW=ALOG10(XRUW)
+      END IF
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C y-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN
+        LLUY=0
+        YBLW=YBUW
+        YTLW=YTUW
+      ELSE
+        LLUY=1
+        YBLW=ALOG10(YBUW)
+        YTLW=ALOG10(YTUW)
+      END IF
+C
+C Initialization.  Call SET, if necessary, to define a linear mapping.
+C
+      IF (LTYP.NE.1)
+     +              CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1)
+C
+C Beginning of loop through points.  Update indices and determine the
+C user-space coordinates of the next point.
+C
+  101 IF (INDP.EQ.NEXY) GO TO 102
+      INDP=INDP+1
+C
+      INDX=INDX+IIEX
+      XNXT=XVEC(INDX)
+      IF (IIEX.EQ.0) XNXT=FLOAT(INDP)
+      IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL
+C
+      INDY=INDY+IIEY
+      YNXT=YVEC(INDY)
+      IF (IIEY.EQ.0) YNXT=FLOAT(INDP)
+      IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL
+C
+C Check whether (XNXT,YNXT) is a special-value point.  Handle that case.
+C
+      IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN
+        IF (LDLP.EQ.0) GO TO 101
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+        LDLP=0
+        GO TO 101
+      END IF
+C
+C If user space is not linear/linear, modify XNXT and YNXT accordingly.
+C
+      IF (LLUX.NE.0) XNXT=ALOG10(XNXT)
+      IF (LLUY.NE.0) YNXT=ALOG10(YNXT)
+C
+C Start or continue line.
+C
+      IF (LDLP.EQ.0) THEN
+        CALL FRSTD (XNXT,YNXT)
+        XLST=XNXT
+        YLST=YNXT
+      ELSE
+        CALL VECTD (XNXT,YNXT)
+      END IF
+C
+      LDLP=LDLP+1
+      GO TO 101
+C
+C Last point was final point.  Finish up.
+C
+  102 IF (LDLP.NE.0) THEN
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+      END IF
+C
+C Restore logarithmic mapping, if appropriate.
+C
+      IF (LTYP.NE.1)
+     +           CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Return to caller.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL SETER ('AGKURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE
+     +RO',3,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aglbls.f b/sys/gio/ncarutil/autograph/aglbls.f
new file mode 100644
index 00000000..d99b038d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aglbls.f
@@ -0,0 +1,616 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGLBLS (ITST,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+      DIMENSION FLLB(10,8),FLLN(6,16),DBOX(6,4),SBOX(6,4),RBOX(6)
+C
+C The routine AGLBLS is used (if ITST .LE. 0) to predict the amount of
+C space which will be required for graph labels (excluding the numeric
+C labels on the axes, which are handled by AGAXIS) or (if ITST .GT. 0)
+C to actually draw the graph labels.
+C
+C The labels in question are defined by the label list (FLLB array) and
+C the line list (FLLN array).  Each label is assumed to lie in one of
+C five boxes, as follows:
+C
+C    Box 1 is to the left of the curve window.
+C    Box 2 is to the right of the curve window.
+C    Box 3 is below the curve window.
+C    Box 4 is above the curve window.
+C    Box 5 is the curve window itself.
+C    Box 6 is the entire plot (graph) window.
+C
+C A test run of AGLBLS returns two sets of box dimensions to the caller.
+C DBOX contains the dimensions required if all labels are to have their
+C desired sizes, SBOX the dimensions required if all labels are to have
+C their smallest sizes.  The caller is expected to use this information
+C to determine a final set of box dimensions (stored in DBOX), and then
+C call AGLBLS again to actually draw the labels in those boxes.
+C
+C The arguments of AGLBLS are as follows:
+C
+C -- ITST specifies whether the call is a test call (ITST .LE. 0) or a
+C    real call (ITST .GT. 0).  If ABSV(ITST) .GT. 1, AGLBLS is allowed
+C    to shrink the labels if they would not otherwise fit in their box.
+C    If ABSV(ITST) .EQ. 1, shrinkage of labels is prohibited.  If ITST
+C    .EQ. 0, labels are suppressed.
+C
+C -- WCWP and HCWP are the width and height of the curve window, in
+C    plotter-coordinate-system units.  AGLBLS assumes that the last call
+C    to the plot package routine "SET" had arguments XLCW, XRCW, YBCW,
+C    YTCW, 0., 1., 0., 1., and 1 - defining the most convenient system
+C    of coordinates for it.
+C
+C -- FLLB is the array in which the label list is stored.  The array is
+C    doubly-dimensioned.  The first subscript specifies one of ten label
+C    attributes, the second a particular label.  The attributes are as
+C    follows (the name ILLB(M,N) refers to a label attribute which is
+C    intrinsically an integer, despite being stored as a real):
+C
+C    -- ILLB(1,N) specifies the name of label N.  If ILLB(1,N) is zero,
+C       no label is defined.  Otherwise, ILLB(1,N) is an identifier
+C       returned by AGSTCH when the name of the label (a character
+C       string) was stored away.
+C
+C    -- ILLB(2,N) may be set non-zero to suppress label N.
+C
+C    -- FLLB(3,N) and FLLB(4,N) are the x and y coordinates of a base-
+C       point relative to which label N is positioned, as fractions of
+C       the width and height, respectively, of the curve window.  The
+C       position of the base-point determines the box in which label N
+C       is considered to lie.
+C
+C    -- FLLB(5,N) and FLLB(6,N) are small offsets (typically about the
+C       size of a character width), stated as fractions of the smaller
+C       side of the curve window.  They are used to offset the label
+C       base-point (after the box number is determined).  Typically,
+C       this provides a minimum spacing between the label and one side
+C       of the curve window.
+C
+C    -- ILLB(7,N) is the orientation angle of the label, in degrees
+C       counter-clockwise from horizontal.  The base-line for label N
+C       is a vector emanating from the base-point at this angle.  The
+C       specified angle must be a multiple of 90 degrees.
+C
+C    -- ILLB(8,N) is the centering option for the label.  It specifies
+C       how each line of the label is to be positioned relative to a
+C       line perpendicular to the base-line at the base-point.
+C
+C       -- If ILLB(8,N) .LT. 0, the left edge of each line lies on
+C          the perpendicular.
+C
+C       -- If ILLB(8,N) .EQ. 0, the center of each line lies on the
+C          perpendicular.
+C
+C       -- If ILLB(8,N) .GT. 0, the right edge of each line lies on
+C          the perpendicular.
+C
+C    -- ILLB(9,N) is the number of lines in label N.
+C
+C    -- ILLB(10,N) is the second subscript (in the line list) of the
+C       first line of label N.
+C
+C -- LBIM is the maximum number of labels the label list will hold.
+C
+C -- FLLN is the array in which the line list is stored.  The array is
+C    doubly-dimensioned.  The first subscript specifies one of six line
+C    attributes, the second a particular line.  The attributes are as
+C    follows (the name ILLN(M,N) refers to a line attribute which is
+C    intrinsically an integer, despite being stored as a real):
+C
+C    -- ILLN(1,N) is the position number of line N.  The lines of a
+C       label are ordered according to their position numbers, the one
+C       having the largest position number being top-most.  Moreover,
+C       lines having position numbers .GT. 0 are placed above the label
+C       base-line, those having position numbers .EQ. 0 (of which there
+C       should be but one) are placed on the label base-line, and those
+C       having position numbers .LT. 0 are placed below the label base-
+C       line.  The magnitudes of the position numbers have nothing to
+C       do with inter-line spacing - that is up to AGLBLS to determine.
+C
+C    -- ILLN(2,N) may be set non-zero to suppress line N.
+C
+C    -- FLLN(3,N) is the desired width of characters in the line, as a
+C       fraction of the smaller side of the curve window.
+C
+C    -- ILLN(4,N) is the identifier of the character string comprising
+C       the text of the line, as returned by AGSTCH at the time the
+C       string was stored.
+C
+C    -- ILLN(5,N) is the number of characters in the line.
+C
+C    -- ILLN(6,N) is the index of the next line of the label.  The
+C       lines of a label must be ordered by position number (largest
+C       to smallest).
+C
+C -- DBOX and SBOX, dimensioned 6 X 4, contain box dimensions, as dis-
+C    cussed above.  D/SBOX(M,N) is the Nth edge-coordinate of box M,
+C    where N .EQ. 1 for the left edge, 2 for the right edge, 3 for the
+C    bottom edge, and 4 for the top edge, of the box.  The first two are
+C    stated as fractions of the width, the second two as fractions of
+C    the height, of the curve window.
+C
+C    RBOX, dimensioned 6, holds reduction factors for the sizes of the
+C    characters in labels in each of the six boxes.  Each RBOX(M) is
+C
+C    -- negative to specify smallest-size characters, or
+C
+C    -- zero to specify that no reduction factor has been chosen, or
+C
+C    -- positive, between 0. and 1. (an actual reduction factor).
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only one of
+C interest here is MWCL, which is the minimum usable character width,
+C in plotter units.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C HCFW(WDTH) specifies the height of a character as a function of width.
+C
+      HCFW(WDTH)=2.*WDTH
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the main section of AGLBLS.
+C
+C Compute the length of the smallest side of the curve window.
+C
+      SCWP=AMIN1(WCWP,HCWP)
+C
+C Preset certain jumps in the internal procedure which follows.
+C
+      ASSIGN 211 TO JMP1
+      ASSIGN 216 TO JMP2
+      ASSIGN 221 TO JMP3
+C
+C Jump if this is a test run.
+C
+      IF (ITST.LE.0) GO TO 101
+C
+C This is not a test run.  If the reduction factors for the six boxes
+C are already set, jump directly to the plotting section; otherwise, we
+C must first compute the coordinates of the six smallest-size boxes.
+C
+      IF (RBOX(1).NE.0.) GO TO 115
+      GO TO 105
+C
+C This is a test run.  Compute the coordinates of the edges of the six
+C desired-size boxes.
+C
+  101 RWCL=1.
+      NBOX=0
+      ASSIGN 102 TO JMP4
+      GO TO 200
+C
+  102 DBOX(NBOX,1)=XLBX
+      DBOX(NBOX,2)=XRBX
+      DBOX(NBOX,3)=YBBX
+      DBOX(NBOX,4)=YTBX
+C
+      IF (NBOX.LT.6) GO TO 200
+C
+C This is a test run.  Compute the coordinates of the edges of the six
+C smallest-size boxes, in one of two ways.
+C
+      IF (IABS(ITST).GT.1) GO TO 105
+C
+C This is a test run.  Determine smallest-size boxes (no shrinking).
+C
+      DO 104 J=1,4
+        DO 103 I=1,6
+          SBOX(I,J)=DBOX(I,J)
+  103   CONTINUE
+  104 CONTINUE
+      RETURN
+C
+C Determine smallest-size boxes (shrinking allowed).
+C
+  105 RWCL=0.
+      NBOX=0
+      ASSIGN 106 TO JMP4
+      GO TO 200
+C
+  106 SBOX(NBOX,1)=XLBX
+      SBOX(NBOX,2)=XRBX
+      SBOX(NBOX,3)=YBBX
+      SBOX(NBOX,4)=YTBX
+C
+      IF (NBOX.LT.6) GO TO 200
+C
+C If this is not a test run, jump to compute reduction factors for each
+C of the six boxes and then plot the labels.  Otherwise, return.
+C
+      IF (ITST.GT.0) GO TO 107
+      RETURN
+C
+C This is not a test run.  Compute reduction factors for each of the
+C six boxes.
+C
+  107 NBOX=1
+      ASSIGN 110 TO JMP4
+C
+C (DBOX(NBOX,I),I=1,4) specifies the box in which the labels are to be
+C drawn, (SBOX(NBOX,I),I=1,4) the minimum box in which they can be drawn
+C if shrunk.  Check first whether the latter is contained in the former.
+C If so, we have a chance.  If not, the best we can do is shrink the
+C labels to minimum size and hope for the best.
+C
+  108 IF (SBOX(NBOX,1).LT.SBOX(NBOX,2).AND.
+     +    DBOX(NBOX,1)-SBOX(NBOX,1).LT..0001.AND.
+     +    SBOX(NBOX,2)-DBOX(NBOX,2).LT..0001.AND.
+     +    DBOX(NBOX,3)-SBOX(NBOX,3).LT..0001.AND.
+     +    SBOX(NBOX,4)-DBOX(NBOX,4).LT..0001      ) GO TO 109
+C
+      RBOX(NBOX)=-1.
+      GO TO 114
+C
+C Mimimum-size labels will fit.  Find the largest value of RBOX(NBOX)
+C for which the labels will fit.
+C
+  109 RWCL=1.
+      DWCL=.5
+      SWCL=0.
+      GO TO 201
+C
+C See if the last value of RBOX(NBOX) gave us labels which would fit or
+C not and adjust the value accordingly.
+C
+  110 IF (DBOX(NBOX,1)-XLBX.LT..0001.AND.
+     +    XRBX-DBOX(NBOX,2).LT..0001.AND.
+     +    DBOX(NBOX,3)-YBBX.LT..0001.AND.
+     +    YTBX-DBOX(NBOX,4).LT..0001      ) GO TO 111
+C
+C Labels did not fit.  Adjust RBOX(NBOX) downward.
+C
+      RWCL=RWCL-DWCL
+      DWCL=.5*DWCL
+      IF (DWCL.LT..001) RWCL=SWCL
+      GO TO 201
+C
+C Labels did fit.  Adjust RBOX(NBOX) upward, unless it is equal to 1.
+C
+  111 IF (RWCL.EQ.1.) GO TO 113
+      SWCL=RWCL
+      RWCL=RWCL+DWCL
+      DWCL=.5*DWCL
+      IF (DWCL.GT..001) GO TO 201
+C
+C The current value of RBOX(NBOX) is acceptable.  Do next box, if any.
+C
+  113 IF (NBOX.GE.5) GO TO 114
+C
+C Return updated box-edge coordinates for boxes 1 through 4.
+C
+      DBOX(NBOX,1)=XLBX
+      DBOX(NBOX,2)=XRBX
+      DBOX(NBOX,3)=YBBX
+      DBOX(NBOX,4)=YTBX
+C
+  114 NBOX=NBOX+1
+      IF (NBOX.LE.6) GO TO 108
+C
+C We have done all we can to make the labels fit.  Plot them now.
+C
+  115 NBOX=0
+      LBIN=0
+      ASSIGN 117 TO JMP3
+      ASSIGN 120 TO JMP4
+C
+C Get a label to chew on.
+C
+  116 ASSIGN 211 TO JMP1
+      ASSIGN 216 TO JMP2
+      GO TO 202
+C
+C We have a label.  Initialize the re-loop through the lines in it.
+C
+  117 XPLN=XPLB-DTLB*YDLB/WCWP
+      YPLN=YPLB+DTLB*XDLB/HCWP
+      PHCL=0.
+      LNIN=LNII
+      ASSIGN 118 TO JMP1
+      ASSIGN 116 TO JMP2
+      GO TO 210
+C
+C Get ready to plot the label line.
+C
+  118 XPLN=XPLN+.5*(PHCL+FHCL)*YDLB/WCWP
+      YPLN=YPLN-.5*(PHCL+FHCL)*XDLB/HCWP
+      PHCL=FHCL
+      CALL AGGTCH (IFIX(FLLN(4,LNIN)),CHS2,LNC2)
+C
+C Give the user a chance to change the appearance of the label line.
+C
+      CALL AGCHIL (0,CHS1(1:LNC1),IFIX(FLLN(1,LNIN)))
+C
+C Plot the label line.
+C
+      CALL AGPWRT (XPLN,YPLN,CHS2,LNC2,IWCL,LBOR,LBCN)
+C
+C Give the user a chance to undo the changes he made above.
+C
+      CALL AGCHIL (1,CHS1(1:LNC1),IFIX(FLLN(1,LNIN)))
+C
+C Go get the next line, if any.
+C
+      GO TO 215
+C
+C All labels are drawn.  Return.
+C
+  120 RETURN
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure, which may be entered and exited in a number
+C of different ways, is used to scan the label list and the line list
+C and to return information about the labels and lines defined there.
+C
+C Entry occurs here to bump the box number, store away a reduction
+C factor for the sizes of labels in that box, and then compute the edge
+C coordinates of the box required to hold labels of the size implied by
+C that reduction factor.
+C
+  200 NBOX=NBOX+1
+C
+C Entry occurs here to do all of the above except the bumping of the box
+C number.
+C
+  201 RBOX(NBOX)=RWCL
+C
+C Initialize the label-list index and the box-edge parameters.
+C
+      LBIN=0
+      XLBX=+1000.
+      XRBX=-1000.
+      YBBX=+1000.
+      YTBX=-1000.
+      IF (ITST.EQ.0) GO TO 222
+C
+C This is the beginning of the loop through the labels.  Entry occurs
+C here to find the next label in the list and return positioning info.
+C
+C Increment the label index and test for end of label list.
+C
+  202 LBIN=LBIN+1
+      IF (LBIN.GT.LBIM) GO TO 222
+C
+C Skip this label if it is non-existent, suppressed, or empty.
+C
+      IF (FLLB(1,LBIN).EQ.0..OR.FLLB(2,LBIN).NE.0.
+     +                      .OR.FLLB(9,LBIN).EQ.0.) GO TO 202
+C
+C Unpack the parameters specifying the label-base-point position.
+C
+      XBLB=FLLB(3,LBIN)
+      YBLB=FLLB(4,LBIN)
+      XOLB=FLLB(5,LBIN)
+      YOLB=FLLB(6,LBIN)
+C
+C Determine in which of five boxes the label lies:
+C
+C in the box to the left of the curve window.
+C
+      LBBX=1
+      IF (XBLB.EQ.0..AND.XOLB.LE.0.) GO TO 203
+C
+C in the box to the right of the curve window,
+C
+      LBBX=2
+      IF (XBLB.EQ.1..AND.XOLB.GE.0.) GO TO 203
+C
+C in the box below the curve window,
+C
+      LBBX=3
+      IF (YBLB.EQ.0..AND.YOLB.LE.0.) GO TO 203
+C
+C in the box above the curve window,
+C
+      LBBX=4
+      IF (YBLB.EQ.1..AND.YOLB.GE.0.) GO TO 203
+C
+C in the curve window,
+C
+      LBBX=5
+      IF ( (XBLB.EQ.0..AND.XOLB.GT.0.).OR.
+     +     (XBLB.EQ.1..AND.XOLB.LT.0.).OR.
+     +     (YBLB.EQ.0..AND.YOLB.GT.0.).OR.
+     +     (YBLB.EQ.1..AND.YOLB.LT.0.)    ) GO TO 203
+C
+C or elsewhere.
+C
+      LBBX=6
+C
+C If we are interested in a particular box and this label is not in that
+C box, skip it.
+C
+  203 IF (NBOX.NE.0.AND.LBBX.NE.NBOX) GO TO 202
+C
+C On a non-test run, get the label name and length for call to AGCHIL.
+C
+      IF (ITST.GT.0) CALL AGGTCH (IFIX(FLLB(1,LBIN)),CHS1,LNC1)
+C
+C Unpack the label orientation and compute its direction cosines.
+C
+      LBOR=IFIX(FLLB(7,LBIN))
+C
+      XDLB=COS(.017453292519943*FLLB(7,LBIN))
+      YDLB=SIN(.017453292519943*FLLB(7,LBIN))
+C
+C Unpack the label-centering option.
+C
+      LBCN=IFIX(FLLB(8,LBIN))
+C
+C Unpack the index of the initial line of the label and save it.
+C
+      LNIN=IFIX(FLLB(10,LBIN))
+      LNII=LNIN
+C
+C If this is not a test run, modify the label-base-point position as
+C needed to move the label into the actual box in which it must fit.
+C
+      IF (ITST.LE.0) GO TO 209
+C
+      GO TO (204,205,206,207,208,209) , LBBX
+C
+  204 XBLB=XBLB+DBOX(1,2)
+      GO TO 209
+C
+  205 XBLB=XBLB+DBOX(2,1)-1.
+      GO TO 209
+C
+  206 YBLB=YBLB+DBOX(3,4)
+      GO TO 209
+C
+  207 YBLB=YBLB+DBOX(4,3)-1.
+      GO TO 209
+C
+  208 IF (XBLB.EQ.0.) XBLB=XBLB+DBOX(5,1)
+      IF (XBLB.EQ.1.) XBLB=XBLB+DBOX(5,2)-1.
+      IF (YBLB.EQ.0.) YBLB=YBLB+DBOX(5,3)
+      IF (YBLB.EQ.1.) YBLB=YBLB+DBOX(5,4)-1.
+C
+C Compute the final label-base-point position.
+C
+  209 XPLB=XBLB+XOLB*SCWP/WCWP
+      YPLB=YBLB+YOLB*SCWP/HCWP
+C
+C Before entering the loop through the line list, initialize the label-
+C dimension parameters.
+C
+      DLLB=0.
+      DRLB=0.
+      DBLB=0.
+      DTLB=0.
+C
+C This is the beginning of the loop through the lines in a given label.
+C Entry may occur here to find the next line and return info about it.
+C
+C If the line is suppressed or of zero length, skip it.
+C
+  210 IF (FLLN(2,LNIN).NE.0..OR.FLLN(5,LNIN).LE.0.) GO TO 215
+C
+C Unpack the position-number, character-width, and character-count
+C parameters for the line.
+C
+      LNPN=IFIX(FLLN(1,LNIN))
+      WCLN=FLLN(3,LNIN)
+      LNCC=IFIX(FLLN(5,LNIN))
+C
+C Compute the integer width (IWCL) and the floating-point width and
+C height (FWCL and FHCL) of characters in the label.  All are expressed
+C in plotter-coordinate-system units.
+C
+      IWCL=MAX0(MWCL,IFIX(RBOX(LBBX)*WCLN*SCWP+.5))
+      FWCL=FLOAT(IWCL)
+      FHCL=HCFW(FWCL)
+C
+C Jump back with line information or drop through, as directed.
+C
+      GO TO JMP1 , (118,211)
+C
+C Update the label-dimension parameters.
+C
+  211 DRLB=AMAX1(DRLB,FLOAT(LNCC)*FWCL)
+C
+      IF (LNPN) 212,213,214
+C
+  212 DBLB=DBLB+FHCL
+      GO TO 215
+C
+  213 DBLB=DBLB+.5*FHCL
+      DTLB=DTLB+.5*FHCL
+      GO TO 215
+C
+  214 DTLB=DTLB+FHCL
+C
+C Go to the next line in the label, if there is one.
+C
+  215 LNIN=IFIX(FLLN(6,LNIN))
+      IF (LNIN.NE.0) GO TO 210
+C
+C Jump back on end of lines or drop through, as directed.
+C
+      GO TO JMP2 , (116,216)
+C
+C If all the lines in the label were either suppressed or of zero
+C length, skip this label.
+C
+  216 IF (DRLB.EQ.0.) GO TO 202
+C
+C Complete the computation of the label dimensions.  The four parameters
+C DLLB, DRLB, DBLB, and DTLB represent the distances from the base-point
+C to the left edge, right edge, bottom edge, and top edge of the label,
+C in plotter-coordinate-system units, where left, right, etc., are as
+C viewed by a reader of the label.
+C
+      IF (LBCN) 217,218,219
+C
+C Left edges of lines are aligned.
+C
+  217 GO TO 220
+C
+C Centers of lines are aligned.
+C
+  218 DLLB=.5*(DLLB+DRLB)
+      DRLB=DLLB
+      GO TO 220
+C
+C Right edges of lines are aligned.
+C
+  219 SWAP=DLLB
+      DLLB=DRLB
+      DRLB=SWAP
+C
+C Jump back with label information or drop through, as directed.
+C
+  220 GO TO JMP3 , (117,221)
+C
+C Update the x and y coordinates of the label box edges.
+C
+  221 XLBX=AMIN1(XLBX,XBLB,
+     +     XPLB-AMAX1(+DLLB*XDLB,-DRLB*XDLB,-DBLB*YDLB,+DTLB*YDLB)/WCWP)
+      XRBX=AMAX1(XRBX,XBLB,
+     +     XPLB+AMAX1(-DLLB*XDLB,+DRLB*XDLB,+DBLB*YDLB,-DTLB*YDLB)/WCWP)
+      YBBX=AMIN1(YBBX,YBLB,
+     +     YPLB-AMAX1(+DLLB*YDLB,-DRLB*YDLB,+DBLB*XDLB,-DTLB*XDLB)/HCWP)
+      YTBX=AMAX1(YTBX,YBLB,
+     +     YPLB+AMAX1(-DLLB*YDLB,+DRLB*YDLB,-DBLB*XDLB,+DTLB*XDLB)/HCWP)
+C
+C Go back for the next label.
+C
+      GO TO 202
+C
+C End of label list.  Jump as directed.
+C
+  222 GO TO JMP4 , (102,106,110,120)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agmaxi.f b/sys/gio/ncarutil/autograph/agmaxi.f
new file mode 100644
index 00000000..9c981e0d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agmaxi.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      FUNCTION AGMAXI (SVAL,ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+      DIMENSION ZDRA(1)
+C
+C The routine AGMAXI returns the maximum value of the elements in ZDRA
+C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the
+C special value SVAL (or more than ZHGH, if ZHGH is not equal to SVAL).
+C
+C -- NVIZ is the number of vectors of data stored in ZDRA.
+C
+C -- IIVZ is the index increment from one data vector to the next.
+C
+C -- NEVZ is the number of elements per vector to be examined.
+C
+C -- IIEZ is the index increment from one vector element to the next.
+C    If IIEZ is 0, the array is ignored and NEVZ is returned.
+C
+      AGMAXI=FLOAT(NEVZ)
+      IF (IIEZ.EQ.0) RETURN
+C
+      AGMAXI=SVAL
+      INDZ=1-IIEZ
+C
+      DO 103 I=1,NVIZ
+        IF (ZHGH.EQ.SVAL) THEN
+          DO 101 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL) GO TO 101
+            IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ)
+            AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ))
+  101     CONTINUE
+        ELSE
+          DO 102 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).GT.ZHGH) GO TO 102
+            IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ)
+            AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ))
+  102     CONTINUE
+        END IF
+        INDZ=INDZ-NEVZ*IIEZ+IIVZ
+  103 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agmini.f b/sys/gio/ncarutil/autograph/agmini.f
new file mode 100644
index 00000000..be4b6d2c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agmini.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      FUNCTION AGMINI (SVAL,ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+      DIMENSION ZDRA(1)
+C
+C The routine AGMINI returns the mimimum value of the elements in ZDRA
+C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the
+C special value SVAL (or less than ZLOW, if ZLOW is not equal to SVAL).
+C
+C -- NVIZ is the number of vectors of data stored in ZDRA.
+C
+C -- IIVZ is the index increment from one data vector to the next.
+C
+C -- NEVZ is the number of elements per vector to be examined.
+C
+C -- IIEZ is the index increment from one vector element to the next.
+C    If IIEZ is 0, the array is ignored and 1. is returned.
+C
+      AGMINI=1.
+      IF (IIEZ.EQ.0) RETURN
+C
+      AGMINI=SVAL
+      INDZ=1-IIEZ
+C
+      DO 103 I=1,NVIZ
+        IF (ZLOW.EQ.SVAL) THEN
+          DO 101 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL) GO TO 101
+            IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ)
+            AGMINI=AMIN1(AGMINI,ZDRA(INDZ))
+  101     CONTINUE
+        ELSE
+          DO 102 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).LT.ZLOW) GO TO 102
+            IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ)
+            AGMINI=AMIN1(AGMINI,ZDRA(INDZ))
+  102     CONTINUE
+        END IF
+        INDZ=INDZ-NEVZ*IIEZ+IIVZ
+  103 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agnumb.f b/sys/gio/ncarutil/autograph/agnumb.f
new file mode 100644
index 00000000..24469772
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agnumb.f
@@ -0,0 +1,491 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGNUMB (NBTP,SBSE,EXMU , NLTP,NLEX,NLFL ,
+     +                             BFRM,MCIM,NCIM,IPXM , BFRE,MCIE,NCIE)
+C
+      CHARACTER*(*) BFRM,BFRE
+C
+C The routine AGNUMB converts the number specified by the arguments
+C NBTP, SBSE, and EXMU to the label format specified by the arguments
+C NLTP, NLEX, and NLFL, returning the characters of the mantissa in the
+C buffer BFRM and the characters of the exponent in the buffer BFRE,
+C ready for plotting.  The arguments of AGNUMB are as follows:
+C
+C -- NBTP is an integer specifying the type of number to be converted.
+C    There are three possibilities:
+C
+C        NBTP = 1 - number of the form SBSE * EXMU.
+C
+C        NBTP = 2 - number of the form SBSE * 10**EXMU.
+C
+C        NBTP = 3 - number of the form SIGN(SBSE) * ABSV(SBSE)**EXMU.
+C
+C -- SBSE is a base value for a set of labels.  See NBTP description.
+C
+C -- EXMU is an exponent or a multiplier for a given label.  Although it
+C    is a floating-point number, its value should be integral, unless
+C    NBTP equals 1 and/or NLTP equals 1.  Using a non-integral EXMU in
+C    other cases will have undesirable effects.  See NBTP description.
+C
+C -- NLTP is an integer specifying the type of label to be generated.
+C    There are three possibilities:
+C
+C      -- NLTP = 1 - label is to have an exponent portion and is to be
+C         expressed in scientific notation.
+C
+C      -- NLTP = 2 - label is to have an exponent portion and is to be
+C         expressed in a form determined by the number type NBTP.
+C
+C      -- NLTP = 3 - label is to have no exponent portion and is to be
+C         expressed in a form determined by the number type NBTP.
+C
+C    The possible label types will be described in greater detail below.
+C
+C -- NLEX (when used) is an integer specifying (in a manner depending on
+C    the values of other parameters) the value of the exponent portion
+C    of the label.  See the detailed discussion of label types, below.
+C
+C -- NLFL (when used) is an integer specifying (in a manner depending on
+C    the values of other parameters) the length of the fractional por-
+C    tion of the mantissa of the label.  See the detailed discussion of
+C    label types, below.
+C
+C -- BFRM is a character variable in which the mantissa portion of the
+C    label is to be returned.
+C
+C -- MCIM specifies the maximum number of characters BFRM can hold.
+C
+C -- NCIM is the number of characters returned in BFRM by AGNUMB.
+C
+C -- IPXM is the position of the character X in the mantissa.  If IPXM
+C    is zero, the character X does not occur in the mantissa.
+C
+C -- BFRE, MCIE, and NCIE are analogous to BFRM, MCIM, and NCIM, but
+C    pertain to the exponent portion of the label.
+C
+C Label types:  AGNUMB will produce many different types of labels, as
+C directed by the various input parameters.  Each of these is described
+C below.  The general form of a label is
+C
+C    (-) (1/) (I) (.) (F) (X 10) (E)
+C
+C where the parentheses are used to mark portions which may either be
+C present or absent.  The minus sign is included only if the label value
+C is negative.  I is the integer portion of the mantissa, included only
+C if its value is non-zero.  The decimal point is included if the input
+C parameter NLFL does not specifically direct that it should be omitted
+C or if the fractional portion of the mantissa (F) is present.  F is the
+C fractional portion of the mantissa.  The "X 10" is included if it is
+C appropriate, and is considered to be a part of the mantissa; if it is
+C included, a blank is actually returned for the character X, so the
+C routine which plots the label should construct this character by
+C drawing two short lines.  E is the exponent, returned in a separate
+C buffer so that it may be plotted in a superscript form.  The possible
+C label types are, then, as follows:
+C
+C -- Scientific notation - if the label type NLTP equals 1, the form
+C
+C        (-) (I) (.) (F) X 10 (E)
+C
+C    is used.  NLEX specifies the length of I (thus also specifying the
+C    value of the exponent E).  If NLEX is .LE. 0, I is omitted.  If
+C    NLEX is .LT. 0 and has the absolute value N, the fraction F is
+C    forced to have N leading zeroes.  NLFL specifies the length of F.
+C    If NLFL is .LE. 0, F is omitted.  If NLFL is .LT. 0, the decimal
+C    point is omitted.  If (I.F) has the value 1, (I.F X) is omitted.
+C    If the entire label has zero value, the character 0 is used.
+C
+C -- Exponential, but non-scientific notation - if the label type NLTP
+C    equals 2, the form used depends on the argument NBTP, as follows:
+C
+C     -- If NBTP equals 1 (number of the form SBSE * EXMU), the form
+C
+C            (-) (I) (.) (F) X 10 (E)
+C
+C        is used.  NLEX specifies the value of the exponent E.  The
+C        length of F is specified by NLFL.  If NLFL is .LE. 0, F is
+C        omitted.  If NLFL is .LT. 0, the decimal point is omitted.  If
+C        the label value is exactly 0, the character 0 is used.
+C
+C     -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form
+C
+C            (-) (I) (.) (F) X 10 (E)
+C
+C        is used.  The exponent E has the value NLEX+EXMU.  The length
+C        of F is specified by NLFL.  If NLFL is .LE. 0, F is omitted.
+C        If NLFL is .LT. 0, the decimal point is omitted.  If the label
+C        value is exactly 0, the character 0 is used.  If (I.F) has the
+C        value 1., then (I.F X) is omitted.
+C
+C     -- If NBTP equals 3, specifying that the number is of the form
+C        SIGN(SBSE) * ABSV(SBSE)**EXMU, the form
+C
+C            (-) (I) (.) (F) (E)
+C
+C        is used.  The exponent E has the value EXMU.  The length of F
+C        is specified by NLFL.  If NLFL is .LE. 0, F is omitted.  If
+C        NLFL is .LT. 0, the decimal point is omitted.
+C
+C -- No-exponent notation - if the label type NLTP equals 3, the form
+C    used depends on the argument NBTP, as follows:
+C
+C     -- If NBTP equals 1 (number of the form SBSE * EXMU), the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used.  NLFL specifies the length of F.  If NLFL is .LE. 0,
+C        F is omitted.  If NLFL is .LT. 0, the decimal point is omitted.
+C        If the entire label has zero value, the character 0 is used.
+C
+C     -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used.  The length of F is specified by the function
+C
+C            MAX(NLFL,0)-EXMU  (if EXMU is .LT. MAX(NLFL,0))
+C            MIN(NLFL,0)       (if EXMU is .GE. MAX(NLFL,0))
+C
+C        which may appear somewhat formidable, but produces a simple,
+C        desirable result.  Suppose, for example, that SBSE = 3.6,
+C        NLFL = 1, and EXMU ranges from -3 to +3 - the labels produced
+C        are as follows:
+C
+C            .0036   .036   .36   3.6   36.   360.   3600.
+C
+C        NLFL may be viewed as specifying the length of F if EXMU is 0.
+C        If the value of the function is .LE. 0, F is omitted - if its
+C        value is .LT. 0, the decimal point is omitted.
+C
+C     -- If NBTP equals 3, specifying that the number is of the form
+C        SIGN(SBSE) * ABSV(SBSE)**EXMU, the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used if EXMU is positive (or zero), and the form
+C
+C            (-) 1 / (I) (.) (F)
+C
+C        is used if EXMU is negative.  The length of F is specified by
+C        the function
+C
+C            NLFL * ABSV(EXMU)  (if EXMU is .NE. 0)
+C            MIN(NLFL,0)        (if EXMU is .EQ. 0)
+C
+C        Again, this function produces a simple result.  Suppose that
+C        SBSE = 1.1, NLFL = 1, and EXMU ranges from -3 to +3 - the
+C        labels produced are as follows:
+C
+C            1/1.331   1/1.21   1/1.1   1.   1.1   1.21   1.331
+C
+C        NLFL may be viewed as specifying the length of F if EXMU is 1.
+C        If the value of the function is .LE. 0, F is omitted - if its
+C        value is .LT. 0, the decimal point is omitted.  As another
+C        example, suppose that SBSE = 2., NLFL = -1, and EXMU ranges
+C        from -4 to +4.  The labels produced are as follows:
+C
+C            1/16   1/8   1/4   1/2   1   2   4   8   16
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C KHAR holds single characters to be stored away in BFRM or BFRE.
+C
+      CHARACTER*1 KHAR
+C
+C Zero character counters and pointers.
+C
+      NCIM=0
+      NCIE=0
+      IPXM=0
+C
+C Compute a jump parameter to allow a quick sorting-out of the possible
+C number-type/label-type combinations below.
+C
+      NTLT=NBTP+3*(NLTP-1)
+C
+C Compute the value (XMAN) from which the characters of the mantissa
+C will be generated.
+C
+      GO TO (101,102,103,101,102,104,101,102,105) , NTLT
+C
+  101 XMAN=SBSE*EXMU
+      GO TO 106
+C
+  102 XMAN=SBSE*SNGL(10.D0**DBLE(EXMU))
+      GO TO 106
+C
+  103 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(EXMU))
+      GO TO 106
+C
+  104 XMAN=SBSE
+      GO TO 106
+C
+  105 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(ABS(EXMU)))
+C
+C If the mantissa-generator is negative, make it positive and put a
+C minus sign in the mantissa buffer.
+C
+  106 IF (XMAN.LT.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='-'
+        XMAN=-XMAN
+      END IF
+C
+C If the number is zero, put a zero in the mantissa buffer and quit.
+C
+      IF (XMAN.EQ.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='0'
+        RETURN
+      END IF
+C
+C Reduce the mantissa-generator to the range (1.,10.), keeping track of
+C the power of 10 required to do it.  Round the result, keeping in mind
+C that the rounding may kick the value past 10. .
+C
+      IMAN=IFIX(ALOG10(XMAN))
+      IF (XMAN.LT.1.) IMAN=IMAN-1
+      XMAN=XMAN*SNGL(10.D0**(-IMAN))+SMRL
+      IF (XMAN.GE.10.) THEN
+        XMAN=XMAN/10.
+        IMAN=IMAN+1
+      END IF
+C
+C Jump (depending on the number-type/label-type combination) to set up
+C the label-generation control parameters, as follows:
+C
+C    NDPD - number of digits to precede decimal point - if NDPD .LT. 0,
+C           ABS(NDPD) leading zeroes follow the decimal point, preceding
+C           the first digit generated from XMAN.
+C    NDFD - number of digits to follow decimal point - if NDFD .LT. 0,
+C           the decimal point is suppressed.
+C    IF10 - flag, set non-zero to force generation of the (X 10) portion
+C           of the label.
+C    IFEX - flag, set non-zero to force generation of an exponent.
+C    IVEX - value of exponent (if any) - always equals (IMAN+1) - NDPD.
+C
+      GO TO (107,107,107,108,109,110,111,112,113) , NTLT
+C
+C Scientific notation.
+C
+  107 NDPD=NLEX
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SBSE * EXMU.
+C
+  108 NDPD=IMAN+1-NLEX
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SBSE * 10**EXMU.
+C
+  109 NDPD=IMAN+1-(NLEX+IFIX(EXMU+SMRL*EXMU))
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SIGN(SBSE) * ABSV(SBSE)**EXMU.
+C
+  110 NDPD=IMAN+1
+      IMAN=IMAN+IFIX(EXMU+SMRL*EXMU)
+      NDFD=NLFL
+      IF10=0
+      IFEX=1
+      GO TO 115
+C
+C No-exponent notation for SBSE * EXMU.
+C
+  111 NDPD=IMAN+1
+      NDFD=NLFL
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C No-exponent notation for SBSE * 10**EXMU.
+C
+  112 NDPD=IMAN+1
+      NDFD=MAX0(NLFL,0)-IFIX(EXMU+SMRL*EXMU)
+      IF (NDFD.LE.0) NDFD=MIN0(NLFL,0)
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C No-exponent notation for SIGN(SBSE) * ABSV(SBSE)**EXMU
+C
+  113 IF (EXMU.LT.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='1'
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='/'
+      END IF
+C
+      NDPD=IMAN+1
+      NDFD=NLFL*IFIX(ABS(EXMU+SMRL*EXMU))
+      IF (NDFD.EQ.0) NDFD=MIN0(NLFL,0)
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C If there is an exponent of 10 and the mantissa is precisely 1, omit
+C the (I.F X) portion of the mantissa.
+C
+  114 IF (NDPD.NE.1) GO TO 115
+      IF (IFIX(XMAN).NE.1) GO TO 115
+      IF (((XMAN-1.)*10.**MAX0(0,NDFD)).GE.1.) GO TO 115
+      IVEX=IMAN+1-NDPD
+      GO TO 123
+C
+C Generate the characters of the mantissa (I.F).  Check first for zero-
+C or-negative-length error.
+C
+  115 LMAN=MAX0(NDPD,0)+1+MAX0(NDFD,-1)
+      IF (LMAN.LE.0) GO TO 903
+C
+C Make sure the mantissa buffer is big enough to hold (I.F).
+C
+      IF (NCIM+LMAN.GT.MCIM) GO TO 901
+C
+C Compute the value of the parameter IVEX before changing NDPD.
+C
+      IVEX=IMAN+1-NDPD
+C
+C Generate the digits preceding the decimal point, if any.
+C
+      IF (NDPD.LE.0) GO TO 117
+C
+      ASSIGN 116 TO JUMP
+      GO TO 121
+C
+  116 NDPD=NDPD-1
+      IF (NDPD.NE.0) GO TO 121
+C
+C Generate the decimal point.
+C
+  117 KHAR='.'
+      ASSIGN 118 TO JUMP
+      GO TO 122
+C
+C Generate leading zeroes, if any, after the decimal point.
+C
+  118 IF (NDPD.EQ.0) GO TO 120
+      KHAR='0'
+      ASSIGN 119 TO JUMP
+      GO TO 122
+C
+  119 NDPD=NDPD+1
+      IF (NDPD.NE.0) GO TO 122
+C
+C Generate remaining fractional digits.
+C
+  120 ASSIGN 121 TO JUMP
+C
+C Generate a digit from the mantissa-generator.  It is assumed that, for
+C n between 1 and 9, ICHAR('n') = ICHAR('n-1') + 1 .
+C
+  121 IDGT=IFIX(XMAN)
+      KHAR=CHAR(ICHAR('0')+IDGT)
+      XMAN=XMAN-FLOAT(IDGT)
+      XMAN=XMAN*10.
+C
+C Store a digit from KHAR into the mantissa buffer.
+C
+  122 NCIM=NCIM+1
+      BFRM(NCIM:NCIM)=KHAR
+C
+C Check whether (I.F) is complete.
+C
+      LMAN=LMAN-1
+      IF (LMAN.NE.0) GO TO JUMP , (116,118,119,121)
+C
+C If appropriate, leave space in the mantissa buffer for the "X" .
+C
+      IF (IF10.EQ.0) GO TO 124
+      NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      IPXM=NCIM
+      BFRM(IPXM:IPXM)=' '
+C
+C If appropriate, put a "10" in the mantissa buffer.
+C
+  123 NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      BFRM(NCIM:NCIM)='1'
+      NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      BFRM(NCIM:NCIM)='0'
+C
+C If appropriate, generate an exponent in the exponent buffer.
+C
+  124 IF (IFEX.EQ.0) RETURN
+C
+      IF (IVEX) 126,125,127
+C
+  125 NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+      BFRE(NCIE:NCIE)='0'
+      RETURN
+C
+  126 NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+      BFRE(NCIE:NCIE)='-'
+      IVEX=-IVEX
+C
+  127 NCIE=NCIE+1
+      IF (IVEX.GE.10) NCIE=NCIE+1
+      IF (IVEX.GE.100) NCIE=NCIE+1
+      IF (IVEX.GE.1000) NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+C
+      DO 128 I=1,4
+        J=NCIE+1-I
+        BFRE(J:J)=CHAR(ICHAR('0')+MOD(IVEX,10))
+        IVEX=IVEX/10
+        IF (IVEX.EQ.0) RETURN
+  128 CONTINUE
+C
+      IF (IVEX.NE.0) GO TO 902
+C
+C Done.
+C
+      RETURN
+C
+C Error exits.
+C
+  901 CALL SETER ('AGNUMB - MANTISSA TOO LONG',4,2)
+C
+  902 CALL SETER ('AGNUMB - EXPONENT TOO LARGE',5,2)
+C
+  903 CALL SETER ('AGNUMB - ZERO-LENGTH MANTISSA',6,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agppid.f b/sys/gio/ncarutil/autograph/agppid.f
new file mode 100644
index 00000000..145d98d3
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agppid.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGPPID (TPID)
+C
+      CHARACTER*(*) TPID
+C
+C The object of this routine is to print out a parameter identifier
+C which has caused some kind of problem.
+C
+C Define a character variable to hold the print line.
+C
+      CHARACTER*124 TEMP
+C
+C +NOAO
+      integer*2 itemp(124)
+C -NOAO
+C
+C Set up the print line.
+C
+      TEMP='0PARAMETER IDENTIFIER - '
+C
+C Transfer characters of the parameter identifier, one at a time, until
+C 100 have been transferred or a period is encountered, whichever occurs
+C first.  This is done so as to allow for old programs on the Cray which
+C used Hollerith strings as parameter identifiers.
+C
+      I=24
+C
+      DO 101 J=1,100
+        I=I+1
+        TEMP(I:I)=TPID(J:J)
+        IF (TEMP(I:I).EQ.'.') GO TO 102
+  101 CONTINUE
+C
+C Print the line.
+C
+C +NOAO - replace FTN write and format statement.
+C 102 WRITE (I1MACH(4),1001) TEMP
+  102 CONTINUE
+      call f77upk (temp, itemp, 125)
+      call pstr (itemp)
+C
+C Done.
+C
+      RETURN
+C
+C Format.
+C
+C1001 FORMAT (A124)
+C -NOAO
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agpwrt.f b/sys/gio/ncarutil/autograph/agpwrt.f
new file mode 100644
index 00000000..25cc2e52
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agpwrt.f
@@ -0,0 +1,31 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGPWRT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN)
+C
+      CHARACTER*(*) CHRS
+C
+C This routine just passes its arguments along to the character-drawing
+C routine PWRIT, in the system plot package.  By substituting his/her
+C own version of AGPWRT, the user can cause a fancier character-drawer
+C to be used.
+C
+      CALL PWRIT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agqurv.f b/sys/gio/ncarutil/autograph/agqurv.f
new file mode 100644
index 00000000..dc70fc43
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agqurv.f
@@ -0,0 +1,322 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGQURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C The curve drawn is windowed.  Portions of the curve which would fall
+C outside the current curve window, as defined by the last SET call,
+C are not drawn.
+C
+C Check first whether the number of curve points is properly specified.
+C
+      IF (NEXY.LE.0) GO TO 901
+C
+C Initialization.  Pretend that the last point was point number zero.
+C Set the indices for the x and y vectors accordingly.  Clear the line-
+C drawn-to-last-point and last-point-outside-window flags.
+C
+      INDP=0
+      INDX=1-IIEX
+      INDY=1-IIEY
+      LDLP=0
+      LPOW=0
+C
+C Initialization.  Retrieve the current curve window, user window, and
+C x/y linear/logarithmic flags.
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C x-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN
+        LLUX=0
+        XLLW=XLUW
+        XRLW=XRUW
+      ELSE
+        LLUX=1
+        XLLW=ALOG10(XLUW)
+        XRLW=ALOG10(XRUW)
+      END IF
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C y-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN
+        LLUY=0
+        YBLW=YBUW
+        YTLW=YTUW
+      ELSE
+        LLUY=1
+        YBLW=ALOG10(YBUW)
+        YTLW=ALOG10(YTUW)
+      END IF
+C
+C Initialization.  Call SET, if necessary, to define a linear mapping.
+C (This greatly simplifies the windowing code.)
+C
+      IF (LTYP.NE.1)
+     +              CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1)
+C
+C Initialization.  Compute mimimum and maximum values of x which are
+C slightly outside the linear window.  (Note:  XLLW and XRLW will not
+C be used after this.)
+C
+      IF (XLLW.GT.XRLW) THEN
+        TEMP=XLLW
+        XLLW=XRLW
+        XRLW=TEMP
+      END IF
+      XEPS=.000001*(XRLW-XLLW)
+      XMIN=XLLW-XEPS
+      XMAX=XRLW+XEPS
+C
+C Initialization.  Compute minimum and maximum values of y which are
+C slightly outside the linear window.  (Note:  YBLW and YTLW will not
+C be used after this.)
+C
+      IF (YBLW.GT.YTLW) THEN
+        TEMP=YBLW
+        YBLW=YTLW
+        YTLW=TEMP
+      END IF
+      YEPS=.000001*(YTLW-YBLW)
+      YMIN=YBLW-YEPS
+      YMAX=YTLW+YEPS
+C
+C Beginning of loop through points.  Update indices and determine the
+C user-space coordinates of the next point.
+C
+  101 IF (INDP.EQ.NEXY) GO TO 120
+      INDP=INDP+1
+C
+      INDX=INDX+IIEX
+      XNXT=XVEC(INDX)
+      IF (IIEX.EQ.0) XNXT=FLOAT(INDP)
+      IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL
+C
+      INDY=INDY+IIEY
+      YNXT=YVEC(INDY)
+      IF (IIEY.EQ.0) YNXT=FLOAT(INDP)
+      IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL
+C
+C Check whether (XNXT,YNXT) is a special-value point.  Handle that case.
+C
+      IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN
+        LPOW=0
+        IF (LDLP.EQ.0) GO TO 101
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+        LDLP=0
+        GO TO 101
+      END IF
+C
+C If user space is not linear/linear, modify XNXT and YNXT accordingly.
+C
+      IF (LLUX.NE.0) XNXT=ALOG10(XNXT)
+      IF (LLUY.NE.0) YNXT=ALOG10(YNXT)
+C
+C Set the next-point-outside-window flag to a value between -4 and +4,
+C inclusive.  A non-zero value indicates that the next point is outside
+C the window and indicates which of eight possible areas it falls in.
+C
+      NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+
+     +             (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX)))
+C
+C There are now various possible cases, depending on whether the line-
+C drawn-to-last-point flag is set or not, whether the next point is in
+C the window or not, and whether the last point was in the window, not
+C in the window, or non-existent (point 0 or a special-value point).
+C
+      IF (LDLP.EQ.0) GO TO 102
+      IF (NPOW.NE.0) GO TO 103
+C
+C Line drawn to last point, next point inside, last point inside.
+C
+      CALL VECTD (XNXT,YNXT)
+      LDLP=LDLP+1
+      GO TO 119
+C
+  102 IF (NPOW.NE.0) GO TO 109
+      IF (LPOW.NE.0) GO TO 105
+C
+C No line drawn to last point, next point inside, no last point.
+C
+      CALL FRSTD (XNXT,YNXT)
+      LDLP=1
+      GO TO 119
+C
+C Line drawn to last point, next point outside, last point inside.
+C
+  103 XPIW=XLST
+      YPIW=YLST
+      XPOW=XNXT
+      YPOW=YNXT
+      ASSIGN 104 TO JUMP
+      GO TO 107
+  104 CALL VECTD (XPEW,YPEW)
+      CALL LASTD
+      LDLP=0
+      GO TO 119
+C
+C No line drawn to last point, next point inside, last point outside.
+C
+  105 XPIW=XNXT
+      YPIW=YNXT
+      XPOW=XLST
+      YPOW=YLST
+      ASSIGN 106 TO JUMP
+      GO TO 107
+  106 CALL FRSTD (XPEW,YPEW)
+      CALL VECTD (XNXT,YNXT)
+      LDLP=2
+      GO TO 119
+C
+C The following local procedure, given a point (XPIW,YPIW) inside the
+C window and a point (XPOW,YPOW) outside the window, finds the point of
+C intersection (XPEW,YPEW) of a line joining them with the window edge.
+C
+  107 XPEW=XPIW
+      YPEW=YPIW
+      XDIF=XPOW-XPIW
+      YDIF=YPOW-YPIW
+C
+      IF (ABS(XDIF).GT.XEPS) THEN
+        XPEW=XMIN
+        IF (XDIF.GE.0.) XPEW=XMAX
+        YPEW=YPIW+(XPEW-XPIW)*YDIF/XDIF
+        IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 108
+      END IF
+C
+      IF (ABS(YDIF).GT.YEPS) THEN
+        YPEW=YMIN
+        IF (YDIF.GE.0.) YPEW=YMAX
+        XPEW=XPIW+(YPEW-YPIW)*XDIF/YDIF
+      END IF
+C
+  108 GO TO JUMP , (104,106)
+C
+C No line drawn to last point, next point outside.  Jump if no last
+C point.
+C
+  109 IF (LPOW.EQ.0) GO TO 119
+C
+C No line drawn to last point, next point outside, last point outside.
+C Check whether a portion of the line joining them lies in the window.
+C
+      MPOW=9*LPOW+NPOW+41
+C
+      GO TO (119,119,119,119,119,110,119,110,110,
+     +       119,119,119,111,119,110,111,110,110,
+     +       119,119,119,111,119,119,111,111,119,
+     +       119,113,113,119,119,110,119,110,110,
+     +       119,119,119,119,119,119,119,119,119,
+     +       112,112,119,112,119,119,111,111,119,
+     +       119,113,113,119,119,113,119,119,119,
+     +       112,112,113,112,119,113,119,119,119,
+     +       112,112,119,112,119,119,119,119,119) , MPOW
+C
+  110 XPE1=XMIN
+      YPT1=YMIN
+      XPE2=XMAX
+      YPT2=YMAX
+      GO TO 114
+C
+  111 XPE1=XMIN
+      YPT1=YMAX
+      XPE2=XMAX
+      YPT2=YMIN
+      GO TO 114
+C
+  112 XPE1=XMAX
+      YPT1=YMAX
+      XPE2=XMIN
+      YPT2=YMIN
+      GO TO 114
+C
+  113 XPE1=XMAX
+      YPT1=YMIN
+      XPE2=XMIN
+      YPT2=YMAX
+C
+  114 XDIF=XNXT-XLST
+      YDIF=YNXT-YLST
+C
+      IF (ABS(XDIF).LE.XEPS) GO TO 116
+      YPE1=YLST+(XPE1-XLST)*YDIF/XDIF
+      YPE2=YLST+(XPE2-XLST)*YDIF/XDIF
+C
+      IF (ABS(YDIF).LE.YEPS) GO TO 118
+      IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 115
+      YPE1=YPT1
+      XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
+      IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119
+C
+  115 IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 118
+      GO TO 117
+C
+  116 YPE1=YPT1
+      XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
+      IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119
+C
+  117 YPE2=YPT2
+      XPE2=XLST+(YPE2-YLST)*XDIF/YDIF
+      IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 119
+C
+  118 CALL FRSTD (XPE1,YPE1)
+      CALL VECTD (XPE2,YPE2)
+      CALL LASTD
+C
+C Processing of next point is done.  It becomes the last point and we
+C go back for a new next point.
+C
+  119 LPOW=NPOW
+      XLST=XNXT
+      YLST=YNXT
+      GO TO 101
+C
+C Last point was final point.  Finish up.
+C
+  120 IF (LDLP.NE.0) THEN
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+      END IF
+C
+C Restore logarithmic mapping, if appropriate.
+C
+      IF (LTYP.NE.1)
+     +           CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Return to caller.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL SETER ('AGQURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE
+     +RO',7,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agrpch.f b/sys/gio/ncarutil/autograph/agrpch.f
new file mode 100644
index 00000000..c37a7ae4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agrpch.f
@@ -0,0 +1,86 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGRPCH (CHST,LNCS,IDCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine is used to replace a character string previously stored
+C by the routine AGSTCH (which see).  This could be done by an AGDLCH
+C followed by an AGSTCH, and, in fact, under certain conditions, does
+C exactly that.  Only when it is easy to do so does AGRPCH operate more
+C efficiently.  Nevertheless, a user who (for example) repeatedly and
+C perhaps redundantly defines x-axis labels of the same length may
+C greatly benefit thereby; repeated deletes and stores would lead to
+C frequent garbage collection by AGSTCH.
+C
+C AGRPCH has the following arguments:
+C
+C -- CHST is the new character string, to replace what was originally
+C    stored.
+C
+C -- LNCS is the length of the character string in CHST.
+C
+C -- IDCS is the identifier returned by AGSTCH when the original string
+C    was stored.  The value of IDCS may be changed by the call.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If the identifier is positive or is negative but less than -LNIC, the
+C original string was never stored in CHRA; just treat the replacement
+C as a store and return a new value of IDCS.
+C
+      IF (IDCS.GT.(-1).OR.IDCS.LT.(-LNIC)) THEN
+        CALL AGSTCH (CHST,LNCS,IDCS)
+C
+      ELSE
+C
+C The absolute value of the identifier is the index, in INCH, of the
+C descriptor of the character string stored in CHRA.  If the new string
+C is shorter than the old one, store it and zero remaining character
+C positions.  Otherwise, treat the replacement as a delete followed by
+C a store.
+C
+        I=-IDCS
+        IF (LNCS.LE.INCH(2,I)) THEN
+          J=INCH(1,I)-1
+          DO 101 K=1,LNCS
+            J=J+1
+            CHRA(J)=CHST(K:K)
+  101     CONTINUE
+          DO 102 K=LNCS+1,INCH(2,I)
+            J=J+1
+            CHRA(J)=CHAR(0)
+  102     CONTINUE
+          INCH(2,I)=LNCS
+        ELSE
+          CALL AGDLCH (IDCS)
+          CALL AGSTCH (CHST,LNCS,IDCS)
+        END IF
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agrstr.f b/sys/gio/ncarutil/autograph/agrstr.f
new file mode 100644
index 00000000..72afc643
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agrstr.f
@@ -0,0 +1,88 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C +NOAO - this subroutine is a no-op in IRAF.
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGRSTR (IFNO)
+C
+C This subroutine is called to restore the current state of AUTOGRAPH by
+C reading all of its important variables from a record on the file which
+C is associated with the unit number IFNO.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C Read the record.
+C
+C     READ (IFNO,ERR=901,END=902)
+C    1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM,
+C    2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP,
+C    3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD,
+C    4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX,
+C    5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR,
+C    6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF,
+C    7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA,
+C    8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW,
+C    9 YTUW,
+C    + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL,
+C    1 INCA,INCH,LNCA,LNIC,
+C    2 CHRA
+C
+C Done.
+C
+      RETURN
+C
+C Error exits.
+C
+C 901 CALL SETER ('AGRSTR - ERROR ON READ',8,2)
+C
+C 902 CALL SETER ('AGRSTR - END-OF-FILE ON READ',9,2)
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agsave.f b/sys/gio/ncarutil/autograph/agsave.f
new file mode 100644
index 00000000..ef0feb7d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsave.f
@@ -0,0 +1,93 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C +NOAO - This routine is a no-op in IRAF.
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSAVE (IFNO)
+C
+C This subroutine is called to save the current state of AUTOGRAPH by
+C writing all of its important variables as a record on the file which
+C is associated with the unit number IFNO.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C Write the record.  Variables from each COMMON block are together, in
+C alphabetical order.
+C
+C     WRITE (IFNO,ERR=901)
+C    1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM,
+C    2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP,
+C    3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD,
+C    4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX,
+C    5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR,
+C    6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF,
+C    7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA,
+C    8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW,
+C    9 YTUW,
+C    + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL,
+C    1 INCA,INCH,LNCA,LNIC,
+C    2 CHRA
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+C 901 CALL SETER ('AGSAVE - ERROR ON WRITE',10,2)
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agscan.f b/sys/gio/ncarutil/autograph/agscan.f
new file mode 100644
index 00000000..222db6c4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agscan.f
@@ -0,0 +1,628 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+      CHARACTER*(*) TPID
+C
+C The routine AGSCAN is used by AGGETP and AGSETP to scan a parameter
+C identifier and return a description of the parameter-list items which
+C are specified by that parameter identifier.  It has the following
+C arguments:
+C
+C -- TPID is the parameter identifier.
+C
+C -- LOPA is the index of the first parameter-list item specified.
+C
+C -- NIPA is the number of parameter-list items specified.
+C
+C -- IIPA is the index increment between one of the parameter-list items
+C    specified and the next (meaningless if NIPA=1).
+C
+C
+C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE
+C
+C Originally, this routine used the function "LOC" to return, in LOPA,
+C the base address, in core, of the specified parameter group.  To some
+C degree, it was thereby insulated from changes in the labelled common
+C block AGCONP.  With the demise of "LOC", LOPA has been re-defined and
+C that insulation no longer exists.  In the following code, there are
+C integers which represent the indices of desired quantities in common.
+C
+C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE
+C
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C Declare the block data routine EXTERNAL to force loading of it.
+C
+C +NOAO - call agdflt as run time initialization
+C
+C     EXTERNAL AGDFLT
+      call agdflt
+C -NOAO
+C
+C Initialize the parameter-identifier character index.
+C
+      IPID=0
+C
+C Initialize the value of the index increment to be returned.
+C
+      IIPA=1
+C
+C Find the first keyword in the parameter identifier.
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'PRIMFRAMSET ROW INVEWINDNULLGRAPGRIDX
+     +   Y   AXISLEFTRIGHBOTTTOP DASHLABELINESECOBACK')
+C
+      GO TO (101,102,103,104,105,106,107,108,109,110,
+     +       111,113,114,114,114,114,132,133,147,155,166,901) , IKWL
+C
+C PRIMARY CONTROL PARAMETERS.
+C
+  101 LOPA=1
+      NIPA=336
+      GO TO 203
+C
+C FRAME PARAMETER.
+C
+  102 LOPA=1
+      GO TO 202
+C
+C SET PARAMETER.
+C
+  103 LOPA=2
+      GO TO 202
+C
+C ROW PARAMETER.
+C
+  104 LOPA=3
+      GO TO 202
+C
+C X/Y INVERSION PARAMETER.
+C
+  105 LOPA=4
+      GO TO 202
+C
+C WINDOWING PARAMETER.
+C
+  106 LOPA=5
+      GO TO 202
+C
+C BACKGROUND PARAMETER.
+C
+  166 LOPA=6
+      GO TO 202
+C
+C NULL PARAMETER(S).
+C
+  107 LOPA=7
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'1   2   ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C PLOT (GRAPH) WINDOW PARAMETERS.
+C
+  108 LOPA=9
+      NIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+      GO TO 201
+C
+C GRID WINDOW PARAMETERS.
+C
+  109 LOPA=13
+      NIPA=5
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP SHAP')
+C
+      IF (IKWL.EQ.6) GO TO 901
+      GO TO 201
+C
+C X DATA PARAMETERS.
+C
+  110 LOPA=18
+      GO TO 112
+C
+C Y DATA PARAMETERS.
+C
+  111 LOPA=25
+C
+C X OR Y DATA PARAMETERS.
+C
+  112 NIPA=7
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MINIMAXILOGAORDENICESMALLARG')
+C
+      IF (IKWL.EQ.8) GO TO 901
+      GO TO 201
+C
+C AXIS PARAMETERS.
+C
+  113 LOPA=32
+      NIPA=92
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+      IKWL=IKWL+12
+C
+C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS.
+C
+  114 LOPA=19+IKWL
+      NIPA=23
+      IIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +       'CONTLINEINTEFUNCTICKMAJOMINONUMETYPEEXPOFRACANGLOFFSWIDT')
+C
+      GO TO (202,201,115,167,116,117,123,126,127,127,127,
+     +       127,127,127,901) , IKWL
+C
+C AXIS INTERSECTION PARAMETERS.
+C
+  115 LOPA=LOPA+8
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'GRIDUSER')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C AXIS MAPPING FUNCTION.
+C
+  167 LOPA=LOPA+16
+      GO TO 202
+C
+C AXIS TICK PARAMETERS.
+C
+  116 LOPA=LOPA+20
+      NIPA=10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MAJOMINO')
+C
+      LOPA=LOPA-20
+      GO TO (117,123,901) , IKWL
+C
+C AXIS MAJOR-TICK PARAMETERS.
+C
+  117 LOPA=LOPA+20
+      NIPA=6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SPACTYPEBASECOUNPATTLENGOUTWINWA')
+C
+      GO TO (118,119,119,119,120,121,122,122,901) , IKWL
+C
+C AXIS MAJOR-TICK SPACING PARAMETERS.
+C
+  118 NIPA=3
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'TYPEBASECOUN')
+C
+      IF (IKWL.EQ.4) GO TO 901
+C
+      GO TO 201
+C
+  119 IKWL=IKWL-1
+      GO TO 201
+C
+C AXIS MAJOR-TICK DASH PATTERN.
+C
+  120 LOPA=LOPA+12
+      GO TO 202
+C
+C AXIS MAJOR-TICK LENGTH PARAMETERS.
+C
+  121 LOPA=LOPA+16
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+  122 LOPA=LOPA+16
+      IKWL=IKWL-6
+      GO TO 201
+C
+C AXIS MINOR-TICK PARAMETERS.
+C
+  123 LOPA=LOPA+44
+      NIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SPACPATTLENGOUTWINWA')
+C
+      GO TO (202,201,124,125,125,901) , IKWL
+C
+C AXIS MINOR-TICK LENGTH PARAMETERS.
+C
+  124 LOPA=LOPA+8
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+  125 LOPA=LOPA+8
+      IKWL=IKWL-3
+      GO TO 201
+C
+C AXIS NUMERIC-LABEL PARAMETERS.
+C
+  126 LOPA=LOPA+60
+      NIPA=8
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'TYPEEXPOFRACANGLOFFSWIDT')
+C
+      GO TO 128
+C
+  127 LOPA=LOPA+60
+      IKWL=IKWL-8
+C
+  128 GO TO (202,201,201,129,130,131,901) ,IKWL
+C
+C AXIS NUMERIC-LABEL ORIENTATION ANGLE.
+C
+  129 LOPA=LOPA+12
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'1ST 2ND ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C AXIS NUMERIC-LABEL OFFSET.
+C
+  130 LOPA=LOPA+20
+      GO TO 202
+C
+C AXIS NUMERIC-LABEL WIDTH PARAMETERS.
+C
+  131 LOPA=LOPA+24
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MANTEXPO')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C DASH-PATTERN PARAMETERS.
+C
+  132 LOPA=124
+      NIPA=30
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+      JPID=IPID
+      CALL AGSRCH (TPID,IPID,IKWL,'SELELENGCHARDOLLPATT')
+      IF (IKWL.EQ.6) THEN
+        IPID=JPID
+        GO TO 168
+      END IF
+      IF (IKWL.NE.5) GO TO 201
+  168 LOPA=LOPA+4
+      NIPA=26
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +'1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  1
+     +7  18  19  20  21  22  23  24  25  26  ')
+      IF (IKWL.EQ.27) GO TO 901
+      GO TO 201
+C
+C LABEL PARAMETERS.
+C
+  133 LBIM=IFIX(QBIM)
+      LBAN=IFIX(QBAN)
+C
+      LOPA=154
+      NIPA=3+LBIM*10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                   'CONTBUFFNAMEDEFISUPPBASEOFFSANGLCENTLINEINDE')
+C
+      GO TO (202,136,139,140,141,141,141,141,141,141,141,901) , IKWL
+C
+C LABEL BUFFER PARAMETERS.
+C
+  136 LOPA=155
+      NIPA=1+LBIM*10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LENGCONTNAME')
+C
+      GO TO (202,137,138,901) , IKWL
+C
+C LABEL BUFFER CONTENTS.
+C
+  137 LOPA=156
+      NIPA=LBIM*10
+      GO TO 203
+C
+C LABEL BUFFER NAMES.
+C
+  138 LOPA=156
+      NIPA=LBIM
+      IIPA=10
+      GO TO 203
+C
+C LABEL NAME.
+C
+  139 LOPA=236
+      GO TO 202
+C
+C LABEL DEFINITION.
+C
+  140 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902
+C
+      LOPA=157+(LBAN-1)*10
+      NIPA=9
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SUPPBASEOFFSANGLCENTLINEINDE')
+C
+      GO TO 142
+C
+  141 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902
+C
+      LOPA=157+(LBAN-1)*10
+      IKWL=IKWL-4
+C
+  142 GO TO (202,143,144,146,146,146,146,901) , IKWL
+C
+C LABEL POSITION.
+C
+  143 LOPA=LOPA+1
+      GO TO 145
+C
+C LABEL OFFSET.
+C
+  144 LOPA=LOPA+3
+C
+C LABEL POSITION OR OFFSET.
+C
+  145 NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'X   Y   ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C OTHER LABEL ATTRIBUTES.
+C
+  146 LOPA=LOPA+5
+      IKWL=IKWL-3
+      GO TO 201
+C
+C LINE PARAMETERS.
+C
+  147 LNIM=IFIX(QNIM)
+      LNAN=IFIX(QNAN)
+C
+      LOPA=237
+      NIPA=4+LNIM*6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                       'MAXIEND BUFFNUMBDEFISUPPCHARTEXTLENGINDE')
+C
+      GO TO (202,201,150,152,153,154,154,154,154,154,901) , IKWL
+C
+C LINE BUFFER PARAMETERS.
+C
+  150 LOPA=239
+      NIPA=1+LNIM*6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LENGCONT')
+C
+      GO TO (202,151,901) , IKWL
+C
+C LINE BUFFER CONTENTS.
+C
+  151 LOPA=240
+      NIPA=LNIM*6
+      GO TO 203
+C
+C LINE NUMBER.
+C
+  152 LOPA=336
+      GO TO 202
+C
+C LINE DEFINITION.
+C
+  153 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903
+C
+      LOPA=241+(LNAN-1)*6
+      NIPA=5
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SUPPCHARTEXTLENGINDE')
+C
+      IF (IKWL.EQ.6) GO TO 901
+      GO TO 201
+C
+  154 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903
+      LOPA=241+(LNAN-1)*6
+      IKWL=IKWL-5
+      GO TO 201
+C
+C SECONDARY CONTROL PARAMETERS.
+C
+  155 LOPA=337
+      NIPA=149
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                       'GRAPUSERCURVDIMEAXISLEFTRIGHBOTTTOP LABE')
+C
+      GO TO (156,157,158,159,160,161,161,161,161,165,901) , IKWL
+C
+C PLOT (GRAPH) WINDOW EDGES.
+C
+  156 LOPA=337
+      NIPA=4
+      GO TO 203
+C
+C USER WINDOW PARAMETERS.
+C
+  157 LOPA=341
+      NIPA=4
+      GO TO 203
+C
+C CURVE WINDOW PARAMETERS.
+C
+  158 LOPA=345
+      NIPA=4
+      GO TO 203
+C
+C CURVE WINDOW DIMENSIONS.
+C
+  159 LOPA=349
+      NIPA=3
+      GO TO 203
+C
+C AXIS PARAMETERS.
+C
+  160 LOPA=352
+      NIPA=80
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+C
+      IKWL=IKWL+5
+C
+C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS.
+C
+  161 LOPA=346+IKWL
+      NIPA=20
+      IIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'POSITICKNUME')
+C
+      GO TO (162,163,164,901) , IKWL
+C
+C AXIS POSITIONING PARAMETERS.
+C
+  162 NIPA=6
+      GO TO 203
+C
+C AXIS TICK PARAMETERS.
+C
+  163 LOPA=LOPA+24
+      NIPA=3
+      GO TO 203
+C
+C AXIS NUMERIC-LABEL PARAMETERS.
+C
+  164 LOPA=LOPA+36
+      NIPA=11
+      GO TO 203
+C
+C LABEL BOXES.
+C
+  165 LOPA=432
+      NIPA=54
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP CENTGRAP')
+C
+      IF (IKWL.EQ.7) GO TO 901
+C
+      LOPA=LOPA+IKWL-1
+      NIPA=9
+      IIPA=6
+      GO TO 203
+C
+C Normal exits.
+C
+  201 LOPA=LOPA+(IKWL-1)*IIPA
+C
+  202 NIPA=1
+C
+  203 IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGPPID (TPID)
+C +NOAO - following FTN write and fmt statements commented out, SETER is okay.
+C
+C     WRITE (I1MACH(4),1001)
+      RETURN
+C
+C Error exits.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ILLEGAL KEYWORD USED IN PARAMETER
+     +IDENTIFIER',11,2)
+C
+  902 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LABEL ATTRIBUTES
+     + BEFORE SETTING LABEL NAME',12,2)
+C
+  903 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LINE ATTRIBUTES
+     +BEFORE SETTING LINE NUMBER',13,2)
+C
+C Formats.
+C
+C1001 FORMAT (' WARNING - ABOVE PARAMETER IDENTIFIER HAS TOO MANY KEYWOR
+C    +DS')
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetc.f b/sys/gio/ncarutil/autograph/agsetc.f
new file mode 100644
index 00000000..bced8458
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetc.f
@@ -0,0 +1,100 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETC (TPID,CUSR)
+C
+      CHARACTER*(*) TPID,CUSR
+C
+      DIMENSION FURA(1)
+C
+C The routine AGSETC is used to set the values of individual AUTOGRAPH
+C parameters which intrinsically represent character strings.  TPID is a
+C parameter identifier.  CUSR is a character string.  The situation is
+C complicated by the fact that the character string may be either a dash
+C pattern, the name of a label, the line-end character, or the text of a
+C line, all of which are treated differently.
+C
+C Define a local variable to hold the "line-end" character.
+C
+      CHARACTER*1 LEND
+C
+C See what kind of parameter is being set.
+C
+      CALL AGCTCS (TPID,ITCS)
+C
+C If the parameter is not intrinsically of type character, log an error.
+C
+      IF (ITCS.EQ.0) GO TO 901
+C
+C Find the length of the string, which may or may not actually be used.
+C (On the Cray, at least, it may be zero if the wrong type of argument
+C was used.)
+C
+      ILEN=LEN(CUSR)
+C
+C Retrieve the current (integer) value of the parameter.
+C
+      CALL AGGETI (TPID,ITMP)
+C
+C Check for a dash pattern.
+C
+      IF (ITCS.EQ.1) THEN
+        CALL AGGETI ('DASH/LENG.',NCHR)
+        IF (ILEN.GT.0.AND.ILEN.LT.NCHR) NCHR=ILEN
+        CALL AGRPCH (CUSR,NCHR,ITMP)
+C
+C Check for a label name.
+C
+      ELSE IF (ITCS.EQ.2) THEN
+        CALL AGRPCH (CUSR,MAX0(1,ILEN),ITMP)
+C
+C Check for the line-end character.
+C
+      ELSE IF (ITCS.EQ.3) THEN
+        CALL AGRPCH (CUSR,1,ITMP)
+C
+C Check for the text of a label.
+C
+      ELSE IF (ITCS.EQ.4) THEN
+        CALL AGGETI ('LINE/MAXI.',NCHR)
+        IF (ILEN.GT.0) NCHR=MIN0(NCHR,ILEN)
+        CALL AGGETC ('LINE/END .',LEND)
+        DO 101 I=1,NCHR
+          IF (CUSR(I:I).EQ.LEND) THEN
+            NCHR=I-1
+            GO TO 102
+          END IF
+  101   CONTINUE
+C
+  102   CALL AGRPCH (CUSR,NCHR,ITMP)
+C
+      END IF
+C
+C Transfer the generated value to the list of AUTOGRAPH parameters.
+C
+      FURA(1)=FLOAT(ITMP)
+      CALL AGSETP (TPID,FURA,1)
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGSETC - PARAMETER TO SET IS NOT INTRINSICALLY OF TYP
+     +E CHARACTER',14,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetf.f b/sys/gio/ncarutil/autograph/agsetf.f
new file mode 100644
index 00000000..36fca46e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetf.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETF (TPID,FUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGSETF may be used to set the real (floating-point) value
+C of any single AUTOGRAPH control parameter.
+C
+      FURA(1)=FUSR
+      CALL AGSETP (TPID,FURA,1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agseti.f b/sys/gio/ncarutil/autograph/agseti.f
new file mode 100644
index 00000000..06e3b3f1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agseti.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETI (TPID,IUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGSETI may be used to set the integer-equivalent value of
+C any single AUTOGRAPH control parameter.
+C
+      FURA(1)=FLOAT(IUSR)
+      CALL AGSETP (TPID,FURA,1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetp.f b/sys/gio/ncarutil/autograph/agsetp.f
new file mode 100644
index 00000000..95e98a6d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetp.f
@@ -0,0 +1,447 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETP (TPID,FURA,LURA)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(LURA)
+C
+C The routine AGSETP stores user-provided values of the AUTOGRAPH
+C parameters specified by the parameter identifier TPID.  The arguments
+C are as follows:
+C
+C -- TPID is the parameter identifier, a string of keywords separated
+C    from each other by slashes and followed by a period.
+C
+C -- FURA is the user array from which parameter values are to be taken.
+C
+C -- LURA is the length of the user array.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C Define the array DUMI, which allows access to the control-parameter
+C list as an array.
+C
+      DIMENSION DUMI(1)
+      EQUIVALENCE (QFRA,DUMI)
+C
+C +NOAO - Make sure common has been initialized. 
+C
+      call agdflt
+C
+C -NOAO
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C The routine AGSCAN is called to scan the parameter identifier and to
+C return three quantities describing the AUTOGRAPH parameters affected.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C Determine the number of values to transfer.
+C
+      NURA=MAX0(1,MIN0(LURA,NIPA))
+C
+C If character-string dash patterns are being replaced by integer dash
+C patterns, reclaim the space used in the character-storage arrays.
+C
+      CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP)
+      IF (LOPA.LE.LODP+NIDP-1.AND.LOPA+NURA-1.GE.LODP) THEN
+        MINI=MAX0(LOPA,LODP)-LOPA+1
+        MAXI=MIN0(LOPA+NURA-1,LODP+NIDP-1)-LOPA+1
+        DO 100 I=MINI,MAXI
+          IF (FURA(I).GT.0.) CALL AGDLCH (IFIX(DUMI(LOPA+I-1)))
+  100   CONTINUE
+      END IF
+C
+C Save the current values of special values 1 and 2.
+C
+      SVL1=SVAL(1)
+      SVL2=SVAL(2)
+C
+C Transfer the user-provided values to the parameter list.
+C
+      IDMI=LOPA-IIPA
+C
+      DO 101 IURA=1,NURA
+        IDMI=IDMI+IIPA
+        DUMI(IDMI)=FURA(IURA)
+  101 CONTINUE
+C
+C If a specific item was changed, we may have a bit more work to do;
+C otherwise, return to the user.
+C
+      IF (NIPA.NE.1) RETURN
+C
+C If the specific item was special value 1 or 2, scan the primary list
+C of parameters for other occurrences of the special value and change
+C them to the new value.
+C
+      IF (SVAL(1).NE.SVL1) THEN
+        SVLO=SVL1
+        SVLN=SVAL(1)
+        GO TO 102
+      END IF
+C
+      IF (SVAL(2).NE.SVL2) THEN
+        SVLO=SVL2
+        SVLN=SVAL(2)
+        GO TO 102
+      END IF
+C
+      GO TO 104
+C
+  102 CALL AGSCAN ('PRIM.',LOPR,NIPR,IIPR)
+C
+      IDMI=LOPR-IIPR
+C
+      DO 103 I=1,NIPR
+        IDMI=IDMI+IIPR
+        IF (DUMI(IDMI).EQ.SVLO) DUMI(IDMI)=SVLN
+  103 CONTINUE
+C
+      RETURN
+C
+C If the specific item was the label control flag and it was set
+C negative, delete all labels and lines.
+C
+  104 CALL AGSCAN ('LABE/CONT.',LOLC,NILC,IILC)
+      IF (LOPA.NE.LOLC) GO TO 107
+      IF (QDLB.GE.0.) RETURN
+C
+      QBAN=0.
+      QNAN=0.
+C
+      LBIM=IFIX(QBIM)
+C
+      DO 105 I=1,LBIM
+        IF (FLLB(1,I).NE.0.) THEN
+          CALL AGDLCH (IFIX(FLLB(1,I)))
+          FLLB(1,I)=0.
+        END IF
+  105 CONTINUE
+C
+      LNIM=IFIX(QNIM)
+C
+      DO 106 I=1,LNIM
+        IF (FLLN(1,I).NE.SVAL(1)) THEN
+          CALL AGDLCH (IFIX(FLLN(4,I)))
+          FLLN(1,I)=SVAL(1)
+        END IF
+  106 CONTINUE
+C
+      RETURN
+C
+C If the specific item was the label name, reset it to an appropriate
+C index in the label list, providing initial values if appropriate.
+C
+  107 CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.NE.LOLN) GO TO 109
+C
+      LBAN=0
+      LBIM=IFIX(QBIM)
+      QNAN=0.
+C
+      CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1)
+C
+      DO 108 I=1,LBIM
+        IF (LBAN.EQ.0.AND.FLLB(1,I).EQ.0.) LBAN=I
+        CALL AGGTCH (IFIX(FLLB(1,I)),CHS2,LCS2)
+        IF (LCS1.NE.LCS2) GO TO 108
+        IF (CHS1(1:LCS1).NE.CHS2(1:LCS2)) GO TO 108
+        QBAN=FLOAT(I)
+        RETURN
+  108 CONTINUE
+C
+      IF (LBAN.EQ.0) GO TO 901
+C
+      QBAN=FLOAT(LBAN)
+C
+      FLLB( 1,LBAN)=FURA(1)
+      FLLB( 2,LBAN)=0.
+      FLLB( 3,LBAN)=.5
+      FLLB( 4,LBAN)=.5
+      FLLB( 5,LBAN)=0.
+      FLLB( 6,LBAN)=0.
+      FLLB( 7,LBAN)=0.
+      FLLB( 8,LBAN)=0.
+      FLLB( 9,LBAN)=0.
+      FLLB(10,LBAN)=0.
+C
+      RETURN
+C
+C If the label access name is not set, skip.
+C
+  109 IF (QBAN.LE.0.) GO TO 122
+C
+      LBAN=IFIX(QBAN)
+      LBIM=IFIX(QBIM)
+      LNAN=IFIX(QNAN)
+      LNIM=IFIX(QNIM)
+C
+C If the specific item was the suppression flag for the current label
+C and it was set negative, delete the label and/or its lines.
+C
+      CALL AGSCAN ('LABE/SUPP.',LOLS,NILS,IILS)
+      IF (LOPA.NE.LOLS) GO TO 111
+      IF (FLLB(2,LBAN).GE.0.) RETURN
+C
+      ITMP=IFIX(FLLB(2,LBAN))
+      FLLB(2,LBAN)=0.
+      FLLB(9,LBAN)=0.
+      LNIN=IFIX(FLLB(10,LBAN))
+      FLLB(10,LBAN)=0.
+      QNAN=0.
+      IF (ITMP.EQ.(-1)) GO TO 110
+      CALL AGDLCH (IFIX(FLLB(1,LBAN)))
+      FLLB(1,LBAN)=0.
+      QBAN=0.
+C
+  110 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN
+      FLLN(1,LNIN)=SVAL(1)
+      CALL AGDLCH (IFIX(FLLN(4,LNIN)))
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 110
+C
+C If the specific item was the line number, reset it to an appropriate
+C index in the line list, providing initial values if appropriate.
+C
+  111 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN)
+      IF (LOPA.NE.LOLN) GO TO 118
+C
+      LNIL=0
+      LNIN=IFIX(FLLB(10,LBAN))
+C
+  112 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) GO TO 115
+      IF (LNAN-IFIX(FLLN(1,LNIN))) 113,114,115
+C
+  113 LNIL=LNIN
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 112
+C
+  114 QNAN=FLOAT(LNIN)
+      RETURN
+C
+  115      DO 116 I=1,LNIM
+           LNIT=I
+           IF (FLLN(1,I).EQ.SVAL(1)) GO TO 117
+  116      CONTINUE
+C
+      GO TO 903
+C
+  117 CALL AGSTCH (' ',1,ITMP)
+C
+      FLLN(1,LNIT)=FLOAT(LNAN)
+      FLLN(2,LNIT)=0.
+      FLLN(3,LNIT)=.015
+      FLLN(4,LNIT)=ITMP
+      FLLN(5,LNIT)=1.
+      FLLN(6,LNIT)=FLOAT(LNIN)
+C
+      LNAN=LNIT
+      IF (LNIL.EQ.0) FLLB(10,LBAN)=FLOAT(LNAN)
+      IF (LNIL.NE.0) FLLN( 6,LNIL)=FLOAT(LNAN)
+C
+      FLLB(9,LBAN)=FLLB(9,LBAN)+1.
+C
+      QNAN=FLOAT(LNAN)
+      RETURN
+C
+C If the line access number is not set, skip.
+C
+  118 IF (LNAN.LE.0) GO TO 122
+C
+C If the specific item was the suppression flag for the current line and
+C it was set negative, delete the line.
+C
+      CALL AGSCAN ('LINE/SUPP.',LOLS,NILS,IILS)
+      IF (LOPA.NE.LOLS) GO TO 121
+      IF (FLLN(2,LNAN).GE.0.) RETURN
+C
+      LNIL=0
+      LNIN=IFIX(FLLB(10,LBAN))
+C
+  119 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN
+      IF (LNAN.EQ.LNIN) GO TO 120
+      LNIL=LNIN
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 119
+C
+  120 IF (LNIL.EQ.0) FLLB(10,LBAN)=FLLN(6,LNAN)
+      IF (LNIL.NE.0) FLLN( 6,LNIL)=FLLN(6,LNAN)
+      FLLN(1,LNAN)=SVAL(1)
+      CALL AGDLCH (IFIX(FLLN(4,LNAN)))
+      QNAN=0.
+      RETURN
+C
+C If the specific item was the text of a line, set the length of the
+C line, as well.
+C
+  121 CALL AGSCAN ('LINE/TEXT.',LOLT,NILT,IILT)
+      IF (LOPA.NE.LOLT) GO TO 123
+      CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1)
+      FLLN(5,LNAN)=FLOAT(LCS1)
+      RETURN
+C
+C See if the user is trying to get at a line of a non-existent label.
+C
+  122 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN) GO TO 902
+C
+C If the specific item was the background parameter, set up the back-
+C ground requested by the user.
+C
+  123 CALL AGSCAN ('BACK.',LOBG,NIBG,IIBG)
+      IF (LOPA.NE.LOBG) GO TO 130
+C
+      QBAC=AMAX1(1.,AMIN1(4.,QBAC))
+      IBAC=IFIX(QBAC)
+      GO TO (124,125,126,127) , IBAC
+C
+C Perimeter background.
+C
+  124 QLBC=4.
+      QRTC=4.
+      WMJI=.015
+      WMNI=.010
+      GO TO 128
+C
+C Grid background.
+C
+  125 QLBC=4.
+      QRTC=-1.
+      WMJI=1.
+      WMNI=1.
+      GO TO 128
+C
+C Half-axis background.
+C
+  126 QLBC=4.
+      QRTC=0.
+      WMJI=.015
+      WMNI=.010
+      GO TO 128
+C
+C No background.
+C
+  127 QLBC=0.
+      QRTC=0.
+      WMJI=.015
+      WMNI=.010
+C
+  128 QDAX(1)=QLBC
+      QDAX(2)=QRTC
+      QDAX(3)=QLBC
+      QDAX(4)=QRTC
+C
+      DO 129 I=1,4
+        WMJR(I)=WMJI
+        WMNR(I)=WMNI
+  129 CONTINUE
+C
+      QDLB=FLOAT(2-2*(IBAC/4))
+      RETURN
+C
+C If the specific item was the get-limits-from-last-SET-call parameter,
+C do what is necessary.
+C
+  130 CALL AGSCAN ('SET .',LOSE,NISE,IISE)
+      IF (LOPA.NE.LOSE) GO TO 131
+C
+      QSET=SIGN(AMAX1(1.,AMIN1(4.,ABS(QSET))),QSET)
+C
+      XLGD=.15
+      XRGD=.95
+      YBGD=.15
+      YTGD=.95
+      SOGD=0.
+C
+      XMIN=SVAL(1)
+      XMAX=SVAL(1)
+      QLUX=AMIN1(QLUX,0.)
+      QOVX=0.
+      QCEX=-1.
+      XLOW=SVAL(1)
+      XHGH=SVAL(1)
+C
+      YMIN=SVAL(1)
+      YMAX=SVAL(1)
+      QLUY=AMIN1(QLUY,0.)
+      QOVY=0.
+      QCEY=-1.
+      YLOW=SVAL(1)
+      YHGH=SVAL(1)
+C
+      RETURN
+C
+C Return to caller.
+C
+  131 RETURN
+C
+C Error exits.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - LABEL LIST OVERFLOW - SEE AUTOGRAPH SPECIALI
+     +ST',15,2)
+C
+  902 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - ATTEMPT TO DEFINE LINE OF NON-EXISTENT LABEL
+     +',16,2)
+C
+  903 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - LINE LIST OVERFLOW - SEE AUTOGRAPH SPECIALIS
+     +T',17,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsrch.f b/sys/gio/ncarutil/autograph/agsrch.f
new file mode 100644
index 00000000..366c46cc
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsrch.f
@@ -0,0 +1,96 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSRCH (TPID,IPID,IKWL,TKWL)
+C
+      CHARACTER*(*) TPID,TKWL
+C
+C The routine AGSRCH is used by AGSCAN to search a parameter identifier
+C for the next keyword and return the index of that keyword in a list of
+C keywords.  It has the following arguments.
+C
+C -- TPID is the parameter identifier, a character string.
+C
+C -- IPID is the index of the last character examined in TPID.  It is
+C    updated by AGSRCH to point to the first slash or period following
+C    the next keyword.
+C
+C -- IKWL is returned containing the index (in the keyword list) of the
+C    next keyword in the parameter identifier (list length, plus one,
+C    if the keyword is not found in the list).
+C
+C -- TKWL is the keyword list - 4*LKWL characters in all.
+C
+C ICHR is used to hold up to four characters of a keyword.
+C
+      CHARACTER*4 ICHR
+C
+C LPID is the assumed maximum length of a parameter identifier.
+C
+      DATA LPID / 100 /
+C
+C Compute the number of 4-character keywords in the keyword list.
+C
+      LKWL=LEN(TKWL)/4
+C
+C Find the next non-blank in the parameter identifier.
+C
+  101 IPID=IPID+1
+      IF (IPID.GT.LPID) GO TO 107
+      IF (TPID(IPID:IPID).EQ.' ') GO TO 101
+C
+C Pick up at most four characters of the keyword, stopping on the first
+C blank, slash, or period encountered.
+C
+      NCHR=0
+C
+  102 IF (TPID(IPID:IPID).EQ.' '.OR.
+     +    TPID(IPID:IPID).EQ.'/'.OR.
+     +    TPID(IPID:IPID).EQ.'.') GO TO 103
+C
+      NCHR=NCHR+1
+      ICHR(NCHR:NCHR)=TPID(IPID:IPID)
+C
+      IPID=IPID+1
+C
+      IF (NCHR.LT.4) GO TO 102
+C
+C If the keyword found has zero length, error.
+C
+  103 IF (NCHR.EQ.0) GO TO 107
+C
+C Scan ahead for the next slash or period.
+C
+  104 IF (TPID(IPID:IPID).EQ.'/'.OR.TPID(IPID:IPID).EQ.'.') GO TO 105
+C
+      IPID=IPID+1
+      IF (IPID.GT.LPID) GO TO 107
+      GO TO 104
+C
+C Search the keyword list for the keyword found.
+C
+  105 DO 106 I=1,LKWL
+        IKWL=I
+        ISTR=(I-1)*4+1
+        IEND=(I-1)*4+NCHR
+        IF (ICHR(1:NCHR).EQ.TKWL(ISTR:IEND)) RETURN
+  106 CONTINUE
+C
+C Keyword not found - set IKWL to impossible value and return.
+C
+  107 IKWL=LKWL+1
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agstch.f b/sys/gio/ncarutil/autograph/agstch.f
new file mode 100644
index 00000000..2b2906bd
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agstch.f
@@ -0,0 +1,124 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSTCH (CHST,LNCS,IDCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine stores strings of characters for later retrieval and/or
+C modification by the routines AGGTCH, AGRPCH, and AGDLCH.  It has the
+C following arguments:
+C
+C -- CHST is the character string to be stored.
+C
+C -- LNCS is the length of the character string in CHST.  LNCS must be
+C    less than or equal to the value of the FORTRAN function LEN(CHST).
+C
+C -- IDCS is an identifying integer, returned to the caller by AGSTCH
+C    for later use in calls to AGGTCH, AGRPCH, and AGDLCH.  If CHST is
+C    more than one character long, it is stashed in the array CHRA, and
+C    the value returned in IDCS is a negative number between -LNIC and
+C    -1, inclusive, the absolute value of which is the index of an entry
+C    in the array INCH describing where in the array CHRA the string was
+C    stored.  If CHST is only one character long, IDCS is returned as
+C    the value of the FORTRAN expression -(LNIC+1+ICHAR(CHST(1:1))).
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If the string is short enough, just embed it in a negative integer
+C and return that value to the caller as the identifier of the string.
+C
+      IF (LNCS.LE.1) THEN
+        IDCS=-(LNIC+1+ICHAR(CHST(1:1)))
+        RETURN
+      END IF
+C
+C Otherwise, the string must be stashed in CHRA and the negative of the
+C index, in INCH, of its descriptor returned to the caller.  Loop, on I,
+C through the index of character strings.
+C
+      DO 104 I=1,LNIC
+C
+C If the next entry in the index is zeroed, use it for the new string.
+C
+        IF (INCH(1,I).EQ.0) THEN
+C
+C Zeroed entry found.  Return the negative of its index to the user.
+C
+          IDCS=-I
+C
+C If there isn't enough room for the character string at the end of the
+C character-storage array, do some garbage-collecting, eliminating all
+C strings of all-zero characters.
+C
+          IF (LNCS.GT.LNCA-INCA) THEN
+            J=0
+            K=0
+            DO 102 L=1,INCA
+              IF (CHRA(L).EQ.CHAR(0)) THEN
+                IF (J.EQ.0) J=L
+              ELSE
+                IF (J.NE.0) THEN
+                  DO 101 M=1,LNIC
+                    IF (INCH(1,M).GT.K) INCH(1,M)=INCH(1,M)+J-L
+  101             CONTINUE
+                  J=0
+                END IF
+                K=K+1
+                CHRA(K)=CHRA(L)
+              END IF
+  102       CONTINUE
+            INCA=K
+          END IF
+C
+C If there still isn't enough room for the character string at the end
+C of the character-storage array, take an error exit.  Otherwise, stash
+C it and return.  All-zero characters are changed to blanks.
+C
+          IF (LNCS.GT.LNCA-INCA) GO TO 901
+          INCH(1,I)=INCA+1
+          INCH(2,I)=LNCS
+          DO 103 J=1,LNCS
+            INCA=INCA+1
+            CHRA(INCA)=CHST(J:J)
+            IF (ICHAR(CHRA(INCA)).EQ.0) CHRA(INCA)=' '
+  103     CONTINUE
+          RETURN
+C
+        END IF
+C
+  104 CONTINUE
+C
+C If no zeroed entry was found in the index of character strings, jump
+C to log an error and quit.
+C
+      GO TO 902
+C
+C Error exits.
+C
+  901 CALL SETER ('AGSTCH - CHARACTER-STRING BUFFER OVERFLOW - SEE CONSU
+     +LTANT',18,2)
+C
+  902 CALL SETER ('AGSTCH - CHARACTER-STRING INDEX OVERFLOW - SEE CONSUL
+     +TANT',19,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agstup.f b/sys/gio/ncarutil/autograph/agstup.f
new file mode 100644
index 00000000..41a97674
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agstup.f
@@ -0,0 +1,543 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,
+     +                   YDRA,NVIY,IIVY,NEVY,IIEY)
+C
+      DIMENSION XDRA(1),YDRA(1)
+C
+C The routine AGSTUP is called to examine the parameter list, to provide
+C default values for missing parameters, and to check for and cope with
+C label overlap problems.
+C
+C The arguments describe the x and y data arrays to be used for the next
+C graph.  See the routine AGEXUS for a description of them.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Declare the block data routine external to force it to load.
+C
+C     EXTERNAL AGDFLT
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','AGSTUP','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO - Block data replaced with run time initialization
+C
+      call agdflt
+C 
+C -NOAO
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C Compute the width and height of the plotter frame.
+C
+      CALL GETSI (IWFP,IHFP)
+      WOFP=2.**IWFP-1.
+      HOFP=2.**IHFP-1.
+C
+C Examine the get-limits-from-last-set-call parameter.
+C
+      IF (ABS(QSET).EQ.1.) GO TO 141
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XMNT,XMXT,YMNT,YMXT,LILO)
+C
+      QLUX=FLOAT((1-LILO)/2)
+      QLUY=FLOAT(MOD(1-LILO,2))
+C
+      IF (ABS(QSET).EQ.3.) GO TO 140
+C
+      XLGD=(XLCW-XLGF)/(XRGF-XLGF)
+      XRGD=(XRCW-XLGF)/(XRGF-XLGF)
+      YBGD=(YBCW-YBGF)/(YTGF-YBGF)
+      YTGD=(YTCW-YBGF)/(YTGF-YBGF)
+      SOGD=0.
+C
+      IF (ABS(QSET).EQ.2.) GO TO 141
+C
+  140 XMIN=AMIN1(XMNT,XMXT)
+      XMAX=AMAX1(XMNT,XMXT)
+      QOVX=0.
+      IF (XMNT.GT.XMXT) QOVX=1.
+      QCEX=0.
+C
+      YMIN=AMIN1(YMNT,YMXT)
+      YMAX=AMAX1(YMNT,YMXT)
+      QOVY=0.
+      IF (YMNT.GT.YMXT) QOVY=1.
+      QCEY=0.
+C
+  141 CONTINUE
+C
+C Examine the graph-window parameters.
+C
+      XLGF=AMAX1(0.,AMIN1(1.,XLGF))
+      XRGF=AMAX1(0.,AMIN1(1.,XRGF))
+      YBGF=AMAX1(0.,AMIN1(1.,YBGF))
+      YTGF=AMAX1(0.,AMIN1(1.,YTGF))
+C
+      IF (XLGF.GE.XRGF.OR.YBGF.GE.YTGF) GO TO 901
+C
+C Examine the grid-window parameters.
+C
+      XLGD=AMAX1(0.,AMIN1(1.,XLGD))
+      XRGD=AMAX1(0.,AMIN1(1.,XRGD))
+      YBGD=AMAX1(0.,AMIN1(1.,YBGD))
+      YTGD=AMAX1(0.,AMIN1(1.,YTGD))
+C
+      IF (XLGD.GE.XRGD.OR.YBGD.GE.YTGD) GO TO 902
+C
+C Examine the user-window minima and maxima for special values.  Compute
+C tentative values of the user-window edge parameters.
+C
+      QIXY=AMAX1(0.,AMIN1(1.,QIXY))
+C
+      IF (QIXY.NE.0.) GO TO 142
+C
+      CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH,
+     +                               XDRA,NVIX,IIVX,NEVX,IIEX,XLUW,XRUW)
+      CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH,
+     +                               YDRA,NVIY,IIVY,NEVY,IIEY,YBUW,YTUW)
+      GO TO 143
+C
+  142 CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH,
+     +                               YDRA,NVIY,IIVY,NEVY,IIEY,XLUW,XRUW)
+      CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH,
+     +                               XDRA,NVIX,IIVX,NEVX,IIEX,YBUW,YTUW)
+C
+  143 CONTINUE
+C
+C Examine the user-window nice-value-at-ends parameters.  INAX and INAY
+C specify which axis has the nice values (if any).
+C
+      QCEX=AMAX1(-1.,AMIN1(+1.,QCEX))
+      INAX=IFIX(QCEX)
+      IF (INAX.NE.0) INAX=(INAX+7)/2
+C
+      QCEY=AMAX1(-1.,AMIN1(+1.,QCEY))
+      INAY=IFIX(QCEY)
+      IF (INAY.NE.0) INAY=(INAY+3)/2
+C
+C Examine the user-window linear-log flags.
+C
+      QLUX=AMAX1(-1.,AMIN1(1.,QLUX))
+      QLUY=AMAX1(-1.,AMIN1(1.,QLUY))
+C
+C Examine the axis parameters.
+C
+      QLUD=ABS(QLUY)
+      INAD=INAY
+      UMIN=YBUW
+      UMAX=YTUW
+      QMIN=YBUW
+      QMAX=YTUW
+C
+      I=0
+C
+  101 I=I+1
+      IF (I.EQ.5) GO TO 104
+C
+      IF (I.EQ.3) THEN
+        QLUD=ABS(QLUX)
+        INAD=INAX
+        UMIN=XLUW
+        UMAX=XRUW
+        QMIN=XLUW
+        QMAX=XRUW
+      END IF
+C
+      QDAX(I)=AMAX1(-1.,AMIN1(4.,QDAX(I)))
+      IF (QDAX(I).LE.0.) GO TO 102
+      QLUA(I)=QLUD
+      QBTP(I)=QBTD(I)
+      IF (QBTD(I).EQ.SVAL(1).OR.QBTD(I).EQ.SVAL(2)) QBTP(I)=1.+QLUD
+      QBTP(I)=AMAX1(0.,AMIN1(3.,QBTP(I)))
+      IF (QBTD(I).EQ.SVAL(2)) QBTD(I)=QBTP(I)
+C
+      CALL AGEXAX (I,SVAL,UMIN,UMAX,INAD-I,QLUD,FUNS(I),QBTP(I),BASD(I),
+     +             BASE(I),QMJD(I),QMND(I),QMNT(I),QLTD(I),QLTP(I),
+     +             QLED(I),QLEX(I),QLFD(I),QLFL(I),QMIN,QMAX)
+C
+      QSPA(I)=AMAX1(0.,AMIN1(1.,QSPA(I)))
+      IF (QJDP(I).EQ.SVAL(1).OR.QJDP(I).EQ.SVAL(2)) QJDP(I)=65535.
+      IF (QNDP(I).EQ.SVAL(1).OR.QNDP(I).EQ.SVAL(2)) QNDP(I)=65535.
+C
+  102 IF (I.EQ.2) THEN
+        YBUW=QMIN
+        YTUW=QMAX
+      ELSE IF (I.EQ.4) THEN
+        XLUW=QMIN
+        XRUW=QMAX
+      END IF
+C
+      GO TO 101
+C
+C Examine the user-window min-max/max-min ordering parameters.  Compute
+C final values of the user-window edge parameters.
+C
+  104 QOVX=AMAX1(0.,AMIN1(1.,QOVX))
+      IF (QOVX.EQ.0.) GO TO 105
+      TEMP=XLUW
+      XLUW=XRUW
+      XRUW=TEMP
+C
+  105 QOVY=AMAX1(0.,AMIN1(1.,QOVY))
+      IF (QOVY.EQ.0.) GO TO 106
+      TEMP=YBUW
+      YBUW=YTUW
+      YTUW=TEMP
+C
+C Determine the exact size and shape of the curve window.
+C
+  106 XLGW=XLGF*WOFP
+      XRGW=XRGF*WOFP
+      YBGW=YBGF*HOFP
+      YTGW=YTGF*HOFP
+C
+      XLCW=XLGW+XLGD*(XRGW-XLGW)
+      XRCW=XLGW+XRGD*(XRGW-XLGW)
+      YBCW=YBGW+YBGD*(YTGW-YBGW)
+      YTCW=YBGW+YTGD*(YTGW-YBGW)
+C
+      WCWP=XRCW-XLCW
+      HCWP=YTCW-YBCW
+C
+      ARWH=WCWP/HCWP
+C
+      IF (SOGD) 107,115,108
+C
+  107 DRWH=ABS(SOGD)
+      GO TO 111
+C
+  108 DRWH=ABS((XRUW-XLUW)/(YTUW-YBUW))
+      IF (SOGD-1.) 109,110,110
+C
+  109 IF (DRWH.LT.SOGD.OR.(1./DRWH).LT.SOGD) GO TO 115
+      GO TO 111
+C
+  110 IF (DRWH.GT.SOGD.OR.(1./DRWH).GT.SOGD) DRWH=1.
+C
+  111 IF (DRWH-ARWH) 112,115,113
+C
+  112 XLCW=XLCW+.5*(WCWP-HCWP*DRWH)
+      XRCW=XRCW-.5*(WCWP-HCWP*DRWH)
+      GO TO 114
+C
+  113 YBCW=YBCW+.5*(HCWP-WCWP/DRWH)
+      YTCW=YTCW-.5*(HCWP-WCWP/DRWH)
+C
+  114 WCWP=XRCW-XLCW
+      HCWP=YTCW-YBCW
+C
+  115 SCWP=AMIN1(WCWP,HCWP)
+C
+      XLGW=(XLGW-XLCW)/WCWP
+      XRGW=(XRGW-XLCW)/WCWP
+      YBGW=(YBGW-YBCW)/HCWP
+      YTGW=(YTGW-YBCW)/HCWP
+C
+      XLCW=XLCW/WOFP
+      XRCW=XRCW/WOFP
+      YBCW=YBCW/HOFP
+      YTCW=YTCW/HOFP
+C
+C Make sure the number of dash patterns is in range.
+C
+      QODP=AMAX1(-26.,AMIN1(+26.,QODP))
+      IF (QODP.EQ.0.) QODP=-1.
+C
+C Examine the windowing parameter.
+C
+      QWND=AMAX1(0.,AMIN1(1.,QWND))
+C
+C Do a test run of the routine AGLBLS to find out how much space will be
+C required for labels in each of the six label boxes.
+C
+      QDLB=AMAX1(0.,AMIN1(2.,QDLB))
+      IDLB=IFIX(QDLB)
+      LBIM=IFIX(QBIM)
+C
+      CALL AGLBLS (-IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+C Compute the desired and smallest-possible widths of the labels in
+C boxes 1 and 2.
+C
+      DWB1=AMAX1(0.,DBOX(1,2)-DBOX(1,1))
+      SWB1=AMAX1(0.,SBOX(1,2)-SBOX(1,1))
+      DWB2=AMAX1(0.,DBOX(2,2)-DBOX(2,1))
+      SWB2=AMAX1(0.,SBOX(2,2)-SBOX(2,1))
+C
+C Compute the desired and smallest-possible heights of the labels in
+C boxes 3 and 4.
+C
+      DHB3=AMAX1(0.,DBOX(3,4)-DBOX(3,3))
+      SHB3=AMAX1(0.,SBOX(3,4)-SBOX(3,3))
+      DHB4=AMAX1(0.,DBOX(4,4)-DBOX(4,3))
+      SHB4=AMAX1(0.,SBOX(4,4)-SBOX(4,3))
+C
+C Do test runs of AGAXIS for each of the four axes to see how much space
+C will be required for numeric labels.
+C
+      I=0
+C
+  118 I=I+1
+      IF (I.EQ.5) GO TO 128
+C
+      XYPI=FLOAT(1-MOD(I,2))
+      IF (QDAX(I).EQ.0.) GO TO 121
+      IF (PING(I).NE.SVAL(1)) XYPI=PING(I)
+C
+      IF (I.GE.3) GO TO 119
+C
+      XYMN=XLGW
+      XYMX=XRGW
+      IF (PINU(I).EQ.SVAL(1)) GO TO 120
+      XYPI=(PINU(I)-XLUW)/(XRUW-XLUW)
+      IF (QLUX.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(XLUW))/
+     +                                       (ALOG10(XRUW)-ALOG10(XLUW))
+      GO TO 120
+C
+  119 XYMN=YBGW
+      XYMX=YTGW
+      IF (PINU(I).EQ.SVAL(1)) GO TO 120
+      XYPI=(PINU(I)-YBUW)/(YTUW-YBUW)
+      IF (QLUY.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(YBUW))/
+     +                                       (ALOG10(YTUW)-ALOG10(YBUW))
+C
+  120 XYPI=AMAX1(XYMN,AMIN1(XYMX,XYPI))
+C
+  121 GO TO (122,123,124,125) , I
+C
+C Left y axis.
+C
+  122 XBGA(1)=XYPI
+      YBGA(1)=0.
+      UBGA(1)=YBUW
+      XNDA(1)=XYPI
+      YNDA(1)=1.
+      UNDA(1)=YTUW
+      WNLL(1)=XYPI-XLGW-DWB1
+      WNLR(1)=XRGW-XYPI-DWB2
+      GO TO 126
+C
+C Right y axis.
+C
+  123 XBGA(2)=XYPI
+      YBGA(2)=1.
+      UBGA(2)=YTUW
+      XNDA(2)=XYPI
+      YNDA(2)=0.
+      UNDA(2)=YBUW
+      WNLL(2)=XRGW-XYPI-DWB2
+      WNLR(2)=XYPI-XLGW-DWB1
+      GO TO 126
+C
+C Bottom x axis.
+C
+  124 XBGA(3)=1.
+      YBGA(3)=XYPI
+      UBGA(3)=XRUW
+      XNDA(3)=0.
+      YNDA(3)=XYPI
+      UNDA(3)=XLUW
+      WNLL(3)=XYPI-YBGW-DHB3
+      WNLR(3)=YTGW-XYPI-DHB4
+      GO TO 126
+C
+C Top x axis.
+C
+  125 XBGA(4)=0.
+      YBGA(4)=XYPI
+      UBGA(4)=XLUW
+      XNDA(4)=1.
+      YNDA(4)=XYPI
+      UNDA(4)=XRUW
+      WNLL(4)=YTGW-XYPI-DHB4
+      WNLR(4)=XYPI-YBGW-DHB3
+C
+  126 IF (QDAX(I).GT.0.) THEN
+        CALL AGAXIS (I,QDAX(I),QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I),
+     +               XNDA(I),YNDA(I),QLUA(I),UBGA(I),UNDA(I),FUNS(I),
+     +               QBTP(I),BASE(I),QJDP(I),WMJL(I),WMJR(I),QMNT(I),
+     +               QNDP(I),WMNL(I),WMNR(I),QLTP(I),QLEX(I),QLFL(I),
+     +               QLOF(I),QLOS(I),DNLA(I),WCLM(I),WCLE(I),RFNL(I),
+     +               QCIM(I),QCIE(I),WNLL(I),WNLR(I),10.,11.)
+      ELSE
+        WNLL(I)=0.
+        WNLR(I)=0.
+      END IF
+      GO TO 118
+C
+C If no labels are to be drawn, AGSTUP is now done.
+C
+  128 IF (IDLB.EQ.0) GO TO 138
+C
+C Check the label boxes, moving and/or shrinking them to prevent the
+C labels in them from overlapping any portion of any axis.  The labels
+C on an axis may have to be moved, as well.
+C
+C Box 1 - to the left of the curve window.
+C
+      IF (DBOX(1,2).GT.0.) GO TO 903
+      DBOX(1,2)=AMIN1(0.,XBGA(1)-WNLL(1),XBGA(2)-WNLR(2))
+      DBOX(1,1)=DBOX(1,2)-DWB1
+      IF (DBOX(1,1).LT.XLGW) DBOX(1,1)=AMIN1(DBOX(1,2)-SWB1,XLGW)
+      IF (DBOX(1,1).GE.XLGW) GO TO 130
+      DBOX(1,1)=XLGW
+      DBOX(1,2)=XLGW+SWB1
+      TEMP=XBGA(1)-WNLL(1)-DBOX(1,2)
+      IF (TEMP.GE.0.) GO TO 129
+      WNLL(1)=WNLL(1)+TEMP
+      WNLR(1)=WNLR(1)-TEMP
+  129 TEMP=XBGA(2)-WNLR(2)-DBOX(1,2)
+      IF (TEMP.GE.0.) GO TO 130
+      WNLL(2)=WNLL(2)-TEMP
+      WNLR(2)=WNLR(2)+TEMP
+C
+C Box 2 - to the right of the curve window.
+C
+  130 IF (DBOX(2,1).LT.1.) GO TO 904
+      DBOX(2,1)=AMAX1(1.,XBGA(1)+WNLR(1),XBGA(2)+WNLL(2))
+      DBOX(2,2)=DBOX(2,1)+DWB2
+      IF (DBOX(2,2).GT.XRGW) DBOX(2,2)=AMAX1(DBOX(2,1)+SWB2,XRGW)
+      IF (DBOX(2,2).LE.XRGW) GO TO 132
+      DBOX(2,1)=XRGW-SWB2
+      DBOX(2,2)=XRGW
+      TEMP=XBGA(1)+WNLR(1)-DBOX(2,1)
+      IF (TEMP.LE.0.) GO TO 131
+      WNLL(1)=WNLL(1)+TEMP
+      WNLR(1)=WNLR(1)-TEMP
+  131 TEMP=XBGA(2)+WNLL(2)-DBOX(2,1)
+      IF (TEMP.LE.0.) GO TO 132
+      WNLL(2)=WNLL(2)-TEMP
+      WNLR(2)=WNLR(2)+TEMP
+C
+C Box 3 - below the curve window.
+C
+  132 IF (DBOX(3,4).GT.0.) GO TO 905
+      DBOX(3,4)=AMIN1(0.,YBGA(3)-WNLL(3),YBGA(4)-WNLR(4))
+      DBOX(3,3)=DBOX(3,4)-DHB3
+      IF (DBOX(3,3).LT.YBGW) DBOX(3,3)=AMIN1(DBOX(3,4)-SHB3,YBGW)
+      IF (DBOX(3,3).GE.YBGW) GO TO 134
+      DBOX(3,3)=YBGW
+      DBOX(3,4)=YBGW+SHB3
+      TEMP=YBGA(3)-WNLL(3)-DBOX(3,4)
+      IF (TEMP.GE.0.) GO TO 133
+      WNLL(3)=WNLL(3)+TEMP
+      WNLR(3)=WNLR(3)-TEMP
+  133 TEMP=YBGA(4)-WNLR(4)-DBOX(3,4)
+      IF (TEMP.GE.0.) GO TO 134
+      WNLL(4)=WNLL(4)-TEMP
+      WNLR(4)=WNLR(4)+TEMP
+C
+C Box 4 - above the curve window.
+C
+  134 IF (DBOX(4,3).LT.1.) GO TO 906
+      DBOX(4,3)=AMAX1(1.,YBGA(3)+WNLR(3),YBGA(4)+WNLL(4))
+      DBOX(4,4)=DBOX(4,3)+DHB4
+      IF (DBOX(4,4).GT.YTGW) DBOX(4,4)=AMAX1(DBOX(4,3)+SHB4,YTGW)
+      IF (DBOX(4,4).LE.YTGW) GO TO 136
+      DBOX(4,3)=YTGW-SHB4
+      DBOX(4,4)=YTGW
+      TEMP=YBGA(3)+WNLR(3)-DBOX(4,3)
+      IF (TEMP.LE.0.) GO TO 135
+      WNLL(3)=WNLL(3)+TEMP
+      WNLR(3)=WNLR(3)-TEMP
+  135 TEMP=YBGA(4)+WNLL(4)-DBOX(4,3)
+      IF (TEMP.LE.0.) GO TO 136
+      WNLL(4)=WNLL(4)-TEMP
+      WNLR(4)=WNLR(4)+TEMP
+C
+C Box 5 - the curve window itself.
+C
+  136 IF (DBOX(5,1).LT.0..OR.DBOX(5,2).GT.1..OR.
+     +                     DBOX(5,3).LT.0..OR.DBOX(5,4).GT.1.) GO TO 907
+C
+      DBOX(5,1)=AMAX1(XLGW,XBGA(1)+WNLR(1))
+      DBOX(5,2)=AMIN1(XRGW,XBGA(2)-WNLR(2))
+      DBOX(5,3)=AMAX1(YBGW,YBGA(3)+WNLR(3))
+      DBOX(5,4)=AMIN1(YTGW,YBGA(4)-WNLR(4))
+C
+C Do a final check on all boxes for labels running outside the graph
+C window.
+C
+           DO 137 NBOX=1,6
+           DBOX(NBOX,1)=AMAX1(XLGW,DBOX(NBOX,1))
+           DBOX(NBOX,2)=AMIN1(XRGW,DBOX(NBOX,2))
+           DBOX(NBOX,3)=AMAX1(YBGW,DBOX(NBOX,3))
+           DBOX(NBOX,4)=AMIN1(YTGW,DBOX(NBOX,4))
+  137      CONTINUE
+C
+C Do a "SET" call for the user and return.
+C
+  138 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+      RETURN
+C
+C Error exits.
+C
+  901 CALL SETER ('AGSTUP - GRAPH WINDOW IMPROPERLY SPECIFIED',20,2)
+C
+  902 CALL SETER ('AGSTUP - GRID WINDOW IMPROPERLY SPECIFIED',21,2)
+C
+  903 CALL SETER ('AGSTUP - LEFT LABELS IMPROPERLY SPECIFIED',22,2)
+C
+  904 CALL SETER ('AGSTUP - RIGHT LABELS IMPROPERLY SPECIFIED',23,2)
+C
+  905 CALL SETER ('AGSTUP - BOTTOM LABELS IMPROPERLY SPECIFIED',24,2)
+C
+  906 CALL SETER ('AGSTUP - TOP LABELS IMPROPERLY SPECIFIED',25,2)
+C
+  907 CALL SETER ('AGSTUP - INTERIOR LABELS IMPROPERLY SPECIFIED',26,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agutol.f b/sys/gio/ncarutil/autograph/agutol.f
new file mode 100644
index 00000000..02dbf64c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agutol.f
@@ -0,0 +1,49 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP)
+C
+C This routine is called to perform the mapping from the "user system"
+C along an axis to the "label system" along that axis or vice-versa.  It
+C may be replaced by the user in order to create a desired graph.  The
+C arguments are as follows:
+C
+C -- IAXS is the index of the axis being drawn.  Its value is 1, 2, 3,
+C    or 4, implying the left, right, bottom, or top axis, respectively.
+C
+C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.', which may be
+C    used to select the desired mapping function for axis IAXS.  It is
+C    recommended that the default value (zero) be used to specify the
+C    identity mapping.  A non-zero value may be integral (1., 2., etc.)
+C    and serve purely to select the code to be executed or it may be the
+C    value of a real parameter in the equations defining the mapping.
+C
+C -- IDMA specifies the direction of the mapping.  A value greater than
+C    zero indicates that VINP is a value in the user system and that
+C    VOTP is to be a value in the label system, a value less than zero
+C    the opposite.
+C
+C -- VINP is an input value in one coordinate system along the axis.
+C
+C -- VOTP is an output value in the other coordinate system along the
+C    axis.
+C
+C The default routine simply defines the identity mapping for all axes.
+C
+      VOTP=VINP
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/anotat.f b/sys/gio/ncarutil/autograph/anotat.f
new file mode 100644
index 00000000..ed46025b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/anotat.f
@@ -0,0 +1,63 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE ANOTAT (LABX,LABY,LBAC,LSET,NDSH,DSHL)
+C
+      CHARACTER*(*) LABX,LABY,DSHL(*)
+C
+C The routine ANOTAT resets background annotation.
+C
+C Declare the type of the dash-pattern-parameter-name generator.
+C
+      CHARACTER*16 AGDSHN
+C
+C Set up the x-axis label.
+C
+      IF (ICHAR(LABX(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'B')
+        CALL AGSETI ('LINE/NUMB.',-100)
+        CALL AGSETC ('LINE/TEXT.',LABX)
+      END IF
+C
+C Set up the y-axis label.
+C
+      IF (ICHAR(LABY(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'L')
+        CALL AGSETI ('LINE/NUMB.', 100)
+        CALL AGSETC ('LINE/TEXT.',LABY)
+      END IF
+C
+C Set up the background the user wants.
+C
+      IF (LBAC.GT.0) CALL AGSETI ('BACK.',LBAC)
+C
+C Set the parameter ISET.
+C
+      IF (LSET.NE.0) CALL AGSETI ('SET .',LSET)
+C
+C Set up the dash patterns the user wants.
+C
+      IF (NDSH.NE.0) THEN
+        IDSH=MIN0(26,NDSH)
+        CALL AGSETI ('DASH/SELE.',IDSH)
+        IF (IDSH.LT.0) RETURN
+        DO 101 I=1,IDSH
+          CALL AGSETC (AGDSHN(I),DSHL(I))
+  101   CONTINUE
+      END IF
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/displa.f b/sys/gio/ncarutil/autograph/displa.f
new file mode 100644
index 00000000..0749b29b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/displa.f
@@ -0,0 +1,33 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE DISPLA (LFRA,LROW,LTYP)
+C
+C The subroutine DISPLA resets the parameters IFRA, IROW, and/or LLUX
+C and LLUY.
+C
+      IF (LFRA.NE.0) CALL AGSETI ('FRAM.', MAX0(1,MIN0(3,LFRA)))
+C
+      IF (LROW.NE.0) CALL AGSETI ('ROW .',LROW)
+C
+      IF (LTYP.EQ.0) RETURN
+C
+      ITYP=MAX0(1,MIN0(4,LTYP))
+      CALL AGSETI ('X/LOGA.',   (1-ITYP)/2)
+      CALL AGSETI ('Y/LOGA.',MOD(1-ITYP,2))
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezmxy.f b/sys/gio/ncarutil/autograph/ezmxy.f
new file mode 100644
index 00000000..bc8f6352
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezmxy.f
@@ -0,0 +1,67 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,LABG)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZMXY draws many curves, each of them defined by points of
+C the form (XDRA(I,J),YDRA(I,J)) or (XDRA(J,I),YDRA(J,I)) or, possibly,
+C (XDRA(I),YDRA(I,J)) or (XDRA(I),YDRA(J,I)), for I = 1, 2, ... NPTS and
+C for J = 1, 2, ... MANY.  (YDRA is actually dimensioned IDXY by * .)
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMXY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C 
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+      CALL AGGETI ('DASH/SELE.',IDSH)
+C
+      CALL AGEZSU (4,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.LT.0) GO TO 102
+C
+           DO 101 I=1,MANY
+           INXD=1+(I-1)*IIVX
+           INYD=1+(I-1)*IIVY
+           KDSH=ISIGN(I,IDSH)
+           CALL AGCURV (XDRA(INXD),IIEX,YDRA(INYD),IIEY,NPTS,KDSH)
+  101      CONTINUE
+C
+  102 IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezmy.f b/sys/gio/ncarutil/autograph/ezmy.f
new file mode 100644
index 00000000..e406465b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezmy.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZMY (YDRA,IDXY,MANY,NPTS,LABG)
+C
+      REAL XDRA(1),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZMY draws many curves, each of them defined by points of
+C the form (I,YDRA(I,J)) or (I,YDRA(J,I)), for I = 1, 2, ... NPTS and
+C for J = 1, 2, ... MANY.  (YDRA is actually dimensioned IDXY by * .)
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+      CALL AGGETI ('DASH/SELE.',IDSH)
+C
+      CALL AGEZSU (3,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.LT.0) GO TO 102
+C
+           DO 101 I=1,MANY
+           INYD=1+(I-1)*IIVY
+           KDSH=ISIGN(I,IDSH)
+           CALL AGCURV (XDRA,0,YDRA(INYD),IIEY,NPTS,KDSH)
+  101      CONTINUE
+C
+  102 IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezxy.f b/sys/gio/ncarutil/autograph/ezxy.f
new file mode 100644
index 00000000..e6ef3b5e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezxy.f
@@ -0,0 +1,57 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZXY (XDRA,YDRA,NPTS,LABG)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZXY draws one curve through the points (XDRA(I),YDRA(I)),
+C for I = 1, 2, ... NPTS.
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZXY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+C
+      CALL AGEZSU (2,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.GE.0) CALL AGCURV (XDRA,1,YDRA,1,NPTS,1)
+C
+      IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezy.f b/sys/gio/ncarutil/autograph/ezy.f
new file mode 100644
index 00000000..3be54a03
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezy.f
@@ -0,0 +1,57 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZY (YDRA,NPTS,LABG)
+C
+      REAL XDRA(1),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The subroutine EZY draws one curve through the points (I,YDRA(I)), for
+C I = 1, 2, ... NPTS.
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+C
+      CALL AGEZSU (1,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.GE.0) CALL AGCURV (XDRA,0,YDRA,1,NPTS,1)
+C
+      IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/idiot.f b/sys/gio/ncarutil/autograph/idiot.f
new file mode 100644
index 00000000..0e2ce5e5
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/idiot.f
@@ -0,0 +1,64 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      INTEGER LDSH(*)
+C
+      CHARACTER*(*) LABX,LABY,LABG
+C
+      CHARACTER*16 AGBNCH
+C
+C This is an implementation of the routine from which AUTOGRAPH grew.
+C It should work pretty much as the original did (if you can figure out
+C what that was).
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','IDIOT','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C 
+C -NOAO
+      CALL ANOTAT (LABX,LABY,1,2-ISIGN(1,NPTS),1,AGBNCH(LDSH))
+C
+      CALL DISPLA (2-MAX0(-1,MIN0(1,LFRA)),1,LTYP)
+C
+      CALL AGEZSU (5,XDRA,YDRA,IABS(NPTS),1,IABS(NPTS),LABG,IIVX,IIEX,
+     +                                                        IIVY,IIEY)
+      CALL AGBACK
+C
+      CALL AGCURV (XDRA,1,YDRA,1,IABS(NPTS),1)
+C
+      IF (LFRA.GT.0) CALL FRAME
+C
+C +NOAO
+C
+      call plotit (0, 0, 2)
+      call initut
+C
+C -NOAO
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/autograph/mkpkg b/sys/gio/ncarutil/autograph/mkpkg
new file mode 100644
index 00000000..8af0a0d4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/mkpkg
@@ -0,0 +1,62 @@
+# Make the NCAR AUTOGRAPH library.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	agdflt.f  
+	agaxis.f
+	agback.f
+	agbnch.f
+	agchax.f
+	agchcu.f
+	agchil.f
+	agchnl.f
+	agctcs.f
+	agctko.f
+	agcurv.f
+	agdash.f
+	agdlch.f
+	agdshn.f
+	agexax.f
+	agexus.f
+	agezsu.f
+	agfpbn.f
+	agftol.f
+	aggetc.f
+	aggetf.f
+	aggeti.f
+	aggetp.f
+	aggtch.f
+	aginit.f
+	agkurv.f
+	aglbls.f
+	agmaxi.f
+	agmini.f
+	agnumb.f
+	agppid.f
+	agpwrt.f
+	agqurv.f
+	agrpch.f
+	agrstr.f
+	agsave.f
+	agscan.f
+	agsetc.f
+	agsetf.f
+	agseti.f
+	agsetp.f
+	agsrch.f
+	agstch.f
+	agstup.f
+	agutol.f
+	anotat.f
+	displa.f
+	ezmxy.f
+	ezmy.f
+	ezxy.f
+	ezy.f
+	idiot.f
+	pstr.x
+	;
diff --git a/sys/gio/ncarutil/autograph/pstr.x b/sys/gio/ncarutil/autograph/pstr.x
new file mode 100644
index 00000000..a40c9fc1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/pstr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PSTR -- Print a character string from a fortran program.  The string is
+# passed as an unpacked spp string, the result of f77upk in the calling
+# program.  PSTR is called by agppid.f in the autograph package.
+
+procedure pstr (spp_string)
+
+char 	spp_string[ARB]
+
+begin
+	call eprintf ("%s\n")
+	    call pargstr (spp_string)
+end
diff --git a/sys/gio/ncarutil/conbd.f b/sys/gio/ncarutil/conbd.f
new file mode 100644
index 00000000..eaaf2df5
--- /dev/null
+++ b/sys/gio/ncarutil/conbd.f
@@ -0,0 +1,111 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C     BLOCKDATA CONBD
+      subroutine conbd
+      integer first, temp
+      common /conflg/ first
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE2/ IX         ,IY         ,IDX  ,IDY ,
+     1                IS         ,ISS        ,NP         ,CV ,
+     2                INX(8)     ,INY(8)     ,IR(80000)    ,NR
+c +noao: dimension of stline ir array increased from 20000 to 80000 6-93
+      COMMON /CONRE4/ ISIZEL     ,ISIZEM     ,ISIZEP     ,NREP,
+     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD,
+     2                EXT        ,IOFFM      ,ISOLID     ,NLA,
+     3                NLM        ,XLT        ,YBT        ,SIDE
+      COMMON /RECINT/ IRECMJ     ,IRECMN          ,IRECTX
+C
+      SAVE
+C
+C     DATA IOFFP,SPVAL/0,0.0/
+      data temp /1/
+      first = temp
+      IOFFP  = 0
+      SPVAL  = 0.0
+C     DATA ISIZEL,ISIZEM,ISIZEP,NLA,NLM,XLT,YBT,SIDE,ISOLID,NREP,NCRT/
+C    1       1,  2,   0, 16, 40,.05,.05,  .9,  1023,   6,   4 /
+      if (first .ne. 1) then
+        return
+      endif
+
+      temp = 0
+
+c     ISIZEL = 1
+c noao: size of contour labels seemed too large.  Changed from 1 to 0
+      isizel = 0
+      ISIZEM = 2
+      ISIZEP = 0
+      NLA    = 16
+      NLM    = 40
+      XLT    = .05
+      YBT    = .05
+      SIDE   = .9
+      ISOLID = 1023
+      NREP   = 4
+      NCRT   = 2 
+C     DATA EXT,IOFFD,NULBLL,IOFFM,ILAB/.25,0,3,0,1/
+C +noao value of "extreme" axes ratios changed from 1/4 to 1/16 (ShJ 6-10-88)
+C     EXT    = .25
+      EXT    = .0625
+C -noao
+      IOFFD  = 0
+      NULBLL = 3
+      IOFFM  = 0
+      ILAB   = 1
+C     DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/
+C    1        -1 ,   -1 ,    0 ,    1 ,    1 ,          1 ,      0 ,   -1 /
+      INX(1) = -1 
+      INX(2) = -1
+      INX(3) = 0 
+      INX(4) = 1 
+      INX(5) = 1 
+      INX(6) = 1
+      INX(7) = 0
+      INX(8) = -1
+C     DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/
+C    1         0 ,    1 ,    1 ,    1 ,    0 ,   -1 ,   -1 ,   -1 /
+      INY(1) = 0 
+      INY(2) = 1
+      INY(3) = 1
+      INY(4) = 1 
+      INY(5) = 0
+      INY(6) = -1
+      INY(7) = -1
+      INY(8) = -1
+C     DATA NR/500/
+c +noao: dimension of stline array increased from 500 to 5000 6March87
+c +noao: dimension of stline array increased from 5000 to 20000 Jan90
+c +noao: dimension of stline array increased from 20000 to 80000 6-93
+      NR     = 80000
+C     DATA IRECMJ,IRECMN,IRECTX/ 1 ,   1 ,   1/
+c +noao: value of irecmj changed so major divisions are high intensity
+      IRECMJ = 2 
+      IRECMN = 1
+      IRECTX = 1
+C
+C - noao
+C
+C REVISION HISTORY---
+C
+C JANUARY 1980     ADDED REVISION HISTORY AND CHANGED LIBRARY NAME
+C                  FROM CRAYLIB TO PORTLIB FOR MOVE TO PORTLIB
+C
+C MAY 1980         ARRAYS IWORK AND ENCSCR, PREVIOUSLY TOO SHORT FOR
+C                  SHORT-WORD-LENGTH MACHINES, LENGTHENED.  SOME
+C                  DOCUMENTATION CLARIFIED AND CORRECTED.
+C
+C JUNE 1984        CONVERTED TO FORTRAN 77 AND TO GKS
+C-------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/conbdn.f b/sys/gio/ncarutil/conbdn.f
new file mode 100644
index 00000000..cd7ca00d
--- /dev/null
+++ b/sys/gio/ncarutil/conbdn.f
@@ -0,0 +1,342 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data conbdn changed to run time initialization
+c     BLOCKDATA CONBDN
+      subroutine conbdn
+C
+C
+C
+C COMMON DATA
+C
+C NOTE THE COMMON BLOCKS LISTED INCLUDE ALL THE COMMON USED BY
+C      THE ENTIRE CONRAN FAMILY, NOT ALL MEMBERS WILL USE ALL
+C      THE COMMON DATA.
+C
+C   CONRA1
+C       CL-ARRAY OF CONTOUR LEVELS
+C       NCL-NUMBER OF CONTOUR LEVELS
+C       OLDZ-Z VALUE OF LEFT NEIGHBOR TO CURRENT LOCATION
+C       PV-ARRAY OF PREVIOUS ROW VALUES
+C       HI-LARGEST CONTOUR PLOTTED
+C       FLO-LOWEST CONTOUR PLOTTED
+C       FINC-INCREMENT LEVEL BETWEEN EQUALLY SPACED CONTOURS
+C   CONRA2
+C       REPEAT-FLAG TO TRIANGULATE AND DRAW OR JUST DRAW
+C       EXTRAP-PLOT DATA OUTSIDE OF CONVEX DATA HULL
+C       PER-PUT PERIMETER ARROUND PLOT
+C       MESS-FLAG TO INDICATE MESSAGE OUTPUT
+C       ISCALE-SCALING SWITCH
+C       LOOK-PLOT TRIANGLES FLAG
+C       PLDVLS-PLOT THE DATA VALUES FLAG
+C       GRD-PLOT GRID FLAG
+C       CON-USER SET OR PROGRAM SET CONTOURS FLAG
+C       CINC-USER OR PROGRAM SET INCREMENT FLAG
+C       CHILO-USER OR PROGRAM SET HI LOW CONTOURS
+C       LABON-FLAG TO CONTROL LABELING OF CONTOURS
+C       PMIMX-FLAG TO CONTROL THE PLOTTING OF MIN"S
+C               AND MAX"S
+C       SCALE-THE SCALE FACTOR FOR CONTOUR LINE VALUES
+C               AND MIN ,       MAX PLOTTED VALUES
+C       FRADV-ADVANCE FRAME BEFORE PLOTTING TRIANGUALTION
+C       EXTRI-ONLY PLOT TRIANGULATION
+C       BPSIZ-BREAKPOINT SIZE FOR DASHPATTERNS
+C       LISTOP-LIST OPTIONS ON UNIT6 FLAG
+C   CONRA3
+C       IREC-PORT RECOVERABLE ERROR FLAG
+C   CONRA4
+C       NCP-NUMBER OF DATA POINTS USED AT EACH POINT FOR
+C           POLYNOMIAL CONSTRUCTION.
+C       NCPSZ-MAX SIZE ALLOWED FOR NCP
+C   CONRA5
+C       NIT-FLAG TO INDICATE STATUS OF SEARCH DATA BASE
+C       ITIPV-LAST TRIANGLE INTERPOLATION OCCURRED IN
+C  CONRA6
+C       XST-X COORDINATE START POINT FOR CONTOURING
+C       YST-Y COORDINATE START POINT FOR CONTOURING
+C       XED-X COORDINATE END POINT FOR CONTOURING
+C       YED-Y COORDINATE END POINT FOR CONTOURING
+C       STPSZ-STEP SIZE FOR X,Y CHANGE WHEN CONTOURING
+C       IGRAD-NUMBER OF GRADUATIONS FOR CONTOURING(STEP SIZE)
+C       IG-RESET VALUE FOR IGRAD
+C       XRG-X RANGE OF COORDINATES
+C       YRG-Y RANGE OF COORDINATES
+C       BORD-PERCENT OF FRAME USED FOR CONTOUR PLOT
+C       PXST-X PLOTTER START ADDRESS FOR CONTOURS
+C       PYST-Y PLOTTER START ADDRESS FOR CONTOURS
+C       PXED-X PLOTTER END ADDRESS FOR CONTOURS
+C       PYED-Y PLOTTER END ADDRESS FOR CONTOURS
+C       ITICK-NUMBER OF TICK MARKS FOR GRIDS AND PERIMETERS
+C CONRA7
+C       TITLE-SWITCH TO INDICATE IF TITLE OPTION ON OR OFF
+C       ISTRNG-CHARACTER STRING OF TITLE
+C       ICNT-CHARACTER COUNT OF ISTRNG
+C       ITLSIZ-SIZE OF TITLE IN PWRIT UNITS
+C CONRA8
+C       IHIGH-DEFAULT COLOR (INTENSITY) INDEX SETTING
+C       INMAJ-CONTOUR LEVEL COLOR (INTENSITY) INDEX FOR MAJOR LINES
+C       INMIN-CONTOUR LEVEL COLOR (INTENSITY) INDEX FOR MINOR LINES
+C       INLAB-TITLE AND MESSAGE COLOR (INTENSITY) INDEX
+C       INDAT-DATA VALUE COLOR (INTENSITY) INDEX
+C       FORM-THE FORMAT FOR PLOTTING THE DATA VALUES
+C       LEN-THE NUMBER OF CHARACTERS IN THE FORMAT
+C       IFMT-SIZE OF THE FORMAT FIELD
+C       LEND-DEFAULT FORMAT LENGTH
+C       IFMTD-DEFAULT FORMAT FIELD SIZE
+C       ISIZEP-SIZE OF THE PLOTTED DATA VALUES
+C  CONRA9
+C       X-ARRAY OF X COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       Y-ARRAY OF Y COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       NP-COUNT IN X AND Y
+C       MXXY-SIZE OF X AND Y
+C       TR-TOP RIGHT CORNER VALUE OF CURRENT CELL
+C       BR-BOTTOM RIGHT CORNER VALUE OF CURRENT CELL
+C       TL-TOP LEFT CORNER VALUE OF CURRENT CELL
+C       BL-BOTTOM LEFT CORNER VALUE OF CURRENT CELL
+C       CONV-CURRENT CONTOUR VALUE
+C       XN-X POSITION WHERE CONTOUR IS BEING DRAWN
+C       YN-Y POSITION WHERE CONTOUR IS BEING DRAWN
+C       ITLL-TRIANGLE WHERE TOP LEFT CORNER OF CURRENT CELL LIES
+C       IBLL-TRIANGLE OF BOTTOM LEFT CORNER
+C       ITRL-TRIANGLE OF TOP RIGHT CORNER
+C       IBRL-TRIANGLE OF BOTTOM LEFT CORNER
+C       XC-X COORDINATE OF CURRENT CELL
+C       YC-Y CORRDINATE OF CURRENT CELL
+C       ITLOC-IN CONJUNCTION WITH PV STORES THE TRIANGLE WHERE PV
+C               VALUE CAME FROM
+C CONR10
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       NL-NUMBER OF LINE SEGMENTS
+C       NTNL-NT+NL
+C       JWIPT-POINTER INTO IWK WHERE WHERE TRIANGLE POINT NUMBERS
+C               ARE STORED
+C       JWIWL-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIWP-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIPL-IN IWK THE LOCATION OF END POINTS FOR BORDER LINE
+C               SEGMENTS
+C       IPR-IN WK THE LOCATION OF THE PARTIAL DERIVITIVES AT EACH
+C           DATA POINT
+C       ITPV-THE TRIANGLE WHERE THE PREVIOUS VALUE CAME FROM
+C CONR11
+C       NREP-NUMBER OF REPETITIONS OF DASH PATTERN BEFORE A LABEL
+C       NCRT-NUMBER OF CRT UNITS FOR A DASH MARK OR BLANK
+C       ISIZEL-SIZE OF CONTOUR LINE LABELS
+C       NDASH-ARRAY CONTAINING THE NEGATIVE VALUED CONTOUR DASH
+C               PATTERN
+C       MINGAP-NUMBER OF UNLABELED LINES BETWEEN EACH LABELED ONE
+C       IDASH-POSITIVE VALUED CONTOUR DASH PATTERN
+C       ISIZEM-SIZE OF PLOTTED MINIMUMS AND MAXIMUMS
+C       EDASH-EQUAL VALUED CONTOUR DASH PATTERN
+C       TENS-DEFAULT TENSION SETTING FOR SMOOTHING
+C CONR12
+C       IXMAX,IYMAX-MAXINUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C       XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C CONR13
+C       XVS-ARRAY OF THE X COORD FOR SHIELDING
+C       YVS-ARRAY OF THE Y COORD FOR SHIELDING
+C       IXVST-POINTER (VIA LOC) TO THE USERS X ARRAY FOR SHIELDING
+C       IYVST-POINTER (VIA LOC) TO THE USERS Y ARRAY FOR SHIELDING
+C       ICOUNT-COUNT OF THE SHIELD ELEMENTS
+C       SPVAL-SPECIAL VALUE USED TO HALT CONTOURING AT THE SHIELD
+C               BOUNDRY
+C       SHIELD-LOGICAL FLAG TO SIGNAL STATUS OF SHIELDING
+C       SLDPLT-LOGICAL FLAG TO INDICTE STATUS OF SHIEDL PLOTTING
+C CONR14
+C       LINEAR-C1 LINAER INTERPOLATIN FLAG
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ    ,PV(210),
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER   ,MESS,
+     1                ISCALE     ,LOOK           ,PLDVLS  ,GRD,
+     2                CINC       ,CHILO         ,CON     ,LABON,
+     3                PMIMX      ,SCALE          ,FRADV  ,EXTRI,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED,
+     1                STPSZ      ,IGRAD          ,IG     ,XRG,
+     2                YRG        ,BORD       ,PXST       ,PYST,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ          ,INLAB  ,INDAT,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP         ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP              ,MXXY  ,TR,
+     1                BR         ,TL               ,BL   ,CONV,
+     2                XN         ,YN               ,ITLL      ,IBLL,
+     3                ITRL       ,IBRL       ,XC         ,YC,
+     4                ITLOC(210) ,JX              ,JY    ,ILOC ,
+     5                ISHFCT     ,XO         ,YO         ,IOC    ,NC
+      COMMON /CONR10/ NT         ,NL               ,NTNL       ,JWIPT,
+     1                JWIWL      ,JWIWP          ,JWIPL  ,IPR  ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX          ,XMAX   ,YMAX
+      LOGICAL         REPEAT       ,EXTRAP      ,PER     ,MESS,
+     1                LOOK       ,PLDVLS        ,GRD     ,LABON,
+     2                PMIMX      ,FRADV          ,EXTRI  ,CINC,
+     3                TITLE      ,LISTOP         ,CHILO  ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      logical first
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+        SAVE
+C
+C
+c +noao:  parameter added to avoid clobbering initialization done
+c by conop[1-4].  
+        data first /.true./
+        if (.not. first) return
+        first = .false.
+c -noao
+C
+c       DATA ICOUNT,SHIELD,SLDPLT,LINEAR/0,.FALSE.,.FALSE.,.FALSE./
+        ICOUNT = 0
+        SHIELD = .FALSE.
+        SLDPLT = .FALSE.
+        LINEAR = .FALSE.
+c
+c       DATA REPEAT,EXTRAP,PER/.FALSE.,.FALSE.,.TRUE./
+        REPEAT = .FALSE.
+        EXTRAP = .FALSE.
+        PER = .TRUE.
+c
+c       DATA FRADV,EXTRI,BPSIZ/.TRUE.,.FALSE.,0.0/
+        FRADV = .TRUE.
+        EXTRI = .FALSE.
+        BPSIZ = 0.0
+c
+c       DATA TITLE,MESS,LOOK/.FALSE.,.TRUE.,.FALSE./
+        TITLE = .FALSE.
+        MESS  = .TRUE.
+        LOOK  = .FALSE.
+c
+c       DATA PLDVLS,GRD/.FALSE.,.FALSE./
+        PLDVLS = .FALSE.
+        GRD     = .FALSE.
+c
+c       DATA CON,CINC,CHILO/.FALSE.,.FALSE.,.FALSE./
+        CON   = .FALSE.
+        CINC  = .FALSE.
+        CHILO = .FALSE.
+c
+c       DATA SCALE,PMIMX/1.,.FALSE./
+        SCALE = 1.
+        PMIMX = .FALSE.
+c
+c       DATA ISIZEP,ISIZEM,TENS/8,15,2.5/
+        ISIZEP = 8
+        ISIZEM = 15
+        TENS    = 2.5
+c
+c       DATA INMAJ,INMIN,INLAB,INDAT/1, 1, 1, 1/
+        INMAJ = 2
+        INMIN = 1
+        INLAB = 2
+        INDAT = 1
+c
+c       DATA IRANMJ, IRANMN, IRANTX /1, 1, 1/
+        IRANMJ = 2
+        IRANMN = 1
+        IRANTX = 1
+c
+c       DATA IRASMJ, IRASMN, IRASTX /1, 1, 1/
+        IRASMJ = 2
+        IRASMN = 1
+        IRASTX = 1
+c
+c       DATA IRAQMJ, IRAQMN, IRAQTX /1, 1, 1/
+        IRAQMJ = 2
+        IRAQMN = 1
+        IRAQTX = 1
+c
+c       DATA LABON/.TRUE./,LISTOP/.FALSE./
+        LABON   = .TRUE.
+        LISTOP = .FALSE.
+c
+c       DATA BORD,ITICK/.9,10/
+        BORD  = .9
+        ITICK = 10
+c
+c       DATA ISCALE,ITLSIZ/0,16/
+        ISCALE = 0
+        ITLSIZ = 16
+c
+c       DATA ITIPV,NIT,NCL/0,0,0/
+        ITIPV = 0
+        NIT   = 0
+        NCL   = 0
+c
+c       DATA NCPSZ/25/
+        NCPSZ = 25
+c
+c       DATA IHIGH/255/
+        IHIGH = 255
+c
+c       DATA NCP /4/
+        NCP  = 4
+c
+c       DATA IREC /1/
+        IREC  = 1
+c
+c       DATA LEN,IFMT,LEND,IFMTD/0,0,7,10/
+        LEN = 0
+        IFMT = 0
+        LEND = 7
+        IFMTD = 10
+c
+c       DATA IGRAD,IG/40,40/
+        IGRAD = 40
+        IG    = 40
+c
+c       DATA NREP,NCRT,ISIZEL,MXXY,MINGAP/6,3,9,500,3/
+        NREP = 6
+        NCRT = 3
+        ISIZEL = 9
+        MXXY = 500
+        MINGAP = 3
+c
+c       DATA IDASH(1:1)/' '/
+        IDASH(1:1) = ' '
+c
+c       DATA NDASH(1:1)/' '/
+        NDASH(1:1) = ' '
+c
+c       DATA EDASH(1:1)/' '/
+        EDASH(1:1) = ' '
+c
+c       DATA ISHFCT/9/
+        ISHFCT = 9
+c
+c - noao
+      END
diff --git a/sys/gio/ncarutil/conlib/README b/sys/gio/ncarutil/conlib/README
new file mode 100644
index 00000000..69f73877
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/README
@@ -0,0 +1,3 @@
+CONLIB -- This directory contains the contents of the NCAR files concom.f and
+conterp.f, unpacked one subroutine per file.  The unpacking operation is
+necessary to permit topological ordering of the library.
diff --git a/sys/gio/ncarutil/conlib/concal.f b/sys/gio/ncarutil/conlib/concal.f
new file mode 100644
index 00000000..e021fa30
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concal.f
@@ -0,0 +1,340 @@
+      SUBROUTINE CONCAL (XD,YD,ZD,NT,IPT,NL,IPL,PDD,ITI,XII,YII,ZII,
+     1                   ITPV)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE PERFORMS PUNCTUAL INTERPOLATION OR EXTRAPO-
+C LATION, I.E., DETERMINES THE Z VALUE AT A POINT.
+C THE INPUT PARAMETERS ARE
+C
+C     XD,YD,ZD = ARRAYS CONTAINING THE X, Y, AND Z
+C                COORDINATES OF DATA POINTS,
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           THE VERTEXES OF THE TRIANGLES,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           THE END POINTS OF THE BORDER LINE SEGMENTS AND
+C           THEIR RESPECTIVE TRIANGLE NUMBERS,
+C     PDD = ARRAY CONTAINING THE PARTIAL DERIVATIVES AT
+C           THE DATA POINTS,
+C     ITI = TRIANGLE NUMBER OF THE TRIANGLE IN WHICH LIES
+C           THE POINT FOR WHICH INTERPOLATION IS TO BE
+C           PERFORMED,
+C     XII,YII = X AND Y COORDINATES OF THE POINT FOR WHICH
+C               INTERPOLATION IS TO BE PERFORMED.
+C THE OUTPUT PARAMETER IS
+C
+C     ZII = INTERPOLATED Z VALUE.
+C
+C DECLARATION STATEMENTS
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)      ,IPT(1)     ,
+     1                IPL(1)     ,PDD(1)
+      DIMENSION       X(3)       ,Y(3)       ,Z(3)       ,PD(15)     ,
+     1                ZU(3)      ,ZV(3)      ,ZUU(3)     ,ZUV(3)     ,
+     2                ZVV(3)
+      REAL            LU         ,LV
+      EQUIVALENCE     (P5,P50)
+C
+        SAVE
+C
+C PRELIMINARY PROCESSING
+C
+      IT0 = ITI
+      NTL = NT+NL
+      IF (IT0 .LE. NTL) GO TO  100
+      IL1 = IT0/NTL
+      IL2 = IT0-IL1*NTL
+      IF (IL1 .EQ. IL2) GO TO  150
+      GO TO  200
+C
+C CALCULATION OF ZII BY INTERPOLATION.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  100 IF (IT0 .EQ. ITPV) GO TO  140
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE
+C IPI 102 VERTEXES.
+C IPI 103
+C
+      JIPT = 3*(IT0-1)
+      JPD = 0
+      DO  120 I=1,3
+         JIPT = JIPT+1
+         IDP = IPT(JIPT)
+         X(I) = XD(IDP)
+         Y(I) = YD(IDP)
+         Z(I) = ZD(IDP)
+         JPDD = 5*(IDP-1)
+         DO  110 KPD=1,5
+            JPD = JPD+1
+            JPDD = JPDD+1
+            PD(JPD) = PDD(JPDD)
+  110    CONTINUE
+  120 CONTINUE
+C
+C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
+C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
+C AND VICE VERSA.
+C
+      X0 = X(1)
+      Y0 = Y(1)
+      A = X(2)-X0
+      B = X(3)-X0
+      C = Y(2)-Y0
+      D = Y(3)-Y0
+      AD = A*D
+      BC = B*C
+      DLT = AD-BC
+      AP = D/DLT
+      BP = -B/DLT
+      CP = -C/DLT
+      DP = A/DLT
+C
+C CONVERTS THE PARTIAL DERIVATIVES AT THE VERTEXES OF THE
+C TRIANGLE FOR THE U-V COORDINATE SYSTEM.
+C
+      AA = A*A
+      ACT2 = 2.0*A*C
+      CC = C*C
+      AB = A*B
+      ADBC = AD+BC
+      CD = C*D
+      BB = B*B
+      BDT2 = 2.0*B*D
+      DD = D*D
+      DO  130 I=1,3
+         JPD = 5*I
+         ZU(I) = A*PD(JPD-4)+C*PD(JPD-3)
+         ZV(I) = B*PD(JPD-4)+D*PD(JPD-3)
+         ZUU(I) = AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
+         ZUV(I) = AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
+         ZVV(I) = BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
+  130 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = ZU(1)
+      P01 = ZV(1)
+      P20 = 0.5*ZUU(1)
+      P11 = ZUV(1)
+      P02 = 0.5*ZVV(1)
+      H1 = Z(2)-P00-P10-P20
+      H2 = ZU(2)-P10-ZUU(1)
+      H3 = ZUU(2)-ZUU(1)
+      P30 = 10.0*H1-4.0*H2+0.5*H3
+      P40 = -15.0*H1+7.0*H2-H3
+      P50 = 6.0*H1-3.0*H2+0.5*H3
+      H1 = Z(3)-P00-P01-P02
+      H2 = ZV(3)-P01-ZVV(1)
+      H3 = ZVV(3)-ZVV(1)
+      P03 = 10.0*H1-4.0*H2+0.5*H3
+      P04 = -15.0*H1+7.0*H2-H3
+      P05 = 6.0*H1-3.0*H2+0.5*H3
+      LU = SQRT(AA+CC)
+      LV = SQRT(BB+DD)
+      THXU = ATAN2(C,A)
+      THUV = ATAN2(D,B)-THXU
+      CSUV = COS(THUV)
+      P41 = 5.0*LV*CSUV/LU*P50
+      P14 = 5.0*LU*CSUV/LV*P05
+      H1 = ZV(2)-P01-P11-P41
+      H2 = ZUV(2)-P11-4.0*P41
+      P21 = 3.0*H1-H2
+      P31 = -2.0*H1+H2
+      H1 = ZU(3)-P10-P11-P14
+      H2 = ZUV(3)-P11-4.0*P14
+      P12 = 3.0*H1-H2
+      P13 = -2.0*H1+H2
+      THUS = ATAN2(D-C,B-A)-THXU
+      THSV = THUV-THUS
+      AA = SIN(THSV)/LU
+      BB = -COS(THSV)/LU
+      CC = SIN(THUS)/LV
+      DD = COS(THUS)/LV
+      AC = AA*CC
+      AD = AA*DD
+      BC = BB*CC
+      G1 = AA*AC*(3.0*BC+2.0*AD)
+      G2 = CC*AC*(3.0*AD+2.0*BC)
+      H1 = -AA*AA*AA*(5.0*AA*BB*P50+(4.0*BC+AD)*P41)-
+     1     CC*CC*CC*(5.0*CC*DD*P05+(4.0*AD+BC)*P14)
+      H2 = 0.5*ZVV(2)-P02-P12
+      H3 = 0.5*ZUU(3)-P20-P21
+      P22 = (G1*H2+G2*H3-H1)/(G1+G2)
+      P32 = H2-P22
+      P23 = H3-P22
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  140 DX = XII-X0
+      DY = YII-Y0
+      U = AP*DX+BP*DY
+      V = CP*DX+DP*DY
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*(P02+V*(P03+V*(P04+V*P05))))
+      P1 = P10+V*(P11+V*(P12+V*(P13+V*P14)))
+      P2 = P20+V*(P21+V*(P22+V*P23))
+      P3 = P30+V*(P31+V*P32)
+      P4 = P40+V*P41
+      ZII = P0+U*(P1+U*(P2+U*(P3+U*(P4+U*P5))))
+      RETURN
+C
+C CALCULATION OF ZII BY EXTRATERPOLATION IN THE RECTANGLE.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  150 IF (IT0 .EQ. ITPV) GO TO  190
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE END
+C POINTS OF THE BORDER LINE SEGMENT.
+C
+      JIPL = 3*(IL1-1)
+      JPD = 0
+      DO  170 I=1,2
+         JIPL = JIPL+1
+         IDP = IPL(JIPL)
+         X(I) = XD(IDP)
+         Y(I) = YD(IDP)
+         Z(I) = ZD(IDP)
+         JPDD = 5*(IDP-1)
+         DO  160 KPD=1,5
+            JPD = JPD+1
+            JPDD = JPDD+1
+            PD(JPD) = PDD(JPDD)
+  160    CONTINUE
+  170 CONTINUE
+C
+C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
+C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
+C AND VICE VERSA.
+C
+      X0 = X(1)
+      Y0 = Y(1)
+      A = Y(2)-Y(1)
+      B = X(2)-X(1)
+      C = -B
+      D = A
+      AD = A*D
+      BC = B*C
+      DLT = AD-BC
+      AP = D/DLT
+      BP = -B/DLT
+      CP = -BP
+      DP = AP
+C
+C CONVERTS THE PARTIAL DERIVATIVES AT THE END POINTS OF THE
+C BORDER LINE SEGMENT FOR THE U-V COORDINATE SYSTEM.
+C
+      AA = A*A
+      ACT2 = 2.0*A*C
+      CC = C*C
+      AB = A*B
+      ADBC = AD+BC
+      CD = C*D
+      BB = B*B
+      BDT2 = 2.0*B*D
+      DD = D*D
+      DO  180 I=1,2
+         JPD = 5*I
+         ZU(I) = A*PD(JPD-4)+C*PD(JPD-3)
+         ZV(I) = B*PD(JPD-4)+D*PD(JPD-3)
+         ZUU(I) = AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
+         ZUV(I) = AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
+         ZVV(I) = BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
+  180 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = ZU(1)
+      P01 = ZV(1)
+      P20 = 0.5*ZUU(1)
+      P11 = ZUV(1)
+      P02 = 0.5*ZVV(1)
+      H1 = Z(2)-P00-P01-P02
+      H2 = ZV(2)-P01-ZVV(1)
+      H3 = ZVV(2)-ZVV(1)
+      P03 = 10.0*H1-4.0*H2+0.5*H3
+      P04 = -15.0*H1+7.0*H2-H3
+      P05 = 6.0*H1-3.0*H2+0.5*H3
+      H1 = ZU(2)-P10-P11
+      H2 = ZUV(2)-P11
+      P12 = 3.0*H1-H2
+      P13 = -2.0*H1+H2
+      P21 = 0.0
+      P23 = -ZUU(2)+ZUU(1)
+      P22 = -1.5*P23
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  190 DX = XII-X0
+      DY = YII-Y0
+      U = AP*DX+BP*DY
+      V = CP*DX+DP*DY
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*(P02+V*(P03+V*(P04+V*P05))))
+      P1 = P10+V*(P11+V*(P12+V*P13))
+      P2 = P20+V*(P21+V*(P22+V*P23))
+      ZII = P0+U*(P1+U*P2)
+      RETURN
+C
+C CALCULATION OF ZII BY EXTRATERPOLATION IN THE TRIANGLE.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  200 IF (IT0 .EQ. ITPV) GO TO  220
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE VERTEX
+C OF THE TRIANGLE.
+C
+      JIPL = 3*IL2-2
+      IDP = IPL(JIPL)
+      X(1) = XD(IDP)
+      Y(1) = YD(IDP)
+      Z(1) = ZD(IDP)
+      JPDD = 5*(IDP-1)
+      DO  210 KPD=1,5
+         JPDD = JPDD+1
+         PD(KPD) = PDD(JPDD)
+  210 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = PD(1)
+      P01 = PD(2)
+      P20 = 0.5*PD(3)
+      P11 = PD(4)
+      P02 = 0.5*PD(5)
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  220 U = XII-X(1)
+      V = YII-Y(1)
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*P02)
+      P1 = P10+V*P11
+      ZII = P0+U*(P1+U*P20)
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concld.f b/sys/gio/ncarutil/conlib/concld.f
new file mode 100644
index 00000000..6829d5fe
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concld.f
@@ -0,0 +1,314 @@
+      SUBROUTINE CONCLD (ICASE,IOOP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      INTEGER GOOP
+C
+        SAVE
+        DATA GOOP/0/
+C
+C  STATEMENT FUNCTIONS FOR CONTOUR PLACEMENT WITHIN CELLS
+C
+      CX(W1,W2) = STPSZ*( (W1-CONV)/(W1-W2) )
+      CY(W1,W2) = STPSZ*( (W1-CONV)/(W1-W2) )
+      IC = ICASE
+      ICASE = 0
+C
+C  SPECIAL PROCESSING IF SHIELDING ACTIVATED
+C
+      IF (.NOT.SHIELD) GO TO 1
+C
+C  CHECK IF ANY CELL CORNER CONTAINS A SPECIAL VALUE
+C       IF SO THEN FLAG AND RETURN
+C
+      IF (TR.NE.SPVAL.AND.BR.NE.SPVAL.AND.TL.NE.SPVAL.AND.BL.NE.SPVAL)
+     1      GO TO 1
+C
+C  SPECIAL VALUE IN CELL FLAG AND RETURN
+C
+      ICASE = -1
+      RETURN
+C
+C  IF CURRENT BR VALUE LESS THAN CONTOUR THEN NEIGHBOR WILL BE WHERE
+C  CONTOUR IS DRAWN.
+C
+ 1    CONTINUE
+C
+      IF (BR.LT.CONV) GO TO    90
+C
+C  CURRENT LOCATION IS WHERE CONTOUR WILL BE DRAWN
+C
+C  TEST FOR VERTICAL CONTOUR BREAK
+C
+      IF (BL.GE.CONV) GO TO    60
+C
+C  VERTICAL CONTOUR BREAK
+C
+C  CASE 1 LEFT NEIGHBOR LESS THAN CONTOUR LEVEL AND CURRENT
+C  LOCATION GE CONTOUR VALUE
+C
+      IF (TR.GE.CONV) GO TO    40
+C
+C  CASE 1A CONTOUR LOWER RIGHT
+C
+C
+C  CONTOUR FROM UPPER RIGHT
+C
+      XO = XC-CX(BR,TR)
+      YO = YC
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 4
+      IF (IC.NE.3) GO TO    10
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+   10 IF (IOOP.NE.GOOP) GO TO    20
+      IF (IC.NE.2) GO TO    30
+   20 ICASE = NC
+      RETURN
+C
+C CASE 1B  CONTOR UPPER LEFT
+C
+   30 XN = XC-STPSZ
+      YN = YC-STPSZ+CY(TL,TR)
+      XO = XC-STPSZ+CX(TL,BL)
+      YO = YC-STPSZ
+      IOC = 2
+      NC = 3
+      GO TO   180
+C
+C  CONTOURS FROM ABOVE AND UPPER LEFT
+C
+   40 IF (TL.LT.CONV) GO TO    50
+C
+C  CASE 1C CONTOUR LOWER LEFT
+C
+      XO = XC-STPSZ+CX(TL,BL)
+      YO = YC-STPSZ
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 2
+      GO TO   180
+C
+C CASE 1D CONTOUR FROM ABOVE
+C
+   50 XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 3
+      GO TO   180
+C
+C
+C  TEST FOR HORIZONTAL CONTOUR BREAK
+C
+   60 IF (TR.LT.CONV) GO TO    70
+      IF (TL.GE.CONV) GO TO   200
+C
+C  CASE 2A CONTOUR UPPER LEFT
+C
+      XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-CX(BL,TL)
+      YN = YC-STPSZ
+      NC = 2
+      IOC = 3
+      GO TO   180
+C
+   70 IF (TL.LT.CONV) GO TO    80
+C
+C  CASE 2B CONTOUR FROM UPPER RIGHT
+C
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      XN = XC-CX(BR,TR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+C  CASE 2C CONTOUR FROM LEFT TO RIGHT
+C
+   80 XO = XC-CX(BL,TL)
+      YO = YC-STPSZ
+      XN = XC-CX(BR,TR)
+      YN = YC
+      NC = 4
+      IOC = 2
+      GO TO   180
+C
+C
+C  CURRENT BR VALUE LESS THAN CONTOUR
+C
+C
+   90 IF (BL.LT.CONV) GO TO   150
+C
+C  VERTICAL CONTOUR BREAK
+C
+C  CASE 3 CURRENT SPACE LESS THAN CONTOUR LEVEL AND LEFT
+C  NEIGHBOR GE CONTOUR LEVEL
+C
+      IF (TL.GE.CONV) GO TO   130
+C
+C  CASE 3A CONTOUR LOWER LEFT
+C
+      XO = XC-CX(BL,TL)
+      YO = YC-STPSZ
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 2
+      IF (IC.NE.3) GO TO   100
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+  100 IF (IOOP.NE.GOOP) GO TO   110
+      IF (IC.NE.4) GO TO   120
+  110 ICASE = NC
+      RETURN
+C
+C  CASE 3B CONTOUR UPPERRIGHT
+C
+  120 XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+  130 IF (TR.GE.CONV) GO TO   140
+C
+C  CASE 3C CONTOUR FROM ABOVE
+C
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 3
+      GO TO   180
+C
+C  CASE 3D CONTOUR LOWER RIGHT
+C
+  140 XO = XC-STPSZ+CX(TR,BR)
+      YO = YC
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 4
+      GO TO   180
+C
+C
+C
+C  TEST FOR HORIZONTAL BREAK POINT
+C
+  150 IF (TR.GE.CONV) GO TO   160
+C
+      IF (TL.LT.CONV) GO TO   200
+C
+C  CASE 4A CONTOUR UPPER LEFT
+C
+      XN = XC-STPSZ+CX(TL,BL)
+      YN = YC-STPSZ
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      NC = 2
+      IOC = 3
+      GO TO   180
+C
+  160 IF (TL.GE.CONV) GO TO   170
+C
+C  CASE 4B CONTOUR UPPER RIGHT
+C
+      XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+C  CASE 4C CONTOUR FROM LEFT TO RIGHT
+C
+  170 YO = YC-STPSZ
+      XO = XC-STPSZ+CX(TL,BL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 2
+C
+C  DRAW THE CONTOUR LINES NOT ALREADY TAKEN CARE OF
+C
+  180 IF (IABS(IC-NC).NE.2) GO TO   190
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+  190 ICASE = NC
+  200 RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concls.f b/sys/gio/ncarutil/conlib/concls.f
new file mode 100644
index 00000000..02d97a4d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concls.f
@@ -0,0 +1,177 @@
+      SUBROUTINE CONCLS (ZD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  GENERATE CONTOUR LEVELS BASED ON THE INPUT DATA
+C
+      DIMENSION       ZD(1)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      SAVE
+C
+C  IF NOT USER SET COMPUTE CONTOUR LEVELS
+C
+      IF (.NOT.CON) GO TO  150
+C
+C  OTHERWISE GET HI AND LOW CONTOURS FOR MESSAGE
+C
+      HI = CL(1)
+      FLO = CL(1)
+      DO  110 I=1,NCL
+         IF (HI .GE. CL(I)) GO TO  100
+         HI = CL(I)
+         GO TO  110
+  100    IF (FLO .LE. CL(I)) GO TO  110
+         FLO = CL(I)
+  110 CONTINUE
+C
+C GET INCREMENT IF EQUAL SPACED CONTOURS
+C
+      IF (NCL .NE. 1) GO TO  120
+      FINC = 0.
+      RETURN
+  120 FINC = ABS(CL(1)-CL(2))
+      IF (NCL .EQ. 2) RETURN
+      DO  130 I=3,NCL
+         IF (FINC .NE. ABS(CL(I-1)-CL(I))) GO TO  140
+  130 CONTINUE
+      RETURN
+  140 FINC = -1.
+      RETURN
+C
+C  FIND HIGHEST AND LOWEST INPUT VALUES
+C
+  150 IF (CHILO) GO TO  180
+      FLO = ZD(1)
+      HI = ZD(1)
+      DO  170 I=2,NDP
+         IF (FLO .LE. ZD(I)) GO TO  160
+         FLO = ZD(I)
+         GO TO  170
+  160    IF (HI .GE. ZD(I)) GO TO  170
+         HI = ZD(I)
+  170 CONTINUE
+C
+C  CALCULATE THE CONTOUR LEVEL INTERVAL
+C
+  180 IF (CINC) GO TO  200
+      FINC = (HI-FLO)/15.
+      IF (FINC .NE. 0.) GO TO  190
+      CALL SETER (' CONCLS - CONSTANT INPUT FIELD',1,1)
+      RETURN
+C
+C  ROUND FINC TO NICE NUMBER
+C
+  190 P = 10.**(IFIX(ALOG10(FINC)+500.)-500)
+      FINC = AINT(FINC/P+0.1)*P
+C
+C  ROUND THE LOW VALUE TO START AT A NICE NUMBER
+C
+  200 IF (CHILO) GO TO  210
+      FLO = AINT(FLO/FINC)*FINC
+C
+C  COMPUTE THE CONTOUR LEVELS
+C
+C  TEST IF BREAK POINT WITHIN RANGE OF HI TO FLO
+C
+  210 IF (BPSIZ.GE.FLO .AND. BPSIZ.LE.HI) GO TO  240
+C
+C  BREAK POINT OUT OF RANGE SO GENERATE CONTOURS BASED ON FLO
+C
+      DO  220 I=1,30
+         CV = FLO+FLOAT(I-1)*FINC
+         ICUR = I
+         CL(I) = CV
+         IF (CV .GE. HI) GO TO  230
+  220 CONTINUE
+  230 NCL = ICUR
+      HI = CV
+      RETURN
+C
+C  BREAK POINT WITHIN RANGE SO BASE CONTOURS ON IT
+C
+  240 DO  250 I=1,30
+         CV = BPSIZ-FLOAT(I-1)*FINC
+         IND = (30-I)+1
+         CL(IND) = CV
+         ICUR = I
+         IF (CV .LE. FLO) GO TO  260
+  250 CONTINUE
+C
+C  PUT THE CONTOURS IN THE CORRECT ORDER
+C
+  260 DO  270 I=1,ICUR
+         IND = (30-ICUR)+I
+         CL(I) = CL(IND)
+  270 CONTINUE
+C
+C  ADD THE GREATER THAN BREAK POINT CONTOURS
+C
+      IEND = 30-ICUR
+      ISAV = ICUR+1
+      DO  280 I=1,IEND
+         CV = BPSIZ+FLOAT(I)*FINC
+         CL(ISAV) = CV
+         ISAV = ISAV+1
+         IF (CV .GE. HI) GO TO  290
+  280 CONTINUE
+C
+C  SET NUMBER OF CONTOUR LEVELS AND UPDATE THE HIGH VALUE
+C
+  290 NCL = ISAV-1
+      HI = CV
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concom.f b/sys/gio/ncarutil/conlib/concom.f
new file mode 100644
index 00000000..8a5041df
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concom.f
@@ -0,0 +1,78 @@
+      FUNCTION CONCOM (XQ,YQ,XD,YD,ZD,NDP,WK,IWK,LOC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  INTERPOLATE A GIVEN X,Y PAIR AND RETURN ITS LOCATION
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)      ,WK(1)      ,
+     1                IWK(1)
+C
+        SAVE
+C
+C LOCATE PROPER TRIANGLE
+C
+      CALL CONLOC (NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),XQ,YQ,LOC,
+     1             IWK(JWIWL),WK)
+C
+C  INTERPOLATE THE LOCATION
+C
+      CALL CONCAL (XD,YD,ZD,NT,IWK(JWIPT),NL,IWK(JWIPL),WK(IPR),LOC,XQ,
+     1             YQ,TEMP,ITPV)
+      CONCOM = TEMP
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condet.f b/sys/gio/ncarutil/conlib/condet.f
new file mode 100644
index 00000000..6b3a3077
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condet.f
@@ -0,0 +1,128 @@
+      SUBROUTINE CONDET (NDP,XD,YD,NCP,IPC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C******************************************************************
+C*                                                                *
+C*   THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB      *
+C*   FILES CONRAN , CONRAQ AND CONRAS.  SEE THOSE FILES FOR AN    *
+C*   EXPLAINATION OF THE ENTRY POINTS.                            *
+C*                                                                *
+C******************************************************************
+C
+C THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST
+C TO EACH OF THE DATA POINT.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD = ARRAYS CONTAINING THE X AND Y COORDINATES
+C             OF DATA POINTS,
+C     NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA
+C           POINTS.
+C THE OUTPUT PARAMETER IS
+C     IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE
+C           POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
+C           EACH OF THE NDP DATA POINTS ARE TO BE STORED.
+C THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST
+C NOT EXCEED 25 WITHOUT MODIFICATION TO THE ARRAYS DSQ0 AND IPC0.
+C DECLARATION STATEMENTS
+C
+      COMMON /CONRA3/ IREC
+      DIMENSION       XD(NDP)    ,YD(NDP)    ,IPC(1)
+      DIMENSION       DSQ0(25)   ,IPC0(25)
+C
+        SAVE
+C
+C STATEMENT FUNCTION
+C
+      DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
+C
+C CALCULATION
+C
+      DO  220 IP1=1,NDP
+C
+C - SELECTS NCP POINTS.
+C
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         J1 = 0
+         DSQMX = 0.0
+         DO  110 IP2=1,NDP
+            IF (IP2 .EQ. IP1) GO TO  110
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            J1 = J1+1
+            DSQ0(J1) = DSQI
+            IPC0(J1) = IP2
+            IF (DSQI .LE. DSQMX) GO TO  100
+            DSQMX = DSQI
+            JMX = J1
+  100       IF (J1 .GE. NCP) GO TO  120
+  110    CONTINUE
+  120    IP2MN = IP2+1
+         IF (IP2MN .GT. NDP) GO TO  150
+         DO  140 IP2=IP2MN,NDP
+            IF (IP2 .EQ. IP1) GO TO  140
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            IF (DSQI .GE. DSQMX) GO TO  140
+            DSQ0(JMX) = DSQI
+            IPC0(JMX) = IP2
+            DSQMX = 0.0
+            DO  130 J1=1,NCP
+               IF (DSQ0(J1) .LE. DSQMX) GO TO  130
+               DSQMX = DSQ0(J1)
+               JMX = J1
+  130       CONTINUE
+  140    CONTINUE
+C
+C - CHECKS IF ALL THE NCP+1 POINTS ARE COLLINEAR.
+C
+  150    IP2 = IPC0(1)
+         DX12 = XD(IP2)-X1
+         DY12 = YD(IP2)-Y1
+         DO  160 J3=2,NCP
+            IP3 = IPC0(J3)
+            DX13 = XD(IP3)-X1
+            DY13 = YD(IP3)-Y1
+            IF ((DY13*DX12-DX13*DY12) .NE. 0.0) GO TO  200
+  160    CONTINUE
+C
+C - SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT.
+C
+         NCLPT = 0
+         DO  190 IP3=1,NDP
+            IF (IP3 .EQ. IP1) GO TO  190
+            DO  170 J4=1,NCP
+               IF (IP3 .EQ. IPC0(J4)) GO TO  190
+  170       CONTINUE
+            DX13 = XD(IP3)-X1
+            DY13 = YD(IP3)-Y1
+            IF ((DY13*DX12-DX13*DY12) .EQ. 0.0) GO TO  190
+            DSQI = DSQF(X1,Y1,XD(IP3),YD(IP3))
+            IF (NCLPT .EQ. 0) GO TO  180
+            IF (DSQI .GE. DSQMN) GO TO  190
+  180       NCLPT = 1
+            DSQMN = DSQI
+            IP3MN = IP3
+  190    CONTINUE
+         DSQMX = DSQMN
+         IPC0(JMX) = IP3MN
+C
+C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY.
+C
+  200    J1 = (IP1-1)*NCP
+         DO  210 J2=1,NCP
+            J1 = J1+1
+            IPC(J1) = IPC0(J2)
+  210    CONTINUE
+  220 CONTINUE
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condrw.f b/sys/gio/ncarutil/conlib/condrw.f
new file mode 100644
index 00000000..df47eae9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condrw.f
@@ -0,0 +1,253 @@
+      SUBROUTINE CONDRW (SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW ALL CONTOURS AT THIS LEVEL
+C  IF NOT EXTRAPOLATING
+C         SEARCH CONVEX HULL FOR CONTOURS INTERSECTING IT AND DRAW THEM
+C         SEARCH INTERIOR AND DRAW ALL REMAINING UNDRAWN CONTOURS
+C
+C  IF EXTRAPOLATING
+C         SEARCH FROM X START TO X END AND Y START TO Y END FOR ALL
+C         CONTOURS AT THIS LEVEL
+C
+C  INPUT
+C       SCRARR SCRATCH ARRAY USED FOR FAST CONTOURING
+C       VIA COMMON BLOCKS BELOW
+C           CONV-THE CURRENT CONTOUR LEVEL
+C           ITLOC-THE CONVEX HULL BOUNDRIES RELATIVE TO THE SCRATCH
+C                 ARRAY, SCRARR
+C           PV-REAL Y COOORDINATES OF THE CONVEX HULL RELATIVE TO THE
+C                 USERS COORDINATE SPACE
+C           IXMAX,IYMAX-MAXINUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C           XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C
+C  OUTPUT
+C    CONTOUR LINES OUTPUT TO PLOTTER FILE
+C
+C  NOTE
+C       THIS ROUTINE WILL DETECT AND CORRECT FOR CONRAN ERROR 9
+C
+      DIMENSION       SCRARR(1)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+        SAVE
+C
+C
+C  FLAGS TO ALLOW COMPRESSION OF CONTOUR STORAGE IF IT IS EXAUSTED
+C
+        DATA ICOMP,NOCOMP/1,0/
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  CLEAR THE CONTOUR STORAGE LIST
+C
+      NP = 0
+C
+C  SCAN X BOARDERS FOR INTERSECTIONS
+C
+      JX = 2
+      ICASE = 1
+      X = XST+STPSZ
+C
+C  IF NOT EXTRAPOLATING BRANCH
+C
+   10 IF (.NOT.EXTRAP) GO TO    20
+      JY = 2
+      JYE = IYMAX
+      Y = YST+STPSZ
+      GO TO    30
+C
+C  NOT EXTRAPOLATING
+C
+   20 JY = ITLOC(JX*2-1)
+      IF (JY.EQ.0) GO TO    60
+      JYE = ITLOC(JX*2)+1
+      IF (JYE.GT.IYMAX) JYE = IYMAX
+      Y = PV(JX*2-1)
+      IF (JY.GE.2) GO TO 30
+      JY = 2
+      Y = YST+STPSZ
+   30 TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+   40 TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,NOCOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO    50
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+   50 TL = TR
+      BL = BR
+      JY = JY+1
+      Y = Y+STPSZ
+      IF (JY.LE.JYE) GO TO    40
+   60 IF (JX.EQ.IXMAX) GO TO    70
+      JX = IXMAX
+      ICASE = 3
+      X = XMAX
+      GO TO    10
+C
+C  SCAN Y BOARDERS
+C
+   70 IPOS = 1
+      ICASE = 4
+   80 JX = 3
+      X = XST+STPSZ+STPSZ
+C
+C  IF NOT EXTRAPOLATING BRANCH
+C
+   90 IF (.NOT.EXTRAP) GO TO   100
+      JY = 2
+      Y = YST+STPSZ
+      IF (IPOS.NE.0) GO TO   110
+      JY = IYMAX
+      Y = YED
+      GO TO   110
+C
+C  NOT EXTRAPOLATING
+C
+ 100    JY = ITLOC(JX*2 - IPOS )
+      IF (JY.EQ.0) GO TO   120
+        JY = JY + IPOS
+      Y = PV(JX*2 - IPOS) + STPSZ*(1*IPOS)
+  110 TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+      TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,NOCOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO   120
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+  120 JX = JX+1
+      X = X+STPSZ
+      IF (JX.LE.IXMAX-1) GO TO    90
+      IF (IPOS.EQ.0) GO TO   130
+      IPOS = 0
+      ICASE = 2
+      GO TO    80
+C
+C  BOARDER SEARCH DONE CONTOUR INTERIOR
+C
+C  INITIALIZE THE SEARCH
+C
+  130 JX = 3
+      ICASE = 0
+      X = XST+STPSZ+STPSZ
+      JXE = IXMAX-1
+C
+C  IF EXTRAPOLATING GO FROM BORDER TO BORDER
+C
+  140 IF (.NOT.EXTRAP) GO TO   150
+      JY = 3
+      JYE = IYMAX-1
+      Y = YST+STPSZ+STPSZ
+      GO TO   160
+C
+C  NOT EXTRAPOLATING STAY IN HULL
+C
+  150 JY = ITLOC(JX*2 - 1)+2
+      IF (JY.EQ.2) GO TO   190
+      JYE = ITLOC(JX*2)-1
+      Y = PV(JX*2 - 1)+STPSZ+STPSZ
+C
+  160 IF (JY.GT.JYE) GO TO   190
+      TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+  170 TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,ICOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO   180
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+  180 JY = JY+1
+      Y = Y+STPSZ
+      TL = TR
+      BL = BR
+      IF (JY.LE.JYE) GO TO   170
+C
+C  PROCESS EACH ROW OF INTERIOR
+C
+  190 X = X+STPSZ
+      JX = JX+1
+      IF (JX.LE.JXE) GO TO   140
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condsd.f b/sys/gio/ncarutil/conlib/condsd.f
new file mode 100644
index 00000000..0ea5fb43
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condsd.f
@@ -0,0 +1,54 @@
+      SUBROUTINE CONDSD
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW THE OUTLINE OF THE SHIELD ON THE PLOT
+C
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+        SAVE
+C
+C  GET THE START POINT
+C
+      XS = XVS(1)
+      YS = YVS(1)
+C
+C  MOVE TO THE START OF THE OUTLINE
+C
+      CALL FL2INT(XS,YS,IX,IY)
+      CALL PLOTIT(IX,IY,0)
+C
+C  LOOP FOR ALL SHIELD ELEMENTS
+C
+      DO 100 IC = 2,ICOUNT
+C
+C       DRAW THE OUTLINE OF THE SHIELD
+C
+        CALL FL2INT(XVS(IC),YVS(IC),IX,IY)
+        CALL PLOTIT(IX,IY,1)
+C
+ 100  CONTINUE
+C
+C  DRAW TO THE START
+C
+      CALL FL2INT(XS,YS,IX,IY)
+      CALL PLOTIT(IX,IY,1)
+C
+C  FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conecd.f b/sys/gio/ncarutil/conlib/conecd.f
new file mode 100644
index 00000000..56d8a934
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conecd.f
@@ -0,0 +1,178 @@
+      SUBROUTINE CONECD (VAL,IOUT,NUSED)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  ENCODE A NUMBER IN THE LEAST AMOUNT OF SPACE
+C  ON INPUT
+C       VAL THE NUMBER TO BE ENCODED
+C  ON OUTPUT
+C       IOUT CHARACTER STRING FILLED WITH THE ENCODED RESULT, MUST BE ABLE TO
+C            HOLD UP TO 9 CHARACTERS.
+C
+C     NUSED NUMBER OF CHARACTERS IN IOUT
+C
+C  VALUE INPUT WILL BE SCALED BY SCALE IN CONRA2
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+        CHARACTER*(*)   IOUT
+        CHARACTER*6     IFMT1
+C
+C +NOAO - Variables CHTMP and IT are not used.
+C
+C       CHARACTER*9     CHTMP
+C       CHARACTER*1     IT
+C
+C -NOAO
+C
+        SAVE
+C
+      V = VAL
+C
+C  IF VAL EQUALS ZERO EASY PROCESSING
+C
+      IF (V.NE.0.) GO TO    20
+        IOUT = '0.0'
+      NUSED = 3
+      RETURN
+C
+C  SCALE VALUE
+C
+   20 V = V*SCALE
+C
+C  GET SIZE OF NUMBER
+C
+      LOG = IFIX(ALOG10(ABS(V))+.1)
+      IF (IABS(LOG).GT.4) GO TO    60
+C
+C  COMPUTE FLOATING POINT FIELD
+C
+      NS = IABS(LOG)+3
+      ND = 1
+      IF (LOG.GT.0) GO TO    40
+C
+C  LOG = 0 TEST FOR FRACTIONAL PART ONLY
+C
+      IF (ALOG10( ABS(V) ).GE.0.) GO TO    30
+C
+C  NUMBER LT 1 BUT GREATER THAN ZERO IN ABSOLUTE VALUE
+C
+      NS = 4
+      ND = 1
+      GO TO    40
+C
+C  NUMBER LESS THAN 10 BUT GE 1
+C
+   30 ND = 1
+      NS = 4
+C
+C  BUILD THE FORMAT
+C
+   40 IF (V.LT.0) NS = NS+1
+        IFMT1 = '(F . )'
+C
+C  INSERT THE FLOATING POINT FORMAT SIZE
+C
+C +NOAO - Scheme for creating format has been modified because it uses
+C         FTN internal writes.  NOAO mods are written in lower case.
+C
+C       WRITE(IT,'(I1)')NS
+C       IFMT1(3:3) = IT
+C       WRITE(IT,'(I1)')ND
+C       IFMT1(5:5) = IT
+C
+	ifmt1(1:6) = '(f . )'
+	ifmt1(3:3) = char (ns + ichar ('0') + 1)
+	ifmt1(5:5) = char (nd + ichar ('0'))
+C
+C  ENCODE THE DESIRED NUMBER
+C
+C       WRITE(CHTMP,IFMT1)V
+C       IOUT = CHTMP
+C
+        call encode (ns, ifmt1, iout, v)
+
+      NUSED = NS
+      RETURN
+C
+C  DATA LARGER THAN A NICE SIZE FORCE IT TO BE ENCODED
+C
+C 60  WRITE(CHTMP,'(E8.3)')V
+C     IOUT = CHTMP
+C
+  60  call encode (8, '(E8.3)', iout, v)
+C
+C -NOAO
+      NUSED = 8
+      RETURN
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONCOM TO ULIB                              *
+C*  AUGUST 1980 FIXED BOARDER CONTOUR DETECTION                   *
+C*  DECEMBER 1980 FIXED ERROR TRAP, CONTOUR REORDERING ALGORITHM  *
+C*                AND ERROR MESSAGE 10                            *
+C*  AUGUST 1983 ADDED LINEAR INTERPOLATION AND SHIELDING          *
+C*  JULY 1984 CONVERTED TO FORTRAN77 AND GKS                      *
+C*  AUGUST 1985 DELETED (MACHINE DEPENDENT) FUNCTION LOC; CHANGED *
+C*              COMMON /CONR13/                                   *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/congen.f b/sys/gio/ncarutil/conlib/congen.f
new file mode 100644
index 00000000..c70cfe05
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/congen.f
@@ -0,0 +1,454 @@
+      SUBROUTINE CONGEN (XI,YI,IPACK,SCRARR,ICA)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW A CONTOUR AT THE CURRENT LEVEL
+C
+C  INPUT
+C       XI YI LOWER RIGHT CORNER OF CELL
+C       IPACK-FLAG TO ALLOW REDUCTION OF COORDINATE PAIR STORAGE
+C             IF REQUIRED
+C       SCRARR-SCRATCH ARRAY OF CONTOUR VALUES
+C       ICA-ENTERING CASE CONDITIONS IF ANY REQUIRED
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+      DIMENSION       SCRARR(1)  ,IXMOV(2)   ,IYMOV(2)
+        CHARACTER*64    IHOLD
+        CHARACTER*23    IVOUT
+      INTEGER         GOOP
+C
+        SAVE
+        DATA NOOP,GOOP/1,0/
+C
+C  STATEMENT FUNCTIONS FOR MAPPING GRAPHICS OUTPUT
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  DRAW AN ENTIRE CONTOUR LINE WHEN A POTENTIAL START POINT IS
+C  PROVIDED
+C
+C  SAVE STARTING CELL
+C
+      XCS = XI
+      YCS = YI
+C
+C  TEST IF VALID START POINT
+C
+      ICASE = ICA
+      XC = XI
+      YC = YI
+      CALL CONCLD (ICASE,NOOP)
+C
+C  IF NO CONTOUR RETURN
+C
+      IF (ICASE.EQ.-1) RETURN
+      IF (ICASE.EQ.0) RETURN
+C
+C  IF CONTOUR ALREADY DRAWN RETURN
+C
+      ILOC = IOR(ISHIFT(JX,ISHFCT),JY)
+      IF (NP.EQ.0) GO TO    20
+C
+C TEST IF CONTOUR FOUND
+C
+          DO    10 I=1,NP
+          IF (ILOC.NE.ICOORD(I)) GO TO    10
+          RETURN
+   10     CONTINUE
+C
+C  GET CORRECT OLD CASE
+C
+   20 IC = IOC
+      IF (ICASE.EQ.IOC) IC = NC
+C
+C  SET UP STRUCTURE TO START IN OTHER DIRECTION FROM HERE IF CONTOUR
+C  UNEXPECTLY ENDS IN THIS DIRECTION
+C
+      IFCASE = IC
+      IFOCSE = ICASE
+      FXO = XO
+      FYO = YO
+      LOOP = 1
+C
+C  SET UP IC TO SIMULATE EXIT FROM A PREVIOUS CELL
+C
+      IC = MOD(IC+2,4)
+C
+C  IF EXTRAPOLATING PASS ON
+C
+      IF (EXTRAP) GO TO    60
+C
+C  TEST IF CONTOUR EXCEEDED BORDER LIMITS
+C  NOTE THAT ICASER CANNOT EQUAL 3 AT THIS POINT
+C
+      GO TO (   30,   40,   30,   50),ICASE
+C
+C  EXIT FROM BOTTOM
+C
+   30 IF (JX.GE.IXMAX) RETURN
+      GO TO    60
+C
+C  EXIT FROM LEFT
+C
+   40 IF (JY.LE.ITLOC(JX*2 - 1)) RETURN
+      GO TO    60
+C
+C  EXIT FROM RIGHT
+C
+   50 IF (JY.GE.ITLOC(JX*2 - 1)) RETURN
+C
+C  SAVE CELL INFO IF COMMING BACK
+C
+   60 TRT = TR
+      BRT = BR
+      TLT = TL
+      BLT = BL
+      IX = JX
+      IY = JY
+C
+C  VALID CONTOUR START FOUND
+C
+      XX = FX(XO,YO)
+      CALL FRSTD (XX,FY(XO,YO))
+C
+C  DRAW CONTOUR IN THIS CELL
+C
+   70 XX = FX(XN,YN)
+      CALL VECTD (XX,FY(XN,YN))
+      XCSTOR = XC
+      YCSTOR = YC
+      IXSTOR = IX
+      IYSTOR = IY
+      IOLDC = IC
+      IC = ICASE
+C
+C  ENTER COORDINATE PAIR OF CONTOUR IN LIST
+C
+      NP = NP+1
+      IF (NP.GT.MXXY) GO TO   180
+      ICOORD(NP) = ILOC
+C
+C  BRANCH TO APPROPIATE CODE DEPENDING ON CONTOUR EXIT FROM THE CELL
+C
+   80 GO TO (   90,  110,  130,  150),IC
+C
+C  EXIT FORM BOTTOM
+C  END CONTOUR IF ON CONVEX HULL
+C
+   90 IF (EXTRAP) GO TO   100
+      IF (IY.LT.ITLOC(IX*2 - 1) .OR. IY-1.GT.ITLOC(IX*2)) GO TO   360
+  100 TR = BR
+      TL = BL
+      XC = XC+STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IX = IX+1
+      IF (IX.GT.IXMAX) GO TO   360
+      BR = SCRTCH(IX,IY)
+      BL = SCRTCH(IX,IY-1)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM LEFT SIDE
+C  TEST IF IN CONVEX HULL
+C
+  110 IF (EXTRAP) GO TO   120
+      IF (IY-1.LT.ITLOC( (IX-1)*2 - 1 ) .AND. IY-1.LT.ITLOC(IX*2 - 1))
+     1    GO TO   360
+  120 TR = TL
+      BR = BL
+      YC = YC-STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IY = IY-1
+      IF (IY.LT.2) GO TO   360
+      TL = SCRTCH(IX-1,IY-1)
+      BL = SCRTCH(IX,IY-1)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM TOP
+C  END CONTOUR IF OUT OF CONVEX HULL
+C
+  130 IF (EXTRAP) GO TO   140
+      IF (IY.LT.ITLOC( (IX-1)*2 - 1 ) .OR. IY-1.GT.ITLOC( (IX-1)*2 ))
+     1    GO TO   360
+  140 BR = TR
+      BL = TL
+      XC = XC-STPSZ
+C
+C  END CONTOUR IF OUTSIDE OF BORDER
+C
+      IX = IX-1
+      IF (IX.LT.2) GO TO   360
+      TR = SCRTCH(IX-1,IY)
+      TL = SCRTCH(IX-1,IY-1)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM RIGHT SIDE
+C  TEST IF ON CONVEX HULL
+C
+  150 IF (EXTRAP) GO TO   160
+      IF (IY.GT.ITLOC( (IX-1)*2 ) .AND. IY.GT.ITLOC(IX*2)) GO TO   360
+  160 TL = TR
+      BL = BR
+      YC = YC+STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IY = IY+1
+      IF (IY.GT.IYMAX) GO TO   360
+      TR = SCRTCH(IX-1,IY)
+      BR = SCRTCH(IX,IY)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  END THE CONTOUR
+C
+  170 CALL LASTD
+      TR = TRT
+      BR = BRT
+      TL = TLT
+      BL = BLT
+      RETURN
+C
+C  CONTOUR STORAGE EXCEEDED TRY PACKING
+C
+  180 IF (IPACK.EQ.0) GO TO   200
+      NP = 0
+      ITEST = IOR(ISHIFT(JX,ISHFCT),JY)
+          DO   190 K=1,MXXY
+          IF (ICOORD(K).LE.ITEST) GO TO   190
+          NP = NP+1
+          ICOORD(NP) = ICOORD(K)
+  190     CONTINUE
+      IF (NP.LT.MXXY) GO TO    80
+C
+C  FAILURE NO MORE SPACE ABORT THIS CONTOUR LEVEL
+C
+  200 IHOLD(1:39) = ' CONDRW-CONTOUR STORAGE EXAUSTED LEVEL='
+C
+C  BLANK FILL THE ENCODE ARRAY
+C
+        IVOUT = '                       '
+C +NOAO - FTN internal write rewritten as encode for IRAF.
+C
+C     WRITE(IVOUT,'(G13.5)')CONV
+      call encode (13, '(g13.5)', ivout, conv)
+C
+C -NOAO
+        IHOLD(40:62) = IVOUT
+      CALL SETER (IHOLD,10,IREC)
+      RETURN
+C
+C  BAD TIME THE CONTOUR EXITED A CORNER OF THE CELL MUST SEARCH FOR
+C  NEW CELL
+C
+  230 IXSTP = IXSTOR
+      IYSTP = IYSTOR
+      GO TO (  240,  250,  260,  270),IOLDC
+C
+C PREVIOUS CELL BOTTOM EXIT
+C
+  240 IXSTP = IXSTP-1
+      GO TO   280
+C
+C  PREVIOUS CELL LEFT EXIT
+C
+  250 IYSTP = IYSTP+1
+      GO TO   280
+C
+C  PREVIOUS CELL TOP EXIT
+C
+  260 IXSTP = IXSTP+1
+      GO TO   280
+C
+C  PREVIOUS CELL RIGHT EXIT
+C
+  270 IYSTP = IYSTP-1
+C
+C  BRANCH TO CURRENT CELL CASE
+C
+  280 GO TO (  290,  300,  310,  320),IC
+C
+C  APPARENT BOTTOM EXIT
+C
+  290 IXMOV(1) = 0
+      IXMOV(2) = 1
+      IYMOV(1) = -1
+      IYMOV(2) = 1
+      GO TO   330
+C
+C  APPARENT LEFT EXIT
+C
+  300 IXMOV(1) = 1
+      IXMOV(2) = -1
+      IYMOV(1) = 0
+      IYMOV(2) = -1
+      GO TO   330
+C
+C  APPARENT TOP EXIT
+C
+  310 IXMOV(1) = 0
+      IXMOV(2) = -1
+      IYMOV(1) = -1
+      IYMOV(2) = 1
+      GO TO   330
+C
+C  APPARENT RIGHT EXIT
+C
+  320 IXMOV(1) = 1
+      IXMOV(2) = -1
+      IYMOV(1) = 0
+      IYMOV(2) = 1
+C
+C  SEARCH THE POSSIBLE CELLS
+C
+  330     DO   350 K=1,2
+              DO   340 L=1,2
+              XC = XCSTOR + STPSZ*FLOAT( IXMOV(K) )
+              YC = YCSTOR + STPSZ*FLOAT( IYMOV(L) )
+              IX = IXSTOR+IXMOV(K)
+              IY = IYSTOR+IYMOV(L)
+              ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  IF BACK TO START END CONTOUR
+C
+              IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+C
+C  IF AT PREVIOUS CELL SKIP PROCESSING
+C
+              IF (IX.EQ.IXSTP .AND. IY.EQ.IYSTP) GO TO   340
+C
+C  COMPUTE CELL VALUES
+C
+              TL = SCRTCH(IX-1,IY-1)
+              BL = SCRTCH(IX,IY-1)
+              TR = SCRTCH(IX-1,IY)
+              BL = SCRTCH(IX,IY)
+              ICASE = IC
+              CALL CONCLD (ICASE,NOOP)
+              IF (ICASE.EQ.-1) GO TO 360
+              IF (ICASE.NE.0) GO TO    70
+C
+C  FAILURE TRY AGAIN
+C
+  340         CONTINUE
+  350     CONTINUE
+C
+C  NO MORE CONTOUR TRY OTHER END OF LINE
+C
+  360 IF (LOOP.EQ.0) GO TO   170
+      LOOP = 0
+      IX = JX
+      IY = JY
+      TR = TRT
+      TL = TLT
+      BR = BRT
+      BL = BLT
+      IC = IFCASE
+      ICASE = IC
+      IOLDC = IFOCSE
+      XC = XI
+      YC = YI
+      IXSTOR = IX
+      IYSTOR = IY
+      YCSTOR = YI
+      XCSTOR = XI
+      XX = FX(FXO,FYO)
+      CALL LASTD
+      CALL FRSTD (XX,FY(FXO,FYO))
+      GO TO (   90,  110,  130,  150),IC
+      END
diff --git a/sys/gio/ncarutil/conlib/conint.f b/sys/gio/ncarutil/conlib/conint.f
new file mode 100644
index 00000000..84a1be82
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conint.f
@@ -0,0 +1,147 @@
+      SUBROUTINE CONINT (NDP,XD,YD,ZD,NCP,IPC,PD)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE ESTIMATES PARTIAL DERIVATIVES OF THE FIRST AND
+C SECOND ORDER AT THE DATA POINTS.
+C THE INPUT PARAMETERS ARE
+C
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD,ZD = ARRAYS CONTAINING THE X, Y, AND Z COORDI-
+C                NATES OF DATA POINTS,
+C     NCP = NUMBER OF DATA POINTS TO BE USED FOR ESTIMATION
+C           OF PARTIAL DERIVATIVES AT EACH DATA POINT,
+C     IPC = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           NCP DATA POINTS CLOSEST TO EACH OF THE NDP DATA
+C           POINT.
+C THE OUTPUT PARAMETER IS
+C
+C     PD  = ARRAY OF DIMENSION 5*NDP, WHERE THE ESTIMATED
+C
+C           ZX, ZY, ZXX, ZXY, AND ZYY VALUES AT THE DATA
+C           POINTS ARE TO BE STORED.
+C DECLARATION STATEMENTS
+C
+C
+      DIMENSION       XD(NDP)    ,YD(NDP)    ,ZD(NDP)    ,IPC(1)     ,
+     1                PD(1)
+      REAL            NMX        ,NMY        ,NMZ        ,NMXX       ,
+     1                NMXY        ,NMYX       ,NMYY
+C
+      SAVE
+C
+C PRELIMINARY PROCESSING
+C
+C
+      NCPM1 = NCP-1
+C
+C ESTIMATION OF ZX AND ZY
+C
+C
+      DO  130 IP0=1,NDP
+         X0 = XD(IP0)
+         Y0 = YD(IP0)
+         Z0 = ZD(IP0)
+         NMX = 0.0
+         NMY = 0.0
+         NMZ = 0.0
+         JIPC0 = NCP*(IP0-1)
+         DO  120 IC1=1,NCPM1
+            JIPC = JIPC0+IC1
+            IPI = IPC(JIPC)
+            DX1 = XD(IPI)-X0
+            DY1 = YD(IPI)-Y0
+            DZ1 = ZD(IPI)-Z0
+            IC2MN = IC1+1
+            DO  110 IC2=IC2MN,NCP
+               JIPC = JIPC0+IC2
+               IPI = IPC(JIPC)
+               DX2 = XD(IPI)-X0
+               DY2 = YD(IPI)-Y0
+               DNMZ = DX1*DY2-DY1*DX2
+               IF (DNMZ .EQ. 0.0) GO TO  110
+               DZ2 = ZD(IPI)-Z0
+               DNMX = DY1*DZ2-DZ1*DY2
+               DNMY = DZ1*DX2-DX1*DZ2
+               IF (DNMZ .GE. 0.0) GO TO  100
+               DNMX = -DNMX
+               DNMY = -DNMY
+               DNMZ = -DNMZ
+  100          NMX = NMX+DNMX
+               NMY = NMY+DNMY
+               NMZ = NMZ+DNMZ
+  110       CONTINUE
+  120    CONTINUE
+         JPD0 = 5*IP0
+         PD(JPD0-4) = -NMX/NMZ
+         PD(JPD0-3) = -NMY/NMZ
+  130 CONTINUE
+C
+C ESTIMATION OF ZXX, ZXY, AND ZYY
+C
+C
+      DO  170 IP0=1,NDP
+         JPD0 = JPD0+5
+         X0 = XD(IP0)
+         JPD0 = 5*IP0
+         Y0 = YD(IP0)
+         ZX0 = PD(JPD0-4)
+         ZY0 = PD(JPD0-3)
+         NMXX = 0.0
+         NMXY = 0.0
+         NMYX = 0.0
+         NMYY = 0.0
+         NMZ = 0.0
+         JIPC0 = NCP*(IP0-1)
+         DO  160 IC1=1,NCPM1
+            JIPC = JIPC0+IC1
+            IPI = IPC(JIPC)
+            DX1 = XD(IPI)-X0
+            DY1 = YD(IPI)-Y0
+            JPD = 5*IPI
+            DZX1 = PD(JPD-4)-ZX0
+            DZY1 = PD(JPD-3)-ZY0
+            IC2MN = IC1+1
+            DO  150 IC2=IC2MN,NCP
+               JIPC = JIPC0+IC2
+               IPI = IPC(JIPC)
+               DX2 = XD(IPI)-X0
+               DY2 = YD(IPI)-Y0
+               DNMZ = DX1*DY2-DY1*DX2
+               IF (DNMZ .EQ. 0.0) GO TO  150
+               JPD = 5*IPI
+               DZX2 = PD(JPD-4)-ZX0
+               DZY2 = PD(JPD-3)-ZY0
+               DNMXX = DY1*DZX2-DZX1*DY2
+               DNMXY = DZX1*DX2-DX1*DZX2
+               DNMYX = DY1*DZY2-DZY1*DY2
+               DNMYY = DZY1*DX2-DX1*DZY2
+               IF (DNMZ .GE. 0.0) GO TO  140
+               DNMXX = -DNMXX
+               DNMXY = -DNMXY
+               DNMYX = -DNMYX
+               DNMYY = -DNMYY
+               DNMZ = -DNMZ
+  140          NMXX = NMXX+DNMXX
+               NMXY = NMXY+DNMXY
+               NMYX = NMYX+DNMYX
+               NMYY = NMYY+DNMYY
+               NMZ = NMZ+DNMZ
+  150       CONTINUE
+  160    CONTINUE
+         PD(JPD0-2) = -NMXX/NMZ
+         PD(JPD0-1) = -(NMXY+NMYX)/(2.0*NMZ)
+         PD(JPD0) = -NMYY/NMZ
+  170 CONTINUE
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlcm.f b/sys/gio/ncarutil/conlib/conlcm.f
new file mode 100644
index 00000000..80791d49
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlcm.f
@@ -0,0 +1,65 @@
+      FUNCTION CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,LOC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  COMPUTE A Z VALUE FOR A GIVEN X,Y VALUE
+C  NOTE THAT X,Y MUST BE INSIDE THE CONVEX HULL OF THE INPUT DATA
+C  INORDER FOR THIS FUNCTION TO WORK.
+C
+C  INPUT
+C       X-X COORDINATE OF REQUESTED POINT
+C       Y-Y COORDINATE OF REQUESTED POINT
+C       WK-LIST OF COEFICENTS FOR LINEAR INTERPOLATION  FUNCTIONS
+C             LOCATED BY A = WK((TRI-1)*3+1)
+C                        B = WK((TRI-2)*3+1)
+C                        C = WK((TRI-3)*3+1)
+C
+C  OUTPUT
+C       LOC-TRIANGLE NUMBER OF REQUESTED POINT
+C       Z VALUE AS FUNCTION RESULT
+C
+      DIMENSION WK(1),IWK(1),XD(1),YD(1),ZD(1)
+C
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+C
+        SAVE
+C
+C  LOCATE THE TRIANGLE
+C
+      CALL CONLOC(NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),X,Y,LOC,
+     1            IWK(JWIWL),WK)
+C
+C  IF OUTSIDE CONVEX HULL THEN DON'T COMPUTE A VALUE
+C
+      IF (LOC.GT.NT) RETURN
+C
+C  GET THE VECTOR 1 VALUES FOR THE TRIANGLE
+C
+      IVEC = (LOC-1)*3 + JWIPT
+      IV = IWK(IVEC)
+      X1 = X - XD(IV)
+      Y1 = Y - YD(IV)
+      Z1 = ZD(IV)
+C
+C  COMPUT THE Z VALUE
+C
+      IPOINT = (LOC-1)*3 + IPR
+C
+      Z = (WK(IPOINT)*X1+WK(IPOINT+1)*Y1)/WK(IPOINT+2) + Z1
+C
+      CONLCM = Z
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlin.f b/sys/gio/ncarutil/conlib/conlin.f
new file mode 100644
index 00000000..f940d48c
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlin.f
@@ -0,0 +1,68 @@
+      SUBROUTINE CONLIN(XD,YD,ZD,NT,IWK,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS ROUTINE GENERATES THE COORDINATES USED IN A LINEAR INTERPOLATION
+C  OF THE TRIANGLES CREATED FROM IRREGULARLY DISTRIBUTED DATA.
+C
+C  INPUT
+C       XD-X INPUT COORDINATES]
+C       YD-Y INPUT COORDINATES
+C       ZD-Z VALUE AT INPUT X,Y
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       IWK-LIST OF TRIANGLE POINTS, RELATIVE TO XD,YD
+C               GROUPED 3 PER TRIANGLE I.E. TRIANGLE 1 IWK(1,2,3),
+C               TRIANGLE 2 IWK(4,5,6)  ETC.
+C
+C  OUTPUT
+C       WK ARRAY OF COEFICENTS FOR LINEATION FORMUALS
+C               GROUPED 3 PER TRIANGLE
+C               POINTS ARE (TRI-1)*3 + 1,2,3
+C
+      DIMENSION IWK(1),WK(1),XD(1),YD(1),ZD(1)
+C
+        SAVE
+C
+C   LOOP FOR ALL TRIANGLES
+C
+      DO 1000 ITRI = 1,NT
+C
+C       GET THE POINTS OF THE TRIANGLE
+C
+        IPOINT = (ITRI-1)*3
+        IP1 = IWK(IPOINT+1)
+        IP2 = IWK(IPOINT+2)
+        IP3 = IWK(IPOINT+3)
+C
+C       GET THE VALUES AT THE TRIANBGLE POINTS
+C
+        X1 = XD(IP1)
+        Y1 = YD(IP1)
+        Z1 = ZD(IP1)
+        X2 = XD(IP2)
+        Y2 = YD(IP2)
+        Z2 = ZD(IP2)
+        X3 = XD(IP3)
+        Y3 = YD(IP3)
+        Z3 = ZD(IP3)
+C
+C  COMPUTE THE INTERPLOATING COEFICIENTS
+C
+        WK(IPOINT+1) = (Y2-Y1)*(Z3-Z1)-(Y3-Y1)*(Z2-Z1)
+        WK(IPOINT+2) = (X3-X1)*(Z2-Z1)-(X2-X1)*(Z3-Z1)
+        WK(IPOINT+3) = (X3-X1)*(Y2-Y1)-(X2-X1)*(Y3-Y1)
+C
+ 1000 CONTINUE
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conloc.f b/sys/gio/ncarutil/conlib/conloc.f
new file mode 100644
index 00000000..5907c9df
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conloc.f
@@ -0,0 +1,256 @@
+      SUBROUTINE CONLOC (NDP,XD,YD,NT,IPT,NL,IPL,XII,YII,ITI,IWK,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE LOCATES A POINT, I.E., DETERMINES TO WHAT TRI-
+C ANGLE A GIVEN POINT (XII,YII) BELONGS.  WHEN THE GIVEN POINT
+C DOES NOT LIE INSIDE THE DATA AREA, THIS SUBROUTINE DETERMINES
+C THE BORDER LINE SEGMENT WHEN THE POINT LIES IN AN OUTSIDE
+C RECTANGULAR AREA, AND TWO BORDER LINE SEGMENTS WHEN THE POINT
+C LIES IN AN OUTSIDE TRIANGULAR AREA.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
+C           COORDINATES OF THE DATA POINTS,
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
+C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
+C           POINT NUMBERS OF THE END POINTS OF THE BORDER
+C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
+C           NUMBERS,
+C     XII,YII = X AND Y COORDINATES OF THE POINT TO BE
+C           LOCATED.
+C THE OUTPUT PARAMETER IS
+C     ITI = TRIANGLE NUMBER, WHEN THE POINT IS INSIDE THE
+C           DATA AREA, OR
+C           TWO BORDER LINE SEGMENT NUMBERS, IL1 AND IL2,
+C           CODED TO IL1*(NT+NL)+IL2, WHEN THE POINT IS
+C           OUTSIDE THE DATA AREA.
+C THE OTHER PARAMETERS ARE
+C     IWK = INTEGER ARRAY OF DIMENSION 18*NDP USED INTER-
+C           NALLY AS A WORK AREA,
+C     WK  = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
+C           WORK AREA.
+C DECLARATION STATEMENTS
+C
+      DIMENSION       XD(1)      ,YD(1)      ,IPT(1)     ,IPL(1)     ,
+     1                IWK(1)     ,WK(1)
+C
+C
+C
+      DIMENSION       NTSC(9)    ,IDSC(9)
+      COMMON /CONRA5/ NIT        ,ITIPV
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS
+C
+      SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3)-(V1-V3)*(U2-U3)
+      SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2)+(V1-V2)*(V3-V2)
+C
+C PRELIMINARY PROCESSING
+C
+      NT0 = NT
+      NL0 = NL
+      NTL = NT0+NL0
+      X0 = XII
+      Y0 = YII
+C
+C PROCESSING FOR A NEW SET OF DATA POINTS
+C
+      IF (NIT .NE. 0) GO TO  170
+      NIT = 1
+C
+C - DIVIDES THE X-Y PLANE INTO NINE RECTANGULAR SECTIONS.
+C
+      XMN = XD(1)
+      XMX = XMN
+      YMN = YD(1)
+      YMX = YMN
+      DO  100 IDP=2,NDP
+         XI = XD(IDP)
+         YI = YD(IDP)
+         XMN = AMIN1(XI,XMN)
+         XMX = AMAX1(XI,XMX)
+         YMN = AMIN1(YI,YMN)
+         YMX = AMAX1(YI,YMX)
+  100 CONTINUE
+      XS1 = (XMN+XMN+XMX)/3.0
+      XS2 = (XMN+XMX+XMX)/3.0
+      YS1 = (YMN+YMN+YMX)/3.0
+      YS2 = (YMN+YMX+YMX)/3.0
+C
+C - DETERMINES AND STORES IN THE IWK ARRAY TRIANGLE NUMBERS OF
+C - THE TRIANGLES ASSOCIATED WITH EACH OF THE NINE SECTIONS.
+C
+      DO  110 ISC=1,9
+         NTSC(ISC) = 0
+         IDSC(ISC) = 0
+  110 CONTINUE
+      IT0T3 = 0
+      JWK = 0
+      DO  160 IT0=1,NT0
+         IT0T3 = IT0T3+3
+         I1 = IPT(IT0T3-2)
+         I2 = IPT(IT0T3-1)
+         I3 = IPT(IT0T3)
+         XMN = AMIN1(XD(I1),XD(I2),XD(I3))
+         XMX = AMAX1(XD(I1),XD(I2),XD(I3))
+         YMN = AMIN1(YD(I1),YD(I2),YD(I3))
+         YMX = AMAX1(YD(I1),YD(I2),YD(I3))
+         IF (YMN .GT. YS1) GO TO  120
+         IF (XMN .LE. XS1) IDSC(1) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(2) = 1
+         IF (XMX .GE. XS2) IDSC(3) = 1
+  120    IF (YMX.LT.YS1 .OR. YMN.GT.YS2) GO TO  130
+         IF (XMN .LE. XS1) IDSC(4) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(5) = 1
+         IF (XMX .GE. XS2) IDSC(6) = 1
+  130    IF (YMX .LT. YS2) GO TO  140
+         IF (XMN .LE. XS1) IDSC(7) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(8) = 1
+         IF (XMX .GE. XS2) IDSC(9) = 1
+  140    DO  150 ISC=1,9
+            IF (IDSC(ISC) .EQ. 0) GO TO  150
+            JIWK = 9*NTSC(ISC)+ISC
+            IWK(JIWK) = IT0
+            NTSC(ISC) = NTSC(ISC)+1
+            IDSC(ISC) = 0
+  150    CONTINUE
+C
+C - STORES IN THE WK ARRAY THE MINIMUM AND MAXIMUM OF THE X AND
+C - Y COORDINATE VALUES FOR EACH OF THE TRIANGLE.
+C
+         JWK = JWK+4
+         WK(JWK-3) = XMN
+         WK(JWK-2) = XMX
+         WK(JWK-1) = YMN
+         WK(JWK) = YMX
+  160 CONTINUE
+      GO TO  200
+C
+C CHECKS IF IN THE SAME TRIANGLE AS PREVIOUS.
+C
+  170 IT0 = ITIPV
+      IF (IT0 .GT. NT0) GO TO  180
+      IT0T3 = IT0*3
+      IP1 = IPT(IT0T3-2)
+      X1 = XD(IP1)
+      Y1 = YD(IP1)
+      IP2 = IPT(IT0T3-1)
+      X2 = XD(IP2)
+      Y2 = YD(IP2)
+      IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  200
+      IP3 = IPT(IT0T3)
+      X3 = XD(IP3)
+      Y3 = YD(IP3)
+      IF (SIDE(X2,Y2,X3,Y3,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SIDE(X3,Y3,X1,Y1,X0,Y0) .LT. 0.0) GO TO  200
+      GO TO  260
+C
+C CHECKS IF ON THE SAME BORDER LINE SEGMENT.
+C
+  180 IL1 = IT0/NTL
+      IL2 = IT0-IL1*NTL
+      IL1T3 = IL1*3
+      IP1 = IPL(IL1T3-2)
+      X1 = XD(IP1)
+      Y1 = YD(IP1)
+      IP2 = IPL(IL1T3-1)
+      X2 = XD(IP2)
+      Y2 = YD(IP2)
+      IF (IL2 .NE. IL1) GO TO  190
+      IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SPDT(X2,Y2,X1,Y1,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  200
+      GO TO  260
+C
+C CHECKS IF BETWEEN THE SAME TWO BORDER LINE SEGMENTS.
+C
+  190 IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  200
+      IP3 = IPL(3*IL2-1)
+      X3 = XD(IP3)
+      Y3 = YD(IP3)
+      IF (SPDT(X3,Y3,X2,Y2,X0,Y0) .LE. 0.0) GO TO  260
+C
+C LOCATES INSIDE THE DATA AREA.
+C - DETERMINES THE SECTION IN WHICH THE POINT IN QUESTION LIES.
+C
+  200 ISC = 1
+      IF (X0 .GE. XS1) ISC = ISC+1
+      IF (X0 .GE. XS2) ISC = ISC+1
+      IF (Y0 .GE. YS1) ISC = ISC+3
+      IF (Y0 .GE. YS2) ISC = ISC+3
+C
+C - SEARCHES THROUGH THE TRIANGLES ASSOCIATED WITH THE SECTION.
+C
+      NTSCI = NTSC(ISC)
+      IF (NTSCI .LE. 0) GO TO  220
+      JIWK = -9+ISC
+      DO  210 ITSC=1,NTSCI
+         JIWK = JIWK+9
+         IT0 = IWK(JIWK)
+         JWK = IT0*4
+         IF (X0 .LT. WK(JWK-3)) GO TO  210
+         IF (X0 .GT. WK(JWK-2)) GO TO  210
+         IF (Y0 .LT. WK(JWK-1)) GO TO  210
+         IF (Y0 .GT. WK(JWK)) GO TO  210
+         IT0T3 = IT0*3
+         IP1 = IPT(IT0T3-2)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP2 = IPT(IT0T3-1)
+         X2 = XD(IP2)
+         Y2 = YD(IP2)
+         IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  210
+         IP3 = IPT(IT0T3)
+         X3 = XD(IP3)
+         Y3 = YD(IP3)
+         IF (SIDE(X2,Y2,X3,Y3,X0,Y0) .LT. 0.0) GO TO  210
+         IF (SIDE(X3,Y3,X1,Y1,X0,Y0) .LT. 0.0) GO TO  210
+         GO TO  260
+  210 CONTINUE
+C
+C LOCATES OUTSIDE THE DATA AREA.
+C
+  220 DO  240 IL1=1,NL0
+         IL1T3 = IL1*3
+         IP1 = IPL(IL1T3-2)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP2 = IPL(IL1T3-1)
+         X2 = XD(IP2)
+         Y2 = YD(IP2)
+         IF (SPDT(X2,Y2,X1,Y1,X0,Y0) .LT. 0.0) GO TO  240
+         IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  230
+         IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  240
+         IL2 = IL1
+         GO TO  250
+  230    IL2 = MOD(IL1,NL0)+1
+         IP3 = IPL(3*IL2-1)
+         X3 = XD(IP3)
+         Y3 = YD(IP3)
+         IF (SPDT(X3,Y3,X2,Y2,X0,Y0) .LE. 0.0) GO TO  250
+  240 CONTINUE
+      IT0 = 1
+      GO TO  260
+  250 IT0 = IL1*NTL+IL2
+C
+C NORMAL EXIT
+C
+  260 ITI = IT0
+      ITIPV = IT0
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlod.f b/sys/gio/ncarutil/conlib/conlod.f
new file mode 100644
index 00000000..d7fc3804
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlod.f
@@ -0,0 +1,194 @@
+      SUBROUTINE CONLOD (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C******************************************************************
+C*                                                                *
+C*   THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB      *
+C*   FILES CONRAN AND CONRAS.  SEE THOSE FILES FOR AN             *
+C*   EXPLAINATION OF THE ENTRY POINTS.                            *
+C*                                                                *
+C******************************************************************
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       SCRARR(1)
+C
+        SAVE
+C
+C  IFR - FLAG TO REGISTER FIRST PASS IN Y DIRECTION
+C
+C  LOAD THE SCRATCH SPACE AND CONVEX HULL POINTERS
+C  ITLOC IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO THE SCARTCH
+C  SPACE.
+C  PV IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO USER COORDINATES
+C
+C  INITALIZE THE SPECIAL VALUE FEATURE
+C
+      X = (XED-XST)/2. + XST
+      Y = (YED-YST)/2. + YST
+      IF(LINEAR) GO TO 1
+      SPVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+        GO TO 2
+ 1    SPVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+ 2    CONTINUE
+C
+C  INITIALIZE THE SEARCH
+C
+      IYMAX = 0
+      IFR = 1
+      JX = 1
+      X = XST
+   10 JY = 1
+      Y = YST
+C
+C  SET HULL POINTERS FOR THIS COLUMN TO NULL
+C
+      ITLOC(JX*2-1) = 0
+      ITLOC(JX*2) = 0
+C
+C  FLAG START OF COLUMN
+C
+      LOOP = 1
+C
+C  GET INTERPOLATED VALUE
+C
+  20  IF (LINEAR) GO TO 3
+      RVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+      GO TO 4
+  3   RVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+  4   CONTINUE
+      SCRARR(JY+(JX-1)*IYMAX) = RVAL
+      IF (RVAL.GT.SPVAL) SPVAL = RVAL
+C
+C  IF OUTSIDE CONVEX HULL BRANCH
+C
+      IF (IT.GT.NTNL) GO TO    30
+C
+C  IF OUTSIDE TRIANGLES AND USING LINEAR INTERPLOATION THEN BRANCH
+C
+      IF(LINEAR.AND.IT.GT.NT) GO TO 30
+C
+C  IF FIRST OF COLUMN IN HULL CONTINUE THROUGH
+C
+      IF (LOOP.NE.1) GO TO    40
+C
+C  SET HULL POINTERS
+C
+      PV(JX*2-1) = Y
+      ITLOC(JX*2-1) = JY
+C
+C  SET FLAG TO LOOK FOR END OF HULL IN COLUMN
+C
+      LOOP = 2
+C
+C  GO FOR NEXT ENTRY
+C
+      GO TO    40
+C
+C  TEST FOR END OF CONVEX HULL ON THIS ROW
+C
+   30 IF (LOOP.NE.2) GO TO    40
+C
+C  END OF HULL SET POINTERS FOR END OF HULL AND FLAG IT VIA LOOP
+C
+      LOOP = 0
+      ITLOC(JX*2) = JY-1
+      PV(JX*2) = Y-STPSZ
+C
+C  GET NEXT ELEMENT IN ROW IF NOT OUTSIDE ENCLOSING RECTANGULAR
+C  BOARDER
+C
+   40 Y = Y+STPSZ
+      JY = JY+1
+      IF (Y.LE.YED) GO TO    20
+C
+C  TEST FOR FIRST COLUMN
+C
+      IF (IFR.NE.1) GO TO    50
+C
+C  FIRST COLUMN OVER SET MAX Y VALUES
+C
+      IYMAX = JY-1
+      YMAX = Y-STPSZ
+      IFR = 0
+C
+C  IF HULL WENT TO EDGE OF RECTANGULAR BOARDER SET HULL POINTERS HERE
+C
+   50 IF (LOOP.NE.2) GO TO    60
+      PV(JX*2) = Y-STPSZ
+      ITLOC(JX*2) = JY-1
+C
+C  END OF COLUMN GET NEXT ONE
+C
+   60 X = X+STPSZ
+      JX = JX+1
+C
+C  IF NOT END OF WORK CONTINUE WITH NEXT COLUMN
+C
+      IF (X.LE.XED) GO TO    10
+C
+C  END OF WORK SET MAX X VALUES
+C
+      IXMAX = JX-1
+      XMAX = X-STPSZ
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conop1.f b/sys/gio/ncarutil/conlib/conop1.f
new file mode 100644
index 00000000..fc61872d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop1.f
@@ -0,0 +1,465 @@
+      SUBROUTINE CONOP1 (IOPT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+C
+        SAVE
+C
+c +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE OPTION AND ITS VALUE
+C
+        TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+                OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  REP FOUND CHECK VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'RE') THEN
+C
+C  SWITCH = ON CONTOUR SAME DATA
+C
+            IF (OPT .EQ. 'ON') THEN
+              REPEAT = .TRUE.
+              RETURN
+C
+C  SWITCH = OFF CONTOUR NEW DATA
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              REPEAT = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  EXTRAPOLATION FLAG
+C
+      ELSEIF (TAG .EQ. 'EX') THEN
+C
+C  SWITCH = ON EXTRAPOLATE WHEN CONTOURING
+C
+            IF (OPT .EQ. 'ON') THEN
+              EXTRAP = .TRUE.
+              RETURN
+C
+C  SWITCH = OFF INTERPOLATE ONLY
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              EXTRAP = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  PER FOUND SET PERIMETER
+C
+      ELSEIF (TAG .EQ. 'PE') THEN
+C
+C  SWITCH = ON DRAW PERIMETERS
+C
+            IF (OPT .EQ. 'ON') THEN
+              PER = .TRUE.
+C
+C  TURN GRID OFF, USER WANTS PERIMETER
+C
+             GRD = .FALSE.
+             RETURN
+C
+C  SWITCH = OFF DO NOT DRAW PERIMETERS
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+             PER = .FALSE.
+             RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DEF FOUND SET ALL OPTIONS TO DEFAULT (NO SWITCHES)
+C
+        ELSEIF (TAG .EQ. 'DE') THEN
+      PER = .TRUE.
+      LISTOP = .FALSE.
+      PMIMX = .FALSE.
+      SCALE = 1.
+      TENSN = TENS
+      EXTRAP = .FALSE.
+      TITLE = .FALSE.
+      ITLSIZ = 16
+      REPEAT = .FALSE.
+      MESS = .TRUE.
+      CON = .FALSE.
+      CINC = .FALSE.
+      CHILO = .FALSE.
+      IGRAD = IG
+      ISCALE = 0
+      NCP = 4
+      LOOK = .FALSE.
+      GRD = .FALSE.
+      PLDVLS = .FALSE.
+      INMAJ = 1
+      INMIN = 1
+      INDAT = 1
+      INLAB = 1
+      IRANMJ = 1
+      IRANMN = 1
+      IRANTX = 1
+      IRASMJ = 1
+      IRASMN = 1
+      IRASTX = 1
+      IRAQMJ = 1
+      IRAQMN = 1
+      IRAQTX = 1
+      BPSIZ = 0.
+      LABON = .TRUE.
+      ISIZEL = 9
+      ISIZEP = 8
+      ISIZEM = 15
+      FRADV = .TRUE.
+      EXTRI = .FALSE.
+      MINGAP = 3
+      LINEAR = .FALSE.
+      ICOUNT = 0
+      SHIELD = .FALSE.
+      SLDPLT = .FALSE.
+C
+C  SET DEFAULT DASH PATTERN
+C
+         IDASH = '$$$$$$$$$$'
+         NDASH = '$$$$$$$$$$'
+         EDASH = '$$$$$$$$$$'
+C
+C  SET DEFAULT FORMAT
+C
+         FORM = '(G10.3)'
+      RETURN
+C
+C  MES FOUND TEST VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'ME') THEN
+C
+C  ACTIVATE CONRAN MESSAGE
+C
+            IF (OPT .EQ. 'ON') THEN
+              MESS = .TRUE.
+              RETURN
+C
+C  TURN OFF CONRAN MESSAGE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              MESS = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+          ENDIF
+C
+C  SCALING OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'SC') THEN
+C
+C  SET VALUE OF SCALE FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+                  ISCALE = 0
+                  RETURN
+            ELSEIF (OPT .EQ. 'OF') THEN
+                  ISCALE = 1
+                  RETURN
+            ELSEIF (OPT .EQ. 'PR') THEN
+                  ISCALE = 2
+                  RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+C
+C  TRIANGLE FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'TR') THEN
+C
+C  SWITCH ON
+C
+            IF (OPT .EQ. 'ON') THEN
+              LOOK = .TRUE.
+              RETURN
+C
+C  SWITCH OFF
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              LOOK = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+          ENDIF
+C
+C  PLOT DATA VALUES FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'PD') THEN
+C
+C SWITCH ON
+C
+            IF (OPT .EQ. 'ON') THEN
+              PLDVLS = .TRUE.
+              RETURN
+C
+C  SWITCH OFF
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              PLDVLS = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  GRID OPTION ACTIVATED GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'GR') THEN
+C
+C  SWITCH ON SET GRID FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+              GRD = .TRUE.
+C
+C  TURN PER OFF USER WANTS GRID
+C
+              PER = .FALSE.
+              RETURN
+C
+C  SWITCH OFF CLEAR GRID FLAG
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              GRD = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LABEL PLOTTING FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LA') THEN
+C
+C  SWITCH ON LABEL CONTOURS
+C
+            IF (OPT .EQ. 'ON') THEN
+              LABON = .TRUE.
+                RETURN
+C
+C  SWITCH OFF DON"T LABEL CONTOURS
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              LABON = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  PLOT THE RELATIVE MIN"S AND MAX"S
+C
+      ELSEIF (TAG .EQ. 'PM') THEN
+C
+C  SWTICH ON PLOT THE INFO
+C
+            IF (OPT .EQ. 'ON') THEN
+              PMIMX = .TRUE.
+                RETURN
+C
+C  SWTICH OFF DO NOT PLOT THE INFO
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              PMIMX = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  ADVANCE FRAME BEFORE TRIANGULATION PLOT
+C
+      ELSEIF (TAG .EQ. 'TF') THEN
+C
+C  SWITCH ON ADVANCE FRAME
+C
+          IF (OPT .EQ. 'ON') THEN
+                FRADV = .TRUE.
+                RETURN
+C
+C  SWITCH OFF DO NOT ADVANCE FRAME
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                FRADV = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  EXIT AFTER TRIANGULATION
+C
+      ELSEIF (TAG .EQ. 'TO') THEN
+C
+C  SWITCH ON EXIT AFTER TRIANGULATION
+C
+          IF (OPT .EQ. 'ON') THEN
+                EXTRI = .TRUE.
+                LOOK = .TRUE.
+                FRADV = .FALSE.
+                RETURN
+C
+C  SWITCH OFF DO NOT EXIT AFTER TRIANGULATION
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+                FRADV = .TRUE.
+                LOOK = .FALSE.
+                EXTRI = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LIST OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LO') THEN
+C
+C  ON SET LIST OPTIONS FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+              LISTOP = .TRUE.
+                RETURN
+C
+C  TURN OFF LIST OPTIONS FLAG
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              LISTOP = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE INTERPOLATION SCHEME
+C
+      ELSEIF (TAG .EQ. 'IT') THEN
+C
+C  SET TO C1 SURFACE
+C
+            IF (OPT .EQ. 'C1') THEN
+              LINEAR = .FALSE.
+                RETURN
+C
+C  SET TO LINEAR INTERPOLATION
+C
+            ELSEIF (OPT .EQ. 'LI') THEN
+                LINEAR = .TRUE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE SHIELD PLOT FLAG
+C
+      ELSEIF (TAG .EQ. 'PS') THEN
+C
+C  TURN ON SHIELD PLOT
+C
+            IF (OPT .EQ. 'ON') THEN
+                SLDPLT = .TRUE.
+                RETURN
+C
+C  TURN OFF SHIELD PLOT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                SLDPLT = .FALSE.
+                RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP1 -- UNDEFINED OPTION',1,1)
+      RETURN
+C
+        END
diff --git a/sys/gio/ncarutil/conlib/conop2.f b/sys/gio/ncarutil/conlib/conop2.f
new file mode 100644
index 00000000..41dc27c3
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop2.f
@@ -0,0 +1,316 @@
+      SUBROUTINE CONOP2 (IOPT,ISIZE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C     ISIZE-  INTEGER INPUT
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+        SAVE
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  SET RESOLUTION OF VIRTUAL GRID
+C
+      IF (TAG .EQ. 'SS') THEN
+C
+C  SWITCH = ON SET RESOLUTION OF VIRTUAL GRID
+C
+            IF (OPT .EQ. 'ON') THEN
+              IGRAD = ISIZE
+              RETURN
+C
+C  SWITCH = OFF RESET RESOLUTION TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              IGRAD = IG
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  NCP OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'NC') THEN
+C
+C  SWITCH ON GET VALUE FOR NUMBER OF SURROUNDING DATA POINTS TO USE
+C
+            IF (OPT .EQ. 'ON') THEN
+              NCP = ISIZE
+              RETURN
+C
+C  SWITCH OFF SET TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              NCP = 4
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  INTENSITY OPTION FOUND GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'IN') THEN
+C
+C  SWITCH OFF SET DEFAULT VALUES
+C
+            IF (OPT .EQ. 'OF') THEN
+                  IRANMJ = 1
+                  IRANMN = 1
+                  IRANTX = 1
+                  IRASMJ = 1
+                  IRASMN = 1
+                  IRASTX = 1
+                  IRAQMJ = 1
+                  IRAQMN = 1
+                  IRAQTX = 1
+              INMAJ = 1
+              INMIN = 1
+              INDAT = 1
+              INLAB = 1
+              RETURN
+C
+C  SET PLOTTED DATA INTENSITY
+C
+            ELSEIF (OPT .EQ. 'DA') THEN
+              INDAT = ISIZE
+              RETURN
+C
+C SET TITLE AND MESSAGE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'LA') THEN
+              INLAB = ISIZE
+                  IRANTX = ISIZE
+                  IRASTX = ISIZE
+                  IRAQTX = ISIZE
+              RETURN
+C
+C  SET ALL INTENSITIES TO THE SAME VALUE
+C
+            ELSEIF (OPT .EQ. 'AL') THEN
+                  IRANMJ = ISIZE
+                  IRANMN = ISIZE
+                  IRANTX = ISIZE
+                  IRASMJ = ISIZE
+                  IRASMN = ISIZE
+                  IRASTX = ISIZE
+                  IRAQMJ = ISIZE
+                  IRAQMN = ISIZE
+                  IRAQTX = ISIZE
+              INMAJ = ISIZE
+                INMIN = ISIZE
+              INLAB = ISIZE
+              INDAT = ISIZE
+              RETURN
+C
+C  SET MAJOR LINE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'MA') THEN
+                  IRANMJ = ISIZE
+                  IRASMJ = ISIZE
+                  IRAQMJ = ISIZE
+              INMAJ = ISIZE
+              RETURN
+C
+C  SET MINOR LINE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'MI') THEN
+                  IRANMN = ISIZE
+                  IRASMN = ISIZE
+                  IRAQMN = ISIZE
+                INMIN = ISIZE
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LABEL SIZE OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LS') THEN
+C
+C  SWITCH ON GET USER LABEL SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEL = ISIZE
+                RETURN
+C
+C  SWITCH OFF SET LABEL SIZE TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEL = 9
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET SIZES OF MINIMUM AND MAXIMUM LABELS
+C
+      ELSEIF (TAG .EQ. 'SM') THEN
+C
+C  SWTICH ON GET USERS SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEM = ISIZE
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEM = 15
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET SIZE OF THE PLOTTED DATA
+C
+      ELSEIF (TAG .EQ. 'SP') THEN
+C
+C  SWTICH ON GET USERS SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEP = ISIZE
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEP = 8
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  TITLE SIZE SWITCH
+C
+      ELSEIF (TAG .EQ. 'ST') THEN
+C
+C  SWITCH ON SET THE TITLE SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ITLSIZ = ISIZE
+                RETURN
+C
+C  SWITCH OFF SET TITLE SIZE TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ITLSIZ = 16
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  MINOR LINE COUNT OPTION
+C
+      ELSEIF (TAG .EQ. 'MI') THEN
+C
+C  SET MINOR LINE COUNT
+C
+            IF (OPT .EQ. 'ON') THEN
+                MINGAP = ISIZE+1
+                RETURN
+C
+C  SET MINOR LINE COUNT TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                MINGAP = 3
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP2 - UNDEFINED OPTION',1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conop3.f b/sys/gio/ncarutil/conlib/conop3.f
new file mode 100644
index 00000000..e4632478
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop3.f
@@ -0,0 +1,266 @@
+      SUBROUTINE CONOP3 (IOPT,ARRAY,ISIZE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C     ARRAY-   REAL ARRAY OF DIMENSION ISIZE
+C     ISIZE-   SIZE OF ARRAY
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        DIMENSION ARRAY(ISIZE)
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+C
+        SAVE
+C
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  CON CONTOUR LEVELS  CHECK VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'CO') THEN
+C
+C  SWITCH = ON SET CONTOUR LEVELS
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CHILO .OR. CINC) GOTO  140
+C
+C  TEST IF NUMBER OF CONTOURS IS ACCEPTABLE
+C
+              IF (ISIZE .GT. 30)
+     1    CALL SETER (' CONOP3-NUMBER OF CONTOUR LEVELS EXCEEDS 30',
+     2                 1,1)
+      DO  200 I=1,ISIZE
+       CL(I) = ARRAY(I)
+  200 CONTINUE
+      CON = .TRUE.
+      NCL = ISIZE
+      RETURN
+C
+C  SWITCH = OFF CLEAR CONTOUR LEVEL ARRAY (PROGRAM SELECTS)
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              CON = .FALSE.
+              RETURN
+            ELSE
+                  GOTO 120
+          ENDIF
+C
+C  CONTOUR HI LO OPTION FOUND GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CH') THEN
+C
+C  SWITCH ON SET HI AND FLO
+C
+            IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+                  HI = ARRAY(1)
+                  FLO = ARRAY(2)
+                  CHILO = .TRUE.
+                  RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                CHILO = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  CONTOUR INCREMENT OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CI') THEN
+C
+C  SWITCH ON SET INCREMENT
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+              CINC = .TRUE.
+              FINC = ARRAY(1)
+              RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              CINC = .FALSE.
+              RETURN
+        ELSE
+                GOTO 120
+          ENDIF
+C
+C  SCALE THE DATA PLOTTED ON THE CONTOURS AND MIN MAX POINTS
+C
+      ELSEIF (TAG .EQ. 'SD') THEN
+C
+C  SWTICH ON GET SCALE FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                SCALE = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET FOR NO SCALING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                SCALE = 1.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE TENSION VALUE FOR SMOOTHING
+C
+      ELSEIF (TAG .EQ. 'TE') THEN
+C
+C  SWTICH ON SET TENSION FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                TENSN = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT TENSION
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                TENSN = TENS
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DASH PATTERN BREAK POINT SWITCH
+C
+      ELSEIF (TAG .EQ. 'DB') THEN
+C
+C  SWITCH ON GET USERS BREAKPOINT
+C
+            IF (OPT .EQ. 'ON') THEN
+                BPSIZ = ARRAY(1)
+                RETURN
+C
+C  SWITCH OFF SET TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                BPSIZ = 0.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SHIELD OPTION
+C
+        ELSEIF (TAG .EQ. 'SL') THEN
+C
+C  TURN SHIELDING ON AND SET THE SHIELD COORD POINTERS
+C
+            IF (OPT .EQ. 'ON') THEN
+                  NISIZE = ISIZE/2
+                  CALL CONSSD(ARRAY(1),ARRAY(NISIZE+1),NISIZE)
+                  RETURN
+C
+C  DEACTIVATE SHIELDING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                  ICOUNT = 0
+                  SHIELD = .FALSE.
+                  RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP3-UNDEFINED OPTION',1,1)
+      RETURN
+C
+C  ILLEGAL USE OF CON WITH CIL OR CHL
+C
+  140 CALL SETER
+     1('CONOP3-ILLEGAL USE OF CON OPTION WITH CIL OR CHL OPTION',
+     2 1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conop4.f b/sys/gio/ncarutil/conlib/conop4.f
new file mode 100644
index 00000000..f963dcf9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop4.f
@@ -0,0 +1,197 @@
+      SUBROUTINE CONOP4 (IOPT,ARRAY,ISIZE,IFORT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT  --  CHARACTER STRING OF OPTION VALUE
+C     ARRAY --  CHARACTER INPUT DATA
+C     ISIZE --  INTEGER INPUT
+C     IFORT --  INTEGER.  THIS VALUE IS USED ONLY WHEN IOPT IS
+C               "FMT=ON".  IN THIS CASE, IFORT IS THE TOTAL NUMBER
+C               OF CHARACTERS TO BE PROCESSED BY THE FORMAT
+C               STATEMENT.  FOR EXAMPLE, FOR THE FORMAT "F10.3",
+C               IFORT SHOULD BE SET TO 10.
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*(*)  ARRAY
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+        SAVE
+C
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  TITLE OPTION GET VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'TL') THEN
+C
+C  SWITCH ON GET TITLE AND COUNT FROM INPUT
+C
+            IF (OPT .EQ. 'ON') THEN
+              TITLE = .TRUE.
+                ISTRNG = ARRAY
+                  ICNT = ISIZE
+              RETURN
+C
+C  SWITCH OFF OPTION DEACTIVATED
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              TITLE = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  CHANGE DATA VALUE FORMAT
+C
+      ELSEIF (TAG .EQ. 'FM') THEN
+C
+C  SWITCH ON GET USER FORMAT
+C
+          IF (OPT .EQ. 'ON') THEN
+                FORM = ARRAY
+              LEN = ISIZE
+              IFMT = IFORT
+              RETURN
+C
+C SWITCH OFF SET FORMAT TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                FORM = '(G10.3)'
+                  LEN = LEND
+              IFMT = IFMTD
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DASH PATTERN OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'DA') THEN
+C
+C  SWITCH OFF DEFAULT PATTERNS
+C
+          IF (OPT .EQ. 'OF') THEN
+                  NDASH = '$$$$$$$$$$'
+                  EDASH = '$$$$$$$$$$'
+                  IDASH = '$$$$$$$$$$'
+                  RETURN
+C
+C  SWITCH ALL SET GTR,LSS,AND EQU TO SAME VALUE
+C
+          ELSEIF (OPT .EQ. 'AL') THEN
+                  IDASH = ARRAY
+                  EDASH = ARRAY
+                  NDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO POS CHANGE POS DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'GT') THEN
+                  IDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO NEG SET NEG DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'LS') THEN
+                  NDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO EQU SET EQUAL DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'EQ') THEN
+                EDASH = ARRAY
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP4-UNDEFINED OPTION',1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conot2.f b/sys/gio/ncarutil/conlib/conot2.f
new file mode 100644
index 00000000..f2bc6aed
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conot2.f
@@ -0,0 +1,178 @@
+      SUBROUTINE CONOT2 (IVER,IUNIT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C + NOAO - This routine is a no-op in IRAF.
+C - NOAO
+C
+C  OUTPUT THE OPTION VALUES TO THE LINE PRINTER
+C
+C  CONTINUE FOR CONRAN AND CONRAS
+C
+C
+C
+C      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+C     1                FINC       ,HI         ,FLO
+C      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+C     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+C     2                CINC       ,CHILO      ,CON        ,LABON      ,
+C     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+C     4                BPSIZ      ,LISTOP
+C      COMMON /CONRA3/ IREC
+C      COMMON /CONRA4/ NCP        ,NCPSZ
+C      COMMON /CONRA5/ NIT        ,ITIPV
+C      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+C     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+C     2                YRG        ,BORD       ,PXST       ,PYST       ,
+C     3                PXED       ,PYED       ,ITICK
+C      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+C      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+C     1              LEN      ,IFMT       ,LEND       ,
+C     2                IFMTD      ,ISIZEP     ,INMIN
+C      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+C     1                BR         ,TL         ,BL         ,CONV       ,
+C     2                XN         ,YN         ,ITLL       ,IBLL       ,
+C     3                ITRL       ,IBRL       ,XC         ,YC         ,
+C     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+C     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+C      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+C     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+C     2                ITPV
+C      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+C     1                MINGAP     ,ISIZEM         ,
+C     2                TENS
+C      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+C      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+C     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+C     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+C     3                TITLE      ,LISTOP     ,CHILO      ,CON
+C      COMMON /CONR15/ ISTRNG
+C        CHARACTER*64 ISTRNG
+C        COMMON /CONR16/ FORM
+C        CHARACTER*10 FORM
+C        COMMON /CONR17/ NDASH, IDASH, EDASH
+C        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C      SAVE
+C
+C  LABEL THE CONTOURS
+C
+C      WRITE (IUNIT,1001)
+C      IF (LABON) GO TO  100
+C      WRITE (IUNIT,1002)
+C      GO TO  110
+C  100 WRITE (IUNIT,1003)
+C
+C  LABEL SIZE
+C
+C  110 WRITE (IUNIT,1004) ISIZEL
+C
+C  SCALE DATA ON CONTOURS
+C
+C      WRITE (IUNIT,1005)
+C      IF (SCALE .NE. 1.) GO TO  120
+C      WRITE (IUNIT,1006)
+C      GO TO  130
+C  120 WRITE (IUNIT,1007) SCALE
+C
+C  TENSION FACTOR
+C
+C  130 WRITE (IUNIT,1008) TENS
+C
+C  PLOT RELATIVE MINS AND MAXS
+C
+C      WRITE (IUNIT,1009)
+C      IF (PMIMX) GO TO  140
+C      WRITE (IUNIT,1010)
+C      GO TO  150
+C  140 WRITE (IUNIT,1011)
+C
+C  SIZE OF MINIMUM AND MAXIMUM LABELS
+C
+C  150 WRITE (IUNIT,1012) ISIZEM
+C
+C  DASH PATTERN
+C
+C      WRITE (IUNIT,1013)
+C      IF (IDASH(1:1) .EQ. ' ') GO TO  170
+C      WRITE (IUNIT,1014) IDASH
+C      GO TO  180
+C  170 WRITE (IUNIT,1015)
+C  180 IF (EDASH(1:1) .EQ. ' ') GO TO  200
+C      WRITE (IUNIT,1016) EDASH
+C      GO TO  210
+C  200 WRITE (IUNIT,1017)
+C  210 IF (NDASH(1:1) .EQ. ' ') GO TO  230
+C      WRITE (IUNIT,1018) NDASH
+C      GO TO  240
+C  230 WRITE (IUNIT,1019)
+C
+C  DASH PATTERN BREAK POINT
+C
+C  240 WRITE (IUNIT,1020) BPSIZ
+C
+C  PRINT MINOR LINE GAP
+C
+C      ITT = MINGAP-1
+C      WRITE (IUNIT,1021) ITT
+C      RETURN
+C
+C 1001 FORMAT (5X,'LABEL THE CONTOURS, LAB=')
+C 1002 FORMAT ('+',28X,'OFF')
+C 1003 FORMAT ('+',28X,'ON')
+C 1004 FORMAT (5X,'CONTOUR LABEL SIZE IN PWRIT UNITS, LSZ=',I4)
+C 1005 FORMAT (5X,'SCALE THE DATA ON CONTOUR LINES, SDC=')
+C 1006 FORMAT ('+',41X,'OFF')
+C 1007 FORMAT ('+','ON, SCALE FACTOR=',G10.3)
+C 1008 FORMAT (5X,'TENSION FACTOR (USED FOR SMOOTH AND SUPER), TEN=',
+C     1        F6.2)
+C 1009 FORMAT (5X,'PLOT RELATIVE MINIMUMS AND MAXIMUMS, PMM=')
+C 1010 FORMAT ('+',45X,'OFF')
+C 1011 FORMAT ('+',45X,'ON')
+C 1012 FORMAT (5X,'SIZE OF MIN AND MAX LABELS IN PWRIT UNITS SML=',
+C     1        I4)
+C 1013 FORMAT (5X,'DASH PATTERN GTR=GREATER, EQU=EQUAL, LSS=LESS')
+C 1014 FORMAT (10X,'GTR=',A10)
+C 1015 FORMAT (10X,'GTR=$$$$$$$$$$')
+C 1016 FORMAT (10X,'EQU=',A10)
+C 1017 FORMAT (10X,'EQU=$$$$$$$$$$')
+C 1018 FORMAT (10X,'LSS=',A10)
+C 1019 FORMAT (10X,'LSS=$$$$$$$$$$')
+C 1020 FORMAT (5X,'DASH PATTERN BREAK POINT, DBP=',G10.3)
+C 1021 FORMAT (5X,'MINOR LINE COUNT=',I3)
+C
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONTERP TO ULIB                             *
+C*  AUGUST 1980 FIXED THE FOLLOWING PROBLEMS                      *
+C*              1.PLOTTING OF INPUT DATA VALUES                   *
+C*              2.SETTING OF MINIMUM INTENSITY IN ALL OPTION      *
+C*              3.SETTING OF EQU FLAG IN CONTOUR DASH PATTERN     *
+C*              4.TURNING OFF OF SIZE OF PLOTTED DATA OPTION      *
+C*  DECEMBER 1980 FIXED CONTOUR SELECTION ALGORITHM  AND MOVED IN *
+C*                DASH PACKAGE COMMON BLOCK INTPR
+C*  MARCH 1981  FIXED NON-PORTABLE STATEMENT ORDERING IN CONSET   *
+C*  APRIL 1981  FIXED OPTION LISTING ROUTINE                      *
+C*              ADDED MINOR LINE COUNT OPTION                     *
+C*  JULY 1983   ADDED LINEAR INTERPOLATION AND SHIELDING          *
+C*  JULY 1984     CONVERTED TO STANDARD FORTRAN77 AND GKS         *
+C*  AUGUST 1985 DELETED LOC (MACHINE DEPENDENT FUNCTION), CHANGED *
+C*              COMMON /CONR13/                                   *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conout.f b/sys/gio/ncarutil/conlib/conout.f
new file mode 100644
index 00000000..c2684de9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conout.f
@@ -0,0 +1,350 @@
+      SUBROUTINE CONOUT (IVER)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C + NOAO - This routine is a no-op in IRAF.
+C - NOAO
+C
+C  LIST OUT ALL THE CONRAN OPTION VALUES ON THE LINE PRINTER
+C
+C  THE VALUE OF IVER DETERMINES WHICH ENTRY POINT CALLED THIS ROUTINE
+C
+C 1. CONRAQ
+C 2. CONRAN
+C 3. CONRAS
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+      SAVE
+C
+C  GET THE STANDARD OUTPUT UNIT TO WRITE THE OPTION VALUE LIST
+C
+      IUNIT = I1MACH(2)
+C
+C  PRINT OUT HEADER AND ALL OPTIONS WHICH APPLY TO CALLING VERSION
+C
+C     GO TO ( 100, 110, 120),IVER
+C 100 WRITE (IUNIT,1001)
+C     GO TO  130
+C 110 WRITE (IUNIT,1002)
+C     GO TO  130
+C 120 WRITE (IUNIT,1003)
+C 130 WRITE (IUNIT,1004)
+C
+C  PERIMETER
+C
+C     WRITE (IUNIT,1005)
+C     IF (PER) GO TO  140
+C     WRITE (IUNIT,1006)
+C     GO TO  150
+C 140 WRITE (IUNIT,1007)
+C
+C  GRID
+C
+C 150 WRITE (IUNIT,1008)
+C     IF (GRD) GO TO  160
+C     WRITE (IUNIT,1009)
+C     GO TO  170
+C 160 WRITE (IUNIT,1010)
+C
+C  SCALING OF DATA ON FRAME
+C
+C 170 WRITE (IUNIT,1011)
+C     GO TO ( 180, 190, 200),ISCALE+1
+C 180 WRITE (IUNIT,1012)
+C     GO TO  210
+C 190 WRITE (IUNIT,1013)
+C     GO TO  210
+C 200 WRITE (IUNIT,1014)
+C
+C  SAME DATA ANOTHER PLOT
+C
+C 210 WRITE (IUNIT,1015)
+C     IF (REPEAT) GO TO  220
+C     WRITE (IUNIT,1016)
+C     GO TO  230
+C 220 WRITE (IUNIT,1017)
+C
+C  SHIELDING
+C
+C 230 WRITE(IUNIT,2000)
+C     IF (SHIELD) GO TO 231
+C     WRITE(IUNIT,2001)
+C     GO TO 232
+C 231 WRITE(IUNIT,2002)
+C
+C  INTERPOLATION
+C
+C 232 WRITE(IUNIT,2003)
+C     IF (LINEAR) GO TO 233
+C     WRITE(IUNIT,2004)
+C     GO TO 234
+C 233 WRITE(IUNIT,2005)
+C
+C  PLOT THE SHIELD
+C
+C 234 WRITE(IUNIT,2006)
+C     IF (SLDPLT) GO TO 235
+C     WRITE(IUNIT,2007)
+C     GO TO 236
+C 235 WRITE(IUNIT,2008)
+C
+C  EXTRAPOLATION
+C
+C 236 WRITE (IUNIT,1018)
+C     IF (EXTRAP) GO TO  240
+C     WRITE (IUNIT,1019)
+C     GO TO  250
+C 240 WRITE (IUNIT,1020)
+C
+C  STEP SIZE OR RESOLUTION OF THE GRID
+C
+C 250 WRITE (IUNIT,1021) IGRAD
+C
+C  MESSAGE AT BOTTOM OF PLOT
+C
+C     WRITE (IUNIT,1022)
+C     IF (MESS) GO TO  260
+C     WRITE (IUNIT,1023)
+C     GO TO  270
+C 260 WRITE (IUNIT,1024)
+C
+C  TITLE AT TOP OF PLOT
+C
+C 270 WRITE (IUNIT,1025)
+C     IF (TITLE) GO TO  280
+C     WRITE (IUNIT,1026)
+C     GO TO  290
+C 280 WRITE (IUNIT,1027)
+C
+C  SIZE OF TITLE
+C
+C 290 WRITE (IUNIT,1028) ITLSIZ
+C
+C  PRINT TITLE
+C
+C     IF (ICNT.EQ.0 .OR. .NOT.TITLE) GO TO  310
+C     ICC = 100
+C     IF (ICC .GT. ICNT) ICC = ICNT
+C     WRITE (IUNIT,1029) ISTRNG
+C
+C  DATA POINTS USED FOR PARTIAL DERIVATIVE ESTIMATION
+C
+C 310 WRITE (IUNIT,1030) NCP
+C
+C  LOOK AT TRIANGLES SWITCH
+C
+C     WRITE (IUNIT,1031)
+C     IF (LOOK) GO TO  320
+C     WRITE (IUNIT,1032)
+C     GO TO  330
+C 320 WRITE (IUNIT,1033)
+C
+C  ADVANCE FRAME BEFORE PLOTTING TRIANGULATION
+C
+C 330 WRITE (IUNIT,1034)
+C     IF (FRADV) GO TO  340
+C     WRITE (IUNIT,1035)
+C     GO TO  350
+C 340 WRITE (IUNIT,1036)
+C
+C  TRIANGLES ONLY PLOT
+C
+C 350 WRITE (IUNIT,1037)
+C     IF (EXTRI) GO TO  360
+C     WRITE (IUNIT,1038)
+C     GO TO  370
+C 360 WRITE (IUNIT,1039)
+C
+C  PLOT THE INPUT DATA VALUES
+C
+C 370 WRITE (IUNIT,1040)
+C     IF (PLDVLS) GO TO  380
+C     WRITE (IUNIT,1041)
+C     GO TO  390
+C 380 WRITE (IUNIT,1042)
+C
+C  FORMAT OF THE PLOTTED INPUT DATA
+C
+C 390 WRITE (IUNIT,1043)
+C     IF (LEN .NE. 0) GO TO  400
+C     WRITE (IUNIT,1044)
+C     GO TO  420
+C 400 WRITE (IUNIT,1045) FORM
+C
+C  SIZE OF THE PLOTTED DATA VALUES
+C
+C 420 WRITE (IUNIT,1046) ISIZEP
+C
+C  INTENSITY SETTINGS
+C
+C     WRITE (IUNIT,1047)
+C     WRITE (IUNIT,1048) INMAJ,INMIN,INLAB,INDAT
+C
+C  DISTLAY CONTOUR SETTING
+C
+C     WRITE (IUNIT,1049)
+C     IF (CON) GO TO  430
+C     WRITE (IUNIT,1050)
+C     GO TO  440
+C 430 WRITE (IUNIT,1051) NCL,(CL(I),I=1,NCL)
+C
+C  CONTOUR INCREMENT
+C
+C 440 WRITE (IUNIT,1052)
+C     IF (CINC) GO TO  450
+C     WRITE (IUNIT,1053)
+C     GO TO  460
+C 450 WRITE (IUNIT,1054) FINC
+C
+C  CONTOUR HIGH AND LOW VALUES
+C
+C 460 WRITE (IUNIT,1055)
+C     IF (CHILO) GO TO  470
+C     WRITE (IUNIT,1056)
+C     GO TO  480
+C 470 WRITE (IUNIT,1057) HI,FLO
+C
+C  CALL CONOT2 IF NOT QUICK VERSION
+C
+C 480 IF (IVER .NE. 1) CALL CONOT2 (IVER,IUNIT)
+C
+C  THE ROUTINE CONOT2 WAS GENERATED TO ELIMINATE COMPILER ERRORS
+C  RESULTING FROM TOO MANY FORMAT STATEMENTS IN ONE SUBROUTINE
+C
+C     RETURN
+C
+C
+C1001 FORMAT (1X,'CONRAQ')
+C1002 FORMAT (1X,'CONRAN')
+C1003 FORMAT (1X,'CONRAS')
+C1004 FORMAT ('+',6X,'-OPTION VALUE SETTINGS',/
+C    1        ,7X,'ALL NON-PWRIT VALUES APPLY TO THE UNSCALED DATA')
+C1005 FORMAT (5X,'PERIMETER, PER=')
+C1006 FORMAT ('+',19X,'OFF')
+C1007 FORMAT ('+',19X,'ON')
+C1008 FORMAT (5X,'GRID, GRD=')
+C1009 FORMAT ('+',14X,'OFF')
+C1010 FORMAT ('+',14X,'ON')
+C1011 FORMAT (5X,'SCALING OF PLOT ON FRAME, SCA=')
+C1012 FORMAT ('+',34X,'ON')
+C1013 FORMAT ('+',34X,'OFF')
+C1014 FORMAT ('+',34X,'PRI')
+C1015 FORMAT (5X,'SAME DATA FOR ANOTHER PLOT, REP=')
+C1016 FORMAT ('+',36X,'OFF')
+C1017 FORMAT ('+',36X,'ON')
+C1018 FORMAT (5X,'EXTRAPOLATION, EXT=')
+C1019 FORMAT ('+',23X,'OFF')
+C1020 FORMAT ('+',23X,'ON')
+C1021 FORMAT (5X,'RESOLUTION, SSZ=',I4)
+C1022 FORMAT (5X,'MESSAGE, MES=')
+C1023 FORMAT ('+',17X,'OFF')
+C1024 FORMAT ('+',17X,'ON')
+C1025 FORMAT (5X,'TITLE, TLE=')
+C1026 FORMAT ('+',15X,'OFF')
+C1027 FORMAT ('+',15X,'ON')
+C1028 FORMAT (5X,'TITLE SIZE IN PWRIT UNITS, STL=',I4)
+C1029 FORMAT (5X,'TITLE=',A64)
+C1030 FORMAT (5X,'DATA POINTS USED FOR PARTIAL DERIVATIVE',
+C    1' ESTIMATION,  NCP=',I4)
+C1031 FORMAT (5X,'LOOK AT TRIANGLES, TRI=')
+C1032 FORMAT ('+',27X,'OFF')
+C1033 FORMAT ('+',27X,'ON')
+C1034 FORMAT (5X,'ADVANCE FRAME BEFORE PLOTTING TRIANGULATION,',
+C    1' TFR=')
+C1035 FORMAT ('+',53X,'OFF')
+C1036 FORMAT ('+',53X,'ON')
+C1037 FORMAT (5X,'TRIANGULATION ONLY PLOT, TOP=')
+C1038 FORMAT ('+',33X,'OFF')
+C1039 FORMAT ('+',33X,'ON')
+C1040 FORMAT (5X,'PLOT THE INPUT DATA VALUES, PDV=')
+C1041 FORMAT ('+',36X,'OFF')
+C1042 FORMAT ('+',36X,'ON')
+C1043 FORMAT (5X,'FORMAT OF THE PLOTTED INPUT DATA, FMT=')
+C1044 FORMAT ('+',42X,'(G10.3)')
+C1045 FORMAT ('+',42X,A10)
+C1046 FORMAT (5X,'SIZE OF THE PLOTTED DATA VALUES IN PWRIT',
+C    1' UNITS, SPD=',I4)
+C1047 FORMAT (5X,'COLOR (INTENSITY) INDICES FOLLOW.',
+C    1' FOR CONRAQ MAJOR CONTOURS ARE ONLY USED')
+C1048 FORMAT (10X,'MAJOR CONTOUR LINES, MAJ=',I4,/
+C    1        ,10X,'MINOR CONTOUR LINES, MIN=',I4,/
+C    2        ,10X,'TITLE AND MESSAGE, LAB=',I4,/
+C    3        ,10X,'PLOTTED DATA VALUES, DAT=',I4)
+C1049 FORMAT (5X,'CONTOUR LEVELS,  CON=')
+C1050 FORMAT ('+',25X,'OFF')
+C1051 FORMAT ('+',25X,'ON, NCL=',I4,' ARRAY='/(10(2X,F10.3)))
+C1052 FORMAT (5X,'CONTOUR INCREMENT, CIL=')
+C1053 FORMAT ('+',27X,'OFF')
+C 1054 FORMAT ('+',27X,'ON, INCREMENT=',G10.3)
+C 1055 FORMAT (5X,'CONTOUR HIGH AND LOW VALUES, CHL=')
+C 1056 FORMAT ('+',37X,'OFF')
+C 1057 FORMAT ('+',37X,'ON, HI=',G10.3,' FLO=',G10.3)
+C 2000 FORMAT (5X,'SHIELDING, SLD=')
+C 2001 FORMAT ('+',19X,'OFF')
+C 2002 FORMAT ('+',19X,'ON')
+C 2003 FORMAT (5X,'INTERPOLATION, ITP=')
+C 2004 FORMAT ('+',23X,'C1 SURFACE')
+C 2005 FORMAT ('+',23X,'LINEAR')
+C 2006 FORMAT (5X,'PLOT THE SHIELD, SPT=')
+C 2007 FORMAT ('+',25X,'OFF')
+C 2008 FORMAT ('+',25X,'ON')
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conpdv.f b/sys/gio/ncarutil/conlib/conpdv.f
new file mode 100644
index 00000000..49c1f61f
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conpdv.f
@@ -0,0 +1,118 @@
+      SUBROUTINE CONPDV (XD,YD,ZD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  PLOT THE DATA VALUES ON THE CONTOUR MAP
+C  CURRENTLY UP TO 10 CHARACTERS FOR EACH VALUE ARE DISPLAYED
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+      CHARACTER*10  ISTR
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)
+C
+        SAVE
+C
+C  DATA TO CONVERT 0-32767 COORIDNATES TO 1-1024 VALUES
+C
+        DATA TRANS/32./
+C
+C  SET INTENSITY
+C
+        IF (INDAT .NE. 1) THEN
+          CALL GSTXCI (INDAT)
+        ELSE
+            CALL GSTXCI (IRANTX)
+      ENDIF
+C
+C  SET FORMAT IF NONE SPECIFIED
+C
+      IF (LEN .NE. 0) GO TO  110
+        FORM = '(G10.3)'
+      LEN = LEND
+      IFMT = IFMTD
+C
+C  LOOP AND PLOT ALL VALUES
+C
+  110 DO  120 K=1,NDP
+         CALL FL2INT (XD(K),YD(K),MX,MY)
+         MX = IFIX(FLOAT(MX)/TRANS)+1
+         MY = IFIX(FLOAT(MY)/TRANS)+1
+C
+C + NOAO - FTN internal write rewritten as call to encode for IRAF
+C
+C      WRITE(ISTR,FORM)ZD(K)
+       call encode (len, form, istr, zd(k))
+C
+C - NOAO
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+C
+         CALL WTSTR(XC,YC,ISTR,ISIZEP,0,0)
+      CALL GSELNT(ICN)
+  120 CONTINUE
+        IF (INDAT .NE. 1) THEN
+            CALL GSTXCI (IRANTX)
+        ENDIF
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conreo.f b/sys/gio/ncarutil/conlib/conreo.f
new file mode 100644
index 00000000..c029c0bb
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conreo.f
@@ -0,0 +1,129 @@
+      SUBROUTINE CONREO (MAJLNS)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS ROUTINE PUTS THE MAJOR (LABELED) LEVELS IN THE BEGINNING OF CL
+C AND THE MINOR (UNLABELED) LEVELS IN END OF CL.  THE NUMBER OF MAJOR
+C LEVELS IS RETURNED IN MAJLNS.  PV IS USED AS A WORK SPACE.  MINGAP IS
+C THE NUMBER OF MINOR GAPS (ONE MORE THAN THE NUMBER OF MINOR LEVELS
+C BETWEEN MAJOR LEVELS).
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10    NDASH, IDASH, EDASH
+C
+        SAVE
+C
+      NL = NCL
+      IF (NL.LE.4 .OR. MINGAP.LE.1) GO TO   160
+      NML = MINGAP-1
+      IF (NL.LE.10) NML = 1
+C
+C CHECK FOR BREAK POINT IN THE LIST OF CONTOURS FOR A MAJOR LINE
+C
+      NMLP1 = NML+1
+          DO    10 I=1,NL
+          ISAVE = I
+          IF (CL(I).EQ.BPSIZ) GO TO    40
+   10     CONTINUE
+C
+C  NO BREAKPOINT FOUND SO TRY FOR A NICE NUMBER
+C
+      L = NL/2
+      L = ALOG10( ABS( CL(L) ) )+1.
+      Q = 10.**L
+          DO    30 J=1,3
+          Q = Q/10.
+              DO    20 I=1,NL
+              ISAVE = I
+              IF (AMOD( ABS( CL(I) + 1.E-9*CL(I) )/Q,FLOAT(NMLP1) ).LE.
+     1            .0001) GO TO    40
+   20         CONTINUE
+   30     CONTINUE
+      ISAVE = NL/2
+C
+C PUT MAJOR LEVELS IN PV
+C
+   40 ISTART = MOD(ISAVE,NMLP1)
+      IF (ISTART.EQ.0) ISTART = NMLP1
+      NMAJL = 0
+          DO    50 I=ISTART,NL,NMLP1
+          NMAJL = NMAJL+1
+          PV(NMAJL) = CL(I)
+   50     CONTINUE
+      MAJLNS = NMAJL
+      L = NMAJL
+C
+C PUT MINOR LEVELS IN PV
+C
+      IC = NML/2 + 1
+      L = MAJLNS+1
+          DO   100 LOOP=1,NML
+          IC1 = IC
+              DO    90 IWCH=1,2
+              IF (LOOP.EQ.1) GO TO    60
+              IC1 = IC+(LOOP-1)
+              IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
+              IF (IC1.GE.NMLP1) GO TO    90
+              IF (IC1.LE.0) GO TO    90
+   60             DO    70 K=ISTART,NL,NMLP1
+                  IND = K+IC1
+                  IF (IND.GT.NL) GO TO    80
+                  PV(L) = CL(IND)
+                  L = L+1
+   70             CONTINUE
+   80         IF (LOOP.EQ.1) GO TO   100
+   90         CONTINUE
+  100     CONTINUE
+C
+C  IF MAJOR LINES DID NOT START ON THE FIRST ENTRY PICK UP THE MISSING
+C  LEVELS
+C
+      IF (ISTART.EQ.1) GO TO   140
+          DO   130 LOOP=1,NML
+          IC1 = IC
+              DO   120 IWCH=1,2
+              IF (LOOP.EQ.1) GO TO   110
+              IC1 = IC+(LOOP-1)
+              IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
+  110         IF (IC1.GE.ISTART) GO TO   120
+              IF (IC1.LE.0) GO TO   120
+              PV(L) = CL(IC1)
+              L = L+1
+              IF (LOOP.EQ.1) GO TO   130
+  120         CONTINUE
+  130     CONTINUE
+C
+C PUT REORDERED ARRAY BACK IN ORIGINAL PLACE
+C
+  140     DO   150 I=1,NL
+          CL(I) = PV(I)
+  150     CONTINUE
+      RETURN
+  160 MAJLNS = NL
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/consld.f b/sys/gio/ncarutil/conlib/consld.f
new file mode 100644
index 00000000..fd40e10d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/consld.f
@@ -0,0 +1,165 @@
+        SUBROUTINE CONSLD (SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS ROUTINE IS USED TO GENERATE A SHIELD WHERE CONTOUR
+C  DRAWING IS ALLOWED.
+C
+C  THE ROUTINE TAKES THE SILHOUETTE INFORMATION FROM COMMON BLOCK
+C  CONR13 AND TRANSFORMS THIS INTO A SHIELD TO BE USED IN THE
+C  SCRATCH ARRAY PASSED IN BY THE USER (THE SCRATCH ARRAY HOLDS THE
+C  GRIDED DATA FROM THE INTERPOLATION).
+C
+C  INPUT
+C       SCRARR-THE SCRATCH ARRAY HOLDING THE INTERPOLATED DATA
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+C  INCREASE THE RESOLUTION OF THE SHIELD PROFILE
+C
+      DIMENSION SCRARR(1)
+C
+      SAVE
+      DATA RESINC/8.0/
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+C +NOAO
+C  These statement functions are never called.
+C     SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C     IARVL(IXX,IYY) = IYY+(IXX-1)*IYMAX
+C -NOAO
+      IGADDR(XXX,YYY) =
+     1 IFIX((YYY-YST)/STPSZ+.5)+(IFIX((XXX-XST)/STPSZ+.5))*IYMAX
+C
+C  SET THE SPECIAL VALUE
+C
+      SPVAL = SPVAL * 2.
+C
+C  SET THE USER ARRAY LOCATIONS TO TEMPORARY POINTERS
+C
+C  LOOP FOR ALL SHIELD ELEMENTS
+C
+      DO 100 IC = 1,ICOUNT
+C
+C       ASSIGN LINE SEGMENT END POINTS
+C
+        X1 = XVS(IC)
+        Y1 = YVS(IC)
+        IF (IC .EQ. ICOUNT) GO TO 10
+                X2 = XVS(IC+1)
+                Y2 = YVS(IC+1)
+                GO TO 15
+ 10             CONTINUE
+                X2 = XVS(1)
+                Y2 = YVS(1)
+ 15     CONTINUE
+C
+C  INSURE THAT ALL POINTS ARE IN THE CONVEX HULL
+C
+      IF (X1.GT.XED) X1 = XED
+      IF (X1.LT.XST) X1 = XST
+      IF (X2.GT.XED) X2 = XED
+      IF (X2.LT.XST) X2 = XST
+      IF (Y1.GT.YED) Y1 = YED
+      IF (Y1.LT.YST) Y1 = YST
+      IF (Y2.GT.YED) Y2 = YED
+      IF (Y2.LT.YST) Y2 = YST
+C
+C       SET THE START OF THE LINE SEGMENT SCRATCH LOCATION TO
+C       THE SPECIAL VALUE
+C
+        II = IGADDR(X1,Y1)
+        SCRARR(II) = SPVAL
+C
+C       FIND THE LENGTH OF THE LINE SEGMENT
+C
+        DIST = SQRT(((X2-X1)**2)+((Y2-Y1)**2))
+C
+C       IF LENGTH SHORTER THAN STEP SIZE THEN THERE IS NOTHING TO DO
+C
+        IF (DIST .LE. STPSZ) GO TO 100
+C
+C       SET UP LOOP TO SET ALL CELLS ON THE LINE SEGMENT
+C
+        NSTPS = (DIST/STPSZ)*RESINC
+        XSTP = (X2-X1)/FLOAT(NSTPS)
+        YSTP = (Y2-Y1)/FLOAT(NSTPS)
+        X = X1
+        Y = Y1
+        DO 20 K = 1,NSTPS
+                X = X + XSTP
+                Y = Y + YSTP
+                II = IGADDR(X,Y)
+                SCRARR(II) = SPVAL
+ 20     CONTINUE
+C
+ 100  CONTINUE
+C
+C  FILL THE SHIELDED AREAS
+C       FOR EACH COLUMN THE ELEMENTS ARE SET TO SPVAL IF FILL IS TRUE.
+C       THE VALUE OF FILL IS NEGATED EVERY TIME A SPVAL IS ENCOUNTERED,
+C       AND THAT CELL REMAINS UNCHANGED.
+C
+C       LOOP THROUGH THE GRID
+C
+        DO 39 I = 1,IXMAX
+C
+C               GET THE START AND END FOR THE COLUMN
+C
+                IYS = (I-1)*IYMAX+1
+                IYE = I*IYMAX
+C
+C               ADVANCE IN THE FORWARD DIRECTION
+C
+                DO 32 J = IYS,IYE
+C
+C                       IF NOT SPVAL THEN SET CELL AS APPROPIATE
+C
+                        IF (SCRARR(J).EQ.SPVAL) GO TO 33
+                                SCRARR(J) = SPVAL
+ 32             CONTINUE
+                GO TO 39
+C
+C               ADVANCE IN THE BACKWARD DIRECTION
+C
+ 33             CONTINUE
+                DO 34 J = 1,IYMAX
+                        NJ =IYE+1-J
+C                       IF NOT SPVAL THEN SET CELL AS APPROPIATE
+C
+                        IF (SCRARR(NJ).EQ.SPVAL) GO TO 39
+                                SCRARR(NJ) = SPVAL
+ 34             CONTINUE
+ 39     CONTINUE
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conssd.f b/sys/gio/ncarutil/conlib/conssd.f
new file mode 100644
index 00000000..26ac20d1
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conssd.f
@@ -0,0 +1,61 @@
+      SUBROUTINE CONSSD(X,Y,IC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS SUBROUTINE SETS THE SHIELDING FLAG AND CONNECTS THE
+C  USERS SHIELD ARRAYS TO SOME INTERNAL POINTERS
+C
+C  INPUT
+C       X-X COORDINATE STRING
+C       Y-Y COORDINATE STRING
+C       IC-NUMBER OF COORDINATES
+C
+C  NOTE THE USERS ARRAYS CANNOT BE MUCKED WITH DURING EXECUTION
+C       THOSE ARRAYS ARE USED DURING CONRAN EXECUTION
+C
+      DIMENSION X(1),Y(1)
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+        SAVE
+C
+C  SET COUNTER
+C
+      ICOUNT = IC
+C
+C  CHECK THE DIMENSION OF SHIELD ARRAYS
+C
+      IERUNT = I1MACH(4)
+      IF (ICOUNT .GT. 50) THEN
+        CALL SETER (' CONSSD -- NUMBER OF SHIELD POINTS .GT. 50',1,1)
+C
+C + NOAO - FTN write and format statement commented out; SETER is enough.
+C       WRITE(IERUNT,1001)
+        ICOUNT = 50
+      ENDIF
+C1001 FORMAT(' ERROR 1 IN CONSSD -- NUMBER OF SHIELD POINTS .GT. 50')
+C - NOAO
+C
+C  SET THE SHIELDING FLAG TO TRUE
+C
+      SHIELD = .TRUE.
+C
+C  COMPUTE POINTERS FOR THE USERS SHIELDING ARRAYS
+C
+      DO 300 I = 1,ICOUNT
+        XVS(I) = X(I)
+ 300  YVS(I) = Y(I)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/constp.f b/sys/gio/ncarutil/conlib/constp.f
new file mode 100644
index 00000000..8df0e23b
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/constp.f
@@ -0,0 +1,135 @@
+      SUBROUTINE CONSTP (XD,YD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  COMPUTE STEP SIZE IN X AND Y DIRECTION
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)
+C
+        SAVE
+C
+C  FIND SMALLEST AND LARGST X AND Y
+C
+      XST = XD(1)
+      XED = XD(1)
+      YST = YD(1)
+      YED = YD(1)
+      DO  130 I=2,NDP
+         IF (XST .LE. XD(I)) GO TO  100
+         XST = XD(I)
+         GO TO  110
+  100    IF (XED .GE. XD(I)) GO TO  110
+         XED = XD(I)
+  110    IF (YST .LE. YD(I)) GO TO  120
+         YST = YD(I)
+         GO TO  130
+  120    IF (YED .GE. YD(I)) GO TO  130
+         YED = YD(I)
+  130 CONTINUE
+C
+C  COMPUTE STEP SIZE
+C
+      XRG = (ABS(XED-XST))
+      YRG = (ABS(YED-YST))
+      SQRG = XRG
+      IF (SQRG .LT. YRG) SQRG = YRG
+      STPSZ = SQRG/FLOAT(IGRAD-1)
+C
+C  COMPUTE PARAMETERS FOR SET CALL
+C
+      DIFX = XRG/SQRG
+      DIFY = YRG/SQRG
+      PXST = .5-(BORD*DIFX)/2.
+      PXED = .5+(BORD*DIFX)/2.
+      PYST = .5-(BORD*DIFY)/2.
+      PYED = .5+(BORD*DIFY)/2.
+      XRG = XRG/FLOAT(ITICK)
+      YRG = YRG/FLOAT(ITICK)
+C
+C  TEST IF THE ASPECT RATIO FOR THE COORDINATES IS REASONABLE.
+C     REASONABLE IS CURRENTLY DEFINED AS 5 TO 1.
+C     IF IT IS NOT REASONABLE THEN A POOR PLOT MAY BE GENERATED
+C     SO IT IS NICE THE WARN THE USER WHEN THIS HAPPENS.
+C
+      TEST = XRG/YRG
+      IF (TEST.LE.5. .AND. TEST.GE.0.2) RETURN
+C
+C  WARN THE USER ON THE STANDARD OUTPUT UNIT THAT THE PLOT MAY
+C  NOT BE TOO GOOD.
+C
+C  SET RECOVERY MODE
+C
+      CALL ENTSR(IROLD,IREC)
+C
+C  FLAG THE ERROR
+C
+      CALL SETER(' ASPECT RATIO OF X AND Y GREATER THAN 5 TO 1',
+     1           1,1)
+C
+      CALL EPRIN
+C
+C  CLEAR THE ERROR
+C
+      CALL ERROF
+C
+C  RESET USER ERROR MODE
+C
+      CALL ENTSR(IDUM,IROLD)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/contlk.f b/sys/gio/ncarutil/conlib/contlk.f
new file mode 100644
index 00000000..201b4d07
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/contlk.f
@@ -0,0 +1,98 @@
+      SUBROUTINE CONTLK (XD,YD,NDP,IPT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW THE TRIANGLES CREATED BY CONTNG
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,IPT(1)
+C
+        SAVE
+C
+C  STATEMENT FUNCTIONS TO SCALE DATA FOR OVERLAYS
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C   ADVANCE PICTURE IF DESIRED
+C
+      IF (FRADV) CALL FRAME
+C
+C  DRAW TRIANGLES
+C
+      DO  100 K=1,NT
+         I = K*3
+         I1 = IPT(I)
+         I2 = IPT(I-1)
+         I3 = IPT(I-2)
+         XX = FX(XD(I1),YD(I1))
+         CALL FL2INT (XX,FY(XD(I1),YD(I1)),MX1,MY1)
+         CALL PLOTIT (MX1,MY1,0)
+         XX = FX(XD(I2),YD(I2))
+         CALL FL2INT (XX,FY(XD(I2),YD(I2)),MX,MY)
+         CALL PLOTIT (MX,MY,1)
+         XX = FX(XD(I3),YD(I3))
+         CALL FL2INT (XX,FY(XD(I3),YD(I3)),MX,MY)
+         CALL PLOTIT (MX,MY,1)
+         CALL PLOTIT (MX1,MY1,1)
+  100 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/contng.f b/sys/gio/ncarutil/conlib/contng.f
new file mode 100644
index 00000000..7ebad596
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/contng.f
@@ -0,0 +1,432 @@
+      SUBROUTINE CONTNG (NDP,XD,YD,NT,IPT,NL,IPL,IWL,IWP,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE PERFORMS TRIANGULATION.  IT DIVIDES THE X-Y
+C PLANE INTO A NUMBER OF TRIANGLES ACCORDING TO GIVEN DATA
+C POINTS IN THE PLANE, DETERMINES LINE SEGMENTS THAT FORM THE
+C BORDER OF DATA AREA, AND DETERMINES THE TRIANGLE NUMBERS
+C CORRESPONDING TO THE BORDER LINE SEGMENTS.
+C AT COMPLETION, POINT NUMBERS OF THE VERTEXES OF EACH TRIANGLE
+C ARE LISTED COUNTER-CLOCKWISE.  POINT NUMBERS OF THE END POINTS
+C OF EACH BORDER LINE SEGMENT ARE LISTED COUNTER-CLOCKWISE,
+C LISTING ORDER OF THE LINE SEGMENTS BEING COUNTER-CLOCKWISE.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD  = ARRAY OF DIMENSION NDP CONTAINING THE
+C           X COORDINATES OF THE DATA POINTS,
+C     YD  = ARRAY OF DIMENSION NDP CONTAINING THE
+C           Y COORDINATES OF THE DATA POINTS.
+C THE OUTPUT PARAMETERS ARE
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = ARRAY OF DIMENSION 6*NDP-15, WHERE THE POINT
+C           NUMBERS OF THE VERTEXES OF THE (IT)TH TRIANGLE
+C           ARE TO BE STORED AS THE (3*IT-2)ND, (3*IT-1)ST,
+C           AND (3*IT)TH ELEMENTS, IT=1,2,...,NT,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = ARRAY OF DIMENSION 6*NDP, WHERE THE POINT
+C           NUMBERS OF THE END POINTS OF THE (IL)TH BORDER
+C           LINE SEGMENT AND ITS RESPECTIVE TRIANGLE NUMBER
+C           ARE TO BE STORED AS THE (3*IL-2)ND, (3*IL-1)ST,
+C           AND (3*IL)TH ELEMENTS, IL=1,2,..., NL.
+C THE OTHER PARAMETERS ARE
+C     IWL = INTEGER ARRAY OF DIMENSION 18*NDP USED
+C           INTERNALLY AS A WORK AREA,
+C     IWP = INTEGER ARRAY OF DIMENSION NDP USED
+C           INTERNALLY AS A WORK AREA,
+C     WK  = ARRAY OF DIMENSION NDP USED INTERNALLY AS A
+C           WORK AREA.
+C DECLARATION STATEMENTS
+C
+      SAVE
+C
+      INTEGER         CONXCH
+      COMMON /CONRA3/ IREC
+      DIMENSION       XD(*)      ,YD(*)      ,IPT(*)     ,IPL(*)     ,
+     1                IWL(*)     ,IWP(*)     ,WK(*)
+      DIMENSION       ITF(2)
+        CHARACTER*4  IP1C, IP2C
+        CHARACTER*64  ITEMP
+      DATA  RATIO/1.0E-6/, NREP/100/
+C
+C STATEMENT FUNCTIONS
+C
+      DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
+      SIDE(U1,V1,U2,V2,U3,V3) = (V3-V1)*(U2-U1)-(U3-U1)*(V2-V1)
+C
+C PRELIMINARY PROCESSING
+C
+      NDPM1 = NDP-1
+C
+C DETERMINES THE CLOSEST PAIR OF DATA POINTS AND THEIR MIDPOINT.
+C
+      DSQMN = DSQF(XD(1),YD(1),XD(2),YD(2))
+      IPMN1 = 1
+      IPMN2 = 2
+      DO  140 IP1=1,NDPM1
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP1P1 = IP1+1
+         DO  130 IP2=IP1P1,NDP
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            IF (DSQI .NE. 0.) GO TO  120
+C
+C  ERROR, IDENTICAL INPUT DATA POINTS
+C
+          ITEMP = ' CONTNG-IDENTICAL INPUT DATA POINTS FOUND
+     1 AT      AND      '
+C 
+C + NOAO - FTN internal writes rewritten as calls to encode for IRAF
+C
+C         WRITE(IP1C,'(I4)')IP1
+C         WRITE(IP2C,'(I4)')IP2
+          call encode (4, '(I4)', ip1c, ip1)
+	  call encode (4, '(I4)', ip2c, ip2)
+C - NOAO
+C
+            CALL SETER (ITEMP,1,1)
+            ITEMP(46:49) = IP1C
+            ITEMP(55:58) = IP2C
+            RETURN
+  120       IF (DSQI .GE. DSQMN) GO TO  130
+            DSQMN = DSQI
+            IPMN1 = IP1
+            IPMN2 = IP2
+  130    CONTINUE
+  140 CONTINUE
+      DSQ12 = DSQMN
+      XDMP = (XD(IPMN1)+XD(IPMN2))/2.0
+      YDMP = (YD(IPMN1)+YD(IPMN2))/2.0
+C
+C SORTS THE OTHER (NDP-2) DATA POINTS IN ASCENDING ORDER OF
+C DISTANCE FROM THE MIDPOINT AND STORES THE SORTED DATA POINT
+C NUMBERS IN THE IWP ARRAY.
+C
+      JP1 = 2
+      DO  150 IP1=1,NDP
+         IF (IP1.EQ.IPMN1 .OR. IP1.EQ.IPMN2) GO TO  150
+         JP1 = JP1+1
+         IWP(JP1) = IP1
+         WK(JP1) = DSQF(XDMP,YDMP,XD(IP1),YD(IP1))
+  150 CONTINUE
+      DO  170 JP1=3,NDPM1
+         DSQMN = WK(JP1)
+         JPMN = JP1
+         DO  160 JP2=JP1,NDP
+            IF (WK(JP2) .GE. DSQMN) GO TO  160
+            DSQMN = WK(JP2)
+            JPMN = JP2
+  160    CONTINUE
+         ITS = IWP(JP1)
+         IWP(JP1) = IWP(JPMN)
+         IWP(JPMN) = ITS
+         WK(JPMN) = WK(JP1)
+  170 CONTINUE
+C
+C IF NECESSARY, MODIFIES THE ORDERING IN SUCH A WAY THAT THE
+C FIRST THREE DATA POINTS ARE NOT COLLINEAR.
+C
+      AR = DSQ12*RATIO
+      X1 = XD(IPMN1)
+      Y1 = YD(IPMN1)
+      DX21 = XD(IPMN2)-X1
+      DY21 = YD(IPMN2)-Y1
+      DO  180 JP=3,NDP
+         IP = IWP(JP)
+         IF (ABS((YD(IP)-Y1)*DX21-(XD(IP)-X1)*DY21) .GT. AR) GO TO  190
+  180 CONTINUE
+      CALL SETER (' CONTNG - ALL COLLINEAR DATA POINTS',1,1)
+  190 IF (JP .EQ. 3) GO TO  210
+      JPMX = JP
+      JP = JPMX+1
+      DO  200 JPC=4,JPMX
+         JP = JP-1
+         IWP(JP) = IWP(JP-1)
+  200 CONTINUE
+      IWP(3) = IP
+C
+C FORMS THE FIRST TRIANGLE.  STORES POINT NUMBERS OF THE VER-
+C TEXES OF THE TRIANGLE IN THE IPT ARRAY, AND STORES POINT NUM-
+C BERS OF THE BORDER LINE SEGMENTS AND THE TRIANGLE NUMBER IN
+C THE IPL ARRAY.
+C
+  210 IP1 = IPMN1
+      IP2 = IPMN2
+      IP3 = IWP(3)
+      IF (SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3)) .GE.
+     1    0.0) GO TO  220
+      IP1 = IPMN2
+      IP2 = IPMN1
+  220 NT0 = 1
+      NTT3 = 3
+      IPT(1) = IP1
+      IPT(2) = IP2
+      IPT(3) = IP3
+      NL0 = 3
+      NLT3 = 9
+      IPL(1) = IP1
+      IPL(2) = IP2
+      IPL(3) = 1
+      IPL(4) = IP2
+      IPL(5) = IP3
+      IPL(6) = 1
+      IPL(7) = IP3
+      IPL(8) = IP1
+      IPL(9) = 1
+C
+C ADDS THE REMAINING (NDP-3) DATA POINTS, ONE BY ONE.
+C
+      DO  400 JP1=4,NDP
+         IP1 = IWP(JP1)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+C
+C - DETERMINES THE VISIBLE BORDER LINE SEGMENTS.
+C
+         IP2 = IPL(1)
+         JPMN = 1
+         DXMN = XD(IP2)-X1
+         DYMN = YD(IP2)-Y1
+         DSQMN = DXMN**2+DYMN**2
+         ARMN = DSQMN*RATIO
+         JPMX = 1
+         DXMX = DXMN
+         DYMX = DYMN
+         DSQMX = DSQMN
+         ARMX = ARMN
+         DO  240 JP2=2,NL0
+            IP2 = IPL(3*JP2-2)
+            DX = XD(IP2)-X1
+            DY = YD(IP2)-Y1
+            AR = DY*DXMN-DX*DYMN
+            IF (AR .GT. ARMN) GO TO  230
+            DSQI = DX**2+DY**2
+            IF (AR.GE.(-ARMN) .AND. DSQI.GE.DSQMN) GO TO  230
+            JPMN = JP2
+            DXMN = DX
+            DYMN = DY
+            DSQMN = DSQI
+            ARMN = DSQMN*RATIO
+  230       AR = DY*DXMX-DX*DYMX
+            IF (AR .LT. (-ARMX)) GO TO  240
+            DSQI = DX**2+DY**2
+            IF (AR.LE.ARMX .AND. DSQI.GE.DSQMX) GO TO  240
+            JPMX = JP2
+            DXMX = DX
+            DYMX = DY
+            DSQMX = DSQI
+            ARMX = DSQMX*RATIO
+  240    CONTINUE
+         IF (JPMX .LT. JPMN) JPMX = JPMX+NL0
+         NSH = JPMN-1
+         IF (NSH .LE. 0) GO TO  270
+C
+C - SHIFTS (ROTATES) THE IPL ARRAY TO HAVE THE INVISIBLE BORDER
+C - LINE SEGMENTS CONTAINED IN THE FIRST PART OF THE IPL ARRAY.
+C
+         NSHT3 = NSH*3
+         DO  250 JP2T3=3,NSHT3,3
+            JP3T3 = JP2T3+NLT3
+            IPL(JP3T3-2) = IPL(JP2T3-2)
+            IPL(JP3T3-1) = IPL(JP2T3-1)
+            IPL(JP3T3) = IPL(JP2T3)
+  250    CONTINUE
+         DO  260 JP2T3=3,NLT3,3
+            JP3T3 = JP2T3+NSHT3
+            IPL(JP2T3-2) = IPL(JP3T3-2)
+            IPL(JP2T3-1) = IPL(JP3T3-1)
+            IPL(JP2T3) = IPL(JP3T3)
+  260    CONTINUE
+         JPMX = JPMX-NSH
+C
+C - ADDS TRIANGLES TO THE IPT ARRAY, UPDATES BORDER LINE
+C - SEGMENTS IN THE IPL ARRAY, AND SETS FLAGS FOR THE BORDER
+C - LINE SEGMENTS TO BE REEXAMINED IN THE IWL ARRAY.
+C
+  270    JWL = 0
+         DO  310 JP2=JPMX,NL0
+            JP2T3 = JP2*3
+            IPL1 = IPL(JP2T3-2)
+            IPL2 = IPL(JP2T3-1)
+            IT = IPL(JP2T3)
+C
+C - - ADDS A TRIANGLE TO THE IPT ARRAY.
+C
+            NT0 = NT0+1
+            NTT3 = NTT3+3
+            IPT(NTT3-2) = IPL2
+            IPT(NTT3-1) = IPL1
+            IPT(NTT3) = IP1
+C
+C - - UPDATES BORDER LINE SEGMENTS IN THE IPL ARRAY.
+C
+            IF (JP2 .NE. JPMX) GO TO  280
+            IPL(JP2T3-1) = IP1
+            IPL(JP2T3) = NT0
+  280       IF (JP2 .NE. NL0) GO TO  290
+            NLN = JPMX+1
+            NLNT3 = NLN*3
+            IPL(NLNT3-2) = IP1
+            IPL(NLNT3-1) = IPL(1)
+            IPL(NLNT3) = NT0
+C
+C - - DETERMINES THE VERTEX THAT DOES NOT LIE ON THE BORDER
+C - - LINE SEGMENTS.
+C
+  290       ITT3 = IT*3
+            IPTI = IPT(ITT3-2)
+            IF (IPTI.NE.IPL1 .AND. IPTI.NE.IPL2) GO TO  300
+            IPTI = IPT(ITT3-1)
+            IF (IPTI.NE.IPL1 .AND. IPTI.NE.IPL2) GO TO  300
+            IPTI = IPT(ITT3)
+C
+C - - CHECKS IF THE EXCHANGE IS NECESSARY.
+C
+  300       IF (CONXCH(XD,YD,IP1,IPTI,IPL1,IPL2) .EQ. 0) GO TO  310
+C
+C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
+C
+            IPT(ITT3-2) = IPTI
+            IPT(ITT3-1) = IPL1
+            IPT(ITT3) = IP1
+            IPT(NTT3-1) = IPTI
+            IF (JP2 .EQ. JPMX) IPL(JP2T3) = IT
+            IF (JP2.EQ.NL0 .AND. IPL(3).EQ.IT) IPL(3) = NT0
+C
+C - - SETS FLAGS IN THE IWL ARRAY.
+C
+            JWL = JWL+4
+            IWL(JWL-3) = IPL1
+            IWL(JWL-2) = IPTI
+            IWL(JWL-1) = IPTI
+            IWL(JWL) = IPL2
+  310    CONTINUE
+         NL0 = NLN
+         NLT3 = NLNT3
+         NLF = JWL/2
+         IF (NLF .EQ. 0) GO TO  400
+C
+C - IMPROVES TRIANGULATION.
+C
+         NTT3P3 = NTT3+3
+         DO  390 IREP=1,NREP
+            DO  370 ILF=1,NLF
+               ILFT2 = ILF*2
+               IPL1 = IWL(ILFT2-1)
+               IPL2 = IWL(ILFT2)
+C
+C - - LOCATES IN THE IPT ARRAY TWO TRIANGLES ON BOTH SIDES OF
+C - - THE FLAGGED LINE SEGMENT.
+C
+               NTF = 0
+               DO  320 ITT3R=3,NTT3,3
+                  ITT3 = NTT3P3-ITT3R
+                  IPT1 = IPT(ITT3-2)
+                  IPT2 = IPT(ITT3-1)
+                  IPT3 = IPT(ITT3)
+                  IF (IPL1.NE.IPT1 .AND. IPL1.NE.IPT2 .AND.
+     1                IPL1.NE.IPT3) GO TO  320
+                  IF (IPL2.NE.IPT1 .AND. IPL2.NE.IPT2 .AND.
+     1                IPL2.NE.IPT3) GO TO  320
+                  NTF = NTF+1
+                  ITF(NTF) = ITT3/3
+                  IF (NTF .EQ. 2) GO TO  330
+  320          CONTINUE
+               IF (NTF .LT. 2) GO TO  370
+C
+C - - DETERMINES THE VERTEXES OF THE TRIANGLES THAT DO NOT LIE
+C - - ON THE LINE SEGMENT.
+C
+  330          IT1T3 = ITF(1)*3
+               IPTI1 = IPT(IT1T3-2)
+               IF (IPTI1.NE.IPL1 .AND. IPTI1.NE.IPL2) GO TO  340
+               IPTI1 = IPT(IT1T3-1)
+               IF (IPTI1.NE.IPL1 .AND. IPTI1.NE.IPL2) GO TO  340
+               IPTI1 = IPT(IT1T3)
+  340          IT2T3 = ITF(2)*3
+               IPTI2 = IPT(IT2T3-2)
+               IF (IPTI2.NE.IPL1 .AND. IPTI2.NE.IPL2) GO TO  350
+               IPTI2 = IPT(IT2T3-1)
+               IF (IPTI2.NE.IPL1 .AND. IPTI2.NE.IPL2) GO TO  350
+               IPTI2 = IPT(IT2T3)
+C
+C - - CHECKS IF THE EXCHANGE IS NECESSARY.
+C
+  350          IF (CONXCH(XD,YD,IPTI1,IPTI2,IPL1,IPL2) .EQ. 0)
+     1             GO TO  370
+C
+C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
+C
+               IPT(IT1T3-2) = IPTI1
+               IPT(IT1T3-1) = IPTI2
+               IPT(IT1T3) = IPL1
+               IPT(IT2T3-2) = IPTI2
+               IPT(IT2T3-1) = IPTI1
+               IPT(IT2T3) = IPL2
+C
+C - - SETS NEW FLAGS.
+C
+               JWL = JWL+8
+               IWL(JWL-7) = IPL1
+               IWL(JWL-6) = IPTI1
+               IWL(JWL-5) = IPTI1
+               IWL(JWL-4) = IPL2
+               IWL(JWL-3) = IPL2
+               IWL(JWL-2) = IPTI2
+               IWL(JWL-1) = IPTI2
+               IWL(JWL) = IPL1
+               DO  360 JLT3=3,NLT3,3
+                  IPLJ1 = IPL(JLT3-2)
+                  IPLJ2 = IPL(JLT3-1)
+                  IF ((IPLJ1.EQ.IPL1 .AND. IPLJ2.EQ.IPTI2) .OR.
+     1                (IPLJ2.EQ.IPL1 .AND. IPLJ1.EQ.IPTI2))
+     2                IPL(JLT3) = ITF(1)
+                  IF ((IPLJ1.EQ.IPL2 .AND. IPLJ2.EQ.IPTI1) .OR.
+     1                (IPLJ2.EQ.IPL2 .AND. IPLJ1.EQ.IPTI1))
+     2                IPL(JLT3) = ITF(2)
+  360          CONTINUE
+  370       CONTINUE
+            NLFC = NLF
+            NLF = JWL/2
+            IF (NLF .EQ. NLFC) GO TO  400
+C
+C - - RESETS THE IWL ARRAY FOR THE NEXT ROUND.
+C
+            JWL = 0
+            JWL1MN = (NLFC+1)*2
+            NLFT2 = NLF*2
+            DO  380 JWL1=JWL1MN,NLFT2,2
+               JWL = JWL+2
+               IWL(JWL-1) = IWL(JWL1-1)
+               IWL(JWL) = IWL(JWL1)
+  380       CONTINUE
+            NLF = JWL/2
+  390    CONTINUE
+  400 CONTINUE
+C
+C REARRANGE THE IPT ARRAY SO THAT THE VERTEXES OF EACH TRIANGLE
+C ARE LISTED COUNTER-CLOCKWISE.
+C
+      DO  410 ITT3=3,NTT3,3
+         IP1 = IPT(ITT3-2)
+         IP2 = IPT(ITT3-1)
+         IP3 = IPT(ITT3)
+         IF (SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3)) .GE.
+     1       0.0) GO TO  410
+         IPT(ITT3-2) = IP2
+         IPT(ITT3-1) = IP1
+  410 CONTINUE
+      NT = NT0
+      NL = NL0
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conxch.f b/sys/gio/ncarutil/conlib/conxch.f
new file mode 100644
index 00000000..6309f360
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conxch.f
@@ -0,0 +1,67 @@
+      INTEGER FUNCTION CONXCH (X,Y,I1,I2,I3,I4)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS FUNCTION DETERMINES WHETHER OR NOT THE EXCHANGE OF TWO
+C TRIANGLES IS NECESSARY ON THE BASIS OF MAX-MIN-ANGLE CRITERION
+C BY C. L. LAWSON.
+C THE INPUT PARAMETERS ARE
+C     X,Y = ARRAYS CONTAINING THE COORDINATES OF THE DATA
+C           POINTS,
+C     I1,I2,I3,I4 = POINT NUMBERS OF FOUR POINTS P1, P2,
+C                   P3, AND P4 THAT FORM A QUADRILATERAL
+C                   WITH P3 AND P4 CONNECTED DIADONALLY.
+C THIS FUNCTION RETURNS A VALUE 1 (ONE) WHEN AN EXCHANGE IS
+C NEEDED, AND 0 (ZERO) OTHERWISE.
+C DECLARATION STATEMENTS
+C
+      DIMENSION       X(1)       ,Y(1)
+      DIMENSION       X0(4)      ,Y0(4)
+      EQUIVALENCE     (C2SQ,C1SQ),(A3SQ,B2SQ),(B3SQ,A1SQ),(A4SQ,B1SQ),
+     1                (B4SQ,A2SQ),(C4SQ,C3SQ)
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS
+C
+C CALCULATION
+C
+      X0(1) = X(I1)
+      Y0(1) = Y(I1)
+      X0(2) = X(I2)
+      Y0(2) = Y(I2)
+      X0(3) = X(I3)
+      Y0(3) = Y(I3)
+      X0(4) = X(I4)
+      Y0(4) = Y(I4)
+      IDX = 0
+      U3 = (Y0(2)-Y0(3))*(X0(1)-X0(3))-(X0(2)-X0(3))*(Y0(1)-Y0(3))
+      U4 = (Y0(1)-Y0(4))*(X0(2)-X0(4))-(X0(1)-X0(4))*(Y0(2)-Y0(4))
+      IF (U3*U4 .LE. 0.0) GO TO  100
+      U1 = (Y0(3)-Y0(1))*(X0(4)-X0(1))-(X0(3)-X0(1))*(Y0(4)-Y0(1))
+      U2 = (Y0(4)-Y0(2))*(X0(3)-X0(2))-(X0(4)-X0(2))*(Y0(3)-Y0(2))
+      A1SQ = (X0(1)-X0(3))**2+(Y0(1)-Y0(3))**2
+      B1SQ = (X0(4)-X0(1))**2+(Y0(4)-Y0(1))**2
+      C1SQ = (X0(3)-X0(4))**2+(Y0(3)-Y0(4))**2
+      A2SQ = (X0(2)-X0(4))**2+(Y0(2)-Y0(4))**2
+      B2SQ = (X0(3)-X0(2))**2+(Y0(3)-Y0(2))**2
+      C3SQ = (X0(2)-X0(1))**2+(Y0(2)-Y0(1))**2
+      S1SQ = U1*U1/(C1SQ*AMAX1(A1SQ,B1SQ))
+      S2SQ = U2*U2/(C2SQ*AMAX1(A2SQ,B2SQ))
+      S3SQ = U3*U3/(C3SQ*AMAX1(A3SQ,B3SQ))
+      S4SQ = U4*U4/(C4SQ*AMAX1(A4SQ,B4SQ))
+      IF (AMIN1(S1SQ,S2SQ) .LT. AMIN1(S3SQ,S4SQ)) IDX = 1
+  100 CONXCH = IDX
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/mkpkg b/sys/gio/ncarutil/conlib/mkpkg
new file mode 100644
index 00000000..5ebdc2cb
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/mkpkg
@@ -0,0 +1,37 @@
+# Update the CONCOM and CONTERP contributions to LIBNCAR.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	concal.f
+	concld.f
+	concls.f
+	concom.f
+	condet.f
+	condrw.f
+	condsd.f
+	conecd.f
+	congen.f
+	conint.f
+	conlcm.f
+	conlin.f
+	conloc.f
+	conlod.f
+	conop1.f
+	conop2.f
+	conop3.f
+	conop4.f
+	conot2.f
+	conout.f
+	conpdv.f
+	conreo.f
+	consld.f
+	conssd.f
+	constp.f
+	contlk.f
+	contng.f
+	conxch.f
+	;
diff --git a/sys/gio/ncarutil/conran.f b/sys/gio/ncarutil/conran.f
new file mode 100644
index 00000000..bc23a6cc
--- /dev/null
+++ b/sys/gio/ncarutil/conran.f
@@ -0,0 +1,1976 @@
+      SUBROUTINE CONRAN (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C    SUBROUTINE CONRAN(XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C    STANDARD AND SMOOTH VERSIONS OF CONRAN
+C
+C          DIMENSION OF  XD(NDP),YD(NDP),ZD(NDP),WK(13*NDP)
+C             ARGUMENTS  IWK((27+NCP)*NDP),SCRARR(RESOLUTION**2)
+C                        WHERE NCP = 4 AND RESOLUTION = 40 BY
+C                        DEFAULT.
+C
+C       LATEST REVISION  JULY 1984
+C
+C              OVERVIEW  CONRAN  PERFORMS  CONTOURING  OF  IRREGULARLY
+C                        DISTRIBUTED  DATA.   IT IS THE STANDARD AND
+C                        SMOOTH MEMBERS OF THE CONRAN FAMILY. THIS
+C                        VERSION  WILL  PLOT CONTOURS; SMOOTH THEM USING
+C                        SPLINES  UNDER  TENSION (IF THE PACKAGE DASHSMTH
+C                        IS LOADED); PLOT A PERIMETER OR GRID; TITLE THE
+C                        PLOT; PRINT A MESSAGE GIVING THE CONTOUR INTERVALS
+C                        BELOW THE MAP; PLOT THE INPUT DATA ON THE MAP;
+C                        AND LABEL THE CONTOUR LINES.
+C
+C               PURPOSE  CONRAN  PLOTS  CONTOUR  LINES  USING  RANDOM,
+C                        SPARSE  OR  IRREGULAR DATA SETS.  THE DATA IS
+C                        TRIANGULATED AND THEN CONTOURED.   CONTOURING
+C                        IS  PERFORMED USING INTERPOLATION OF THE TRI-
+C                        ANGULATED DATA.  THERE ARE TWO METHODS OF
+C                        INTERPOLATION:  C1 SURFACES AND LINEAR.
+C
+C                 USAGE  CALL CONRAN(XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C                        AN OPTION SETTING ROUTINE  CAN  ALSO  BE  IN-
+C                        VOKED,  SEE  WRITEUP  BELOW.   FRAME  MUST BE
+C                        CALLED BY THE USER.
+C
+C                        IF DIFFERENT COLORS (OR INTENSITIES) ARE TO BE
+C                        USED FOR NORMAL INTENSITY, LOW INTENSITY OR
+C                        TEXT OUTPUT, THEN THE VALUES IN COMMON BLOCK
+C                        RANINT SHOULD BE CHANGED:
+C
+C                        IRANMJ  COLOR INDEX FOR NORMAL (MAJOR) INTENSITY
+C                                LINES.
+C                        IRANMN  COLOR INDEX FOR LOW INTENSITY LINES
+C                        IRANTX  COLOR INDEX FOR TEXT (LABELS)
+C
+C
+C             ARGUMENTS
+C
+C              ON INPUT  XD
+C                            ARRAY OF DIMENSION NDP CONTAINING THE  X-
+C                            COORDINATES OF THE DATA POINTS.
+C
+C                        YD
+C                            ARRAY OF DIMENSION NDP CONTAINING THE  Y-
+C                            COORDINATES OF THE DATA POINTS.
+C
+C                        ZD
+C                            ARRAY OF  DIMENSION  NDP  CONTAINING  THE
+C                            DATA VALUES AT THE POINTS.
+C
+C                        NDP
+C                            NUMBER OF  DATA  POINTS  (MUST  BE  4  OR
+C                            GREATER) TO BE CONTOURED.
+C
+C                        WK
+C                            REAL WORK ARRAY  OF  DIMENSION  AT  LEAST
+C                            13*NDP
+C
+C                        IWK
+C                            INTEGER WORK ARRAY.  WHEN USING C1 SURFACES
+C                            THE ARRAY MUST BE AT LEAST IWK((27+NCP)*NDP).
+C                            WHEN USING LINEAR INTERPOLATION THE ARRAY
+C                            MUST BE AT LEAST IWK((27+4)*NDP).
+C
+C                        SCRARR
+C                            REAL WORK ARRAY  OF  DIMENSION  AT  LEAST
+C                            (RESOLUTION**2)   WHERE   RESOLUTION   IS
+C                            DESCRIBED IN THE SSZ OPTION BELOW.  RESO-
+C                            LUTION IS 40 BY DEFAULT.
+C
+C             ON OUTPUT  ALL ARGUMENTS  REMAIN  UNCHANGED  EXCEPT  THE
+C                        SCRATCH ARRAYS IWK, WK, AND SCRARR WHICH HAVE
+C                        BEEN WRITTEN INTO.  IF MAKING  MULTIPLE  RUNS
+C                        ON  THE SAME TRIANGULATION IWK AND WK MUST BE
+C                        SAVED AND RETURNED TO THE NEXT INVOCATION  OF
+C                        CONRAN.
+C
+C          ENTRY POINTS  CONRAN, CONDET, CONINT, CONCAL, CONLOC, CONTNG,
+C                        CONDRW, CONCLS, CONSTP, CONBDN, CONTLK
+C                        CONPDV, CONOP1, CONOP2, CONOP3, CONOP4,
+C                        CONXCH, CONREO, CONCOM, CONCLD, CONPMM,
+C                        CONGEN, CONLOD, CONECD, CONOUT, CONOT2,
+C                        CONSLD, CONLCM, CONLIN, CONDSD, CONSSD
+C
+C         COMMON BLOCKS  CONRA1, CONRA2, CONRA3, CONRA4, CONRA5, CONRA6,
+C                        CONRA7, CONRA8, CONRA9, CONR10, CONR11, CONR12,
+C                        CONR13, CONR14, CONR15, CONR16, CONR17, RANINT
+C                        INTPR FROM THE DASH PACKAGE
+C
+C                   I/O  PLOTS THE CONTOUR MAP AND, VIA  THE ERPRT77
+C                        PACKAGE,  OUTPUTS  MESSAGES  TO  THE MESSAGE
+C                        OUTPUT  UNIT; AT  NCAR  THIS  UNIT  IS  THE
+C                        PRINTER.  THE OPTION VALUES ARE ALL LISTED ON
+C                        STANDARD ERPRT77 OUTPUT UNIT; AT NCAR THIS
+C                        UNIT IS THE PRINTER.
+C
+C             PRECISION  SINGLE
+C
+C      REQUIRED LIBRARY  STANDARD VERSION: DASHCHAR, WHICH AT NCAR IS
+C              ROUTINES  LOADED BY DEFAULT.
+C                        SMOOTH VERSION: DASHSMTH WHICH MUST BE
+C                        REQUESTED AT NCAR.
+C                        BOTH VERSIONS REQUIRE CONCOM, CONTERP, GRIDAL
+C                        THE ERPRT77 PACKAGE, AND THE SPPS.
+C
+C              LANGUAGE  FORTRAN77
+C
+C               HISTORY
+C
+C             ALGORITHM  THE SPARSE DATA IS TRIANGULATED AND A VIRTUAL
+C                        GRID  IS  LAID  OVER  THE  TRIANGULATED AREA.
+C                        EACH VIRTUAL GRID POINT RECEIVES AN  INTERPO-
+C                        LATED  VALUE.   THE  GRID IS SCANNED ONCE FOR
+C                        EACH CONTOUR LEVEL AND ALL CONTOURS  AT  THAT
+C                        LEVEL ARE PLOTTED.
+C                        THERE ARE TWO METHODS OF INTERPOLATION. THE
+C                        FIRST IS A SMOOTH DATA INTERPOLATION
+C                        SCHEME BASED  ON  LAWSON'S  C1
+C                        SURFACE  INTERPOLATION  ALGORITHM,  WHICH HAS
+C                        BEEN REFINED  BY  HIROSHA  AKIMA.   PARTS  OF
+C                        AKIMA'S  ALGORITHM  ARE USED IN THIS PACKAGE.
+C                        SEE THE "REFERENCE" SECTION BELOW.
+C                        THE SECOND IS A LINEAR INTERPOLATION SCHEME.
+C                        WHEN DATA IS SPARSE IT IS USUALLY BETTER TO
+C                        USE THE C1 INTERPOLATION.  IF YOU HAVE DENSE
+C                        DATA (OVER 100 POINTS) THEN THE LINEAR
+C                        INTERPOLATION WILL GIVE THE BETTER RESULTS.
+C
+C           PORTABILITY  ANSI FORTRAN
+C
+C
+C             OPERATION  CALL CONRAN (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C                        FRAME MUST BE CALLED BY THE USER.
+C
+C                        CONRAN HAS MANY OPTIONS, EACH OF WHICH MAY
+C                        BE CHANGED BY CALLING ONE OF THE FOUR
+C                        SUBROUTINES CONOP1, CONOP2, CONOP3, OR
+C                        CONOP4.  THE NUMBER OF ARGUMENTS TO EACH
+C                        CONOP ROUTINE IS THE SAME AS THE FINAL
+C                        SUFFIX CHARACTER IN THE ROUTINE'S NAME.
+C
+C                        THE CONOP ROUTINES ARE CALLED BEFORE CONRAN
+C                        IS CALLED, AND VALUES SET BY THESE CALLS
+C                        CONTINUE TO BE IN EFFECT UNTIL THEY ARE
+C                        CHANGED BY ANOTHER CALL TO A CONOP ROUTINE.
+C
+C                        ALL THE CONOP ROUTINES HAVE AS THEIR FIRST
+C                        ARGUMENT A CHARACTER STRING TO IDENTIFY THE
+C                        OPTION BEING CHANGED.  THIS IS THE ONLY
+C                        ARGUMENT TO CONOP1.  CONOP2 HAS AN INTEGER
+C                        SECOND ARGUMENT.  CONOP3 HAS A REAL ARRAY (OR
+C                        CONSTANT) AS ITS SECOND ARGUMENT AND AN
+C                        INTEGER (USUALLY THE DIMENSION OF THE
+C                        ARRAY) AS ITS THIRD ARGUMENT.  CONOP4 HAS A
+C                        CHARACTER STRING AS ITS SECOND ARGUMENT AND
+C                        INTEGERS FOR THE THIRD AND FOURTH ARGUMENTS.
+C
+C                        ONLY THE FIRST TWO CHARACTERS ON EACH SIDE OF
+C                        THE EQUAL SIGN ARE SCANNED.  THEREFORE ONLY 2
+C                        CHARACTERS  FOR  EACH  OPTION ARE REQUIRED ON
+C                        INPUT TO CONOP (I.E.  'SCA=PRI'  AND  'SC=PR'
+C                        ARE EQUIVALENT.)
+C
+C                        REMEMBER, THERE MUST BE AT LEAST 4 DATA POINTS.
+C                        THIS IS EQUAL TO  THE  DEFAULT  NUMBER OF
+C                        DATA POINTS TO BE USED FOR ESTIMATION OF PAR-
+C                        TIAL DERIVATIVES AT  EACH  DATA  POINT.
+C                        THE ESTIMATED PARTIAL DERIVATIVES  ARE
+C                        USED  FOR THE CONSTRUCTION OF THE INTERPOLAT-
+C                        ING POLYNOMIAL'S COEFFICIENTS.
+C
+C                        LISTED BELOW ARE OPTIONS WHICH CAN ENHANCE
+C                        YOUR PLOT.  AN EXAMPLE OF AN APPROPRIATE
+C                        CONOP CALL IS GIVEN FOR EACH OPTION.  A
+C                        COMPLETE LIST OF DEFAULT SETTINGS FOLLOWS
+C                        THE LAST OPTION.
+C
+C               OPTIONS
+C
+C                   CHL  THIS FLAG DETERMINES HOW  THE  HIGH  AND  LOW
+C                        CONTOUR VALUES ARE SET.  THESE CONTOUR VALUES
+C                        MAY BE SET BY THE PROGRAM OR BY THE USER.  IF
+C                        CHL=OFF,  THE PROGRAM EXAMINES THE USER'S IN-
+C                        PUT DATA AND DETERMINES BOTH THE HIGH AND LOW
+C                        VALUES.  IF CHL=ON, THE USER MUST SPECIFY THE
+C                        DESIRED HIGH (HI) AND LOW (FLO) VALUES.
+C                        THE DEFAULT IS CHL=OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CHL=OFF',0.,0)
+C
+C                        IF USER SET:  CALL CONOP3('CHL=ON',ARRAY,2)
+C                                WHERE ARRAY(1)=HI, ARRAY(2)=FLO
+C
+C                        NOTE: THE VALUES SUPPLIED FOR CONTOUR  INCRE-
+C                        MENT  AND CONTOUR HIGH AND LOW VALUES ASSUMES
+C                        THE UNSCALED DATA VALUES.  SEE THE SDC  FLAG,
+C                        BELOW.
+C
+C                        EXAMPLE:  CALL   CONOP3('CHL=ON',ARRAY,2)
+C                                  WHERE  ARRAY(1)=5020. (THE DESIRED
+C                                  HIGH CONTOUR VALUE) AND ARRAY(2)=
+C                                  2000 (THE DESIRED LOW CONTOUR VALUE).
+C                                  THESE ARE FLOATING POINT NUMBERS.
+C
+C                   CIL  THIS FLAG DETERMINES HOW THE  CONTOUR  INCRE-
+C                        MENT  (CINC) IS SET.  THE INCREMENT IS EITHER
+C                        CALCULATED BY THE PROGRAM (CIL=OFF) USING THE
+C                        RANGE  OF HIGH AND LOW VALUES FROM THE USER'S
+C                        INPUT DATA, OR SET BY THE USER (CIL=ON). THE
+C                        DEFAULT IS CIL=OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CIL=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('CIL=ON',CINC,1)
+C
+C                        NOTE: BY DEFAULT,  THE  PROGRAM  WILL EXAMINE
+C                        THE USER'S INPUT DATA AND DETERMINE THE CONTOUR
+C                        INTERVAL (CINC)  AT SOME APPROPRIATE RANGE BETWEEN
+C                        THE LEVEL OF HIGH AND LOW VALUES SUPPLIED, USUALLY
+C                        GENERATING BETWEEN 15 AND 20 CONTOUR LEVELS.
+C                        ELS.
+C
+C                        EXAMPLE:          CALL CONOP3('CIL=ON',15.,1)
+C                                          WHERE  15.  REPRESENTS  THE
+C                                          CONTOUR  INCREMENT  DESIRED
+C                                          BY THE USER.
+C
+C                   CON  THIS FLAG DETERMINES HOW THE  CONTOUR  LEVELS
+C                        ARE  SET.   IF  CON=ON, THE USER MUST SPECIFY
+C                        THE ARRAY OF CONTOUR VALUES AND THE NUMBER OF
+C                        CONTOUR LEVELS.  A  MAXIMUM OF 30 CONTOUR (NCL)
+C                        LEVELS ARE PERMITTED.  IF CON=OFF,  DEFAULT
+C                        VALUES  ARE  USED.  IN THIS CASE, THE PROGRAM
+C                        WILL CALCULATE THE VALUES FOR THE  ARRAY  AND
+C                        NCL USING INPUT DATA.  THE DEFAULT IS OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CON=OFF',0.,0)
+C
+C                        IF USER SET:   CALL CONOP3('CON=ON',ARRAY,NCL)
+C
+C                        NOTE: THE ARRAY (ARRAY) CONTAINS THE  CONTOUR
+C                        LEVELS  (FLOATING  POINT ONLY) AND NCL IS THE
+C                        NUMBER OF LEVELS.  THE MAXIMUM NUMBER OF CON-
+C                        TOUR LEVELS ALLOWED IS 30.  WHEN ASSIGNING
+C                        THE ARRAY OF CONTOUR VALUES, THE VALUES MUST
+C                        BE ORDERED FROM SMALLEST TO LARGEST.
+C
+C                        EXAMPLE:
+C                         DATA RLIST(1),...,RLIST(5)/1.,2.,3.,10.,12./
+C
+C                                  CALL CONOP3('CON=ON',RLIST,5) WHERE
+C                                  'RLIST' CONTAINS THE USER SPECIFIED
+C                                  CONTOUR LEVELS, AND 5  IS  THE
+C                                  NUMBER  OF  USER  SPECIFIED CONTOUR
+C                                  LEVELS (NCL).
+C
+C                        WARNING ON CONTOUR OPTIONS:
+C                        IT IS ILLEGAL TO USE THE CON OPTION WHEN
+C                        EITHER  CIL  OR  CHL  ARE ACTIVATED.  IF
+C                        THIS IS DONE, THE OPTION CALL THAT DETECTED
+C                        THE ERROR WILL NOT BE EXECUTED.
+C
+C                   DAS  THIS  FLAG  DETERMINES  WHICH  CONTOURS   ARE
+C                        REPRESENTED  BY  DASHED LINES.  THE USER SETS
+C                        THE DASHED LINE PATTERN.  THE USER MAY SPECI-
+C                        FY  THAT  DASHED  LINES  BE USED FOR CONTOURS
+C                        WHOSE  VALUE  IS  LESS  THAN,  EQUAL  TO,  OR
+C                        GREATER THAN THE DASH PATTERN BREAKPOINT (SEE
+C                        THE DBP OPTION BELOW), WHICH IS ZERO BY
+C                        DEFAULT.  IF DAS=OFF (THE DEFAULT VALUE), ALL
+C                        SOLID LINES ARE USED.
+C
+C                        ALL SOLID LINES: CALL CONOP4('DAS=OFF',' ',0,0)
+C
+C                        IF GREATER:      CALL CONOP4('DAS=GTR',PAT,0,0)
+C
+C                        IF EQUAL:        CALL CONOP4('DAS=EQU',PAT,0,0)
+C
+C                        IF LESS:         CALL CONOP4('DAS=LSS',PAT,0,0)
+C
+C                        IF ALL SAME:     CALL CONOP4('DAS=ALL',PAT,0,0)
+C
+C                        NOTE: PAT MUST BE A TEN CHARACTER
+C                        STRING WITH A DOLLAR SIGN ($) FOR SOLID AND A
+C                        SINGLE QUOTE (') FOR BLANK.  RECALL THAT IN
+C                        FORTRAN 77, IN A QUOTED STRING A SINGLE QUOTE
+C                        IS REPRESENTED BY TWO SINGLE QUOTES ('').
+C
+C                        EXAMPLE:
+C                          CALL CONOP4('DAS=GTR','$$$$$''$$$$',0,0)
+C
+C                   DBP  THIS FLAG DETERMINES  HOW  THE  DASH  PATTERN
+C                        BREAK POINT (BP) IS SET.  IF DBP=ON, BP  MUST
+C                        BE SET BY THE  USER  BY  SPECIFYING  BP.   IF
+C                        DBP=OFF  THE  PROGRAM  WILL SET BP TO THE
+C                        DEFAULT VALUE WHICH IS ZERO.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('DBP=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('DBP=ON',BP,1)
+C
+C                        NOTE: BP IS A FLOATING POINT NUMBER WHERE THE
+C                        BREAK  FOR  GTR AND LSS CONTOUR DASH PATTERNS
+C                        ARE DEFINED.  BP IS ASSUMED TO BE GIVEN RELA-
+C                        TIVE TO THE UNTRANSFORMED CONTOURS.
+C
+C                        EXAMPLE:          CALL CONOP3('DBP=ON',5.,1)
+C                                          WHERE 5. IS THE USER SPECI-
+C                                          FIED BREAK POINT.
+C
+C                   DEF  RESET FLAGS TO  DEFAULT  VALUES.   ACTIVATING
+C                        THIS  OPTION  SETS  ALL  FLAGS TO THE DEFAULT
+C                        VALUE.  DEF HAS NO 'ON' OF 'OFF' STATES.
+C
+C                        TO ACTIVATE:   CALL CONOP1('DEF')
+C
+C                   EXT  FLAG TO SET EXTRAPOLATION. NORMALLY ALL
+C                        CONRAN VERSIONS WILL  ONLY PLOT THE BOUNDARIES
+C                        OF THE CONVEX HULL DEFINED BY THE USER'S DATA.
+C                        TO HAVE THE CONTOURS FILL THE RECTANGULAR
+C                        AREA OF THE FRAME, SET THE EXT SWITCH ON.
+C                        THE DEFAULT IS OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('EXT=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('EXT=OFF')
+C
+C                   FMT  FLAG FOR THE FORMAT OF THE PLOTTED INPUT DATA
+C                        VALUES.   IF  FMT=OFF, THE DEFAULT VALUES FOR
+C                        FT, L, AND IF ARE USED.  THE  DEFAULT  VALUES
+C                        ARE:
+C
+C                        FT = '(G10.3)'
+C                        L  = 7  CHARACTERS INCLUDING THE PARENTHESES
+C                        IF = 10 CHARACTERS PRINTED IN THE OUTPUT
+C                             FIELD BY THE FORMAT
+C
+C                        IF FMT=ON, THE USER MUST SPECIFY  VALUES  FOR
+C                        FT,  L,  AND  IF.   ALL USER SPECIFIED VALUES
+C                        MUST BE GIVEN IN THE CORRECT FORMAT.
+C
+C                        IF PROGRAM SET:  CALL CONOP4('FMT=OFF',' ',0,0)
+C
+C                        IF USER SET:  CALL CONOP4('FMT=ON',FT,L,IF)
+C
+C                        NOTE: FT IS A CHARACTER STRING CONTAINING THE
+C                        FORMAT.   THE  FORMAT  MUST  BE  ENCLOSED  IN
+C                        PARENTHESES.  ANY  FORMAT, UP TO 10 CHARACTERS
+C                        WHICH IS  ALLOWED  AT  YOUR INSTALLATION WILL BE
+C                        ACCEPTED.  L IS THE NUMBER OF  CHARACTERS  IN
+C                        FT.  IF IS THE LENGTH OF THE FIELD CREATED BY
+C                        THE FORMAT.
+C
+C                        EXAMPLE:  CALL CONOP4('FMT=ON','(G30.2)',7,30)
+C
+C                        WARNING: CONRAN WILL NOT  TEST  FOR  A  VALID
+C                        FORMAT.  THE FORMAT IS ONLY ALLOWED TO BE
+C                        10 CHARACTERS LONG.
+C
+C                   GRI  FLAG TO DISPLAY THE GRID. GRI IS OFF BY DEFAULT.
+C
+C                        TO TURN ON:    CALL CONOP1('GRI=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('GRI=OFF')
+C
+C                        NOTE: IF GRI IS ON, THE VIRTUAL GRID WILL
+C                        BE SUPERIMPOSED OVER THE CONTOUR PLOT.
+C                        THE X AND Y TICK INTERVALS WILL BE DISPLAYED
+C                        UNDER THE MAP ONLY IF PER=ON.  (SEE PER)
+C
+C                   INT  FLAG TO DETERMINE THE INTENSITIES OF THE CON-
+C                        TOUR  LINES  AND OTHER PARTS OF THE PLOT.  IF
+C                        INT=OFF,  ALL INTENSITIES ARE SET TO THE DEFAULT
+C                        VALUES.  IF INT=ALL, ALL INTENSITIES ARE SET
+C                        TO THE GIVEN VALUE, IVAL.  IF INT IS SET TO
+C                        ONE OF THE OTHER POSSIBLE OPTIONS (MAJ, MIN,
+C                        LAB OR DAT), THE INTENSITY LEVEL FOR THAT
+C                        OPTION IS SET TO THE GIVEN VALUE, IVAL.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('INT=OFF',0)
+C
+C                        ALL THE SAME:     CALL  CONOP2('INT=ALL',IVAL)
+C
+C                        MAJOR LINES:      CALL CONOP2('INT=MAJ',IVAL)
+C
+C                        MINOR LINES:      CALL CONOP2('INT=MIN',IVAL)
+C
+C                        TITLE AND MESSAGE:
+C                                          CALL  CONOP2('INT=LAB',IVAL)
+C
+C                        DATA VALUES:      CALL  CONOP2('INT=DAT',IVAL)
+C
+C                        NOTE: 'INT=DAT' RELATES TO THE PLOTTED DATA
+C                        VALUES AND THE PLOTTED MAXIMUMS AND MINIMUMS.
+C
+C                        NOTE: IVAL IS THE INTENSITY DESIRED.  FOR  AN
+C                        EXPLANATION  OF THE OPTION VALUE SETTINGS SEE
+C                        THE OPTN ROUTINE  IN  THE  NCAR  SYSTEM  PLOT
+C                        PACKAGE DOCUMENTATION.  BRIEFLY, IVAL  VALUES
+C                        RANGE FROM 0 TO 255 OR THE CHARACTER  STRINGS
+C                        'LO'  AND  'HI'.   THE DEFAULT IS 'HI' EXCEPT
+C                        FOR INT=MIN WHICH IS SET TO 'LO'.
+C
+C                        EXAMPLE:           CALL CONOP2('INT=ALL',110)
+C
+C                   ITP  SET THE INTERPOLATION SCHEME.
+C                        THERE ARE TWO SCHEMES--C1 SURFACES AND LINEAR.
+C                        THE C1 METHOD TAKES LONGER BUT WILL GIVE THE
+C                        BEST RESULTS WHEN THE DATA IS SPARSE (LESS
+C                        THAN 100 POINTS).  THE LINEAR METHOD WILL
+C                        PRODUCE A BETTER PLOT WHEN THERE IS A DENSE
+C                        DATA SET.  THE DEFAULT IS C1 SURFACE.
+C
+C                        FOR C1 SURFACE   CALL CONOP1('ITP=C1')
+C
+C                        FOR LINEAR       CALL CONOP1('ITP=LIN')
+C
+C                   LAB  THIS FLAG CAN BE SET TO EITHER LABEL THE CON-
+C                        TOURS (LAB=ON) OR NOT (LAB=OFF).  THE DEFAULT
+C                        VALUE IS LAB=ON.
+C
+C                        TO TURN ON:    CALL CONOP1('LAB=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('LAB=OFF')
+C
+C                   LOT  FLAG TO LIST OPTIONS ON THE PRINTER.  THE DE-
+C                        FAULT  VALUE  IS  SET  TO OFF, AND NO OPTIONS
+C                        WILL BE DISPLAYED.
+C
+C                        TO TURN ON:    CALL CONOP1('LOT=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('LOT=OFF')
+C
+C                        NOTE: IF  USERS  WANT  TO  PRINT  THE  OPTION
+C                        VALUES, THEY SHOULD TURN THIS OPTION ON.  THE
+C                        OPTION VALUES WILL BE SENT  TO  THE  STANDARD
+C                        OUTPUT  UNIT  AS  DEFINED BY THE SUPPORT
+C                        ROUTINE I1MACH.
+C
+C                   LSZ  THIS FLAG  DETERMINES  THE  LABEL  SIZE.   IF
+C                        LSZ=OFF,  THE  DEFAULT ISZLSZ VALUE WILL BE
+C                        USED.  IF LSZ=ON,  THE  USER  SHOULD  SPECIFY
+C                        ISZLSZ.   THE  DEFAULT VALUE IS 9 PLOTTER
+C                        ADDRESS UNITS.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('LSZ=OFF',0)
+C
+C                        IF USER SET:   CALL CONOP2('LSZ=ON',ISZLSZ)
+C
+C                        NOTE: ISZLSZ  IS  THE  REQUESTED  CHARACTER
+C                        SIZE IN PLOTTER ADDRESS UNITS.
+C
+C                        EXAMPLE:          CALL CONOP2('LSZ=ON',4)
+C                                          WHERE 4 IS THE USER DESIRED
+C                                          INTEGER PLOTTER ADDRESS
+C                                          UNITS.
+C
+C                   MES  FLAG TO PLOT A MESSAGE. THE DEFAULT IS ON.
+C
+C                        TO TURN ON:    CALL CONOP1('MES=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('MES=OFF')
+C
+C                        NOTE: IF MES=ON, A MESSAGE IS  PRINTED   BELOW
+C                        THE  PLOT GIVING CONTOUR INTERVALS AND EXECU-
+C                        TION TIME IN SECONDS.  IF PER OR GRI ARE  ON,
+C                        THE  MESSAGE  ALSO  CONTAINS THE X AND Y TICK
+C                        INTERVALS.
+C
+C                   NCP  FLAG TO INDICATE THE NUMBER OF DATA POINTS
+C                        USED FOR THE PARTIAL DERIVATIVE
+C                        ESTIMATION.   IF NCP=OFF, NUM IS SET TO
+C                        4, WHICH IS THE DEFAULT  VALUE.   IF  NCP=ON,
+C                        THE  USER  MUST  SPECIFY  NUM GREATER THAN OR
+C                        EQUAL TO 2.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('NCP=OFF',0)
+C
+C                        IF USER SET:      CALL CONOP2('NCP=ON',NUM)
+C
+C                        NOTE: NUM = NUMBER OF DATA  POINTS  USED  FOR
+C                        ESTIMATION.   CHANGING THIS VALUE EFFECTS THE
+C                        CONTOURS PRODUCED AND THE SIZE OF INPUT ARRAY
+C                        IWK.
+C
+C                        EXAMPLE:          CALL CONOP2('NCP=ON',3)
+C
+C                   PDV  FLAG TO PLOT THE INPUT DATA VALUES.  THE
+C                        DEFAULT VALUE IS PDV=OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('PDV=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('PDV=OFF')
+C
+C                        NOTE: IF PDV=ON, THE INPUT  DATA  VALUES  ARE
+C                        PLOTTED  RELATIVE  TO  THEIR  LOCATION ON THE
+C                        CONTOUR MAP.  IF YOU ONLY WISH TO SEE THE
+C                        LOCATIONS  AND  NOT THE VALUES, SET PDV=ON AND
+C                        CHANGE FMT TO PRODUCE AN ASTERISK (*) SUCH AS
+C                        (I1).
+C
+C                   PER  FLAG TO SET THE PERIMETER.  THE DEFAULT VALUE
+C                        IS  PER=ON,  WHICH  CAUSES  A PERIMETER TO BE
+C                        DRAWN AROUND THE CONTOUR PLOT.
+C
+C                        TO TURN ON:    CALL CONOP1('PER=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('PER=OFF')
+C
+C                        NOTE: IF MES IS ON, THE X AND Y TICK INTERVALS
+C                        WILL  BE GIVEN.  THESE ARE THE INTERVALS IN USER
+C                        COORDINATES THAT EACH TICK MARK REPRESENTS.
+C
+C                   PMM  FLAG TO PLOT RELATIVE MINIMUMS AND MAXIMUMS.
+C                        THIS FLAG IS OFF BY DEFAULT.
+C
+C                        TO TURN OFF:      CALL CONOP1('PMM=OFF')
+C
+C                        TO TURN ON:       CALL CONOP1('PMM=ON')
+C
+C                   PSL  FLAG WHICH SETS THE PLOT SHIELD OPTION.
+C                        THE OUTLINE OF THE SHIELD WILL BE DRAWN ON
+C                        THE SAME FRAME AS THE CONTOUR PLOT.
+C                        BY DEFAULT THIS OPTION IS OFF.
+C                        (SEE SLD OPTION).
+C
+C                        DRAW THE SHIELD:  CALL CONOP1('PSL=ON')
+C
+C                        DON'T DRAW IT:    CALL CONOP1('PSL=OFF')
+C
+C                   REP  FLAG INDICATING THE USE OF THE SAME DATA IN
+C                        A NEW EXECUTION.  THE DEFAULT VALUE IS OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('REP=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('REP=OFF')
+C
+C                        NOTE: IF REP=ON, THE SAME X-Y DATA AND TRIANGU-
+C                        LATION  ARE  TO  BE  USED BUT IT IS ASSUMED
+C                        THE USER HAS CHANGED CONTOUR VALUES OR RESOLUTION
+C                        FOR THIS RUN.  SCRATCH ARRAYS WK AND IWK MUST
+C                        REMAIN UNCHANGED.
+C
+C                   SCA  FLAG FOR SCALING OF THE PLOT ON A FRAME.
+C                        THIS FLAG IS ON BY DEFAULT.
+C
+C                        USER SCALING:     CALL CONOP1('SCA=OFF')
+C
+C                        PROGRAM SCALING:  CALL CONOP1('SCA=ON')
+C
+C                        PRIOR WINDOW:     CALL CONOP1('SCA=PRI')
+C
+C                        NOTE:  WITH  SCA=OFF,  PLOTTING  INSTRUCTIONS
+C                        WILL BE ISSUED USING THE USER'S INPUT COORDI-
+C                        NATES, UNLESS THEY ARE TRANSFORMED VIA FX AND
+C                        FY  TRANSFORMATIONS.   USERS WILL FIND AN
+C                        EXTENDED DISCUSSION IN THE "INTERFACING WITH
+C                        OTHER GRAPHICS ROUTINES" SECTION BELOW.  THE SCA
+C                        OPTION  ASSUMES  THAT ALL INPUT DATA FALLS INTO
+C                        THE CURRENT WINDOW SETTING.  WITH SCA=ON, THE
+C                        ENTRY POINT WILL ESTABLISH A VIEWPORT SO THAT
+C                        THE USER'S PLOT WILL FIT INTO THE  CENTER  90
+C                        PERCENT OF THE FRAME.  WHEN SCA=PRI, THE
+C                        PROGRAM  MAPS THE USER'S PLOT INSTRUCTIONS  INTO
+C                        THE  PORTION OF THE FRAME DEFINED BY THE
+C                        CURRENT NORMALIZATION TRANSFORMATION.  SCA=OFF
+C                        SHOULD BE USED TO INTERFACE WITH EZMAP.
+C
+C                   SDC  FLAG TO DETERMINE HOW TO SCALE  THE  DATA  ON
+C                        THE CONTOURS.  IF SDC=OFF, THE FLOATING POINT
+C                        VALUE IS GIVEN BY SCALE.  IF SDC=ON, THE USER
+C                        MAY SPECIFY SCALE.  THE DEFAULT VALUE FOR SCALE
+C                        IS 1.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('SDC=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('SDC=ON',SCALE,1)
+C
+C                        NOTE: THE DATA PLOTTED ON CONTOUR  LINES  AND
+C                        THE  DATA  PLOTTED  FOR RELATIVE MINIMUMS AND
+C                        MAXIMUMS WILL BE SCALED BY THE FLOATING POINT
+C                        VALUE  GIVEN  BY SCALE.  TYPICAL SCALE VALUES
+C                        ARE 10., 100., 1000., ETC.  THE ORIGINAL DATA
+C                        VALUES ARE MULTIPLIED BY SCALE.  SCALE MUST BE
+C                        A FLOATING POINT NUMBER AND IS DISPLAYED IN THE
+C                        MESSAGE  (SEE  MES).
+C
+C                        EXAMPLE:          CALL CONOP2('SDC=ON',100.,1)
+C
+C                   SLD  ACTIVATE OR DEACTIVATE THE SHIELDING OPTION.
+C                        WHEN THIS OPTION IS ACTIVATED,  ONLY THOSE
+C                        CONTOURS WITHIN THE SHIELD ARE DRAWN. THE SHIELD
+C                        IS A POLYGON SPECIFIED BY THE USER WHICH MUST
+C                        BE GIVEN IN THE SAME COORDINATE RANGE AS THE
+C                        THE DATA. IT MUST DEFINE ONLY ONE POLYGON.
+C
+C                        TO ACTIVATE THE SHIELD:
+C                               CALL CONOP3('SLD=ON',ARRAY,ICSD)
+C
+C                        TO DEACTIVATE THE SHIELD:
+C                               CALL CONOP3('SLD=OFF',0.,0)
+C
+C                        NOTE:  ARRAY IS A REAL ARRAY ICSD ELEMENTS LONG.
+C                        THE FIRST ICSD/2 ELEMENTS ARE X COORDINATES AND
+C                        THE SECOND ICSD/2 ELEMENTS ARE Y COORDINATES.
+C                        ICSD IS THE LENGTH OF ENTIRE ARRAY, THE
+C                        NUMBER OF (X + Y) SHIELD COORDS. THE POLYGON
+C                        MUST BE CLOSED, THAT IS THE FIRST AND LAST
+C                        POINTS DESCRIBING IT MUST BE THE SAME.
+C
+C                        EXAMPLE:       DIMENSION SHLD
+C                                       DATA SHLD/ 7.,10.,10.,7.,7.,
+C                                      1           7.,7.,10.,10.,7./
+C                                       CALL CONOP3 (6HSLD=ON,SHLD,10)
+C
+C
+C                   SML  FLAG TO DETERMINE THE  SIZE  OF  MINIMUM  AND
+C                        MAXIMUM CONTOUR LABELS.  IF SML=OFF, THE
+C                        ISZSML DEFAULT VALUE OF  15 IS  USED.
+C                        IF SML=ON, THE USER MUST SPECIFY ISZSML.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SML=OFF',0)
+C
+C                        IF USER SET:  CALL CONOP2('SML=ON',ISZSML)
+C
+C                        NOTE: ISZSML IS AN INTEGER NUMBER WHICH  IS
+C                        THE SIZE OF LABELS IN PLOTTER ADDRESS UNITS
+C                        AS DEFINED IN THE SPPS ENTRY WTSTR.
+C
+C                        EXAMPLE:      CALL CONOP2('SML=ON',12)
+C
+C                   SPD  FLAG FOR THE SIZE OF THE PLOTTED  INPUT  DATA
+C                        VALUES.  IF SPD=OFF, THE VALUE OF ISZSPD IS
+C                        8, WHICH IS THE DEFAULT.  IF SPD=ON, THE USER
+C                        MUST SPECIFY ISZSPD.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SPD=OFF',0)
+C
+C                        IF USER SET:   CALL CONOP2('SPD=ON',ISZSPD)
+C
+C                        NOTE: ISZSPD IS AN INTEGER NUMBER GIVING THE
+C                        SIZE TO PLOT THE DATA VALUES IN PLOTTER ADDRESS
+C                        UNITS AS DEFINED IN THE SPPS ENTRY WTSTR.    .
+C
+C                        EXAMPLE:          CALL CONOP2('SPD=ON',6)
+C
+C                   SSZ  FLAG TO DETERMINE THE RESOLUTION  (NUMBER  OF
+C                        STEPS  IN  EACH  DIRECTION).   IF SSZ=ON, THE
+C                        USER SETS ISTEP, OR, IF SSZ=OFF, THE  PROGRAM
+C                        WILL  AUTOMATICALLY  SET ISTEP AT THE DEFAULT
+C                        VALUE OF 40.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SSZ=OFF',0)
+C
+C                        IF USER SET:      CALL CONOP2('SSZ=ON',ISTEP)
+C
+C                        NOTE: ISTEP IS AN INTEGER SPECIFYING THE DENSITY
+C                        OF THE VIRTUAL GRID. IN MOST CASES, THE DEFAULT
+C                        VALUE OF 40 PRODUCES PLEASING CONTOURS.   FOR
+C                        COARSER   BUT  QUICKER  CONTOURS,  LOWER  THE
+C                        VALUE.  FOR SMOOTHER CONTOURS AT
+C                        THE EXPENSE OF TAKING LONGER  TIME,  RAISE
+C                        THE  VALUE.   NOTE:   FOR  STEP SIZES GREATER
+C                        THAN 200 IN CONRAN, THE ARRAYS  PV  IN  COMMON
+C                        CONRA1  AND ITLOC IN COMMON CONRA9,  MUST BE
+C                        EXPANDED TO ABOUT 10 MORE THAN ISTEP.
+C                        SEE CONRA1 AND CONRA9 COMMENTS BELOW FOR MORE
+C                        INFORMATION.
+C
+C                        EXAMPLE:          CALL    CONOP2('SSZ=ON',25)
+C                                          THIS  ISTEP VALUE WILL PRO-
+C                                          DUCE A COARSE CONTOUR.
+C
+C                   STL  FLAG TO DETERMINE  THE  SIZE  OF  THE  TITLE.
+C                        ISZSTL  MAY BE SET BY THE USER (STL=ON), OR
+C                        THE PROGRAM WILL SET IT TO THE  DEFAULT  SIZE
+C                        OF 16 PLOTTER ADDRESS UNITS (STL=OFF).
+C
+C                        IF PROGRAM SET:   CALL CONOP2('STL=OFF',0)
+C
+C                        IF USER SET:  CALL  CONOP2('STL=ON',ISZSTL)
+C
+C                        NOTE: WHEN 30 OR 40 CHARACTERS ARE  USED  FOR
+C                        THE TITLE, THE DEFAULT SIZE OF 16 PLOTTER
+C                        ADDRESS UNITS WORKS WELL.  FOR LONGER TITLES,
+C                        A SMALLER TITLE SIZE IS REQUIRED.
+C
+C                        EXAMPLE:          CALL CONOP2('STL=ON',13)
+C
+C                   TEN  FLAG TO DETERMINE THE TENSION FACTOR  APPLIED
+C                        WHEN  SMOOTHING  CONTOUR LINES.  THE USER MAY
+C                        SET TENS OR ALLOW  THE  PROGRAM  TO  SET  THE
+C                        VALUE.   IF  USER SET, TENS MUST HAVE A VALUE
+C                        GREATER THAN ZERO AND LESS THAN OR  EQUAL  TO
+C                        30.  THE DEFAULT VALUE IS 2.5.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('TEN=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('TEN=ON',TENS,1)
+C
+C                        NOTE: TENS IS NOT AVAILABLE IN THE STANDARD
+C                        VERSION OF CONRAN.
+C                        SMOOTHING OF CONTOUR  LINES  IS  ACCOMPLISHED
+C                        WITH  SPLINES  UNDER  TENSION.  TO ADJUST THE
+C                        AMOUNT OF SMOOTHING APPLIED, ADJUST THE  TEN-
+C                        SION  FACTOR.   SETTING TENS VERY LARGE
+C                        (I.E. 30.), EFFECTIVELY SHUTS OFF SMOOTHING.
+C
+C                        EXAMPLE:          CALL CONOP3('TEN=ON',14.,1)
+C
+C                   TFR  FLAG TO ADVANCE THE FRAME BEFORE TRIANGULATION.
+C                        THE DEFAULT VALUE IS TFR=ON, WHICH MEANS THAT
+C                        THE CONTOURS AND THE TRIANGLES WILL BE PLOTTED
+C                        ON SEPARATE FRAMES.
+C
+C                        IF PROGRAM SET:   CALL CONOP1('TFR=ON')
+C
+C                        TO TURN OFF:      CALL CONOP1('TFR=OFF')
+C
+C                        NOTE: TRIANGLES ARE PLOTTED  AFTER  THE  CON-
+C                        TOURING  IS COMPLETED.  TO SEE THE TRIANGLES
+C                        OVER  THE  CONTOURS,  TURN THIS SWITCH OFF.
+C
+C                   TLE  FLAG TO PLACE A TITLE AT THE TOP OF THE PLOT.
+C                        IF  TLE=ON,  THE USER MUST SPECIFY CHARS AND
+C                        INUM.  CHARS  IS THE CHARACTER STRING CONTAINING
+C                        THE TITLE.  INUM IS THE NUMBER OF CHARACTERS
+C                        IN CHARS.  THE DEFAULT VALUE IS  OFF.
+C
+C                        TO TURN ON: CALL CONOP4('TLE=ON',CHARS,INUM,0)
+C
+C                        TO TURN OFF:   CALL CONOP4('TLE=OFF',' ',0,0)
+C
+C                        NOTE: IF LONGER THAN 64-CHARACTER TITLES ARE
+C                        DESIRED, THE CHARACTER VARIABLE ISTRNG FOUND
+C                        IN CONRA7 MUST BE INCREASED APPROPRIATELY.
+C
+C                        EXAMPLE: CALL CONOP4('TLE=ON','VECTOR REVIEW'
+C                                       ,13,0)
+C
+C                   TOP  FLAG TO PLOT ONLY THE TRIANGLES.
+C
+C                        TO TURN OFF:   CALL CONOP1('TOP=OFF')
+C
+C                        TO TURN ON:    CALL CONOP1('TOP=ON')
+C
+C                        NOTE: THE USER MAY WISH TO OVERLAY THE TRIAN-
+C                        GLES ON SOME OTHER PLOT.  'TOP=ON' WILL
+C                        ALLOW  THAT.   THIS  OPTION  WHEN   ACTIVATED
+C                        (TOP=ON),  WILL  SET TRI=ON, AND TFR=OFF.  IF
+C                        THE USER WANTS TFR=ON, IT SHOULD BE SET AFTER
+C                        TOP IS SET.  IF THE USER SETS TOP=OFF IT WILL
+C                        SET TRI=OFF AND TFR=ON. IF THE USER WANTS TRI
+C                        OR  TFR  DIFFERENT, SET THEM AFTER THE
+C                        TOP CALL.
+C
+C                   TRI  FLAG TO PLOT THE TRIANGULATION.  THE DEFAULT IS
+C                        OFF AND THEREFORE THE TRIANGLES ARE NOT DRAWN.
+C
+C                        TO TURN ON:    CALL CONOP1('TRI=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('TRI=OFF')
+C
+C                        NOTE: PLOTTING THE TRIANGLES WILL INDICATE TO
+C                        THE  USER WHERE GOOD AND BAD POINTS OF INTER-
+C                        POLATION ARE OCCURRING IN  THE  CONTOUR  MAP.
+C                        EQUILATERAL  TRIANGLES ARE OPTIMAL FOR INTER-
+C                        POLATION.  QUALITY DEGRADES AS TRIANGLES
+C                        APPROACH  A  LONG AND NARROW SHAPE.  THE CONVEX
+C                        HULL OF THE  TRIANGULATION  IS  ALSO  A  POOR
+C                        POINT OF INTERPOLATION.
+C
+C        OPTION DEFAULT  BELOW ARE  LISTED  THE  DEFAULT
+C                VALUES  VALUES  FOR  THE VARIOUS OPTIONS GIVEN ABOVE.
+C                        UNLESS THE USER  SPECIFIES  OTHERWISE,  THESE
+C                        VALUES WILL BE USED IN EXECUTION OF THE VARI-
+C                        OUS OPTIONS.
+C
+C                           CHL=OFF  LOT=OFF  SLD=OFF
+C                           CIL=OFF  LSZ=OFF  SML=OFF
+C                           CON=OFF  MES=ON   SPD=OFF
+C                           DAS=OFF  NCP=OFF  SPT=OFF
+C                           DBP=OFF  PDV=OFF  SSZ=OFF
+C                           EXT=OFF  PER=ON   STL=OFF
+C                           FMT=OFF  PMM=OFF  TEN=OFF
+C                           GRI=OFF  REP=OFF  TFR=ON
+C                           ITP=C1   SCA=ON   TOP=OFF
+C                           LAB=ON   SDC=OFF  TRI=OFF
+C
+C    DEFAULT VALUES FOR  THE OPTION DEFAULT  VALUES  GIVEN  ABOVE,  IF
+C        USER SPECIFIED  USED, WILL SET DEFAULT VALUES FOR THE FOLLOW-
+C            PARAMETERS  ING PARAMETERS:
+C
+C                        PARAMETER    DEFAULT
+C                        ---------    -------
+C
+C                        ARRAY        UP TO 30 CONTOUR LEVELS ALLOWED.
+C                                     VALUES  ARE COMPUTED BY THE
+C                                     PROGRAM, BASED ON INPUT.
+C
+C                        BP           0.
+C
+C                        CINC         COMPUTED BY THE PROGRAM BASED ON THE
+C                                     RANGE OF HI AND LO VALUES OF THE
+C                                     INPUT DATA.
+C
+C                        FLO          COMPUTED BY THE PROGRAM BASED ON THE
+C                                     LOWEST UNSCALED INPUT DATA.
+C
+C                        FT           (G10.3)  PARENTHESES MUST BE
+C                                     INCLUDED.
+C
+C                        HI           COMPUTED BY THE PROGRAM BASED ON THE
+C                                     HIGHEST UNSCALED INPUT DATA.
+C
+C                        CHARS        NO TITLE
+C
+C                        IF           10 CHARACTERS
+C
+C                        INUM         NO TITLE
+C
+C                        IPAT         '$$$$$$$$$$'  (THIS IS A 10 CHARACTER
+C                                     STRING.)
+C
+C                        ISZLSZ       9 PLOTTER ADDRESS UNITS
+C
+C                        ISZSML       15 PLOTTER ADDRESS UNITS
+C
+C                        ISZSPD       8 PLOTTER ADDRESS UNITS
+C
+C                        ISZSTL       16 PLOTTER ADDRESS UNITS
+C
+C                        ISTEP        40
+C
+C                        IVAL         'HI' FOR ALL EXCEPT  MINOR  CON-
+C                                     TOUR   LINES   WHICH  ARE  'LO'.
+C
+C                        L            7  CHARACTERS  (INCLUDING   BOTH
+C                                     PARENTHESES)
+C
+C                        NCL          COMPUTED BY THE PROGRAM BASED ON
+C                                     INPUT DATA.  UP TO 30 CONTOUR
+C                                     LEVELS ARE PERMITTED.
+C
+C                        NUM          4 DATA POINTS
+C
+C                        SCALE        1. (NO SCALING PERFORMED)
+C
+C                        TENS         2.5
+C
+C                        ICSD         0 (NO SHIELD)
+C
+C         OPTIONS WHICH  THE SHAPE OF THE CONTOURS MAY BE MODIFIED BY
+C            EFFECT THE  CHANGING NCP  AND SSZ.  NCP CONTROLS THE
+C              CONTOURS  NUMBER OF DATA POINTS TO BE USED IN THE
+C                        INTERPOLATION.  INCREASING NCP CAUSES MORE
+C                        OF THE  SURROUNDING  DATA  TO INFLUENCE THE
+C                        POINT OF INTERPOLATION.  SOME  DATASETS CAUSE
+C                        DIFFICULTY  WHEN  TRYING  TO PRODUCE MEANINGFUL
+C                        CONTOURS (TRIANGLES WHICH ARE LONG AND  NARROW).
+C                        BY MODIFYING NCP A USER CAN FINE-TUNE A
+C                        PLOT.   INCREASING  ISTEP, THE DENSITY OF THE
+C                        VIRTUAL GRID, WILL  SMOOTH OUT THE CONTOUR
+C                        LINES AND PICK UP  MORE  DETAIL  (NEW  CONTOURS
+C                        WILL APPEAR AS ISTEP INCREASES AND OLD ONES WILL
+C                        SOMETIMES BREAK INTO MORE  DISTINCT UNITS).
+C                        ISTEP IS CHANGED BY THE SSD OPTION.
+C
+C                  NOTE  IF NCP.GT.25, ARRAYS DSQ0 AND IPC0 IN CONDET
+C                        MUST  BE ADJUSTED ACCORDINGLY.  ALSO NCPSZ IN
+C                        CONBDN (25 BY DEFAULT), MUST BE INCREASED TO
+C                        NCP.   THE  DEFAULT  VALUE OF NCP, WHICH IS 4,
+C                        PRODUCES PLEASING  PICTURES  IN  MOST  CASES.
+C                        HOWEVER, FINE-TUNING OF THE INTERPOLATION CAN
+C                        BE OBTAINED BY INCREASING THE  SIZE  OF  NCP,
+C                        WITH  A CORRESPONDING LINEAR INCREASE IN WORK
+C                        SPACE.
+C
+C                        THE INTERPOLATION METHOD USED WILL ALSO CAUSE
+C                        DIFFERENT LOOKING CONTOURS.  THE C1 METHOD
+C                        IS RECOMMENDED WHEN THE DATA IS SPARSE.  IT
+C                        WILL SMOOTH THE DATA AND ADD TRENDS (FALSE
+C                        HILLS AND VALLEYS).  THE LINEAR METHOD IS
+C                        RECOMMENDED WHEN DATA IS DENSE (GT 50 TO 100)
+C                        IT WILL NOT SMOOTH THE DATA OR ADD TRENDS.
+C
+C      INTERFACING WITH  NORMALLY THE SCALING FACTOR WILL BE SET TO OFF.
+C        OTHER GRAPHICS  IN MOST CASES MAPPING CAN BE PERFORMED BEFORE
+C              ROUTINES  CALLING THE CONRAN ENTRY POINT, THUS SAVING THE
+C                        USER FROM  MODIFYING THE FILE.  IF REASONABLE
+C                        RESULTS CANNOT BE OBTAINED, THE STATEMENT
+C                        FUNCTIONS, FX AND FY, WILL HAVE TO BE REPLACED.
+C                        THE ROUTINES HAVING THESE STATEMENT FUNCTIONS
+C                        ARE:
+C
+C                           CONDRW, CONPDV, CONTLK, CONPMS, CONGEN
+C
+C            REFERENCES  AKIMA, HIROSHA
+C                           A METHOD OF BIVARIATE INTERPOLATION AND
+C                           SMOOTH SURFACE FITTING FOR IRREGULARLY
+C                           DISTRIBUTED DATA POINTS.
+C                           ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE
+C                           VOL 4, NO. 2, JUNE 1978, PAGES 148-159
+C                        LAWSON, C.L.
+C                           SOFTWARE FOR C1 SURFACE INTERPOLATION
+C                           JPL PUBLICATION 77-30
+C                           AUGUST 15, 1977
+C
+C     CONRAN ERROR  ERROR  ROUTINE               MESSAGE
+C       MESSAGES
+C                    1      CONRAN         INPUT PARAMETER NDP LT NCP
+C                    2      CONRAN         NCP GT MAX SIZE OR LT 2
+C                    3      CONTNG         ALL COLINEAR DATA POINTS
+C                    4      CONTNG         IDENTICAL INPUT DATA POINTS
+C                                          FOUND
+C                    5      CONOP          UNDEFINED OPTION
+C                    6      CONCLS         CONSTANT INPUT FIELD
+C                    7      CONOP          INCORRECT CONOP CALL USED
+C                    8      CONOP          ILLEGAL USE OF CON OPTION
+C                                          WITH CIL OR CHL OPTIONS
+C                    9      CONOP          NUMBER OF CONTOUR LEVELS
+C                                          EXCEEDS 30
+C                    10     CONDRW         CONTOUR STORAGE EXHAUSTED
+C                                          THIS ERROR IS TRAPPED AND
+C                                          NULLIFIED BY CONRAN.  IT
+C                                          SERVES TO SIGNAL THE USER
+C                                          THAT A CONTOUR LEVEL MAY NOT
+C                                          BE COMPLETE.
+C                    11     CONSTP         ASPECT RATIO OF X AND Y
+C                                          GREATER THAN 5 TO 1.
+C                                          (THIS ERROR MAY CAUSE A POOR
+C                                          QUALITY PLOT.  USUALLY THIS
+C                                          CAN BE FIXED BY MULTIPLYING
+C                                          X OR Y BY A CONSTANT FACTOR.
+C                                          IF THIS SOLUTION IS
+C                                          UNACCEPTABLE THEN INCREASING
+C                                          SSZ TO A VERY LARGE VALUE
+C                                          MAY HELP.  NOTE:  THIS CAN BE
+C                                          EXPENSIVE.)
+C
+C                     THE ERRORS LISTED ABOVE ARE DEFINED AS RECOVERABLE
+C                     ERRORS SHOULD THE USER WISH TO USE THEM IN THAT
+C                     FASHION.  THE DOCUMENTATION ON THE ERPRT77 PACKAGE
+C                     EXPLAINS HOW TO RECOVER FROM AN ERROR.
+C
+C NOTE:  THE COMMON BLOCKS LISTED INCLUDE ALL THE COMMON USED BY
+C        THE ENTIRE CONRAN FAMILY.  NOT ALL MEMBERS WILL USE ALL
+C        THE COMMON VARIABLES.
+C
+C   CONRA1
+C       CL-ARRAY OF CONTOUR LEVELS
+C       NCL-NUMBER OF CONTOUR LEVELS
+C       OLDZ-Z VALUE OF LEFT NEIGHBOR TO CURRENT LOCATION
+C       PV-ARRAY OF PREVIOUS ROW VALUES
+C       HI-LARGEST CONTOUR PLOTTED
+C       FLO-LOWEST CONTOUR PLOTTED
+C       FINC-INCREMENT LEVEL BETWEEN EQUALLY SPACED CONTOURS
+C   CONRA2
+C       REPEAT-FLAG TO TRIANGULATE AND DRAW OR JUST DRAW
+C       EXTRAP-PLOT DATA OUTSIDE OF CONVEX DATA HULL
+C       PER-PUT PERIMETER AROUND PLOT
+C       MESS-FLAG TO INDICATE MESSAGE OUTPUT
+C       ISCALE-SCALING SWITCH
+C       LOOK-PLOT TRIANGLES FLAG
+C       PLDVLS-PLOT THE DATA VALUES FLAG
+C       GRD-PLOT GRID FLAG
+C       CON-USER SET OR PROGRAM SET CONTOURS FLAG
+C       CINC-USER OR PROGRAM SET INCREMENT FLAG
+C       CHILO-USER OR PROGRAM SET HI LOW CONTOURS
+C       LABON-FLAG TO CONTROL LABELING OF CONTOURS
+C       PMIMX-FLAG TO CONTROL THE PLOTTING OF MIN'S
+C             AND MAX'S
+C       SCALE-THE SCALE FACTOR FOR CONTOUR LINE VALUES
+C             AND MIN, MAX PLOTTED VALUES
+C       FRADV-ADVANCE FRAME BEFORE PLOTTING TRIANGULATION
+C       EXTRI-ONLY PLOT TRIANGULATION
+C       BPSIZ-BREAKPOINT SIZE FOR DASHPATTERNS
+C       LISTOP-LIST OPTIONS ON UNIT6 FLAG
+C   CONRA3
+C       IRED-ERPRT77 RECOVERABLE ERROR FLAG
+C   CONRA4
+C       NCP-NUMBER OF DATA POINTS USED AT EACH POINT FOR
+C           POLYNOMIAL CONSTRUCTION.
+C       NCPSZ-MAX SIZE ALLOWED FOR NCP
+C   CONRA5
+C       NIT-FLAG TO INDICATE STATUS OF SEARCH DATA BASE
+C       ITIPV-LAST TRIANGLE INTERPOLATION OCCURRED IN
+C  CONRA6
+C       XST-X COORDINATE START POINT FOR CONTOURING
+C       YST-Y COORDINATE START POINT FOR CONTOURING
+C       XED-X COORDINATE END POINT FOR CONTOURING
+C       YED-Y COORDINATE END POINT FOR CONTOURING
+C       STPSZ-STEP SIZE FOR X,Y CHANGE WHEN CONTOURING
+C       IGRAD-NUMBER OF GRADUATIONS FOR CONTOURING (STEP SIZE)
+C       IG-RESET VALUE FOR IGRAD
+C       XRG-X RANGE OF COORDINATES
+C       YRG-Y RANGE OF COORDINATES
+C       BORD-PERCENT OF FRAME USED FOR CONTOUR PLOT
+C       PXST-X PLOTTER START ADDRESS FOR CONTOURS
+C       PYST-Y PLOTTER START ADDRESS FOR CONTOURS
+C       PXED-X PLOTTER END ADDRESS FOR CONTOURS
+C       PYED-Y PLOTTER END ADDRESS FOR CONTOURS
+C       ITICK-NUMBER OF TICK MARKS FOR GRIDS AND PERIMETERS
+C CONRA7
+C       TITLE-SWITCH TO INDICATE IF TITLE OPTION ON OR OFF
+C       ISTRNG-CHARACTER STRING CONTAINING THE TITLE
+C       ICNT-CHARACTER COUNT OF ISTRNG
+C       ITLSIZ-SIZE OF TITLE IN PWRIT UNITS
+C CONRA8
+C       IHIGH-DEFAULT INTENSITY SETTING
+C       INMAJ-CONTOUR LEVEL INTENSITY FOR MAJOR LINES
+C       INMIN-CONTOUR LEVEL INTENSITY FOR MINOR LINES
+C       INLAB-TITLE AND MESSAGE INTENSITY
+C       INDAT-DATA VALUE INTENSITY
+C       FORM-THE FORMAT FOR PLOTTING THE DATA VALUES
+C       LEN-THE NUMBER OF CHARACTERS IN THE FORMAT
+C       IFMT-SIZE OF THE FORMAT FIELD
+C       LEND-DEFAULT FORMAT LENGTH
+C       IFMTD-DEFAULT FORMAT FIELD SIZE
+C       ISIZEP-SIZE OF THE PLOTTED DATA VALUES
+C  CONRA9
+C       X-ARRAY OF X COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       Y-ARRAY OF Y COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       NP-COUNT IN X AND Y
+C       MXXY-SIZE OF X AND Y
+C       TR-TOP RIGHT CORNER VALUE OF CURRENT CELL
+C       BR-BOTTOM RIGHT CORNER VALUE OF CURRENT CELL
+C       TL-TOP LEFT CORNER VALUE OF CURRENT CELL
+C       BL-BOTTOM LEFT CORNER VALUE OF CURRENT CELL
+C       CONV-CURRENT CONTOUR VALUE
+C       XN-X POSITION WHERE CONTOUR IS BEING DRAWN
+C       YN-Y POSITION WHERE CONTOUR IS BEING DRAWN
+C       ITLL-TRIANGLE WHERE TOP LEFT CORNER OF CURRENT CELL LIES
+C       IBLL-TRIANGLE OF BOTTOM LEFT CORNER
+C       ITRL-TRIANGLE OF TOP RIGHT CORNER
+C       IBRL-TRIANGLE OF BOTTOM RIGHT CORNER
+C       XC-X COORDINATE OF CURRENT CELL
+C       YC-Y COORDINATE OF CURRENT CELL
+C       ITLOC-IN CONJUNCTION WITH PV STORES THE TRIANGLE WHERE PV
+C             VALUE CAME FROM
+C CONR10
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       NL-NUMBER OF LINE SEGMENTS
+C       NTNL-NT+NL
+C       JWIPT-POINTER INTO IWK WHERE WHERE TRIANGLE POINT NUMBERS
+C             ARE STORED
+C       JWIWL-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIWP-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIPL-IN IWK THE LOCATION OF END POINTS FOR BORDER LINE
+C             SEGMENTS
+C       IPR-IN WK THE LOCATION OF THE PARTIAL DERIVATIVES AT EACH
+C           DATA POINT
+C       ITPV-THE TRIANGLE WHERE THE PREVIOUS VALUE CAME FROM
+C CONR11
+C       NREP-NUMBER OF REPETITIONS OF DASH PATTERN BEFORE A LABEL
+C       NCRT-NUMBER OF CRT UNITS FOR A DASH MARK OR BLANK
+C       ISIZEL-SIZE OF CONTOUR LINE LABELS
+C       NDASH-ARRAY CONTAINING THE NEGATIVE VALUED CONTOUR DASH
+C             PATTERN
+C       MINGAP-NUMBER OF UNLABELED LINES BETWEEN EACH LABELED ONE
+C       IDASH-POSITIVE VALUED CONTOUR DASH PATTERN
+C       ISIZEM-SIZE OF PLOTTED MINIMUMS AND MAXIMUMS
+C       EDASH-EQUAL VALUED CONTOUR DASH PATTERN
+C       TENS-DEFAULT TENSION SETTING FOR SMOOTHING
+C CONR12
+C       IXMAX,IYMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C       XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C CONR13
+C       XVS-ARRAY OF THE X COORDINATES FOR SHIELDING
+C       YVS-ARRAY OF THE Y COORDINATES FOR SHIELDING
+C       IXVST-POINTER TO THE USERS X ARRAY FOR SHIELDING
+C       IYVST-POINTER TO THE USERS Y ARRAY FOR SHIELDING
+C       ICOUNT-COUNT OF THE SHIELD ELEMENTS
+C       SPVAL-SPECIAL VALUE USED TO HALT CONTOURING AT THE SHIELD
+C               BOUNDARY
+C       SHIELD-LOGICAL FLAG TO SIGNAL STATUS OF SHIELDING
+C       SLDPLT-LOGICAL FLAG TO INDICATE STATUS OF SHIELD PLOTTING
+C CONR14
+C       LINEAR-C1 LINEAR INTERPOLATING FLAG
+C CONR15
+C       ISTRNG-TITLE OF THE PLOT
+C CONR16
+C       FORM-FORMAT USED FOR DATA
+C CONR17
+C       NDASH-DASH PATTERN USED FOR CONTOUR LINES LESS THAN BP
+C       IDASH-DASH PATTERN USED FOR CONTOUR LINES GREATER THAN BP
+C       EDASH-DASH PATTERN USED FOR CONTOUR LINES EQUAL TO THE BP
+C RANINT
+C       IRANMJ-COLOR INDEX FOR NORMAL (MAJOR) INTENSITY LINES
+C       IRANMN-COLOR INDEX FOR LOW INTENSITY LINES
+C       IRANMJ-COLOR INDEX FOR TEXT (LABELS)
+C
+C +NOAO - Blockdata data conbdn rewritten as run time initialization
+C         Variable LNGTHS not used.
+C
+C     EXTERNAL        CONBDN
+C     DIMENSION       LNGTHS(4), HOLD(4)
+      DIMENSION       HOLD(4)
+C - NOAO
+        CHARACTER*110   IWORK
+        CHARACTER*13    ENCSCR,  ENSCRY
+        CHARACTER*1     ICHAR
+        CHARACTER*500   DPAT
+        REAL            WIND(4),   VIEW(4),  NWIND(4), NVIEW(4)
+      DIMENSION       XD(*)      ,YD(*)      ,ZD(*)      ,WK(*)      ,
+     1                IWK(*)     ,SCRARR(*)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        INTEGER OPLASF, OTXASF, LASF(13), OCOLI, OTEXCI
+        SAVE
+C
+C
+C+NOAO - Variable LNGTHS not used.
+C       DATA LNGTHS(1),LNGTHS(2),LNGTHS(3),LNGTHS(4)/13,4,21,6/
+C-NOAO
+C
+C ICONV CONVERT FORM 0-32767 TO 1-1024
+C
+        DATA ICONV/32/
+C
+C IABOVE AMOUNT TITLE IS PLACED ABOVE PLOT
+C IBELOW, IBEL2 AMOUNT MESSAGE IS BELOW PLOT
+C
+C       DATA IABOVE,IBELOW,IBEL2/30,-30,-45/
+C
+C + NOAO - Label placement is improved by changed these values.  Also,
+C          call the run time initialization subroutine, conbdn.
+C
+      iabove = 30
+      ibelow = -15
+      ibel2 = -30
+      call conbdn
+C - NOAO
+C
+C  THE FOLLOWING CALL IS FOR MONOTORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','CONRAN','CONRAN','VERSION 01')
+C
+C  LIST THE OPTION VALUES IF REQUESTED
+C
+      IF (LISTOP) CALL CONOUT (2)
+C
+C  SET SWITCH TO MAP TRIANGLES, IN CONLOC, FOR QUICK SEARCHES
+C
+      NIT = 0
+C
+C  TEST TO SEE IF ENOUGH INPUT DATA
+C
+      IF (NDP.GE.NCP) GO TO    10
+      CALL SETER (' CONRAN - INPUT PARAMETER NDP LESS THAN NCP',1,
+     1             IREC)
+      RETURN
+C
+   10 IF (NCPSZ.GE.NCP .AND. NCP.GE.2) GO TO    20
+      CALL SETER (' CONRAN - NCP LT 2 OR GT NCPSZ',2,IREC)
+C
+   20 IWK(1) = NDP
+      IWK(2) = NCP
+      IWK(3) = 1
+C
+C  SET POLYLINE COLOR ASF TO INDIVIDUAL
+C
+        CALL GQASF(IERR,LASF)
+        OPLASF = LASF(3)
+        LASF(3) = 1
+        OTXASF = LASF(10)
+        LASF(10) = 1
+        CALL GSASF(LASF)
+C
+C  INQUIRE CURRENT POLYLINE AND TEXT COLOR
+C
+        CALL GQPLCI(IERR,OCOLI)
+        CALL GQTXCI(IERR,OTEXCI)
+C
+C  SET POLYLINE AND TEXT COLOR TO VALUE IN COMMON
+C
+        CALL GSPLCI(IRANMJ)
+      CALL GSTXCI(IRANTX)
+C
+C CONSTRUCTION OF WORK SPACE POINTERS
+C
+C TRIANGLE POINT NUMBERS
+C
+      JWIPT = 16
+C
+C SCRATCH SPACE
+C
+      JWIWL = 6*NDP + 1
+C
+C  END POINTS OF BORDER LINE SEGMENTS AND TRIANGLE NUMBER
+C
+      JWIPL = 24*NDP + 1
+C
+C  POINT NUMBERS WHERE THE NCP DATA POINTS AROUND EACH POINT
+C
+      JWIPC = 27*NDP + 1
+C
+C  SCRATCH SPACE
+C
+      JWIWP = 30*NDP + 1
+C
+C  PARTIAL DERIVATIVES AT EACH DATA POINT
+C
+      IPR = 8*NDP + 1
+C
+C  TEST IF REPEAT (JUST NEW CONTOURS OF INTERPOLATED DATA)
+C  OR NO REPEAT (TRIANGULATE AND CONTOUR)
+C
+      IF (REPEAT) GO TO    30
+C
+C TRIANGULATES THE X-Y PLANE.
+C
+      CALL CONTNG (NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),IWK(JWIWL),
+     1             IWK(JWIWP),WK)
+      IF (NERRO(ITEMP).NE.0) RETURN
+C
+      IWK(5) = NT
+      IWK(6) = NL
+      NTNL = NT+NL
+C
+C  SKIP IF NOT LINEAR INTERPOLATION
+C
+      IF (.NOT.LINEAR) GO TO 25
+C
+C  FIND THE COEFICENTS FOR LINER INTERPOLATION OF EACH TRIANGLE
+C
+      CALL CONLIN(XD,YD,ZD,NT,IWK(JWIPT),WK(IPR))
+      GO TO 35
+C
+C
+C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT.
+C
+ 25   CALL CONDET (NDP,XD,YD,NCP,IWK(JWIPC))
+C
+C  ESTIMATE THE PARTIAL DERIVATIVES AT ALL DATA POINTS
+C
+      CALL CONINT (NDP,XD,YD,ZD,NCP,IWK(JWIPC),WK(IPR))
+C
+C  VERIFY DATA VALUES VALID
+C
+   30 NT = IWK(5)
+      NL = IWK(6)
+      NTNL = NT+NL
+C
+C  COMPUTE STEP SIZE FOR CONTOURING
+C
+ 35   CALL CONSTP (XD,YD,NDP)
+C
+C  SAVE ORIGINAL WINDOW, VIEWPORT OF TRANSFORMATION 1, AND ORIGINAL
+C  LOG SCALING FLAG.
+C
+        CALL GQCNTN(IER,IOLDNT)
+        CALL GQNT(IOLDNT,IER,WIND,VIEW)
+        RX1 = VIEW(1)
+        RX2 = VIEW(2)
+        RY1 = VIEW(3)
+        RY2 = VIEW(4)
+C  SAVE NORMALIZATION TRANSFORMATION 1
+        CALL GQNT(1,IER,WIND,VIEW)
+        CALL GETUSV('LS',IOLLS)
+C
+C  DETERMINE SCALING OPTION
+C
+      ISC = ISCALE+1
+      GO TO (   40,   60,   50),ISC
+C
+C  CONRAN SETS SCALING FACTOR
+C
+   40 CALL SET(PXST,PXED,PYST,PYED,XST,XED,YST,YED,1)
+      GO TO 60
+C
+C  CONRAN PLOTS WITHIN USERS BOUNDARIES
+C
+   50 CALL SET(RX1,RX2,RY1,RY2,XST,XED,YST,YED,1)
+C
+C  IF TRIANGULATION PLOT ONLY BRANCH
+C
+   60 IF (EXTRI) GO TO   390
+C
+C  GENERATE CONTOURS IF NONE SUPPLIED BY USER
+C
+      CALL CONCLS (ZD,NDP)
+      IF (NERRO(ITEMP).NE.0) RETURN
+C
+C  REORDER THE CONTOUR LINES FOR CORRECT PATTERN DISPLAY
+C
+      MAJLNS = 0
+      IF (LABON) CALL CONREO (MAJLNS)
+C
+C  MAKE SURE INTEGER COORDINATES IN 1-1024 RANGE
+C
+      CALL SETUSV('XF',10)
+        CALL SETUSV('YF',10)
+C
+C  SET THE DASH PATTERNS TO DEFAULT IF THEY HAVE NOT BEEN SET
+C
+C
+      IF (IDASH(1:1).NE.' ') GO TO        80
+C
+C  SET POSITIVE CONTOUR VALUE TO DEFAULT
+C
+        IDASH = '$$$$$$$$$$'
+   80 IF (NDASH(1:1).NE.' ') GO TO       100
+C
+C  SET NEGATIVE CONTOUR DASH PATTERN TO DEFAULT
+C
+        NDASH = '$$$$$$$$$$'
+  100 IF (EDASH(1:1).NE.' ') GO TO   120
+C
+C  SET EQUAL CONTOUR DASH PATTERN TO DEFAULT
+C
+        EDASH = '$$$$$$$$$$'
+C
+C  INITIALIZE THE CONTOURING DATA STRUCTURE
+C
+  120 IF (.NOT.EXTRAP) YST = YST+STPSZ
+C
+C  LOAD THE SCRATCH SPACE
+C
+      CALL CONLOD (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C  PERFORM SHIELDING IF SO REQUESTED
+C
+      IF (SHIELD) CALL CONSLD(SCRARR)
+C
+C  *******************************************************
+C  *                                                     *
+C  * IF THE USER NEEDS TO DIVIDE THE PROGRAM UP          *
+C  * THIS IS THE BREAK POINT.  ALL SUBROUTINES CALLED    *
+C  * PRIOR TO THIS MESSAGE ARE NOT USED AGAIN AND        *
+C  * ALL ROUTINES AFTER THIS MESSAGE ARE NOT USED        *
+C  * ANY EARLIER.  NOTE THIS ONLY REFEARS TO ENTRY POINTS*
+C  * WHICH ARE PART OF THE CONRAN PACKAGE.               *
+C  * ALL DATA STRUCTURES AND VARIABLES MUST BE RETAINED. *
+C  *******************************************************
+C
+C
+C  PLOT RELATIVE MINIMUMS AND MAXIMUMS IF REQUESTED
+C
+      IF (PMIMX) CALL CONPMM (SCRARR)
+C
+C
+      LENDAS = NREP*10
+C
+C  SET THE ERROR MODE TO RECOVERY FOR THE CONTOURING STORAGE ERROR
+C
+      CALL ENTSR (IROLD,1)
+C
+C  DRAW THE CONTOURS
+C
+      DO   250 I=1,NCL
+C
+          CONV = CL(I)
+          IF (CONV.GE.BPSIZ) GO TO   150
+C
+C  SET UP NEGATIVE CONTOUR PATTERN
+C
+              DO   140 J=1,10
+                ICHAR = NDASH(J:J)
+                  DO   130 K=1,NREP
+                DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  130             CONTINUE
+  140         CONTINUE
+          GO TO   210
+C
+C  SET UP POSITIVE CONTOUR DASH PATTERN
+C
+  150     IF (CONV.EQ.BPSIZ) GO TO   180
+              DO   170 J=1,10
+                ICHAR = IDASH(J:J)
+                  DO   160 K=1,NREP
+                  DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  160             CONTINUE
+  170         CONTINUE
+          GO TO   210
+C
+C  SET UP EQUAL CONTOUR DASH PATTERN
+C
+  180         DO   200 J=1,10
+                ICHAR = EDASH(J:J)
+                  DO   190 K=1,NREP
+                DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  190             CONTINUE
+  200         CONTINUE
+C
+  210     IF (I.GT.MAJLNS) GO TO   230
+C
+C  SET UP MAJOR LINES
+C
+          CALL GSPLCI (IRANMJ)
+          CALL CONECD (CONV,IWORK,NCUSED)
+          NCHAR = LENDAS + NCUSED
+        DPAT(LENDAS+1:NCHAR) = IWORK(1:NCUSED)
+          GO TO   240
+C
+C  SET UP MINOR LINES
+C
+  230     NCHAR = 10
+      CALL GSPLCI (IRANMN)
+C
+C  PROCESS FOR ALL CONTOURS
+C
+  240     CALL DASHDC (DPAT(1:NCHAR),NCRT,ISIZEL)
+C
+C  DRAW ALL CONTOURS AT THIS LEVEL
+C
+          CALL CONDRW (SCRARR)
+C
+C  GET NEXT CONTOUR LEVEL
+C
+  250     CONTINUE
+C
+C  CONTOURING COMPLETED CHECK FOR OPTIONAL OUTPUTS ON PLOT
+C
+C  FIRST SET ERROR MODE BACK TO USERS VALUE
+C
+      CALL RETSR (IROLD)
+C
+C  GET PLOT BOUNDRIES FOR TITLING AND MESSAGE POSITIONING
+C
+      CALL GQCNTN(IER,ICN)
+        CALL GQNT(ICN,IER,NWIND,NVIEW)
+        XST = NWIND(1)
+        XED = NWIND(2)
+        YST = NWIND(3)
+        YED = NWIND(4)
+        CALL GETUSV('LS',LT)
+C
+C  RESET POLYLINE COLOR INDEX TO MAJOR (NORMAL)
+C
+        CALL GSPLCI (IRANMJ)
+C
+C  DRAW SHIELD ON PLOT IF REQUESTED
+C
+      IF(SLDPLT.AND.SHIELD) CALL CONDSD
+C
+C  DRAW PERIMETER ARROUND PLOT IF DESIRED
+C
+      IF (PER) CALL PERIM (ITICK,0,ITICK,0)
+C
+C  DRAW GRID IF REQUESTED
+C
+      IF (GRD) CALL GRID (ITICK,0,ITICK,0)
+C
+C  PLOT THE DATA VALUES IF REQUESTED
+C
+      IF (.NOT.PLDVLS) GO TO   260
+      CALL CONPDV (XD,YD,ZD,NDP)
+C
+C  OUTPUT TITLE IF REQUESTED
+C
+  260 IF (.NOT.TITLE) GO TO   270
+        CALL GSTXCI (IRANTX)
+      CALL FL2INT (XED,YED,MX,MY)
+      MY = (MY/ICONV)+IABOVE
+        ILAST = 64
+        DO 261 I = 64,1,-1
+            IF (ISTRNG(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 262
+            ENDIF
+  261 CONTINUE
+  262 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,ISTRNG(1:ILAST),ITLSIZ,0,0)
+      CALL GSELNT(ICN)
+C
+C
+C  OUTPUT MESSAGE IF REQUESTED
+C
+  270 IF (.NOT.MESS) GO TO   390
+C
+        CALL GSTXCI(IRANTX)
+      CALL FL2INT (XST,YST,MX,MY)
+      MY = (MY/ICONV)
+C
+C  IF PERIMETER OR GRID PUT OUT TICK INTERVAL
+C
+        IMSZ = 0
+      IF (.NOT.PER .AND. .NOT.GRD) GO TO   300
+        IWORK(1:36) = 'X INTERVAL=              Y INTERVAL='
+C
+C +NOAO - FTN internal writes rewritten as calls to encode.
+C       WRITE(ENCSCR,'(G13.5)')XRG
+C       WRITE(ENSCRY,'(G13.5)')YRG
+        call encode (13, '(f13.5)', encscr, xrg)
+	call encode (13, '(f13.5)', enscry, yrg)
+C -NOAO
+        IWORK(12:24) = ENCSCR
+        IWORK(37:49) = ENSCRY
+        IMSZ = 50
+  300 IF (SCALE .EQ. 1.) GOTO 330
+            IWORK(IMSZ:IMSZ+10) = ' SCALED BY '
+C +NOAO
+C           WRITE(ENCSCR,'(G13.5)')SCALE
+            call encode (13, '(f13.5)', encscr, scale)
+C -NOAO
+            IWORK(IMSZ+11:IMSZ+23) = ENCSCR
+            IMSZ = 73
+  330 IF (IMSZ .NE. 0) THEN
+        ILAST = IMSZ
+        DO 291 I = IMSZ,1,-1
+            IF (IWORK(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 292
+            ENDIF
+  291 CONTINUE
+  292 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY+IBEL2)
+      CALL WTSTR(XC,YC,IWORK(1:ILAST),8,0,0)
+      CALL GSELNT(ICN)
+        ENDIF
+C
+C  PRODUCE CONTOUR INFO
+C
+      IWORK(1:42) = 'CONTOUR FROM              TO              '
+      IWORK(43:77) = 'CONTOUR INTERVAL OF                '
+      HOLD(1) = FLO
+      HOLD(2) = HI
+      HOLD(3) = FINC
+C
+C +NOAO
+C       WRITE(ENCSCR,'(G13.5)')HOLD(1)
+        call encode (13, '(f13.5)', encscr, hold(1))
+        IWORK(13:25) = ENCSCR
+C       WRITE(ENCSCR,'(G13.5)')HOLD(2)
+        call encode (13, '(f13.5)', encscr, hold(2))
+        IWORK(29:41) = ENCSCR
+C       WRITE(ENCSCR,'(G13.5)')HOLD(3)
+        call encode (13, '(f13.5)', encscr, hold(3))
+        IWORK(62:74) = ENCSCR
+C -NOAO
+C
+C  IF IRREGULAR SPACED CONTOURS MODIFY CONTOUR INTERVAL STATEMENT
+C
+      IF (FINC.GE.0.) GO TO   380
+      NC = 62
+          IWORK(NC:NC+15) = ' IRREGULAR      '
+C
+        ILAST = 77
+  380 DO 381 I = 77,1,-1
+            IF (IWORK(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 382
+            ENDIF
+  381 CONTINUE
+  382 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY+IBELOW)
+      CALL WTSTR(XC,YC,IWORK(1:ILAST),8,0,0)
+      CALL GSELNT(ICN)
+C
+C
+C
+C  PLOT TRIANGLES IF REQUESTED
+C
+  390 IF (LOOK) THEN
+          CALL GSPLCI(IRANMN)
+          CALL CONTLK (XD,YD,NDP,IWK(JWIPT))
+          CALL GSPLCI(IRANMJ)
+      ENDIF
+C  RESTORE NORMALIZATION TRANSFORMATION 1 AND LOG SCALING
+      IF (ISCALE .NE. 1) THEN
+        CALL SET(VIEW(1),VIEW(2),VIEW(3),VIEW(4),
+     -           WIND(1),WIND(2),WIND(3),WIND(4),IOLLS)
+      ENDIF
+C RESTORE ORIGINAL NORMALIZATION TRANSFORMATION NUMBER
+      CALL GSELNT (IOLDNT)
+C
+C  RESTORE ORIGINAL COLOR
+C
+      CALL GSPLCI(OCOLI)
+      CALL GSTXCI(OTEXCI)
+C
+C  RESTORE POLYLINE COLOR ASF TO WHAT IT WAS ON ENTRY TO GRIDAL
+C
+        LASF(10) = OTXASF
+        LASF(3) = OPLASF
+        CALL GSASF(LASF)
+      RETURN
+      END
+      SUBROUTINE CONPMM (SCRARR)
+C
+C THIS ROUTINE FINDS RELATIVE MINIMUMS AND MAXIMUMS.  A RELATIVE MINIMUM
+C (OR MAXIMUM) IS DEFINED TO BE THE LOWEST (OR HIGHEST) POINT WITHIN
+C A CERTAIN NEIGHBORHOOD OF THE POINT.  THE NEIGHBORHOOD USED HERE
+C IS + OR - IXRG IN THE X DIRECTION AND + OR - IYRG IN THE Y DIRECTION.
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+      DIMENSION       SCRARR(*)
+      CHARACTER*10    IA
+      SAVE
+C
+C  CONVERT FROM 0-32767 TO 1-1024
+C
+        DATA ICONV/32/
+C
+C  ACCESSING FUNCTION INTO SCRARR
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  GRAPHICS MAPPING FUNCTIONS
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C  MAPPING FROM INTEGER TO USER INPUT FLOATING POINT
+C
+      CONVX(IXX) = XST + FLOAT(IXX-1)*STPSZ
+      CONVY(IYY) = YST + FLOAT(IYY-1)*STPSZ
+C
+C  SET INTENSITY TO HIGH
+C
+        IF (INDAT .NE. 1) THEN
+          CALL GSTXCI (INDAT)
+      ELSE
+            CALL GSTXCI (IRANTX)
+        ENDIF
+C
+C  COMPUTE THE SEARCH RANGE FOR MIN AND MAX DETERMINATION
+C
+      IXRG = MIN0(15,MAX0(2,IFIX(FLOAT(IXMAX)/8.)))
+      IYRG = MIN0(15,MAX0(2,IFIX(FLOAT(IYMAX)/8.)))
+C
+C  LOOP THROUGH ALL ROWS OF THE DATA SEARCHING FOR AN IMMEDIATE MIN OR
+C  MAX.
+C
+      IX = 1
+C
+C  SCAN A ROW
+C
+C  IF EXTRAPOLATING DONT LIMIT ROW SCANS
+C
+   10 IF (.NOT.EXTRAP) GO TO    20
+      IYST = 1
+      IYED = IYMAX
+      IY = 1
+      GO TO    30
+C
+C  NOT EXTRAPOLATING STAY IN HULL BOUNDRIES
+C
+   20 IYST = ITLOC(IX*2-1)
+      IYED = ITLOC(IX*2)
+      IF (IYST.EQ.0) GO TO   240
+      IY = IYST
+   30 VAL = SCRTCH(IX,IY)
+C
+C  SEARCH FOR A MIN
+C
+C
+C  BRANCH IF NOT FIRST ON A ROW
+C
+      IF (IY.NE.IYST) GO TO    40
+      IF (VAL.GE.SCRTCH(IX,IY+1)) GO TO   130
+      IF (VAL.GE.SCRTCH(IX,IY+2)) GO TO   130
+      GO TO    60
+C
+C  BRANCH IF NOT LAST ON ROW
+C
+   40 IF (IY.NE.IYED) GO TO    50
+      IF (VAL.GE.SCRTCH(IX,IY-1)) GO TO   140
+      IF (VAL.GE.SCRTCH(IX,IY-2)) GO TO   140
+      GO TO    60
+C
+C  IN MIDDLE OF ROW
+C
+   50 IF (VAL.GE.SCRTCH(IX,IY+1)) GO TO   150
+      IF (VAL.GE.SCRTCH(IX,IY-1)) GO TO   150
+C
+C  POSSIBLE MIN FOUND SEARCH NEIGHBORHOOD
+C
+   60 IXST = MAX0(1,IX-IXRG)
+      IXSTOP = MIN0(IXMAX,IX+IXRG)
+C
+C IF NOT EXTRAPOLATING BRANCH
+C
+   70 IF (.NOT.EXTRAP) GO TO    80
+      IYSRS = 1
+      IYSRE = IYMAX
+      GO TO    90
+C
+C  NOT EXTRAPOLATING STAY IN CONVEX HULL
+C
+   80 IYSRS = ITLOC(IXST*2-1)
+      IYSRE = ITLOC(IXST*2)
+      IF (IYSRS.EQ.0) GO TO   120
+C
+   90 IYSRS = MAX0(IYSRS,IY-IYRG)
+      IYSRE = MIN0(IYSRE,IY+IYRG)
+C
+  100 CUR = SCRTCH(IXST,IYSRS)
+      IF (VAL.LT.CUR) GO TO   110
+      IF (VAL.GT.CUR) GO TO   230
+      IF (IX.EQ.IXST .AND. IY.EQ.IYSRS) GO TO   110
+      GO TO   230
+C
+C  SUCCESS SO FAR TRY NEXT SPACE
+C
+  110 IYSRS = IYSRS+1
+      IF (IYSRS.LE.IYSRE) GO TO   100
+  120 IXST = IXST+1
+      IF (IXST.LE.IXSTOP) GO TO    70
+C
+C  SUCCESS, WE HAVE FOUND A RELATIVE MIN
+C
+      X = CONVX(IX)
+      Y = CONVY(IY)
+      X1 = FX(X,Y)
+      CALL FL2INT (X1,FY(X,Y),MX,MY)
+      MX = MX/ICONV
+      MY = MY/ICONV
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,'L',ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      CALL CONECD (VAL,IA,NC)
+      MY = MY - 2*ISIZEM
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,IA(1:NC),ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      GO TO   230
+C
+C  SEARCH FOR A LOCAL MAXIMUM
+C
+C  IF FIRST LOC ON A ROW
+C
+  130 IF (VAL.LE.SCRTCH(IX,IY+1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY+2)) GO TO   230
+      GO TO   160
+C
+C  IF LAST ON ROW
+C
+  140 IF (VAL.LE.SCRTCH(IX,IY-1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY-2)) GO TO   230
+      GO TO   160
+C
+C  IN MIDDLE OF ROW
+C
+  150 IF (VAL.LE.SCRTCH(IX,IY+1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY-1)) GO TO   230
+C
+C  POSSIBLE MIN FOUND SEARCH NEIGHBORHOOD
+C
+  160 IXST = MAX0(1,IX-IXRG)
+      IXSTOP = MIN0(IXMAX,IX+IXRG)
+  170 IF (.NOT.EXTRAP) GO TO   180
+      IYSRS = 1
+      IYSRE = IYMAX
+      GO TO   190
+C
+C  NOT EXTRAPOLATING STAY IN CONVEX HULL
+C
+  180 IYSRS = ITLOC(IXST*2-1)
+      IYSRE = ITLOC(IXST*2)
+      IF (IYSRS.EQ.0) GO TO   220
+C
+  190 IYSRS = MAX0(IYSRS,IY-IYRG)
+      IYSRE = MIN0(IYSRE,IY+IYRG)
+C
+  200 CUR = SCRTCH(IXST,IYSRS)
+      IF (VAL.GT.CUR) GO TO   210
+      IF (VAL.LT.CUR) GO TO   230
+      IF (IX.EQ.IXST .AND. IY.EQ.IYSRS) GO TO   210
+      GO TO   230
+C
+C  SUCCESS SO FAR TRY NEXT SPACE
+C
+  210 IYSRS = IYSRS+1
+      IF (IYSRS.LE.IYSRE) GO TO   200
+  220 IXST = IXST+1
+      IF (IXST.LE.IXSTOP) GO TO   170
+C
+C  SUCCESS WE HAVE A MAXIMUM
+C
+      X = CONVX(IX)
+      Y = CONVY(IY)
+      X1 = FX(X,Y)
+      CALL FL2INT (X1,FY(X,Y),MX,MY)
+      MX = MX/ICONV
+      MY = MY/ICONV
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,'H',ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      CALL CONECD (VAL,IA,NC)
+      MY = MY - 2*ISIZEM
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,IA(1:NC),ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+C  END OF SEARCH AT THIS LOCATION TRY NEXT
+C
+  230 IY = IY+1
+      IF (IY.LE.IYED) GO TO    30
+  240 IX = IX+1
+      IF (IX.LE.IXMAX) GO TO    10
+C
+      CALL GSTXCI (IRANTX)
+C
+      RETURN
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONRAN TO ULIB                              *
+C*  AUGUST 1980 CHANGED ACCESS CARD DOCUMENTATION                 *
+C*  DECEMBER 1980 MODIFIED COMMENT CARD DOCUMENTATION             *
+C*  MARCH 1983  ADDED ASPECT RATIO ERROR                          *
+C*  JULY 1983  ADDED SHIELDING AND LINEAR INTERPOLATION           *
+C*             REMOVED 7600 ACCESS CARDS                          *
+C*  JULY 1984  CONVERTED TO STANDARD FORTRAN77 AND GKS        *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conrec.f b/sys/gio/ncarutil/conrec.f
new file mode 100644
index 00000000..b3e246c1
--- /dev/null
+++ b/sys/gio/ncarutil/conrec.f
@@ -0,0 +1,1313 @@
+      SUBROUTINE CONREC (Z,L,M,N,FLO,HI,FINC,NSET,NHI,NDOT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+C     DIMENSION OF           Z(L,N)
+C     ARGUMENTS
+C
+C     LATEST REVISION        JUNE 1984
+C
+C     PURPOSE                CONREC DRAWS A CONTOUR MAP FROM DATA STORED
+C                            IN A RECTANGULAR ARRAY, LABELING THE LINES.
+C
+C     USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                              CALL EZCNTR (Z,M,N)
+C
+C                              ASSUMPTIONS:
+C                                  --ALL OF THE ARRAY IS TO BE CONTOURED.
+C                                  --CONTOUR LEVELS ARE PICKED
+C                                    INTERNALLY.
+C                                  --CONTOURING ROUTINE PICKS SCALE
+C                                    FACTORS.
+C                                  --HIGHS AND LOWS ARE MARKED.
+C                                  --NEGATIVE LINES ARE DRAWN WITH A
+C                                    DASHED LINE PATTERN.
+C                                  --EZCNTR CALLS FRAME AFTER DRAWING THE
+C                                    CONTOUR MAP.
+C
+C                            IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                              CALL CONREC (Z,L,M,N,FLO,HI,FINC,NSET,
+C                                           NHI,NDOT)
+C
+C     ARGUMENTS
+C
+C     ON INPUT               Z
+C     FOR EZCNTR               M BY N ARRAY TO BE CONTOURED.
+C
+C                            M
+C                              FIRST DIMENSION OF Z.
+C
+C                            N
+C                              SECOND DIMENSION OF Z.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR EZCNTR
+C
+C     ON INPUT               Z
+C     FOR CONREC               THE (ORIGIN OF THE) ARRAY TO BE
+C                              CONTOURED.  Z IS DIMENSIONED L BY N.
+C
+C                            L
+C                              THE FIRST DIMENSION OF Z IN THE CALLING
+C                              PROGRAM.
+C
+C                            M
+C                              THE NUMBER OF DATA VALUES TO BE CONTOURED
+C                              IN THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                              DIRECTION).  WHEN PLOTTING AN ENTIRE
+C                              ARRAY, L = M.
+C
+C                            N
+C                              THE NUMBER OF DATA VALUES TO BE CONTOURED
+C                              IN THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                              DIRECTION).
+C
+C                            FLO
+C                              THE VALUE OF THE LOWEST CONTOUR LEVEL.
+C                              IF FLO = HI = 0., A VALUE ROUNDED UP FROM
+C                              THE MINIMUM Z IS GENERATED BY CONREC.
+C
+C                            HI
+C                              THE VALUE OF THE HIGHEST CONTOUR LEVEL.
+C                              IF HI = FLO = 0., A VALUE ROUNDED DOWN
+C                              FROM THE MAXIMUM Z IS GENERATED BY
+C                              CONREC.
+C
+C                            FINC
+C                              > 0  INCREMENT BETWEEN CONTOUR LEVELS.
+C                              = 0  A VALUE, WHICH PRODUCES BETWEEN 10
+C                                   AND 30 CONTOUR LEVELS AT NICE VALUES,
+C                                   IS GENERATED BY CONREC.
+C                              < 0  THE NUMBER OF LEVELS GENERATED BY
+C                                   CONREC IS ABS(FINC).
+C
+C                            NSET
+C                              FLAG TO CONTROL SCALING.
+C                              = 0  CONREC AUTOMATICALLY SETS THE
+C                                   WINDOW AND VIEWPORT TO PROPERLY
+C                                   SCALE THE FRAME TO THE STANDARD
+C                                   CONFIGURATION.
+C                                   THE GRIDAL ENTRY PERIM IS
+C                                   CALLED AND TICK MARKS ARE PLACED
+C                                   CORRESPONDING TO THE DATA POINTS.
+C                              > 0  CONREC ASSUMES THAT THE USER
+C                                   HAS SET THE WINDOW AND VIEWPORT
+C                                   IN SUCH A WAY AS TO PROPERLY
+C                                   SCALE THE PLOTTING
+C                                   INSTRUCTIONS GENERATED BY CONREC.
+C                                   PERIM IS NOT CALLED.
+C                              < 0  CONREC GENERATES COORDINATES SO AS
+C                                   TO PLACE THE (UNTRANSFORMED) CONTOUR
+C                                   PLOT WITHIN THE LIMITS OF THE
+C                                   USER'S CURRENT WINDOW AND
+C                                   VIEWPORT.  PERIM IS NOT CALLED.
+C
+C                            NHI
+C                              FLAG TO CONTROL EXTRA INFORMATION ON THE
+C                              CONTOUR PLOT.
+C                              = 0  HIGHS AND LOWS ARE MARKED WITH AN H
+C                                   OR L AS APPROPRIATE, AND THE VALUE
+C                                   OF THE HIGH OR LOW IS PLOTTED UNDER
+C                                   THE SYMBOL.
+C                              > 0  THE DATA VALUES ARE PLOTTED AT
+C                                   EACH Z POINT, WITH THE CENTER OF
+C                                   THE STRING INDICATING THE DATA
+C                                   POINT LOCATION.
+C                              < 0  NEITHER OF THE ABOVE.
+C
+C                            NDOT
+C                              A 10-BIT CONSTANT DESIGNATING THE DESIRED
+C                              DASHED LINE PATTERN.
+C                              IF ABS(NDOT) = 0, 1, OR 1023, SOLID LINES
+C                              ARE DRAWN.
+C                              > 0 NDOT PATTERN IS USED FOR ALL LINES.
+C                              < 0 ABS(NDOT) PATTERN IS USED FOR NEGA-
+C                                TIVE-VALUED CONTOUR LINES, AND SOLID IS
+C                                USED FOR POSITIVE-VALUED CONTOURS.
+C                                CONREC CONVERTS NDOT
+C                                TO A 16-BIT PATTERN AND DASHDB IS USED.
+C                                SEE DASHDB COMMENTS IN THE DASHLINE
+C                                DOCUMENTATION FOR DETAILS.
+C
+C
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR CONREC
+C
+C
+C     ENTRY POINTS           CONREC, CLGEN, REORD, STLINE, DRLINE,
+C                            MINMAX, PNTVAL, CALCNT, EZCNTR, CONBD
+C
+C     COMMON BLOCKS          INTPR, RECINT, CONRE1, CONRE2, CONRE3,
+C                            CONRE4,CONRE5
+C
+C     REQUIRED LIBRARY       STANDARD VERSION: DASHCHAR, WHICH AT
+C     ROUTINES               NCAR ISLOADED BY DEFAULT.
+C                            SMOOTH VERSION: DASHSMTH WHICH MUST BE
+C                            REQUESTED AT NCAR.
+C                            BOTH VERSIONS REQUIRE  GRIDAL, THE
+C                            ERPRT77 PACKAGE, AND THE SPPS.
+C
+C     I/O                    PLOTS CONTOUR MAP.
+C
+C     PRECISION              SINGLE
+C
+C     LANGUAGE               FORTRAN 77
+C
+C     HISTORY                REPLACES OLD CONTOURING PACKAGE CALLED
+C                            CALCNT AT NCAR.
+C
+C     ALGORITHM              EACH LINE IS FOLLOWED TO COMPLETION.  POINTS
+C                            ALONG A LINE ARE FOUND ON BOUNDARIES OF THE
+C                            (RECTANGULAR) CELLS. THESE POINTS ARE
+C                            CONNECTED BY LINE SEGMENTS USING THE
+C                            SOFTWARE DASHED LINE PACKAGE, DASHCHAR.
+C                            DASHCHAR IS ALSO USED TO LABEL THE
+C                            LINES.
+C
+C     NOTE                   TO DRAW NON-UNIFORM CONTOUR LEVELS, SEE
+C                            THE COMMENTS IN CLGEN.  TO MAKE SPECIAL
+C                            MODIFICATIONS FOR SPECIFIC NEEDS SEE THE
+C                            EXPLANATION OF THE INTERNAL PARAMETERS
+C                            BELOW.
+C
+C     TIMING                 VARIES WIDELY WITH SIZE AND SMOOTHNESS OF
+C                            Z.
+C
+C     INTERNAL PARAMETERS    NAME   DEFAULT         FUNCTION
+C                            ----   -------         --------
+C
+C                            ISIZEL   1      SIZE OF LINE LABELS,
+C                                            AS PER THE SIZE DEFINITIONS
+C                                            GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            ISIZEM   2      SIZE OF LABELS FOR MINIMUMS
+C                                            AND MAXIMUMS,
+C                                            AS PER THE SIZE DEFINITIONS
+C                                            GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            ISIZEP   0      SIZE OF LABELS FOR DATA
+C                                            POINT VALUES AS PER THE SIZE
+C                                            DEFINITIONS GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            NLA      16     APPROXIMATE NUMBER OF
+C                                            CONTOUR LEVELS WHEN
+C                                            INTERNALLY GENERATED.
+C
+C                            NLM      40     MAXIMUM NUMBER OF CONTOUR
+C                                            LEVELS.  IF THIS IS TO BE
+C                                            INCREASED, THE DIMENSIONS
+C                                            OF CL AND RWORK IN CONREC
+C                                            MUST BE INCREASED BY THE
+C                                            SAME AMOUNT.
+C
+C                            XLT      .05    LEFT HAND EDGE OF THE PLOT
+C                                            (0.0 IS THE LEFT EDGE OF
+C                                            THE FRAME AND 1.0 IS THE
+C                                            RIGHT EDGE OF THE FRAME.)
+C
+C                            YBT      .05    BOTTOM EDGE OF THE PLOT
+C                                            (0.0 IS THE BOTTOM OF THE
+C                                            FRAME AND 1.0 IS THE TOP
+C                                            OF THE FRAME.)
+C
+C                            SIDE     0.9    LENGTH OF LONGER EDGE OF
+C                                            PLOT (SEE ALSO EXT).
+C
+C                            NREP     6      NUMBER OF REPETITIONS OF
+C                                            THE DASH PATTERN BETWEEN
+C                                            LINE LABELS.
+C
+C                            NCRT     2      NUMBER OF CRT UNITS PER
+C                                            ELEMENT (BIT) IN THE DASH
+C                                            PATTERN.
+C +NOAO - Value of ncrt changed from 4 to 2 in conbd.
+C -NOAO
+C
+C                            ILAB     1      FLAG TO CONTROL THE DRAWING
+C                                            OF LINE LABELS.
+C                                            . ILAB NON-ZERO MEANS LABEL
+C                                              THE LINES.
+C                                            . ILAB = 0 MEANS DO NOT
+C                                              LABEL THE LINES.
+C
+C                            NULBLL   3      NUMBER OF UNLABELED LINES
+C                                            BETWEEN LABELED LINES.  FOR
+C                                            EXAMPLE, WHEN NULBLL = 3,
+C                                            EVERY FOURTH LEVEL IS
+C                                            LABELED.
+C
+C                            IOFFD    0      FLAG TO CONTROL
+C                                            NORMALIZATION OF LABEL
+C                                            NUMBERS.
+C                                            . IOFFD = 0 MEANS INCLUDE
+C                                              DECIMAL POINT WHEN
+C                                              POSSIBLE (DO NOT
+C                                              NORMALIZE UNLESS
+C                                              REQUIRED).
+C                                            . IOFFD NON-ZERO MEANS
+C                                              NORMALIZE ALL LABEL
+C                                              NUMBERS AND OUTPUT A
+C                                              SCALE FACTOR IN THE
+C                                              MESSAGE BELOW THE GRAPH.
+C
+C                            EXT      .0625  LENGTHS OF THE SIDES OF THE
+C                                            PLOT ARE PROPORTIONAL TO M
+C                                            AND N (WHEN CONREC SETS
+C                                            THE WINDOW AND VIEWPORT).
+C                                            IN EXTREME CASES, WHEN
+C                                            MIN(M,N)/MAX(M,N) IS LESS
+C                                            THAN EXT, CONREC
+C                                            PRODUCES A SQUARE PLOT.
+C
+C                            IOFFP      0    FLAG TO CONTROL SPECIAL
+C                                            VALUE FEATURE.
+C                                            . IOFFP = 0 MEANS SPECIAL
+C                                              VALUE FEATURE NOT IN USE.
+C                                            . IOFFP NON-ZERO MEANS
+C                                              SPECIAL VALUE FEATURE IN
+C                                              USE.  (SPVAL IS SET TO THE
+C                                              SPECIAL VALUE.)  CONTOUR
+C                                              LINES WILL THEN BE
+C                                              OMITTED FROM ANY CELL
+C                                              WITH ANY CORNER EQUAL TO
+C                                              THE SPECIAL VALUE.
+C
+C                            SPVAL    0.     CONTAINS THE SPECIAL VALUE
+C                                            WHEN IOFFP IS NON-ZERO.
+C
+C                            IOFFM    0      FLAG TO CONTROL THE MESSAGE
+C                                            BELOW THE PLOT.
+C                                            . IOFFM = 0  IF THE MESSAGE
+C                                              IS TO BE PLOTTED.
+C                                            . IOFFM NON-ZERO IF THE
+C                                              MESSAGE IS TO BE OMITTED.
+C
+C                            ISOLID   1023   DASH PATTERN FOR
+C                                            NON-NEGATIVE CONTOUR LINES.
+C
+C
+C +NOAO - Block data conbd rewritten as run time initialization.
+C     EXTERNAL        CONBD
+C -NOAO
+C
+      SAVE
+      CHARACTER*1     IGAP       ,ISOL       ,RCHAR
+      CHARACTER       ENCSCR*22  ,IWORK*126
+C +NOAO - Character variable added for improved label processing.
+      character*25    string(5)
+C -NOAO
+      DIMENSION       LNGTHS(5)  ,HOLD(5)    ,WNDW(4)    ,VWPRT(4)
+      DIMENSION       Z(L,N)     ,CL(40)     ,RWORK(40)  ,LASF(13)
+      COMMON /INTPR/ PAD1, FPART, PAD(8)
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+      COMMON /CONRE4/ ISIZEL     ,ISIZEM     ,ISIZEP     ,NREP       ,
+     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD      ,
+     2                EXT        ,IOFFM      ,ISOLID     ,NLA        ,
+     3                NLM        ,XLT        ,YBT        ,SIDE
+      COMMON /CONRE5/ SCLY
+      COMMON /RECINT/ IRECMJ     ,IRECMN     ,IRECTX
+C +NOAO - Value of LNGTHS have been changed from original defaults.  Additional
+C         common block noaolb added for communication with calling routine.
+C
+      common /noaolb/ hold
+      DATA  LNGTHS(1),LNGTHS(2),LNGTHS(3),LNGTHS(4),LNGTHS(5)
+     1      /  13,       4,        21,       10,        19       /
+      DATA  ISOL, IGAP /'$', ''''/
+C
+C -NOAO
+C
+C ISOL AND IGAP (DOLLAR-SIGN AND APOSTROPHE) ARE USED TO CONSTRUCT PAT-
+C TERNS PASSED TO ROUTINE DASHDC IN THE SOFTWARE DASHED-LINE PACKAGE.
+C
+C
+C
+C +NOAO - Blockdata conbd called as run time initialization subroutine
+      call conbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','CONREC','VERSION 01')
+C
+C NONSMOOTHING VERSION
+C
+C
+C
+C  CALL RESET FOR COMPATIBILITY WITH ALL DASH ROUTINES(EXCEPT DASHLINE)
+C
+      CALL RESET
+C
+C  GET NUMBER OF BITS IN INTEGER ARITHMETIC
+C
+      IARTH = I1MACH(8)
+      IXBITS = 0
+      DO 101 I=1,IARTH
+         IF (M .LE. (2**I-1)) GO TO 102
+         IXBITS = I+1
+  101 CONTINUE
+  102 IYBITS = 0
+      DO 103 I=1,IARTH
+         IF (N .LE. (2**I-1)) GO TO 104
+         IYBITS = I+1
+  103 CONTINUE
+  104 IF ((IXBITS*IYBITS).GT.0 .AND. (IXBITS+IYBITS).LE.24) GO TO 105
+C
+C REPORT ERROR NUMBER ONE
+C
+      IWORK =    'CONREC  - DIMENSION ERROR - M*N .GT. (2**IARTH)    M =
+     +            N = '
+C +NOAO
+C
+C     WRITE (IWORK(56:62),'(I6)') M
+      call encode (6, '(i6)', iwork(56:62), m)
+C     WRITE (IWORK(73:79),'(I6)') N
+      call encode (6, '(i6)', iwork(73:79), n)
+C -NOAO
+C
+      CALL SETER( IWORK, 1, 1 )
+      RETURN
+  105 CONTINUE
+C
+C INQUIRE CURRENT TEXT AND LINE COLOR INDEX
+C
+      CALL GQTXCI ( IERR, ITXCI )
+      CALL GQPLCI ( IERR, IPLCI )
+C
+C SET LINE AND TEXT ASF TO INDIVIDUAL
+C
+      CALL GQASF ( IERR, LASF )
+      LSV3  = LASF(3)
+      LSV10 = LASF(10)
+      LASF(3)  = 1
+      LASF(10) = 1
+      CALL GSASF ( LASF )
+C
+      GL = FLO
+      HA = HI
+      GP = FINC
+      MX = L
+      NX = M
+      NY = N
+      IDASH = NDOT
+      NEGPOS = ISIGN(1,IDASH)
+      IDASH = IABS(IDASH)
+      IF (IDASH.EQ.0 .OR. IDASH.EQ.1) IDASH = ISOLID
+C
+C SET CONTOUR LEVELS.
+C
+      CALL CLGEN (Z,MX,NX,NY,GL,HA,GP,NLA,NLM,CL,NCL,ICNST)
+C
+C FIND MAJOR AND MINOR LINES
+C
+      IF (ILAB .NE. 0) CALL REORD (CL,NCL,RWORK,NML,NULBLL+1)
+      IF (ILAB .EQ. 0) NML = 0
+C
+C SAVE CURRENT NORMALIZATION TRANS NUMBER NTORIG AND LOG SCALING FLAG
+C
+      CALL GQCNTN ( IERR, NTORIG )
+      CALL GETUSV ('LS',IOLLS)
+C
+C SET UP SCALING
+C
+      CALL GETUSV ( 'YF' , IYVAL )
+      SCLY = 1.0 / ISHIFT ( 1, 15 - IYVAL )
+C
+      IF (NSET) 106,107,111
+  106 CALL GQNT ( NTORIG,IERR,WNDW,VWPRT )
+      X1 = VWPRT(1)
+      X2 = VWPRT(2)
+      Y1 = VWPRT(3)
+      Y2 = VWPRT(4)
+C
+C SAVE NORMALIZATION TRANS 1
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+C
+C DEFINE NORMALIZATION TRANS AND LOG SCALING
+C
+      CALL SET(X1, X2, Y1, Y2, 1.0, FLOAT(NX), 1.0, FLOAT(NY), 1)
+      GO TO 111
+  107 CONTINUE
+      X1 = XLT
+      X2 = XLT+SIDE
+      Y1 = YBT
+      Y2 = YBT+SIDE
+      X3 = NX
+      Y3 = NY
+      IF (AMIN1(X3,Y3)/AMAX1(X3,Y3) .LT. EXT) GO TO 110
+      IF (NX-NY) 108,110,109
+  108 X2 = SIDE*X3/Y3+XLT
+      GO TO 110
+  109 Y2 = SIDE*Y3/X3+YBT
+C
+C SAVE NORMALIZATION TRANS 1
+C
+  110 CALL GQNT ( 1, IERR, WNDW, VWPRT )
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+C
+C DRAW PERIMETER
+C
+      CALL PERIM (NX-1,1,NY-1,1)
+  111 IF (ICNST .NE. 0) GO TO 124
+C
+C SET UP LABEL SCALING
+C
+      IOFFDT = IOFFD
+      IF (GL.NE.0.0 .AND. (ABS(GL).LT.0.1 .OR. ABS(GL).GE.1.E5))
+     1    IOFFDT = 1
+      IF (HA.NE.0.0 .AND. (ABS(HA).LT.0.1 .OR. ABS(HA).GE.1.E5))
+     1    IOFFDT = 1
+      ASH = 10.**(3-IFIX(ALOG10(AMAX1(ABS(GL),ABS(HA),ABS(GP)))-5000.)-
+     1                                                             5000)
+      IF (IOFFDT .EQ. 0) ASH = 1.
+      HOLD(1) = GL
+      HOLD(2) = HA
+      HOLD(3) = GP
+      HOLD(4) = Z(3,3)
+      HOLD(5) = ASH
+      NCHAR = 0
+      IF (IOFFM .NE. 0) GO TO 115
+C +NOAO -  This label generation has been reworked to eliminate the large
+C          spaces in between fields of the label.
+C     IWORK = 'CONTOUR FROM              TO              CONTOUR INTERVAL
+C    1 OF              PT(3,3)=              LABELS SCALED BY'
+      string(1)(1:13) = 'CONTOUR FROM '
+      string(2)(1:4)  = ' TO '
+      string(3)(1:21) = '; CONTOUR INTERVAL = '
+      string(4)(1:11) = '; PT(3,3)= '
+      string(5)(1:19) = '; LABELS SCALED BY '
+C
+      DO 114 I=1,5
+C (NOAO) WRITE ( ENCSCR, '(G13.5)' ) HOLD(I)
+         call encd (hold(i), ash, encscr, nc, ioffd)
+         do 1113 k = 1, lngths(i)
+            nchar = nchar + 1
+ 1113    iwork(nchar:nchar) = string(i)(k:k)
+C
+C (NOAO) NCHAR = NCHAR+LNGTHS(I)
+C (NOAO) DO 113 J=1,13
+         do 113 j = 1, nc
+            NCHAR = NCHAR+1
+            IWORK(NCHAR:NCHAR) = ENCSCR(J:J)
+  113    CONTINUE
+  114 CONTINUE
+C
+C +NOAO IF (ASH .EQ. 1.) NCHAR = NCHAR-13-LNGTHS(5)
+         if (ash .eq. 1.) nchar = nchar - nc - lngths(5)
+C -NOAO
+C
+C SET TEXT INTENSITY TO LOW, AND WRITE TITLE USING NORMALIZATION
+C TRANS NUMBER 0
+C
+      CALL GSTXCI (IRECTX)
+      CALL GETUSV('LS',LSO)
+      CALL SETUSV('LS',1)
+      CALL GSELNT (0)
+C +NOAO - following text output centered on current viewport
+C     CALL WTSTR ( 0.5, 0.015625, IWORK(1:NCHAR), 0, 0, 0 )
+      CALL WTSTR ( ((x1+x2)/2.0), y1 - 0.03, IWORK(1:NCHAR), 0, 0, 0 )
+C -NOAO
+      CALL SETUSV('LS',LSO)
+      CALL GSELNT (1)
+C
+C
+C
+C                       * * * * * * * * * *
+C                            * * * * * * * * * *
+C
+C
+C PROCESS EACH LEVEL
+C
+  115 FPART = .5
+C
+      DO 123 I=1,NCL
+         CONTR = CL(I)
+         NDASH = IDASH
+         IF (NEGPOS.LT.0 .AND. CONTR.GE.0.) NDASH = ISOLID
+C
+C CHANGE 10 BIT PATTERN TO 10 CHARACTER PATTERN.
+C
+         DO 116 J=1,10
+            IBIT = IAND(ISHIFT(NDASH,(J-10)),1)
+            RCHAR = IGAP
+            IF (IBIT .NE. 0) RCHAR = ISOL
+            IWORK(J:J) = RCHAR
+  116    CONTINUE
+         IF (I .GT. NML) GO TO 121
+C
+C SET UP MAJOR LINE (LABELED)
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI ( IRECMJ )
+C
+C NREP REPITITIONS OF PATTERN PER LABEL.
+C
+         NCHAR = 10
+         IF (NREP .LT. 2) GO TO 119
+         DO 118 J=1,10
+            NCHAR = J
+            RCHAR = IWORK(J:J)
+            DO 117 K=2,NREP
+               NCHAR = NCHAR+10
+               IWORK(NCHAR:NCHAR) = RCHAR
+  117       CONTINUE
+  118    CONTINUE
+  119    CONTINUE
+C
+C PUT IN LABEL.
+C
+         CALL ENCD (CONTR,ASH,ENCSCR,NCUSED,IOFFDT)
+         DO 120 J=1,NCUSED
+            NCHAR = NCHAR+1
+            IWORK(NCHAR:NCHAR) = ENCSCR(J:J)
+  120    CONTINUE
+         GO TO 122
+C
+C SET UP MINOR LINE (UNLABELED).
+C
+  121    CONTINUE
+C
+C SET LINE INTENSITY TO LOW
+C
+         CALL GSPLCI ( IRECMN )
+         NCHAR = 10
+  122    CALL DASHDC ( IWORK(1:NCHAR),NCRT, ISIZEL )
+C
+C
+C DRAW ALL LINES AT THIS LEVEL.
+C
+         CALL STLINE (Z,MX,NX,NY,CONTR)
+C
+C
+  123 CONTINUE
+C
+C FIND RELATIVE MINIMUMS AND MAXIMUMS IF WANTED, AND MARK VALUES IF
+C WANTED.
+C
+      IF (NHI .EQ. 0) CALL MINMAX (Z,MX,NX,NY,ISIZEM,ASH,IOFFDT)
+      IF (NHI .GT. 0) CALL MINMAX (Z,MX,NX,NY,ISIZEP,-ASH,IOFFDT)
+      FPART = 1.
+      GO TO 127
+  124 CONTINUE
+         IWORK = 'CONSTANT FIELD'
+C +NOAO 
+C     WRITE( ENCSCR, '(G22.14)' ) GL
+      i = gl
+      call encode (22, '(g22.14)', encscr, i)
+C -NOAO
+      DO 126 I=1,22
+         IWORK(I+14:I+14) = ENCSCR(I:I)
+  126 CONTINUE
+C
+C WRITE TITLE USING NORMALIZATION TRNS 0
+C
+      CALL GETUSV('LS',LSO)
+      CALL SETUSV('LS',1)
+      CALL GSELNT (0)
+C +NOAO
+C     CALL WTSTR ( 0.09765, 0.48825, IWORK(1:36), 3, 0, -1 )
+      CALL WTSTR ( x1+0.03, (y1+y2)/2.0, IWORK(1:36), 3, 0, -1 )
+C -NOAO
+C
+C RESTORE NORMALIZATION TRANS 1, LINE AND TEXT INTENSITY TO ORIGINAL
+C
+  127 IF (NSET.LE.0) THEN
+          CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -             WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      END IF
+      CALL GSPLCI ( IPLCI )
+      CALL GSTXCI ( ITXCI )
+C
+C SELECT ORIGINAL NORMALIZATION TRANS NUMBER NTORIG, AND RESTORE ASF
+C
+      CALL GSELNT ( NTORIG )
+      LASF(3)  = LSV3
+      LASF(10) = LSV10
+      CALL GSASF ( LASF )
+C
+      RETURN
+C
+C
+      END
+      SUBROUTINE CLGEN (Z,MX,NX,NNY,CCLO,CHI,CINC,NLA,NLM,CL,NCL,ICNST)
+      SAVE
+      DIMENSION       CL(NLM)    ,Z(MX,NNY)
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+C
+C CLGEN PUTS THE VALUES OF THE CONTOUR LEVELS IN CL.
+C VARIABLE NAMES MATCH THOSE IN CONREC, WITH THE FOLLOWING ADDITIONS.
+C         NCL     -NUMBER OF CONTOUR LEVELS PUT IN CL.
+C         ICNST   -FLAG TO TELL CONREC IF A CONSTANT FIELD WAS DETECTED.
+C                 .ICNST=0 MEANS NON-CONSTANT FIELD.
+C                 .ICNST NON-ZERO MEANS CONSTANT FIELD.
+C
+C TO PRODUCE NON-UNIFORM CONTOUR LEVEL SPACING, REPLACE THE CODE IN THIS
+C SUBROUTINE WITH CODE TO PRODUCE WHATEVER SPACING IS DESIRED.
+C
+      ICNST = 0
+      NY = NNY
+      CLO = CCLO
+      GLO = CLO
+      HA = CHI
+      FANC = CINC
+      CRAT = NLA
+      IF (HA-GLO) 101,102,111
+  101 GLO = HA
+      HA = CLO
+      GO TO 111
+  102 IF (GLO .NE. 0.) GO TO 120
+      GLO = Z(1,1)
+      HA = Z(1,1)
+      IF (IOFFP .EQ. 0) GO TO 107
+      DO 106 J=1,NY
+         DO 105 I=1,NX
+            IF (Z(I,J) .EQ. SPVAL) GO TO 105
+            GLO = Z(I,J)
+            HA = Z(I,J)
+            DO 104 JJ=J,NY
+               DO 103 II=1,NX
+                  IF (Z(II,JJ) .EQ. SPVAL) GO TO 103
+                  GLO = AMIN1(Z(II,JJ),GLO)
+                  HA = AMAX1(Z(II,JJ),HA)
+  103          CONTINUE
+  104       CONTINUE
+            GO TO 110
+  105    CONTINUE
+  106 CONTINUE
+      GO TO 110
+  107 DO 109 J=1,NY
+         DO 108 I=1,NX
+            GLO = AMIN1(Z(I,J),GLO)
+            HA = AMAX1(Z(I,J),HA)
+  108    CONTINUE
+  109 CONTINUE
+  110 IF (GLO .GE. HA) GO TO 119
+  111 IF (FANC) 112,113,114
+  112 CRAT = AMAX1(1.,-FANC)
+  113 FANC = (HA-GLO)/CRAT
+      P = 10.**(IFIX(ALOG10(FANC)+5000.)-5000)
+      FANC = AINT(FANC/P)*P
+  114 IF (CHI-CLO) 116,115,116
+  115 GLO = AINT(GLO/FANC)*FANC
+      HA = AINT(HA/FANC)*FANC*(1.+SIGN(1.E-6,HA))
+  116 DO 117 K=1,NLM
+         CC = GLO+FLOAT(K-1)*FANC
+         IF (CC .GT. HA) GO TO 118
+         KK = K
+         CL(K) = CC
+  117 CONTINUE
+  118 NCL = KK
+      CCLO = CL(1)
+      CHI = CL(NCL)
+      CINC = FANC
+      RETURN
+  119 ICNST = 1
+      NCL = 1
+      CCLO = GLO
+      RETURN
+  120 CL(1) = GLO
+      NCL = 1
+      RETURN
+      END
+      SUBROUTINE DRLINE (Z,L,MM,NN)
+      SAVE
+      DIMENSION       Z(L,NN)
+C
+C THIS ROUTINE TRACES A CONTOUR LINE WHEN GIVEN THE BEGINNING BY STLINE.
+C TRANSFORMATIONS CAN BE ADDED BY DELETING THE STATEMENT FUNCTIONS FOR
+C FX AND FY IN DRLINE AND MINMAX AND ADDING EXTERNAL FUNCTIONS.
+C X=1. AT Z(1,J), X=FLOAT(M) AT Z(M,J). X TAKES ON NON-INTEGER VALUES.
+C Y=1. AT Z(I,1), Y=FLOAT(N) AT Z(I,N). Y TAKES ON NON-INTEGER VALUES.
+C
+      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(80000)  ,NR
+c + noao:  dimension of ir array in conre2 changed from 500 to 20000 6March87
+c + noao:  dimension of ir array in conre2 changed from 20000 to 80000 6-93
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+      LOGICAL         IPEN       ,IPENO
+      DATA IPEN,IPENO/.TRUE.,.TRUE./
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+      IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
+      C(P1,P2) = (P1-CV)/(P1-P2)
+C
+      M = MM
+      N = NN
+      IF (IOFFP .EQ. 0) GO TO 101
+      ASSIGN 110 TO JUMP1
+      ASSIGN 115 TO JUMP2
+      GO TO 102
+  101 ASSIGN 112 TO JUMP1
+      ASSIGN 117 TO JUMP2
+  102 IX0 = IX
+      IY0 = IY
+      IS0 = IS
+      IF (IOFFP .EQ. 0) GO TO 103
+      IX2 = IX+INX(IS)
+      IY2 = IY+INY(IS)
+      IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL
+      IPENO = IPEN
+  103 IF (IDX .EQ. 0) GO TO 104
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 105
+  104 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  105 CALL FRSTD (FX(X,Y),FY(X,Y))
+  106 IS = IS+1
+      IF (IS .GT. 8) IS = IS-8
+      IDX = INX(IS)
+      IDY = INY(IS)
+      IX2 = IX+IDX
+      IY2 = IY+IDY
+      IF (ISS .NE. 0) GO TO 107
+      IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 120
+  107 IF (CV-Z(IX2,IY2)) 108,108,109
+  108 IS = IS+4
+      IX = IX2
+      IY = IY2
+      GO TO 106
+  109 IF (IS/2*2 .EQ. IS) GO TO 106
+      GO TO JUMP1,(110,112)
+  110 ISBIG = IS+(8-IS)/6*8
+      IX3 = IX+INX(ISBIG-1)
+      IY3 = IY+INY(ISBIG-1)
+      IX4 = IX+INX(ISBIG-2)
+      IY4 = IY+INY(ISBIG-2)
+      IPENO = IPEN
+      IF (ISS .NE. 0) GO TO 111
+      IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 120
+      IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 120
+  111 IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL .AND.
+     1       Z(IX3,IY3).NE.SPVAL .AND. Z(IX4,IY4).NE.SPVAL
+  112 IF (IDX .EQ. 0) GO TO 113
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 114
+  113 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  114 GO TO JUMP2,(115,117)
+  115 IF (.NOT.IPEN) GO TO 118
+      IF (IPENO) GO TO 116
+C
+C END OF LINE SEGMENT
+C
+      CALL LASTD
+      CALL FRSTD (FX(XOLD,YOLD),FY(XOLD,YOLD))
+C
+C CONTINUE LINE SEGMENT
+C
+  116 CONTINUE
+  117 CALL VECTD (FX(X,Y),FY(X,Y))
+  118 XOLD = X
+      YOLD = Y
+      IF (IS .NE. 1) GO TO 119
+      NP = NP+1
+      IF (NP .GT. NR) GO TO 120
+      IR(NP) = IXYPAK(IX,IY)
+  119 IF (ISS .EQ. 0) GO TO 106
+      IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO 106
+C
+C END OF LINE
+C
+  120 CALL LASTD
+      RETURN
+      END
+      SUBROUTINE MINMAX (Z,L,MM,NN,ISSIZM,AASH,JOFFDT)
+C
+C THIS ROUTINE FINDS RELATIVE MINIMUMS AND MAXIMUMS.  A RELATIVE MINIMUM
+C (OR MAXIMUM) IS DEFINED TO BE THE LOWEST (OR HIGHEST) POINT WITHIN
+C A CERTAIN NEIGHBORHOOD OF THE POINT.  THE NEIGHBORHOOD USED HERE
+C IS + OR - MN IN THE X DIRECTION AND + OR - NM IN THE Y DIRECTION.
+C
+C ORIGINATOR       DAVID KENNISON
+C
+      SAVE
+      CHARACTER*6     IA
+      DIMENSION       Z(L,NN)
+C
+C
+C
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE5/ SCLY
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+C
+      M = MM
+      N = NN
+C
+C SET UP SCALING FOR LABELS
+C
+      SIZEM = (ISSIZM + 1)*256*SCLY
+      ISIZEM = ISSIZM
+C
+      ASH = ABS(AASH)
+      IOFFDT = JOFFDT
+C
+      IF (AASH .LT. 0.0) GO TO 128
+C
+      MN = MIN0(15,MAX0(2,IFIX(FLOAT(M)/8.)))
+      NM = MIN0(15,MAX0(2,IFIX(FLOAT(N)/8.)))
+      NM1 = N-1
+      MM1 = M-1
+C
+C LINE LOOP FOLLOWS - THE COMPLETE TWO-DIMENSIONAL TEST FOR A MINIMUM OR
+C MAXIMUM OF THE FIELD IS ONLY PERFORMED FOR POINTS WHICH ARE MINIMA OR
+C MAXIMA ALONG SOME LINE - FINDING THESE CANDIDATES IS MADE EFFICIENT BY
+C USING A COUNT OF CONSECUTIVE INCREASES OR DECREASES OF THE FUNCTION
+C ALONG THE LINE
+C
+      DO 127 JP=2,NM1
+C
+         IM = MN-1
+         IP = -1
+         GO TO 126
+C
+C CONTROL RETURNS TO STATEMENT 10 AS LONG AS THE FUNCTION IS INCREASING
+C ALONG THE LINE - WE SEEK A POSSIBLE MAXIMUM
+C
+  101    IP = IP+1
+         AA = AN
+         IF (IP .EQ. MM1) GO TO 104
+         AN = Z(IP+1,JP)
+         IF (IOFFP.NE.0 .AND. AN.EQ.SPVAL) GO TO 125
+         IF (AA-AN) 102,103,104
+  102    IM = IM+1
+         GO TO 101
+  103    IM = 0
+         GO TO 101
+C
+C FUNCTION DECREASED - TEST FOR MAXIMUM ON LINE
+C
+  104    IF (IM .GE. MN) GO TO 106
+         IS = MAX0(1,IP-MN)
+         IT = IP-IM-1
+         IF (IS .GT. IT) GO TO 106
+         DO 105 II=IS,IT
+            IF (AA .LE. Z(II,JP)) GO TO 112
+  105    CONTINUE
+  106    IS = IP+2
+         IT = MIN0(M,IP+MN)
+         IF (IS .GT. IT) GO TO 109
+         DO 108 II=IS,IT
+            IF (IOFFP.EQ.0 .OR. Z(II,JP).NE.SPVAL) GO TO 107
+            IP = II-1
+            GO TO 125
+  107       IF (AA .LE. Z(II,JP)) GO TO 112
+  108    CONTINUE
+C
+C WE HAVE MAXIMUM ON LINE - DO TWO-DIMENSIONAL TEST FOR MAXIMUM OF FIELD
+C
+  109    JS = MAX0(1,JP-NM)
+         JT = MIN0(N,JP+NM)
+         IS = MAX0(1,IP-MN)
+         IT = MIN0(M,IP+MN)
+         DO 111 JK=JS,JT
+            IF (JK .EQ. JP) GO TO 111
+            DO 110 IK=IS,IT
+               IF (Z(IK,JK).GE.AA .OR.
+     1             (IOFFP.NE.0 .AND. Z(IK,JK).EQ.SPVAL)) GO TO 112
+  110       CONTINUE
+  111    CONTINUE
+C
+         X = FLOAT(IP)
+         Y = FLOAT(JP)
+         CALL WTSTR ( FX(X,Y),FY(X,Y),'H',ISIZEM,0,0 )
+         CALL FL2INT ( FX(X,Y),FY(X,Y),IFX,IFY )
+C
+C SCALE TO USER SET RESOLUTION
+C
+         IFY = IFY*SCLY
+         CALL ENCD (AA,ASH,IA,NC,IOFFDT)
+         MY = IFY - SIZEM
+         TMY = CPUY ( MY )
+         CALL WTSTR ( FX(X,Y),TMY,IA(1:NC),ISIZEM,0,0 )
+  112    IM = 1
+         IF (IP-MM1) 113,127,127
+C
+C CONTROL RETURNS TO STATEMENT 20 AS LONG AS THE FUNCTION IS DECREASING
+C ALONG THE LINE - WE SEEK A POSSIBLE MINIMUM
+C
+  113    IP = IP+1
+         AA = AN
+         IF (IP .EQ. MM1) GO TO 116
+         AN = Z(IP+1,JP)
+         IF (IOFFP.NE.0 .AND. AN.EQ.SPVAL) GO TO 125
+         IF (AA-AN) 116,115,114
+  114    IM = IM+1
+         GO TO 113
+  115    IM = 0
+         GO TO 113
+C
+C FUNCTION INCREASED - TEST FOR MINIMUM ON LINE
+C
+  116    IF (IM .GE. MN) GO TO 118
+         IS = MAX0(1,IP-MN)
+         IT = IP-IM-1
+         IF (IS .GT. IT) GO TO 118
+         DO 117 II=IS,IT
+            IF (AA .GE. Z(II,JP)) GO TO 124
+  117    CONTINUE
+  118    IS = IP+2
+         IT = MIN0(M,IP+MN)
+         IF (IS .GT. IT) GO TO 121
+         DO 120 II=IS,IT
+            IF (IOFFP.EQ.0 .OR. Z(II,JP).NE.SPVAL) GO TO 119
+            IP = II-1
+            GO TO 125
+  119       IF (AA .GE. Z(II,JP)) GO TO 124
+  120    CONTINUE
+C
+C WE HAVE MINIMUM ON LINE - DO TWO-DIMENSIONAL TEST FOR MINIMUM OF FIELD
+C
+  121    JS = MAX0(1,JP-NM)
+         JT = MIN0(N,JP+NM)
+         IS = MAX0(1,IP-MN)
+         IT = MIN0(M,IP+MN)
+         DO 123 JK=JS,JT
+            IF (JK .EQ. JP) GO TO 123
+            DO 122 IK=IS,IT
+               IF (Z(IK,JK).LE.AA .OR.
+     1             (IOFFP.NE.0 .AND. Z(IK,JK).EQ.SPVAL)) GO TO 124
+  122       CONTINUE
+  123    CONTINUE
+C
+         X = FLOAT(IP)
+         Y = FLOAT(JP)
+         CALL WTSTR ( FX(X,Y),FY(X,Y),'L',ISIZEM,0,0 )
+         CALL FL2INT( FX(X,Y),FY(X,Y),IFX,IFY )
+         IFY = SCLY*IFY
+         CALL ENCD (AA,ASH,IA,NC,IOFFDT)
+         MY = IFY - SIZEM
+         TMY = CPUY ( MY )
+         CALL WTSTR ( FX(X,Y),TMY,IA(1:NC),ISIZEM,0,0 )
+  124    IM = 1
+         IF (IP-MM1) 101,127,127
+C
+C SKIP SPECIAL VALUES ON LINE
+C
+  125    IM = 0
+  126    IP = IP+1
+         IF (IP .GE. MM1) GO TO 127
+         IF (IOFFP.NE.0 .AND. Z(IP+1,JP).EQ.SPVAL) GO TO 125
+         IM = IM+1
+         IF (IM .LE. MN) GO TO 126
+         IM = 1
+         AN = Z(IP+1,JP)
+         IF (Z(IP,JP)-AN) 101,103,113
+C
+  127 CONTINUE
+C
+      RETURN
+C
+C ****************************** ENTRY PNTVAL **************************
+C     ENTRY PNTVAL (Z,L,MM,NN,ISSIZM,AASH,JOFFDT)
+C
+  128 CONTINUE
+      II = (M-1+24)/24
+      JJ = (N-1+48)/48
+      NIQ = 1
+      NJQ = 1
+      DO 130 J=NJQ,N,JJ
+         Y = J
+         DO 129 I=NIQ,M,II
+            X = I
+            ZZ = Z(I,J)
+            IF (IOFFP.NE.0 .AND. ZZ.EQ.SPVAL) GO TO 129
+            CALL ENCD (ZZ,ASH,IA,NC,IOFFDT)
+            CALL WTSTR (FX(X,Y),FY(X,Y),IA(1:NC),ISIZEM,0,0 )
+  129    CONTINUE
+  130 CONTINUE
+      RETURN
+      END
+      SUBROUTINE REORD (CL,NCL,C1,MARK,NMG)
+      SAVE
+      DIMENSION       CL(NCL)    ,C1(NCL)
+C
+C THIS ROUTINE PUTS THE MAJOR (LABELED) LEVELS IN THE BEGINNING OF CL
+C AND THE MINOR (UNLABELED) LEVELS IN END OF CL.  THE NUMBER OF MAJOR
+C LEVELS IS RETURNED IN MARK.  C1 IS USED AS A WORK SPACE.  NMG IS THE
+C NUMBER OF MINOR GAPS (ONE MORE THAN THE NUMBER OF MINOR LEVELS BETWEEN
+C MAJOR LEVELS).
+C
+      NL = NCL
+      IF (NL.LE.4 .OR. NMG.LE.1) GO TO 113
+      NML = NMG-1
+      IF (NL .LE. 10) NML = 1
+C
+C CHECK FOR ZERO OR OTHER NICE NUMBER FOR A MAJOR LINE
+C
+      NMLP1 = NML+1
+      DO 101 I=1,NL
+         ISAVE = I
+         IF (CL(I) .EQ. 0.) GO TO 104
+  101 CONTINUE
+      L = NL/2
+      L = ALOG10(ABS(CL(L)))+1.
+      Q = 10.**L
+      DO 103 J=1,3
+         Q = Q/10.
+         DO 102 I=1,NL
+            ISAVE = I
+            IF (AMOD(ABS(CL(I)+1.E-9*CL(I))/Q,FLOAT(NMLP1)) .LE. .0001)
+     1          GO TO 104
+  102    CONTINUE
+  103 CONTINUE
+      ISAVE = NL/2
+C
+C PUT MAJOR LEVELS IN C1
+C
+  104 ISTART = MOD(ISAVE,NMLP1)
+      IF (ISTART .EQ. 0) ISTART = NMLP1
+      NMAJL = 0
+      DO 105 I=ISTART,NL,NMLP1
+         NMAJL = NMAJL+1
+         C1(NMAJL) = CL(I)
+  105 CONTINUE
+      MARK = NMAJL
+      L = NMAJL
+C
+C PUT MINOR LEVELS IN C1
+C
+      IF (ISTART .EQ. 1) GO TO 107
+      DO 106 I=2,ISTART
+         ISUB = L+I-1
+         C1(ISUB) = CL(I-1)
+  106 CONTINUE
+  107 L = NMAJL+ISTART-1
+      DO 109 I=2,NMAJL
+         DO 108 J=1,NML
+            L = L+1
+            ISUB = ISTART+(I-2)*NMLP1+J
+            C1(L) = CL(ISUB)
+  108    CONTINUE
+  109 CONTINUE
+      NLML = NL-L
+      IF (L .EQ. NL) GO TO 111
+      DO 110 I=1,NLML
+         L = L+1
+         C1(L) = CL(L)
+  110 CONTINUE
+C
+C PUT REORDERED ARRAY BACK IN ORIGINAL PLACE
+C
+  111 DO 112 I=1,NL
+         CL(I) = C1(I)
+  112 CONTINUE
+      RETURN
+  113 MARK = NL
+      RETURN
+      END
+      SUBROUTINE STLINE (Z,LL,MM,NN,CONV)
+      SAVE
+      DIMENSION       Z(LL,NN)
+C
+C THIS ROUTINE FINDS THE BEGINNINGS OF ALL CONTOUR LINES AT LEVEL CONV.
+C FIRST THE EDGES ARE SEARCHED FOR LINES INTERSECTING THE EDGE (OPEN
+C LINES) THEN THE INTERIOR IS SEARCHED FOR LINES WHICH DO NOT INTERSECT
+C THE EDGE (CLOSED LINES).  BEGINNINGS ARE STORED IN IR TO PREVENT RE-
+C TRACING OF LINES.  IF IR IS FILLED, THE SEARCH IS STOPPED FOR THIS
+C CONV.
+C
+      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(80000)  ,NR
+c + noao:  dimension of ir array in conre2 changed from 500 to 20000 6March87
+c + noao:  dimension of ir array in conre2 changed from 20000 to 80000 6-93
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+C
+C
+C
+C
+C
+C
+      IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
+C
+      L = LL
+      M = MM
+      N = NN
+      CV = CONV
+      NP = 0
+      ISS = 0
+      DO 102 IP1=2,M
+         I = IP1-1
+         IF (Z(I,1).GE.CV .OR. Z(IP1,1).LT.CV) GO TO 101
+         IX = IP1
+         IY = 1
+         IDX = -1
+         IDY = 0
+         IS = 1
+         CALL DRLINE (Z,L,M,N)
+  101    IF (Z(IP1,N).GE.CV .OR. Z(I,N).LT.CV) GO TO 102
+         IX = I
+         IY = N
+         IDX = 1
+         IDY = 0
+         IS = 5
+         CALL DRLINE (Z,L,M,N)
+  102 CONTINUE
+      DO 104 JP1=2,N
+         J = JP1-1
+         IF (Z(M,J).GE.CV .OR. Z(M,JP1).LT.CV) GO TO 103
+         IX = M
+         IY = JP1
+         IDX = 0
+         IDY = -1
+         IS = 7
+         CALL DRLINE (Z,L,M,N)
+  103    IF (Z(1,JP1).GE.CV .OR. Z(1,J).LT.CV) GO TO 104
+         IX = 1
+         IY = J
+         IDX = 0
+         IDY = 1
+         IS = 3
+         CALL DRLINE (Z,L,M,N)
+  104 CONTINUE
+      ISS = 1
+      DO 108 JP1=3,N
+         J = JP1-1
+         DO 107 IP1=2,M
+            I = IP1-1
+            IF (Z(I,J).GE.CV .OR. Z(IP1,J).LT.CV) GO TO 107
+            IXY = IXYPAK(IP1,J)
+            IF (NP .EQ. 0) GO TO 106
+            DO 105 K=1,NP
+               IF (IR(K) .EQ. IXY) GO TO 107
+  105       CONTINUE
+  106       NP = NP+1
+            IF (NP .GT. NR) THEN
+C
+C THIS PRINTS AN ERROR MESSAGE IF THE LOCAL ARRAY IR IN SUBROUTINE
+C STLINE HAS AN OVERFLOW
+C THIS MESSAGE IS WRITTEN BOTH ON THE FRAME AND ON THE STANDARD ERROR
+C UNIT
+C
+C +NOAO - Message is written only to stderr, not to the plotting frame.
+C         Error is written with uliber, not FTN write statement.
+C
+      call uliber (1, 'STLINE (CONREC) - WORK ARRAY OVERFLOW', 80)
+      call uliber (1,'STLINE - ***WARNING -- PICTURE INCOMPLETE***',80)
+C     IUNIT = I1MACH(4)
+C     WRITE(IUNIT,1000)
+C1000 FORMAT(
+C    1' WARNING FROM ROUTINE STLINE IN CONREC--WORK ARRAY OVERFLOW')
+C     CALL GETSET(VXA,VXB,VYA,VYB,XA,XB,YA,YB,LTYPE)
+C     Y = (YB - YA) / 2.
+C     X = (XB - XA) / 2.
+C     CALL PWRIT(X,Y,
+C    1'**WARNING--PICTURE INCOMPLETE**',
+C    2 31,3,0,0)
+C     Y = Y * .7
+C     CALL PWRIT(X,Y,
+C    1'WORK ARRAY OVERFLOW IN STLINE',
+C    2 29,3,0,0)
+C -NOAO
+        RETURN
+        ENDIF
+            IR(NP) = IXY
+            IX = IP1
+            IY = J
+            IDX = -1
+            IDY = 0
+            IS = 1
+            CALL DRLINE (Z,L,M,N)
+  107    CONTINUE
+  108 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CALCNT (Z,M,N,A1,A2,A3,I1,I2,I3)
+C
+C THIS ENTRY POINT IS FOR USERS WHO ARE TOO LAZY TO SWITCH OLD DECKS
+C TO THE NEW CALLING SEQUENCE.
+C
+      DIMENSION       Z(M,N)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','CALCNT','VERSION 01')
+C
+      CALL CONREC (Z,M,M,N,A1,A2,A3,I1,I2,-IABS(I3))
+      RETURN
+      END
+      SUBROUTINE EZCNTR (Z,M,N)
+C
+C CONTOURING VIA SHORTEST POSSIBLE ARGUMENT LIST
+C ASSUMPTIONS --
+C     ALL OF THE ARRAY IS TO BE CONTOURED,
+C     CONTOUR LEVELS ARE PICKED INTERNALLY,
+C     CONTOURING ROUTINE PICKS SCALE FACTORS,
+C     HIGHS AND LOWS ARE MARKED,
+C     NEGATIVE LINES ARE DRAWN WITH A DASHED LINE PATTERN,
+C     EZCNTR CALLS FRAME AFTER DRAWING THE CONTOUR MAP.
+C IF THESE ASSUMPTIONS ARE NOT MET, USE CONREC.
+C
+C ARGUMENTS
+C     Z   ARRAY TO BE CONTOURED
+C     M   FIRST DIMENSION OF Z
+C     N   SECOND DIMENSION OF Z
+C
+      SAVE
+      DIMENSION       Z(M,N)
+      DATA NSET,NHI,NDASH/0,0,682/
+C
+C                             682=1252B
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','EZCNTR','VERSION 01')
+C
+      CALL CONREC (Z,M,M,N,0.,0.,0.,NSET,NHI,-NDASH)
+C +NOAO - EZCNTR no longer calls frame.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+C
+C REVISION HISTORY---
+C
+C JANUARY 1980     ADDED REVISION HISTORY AND CHANGED LIBRARY NAME
+C                  FROM CRAYLIB TO PORTLIB FOR MOVE TO PORTLIB
+C
+C MAY 1980         ARRAYS IWORK AND ENCSCR, PREVIOUSLY TOO SHORT FOR
+C                  SHORT-WORD-LENGTH MACHINES, LENGTHENED.  SOME
+C                  DOCUMENTATION CLARIFIED AND CORRECTED.
+C
+C JUNE 1984        CONVERTED TO FORTRAN 77 AND TO GKS
+C
+C JUNE 1985        ERROR HANDLING LINES ADDED; IF OVERFLOW HAPPENS TO
+C                  WORK ARRAY IN STLINE, A WARNING MESSAGE IS WRITTEN
+C                  BOTH ON PLOT FRAME AND ON STANDARD ERROR MESSAGE.
+C-------------------------------------------------------------------
+C
diff --git a/sys/gio/ncarutil/dashbd.f b/sys/gio/ncarutil/dashbd.f
new file mode 100644
index 00000000..cf499bc2
--- /dev/null
+++ b/sys/gio/ncarutil/dashbd.f
@@ -0,0 +1,143 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data changed to run time initialization. Logical param
+c "first" added, so initialization doesn't occur more than once.
+c     BLOCKDATA DASHBD
+        subroutine dashbd
+C
+C DASHBD IS USED TO INITIALIZE VARIABLES IN NAMED COMMON.
+C
+        logical first
+c
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+C
+      COMMON /FDFLAG/ IFLAG
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+      COMMON /CFFLAG/ IVCTFG
+C
+      COMMON /DSAVE3/ IXSTOR,IYSTOR
+C
+      COMMON /DSAVE5/ XSAVE(70), YSAVE(70), XSVN, YSVN, XSV1, YSV1,
+     1                SLP1, SLPN, SSLP1, SSLPN, N, NSEG
+C
+      COMMON /SMFLAG/ IOFFS
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+        SAVE
+        data first /.true./
+        if (.not. first) return
+        first = .false.
+            
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C
+c     DATA IFSTFL /1/
+      IFSTFL  = 1
+C
+C IVCTFG INDICATES IF VECTD IS BEING CALLED OR LASTD (IN CFVLD)
+C
+c     DATA IVCTFG /1/
+      IVCTFG = 1
+C
+C ISL IS A FLAG FOR AN ALL SOLID PATTERN (+1) OR AN ALL GAP PATTERN (-1)
+C
+c     DATA ISL /1/
+      ISL = 1
+C
+C IGP IS AN INTERNAL PARAMETER. IT IS DESCRIBED IN THE DOCUMENTATION
+C TO THE DASHED LINE PACKAGE.
+C
+c     DATA IGP /9/
+      IGP = 9
+C
+C MNCSTR IS THE MAXIMUM NUMBER OF CHARACTERS ALLOWED IN A HOLLERITH
+C STRING PASSED TO DASHDC.
+C
+c     DATA MNCSTR /15/
+      MNCSTR = 15
+C
+C IOFFS IS AN INTERNAL PARAMETER.
+C IOFFS IS USED IN FDVDLD AND DRAWPV.
+C
+c     DATA IOFFS /0/
+      IOFFS = 0
+C
+C  INTERNAL PARAMETERS
+C
+c     DATA IPAU/3/
+      IPAU = 3
+c     DATA FPART/1./
+      FPART = 1.
+c     DATA TENSN/2.5/
+      TENSN = 2.5
+c     DATA NP/150/
+      NP = 150
+c     DATA SMALL/128./
+      SMALL = 128.
+c     DATA L1/70/
+      L1 = 70
+c     DATA ADDLR/2./
+      ADDLR = 2.
+c     DATA ADDTB/2./
+      ADDTB = 2.
+c     DATA MLLINE/384/
+      MLLINE = 384
+c     DATA ICLOSE/6/
+      ICLOSE = 6
+C
+C IFSTF2 IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS
+C CALLED (IN SUBROUTINE FDVDLD), WHENEVER DASHDB OR DASHDC
+C HAS BEEN CALLED.
+C
+c     DATA IFSTF2 /1/
+      IFSTF2  = 1
+C
+C IFLAG CONTROLS IF LASTD CAN BE CALLED DIRECTLY OR IF IT WAS JUST
+C CALLED FROM BY VECTD SO THAT THIS CALL CAN BE IGNORED.
+C
+c     DATA IFLAG /1/
+      IFLAG = 1
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR SUBROUTINES DASHDB AND DASHDC.
+C  1 = FIRST CALL TO DASHDB OR DASHDC.
+C  2 = DASHDB OR DASHDC HAS BEEN CALLED BEFORE.
+C
+c     DATA IFCFLG /1/
+      IFCFLG = 1
+C
+C IXSTOR AND IYSTOR CONTAIN THE CURRENT PEN POSITION. THEY ARE
+C INITIALIZED TO AN IMPOSSIBLE VALUE.
+C
+c     DATA IXSTOR,IYSTOR /-9999,-9999/
+      IXSTOR = -9999 
+      IYSTOR = -9999
+C
+C SLP1 AND SLPN ARE INITIALIZED TO AVOID THAT THEY ARE PASSED AS ACTUAL
+C PARAMETERS FROM FDVDLD TO KURV1S WITHOUT BEING DEFINED.
+C
+c     DATA SLP1,SLPN /-9999.,-9999./
+      SLP1 = -9999. 
+      SLPN = -9999.
+c -noao
+C
+      END
diff --git a/sys/gio/ncarutil/dashsmth.f b/sys/gio/ncarutil/dashsmth.f
new file mode 100644
index 00000000..2fe25185
--- /dev/null
+++ b/sys/gio/ncarutil/dashsmth.f
@@ -0,0 +1,1224 @@
+      SUBROUTINE FDVDLD (IENTRY,IIX,IIY)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C SOFTWARE DASHED LINE PACKAGE WITH CHARACTER CAPABILITY AND SMOOTHING
+C
+C LATEST REVISION        JUNE 1984
+C
+C PURPOSE                DASHSMTH IS A SOFTWARE DASHED LINE PACKAGE WITH
+C                        SMOOTHING CAPABILITIES.  DASHSMTH IS DASHCHAR
+C                        WITH SMOOTHING FEATURES ADDED.
+C
+C USAGE                  FIRST, EITHER
+C                             CALL DASHDB (IPAT)
+C                        WHERE IPAT IS A 16-BIT DASH PATTERN AS
+C                        DESCRIBED IN THE SUBROUTINE DASHDB (SEE
+C                        DASHLINE DOCUMENTATION), OR
+C                             CALL DASHDC (IPAT,JCRT,JSIZE)
+C                        AS DESCRIBED BELOW.
+C
+C                        THEN, CALL ANY OF THE FOLLOWING:
+C                             CALL CURVED (X,Y,N)
+C                             CALL FRSTD (X,Y)
+C                             CALL VECTD (X,Y)
+C                             CALL LASTD
+C
+C                        LASTD IS CALLED ONLY AFTER THE LAST
+C                        POINT OF A LINE HAS BEEN PROCESSED IN VECTD.
+C
+C                        THE FOLLOWING MAY ALSO BE CALLED, BUT NO
+C                        SMOOTHING WILL RESULT:
+C                             CALL LINED (XA,YA,XB,YB)
+C
+C
+C ARGUMENTS              IPAT
+C ON INPUT                 A CHARACTER STRING OF ARBITRARY LENGTH
+C TO DASHDC                (60 CHARACTERS SEEMS TO BE A PRACTICAL
+C                          LIMIT) WHICH SPECIFIES THE DASH PATTERN
+C                          TO BE USED.  A DOLLAR SIGN IN IPAT
+C                          INDICATES SOLID; AN APOSTROPHE INDICATES
+C                          A GAP; BLANKS ARE IGNORED.  ANY CHARACTER
+C                          IN IPAT WHICH IS NOT A DOLLAR SIGN,
+C                          APOSTROPHE, OR BLANK IS CONSIDERED TO BE
+C                          PART OF A LINE LABEL.  EACH LINE LABEL
+C                          CAN BE AT MOST 15 CHARACTERS IN LENGTH.
+C                          SUFFICIENT WHITE SPACE IS RESERVED IN THE
+C                          DASHED LINE FOR WRITING LINE LABELS.
+C
+C                        JCRT
+C                          THE LENGTH IN PLOTTER ADDRESS UNITS PER
+C                          $ OR APOSTROPHE.
+C
+C                        JSIZE
+C                          IS THE SIZE OF THE PLOTTED CHARACTERS:
+C                          . IF BETWEEN 0 AND 3 , IT IS 1., 1.5, 2.
+C                            AND 3. TIMES AN 8 PLOTTER ADDRESS UNIT
+C                            WIDTH.
+C                          . IF GREATER THAN 3, IT IS THE CHARACTER
+C                            WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C
+C ARGUMENTS TO           CURVED(X,Y,N)
+C OTHER LINE-DRAWING       X AND Y ARE ARRAYS OF WORLD COORDINATE VALUES
+C ROUTINES                 OF LENGTH N OR GREATER.  LINE SEGMENTS OBEYING
+C                          THE SPECIFIED DASH PATTERN ARE DRAWN TO
+C                          CONNECT THE N POINTS.
+C
+C                        FRSTD(X,Y)
+C                          THE CURRENT PEN POSITION IS SET TO
+C                          THE WORLD COORDINATE VALUE (X,Y)
+C
+C                        VECTD(X,Y)
+C                          A LINE SEGMENT IS DRAWN BETWEEN THE
+C                          WORLD COORDINATE VALUE (X,Y) AND THE
+C                          MOST RECENT PEN POSITION.  (X,Y) THEN
+C                          BECOMES THE MOST RECENT PEN POSITION.
+C
+C                        LINED(XA,XB,YA,YB)
+C                          A LINE IS DRAWN BETWEEN WORLD COORDINATE
+C                          VALUES (XA,YA) AND (XB,YB).
+C
+C ON OUTPUT                ALL ARGUMENTS ARE UNCHANGED FOR ALL ROUTINES.
+C
+C NOTE                     WHEN USING FRSTD AND VECTD, LASTD MUST BE
+C                          CALLED (NO ARGUMENTS NEEDED).  LASTD SETS UP
+C                          THE CALLS TO THE SMOOTHING ROUTINES KURV1S AND
+C                          KURV2S.
+C
+C                          WHEN SWITCHING FROM THE REGULAR PLOTTING
+C                          ROUTINES TO A DASHED LINE PACKAGE THE FIRST
+C                          CALL SHOULD NOT BE TO VECTD.
+C
+C ENTRY POINTS             DASHDB, DASHDC, CURVED, FRSTD, VECTD, LINED,
+C                          RESET, LASTD, KURV1S, KURV2S, CFVLD, FDVDLD,
+C                          DRAWPV, DASHBD
+C
+C COMMON BLOCKS            INTPR, DASHD1, DASHD2, DDFLAG, DCFLAG, DSAVE1,
+C                          DSAVE2, DSAVE3, DSAVE5, CFFLAG, SMFLAG, DFFLAG,
+C                          FDFLAG
+C
+C REQUIRED LIBRARY         THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O                      PLOTS SOLID OR DASHED LINES, POSSIBLY WITH
+C                          CHARACTERS AT INTERVALS IN THE LINE.
+C                          THE LINES MAY ALSO BE SMOOTHED.
+C
+C PRECISION                SINGLE
+C
+C LANGUAGE                 FORTRAN
+C
+C HISTORY                  WRITTEN IN OCTOBER 1973.
+C                          MADE PORTABLE IN SEPTEMBER 1977 FOR USE
+C                          WITH ALL MACHINES WHICH
+C                          SUPPORT PLOTTERS WITH UP TO 15 BIT RESOLUTION.
+C                          CONVERTED TO FORTRAN77 AND GKS IN JUNE, 1984.
+C
+C ALGORITHM                POINTS FOR EACH LINE
+C                          SEGMENT ARE PROCESSED AND PASSED TO THE
+C                          ROUTINES, KURV1S AND KURV2S, WHICH COMPUTE
+C                          SPLINES UNDER TENSION PASSING THROUGH THESE
+C                          POINTS.  NEW POINTS ARE GENERATED BETWEEN THE
+C                          GIVEN POINTS, RESULTING IN SMOOTH LINES.
+C
+C ACCURACY                 PLUS OR MINUS .5 PLOTTER ADDRESS UNITS PER CALL.
+C                          THERE IS NO CUMULATIVE ERROR.
+C
+C TIMING                   ABOUT THREE TIMES AS LONG AS DASHCHAR.
+C
+C
+C
+C
+C
+C
+C
+C
+C***********************************************************************
+C
+C FDVDLD RECEIVES IN ITS ARGUMENTS THE POINTS TO BE PROCESSED FOR A
+C LINE SEGMENT. IT PASSES THESE POINTS TO THE ROUTINES KURV1S AND KURV2S
+C WHICH COMPUTE SPLINES UNDER TENSION PASSING THROUGH THESE POINTS.
+C FDVDLD THEN CALLS CFVLD TO CONNECT THE POINTS GENERATED IN KURV2S.
+C
+      DIMENSION       XP(70),  YP(70),  TEMP(70)
+C
+C THE VARIABLES IN DSAVE5 HAVE TO BE SAVED FOR THE NEXT CALL TO FDVDLD.
+C
+      COMMON /DSAVE5/ XSAVE(70), YSAVE(70), XSVN, YSVN, XSV1, YSV1,
+     1                SLP1, SLPN, SSLP1, SSLPN, N, NSEG
+C
+C IOFFS IS AN INTERNAL PARAMETER. IT IS INITIALIZED IN DASHBD AND
+C REFERENCED IN FDVDLD AND DRAWPV.
+C
+      COMMON /SMFLAG/ IOFFS
+C
+C IFSTF2 IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS
+C CALLED.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C IFLAG CONTROLS IF LASTD CAN BE CALLED DIRECTLY OR IF IT WAS JUST
+C CALLED FROM BY VECTD SO THAT THIS CALL CAN BE IGNORED.
+C
+      COMMON /FDFLAG/ IFLAG
+C
+C NOTE THAT THIS IFSTF2 FLAG CANNOT BE IDENTICAL TO THE IFSTFL FLAG
+C IN THE ROUTINE CFVLD, BECAUSE A CALL TO THE FRSTD ENTRY OF FDVDLD DOES
+C NOT ELIMINATE THE NECESSITY OF A CALL TO THE FRSTD ENTRY OF CFVLD,
+C AND REVERSE.
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+      SAVE
+C
+C
+C OTHER CONSTANTS.
+C
+      DATA PI /3.14159265358/
+      DATA IDUMMY /0/
+C
+C
+      GO TO (10,15,35),IENTRY
+C
+C *************************************
+C
+C ENTRY  FRSTD (XX,YY)
+C
+   10 DEG = 180./PI
+C
+      MX = IIX
+      MY = IIY
+      IFSTF2 = 0
+      SSLP1 = 0.0
+      SSLPN = 0.0
+      XSVN = 0.0
+      YSVN = 0.0
+      IF (IOFFS .GE. 1) CALL CFVLD (1,MX,MY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C INITIALIZE THE POINT AND SEGMENT COUNTER
+C N COUNTS THE NUMBER OF POINTS/SEGMENT
+C
+      N = 0
+C
+C NSEG = 0       FIRST SEGMENT
+C NSEG = 1       MORE THAN ONE SEGMENT
+C
+      NSEG = 0
+C
+C SAVE THE X,Y COORDINATES OF THE FIRST POINT
+C XSV1           CONTAINS THE X COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C YSV1           CONTAINS THE Y COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C
+      XSV1 = MX
+      YSV1 = MY
+      GO TO 30
+C
+C *************************************
+C
+C     ENTRY VECTD (XX,YY)
+C
+   15 CONTINUE
+C
+C TEST FOR PREVIOUS FRSTD CALL
+C
+      IF (IFSTF2 .EQ. 0) GO TO 20
+C
+C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL.
+C
+      CALL SETER(' FDVDLD- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.',
+     -            1,1)
+      GO TO 10
+   20 MX = IIX
+      MY = IIY
+C
+C VECTD          SAVES THE X,Y COORDINATES OF THE ACCEPTED
+C                POINTS ON A LINE SEGMENT
+C
+      IF (IOFFS .GE. 1) CALL CFVLD (2,MX,MY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C IF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT
+C
+      IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT.
+     1    SMALL) RETURN
+      IFLAG = 0
+   30 N = N+1
+C
+C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT
+C XSAVE          THE ARRAY OF X COORDINATES OF LINE SEGMENT
+C YSAVE          THE ARRAY OF Y COORDINATES OF LINE SEGMENT
+C
+      XSAVE(N) = MX
+      YSAVE(N) = MY
+      XSVN = XSAVE(N)
+      YSVN = YSAVE(N)
+      IF (N .GE. L1-1) GO TO 40
+      RETURN
+C
+C *************************************
+C
+C     ENTRY LASTD
+C
+   35 CONTINUE
+      IF (IFSTF2 .NE. 0) RETURN
+      IFSTF2 = 1
+C
+C LASTD          CHECKS FOR PERIODIC LINES AND SETS UP
+C                  THE CALLS TO KURV1S AND KURV2S
+C
+      IF (IOFFS .GE. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C IFLAG = 0      OK TO CALL LASTD DIRECTLY
+C IFLAG = 1      LASTD WAS JUST CALLED FROM BY VECTD
+C                IGNORE CALL TO LASTD
+C
+      IF (IFLAG .EQ. 1) RETURN
+C
+C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE
+C
+   40 IFLAG = 1
+C
+C IPRD = 0       PERIODIC LINE
+C IPRD = 1       NON-PERIODIC LINE
+C
+      IPRD = 1
+      IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0
+C
+C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE
+C
+      IF (NSEG .GE. 1) GO TO 60
+      IF (N-2) 150,140,50
+   50 IF (N .GE. 4) GO TO 60
+C
+      IF (IPRD .NE. 0) GO TO 60
+      DX = XSAVE(2)-XSAVE(1)
+      DY = YSAVE(2)-YSAVE(1)
+      SLOPE = ATAN2(DY,DX)*DEG+90.
+      IF (SLOPE .GE. 360.) SLOPE = SLOPE-360.
+      IF (SLOPE .LE. 0.) SLOPE = SLOPE+360.
+      SLP1 = SLOPE
+      SLPN = SLOPE
+      ISLPSW = 0
+      SIGMA = TENSN
+      GO TO 100
+   60 SIGMA = TENSN
+      IF (IPRD .GE. 1) GO TO 80
+      IF (NSEG .GE. 1) GO TO 70
+C
+C SET UP FLAGS FOR A  1  SEGMENT, PERIODIC LINE
+C
+      ISLPSW = 4
+      XSAVE(N) = XSV1
+      YSAVE(N) = YSV1
+      GO TO 100
+C
+C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE
+C
+   70 SLP1 = SSLPN
+      SLPN = SSLP1
+      ISLPSW = 0
+      GO TO 100
+   80 IF (NSEG .GE. 1) GO TO 90
+C
+C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE
+C
+      ISLPSW = 3
+      GO TO 100
+C
+C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE
+C
+   90 SLP1 = SSLPN
+      ISLPSW = 1
+C
+C CALL THE SMOOTHING ROUTINES
+C
+  100 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+C
+C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT
+C
+      IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 110
+      NPRIME = FLOAT(NP)-(S*FLOAT(NP)*.5)/32767.
+      IF (S .GE. 32767.) NPRIME = .5*FLOAT(NP)
+      NPL = AMAX1(FLOAT(NPRIME)*S/32767.,2.5)
+  110 DT = 1./FLOAT(NPL)
+      IX = IFIX (XSAVE(1))
+      IY = IFIX (YSAVE(1))
+      IF (NSEG .LE. 0) GO TO 112
+      CALL DRAWPV (IX,IY,0)
+      GO TO 114
+  112 CONTINUE
+      CALL CFVLD (1,IX,IY)
+  114 CONTINUE
+      T = 0.0
+      NSLPSW = 1
+      IF (NSEG .GE. 1) NSLPSW = 0
+      NSEG = 1
+      CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE SLOPE AT THE FIRST POINT OF THE LINE
+C
+      IF (NSLPSW .GE. 1) SSLP1 = SLP
+      NSLPSW = 0
+      DO 120 I=1,NPL
+         T = T+DT
+         TT = -T
+         IF (I .EQ. NPL) NSLPSW = 1
+         CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE THE LAST SLOPE OF THIS LINE SEGMENT
+C
+         IF (NSLPSW .GE. 1) SSLPN = SLP
+C
+C DRAW EACH PART OF THE LINE SEGMENT
+C
+         IX = IFIX(XS)
+         IY = IFIX (YS)
+         CALL CFVLD (2,IX,IY)
+  120 CONTINUE
+      IF (IPRD .NE. 0) GO TO 130
+C
+C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE
+C
+      IX = IFIX (XSV1)
+      IY = IFIX (YSV1)
+      CALL CFVLD (2,IX,IY)
+C
+C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT
+C
+  130 XSAVE(1) = XS
+      YSAVE(1) = YS
+      N = 1
+      IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+      GO TO 150
+C
+C FOR THE CASE WHEN THERE ARE ONLY 2 DISTINCT POINTS ON A LINE.
+C
+  140 IX = IFIX (XSAVE(1))
+      IY = IFIX (YSAVE(1))
+      CALL CFVLD (1,IX,IY)
+      IX = IFIX (XSAVE(N))
+      IY = IFIX (YSAVE(N))
+      CALL CFVLD (2,IX,IY)
+      IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+C
+  150 CONTINUE
+      RETURN
+      END
+      SUBROUTINE RESET
+C
+C  THIS USER ENTRY POINT IS HERE ONLY FOR COMPATIBILITY WITH USE IN
+C  THE CONREC FAMILY WHICH CALL RESET WHEN USED WITH DASHSUPR.
+C
+      RETURN
+      END
+      SUBROUTINE DASHDC (IPAT,JCRT,JSIZE)
+C
+C
+C
+C
+C
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C USER ENTRY POINT.
+C DASHDC GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS
+C SPECIFIED IN ITS ARGUMENTS. THIS INTERNAL REPRESENTATION IS PASSED
+C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1.
+C
+      CHARACTER*(*) IPAT
+      CHARACTER*1   IBLK, IGAP, ISOL, ICR
+      CHARACTER*16  IPC(100)
+C
+C DASHD1 AND DASHD2 ARE USED
+C FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB, DASHDC AND CFVLD.
+C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+      COMMON /DASHD2/  IPC
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB AND DASHDC.
+C IT IS INITIALIZED IN DASHBD.
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IT IS INITIALIZED IN DASHBD AND REFERENCED IN CFVLD.
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE
+C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IT IS INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C LOCAL VARIABLES TO DASHDB AND DASHDC ARE SAVED IN DSAVE2
+C FOR THE NEXT CALL
+C
+      COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1
+C SAVE ALL VARIABLES
+      SAVE
+C
+C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED
+C
+C NPD IS THE NUMBER OF WORDS IN IP
+C
+      DATA NPD/100/
+C
+C INITIALIZE CHARACTER FLAGS
+C
+      DATA IBLK,IGAP,ISOL/' ','''','$'/
+C
+C +NOAO - blockdata replaced with run time initialization.
+C     EXTERNAL DASHBD
+      call dashbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR
+      CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDC', 'VERSION  1')
+C
+C     NC IS THE NUMBER OF CHARACTERS IN IPAT
+C
+      NC = LEN(IPAT)
+      IF (IFCFLG .EQ. 2) GOTO 10
+C
+C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY
+C
+      IF (MNCSTR .EQ. 15) GOTO 6
+      CALL SETER('DASHDC -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR
+     1ECTLY',1,2)
+    6 CONTINUE
+C
+C INITIALIZATION
+C
+      MNCST1 = MNCSTR + 1
+C
+C MASK IS AN ALL SOLID PATTERN TO BE PASSED TO OPTN (65535=177777B).
+C
+      MASK=IOR(ISHIFT(32767,1),1)
+C
+C
+      IFCFLG = 2
+C
+C NCHRTS - NUMBER OF CHARS IN THIS HOLLERITH STRING.
+C L      - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY.
+C ISL    - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1).
+C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS
+C          CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD
+C          IS CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C
+   10 CONTINUE
+      NCHRTS = 0
+      L = 0
+      ISL = 0
+      IFSTFL = 1
+      IFSTF2 = 1
+C
+C RETRIEVE THE RESOLUTION AS SET BY THE USER.
+C
+      CALL GETUSV('XF',LXSAVE)
+      CALL GETUSV('YF',LYSAVE)
+C
+C IADJUS - TO ADJUST NUMBERS TO THE GIVEN RESOLUTION.
+C
+      IADJUS = ISHIFT(1,15-LXSAVE)
+      ICRT = JCRT*IADJUS
+      ISIZE = JSIZE
+      CHARW = FLOAT(ISIZE*IADJUS)
+      IF (ISIZE .GT. 3) GO TO 30
+      CHARW = 256. + FLOAT(ISIZE)*128.
+      IF (ISIZE .EQ. 3) CHARW = 768.
+C
+   30 CONTINUE
+      IF (ICRT .LT. 1) GO TO 230
+      MODE = 2
+C
+C START MAIN LOOP
+C
+C THIS LOOP GENERATES THE IP ARRAY (NEEDED BY CURVED,VECTD,ETC.) FROM
+C THE CHARACTER STRING IN IPAT.  EACH ITERATION OF THE LOOP PROCESSES
+C ONE CHAR OF IPAT.  A SOLID OR GAP IS CONSIDERED TO BE A TYPE 1 ENTRY,
+C AND A LABEL CHARACTER IS CONSIDERED TO BE A TYPE 2 ENTRY.
+C
+C IN THE CODE, L IS THE NUMBER OF CHANGES IN THE LINESTYLE (FROM GAP
+C TO SOLID, SOLID TO CHARACTER, ETC.)  THE IP AND IPFLAG ARRAYS DESCRIBE
+C THE LINE TO BE DRAWN, AND THESE ARRAYS ARE INDEXED FROM 1 TO L.  THE
+C RELATIONSHIP BETWEEN IP AND IPFLAG IS:
+C
+C      IPFLAG(N)    IP(N)
+C      ---------    -----
+C          1        LENGTH (IN PLOTTER ADDRESS UNITS) OF SOLID LINE TO
+C                   BE DRAWN.
+C          0        NUMBER OF CHARACTERS TO BE PLOTTED.
+C         -1        LENGTH (IN PLOTTER ADDRESS UNITS) OF GAP.
+C
+C THE 160 LOOP HANDLES 5 CASES:
+C
+C    1.)  CONTINUE TYPE 2 ENTRY (60-80)
+C    2.)  START TYPE 2 ENTRY (80-90)
+C    3.)  END TYPE 2 ENTRY AND START TYPE 1 ENTRY (90-160)
+C    4.)  START TYPE 1 ENTRY, OR SWITCH TYPE 1 ENTRY FROM SOLID TO
+C         GAP OR FROM GAP TO SOLID (140-160)
+C    5.)  CONTINUE TYPE 1 ENTRY (150-160)
+C
+      DO 160 J=1,NC
+C
+C GET NEXT CHAR INTO ICR, RIGHT JUSTIFIED ZERO FILLED.
+C
+            ICR = IPAT(J:J)
+C
+C MODE SPECIFIES WHAT THE LAST CHARACTER PROCESSED WAS:
+C
+C    LAST ICR WAS $ (SOLID),      MODE IS 8
+C    LAST ICR WAS ' (GAP),        MODE IS 2
+C    LAST ICR WAS HOLLERITH CHAR, MODE IS 5
+C
+C NMODE SPECIFIES WHAT THE CURRENT CHARACTER TO BE PROCESSED IS:
+C
+C      ICR     NMODE
+C      ---     -----
+C       $        1
+C       CHAR     0
+C       '       -1
+C
+            NMODE = 0
+            IF (ICR .EQ. IBLK) GO TO 160
+            IF (ICR .EQ. IGAP) NMODE = -1
+            IF (ICR .EQ. ISOL) NMODE = 1
+            IF (L.EQ.0 .AND. NMODE.EQ.-1) MODE = 8
+C
+C NGO DETERMINES WHERE TO BRANCH BASED ON CASE TO BE PROCESSED.
+C COMPUTE MODE FOR NEXT ITERATION.
+C
+            NGO = NMODE+MODE
+            MODE = NMODE*3+5
+            GO TO (150,80,140,90,60,90,140,80,150),NGO
+C
+C CHAR TO CHAR
+C
+C CASE 1) - CONTINUE TYPE 2 ENTRY.
+C
+   60      IF (NCHRTS .EQ. MNCSTR) GO TO 160
+           NCHRTS = NCHRTS + 1
+           IP(L) = NCHRTS
+           IPC(L)(NCHRTS:NCHRTS) = ICR
+           GO TO 160
+C
+C BLANK OR SOLID TO CHAR
+C
+C CASE 2) - START STRING ENTRY.  LGBSTR POINTS TO THE GAP WHICH
+C           WILL CONTAIN THE STRING.
+C
+   80      LGBSTR = MIN0(L+1,NPD)
+           L = MIN0(LGBSTR+1,NPD)
+           IPFLAG(L) = 0
+           NCHRTS    = 1
+           IP(L)     = 1
+           IPC(L)(NCHRTS:NCHRTS) = ICR
+           GO TO 160
+C
+C CHAR TO SOLID OR GAP
+C
+C CASE 3) - END STRING ENTRY.  ICR IS A $ OR '.
+C
+   90      CONTINUE
+           IP(LGBSTR) = CHARW*(FLOAT(NCHRTS) + .5)
+           IPFLAG(LGBSTR) = -1
+           IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
+C
+C BLANK TO SOLID OR SOLID TO BLANK
+C
+C CASE 4) - START TYPE 1 ENTRY.
+C
+  140       L = MIN0(L+1,NPD)
+            IP(L) = 0
+C
+C ADD TO A BLANK OR SOLID LINE
+C
+C CASE 5) - CONTINUE TYPE 1 ENTRY.  ICR IS A $ OR '.
+C ADD ICRT UNITS TO THE PLOTTER ADDRESS UNITS IN IP(L).
+C NMODE INDICATES IF IT IS A GAP OR A SOLID.
+C
+  150       IP(L) = IP(L) + ICRT
+            IPFLAG(L) = NMODE
+  160    CONTINUE
+C
+C IF LAST ICR PROCESSED WAS A LABEL CHARACTER, MUST END STRING
+C ENTRY.
+C
+      IF (NGO.NE.2 .AND. NGO.NE.5 .AND. NGO.NE.8) GO TO 220
+      IP(LGBSTR) = CHARW*(FLOAT(NCHRTS)+.5)
+      IPFLAG(LGBSTR) = -1
+      IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
+C
+C IF IP ARRAY HAS ONLY ONE TYPE 1 ENTRY, SET ISL FLAG.
+C
+  220 IF (L .GT. 1) RETURN
+      IBIG = ISHIFT(1,MAX0(LXSAVE,LYSAVE))
+      IF (IP(L) .GE. IBIG) GO TO 230
+      IF (IPFLAG(L)) 240,240,230
+  230 ISL = 1
+      RETURN
+  240 ISL = -1
+      RETURN
+      END
+      SUBROUTINE DASHDB (IPAT)
+C
+C ARGUMENTS              IPAT
+C ON INPUT                 IPAT IS A 16-BIT DASH PATTERN.  BY DEFAULT
+C                          EACH BIT IN THE PATTERN REPRESENTS 3 PLOTTER
+C                          ADDRESS UNITS (1=SOLID, 0=BLANK)
+C
+C
+C
+C USER ENTRY POINT.
+C DASHDB GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS
+C SPECIFIED IN ITS ARGUMENT. THIS INTERNAL REPRESENTATION IS PASSED
+C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1.
+C
+      DIMENSION IPAT(1)
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C DASHD1 IS FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB AND CFVLD.
+C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB. IT IS INITIALIZED IN DASHBD.
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB HAS BEEN CALLED. IT IS INITIALIZED IN DASHBD AND
+C REFERENCED IN CFVLD.
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE
+C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAS BEEN CALLED. IT IS
+C INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C LOCAL VARIABLES TO DASHDB ARE SAVED IN DSAVE2 FOR THE NEXT CALL TO
+C DASHDB.
+C
+      COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1
+C
+C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED
+C
+      SAVE
+C
+C +NOAO - blockdata replaced with run time initialization.
+C     EXTERNAL DASHBD
+      call dashbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR
+      CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDB', 'VERSION  1')
+      IF (IFCFLG .EQ. 2) GOTO 10
+C
+C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY
+C
+      IF (MNCSTR .EQ. 15) GOTO 6
+      CALL SETER('DASHDB -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR
+     1ECTLY',1,2)
+    6 CONTINUE
+C
+C INITIALIZATION
+C
+      MNCST1 = MNCSTR + 1
+C
+C MASK IS AN ALL SOLID PATTERN
+C
+      MASK=IOR(ISHIFT(32767,1),1)
+C
+      IFCFLG = 2
+C
+C L - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY.
+C ISL - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1).
+C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS
+C          CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD
+C          IS CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C
+   10 CONTINUE
+      NCHRTS = 0
+      L = 0
+      ISL = 0
+      IFSTFL = 1
+      IFSTF2 = 1
+C
+      ICRT = IPAU*ISHIFT(1,15-10)
+      IF (IPAT(1) .NE. 0) GO TO 260
+      ISL = -1
+      RETURN
+  260 IF (IPAT(1) .NE. MASK) GO TO 270
+      ISL = 1
+      RETURN
+  270 NMODE1 = IAND(ISHIFT(IPAT(1),-15),1)
+      DO 290 I = 1,16
+      IF (NMODE1 .NE. IAND(ISHIFT(IPAT(1),I-16),1)) GO TO 280
+      NMODE1 = 1 - NMODE1
+      L = L + 1
+      IP(L) = 0
+      IPFLAG(L) = 1 - 2*NMODE1
+  280 IP(L) = IP(L) + ICRT
+  290 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRAWPV (IX,IY,IND)
+C
+C DRAWPV INTERCEPTS THE CALL TO PLOTIT TO CHECK IF THE PEN HAS TO BE
+C MOVED OR IF IT IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION.
+C IF IND=2 NEVER MOVE PEN, JUST UPDATE VARIABLES IXSTOR AND IYSTOR.
+C
+C IN IXSTOR AND IYSTOR THE CURRENT POSITION OF THE PEN IS SAVED.
+C
+      COMMON /DSAVE3/ IXSTOR,IYSTOR
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+      SAVE
+      IIND = IND + 1
+      GOTO (100,90,105), IIND
+C
+   90 CONTINUE
+C
+C DRAW LINE AND SAVE POSITION OF PEN.
+C
+      IXSTOR = IX
+      IYSTOR = IY
+      CALL PLOTIT (IXSTOR,IYSTOR,1)
+      GOTO 110
+C
+  100 CONTINUE
+C
+C CHECK IF PEN IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION.
+C
+      DIFF = FLOAT(IABS(IXSTOR-IX)+IABS(IYSTOR-IY))
+      IF (DIFF .LE. FLOAT(ICLOSE)) GO TO 110
+C
+      IXSTOR = IX
+      IYSTOR = IY
+      CALL PLOTIT (IXSTOR,IYSTOR,0)
+      GOTO 110
+C
+  105 CONTINUE
+C
+C DO NOT MOVE PEN. JUST UPDATE VARIABLES IXSTOR AND IYSTOR.
+C
+      IXSTOR = IX
+      IYSTOR = IY
+C
+  110 CONTINUE
+C
+      RETURN
+      END
+C
+      SUBROUTINE CFVLD (IENTRY,IIX,IIY)
+C
+C CFVLD CONNECTS POINTS WHOSE COORDINATES ARE SUPPLIED IN THE ARGUMENTS,
+C ACCORDING TO THE DASH PATTERN WHICH IS PASSED FROM ROUTINE DASHDB
+C OR DASHDC IN THE COMMON-BLOCK DASHD1.
+C
+      CHARACTER*16  IPC(100)
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C THE VARIABLES IN DASHD1 AND DASHD2 ARE USED FOR COMMUNICATION WITH
+C DASHDC AND DASHDB.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+      COMMON /DASHD2/  IPC
+C
+C THE VARIABLES IN DSAVE1 HAVE TO BE SAVED FOR THE NEXT CALL TO CFVLD.
+C
+      COMMON /DSAVE1/ X,Y,X2,Y2,X3,Y3,M,BTI,IB,IX,IY
+C
+C THE FLAGS IFSTFL AND IVCTFG ARE INITIALIZED IN THE BLOCK DATA DASHBD.
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED.
+C IVCTFG IS A FLAG TO INDICATE IF CFVLD IS BEING CALLED FROM VECTD OR
+C LASTD.
+C
+      COMMON /DCFLAG/ IFSTFL
+      COMMON /CFFLAG/ IVCTFG
+      SAVE
+C
+C
+C CMN IS USED TO DETERMINE WHEN TO STOP DRAWING A LINE SEGMENT
+C
+      DATA CMN/1.5/
+C
+C IMPOS IS USED AS AN IMPOSSIBLE PEN POSITION.
+C
+      DATA IMPOS /-9999/
+C
+C
+C  ISL= -1  ALL BLANK  ) FLAG TO AVOID MOST CALCULATIONS
+C        0  DASHED     )   IF PATTERN IS ALL SOLID OR
+C        1  ALL SOLID  )   ALL BLANK
+C
+C     X,IX,Y,IY    CURRENT POSITION
+C     X1,Y1        START OF A USER LINE SEGMENT
+C     X2,Y2        END OF A USER LINE SEGMENT
+C     X3,Y3        START OF A GAP PATTERN SEGMENT
+C
+C  SYMBOLS,IF PRESENT ARE CENTERED IN AN IMMEDIATLY PRECEEDING
+C     GAP SEGMENT, OR DONE AT THE CURRENT POSITION OTHERWISE
+C
+C  SEGMENT TYPES ARE RECOGNIZED AS FOLLOWS
+C     SOLID - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING
+C             ELEMENT IN IPFLAG IS 1.
+C     GAP - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING
+C             ELEMENT IN IPFLAG IS -1.
+C     SYMBOL - WORD IN IP-ARRAY CONTAINS CHARACTER REPRESENTATIONS.
+C             CORRESPONDING ELEMENT IN IPFLAG IS 0.
+C             SYMBOL COUNT FOR CHAR STRING IN CHAR NUMBER MNCSTR+1.
+C     THE IP ARRAY AND THE IPFLAG ARRAY ARE COMPOSED OF L ELEMENTS.
+C
+C     BTI - BITS THIS INCREMENT
+C     BPBX,BPBY BITS PER BIT X(Y)
+C
+C
+C BRANCH DEPENDING ON FUNCTION TO BE PERFORMED.
+C
+      GO TO (330,305,350),IENTRY
+C
+C INITIALIZE VARIABLES (ENTRY FRSTD ONLY)
+C
+   30 CONTINUE
+      X = IX
+      Y = IY
+      X2 = X
+      X3 = X
+      Y2 = Y
+      Y3 = Y
+      M = 1
+      IB = IPFLAG(1)
+      IF (IPFLAG(1) .NE. 0) GO TO 40
+      IB = 0
+      BTI = 0
+   40 CONTINUE
+      BTI = FLOAT(IP(1))*FPART
+      GO TO 300
+C
+C MAIN LOOP START
+C
+   50 CONTINUE
+         X1 = X2
+         Y1 = Y2
+         MX = IIX
+         MY = IIY
+         X2 = MX
+         Y2 = MY
+         DX = X2-X1
+         DY = Y2-Y1
+         D = SQRT(DX*DX+DY*DY)
+         IF (D .LT. CMN) GO TO 190
+   60    BPBX = DX/D
+         BPBY = DY/D
+         CALL DRAWPV (IX,IY,0)
+   70    BTI = BTI-D
+         IF (BTI) 100,100,80
+C
+C LINE SEGMENT WILL FIT IN CURRENT PATTERN ELEMENT
+C
+   80    X = X2
+         Y = Y2
+         IX = X2
+         IY = Y2
+         IF (IB) 200,160,90
+   90    CALL DRAWPV (IX,IY,1)
+         GO TO 200
+C
+C LINE SEGMENT WONT FIT IN CURRENT PATTERN ELEMENT
+C DO IT TO END OF ELEMENT, SAVE HOW MUCH OF SEGMENT LEFT TO DO (D)
+C
+  100    BTI = BTI+D
+         D = D-BTI
+         X = X+BPBX*BTI
+         Y = Y+BPBY*BTI
+         IX = X+.5
+         IY = Y+.5
+         IF (IB) 110,160,120
+  110    CALL DRAWPV (IX,IY,0)
+         GO TO 130
+  120    CALL DRAWPV (IX,IY,1)
+C
+C GET THE NEXT PATTERN ELEMENT
+C
+  130    M = MOD(M,L)+1
+         IB = IPFLAG(M)
+         IF (IB) 140,160,150
+  140    X3 = X
+         Y3 = Y
+         BTI = FLOAT(IP(M))
+         GO TO 70
+  150    X3 = -1.
+         BTI = FLOAT(IP(M))
+         GO TO 70
+C
+C CHARACTER GENERATION
+C
+  160    S = 0.
+         IF (IGP .NE. 9) GO TO 162
+C
+         DX = X-X3
+         DY = Y-Y3
+         GO TO 164
+C
+  162    CONTINUE
+         DX = X - X1
+         DY = Y - Y1
+  164    CONTINUE
+C
+         IF (DY) 170,180,170
+  170    S = ATAN2(DY,DX)
+         IF (ABS(S-.00005) .GT. 1.5708) S = S-SIGN(3.14159,S)
+  180    IF (IGP .NE. 9) GO TO 182
+C
+         MX = X3 + DX*.5
+         MY = Y3 + DY*.5
+         LIGP = 0
+         GO TO 184
+C
+  182    CONTINUE
+         MX = X
+         MY = Y
+         LIGP = 1
+C
+  184    CONTINUE
+         IS = IFIX(S*180./3.14 + .5)
+         IF (IS .LT. 0) IS = 360+IS
+         CALL GETUSV('XF',LXSAVE)
+         CALL GETUSV('YF',LYSAVE)
+         MX = ISHIFT (MX,LXSAVE-15)
+         MY = ISHIFT(MY,LYSAVE-15)
+         CALL WTSTR(CPUX(MX),CPUY(MY),IPC(M)(1:IP(M)),ISIZE,IS,LIGP)
+         CALL DRAWPV (IMPOS,IMPOS,2)
+         CALL DRAWPV (IX,IY,0)
+         GO TO 130
+  190    X2 = X1
+         Y2 = Y1
+  200 CONTINUE
+C
+C EXIT IF CALL WAS TO VECTD.
+C
+      IF (IVCTFG .NE. 2) GO TO 210
+      IVCTFG = 1
+      GO TO 300
+C
+C EXIT IF NOT PLOTTING A GAP
+C
+  210 IF (IB .GE. 0) GO TO 300
+C
+C MUST BE IN A GAP AT END OF LASTD. EXIT IF NOT A LABEL GAP.
+C
+      MO = M
+      M = MOD(M,L) + 1
+      IF (IPFLAG(M) .NE. 0) GO TO 300
+C
+C CHECK PREVIOUS PLOTTED ELEMENT. WAS IT A GAP OR A LINE.
+C
+      MPREV = M - 2
+      IF (MPREV .LE. 0) MPREV = MPREV + L
+      IB = IPFLAG(MPREV)
+      IF (IB .GE. 0) GO TO 250
+C
+C PREVIOUS ELEMENT WAS A GAP - LOOK FOR NEXT LINE.
+C EXIT IF NO LINES IN PATTERN.
+C
+  230 CONTINUE
+  240 M = MOD(M,L)+1
+      IF (M .EQ. MO) GO TO 300
+      IB = IPFLAG(M)
+      IF (IB .EQ. 0) GOTO 245
+      BTI = FLOAT(IP(M))
+  245 CONTINUE
+C
+C IF IP(M) NOT A LINE, CONTINUE LOOKING.
+C
+      IF (IB) 240,230,280
+C
+C PREVIOUS ELEMENT WAS A LINE - LOOK FOR NEXT GAP.
+C IF NO NON-LABEL GAPS IN PATTERN, GO TO 290.
+C
+  250 CONTINUE
+  260 M = MOD(M,L)+1
+      IF (M .EQ. MO) GO TO 290
+      IB = IPFLAG(M)
+      IF (IB .EQ. 0) GOTO 265
+      BTI = FLOAT(IP(M))
+  265 CONTINUE
+C
+C IF IP(M) NOT A GAP, CONTINUE LOOKING.
+C
+      IF (IB) 270,250,260
+C
+C FOUND A GAP. IF ITS A LABEL GAP, GO LOOK FOR NEXT GAP.
+C
+  270 MT = M
+      M = MOD(M,L)+1
+      IF (IPFLAG(M) .EQ. 0) GO TO 250
+      M = MT
+C
+C M POINTS TO NEXT ELEMENT TO PLOT. SET UP AND GO PLOT.
+C
+  280 X1 = X3
+      Y1 = Y3
+      X = X3
+      Y = Y3
+      IX = X+0.5
+      IY = Y+0.5
+      DX = X2-X1
+      DY = Y2-Y1
+      D = SQRT(DX*DX+DY*DY)
+      IF (D .GE. CMN) GO TO 60
+      GO TO 300
+C
+C NO NON-LABEL GAPS IN THE PATTERN - FILL IN WITH SOLID LINE.
+C
+  290 IX = X3+0.5
+      IY = Y3+0.5
+      CALL DRAWPV (IX,IY,0)
+      IX = X2
+      IY = Y2
+      CALL DRAWPV (IX,IY,1)
+  300 RETURN
+C
+C *************************************
+C
+C ENTRY VECTD (XX,YY)
+C
+  305 CONTINUE
+C
+C TEST FOR PREVIOUS CALL TO FRSTD.
+C
+      IF (IFSTFL .EQ. 2) GO TO 310
+C
+C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL.
+C
+      CALL SETER ('CFVLD -- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.',
+     -             1,1)
+      GO TO 330
+  310 K = 1
+      IVCTFG = 2
+      IF (ISL) 300,50,320
+  320 IX = IIX
+      IY = IIY
+      CALL DRAWPV (IX,IY,1)
+      GO TO 300
+C
+C *************************************
+C
+C     ENTRY FRSTD (FLDX,FLDY)
+C
+  330 IX = IIX
+      IY = IIY
+      IFSTFL = 2
+C AVOID UNEXPECTED PEN POSITION IF CALLS TO SYSTEM PLOT PACKAGE
+C ROUTINES WERE MADE.
+      CALL DRAWPV (IMPOS,IMPOS,2)
+      IF (ISL) 300,30,340
+  340 CALL DRAWPV (IX,IY,0)
+      GO TO 300
+C
+C *************************************
+C
+C     ENTRY LASTD
+C
+  350 CONTINUE
+C
+C TEST FOR PREVIOUS CALL TO FRSTD
+C
+      IF (IFSTFL .NE. 2) GO TO 300
+      IFSTFL = 1
+      K = 1
+      IF (ISL .NE. 0) GO TO 300
+      GO TO 210
+      END
+      SUBROUTINE FRSTD (X,Y)
+C USER ENTRY PPINT.
+      CALL FL2INT (X,Y,IIX,IIY)
+      CALL FDVDLD (1,IIX,IIY)
+      RETURN
+      END
+      SUBROUTINE VECTD (X,Y)
+C USER ENTRY POINT.
+      CALL FL2INT (X,Y,IIX,IIY)
+      CALL FDVDLD (2,IIX,IIY)
+      RETURN
+      END
+      SUBROUTINE LASTD
+C USER ENTRY POINT. SEE DOCUMENTATION FOR PURPOSE.
+      DATA IDUMMY /0/
+      CALL FDVDLD (3,IDUMMY,IDUMMY)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE CURVED (X,Y,N)
+C USER ENTRY POINT.
+C
+      DIMENSION X(N),Y(N)
+C
+      CALL FRSTD (X(1),Y(1))
+      DO 10 I=2,N
+         CALL VECTD (X(I),Y(I))
+   10 CONTINUE
+C
+      CALL LASTD
+C
+      RETURN
+      END
+      SUBROUTINE LINED (XA,YA,XB,YB)
+C USER ENTRY POINT.
+C
+      DATA IDUMMY /0/
+      CALL FL2INT (XA,YA,IXA,IYA)
+      CALL FL2INT (XB,YB,IXB,IYB)
+C
+      CALL CFVLD (1,IXA,IYA)
+      CALL CFVLD (2,IXB,IYB)
+      CALL CFVLD (3,IDUMMY,IDUMMY)
+C
+      RETURN
+C
+C------REVISION HISTORY
+C
+C JUNE 1984          CONVERTED TO FORTRAN77 AND GKS
+C
+C DECEMBER 1979      ADDED REVISION HISTORY AND STATISTICS
+C                    CALL
+C
+C-----------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/ezmap.f b/sys/gio/ncarutil/ezmap.f
new file mode 100644
index 00000000..8d87a4d7
--- /dev/null
+++ b/sys/gio/ncarutil/ezmap.f
@@ -0,0 +1,4598 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   I N T R O D U C T I O N
+C***********************************************************************
+C
+C THIS FILE CONTAINS IMPLEMENTATION INSTRUCTIONS, A WRITE-UP, AND THE
+C CODE FOR THE PACKAGE EZMAP.  BANNERS LIKE THE ONE ABOVE DELIMIT THE
+C MAJOR SECTIONS OF THE FILE.  THE CODE ITSELF IS SEPARATED INTO THREE
+C SECTIONS:  USER-LEVEL ROUTINES, INTERNAL ROUTINES, AND THE BLOCK DATA
+C ROUTINE WHICH DETERMINES THE DEFAULT VALUES OF INTERNAL PARAMETERS.
+C WITHIN EACH SECTION, ROUTINES APPEAR IN ALPHABETICAL ORDER.
+C
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   I M P L E M E N T A T I O N
+C***********************************************************************
+C
+C THE EZMAP PACKAGE IS WRITTEN IN FORTRAN-77 AND SHOULD BE RELATIVELY
+C EASY TO IMPLEMENT.  THE OUTLINE DATA REQUIRED MAY BE GENERATED BY
+C RUNNING THE PROGRAM
+C
+C       PROGRAM CONVRT
+C       DIMENSION FLIM(4),PNTS(200)
+C     1 READ (1,3,END=2) NPTS,IGID,(FLIM(I),I=1,4)
+C       IF (NPTS.GT.1) READ (1,4,END=2) (PNTS(I),I=1,NPTS)
+C       WRITE (2) NPTS,IGID,(FLIM(I),I=1,4),(PNTS(I),I=1,NPTS)
+C       GO TO 1
+C     2 STOP
+C     3 FORMAT (2I8,4F8.3)
+C     4 FORMAT (10F8.3)
+C       END
+C
+C WITH THE FILE EZMAPDAT ASSIGNED TO UNIT 1.  THE OUTPUT FILE, ON UNIT
+C 2, CONTAINS THE BINARY OUTLINE DATA TO BE USED BY EZMAP.  THE EZMAP
+C ROUTINE MAPIO (WHICH SEE) MUST THEN BE MODIFIED TO ACCESS THIS FILE.
+C
+C THE ROUTINE MAPCHI CONTAINS THE STATEMENTS
+C
+C       CALL GETUSV ('IN',INTO)
+C       CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.))
+C
+C (TO BE EXECUTED FOR A POSITIVE VALUE OF IPRT) AND THE STATEMENT
+C
+C       CALL SETUSV ('IN',INTO)
+C
+C (TO BE EXECUTED FOR A NEGATIVE VALUE OF IPRT).  THESE STATEMENTS
+C SET/RESET THE INTENSITY FOR VARIOUS PORTIONS OF THE MAP.  IF COLOR
+C IS AVAILABLE ON THE DEVICE(S) BEING DRIVEN, THESE STATEMENTS SHOULD
+C BE OMITTED AND THE IMPLEMENTOR SHOULD PROVIDE A DEFAULT VERSION OF
+C MAPUSR WHICH SETS/RESETS THE INTENSITY AND COLOR AS DESIRED.  THIS
+C DEFAULT VERSION OF MAPUSR SHOULD DECLARE THE LABELLED COMMON BLOCK
+C MAPNTS AND MAKE USE OF THE CURRENT VALUES IN THE ARRAY INTS TO SET
+C THE INTENSITY; IT SHOULD ALSO BE PUBLISHED TO AID USERS IN SETTING
+C UP THEIR OWN VERSIONS.
+C
+C
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   U S E R ' S   G U I D E
+C***********************************************************************
+C
+C LATEST REVISION        AUGUST, 1985
+C
+C PURPOSE                TO PLOT MAPS OF THE EARTH ACCORDING TO ANY
+C                        ONE OF TEN DIFFERENT PROJECTIONS, SHOWING
+C                        CONTINENTAL, INTERNATIONAL, AND/OR U.S. STATE
+C                        OUTLINES, PARALLELS, AND MERIDIANS.  THE
+C                        ORIGIN AND ORIENTATION OF THE PROJECTION ARE
+C                        SELECTED BY THE USER.  POINTS ON THE EARTH
+C                        DEFINED BY LATITUDE AND LONGITUDE ARE MAPPED
+C                        TO POINTS IN THE PLANE OF PROJECTION - THE
+C                        U/V PLANE.  THE U AND V AXES ARE PARALLEL TO
+C                        THE X AND Y AXES OF THE PLOTTER, RESPECTIVELY.
+C                        A RECTANGULAR FRAME WHOSE SIDES ARE PARALLEL
+C                        TO THE U AND V AXES IS CHOSEN AND MATERIAL
+C                        WITHIN THAT FRAME (OR AN INSCRIBED ELLIPTICAL
+C                        FRAME) IS PLOTTED.
+C
+C USAGE                  THE ROUTINE MAPDRW DRAWS A COMPLETE MAP, AS
+C                        DIRECTED BY THE CURRENT VALUES OF PARAMETERS
+C                        IN THE EZMAP PACKAGE.  TO CHANGE THE VALUES
+C                        OF THOSE PARAMETERS, AND THUS THE APPEARANCE
+C                        OF THE MAP, ONE MAY FIRST CALL ONE OF THE
+C                        ROUTINES MAPROJ (TO CHANGE THE PROJECTION TO
+C                        BE USED), MAPSET (TO CHANGE WHAT PORTION OF
+C                        THE U/V PLANE IS TO BE VIEWED), MAPPOS (TO
+C                        CHANGE WHAT PORTION OF THE PLOTTER FRAME IS
+C                        TO BE USED), OR ONE OF THE PARAMETER-SETTING
+C                        ROUTINES MAPSTC, MAPSTI, MAPSTL, AND MAPSTR
+C                        (TO CHANGE VARIOUS OTHER PARAMETERS, OF TYPES
+C                        CHARACTER, INTEGER, LOGICAL, AND REAL).  THE
+C                        PARAMETER-RETRIEVAL ROUTINES MAPGTC, MAPGTI,
+C                        MAPGTL, AND MAPGTR ALLOW THE USER TO RETRIEVE
+C                        THE VALUES OF EZMAP PARAMETERS.
+C
+C                        THE ROUTINE MAPSAV ALLOWS ONE TO SAVE THE
+C                        CURRENT STATE OF EZMAP, THE ROUTINE MAPRST TO
+C                        RESTORE A SAVED STATE.
+C
+C                        USERS WITH SPECIAL NEEDS MAY WISH TO CALL THE
+C                        LOWER-LEVEL ROUTINES MAPINT (TO INITIALIZE
+C                        THE PACKAGE - IT MUST BE CALLED INITIALLY AND
+C                        AGAIN WHENEVER CERTAIN PARAMETERS ARE CHANGED),
+C                        MAPGRD (TO DRAW PARALLELS AND MERIDIANS),
+C                        MAPLBL (TO LABEL THE INTERNATIONAL DATE LINE,
+C                        THE EQUATOR, THE GREENWICH MERIDIAN, AND THE
+C                        POLES, AND TO DRAW THE PERIMETER), AND MAPLOT
+C                        (TO DRAW THE SELECTED GEOGRAPHIC OUTLINES).
+C                        THESE ROUTINES ARE NORMALLY CALLED BY MAPDRW.
+C
+C                        INTENSITIES OF VARIOUS MAP PORTIONS MAY BE SET
+C                        BY CALLS TO THE ROUTINE MAPSTI.  THE ROUTINE
+C                        MAPUSR IS CALLED BY EZMAP JUST BEFORE/AFTER
+C                        DRAWING VARIOUS PORTIONS OF THE MAP; THE
+C                        DEFAULT VERSION, WHICH DOES NOTHING, MAY BE
+C                        REPLACED BY A USER VERSION WHICH SETS/RESTORES
+C                        COLOR, SPOT SIZE, INTENSITY, DASH PATTERN, ETC.
+C
+C                        THE ROUTINE MAPEOS IS CALLED BY EZMAP ONCE FOR
+C                        EACH OUTLINE SEGMENT.  THE USER MAY SUPPLY A
+C                        VERSION WHICH EXAMINES THE SEGMENT TO SEE IF
+C                        IT OUGHT TO BE PLOTTED AND, IF NOT, TO DELETE
+C                        IT.  THIS MAY BE USED, FOR EXAMPLE, TO REDUCE
+C                        THE CLUTTER IN NORTHERN CANADA.
+C
+C                        TO OVERLAY OBJECTS OF ONE'S OWN ON THE MAP
+C                        DRAWN BY MAPDRW, ONE MAY USE ONE OR MORE OF
+C                        THE ROUTINES MAPTRN (TO COMPUTE THE U/V
+C                        COORDINATES OF A POINT, GIVEN ITS LATITUDE
+C                        AND LONGITUDE), MAPIT (TO DO "PEN-UP/DOWN"
+C                        MOVES), MAPFST (TO DO "PEN-UP" MOVES), AND
+C                        MAPVEC (TO DO "PEN-DOWN" MOVES).
+C
+C                        THE ROUTINE SUPMAP, FROM WHICH EZMAP GREW, IS
+C                        IMPLEMENTED WITHIN IT AND ALLOWS ONE TO DRAW
+C                        A COMPLETE MAP WITH A SINGLE, RATHER LENGTHY,
+C                        CALL.  THE ROUTINE SUPCON, WHICH IS THE OLD
+C                        ANALOGUE OF MAPTRN, IS ALSO IMPLEMENTED.
+C
+C                        THE OLD ROUTINE EZMAP, WHICH WAS IMPLEMENTED
+C                        IN SUCH A WAY AS TO CAUSE PORTABILITY PROBLEMS,
+C                        HAS BEEN REMOVED.  STATISTICS INDICATED THAT
+C                        IT WAS NOT BEING USED, ANYWAY.
+C
+C                        SEE THE WRITE-UPS OF INDIVIDUAL ROUTINES BELOW.
+C
+C I/O                    GRAPHICAL OUTPUT IS GENERATED.  OUTLINE DATA
+C                        IS READ FROM A "TAPE UNIT".
+C
+C ERROR CONDITIONS       WHEN AN ERROR OCCURS DURING A CALL TO AN EZMAP
+C                        ROUTINE, AN ERROR MESSAGE IS LOGGED, USING THE
+C                        NCAR VERSION OF THE PORT ERROR ROUTINE SETERR
+C                        (CALLED SETER); BY DEFAULT, THE PROGRAM IS THEN
+C                        ABORTED.  ERROR RECOVERY IS POSSIBLE, HOWEVER.
+C                        INSERT THE CALL
+C
+C                              CALL ENTSR (IOLD,1)
+C
+C                        AT THE BEGINNING OF YOUR PROGRAM.  THIS MAKES
+C                        ERROR RECOVERY POSSIBLE.  THEN, FOLLOWING EACH
+C                        CALL TO AN EZMAP ROUTINE WHICH COULD CAUSE AN
+C                        ERROR, INSERT CODE LIKE THE FOLLOWING:
+C
+C                              IF (NERRO(IERR).NE.0) THEN
+C                                CALL EPRIN
+C                                CALL ERROF
+C                              END IF
+C
+C                        THE VALUE OF THE FUNCTION NERRO IS NON-ZERO IF
+C                        SETER HAS BEEN CALLED.  THE CALL TO EPRIN DUMPS
+C                        OUT THE ERROR MESSAGE (WHICH HAS NOT YET BEEN
+C                        PRINTED) AND THE CALL TO ERROF TURNS OFF THE
+C                        ERROR CONDITION IN SETER.  THIS DOES NOT CLEAR
+C                        EZMAP'S ERROR FLAG, HOWEVER; IT REMAINS SET
+C                        UNTIL AFTER THE NEXT SUCCESSFUL CALL TO MAPINT,
+C                        PREVENTING OTHER EZMAP ROUTINES FROM TRYING TO
+C                        EXECUTE (AND POSSIBLY BOMBING AS A RESULT).
+C                        POSSIBLE ERROR FLAGS ARE AS FOLLOWS:
+C
+C                           1  MAPGTC - UNKNOWN PARAMETER NAME XX
+C                           2  MAPGTI - UNKNOWN PARAMETER NAME XX
+C                           3  MAPGTL - UNKNOWN PARAMETER NAME XX
+C                           4  MAPGTR - UNKNOWN PARAMETER NAME XX
+C                           5  MAPINT - ATTEMPT TO USE NON-EXISTENT
+C                                       PROJECTION
+C                           6  MAPINT - ANGULAR LIMITS TOO GREAT
+C                           7  MAPINT - MAP HAS ZERO AREA
+C                           8  MAPINT - MAP LIMITS INAPPROPIATE
+C                           9  MAPROJ - UNKNOWN PROJECTION NAME XX
+C                          10  MAPSET - UNKNOWN MAP AREA SPECIFIER XX
+C                          11  MAPSTC - UNKNOWN OUTLINE NAME XX
+C                          12  MAPSTC - UNKNOWN PARAMETER NAME XX
+C                          13  MAPSTI - UNKNOWN PARAMETER NAME XX
+C                          14  MAPSTL - UNKNOWN PARAMETER NAME XX
+C                          15  MAPSTR - UNKNOWN PARAMETER NAME XX
+C                          16  MAPTRN - ATTEMPT TO USE NON-EXISTENT
+C                                       PROJECTION
+C                          17  MAPIO -  OUTLINE DATASET IS UNREADABLE
+C                          18  MAPIO -  EOF ENCOUNTERED IN OUTLINE
+C                                       DATASET
+C                          19  MAPPOS - ARGUMENTS ARE INCORRECT
+C                          20  MAPRST - ERROR ON READ
+C                          21  MAPRST - EOF ON READ
+C                          22  MAPSAV - ERROR ON WRITE
+C
+C PRECISION              SINGLE.
+C
+C LANGUAGE               FORTRAN.
+C
+C HISTORY                IN ABOUT 1963, R. L. PARKER OF UCSD WROTE THE
+C                        ORIGINAL CODE CALLED SUPERMAP, USING OUTLINE
+C                        DATA GENERATED BY HERSHEY.  THIS WAS ADAPTED
+C                        FOR USE AT NCAR BY LEE, IN 1968.  REVISIONS
+C                        OCCURRED IN JANUARY OF 1969 AND MAY OF 1971.
+C                        THE CODE WAS PUT IN STANDARD NSSL FORMAT IN
+C                        OCTOBER OF 1973.  FURTHER REVISIONS OCCURRED
+C                        IN JULY, 1974, IN AUGUST, 1976, AND IN JULY,
+C                        1978.  IN LATE 1984 AND EARLY 1985, THE CODE
+C                        WAS HEAVILY REVISED TO ACHIEVE FORTRAN-77 AND
+C                        GKS COMPATIBILITY, TO REMOVE ERRORS, AND TO
+C                        EXPAND THE OUTLINE DATASETS.  CICELY RIDLEY,
+C                        JAY CHALMERS, AND DAVE KENNISON (THE CURRENT
+C                        CURATOR) HAVE ALL HAD A HAND IN THE CREATION
+C                        OF THIS PACKAGE.
+C
+C REFERENCES             HERSHEY, A.V., "THE PLOTTING OF MAPS ON A
+C                        CRT PRINTER."  NWL REPORT NO. 1844, 1963.
+C
+C                        LEE, TSO-HWA, "STUDENTS' SUMMARY REPORTS,
+C                        WORK-STUDY PROGRAM IN SCIENTIFIC COMPUTING".
+C                        NCAR, 1968.
+C
+C                        PARKER, R.L., "2UCSD SUPERMAP:  WORLD
+C                        PLOTTING PACKAGE".
+C
+C                        STEERS, J.A., "AN INTRODUCTION TO THE STUDY
+C                        OF MAP PROJECTIONS".  UNIVERSITY OF LONDON
+C                        PRESS, 1962.
+C
+C ACCURACY               THE DEFINITION OF THE MAP PRODUCED IS LIMITED
+C                        BY TWO FACTORS:  THE RESOLUTION OF THE OUTLINE
+C                        DATA AND THE RESOLUTION OF THE GRAPHICS
+C                        DEVICE.
+C
+C                        DATA POINTS IN THE CONTINENTAL OUTLINES ARE
+C                        ABOUT ONE DEGREE APART AND THE COORDINATES
+C                        ARE ACCURATE TO .01 DEGREE.  DATA POINTS IN
+C                        U.S. STATE OUTLINES ARE ABOUT .05 DEGREES
+C                        APART AND THE COORDINATES ARE ACCURATE TO
+C                        .001 DEGREE.  BOTH THE SPACING AND THE
+C                        ACCURACY OT THE INTERNATIONAL BOUNDARIES
+C                        FALLS SOMEWHERE BETWEEN THESE TWO EXTREMES.
+C
+C                        THE DICOMED HAS 15-BIT COORDINATE REGISTERS,
+C                        BUT AN EFFECTIVE RESOLUTION OF AT MOST 1 IN
+C                        4096 IN BOTH X AND Y.
+C
+C TIMING                 THE MARCH, 1985, UPDATE HAS MADE EZMAP RUN
+C                        SIGNIFICANTLY SLOWER.  THIS IS MOSTLY BECAUSE
+C                        THE DEFAULT RESOLUTION HAS BEEN INCREASED TO
+C                        A VALUE SUITABLE FOR THE DICOMED, RATHER THAN
+C                        THE DD80.  USERS WHO ARE CONCERNED ABOUT THIS
+C                        MAY INCREASE THE VALUES OF THE PARAMETERS 'MV'
+C                        AND/OR 'DD' (SEE THE DESCRIPTION OF MAPSTX)
+C                        TO DECREASE THE TIMING (AT THE EXPENSE OF PLOT
+C                        QUALITY, OF COURSE).
+C
+C PORTABILITY            THE CODE IS WRITTEN IN FORTRAN-77 AND SHOULD
+C                        BE VERY PORTABLE.  A BINARY DATASET CONTAINING
+C                        OUTLINE DATA MUST BE GENERATED AND THE ROUTINE
+C                        MAPIO MUST BE MODIFIED TO READ THAT DATASET.
+C                        SEE THE IMPLEMENTATION INSTRUCTIONS AT THE
+C                        BEGINNING OF THIS FILE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P D R W   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW THE COMPLETE MAP DESCRIBED BY THE
+C                        CURRENT VALUES OF THE EZMAP PARAMETERS.
+C
+C                        MAPDRW CALLS MAPINT (IF REQUIRED), MAPGRD,
+C                        MAPLBL, AND MAPLOT, IN THAT ORDER.  THE USER
+C                        MAY WISH TO CALL THESE ROUTINES DIRECTLY.
+C
+C USAGE                  CALL MAPDRW
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P E O S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                MAPEOS IS CALLED BY EZMAP TO EXAMINE EACH
+C                        SEGMENT IN THE OUTLINE DATASETS.  THE DEFAULT
+C                        VERSION DOES NOTHING.  A USER-SUPPLIED VERSION
+C                        MAY CAUSE SELECTED SEGMENTS TO BE DELETED (TO
+C                        REDUCE THE CLUTTER IN NORTHERN CANADA, FOR
+C                        EXAMPLE).
+C
+C USAGE (BY EZMAP)       CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+C
+C ARGUMENTS              NOUT IS THE NUMBER OF THE OUTLINE DATASET FROM
+C                        WHICH THE SEGMENT COMES, AS FOLLOWS:
+C
+C                          NOUT    DATASET TO WHICH SEGMENT BELONGS.
+C                          ----    ------------------------------------
+C                            1     'CO' - CONTINENTAL OUTLINES ONLY.
+C                            2     'US' - U.S STATE OUTLINES ONLY.
+C                            3     'PS' - CONTINENTAL, U.S STATE, AND
+C                                  INTERNATIONAL OUTLINES.
+C                            4     'PO' - CONTINENTAL AND INTERNATIONAL
+C                                  OUTLINES.
+C
+C                        NSEG IS THE NUMBER OF THE SEGMENT WITHIN THE
+C                        OUTLINE DATASET.
+C
+C                        IGID IDENTIFIES THE GROUP TO WHICH THE SEGMENT
+C                        BELONGS, AS FOLLOWS:
+C
+C                          IGID    GROUP TO WHICH SEGMENT BELONGS.
+C                          ----    ------------------------------------
+C                            1     CONTINENTAL OUTLINES.
+C                            2     U.S. STATE BOUNDARIES.
+C                            3     INTERNATIONAL BOUNDARIES.
+C
+C                        NPTS IS THE NUMBER OF POINTS DEFINING THE
+C                        OUTLINE SEGMENT.  NPTS MAY BE ZEROED TO
+C                        SUPPRESS PLOTTING OF THE SEGMENT.
+C
+C                        PNTS IS AN ARRAY OF COORDINATES.  PNTS(1)
+C                        AND PNTS(2) ARE THE LATITUDE AND LONGITUDE
+C                        OF THE FIRST POINT, PNTS(3) AND PNTS(4) THE
+C                        LATITUDE AND LONGITUDE OF THE SECOND POINT, ...
+C                        PNTS(2*NPTS-1) AND PNTS(2*NPTS) THE LATITUDE
+C                        AND LONGITUDE OF THE LAST POINT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P F S T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO
+C                        MAPDRW - USED IN CONJUNCTION WITH MAPVEC.
+C
+C USAGE                  CALL MAPFST (RLAT,RLON)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPIT (RLAT,RLON,0)
+C
+C ARGUMENTS              RLAT AND RLON ARE DEFINED AS FOR MAPIT.  SEE
+C                        THE DESCRIPTION OF MAPIT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P G R D   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW A GRID MADE UP OF LINES OF LATITUDE AND
+C                        LONGITUDE.  IF EZMAP NEEDS INITIALIZATION OR IF
+C                        THE ERROR FLAG 'ER' IS NON-ZERO, MAPGRD DOES
+C                        NOTHING.
+C
+C USAGE                  CALL MAPGRD
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P G T X   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO GET THE VALUES OF EZMAP PARAMETERS.
+C
+C USAGE                  CALL MAPGTC (WHCH,CVAL)
+C                        CALL MAPGTI (WHCH,IVAL)
+C                        CALL MAPGTL (WHCH,LVAL)
+C                        CALL MAPGTR (WHCH,RVAL)
+C
+C ARGUMENTS              WHCH IS A CHARACTER STRING SPECIFYING THE
+C                        PARAMETER TO GET.
+C
+C                        CVAL, IVAL, LVAL, OR RVAL IS A VARIABLE TO
+C                        RECEIVE THE VALUE OF THE PARAMETER SPECIFIED
+C                        BY WHCH - OF TYPE CHARACTER, INTEGER, LOGICAL,
+C                        OR REAL, RESPECTIVELY.
+C
+C                        ALL OF THE PARAMETERS LISTED IN THE DISCUSSION
+C                        OF MAPSTX MAY BE RETRIEVED.  THE FOLLOWING MAY
+C                        ALSO BE RETRIEVED:
+C
+C                        WHCH       TYPE  MEANING
+C                        ----       ----  -------
+C
+C                        AREA          C  THE VALUE OF THE MAP LIMITS
+C                                         SPECIFIER JLTS FROM THE LAST
+C                                         CALL TO MAPSET.  THE DEFAULT
+C                                         VALUE IS 'MA'.
+C
+C                        ERROR         I  THE CURRENT VALUE OF THE ERROR
+C                                         FLAG.  DEFAULT IS ZERO.
+C
+C                        INITIALIZE  I,L  INITIALIZATION FLAG.  IF TRUE
+C                                         (NON-ZERO), EZMAP IS IN NEED
+C                                         OF INITIALIZATION (BY MEANS OF
+C                                         A CALL MAPINT).  THE DEFAULT
+C                                         VALUE IS TRUE (NON-ZERO).
+C
+C                        PROJECTION    C  THE VALUE OF THE PROJECTION
+C                                         SPECIFIER JPRJ FROM THE LAST
+C                                         CALL TO MAPROJ.  THE DEFAULT
+C                                         VALUE IS 'CE'.
+C
+C                        PN          I,R  THE VALUE OF PLON FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        PT          I,R  THE VALUE OF PLAT FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        PN          I,R  "N" IS AN INTEGER BETWEEN 1
+C                                         AND 8.  RETRIEVES VALUES FROM
+C                                         THE LAST CALL TO MAPSET.  P1
+C                                         THROUGH P4 GET YOU PLM1(1),
+C                                         PLM2(1), PLM3(1), AND PLM4(1),
+C                                         WHILE P5 THROUGH P8 GET YOU
+C                                         PLM1(2), PLM2(2), PLM3(2), AND
+C                                         PLM4(2).  THE DEFAULT VALUES
+C                                         ARE ALL ZERO.
+C
+C                        ROTATION    I,R  THE VALUE OF ROTA FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        XLEFT         R  THE PARAMETERS XLOW, XROW,
+C                        XRIGHT        R  YBOW, AND YTOW FROM THE LAST
+C                        YBOTTOM       R  CALL TO MAPPOS.  DEFAULTS
+C                        YTOP          R  ARE .05, .95, .05, AND .95.
+C
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I N T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO INITIALIZE THE PACKAGE AFTER THE VALUES OF
+C                        SOME PARAMETERS HAVE BEEN CHANGED.  THE FLAG
+C                        'IN', WHICH MAY BE RETRIEVED BY A CALL TO
+C                        MAPGTI OR MAPGTL, INDICATES WHETHER OR NOT
+C                        INITIALIZATION IS REQUIRED AT A GIVEN TIME.
+C                        (SOME PARAMETERS MAY BE RESET AT ANY TIME AND
+C                        DO NOT REQUIRE MAPINT TO BE CALLED AGAIN.)
+C
+C USAGE                  CALL MAPINT
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL
+C                        TO MAPDRW.  MAPIT ATTEMPTS TO OMIT NON-VISIBLE
+C                        PORTIONS AND TO HANDLE "CROSS-OVER" - A JUMP
+C                        FROM ONE END OF THE MAP TO THE OTHER CAUSED
+C                        BY THE PROJECTION'S HAVING SLIT THE GLOBE
+C                        ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT
+C                        OPEN WITH THE TWO SIDES OF THE SLIT AT OPPOSITE
+C                        ENDS OF THE MAP.  CROSS-OVER CAN OCCUR ON
+C                        CYLINDRICAL AND CONICAL PROJECTIONS; MAPIT
+C                        HANDLES IT VERY WELL ON THE FORMER AND NOT SO
+C                        WELL ON THE LATTER.
+C
+C                        THE EZMAP PARAMETER 'DL' DETERMINES WHETHER
+C                        MAPIT DRAWS SOLID LINES OR DOTTED LINES.  THE
+C                        PARAMETERS 'DD' AND 'MV' ALSO AFFECT MAPIT'S
+C                        BEHAVIOR.  SEE THE DESCRIPTION OF THE ROUTINE
+C                        MAPSTX, BELOW.
+C
+C                        A SEQUENCE OF CALLS TO MAPIT SHOULD BE FOLLOWED
+C                        BY A CALL TO MAPIQ (WHICH SEE, ABOVE) TO FLUSH
+C                        ITS BUFFERS.
+C
+C                        POINTS IN TWO CONTIGUOUS PEN-DOWN CALLS TO
+C                        MAPIT SHOULD NOT BE FAR APART ON THE GLOBE.
+C
+C USAGE                  CALL MAPIT (RLAT,RLON,IFST)
+C
+C ARGUMENTS              RLAT AND RLON ARE THE LATITUDE AND LONGITUDE
+C                        OF A POINT TO WHICH THE "PEN" IS TO BE MOVED.
+C                        BOTH ARE GIVEN IN DEGREES.  RLAT MUST BE
+C                        BETWEEN -90. AND +90., INCLUSIVE; RLON MUST BE
+C                        BETWEEN -540. AND +540., INCLUSIVE.
+C
+C                        IFST IS 0 TO DO A "PEN-UP" MOVE, 1 TO DO A
+C                        "PEN-DOWN" MOVE IF THE DISTANCE FROM THE LAST
+C                        POINT TO THE NEW POINT IS GREATER THAN 'MV'
+C                        PLOTTER UNITS, 2 OR GREATER TO DO THE MOVE
+C                        REGARDLESS OF THE DISTANCE FROM THE LAST POINT
+C                        TO THE NEW ONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I Q   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FLUSH MAPIT'S BUFFERS.  THIS IS PARTICULARLY
+C                        IMPORTANT BEFORE A STOP OR A CALL FRAME AND
+C                        BEFORE CHANGING INTENSITY, DASH PATTERN, COLOR,
+C                        ETC.
+C
+C USAGE                  CALL MAPIQ
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P L B L   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO LABEL THE INTERNATIONAL DATE LINE (ID), THE
+C                        EQUATOR (EQ), THE GREENWICH MERIDIAN (GM), AND
+C                        THE POLES (NP AND SP), AND TO DRAW THE BORDER
+C                        AROUND THE MAP.  IF EZMAP NEEDS INITIALIZATION
+C                        OR IF THE ERROR FLAG 'ER' IS SET, MAPLBL DOES
+C                        NOTHING.
+C
+C USAGE                  CALL MAPLBL
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P L O T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW THE CONTINENTAL AND/OR INTERNATIONAL
+C                        AND/OR U.S. STATE OUTLINES SELECTED BY THE
+C                        PARAMETER 'OU'.  IF EZMAP CURRENTLY NEEDS
+C                        INITIALIZATION OR IF THE ERROR FLAG 'ER' IS
+C                        SET, MAPLOT DOES NOTHING.
+C
+C USAGE                  CALL MAPLOT
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P P O S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE POSITION OF THE MAP ON THE
+C                        PLOTTER FRAME.
+C
+C USAGE                  CALL MAPPOS (XLOW,XROW,YBOW,YTOW)
+C
+C ARGUMENTS              THE ARGUMENTS ARE FRACTIONS BETWEEN 0 AND 1
+C                        DETERMINING THE POSITION OF A WINDOW IN THE
+C                        PLOTTER FRAME WITHIN WHICH THE MAP IS TO BE
+C                        DRAWN.  XLOW AND XROW POSITION THE LEFT AND
+C                        RIGHT EDGES AND ARE STATED AS FRACTIONS OF THE
+C                        DISTANCE FROM LEFT TO RIGHT IN THE PLOTTER
+C                        FRAME.  YBOW AND YTOW POSITION THE BOTTOM AND
+C                        TOP EDGES AND ARE STATED AS FRACTIONS OF THE
+C                        DISTANCE FROM BOTTOM TO TOP IN THE PLOTTER
+C                        FRAME.  THE MAP IS CENTERED IN THE SPECIFIED
+C                        WINDOW AND MADE AS LARGE AS POSSIBLE WHILE
+C                        MAINTAINING ITS PROPER SHAPE.
+C
+C                        THE DEFAULT VALUES OF THE INTERNAL PARAMETERS
+C                        CHANGED BY THIS ROUTINE ARE .05, .95, .05, AND
+C                        .95, RESPECTIVELY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R O J   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE PROJECTION TO BE USED.
+C
+C USAGE                  CALL MAPROJ (JPRJ,PLAT,PLON,ROTA)
+C
+C ARGUMENTS              JPRJ IS A CHARACTER VARIABLE DEFINING THE
+C                        DESIRED PROJECTION TYPE, AS FOLLOWS:
+C
+C                        THE CONIC PROJECTION:
+C
+C                            'LC' - LAMBERT CONFORMAL CONIC WITH TWO
+C                                   STANDARD PARALLELS.
+C
+C                        THE AZIMUTHAL PROJECTIONS:
+C
+C                            'ST' - STEREOGRAPHIC.
+C
+C                            'OR' - ORTHOGRAPHIC.  CAUSES THE PARAMETER
+C                                   'SA' (WHICH SEE, IN THE DESCRIPTION
+C                                   OF THE ROUTINE MAPSTX) TO BE ZEROED.
+C
+C                            'LE' - LAMBERT EQUAL AREA.
+C
+C                            'GN' - GNOMONIC.
+C
+C                            'AE' - AZIMUTHAL EQUIDISTANT.
+C
+C                            'SV' - SATELLITE-VIEW.  IF THE PARAMETER
+C                                   'SA' (WHICH SEE, IN THE DESCRIPTION
+C                                   OF THE ROUTINE MAPSTX) IS GREATER
+C                                   THAN 1 OR LESS THAN -1, IT IS LEFT
+C                                   ALONE; OTHERWISE, IT IS GIVEN THE
+C                                   VALUE 6.631.
+C
+C                        THE CYLINDRICAL PROJECTIONS:
+C
+C                            'CE' - CYLINDRICAL EQUIDISTANT.
+C
+C                            'ME' - MERCATOR.
+C
+C                            'MO' - MOLLWEIDE.  THE PROJECTION USED IS
+C                                   NOT ACTUALLY A TRUE MOLLWEIDE.
+C
+C                        PLAT, PLON, AND ROTA ARE REALS SPECIFYING THE
+C                        VALUES OF ANGULAR QUANTITIES, IN DEGREES.  HOW
+C                        THEY ARE USED DEPENDS ON THE VALUE OF JPRJ, AS
+C                        FOLLOWS:
+C
+C                        IF JPRJ IS NOT EQUAL TO 'LC':  PLAT AND PLON
+C                        DEFINE THE LATITUDE AND LONGITUDE OF THE POLE
+C                        OF THE PROJECTION - THE POINT ON THE GLOBE
+C                        WHICH IS TO BE PROJECTED TO THE ORIGIN OF THE
+C                        U/V PLANE.  PLAT MUST BE BETWEEN -90. AND +90.,
+C                        INCLUSIVE, POSITIVE IN THE NORTHERN HEMISPHERE,
+C                        NEGATIVE IN THE SOUTHERN.  PLON MUST BE BETWEEN
+C                        -180. AND +180., INCLUSIVE, POSITIVE TO THE
+C                        EAST, AND NEGATIVE TO THE WEST, OF GREENWICH.
+C                        ROTA IS THE ANGLE BETWEEN THE V AXIS AND NORTH
+C                        AT THE ORIGIN.  IT IS TAKEN TO BE POSITIVE IF
+C                        THE ANGULAR MOVEMENT FROM NORTH TO THE V AXIS
+C                        IS COUNTER-CLOCKWISE, NEGATIVE OTHERWISE.  IF
+C                        THE ORIGIN IS AT THE NORTH POLE, "NORTH" IS
+C                        CONSIDERED TO BE IN THE DIRECTION OF PLON+180.
+C                        IF THE ORIGIN IS AT THE SOUTH POLE, "NORTH" IS
+C                        CONSIDERED TO BE IN THE DIRECTION OF PLON.
+C                        FOR THE CYLINDRICAL PROJECTIONS, THE AXIS OF
+C                        THE PROJECTION IS PARALLEL TO THE V AXIS.
+C
+C                        IF JPRJ IS EQUAL TO 'LC' (LAMBERT CONFORMAL
+C                        CONIC WITH TWO STANDARD PARALLELS):  PLON
+C                        DEFINES THE CENTRAL MERIDIAN OF THE PROJECTION,
+C                        WHILE PLAT AND ROTA DEFINE THE TWO STANDARD
+C                        PARALLELS.  IF PLAT AND ROTA ARE EQUAL, A
+C                        CONIC PROJECTION WITH ONE STANDARD PARALLEL
+C                        IS USED.
+C
+C                        MORE DETAILED DESCRIPTIONS OF THE PROJECTIONS
+C                        MAY BE FOUND IN THE GRAPHICS MANUAL, TOGETHER
+C                        WITH HELPFUL DIAGRAMS, BUT A FEW WORDS MAY BE
+C                        HELPFUL HERE:
+C
+C                        THE CONICAL PROJECTION MAPS THE SURFACE OF THE
+C                        EARTH ONTO THE SURFACE OF A CONE INTERSECTING
+C                        THE EARTH ALONG THE TWO STANDARD PARALLELS.
+C                        THE CONE IS THEN SLIT ALONG A LINE OPPOSITE
+C                        THE CENTRAL MERIDIAN AND OPENED UP (WITH SOME
+C                        STRETCHING) ONTO A FLAT SURFACE.
+C
+C                        THE AZIMUTHAL PROJECTIONS MAP THE SURFACE OF
+C                        THE EARTH (OR OF ONE HEMISPHERE OF THE EARTH)
+C                        ONTO A PLANE WHOSE ORIGIN IS TANGENT TO IT AT
+C                        THE POINT (PLAT,PLON).  THE SEVERAL AZIMUTHAL
+C                        PROJECTIONS DIFFER ONLY IN THE FUNCTION USED
+C                        TO MAP THE GREAT-CIRCLE DISTANCE OF A POINT
+C                        FROM THE POLE (PLAT,PLON) TO A LINEAR DISTANCE
+C                        OF THE PROJECTED POINT FROM THE ORIGIN (0,0).
+C                        THE PROJECTED IMAGE MAY BE ROTATED USING THE
+C                        PARAMETER ROTA.
+C
+C                        THE CYLINDRICAL PROJECTIONS MAP THE SURFACE OF
+C                        THE EARTH ONTO A CYLINDER WHICH IS TANGENT TO
+C                        IT ALONG A GREAT CIRCLE PASSING THROUGH THE
+C                        POINT (PLAT,PLON) AT AN ANGLE DETERMINED BY
+C                        ROTA.  THE CYLINDER IS THEN SLIT ALONG ITS
+C                        LENGTH THROUGH THE POINT OPPOSITE (PLAT,PLON)
+C                        AND OPENED UP ONTO THE PLANE.  THE SEVERAL
+C                        CYLINDRICAL PROJECTIONS DIFFER PRINCIPALLY IN
+C                        THE FUNCTION USED TO MAP THE DISTANCE FROM THE
+C                        GREAT CIRCLE OF TANGENCY TO A DISTANCE ALONG
+C                        THE CYLINDER.  IF PLAT IS ZERO AND ROTA IS
+C                        EITHER 0. OR 180., THE CYLINDRICAL PROJECTIONS
+C                        ARE PARTICULARLY SIMPLE TO DO AND A FASTER PATH
+C                        THROUGH THE CODE IS USED.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                RECALLS SET.  INTENDED TO BE USED WHEN DATA
+C                        IS TO BE PLOTTED OVER A MAP GENERATED IN A
+C                        DIFFERENT OVERLAY (E.G., USING A FLASH BUFFER),
+C                        AND WHEN THE SYSTEM PLOT PACKAGE DOES NOT
+C                        RESIDE IN AN OUTER OVERLAY.
+C
+C USAGE                  CALL MAPRS
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R S T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                RESTORES A SAVED STATE OF EZMAP.  THIS IS DONE
+C                        BY READING SAVED PARAMETER VALUES FROM A USER
+C                        UNIT AND THEN CALLING MAPINT.  SEE MAPSAV.
+C
+C USAGE                  CALL MAPRST (IFNO)
+C
+C ARGUMENTS              IFNO IS THE NUMBER OF A UNIT FROM WHICH A
+C                        SINGLE UNFORMATTED RECORD IS TO BE READ.  IT
+C                        IS THE USER'S RESPONSIBILITY TO POSITION THIS
+C                        UNIT.  MAPRST DOES NOT REWIND IT, EITHER BEFORE
+C                        OR AFTER READING THE RECORD.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S A V   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                SAVES THE CURRENT STATE OF EZMAP BY WRITING
+C                        PARAMETER VALUES ONTO A USER UNIT.  SEE MAPRST.
+C
+C USAGE                  CALL MAPSAV (IFNO)
+C
+C ARGUMENTS              IFNO IS THE NUMBER OF A UNIT TO WHICH A SINGLE
+C                        UNFORMATTED RECORD IS TO BE WRITTEN.  IT IS THE
+C                        USER'S RESPONSIBILITY TO POSITION THIS UNIT.
+C                        MAPSAV DOES NOT REWIND IT, EITHER BEFORE OR
+C                        AFTER WRITING THE RECORD.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S E T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE RECTANGULAR PORTION OF THE U/V
+C                        PLANE TO BE DRAWN.
+C
+C USAGE                  CALL MAPSET (JLTS,PLM1,PLM2,PLM3,PLM4)
+C
+C ARGUMENTS              JLTS CAN HAVE THE FOLLOWING CHARACTER VALUES.
+C                        IT SPECIFIES ONE OF FIVE WAYS IN WHICH THE
+C                        LIMITS OF THE MAP ARE DEFINED BY THE PARAMETERS
+C                        PLM1, PLM2, PLM3, AND PLM4.
+C
+C                        JLTS='MA' (MAXIMUM).  THE MAXIMUM USEFUL AREA
+C                        PRODUCED BY THE PROJECTION IS PLOTTED.  PLM1,
+C                        PLM2, PLM3, AND PLM4 ARE NOT USED.
+C
+C                        JLTS='CO' (CORNERS).  THE POINTS (PLM1,PLM2)
+C                        AND (PLM3,PLM4) ARE TO BE AT OPPOSITE CORNERS
+C                        OF THE MAP.  PLM1 AND PLM3 ARE LATITUDES, IN
+C                        DEGREES.  PLM2 AND PLM4 ARE LONGITUDES, IN
+C                        DEGREES.  IF A CYLINDRICAL PROJECTION IS BEING
+C                        USED, THE FIRST POINT SHOULD BE ON THE LEFT
+C                        EDGE OF THE MAP AND THE SECOND POINT ON THE
+C                        RIGHT EDGE; OTHERWISE, THE ORDER MAKES NO
+C                        DIFFERENCE.
+C
+C                        JLTS='PO' (POINTS).  PLM1, PLM2, PLM3, AND PLM4
+C                        ARE TWO-ELEMENT ARRAYS GIVING THE LATITUDES
+C                        AND LONGITUDES, IN DEGREES, OF FOUR POINTS
+C                        WHICH ARE TO BE ON THE EDGES OF THE RECTANGULAR
+C                        MAP.  IF A CYLINDRICAL PROJECTION IS BEING
+C                        USED, THE FIRST POINT SHOULD BE ON THE LEFT
+C                        EDGE AND THE SECOND POINT ON THE RIGHT EDGE;
+C                        OTHERWISE, THE ORDER MAKES NO DIFFERENCE.
+C                        NOTE THAT THE CALLING PROGRAM SHOULD INCLUDE
+C                        THE FOLLOWING STATEMENT:
+C
+C                          DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2)
+C
+C                        (IN FACT, STRICT ADHERENCE TO THE FORTRAN-77
+C                        STANDARD REQUIRES THIS, NO MATTER WHAT THE
+C                        VALUE OF JLTS.)
+C
+C                        JLTS='AN' (ANGLES).  PLM1, PLM2, PLM3, AND PLM4
+C                        ARE POSITIVE ANGLES, IN DEGREES, REPRESENTING
+C                        ANGULAR DISTANCES FROM A POINT ON THE MAP TO
+C                        THE LEFT, RIGHT, BOTTOM, AND TOP EDGES OF THE
+C                        MAP.  FOR MOST PROJECTIONS, THESE ANGLES ARE
+C                        MEASURED WITH THE CENTER OF THE EARTH AT THE
+C                        VERTEX AND REPRESENT ANGULAR DISTANCES FROM THE
+C                        POINT WHICH PROJECTS TO THE ORIGIN OF THE U/V
+C                        PLANE; ON A SATELLITE-VIEW PROJECTION, THEY ARE
+C                        MEASURED WITH THE SATELLITE AT THE VERTEX AND
+C                        REPRESENT ANGULAR DEVIATIONS FROM THE LINE OF
+C                        SIGHT.  ANGULAR LIMITS ARE PARTICULARLY USEFUL
+C                        FOR POLAR PROJECTIONS AND THE SATELLITE-VIEW
+C                        PROJECTION; THEY ARE NOT APPROPRIATE FOR THE
+C                        LAMBERT CONFORMAL CONIC AND AN ERROR WILL
+C                        RESULT IF ONE ATTEMPTS TO USE JLTS='AN' WITH
+C                        JPRJ='LC'.
+C
+C                        JLTS='LI' (LIMITS).  PLM1, PLM2, PLM3, AND PLM4
+C                        SPECIFY THE MINIMUM VALUE OF U, THE MAXIMUM
+C                        VALUE OF U, THE MINIMUM VALUE OF V, AND THE
+C                        MAXIMUM VALUE OF V, RESPECTIVELY.  KNOWLEDGE
+C                        OF THE PROJECTION EQUATIONS IS NECESSARY IN
+C                        ORDER TO USE THIS OPTION CORRECTLY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S T X   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SET THE VALUES OF EZMAP PARAMETERS.
+C
+C USAGE                  CALL MAPSTC (WHCH,CVAL)
+C                        CALL MAPSTI (WHCH,IVAL)
+C                        CALL MAPSTL (WHCH,LVAL)
+C                        CALL MAPSTR (WHCH,RVAL)
+C
+C ARGUMENTS              WHCH IS A CHARACTER STRING SPECIFYING THE
+C                        PARAMETER TO BE SET.
+C
+C                        CVAL, IVAL, LVAL, OR RVAL IS THE VALUE TO BE
+C                        GIVEN TO THE PARAMETER SPECIFIED BY WHCH - OF
+C                        TYPE CHARACTER, INTEGER, LOGICAL, OR REAL,
+C                        RESPECTIVELY.
+C
+C                        SOME PARAMETERS MAY BE SET IN MORE THAN ONE
+C                        WAY.  FOR EXAMPLE, THE PARAMETER 'GR' (GRID),
+C                        WHICH SPECIFIES THE GRID SPACING, MAY BE GIVEN
+C                        THE VALUE 10.0 IN EITHER OF TWO WAYS:
+C
+C                          CALL MAPSTI ('GR',10)
+C                          CALL MAPSTR ('GR',10.)
+C
+C                        THE FLAG WHICH CONTROLS DOTTING OF OUTLINES
+C                        MAY BE TURNED ON USING EITHER OF THESE CALLS:
+C
+C                          CALL MAPSTI ('DO',1)
+C                          CALL MAPSTL ('DO',.TRUE.)
+C
+C                        THE IMPORTANT POINT TO REMEMBER IS THAT THE
+C                        LAST CHARACTER OF THE ROUTINE NAME IMPLIES
+C                        THE TYPE OF THE ARGUMENT.
+C
+C                        ONLY THE FIRST TWO CHARACTERS OF WHCH ARE
+C                        EXAMINED.  FOR THE SAKE OF CODE READABILITY,
+C                        A LONGER CHARACTER STRING MAY BE USED.
+C
+C                        BELOW IS A LIST OF ALL THE PARAMETERS WHICH
+C                        MAY BE SET USING THESE ROUTINES.
+C
+C                        WHCH       TYPE  MEANING
+C                        ----       ----  -------
+C
+C                        DASHPATTERN   I  DASHED-LINE PATTERN FOR THE
+C                                         GRIDS.  A 16-BIT QUANTITY.
+C                                         DEFAULT IS 21845 (OCTAL 52525
+C                                         OR BINARY 0101010101010101).
+C
+C                        DD          I,R  DISTANCE BETWEEN DOTS ALONG A
+C                                         DOTTED LINE DRAWN BY MAPIT.
+C                                         THE DEFAULT VALUE IS 12 (OUT
+C                                         OF 4096; SEE 'RE', BELOW).
+C
+C                        DL          I,L  IF TRUE (NON-ZERO), USER CALLS
+C                                         TO MAPIT DRAW DOTTED LINES.
+C                                         DEFAULT IS FALSE (ZERO); LINES
+C                                         DRAWN BY MAPIT ARE SOLID OR
+C                                         DASHED, DEPENDING ON THE
+C                                         CURRENT STATE OF THE DASHCHAR
+C                                         PACKAGE.
+C
+C                        DOT         I,L  IF TRUE (NON-ZERO), OUTLINES
+C                                         ARE DOTTED.  DEFAULT IS FALSE
+C                                         (ZERO); OUTLINES ARE SOLID.
+C
+C                        ELLIPTICAL  I,L  IF TRUE (NON-ZERO), ONLY THAT
+C                                         PART OF THE MAP WHICH FALLS
+C                                         INSIDE AN ELLIPSE INSCRIBED
+C                                         WITHIN THE NORMAL RECTANGULAR
+C                                         PERIMETER IS DRAWN.  THIS IS
+C                                         PARTICULARLY APPROPRIATE FOR
+C                                         USE WITH AZIMUTHAL PROJECTIONS
+C                                         AND ANGULAR LIMITS SPECIFYING
+C                                         A SQUARE, IN WHICH CASE THE
+C                                         ELLIPSE BECOMES A CIRCLE, BUT
+C                                         IT WILL WORK FOR ANY MAP.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        GD            R  THE DISTANCE BETWEEN POINTS
+C                                         USED TO DRAW THE GRID, IN
+C                                         DEGREES.  THE DEFAULT VALUE
+C                                         IS 1.; USER VALUES MUST FALL
+C                                         BETWEEN .001 AND 10.
+C
+C                        GRID        I,R  THE DESIRED GRID SPACING.  A
+C                                         ZERO SUPPRESSES THE GRID.  THE
+C                                         DEFAULT IS 10 DEGREES.
+C
+C                        IN            I  "N" IS AN INTEGER BETWEEN 1
+C                                         AND 7.  EACH "IN" SPECIFIES
+C                                         THE INTENSITY OF SOME PORTION
+C                                         OF THE MAP.  VALUES ARE IN THE
+C                                         RANGE 0-255.  DEFAULTS ARE:
+C
+C                                           N   USE           DEFAULT
+C                                           -   -----------   -------
+C                                           1   PERIMETER        240
+C                                           2   GRID             150
+C                                           3   LABELS           210
+C                                           4   LIMBS            240
+C                                           5   CONTINENTS       240
+C                                           6   U.S. STATES      180
+C                                           7   COUNTRIES        210
+C
+C                        LABEL       I,L  IF TRUE (NON-ZERO), LABEL THE
+C                                         MERIDIANS AND POLES.  DEFAULT
+C                                         IS TRUE (NON-ZERO).
+C
+C                        LS            I  CONTROLS LABEL SIZE.  A
+C                                         CHARACTER WIDTH, TO BE USED
+C                                         IN CALLING PWRIT.  THE DEFAULT
+C                                         VALUE IS 1, WHICH GIVES A
+C                                         CHARACTER WIDTH OF 12 PLOTTER
+C                                         UNITS.
+C
+C                        MV          I,R  MINIMUM VECTOR LENGTH FOR
+C                                         OUTLINES.  A POINT CLOSER TO
+C                                         THE PREVIOUS POINT THAN THIS
+C                                         IS OMITTED.  DEFAULT VALUE IS
+C                                         4 (OUT OF 4096; SEE 'RE',
+C                                         BELOW).
+C
+C                        OUTLINE       C  SAYS WHICH SET OF OUTLINE DATA
+C                                         TO USE.  POSSIBLE VALUES ARE
+C                                         'NO', FOR NO OUTLINES, 'CO',
+C                                         FOR THE CONTINENTAL OUTLINES
+C                                         (THE DEFAULT), 'US', FOR U.S.
+C                                         STATE OUTLINES, 'PS', FOR
+C                                         CONTINENTAL OUTLINES PLUS
+C                                         INTERNATIONAL OUTLINES PLUS
+C                                         U.S. STATE OUTLINES, AND 'PO',
+C                                         FOR CONTINENTAL OUTLINES PLUS
+C                                         INTERNATIONAL OUTLINES.
+C                                         DEFAULT IS 'CO'.
+C
+C                        PERIM       I,L  IF TRUE (NON-ZERO), DRAW THE
+C                                         PERIMETER.  DEFAULT IS TRUE
+C                                         (NON-ZERO).
+C
+C                        RESOLUTION  I,R  THE WIDTH OF THE TARGET
+C                                         PLOTTER, IN PLOTTER UNITS.
+C                                         DEFAULT VALUE IS 4096.
+C
+C                        SATELLITE   I,R  IF LESS THAN -1 OR GREATER
+C                                         THAN 1, CHANGES ORTHOGRAPHIC
+C                                         PROJECTION TO SATELLITE-VIEW.
+C                                         ABSOLUTE VALUE IS THE DISTANCE
+C                                         OF SATELLITE FROM THE CENTER
+C                                         OF THE EARTH, IN MULTIPLES OF
+C                                         THE EARTH'S RADIUS.  THE SIGN
+C                                         INDICATES WHETHER A NORMAL
+C                                         PROJECTION (POSITIVE) OR AN
+C                                         EXTENDED PROJECTION (NEGATIVE)
+C                                         IS TO BE USED.  THE EXTENDED
+C                                         PROJECTION IS USEFUL WHEN ONE
+C                                         IS OVERLAYING CONREC OUTPUT ON
+C                                         A MAP.  THE DEFAULT VALUE OF
+C                                         'SA' IS ZERO.  SEE ALSO 'S1'
+C                                         AND 'S2', BELOW.
+C
+C                        S1 AND S2   I,R  USED ONLY WHEN 'SA' IS OUTSIDE
+C                                         [-1,1].  BOTH ARE ANGLES, IN
+C                                         DEGREES.  'S1' MEASURES THE
+C                                         ANGLE BETWEEN THE CENTER OF
+C                                         THE EARTH AND THE AIM POINT
+C                                         OF THE SATELLITE'S CAMERA, AS
+C                                         SEEN FROM THE SATELLITE.  IF
+C                                         'S1' IS ZERO, THE PROJECTION
+C                                         SHOWS THE EARTH AS SEEN BY A
+C                                         SATELLITE LOOKING STRAIGHT
+C                                         DOWN; CALL THIS THE "BASIC
+C                                         VIEW".  IF 'S1' IS NON-ZERO,
+C                                         'S2' MEASURES THE ANGLE FROM
+C                                         THE POSITIVE U AXIS OF THE
+C                                         BASIC VIEW TO THE LINE OP,
+C                                         WHERE O IS THE ORIGIN OF THE
+C                                         BASIC VIEW AND P IS THE
+C                                         PROJECTION OF THE DESIRED LINE
+C                                         OF SIGHT ON THE BASIC VIEW,
+C                                         POSITIVE IF MEASURED COUNTER-
+C                                         CLOCKWISE.
+C
+C                        SR            R  A SEARCH RADIUS, IN DEGREES.
+C                                         USED BY MAPINT IN FINDING THE
+C                                         LATITUDE/LONGITUDE RANGE OF
+C                                         THE MAP.  THE DEFAULT VALUE
+C                                         IS 1.; USER VALUES MUST FALL
+C                                         BETWEEN .001 AND 10.  THIS
+C                                         PARAMETER SHOULD PROBABLY NOT
+C                                         BE CHANGED EXCEPT BY ADVICE
+C                                         OF A KNOWLEDGEABLE CONSULTANT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P T R N   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FIND THE PROJECTION IN THE U/V PLANE OF A
+C                        POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN.
+C                        MAY BE CALLED AT ANY TIME AFTER EZMAP HAS BEEN
+C                        INITIALIZED (BY CALLING MAPINT OR OTHERWISE).
+C
+C USAGE                  CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+C
+C ARGUMENTS              RLAT AND RLON ARE THE LATITUDE AND LONGITUDE,
+C                        RESPECTIVELY, OF A POINT ON THE GLOBE.  RLAT
+C                        MUST BE BETWEEN -90. AND +90., INCLUSIVE; RLON
+C                        MUST BE BETWEEN -540. AND +540., INCLUSIVE.
+C
+C                        (UVAL,VVAL) IS THE PROJECTION IN THE U/V PLANE
+C                        OF (RLAT,RLON).  THE UNITS OF UVAL AND VVAL
+C                        DEPEND ON THE PROJECTION.
+C
+C                        IF THE POINT IS NOT PROJECTABLE, UVAL IS
+C                        RETURNED EQUAL TO 1.E12.  NOTE THAT, IF
+C                        THE POINT IS PROJECTABLE, BUT OUTSIDE THE
+C                        BOUNDARY OF THE MAP, AS DEFINED BY THE LAST
+C                        CALL TO MAPSET, ITS U AND V COORDINATES ARE
+C                        STILL RETURNED BY MAPTRN.  THE USER MUST DO
+C                        THE TEST REQUIRED TO DETERMINE IF THE POINT
+C                        IS WITHIN LIMITS, IF THAT IS NECESSARY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P U S R   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                THE ROUTINE MAPUSR IS CALLED BY EZMAP JUST
+C                        BEFORE AND JUST AFTER PORTIONS OF THE MAP
+C                        ARE DRAWN.  THE DEFAULT VERSION DOES NOTHING.
+C                        (ACTUALLY, THAT'S NOT QUITE TRUE; FOR THE SAKE
+C                        OF EFFICIENCY, THE NON-GKS VERSIONS RESETS THE
+C                        DASH PATTERN FOR GRID LINES TO "SOLID" AND
+C                        THEN DOES AN OPTN CALL TO MAKE THE TRANSLATOR
+C                        GENERATE THE DESIRED PATTERN.)  A USER-SUPPLIED
+C                        VERSION MAY SET/RESET THE DOTTING PARAMETER
+C                        'DL', THE DASHCHAR DASH PATTERN, THE INTENSITY,
+C                        THE COLOR, ETC., SO AS TO ACHIEVE A DESIRED
+C                        EFFECT.
+C
+C USAGE (BY EZMAP)       CALL MAPUSR (IPRT)
+C
+C ARGUMENTS              IPRT, IF POSITIVE, SAYS THAT A PARTICULAR PART
+C                        OF THE MAP IS ABOUT TO BE DRAWN, AS FOLLOWS:
+C
+C                          IPRT  PART
+C                          ----  -----------------------
+C                            1   PERIMETER.
+C                            2   GRID.
+C                            3   LABELS.
+C                            4   LIMB LINES.
+C                            5   CONTINENTAL OUTLINES.
+C                            6   U.S. STATE OUTLINES.
+C                            7   INTERNATIONAL OUTLINES.
+C
+C                        IF IPRT IS NEGATIVE, IT SAYS THAT DRAWING OF
+C                        THE LAST PART IS COMPLETE.  THE ABSOLUTE VALUE
+C                        OF IPRT WILL BE ONE OF THE ABOVE VALUES.
+C                        CHANGED QUANTITIES SHOULD BE RESTORED.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P V E C   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO
+C                        MAPDRW - USED IN CONJUNCTION WITH MAPFST.
+C
+C USAGE                  CALL MAPVEC (RLAT,RLON)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPIT (RLAT,RLON,1)
+C
+C ARGUMENTS              RLAT AND RLON ARE DEFINED AS FOR MAPIT.  SEE
+C                        THE DESCRIPTION OF MAPIT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   S U P C O N   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FIND THE PROJECTION IN THE U/V PLANE OF A
+C                        POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN.
+C                        THIS ROUTINE IS PROVIDED FOR COMPATIBILITY
+C                        WITH EARLIER VERSIONS OF THE PACKAGE.  IF
+C                        EFFICIENCY IS A CONSIDERATION, THE USER SHOULD
+C                        BY-PASS THIS ROUTINE AND CALL MAPTRN DIRECTLY.
+C
+C USAGE                  CALL SUPCON (RLAT,RLON,UVAL,VVAL)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+C
+C ARGUMENTS              RLAT, RLON, UVAL, AND VVAL ARE DEFINED AS FOR
+C                        THE ROUTINE MAPTRN.  SEE THE DESCRIPTION OF
+C                        MAPTRN.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   S U P M A P   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                AN IMPLEMENTATION OF THE ROUTINE FROM WHICH
+C                        EZMAP GREW.  A SINGLE CALL TO SUPMAP CREATES
+C                        A MAP OF A DESIRED PORTION OF THE GLOBE,
+C                        ACCORDING TO A DESIRED PROJECTION, WITH DESIRED
+C                        OUTLINES DRAWN IN, AND WITH LINES OF LATITUDE
+C                        AND LONGITUDE AT DESIRED INTERVALS.  AN
+C                        APPROPRIATE CALL TO THE ROUTINE SET IS
+C                        PERFORMED, AND THE ROUTINE SUPCON (WHICH SEE)
+C                        IS INITIALIZED SO THAT THE USER MAY MAP POINTS
+C                        OF KNOWN LATITUDE AND LONGITUDE TO POINTS IN
+C                        THE U/V PLANE AND USE THE U/V COORDINATES TO
+C                        DRAW OBJECTS ON THE MAP PRODUCED BY SUPMAP.
+C
+C USAGE                  CALL SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2,
+C                                     PLM3,PLM4,JLTS,JGRD,IOUT,IDOT,
+C                                     IERR)
+C
+C ARGUMENTS              IABS(JPRJ) DEFINES THE PROJECTION TYPE, AS
+C                        FOLLOWS (VALUES LESS THAN 1 OR GREATER THAN
+C                        10 ARE TREATED AS 1 OR 10, RESPECTIVELY):
+C
+C                           1  STEREOGRAPHIC.
+C                           2  ORTHOGRAPHIC.
+C                           3  LAMBERT CONFORMAL CONIC.
+C                           4  LAMBERT EQUAL AREA.
+C                           5  GNOMONIC.
+C                           6  AZIMUTHAL EQUIDISTANT.
+C                           7  SATELLITE VIEW.
+C                           8  CYLINDRICAL EQUIDISTANT.
+C                           9  MERCATOR.
+C                          10  MOLLWEIDE.
+C
+C                        USING THE VALUE 2 CAUSES THE PARAMETER 'SA' TO
+C                        BE ZEROED.  USING THE VALUE 7 CAUSES 'SA' TO
+C                        BE EXAMINED.  IF IT HAS A NON-ZERO VALUE, THE
+C                        VALUE IS LEFT ALONE.  IF IT HAS A ZERO VALUE,
+C                        ITS VALUE IS RESET TO 6.631, WHICH IS ABOUT
+C                        RIGHT FOR A SATELLITE IN A GEOSYNCHRONOUS
+C                        EQUATORIAL ORBIT (FOR WHATEVER THAT'S WORTH).
+C
+C                        THE SIGN OF JPRJ, WHEN IOUT IS -1, 0, OR 1,
+C                        INDICATES WHETHER THE CONTINENTAL OUTLINES ARE
+C                        TO BE PLOTTED OR NOT.  SEE IOUT, BELOW.
+C
+C                        PLAT, PLON, AND ROTA DEFINE THE ORIGIN OF THE
+C                        PROJECTION AND ITS ROTATION ANGLE AND ARE USED
+C                        IN THE SAME WAY AS THEY WOULD BE IN A CALL TO
+C                        THE ROUTINE MAPROJ (WHICH SEE).
+C
+C                        JLTS, PLM1, PLM2, PLM3, AND PLM4 SPECIFY THE
+C                        RECTANGULAR LIMITS OF THE MAP.  THESE ARGUMENTS
+C                        ARE USED IN THE SAME WAY AS THEY WOULD BE IN
+C                        A CALL TO MAPSET (WHICH SEE), EXCEPT THAT JLTS
+C                        IS AN INTEGER INSTEAD OF A CHARACTER STRING.
+C                        IABS(JLTS) MAY TAKE ON THE VALUES 1 THROUGH 5,
+C                        AS FOLLOWS:
+C
+C                          1  LIKE JLTS='MA' IN A CALL TO MAPSET.
+C                          2  LIKE JLTS='CO' IN A CALL TO MAPSET.
+C                          3  LIKE JLTS='LI' IN A CALL TO MAPSET.
+C                          4  LIKE JLTS='AN' IN A CALL TO MAPSET.
+C                          5  LIKE JLTS='PO' IN A CALL TO MAPSET.
+C
+C                        AT ONE TIME, THE SIGN OF JLTS SPECIFIED WHETHER
+C                        OR NOT A LINE OF TEXT WAS TO BE WRITTEN AT THE
+C                        BOTTOM OF THE PLOT PRODUCED.  THIS LINE MAY NO
+C                        LONGER BE WRITTEN AND THE SIGN OF JLTS IS
+C                        THEREFORE IGNORED.
+C
+C                        MOD(IABS(JGRD),1000) IS THE VALUE, IN DEGREES,
+C                        OF THE INTERVAL AT WHICH LINES OF LATITUDE AND
+C                        LONGITUDE ARE TO BE PLOTTED.  IF THE GIVEN
+C                        INTERVAL IS ZERO, GRID LINES AND LABELS ARE
+C                        NOT PLOTTED.  IF JGRD IS LESS THAN ZERO, THE
+C                        PERIMETER IS NOT PLOTTED.  SET JGRD TO -1000 TO
+C                        SUPPRESS BOTH GRID LINES AND PERIMETER AND TO
+C                        +1000 TO SUPPRESS THE GRID LINES, BUT LEAVE THE
+C                        PERIMETER.  THE VALUE -0 MAY HAVE A MEANING ON
+C                        ONES' COMPLEMENT MACHINES, BUT SHOULD BE
+C                        AVOIDED; USE -1000 INSTEAD.
+C
+C                        IF IOUT HAS THE VALUE 0, U.S. STATE OUTLINES
+C                        ARE OMITTED.  IF IT HAS THE ABSOLUTE VALUE 1,
+C                        THEY ARE PLOTTED.  IN BOTH OF THESE CASES, THE
+C                        SIGN OF JPRJ INDICATES WHETHER CONTINENTAL
+C                        OUTLINES ARE TO BE PLOTTED (JPRJ POSITIVE)
+C                        OR NOT (JPRJ NEGATIVE).  ORIGINALLY, SUPMAP
+C                        RECOGNIZED ONLY THESE VALUES OF IOUT; NOW, IF
+C                        IOUT IS LESS THAN -1 OR GREATER THAN 1, THE
+C                        SIGN OF JPRJ IS IGNORED, AND IOUT SELECTS AN
+C                        OUTLINE GROUP, AS FOLLOWS:
+C
+C                          -2 OR LESS     'NO' (NO OUTLINES).
+C                           2             'CO' (CONTINENTAL OUTLINES).
+C                           3             'US' (U.S. STATE OUTLINES).
+C                           4             'PS' (CONTINENTAL OUTLINES
+C                                               PLUS INTERNATIONAL
+C                                               OUTLINES PLUS U.S.
+C                                               STATE OUTLINES).
+C                           5 OR GREATER  'PO' (CONTINENTAL OUTLINES
+C                                               PLUS INTERNATIONAL
+C                                               OUTLINES, BUT NO U.S.
+C                                               STATE OUTLINES).
+C
+C                        AT ONE TIME, THE SIGN OF IOUT SPECIFIED WHETHER
+C                        OR NOT A LINE OF TEXT WAS TO BE WRITTEN ON THE
+C                        PRINT OUTPUT.  THIS MAY NO LONGER BE DONE.
+C
+C                        IDOT=0 TO GET CONTINUOUS OUTLINES, 1 TO GET
+C                        DOTTED OUTLINES.
+C
+C                        IERR IS AN OUTPUT PARAMETER.  A NON-ZERO VALUE
+C                        INDICATES THAT AN ERROR HAS OCCURRED.
+C
+C***********************************************************************
+C T H E   C O D E   -   U S E R - L E V E L   R O U T I N E S
+C***********************************************************************
+C
+      SUBROUTINE MAPDRW
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPDRW','VERSION  1')
+C
+C INITIALIZE THE PACKAGE, DRAW AND LABEL THE GRID, AND DRAW OUTLINES.
+C
+      IF (INTF) CALL MAPINT
+      CALL MAPGRD
+      CALL MAPLBL
+      CALL MAPLOT
+C
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+      DIMENSION PNTS(*)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPFST (XLAT,XLON)
+      CALL MAPIT (XLAT,XLON,0)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGRD
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE LOCAL LOGICAL FLAGS.
+C
+      LOGICAL IMF,IPF
+C
+C DEFINE REQUIRED CONSTANTS.
+C
+      DATA DTOR / .017453292519943 /
+C
+C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY,
+C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND
+C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X.
+C
+      FLOOR(X)=AINT(X+1.E4)-1.E4
+      CLING(X)=-FLOOR(-X)
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGRD','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF THE GRID IS SUPPRESSED, DO NOTHING.
+C
+      IF (GRID.LE.0.) RETURN
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR THE GRID.
+C
+      CALL MAPCHI (2,0,IDSH)
+C
+C SET THE FLAGS IMF AND IPF, WHICH ARE TRUE IF AND ONLY IF MERIDIANS AND
+C PARALLELS, RESPECTIVELY, ARE STRAIGHT LINES AND IT IS "SAFE" TO DRAW
+C THEM USING LONG LINE SEGMENTS.  WHAT WE HAVE TO BE SURE OF IS THAT AT
+C LEAST ONE OF THE TWO ENDPOINTS OF EACH MERIDIAN, OR ITS MIDPOINT, WILL
+C BE VISIBLE.  (IF TWO POINTS ARE INVISIBLE, MAPIT DRAWS NOTHING, EVEN
+C THOUGH THE LINE JOINING THEM MAY BE VISIBLE ALONG PART OF ITS LENGTH.)
+C
+      IF (IPRJ.GE.1.AND.IPRJ.LE.6) THEN
+        IF (ELPF) THEN
+          IMF=(UCEN/URNG)**2+(VCEN/VRNG)**2.LT.1.
+        ELSE
+          IMF=UMIN*UMAX.LT.0..AND.VMIN*VMAX.LT.0.
+        END IF
+        IF (IPRJ.NE.1) IMF=IMF.AND.ABS(PHIA).GE.89.9999
+      ELSE IF (IPRJ.EQ.10) THEN
+        IMF=.TRUE.
+      ELSE IF (IPRJ.EQ.11.AND.(.75*(VMAX-VMIN)).LE.VEPS) THEN
+        IMF=.TRUE.
+      ELSE
+        IMF=.FALSE.
+      END IF
+C
+      IPF=IPRJ.EQ.10.OR.IPRJ.EQ.11.OR.(IPRJ.EQ.12.AND.ILTS.EQ.1)
+C
+C TRANSFER THE LATITUDE/LONGITUDE LIMITS COMPUTED BY MAPINT TO LOCAL,
+C MODIFIABLE VARIABLES.
+C
+      SLAT=SLAM
+      BLAT=BLAM
+      SLON=SLOM
+      BLON=BLOM
+C
+C FOR CERTAIN AZIMUTHAL PROJECTIONS CENTERED AT A POLE, THE LATITUDE
+C LIMIT FURTHEST FROM THE POLE NEEDS ADJUSTMENT TO MAKE IT PROJECTABLE
+C AND VISIBLE.  OTHERWISE, WE HAVE TROUBLE WITH PORTIONS OF MERIDIANS
+C DISAPPEARING.
+C
+      IF (IPRJ.EQ.3.OR.IPRJ.EQ.4.OR.IPRJ.EQ.6) THEN
+        IF (PHIA.GT.+89.9999) THEN
+          SLAT=SLAT+SRCH
+          IF (IPRJ.EQ.3) SLAT=SLAT+SRCH
+        END IF
+        IF (PHIA.LT.-89.9999) THEN
+          BLAT=BLAT-SRCH
+          IF (IPRJ.EQ.3) BLAT=BLAT-SRCH
+        END IF
+      END IF
+C
+C RLON IS THE SMALLEST LONGITUDE FOR WHICH A MERIDIAN IS TO BE DRAWN,
+C XLON THE BIGGEST.  AVOID DRAWING A GIVEN MERIDIAN TWICE.
+C
+      RLON=GRID*FLOOR(SLON/GRID)
+      XLON=GRID*CLING(BLON/GRID)
+      IF (XLON-RLON.GT.359.9999) THEN
+        IF (IPRJ.EQ.1) THEN
+          RLON=GRID*CLING((PHIO-179.9999)/GRID)
+          XLON=GRID*FLOOR((PHIO+179.9999)/GRID)
+        ELSE IF (IPRJ.GE.2.AND.IPRJ.LE.9) THEN
+          XLON=XLON-GRID
+          IF (XLON-RLON.GT.359.9999) XLON=XLON-GRID
+        END IF
+      END IF
+C
+C OLAT IS THE LATITUDE AT WHICH MERIDIANS WHICH ARE NOT MULTIPLES OF 90
+C ARE TO STOP.  (EXCEPT ON CERTAIN FAST-PATH CYLINDRICAL PROJECTIONS,
+C ONLY THE MERIDIANS AT LONGITUDES WHICH ARE MULTIPLES OF 90 RUN ALL
+C THE WAY TO THE POLES.  THIS AVOIDS A LOT OF CLUTTER.)
+C
+      IF (IPRJ.EQ.10.OR.IPRJ.EQ.11) THEN
+        OLAT=90.
+      ELSE
+        OLAT=GRID*FLOOR(89.9999/GRID)
+      END IF
+C
+C DRAW THE MERIDIANS.
+C
+      RLON=RLON-GRID
+  101 RLON=RLON+GRID
+      XLAT=OLAT
+      IF (AMOD(RLON,90.).EQ.0.) XLAT=90.
+      RLAT=AMAX1(SLAT,-XLAT)
+      XLAT=AMIN1(BLAT,XLAT)
+      IF (IMF) THEN
+        DLAT=.5*(XLAT-RLAT)
+      ELSE
+        DLAT=(XLAT-RLAT)/CLING((XLAT-RLAT)/GRDR)
+      END IF
+      CALL MAPIT (RLAT,RLON,0)
+  102 RLAT=RLAT+DLAT
+      CALL MAPIT (RLAT,RLON,1)
+      IF (RLAT.LT.XLAT-.9999) GO TO 102
+      IF (RLON.LT.XLON-.9999) GO TO 101
+C
+C ROUND THE LATITUDE LIMITS TO APPROPRIATE MULTIPLES OF GRID.
+C
+      SLAT=GRID*FLOOR(SLAT/GRID)
+      IF (SLAT.LE.-90.) SLAT=SLAT+GRID
+      BLAT=GRID*CLING(BLAT/GRID)
+      IF (BLAT.GE.90.) BLAT=BLAT-GRID
+C
+C IF A FAST-PATH CYLINDRICAL EQUIDISTANT PROJECTION IS IN USE AND EITHER
+C OR BOTH OF THE POLES IS WITHIN THE (RECTANGULAR) PERIMETER, ARRANGE
+C FOR THE PARALLELS AT -90 AND/OR +90 TO BE DRAWN.
+C
+      IF (IPRJ.EQ.10) THEN
+        CALL MAPTRN (-90.,PHIO,U,V)
+        IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
+     +                                                    SLAT=SLAT-GRID
+        CALL MAPTRN (90.,PHIO,U,V)
+        IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
+     +                                                    BLAT=BLAT+GRID
+      END IF
+C
+C DRAW THE PARALLELS.
+C
+      XLAT=SLAT-GRID
+  103 XLAT=XLAT+GRID
+      RLAT=AMAX1(-90.,AMIN1(90.,XLAT))
+      RLON=FLOOR(SLON)
+      XLON=AMIN1(CLING(BLON),RLON+360.)
+      IF (IPF) THEN
+        DLON=.5*(XLON-RLON)
+      ELSE
+        DLON=(XLON-RLON)/CLING((XLON-RLON)/GRDR)
+      END IF
+      CALL MAPIT (RLAT,RLON,0)
+  104 RLON=RLON+DLON
+      CALL MAPIT (RLAT,RLON,1)
+      IF (RLON.LT.XLON-.9999) GO TO 104
+      IF (XLAT.LT.BLAT-.9999) GO TO 103
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+      CALL MAPCHI (-2,0,0)
+C
+C DRAW THE LIMB LINES.
+C
+      CALL MAPLMB
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTC (WHCH,CVAL)
+C
+      CHARACTER*(*) WHCH,CVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTC','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'AR') THEN
+        CVAL=LDCT(ILTS)
+      ELSE IF (WHCH(1:2).EQ.'OU') THEN
+        CVAL=DDCT(NOUT+1)
+      ELSE IF (WHCH(1:2).EQ.'PR') THEN
+        CVAL=PDCT(JPRJ)
+        IF (JPRJ.EQ.3.AND.ABS(SALT).GT.1.) CVAL=PDCT(10)
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=1
+      CALL MAPCEM (' MAPGTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      CVAL=' '
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTI (WHCH,IVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTI','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DA') THEN
+        IVAL=IDSH
+      ELSE IF (WHCH(1:2).EQ.'DD') THEN
+        IVAL=DDTS
+      ELSE IF (WHCH(1:2).EQ.'DL') THEN
+        IVAL=IDTL
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IVAL=IDOT
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        IVAL=0
+        IF (ELPF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'ER') THEN
+        IVAL=IIER
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        IVAL=GRID
+      ELSE IF (WHCH(1:2).EQ.'IN') THEN
+        IVAL=0
+        IF (INTF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'I1') THEN
+        IVAL=INTS(1)
+      ELSE IF (WHCH(1:2).EQ.'I2') THEN
+        IVAL=INTS(2)
+      ELSE IF (WHCH(1:2).EQ.'I3') THEN
+        IVAL=INTS(3)
+      ELSE IF (WHCH(1:2).EQ.'I4') THEN
+        IVAL=INTS(4)
+      ELSE IF (WHCH(1:2).EQ.'I5') THEN
+        IVAL=INTS(5)
+      ELSE IF (WHCH(1:2).EQ.'I6') THEN
+        IVAL=INTS(6)
+      ELSE IF (WHCH(1:2).EQ.'I7') THEN
+        IVAL=INTS(7)
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        IVAL=0
+        IF (LBLF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'LS') THEN
+        IVAL=ILCW
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        IVAL=DPLT
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        IVAL=0
+        IF (PRMF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'PN') THEN
+        IVAL=PHIO
+      ELSE IF (WHCH(1:2).EQ.'PT') THEN
+        IVAL=PHIA
+      ELSE IF (WHCH(1:2).EQ.'P1') THEN
+        IVAL=PLA1
+      ELSE IF (WHCH(1:2).EQ.'P2') THEN
+        IVAL=PLA2
+      ELSE IF (WHCH(1:2).EQ.'P3') THEN
+        IVAL=PLA3
+      ELSE IF (WHCH(1:2).EQ.'P4') THEN
+        IVAL=PLA4
+      ELSE IF (WHCH(1:2).EQ.'P5') THEN
+        IVAL=PLB1
+      ELSE IF (WHCH(1:2).EQ.'P6') THEN
+        IVAL=PLB2
+      ELSE IF (WHCH(1:2).EQ.'P7') THEN
+        IVAL=PLB3
+      ELSE IF (WHCH(1:2).EQ.'P8') THEN
+        IVAL=PLB4
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        IVAL=PLTR
+      ELSE IF (WHCH(1:2).EQ.'RO') THEN
+        IVAL=ROTA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        IVAL=SALT
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        IVAL=ALFA
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        IVAL=BETA
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=2
+      CALL MAPCEM (' MAPGTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      IVAL=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTL (WHCH,LVAL)
+C
+      CHARACTER*(*) WHCH
+      LOGICAL LVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTL','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DL') THEN
+        LVAL=IDTL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        LVAL=IDOT.NE.0
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        LVAL=ELPF
+      ELSE IF (WHCH(1:2).EQ.'IN') THEN
+        LVAL=INTF
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LVAL=LBLF
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        LVAL=PRMF
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=3
+      CALL MAPCEM (' MAPGTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      LVAL=.FALSE.
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTR (WHCH,RVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTR','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DD') THEN
+        RVAL=DDTS
+      ELSE IF (WHCH(1:2).EQ.'GD') THEN
+        RVAL=GRDR
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        RVAL=GRID
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        RVAL=DPLT
+      ELSE IF (WHCH(1:2).EQ.'PN') THEN
+        RVAL=PHIO
+      ELSE IF (WHCH(1:2).EQ.'PT') THEN
+        RVAL=PHIA
+      ELSE IF (WHCH(1:2).EQ.'P1') THEN
+        RVAL=PLA1
+      ELSE IF (WHCH(1:2).EQ.'P2') THEN
+        RVAL=PLA2
+      ELSE IF (WHCH(1:2).EQ.'P3') THEN
+        RVAL=PLA3
+      ELSE IF (WHCH(1:2).EQ.'P4') THEN
+        RVAL=PLA4
+      ELSE IF (WHCH(1:2).EQ.'P5') THEN
+        RVAL=PLB1
+      ELSE IF (WHCH(1:2).EQ.'P6') THEN
+        RVAL=PLB2
+      ELSE IF (WHCH(1:2).EQ.'P7') THEN
+        RVAL=PLB3
+      ELSE IF (WHCH(1:2).EQ.'P8') THEN
+        RVAL=PLB4
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        RVAL=PLTR
+      ELSE IF (WHCH(1:2).EQ.'RO') THEN
+        RVAL=ROTA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        RVAL=SALT
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        RVAL=ALFA
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        RVAL=BETA
+      ELSE IF (WHCH(1:2).EQ.'SR') THEN
+        RVAL=SRCH
+      ELSE IF (WHCH(1:2).EQ.'XL') THEN
+        RVAL=XLOW
+      ELSE IF (WHCH(1:2).EQ.'XR') THEN
+        RVAL=XROW
+      ELSE IF (WHCH(1:2).EQ.'YB') THEN
+        RVAL=YBOW
+      ELSE IF (WHCH(1:2).EQ.'YT') THEN
+        RVAL=YTOW
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=4
+      CALL MAPCEM (' MAPGTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RVAL=0.
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPINT
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C SET UP ALTERNATE NAMES FOR SOME OF THE VARIABLES IN COMMON.
+C
+      EQUIVALENCE     (PHIA,FLT1),(ROTA,FLT2)
+C
+      EQUIVALENCE     (PLA1,AUMN),(PLA2,AUMX),
+     +                (PLA3,AVMN),(PLA4,AVMX)
+C
+C ENSURE THAT THE BLOCK DATA ROUTINE WILL LOAD, SO THAT VARIABLES WILL
+C HAVE THE PROPER DEFAULT VALUES.
+C
+      EXTERNAL MAPBD
+C
+C DEFINE THE NECESSARY CONSTANTS.
+C
+      DATA RESL / 10. /
+      DATA DTOR / .017453292519943 /
+      DATA OV90 / .011111111111111 /
+      DATA PI   / 3.14159265358979 /
+      DATA RTOD / 57.2957795130823 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPINT','VERSION  1')
+C
+C CHECK FOR AN ERROR IN THE PROJECTION SPECIFIER.
+C
+      IF (JPRJ.LE.0.OR.JPRJ.GE.10) GO TO 901
+C
+C IPRJ EQUALS JPRJ UNTIL WE FIND OUT IF FAST-PATH PROJECTIONS ARE TO BE
+C USED.  PHOC IS JUST A COPY OF PHIO.
+C
+      IPRJ=JPRJ
+      PHOC=PHIO
+C
+      IF (IPRJ.EQ.1) THEN
+C
+C COMPUTE CONSTANTS FOR THE LAMBERT CONFORMAL CONIC.
+C
+        SINO=SIGN(1.,.5*(FLT1+FLT2))
+        CHI1=(90.-SINO*FLT1)*DTOR
+        IF (FLT1.EQ.FLT2) THEN
+          COSO=COS(CHI1)
+        ELSE
+          CHI2=(90.-SINO*FLT2)*DTOR
+          COSO=ALOG(SIN(CHI1)/SIN(CHI2))/ALOG(TAN(.5*CHI1)/TAN(.5*CHI2))
+        END IF
+C
+      ELSE
+C
+C COMPUTE CONSTANTS REQUIRED FOR ALL THE OTHER PROJECTIONS.
+C
+        TMP1=ROTA*DTOR
+        TMP2=PHIA*DTOR
+        SINR=SIN(TMP1)
+        COSR=COS(TMP1)
+        SINO=SIN(TMP2)
+        COSO=COS(TMP2)
+C
+C COMPUTE CONSTANTS REQUIRED ONLY BY THE CYLINDRICAL PROJECTIONS.
+C
+        IF (IPRJ.GE.7) THEN
+C
+C SEE IF FAST-PATH TRANSFORMATIONS CAN BE USED.  (PLAT = 0 AND ROTA = 0
+C OR 180.)
+C
+          IF (ABS(PHIA).GE..0001.OR.(ABS(ROTA).GE..0001.AND.
+     +                               ABS(ROTA).LE.179.9999)) THEN
+C
+C NO.  COMPUTE CONSTANTS FOR THE ORDINARY CYLINDRICAL PROJECTIONS.
+C
+            SINT=COSO*COSR
+            COST=SQRT(1.-(SINT)**2)
+            TMP1=SINR/COST
+            TMP2=SINO/COST
+            PHIO=PHIO-ATAN2(TMP1,-COSR*TMP2)*RTOD
+            PHOC=PHIO
+            SINR=TMP1*COSO
+            COSR=-TMP2
+            SINO=SINT
+            COSO=COST
+C
+          ELSE
+C
+C YES.  THE FAST PATHS ARE IMPLEMENTED AS THREE ADDITIONAL PROJECTIONS.
+C
+            IPRJ=IPRJ+3
+C
+            IF (ABS(ROTA).LT..0001) THEN
+              SINO=1.
+            ELSE
+              SINO=-1.
+              PHIO=PHIO+180.
+              PHOC=PHIO
+            END IF
+C
+            COSO=0.
+            SINR=0.
+            COSR=1.
+C
+          END IF
+C
+        END IF
+C
+      END IF
+C
+C NOW, SET UMIN, UMAX, VMIN, AND VMAX TO CORRESPOND TO THE MAXIMUM
+C USEFUL AREA PRODUCED BY THE PROJECTION.
+C
+      GO TO (101,102,101,102,102,103,104,103,105,104,103,105) , IPRJ
+C
+C LAMBERT CONFORMAL CONIC AND ORTHOGRAPHIC.
+C
+  101 IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+        UMIN=-1.
+        UMAX=1.
+        VMIN=-1.
+        VMAX=1.
+      ELSE
+        TMP1=SALT*SALT*CALF*CALF-1.
+        TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*SBET*SBET)-1.)
+        UMIN=SRSS*(-SALF*CBET-TMP2)/TMP1
+        UMAX=SRSS*(-SALF*CBET+TMP2)/TMP1
+        TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*CBET*CBET)-1.)
+        VMIN=SRSS*(-SALF*SBET-TMP2)/TMP1
+        VMAX=SRSS*(-SALF*SBET+TMP2)/TMP1
+      END IF
+C
+      GO TO 106
+C
+C STEREOGRAPHIC, LAMBERT EQUAL AREA, AND GNOMONIC.
+C
+  102 UMIN=-2.
+      UMAX=2.
+      VMIN=-2.
+      VMAX=2.
+      GO TO 106
+C
+C AZIMUTHAL EQUIDISTANT AND MERCATOR.
+C
+  103 UMIN=-PI
+      UMAX=PI
+      VMIN=-PI
+      VMAX=PI
+      GO TO 106
+C
+C CYLINDRICAL EQUIDISTANT.
+C
+  104 UMIN=-180.
+      UMAX=180.
+      VMIN=-90.
+      VMAX=90.
+      GO TO 106
+C
+C MOLLWEIDE.
+C
+  105 UMIN=-2.
+      UMAX=2.
+      VMIN=-1.
+      VMAX=1.
+C
+C COMPUTE THE QUANTITIES USED BY MAPIT IN CHECKING FOR CROSS-OVER.
+C
+  106 UEPS=.75*(UMAX-UMIN)
+      VEPS=.75*(VMAX-VMIN)
+C
+C AS ALWAYS, THE CONICAL PROJECTION IS THE ODDBALL.  CROSS-OVER IS NOT
+C DETECTED IN U AND V, BUT IN LONGITUDE, SO THE VALUE HAS TO BE SET
+C DIFFERENTLY.
+C
+      IF (IPRJ.EQ.1) UEPS=180.
+C
+C NOW, JUMP TO THE APPROPRIATE LIMIT-SETTING CODE.
+C
+      GO TO (600,200,300,400,500) , ILTS
+C
+C ILTS=2    POINTS (PL1,PL2) AND (PL3,PL4) ARE ON OPPOSITE CORNERS
+C ------    OF THE PLOT.
+C
+  200 E=0.
+  201 CALL MAPTRN (PLA1,PLA2+E,TMP1,TMP3)
+      CALL MAPTRN (PLA3,PLA4-E,TMP2,TMP4)
+      IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN
+        E=.0001
+        GO TO 201
+      END IF
+      UMIN=AMIN1(TMP1,TMP2)
+      UMAX=AMAX1(TMP1,TMP2)
+      VMIN=AMIN1(TMP3,TMP4)
+      VMAX=AMAX1(TMP3,TMP4)
+      IF (UMAX.GE.1.E12) GO TO 904
+      GO TO 600
+C
+C ILTS=3    FOUR EDGE POINTS ARE GIVEN.
+C ------
+C
+  300 E=0.
+  301 CALL MAPTRN (PLA1,PLB1+E,TMP1,TMP5)
+      CALL MAPTRN (PLA2,PLB2-E,TMP2,TMP6)
+      IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN
+        E=.0001
+        GO TO 301
+      END IF
+      CALL MAPTRN (PLA3,PLB3,TMP3,TMP7)
+      CALL MAPTRN (PLA4,PLB4,TMP4,TMP8)
+      UMIN=AMIN1(TMP1,TMP2,TMP3,TMP4)
+      UMAX=AMAX1(TMP1,TMP2,TMP3,TMP4)
+      VMIN=AMIN1(TMP5,TMP6,TMP7,TMP8)
+      VMAX=AMAX1(TMP5,TMP6,TMP7,TMP8)
+      IF (UMAX.GE.1.E12) GO TO 904
+      GO TO 600
+C
+C ILTS=4    ANGULAR DISTANCES ARE GIVEN.
+C ------
+C
+  400 CUMI=COS(AUMN*DTOR)
+      SUMI=SIN(AUMN*DTOR)
+      CUMA=COS(AUMX*DTOR)
+      SUMA=SIN(AUMX*DTOR)
+      CVMI=COS(AVMN*DTOR)
+      SVMI=SIN(AVMN*DTOR)
+      CVMA=COS(AVMX*DTOR)
+      SVMA=SIN(AVMX*DTOR)
+C
+      GO TO (904,401,402,403,404,405,406,407,408,406,407,408) , IPRJ
+C
+C STEREOGRAPHIC.
+C
+  401 IF (SUMI.LT..0001) THEN
+        IF (CUMI.GT.0.) UMIN=0.
+      ELSE
+        UMIN=-(1.-CUMI)/SUMI
+      END IF
+      IF (SUMA.LT..0001) THEN
+        IF (CUMA.GT.0.) UMAX=0.
+      ELSE
+        UMAX=(1.-CUMA)/SUMA
+      END IF
+      IF (SVMI.LT..0001) THEN
+        IF (CVMI.GT.0.) VMIN=0.
+      ELSE
+        VMIN=-(1.-CVMI)/SVMI
+      END IF
+      IF (SVMA.LT..0001) THEN
+        IF (CVMA.GT.0.) VMAX=0.
+      ELSE
+        VMAX=(1.-CVMA)/SVMA
+      END IF
+      GO TO 600
+C
+C ORTHOGRAPHIC.
+C
+  402 IF (ABS(SALT).LE.1.) THEN
+        IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GT.90.) GO TO 902
+        UMIN=-SUMI
+        UMAX=SUMA
+        VMIN=-SVMI
+        VMAX=SVMA
+      ELSE
+        IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.90.) GO TO 902
+        UTMP=SRSS*SALF/CALF
+        VTMP=0.
+        UCEN=UTMP*CBET-VTMP*SBET
+        VCEN=VTMP*CBET+UTMP*SBET
+        UMIN=UCEN-SRSS*CALF*SUMI/CUMI
+        UMAX=UCEN+SRSS*CALF*SUMA/CUMA
+        VMIN=VCEN-SRSS*CALF*SVMI/CVMI
+        VMAX=VCEN+SRSS*CALF*SVMA/CVMA
+      END IF
+      GO TO 600
+C
+C LAMBERT EQUAL AREA.
+C
+  403 IF (SUMI.LT..0001) THEN
+        IF (CUMI.GT.0.) UMIN=0.
+      ELSE
+        UMIN=-2./SQRT(1.+((1.+CUMI)/SUMI)**2)
+      END IF
+      IF (SUMA.LT..0001) THEN
+        IF (CUMA.GT.0.) UMAX=0.
+      ELSE
+        UMAX=2./SQRT(1.+((1.+CUMA)/SUMA)**2)
+      END IF
+      IF (SVMI.LT..0001) THEN
+        IF (CVMI.GT.0.) VMIN=0.
+      ELSE
+        VMIN=-2./SQRT(1.+((1.+CVMI)/SVMI)**2)
+      END IF
+      IF (SVMA.LT..0001) THEN
+        IF (CVMA.GT.0.) VMAX=0.
+      ELSE
+        VMAX=2./SQRT(1.+((1.+CVMA)/SVMA)**2)
+      END IF
+      GO TO 600
+C
+C GNOMONIC.
+C
+  404 IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.89.9999) GO TO 902
+      UMIN=-SUMI/CUMI
+      UMAX=SUMA/CUMA
+      VMIN=-SVMI/CVMI
+      VMAX=SVMA/CVMA
+      GO TO 600
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  405 UMIN=-AUMN*DTOR
+      UMAX=AUMX*DTOR
+      VMIN=-AVMN*DTOR
+      VMAX=AVMX*DTOR
+      GO TO 600
+C
+C CYLINDRICAL EQUIDISTANT.
+C
+  406 UMIN=-AUMN
+      UMAX=AUMX
+      VMIN=-AVMN
+      VMAX=AVMX
+      GO TO 600
+C
+C MERCATOR.
+C
+  407 IF (AMAX1(AVMN,AVMX).GE.89.9999) GO TO 902
+      UMIN=-AUMN*DTOR
+      UMAX=AUMX*DTOR
+      VMIN=-ALOG((1.+SVMI)/CVMI)
+      VMAX=ALOG((1.+SVMA)/CVMA)
+      GO TO 600
+C
+C MOLLWEIDE.
+C
+  408 UMIN=-AUMN*OV90
+      UMAX=AUMX*OV90
+      VMIN=-SVMI
+      VMAX=SVMA
+      GO TO 600
+C
+C ILTS=5    VALUES IN THE U/V PLANE ARE GIVEN.
+C ------
+C
+  500 UMIN=PLA1
+      UMAX=PLA2
+      VMIN=PLA3
+      VMAX=PLA4
+C
+C COMPUTE THE WIDTH AND HEIGHT OF THE PLOT.
+C
+  600 DU=UMAX-UMIN
+      DV=VMAX-VMIN
+C
+C ERROR IF MAP HAS ZERO AREA.
+C
+      IF (DU.LE.0..OR.DV.LE.0.) GO TO 903
+C
+C POSITION THE MAP ON THE PLOTTER FRAME.
+C
+      IF (DU/DV.LT.(XROW-XLOW)/(YTOW-YBOW)) THEN
+        ULOW=.5*(XLOW+XROW)-.5*(DU/DV)*(YTOW-YBOW)
+        UROW=.5*(XLOW+XROW)+.5*(DU/DV)*(YTOW-YBOW)
+        VBOW=YBOW
+        VTOW=YTOW
+      ELSE
+        ULOW=XLOW
+        UROW=XROW
+        VBOW=.5*(YBOW+YTOW)-.5*(DV/DU)*(XROW-XLOW)
+        VTOW=.5*(YBOW+YTOW)+.5*(DV/DU)*(XROW-XLOW)
+      END IF
+C
+C ERROR IF MAP HAS ESSENTIALLY ZERO AREA.
+C
+      IF (AMIN1(UROW-ULOW,VTOW-VBOW)*PLTR.LT.RESL) GO TO 903
+C
+C DO THE REQUIRED SET CALL.
+C
+      CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1)
+C
+C COMPUTE THE QUANTITIES USED BY MAPIT TO SEE IF POINTS ARE FAR ENOUGH
+C APART TO DRAW THE LINE BETWEEN THEM AND THE QUANTITIES USED BY MAPVP
+C TO DETERMINE THE NUMBER OF DOTS TO INTERPOLATE BETWEEN TWO POINTS.
+C
+      DSCA=(UROW-ULOW)*PLTR/DU
+      DPSQ=DPLT*DPLT
+      DSSQ=DSCA*DSCA
+      DBTD=DDTS/DSCA
+C
+C SET PARAMETERS REQUIRED IF AN ELLIPTICAL PERIMETER IS BEING USED.  THE
+C ELLIPSE IS MADE TO BE JUST A LITTLE BIGGER THAN AN INSCRIBED ELLIPSE
+C SO AS TO AVOID ROUND-OFF PROBLEMS WHEN DRAWING THE LIMB OF CERTAIN
+C PROJECTIONS.
+C
+      UCEN=.5*(UMIN+UMAX)
+      VCEN=.5*(VMIN+VMAX)
+      URNG=.50005*(UMAX-UMIN)
+      VRNG=.50005*(VMAX-VMIN)
+C
+C NOW, COMPUTE THE LATITUDE/LONGITUDE LIMITS WHICH WILL BE REQUIRED BY
+C MAPGRD AND MAPLOT, IF ANY.
+C
+      IF (GRID.GT.0..OR.NOUT.NE.0) THEN
+C
+C AT FIRST, ASSUME THE WHOLE GLOBE WILL BE PROJECTED.
+C
+        SLAM=-90.
+        BLAM=+90.
+        SLOM=PHIO-180.
+        BLOM=PHIO+180.
+C
+C JUMP IF IT'S OBVIOUS THAT REALLY IS THE CASE.
+C
+        IF (ILTS.EQ.1.AND.(JPRJ.EQ.4.OR.JPRJ.EQ.6.OR.JPRJ.EQ.7.OR.
+     +                                             JPRJ.EQ.9)) GO TO 700
+C
+C OTHERWISE, THE WHOLE GLOBE IS NOT BEING PROJECTED.  THE FIRST THING
+C TO DO IS TO FIND A POINT (CLAT,CLON) WHOSE PROJECTION IS KNOWN TO BE
+C ON THE MAP.  FIRST, TRY THE POLE OF THE PROJECTION.
+C
+        CLAT=PHIA
+        CLON=PHIO
+        CALL MAPTRN (CLAT,CLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 611
+C
+C IF THAT DIDN'T WORK, TRY A POINT BASED ON THE LIMITS SPECIFIER.
+C
+        IF (ILTS.EQ.2) THEN
+          CLAT=.5*(PLA1+PLA3)
+          CLON=.5*(PLA2+PLA4)
+        ELSE IF (ILTS.EQ.3) THEN
+          TMP1=AMIN1(PLA1,PLA2,PLA3,PLA4)
+          TMP2=AMAX1(PLA1,PLA2,PLA3,PLA4)
+          TMP3=AMIN1(PLB1,PLB2,PLB3,PLB4)
+          TMP4=AMAX1(PLB1,PLB2,PLB3,PLB4)
+          CLAT=.5*(TMP1+TMP2)
+          CLON=.5*(TMP3+TMP4)
+        ELSE
+          GO TO 700
+        END IF
+        CALL MAPTRN (CLAT,CLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 611
+        GO TO 700
+C
+C ONCE WE HAVE THE LATITUDES AND LONGITUDES OF A POINT ON THE MAP, WE
+C FIND THE MINIMUM AND MAXIMUM LATITUDE AND THE MINIMUM AND MAXIMUM
+C LONGITUDE BY RUNNING A SEARCH POINT ABOUT ON A FINE LAT/LON GRID.
+C
+C FIND THE MINIMUM LATITUDE.
+C
+  611   RLAT=CLAT
+        RLON=CLON
+        DLON=SRCH
+  612   RLAT=RLAT-SRCH
+        IF (RLAT.LE.-90.) GO TO 621
+  613   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLON=SRCH
+          GO TO 612
+        END IF
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613
+        SLAM=RLAT
+C
+C FIND THE MAXIMUM LATITUDE.
+C
+  621   RLAT=CLAT
+        RLON=CLON
+        DLON=SRCH
+  622   RLAT=RLAT+SRCH
+        IF (RLAT.GT.90.) GO TO 631
+  623   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLON=SRCH
+          GO TO 622
+        END IF
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623
+        BLAM=RLAT
+C
+C FIND THE MINIMUM LONGITUDE.
+C
+  631   RLAT=CLAT
+        RLON=CLON
+        DLAT=SRCH
+  632   RLON=RLON-SRCH
+        IF (RLON.LE.CLON-360.) GO TO 651
+  633   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLAT=SRCH
+          GO TO 632
+        END IF
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633
+        SLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON)
+C
+C FIND THE MAXIMUM LONGITUDE.
+C
+  641   RLAT=CLAT
+        RLON=CLON
+        DLAT=SRCH
+  642   RLON=RLON+SRCH
+        IF (RLON.GE.CLON+360.) GO TO 651
+  643   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLAT=SRCH
+          GO TO 642
+        END IF
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643
+        BLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON)
+        IF (BLOM.LE.SLOM) BLOM=BLOM+360.
+        GO TO 700
+C
+  651   SLOM=PHIO-180.
+        BLOM=PHIO+180.
+C
+      END IF
+C
+C ZERO THE ERROR FLAG AND TURN OFF THE INITIALIZATION-REQUIRED FLAG.
+C
+  700 IIER=0
+      INTF=.FALSE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR RETURNS.
+C
+  901 IIER=5
+      CALL SETER (' MAPINT - ATTEMPT TO USE NON-EXISTENT PROJECTION',
+     1              IIER,1)
+      RETURN
+C
+  902 IIER=6
+      CALL SETER (' MAPINT - ANGULAR LIMITS TOO GREAT',IIER,1)
+      RETURN
+C
+  903 IIER=7
+      CALL SETER (' MAPINT - MAP HAS ZERO AREA',IIER,1)
+      RETURN
+C
+  904 IIER=8
+      CALL SETER (' MAPINT - MAP LIMITS INAPPROPIATE',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIT (RLAT,RLON,IFST)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM8/ P,Q,R
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+C
+      DIMENSION CPRJ(3)
+C
+      SAVE IVSO,POLD,QOLD,UOLD,VOLD
+C
+      DATA CPRJ / 360.,6.28318530717959,4. /
+C
+      DATA IVSO,POLD,QOLD,UOLD,VOLD / 0,0.,0.,0.,0. /
+C
+C PROJECT THE POINT (RLAT,RLON) TO (U,V).
+C
+      CALL MAPTRN (RLAT,RLON,U,V)
+C
+C FOR THE SAKE OF EFFICIENCY, EXECUTE ONE OF TWO PARALLEL ALGORITHMS,
+C DEPENDING ON WHETHER AN ELLIPTICAL OR A RECTANGULAR PERIMETER IS IN
+C USE.  (THAT WAY, WE TEST ELPF ONLY ONCE.)
+C
+      IF (ELPF) THEN
+C
+C ELLIPTICAL - ASSUME THE NEW POINT IS VISIBLE UNTIL WE FIND OTHERWISE.
+C
+        IVIS=1
+C
+C SEE IF THE NEW POINT IS INVISIBLE.
+C
+        IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.) THEN
+C
+C THE NEW POINT IS INVISIBLE.  RESET THE VISIBILITY FLAG.
+C
+          IVIS=0
+C
+C IF THE NEW POINT IS A "FIRST POINT" OR IF THE LAST POINT WAS NOT
+C VISIBLE OR IF THE NEW POINT IS INVISIBLE BECAUSE ITS PROJECTION IS
+C UNDEFINED, DRAW NOTHING.  THE POSSIBLE EXISTENCE OF A VISIBLE SEGMENT
+C ALONG THE LINE JOINING TWO INVISIBLE POINTS IS INTENTIONALLY IGNORED,
+C FOR REASONS OF EFFICIENCY.  FOR THIS REASON, OBJECTS SHOULD NOT BE
+C DRAWN USING LONG LINE SEGMENTS.
+C
+          IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108
+C
+C OTHERWISE, THE NEW POINT IS NOT A "FIRST POINT", THE LAST POINT WAS
+C VISIBLE, AND THE PROJECTION OF THE NEW POINT IS DEFINED, SO WE NEED
+C TO CONTINUE THE LINE.  FIRST, IF THERE'S A CROSS-OVER PROBLEM, MOVE
+C THE NEW POINT TO ITS ALTERNATE POSITION.  THIS MAY MAKE IT VISIBLE.
+C
+          IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN
+C
+            IF (JPRJ.GE.7) THEN
+              P=P-SIGN(CPRJ(JPRJ-6),P)
+              U=P
+              IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V)
+            ELSE
+              GO TO 108
+            END IF
+C
+            IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.) THEN
+              IVIS=1
+              GO TO 107
+            END IF
+C
+          END IF
+C
+C IF IT'S STILL INVISIBLE, INTERPOLATE TO THE EDGE OF THE FRAME, EXTEND
+C THE LINE TO THAT POINT, AND QUIT.
+C
+          CALL MAPTRE (UOLD,VOLD,U,V,UINT,VINT)
+          CALL MAPVP (UOLD,VOLD,UINT,VINT)
+          GO TO 108
+C
+        END IF
+C
+C THE NEW POINT IS VISIBLE.  IF IT'S THE FIRST POINT OF A LINE, GO START
+C A NEW LINE.
+C
+        IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106
+C
+C THE NEW POINT IS VISIBLE, BUT IT'S NOT THE FIRST POINT OF A LINE.
+C CHECK FOR CROSS-OVER PROBLEMS.
+C
+        IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 101
+C
+C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, AND
+C THERE ARE NO CROSS-OVER PROBLEMS.  IF THE OLD POINT WAS INVISIBLE,
+C JUMP TO DRAW THE VISIBLE PORTION OF THE LINE FROM THE OLD POINT TO
+C THE NEW ONE.
+C
+        IF (IVSO.EQ.0) GO TO 102
+C
+C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, THERE
+C ARE NO CROSS-OVER PROBLEMS, AND THE LAST POINT WAS VISIBLE.  JUMP TO
+C JUST CONTINUE THE LINE.
+C
+        GO TO 107
+C
+C WE HAVE THE MOST DIFFICULT CASE.  THE NEW POINT IS VISIBLE, IT'S NOT
+C THE FIRST POINT OF A LINE, AND THERE IS A CROSS-OVER PROBLEM.  NONE,
+C ONE, OR TWO SEGMENTS MAY NEED TO BE DRAWN.
+C
+  101   IF (JPRJ.LT.7) GO TO 106
+C
+C IF THE OLD POINT WAS VISIBLE, GENERATE THE ALTERNATE PROJECTION OF THE
+C NEW POINT AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING THE
+C OLD POINT TO THE ALTERNATE PROJECTION POINT.
+C
+        IF (IVSO.NE.0) THEN
+C
+          UTMP=P-SIGN(CPRJ(JPRJ-6),P)
+          VTMP=Q
+          IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP)
+C
+          IF (((UTMP-UCEN)/URNG)**2+((VTMP-VCEN)/VRNG)**2.GT.1.) THEN
+            CALL MAPTRE (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP)
+          END IF
+C
+          CALL MAPVP (UOLD,VOLD,UTMP,VTMP)
+C
+        END IF
+C
+C NOW GENERATE AN ALTERNATE PROJECTION OF THE OLD POINT CLOSE TO THE NEW
+C ONE AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING IT TO THE
+C NEW POINT.
+C
+        UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD)
+        IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD)
+C
+        IF (((UOLD-UCEN)/URNG)**2+((VOLD-VCEN)/VRNG)**2.LE.1.) GO TO 105
+C
+C MOVE (UOLD,VOLD) BY INTERPOLATING TO THE EDGE OF THE FRAME.
+C
+  102   CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
+C
+      ELSE
+C
+C RECTANGULAR - REPEAT THE ABOVE CODE, CHANGING THE TESTS FOR A POINT'S
+C BEING INSIDE/OUTSIDE THE PERIMETER.  COMMENTING WILL BE ABBREVIATED.
+C
+        IVIS=1
+C
+        IF (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX) THEN
+C
+          IVIS=0
+C
+          IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108
+C
+          IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN
+C
+            IF (JPRJ.GE.7) THEN
+              P=P-SIGN(CPRJ(JPRJ-6),P)
+              U=P
+              IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V)
+            ELSE
+              GO TO 108
+            END IF
+C
+            IF (U.GE.UMIN.AND.U.LE.UMAX.AND.
+     +          V.GE.VMIN.AND.V.LE.VMAX) THEN
+              IVIS=1
+              GO TO 107
+            END IF
+          END IF
+C
+          CALL MAPTRP (UOLD,VOLD,U,V,UINT,VINT)
+          CALL MAPVP (UOLD,VOLD,UINT,VINT)
+          GO TO 108
+C
+        END IF
+C
+        IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106
+C
+        IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 103
+C
+        IF (IVSO.EQ.0) GO TO 104
+C
+        GO TO 107
+C
+  103   IF (JPRJ.LT.7) GO TO 106
+C
+        IF (IVSO.NE.0) THEN
+C
+          UTMP=P-SIGN(CPRJ(JPRJ-6),P)
+          VTMP=Q
+          IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP)
+C
+          IF (UTMP.LT.UMIN.OR.UTMP.GT.UMAX.OR.
+     +        VTMP.LT.VMIN.OR.VTMP.GT.VMAX) THEN
+            CALL MAPTRP (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP)
+          END IF
+C
+          CALL MAPVP (UOLD,VOLD,UTMP,VTMP)
+        END IF
+C
+        UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD)
+        IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD)
+C
+        IF (UOLD.GE.UMIN.AND.UOLD.LE.UMAX.AND.
+     +      VOLD.GE.VMIN.AND.VOLD.LE.VMAX) GO TO 105
+C
+  104   CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
+C
+      END IF
+C
+C DRAW THE VISIBLE PORTION OF THE LINE JOINING THE OLD POINT TO THE NEW.
+C
+  105 IF (IDTL.EQ.0) THEN
+        CALL FRSTD (UOLD,VOLD)
+        DATL=0.
+      END IF
+C
+      CALL MAPVP (UOLD,VOLD,U,V)
+C
+      GO TO 108
+C
+C START A NEW LINE.
+C
+  106 IF (IDTL.EQ.0) THEN
+        CALL FRSTD (U,V)
+        DATL=0.
+      END IF
+C
+      GO TO 108
+C
+C CONTINUE THE LINE.
+C
+  107 IF (IFST.LT.2.AND.((U-UOLD)**2+(V-VOLD)**2)*DSSQ.LE.DPSQ) RETURN
+      CALL MAPVP (UOLD,VOLD,U,V)
+C
+C SAVE INFORMATION ABOUT THE CURRENT POINT FOR THE NEXT CALL AND QUIT.
+C
+  108 IVSO=IVIS
+      POLD=P
+      QOLD=Q
+      UOLD=U
+      VOLD=V
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIQ
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C FLUSH THE POINTS BUFFER.
+C
+      IF (NPTB.GT.0) THEN
+        CALL POINTS (XPTB,YPTB,NPTB,0,0)
+        NPTB=0
+      END IF
+C
+C FLUSH PLOTIT'S BUFFER, TOO.
+C
+      CALL PLOTIT (0,0,0)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLBL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE REQUIRED CONSTANTS.  SIN1 AND COS1 ARE RESPECTIVELY THE SINE
+C AND COSINE OF ONE DEGREE.
+C
+      DATA SIN1 / .017452406437283 /
+      DATA COS1 / .999847695156390 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPLBL','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF REQUESTED, LETTER KEY MERIDIANS AND POLES.
+C
+      IF (LBLF) THEN
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LABELLING.
+C
+        CALL MAPCHI (3,1,0)
+C
+C FIRST, THE NORTH POLE.
+C
+        CALL MAPTRN (90.,0.,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                    CALL WTSTR (U,V,'NP',ILCW,0,0)
+C
+C THEN, THE SOUTH POLE.
+C
+        CALL MAPTRN (-90.,0.,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                    CALL WTSTR (U,V,'SP',ILCW,0,0)
+C
+C THE EQUATOR.
+C
+        RLON=PHIO-10.
+        DO 101 I=1,36
+          RLON=RLON+10.
+          CALL MAPTRN (0.,RLON,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 102
+  101   CONTINUE
+        GO TO 103
+  102   CALL WTSTR (U,V,'EQ',ILCW,0,0)
+C
+C THE GREENWICH MERIDIAN.
+C
+  103   RLAT=85.
+        DO 104 I=1,16
+          RLAT=RLAT-10.
+          CALL MAPTRN (RLAT,0.,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 105
+  104   CONTINUE
+        GO TO 106
+  105   CALL WTSTR (U,V,'GM',ILCW,0,0)
+C
+C INTERNATIONAL DATE LINE.
+C
+  106   RLAT=85.
+        DO 107 I=1,16
+          RLAT=RLAT-10.
+          CALL MAPTRN (RLAT,180.,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 108
+  107   CONTINUE
+        GO TO 109
+  108   CALL WTSTR (U,V,'ID',ILCW,0,0)
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+  109   CALL MAPCHI (-3,0,0)
+C
+      END IF
+C
+C DRAW PERIMETER, IF REQUESTED.
+C
+      IF (PRMF) THEN
+C
+C RESET THE LINE INTENSITY, DOTTING, AND DASH PATTERN FOR THE PERIMETER.
+C
+        CALL MAPCHI (1,0,IOR(ISHIFT(32767,1),1))
+C
+C THE PERIMETER IS EITHER AN ELLIPSE OR A RECTANGLE, DEPENDING ON ELPF.
+C
+        IF (ELPF) THEN
+          U=.9999*URNG
+          V=0.
+          DATL=0.
+          CALL FRSTD (UCEN+U,VCEN)
+          DO 110 I=1,360
+            UOLD=U
+            VOLD=V
+            U=COS1*UOLD-SIN1*VOLD
+            V=SIN1*UOLD+COS1*VOLD
+            CALL MAPVP (UCEN+UOLD,VCEN+VOLD*VRNG/URNG,
+     +                  UCEN+U   ,VCEN+V   *VRNG/URNG)
+  110     CONTINUE
+        ELSE
+          DATL=0.
+          UMINX=UMIN+.9999*(UMAX-UMIN)
+          UMAXX=UMAX-.9999*(UMAX-UMIN)
+          VMINX=VMIN+.9999*(VMAX-VMIN)
+          VMAXX=VMAX-.9999*(VMAX-VMIN)
+          CALL FRSTD (UMINX,VMINX)
+          CALL MAPVP (UMINX,VMINX,UMAXX,VMINX)
+          CALL MAPVP (UMAXX,VMINX,UMAXX,VMAXX)
+          CALL MAPVP (UMAXX,VMAXX,UMINX,VMAXX)
+          CALL MAPVP (UMINX,VMAXX,UMINX,VMINX)
+        END IF
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+        CALL MAPCHI (-1,0,0)
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLOT
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE REQUIRED CONSTANTS.
+C
+      DATA PI / 3.14159265358979 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPLOT','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF THE SELECTED OUTLINE TYPE IS "NONE", DO NOTHING.
+C
+      IF (NOUT.LE.0) RETURN
+C
+C SET THE FLAG IWGF TO SAY WHETHER OR NOT THE WHOLE GLOBE IS SHOWN BY
+C THE CURRENT PROJECTION.  IF SO (IWGF=1), THERE'S NO NEED TO WASTE THE
+C TIME REQUIRED TO CHECK EACH OUTLINE POINT GROUP FOR INTERSECTION WITH
+C THE WINDOW.
+C
+      IWGF=0
+      IF (BLAM-SLAM.GT.179.9999.AND.BLOM-SLOM.GT.359.9999) IWGF=1
+C
+C IGIS KEEPS TRACK OF CHANGES IN THE GROUP IDENTIFIER, SO THAT THE
+C INTENSITY CAN BE CHANGED WHEN NECESSARY.
+C
+      IGIS=0
+C
+C POSITION TO THE USER-SELECTED PORTION OF THE OUTLINE DATASET.
+C
+      CALL MAPIO (1)
+      NSEG=0
+C
+C READ THE NEXT RECORD (GROUP OF POINTS).
+C
+  101 CALL MAPIO (2)
+      NSEG=NSEG+1
+C
+C CHECK FOR THE END OF THE DESIRED DATA.
+C
+      IF (NPTS.EQ.0) GO TO 103
+C
+C IF LESS THAN THE WHOLE GLOBE IS SHOWN BY THE PROJECTION, DO A QUICK
+C CHECK FOR INTERSECTION OF THE BOX SURROUNDING THE POINT GROUP WITH
+C THE AREA SHOWN.
+C
+      IF (IWGF.EQ.0) THEN
+        IF (SLAG.GT.BLAM.OR.BLAG.LT.SLAM) GO TO 101
+        IF ((SLOG     .GT.BLOM.OR.BLOG     .LT.SLOM).AND.
+     +      (SLOG-360..GT.BLOM.OR.BLOG-360..LT.SLOM).AND.
+     +      (SLOG+360..GT.BLOM.OR.BLOG+360..LT.SLOM)) GO TO 101
+      END IF
+C
+C SEE IF THE USER WANTS TO OMIT THIS POINT GROUP.
+C
+      CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+      IF (NPTS.LE.1) GO TO 101
+C
+C IF WE'VE SWITCHED TO A NEW GROUP, SET THE INTENSITY, DOTTING, AND
+C DASH PATTERN FOR THE GROUP.
+C
+      IF (IGID.NE.IGIS) THEN
+        IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0)
+        CALL MAPCHI (4+IGID,IDOT,IOR(ISHIFT(32767,1),1))
+        IGIS=IGID
+      END IF
+C
+C PLOT THE GROUP.
+C
+      CALL MAPIT (PNTS(1),PNTS(2),0)
+C
+      DO 102 K=2,NPTS-1
+        CALL MAPIT (PNTS(2*K-1),PNTS(2*K),1)
+  102 CONTINUE
+C
+      CALL MAPIT (PNTS(2*NPTS-1),PNTS(2*NPTS),2)
+C
+C GO GET ANOTHER GROUP.
+C
+      GO TO 101
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN, IF NECESSARY.
+C
+  103 IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0)
+C
+C IF THE LIMB LINES HAVE NOT ALREADY BEEN DRAWN, DO IT NOW.
+C
+      IF (GRID.LE.0.) CALL MAPLMB
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPPOS (ARG1,ARG2,ARG3,ARG4)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPPOS','VERSION  1')
+C
+C CHECK THE ARGUMENTS FOR ERRORS.
+C
+      IF (ARG1.LT.0..OR.ARG1.GE.ARG2.OR.ARG2.GT.1.) GO TO 901
+      IF (ARG3.LT.0..OR.ARG3.GE.ARG4.OR.ARG4.GT.1.) GO TO 901
+C
+C TRANSFER IN THE VALUES.
+C
+      XLOW=ARG1
+      XROW=ARG2
+      YBOW=ARG3
+      YTOW=ARG4
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=19
+      CALL SETER (' MAPPOS - ARGUMENTS ARE INCORRECT',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPROJ (ARG1,ARG2,ARG3,ARG4)
+C
+      CHARACTER*(*) ARG1
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPROJ','VERSION  1')
+C
+C TRANSFER THE PARAMETERS DEFINING THE PROJECTION.
+C
+      I=IDICTL(ARG1,PDCT,10)
+      IF (I.EQ.0) GO TO 901
+C
+      JPRJ=I
+C
+      IF (JPRJ.EQ.3) THEN
+        CALL MAPSTR ('SA',0.)
+      ELSE IF (JPRJ.EQ.10) THEN
+        JPRJ=3
+        IF (ABS(SALT).LE.1.) CALL MAPSTR ('SA',6.631)
+      END IF
+C
+      PHIA=ARG2
+      PHIO=ARG3
+      ROTA=ARG4
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=9
+      CALL MAPCEM (' MAPROJ - UNKNOWN PROJECTION NAME ',ARG1,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPRS
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPRS','VERSION  1')
+C
+C RESTORE THE SET CALL.
+C
+      CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPRST (IFNO)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPRST','VERSION  1')
+C
+C READ A RECORD OF SAVED PARAMETERS.
+C
+      READ (IFNO,ERR=901,END=902) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,
+     +                            PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,
+     +                            PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF,
+     +                            XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,
+     +                            ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA,
+     +                            BETA,SALF,CALF,SBET,CBET,
+     +                            (INTS(I),I=1,7)
+C
+C RE-INITIALIZE EZMAP.
+C
+      CALL MAPINT
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=20
+      CALL SETER ('MAPRST - ERROR ON READ',IIER,1)
+      RETURN
+C
+  902 IIER=21
+      CALL SETER ('MAPRST - EOF ON READ',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSAV (IFNO)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSAV','VERSION  1')
+C
+C WRITE A RECORD CONTAINING ALL THE USER-SETTABLE PARAMETERS.
+C
+      WRITE (IFNO,ERR=901) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,
+     +                     PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,
+     +                     PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF,
+     +                     XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,
+     +                     ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA,
+     +                     BETA,SALF,CALF,SBET,CBET,
+     +                     (INTS(I),I=1,7)
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=22
+      CALL SETER ('MAPSAV - ERROR ON WRITE',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSET (ARG1,ARG2,ARG3,ARG4,ARG5)
+C
+      CHARACTER*(*) ARG1
+      DIMENSION ARG2(2),ARG3(2),ARG4(2),ARG5(2)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSET','VERSION  1')
+C
+C TRANSFER THE PARAMETERS DEFINING THE MAP LIMITS.
+C
+      I=IDICTL(ARG1,LDCT,5)
+      IF (I.EQ.0) GO TO 901
+      ILTS=I
+C
+      PLA1=ARG2(1)
+      PLA2=ARG3(1)
+      PLA3=ARG4(1)
+      PLA4=ARG5(1)
+C
+      IF (I.EQ.3) THEN
+        PLB1=ARG2(2)
+        PLB2=ARG3(2)
+        PLB3=ARG4(2)
+        PLB4=ARG5(2)
+      END IF
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=10
+      CALL MAPCEM (' MAPSET - UNKNOWN MAP AREA SPECIFIER ',ARG1,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTC (WHCH,CVAL)
+C
+      CHARACTER*(*) WHCH,CVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTC','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'OU') THEN
+        I=IDICTL(CVAL,DDCT,5)
+        IF (I.EQ.0) GO TO 901
+        NOUT=I-1
+      ELSE
+        GO TO 902
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=11
+      CALL MAPCEM (' MAPSTC - UNKNOWN OUTLINE NAME ',CVAL,IIER,1)
+      RETURN
+C
+  902 IIER=12
+      CALL MAPCEM (' MAPSTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTI (WHCH,IVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTI','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DA') THEN
+        IDSH=IVAL
+      ELSE IF (WHCH(1:2).EQ.'DD') THEN
+        DDTS=IVAL
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'DL') THEN
+        IDTL=IVAL
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IDOT=IVAL
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        ELPF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        GRID=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I1') THEN
+        INTS(1)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I2') THEN
+        INTS(2)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I3') THEN
+        INTS(3)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I4') THEN
+        INTS(4)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I5') THEN
+        INTS(5)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I6') THEN
+        INTS(6)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I7') THEN
+        INTS(7)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LBLF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'LS') THEN
+        ILCW=IVAL
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        DPLT=IVAL
+        DPSQ=DPLT*DPLT
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        PRMF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        PLTR=IVAL
+        DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN)
+        DSSQ=DSCA*DSCA
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        SALT=IVAL
+        IF (ABS(SALT).GT.1.) THEN
+          SSMO=SALT*SALT-1.
+          SRSS=SQRT(SSMO)
+        END IF
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        ALFA=IVAL
+        SALF=SIN(.017453292519943*ALFA)
+        CALF=COS(.017453292519943*ALFA)
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        BETA=IVAL
+        SBET=SIN(.017453292519943*BETA)
+        CBET=COS(.017453292519943*BETA)
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=13
+      CALL MAPCEM (' MAPSTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTL (WHCH,LVAL)
+C
+      CHARACTER*(*) WHCH
+      LOGICAL LVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTL','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DL') THEN
+        IDTL=0
+        IF (LVAL) IDTL=1
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IDOT=0
+        IF (LVAL) IDOT=1
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        ELPF=LVAL
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LBLF=LVAL
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        PRMF=LVAL
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=14
+      CALL MAPCEM (' MAPSTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTR (WHCH,RVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTR','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DD') THEN
+        DDTS=RVAL
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'GD') THEN
+        GRDR=AMAX1(.001,AMIN1(10.,RVAL))
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        GRID=RVAL
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        DPLT=RVAL
+        DPSQ=DPLT*DPLT
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        PLTR=RVAL
+        DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN)
+        DSSQ=DSCA*DSCA
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        SALT=RVAL
+        IF (ABS(SALT).GT.1.) THEN
+          SSMO=SALT*SALT-1.
+          SRSS=SQRT(SSMO)
+        END IF
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        ALFA=RVAL
+        SALF=SIN(.017453292519943*ALFA)
+        CALF=COS(.017453292519943*ALFA)
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        BETA=RVAL
+        SBET=SIN(.017453292519943*BETA)
+        CBET=COS(.017453292519943*BETA)
+      ELSE IF (WHCH(1:2).EQ.'SR') THEN
+        SRCH=AMAX1(.001,AMIN1(10.,RVAL))
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=15
+      CALL MAPCEM (' MAPSTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRN (RLAT,RLON,U,V)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM8/ P,Q,R
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C DEFINE REQUIRED CONSTANTS.  DTOR IS PI OVER 180, DTRH IS HALF OF DTOR
+C OR PI OVER 360, AND TOPI IS 2 OVER PI.
+C
+      DATA DTOR / .017453292519943 /
+      DATA DTRH / .008726646259971 /
+      DATA RTOD / 57.2957795130823 /
+      DATA TOPI / .636619772367581 /
+C
+C SET UP U AND V FOR THE FAST PATHS.  U IS A LONGITUDE, IN DEGREES,
+C BETWEEN -180. AND +180., INCLUSIVE, AND V IS A LATITUDE, IN DEGREES.
+C
+      TMP1=RLON-PHOC
+      U=TMP1-SIGN(180.,TMP1+180.)+SIGN(180.,180.-TMP1)
+      V=RLAT
+C
+C TAKE FAST PATHS FOR SIMPLE CYLINDRICAL PROJECTIONS.
+C
+      IF (IPRJ-10) 101,116,112
+C
+C NO FAST PATH.  SORT OUT THE LAMBERT CONFORMAL CONIC FROM THE REST.
+C
+  101 IF (IPRJ-1) 901,102,103
+C
+C LAMBERT CONFORMAL CONIC.
+C
+  102 P=U
+      CHI=90.-SINO*RLAT
+      IF (CHI.GE.179.9999) GO TO 118
+      R=TAN(DTRH*CHI)**COSO
+      U=U*COSO*DTOR
+      V=-R*SINO*COS(U)
+      U=R*SIN(U)
+      GO TO 117
+C
+C NOT LAMBERT CONFORMAL CONIC.  CALCULATE CONSTANTS COMMON TO MOST OF
+C THE OTHER PROJECTIONS.
+C
+  103 TMP1=U*DTOR
+      TMP2=V*DTOR
+      SINPH=SIN(TMP1)
+      SINLA=SIN(TMP2)
+      COSPH=COS(TMP1)
+      COSLA=COS(TMP2)
+      TCOS=COSLA*COSPH
+      COSA=AMAX1(-1.,AMIN1(+1.,SINLA*SINO+TCOS*COSO))
+      SINA=SQRT(1.-COSA*COSA)
+      IF (SINA.LT..0001) THEN
+        SINA=0.
+        IF (IPRJ.GE.7.OR.COSA.LT.0.) GO TO 118
+        U=0.
+        V=0.
+        GO TO 116
+      END IF
+      SINB=COSLA*SINPH/SINA
+      COSB=(SINLA*COSO-TCOS*SINO)/SINA
+C
+C JUMP TO CODE APPROPRIATE FOR THE CHOSEN PROJECTION.
+C
+      GO TO (104,105,106,107,108,109,110,111) , IPRJ-1
+C
+C STEREOGRAPHIC.
+C
+  104 IF (ABS(SINA).LT..0001) THEN
+        R=SINA/2.
+      ELSE
+        R=(1.-COSA)/SINA
+      END IF
+      GO TO 115
+C
+C ORTHOGRAPHIC OR SATELLITE-VIEW, DEPENDING ON THE VALUE OF SALT.
+C
+  105 IF (ABS(SALT).LE.1.) THEN
+        IF (COSA.GT.0.) THEN
+          R=SINA
+        ELSE
+          IF (SALT.GE.0.) GO TO 118
+          R=2.-SINA
+        END IF
+        GO TO 115
+      ELSE
+        IF (COSA.GT.1./ABS(SALT)) THEN
+          R=SRSS*SINA/(ABS(SALT)-COSA)
+        ELSE
+          IF (SALT.GE.0.) GO TO 118
+          R=2.-SRSS*SINA/(ABS(SALT)-COSA)
+        END IF
+        IF (ALFA.EQ.0.) GO TO 115
+        UTM1=R*(SINB*COSR+COSB*SINR)
+        VTM1=R*(COSB*COSR-SINB*SINR)
+        UTM2=UTM1*CBET+VTM1*SBET
+        VTM2=VTM1*CBET-UTM1*SBET
+        UTM3=SRSS*UTM2/(UTM2*SALF+SRSS*CALF)
+        VTM3=SRSS*VTM2*CALF/(UTM2*SALF+SRSS*CALF)
+        U=UTM3*CBET-VTM3*SBET
+        V=VTM3*CBET+UTM3*SBET
+        GO TO 116
+      END IF
+C
+C LAMBERT EQUAL AREA.
+C
+  106 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118
+      R=(1.+COSA)/SINA
+      R=2./SQRT(1.+R*R)
+      GO TO 115
+C
+C GNOMONIC.
+C
+  107 IF (COSA.LE..0001) GO TO 118
+      R=SINA/COSA
+      GO TO 115
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  108 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118
+      R=ACOS(COSA)
+      GO TO 115
+C
+C CYLINDRICAL EQUIDISTANT, ARBITRARY POLE AND ORIENTATION.
+C
+  109 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*RTOD
+      V=90.-ACOS(COSA)*RTOD
+      GO TO 116
+C
+C MERCATOR, ARBITRARY POLE AND ORIENTATION.
+C
+  110 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)
+      V=ALOG((1.+COSA)/SINA)
+      GO TO 116
+C
+C MOLLWEIDE, ARBITRARY POLE AND ORIENTATION.
+C
+  111 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*TOPI
+      P=U
+      V=COSA
+      U=U*SINA
+      GO TO 117
+C
+C FAST-PATH CYLINDRICAL PROJECTIONS (WITH PLAT=ROTA=0).
+C
+  112 IF (IPRJ-12) 113,114,901
+C
+C FAST-PATH MERCATOR.
+C
+  113 IF (ABS(RLAT).GT.89.9999) GO TO 118
+      U=U*DTOR
+      V=ALOG(TAN((RLAT+90.)*DTRH))
+      GO TO 116
+C
+C FAST-PATH MOLLWEIDE.
+C
+  114 U=U/90.
+      V=SIN(RLAT*DTOR)
+      P=U
+      U=U*SQRT(1.-V*V)
+      GO TO 117
+C
+C COMMON TERMINAL CODE FOR CERTAIN PROJECTIONS.
+C
+  115 U=R*(SINB*COSR+COSB*SINR)
+      V=R*(COSB*COSR-SINB*SINR)
+C
+  116 P=U
+C
+  117 Q=V
+C
+C NORMAL EXIT.
+C
+      RETURN
+C
+C PROJECTION OF POINT IS INVISIBLE OR UNDEFINED.
+C
+  118 U=1.E12
+      P=U
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IF (IIER.NE.0) GO TO 118
+      IIER=16
+      CALL SETER (' MAPTRN - ATTEMPT TO USE NON-EXISTENT PROJECTION',
+     +              IIER,1)
+      GO TO 118
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPUSR (IPRT)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPVEC (XLAT,XLON)
+      CALL MAPIT (XLAT,XLON,1)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE SUPCON (RLAT,RLON,UVAL,VVAL)
+      CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2,PLM3,PLM4,JLTS,
+     +                   JGRD,IOUT,IDOT,IERR)
+C
+      DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+      DIMENSION LPRJ(10),LLTS(5)
+C
+      DATA LPRJ / 2,3,1,4,5,6,10,7,8,9 /
+      DATA LLTS / 1,2,5,4,3 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','SUPMAP','VERSION  1')
+C
+C SET EZMAP'S GRID-SPACING PARAMETER.
+C
+      CALL MAPSTI ('GR',MOD(IABS(JGRD),1000))
+C
+C SET EZMAP'S OUTLINE-SELECTION PARAMETER.
+C
+      IF (IABS(IOUT).EQ.0.OR.IABS(IOUT).EQ.1) THEN
+        I=1+2*IABS(IOUT)+(1+ISIGN(1,JPRJ))/2
+      ELSE
+        I=MAX0(1,MIN0(5,IOUT))
+      END IF
+C
+      CALL MAPSTC ('OU',DDCT(I))
+C
+C SET EZMAP'S PERIMETER-DRAWING FLAG.
+C
+      CALL MAPSTL ('PE',JGRD.GE.0)
+C
+C SET EZMAP'S GRID-LINE-LABELLING FLAG.
+C
+      CALL MAPSTL ('LA',MOD(IABS(JGRD),1000).NE.0)
+C
+C SET EZMAP'S DOTTED-OUTLINE FLAG.
+C
+      CALL MAPSTI ('DO',MAX0(0,MIN0(1,IDOT)))
+C
+C SET EZMAP'S PROJECTION-SELECTION PARAMETERS.
+C
+      I=MAX0(1,MIN0(10,IABS(JPRJ)))
+      CALL MAPROJ (PDCT(LPRJ(I)),PLAT,PLON,ROTA)
+C
+C SET EZMAP'S RECTANGULAR-LIMITS-SELECTION PARAMETERS.
+C
+      I=LLTS(MAX0(1,MIN0(5,IABS(JLTS))))
+      CALL MAPSET (LDCT(I),PLM1,PLM2,PLM3,PLM4)
+C
+C DRAW THE MAP.
+C
+      CALL MAPDRW
+C
+C RETURN THE ERROR FLAG TO THE USER.
+C
+      IERR=IIER
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C***********************************************************************
+C T H E   C O D E   -   I N T E R N A L   R O U T I N E S
+C***********************************************************************
+C
+      SUBROUTINE MAPCEM (IEM1,IEM2,IIER,IFLG)
+C
+      CHARACTER*(*) IEM1,IEM2
+C
+C MAPCEM IS CALLED TO DO A CALL TO SETER WHEN THE ERROR MESSAGE TO BE
+C PRINTED IS IN TWO PARTS WHICH NEED TO BE CONCATENATED.  FORTRAN-77
+C RULES MAKE IT NECESSARY TO CONCATENATE THE TWO PARTS OF THE MESSAGE
+C INTO A LOCAL CHARACTER VARIABLE.
+C
+      CHARACTER*100 IEMC
+C
+      IEMC=IEM1//IEM2
+      CALL SETER (IEMC,IIER,IFLG)
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPCHI (IPRT,IDTG,IDPT)
+C
+C MAPCHI IS CALLED BY VARIOUS EZMAP ROUTINES TO RESET THE INTENSITY,
+C DOTTING, AND DASH PATTERN BEFORE AND AFTER DRAWING PARTS OF A MAP.
+C
+C THE ARGUMENT IPRT, IF POSITIVE, SAYS WHICH PART OF THE MAP IS ABOUT
+C TO BE DRAWN, AS FOLLOWS:
+C
+C     IPRT    PART OF MAP.
+C     ----    ------------
+C       1     PERIMETER.
+C       2     GRID.
+C       3     LABELLING.
+C       4     LIMB LINES.
+C       5     OUTLINE POINT GROUP, CONTINENTAL.
+C       6     OUTLINE POINT GROUP, U.S.
+C       7     OUTLINE POINT GROUP, COUNTRY.
+C
+C A CALL WITH IPRT EQUAL TO THE NEGATIVE OF ONE OF THESE VALUES ASKS
+C THAT THE INTENSITY SAVED BY THE LAST CALL, WITH IPRT POSITIVE, BE
+C RESTORED.
+C
+C WHEN IPRT IS POSITIVE, IDTG IS ZERO IF SOLID LINES ARE TO BE USED, 1
+C IF DOTTED LINES ARE TO BE USED.  IF IPRT IS NEGATIVE, IDTG IS IGNORED.
+C
+C WHEN IPRT IS POSITIVE AND IDTG IS ZERO, IDPT IS THE DASH PATTERN TO BE
+C USED.  IF IPRT IS NEGATIVE OR IDTG IS NON-ZERO, IDPT IS IGNORED.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPNTS/ INTS(7)
+C
+C DECLARE ONE OF THE DASH-PACKAGE COMMON BLOCKS, TOO.
+C
+      COMMON /SMFLAG/ ISMO
+C
+C THE VARIABLES INTO, IDTS, AND ISMS NEED TO BE SAVED BETWEEN CALLS.
+C
+      SAVE INTO,IDTS,ISMS
+C
+C FLUSH ALL BUFFERS BEFORE CHANGING ANYTHING.
+C
+      CALL MAPIQ
+C
+C SET/RESET INTENSITY, DOTTING, AND DASH PATTERN.  THE USER HAS THE
+C LAST WORD.
+C
+      IF (IPRT.GT.0) THEN
+        ISMS=ISMO
+        ISMO=1
+        IDTS=IDTL
+        IDTL=IDTG
+        IF (IDTL.EQ.0) CALL DASHDB (IDPT)
+C
+C THE FOLLOWING LINES HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY
+C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND
+C WORKSTATIONS.
+C
+C        CALL GETUSV ('IN',INTO)
+C        CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.))
+        CALL MAPUSR (IPRT)
+      ELSE
+        CALL MAPUSR (IPRT)
+C
+C THE FOLLOWING LINE HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY
+C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND
+C WORKSTATIONS.
+C
+C        CALL SETUSV ('IN',INTO)
+        IF (IDTL.EQ.0) CALL DASHDB (IOR(ISHIFT(32767,1),1))
+        IDTL=IDTS
+        ISMO=ISMS
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      INTEGER FUNCTION IDICTL (ISTR,IDCT,NDCT)
+C
+      CHARACTER*(*) ISTR
+      CHARACTER*2 IDCT(NDCT)
+C
+C THE VALUE OF THIS FUNCTION IS THE INDEX IN THE NDCT-ELEMENT DICTIONARY
+C IDCT OF THE STRING ISTR.  ONLY THE FIRST TWO CHARACTERS OF ISTR AND
+C IDCT(I) ARE COMPARED.  IF ISTR IS NOT FOUND IN THE DICTIONARY, THE
+C FUNCTION VALUE IS ZERO.
+C
+      DO 101 I=1,NDCT
+        IF (ISTR(1:2).EQ.IDCT(I)) THEN
+          IDICTL=I
+          RETURN
+        END IF
+  101 CONTINUE
+C
+C NOT FOUND.  RETURN A ZERO.
+C
+      IDICTL=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIO (IACT)
+C
+C THIS ROUTINE PERFORMS ALL POSITIONING AND INPUT OF THE OUTLINE DATASET
+C FOR MAPLOT.  THE ARGUMENT IACT SPECIFIES WHAT IS TO BE DONE:  1 ASKS
+C THAT THE DATASET BE POSITIONED AT THE BEGINNING OF THE DESIRED "FILE",
+C 2 THAT THE NEXT RECORD BE READ.
+C
+C FIVE LINES OF THE CODE BELOW HAVE BEEN INSERTED TO MAKE THIS ROUTINE
+C RUN EFFICIENTLY ON NCAR'S CRAYS; THESE LINES SHOULD BE REMOVED BY
+C ANYONE IMPLEMENTING EZMAP ON ANOTHER SYSTEM (EXCEPT PERHAPS ANOTHER
+C CRAY).
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCMB/ IERR
+C
+      IF (IACT.EQ.1) THEN
+C
+C POSITION TO THE DESIRED "FILE" WITHIN THE DATASET.
+C
+C THE FOLLOWING FIVE LINES ARE FOR NCAR'S CRAYS.
+C
+C       ITPN=6LEZMPDT
+C       IF (IFDNT(ITPN).EQ.0) THEN
+C         CALL SDACCESS (IERR,ITPN)
+C         IF (IERR.NE.0) GO TO 901
+C       END IF
+C
+        REWIND ITPN
+C
+        IF (NOUT.NE.1) THEN
+          ITMP=NOUT
+  101     READ (ITPN,END=902) NPTS,IGID,BLAG,SLAG,BLOG,SLOG,
+     +                                                (PNTS(I),I=1,NPTS)
+          IF (NPTS.GT.1) GO TO 101
+          ITMP=ITMP-1
+          IF (ITMP.GT.1) GO TO 101
+        END IF
+C
+      ELSE
+C
+C READ THE NEXT RECORD.
+C
+        READ (ITPN) NPTS,IGID,BLAG,SLAG,BLOG,SLOG,(PNTS(I),I=1,NPTS)
+        NPTS=NPTS/2
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=17
+      CALL SETER (' MAPIO - OUTLINE DATASET IS UNREADABLE',IIER,1)
+      NOUT=0
+      RETURN
+C
+  902 IIER=18
+      CALL SETER (' MAPIO - EOF ENCOUNTERED IN OUTLINE DATASET',IIER,1)
+      NOUT=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLMB
+C
+C THE ROUTINE MAPLMB IS CALLED BY MAPGRD AND/OR MAPLOT TO DRAW THE LIMB
+C LINES.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C DEFINE REQUIRED CONSTANTS.  SIN1 AND COS1 ARE RESPECTIVELY THE SINE
+C AND COSINE OF ONE DEGREE.
+C
+      DATA SIN1 / .017452406437283 /
+      DATA COS1 / .999847695156390 /
+      DATA PI   / 3.14159265358979 /
+C
+C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY,
+C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND
+C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X.
+C
+      FLOOR(X)=AINT(X+1.E4)-1.E4
+      CLING(X)=-FLOOR(-X)
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LIMB LINES.
+C
+      CALL MAPCHI (4,0,IOR(ISHIFT(32767,1),1))
+C
+C DRAW LIMB LINES, THE NATURE OF WHICH DEPENDS ON THE PROJECTION.
+C
+      GO TO (101,110,104,105,110,106,110,110,107,110,110,107) , IPRJ
+C
+C LAMBERT CONFORMAL CONIC WITH TWO STANDARD PARALLELS.
+C
+  101 DLAT=GRDR
+      RLON=PHIO+179.9999
+      K=CLING(180./DLAT)
+      DO 103 I=1,2
+        RLAT=-90.
+        CALL MAPIT (RLAT,RLON,0)
+        DO 102 J=1,K-1
+          RLAT=RLAT+DLAT
+          CALL MAPIT (RLAT,RLON,1)
+  102   CONTINUE
+        RLAT=RLAT+DLAT
+        CALL MAPIT (RLAT,RLON,2)
+        RLON=PHIO-179.9999
+  103 CONTINUE
+      GO TO 110
+C
+C ORTHOGRAPHIC (OR SATELLITE-VIEW).
+C
+  104 IF (ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+        URAD=1.
+        RVTU=1.
+      ELSE
+        DNOM=SALT*SALT*CALF*CALF-1.
+        URAD=SSMO*CALF/DNOM
+        RVTU=SQRT(DNOM)/SRSS
+      END IF
+      GO TO 108
+C
+C LAMBERT EQUAL AREA.
+C
+  105 URAD=2.
+      RVTU=1.
+      GO TO 108
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  106 URAD=PI
+      RVTU=1.
+      GO TO 108
+C
+C MOLLWEIDE.
+C
+  107 URAD=2.
+      RVTU=0.5
+C
+  108 UCIR=URAD
+      VCIR=0.
+      IVIS=-1
+      DO 109 I=1,361
+        IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+          U=UCIR
+          V=RVTU*VCIR
+        ELSE
+          UTMP=UCIR-SRSS*SALF/DNOM
+          VTMP=RVTU*VCIR
+          U=UTMP*CBET-VTMP*SBET
+          V=VTMP*CBET+UTMP*SBET
+        END IF
+        IF (.NOT.ELPF.AND.
+     +      (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX)) THEN
+          IF (IVIS.EQ.1) THEN
+            CALL MAPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
+            CALL MAPVP  (UOLD,VOLD,UEDG,VEDG)
+          END IF
+          IVIS=0
+        ELSE IF (ELPF.AND.
+     +           (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.)) THEN
+          IF (IVIS.EQ.1) THEN
+            CALL MAPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
+            CALL MAPVP  (UOLD,VOLD,UEDG,VEDG)
+          END IF
+          IVIS=0
+        ELSE
+          IF (IVIS.LT.0) THEN
+            DATL=0.
+            CALL FRSTD (U,V)
+            IVIS=1
+          ELSE
+            IF (IVIS.EQ.0) THEN
+              IF (.NOT.ELPF) CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
+              IF (     ELPF) CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
+              DATL=0.
+              CALL FRSTD (UOLD,VOLD)
+              IVIS=1
+            END IF
+            CALL MAPVP (UOLD,VOLD,U,V)
+          END IF
+        END IF
+        UOLD=U
+        VOLD=V
+        UTMP=UCIR
+        VTMP=VCIR
+        UCIR=UTMP*COS1-VTMP*SIN1
+        VCIR=UTMP*SIN1+VTMP*COS1
+  109 CONTINUE
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+  110 CALL MAPCHI (-4,0,0)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRE (UINS,VINS,UOUT,VOUT,UINT,VINT)
+C
+C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE
+C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF AN ELLIPTICAL FRAME.
+C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME.
+C
+C BECAUSE MAPTRE CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT
+C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT
+C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C WHAT'S INVOLVED IS JUST A LOT OF ALGEBRA.
+C
+      IF (ABS(UOUT-UINS).GT.ABS(VOUT-VINS)) THEN
+        P=(VOUT-VINS)/(UOUT-UINS)
+        Q=(UOUT*VINS-UINS*VOUT)/(UOUT-UINS)
+        A=VRNG*VRNG+P*P*URNG*URNG
+        B=2.*(P*Q*URNG*URNG-UCEN*VRNG*VRNG-P*URNG*URNG*VCEN)
+        C=UCEN*UCEN*VRNG*VRNG+Q*Q*URNG*URNG-2.*Q*URNG*URNG*VCEN+
+     +                           URNG*URNG*VCEN*VCEN-URNG*URNG*VRNG*VRNG
+        UTM1=SQRT(AMAX1(B*B-4.*A*C,0.))
+        UTM2=.5*(-B-UTM1)/A
+        IF ((UTM2-UOUT)*(UTM2-UINS).GT.0.) UTM2=.5*(-B+UTM1)/A
+        UINT=UTM2
+        VINT=P*UINT+Q
+      ELSE
+        P=(UOUT-UINS)/(VOUT-VINS)
+        Q=(UINS*VOUT-UOUT*VINS)/(VOUT-VINS)
+        A=URNG*URNG+P*P*VRNG*VRNG
+        B=2.*(P*Q*VRNG*VRNG-URNG*URNG*VCEN-P*UCEN*VRNG*VRNG)
+        C=URNG*URNG*VCEN*VCEN+Q*Q*VRNG*VRNG-2.*Q*UCEN*VRNG*VRNG+
+     +                           UCEN*UCEN*VRNG*VRNG-URNG*URNG*VRNG*VRNG
+        VTM1=SQRT(AMAX1(B*B-4.*A*C,0.))
+        VTM2=.5*(-B-VTM1)/A
+        IF ((VTM2-VOUT)*(VTM2-VINS).GT.0.) VTM2=.5*(-B+VTM1)/A
+        VINT=VTM2
+        UINT=P*VINT+Q
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRP (UINS,VINS,UOUT,VOUT,UINT,VINT)
+C
+C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE
+C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF A RECTANGULAR FRAME.
+C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME.
+C
+C BECAUSE MAPTRP CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT
+C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT
+C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C GIVEN ONE COORDINATE OF A POINT ON THE LINE JOINING (UINS,VINS) AND
+C (UOUT,VOUT), THE OTHER CAN BE OBTAINED BY USING ONE OF THE FOLLOWING
+C ARITHMETIC STATEMENT FUNCTIONS:
+C
+      UFUN(V)=UINS+(V-VINS)*DU/DV
+      VFUN(U)=VINS+(U-UINS)*DV/DU
+C
+C                                      I     I
+C                                   5  I  4  I  6
+C                                      I     I
+C                                 -----------------
+C FIRST, DETERMINE IN WHICH            I     I
+C OF THE AREAS SHOWN THE            2  I  1  I  3
+C POINT (UOUT,VOUT) LIES.              I     I
+C                                 -----------------
+C                                      I     I
+C                                   8  I  7  I  9
+C                                      I     I
+C
+      IREA=1
+      IF (UOUT-UMIN) 101,104,102
+  101 IREA=IREA+1
+      GO TO 104
+  102 IF (UOUT-UMAX) 104,104,103
+  103 IREA=IREA+2
+  104 IF (VOUT-VMIN) 105,108,106
+  105 IREA=IREA+6
+      GO TO 108
+  106 IF (VOUT-VMAX) 108,108,107
+  107 IREA=IREA+3
+C
+C NEXT, COMPUTE THE QUANTITIES REQUIRED BY UFUN AND VFUN AND JUMP TO THE
+C APPROPRIATE PIECE OF CODE FOR THE GIVEN AREA.
+C
+  108 DU=UOUT-UINS
+      DV=VOUT-VINS
+C
+      GO TO (119,113,114,115,109,110,116,111,112) , IREA
+C
+  109 IF (UFUN(VMAX)-UMIN) 113,115,115
+  110 IF (UFUN(VMAX)-UMAX) 115,115,114
+  111 IF (UFUN(VMIN)-UMIN) 113,116,116
+  112 IF (UFUN(VMIN)-UMAX) 116,116,114
+C
+  113 UINT=UMIN
+      GO TO 117
+  114 UINT=UMAX
+      GO TO 117
+  115 VINT=VMAX
+      GO TO 118
+  116 VINT=VMIN
+      GO TO 118
+C
+  117 VINT=VFUN(UINT)
+      RETURN
+C
+  118 UINT=UFUN(VINT)
+      RETURN
+C
+  119 UINT=UOUT
+      VINT=VOUT
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPVP (UOLD,VOLD,U,V)
+C
+C PLOT THE LINE SEGMENT FROM (UOLD,VOLD) TO (U,V), USING EITHER A SOLID
+C LINE OR A DOTTED LINE (DEPENDING ON THE VALUE OF THE COMMON VARIABLE
+C IDTL).
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C SELECT VECTOR OR DOT MODE.
+C
+      IF (IDTL.EQ.0) THEN
+C
+C USE A SINGLE VECTOR.
+C
+        CALL VECTD (U,V)
+C
+      ELSE
+C
+C USE DOTS.  DELU AND DELV ARE THE U AND V COMPONENTS OF THE VECTOR
+C JOINING (UOLD,VOLD) TO (U,V) AND VLEN IS THE LENGTH OF THE VECTOR.
+C
+        DELU=U-UOLD
+        DELV=V-VOLD
+C
+        VLEN=SQRT(DELU*DELU+DELV*DELV)
+C
+C NOW DISTRIBUTE DOTS ALONG THE VECTOR.  THE FIRST ONE IS SPACED JUST
+C FAR ENOUGH ALONG IT (DATL UNITS) TO BE DBTD UNITS AWAY FROM THE LAST
+C DOT ON THE PREVIOUS VECTOR AND THE REST ARE DBTD UNITS APART.
+C
+  101   IF (DATL.LT.VLEN) THEN
+          IF (NPTB.GE.50) THEN
+            CALL POINTS (XPTB,YPTB,NPTB,0,0)
+            NPTB=0
+          END IF
+          NPTB=NPTB+1
+          XPTB(NPTB)=UOLD+(DATL/VLEN)*DELU
+          YPTB(NPTB)=VOLD+(DATL/VLEN)*DELV
+          DATL=DATL+DBTD
+          GO TO 101
+        END IF
+C
+C SET DATL FOR THE NEXT CALL.
+C
+        DATL=DATL-VLEN
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C***********************************************************************
+C T H E   B L O C K   D A T A   " R O U T I N E "   -   D E F A U L T S
+C***********************************************************************
+C
+      BLOCK DATA MAPBD
+C
+C THE COMMON BLOCK MAPCM1 CONTAINS TRANSFORMATION CONSTANTS.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+C
+C THE COMMON BLOCK MAPCM2 CONTAINS AREA-SPECIFICATION VARIABLES.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C THE COMMON BLOCK MAPCM3 CONTAINS PARAMETERS HAVING TO DO WITH READING
+C THE DATA FOR OUTLINES.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+C
+C THE COMMON BLOCK MAPCM4 CONTAINS MOST OF THE INPUT PARAMETERS.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+C
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+C
+C THE COMMON BLOCK MAPCM5 CONTAINS VARIOUS LISTS ("DICTIONARIES") OF
+C TWO-CHARACTER CODES REQUIRED BY EZMAP FOR PARAMETER-SETTING.
+C
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+C
+      CHARACTER*2     DDCT,LDCT,PDCT
+C
+C THE COMMON BLOCK MAPCM7 CONTAINS PARAMETERS DESCRIBING THE PORTION OF
+C THE PLOTTER FRAME BEING USED.
+C
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+C
+C THE COMMON BLOCK MAPCM8 CONTAINS PARAMETERS SET BY MAPTRN AND USED BY
+C MAPIT IN HANDLING "CROSS-OVER" PROBLEMS.
+C
+      COMMON /MAPCM8/ P,Q,R
+C
+C THE COMMON BLOCK MAPCMA CONTAINS VALUES WHICH ARE USED TO POSITION
+C DOTS ALONG DOTTED OUTLINES AND TO AVOID DRAWING VECTORS WHICH ARE
+C TOO SHORT.
+C
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+C
+C THE COMMON BLOCK MAPCMB CONTAINS THE EZMAP ERROR FLAG.
+C
+      COMMON /MAPCMB/ IIER
+C
+C THE COMMON BLOCK MAPCMP CONTAINS THE BUFFERS IN WHICH THE X AND Y
+C COORDINATES OF POINTS ARE COLLECTED FOR AN EVENTUAL CALL TO POINTS.
+C
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C THE COMMON BLOCK MAPNTS CONTAINS QUANTITIES SPECIFYING THE INTENSITIES
+C TO BE USED FOR VARIOUS PORTIONS OF THE PLOT.
+C
+      COMMON /MAPNTS/ INTS(7)
+C
+C THE COMMON BLOCK MAPSAT CONTAINS PARAMETERS FOR THE SATELLITE-VIEW
+C PROJECTION.
+C
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C
+C BELOW ARE DESCRIPTIONS OF THE VARIABLES IN EACH OF THE COMMON BLOCKS,
+C TOGETHER WITH DATA STATEMENTS GIVING DEFAULT VALUES TO THOSE VARIABLES
+C WHICH NEED DEFAULT VARIABLES.
+C
+C
+C VARIABLES IN MAPCM1:
+C
+C IPRJ IS AN INTEGER BETWEEN 1 AND 12, SPECIFYING WHAT PROJECTION IS
+C CURRENTLY IN USE.  THE VALUES 10, 11, AND 12 SPECIFY FAST-PATH
+C VERSIONS OF THE VALUES 7, 8, AND 9, RESPECTIVELY.  SINO, COSO, SINR,
+C COSR, AND PHOC ARE PROJECTION VARIABLES COMPUTED BY MAPINT FOR USE BY
+C MAPTRN.  PHOC, AS IT HAPPENS, IS JUST A COPY OF PHIO, FROM THE COMMON
+C BLOCK MAPCM4.
+C
+C
+C VARIABLES IN MAPCM2:
+C
+C UMIN, UMAX, VMIN, AND VMAX SPECIFY THE LIMITS OF THE RECTANGLE TO BE
+C DRAWN, IN PROJECTION SPACE.  UEPS AND VEPS ARE SET BY MAPINT FOR USE
+C IN MAPIT IN TESTING FOR CROSS-OVER PROBLEMS.  UCEN, VCEN, URNG, AND
+C VRNG ARE COMPUTED BY MAPINT FOR USE WHEN THE MAP PERIMETER IS MADE
+C ELLIPTICAL (BY SETTING THE FLAG ELPF).  BLAM, SLAM, BLOM, AND SLOM
+C ARE RESPECTIVELY THE BIGGEST LATITUDE, THE  SMALLEST LATITUDE, THE
+C BIGGEST LONGITUDE, AND THE SMALLEST LONGITUDE ON THE MAP.  THEY ARE
+C USED IN MAPGRD AND IN MAPLOT TO MAKE THE DRAWING OF GRIDS AND OUTLINES
+C MORE EFFICIENT.  UMIN AND UMAX ARE GIVEN DEFAULT VALUES TO PREVENT
+C IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS SET PRIOR TO THE
+C FIRST CALL TO MAPINT.
+C
+      DATA UMIN,UMAX / 0.,1. /
+C
+C
+C VARIABLES IN MAPCM3:
+C
+C ITPN IS THE UNIT NUMBER OF THE "TAPE" FROM WHICH OUTLINE DATA IS TO
+C BE READ.  NOUT IS THE NUMBER OF THE OUTLINE TO BE USED; THE VALUES 0
+C THROUGH 5 IMPLY 'NO', 'CO', 'US', 'PS', AND 'PO', RESPECTIVELY; THUS,
+C IF NOUT IS ZERO, NO OUTLINES ARE TO BE USED, AND, IF IT IS NON-ZERO,
+C IT IS THE NUMBER OF THE "FILE" TO BE READ FROM UNIT ITPN.  NPTS, JUST
+C AFTER A READ, IS THE NUMBER OF ELEMENTS READ INTO PNTS; IT IS THEN
+C DIVIDED BY 2 TO BECOME THE NUMBER OF POINTS DEFINED BY THE GROUP JUST
+C READ.  IGID IS AN IDENTIFIER FOR THE GROUP, SO THAT, FOR EXAMPLE, ONE
+C CAN DISTINGUISH A GROUP BELONGING TO A INTERNATIONAL BOUNDARY FROM
+C ONE BELONGING TO A U.S. STATE BOUNDARY.  BLAG, SLAG, BLOG, AND SLOG
+C SPECIFY THE BIGGEST AND SMALLEST LATITUDE AND THE BIGGEST AND SMALLEST
+C LONGITUDE OF THE POINTS IN THE GROUP, SO THAT, IN SOME CASES AT LEAST,
+C ONE CAN DECIDE QUICKLY NOT TO BOTHER WITH THE GROUP.  PNTS CONTAINS
+C NPTS COORDINATE PAIRS, EACH CONSISTING OF A LATITUDE AND A LONGITUDE,
+C IN DEGREES.
+C
+      DATA ITPN,NOUT / 1,1 /
+C
+C
+C VARIABLES IN MAPCM4:
+C
+C INTF IS A FLAG WHOSE VALUE AT ANY GIVEN TIME INDICATES WHETHER THE
+C PACKAGE EZMAP IS IN NEED OF INITIALIZATION (.TRUE.) OR NOT (.FALSE).
+C JPRJ IS AN INTEGER BETWEEN 1 AND 9 INDICATING THE TYPE OF PROJECTION
+C CURRENTLY IN USE.  PHIA, PHIO, AND ROTA ARE THE POLE LATITUDE AND
+C LONGITUDE AND THE ROTATION ANGLE SPECIFIED BY THE LAST USER CALL TO
+C MAPROJ.  ILTS IS AN INTEGER BETWEEN 1 AND 5, SPECIFYING HOW THE LIMITS
+C OF THE MAP ARE TO BE CHOSEN.  PLA1-4 AND PLB1-4 ARE THE VALUES GIVEN
+C BY THE USER FOR PLM1(1), PLM2(1), ..., PLM1(2), PLM2(2), ..., IN THE
+C LAST CALL TO MAPSET.  PLTR IS THE PLOTTER RESOLUTION - EFFECTIVELY,
+C THE NUMBER OF ADDRESSABLE POINTS IN THE X DIRECTION.  GRID IS THE
+C DESIRED SPACING BETWEEN GRID LINES, IN DEGREES OF LATITUDE/LONGITUDE.
+C IDSH IS THE DESIRED DASH PATTERN (16-BIT BINARY) FOR GRID LINES.  IDOT
+C IS A FLAG SELECTING SOLID OUTLINES (0) OR DOTTED OUTLINES (1).  LBLF
+C IS A LOGICAL FLAG INDICATING WHETHER THE INTERNATIONAL DATE LINE, THE
+C EQUATOR, THE GREENWICH MERIDIAN, AND THE POLES ARE TO BE LABELLED OR
+C NOT.  PRMF IS A LOGICAL FLAG INDICATING WHETHER OR NOT A PERIMETER
+C IS TO BE DRAWN.  ELPF IS A LOGICAL FLAG INDICATING WHETHER THE MAP
+C PERIMETER IS TO BE RECTANGULAR (.FALSE.) OR ELLIPTICAL (.TRUE.).
+C XLOW, XROW, YBOW, AND YTOW ARE FRACTIONS BETWEEN 0. AND 1. SPECIFYING
+C THE POSITION OF AREA OF THE PLOTTER FRAME IN WHICH THE MAP IS TO BE
+C PUT; THE MAP IS CENTERED IN THIS AREA AND MADE AS LARGE AS POSSIBLE.
+C IDTL IS A FLAG SPECIFYING THAT MAPIT SHOULD DRAW SOLID OUTLINES (0)
+C OR DOTTEN OUTLINES (1).  GRDR AND SRCH ARE MEASURED IN DEGREES AND
+C LIE IN THE RANGE FROM .001 TO 10.  GRDR SPECIFIES THE RESOLUTION WITH
+C WHICH THE GRID IS TO BE DRAWN AND SRCH THE ACCURACY WITH WHICH THE
+C LATITUDE/LONGITUDE LIMITS OF THE MAP ARE TO BE FOUND.  ILCW IS THE
+C CHARACTER WIDTH FOR CHARACTERS IN THE LABEL, AS REQUIRED FOR USE IN A
+C CALL TO PWRIT.
+C
+      DATA INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,PLB1,PLB2 /
+     1   .TRUE.,   7,  0.,  0.,  0.,   1,  0.,  0.,  0.,  0.,  0.,  0. /
+C
+      DATA PLB3,PLB4, PLTR,GRID, IDSH,IDOT, LBLF , PRMF ,  ELPF ,IDTL /
+     1       0.,  0.,4096., 10.,21845,   0,.TRUE.,.TRUE.,.FALSE.,   0 /
+C
+      DATA XLOW,XROW,YBOW,YTOW / .05,.95,.05,.95 /
+C
+      DATA GRDR,SRCH / 1.,1. /
+C
+      DATA ILCW / 1 /
+C
+C
+C VARIABLES IN MAPCM5:
+C
+C DDCT IS THE DICTIONARY OF AVAILABLE DATASETS, LDCT THE DICTIONARY OF
+C MAP LIMIT DEFINITION TYPES, AND PDCT THE DICTIONARY OF MAP PROJECTION
+C NAMES.
+C
+      DATA DDCT / 'NO','CO','US','PS','PO' /
+C
+      DATA LDCT / 'MA','CO','PO','AN','LI' /
+C
+      DATA PDCT / 'LC','ST','OR','LE','GN','AE','CE','ME','MO','SV' /
+C
+C
+C VARIABLES IN MAPCM7:
+C
+C ULOW, UROW, VBOW, AND VTOW DEFINE THE FRACTION OF THE PLOTTER FRAME
+C TO BE OCCUPIED BY THE MAP - THEY MAY BE THOUGHT OF AS THE FIRST FOUR
+C ARGUMENTS OF THE SET CALL OR, IN THE GKS SCHEME, AS THE VIEWPORT.
+C THEY ARE COMPUTED BY MAPINT.  ULOW AND UROW ARE GIVEN DEFAULT VALUES
+C TO PREVENT CODE IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS
+C SET PRIOR TO THE FIRST CALL TO MAPINT.
+C
+      DATA ULOW,UROW / 0.,1. /
+C
+C
+C VARIABLES IN MAPCM8:
+C
+C P, Q, AND R ARE SET BY MAPTRN EACH TIME IT MAPS (RLAT,RLON) TO (U,V).
+C Q IS ALWAYS EQUAL TO V, BUT P IS NOT ALWAYS EQUAL TO U.  INSTEAD, IT
+C IS A VALUE OF U FROM AN INTERMEDIATE STEP IN THE PROJECTION PROCESS.
+C FOR THE LAMBERT CONFORMAL CONIC, P IS THE DISTANCE, IN LONGITUDE, FROM
+C THE CENTRAL MERIDIAN.  FOR THE CYLINDRICAL PROJECTIONS, P IS A VALUE
+C OF U PRIOR TO MULTIPLICATION BY A FUNCTION OF V SHRINKING THE MAP
+C TOWARD A VERTICAL BISECTOR.  THEY ARE ALL USED BY MAPIT, WHILE DRAWING
+C LINES FROM POINT TO POINT, TO DETECT "CROSS-OVER" (A JUMP FROM ONE
+C SIDE OF THE MAP TO THE OTHER, CAUSED BY THE PROJECTION'S HAVING SLIT
+C THE GLOBE ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT OPEN WITH THE
+C TWO SIDES OF THE SLIT AT OPPOSITE ENDS OF THE MAP).
+C
+C
+C VARIABLES IN MAPCMA:
+C
+C DPLT IS THE MIMIMUM VECTOR LENGTH; MAPIT REQUIRES TWO POINTS TO BE AT
+C LEAST DPLT PLOTTER UNITS APART BEFORE IT WILL JOIN THEM WITH A VECTOR.
+C DDTS IS THE DESIRED DISTANCE IN PLOTTER UNITS BETWEEN DOTS IN A DOTTED
+C OUTLINE.  THESE VALUES ARE RELATIVE TO THE "PLOTTER RESOLUTION" PLTR;
+C DPLT/PLTR IS A FRACTION OF THE PLOTTER FRAME.  DSCA IS THE RATIO OF
+C THE LENGTH OF A VECTOR, MEASURED IN PLOTTER UNITS, TO THE LENGTH OF
+C THE SAME VECTOR, MEASURED IN THE U/V PLANE.  THUS, GIVEN A VECTOR OF
+C LENGTH D IN THE U/V PLANE, D*DSCA IS ITS LENGTH IN PLOTTER UNITS.
+C DPSQ AND DSSQ ARE THE SQUARES OF DPLT AND DSCA, RESPECTIVELY.  DBTD
+C IS THE DISTANCE, IN THE U/V PLANE, BETWEEN TWO DOTS DDTS PLOTTER
+C UNITS APART.  DPLT AND DDTS HAVE THE VALUES GIVEN BELOW AND ARE NOT
+C RESET BY THE CODE; DSCA, DPSQ, DSSQ, AND DBTD ARE COMPUTED BY MAPINT.
+C DSCA IS GIVEN A DEFAULT VALUE ONLY TO KEEP THE ROUTINES MAPSTI AND
+C MAPSTR FROM BLOWING UP WHEN DDTS IS SET PRIOR TO ANY CALL TO MAPINT.
+C DATL IS USED BY MAPIT AND MAPVP TO KEEP TRACK OF WHERE THE NEXT POINT
+C ALONG A CURVE SHOULD GO.
+C
+      DATA DPLT,DDTS,DSCA / 4.,12.,1. /
+C
+C
+C VARIABLES IN MAPCMB:
+C
+C IIER IS AN ERROR FLAG, SET WHENEVER AN ERROR OCCURS DURING A CALL TO
+C ONE OF THE EZMAP ROUTINES.  ITS VALUE MAY BE RETRIEVED BY A CALL TO
+C MAPGTI.
+C
+      DATA IIER / 0 /
+C
+C
+C VARIABLES IN MAPCMP:
+C
+C NPTB IS THE NUMBER OF POINTS WHOSE COORDINATES HAVE BEEN COLLECTED IN
+C THE ARRAYS XPTB AND YPTB FOR EVENTUAL OUTPUT BY A CALL TO POINTS.
+C
+      DATA NPTB / 0 /
+C
+C VARIABLES IN MAPNTS:
+C
+C THE ARRAY INTS SPECIFIES INTENSITIES TO BE USED FOR THE PERIMETER, FOR
+C THE GRID, FOR LABELLING, FOR LIMBS, FOR THE CONTINENTAL OUTLINES, FOR
+C THE U.S. STATE OUTLINES, AND FOR INTERNATIONAL POLITICAL OUTLINES.
+C SEE THE ROUTINE MAPCHI.  EACH ELEMENT IS AN INTEGER IN THE RANGE 0 TO
+C 255, INCLUSIVE.
+C
+      DATA INTS / 240,150,210,240,240,180,210 /
+C
+C
+C VARIABLES IN MAPSAT:
+C
+C THE ABSOLUTE VALUE OF SALT, IF GREATER THAN 1, SERVES AS A FLAG THAT
+C A SATELLITE-VIEW PROJECTION IS TO BE USED IN PLACE OF AN ORTHOGRAPHIC
+C PROJECTION; ITS VALUE IS THE DISTANCE OF THE SATELLITE FROM THE CENTER
+C OF THE EARTH, IN UNITS OF EARTH RADII.  IN THIS CASE, SSMO IS THE
+C SQUARE OF SALT MINUS 1 AND SRSS IS THE SQUARE ROOT OF SSMO.  IF ALFA
+C IS ZERO, THE PROJECTION SHOWS THE VIEW SEEN BY A SATELLITE LOOKING
+C STRAIGHT AT THE CENTER OF THE EARTH; CALL THIS THE BASIC SATELLITE
+C VIEW.  IF ALFA IS NON-ZERO, IT AND BETA ARE ANGLES, IN DEGREES,
+C DETERMINING WHERE THE LINE OF SIGHT OF THE PROJECTION IS.  IF E IS
+C AT THE CENTER OF THE EARTH, S IS AT THE SATELLITE, AND P IS A POINT
+C ALONG THE LINE OF SIGHT, THEN ALFA MEASURES THE ANGLE ESP.  IF O IS
+C THE POINT AT THE ORIGIN OF THE BASIC SATELLITE VIEW AND P IS THE
+C PROJECTION OF THE LINE OF SIGHT, THEN BETA MEASURES THE ANGULAR
+C DISTANCE FROM THE POSITIVE U AXIS TO THE LINE OP, POSITIVE IF
+C MEASURED COUNTER-CLOCKWISE.  SALF, CALF, SBET, AND CBET ARE SINES
+C AND COSINES OF ALFA AND BETA.  THE SIGN OF SALT INDICATES WHETHER A
+C NORMAL PROJECTION (POSITIVE) OR AN EXTENDED PROJECTION (NEGATIVE)
+C IS TO BE USED.  THE LATTER MAKES IT EASIER TO OVERLAY CONREC OUTPUT
+C ON ONE OF THESE PROJECTIONS, BY PROJECTING POINTS OUT OF SIGHT AROUND
+C THE LIMB TO POINT JUST OUTSIDE THE LIMB ON THE PROJECTED VIEW.
+C
+      DATA SALT,ALFA,BETA,SALF,CALF,SBET,CBET / 0.,0.,0.,0.,1.,0.,1. /
+C
+C REVISION HISTORY:
+C
+C FEBRUARY, 1982   ADDED MODIFICATIONS SO THAT POINTS GENERATED BY THE
+C                  DRAWING OF DOTTED CONTINENTAL OUTLINES ARE BUFFERED
+C                  AND THEN PUT OUT WITH A CALL TO POINTS, INSTEAD OF
+C                  BEING PUT OUT ONE AT A TIME WITH A CALL TO POINT AS
+C                  BEFORE.  THE LATTER RESULTED IN HUGE OVERHEAD IN THE
+C                  PLOT FILE.  ROUTINES MAPLOT AND MAPVP WERE MODIFIED,
+C                  AND A NEW COMMON BLOCK MAPCMP WAS ADDED.
+C
+C AUGUST, 1984     CONVERTED TO FORTRAN-77 AND GKS.  DELETED THE EZMAP
+C                  ENTRY POINT.
+C
+C MARCH, 1985      COMPLETELY OVERHAULED THE CODE TO SIMPLIFY IT AND TO
+C                  REMOVE KNOWN ERRORS.  UPDATED THE OUTLINE DATASET
+C                  TO REMOVE ERRORS AND TO INCLUDE INTERNATIONAL
+C                  BOUNDARIES.  IMPLEMENTED MANY CONTROLS AIMED AT
+C                  OBVIATING THE NEED FOR SOURCE MODIFICATION BY USERS.
+C
+C MAY, 1985        ADDED CODE TO PREVENT PROBLEMS WHEN A SMOOTHING
+C                  VERSION OF THE DASH PACKAGE IS LOADED.  ADDED CODE
+C                  IN MAPIT TO GET AROUND A CFT COMPILER PROBLEM.
+C                  ADDED CODE TO DO EXTENDED ORTHOGRAPHIC AND SATELLITE-
+C                  VIEW PROJECTIONS.
+C
+C JULY, 1985       FIXED A MISSING DECLARATION IN THE SUBROUTINE MAPSET
+C                  AND LIMITED "CALL PLOTIT (0,0,0)" TO THE GKS VERSION.
+C
+C AUGUST, 1985     FIXED A PROBLEM IN MAPGRD WHICH CAUSED MERIDIANS ON
+C                  MERCATOR MAPS WITH VERTICAL LIMITS TOO CLOSE TO THE
+C                  POLES TO BE DRAWN IMPROPERLY.  (THE TEST FOR CROSS-
+C                  OVER, IN MAPIT, WAS BEING PASSED BECAUSE THE POINTS
+C                  USED TO DRAW THE MERIDIANS WERE TOO FAR APART.)  ALSO
+C                  FIXED AN ERROR IN THE GKS CODE IN MAPCHI AND BEEFED
+C                  UP THE IMPLEMENTORS' INSTRUCTIONS TO SAY WHAT TO DO
+C                  WITH THAT ROUTINE WHEN COLOR IS AVAILABLE.
+C
+C NOVEMBER, 1985   ADDED CODE TO PREVENT GKS CLIPPING FROM DESTROYING
+C                  PART OF THE PERIMETER.
+C
+      END
diff --git a/sys/gio/ncarutil/gridal.f b/sys/gio/ncarutil/gridal.f
new file mode 100644
index 00000000..8ad31020
--- /dev/null
+++ b/sys/gio/ncarutil/gridal.f
@@ -0,0 +1,1583 @@
+      SUBROUTINE GRIDAL(MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,IGPH,X,Y)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C LATEST REVISION        JULY, 1985
+C
+C PURPOSE                THIS IS A PACKAGE OF ROUTINES FOR DRAWING
+C                        GRAPH PAPER, AXES, AND OTHER BACKGROUNDS.
+C
+C USAGE                  EACH USER ENTRY POINT IN THIS PACKAGE (GRID,
+C                        GRIDL, PERIM, PERIML, HALFAX, LABMOD,
+C                        TICK4, AND GRIDAL) WILL BE DESCRIBED
+C                        SEPARATELY BELOW.  FIRST, HOWEVER, WE
+C                        WILL DISCUSS HOW MAJOR AND MINOR DIVISIONS
+C                        IN THE GRAPH PAPER ARE HANDLED BY ALL
+C                        ENTRIES WHICH USE THEM.
+C
+C                        GRIDAL, GRID, GRIDL, PERIM, PERIML, AND
+C                        HALFAX HAVE ARGUMENTS  MAJRX,MINRX,MAJRY,
+C                        MINRY WHICH CONTROL THE NUMBER OF MAJOR AND
+C                        MINOR DIVISIONS IN THE GRAPH PAPER OR
+C                        PERIMETERS.  THE NUMBER OF DIVISIONS REFERS
+C                        TO THE HOLES BETWEEN LINES RATHER THAN THE
+C                        LINES THEMSELVES.  THIS MEANS THAT THERE
+C                        IS ALWAYS ONE MORE MAJOR DIVISION LINE THAN
+C                        THE NUMBER OF MAJOR DIVISIONS.  SIMILARLY,
+C                        THERE IS ONE LESS MINOR DIVISION LINE THAN
+C                        MINOR DIVISIONS (PER MAJOR DIVISION.)
+C
+C                        MAJRX,MAJRY,MINRX,MINRY HAVE DIFFERENT
+C                        MEANINGS DEPENDING UPON WHETHER LOG
+C                        SCALING IS IN EFFECT (SET VIA SETUSV OR
+C                        SET IN THE SPPS PACKAGE.)
+C
+C                        FOR LINEAR SCALING,
+C                        MAJRX AND MAJRY SPECIFY THE NUMBER OF MAJOR
+C                        DIVISIONS ALONG THE X-AXIS OR Y-AXIS
+C                        RESPECTIVELY, AND MINRX AND MINRY SPECIFY
+C                        THE NUMBER OF MINOR DIVISIONS PER MAJOR
+C                        DIVISION.
+C
+C                        FOR LOG SCALING ALONG THE X-AXIS
+C                        EACH MAJOR DIVISION OCCURS AT A FACTOR OF
+C                        10**MAJRX TIMES THE PREVIOUS DIVISION.
+C                        FOR EXAMPLE, IF THE MINIMUM X-AXIS VALUE IS
+C                        3., AND THE MAXIMUM X-AXIS VALUE IS 3000.,
+C                        AND MAJRX IS 1, THEN MAJOR DIVISIONS WILL
+C                        OCCUR AT 3., 30., 300., AND 3000.  SIMILARLY
+C                        FOR MAJRY.   IF LOG SCALING IS IN EFFECT ON
+C                        THE X-AXIS AND MINRX.LE.10, THEN THERE ARE
+C                        NINE MINOR DIVISIONS BETWEEN EACH MAJOR
+C                        DIVISION.  FOR EXAMPLE, BETWEEN 3. AND 30.
+C                        THERE WOULD BE A MINOR DIVISION AT 6., 9.,
+C                        12.,...,27.  IF LOG SCALING IS IN EFFECT ON
+C                        THE X-AXIS AND MINRX.GT.10, THEN THERE WILL
+C                        BE NO MINOR SUBDIVISIONS.  MINRY IS TREATED
+C                        IN THE SAME MANNER AS MINRX.
+C
+C                        IF DIFFERENT COLORS (OR INTENSITIES) ARE TO
+C                        BE USED FOR NORMAL INTENSITY, LOW INTENSITY,
+C                        OR TEXT COLOR, THEN THE VALUES IN COMMON
+C                        BLOCK  GRIINT  SHOULD BE CHANGED AS FOLLOWS:
+C
+C                          IGRIMJ      COLOR INDEX FOR NORMAL (MAJOR)
+C                                      INTENSITY LINES.
+C                          IGRIMN      COLOR INDEX FOR LOW INTENSITY
+C                                      LINES.
+C                          IGRITX      COLOR INDEX FOR TEXT (LABELS.)
+C
+C WE NOW DESCRIBE EACH ENTRY IN THIS PACKAGE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRID
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW GRAPH PAPER.
+C
+C USAGE         CALL GRID (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE DRAWS GRAPH LINES IN THE PORTION
+C               OF THE PLOTTER SPECIFIED BY THE CURRENT VIEWPORT
+C               SETTING WITH THE NUMBER OF MAJOR AND MINOR
+C               DIVISIONS AS SPECIFIED BY THE ARGUMENTS.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRIDAL
+C-----------------------------------------------------------------------
+C
+C PURPOSE       A GENERAL ENTRY POINT FOR ALL BACKGROUND ROUTINES
+C               WITH THE OPTION OF LINE LABELLING ON EACH AXIS.
+C
+C USAGE         CALL GRIDAL (MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,
+C                            IGPH,X,Y)
+C
+C ARGUMENTS     MAJRX,MINRX,MAJRY,MINRY
+C                 MAJOR AND MINOR AXIS DIVISIONS AS DESCRIBED IN THE
+C                 USAGE SECTION OF THE PACKAGE DOCUMENTATION ABOVE.
+C
+C               IXLAB,IYLAB (INTEGERS)
+C                 FLAGS FOR AXIS LABELS:
+C
+C                   IXLAB = -1  NO X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  0  X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  1  X-AXIS DRAWN
+C                               X-AXIS LABELS
+C
+C                   IYLAB = -1  NO Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  0  Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  1  Y-AXIS DRAWN
+C                               Y-AXIS LABELS
+C
+C
+C               IGPH
+C                 FLAG FOR BACKGROUND TYPE:
+C
+C                    IGPH         X-AXIS BACKGROUND  Y-AXIS BACKGROUND
+C                    ----         -----------------  -----------------
+C                     0           GRID               GRID
+C                     1           GRID               PERIM
+C                     2           GRID               HALFAX
+C                     4           PERIM              GRID
+C                     5           PERIM              PERIM
+C                     6           PERIM              HALFAX
+C                     8           HALFAX             GRID
+C                     9           HALFAX             PERIM
+C                    10           HALFAX             HALFAX
+C
+C               X,Y
+C                 WORLD COORDINATES OF THE INTERSECTION OF THE AXES
+C                 IF  IGPH=10 .
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRIDL
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW GRAPH PAPER.
+C
+C USAGE         CALL GRIDL (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES EXACTLY AS GRID, BUT EACH
+C               MAJOR DIVISION IS LABELED WITH ITS NUMERICAL VALUE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE HALFAX
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW ORTHOGONAL AXES.
+C
+C USAGE         CALL HALFAX (MAJRX,MINRX,MAJRY,MINRY,X,Y,IXLAB,IYLAB)
+C
+C DESCRIPTION   THIS SUBROUTINE DRAWS ORTHOGONAL AXES INTERSECTING
+C               AT COORDINATE (X,Y) WITH OPTIONAL LABELING OPTIONS AS
+C               SPECIFIED BY IXLAB AND IYLAB.
+C
+C ARGUMENTS     MAJRX,MINRX,MAJRY,MINRY
+C                 MAJOR AND MINOR DIVISION SPECIFICATIONS AS PER THE
+C                 DESCRIPTION IN THE PACKAGE USAGE SECTION ABOVE.
+C
+C               X,Y
+C                 WORLD COORDINATES SPECIFYING THE INTERSECTION POINT
+C                 OF THE X AND Y AXES.
+C
+C               IXLAB,IYLAB (INTEGERS)
+C                 FLAGS FOR AXIS LABELS:
+C
+C                   IXLAB = -1  NO X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  0  X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  1  X-AXIS DRAWN
+C                               X-AXIS LABELS
+C
+C                   IYLAB = -1  NO Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  0  Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  1  Y-AXIS DRAWN
+C                               Y-AXIS LABELS
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE LABMOD
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO ALLOW MORE COMPLETE CONTROL OVER THE APPEARANCE
+C               OF THE LABELS ON THE BACKGROUND PLOTS.
+C
+C USAGE         CALL LABMOD (FMTX,FMTY,NUMX,NUMY,ISIZX,ISIZY,
+C                            IXDEC,IYDEC,IXOR)
+C
+C DESCRIPTION   THIS SUBROUTINE PRESETS PARAMETERS FOR THE OTHER
+C               BACKGROUND ROUTINES IN THIS PACKAGE.  LABMOD ITSELF
+C               DOES NO PLOTTING AND IT MUST BE CALLED BEFORE THE
+C               THE BACKGROUND ROUTINES FOR WHICH IT IS PRESETTING
+C               PARAMETERS.
+C
+C ARGUMENTS     FMTX,FMTY  (TYPE CHARACTER)
+C                 FORMAT SPECIFICATIONS FOR THE X-AXIS AND Y-AXIS
+C                 NUMERICAL LABELS IN GRIDL, PERIML, GRIDAL, OR
+C                 HALFAX.  THE SPECIFICATION MUST START WITH A LEFT
+C                 PARENTHESIS AND END WITH A RIGHT PARENTHESIS AND
+C                 SHOULD NOT USE MORE THAN 8 CHARACTERS.  ONLY
+C                 FLOATING-POINT CONVERSIONS (F, E, AND G) SUCH AS
+C                 FMTX='(F8.2)' AND  FMTY='(E10.0)' FOR EXAMPLE.
+C
+C               NUMX,NUMY (INTEGER)
+C                 THE NUMBER OF CHARACTERS SPECIFIED BY  FMTX  AND
+C                 FMTY.  FOR THE ABOVE EXAMPLES, THESE WOULD BE
+C                 NUMX=8  AND  NUMY=10  (NOT 6 AND 7).
+C
+C               ISIZX,ISIZY
+C                 CHARACTER SIZE CODES FOR THE LABELS.  THESE SIZE
+C                 CODES ARE THE SAME AS THOSE FOR THE SPPS ENTRY
+C                 PWRIT.
+C
+C               IXDEC
+C                 THE DECREMENT IN PLOTTER ADDRESS UNITS FROM THE
+C                 LEFTMOST PLOTTER COORDINATE (AS SPECIFIED BY THE
+C                 CURRENT VIEWPORT) TO THE NEAREST X-ADDRESS OF THE
+C                 LABEL SPECIFIED BY  FMTY, NUMY, AND ISIZY.  FOR
+C                 EXAMPLE, IF THE MINIMUM X-COORDINATE OF THE CURRENT
+C                 VIEWPORT IS .1,  MINX  IS 102 (.1*1024).  IF  IXDEC
+C                 IS 60, THE LABEL WILL START AT 42 (102-60).  THE
+C                 FOLLOWING CONVENTIONS ARE USED:
+C
+C                 O  IF  IXDEC=0, IT IS AUTOMATICALLY RESET TO PROPERLY
+C                    POSITION THE  Y-AXIS  LABELS TO THE LEFT OF THE
+C                    LEFT Y-AXIS,  IXDEC=20 .
+C
+C                 O  IF  IXDEC=1,  Y-AXIS LABELS WILL GO TO THE RIGHT
+C                    OF THE GRAPH, IXDEC=-20 .
+C
+C                 WHEN EITHER  HALFAX  OR  GRIDAL  IS CALLED TO DRAW AN
+C                 AXIS,  IXDEC  IS THE DISTANCE FROM THE AXIS RATHER
+C                 THAN FROM THE MINIMUM VIEWPORT COORDINATE.
+C
+C               IYDEC
+C                 THE DECREMENT IN PLOTTER ADDRESS UNITS FROM THE
+C                 MINIMUM Y-AXIS COORDINATE AS SPECIFIED BY THE
+C                 CURRENT VIEWPORT TO THE NEAREST Y-ADDRESS OF THE
+C                 LABEL SPECIFIED BY  FMTX, NUMX, AND ISIZX.  FOR
+C                 EXAMPLE, IF THE MINIMUM Y-COORDINATE OF THE
+C                 CURRENT VIEWPORT IS .2,  MINY IS 205 (.2*1024).
+C                 IF  IYDEC=30, THE LABEL WILL END AT  205-30=175.
+C                 THE FOLLOWING CONVENTIONS ARE USED:
+C
+C                 O  IF  IYDEC=0, IT IS AUTOMATICALLY RESET TO
+C                    PROPERLY POSITION X-AXIS LABELS ALONG THE
+C                    BOTTOM,  IYDEC=20 .
+C
+C                 O  IF  IYDEC=1, X-AXIS LABELS WILL GO ALONG THE
+C                    TOP OF THE GRAPH,  IYDEC=-20 .
+C
+C               IXOR (INTEGER)
+C                 ORIENTATION OF THE X-AXIS LABELS.
+C
+C                   IXOR = 0    +X (HORIZONTAL)
+C                        = 1    +Y (VERTICAL)
+C
+C                 IN NORMAL ORIENTATION, THE ACTUAL NUMBER OF
+C                 NON-BLANK DIGITS IS CENTERED UNDER THE LINE
+C                 OR TICK TO WHICH IT APPLIES.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE PERIM
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW A PERIMETER WITH TICK MARKS.
+C
+C USAGE         CALL PERIM (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES JUST AS GRID EXCEPT THAT
+C               INTERIOR LINES ARE REPLACED WITH TICK MARKS ALONG
+C               THE EDGES.  TICK MARKS AT MAJOR DIVISIONS ARE
+C               SLIGHTLY LARGER THAN TICK MARKS AT MINOR DIVISIONS.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE PERIML
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW A PERIMETER WITH TICK MARKS AND LABELS.
+C
+C USAGE         CALL PERIML (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES JUST AS PERIM, BUT EACH
+C               MAJOR DIVISION IS LABELED WITH ITS NUMERICAL VALUE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE TICK4
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO ALLOW PROGRAM CONTROL OF TICK MARK LENGTH.
+C
+C USAGE         CALL TICK4 (LMAJX,LMINX,LMAJY,LMINY)
+C
+C DESCRIPTION   THIS SUBROUTINE ALLOWS PROGRAM CONTROL OF TICK
+C               MARK LENGTH IN  PERIM, PERIML, GRIDAL, AND HALFAX.
+C
+C ARGUMENTS     LMAJX,LMAJY
+C                 LENGTH IN PLOTTER ADDRESS UNITS OF MAJOR DIVISION
+C                 TICK MARKS ON THE X-AXIS AND Y-AXIS RESPECTIVELY.
+C                 THESE VALUES ARE INITIALLY SET TO 12 .
+C
+C               MINRX,MINRY
+C                 LENGTH IN PLOTTER ADDRESS UNITS OF MINOR DIVISION
+C                 TICK MARKS ON THE X-AXIS AND Y-AXIS RESPECTIVELY.
+C                 THESE VALUES ARE INITIALLY SET TO 8 .
+C
+C-----------------------------------------------------------------------
+C
+C WE NOW RESUME THE PACKAGE DOCUMENTATION.
+C
+C ENTRY POINTS  GRID,GRIDAL,GRIDL,HALFAX,LABMOD,PERIM,PERIML,TICK4,
+C               TICKS,CHSTR,EXPAND,GRIDT
+C
+C COMMON BLOCKS LAB,CLAB,TICK,GRIINT
+C
+C REQUIRED      THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O           PLOTS BACKGROUNDS
+C
+C PRECISION     SINGLE
+C
+C LANGUAGE      FORTRAN 77
+C
+C HISTORY       WRITTEN IN JUNE, 1984.  BASED ON THE NCAR SYSTEM
+C               PLOT PACKAGE ENTRIES HAVING THE SAME NAMES.
+C
+        COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+        COMMON /CLAB/ XFMT, YFMT
+        COMMON /TICK/ MAJX, MINX, MAJY, MINY
+        COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+C
+C INTERNAL VARIABLES:
+C
+C               CHUPX,CHUPY     CHARACTER UP VECTOR VALUES ON ENTRY
+C
+C               CURMAJ          IF LOGMIN=.TRUE., THEN THIS IS THE
+C                               CURRENT MAJOR TICK/GRID POSITION
+C
+C               ICNT            NORMALIZATION TRANSFORMATION NUMBER IN
+C                               EFFECT ON ENTRY TO GRIDAL
+C
+C               LASF(13)        ASPECT SOURCE FLAG TABLE AS USED BY GKS.
+C
+C               LGRID           .TRUE. IF GRIDS ARE TO BE DRAWN ON THE
+C                               CURRENT AXIS (OPPOSED TO TICKS)
+C
+C               LOGMIN          .TRUE.  IF LOG SCALING IS IN EFFECT AND
+C                               MINOR TICK MARKS OR GRIDS ARE DESIRED
+C
+C               LOGVAL          LINEAR OR LOG SCALING
+C                               1 = X LINEAR, Y LINEAR
+C                               2 = X LINEAR, Y LOG
+C                               3 = X LOG, Y LINEAR
+C                               4 = X LOG, Y LOG
+C
+C               MINCNT          NUMBER OF MINOR DIVISIONS PER MAJOR
+C
+C               NERR            COUNTS ERROR NUMBER
+C
+C               NEXTMAJ         IF LOGMIN=.TRUE., THEN THIS IS THE NEXT
+C                               MAJOR TICK/GRID POSITION
+C
+C               NWIND(4)        WINDOW LIMITS IN WORLD COORDINATES
+C                               AFTER EXPANSION
+C
+C               OCOLI           COLOR INDEX ON ENTRY TO GRIDAL
+C
+C               OLDALH,OLDALV   TEXT ALIGNMENT VALUES ON ENTRY
+C                               (HORIZONTAL AND VERTICAL)
+C
+C               OLDCH           CHARACTER HEIGHT ON ENTRY TO GRIDAL
+C
+C               OPLASF          STORES VALUE OF POLYLINE COLOR ASF ON
+C                               ENTRY TO GRIDAL
+C
+C               OTXASF          STORES VALUE OF TEXT COLOR ASF ON
+C                               ENTRY TO GRIDAL
+C
+C               OTXCOL          TEXT COLOR INDEX ON ENTRY TO GRIDAL
+C
+C               OWIND(4)        WINDOW LIMITS IN WORLD COORDINATES
+C                               ON ENTRY TO GRIDAL
+C
+C               PY(2)           2 Y-COORDINATES FOR LINE TO BE DRAWN
+C                               VIA GKS ROUTINE GPL
+C
+C               PX(2)           2 X-COORDINATES FOR LINE TO BE DRAWN
+C                               VIA GKS ROUTINE GPL
+C
+C               START           IF DRAWING TICKS/GRIDS ON X-AXIS:
+C                                       Y-COORD OF ORIGIN OF EACH LINE;
+C                               IF DRAWING TICKS/GRIDS ON Y-AXIS:
+C                                       X-COORD OF ORIGIN OF EACH LINE
+C
+C               TICBIG          END OF MAJOR TICK LINE IN WORLD
+C                               COORDINATES
+C
+C               TICEND          END OF MINOR TICK LINE IN WORLD
+C                               COORDINATES
+C
+C               TICMAJ          LENGTH OF MAJOR TICKS IN WORLD
+C                               COORDINATES
+C
+C               TICMIN          LENGTH OF MINOR TICKS IN WORLD
+C                               COORDINATES
+C
+C               VIEW(4)         VIEWPORT LIMITS IN NDC PRIOR TO
+C                               EXPANSION FOR LABELLING
+C
+C               WIND(4)         SAME AS IN OWIND(4)
+C
+C               XCUR            A TICK/GRID IS DRAWN AT THIS POSITION
+C                               IF LOG SCALING IS IN EFFECT.
+C
+C               XDEC            LENGTH IN WORLD COORDINATES FROM
+C                               X-AXIS TO LABEL
+C
+C               XI              ALOG10(X), IF LOG SCALING
+C
+C               XINT            INTERVAL BETWEEN MINOR X-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               XINTM           INTERVAL BETWEEN MAJOR X-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               XMIRRO          LOGICAL FLAGS FOR MIRROR-IMAGE
+C
+C               XNUM            TOTAL NUMBER OF X-AXIS TICKS/GRIDS
+C                               WITH LINEAR SCALING
+C
+C               XPOS            IF LINEAR SCALING, KEEPS TRACK OF X-AXIS
+C                               POSITION FOR CURRENT TICK/GRID
+C
+C               XRANGE          TOTAL RANGE IN X DIRECTION IN WORLD
+C                               COORDINATES PRIOR TO EXPANSION FOR
+C                               LABELLING.
+C
+C               XRNEW           RANGE IN X DIRECTION IN WORLD
+C                               COORDINATES, AFTER EXPANSION
+C
+C               YCUR            A TICK/GRID IS DRAWN AT THIS POSITION
+C                               IF LOG SCALING IS IN EFFECT.
+C
+C               YDEC            LENGTH IN WORLD COORDINATES FROM
+C                               Y-AXIS TO LABEL
+C
+C               YI              ALOG10(Y), IF LOG SCALING
+C
+C               YINTM           INTERVAL BETWEEN MAJOR Y-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               YMIRRO          PLOTTING.
+C
+C               YNUM            TOTAL NUMBER OF Y-AXIS TICKS/GRIDS
+C                               WITH LINEAR SCALING
+C
+C               YPOS            IF LINEAR SCALING, KEEPS TRACK OF Y-AXIS
+C                               POSITION FOR CURRENT TICK/GRID
+C
+C               YRANGE          TOTAL RANGE IN Y DIRECTION IN WORLD
+C                               COORDINATES PRIOR TO EXPANSION FOR
+C                               LABELLING.
+C
+C               YRNEW           RANGE IN Y DIRECTION IN WORLD
+C                               COORDINATES, AFTER EXPANSION
+C
+C               XLAB,YLAB       IF LABELLING X-AXIS, Y-COORDINATE FOR
+C                               FOR TEXT POSITION;
+C                               IF LABELLING Y-AXIS, X-COORDINATE FOR
+C                               TEXT POSITION.
+C
+C
+C
+      CHARACTER*8 XFMT,YFMT
+      REAL WIND(4), VIEW(4), PX(2), PY(2), NWIND(4), OWIND(4)
+      REAL MAJX, MINX, MAJY, MINY
+      INTEGER TCOUNT, XTNUM, YTNUM, FIRST, LAST
+      INTEGER OPLASF, OTXASF, LASF(13), OCOLI, OTEXCI, OLDALH ,OLDALV
+      LOGICAL LGRID,LOGMIN
+      LOGICAL XMIRRO,YMIRRO
+      REAL MAJDIV, NEXTMA
+      CHARACTER*15 LABEL
+C
+      DATA TICMIN,TICMAJ,XCUR,YCUR,EXCUR,EYCUR/0.,0.,0.,0.,0.,0./
+C
+C +NOAO - Blockdata rewritten as run time initialization.
+C       EXTERNAL GRIDT
+	call gridt
+C -NOAO
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRIDAL','VERSION 01')
+      XRNEW = 0.
+      YRNEW = 0.
+C
+C  INITIALIZE ERROR COUNT.
+C
+      NERR = 0
+C
+C  CHECK FOR BAD VALUES OF IGPH.
+C
+      IF (IGPH.LT.0.OR.IGPH.EQ.3.OR.IGPH.EQ.7.OR.IGPH.GT.10) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--INVALID IGPH VALUE',NERR,2)
+      ENDIF
+C
+C  GET STANDARD ERROR MESSAGE UNIT
+C
+      IERUNT = I1MACH(4)
+      XMIRRO = .FALSE.
+      YMIRRO = .FALSE.
+C
+C  SET POLYLINE COLOR ASF TO INDIVIDAUL.
+C
+      CALL GQASF(IERR,LASF)
+      OPLASF = LASF(3)
+      LASF(3) = 1
+      OTXASF = LASF(10)
+      LASF(10) = 1
+      CALL GSASF(LASF)
+C
+C  INQUIRE CURRENT POLYLINE COLOR INDEX.
+C
+      CALL GQPLCI(IERR,OCOLI)
+C
+C  SET POLYLINE COLOR TO THE VALUE SPECIFIED IN COMMON.
+C
+      CALL GSPLCI(IGRIMJ)
+C
+C  INQUIRE CURRENT NORMALIZATION TRANSFORMATION NUMBER.
+C
+      CALL GQCNTN(IERR,ICNT)
+C
+C  INQUIRE CURRENT WINDOW AND VIEWPORT LIMITS.
+C
+      CALL GQNT(ICNT,IERR,WIND,VIEW)
+C
+C  STORE WINDOW VALUES
+C
+      DO 10 I = 1,4
+      OWIND(I) = WIND(I)
+   10 CONTINUE
+C
+C  LOG OR LINEAR SCALING?
+C
+C           1 = X LINEAR, Y LINEAR
+C           2 = X LINEAR, Y LOG
+C           3 = X LOG, Y LINEAR
+C           4 = X LOG, Y LOG
+C
+      CALL GETUSV('LS',LOGVAL)
+C
+C  ADJUST WINDOW TO ACCOUNT FOR LOG SCALING.
+C
+      IF (LOGVAL .EQ. 2) THEN
+        WIND(3) = 10.**WIND(3)
+        WIND(4) = 10.**WIND(4)
+      ELSE IF (LOGVAL .EQ. 3) THEN
+        WIND(1) = 10.**WIND(1)
+        WIND(2) = 10.**WIND(2)
+      ELSE IF (LOGVAL .EQ. 4) THEN
+        WIND(1) = 10.**WIND(1)
+        WIND(2) = 10.**WIND(2)
+        WIND(3) = 10.**WIND(3)
+        WIND(4) = 10.**WIND(4)
+      ENDIF
+C
+C  DETERMINE IF MIRROR-IMAGE MAPPING IS REQUIRED.
+C
+      IF (WIND(1) .GT. WIND(2)) THEN
+        XMIRRO = .TRUE.
+      ENDIF
+      IF (WIND(3) .GT. WIND(4)) THEN
+        YMIRRO = .TRUE.
+      ENDIF
+C
+C  IF IGPH=10, CHECK FOR X(Y) VALUES IN RANGE (IF NOT, CHANGE TO
+C  DEFAULT.
+C
+      IF (IGPH .EQ. 10) THEN
+        XI = X
+        YI = Y
+        IF (((XI .LT. WIND(1) .OR. XI .GT. WIND(2)) .AND. .NOT.
+     1  XMIRRO) .OR. (XMIRRO.AND.(XI.GT.WIND(1).OR.XI.LT.WIND(2))))
+     2  THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--X VALUE OUT OF WINDOW RANGE',NERR,1)
+C +NOAO - FTN writes and format statements deleted.  Call to SETER okay.
+C
+C         WRITE(IERUNT,1001)NERR
+C1001     FORMAT(' ERROR',I3,' IN GRIDAL--X VALUE OUT OF WINDOW RANGE')
+          CALL ERROF
+          XI = WIND(1)
+        ENDIF
+        IF (((YI .LT. WIND(3) .OR. YI .GT. WIND(4)) .AND. .NOT.
+     1  YMIRRO).OR.(YMIRRO.AND.(YI.GT.WIND(3).OR.YI.LT.WIND(4))))
+     2  THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--Y VALUE OUT OF WINDOW RANGE',NERR,1)
+C         WRITE(IERUNT,1002)NERR
+C1002     FORMAT(' ERROR',I3,' IN GRIDAL--Y VALUE OUT OF WINDOW RANGE')
+C -NOAO
+          CALL ERROF
+          YI = WIND(3)
+        ENDIF
+      ENDIF
+      MX = MAJRX
+      MY = MAJRY
+      IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 3) THEN
+        IF (MX .LT. 1) MX = 1
+        IF (WIND(1) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(1) = ALOG10(WIND(1))
+        ENDIF
+        IF (WIND(2) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(2) = ALOG10(WIND(2))
+        ENDIF
+        IF (IGPH .EQ. 10) THEN
+          XI = ALOG10(XI)
+        ENDIF
+      ENDIF
+C
+      IF(LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) THEN
+        IF (MY .LT. 1) MY = 1
+        IF (WIND(3) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(3) = ALOG10(WIND(3))
+        ENDIF
+        IF (WIND(4) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(4) = ALOG10(WIND(4))
+        ENDIF
+        IF (IGPH .EQ. 10) THEN
+          YI = ALOG10(YI)
+        ENDIF
+      ENDIF
+C
+C  DEFINE NORMALIZATION TRANSFORMATION NUMBER 1.
+C
+      CALL GSWN(1,WIND(1),WIND(2),WIND(3),WIND(4))
+      CALL GSVP(1,VIEW(1),VIEW(2),VIEW(3),VIEW(4))
+      CALL GSELNT(1)
+C
+C  CALCULATE X AND Y WORLD COORDINATE RANGES.
+C
+      XRANGE = WIND(2) - WIND(1)
+      YRANGE = WIND(4) - WIND(3)
+C
+C  IF LABELS ARE REQUESTED, INQUIRE AND SAVE TEXT ATTRIBUTES.
+C
+      IF (IXLAB .EQ. 1 .OR. IYLAB .EQ. 1) THEN
+        CALL GQCHH(IERR,OLDCHH)
+        CALL GQCHUP(IERR,CHUPX,CHUPY)
+        CALL GQTXAL(IERR,OLDALH,OLDALV)
+        CALL GQTXCI (IERR,OTEXCI)
+        CALL GSTXCI (IGRITX)
+C
+C  EXPAND WINDOW AND VIEWPORT FOR LABELS AND CALCULATE NEW
+C  X AND Y WORLD COORDINATE RANGES.
+C
+        CALL EXPAND(NWIND)
+        XRNEW = NWIND(2) - NWIND(1)
+        YRNEW = NWIND(4) - NWIND(3)
+C
+C  SET CHARACTER HEIGHT (1% OF Y RANGE.)
+C
+        CHARH = SIZX * YRNEW
+        IF (YMIRRO) THEN
+          CHARH = -CHARH
+        ENDIF
+        CALL GSCHH(CHARH)
+      ENDIF
+C
+      IF (IGPH .EQ. 0) GOTO 50
+C
+C  CALCULATE TIC LENGTH.
+C
+C  IF NO LABELS AND TICK4 (OR TICKS) WERE NOT CALLED.
+C
+      IF (MAJX .EQ. 0.) THEN
+        MAJX = .013
+        MINX = .007
+        TICMIN = MINX * YRANGE
+        TICMAJ = MAJX * YRANGE
+      ELSE
+C
+C  EXPAND WINDOW IF NOT ALREADY EXPANDED.
+C  (IF LABMOD WAS NOT CALLED BUT TICK4(S) WAS.)
+C
+        IF (IXLAB.NE.1 .AND. IYLAB.NE.1) THEN
+          CALL EXPAND (NWIND)
+          XRNEW = NWIND(2) - NWIND(1)
+          YRNEW = NWIND(4) - NWIND(3)
+        ENDIF
+        TICMIN = MINX * YRNEW
+        TICMAJ = MAJX * YRNEW
+      ENDIF
+C
+C  **** X-AXIS TICS/GRIDS AND LABELS ****
+C
+C  CALCULATE TIC/GRID INTERVALS ON X AXIS.
+C
+  50  IF (IXLAB .EQ. -1) GOTO 175
+      MINCNT = MINRX
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+        LOGMIN = .FALSE.
+        XINTM = XRANGE/MX
+        XINT = XINTM
+        IF (MINCNT .GT. 1) THEN
+          XINT = XINT/MINCNT
+        ENDIF
+C
+C  CALCULATE TOTAL NUMBER OF TICS/GRIDS ON AXIS.
+C
+        XTNUM = MX * MINCNT
+        IF (MINCNT .EQ. 0) XTNUM = MX
+      ELSE
+        XTNUM = 50
+        XCUR = 10.**OWIND(1)
+        MAJDIV = 10 ** MX
+        IF (MINCNT .LE. 10 .AND. MX .LE. 1) THEN
+          LOGMIN = .TRUE.
+          CURMAJ = XCUR
+          NEXTMA = XCUR * MAJDIV
+          XINT = (NEXTMA - CURMAJ) / 9.
+          MINCNT = 9
+        ELSE
+          LOGMIN = .FALSE.
+          MINCNT = 1
+        ENDIF
+      ENDIF
+C
+      LGRID = .FALSE.
+      LOOP = 1
+C
+C  DETERMINE ORIGIN OF TICK/GRID LINES (Y COORDINATE.)
+C
+      IF (IGPH .NE. 10) THEN
+        START = WIND(3)
+      ELSE
+        START = YI
+      ENDIF
+C
+      XPOS = WIND(1)
+      PY(1) = START
+      TICEND = START + TICMIN
+      TICBIG = START + TICMAJ
+C
+      PX(1) = XPOS
+      PX(2) = PX(1)
+C
+C  DRAW LEFT-MOST TICK ON X-AXIS (IF IGPH = 10 AND
+C  INTERSECTION OF AXES IS NOT AT BOTTOM LEFT OF WINDOW.)
+C
+      IF (IGPH .EQ. 10) THEN
+        IF (XI .NE. WIND(1)) THEN
+          PY(2) = TICBIG
+          CALL GPL(2,PX,PY)
+        ENDIF
+C
+C  DRAW X-AXIS FOR IGPH = 10
+C
+        PX(2) = WIND(2)
+        PY(2) = PY(1)
+        CALL GPL(2,PX,PY)
+        PX(2) = PX(1)
+      ELSE
+C
+C  DRAW Y-AXIS FOR ANY OTHER IGPH (FIRST TICK.)
+C
+        PY(2) = WIND(4)
+        CALL GPL(2,PX,PY)
+      ENDIF
+C
+C  TICKS OR GRIDS ?
+C
+      IF (IGPH .EQ. 0 .OR. IGPH .EQ. 1 .OR. IGPH .EQ.2) THEN
+        PY(2) = WIND(4)
+        LGRID = .TRUE.
+      ELSE
+        PY(2) = TICEND
+      ENDIF
+C
+      IF (IXLAB .EQ. 1) THEN
+C
+C  IF VERTICAL X-AXIS LABEL ORIENTATION, THEN SET CHAR UP VECTOR
+C  TO BE VERTICAL AND TEXT ALIGNMENT TO (RIGHT,HALF),
+C  OTHERWISE TO (CENTER,TOP)
+C
+        IF (YMIRRO) THEN
+          IF (IXORI .EQ. 1) THEN
+            CALL GSCHUP(1.,0.)
+            CALL GSTXAL(3,3)
+          ELSE
+            CALL GSCHUP(0.,-1.)
+            CALL GSTXAL(2,1)
+          ENDIF
+        ELSE
+          IF (IXORI .EQ. 1) THEN
+            CALL GSCHUP(-1.,0.)
+            CALL GSTXAL(3,3)
+          ELSE
+            CALL GSTXAL(2,1)
+          ENDIF
+        ENDIF
+        IF (XDEC.NE.0. .AND. XDEC.NE.1.) THEN
+          DEC = XDEC * YRNEW
+        ELSE
+          DEC = .02 * YRNEW
+        ENDIF
+        IF (XDEC .NE. 1.) THEN
+          XLAB = START - DEC
+        ELSE
+          IF (IGPH .NE. 10) THEN
+            XLAB = WIND(4)+DEC
+          ELSE
+            XLAB = YI+DEC
+          ENDIF
+C
+C  IF LABELS ARE ON TOP OF THE X-AXIS, SET THE TEXT
+C  ALIGNMENT TO (LEFT,HALF) IF THE X-AXIS LABELS ARE
+C  VERTICAL, OTHERWISE TO (CENTER,BASE).
+C
+          IF (IXORI .EQ. 1) THEN
+            CALL GSTXAL(1,3)
+          ELSE
+            CALL GSTXAL(2,4)
+          ENDIF
+        ENDIF
+        IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+C +NOAO
+C         WRITE(LABEL,XFMT)XPOS
+          call encode (10, xfmt, label, xpos)
+C -NOAO
+        ELSE
+C +NOAO
+C         WRITE(LABEL,XFMT)XCUR
+          call encode (10, yfmt, label, xcur)
+C -NOAO
+        ENDIF
+        CALL CHSTR(LABEL,FIRST,LAST)
+        CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+      ENDIF
+C
+ 80   TCOUNT = 1
+C
+      DO 100 I = 1,XTNUM
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+        XPOS = XPOS + XINT
+      ELSE
+        IF (.NOT. LOGMIN) THEN
+          XCUR = XCUR * MAJDIV
+        ELSE
+          IF (TCOUNT .NE. MINCNT) THEN
+            XCUR = XCUR + XINT
+          ELSE
+            XCUR = XCUR + XINT
+            CURMAJ = NEXTMA
+            NEXTMA = CURMAJ * MAJDIV
+            XINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        IF (XCUR .GT. 10.**OWIND(2)-.1*XINT) THEN
+          XPOS = WIND(2)
+        ELSE
+          XPOS = ALOG10(XCUR)
+        ENDIF
+      ENDIF
+C
+      PX(1) = XPOS
+      PX(2) = XPOS
+C
+C  IF IGPH = 0,1,2,4,5,8 OR 9 AND XPOS=RIGHT AXIS, THEN
+C  DRAW AXIS, ELSE IF IGPH = 6 OR 10 DRAW TIC AND LABEL.
+C
+      IF (LOGVAL .EQ. 3 .OR. LOGVAL .EQ. 4) EXCUR = 10.**OWIND(2)
+C
+      IF ((((LOGVAL .EQ. 1.OR.LOGVAL.EQ.2) .AND. (I .EQ. XTNUM))
+     1 .OR.((LOGVAL .EQ.4 .OR.LOGVAL .EQ.3).AND.XCUR.GE.EXCUR-.1*XINT))
+     2 .AND.(IGPH.NE.6.AND.IGPH.NE.10)) THEN
+        IF (LOOP .EQ. 1) THEN
+          PY(2) = WIND(4)
+          CALL GPL(2,PX,PY)
+          IF (IXLAB .EQ. 1) THEN
+            IF (LOGVAL.EQ.1 .OR. LOGVAL.EQ.2) THEN
+C (NOAO)      WRITE(LABEL,XFMT) XPOS
+              call encode (10, xfmt, label, xpos)
+            ELSE
+              IF (XCUR .GT. EXCUR+.1*XINT) THEN
+                GOTO 101
+              ELSE
+C (NOAO)        WRITE(LABEL,XFMT) XCUR
+                call encode (10, xfmt, label, xcur)
+              ENDIF
+            ENDIF
+            CALL CHSTR(LABEL,FIRST,LAST)
+            CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+          ENDIF
+        ENDIF
+        GOTO 101
+      ENDIF
+      IF ((LOGVAL.EQ.4 .OR. LOGVAL.EQ.3) .AND. XCUR.GT.EXCUR+.1*XINT)
+     1    GOTO 101
+C
+C  MINOR TIC/GRID ?
+C
+      IF (TCOUNT .NE. MINCNT .AND. MINCNT .NE. 0) THEN
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMN)
+        ENDIF
+        CALL GPL(2,PX,PY)
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMJ)
+        ENDIF
+        TCOUNT = TCOUNT + 1
+C
+C  MAJOR TIC/GRID
+C
+      ELSE
+        IF (.NOT. LGRID) THEN
+          PY(2) = TICBIG
+        ENDIF
+        CALL GPL(2,PX,PY)
+C
+C  LABEL.
+C
+        IF (IXLAB .EQ. 1 .AND. LOOP .EQ. 1) THEN
+          IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+C (NOAO)    WRITE(LABEL,XFMT)XPOS
+            call encode (10, xfmt, label, xpos)
+          ELSE
+C (NOAO)    WRITE(LABEL,XFMT)XCUR
+            call encode (10, xfmt, label, xcur)
+          ENDIF
+          CALL CHSTR(LABEL,FIRST,LAST)
+          CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+        ENDIF
+        TCOUNT = 1
+        IF (.NOT. LGRID) THEN
+          PY(2) = TICEND
+        ENDIF
+      ENDIF
+      IF ((LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 3) .AND.
+     1     XCUR .GE. EXCUR-.1*XINT) GOTO 101
+ 100  CONTINUE
+ 101  CONTINUE
+C
+C  TOP X-AXIS TICKS ?
+C
+      IF (LOOP.EQ.1 .AND. (IGPH.EQ.4 .OR. IGPH.EQ.5 .OR. IGPH.EQ.6))
+     1  THEN
+        START = WIND(4)
+        TICEND = START - TICMIN
+        TICBIG = START - TICMAJ
+        PY(1) = START
+        PY(2) = TICEND
+        XPOS = WIND(1)
+        LOOP = 2
+        IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ.3) THEN
+          XCUR = 10.**OWIND(1)
+          IF (LOGMIN) THEN
+            CURMAJ = XCUR
+            NEXTMA = XCUR * MAJDIV
+            XINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        GOTO 80
+      ENDIF
+C
+C  **** Y-AXIS TICS/GRIDS AND LABELS ****
+C
+  175 IF (IYLAB .EQ. -1) GOTO 999
+C
+C  CALCULATE Y-AXIS TICS
+C
+      MINCNT = MINRY
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 3) THEN
+        LOGMIN = .FALSE.
+        YINTM = YRANGE/MY
+        YINT = YINTM
+        IF (MINCNT .GT. 1) THEN
+          YINT = YINT/MINCNT
+        ENDIF
+        YTNUM = MY * MINCNT
+        IF (MINCNT .EQ. 0) YTNUM = MY
+      ELSE
+        YTNUM = 50
+        YCUR = 10.**OWIND(3)
+        MAJDIV = 10 ** MY
+        IF (MINCNT .LE. 10 .AND. MY .LE. 1) THEN
+          LOGMIN = .TRUE.
+          CURMAJ = YCUR
+          NEXTMA = YCUR * MAJDIV
+          YINT = (NEXTMA - CURMAJ) / 9.
+          MINCNT = 9
+        ELSE
+          LOGMIN = .FALSE.
+          MINCNT = 1
+        ENDIF
+      ENDIF
+C
+      LGRID = .FALSE.
+      LOOP = 1
+C
+C  DETERMINE ORIGIN OF TICK/GRID LINES (X COORDINATE.)
+C
+      IF (IGPH .NE. 10) THEN
+        START = WIND(1)
+      ELSE
+        START = XI
+      ENDIF
+C
+      YPOS = WIND(3)
+      PX(1) = START
+C
+C  DETERMINE Y-AXIS TICK LENGTHS.
+C
+      IF (MAJY .EQ. 0.) THEN
+        MAJY = .013
+        MINY = .007
+      ENDIF
+      IF (XRNEW .EQ. 0.) THEN
+        TICMIN = MINY * XRANGE
+        TICMAJ = MAJY * XRANGE
+      ELSE
+        TICMIN = MINY * XRNEW
+        TICMAJ = MAJY * XRNEW
+      ENDIF
+      TICEND = START + TICMIN
+      TICBIG = START + TICMAJ
+C
+      PY(1) = YPOS
+      PY(2) = PY(1)
+C
+C  DRAW BOTTOM-MOST TICK ON Y-AXIS IF (IGPH = 10
+C  AND INTERSECTION OF AXES IS NOT AT BOTTOM LEFT
+C  OF WINDOW.)
+C
+      IF (IGPH .EQ. 10) THEN
+        IF (YI .NE. WIND(3)) THEN
+          PX(2) = TICBIG
+          CALL GPL(2,PX,PY)
+        ENDIF
+C
+C  DRAW Y-AXIS FOR IGPH = 10
+C
+        PY(2) = WIND(4)
+        PX(2) = PX(1)
+        CALL GPL(2,PX,PY)
+        PY(2) = PY(1)
+      ELSE
+C
+C  DRAW X-AXIS FOR ANY OTHER IGPH (FIRST TICK.)
+C
+        PX(2) = WIND(2)
+        CALL GPL(2,PX,PY)
+      ENDIF
+C
+C  GRIDS OR TICS ?
+C
+      IF ((IGPH .EQ. 0 .OR. IGPH .EQ. 4).OR. IGPH .EQ. 8) THEN
+        PX(2) = WIND(2)
+        LGRID = .TRUE.
+      ELSE
+        PX(2) = TICEND
+      ENDIF
+C
+C  SET TEXT ATTRIBUTES IF Y-AXIS IS TO BE LABELLED.
+C
+      IF (IYLAB .EQ. 1) THEN
+        IF (IXORI .EQ. 1) THEN
+          IF (YMIRRO) THEN
+            CALL GSCHUP(0.,-1.)
+          ELSE
+            CALL GSCHUP(0.,1.)
+          ENDIF
+        ENDIF
+C
+C  SET TEXT ALIGNMENT TO (RIGHT,HALF)
+C
+        CALL GSTXAL(3,3)
+C
+C  RECALCULATE CHARACTER HEIGHT IF Y-AXIS LABELS ARE OF DIFFERENT
+C  SIZE FORM X-AXIS LABELS.
+C
+        CHARH = SIZY * YRNEW
+        IF (YMIRRO) THEN
+          CHARH = -CHARH
+        ENDIF
+        CALL GSCHH(CHARH)
+        IF (YDEC .NE. 0. .AND. YDEC .NE. 1.) THEN
+          DEC = YDEC * XRNEW
+        ELSE
+          DEC = .02 * XRNEW
+        ENDIF
+        IF (YDEC .NE. 1.) THEN
+          YLAB = START - DEC
+        ELSE
+          IF (IGPH .NE. 10) THEN
+            YLAB = WIND(2)+DEC
+          ELSE
+            YLAB = XI+DEC
+          ENDIF
+C
+C  SET TEXT ALIGNMENT TO (LEFT,HALF) IF LABELLING ON RIGHT OF Y-AXIS.
+C
+          CALL GSTXAL(1,3)
+        ENDIF
+        IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)  WRITE(LABEL,YFMT)YPOS
+          call encode (10, yfmt, label, ypos)
+        ELSE
+C (NOAO)  WRITE(LABEL,YFMT)YCUR
+          call encode (10, yfmt, label, ycur)
+        ENDIF
+        CALL CHSTR(LABEL,FIRST,LAST)
+        CALL GTX (YLAB,YPOS,LABEL(FIRST:LAST))
+      ENDIF
+C
+ 180  TCOUNT = 1
+C
+      DO 200 I = 1,YTNUM
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 3) THEN
+        YPOS = YPOS + YINT
+      ELSE
+        IF (.NOT. LOGMIN) THEN
+          YCUR = YCUR * MAJDIV
+        ELSE
+          IF (TCOUNT .NE. MINCNT) THEN
+            YCUR = YCUR + YINT
+          ELSE
+            YCUR = YCUR + YINT
+            CURMAJ = NEXTMA
+            NEXTMA = CURMAJ * MAJDIV
+            YINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        IF (YCUR .GT. 10.**OWIND(4)-.1*YINT) THEN
+          YPOS = WIND(4)
+        ELSE
+          YPOS = ALOG10(YCUR)
+        ENDIF
+      ENDIF
+C
+      PY(1) = YPOS
+      PY(2) = YPOS
+C
+C IF IGPH = 0,1,2,4,5,6 OR 8 AND YPOS = TOP AXIS, THEN
+C DRAW AXIS, ELSE IF IGPH = 9 OR 10 DRAW TIC.
+C
+      IF (LOGVAL .EQ. 3 .OR. LOGVAL .EQ. 4) EYCUR = 10.**OWIND(4)
+C
+      IF ((((LOGVAL .EQ. 1.OR.LOGVAL.EQ.3) .AND. (I .EQ. YTNUM))
+     1 .OR.((LOGVAL .EQ.4 .OR.LOGVAL .EQ.2).AND.YCUR.GE.EYCUR-.1*YINT))
+     2 .AND.(IGPH.NE.9.AND.IGPH.NE.10)) THEN
+        IF (LOOP .EQ. 1) THEN
+          PX(2) = WIND(2)
+          CALL GPL(2,PX,PY)
+          IF (IYLAB .EQ. 1) THEN
+            IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)      WRITE(LABEL,YFMT)YPOS
+              call encode (10, yfmt, label, ypos)
+            ELSE
+              IF (YCUR .GT. EYCUR+.1*YINT) THEN
+                GOTO 201
+              ELSE
+C (NOAO)        WRITE(LABEL,YFMT)YCUR
+                call encode (10, yfmt, label, ycur)
+              ENDIF
+            ENDIF
+            CALL CHSTR(LABEL,FIRST,LAST)
+            CALL GTX (YLAB,YPOS,LABEL(FIRST:LAST))
+          ENDIF
+        ENDIF
+        GOTO 201
+      ENDIF
+      IF ((LOGVAL.EQ.4 .OR. LOGVAL.EQ.2) .AND. YCUR.GT.EYCUR+.1*YINT)
+     1  GOTO 201
+C
+C  MINOR TIC/GRID ?
+C
+      IF (TCOUNT .NE. MINCNT .AND. MINCNT .NE. 0) THEN
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMN)
+        ENDIF
+        CALL GPL(2,PX,PY)
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMJ)
+        ENDIF
+        TCOUNT = TCOUNT + 1
+C
+C  MAJOR TIC/GRID.
+C
+      ELSE
+        IF (.NOT. LGRID) THEN
+          PX(2) = TICBIG
+        ENDIF
+        CALL GPL(2,PX,PY)
+C
+C  LABEL.
+C
+        IF (IYLAB .EQ. 1 .AND. LOOP .EQ.1) THEN
+          IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)   WRITE(LABEL,YFMT)YPOS
+           call encode (10, yfmt, label, ypos)
+          ELSE
+C (NOAO)    WRITE(LABEL,YFMT)YCUR
+            call encode (10, yfmt, label, ycur)
+          ENDIF
+          CALL CHSTR(LABEL,FIRST,LAST)
+          CALL GTX(YLAB,YPOS,LABEL(FIRST:LAST))
+        ENDIF
+        TCOUNT = 1
+        IF (.NOT. LGRID) THEN
+          PX(2) = TICEND
+        ENDIF
+      ENDIF
+      IF ((LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) .AND.
+     -     YCUR .GE. EYCUR-.1*YINT)
+     1   GOTO 201
+  200 CONTINUE
+  201 CONTINUE
+C
+C  RIGHT Y-AXIS TICKS ?
+C
+      IF (LOOP .EQ. 1 .AND.(IGPH.EQ.1 .OR. IGPH .EQ. 5 .OR.
+     1  IGPH .EQ. 9)) THEN
+        START = WIND(2)
+        TICEND = START - TICMIN
+        TICBIG = START - TICMAJ
+        PX(1) = START
+        PX(2) = TICEND
+        YPOS = WIND(3)
+        LOOP = 2
+        IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) THEN
+          YCUR = 10.**OWIND(3)
+          IF (LOGMIN) THEN
+            CURMAJ = YCUR
+            NEXTMA = YCUR * MAJDIV
+            YINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        GOTO 180
+      ENDIF
+C
+C  RESET NORMALIZATION TRANSFORMATION TO WHAT IT WAS UPON ENTRY.
+C
+      IF (ICNT .NE. 0) THEN
+        CALL GSWN(ICNT,OWIND(1),OWIND(2),OWIND(3),OWIND(4))
+        CALL GSVP(ICNT,VIEW(1),VIEW(2),VIEW(3),VIEW(4))
+      ENDIF
+      CALL GSELNT(ICNT)
+C
+C  IF LABELS, RESTORE TEXT ATTRIBUTES.
+C
+      IF (IXLAB .EQ. 1 .OR. IYLAB .EQ. 1) THEN
+        CALL GSCHH(OLDCHH)
+        CALL GSCHUP(CHUPX,CHUPY)
+        CALL GSTXAL(OLDALH,OLDALV)
+        CALL GSTXCI(OTEXCI)
+      ENDIF
+C
+C  RESTORE ORIGINAL COLOR.
+C
+      CALL GSPLCI(OCOLI)
+C
+C  RESTORE POLYLINE COLOR ASF TO WHAT IS WAS ON ENTRY.
+C
+      LASF(10) = OTXASF
+      LASF(3) = OPLASF
+      CALL GSASF(LASF)
+C
+ 999  RETURN
+      END
+      SUBROUTINE GRID(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRID','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,0,0,0,0.,0.)
+      RETURN
+      END
+      SUBROUTINE GRIDL(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRIDL','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,1,1,0,0.,0.)
+      RETURN
+      END
+      SUBROUTINE PERIM(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','PERIM','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,0,0,5,0.,0.)
+      RETURN
+      END
+      SUBROUTINE PERIML(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','PERIML','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,1,1,5,0.,0.)
+      RETURN
+      END
+      SUBROUTINE HALFAX(MAJRX,MINRX,MAJRY,MINRY,X,Y,IXLAB,IYLAB)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','HALFAX','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,10,X,Y)
+      RETURN
+      END
+      SUBROUTINE LABMOD(FMTX,FMTY,NUMX,NUMY,ISIZX,ISIZY,IXDEC,IYDEC,
+     1                  IXOR)
+C
+C  RESETS PARAMETERS FOR TEXT GRAPHICS FROM DEFAULT VALUES.
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      CHARACTER*8 XFMT,YFMT,FMTX,FMTY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','LABMOD','VERSION 01')
+C
+C
+C +NOAO - Blockdata rewritten as run time initialization.
+C       EXTERNAL GRIDT
+	call gridt
+C -NOAO
+      XFMT = '        '
+      YFMT = '        '
+      XFMT = FMTX
+      YFMT = FMTY
+C
+      CALL GETUSV('XF',IVAL)
+      XRANGE = 2. ** IVAL
+      CALL GETUSV('YF', IVAL)
+      YRANGE = 2. ** IVAL
+C
+C  SIZX AND SIZY ARE COMPUTED TO BE PERCENTAGES OF TOTAL SCREEN
+C  WIDTH.
+C
+      IF (ISIZX .GT. 3) THEN
+        SIZX = FLOAT(ISIZX)/XRANGE
+      ELSEIF (ISIZX .EQ. 3) THEN
+        SIZX = 24./1024.
+      ELSEIF (ISIZX .EQ. 2) THEN
+        SIZX = 16./1024.
+      ELSEIF (ISIZX .EQ. 1) THEN
+        SIZX = 12./1024.
+      ELSE
+        SIZX = 8./1024.
+      ENDIF
+C
+      IF (ISIZY .GT. 3) THEN
+        SIZY = FLOAT(ISIZY)/XRANGE
+      ELSEIF (ISIZY .EQ. 3) THEN
+        SIZY = 24./1024.
+      ELSEIF (ISIZY .EQ. 2) THEN
+        SIZY = 16./1024.
+      ELSEIF (ISIZY .EQ. 1) THEN
+        SIZY = 12./1024.
+      ELSE
+        SIZY = 8./1024.
+      ENDIF
+C
+C  CALCULATE XDEC AND YDEC AS PERCENTAGES OF TOTAL SCREEN WIDTH
+C  IN PLOTTER ADDRESS UNITS.
+C
+      IF (IXDEC .EQ. 0 .OR. IXDEC .EQ. 1) THEN
+        YDEC = FLOAT(IXDEC)
+      ELSE
+        YDEC = FLOAT(IXDEC)/XRANGE
+      ENDIF
+      IF (IYDEC .EQ. 0 .OR. IYDEC .EQ. 1) THEN
+        XDEC = FLOAT(IYDEC)
+      ELSE
+        XDEC = FLOAT(IYDEC)/YRANGE
+      ENDIF
+C
+      IXORI = IXOR
+C
+      RETURN
+      END
+      SUBROUTINE TICK4(LMAJX,LMINX,LMAJY,LMINY)
+C
+C  CHANGES TICK LENGTH FOR EACH AXIS.
+C
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      REAL MAJX, MINX, MAJY, MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','TICK4','VERSION 01')
+C
+      CALL GETUSV('XF', IVAL)
+      XRANGE = 2. ** IVAL
+      CALL GETUSV('YF', IVAL)
+      YRANGE = 2. ** IVAL
+C
+      MAJX = FLOAT(LMAJX)/YRANGE
+      MINX = FLOAT(LMINX)/YRANGE
+      MAJY = FLOAT(LMAJY)/XRANGE
+      MINY = FLOAT(LMINY)/XRANGE
+C
+      RETURN
+      END
+      SUBROUTINE TICKS(LMAJ,LMIN)
+C
+      COMMON /TICK/ MAJX,MINX,MAJY,MINY
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','TICKS','VERSION 01')
+C
+      CALL TICK4(LMAJ,LMIN,LMAJ,LMIN)
+C
+      RETURN
+      END
+      SUBROUTINE CHSTR(LABEL,FIRST,LAST)
+C
+C  THIS CALCULATES THE POSITION OF THE FIRST NON-BLANK CHARACTER
+C  AND THE POSITION OF THE LAST NON-BLANK CHARACTER IN LABEL.
+C
+      INTEGER   FIRST, LAST
+      CHARACTER*15 LABEL
+C
+      DO 100 I = 1,15
+      IF (LABEL(I:I) .NE. ' ') GOTO 200
+ 100  CONTINUE
+ 200  FIRST = I
+      LAST = 15
+      IF (FIRST .NE. 15) THEN
+        DO 300 J = FIRST+1,15
+        IF (LABEL(J:J) .EQ. ' ') THEN
+          LAST = J-1
+          GOTO 999
+        ENDIF
+ 300    CONTINUE
+ 999    CONTINUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE EXPAND(MAXW)
+C
+C  THE WINDOW IS EXPANDED AND THE NEW WORLD COORDINATES ARE
+C  CALCULATED TO CORRESPOND TO THE MAXIMUM VIEWPORT.
+C  THE ORIGINAL ASPECT RATIO OF WORLD COORDINATES TO VIEWPORT
+C  COORDINATES REMAINS THE SAME.  UNDER THE NEWLY-DEFINED
+C  NORMALIZATION TRANSFORMATION, THE WINDOW OF THE ORIGINAL
+C  NORMALIZATION TRANSFORMATION IS MAPPED TO THE VIEWPORT
+C  OF THE ORIGINAL NORMALIZATION TRANSFORMATION IN EXACTLY
+C  THE SAME WAY AS IN THE INITIAL NORMALIZATION TRANSFORMATION.
+C
+      REAL MAXW(4), VIEW(4), WIND(4)
+      REAL LEFT
+C
+C  INQUIRE CURRENT WINDOW AND VIEWPORT SETTINGS.
+C
+      CALL GQCNTN(IERR,ICNT)
+      CALL GQNT(ICNT,IERR,WIND,VIEW)
+C
+C  CALCULATE RATIO OF Y WORLD/VIEWPORT COORDINATES.
+C
+      YRATIO = (WIND(4) - WIND(3))/(VIEW(4) - VIEW(3))
+C
+C  CALCULATE RATIO OF X WORLD/VIEWPORT COORDINATES.
+C
+      XRATIO = (WIND(2) - WIND(1))/(VIEW(2) - VIEW(1))
+C
+C  GET EXPANDED LOWER LIMIT Y COORDINATE.
+C
+      VBOTTM = VIEW(3) - 0.
+      BOTTOM = YRATIO * VBOTTM
+      MAXW(3) = WIND(3) - BOTTOM
+C
+C  GET EXPANDED UPPER LIMIT Y COORDINATE.
+C
+      VTOP = 1. - VIEW(4)
+      TOP = YRATIO * VTOP
+      MAXW(4) = WIND(4) + TOP
+C
+C  GET EXPANDED LEFT LIMIT X COORDINATE.
+C
+      VLEFT = VIEW(1) - 0.
+      LEFT = XRATIO * VLEFT
+      MAXW(1) = WIND(1) - LEFT
+C
+C  GET EXPANDED RIGHT LIMIT X COORDINATE.
+C
+      VRIGHT = 1. - VIEW(2)
+      RIGHT = XRATIO * VRIGHT
+      MAXW(2) = WIND(2) + RIGHT
+C
+C  SET NEW (EXPANDED) NORMALIZATION TRANSFORMATION.
+C
+      CALL GSWN(1,MAXW(1),MAXW(2),MAXW(3),MAXW(4))
+      CALL GSVP(1, 0., 1., 0., 1. )
+      CALL GSELNT(1)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/gridt.f b/sys/gio/ncarutil/gridt.f
new file mode 100644
index 00000000..eb10ddf1
--- /dev/null
+++ b/sys/gio/ncarutil/gridt.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c + noao: block data gridt changed to run time initialization
+c       BLOCK DATA GRIDT
+        subroutine gridt
+C
+C
+        COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+        COMMON /CLAB/ XFMT, YFMT
+        COMMON /TICK/ MAJX, MINX, MAJY, MINY
+        COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+        CHARACTER*8 XFMT,YFMT
+        REAL MAJX,MINX,MAJY,MINY
+C
+c +noao: following flag added to prevent initializing more than once
+        logical first
+        SAVE
+        data first /.true./
+        if (.not. first) then
+            return
+        endif
+        first = .false.
+C
+c       DATA XFMT,YFMT /'(E10.3) ','(E10.3) '/
+        XFMT = '(E10.3) '
+        YFMT = '(E10.3) '
+c
+c       DATA SIZX,SIZY / 0.01, 0.01 /
+        SIZX = 0.01
+        SIZY = 0.01
+c
+c       DATA XDEC,YDEC / 0., 0. /
+        XDEC = 0.
+        YDEC = 0.
+c
+c       DATA IXORI / 0 /
+        IXORI = 0 
+c
+c       DATA MAJX,MINX,MAJY,MINY / 0., 0., 0., 0./
+        MAJX = 0.
+        MINX = 0.
+        MAJY = 0.
+        MINY = 0.
+c
+c       DATA IGRIMJ,IGRIMN,IGRITX / 1, 1, 1/
+c+noao: These values changed so major axes and labels are bold
+        IGRIMJ = 2
+        IGRIMN = 1
+        IGRITX = 2
+C - noao
+        END
+C REVISION HISTORY---------------
+C----------------------------------------------------------
+
diff --git a/sys/gio/ncarutil/hafton.f b/sys/gio/ncarutil/hafton.f
new file mode 100644
index 00000000..7d597470
--- /dev/null
+++ b/sys/gio/ncarutil/hafton.f
@@ -0,0 +1,830 @@
+      SUBROUTINE HAFTON (Z,L,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPVAL)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C     SUBROUTINE HAFTON (Z,L,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPVAL)
+C
+C
+C     DIMENSION OF           Z(L,M)
+C     ARGUMENTS
+C
+C     LATEST REVISION        JULY,1984
+C
+C     PURPOSE                HAFTON DRAWS A HALF-TONE PICTURE FROM DATA
+C                            STORED IN A RECTANGULAR ARRAY WITH THE
+C                            INTENSITY IN THE PICTURE PROPORTIONAL TO
+C                            THE DATA VALUE.
+C
+C     USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                                 CALL EZHFTN (Z,M,N)
+C
+C                              ASSUMPTIONS:
+C                                  .ALL OF THE ARRAY IS TO BE DRAWN.
+C                                  .LOWEST VALUE IN Z WILL BE AT LOWEST
+C                                   INTENSITY ON READER/PRINTER OUTPUT.
+C                                  .HIGHEST VALUE IN Z WILL BE AT
+C                                   HIGHEST INTENSITY.
+C                                  .VALUES IN BETWEEN WILL APPEAR
+C                                   LINEARLY SPACED.
+C                                  .MAXIMUM POSSIBLE NUMBER OF
+C                                   INTENSITIES ARE USED.
+C                                  .THE PICTURE WILL HAVE A PERIMETER
+C                                   DRAWN.
+C                                  .FRAME WILL BE CALLED AFTER THE
+C                                   PICTURE IS DRAWN.
+C                                  .Z IS FILLED WITH NUMBERS THAT SHOULD
+C                                   BE USED (NO MISSING VALUES).
+C
+C                            IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                                 CALL HAFTON (Z,L,M,N,FLO,HI,NLEV,
+C                                              NOPT,NPRM,ISPV,SPVAL)
+C
+C     ARGUMENTS
+C
+C     ON INPUT               Z
+C     FOR EZHFTN               M BY N ARRAY TO BE USED TO GENERATE A
+C                              HALF-TONE PLOT.
+C
+C                            M
+C                              FIRST DIMENSION OF Z.
+C
+C                            N
+C                              SECOND DIMENSION OF Z.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR EZHFTN
+C
+C     ON INPUT               Z
+C     FOR HAFTON               THE ORIGIN OF THE ARRAY TO BE PLOTTED.
+C
+C                            L
+C                              THE FIRST DIMENSION OF Z IN THE CALLING
+C                              PROGRAM.
+C
+C                            M
+C                              THE NUMBER OF DATA VALUES TO BE PLOTTED
+C                              IN THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                              DIRECTION).  WHEN PLOTTING ALL OF AN
+C                              ARRAY, L = M.
+C
+C                            N
+C                              THE NUMBER OF DATA VALUES TO BE PLOTTED
+C                              IN THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                              DIRECTION).
+C
+C                            FLO
+C                              THE VALUE OF Z THAT CORRESPONDS TO THE
+C                              LOWEST INTENSITY.  (WHEN NOPT.LT.0, FLO
+C                              CORRESPONDS TO THE HIGHEST INTENSITY.)
+C                              IF FLO=HI=0.0, MIN(Z) WILL BE USED FOR FLO.
+C
+C                            HI
+C                              THE VALUE OF Z THAT CORRESPONDS TO THE
+C                              HIGHEST INTENSITY.  (WHEN NOPT.LT.0, HI
+C                              CORRESPONDS TO THE LOWEST INTENSITY.)  IF
+C                              HI=FLO=0.0, MAX(Z) WILL BE USED FOR HI.
+C
+C                            NLEV
+C                              THE NUMBER OF INTENSITY LEVELS DESIRED.
+C                              16 MAXIMUM.  IF NLEV = 0 OR 1, 16 LEVELS
+C                              ARE USED.
+C
+C                            NOPT
+C                              FLAG TO CONTROL THE MAPPING OF Z ONTO THE
+C                              INTENSITIES.  THE SIGN OF NOPT CONTROLS
+C                              THE DIRECTNESS OR INVERSENESS OF THE
+C                              MAPPING.
+C
+C                              . NOPT POSITIVE YIELDS DIRECT MAPPING.
+C                                THE LARGEST VALUE OF Z PRODUCES THE
+C                                MOST DENSE DOTS.  ON MECHANICAL PLOTTERS,
+C                                LARGE VALUES OF Z WILL PRODUCE A DARK
+C                                AREA ON THE PAPER.  WITH THE FILM
+C                                DEVELOPMENT METHODS USED AT NCAR,
+C                                LARGE VALUES OF Z WILL PRODUCE MANY
+C                                (WHITE) DOTS ON THE FILM, ALSO
+C                                RESULTING IN A DARK AREA ON
+C                                READER-PRINTER PAPER.
+C                              . NOPT NEGATIVE YIELDS INVERSE MAPPING.
+C                                THE SMALLEST VALUES OF Z PRODUCE THE
+C                                MOST DENSE DOTS RESULTING IN DARK
+C                                AREAS ON THE PAPER.
+C
+C                              THE ABSOLUTE VALUE OF NOPT DETERMINES THE
+C                              MAPPING OF Z ONTO THE INTENSITIES.  FOR
+C                              IABS(NOPT)
+C                              = 0  THE MAPPING IS LINEAR.  FOR
+C                                   EACH INTENSITY THERE IS AN EQUAL
+C                                   RANGE IN Z VALUE.
+C                              = 1  THE MAPPING IS LINEAR.  FOR
+C                                   EACH INTENSITY THERE IS AN EQUAL
+C                                   RANGE IN Z VALUE.
+C                              = 2  THE MAPPING IS EXPONENTIAL.  FOR
+C                                   LARGER VALUES OF Z, THERE IS A
+C                                   LARGER DIFFERENCE IN INTENSITY FOR
+C                                   RELATIVELY CLOSE VALUES OF Z.  DETAILS
+C                                   IN THE LARGER VALUES OF Z ARE DISPLAYED
+C                                   AT THE EXPENSE OF THE SMALLER VALUES
+C                                   OF Z.
+C                              = 3  THE MAPPING IS LOGRITHMIC, SO
+C                                   DETAILS OF SMALLER VALUES OF Z ARE SHOWN
+C                                   AT THE EXPENSE OF LARGER VALUES OF Z.
+C                              = 4  SINUSOIDAL MAPPING, SO MID-RANGE VALUES
+C                                   OF Z SHOW DETAILS AT THE EXPENSE OF
+C                                   EXTREME VALUES OF Z.
+C                              = 5  ARCSINE MAPPING, SO EXTREME VALUES OF
+C                                   Z ARE SHOWN AT THE EXPENSE OF MID-RANGE
+C                                   VALUES OF Z.
+C
+C                            NPRM
+C                              FLAG TO CONTROL THE DRAWING OF A
+C                              PERIMETER AROUND THE HALF-TONE PICTURE.
+C
+C                              . NPRM=0:  THE PERIMETER IS DRAWN WITH
+C                                TICKS POINTING AT DATA LOCATIONS.
+C                                (SIDE LENGTHS ARE PROPORTIONAL TO NUMBER
+C                                OF DATA VALUES.)
+C                              . NPRM POSITIVE:  NO PERIMETER IS DRAWN.  THE
+C                                PICTURE FILLS THE FRAME.
+C                              . NPRM NEGATIVE:  THE PICTURE IS WITHIN THE
+C                                CONFINES OF THE USER'S CURRENT VIEWPORT
+C                                SETTING.
+C
+C                            ISPV
+C                              FLAG TO TELL IF THE SPECIAL VALUE FEATURE
+C                              IS BEING USED.  THE SPECIAL VALUE FEATURE
+C                              IS USED TO MARK AREAS WHERE THE DATA IS
+C                              NOT KNOWN OR HOLES ARE WANTED IN THE
+C                              PICTURE.
+C
+C                              . ISPV = 0:  SPECIAL VALUE FEATURE NOT IN
+C                                USE.  SPVAL IS IGNORED.
+C                              . ISPV NON-ZERO:  SPECIAL VALUE FEATURE
+C                                IN USE.  SPVAL DEFINES THE SPECIAL
+C                                VALUE.  WHERE Z CONTAINS THE SPECIAL
+C                                VALUE, NO HALF-TONE IS DRAWN.  IF ISPV
+C                                = 0  SPECIAL VALUE FEATURE NOT IN USE.
+C                                     SPVAL IS IGNORED.
+C                                = 1  NOTHING IS DRAWN IN SPECIAL VALUE
+C                                     AREA.
+C                                = 2  CONTIGUOUS SPECIAL VALUE AREAS ARE
+C                                     SURROUNDED BY A POLYGONAL LINE.
+C                                = 3  SPECIAL VALUE AREAS ARE FILLED
+C                                     WITH X(S).
+C                                = 4  SPECIAL VALUE AREAS ARE FILLED IN
+C                                     WITH THE HIGHEST INTENSITY.
+C
+C                            SPVAL
+C                              THE VALUE USED IN Z TO DENOTE MISSING
+C                              VALUES.  THIS ARGUMENT IS IGNORED IF
+C                              ISPV = 0.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR HAFTON
+C
+C     NOTE                   THIS ROUTINE PRODUCES A HUGE NUMBER OF
+C                            PLOTTER INSTRUCTIONS PER PICTURE, AVERAGING
+C                            OVER 100,000 LINE-DRAWS PER FRAME WHEN M = N.
+C
+C
+C     ENTRY POINTS           EZHFTN, HAFTON, ZLSET, GRAY, BOUND, HFINIT
+C
+C     COMMON BLOCKS          HAFT01, HAFT02, HAFT03, HAFT04
+C
+C     REQUIRED LIBRARY       GRIDAL, THE ERPRT77 PACKAGE AND THE SPPS.
+C     ROUTINES
+C
+C     I/O                    PLOTS HALF-TONE PICTURE.
+C
+C     PRECISION              SINGLE
+C
+C     LANGUAGE               FORTRAN
+C
+C     HISTORY                REWRITE OF PHOMAP ORIGINALLY WRITTEN BY
+C                            M. PERRY OF HIGH ALTITUDE OBSERVATORY,
+C                            NCAR.
+C
+C     ALGORITHM              BI-LINEAR INTERPOLATION ON PLOTTER
+C                            (RESOLUTION-LIMITED) GRID OF NORMALIZED
+C                            REPRESENTATION OF DATA.
+C
+C     PORTABILITY            ANSI FORTRAN 77.
+C
+C
+C
+C INTERNAL PARAMTERSS
+C VALUES SET IN BLOCK DATA
+C         NAME  DEFAULT                   FUNCTION
+C         ----  -------                   ________
+C
+C         XLT     0.1    LEFT-HAND EDGE OF THE PLOT WHEN NSET=0.  (0.0=
+C                        LEFT EDGE OF FRAME, 1.0=RIGHT EDGE OF FRAME.)
+C         YBT     0.1    BOTTOM EDGE OF THE PLOT WHEN NSET=0.  (0.0=
+C                        BOTTOM OF FRAME, 1.0=TOP OF FRAME.)
+C         SIDE    0.8    LENGTH OF LONGER EDGE OF PLOT (SEE ALSO EXT).
+C         EXT     .25    LENGTHS OF THE SIDES OF THE PLOT ARE PROPOR-
+C                        TIONAL TO M AND N (WHEN NSET=0) EXCEPT IN
+C                        EXTREME CASES, NAMELY, WHEN MIN(M,N)/MAX(M,N)
+C                        IS LESS THAN EXT.  THEN A SQUARE PLOT IS PRO-
+C                        DUCED.  WHEN A RECTANGULAR PLOT IS PRODUCED,
+C                        THE PLOT IS CENTERED ON THE FRAME (AS LONG AS
+C                        SIDE+2*XLT = SIDE+2*YBT=1., AS WITH THE
+C                        DEFAULTS.)
+C         ALPHA   1.6    A PARAMETER TO CONTROL THE EXTREMENESS OF THE
+C                        MAPPING FUNCTION SPECIFIED BY NOPT.  (FOR
+C                        IABS(NOPT)=0 OR 1, THE MAPPING FUNCTION IS
+C                        LINEAR AND INDEPENDENT OF ALPHA.)  FOR THE NON-
+C                        LINEAR MAPPING FUNCTIONS, WHEN ALPHA IS CHANGED
+C                        TO A NUMBER CLOSER TO 1., THE MAPPING FUNCTION
+C                        BECOMES MORE LINEAR; WHEN ALPHA IS CHANGED TO
+C                        A LARGER NUMBER, THE MAPPING FUNCTION BECOMES
+C                        MORE EXTREME.
+C         MXLEV   16     MAXIMUM NUMBER OF LEVELS.  LIMITED BY PLOTTER.
+C         NCRTG   8      NUMBER OF CRT UNITS PER GRAY-SCALE CELL.
+C                        LIMITED BY PLOTTER.
+C         NCRTF   1024   NUMBER OF PLOTTER ADDRESS UNITS PER FRAME.
+C         IL    (BELOW)  AN ARRAY DEFINING WHICH OF THE AVAILABLE IN-
+C                        TENSITIES ARE USED WHEN LESS THAN THE MAXIMUM
+C                        NUMBER OF INTENSITIES ARE REQUESTED.
+C
+C
+C   NLEV         INTENSITIES USED
+C   ____         ________________
+C    2           5,11,
+C    3           4, 8,12,
+C    4           3, 6,10,13,
+C    5           2, 5, 8,11,14,
+C    6           1, 4, 7, 9,12,15,
+C    7           1, 4, 6, 8,10,12,15,
+C    8           1, 3, 5, 7, 9,11,13,15,
+C    9           1, 3, 4, 6, 8,10,12,13,15
+C   10           1, 3, 4, 6, 7, 9,10,12,13,15,
+C   11           1, 2, 3, 5, 6, 8,10,11,13,14,15,
+C   12           1, 2, 3, 5, 6, 7, 9,10,11,13,14,15,
+C   13           1, 2, 3, 4, 6, 7, 8, 9,10,12,13,14,15
+C   14           1, 2, 3, 4, 5, 6, 7, 9,10,11,12,13,14,15,
+C   15           1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+C   16           0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15
+C
+C
+
+      SAVE
+      DIMENSION       Z(L,N)      ,PX(2)       ,PY(2)
+      DIMENSION       ZLEV(16)    ,VWPRT(4)    ,WNDW(4)
+      DIMENSION                    VWPR2(4)    ,WND2(4)
+      CHARACTER*11    IDUMMY
+C
+C
+      COMMON /HAFTO1/ I          ,J          ,INTEN
+      COMMON /HAFTO2/ GLO        ,HA         ,NOPTN      ,ALPHA      ,
+     1                NSPV       ,SP         ,ICNST
+      COMMON /HAFTO3/ XLT        ,YBT        ,SIDE       ,EXT        ,
+     1                IOFFM      ,ALPH       ,MXLEV      ,NCRTG      ,
+     2                NCRTF      ,IL(135)
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT     ,XPNT(50)  ,YPNT(50)
+C +NOAO - Blockdata rewritten as run time initialization subroutine
+C
+C     EXTERNAL HFINIT
+      call hfinit
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','HAFTON','HAFTON','VERSION  1')
+C
+      NPOINT = 0
+      ALPHA = ALPH
+      GLO = FLO
+      HA = HI
+      NLEVL = MIN0(IABS(NLEV),MXLEV)
+      IF (NLEVL .LE. 1) NLEVL = MXLEV
+      NOPTN = NOPT
+      IF (NOPTN .EQ. 0) NOPTN = 1
+      NPRIM = NPRM
+      NSPV = MAX0(MIN0(ISPV,4),0)
+      IF (NSPV .NE. 0) SP = SPVAL
+      MX = L
+      NX = M
+      NY = N
+      CRTF = NCRTF
+      MSPV = 0
+C
+C SET INTENSITY BOUNDARY LEVELS
+C
+      CALL ZLSET (Z,MX,NX,NY,ZLEV,NLEVL)
+C
+C SET UP PERIMETER
+C
+      X3 = NX
+      Y3 = NY
+      CALL GQCNTN (IERR,NTORIG)
+      CALL GETUSV('LS',IOLLS)
+      IF (NPRIM.LT.0) THEN
+         CALL GQNT (NTORIG,IERR,WNDW,VWPRT)
+         X1 = VWPRT(1)
+         X2 = VWPRT(2)
+         Y1 = VWPRT(3)
+         Y2 = VWPRT(4)
+      ELSE IF (NPRIM.EQ.0) THEN
+         X1 = XLT
+         X2 = XLT+SIDE
+         Y1 = YBT
+         Y2 = YBT+SIDE
+         IF (AMIN1(X3,Y3)/AMAX1(X3,Y3) .GE. EXT) THEN
+            IF (NX-NY.LT.0) THEN
+               X2 =SIDE*X3/Y3+XLT
+               X2 = (AINT(X2*CRTF/FLOAT(NCRTG))*FLOAT(NCRTG))/CRTF
+            ELSE IF (NX-NY.GT.0) THEN
+               Y2 = SIDE*Y3/X3+YBT
+               Y2 = (AINT(Y2*CRTF/FLOAT(NCRTG))*FLOAT(NCRTG))/CRTF
+            END IF
+         END IF
+      ELSE IF (NPRIM.GT.0) THEN
+         X1 = 0.0
+         X2 = 1.0
+         Y1 = 0.0
+         Y2 = 1.0
+      END IF
+      MX1 = X1*CRTF
+      MX2 = X2*CRTF
+      MY1 = Y1*CRTF
+      MY2 = Y2*CRTF
+      IF (NPRIM.GT.0) THEN
+         MX1 = 1
+         MY1 = 1
+         MX2 = NCRTF
+         MY2 = NCRTF
+      END IF
+C
+C SAVE NORMALIZATION TRANS 1
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING FOR USE WITH PERIM
+C DRAW PERIMETER IF NPRIM EQUALS 0
+C
+      CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+      IF (NPRIM .EQ. 0) CALL PERIM (NX-1,1,NY-1,1)
+      IF (ICNST .NE. 0) THEN
+        CALL GSELNT (0)
+        CALL WTSTR(XLT*1.1,0.5,'CONSTANT FIELD',2,0,0)
+        GO TO 132
+      END IF
+C
+C FIND OFFSET FOR REFERENCE TO IL, WHICH IS TRIANGULAR
+C
+      IOFFST = NLEVL*((NLEVL-1)/2)+MOD(NLEVL-1,2)*(NLEVL/2)-1
+C
+C OUTPUT INTENSITY SCALE
+C
+      IF (NPRIM .GT. 0) GO TO 112
+      LEV = 0
+      KX = (1.1*XLT+SIDE)*CRTF
+      KY = YBT*CRTF
+      NNX = KX/NCRTG
+  109 LEV = LEV+1
+C +NOAO
+C The following statement moved from after statement label 111 (CONTINUE) to
+C here.  Otherwise an extra (unlabelled) grayscale box was being drawn.
+C This was (eventually) causing a [floating operand error] on a Sun-3.
+      IF (LEV .GT. NLEVL) GO TO 112
+C -NOAO
+      ISUB = IOFFST+LEV
+      INTEN = IL(ISUB)
+      IF (NOPTN .LT. 0) INTEN = MXLEV-INTEN
+      NNY = KY/NCRTG
+      DO 111 JJ=1,3
+         DO 110 II=1,10
+            I = NNX+II
+            J = NNY+JJ
+            CALL GRAY
+  110    CONTINUE
+  111 CONTINUE
+C +NOAO - FTN internal write rewritten as call to encode.
+C       WRITE(IDUMMY,'(G11.4)') ZLEV(LEV)
+	call encode (11, '(g11.4)', idummy, zlev(lev))
+C -NOAO
+      TKX = KX
+      TKY = KY+38
+      CALL GQNT(1,IERR,WND2,VWPR2)
+      CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+      CALL WTSTR (TKX,TKY,IDUMMY,0,0,-1)
+      CALL SET(VWPR2(1),VWPR2(2),VWPR2(3),VWPR2(4),
+     -         WND2(1),WND2(2),WND2(3),WND2(4),1)
+C
+C ADJUST 38 TO PLOTTER.
+C
+      KY = KY+52
+C
+C ADJUST 52 TO PLOTTER.
+C
+      GO TO 109
+C
+C STEP THROUGH PLOTTER GRID OF INTENSITY CELLS.
+C
+  112 IMIN = (MX1-1)/NCRTG+1
+      IMAX = (MX2-1)/NCRTG
+      JMIN = (MY1-1)/NCRTG+1
+      JMAX = (MY2-1)/NCRTG
+      XL = IMAX-IMIN+1
+      YL = JMAX-JMIN+1
+      XN = NX
+      YN = NY
+      LSRT = NLEVL/2
+      DO 130 J=JMIN,JMAX
+C
+C FIND Y FOR THIS J AND Z FOR THIS Y.
+C
+       YJ = (FLOAT(J-JMIN)+.5)/YL*(YN-1.)+1.
+         LOWY = YJ
+         YPART = YJ-FLOAT(LOWY)
+         IF (LOWY .NE. NY) GO TO 113
+         LOWY = LOWY-1
+         YPART = 1.
+  113    IPEN = 0
+         ZLFT = Z(1,LOWY)+YPART*(Z(1,LOWY+1)-Z(1,LOWY))
+         ZRHT = Z(2,LOWY)+YPART*(Z(2,LOWY+1)-Z(2,LOWY))
+         IF (NSPV .EQ. 0) GO TO 114
+         IF (Z(1,LOWY).EQ.SP .OR. Z(2,LOWY).EQ.SP .OR.
+     1       Z(1,LOWY+1).EQ.SP .OR. Z(2,LOWY+1).EQ.SP) IPEN = 1
+  114    IF (IPEN .EQ. 1) GO TO 117
+C
+C FIND INT FOR THIS Z.
+C
+         IF (ZLFT .GT. ZLEV(LSRT+1)) GO TO 116
+  115    IF (ZLFT .GE. ZLEV(LSRT)) GO TO 117
+C
+C LOOK LOWER
+C
+         IF (LSRT .LE. 1) GO TO 117
+         LSRT = LSRT-1
+         GO TO 115
+C
+C LOOK HIGHER
+C
+  116    IF (LSRT .GE. NLEVL) GO TO 117
+         LSRT = LSRT+1
+         IF (ZLFT .GT. ZLEV(LSRT+1)) GO TO 116
+C
+C OK
+C
+  117    IRHT = 2
+         LAST = LSRT
+         DO 129 I=IMIN,IMAX
+C
+C FIND X FOR THIS I AND Z FOR THIS X AND Y.
+C
+            IADD = 1
+            XI = (FLOAT(I-IMIN)+.5)/XL*(XN-1.)+1.
+            LOWX = XI
+            XPART = XI-FLOAT(LOWX)
+            IF (LOWX .NE. NX) GO TO 118
+            LOWX = LOWX-1
+            XPART = 1.
+C
+C TEST FOR INTERPOLATION POSITIONING
+C
+  118       IF (LOWX .LT. IRHT) GO TO 119
+C
+C MOVE INTERPOLATION ONE CELL TO THE RIGHT
+C
+            ZLFT = ZRHT
+            IRHT = IRHT+1
+            ZRHT = Z(IRHT,LOWY)+YPART*(Z(IRHT,LOWY+1)-Z(IRHT,LOWY))
+            IF (NSPV .EQ. 0) GO TO 118
+            IPEN = 0
+            IF (Z(IRHT-1,LOWY).EQ.SP .OR. Z(IRHT,LOWY).EQ.SP .OR.
+     1          Z(IRHT-1,LOWY+1).EQ.SP .OR. Z(IRHT,LOWY+1).EQ.SP)
+     2          IPEN = 1
+            GO TO 118
+  119       IF (IPEN .NE. 1) GO TO 123
+C
+C SPECIAL VALUE AREA
+C
+            GO TO (129,120,121,122),NSPV
+  120       MSPV = 1
+            GO TO 129
+  121       PX(1) = I*NCRTG
+            PY(1) = J*NCRTG
+            PX(2) = PX(1)+NCRTG-1
+            PY(2) = PY(1)+NCRTG-1
+            CALL GPL (2,PX,PY)
+            PYTMP = PY(1)
+            PY(1) = PY(2)
+            PY(2) = PYTMP
+            CALL GPL (2,PX,PY)
+C
+            GO TO 129
+  122       INTEN = MXLEV
+            GO TO 128
+  123       ZZ = ZLFT+XPART*(ZRHT-ZLFT)
+C
+C TEST FOR SAME INT AS LAST TIME.
+C
+            IF (ZZ .GT. ZLEV(LAST+1)) GO TO 126
+  124       IF (ZZ .GE. ZLEV(LAST)) GO TO 127
+C
+C LOOK LOWER
+C
+            IF (LAST .LE. 1) GO TO 125
+            LAST = LAST-1
+            GO TO 124
+  125       IF (ZZ .LT. ZLEV(LAST)) IADD = 0
+            GO TO 127
+C
+C LOOK HIGHER
+C
+  126       IF (LAST .GE. NLEVL) GO TO 127
+            LAST = LAST+1
+            IF (ZZ .GE. ZLEV(LAST+1)) GO TO 126
+C
+C OK
+C
+  127       ISUB = LAST+IOFFST+IADD
+            INTEN = IL(ISUB)
+            IF (NOPTN .LT. 0) INTEN = MXLEV-INTEN
+  128       CALL GRAY
+  129    CONTINUE
+  130 CONTINUE
+C
+C PUT OUT ANY REMAINING BUFFERED POINTS.
+C
+      IF (NPOINT.GT.0) THEN
+         CALL GQNT(1,IERR,WND2,VWPR2)
+         CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+         CALL POINTS(XPNT,YPNT,NPOINT,0,0)
+         CALL SET(VWPR2(1),VWPR2(2),VWPR2(3),VWPR2(4),
+     -            WND2(1),WND2(2),WND2(3),WND2(4),1)
+      ENDIF
+C
+C CALL BOUND IF ISPV=2 AND SPECIAL VALUES WERE FOUND.
+C
+      IF (MSPV .EQ. 1) THEN
+        CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+        CALL BOUND (Z,MX,NX,NY,SP)
+      END IF
+  132 CONTINUE
+C
+C RESTORE NORMALIZATION TRANS 1 AND ORIGINAL NORMALIZATION NUMBER
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL SETUSV('LS',IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+C
+      END
+      SUBROUTINE ZLSET (Z,MX,NX,NY,ZL,NLEVL)
+      SAVE
+C
+      DIMENSION       Z(MX,NY)   ,ZL(NLEVL)
+C
+      COMMON /HAFTO2/ GLO        ,HA         ,NOPTN      ,ALPHA      ,
+     1                NSPV       ,SP         ,ICNST
+C
+      BIG = R1MACH(2)
+C
+C ZLSET PUTS THE INTENSITY LEVEL BREAK POINTS IN ZL.
+C ALL ARGUMENTS ARE AS IN HAFTON.
+C
+      LX = NX
+      LY = NY
+      NLEV = NLEVL
+      NOPT = IABS(NOPTN)
+      RALPH = 1./ALPHA
+      ICNST = 0
+      IF (GLO.NE.0. .OR. HA.NE.0.) GO TO 106
+C
+C FIND RANGE IF NOT KNOWN.
+C
+      GLO = BIG
+      HA = -GLO
+      IF (NSPV .NE. 0) GO TO 103
+      DO 102 J=1,LY
+         DO 101 I=1,LX
+            ZZ = Z(I,J)
+            GLO = AMIN1(ZZ,GLO)
+            HA = AMAX1(ZZ,HA)
+  101    CONTINUE
+  102 CONTINUE
+      GO TO 106
+  103 DO 105 J=1,LY
+         DO 104 I=1,LX
+            ZZ = Z(I,J)
+            IF (ZZ .EQ. SP) GO TO 104
+            GLO = AMIN1(ZZ,GLO)
+            HA = AMAX1(ZZ,HA)
+  104    CONTINUE
+  105 CONTINUE
+C
+C FILL ZL
+C
+  106 DELZ = HA-GLO
+      IF (DELZ .EQ. 0.) GO TO 115
+      DZ = DELZ/FLOAT(NLEV)
+      NLEVM1 = NLEV-1
+      DO 114 K=1,NLEVM1
+         ZNORM = FLOAT(K)/FLOAT(NLEV)
+         GO TO (107,108,109,110,111),NOPT
+C
+C NOPT=1
+C
+  107    ZL(K) = GLO+FLOAT(K)*DZ
+         GO TO 114
+C
+C NOPT=2
+C
+  108    ONORM = (1.-(1.-ZNORM)**ALPHA)**RALPH
+         GO TO 113
+C
+C NOPT=3
+C
+  109    ONORM = 1.-(1.-ZNORM**ALPHA)**RALPH
+         GO TO 113
+C
+C NOPT=4
+C
+  110    ONORM = .5*(1.-(ABS(ZNORM+ZNORM-1.))**ALPHA)**RALPH
+         GO TO 112
+C
+C NOPT=5
+C
+  111    ZNORM2 = ZNORM+ZNORM
+         IF (ZNORM .GT. .5) ZNORM2 = 2.-ZNORM2
+         ONORM = .5*(1.-(1.-ABS(ZNORM2)**ALPHA)**RALPH)
+  112    IF (ZNORM .GT. .5) ONORM = 1.-ONORM
+  113    ZL(K) = GLO+DELZ*ONORM
+  114 CONTINUE
+      ZL(NLEV) = BIG
+      RETURN
+  115 ICNST = 1
+      RETURN
+      END
+      SUBROUTINE GRAY
+C
+C SUBROUTINE GRAY COLORS HALF-TONE CELL (I,J) WITH INTENSITY INTEN.
+C THE ROUTINE ASSUMES 8X8 CELL SIZE ON A VIRTUAL SCREEN 1024X1024.
+C
+      DIMENSION       IFOT(16)   ,JFOT(16)
+      DIMENSION       WNDW(4)    ,VWPRT(4)
+CCC      DIMENSION       MX(16)  ,MY(16)
+      COMMON /HAFTO1/ I          ,J          ,INTEN
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT     ,XPNT(50)  ,YPNT(50)
+      SAVE
+C
+      DATA
+     1 IFOT(1),IFOT(2),IFOT(3),IFOT(4),IFOT(5),IFOT(6),IFOT(7),IFOT(8)/
+     2   1,      5,      1,      5,      3,      7,      3,      7   /
+      DATA
+     1 IFOT(9),IFOT(10),IFOT(11),IFOT(12),IFOT(13),IFOT(14),IFOT(15)/
+     2   3,      7,       3,       7,       1,       5,       1/,
+     3 IFOT(16)/
+     4   5    /
+C
+      DATA
+     1 JFOT(1),JFOT(2),JFOT(3),JFOT(4),JFOT(5),JFOT(6),JFOT(7),JFOT(8)/
+     2   1,      5,      5,      1,      3,     7,      7,      3   /
+      DATA
+     1 JFOT(9),JFOT(10),JFOT(11),JFOT(12),JFOT(13),JFOT(14),JFOT(15)/
+     2   1,      5,       5,       1,       3,       7,       7/,
+     3 JFOT(16)/
+     4   3    /
+C
+      IF (INTEN) 103,103,101
+  101 I1 = I*8
+      J1 = J*8
+      IF ((NPOINT+INTEN) .LE.NPTMAX)  GO TO 1015
+      CALL GQNT(1,IERR,WNDW,VWPRT)
+      CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+      CALL POINTS(XPNT,YPNT,NPOINT,0,0)
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),1)
+      NPOINT = 0
+ 1015 DO 102 I2=1,INTEN
+      NPOINT = NPOINT + 1
+      XPNT(NPOINT) = I1+IFOT(I2)
+      YPNT(NPOINT) = J1+JFOT(I2)
+  102 CONTINUE
+  103 RETURN
+      END
+      SUBROUTINE BOUND (Z,MX,NNX,NNY,SSP)
+      DIMENSION       Z(MX,NNY)   ,PX(2)   ,PY(2)
+C
+C BOUND DRAWS A POLYGONAL BOUNDRY AROUND ANY SPECIAL-VALUE AREAS IN Z.
+C
+      SAVE
+      NX = NNX
+      NY = NNY
+C
+C VERTICAL LINES
+C
+      SP = SSP
+      DO 103 IP1=3,NX
+         I = IP1-1
+         PX(1) = I
+         PX(2) = I
+         IM1 = I-1
+         DO 102 JP1=2,NY
+            PY(2) = JP1
+            J = JP1-1
+            PY(1) = J
+            KLEFT = 0
+            IF (Z(IM1,J).EQ.SP .OR. Z(IM1,JP1).EQ.SP) KLEFT = 1
+            KCENT = 0
+            IF (Z(I,J).EQ.SP .OR. Z(I,JP1).EQ.SP) KCENT = 1
+            KRIGT = 0
+            IF (Z(IP1,J).EQ.SP .OR. Z(IP1,JP1).EQ.SP) KRIGT = 1
+            JUMP = KLEFT*4+KCENT*2+KRIGT+1
+            GO TO (102,101,102,102,101,102,102,102,102),JUMP
+  101       CALL GPL (2,PX,PY)
+  102    CONTINUE
+  103 CONTINUE
+C
+C HORIZONTAL
+C
+      DO 106 JP1=3,NY
+         J = JP1-1
+         PY(1) = J
+         PY(2) = J
+         JM1 = J-1
+         DO 105 IP1=2,NX
+            PX(2) = IP1
+            I = IP1-1
+            PX(1) = I
+            KLOWR = 0
+            IF (Z(I,JM1).EQ.SP .OR. Z(IP1,JM1).EQ.SP) KLOWR = 1
+            KCENT = 0
+            IF (Z(I,J).EQ.SP .OR. Z(IP1,J).EQ.SP) KCENT = 1
+            KUPER = 0
+            IF (Z(I,JP1).EQ.SP .OR. Z(IP1,JP1).EQ.SP) KUPER = 1
+            JUMP = KLOWR*4+KCENT*2+KUPER+1
+            GO TO (105,104,105,105,104,105,105,105,105),JUMP
+  104       CALL GPL (2,PX,PY)
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
+      SUBROUTINE EZHFTN (Z,M,N)
+C
+      DIMENSION       Z(M,N)
+      SAVE
+C
+C HALF-TONE PICTURE VIA SHORTEST ARGUMENT LIST.
+C ASSUMPTIONS--
+C     ALL OF THE ARRAY IS TO BE DRAWN,
+C     LOWEST VALUE IN Z WILL BE AT LOWEST INTENSITY ON READER/PRINTER
+C     OUTPUT, HIGHEST VALUE IN Z WILL BE AT HIGHEST INTENSITY, VALUES IN
+C     BETWEEN WILL APPEAR LINEARLY SPACED, MAXIMUM POSSIBLE NUMBER OF
+C     INTENSITIES ARE USED, THE PICTURE WILL HAVE A PERIMETER DRAWN,
+C     FRAME WILL BE CALLED AFTER THE PICTURE IS DRAWN, Z IS FILLED WITH
+C     NUMBERS THAT SHOULD BE USED (NO UNKNOWN VALUES).
+C IF THESE CONDITIONS ARE NOT MET, USE HAFTON.
+C EZHFTN ARGUMENTS--
+C     Z   2 DIMENSIONAL ARRAY TO BE USED TO GENERATE A HALF-TONE PLOT.
+C     M   FIRST DIMENSION OF Z.
+C     N   SECOND DIMENSION OF Z.
+C
+      DATA FLO,HI,NLEV,NOPT,NPRM,ISPV,SPV/0.0,0.0,0,0,0,0,0.0/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','HAFTON','EZHFTN','VERSION  1')
+C
+      CALL HAFTON (Z,M,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPV)
+C
+C +NOAO - EZHFTN no longer calls frame.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+C REVISION HISTORY---
+C
+C JULY     1984    CONVERTED TO FORTAN 77 AND GKS
+C
+C MARCH    1983    INSTITUTED BUFFERING OF POINTS WITHIN ROUTINE GRAY,
+C                  WHICH DRAMATICALLY REDUCES SIZE OF OUTPUT PLOT CODE,
+C                  METACODE.  THIS IN TURN GENERALLY IMPROVES THROUGHPUT
+C                  OF METACODE INTERPRETERS.
+C
+C FEBRUARY 1979    MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C
+C JANUARY  1978    DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C
+C-----------------------------------------------------------------------
+C
diff --git a/sys/gio/ncarutil/hfinit.f b/sys/gio/ncarutil/hfinit.f
new file mode 100644
index 00000000..e64207eb
--- /dev/null
+++ b/sys/gio/ncarutil/hfinit.f
@@ -0,0 +1,229 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data hfinit changed to run time initialization
+c     BLOCKDATA HFINIT
+        subroutine hfinit
+C
+      COMMON /HAFTO3/ XLT        ,YBT        ,SIDE       ,EXT,
+     1                IOFFM      ,ALPH       ,MXLEV   ,NCRTG ,
+     2                NCRTF      ,IL(135)
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT  ,XPNT(50)  ,YPNT(50)
+C
+C  INITIALIZATION OF INTERNAL PARAMETERS
+C
+c     DATA   XLT,  YBT,SIDE,EXT,IOFFM,ALPH,MXLEV,NCRTG,NCRTF/
+c    1     0.102,0.102,.805,.25,    0, 1.6,   16,    8, 1024/
+c
+c +noao:  following flag added to prevent initializing more than once
+        logical first
+        SAVE
+        data first /.true./
+        if (.not. first) then
+            return
+        endif
+        first = .false.
+
+c +noao: call to utilbd added to make sure those parameters set by getusv
+c        have been set before they are retrieved.
+         call utilbd
+c -noao
+        XLT   = 0.102
+        YBT   = 0.102
+        SIDE  = .805
+        EXT   = .25
+        IOFFM = 0
+        ALPH  = 1.6
+        MXLEV = 16
+        NCRTG = 8
+        NCRTF = 1024
+c
+c     DATA IL(1),IL(2),IL(3),IL(4),IL(5),IL(6),IL(7),IL(8),IL(9),IL(10),
+c    1IL(11),IL(12),IL(13),IL(14),IL(15),IL(16),IL(17),IL(18),IL(19),
+c    2IL(20),IL(21),IL(22),IL(23),IL(24),IL(25),IL(26),IL(27),IL(28),
+c    3IL(29),IL(30),IL(31),IL(32),IL(33),IL(34),IL(35),IL(36),IL(37),
+c    4IL(38),IL(39),IL(40),IL(41),IL(42),IL(43),IL(44)/
+c    5    5,11,
+c    6    4, 8,12,
+c    7    3, 6,10,13,
+c    8    2, 5, 8,11,14,
+c    9    1, 4, 7, 9,12,15,
+c    +    1, 4, 6, 8,10,12,15,
+c    1    1, 3, 5, 7, 9,11,13,15,
+c    2     1, 3, 4, 6, 8, 10, 12, 13, 15/
+c
+       IL(1)  =  5
+       IL(2)  = 11
+       IL(3)  =  4
+       IL(4)  =  8
+       IL(5)  = 12
+       IL(6)  =  3
+       IL(7)  =  6
+       IL(8)  = 10
+       IL(9)  = 13
+       IL(10) =  2
+       IL(11) =  5 
+       IL(12) =  8
+       IL(13) = 11
+       IL(14) = 14
+       IL(15) =  1
+       IL(16) =  4
+       IL(17) =  7
+       IL(18) =  9
+       IL(19) = 12
+       IL(20) = 15
+       IL(21) =  1
+       IL(22) =  4
+       IL(23) =  6
+       IL(24) =  8
+       IL(25) = 10
+       IL(26) = 12
+       IL(27) = 15
+       IL(28) =  1
+       IL(29) =  3
+       IL(30) =  5
+       IL(31) =  7
+       IL(32) =  9
+       IL(33) = 11
+       IL(34) = 13
+       IL(35) = 15
+       IL(36) =  1
+       IL(37) =  3
+       IL(38) =  4
+       IL(39) =  6
+       IL(40) =  8
+       IL(41) = 10
+       IL(42) = 12
+       IL(43) = 13
+       IL(44) = 15
+c
+c     DATA IL(45),IL(46),
+c    1IL(47),IL(48),IL(49),IL(50),IL(51),IL(52),IL(53),IL(54),IL(55),
+c    2IL(56),IL(57),IL(58),IL(59),IL(60),IL(61),IL(62),IL(63),IL(64),
+c    3IL(65),IL(66),IL(67),IL(68),IL(69),IL(70),IL(71),IL(72),IL(73),
+c    4IL(74),IL(75),IL(76),IL(77),IL(78),IL(79),IL(80),IL(81),IL(82),
+c    5IL(83),IL(84),IL(85),IL(86),IL(87),IL(88),IL(89),IL(90)/
+c    6    1, 3, 4, 6, 7, 9,10,12,13,15,
+c    7    1, 2, 3, 5, 6, 8,10,11,13,14,15,
+c    8    1, 2, 3, 5, 6, 7, 9,10,11,13,14,15,
+c    9    1, 2, 3, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15/
+c
+       IL(45) =  1
+       IL(46) =  3
+       IL(47) =  4
+       IL(48) =  6 
+       IL(49) =  7 
+       IL(50) =  9
+       IL(51) = 10
+       IL(52) = 12
+       IL(53) = 13
+       IL(54) = 15 
+       IL(55) =  1 
+       IL(56) =  2 
+       IL(57) =  3 
+       IL(58) =  5 
+       IL(59) =  6 
+       IL(60) =  8
+       IL(61) = 10
+       IL(62) = 11
+       IL(63) = 13
+       IL(64) = 14
+       IL(65) = 15 
+       IL(66) =  1 
+       IL(67) =  2 
+       IL(68) =  3
+       IL(69) =  5 
+       IL(70) =  6 
+       IL(71) =  7 
+       IL(72) =  9
+       IL(73) = 10
+       IL(74) = 11
+       IL(75) = 13
+       IL(76) = 14
+       IL(77) = 15 
+       IL(78) =  1 
+       IL(79) =  2 
+       IL(80) =  3 
+       IL(81) =  4 
+       IL(82) =  6 
+       IL(83) =  7 
+       IL(84) =  8 
+       IL(85) =  9 
+       IL(86) = 10 
+       IL(87) = 12 
+       IL(88) = 13 
+       IL(89) = 14 
+       IL(90) = 15
+c
+c     DATA IL(91),
+c    1IL(92),IL(93),IL(94),IL(95),IL(96),IL(97),IL(98),IL(99),IL(100),
+c    2IL(101),IL(102),IL(103),IL(104),IL(105),IL(106),IL(107),IL(108),
+c    3IL(109),IL(110),IL(111),IL(112),IL(113),IL(114),IL(115),IL(116),
+c    4IL(117),IL(118),IL(119),IL(120),IL(121),IL(122),IL(123),IL(124),
+c    5IL(125),IL(126),IL(127),IL(128),IL(129),IL(130),IL(131),IL(132),
+c    6IL(133),IL(134),IL(135)/
+c    7    1, 2, 3, 4, 5, 6, 7, 9,10,11,12,13,14,15,
+c    8    1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+c    9    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15/
+c
+       IL(91) =  1 
+       IL(92) = 2 
+       IL(93) = 3 
+       IL(94) = 4 
+       IL(95) = 5 
+       IL(96) = 6 
+       IL(97) = 7 
+       IL(98) = 9
+       IL(99) = 10
+       IL(100) = 11
+       IL(101) = 12
+       IL(102) = 13
+       IL(103) = 14
+       IL(104) = 15 
+       IL(105) = 1 
+       IL(106) = 2 
+       IL(107) = 3 
+       IL(108) = 4 
+       IL(109) = 5 
+       IL(110) = 6 
+       IL(111) = 7 
+       IL(112) = 8 
+       IL(113) = 9
+       IL(114) = 10
+       IL(115) = 11
+       IL(116) = 12
+       IL(117) = 13
+       IL(118) = 14
+       IL(119) = 15 
+       IL(120) = 0 
+       IL(121) = 1
+       IL(122) = 2 
+       IL(123) = 3 
+       IL(124) = 4 
+       IL(125) = 5 
+       IL(126) = 6 
+       IL(127) = 7 
+       IL(128) = 8 
+       IL(129) = 9
+       IL(130) = 10
+       IL(131) = 11
+       IL(132) = 12
+       IL(133) = 13
+       IL(134) = 14
+       IL(135) = 15
+c
+C SIZE OF THE COORDINATE BUFFERING ARRAYS FOR POINTS BUFFERING.
+c     DATA  NPTMAX/50/
+      NPTMAX = 50
+c -noao
+      END
diff --git a/sys/gio/ncarutil/isosrb.f b/sys/gio/ncarutil/isosrb.f
new file mode 100644
index 00000000..5c1481a0
--- /dev/null
+++ b/sys/gio/ncarutil/isosrb.f
@@ -0,0 +1,98 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: blockdata isosrb changed to run time initialization subroutine
+      subroutine isosrb
+c     BLOCKDATA ISOSRB
+C
+C     BLOCK DATA
+C
+      COMMON /ISOSR2/ LX         ,NX               ,NY   ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)      ,GENDON
+      LOGICAL               GENDON
+      COMMON /ISOSR6/ IX         ,IY               ,IDX  ,IDY,
+     1                IS         ,ISS        ,NP         ,CV,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX,
+     3                IHB        ,IHS        ,IHV        ,IVOLD,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD,
+     5                IHF
+      COMMON /ISOSR9/ BIG        ,IXBIT
+      COMMON /TEMPR/  RZERO
+      LOGICAL               YCHANG       ,HBFLAG        ,FIRST   ,IHF
+C
+      logical first1
+      SAVE
+      data first1 /.true./
+      if (.not. first1) then
+        return
+      endif
+      first1 = .false.
+c
+c     DATA LX,NX,NY/8,128,128/
+      LX = 8
+      NX = 128
+      NY = 128   
+c
+c     DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/
+c    1        -1 ,   -1 ,    0 ,    1 ,    1 ,          1 ,      0 ,   -1 /
+      INX(1) = -1
+      INX(2) = -1
+      INX(3) =  0
+      INX(4) =  1
+      INX(5) =  1
+      INX(6) =  1
+      INX(7) =  0
+      INX(8) = -1
+c
+c     DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/
+c    1         0 ,    1 ,    1 ,    1 ,    0 ,   -1 ,   -1 ,   -1 /
+      INY(1) =  0
+      INY(2) =  1
+      INY(3) =  1
+      INY(4) =  1
+      INY(5) =  0
+      INY(6) = -1
+      INY(7) = -1
+      INY(8) = -1
+c
+c     DATA NR/500/
+      NR = 500
+c
+c     DATA NBPW/16/
+      NBPW = 16
+c
+c     DATA IHF/.FALSE./
+      IHF = .FALSE.
+C
+c     DATA GENDON /.FALSE./
+      GENDON = .FALSE.
+c
+c     DATA RZERO/0./
+      RZERO = 0.
+C
+C
+C RX = (NX-1)/SCREEN WIDTH FROM TRN32I
+C RY = (NY-1)/SCREEN HEIGHT FROM TRN32I
+C
+c     DATA RX,RY/.00389,.00389/
+      RX = .00389
+      RY = .00389  
+C
+c -noao
+      END
diff --git a/sys/gio/ncarutil/isosrf.f b/sys/gio/ncarutil/isosrf.f
new file mode 100644
index 00000000..7be532ee
--- /dev/null
+++ b/sys/gio/ncarutil/isosrf.f
@@ -0,0 +1,1696 @@
+      SUBROUTINE ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C DIMENSION OF           T(LU,LV,MW),EYE(3),SLAB(MUVWP2,MUVWP2)
+C ARGUMENTS
+C
+C LATEST REVISION        DECEMBER 1984
+C
+C PURPOSE                ISOSRF DRAWS AN APPROXIMATION OF AN ISO-VALUED
+C                        SURFACE FROM A THREE-DIMENSIONAL ARRAY WITH
+C                        HIDDEN LINES REMOVED.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                            CALL EZISOS (T,MU,MV,MW,EYE,SLAB,TISO)
+C
+C                               ASSUMPTIONS:
+C                                 -- ALL OF THE T ARRAY IS TO BE USED.
+C                                 -- IFLAG IS CHOSEN INTERNALLY.
+C                                 -- FRAME IS CALLED BY EZISOS.
+C
+C                        IF THE ASSUMPTIONS ARE NOT MET, USE
+C
+C                            CALL ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2,
+C                                         SLAB,TISO,IFLAG)
+C
+C ARGUMENTS
+C
+C ON INPUT               T
+C                          THREE DIMENSIONAL ARRAY OF DATA THAT DEFINES
+C                          THE ISO-VALUED SURFACE.
+C
+C                        LU
+C                          FIRST DIMENSION OF T IN THE CALLING PROGRAM.
+C
+C                        MU
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE U DIRECTION (THE FIRST
+C                          SUBSCRIPT DIRECTION).  WHEN PROCESSING THE
+C                          ENTIRE ARRAY, LU = MU (AND LV = MV).
+C
+C                        LV
+C                          SECOND DIMENSION OF T IN THE CALLING PROGRAM.
+C
+C                        MV
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE V DIRECTION (THE SECOND
+C                          SUBSCRIPT DIRECTION).
+C
+C                        MV
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE W DIRECTION (THE THIRD
+C                          SUBSCRIPT DIRECTION).
+C
+C                        EYE
+C                          THE POSITION OF THE EYE IN THREE-SPACE.  T IS
+C                          CONSIDERED TO BE IN A BOX WITH OPPOSITE
+C                          CORNERS (1,1,1) AND (MU,MV,MW).  THE EYE IS
+C                          AT (EYE(1),EYE(2),EYE(3)), WHICH MUST BE
+C                          OUTSIDE THE BOX THAT CONTAINS T.  WHILE GAINING
+C                          EXPERIENCE WITH THE ROUTINE, A GOOD CHOICE
+C                          FOR EYE MIGHT BE (5.0*MU,3.5*MV,2.0*MW).
+C
+C                        MUVWP2
+C                          THE MAXIMUM OF (MU,MV,MW)+2; THAT IS,
+C                          MUVWP2 = MAX(MU,MV,MW)+2).
+C
+C                        SLAB
+C                          A WORK SPACE USED FOR INTERNAL STORAGE.  SLAB
+C                          MUST BE AT LEAST MUVWP2*MUVWP2 WORDS LONG.
+C
+C                        TISO
+C                          THE ISO-VALUE USED TO DEFINE THE SURFACE.  THE
+C                          SURFACE DRAWN WILL SEPARATE VOLUMES OF T THAT
+C                          HAVE VALUES GREATER THAN OR EQUAL TO TISO FROM
+C                          VOLUMES OF T THAT HAVE VALUES LESS THAN TISO.
+C
+C                        IFLAG
+C                          THIS FLAG SERVES TWO PURPOSES.
+C                          .  FIRST, THE ABSOLUTE VALUE OF IFLAG
+C                             DETERMINES WHICH TYPES OF LINES ARE DRAWN
+C                             TO APPROXIMATE THE SURFACE.  THREE TYPES
+C                             OF LINES ARE CONSIDERED:  LINES OF
+C                             CONSTANT U, LINES OF CONSTANT V AND LINES
+C                             OF CONSTANT W.  THE FOLLOWING TABLE LISTS
+C                             THE TYPES OF LINES DRAWN.
+C
+C                                                LINES OF CONSTANT
+C                                                -----------------
+C                             IABS(IFLAG)           U    V    W
+C                             -----------          ---  ---  ---
+C                                  1               NO   NO   YES
+C                                  2               NO   YES  NO
+C                                  3               NO   YES  YES
+C                                  4               YES  NO   NO
+C                                  5               YES  NO   YES
+C                                  6               YES  YES  NO
+C                             0, 7 OR MORE         YES  YES  YES
+C
+C                          .  SECOND, THE SIGN OF IFLAG DETERMINES WHAT
+C                             IS INSIDE AND WHAT IS OUTSIDE, HENCE,
+C                             WHICH LINES ARE VISIBLE AND WHAT IS DONE
+C                             AT THE BOUNDARY OF T.  FOR IFLAG:
+C
+C                             POSITIVE   T VALUES GREATER THAN TISO ARE
+C                                        ASSUMED TO BE INSIDE THE SOLID
+C                                        FORMED BY THE DRAWN SURFACE.
+C                             NEGATIVE   T VALUES LESS THAN TISO ARE
+C                                        ASSUMED TO BE INSIDE THE SOLID
+C                                        FORMED BY THE DRAWN SURFACE.
+C                             IF THE ALGORITHM DRAWS A CUBE, REVERSE THE
+C                             SIGN OF IFLAG.
+C
+C ON OUTPUT              T,LU,MU,LV,MV,MW,EYE,MUVWP2,TISO AND IFLAG ARE
+C                        UNCHANGED.  SLAB HAS BEEN WRITTEN IN.
+C
+C NOTE                   .   THIS ROUTINE IS FOR LOWER RESOLUTION ARRAYS
+C                            THAN ISOSRFHR.  40 BY 40 BY 40 IS A
+C                            PRACTICAL MAXIMUM.
+C                        .   TRANSFORMATIONS CAN BE ACHIEVED BY
+C                            ADJUSTING SCALING STATEMENT FUNCTIONS IN
+C                            ISOSRF, SET3D AND TR32.
+C                        .   THE HIDDEN-LINE ALGORITHM IS NOT EXACT, SO
+C                            VISIBILITY ERRORS CAN OCCUR.
+C                        .   THREE-DIMENSIONAL PERSPECTIVE CHARACTER
+C                            LABELING OF ISOSRF IS POSSIBLE BY USING
+C                            THE UTILITY PWRZI.  FOR A DESCRIPTION OF
+C                            THE USAGE, SEE THE PWRZI DOCUMENTATION.
+C
+C ENTRY POINTS           ISOSRF, EZISOS, SET3D, TRN32I, ZEROSC,
+C                        STCNTR, DRCNTR, TR32, FRSTS, KURV1S, KURV2S,
+C                        FRSTC, FILLIN, DRAWI, ISOSRB, MMASK
+C
+C COMMON BLOCKS          ISOSR1, ISOSR2, ISOSR3, ISOSR4, ISOSR5,
+C                        ISOSR6, ISOSR7, ISOSR8, ISOSR9, TEMPR,
+C                        PWRZ1I
+C
+C REQUIRED LIBRARY       THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O                    PLOTS SURFACE
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN 77
+C
+C HISTORY                DEVELOPED FOR USERS OF ISOSRFHR WITH SMALLER
+C                        ARRAYS.
+C
+C ALGORITHM              CUTS THROUGH THE THREE-DIMENSIONAL ARRAY ARE
+C                        CONTOURED WITH A SMOOTHING CONTOURER WHICH ALSO
+C                        MARKS A MODEL OF THE PLOTTING PLANE.  INTERIORS
+C                        OF BOUNDARIES ARE FILLED IN AND THE RESULT IS
+C                        .OR.ED INTO ANOTHER MODEL OF THE PLOTTING PLANE
+C                        WHICH IS USED TO TEST SUBSEQUENT CONTOUR LINES
+C                        FOR VISIBILITY.
+C
+C TIMING                 VARIES WIDELY WITH SIZE OF T AND THE VOLUME OF
+C                        THE SPACE ENCLOSED BY THE SURFACE DRAWN.
+C
+C  **NOTE**                  SPACE REQUIREMENTS CAN BE REDUCED BY
+C                            CHANGING THE SIZE OF THE ARRAYS ISCR, ISCA
+C                            (FOUND IN COMMON ISOSR2), MASK(FOUND IN
+C                            COMMON ISOSR5) AND THE VARIABLE NBPW
+C                            (COMMON ISOSR5).
+C                            ISCR AND ISCA NEED 128X128 BITS.  SO ON A
+C                            64 BIT MACHINE ISCR, ISCA CAN BE
+C                            DIMENSIONED TO (2,128). NBPW SET IN
+C                            SUBROUTINE MMASK SHOULD CONTAIN THE
+C                            NUMBER OF BITS PER WORD YOU WISH TO
+C                            UTILIZE.
+C                            THE DIMENSION OF MASK AND NMASK SHOULD
+C                            EQUAL THE VALUE OF NBPW.
+C                            LS SHOULD BE SET TO THE FIRST DIMENSION
+C                            OF ISCA AND ISCR.
+C
+C               EXAMPLES:
+C                            ON A 60 BIT MACHINE:
+C                                 DIMENSION ISCA(4,128), ISCR(4,128)
+C                                 DIMENSION MASK(32)
+C                                 NBPW = 32
+C                            ON A 64 BIT MACHINE:
+C                                 DIMENSION ISCA(2,128), ISCR(2,128)
+C                                 DIMENSION MASK(64)
+C                                 NBPW = 64
+C
+C INTERNAL PARAMETERS    NAME  DEFAULT           FUNCTION
+C                        ----  -------           --------
+C                        IREF     1     FLAG TO CONTROL DRAWING OF AXES.
+C                                       .IREF=NONZERO   DRAW AXES.
+C                                       .IREF=ZERO      DO NOT DRAW AXES.
+C
+C
+      SAVE
+      DIMENSION       T(LU,LV,MW),EYE(3)     ,SLAB(MUVWP2,MUVWP2)
+C
+      COMMON /ISOSR1/ ISLBT      ,U          ,V          ,W
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+      LOGICAL         GENDON
+      DATA IREF/1/
+C
+      AVE(A,B) = (A+B)*.5
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C +NOAO - Blockdata ISOSRB rewritten as run time initialization
+C     EXTERNAL ISOSRB
+      call isosrb
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','ISOSRF','ISOSRF','VERSION 12')
+      NERR = 0
+C
+C 3-SPACE  U,V,W,IU,IV,IW,ETC
+C 2-SPACE  X,Y,IX,IY,ETC
+C
+C  INITIALIZE MASKS
+C
+      IF (.NOT.GENDON) CALL MMASK
+C
+C  SET SHIFT VALUE FOR X,Y PACKING
+C
+C  IF YOUR MACHINE HAS MORE THAN 16 BITS PER WORD THIS CHECK MAY BE
+C  MODIFIED
+C
+      IF (LU .LE. 256) GO TO  10
+      NERR = NERR + 1
+      CALL SETER('DIMENSION OF CUBE EXCEEDS 256',NERR,2)
+      RETURN
+   10 DO  20 J=1,30
+         IF (LU .LE. 2**(J-1)) GO TO  30
+   20 CONTINUE
+   30 IXBIT = J
+      NU = MU
+      NUP2 = NU+2
+      NV = MV
+      NVP2 = NV+2
+      NW = MW
+      NWP2 = NW+2
+      FNU = NU
+      FNV = NV
+      FNW = NW
+      SU1 = SU(1.)
+      SV1 = SV(1.)
+      SW1 = SW(1.)
+      SUNU = SU(FNU)
+      SVNV = SV(FNV)
+      SWNW = SW(FNW)
+      AVEU = AVE(SU1,SUNU)
+      AVEV = AVE(SV1,SVNV)
+      AVEW = AVE(SW1,SWNW)
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+      NUVWP2 = MUVWP2
+      TVAL = TISO
+      NFLAG = IABS(IFLAG)
+      IF (NFLAG.EQ.0 .OR. NFLAG.GE.8) NFLAG = 7
+C
+C SET UP SCALING
+C
+      FACT = -ISIGN(1,IFLAG)
+      CALL SET3D (EYE,1.,FNU,1.,FNV,1.,FNW)
+C
+C BOUND LOWER AND LEFT EDGE OF SLAB
+C
+      EDGE = SIGN(BIG,FACT)
+      DO  40 IUVW=1,NUVWP2
+         SLAB(IUVW,1) = EDGE
+         SLAB(1,IUVW) = EDGE
+   40 CONTINUE
+C
+C SLICES PERPENDICULAR TO U. THAT IS, V W SLICES. T OF CONSTANT U.
+C
+      IF (NFLAG .LT. 4) GO TO 100
+      CALL ZEROSC
+      ISLBT = -1
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO  50 IV=2,NVP2
+         SLAB(IV,NWP2) = EDGE
+   50 CONTINUE
+      DO  60 IW=2,NWP2
+         SLAB(NVP2,IW) = EDGE
+   60 CONTINUE
+C
+C GO THRU 3-D ARRAY IN U DIRECTION.  IUEW=IU EITHER WAY.
+C PICK IU BASED ON EYEU.
+C
+      DO  90 IUEW=1,NU
+         IU = IUEW
+         IF (EYEU .GT. AVEU) IU = NU+1-IUEW
+         U = IU
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO  80 IV=1,NV
+            DO  70 IW=1,NW
+               SLAB(IV+1,IW+1) = T(IU,IV,IW)
+   70       CONTINUE
+   80    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NVP2,NWP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+   90 CONTINUE
+C
+C SLICES PERPENDICULAR TO V. U W SLICES. T OF CONSTANT V.
+C
+  100 IF (MOD(NFLAG/2,2) .EQ. 0) GO TO 160
+      CALL ZEROSC
+      ISLBT = 0
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO 110 IU=2,NUP2
+         SLAB(IU,NWP2) = EDGE
+  110 CONTINUE
+      DO 120 IW=2,NWP2
+         SLAB(NUP2,IW) = EDGE
+  120 CONTINUE
+C
+C GO THRU T IN V DIRECTION.  IVEW=IV EITHER WAY.
+C
+      DO 150 IVEW=1,NV
+         IV = IVEW
+         IF (EYEV .GT. AVEV) IV = NV+1-IVEW
+         V = IV
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO 140 IU=1,NU
+            DO 130 IW=1,NW
+               SLAB(IU+1,IW+1) = T(IU,IV,IW)
+  130       CONTINUE
+  140    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NUP2,NWP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+  150 CONTINUE
+C
+C SLICES PERPENDICULAR TO W. U V SLICES. T OF CONSTANT W.
+C
+  160 IF (MOD(NFLAG,2) .EQ. 0) GO TO 220
+      CALL ZEROSC
+C
+      ISLBT = 1
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO 170 IU=2,NUP2
+         SLAB(IU,NVP2) = EDGE
+  170 CONTINUE
+      DO 180 IV=2,NVP2
+         SLAB(NUP2,IV) = EDGE
+  180 CONTINUE
+C
+C GO THRU T IN W DIRECTION.
+C
+      DO 210 IWEW=1,NW
+         IW = IWEW
+         IF (EYEW .GT. AVEW) IW = NW+1-IWEW
+         W = IW
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO 200 IU=1,NU
+            DO 190 IV=1,NV
+               SLAB(IU+1,IV+1) = T(IU,IV,IW)
+  190       CONTINUE
+  200    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NUP2,NVP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+  210 CONTINUE
+C
+C DRAW REFERENCE PLANE EDGES AND W AXIS.
+C
+  220 IF (IREF .EQ. 0) RETURN
+      CALL TRN32I (SU1,SV1,SW1,XT,YT,DUM,2)
+      IF (EYEV .LT. SV1) GO TO 240
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 230 IU=2,NU
+         CALL TRN32I (SU(FLOAT(IU)),SV1,SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  230 CONTINUE
+      GO TO 250
+  240 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SUNU,SV1,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  250 IF (EYEU .GT. SUNU) GO TO 270
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 260 IV=2,NV
+         CALL TRN32I (SUNU,SV(FLOAT(IV)),SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  260 CONTINUE
+      GO TO 280
+  270 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SUNU,SVNV,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  280 IF (EYEV .GT. SVNV) GO TO 300
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 290 IUOW=2,NU
+         CALL TRN32I (SU(FLOAT(NU-IUOW+1)),SVNV,SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  290 CONTINUE
+      GO TO 310
+  300 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SVNV,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  310 IF (EYEU .LT. SU1) GO TO 330
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 320 IVOW=2,NV
+         CALL TRN32I (SU1,SV(FLOAT(NV-IVOW+1)),SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  320 CONTINUE
+      GO TO 340
+  330 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SV1,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  340 IF (EYEU.LE.SU1 .OR. EYEV.LE.SV1) GO TO 360
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 350 IW=2,NW
+         CALL TRN32I (SU1,SV1,SW(FLOAT(IW)),XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  350 CONTINUE
+C +NOAO - Plotit buffer needs to be flushed before returning.
+      call plotit (0, 0, 2)
+C -NOAO
+      RETURN
+  360 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SV1,SWNW,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+C +NOAO - Plotit buffer needs to be flushed before returning.
+      call plotit (0, 0, 2)
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE EZISOS (T,MU,MV,MW,EYE,SLAB,TISO)
+C
+      SAVE
+      DIMENSION       T(MU,MV,MW),EYE(3)
+C
+        DATA ANG,PI/.35,3.141592/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','ISOSRF','EZISOS','VERSION 12')
+C
+C ARGUMENTS DESCRIBED IN ISOSRF
+C
+C PICK TYPES OF LINES TO DRAW
+C
+      NU = MU
+      NV = MV
+      NW = MW
+      TVAL = TISO
+      MAX = MAX0(NU,NV,NW)+2
+      ATU = NU/2
+      ATV = NV/2
+      ATW = NW/2
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+      RU = EYEU-ATU
+      RV = EYEV-ATV
+      RW = EYEW-ATW
+      RU2 = RU*RU
+      RV2 = RV*RV
+      RW2 = RW*RW
+      DU = SQRT(RV2+RW2)
+      DV = SQRT(RU2+RW2)
+      DW = SQRT(RU2+RV2)
+      DR = 1./SQRT(RU2+RV2+RW2)
+C
+C  COMPUTE THE ARCCOSINE
+C
+      TU = DU*DR
+      ANGU = ATAN(ABS(SQRT(1.-TU*TU)/TU))
+      IF (TU .LE. 0.) ANGU = PI-ANGU
+      TV = DV*DR
+      ANGV = ATAN(ABS(SQRT(1.-TV*TV)/TV))
+      IF (TV .LE. 0.) ANGV = PI-ANGV
+      TW = DW*DR
+      ANGW = ATAN(ABS(SQRT(1.-TW*TW)/TW))
+      IF (TW .LE. 0.) ANGW = PI-ANGW
+C
+C BREAK POINT IS ABOUT 20 DEGREES OR ABOUT .35 RADIANS
+C
+      IFLAG = 0
+      IF (ANGU .GT. ANG) IFLAG = IFLAG+4
+      IF (ANGV .GT. ANG) IFLAG = IFLAG+2
+      IF (ANGW .GT. ANG) IFLAG = IFLAG+1
+C
+C FIND SIGN OF IFLAG
+C
+      ICNT = 0
+      IF (ABS(RU) .LE. ATU) GO TO  30
+      IU = 1
+      IF (EYEU .GT. ATU) IU = NU
+      DO  20 IW=1,NW
+         DO  10 IV=1,NV
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   10    CONTINUE
+   20 CONTINUE
+   30 IF (ABS(RV) .LE. ATV) GO TO  60
+      IV = 1
+      IF (EYEV .GT. ATV) IV = NV
+      DO  50 IW=1,NW
+         DO  40 IU=1,NU
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   40    CONTINUE
+   50 CONTINUE
+   60 IF (ABS(RW) .LE. ATW) GO TO  90
+      IW = 1
+      IF (EYEW .GT. ATW) IW = NW
+      DO  80 IV=1,NV
+         DO  70 IU=1,NU
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   70    CONTINUE
+   80 CONTINUE
+   90 IFLAG = ISIGN(IFLAG,ICNT)
+      CALL ISOSRF (T,NU,NU,NV,NV,NW,EYE,MAX,SLAB,TVAL,IFLAG)
+C +NOAO - Call to frame is suppressed.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE SET3D (EYE,ULO,UHI,VLO,VHI,WLO,WHI)
+      SAVE
+      COMMON /TEMPR/  RZERO
+C
+      DIMENSION       EYE(3)
+C
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+      COMMON /PWRZ1I/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+C
+C
+      AVE(A,B) = (A+B)*.5
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C CONSTANTS FOR PWRZ
+C
+      UUMIN = ULO
+      UUMAX = UHI
+      VVMIN = VLO
+      VVMAX = VHI
+      WWMIN = WLO
+      WWMAX = WHI
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+C
+C FIND CORNERS IN 2-SPACE FOR 3-SPACE BOX CONTAINING OBJECT
+C
+      ISCALE = 0
+      ATU = AVE(SU(UUMIN),SU(UUMAX))
+      ATV = AVE(SV(VVMIN),SV(VVMAX))
+      ATW = AVE(SW(WWMIN),SW(WWMAX))
+      BIGD = 0.
+      IF (RZERO .LE. 0.) GO TO  10
+C
+C RELETIVE SIZE FEATURE IN USE.
+C GENERATE EYE POSITION THAT MAKES BOX HAVE MAXIMUM PROJECTED SIZE.
+C
+      ALPHA = -(VVMIN-ATV)/(UUMIN-ATU)
+      VVEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      UUEYE = VVEYE*ALPHA
+      VVEYE = VVEYE+ATV
+      UUEYE = UUEYE+ATU
+      WWEYE = ATW
+      CALL TRN32I (ATU,ATV,ATW,UUEYE,VVEYE,WWEYE,1)
+      CALL TRN32I (UUMIN,VVMIN,ATW,XMIN,DUMM,DUMM,2)
+      CALL TRN32I (UUMAX,VVMIN,WWMIN,DUMM,YMIN,DUMM,2)
+      CALL TRN32I (UUMAX,VVMAX,ATW,XMAX,DUMM,DUMM,2)
+      CALL TRN32I (UUMAX,VVMIN,WWMAX,DUMM,YMAX,DUMM,2)
+      BIGD = SQRT((UUMAX-UUMIN)**2+(VVMAX-VVMIN)**2+(WWMAX-WWMIN)**2)*.5
+      R0 = RZERO
+      GO TO  20
+   10 CALL TRN32I (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      CALL TRN32I (SU(UUMIN),SV(VVMIN),SW(WWMIN),X1,Y1,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMIN),SW(WWMAX),X2,Y2,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMAX),SW(WWMIN),X3,Y3,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMAX),SW(WWMAX),X4,Y4,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMIN),SW(WWMIN),X5,Y5,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMIN),SW(WWMAX),X6,Y6,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMAX),SW(WWMIN),X7,Y7,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMAX),SW(WWMAX),X8,Y8,DUM,2)
+      XMIN = AMIN1(X1,X2,X3,X4,X5,X6,X7,X8)
+      XMAX = AMAX1(X1,X2,X3,X4,X5,X6,X7,X8)
+      YMIN = AMIN1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+      YMAX = AMAX1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+C
+C ADD RIGHT AMOUNT TO KEEP PICTURE SQUARE
+C
+   20 WIDTH = XMAX-XMIN
+      HIGHT = YMAX-YMIN
+      DIF = .5*(WIDTH-HIGHT)
+      IF (DIF)  30, 50, 40
+   30 XMIN = XMIN+DIF
+      XMAX = XMAX-DIF
+      GO TO  50
+   40 YMIN = YMIN-DIF
+      YMAX = YMAX+DIF
+   50 ISCALE = 1
+      CALL TRN32I (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      RETURN
+      END
+      SUBROUTINE TRN32I (U,V,W,XT,YT,ZT,IENT)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C ARGUMENTS FOR SET
+C U,V,W    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.  THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C TRN32 ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.  WHEN ISCALE=0, XT AND YT ANR IN THE SAME
+C          UNITS AS U,V, AND W.  WHEN ISCALE'0, XT AND YT
+C          ARE IN PLOTTER COORDINATES.
+C ZT       NOT USED.
+C
+      SAVE
+      COMMON /PWRZ1I/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+C
+C RANGE OF PLOTTER COORDINATES
+C
+C
+C  WARNING
+C  IF PLOTTER MAXIMUM VALUE RANGES (IN X OR Y DIRECTION) FALL BELOW
+C  101, THEN CHANGES MUST BE MADE IN SUBROUTINE FRSTC. THE REQUIRED
+C  CHANGES ARE MARKED BY WARNING COMMENTS IN FRSTC.
+      DATA NLX,NBY,NRX,NTY/10,10,32760,32760/
+        DATA PI/3.1411592/
+C
+C STORE THE PARAMETERS OF THE SET CALL FOR USE
+C WITH THE TRANSLATE CALL
+C
+C DECIDE IF SET OR TRANSLATE CALL
+C
+      IF (IENT .NE. 1) GO TO  50
+      AU = U
+      AV = V
+      AW = W
+      EU = XT
+      EV = YT
+      EW = ZT
+C
+C
+C
+C
+C
+      DU = AU-EU
+      DV = AV-EV
+      DW = AW-EW
+      D = SQRT(DU*DU+DV*DV+DW*DW)
+      COSAL = DU/D
+      COSBE = DV/D
+      COSGA = DW/D
+C
+C  COMPUTE THE ARCCOSINE
+C
+      AL = ATAN(ABS(SQRT(1.-COSAL*COSAL)/COSAL))
+      IF (COSAL .LE. 0.) AL = PI-AL
+      BE = ATAN(ABS(SQRT(1.-COSBE*COSBE)/COSBE))
+      IF (COSBE .LE. 0.) BE = PI-BE
+      GA = ATAN(ABS(SQRT(1.-COSGA*COSGA)/COSGA))
+      IF (COSGA .LE. 0.) GA = PI-GA
+      SINGA = SIN(GA)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE W AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE W AXIS, THE 3-SPACE V AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE W AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+      ASSIGN  90 TO JDONE
+      IF (ISCALE)  10, 30, 10
+   10 X0 = XMIN
+      Y0 = YMIN
+      X1 = NLX
+      Y1 = NBY
+      X2 = NRX-NLX
+      Y2 = NTY-NBY
+      X3 = X2/(XMAX-XMIN)
+      Y3 = Y2/(YMAX-YMIN)
+      X4 = NRX
+      Y4 = NTY
+      FACT = 1.
+      IF (BIGD .LE. 0.) GO TO  20
+      X0 = -BIGD
+      Y0 = -BIGD
+      X3 = X2/(2.*BIGD)
+      Y3 = Y2/(2.*BIGD)
+      FACT = R0/D
+   20 DELCRT = X2
+      ASSIGN  80 TO JDONE
+   30 IF (SINGA .LT. 0.0001) GO TO  40
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   40 SINBE = SIN(BE)
+      R = 1./SINBE
+      ASSIGN  60 TO JUMP
+      RETURN
+C
+C********************  ENTRY TRN32  ************************
+C     ENTRY TRN32 (U,V,W,XT,YT,ZT)
+C
+   50 UU = U
+      VV = V
+      WW = W
+      Q = D/((UU-EU)*COSAL+(VV-EV)*COSBE+(WW-EW)*COSGA)
+      GO TO JUMP,( 60, 70)
+   60 UU = ((EW+Q*(WW-EW)-AW)*COSAL-(EU+Q*(UU-EU)-AU)*COSGA)*R
+      VV = (EV+Q*(VV-EV)-AV)*R
+      GO TO JDONE,( 80, 90)
+   70 UU = ((EU+Q*(UU-EU)-AU)*COSBE-(EV+Q*(VV-EV)-AV)*COSAL)*R
+      VV = (EW+Q*(WW-EW)-AW)*R
+      GO TO JDONE,( 80, 90)
+   80 XT = AMIN1(X4,AMAX1(X1,X1+X3*(FACT*UU-X0)))
+      YT = AMIN1(Y4,AMAX1(Y1,Y1+Y3*(FACT*VV-Y0)))
+      RETURN
+   90 XT = UU
+      YT = VV
+      RETURN
+      END
+      SUBROUTINE ZEROSC
+      SAVE
+C
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+C
+C ZERO BOTH SCRENE MODELS.
+C
+      DO  20 I=1,LX
+         DO  10 J=1,NY
+            ISCR(I,J) = 0
+            ISCA(I,J) = 0
+   10    CONTINUE
+   20 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STCNTR (Z,L,M,N,CONV)
+C
+      SAVE
+      DIMENSION       Z(L,N)
+C
+C THIS ROUTINE FINDS THE BEGINNINGS OF ALL CONTOUR LINES AT LEVEL CONV.
+C FIRST THE EDGES ARE SEARCHED FOR LINES INTERSECTING THE EDGE (OPEN
+C LINES) THEN THE INTERIOR IS SEARCHED FOR LINES WHICH DO NOT INTERSECT
+C THE EDGE (CLOSED LINES).  BEGINNINGS ARE STORED IN IR TO PREVENT RE-
+C TRACING OF LINES.  IF IR IS FILLED, THE SEARCH IS STOPPED FOR THIS
+C CONV.
+C
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+C  PACK X AND Y
+C
+      IPXY(I1,J1) = ISHIFT(I1,IXBIT)+J1
+C
+      IENTRY = 0
+      NP = 0
+      CV = CONV
+C
+C THE FOLLOWING CODE SHOULD BE RE-ENABLED IF THIS ROUTINE IS USED FOR
+C GENERAL CONTOURING
+C
+C     ISS=0
+C     DO 2 IP1=2,M
+C     I=IP1-1
+C     IF(Z(I,1).GE.CV.OR.Z(IP1,1).LT.CV) GO TO 1
+C     IX=IP1
+C     IY=1
+C     IDX=-1
+C     IDY=0
+C     IS=1
+C     CALL DRLINE(Z,L,M,N)
+C   1 IF(Z(IP1,N).GE.CV.OR.Z(I,N).LT.CV) GO TO 2
+C     IX=I
+C     IY=N
+C     IDX=1
+C     IDY=0
+C     IS=5
+C     CALL DRLINE(Z,L,M,N)
+C   2 CONTINUE
+C     DO 4 JP1=2,N
+C     J=JP1-1
+C     IF(Z(M,J).GE.CV.OR.Z(M,JP1).LT.CV) GO TO 3
+C     IX=M
+C     IY=JP1
+C     IDX=0
+C     IDY=-1
+C     IS=7
+C     CALL DRLINE(Z,L,M,N)
+C   3 IF(Z(1,JP1).GE.CV.OR.Z(1,J).LT.CV) GO TO 4
+C     IX=1
+C     IY=J
+C     IDX=0
+C     IDY=1
+C     IS=3
+C     CALL DRLINE(Z,L,M,N)
+C   4 CONTINUE
+C
+      ISS = 1
+      DO  40 JP1=3,N
+         J = JP1-1
+         DO  30 IP1=2,M
+            I = IP1-1
+            IF (Z(I,J).GE.CV .OR. Z(IP1,J).LT.CV) GO TO  30
+            IXY = IPXY(IP1,J)
+            IF (NP .EQ. 0) GO TO  20
+            DO  10 K=1,NP
+               IF (IR(K) .EQ. IXY) GO TO  30
+   10       CONTINUE
+   20       NP = NP+1
+            IF (NP .GT. NR) RETURN
+            IR(NP) = IXY
+            IX = IP1
+            IY = J
+            IDX = -1
+            IDY = 0
+            IS = 1
+            CALL DRCNTR (Z,L,M,N)
+   30    CONTINUE
+   40 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRCNTR (Z,L,MM,NN)
+      SAVE
+C
+      DIMENSION       Z(L,NN)
+C
+C THIS ROUTINE TRACES A CONTOUR LINE WHEN GIVEN THE BEGINNING BY STLINE.
+C TRANSFORMATIONS CAN BE ADDED BY DELETING THE STATEMENT FUNCTIONS FOR
+C FX AND FY IN DRLINE AND MINMAX AND ADDING EXTERNAL FUNCTIONS.
+C X=1. AT Z(1,J), X=FLOAT(M) AT Z(M,J). X TAKES ON NON-INTEGER VALUES.
+C Y=1. AT Z(I,1), Y=FLOAT(N) AT Z(I,N). Y TAKES ON NON-INTEGER VALUES.
+C
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+      LOGICAL         IPEN       ,IPENO
+C
+      DATA IOFFP,SPVAL/0,0./
+      DATA IPEN,IPENO/.TRUE.,.TRUE./
+C
+C  PACK X AND Y
+C
+      IPXY(I1,J1) = ISHIFT(I1,IXBIT)+J1
+      FX(X1,Y1) = X1
+      FY(X1,Y1) = Y1
+      C(P11,P21) = (P11-CV)/(P11-P21)
+C
+      M = MM
+      N = NN
+      IF (IOFFP .EQ. 0) GO TO  10
+      ASSIGN 100 TO JUMP1
+      ASSIGN 150 TO JUMP2
+      GO TO  20
+   10 ASSIGN 120 TO JUMP1
+      ASSIGN 160 TO JUMP2
+   20 IX0 = IX
+      IY0 = IY
+      IS0 = IS
+      IF (IOFFP .EQ. 0) GO TO  30
+      IX2 = IX+INX(IS)
+      IY2 = IY+INY(IS)
+      IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL
+      IPENO = IPEN
+   30 IF (IDX .EQ. 0) GO TO  40
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO  50
+   40 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+   50 IF (IPEN) CALL FRSTS (FX(X,Y),FY(X,Y),1)
+   60 IS = IS+1
+      IF (IS .GT. 8) IS = IS-8
+      IDX = INX(IS)
+      IDY = INY(IS)
+      IX2 = IX+IDX
+      IY2 = IY+IDY
+      IF (ISS .NE. 0) GO TO  70
+      IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 190
+   70 IF (CV-Z(IX2,IY2))  80, 80, 90
+   80 IS = IS+4
+      IX = IX2
+      IY = IY2
+      GO TO  60
+   90 IF (IS/2*2 .EQ. IS) GO TO  60
+      GO TO JUMP1,(100,120)
+  100 ISBIG = IS+(8-IS)/6*8
+      IX3 = IX+INX(ISBIG-1)
+      IY3 = IY+INY(ISBIG-1)
+      IX4 = IX+INX(ISBIG-2)
+      IY4 = IY+INY(ISBIG-2)
+      IPENO = IPEN
+      IF (ISS .NE. 0) GO TO 110
+      IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 190
+      IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 190
+  110 IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL .AND.
+     1       Z(IX3,IY3).NE.SPVAL .AND. Z(IX4,IY4).NE.SPVAL
+  120 IF (IDX .EQ. 0) GO TO 130
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 140
+  130 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  140 GO TO JUMP2,(150,160)
+  150 IF (.NOT.IPEN) GO TO 170
+      IF (IPENO) GO TO 160
+C
+C END OF LINE SEGMENT
+C
+      CALL FRSTS (D1,D2,3)
+      CALL FRSTS (FX(XOLD,YOLD),FY(XOLD,YOLD),1)
+C
+C CONTINUE LINE SEGMENT
+C
+  160 CALL FRSTS (FX(X,Y),FY(X,Y),2)
+  170 XOLD = X
+      YOLD = Y
+      IF (IS .NE. 1) GO TO 180
+      NP = NP+1
+      IF (NP .GT. NR) GO TO 190
+      IR(NP) = IPXY(IX,IY)
+  180 IF (ISS .EQ. 0) GO TO  60
+      IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO  60
+C
+C END OF LINE
+C
+  190 CALL FRSTS (D1,D2,3)
+      RETURN
+      END
+      SUBROUTINE TR32 (X,Y,MX,MY)
+      SAVE
+C
+      COMMON /ISOSR1/ ISLBT      ,U          ,V          ,W
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+      XX = X
+      YY = Y
+      IF (ISLBT)  10, 20, 30
+   10 CALL TRN32I (SU(U),SV(XX-1.),SW(YY-1.),XT,YT,DUM,2)
+      GO TO  40
+   20 CALL TRN32I (SU(XX-1.),SV(V),SW(YY-1.),XT,YT,DUM,2)
+      GO TO  40
+   30 CALL TRN32I (SU(XX-1.),SV(YY-1.),SW(W),XT,YT,DUM,2)
+   40 MX = XT
+      MY = YT
+      RETURN
+      END
+      SUBROUTINE FRSTS (XX,YY,IENT)
+C
+C THIS IS A SPECIAL VERSION OF THE SMOOTHING DASHED LINE PACKAGE.  LINES
+C ARE SMOOTHED IN THE SAME WAY, BUT NO SOFTFARE DASHED LINES ARE USED.
+C CONDITIONAL PLOTTING ROUTINES ARE CALL WHICH DETERMINE THE VISIBILITY
+C OF A LINE SEGMENT BEFORE PLOTTING.
+C
+      SAVE
+      DIMENSION       XSAVE(70)  ,YSAVE(70)  ,XP(70)     ,YP(70)     ,
+     1                TEMP(70)
+C
+      COMMON /ISOSR7/ IENTRY     ,IONES
+C
+      DATA NP/150/
+      DATA L1/70/
+      DATA TENSN/2.5/
+      DATA PI/3.14159265358/
+      DATA SMALL/128./
+C
+      AVE(A,B) = .5*(A+B)
+C
+C  DECIDE IF FRSTS,VECTS,LASTS CALL
+C
+      GO TO ( 10, 20, 40),IENT
+   10 DEG = 180./PI
+      X = XX
+      Y = YY
+      LASTFL = 0
+      SSLP1 = 0.0
+      SSLPN = 0.0
+      XSVN = 0.0
+      YSVN = 0.0
+C
+C INITIALIZE THE POINT AND SEGMENT COUNTER
+C N COUNTS THE NUMBER OF POINTS/SEGMENT
+C
+      N = 0
+C
+C NSEG = 0       FIRST SEGMENT
+C NSEG = 1       MORE THAN ONE SEGMENT
+C
+      NSEG = 0
+      CALL TR32 (X,Y,MX,MY)
+C
+C SAVE THE X,Y COORDINATES OF THE FIRST POINT
+C XSV1           CONTAINS THE X COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C YSV1           CONTAINS THE Y COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C
+      XSV1 = MX
+      YSV1 = MY
+      GO TO  30
+C
+C ************************* ENTRY VECTS *************************
+C     ENTRY VECTS (XX,YY)
+C
+   20 X = XX
+      Y = YY
+C
+C VECTS          SAVES THE X,Y COORDINATES OF THE ACCEPTED
+C                POINTS ON A LINE SEGMENT
+C
+      CALL TR32 (X,Y,MX,MY)
+C
+CIF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT
+C
+      IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT.
+     1    SMALL) RETURN
+      IFLAG = 0
+   30 N = N+1
+C
+C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT
+C XSAVE          THE ARRAY OF X COORDINATES OF LINE SEGMENT
+C YSAVE          THE ARRAY OF Y COORDINATES OF LINE SEGMENT
+C
+      XSAVE(N) = MX
+      YSAVE(N) = MY
+      XSVN = XSAVE(N)
+      YSVN = YSAVE(N)
+      IF (N .GE. L1-1) GO TO  50
+      RETURN
+C
+C ************************* ENTRY LASTS *************************
+C     ENTRY LASTS
+C
+   40 LASTFL = 1
+C
+C LASTS          CHECKS FOR PERIODIC LINES AND SETS UP
+C                  THE CALLS TO KURV1S AND KURV2S
+C
+C IFLAG = 0      OK TO CALL LASTS DIRECTLY
+C IFLAG = 1      LASTS WAS JUST CALLED FROM BY VECTS
+C                IGNORE CALL TO LASTS
+C
+      IF (IFLAG .EQ. 1) RETURN
+C
+C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE
+C
+   50 IFLAG = 1
+C
+C IPRD = 0       PERIODIC LINE
+C IPRD = 1       NON-PERIODIC LINE
+C
+      IPRD = 1
+      IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0
+C
+C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE
+C
+      IF (NSEG .GE. 1) GO TO  70
+      IF (N-2) 160,150, 60
+   60 IF (N .GE. 4) GO TO  70
+      DX = XSAVE(2)-XSAVE(1)
+      DY = YSAVE(2)-YSAVE(1)
+      SLOPE = ATAN2(DY,DX)*DEG+90.
+      IF (SLOPE .GE. 360.) SLOPE = SLOPE-360.
+      IF (SLOPE .LE. 0.) SLOPE = SLOPE+360.
+      SLP1 = SLOPE
+      SLPN = SLOPE
+      ISLPSW = 0
+      SIGMA = TENSN
+      GO TO 110
+   70 SIGMA = TENSN
+      IF (IPRD .GE. 1) GO TO  90
+      IF (NSEG .GE. 1) GO TO  80
+C
+C SET UP FLAGS FOR A  1  SEGMENT, PERIODIC LINE
+C
+      ISLPSW = 4
+      XSAVE(N) = XSV1
+      YSAVE(N) = YSV1
+      GO TO 110
+C
+C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE
+C
+   80 SLP1 = SSLPN
+      SLPN = SSLP1
+      ISLPSW = 0
+      GO TO 110
+   90 IF (NSEG .GE. 1) GO TO 100
+C
+C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE
+C
+      ISLPSW = 3
+      GO TO 110
+C
+C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE
+C
+  100 SLP1 = SSLPN
+      ISLPSW = 1
+C
+C CALL THE SMOOTHING ROUTINES
+C
+  110 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+      IF (IPRD.EQ.0 .AND. NSEG.EQ.0 .AND. S.LT.70.) GO TO 170
+      IENTRY = 1
+C
+C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT
+C
+      IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 120
+      NPRIME = FLOAT(NP)-(S*FLOAT(NP))/(2.*32768.)
+      IF (S .GE. 32768.) NPRIME = .5*FLOAT(NP)
+      NPL = FLOAT(NPRIME)*S/32768.
+      IF (NPL .LT. 2) NPL = 2
+  120 DT = 1./FLOAT(NPL)
+      IF (NSEG .LE. 0) CALL FRSTC (IFIX(XSAVE(1)),IFIX(YSAVE(1)),1)
+      T = 0.0
+      NSLPSW = 1
+      IF (NSEG .GE. 1) NSLPSW = 0
+      NSEG = 1
+      CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE SLOPE AT THE FIRST POINT OF THE LINE
+C
+      IF (NSLPSW .GE. 1) SSLP1 = SLP
+      NSLPSW = 0
+      XSOLD = XSAVE(1)
+      YSOLD = YSAVE(1)
+      DO 130 I=1,NPL
+         T = T+DT
+         TT = -T
+         IF (I .EQ. NPL) NSLPSW = 1
+         CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE THE LAST SLOPE OF THIS LINE SEGMENT
+C
+         IF (NSLPSW .GE. 1) SSLPN = SLP
+C
+C DRAW EACH PART OF THE LINE SEGMENT
+C
+         CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2)
+         CALL FRSTC (IFIX(XS),IFIX(YS),2)
+         XSOLD = XS
+         YSOLD = YS
+  130 CONTINUE
+      IF (IPRD .NE. 0) GO TO 140
+C
+C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE
+C
+      CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2)
+      CALL FRSTC (IFIX(XSV1),IFIX(YSV1),2)
+C
+C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT
+C
+  140 XSAVE(1) = XS
+      YSAVE(1) = YS
+      N = 1
+  150 CONTINUE
+  160 RETURN
+  170 N = 0
+      RETURN
+      END
+      SUBROUTINE FRSTC (MX,MY,IENT)
+      SAVE
+C
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD     ,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX       ,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX        ,
+     3                IHB        ,IHS        ,IHV        ,IVOLD      ,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD       ,
+     5                IHF
+      LOGICAL         YCHANG     ,HBFLAG     ,FIRST      ,IHF
+C
+C
+C  DRAW LINE TO THE POINT MX,MY
+C
+C  ENTER THE POINT INTO THE CURRENT SCREEN, ISCR, IF THE POINT CONFORMS
+C  TO THE SHADING ALGORITHM.
+C  THE POINT IS NOT ENTERED WHEN;
+C  1. IT IS THE SAME POINT USED IN THE LAST CALL, RESOLUTION PROBLEM
+C  2. IT IS PART OF A HORIZONTAL LINE BUT NOT AN END POINT
+C  3.  THE ENTIRE CONTOUR RESTS ON A HORIZONTAL PLANE
+C
+C  WHEN DRAWING A HORIZONTAL LINE THREE CONDITIONS EXIST;
+C  1. WHEN THE LINE IS A HORIZONTAL STEP ENTER ONLY THE OUTSIDE POINT.
+C     A HORIZONTAL STEP IS DEFINED BY THE ENTERING AND EXITING Y
+C     DIRECTION THAT IS THE SAME.
+C  2. ENTER BOTH END POINTS OF A HORIZONTAL TURNING POINT. A HORIZONTAL
+C     TURNING POINT IS A LINE WITH GREATER THAN 1 HORIZONTAL BITS
+C     AND THE ENTERING AND EXITING Y DIRECTION IS DIFFIRENT.
+C  3.  WHEN THE ENTIRE CONTOUR IS A HORIZONTAL LINE NO POINTS ARE
+C      ENTERED. THIS CONDITION IS DETECTED BY THE STATUS OF YCHANG.
+C      IF IT IS TRUE THEN THE CONTOUR IS NOT A SINGLE HORIZONTAL LINE.
+C
+C  THE PREVIOUS POINT IS ERASED IF IT IS A VERTICAL TURNING POINT.
+C  A VERTICAL TURNING POINT IS A HORIZONTAL LINE WITH ONLY 1 POINT
+C  AND THE ENTERING AND EXITING Y DIRECTION DIFFERS.THIS DATA IS
+C  IN THE VARIABLES IOSLSN-OLD SLOPE AND ISLSGN-NEW SLOPE.
+C  THE CHANGE IN SLOPE MUST BE -1 TO 1 OR 1 TO -1.
+C
+C  OTHERWISE THE POINT IS ENTERED INTO ISCR.
+C
+C  THE TWO ENTRY POINTS ARE REQUIRED BY THE HARDWARE DRAWING ROUTINES.
+C  FIRSTC IS USED FOR THE FIRST POINT ON THE CONTOUR. THE REMAINING
+C  POINTS ON THE SAME CONTOUR ARE ENTERED VIA VECTC.
+C
+      DATA IONE/1/
+      AVE(A,B) = (A+B)*.5
+C
+C  COMPUTE VISIBILITY OF THIS POINT
+C
+C  WARNING
+C  IF X OR Y PLOTTER MAXIMUM VALUE RANGES FALL BELOW 101 THEN THE
+C  FOLLOWING TWO STATEMENTS WHICH SET IX AND IY MUST BE CHANGED.
+C  REPLACE THE CONSTANT 1.0 BY 0.5 IN THE STATEMENTS WHERE THE
+C  MAXIMUM PLOTTER VALUE IS LESS THAN 101 FOR THAT DIRECTION.  THE
+C  PLOTTER CORDINATE RANGES ARE SET IN SET32.
+C
+      IX = FLOAT(MX-1)*RX+1.0
+      NRLX = IX
+      IY = FLOAT(MY-1)*RY+1.0
+      IBIT = NBPW-MOD(IX,NBPW)
+      IX = IX/NBPW+1
+      IVNOW = IAND(ISHIFT(ISCA(IX,IY),1-IBIT),IONE)
+C
+C  DECIDE IF FRSTC OR VECTC CALL
+C
+      IF (IENT .NE. 1) GO TO  10
+C
+      XOLD = MX
+      YOLD = MY
+C
+C
+C  SET INITIAL VALUES
+C
+      IHF = .FALSE.
+      IYDIR = 0
+      ITPD = 0
+      IVAL = 0
+      IOSLSN = 0
+      IFSX = NRLX
+      IFSY = IY
+      LASTV = IVNOW
+      HBFLAG = .FALSE.
+      YCHANG = .FALSE.
+      CALL PLOTIT (IFIX(XOLD),IFIX(YOLD),0)
+      GO TO 180
+C
+C****************************  ENTRY VECTC  ****************************
+C     ENTRY VECTC (MX,MY)
+C
+   10 XNOW = MX
+      YNOW = MY
+      JUMP = IVNOW*2+LASTV+1
+      GO TO ( 20, 30, 40, 50),JUMP
+C
+C BOTH VISIBLE
+C
+   20 CALL PLOTIT (IFIX(XNOW),IFIX(YNOW),1)
+      GO TO  50
+C
+C JUST TURNED VISIBLE
+C
+   30 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),0)
+      GO TO  50
+C
+C JUST TURNED INVISIBLE
+C
+   40 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),1)
+C
+C BOTH INVISIBLE
+C
+   50 XOLD = XNOW
+      YOLD = YNOW
+      LASTV = IVNOW
+C
+C  TEST FOR RESOLUTION PROBLEM
+C
+      IF (NRLX.EQ.LRLX .AND. IY.EQ.IYOLD) RETURN
+C
+C  TEST FOR HORIZONTAL BITS
+C
+      IF (IYOLD .NE. IY) GO TO  70
+C
+C  HORIZONTAL BITS DETECTED. SET FLAG AND EXIT.
+C  THIS AND THE NEXT HORIZONTAL BIT TEST IS NECESSARY FOR ISCR TO
+C  CONFORM TO THE SHADING ALGORITHM IN SUBROUTINE FILLIN
+C
+C
+C  IF HORIZONTAL LINE PREVIOUSLY DETECTED EXIT
+C
+      IF (.NOT.HBFLAG) GO TO  60
+C
+C  IF END OF CONTOUR ON A HORIZONTAL LINE BRANCH FOR SPECIAL PROCESSING.
+C
+      IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210
+      GO TO 200
+C
+C  SAVE SLOPE PRIOR TO HORIZONTAL LINE
+C
+   60 IHX = IXOLD
+      IHB = IBTOLD
+      IHS = IOSLSN
+      IOSLSN = 0
+      HBFLAG = .TRUE.
+      IHRX = LRLX
+      IHV = IVOLD
+      IF (LRLX.EQ.IFSX .AND. IYOLD.EQ.IFSY) IHF = .TRUE.
+C
+C  THIS IS THE SECOND TRAP FOR END OF CONTOUR ON A HORIZONTAL LINE.
+C
+      IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210
+      GO TO 200
+C
+C  COMPUTE THE SLOPE TO THIS POINT
+C
+   70 IF (IY-IYOLD)  80, 90,100
+   80 ISLSGN = 1
+      GO TO 110
+   90 ISLSGN = 0
+      GO TO 120
+  100 ISLSGN = -1
+  110 IF (IYDIR .EQ. 0) IYDIR = ISLSGN
+  120 CONTINUE
+C
+C  IF PROCESS REACHES THIS CODE THE CONTOUR IS NOT CONTAINED ON A SINGLE
+C  HORIZONTAL  PLANE, SO RECORD THIS FACT BY SETTING Y CHANGE FLAG.
+C
+      YCHANG = .TRUE.
+C
+C  TEST FOR END OF HORIZONTAL LINE
+C
+      IF (.NOT.HBFLAG) GO TO 160
+      HBFLAG = .FALSE.
+C
+C  HORIZONTAL LINE JUST ENDED
+C
+C  TEST FOR REDRAW
+C
+      ITEMP = IAND(ISCR(IXOLD,IYOLD),MASK(IBTOLD))
+      IF ((IHV .EQ. 0) .AND. (ITEMP .EQ. 0)) GO TO 130
+C
+C  REDRAWING ERASE THIS POINT
+C
+      ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD))
+      ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB))
+      GO TO 170
+C
+C  TEST FOR STEP PROBLEM
+C
+  130 IF (IHS .NE. ISLSGN) GO TO 140
+C
+C  STEP PROBLEM
+C
+      GO TO 170
+C
+C  TURNING PROBLEM HORIZONTAL LINE IS A TURNING POINT
+C
+  140 CONTINUE
+C
+C  ENTER THE TURNING POINT ONLY IF IT IS NOT THE SECOND SUCCEEDING
+C  EVENT IN A ROW
+C
+      ICTPD = 1
+      IF (IHRX .GT. NRLX) ICTPD = -1
+      IF (ICTPD .NE. ITPD) GO TO 150
+      ITPD = 0
+C
+C  ERASE THE FIRST POINT
+C
+      ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB))
+      GO TO 170
+C
+C  ENTER THE TURNING POINT
+C
+  150 CONTINUE
+      ITPD = ICTPD
+C
+C  ENTER THE SECOND POINT
+C
+      ISCR(IXOLD,IYOLD) = IOR(ISCR(IXOLD,IYOLD),MASK(IBTOLD))
+      GO TO 170
+C
+C  CHECK IF PREVIOUS ENTRY WAS A VERTICAL TURNING POINT.
+C  IF SO ERASE IT.
+C
+  160 IF (ISLSGN.EQ.IOSLSN .OR. (IOSLSN.EQ.0 .OR. ISLSGN.EQ.0))
+     1    GO TO 170
+      ITPD = 0
+      ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD))
+C
+  170 IOSLSN = ISLSGN
+C
+C  CHECK IF THIS GRID POINT PREVIOUSLY ACTIVATED
+C
+      IVAL = IAND(ISCR(IX,IY),MASK(IBIT))
+C
+C  IF GRID POINTS ACTIVATED BRANCH
+C
+      IF (IVAL .NE. 0) GO TO 190
+C
+C  GRID POINT NOT ACTIVATED   SET AND EXIT
+C
+  180 CONTINUE
+      ISCR(IX,IY) = IOR(ISCR(IX,IY),MASK(IBIT))
+      GO TO 200
+C
+C  THIS POINT IS BEING REDRAWN SO ERASE IT.
+C  (THIS IS TO CONFORM WITH THE SHADING ALGORITHM, FILLIN.
+C  HOWEVER IF BACK TO STARTING POINT DO NOT ERASE
+C
+  190 IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) RETURN
+      ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT))
+C
+C
+  200 IXOLD = IX
+      LRLX = NRLX
+      IYOLD = IY
+      IBTOLD = IBIT
+      IVOLD = IVAL
+      RETURN
+C
+C  PERFORM THIS OPERATION WHEN A CONTOUR STARTS OR ENDS ON A HORIZONTAL
+C  LINE.
+C
+  210 CONTINUE
+C
+C  ERASE THE FIRST POINT OF A CONTOUR WHEN IT IS PART OF A HORIZONTAL
+C  LINE SEGMENT AND IS NOT THE ENDPOINT OF THE SEGMENT
+C
+      IF (.NOT.IHF) GO TO 220
+      ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT))
+  220 CONTINUE
+C
+C  ERASE THE FIRST POINT OF A HORIZONTAL LINE SEGMENT WHEN IT ENDS
+C  THE CONTOUR AND IS NOT THE HIGHEST LINE SEG ON THS SIDE.
+C
+      IF (.NOT.YCHANG) GO TO 230
+      IF (IYDIR .NE. IHS) GO TO 200
+  230 ISCR(IHX,IY) = IAND(ISCR(IHX,IY),NMASK(IHB))
+      GO TO 200
+      END
+      SUBROUTINE FILLIN
+C
+      SAVE
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR7/ IENTRY     ,IONES
+C
+      IF (IENTRY .EQ. 0) RETURN
+C
+C  THIS IS A SHADING ALGORITHM IT IS USED TO DETERMINE CONTOUR LINES
+C  THAT ARE HIDDEN BY THE PRESENT LINE. THE ALGORITHM PROCESSES
+C  HORIZONTAL ROWS. IT ASSUMES THAT THE BIT PATTERN PASSED TO IT
+C  HAS ONLY BITS SET TO MARK THE START AND END OF SHADING. THE
+C  ALGORITHM ALSO ASSUMES THAT WHEN AN ON BIT IS ENCOUNTERED THAT A
+C  CORRESPONDING OFF BIT IS INCLUDED IN THE SAME ROW.
+C
+C
+C  PULL OUT ROWS OF THE CONTOUR PATTERN
+C
+      IBVAL = 0
+      DO  80 IYNOW=1,NY
+         DO  40 IXNOW=1,LX
+C
+C  IF NO ACTIVATED BITS BRANCH
+C
+            ICRWD = ISCR(IXNOW,IYNOW)
+            IF (ICRWD .EQ. 0) GO TO  30
+C
+C  ACTIVATED BITS IN WORD SET SHADING FLAG
+C
+C  CHECK BIT BY BIT FOR ON/OFF FLAGS
+C
+            DO  20 IB=1,NBPW
+               IBIT = (NBPW+1)-IB
+C
+C
+C  PULL OUT THE CURRENT GRID POINT VALUE
+C
+               IVAL = IAND(ICRWD,MASK(IBIT))
+C
+C  IF IVAL SET, THIS IS AN ON/OFF FLAG
+C
+               IF (IVAL .EQ. 0) GO TO  10
+C
+C  FLAG BIT, ALWAYS SET
+C
+               IBVAL = MOD(IBVAL+1,2)
+               GO TO  20
+C
+C  SHADE THE SCREEN ACCORDING TO THE STATUS OF IBVAL
+C
+   10          IF (IBVAL .NE. 0) ICRWD = IOR(ICRWD,MASK(IBIT))
+C
+   20       CONTINUE
+C
+C  ZERO OUT THE SCREEN
+C
+            ISCR(IXNOW,IYNOW) = 0
+            ISCA(IXNOW,IYNOW) = IOR(ICRWD,ISCA(IXNOW,IYNOW))
+            GO TO  40
+C
+   30       IF (IBVAL .NE. 0) ISCA(IXNOW,IYNOW) = IONES
+   40    CONTINUE
+C
+C  FIX FOR NONCORRECTABLE RUNAWAYS
+C
+         IF (IBVAL .EQ. 0) GO TO  80
+         IBVAL = 0
+         DO  70 K=1,LX
+            ITEST = 0
+            IF (IYNOW .EQ. 1) GO TO  50
+            ITEST = ISCA(K,IYNOW-1)
+            IF (IYNOW .EQ. NY) GO TO  60
+   50       ITEST = IOR(ITEST,ISCA(K,IYNOW+1))
+   60       ISCA(K,IYNOW) = ITEST
+   70    CONTINUE
+C
+   80 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRAWI (IXA,IYA,IXB,IYB)
+C
+C INCLUDED FOR USE BY PWRZ
+C
+      SAVE
+      CALL FRSTC (IXA,IYA,1)
+      CALL FRSTC (IXB,IYB,2)
+      RETURN
+      END
+      SUBROUTINE MMASK
+C
+C  MAKE THE MACHINE DEPENDENT MASKS USED IN THE CONTOUR DRAWING
+C  AND SHADING ALGORITHMS
+C
+      SAVE
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD     ,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX       ,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX        ,
+     3                IHB        ,IHS        ,IHV        ,IVOLD      ,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD       ,
+     5                IHF
+      COMMON /ISOSR9/ BIG        ,IXBIT
+      LOGICAL         YCHANG     ,HBFLAG     ,FIRST      ,IHF
+      GENDON = .TRUE.
+      NBPW = 16
+C
+C  GET BIGGEST REAL NUMBER
+C
+      BIG = R1MACH(2)
+C
+C  MASKS TO SELECT A SPECIFIC BIT
+C
+      DO  10 K=1,NBPW
+         MASK(K) = ISHIFT(1,K-1)
+   10 CONTINUE
+C
+C  GENERATE  THE BIT PATTERN 177777 OCTAL
+C
+      ITEMP1 = 0
+      ITEMP = MASK(NBPW)
+      IST = NBPW-1
+      DO  20 K=1,IST
+         ITEMP1 = IOR(ITEMP,ISHIFT(ITEMP1,-1))
+   20 CONTINUE
+      MFIX = IOR(ITEMP1,1)
+C
+C  MASKS TO CLEAR A SPECIFIC BIT
+C
+      DO  30 K=1,NBPW
+         NMASK(K) = IAND(ITEMP1,MFIX)
+         ITEMP1 = IOR(ISHIFT(ITEMP1,1),1)
+   30 CONTINUE
+      IONES = MFIX
+      RETURN
+C
+C REVISION HISTORY---
+C
+C JANUARY 1978     DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C JANUARY 1979     NEW SHADING ALGORITHM
+C MARCH 1979       MADE CODE MACHINE INDEPENDENT AND CONFORM
+C                  TO 66 FORTRAN STANDARD
+C JUNE 1979        THIS VERSION PLACED ON ULIB.
+C SEPTEMBER 1979   FIXED PROBLEM IN EZISOS DEALING WITH
+C                  DETERMINATION OF VISIBILITY OF W PLANE.
+C DECEMBER 1979    FIXED PROBLEM WITH PEN DOWN ON CONTOUR
+C                  INITIALIZATION IN SUBROUTINE FRSTC
+C MARCH            CHANGED ROUTINE NAMES  TRN32I  AND  DRAW  TO
+C                  TRN32I  AND  DRAWI  TO BE CONSISTENT WITH THE
+C                  USAGE OF THE NEW ROUTINE  PWRZI.
+C JUNE  1980       FIXED PROBLEM WITH ZERO INDEX COMPUTATION IN
+C                  SUBROUTINE FRSTC.  ADDED INPUT PARAMETER
+C                  DIMENSION STATEMENT MISSING IN EZISOS.
+C                  FIXED ERROR IN COMPUTATION OF ARCCOSINE
+C                  IN EZISOS AND TRN32I.
+C DECEMBER 1984    CONVERTED TO GKS LEVEL 0A AND STANDARD FORTRAN 77
+C-----------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/kurv.f b/sys/gio/ncarutil/kurv.f
new file mode 100644
index 00000000..1d160b89
--- /dev/null
+++ b/sys/gio/ncarutil/kurv.f
@@ -0,0 +1,451 @@
+      SUBROUTINE KURV1S (N,X,Y,SLOP1,SLOPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C DIMENSION OF           X(N),Y(N),XP(N),YP(N),TEMP(N)
+C ARGUMENTS
+C
+C LATEST REVISION        FEBRUARY 5, 1974
+C
+C PURPOSE                KURV1S DETERMINES THE PARAMETERS NECESSARY TO
+C                        COMPUTE A SPLINE UNDER TENSION PASSING THROUGH
+C                        A SEQUENCE OF PAIRS
+C                        (X(1),Y(1)),...,(X(N),Y(N)) IN THE PLANE.
+C                        THE SLOPES AT THE TWO ENDS OF THE CURVE MAY BE
+C                        SPECIFIED OR OMITTED.  FOR ACTUAL COMPUTATION
+C                        OF POINTS ON THE CURVE IT IS NECESSARY TO CALL
+C                        THE SUBROUTINE KURV2S.
+C
+C USAGE                  CALL KURV1S(N,X,Y,SLP1,SLPN,XP,YP,TEMP,S,SIGMA)
+C
+C ARGUMENTS
+C
+C ON INPUT               N
+C                          IS THE NUMBER OF POINTS TO BE INTERPOLATED
+C                          (N .GE. 2).
+C
+C                        X
+C                          IS AN ARRAY CONTAINING THE N X-COORDINATES
+C                          OF THE POINTS.
+C
+C                        Y
+C                          IS AN ARRAY CONTAINING THE N Y-COORDINATES
+C                          OF THE POINTS.
+C
+C                        SLOP1 AND SLOPN
+C                          CONTAIN THE DESIRED VALUES FOR THE SLOPE OF
+C                          THE CURVE AT (X(1),Y(1)) AND (X(N),Y(N)),
+C                          RESPECTIVELY.  THESE QUANTITIES ARE IN
+C                          DEGREES AND MEASURED COUNTER-CLOCKWISE
+C                          FROM THE POSITIVE X-AXIS.  IF ISLPSW IS NON-
+C                          ZERO, ONE OR BOTH OF SLP1 AND SLPN MAY BE
+C                          DETERMINED INTERNALLY BY KURV1S.
+C
+C                        XP AND YP
+C                          ARE ARRAYS OF LENGTH AT LEAST N.
+C
+C                        TEMP
+C                          IS AN ARRAY OF LENGTH AT LEAST N WHICH IS
+C                          USED FOR SCRATCH STORAGE.
+C
+C                        SIGMA
+C                          CONTAINS THE TENSION FACTOR.  THIS IS
+C                          NON-ZERO AND INDICATES THE CURVINESS DESIRED.
+C                          IF ABS(SIGMA) IS VERY LARGE (E.G., 50.) THE
+C                          RESULTING CURVE IS VERY NEARLY A POLYGONAL
+C                          LINE.  A STANDARD VALUE FOR SIGMA IS ABOUT 2.
+C
+C                        ISLPSW
+C                          IS AN INTEGER INDICATING WHICH END SLOPES
+C                          HAVE BEEN USER PROVIDED AND WHICH MUST BE
+C                          COMPUTED BY KURV1S.  FOR ISLPSW
+C                            = 0  INDICATES BOTH SLOPES ARE PROVIDED,
+C                            = 1  ONLY SLOP1 IS PROVIDED,
+C                            = 2  ONLY SLOPN IS PROVIDED,
+C                            = 3  NEITHER SLOP1 NOR SLOPN IS PROVIDED.
+C                            = 4  NEITHER SLOP1 NOR SLOPN IS PROVIDED,
+C                                 BUT SLOP1=SLOPN.  IN THIS CASE X(1)=
+C                                 X(N), Y(1)=Y(N) AND N.GE.3.
+C ON OUTPUT              XP AND YP
+C                          CONTAIN INFORMATION ABOUT THE CURVATURE OF
+C                          THE CURVE AT THE GIVEN NODES.
+C
+C                        S
+C                          CONTAINS THE POLYGONAL ARCLENGTH OF THE
+C                          CURVE.
+C
+C                        N, X, Y, SLP1, SLPN, SIGMA AND ISLPSW ARE
+C                        UNCHANGED.
+C
+C ENTRY POINTS           KURV1S
+C
+C SPECIAL CONDITIONS     NONE
+C
+C COMMON BLOCKS          NONE
+C
+C I/O                    NONE
+C
+C PRECISION              SINGLE
+C
+C REQUIRED ULIB          NONE
+C ROUTINES
+C
+C SPECIALIST             RUSSELL K. REW, NCAR, BOULDER, COLORADO  80302
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                ORIGINALLY WRITTEN BY A. K. CLINE, MARCH 1972.
+C
+C
+C
+C
+      INTEGER         N
+      REAL            X(N)       ,Y(N)       ,XP(N)      ,YP(N)      ,
+     1                TEMP(N)    ,S          ,SIGMA
+      SAVE
+C
+      DATA PI /3.1415926535897932/
+C
+      NN = N
+      JSLPSW = ISLPSW
+      SLP1 = SLOP1
+      SLPN = SLOPN
+      DEGRAD = PI/180.
+      NM1 = NN-1
+      NP1 = NN+1
+      DELX1 = X(2)-X(1)
+      DELY1 = Y(2)-Y(1)
+      DELS1 = SQRT(DELX1*DELX1+DELY1*DELY1)
+      DX1 = DELX1/DELS1
+      DY1 = DELY1/DELS1
+C
+C DETERMINE SLOPES IF NECESSARY
+C
+      IF (JSLPSW .NE. 0) GO TO 70
+   10 SLPP1 = SLP1*DEGRAD
+      SLPPN = SLPN*DEGRAD
+C
+C SET UP RIGHT HAND SIDES OF TRIDIAGONAL LINEAR SYSTEM FOR XP
+C AND YP
+C
+      XP(1) = DX1-COS(SLPP1)
+      YP(1) = DY1-SIN(SLPP1)
+
+      TEMP(1) = DELS1
+      SS = DELS1
+      IF (NN .EQ. 2) GO TO 30
+      DO 20 I=2,NM1
+         DELX2 = X(I+1)-X(I)
+         DELY2 = Y(I+1)-Y(I)
+         DELS2 = SQRT(DELX2*DELX2+DELY2*DELY2)
+         DX2 = DELX2/DELS2
+         DY2 = DELY2/DELS2
+         XP(I) = DX2-DX1
+         YP(I) = DY2-DY1
+         TEMP(I) = DELS2
+         DELX1 = DELX2
+         DELY1 = DELY2
+         DELS1 = DELS2
+         DX1 = DX2
+         DY1 = DY2
+C
+C ACCUMULATE POLYGONAL ARCLENGTH
+C
+         SS = SS+DELS1
+   20 CONTINUE
+   30 XP(NN) = COS(SLPPN)-DX1
+      YP(NN) = SIN(SLPPN)-DY1
+C
+C DENORMALIZE TENSION FACTOR
+C
+      SIGMAP = ABS(SIGMA)*FLOAT(NN-1)/SS
+C
+C PERFORM FORWARD ELIMINATION ON TRIDIAGONAL SYSTEM
+C
+      S = SS
+      DELS = SIGMAP*TEMP(1)
+      EXPS = EXP(DELS)
+      SINHS = .5*(EXPS-1./EXPS)
+      SINHIN = 1./(TEMP(1)*SINHS)
+      DIAG1 = SINHIN*(DELS*.5*(EXPS+1./EXPS)-SINHS)
+      DIAGIN = 1./DIAG1
+      XP(1) = DIAGIN*XP(1)
+      YP(1) = DIAGIN*YP(1)
+      SPDIAG = SINHIN*(SINHS-DELS)
+      TEMP(1) = DIAGIN*SPDIAG
+      IF (NN .EQ. 2) GO TO 50
+      DO 40 I=2,NM1
+         DELS = SIGMAP*TEMP(I)
+         EXPS = EXP(DELS)
+         SINHS = .5*(EXPS-1./EXPS)
+         SINHIN = 1./(TEMP(I)*SINHS)
+         DIAG2 = SINHIN*(DELS*(.5*(EXPS+1./EXPS))-SINHS)
+         DIAGIN = 1./(DIAG1+DIAG2-SPDIAG*TEMP(I-1))
+         XP(I) = DIAGIN*(XP(I)-SPDIAG*XP(I-1))
+         YP(I) = DIAGIN*(YP(I)-SPDIAG*YP(I-1))
+         SPDIAG = SINHIN*(SINHS-DELS)
+         TEMP(I) = DIAGIN*SPDIAG
+         DIAG1 = DIAG2
+   40 CONTINUE
+   50 DIAGIN = 1./(DIAG1-SPDIAG*TEMP(NM1))
+      XP(NN) = DIAGIN*(XP(NN)-SPDIAG*XP(NM1))
+      YP(NN) = DIAGIN*(YP(NN)-SPDIAG*YP(NM1))
+C
+C PERFORM BACK SUBSTITUTION
+C
+      DO 60 I=2,NN
+         IBAK = NP1-I
+         XP(IBAK) = XP(IBAK)-TEMP(IBAK)*XP(IBAK+1)
+         YP(IBAK) = YP(IBAK)-TEMP(IBAK)*YP(IBAK+1)
+   60 CONTINUE
+      RETURN
+   70 IF (NN .EQ. 2) GO TO 100
+C
+C IF NO SLOPES ARE GIVEN, USE SECOND ORDER INTERPOLATION ON
+C INPUT DATA FOR SLOPES AT ENDPOINTS
+C
+      IF (JSLPSW .EQ. 4) GO TO 90
+      IF (JSLPSW .EQ. 2) GO TO 80
+      DELNM1 = SQRT((X(NN-2)-X(NM1))**2+(Y(NN-2)-Y(NM1))**2)
+      DELN = SQRT((X(NM1)-X(NN))**2+(Y(NM1)-Y(NN))**2)
+      DELNN = DELNM1+DELN
+      C1 = (DELNN+DELN)/DELNN/DELN
+      C2 = -DELNN/DELN/DELNM1
+      C3 = DELN/DELNN/DELNM1
+      SX = C3*X(NN-2)+C2*X(NM1)+C1*X(NN)
+      SY = C3*Y(NN-2)+C2*Y(NM1)+C1*Y(NN)
+C
+      SLPN = ATAN2(SY,SX)/DEGRAD
+   80 IF (JSLPSW .EQ. 1) GO TO 10
+      DELS2 = SQRT((X(3)-X(2))**2+(Y(3)-Y(2))**2)
+      DELS12 = DELS1+DELS2
+      C1 = -(DELS12+DELS1)/DELS12/DELS1
+      C2 = DELS12/DELS1/DELS2
+      C3 = -DELS1/DELS12/DELS2
+      SX = C1*X(1)+C2*X(2)+C3*X(3)
+      SY = C1*Y(1)+C2*Y(2)+C3*Y(3)
+C
+      SLP1 = ATAN2(SY,SX)/DEGRAD
+      GO TO 10
+   90 DELN = SQRT((X(NM1)-X(NN))**2+(Y(NM1)-Y(NN))**2)
+      DELNN = DELS1+DELN
+      C1 = -DELS1/DELN/DELNN
+      C2 = (DELS1-DELN)/DELS1/DELN
+      C3 = DELN/DELNN/DELS1
+      SX = C1*X(NM1)+C2*X(1)+C3*X(2)
+      SY = C1*Y(NM1)+C2*Y(1)+C3*Y(2)
+      IF (SX.EQ.0. .AND. SY.EQ.0.) SX = 1.
+      SLP1 = ATAN2(SY,SX)/DEGRAD
+      SLPN = SLP1
+      GO TO 10
+C
+C IF ONLY TWO POINTS AND NO SLOPES ARE GIVEN, USE STRAIGHT
+C LINE SEGMENT FOR CURVE
+C
+  100 IF (JSLPSW .NE. 3) GO TO 110
+      XP(1) = 0.
+      XP(2) = 0.
+      YP(1) = 0.
+      YP(2) = 0.
+C
+      SLP1 = ATAN2(Y(2)-Y(1),X(2)-X(1))/DEGRAD
+      SLPN = SLP1
+      RETURN
+C
+  110 IF (JSLPSW .EQ. 2)
+     1    SLP1 = ATAN2(Y(2)-Y(1)-SLPN*(X(2)-X(1)),
+     2                                X(2)-X(1)-SLPN*(Y(2)-Y(1)))/DEGRAD
+C
+      IF (JSLPSW .EQ. 1)
+     1    SLPN = ATAN2(Y(2)-Y(1)-SLP1*(X(2)-X(1)),
+     2                                X(2)-X(1)-SLP1*(Y(2)-Y(1)))/DEGRAD
+      GO TO 10
+      END
+      SUBROUTINE KURV2S (T,XS,YS,N,X,Y,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C
+C
+C DIMENSION OF           X(N),Y(N),XP(N),YP(N)
+C ARGUMENTS
+C
+C LATEST REVISION        OCTOBER 22, 1973
+C
+C PURPOSE                KURV2S PERFORMS THE MAPPING OF POINTS IN THE
+C                        INTERVAL (0.,1.) ONTO A CURVE IN THE PLANE.
+C                        THE SUBROUTINE KURV1S SHOULD BE CALLED EARLIER
+C                        TO DETERMINE CERTAIN NECESSARY PARAMETERS.
+C                        THE RESULTING CURVE HAS A PARAMETRIC
+C                        REPRESENTATION BOTH OF WHOSE COMPONENTS ARE
+C                        SPLINES UNDER TENSION AND FUNCTIONS OF THE
+C                        POLYGONAL ARCLENGTH PARAMETER.
+C
+C ACCESS CARDS           *FORTRAN,S=ULIB,N=KURV
+C                        *COSY
+C
+C USAGE                  CALL KURV2S (T,XS,YS,N,X,Y,XP,YP,S,SIGMA)
+C
+C ARGUMENTS
+C
+C ON INPUT               T
+C                          CONTAINS A REAL VALUE OF ABSOLUTE VALUE LESS
+C                          THAN OR EQUAL TO 1. TO BE MAPPED TO A POINT
+C                          ON THE CURVE.  THE SIGN OF T IS IGNORED AND
+C                          THE INTERVAL (0.,1.) IS MAPPED ONTO THE
+C                          ENTIRE CURVE.  IF T IS NEGATIVE, THIS
+C                          INDICATES THAT THE SUBROUTINE HAS BEEN CALLED
+C                          PREVIOUSLY (WITH ALL OTHER INPUT VARIABLES
+C                          UNALTERED) AND THAT THIS VALUE OF T EXCEEDS
+C                          THE PREVIOUS VALUE IN ABSOLUTE VALUE.  WITH
+C                          SUCH INFORMATION THE SUBROUTINE IS ABLE TO
+C                          MAP THE POINT MUCH MORE RAPIDLY.  THUS IF THE
+C                          USER SEEKS TO MAP A SEQUENCE OF POINTS ONTO
+C                          THE SAME CURVE, EFFICIENCY IS GAINED BY
+C                          ORDERING THE VALUES INCREASING IN MAGNITUDE
+C                          AND SETTING THE SIGNS OF ALL BUT THE FIRST
+C                          NEGATIVE.
+C
+C                        N
+C                          CONTAINS THE NUMBER OF POINTS WHICH WERE
+C                          INTERPOLATED TO DETERMINE THE CURVE.
+C
+C                        X AND Y
+C                          ARRAYS CONTAINING THE X- AND Y-COORDINATES
+C                          OF THE INTERPOLATED POINTS.
+C
+C                        XP AND YP
+C                          ARE THE ARRAYS OUTPUT FROM KURV1 CONTAINING
+C                          CURVATURE INFORMATION.
+C
+C                        S
+C                          CONTAINS THE POLYGONAL ARCLENGTH OF THE
+C                          CURVE.
+C
+C                        SIGMA
+C                          CONTAINS THE TENSION FACTOR (ITS SIGN IS
+C                          IGNORED).
+C
+C                        NSLPSW
+C                          IS AN INTEGER SWITCH WHICH TURNS ON OR OFF
+C                          THE CALCULATION OF SLP
+C                          NSLPSW
+C                                 = 0 INDICATES THAT SLP WILL NOT BE
+C                                     CALCULATED
+C                                 = 1 SLP WILL BE CALCULATED
+C
+C                        THE PARAMETERS N, X, Y, XP, YP, S AND SIGMA
+C                        SHOULD BE INPUT UNALTERED FROM THE OUTPUT OF
+C                        KURV1S.
+C
+C ON OUTPUT              XS AND YS
+C                          CONTAIN THE X- AND Y-COORDINATES OF THE IMAGE
+C                          POINT ON THE CURVE.
+C
+C                        SLP
+C                          CONTAINS THE SLOPE OF THE CURVE IN DEGREES AT
+C                          THIS POINT.
+C
+C                        T, N, X, Y, XP, YP, S AND SIGMA ARE UNALTERED.
+C
+C ENTRY POINTS           KURV2S
+C
+C SPECIAL CONDITIONS     NONE
+C
+C COMMON BLOCKS          NONE
+C
+C I/O                    NONE
+C
+C PRECISION              SINGLE
+C
+C REQUIRED ULIB          NONE
+C ROUTINES
+C
+C SPECIALIST             RUSSELL K. REW, NCAR, BOULDER, COLORADO  80302
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                ORIGINALLY WRITTEN BY A. K. CLINE, MARCH 1972.
+C
+C
+C
+C
+      INTEGER         N
+      REAL            T          ,XS         ,YS         ,X(N)       ,
+     1                Y(N)       ,XP(N)      ,YP(N)      ,S          ,
+     2                SIGMA      ,SLP
+      SAVE
+C
+      DATA PI /3.1415926535897932/
+C
+C
+C DENORMALIZE SIGMA
+C
+      SIGMAP = ABS(SIGMA)*FLOAT(N-1)/S
+C
+C STRETCH UNIT INTERVAL INTO ARCLENGTH DISTANCE
+C
+      TN = ABS(T*S)
+C
+C FOR NEGATIVE T START SEARCH WHERE PREVIOUSLY TERMINATED,
+C OTHERWISE START FROM BEGINNING
+C
+      IF (T .LT. 0.) GO TO 10
+      DEGRAD = PI/180.
+      I1 = 2
+      XS = X(1)
+      YS = Y(1)
+      SUM = 0.
+      IF (T .LT. 0.) RETURN
+C
+C DETERMINE INTO WHICH SEGMENT TN IS MAPPED
+C
+   10 DO 30 I=I1,N
+         DELX = X(I)-X(I-1)
+         DELY = Y(I)-Y(I-1)
+         DELS = SQRT(DELX*DELX+DELY*DELY)
+         IF (SUM+DELS-TN) 20,40,40
+   20    SUM = SUM+DELS
+   30 CONTINUE
+C
+C IF ABS(T) IS GREATER THAN 1., RETURN TERMINAL POINT ON
+C CURVE
+C
+      XS = X(N)
+      YS = Y(N)
+      RETURN
+C
+C SET UP AND PERFORM INTERPOLATION
+C
+   40 DEL1 = TN-SUM
+      DEL2 = DELS-DEL1
+      EXPS1 = EXP(SIGMAP*DEL1)
+      SINHD1 = .5*(EXPS1-1./EXPS1)
+      EXPS2 = EXP(SIGMAP*DEL2)
+      SINHD2 = .5*(EXPS2-1./EXPS2)
+      EXPS = EXPS1*EXPS2
+      SINHS = .5*(EXPS-1./EXPS)
+      XS = (XP(I)*SINHD1+XP(I-1)*SINHD2)/SINHS+
+     1     ((X(I)-XP(I))*DEL1+(X(I-1)-XP(I-1))*DEL2)/DELS
+      YS = (YP(I)*SINHD1+YP(I-1)*SINHD2)/SINHS+
+     1     ((Y(I)-YP(I))*DEL1+(Y(I-1)-YP(I-1))*DEL2)/DELS
+      I1 = I
+      IF (NSLPSW .EQ. 0) RETURN
+      COSHD1 = .5*(EXPS1+1./EXPS1)*SIGMAP
+      COSHD2 = .5*(EXPS2+1./EXPS2)*SIGMAP
+      XT = (XP(I)*COSHD1-XP(I-1)*COSHD2)/SINHS+
+     1     ((X(I)-XP(I))-(X(I-1)-XP(I-1)))/DELS
+      YT = (YP(I)*COSHD1-YP(I-1)*COSHD2)/SINHS+
+     1     ((Y(I)-YP(I))-(Y(I-1)-YP(I-1)))/DELS
+      SLP = ATAN2(YT,XT)/DEGRAD
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/mkpkg b/sys/gio/ncarutil/mkpkg
new file mode 100644
index 00000000..20b06e09
--- /dev/null
+++ b/sys/gio/ncarutil/mkpkg
@@ -0,0 +1,51 @@
+# Make the NCAR utilities library libncar.a.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	@sysint
+	@autograph
+	@conlib
+
+	conran.f    # blockdata for the conrec utility
+	conbdn.f    # blockdata for the conran utility
+	#conraq.f   - Conran, conraq and conras form the "conran" family.
+	#conras.f   - Conran is the only one of the 3 included in "libncar.a";
+	#	    - the others contain duplicate entry points and blockdatas
+	#           - and are not included.
+	#
+	conrec.f
+	conbd.f
+	#conrcqck.f - Conrcqck, conrcspr and conrec form the "conrec" family.
+	#conrcspr.f - Conrec is the only one of the 3 included in "libncar.a";
+	#           - the others contain duplicate entry points and blockdatas
+	#           - and are not included.
+	#dashchar.f
+	#dashline.f - Like the "conrec" family above, the "dash" family contains
+	dashsmth.f  #- duplicate entry points and blockdatas.  Only dashsmth is
+		    #- included in "libncar.a".  The others are redundant.
+	dashbd.f    #  blockdata for the dashsmth utility
+	#dashsupr.f
+	#ezmapg.f
+	gridal.f
+	gridt.f     #- blockdata for the gridal utility
+	hafton.f
+	hfinit.f    #- blockdata for the hafton utility
+	isosrf.f 
+	isosrb.f    #- blockdata for the isosrf utility
+ 	kurv.f	    #- support routines for dashsmth and isosrf
+	pwrity.f
+	pwrzi.f
+	pwrzs.f
+	pwrzt.f
+	srface.f
+	srfabd.f    #- blockdata for the srface utility
+	#strmln.f
+	threed.f
+	threbd.f    #- blockdata for the threed utility
+	velvct.f
+	veldat.f    #- blockdata for the velvct utility
+	;
diff --git a/sys/gio/ncarutil/pwrity.f b/sys/gio/ncarutil/pwrity.f
new file mode 100644
index 00000000..5685c9b7
--- /dev/null
+++ b/sys/gio/ncarutil/pwrity.f
@@ -0,0 +1,604 @@
+      SUBROUTINE PWRITY (X,Y,ID,N,ISIZE,ITHETA,ICNT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C LATEST REVISION        JULY 1984
+C
+C PURPOSE                PWRITY IS A CHARACTER PLOTTING ROUTINE.  IT HAS
+C                        SOME FEATURES NOT FOUND IN WTSTR, BUT IS NOT AS
+C                        FANCY AS PWRITX.
+C
+C
+C USAGE                  CALL PWRITY(X,Y,ID,N,ISIZE,ITHETA,ICNT)
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y
+C                          POSITIONING COORDINATES FOR THE CHARACTERS TO
+C                          BE DRAWN.  X AND Y ARE USER WORLD COORDINATES
+C                          AND ARE SCALED ACCORDING TO THE CURRENT
+C                          NORMALIZATION TRANSFORMATION.  ALSO, SEE ICNT.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                         ISIZE
+C                            SIZE OF THE CHARACTER:
+C                            . IF BETWEEN 0 AND 3, ISIZE IS CHOSEN AS
+C                              1., 1.5, 2., OR 3. TIMES AN 8 PLOTTER
+C                              ADDRESS CHARACTER WIDTH.
+C                            . IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                              WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        ITHETA
+C                          ANGLE, IN DEGREES, AT WHICH THE CHARACTERS ARE
+C                          PLOTTED (COUNTER CLOCKWISE FROM THE POSITIVE
+C                          X AXIS.)
+C
+C                        ICNT
+C                          CENTERING OPTION:
+C                            = -1  (X,Y) IS THE CENTER OF THE LEFT EDGE
+C                                  OF THE FIRST CHARACTER.
+C                            =  0  (X,Y) IS THE CENTER OF THE ENTIRE
+C                                  STRING.
+C                            =  1  (X,Y) IS THE CENTER OD THE RIGHT EDGE
+C                                  OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C ENTRY POINTS           PWRY, PWRYSO, PWRYGT, PWRITY, PWRYBD
+C
+C COMMON BLOCKS          PWRCOM
+C
+C REQUIRED LIBRARY       THE SPPS.
+C
+
+C
+C I/O                    PLOTS CHARACTERS.
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE IN DASHCHAR.
+C                        MADE PORTABLE IN JANUARY 1977
+C                        FOR USE ON COMPUTER SYSTEMS WHICH
+C                        SUPPORT PLOTTERS WITH UP TO 15 BITS RESOLUTION.
+C                        CONVERTED TO FORTRAN77 AND GKS IN JULY, 1984.
+C
+C ALGORITHM              DIGITIZATIONS OF THE CHARACTERS ARE STORED
+C                        NTERNALLY AND ADJUSTED ACCORDING TO X, Y,
+C                        ISIZE AND ICNT, THEN PLOTTED.
+C
+C TIMING                 SLOWER THAN WTSTR, FASTER THAN PWRITX.
+C
+C PORTABILITY            FORTRAN
+C
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      COMMON /PWRCOM/ USABLE
+      LOGICAL         USABLE
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+      DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LEN IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRY.
+C LRES IS THE NUMBER OF BITS OF ACCURACY USED FOR INTEGER INPUT TO
+C THE SYSTEM PLOT PACKAGE.
+C
+      DATA NSIZE/46/
+c Variable LEN not used.
+c     DATA LEN/494/
+      DATA LENTRY/.FALSE./
+      DATA LRES/15/
+      DATA DEGRAD/0.017453293/
+      IF (USABLE) GO TO 101
+C
+C  THIS IS A PWRITY CALL
+C
+      CALL Q8QST4 ('GRAPHX','PWRITY','PWRITY','VERSION  1')
+  101 USABLE = .FALSE.
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRITY.
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRY.
+C
+      CALL PWRYSO (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+C TRANSFORM THE INPUT COORDINATES TO INTEGER SPACE.
+C
+  103 CALL FL2INT (X,Y,IX,IY)
+C
+      NN = N
+      IF (NN .LE. 0) GO TO 113
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C GET USER SET RESOLUTION.
+C
+      CALL GETUSV ('XF',LXSAVE)
+      CALL GETUSV ('YF',LYSAVE)
+C
+C PUT RELATIVE SIZE IN Q.
+C
+      Q = ISIZE
+      IF (Q .LE. 3.) GO TO 104
+      Q = Q/FLOAT(ISHIFT(6,LXSAVE-10))
+      GO TO 105
+  104 Q = (1.+.5*(FLOAT(IFIX(Q)+IFIX(Q)/3)))*4./3.
+  105 Q = Q*FLOAT(ISHIFT(1,LRES-10))
+C
+C CALCULATE COMBINED TRANSFORMATION.
+C
+      THETA = FLOAT(ITHETA)*DEGRAD
+      CT = Q*COS(THETA)
+      ST = Q*SIN(THETA)
+C
+C FIND PLOTTER ADDRESS COORDINATES FOR BEGINNING.
+C
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-WHITE*CT+HIGH*.5*ST
+      YC = YC-WHITE*ST-HIGH*.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCENT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (107,106,108),JCENT
+  106 XC = XC-CT*FNNM1*WIDE*.5
+      YC = YC-ST*FNNM1*WIDE*.5
+      GO TO 109
+  107 XC = XC+CT*WHITE
+      YC = YC+ST*WHITE
+      GO TO 109
+  108 XC = XC-CT*WHITE
+      YC = YC-ST*WHITE
+      XC = XC-CT*FNNM1*WIDE
+      YC = YC-ST*FNNM1*WIDE
+C
+C SET PLOTTER TO STARTING POINT.
+C
+  109 CALL PLOTIT (IFIX(XC),IFIX(YC),0)
+C
+C PLOT ALL THE CHARACTERS IN THE INPUT STRING.
+C
+      DO 112 K=1,NN
+         YB = YC
+         XB = XC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+         CALL PWRYGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+         IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C DRAW INDIVIDUAL CHARACTER.
+C
+         L = 0
+  110    ISUB = IPOINT+L
+         NX = KX(ISUB)
+         FNX = NX
+         NY = KY(ISUB)
+         FNY = NY
+         L = L+1
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+         IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+         IP = 0
+         IF (NY-7) 110,112,110
+C
+C DX AND DY
+C
+  111    XC = XB+FNX*CT-FNY*ST
+         YC = YB+FNX*ST+FNY*CT
+C
+C CALL PLOTTING ROUTINE. MODE DETERMINED BY OP-CODE.
+C
+         CALL PLOTIT (IFIX(XC+.5),IFIX(YC+.5),IP)
+         IP = 1
+         GO TO 110
+  112 CONTINUE
+C
+  113 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE PWRYSO (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)   ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+         LDONE = .TRUE.
+         I = ISTART
+  101    ISUB = I+ISTEP
+         IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102    LDONE = .FALSE.
+         JTEMP = JCHAR(I)
+         KTEMP = JCHAR(ISUB)
+         JCHAR(I) = KTEMP
+         JCHAR(ISUB) = JTEMP
+         ITEMP = INDEX(I)
+         INDEX(I) = INDEX(ISUB)
+         INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103    I = I+ISTEP
+         IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+         IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+         ISTEP  = -ISTEP
+         ITEMP  = ISTART
+         ISTART = ISTOP+ISTEP
+         ISTOP  = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRYGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)   ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+      END
+      SUBROUTINE PWRY (X,Y,ID,N,SIZE,THETA,ICNT)
+C
+C PWRY IS AN OLD ENTRY POINT AND HAS BEEN REMOVED - USE PWRITY
+C ENTRY POINT
+C
+C +NOAO - FTN writes and format statements commented out.
+C     WRITE (I1MACH(4),1001)
+C     WRITE (I1MACH(4),1002)
+C     STOP
+C
+C1001 FORMAT ('1'//////////)
+C1002 FORMAT (' ****************************************'/
+C    1        ' *                                      *'/
+C    2        ' *                                      *'/
+C    3        ' *   THE ENTRY POINT PWRY IS NO LONGER  *'/
+C    4        ' *   SUPPORTED.  PLEASE USE THE MORE    *'/
+C    5        ' *   RECENT VERSION  PWRITY.            *'/
+C    6        ' *                                      *'/
+C    7        ' *                                      *'/
+C    8        ' ****************************************')
+C -NOAO
+      END
+C +NOAO - Blockdata rewritten as subroutine
+C     BLOCKDATA PWRYBD
+      subroutine pwrybd
+      COMMON /PWRCOM/ USABLE
+      LOGICAL         USABLE
+C     DATA USABLE/.FALSE./
+      usable = .false.
+C -NOAO
+C REVISION HISTORY------
+C FEBURARY 1979    CREATED NEW ALGORITHM PWRITY TO REPLACE PWRY
+C                  ADDED REVISION HISTORY
+C JUNE 1979        CHANGE ARGUMENT THETA IN PWRITY FROM FLOATING TO
+C                  INTEGER, USING ITHETA AS THE NEW NAME.  ITS
+C                  MEANING IS NOW DEGREES INSTEAD OF RADIANS.
+C JULY 1984        CONVERTED TO FORTRAN 77 AND GKS
+C-----------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzi.f b/sys/gio/ncarutil/pwrzi.f
new file mode 100644
index 00000000..d49b9ff5
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzi.f
@@ -0,0 +1,732 @@
+      SUBROUTINE PWRZI (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZI IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        ISOSRF.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C                        PWRZI WILL NOT WORK WITH ISOSRFHR.
+C
+C
+C USAGE                  CALL PWRZI (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZI AFTER CALLING
+C                          ISOSRF AND BEFORE CALLING FRAME.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          ISOSRF.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.  ID IS OF TYPE
+C                          CHARACTER .
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER:
+C                          .  IF BETWEEN 0 AND 3, ISIZE IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER (THE POTENTIAL VALUES FOR
+C                          ITOP ARE THE SAME AS THOSE FOR LINE AS
+C                          GIVEN ABOVE.)  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZI, INITZI, PWRZOI, PWRZGI
+C
+C COMMON BLOCKS          PWRZ1I,PWRZ2I
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       ISOSRF, THE ERPRT77 PACKAGE, AND THE SPPS
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH ISOSRF.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following variables are used.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZI.
+C
+      DATA NSIZE/46/
+c Variable LNGTH is not used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZI','PWRZI','VERSION  1')
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZI
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZI.
+C
+      CALL PWRZOI (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 32.
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)*(2**(15-LX))/6.
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZI (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZI (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZI (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZI (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE INTZI (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2I/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZI (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZI (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1I/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX      ,
+     +                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX       ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2I/ X          ,Y          ,Z
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZI,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZI - LINE OR ITOP IMPROPER IN PWRZI CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32I (XX,YY,ZZ,XT,YT,DUMMY,2)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+  119 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      RETURN
+  120 CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN ISOSRF
+C
+      CALL DRAWI (IX1,IY1,IX2,IY2)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOI (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  ISOSRF
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzs.f b/sys/gio/ncarutil/pwrzs.f
new file mode 100644
index 00000000..cfda613e
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzs.f
@@ -0,0 +1,772 @@
+      SUBROUTINE PWRZS (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZS IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        SRFACE.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C
+C
+C USAGE                  CALL PWRZS (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZS AFTER CALLING
+C                          SRFACE AND BEFORE CALLING FRAME
+C                            NOTE:  SRFACE WILL HAVE TO BE CHANGED
+C                                   TO SUPPRESS THE FRAME CALL.  SEE IFR
+C                                   IN SRFACE INTERNAL PARAMETERS.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          SRFACE.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER
+C                          .  IF BETWEEN 0 AND 3 THE FACTOR IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3 IT IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER.  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZS, INITZS, PWRZOS, PWRZGS
+C
+C COMMON BLOCKS          PWRZ1S,PWRZ2S
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       SRFACE
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH SRFACE.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      DIMENSION       VWPRT(4)   ,WNDW(4)
+      LOGICAL         LENTRY
+c +NOAO:  common block added for user control of viewport
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+C
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following are used anywere.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZS.
+C
+      DATA NSIZE/46/
+c Variable LNGTH never used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZS','PWRZS','VERSION  1')
+C
+C INQUIRE CURRENT NORMALIZATION TRANS NUMBER
+C
+      CALL GQCNTN (IERR,NTORIG)
+C
+C SAVE NORMALIZATION TRANS 1 AND LOG SCALING FLAG
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+      CALL GETUSV('LS',IOLLS)
+C
+C DEFINE NORMALIZATION TRANS 1 FOR USE WITH DRAWS
+C
+c +NOAO: device viewport now user controlled through common noaovp
+      call set (vpx1, vpx2, vpy1, vpy2, 1., 1024., 1., 1024., 1)
+c     CALL SET(0.0,1.0,0.0,1.0,1.0,1024.0,1.0,1024.0,1)
+c-NOAO
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZS
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZS.
+C
+      CALL PWRZOS (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 2.**(LX-10)
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)/(6.)
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZS (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZS (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZS (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZS (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+C
+C RESTORE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     +         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+      END
+      SUBROUTINE INTZS (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2S/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZS (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZS (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX ,
+     +                ZZMIN ,ZZMAX ,DELCRT,EYEX  ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2S/ X          ,Y          ,Z
+c +NOAO:  common block added to allow user control of device viewport.
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZS,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZS - LINE OR ITOP IMPROPER IN PWRZS CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32S (XX,YY,ZZ,XT,YT,DUMMY,1)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+c +NOAO: Remove the assumption that window coordinates 1-1024 map to the
+c full plotter metacode range 1-32768
+c
+  119 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.)
+      zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.)
+      call plotit (ifix(zzxmc), ifix(zzymc), 0)
+c 119 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),0)
+      RETURN
+c
+  120 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.)
+      zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.)
+      call plotit (ifix(zzxmc), ifix(zzymc), 1)
+c 120 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),1)
+c -NOAO
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN SRFACE
+C
+      CALL DRAWS (IX1,IY1,IX2,IY2,1,0)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOS (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  SRFACE
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzt.f b/sys/gio/ncarutil/pwrzt.f
new file mode 100644
index 00000000..eea2b0d0
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzt.f
@@ -0,0 +1,731 @@
+      SUBROUTINE PWRZT (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZT IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        THREED.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C
+C
+C USAGE                  CALL PWRZT (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZT AFTER CALLING
+C                          THREED AND BEFORE CALLING FRAME.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          THREED.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.  ID IS OF TYPE
+C                          CHARACTER .
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER:
+C                          .  IF BETWEEN 0 AND 3, ISIZE IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER (THE POTENTIAL VALUES FOR
+C                          ITOP ARE THE SAME AS THOSE FOR LINE AS
+C                          GIVEN ABOVE.)  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZT, INITZT, PWRZOT, PWRZGT
+C
+C COMMON BLOCKS          PWRZ1T,PWRZ2T
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       THREED, THE ERPRT77 PACKAGE, AND THE SPPS
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH THREED.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following are used anywhere.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZT.
+C
+      DATA NSIZE/46/
+c Variable LNGTH not used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZT','PWRZT','VERSION  1')
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZT
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZT.
+C
+      CALL PWRZOT (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 2.**(LX-10)
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)/(6.)
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZT (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZT (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZT (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZT (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZT (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZT (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE INTZT (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2T/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZT (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZT (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1T/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX      ,
+     +                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX       ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2T/ X          ,Y          ,Z
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZT,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZT - LINE OR ITOP IMPROPER IN PWRZT CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32T (XX,YY,ZZ,XT,YT,DUMMY,2)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+  119 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),0)
+      RETURN
+  120 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),1)
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN THREED
+C
+      CALL DRAWT (IX1,IY1,IX2,IY2)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOT (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  THREED
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/srfabd.f b/sys/gio/ncarutil/srfabd.f
new file mode 100644
index 00000000..25712c27
--- /dev/null
+++ b/sys/gio/ncarutil/srfabd.f
@@ -0,0 +1,89 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: here is the changed block data
+c     BLOCKDATA SRFABD
+      subroutine srfabd
+c
+      integer first, temp
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /SRFIP1/ IFR        ,ISTP       ,IROTS      ,IDRX,
+     1                IDRY       ,IDRZ       ,IUPPER     ,ISKIRT,
+     2                NCLA       ,THETA      ,HSKIRT     ,CHI,
+     3                CLO        ,CINC       ,ISPVAL
+      COMMON /SRFINT/ ISRFMJ     ,ISRFMN     ,ISRFTX
+c +noao: common block added 4NOV85 to allow user control of viewport.
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c-noao
+C
+c +noao: following flag added to prevent initialization more than once
+        common /frstfg/ first
+	SAVE
+        data temp /1/
+	first = temp
+        if (first .ne. 1) then
+            return
+        endif
+        temp = 0
+c
+C +noao: by default, the full device viewport is used
+      vpx1 = 0.0
+      vpx2 = 1.0
+      vpy1 = 0.0
+      vpy2 = 1.0
+c -noao
+C  INITIALIZATION OF INTERNAL PARAMETERS
+C
+c     DATA ISPVAL/-999/
+      ISPVAL = -999
+
+c     DATA IFR,ISTP,IROTS,IDRX,IDRY,IDRZ,IUPPER,ISKIRT,NCLA/
+c    1       1,   0,    0,       1,       1,   0,         0,     0,       6/
+c +noao: initial value of ifr changed to 0 to suppress frame advance.  This
+c       function should be performed by the calling procedure.
+c -noao
+      IFR    = 0
+      ISTP   = 0
+      IROTS  = 0  
+      IDRX   = 1
+      IDRY   = 1
+      IDRZ   = 0
+      IUPPER = 0
+      ISKIRT = 0
+      NCLA   = 6
+     
+c     DATA THETA,HSKIRT,CHI,CLO,CINC/
+c    1       .02,    0., 0., 0.,  0./
+      THETA  =.02
+      HSKIRT = 0.
+      CHI    = 0.
+      CLO    = 0.
+      CINC   = 0.
+     
+c     DATA NRSWT/0/
+      NRSWT = 0
+
+c     DATA IOFFP,SPVAL/0,0.0/
+      IOFFP = 0
+      SPVAL = 0.0
+
+C LINE COLOR INDEX
+c     DATA ISRFMJ/1/
+      ISRFMJ = 1
+C
+c -noao
+      END
diff --git a/sys/gio/ncarutil/srface.f b/sys/gio/ncarutil/srface.f
new file mode 100644
index 00000000..8a5981db
--- /dev/null
+++ b/sys/gio/ncarutil/srface.f
@@ -0,0 +1,1347 @@
+      SUBROUTINE SRFACE (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C DIMENSION OF           X(NX),Y(NY),Z(MX,NY),M(2,NX,NY),S(6)
+C ARGUMENTS
+C
+C LATEST REVISION        MARCH 1984
+C
+C PURPOSE                SRFACE DRAWS A PERSPECTIVE PICTURE OF A
+C                        FUNCTION OF TWO VARIABLES WITH HIDDEN LINES
+C                        REMOVED.  THE FUNCTION IS APPROXIMATED BY A
+C                        TWO-DIMENSIONAL ARRAY OF HEIGHTS.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C                                 CALL EZSRFC (Z,M,N,ANGH,ANGV,WORK)
+C
+C                          ASSUMPTIONS:
+C                                  .THE ENTIRE ARRAY IS TO BE DRAWN,
+C                                  .THE DATA IS EQUALLY SPACED (IN THE
+C                               X-Y PLANE),
+C                                  .NO STEREO PAIRS,
+C                                  .SCALING     IS CHOSEN INTERNALLY.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET USE
+C                                 CALL SRFACE (X,Y,Z,M,MX,NX,NY,S,
+C                                                STEREO)
+C
+C ARGUMENTS
+C
+C ON INPUT               Z
+C FOR EZSRFC                     THE M BY N ARRAY TO BE DRAWN.
+C
+C                        M
+C                          THE FIRST DIMENSION OF Z.
+C
+C                        N
+C                          THE SECOND DIMENSION OF Z.
+C
+C                        ANGH
+C                          ANGLE IN DEGREES IN THE X-Y PLANE TO THE
+C                          LINE OF SIGHT (COUNTER-CLOCK WISE FROM
+C                          THE PLUS-X AXIS).
+C
+C                        ANGV
+C                          ANGLE IN DEGREES FROM THE X-Y PLANE TO
+C                          THE LINE OF SIGHT (POSITIVE ANGLES ARE
+C                          ABOVE THE MIDDLE Z, NEGATIVE BELOW).
+C
+C                        WORK
+C                          A SCRATCH STORAGE DIMENSIONED AT LEAST
+C                          2*M*N+M+N.
+C
+C ON OUTPUT              Z, M, N, ANGH, ANGV ARE UNCHANGED.  WORK
+C FOR EZSRFC             HAS BEEN WRITTEN IN.
+C
+C
+C ARGUMENTS
+C
+C ON INPUT               X
+C FOR SRFACE                     A LINEAR ARRAY NX LONG CONTAINING THE X
+C                          COORDINATES OF THE POINTS IN THE SURFACE
+C                          APPROXIMATION.  SEE NOTE, BELOW.
+C
+C                        Y
+C                          THE LINEAR ARRAY NY LONG CONTAINING THE
+C                          Y COORDINATES OF THE POINTS IN THE
+C                          SURFACE APPROXIMATION.  SEE NOTE, BELOW.
+C
+C                        Z
+C                          AN ARRAY MX BY NY CONTAINING THE SURFACE
+C                          TO BE DRAWN IN NX BY NY CELLS.
+C                          Z(I,J) = F(X(I),Y(J)).  SEE NOTE, BELOW.
+C
+C                        M
+C                          SCRATCH ARRAY AT LEAST 2*NX*NY WORDS
+C                          LONG.
+C
+C                        MX
+C                          FIRST DIMENSION OF Z.
+C
+C                        NX
+C                          NUMBER OF POINTS IN THE X DIRECTION
+C                          IN Z.  WHEN PLOTTING AN ENTIRE ARRAY,
+C                          MX=NX.  SEE APPENDIX 1 OF THE GRAPHICS
+C                          CHAPTER FOR AN EXPLANATION OF USING THIS
+C                          ARGUMENT LIST TO PROCESS ANY PART OF AN
+C                          ARRAY.
+C
+C                        NY
+C                          NUMBER OF POINTS IN THE Y DIRECTION IN Z.
+C
+C                        S
+C                          S DEFINES THE LINE OF SIGHT.  THE VIEWER'S
+C                          EYE IS AT (S(1), S(2), S(3)) AND THE
+C                          POINT LOOKED AT IS AT (S(4), S(5), S(6)).
+C                          THE EYE SHOULD BE OUTSIDE THE BLOCK WITH
+C                          OPPOSITE CORNERS (X(1), Y(1), ZMIN) AND
+C                          (X(NX), Y(NY), ZMAX) AND THE POINT LOOKED
+C                          AT SHOULD BE INSIDE IT.      FOR     A NICE
+C                          PERSPECTIVE EFFECT, THE DISTANCE BETWEEN
+C                          THE EYE AND THE POINT LOOKED AT SHOULD BE
+C                          5 TO 10 TIMES THE SIZE OF THE BLOCK.  SEE
+C                          NOTE, BELOW.
+C
+C                        STEREO
+C                          FLAG TO INDICATE IF STEREO PAIRS ARE TO
+C                          BE DRAWN.  0.0 MEANS NO STEREO PAIR (ONE
+C                          PICTURE).  NON-ZERO MEANS PUT OUT TWO
+C                          PICTURES.  THE VALUE OF STEREO IS THE
+C                          RELATIVE ANGLE BETWEEN THE EYES.  A VALUE
+C                          OF 1.0 PRODUCES STANDARD SEPARATION.
+C                          NEGATIVE STEREO REVERSES THE LEFT AND
+C                          RIGHT FIGURES.
+C
+C ON OUTPUT              X, Y, Z, MX, NX, NY, S, STEREO ARE
+C FOR SRFACE             UNCHANGED.  M HAS BEEN WRITTEN IN.
+C
+C NOTES                  . THE RANGE OF Z COMPARED WITH THE RANGE
+C                          OF X AND Y DETERMINES THE SHAPE OF THE
+C                          PICTURE.  THEY ARE ASSUMED TO BE IN THE
+C                          SAME UNITS AND NOT WILDLY DIFFERENT IN
+C                          MAGNITUDE.  S IS ASSUMED TO BE IN THE
+C                          SAME UNITS AS X, Y, AND Z.
+C                        . PICTURE SIZE CAN BE MADE RELATIVE TO
+C                          DISTANCE.  SEE COMMENTS IN SETR.
+C                        . TRN32S CAN BE USED TO TRANSLATE FROM 3
+C                          SPACE TO 2 SPACE.  SEE COMMENTS THERE.
+C                        . DATA WITH EXTREME DISCONTINUITIES MAY
+C                          CAUSE VISIBILITY ERRORS.  IF THIS PROBLEM
+C                          OCCURS, USE A DISTANT EYE POSITION
+C                          AWAY FROM THE +Z AXIS.
+C                        . THE DEFAULT LINE COLOR IS SET TO
+C                          COLOR INDEX 1.  IF THE USER WISHES TO
+C                          CHANGE THE LINE COLOR, HE CAN DO SO BY
+C                          DEFINING COLOR INDEX 1 BEFORE CALLING
+C                          SRFACE, OR BY PUTTING THE COMMON BLOCK
+C                          SRFINT IN HIS CALLING PROGRAM AND
+C                          DEFINING AND USING COLOR INDEX ISRFMJ
+C                          (DEFAULTED TO 1 IN BLOCKDATA.)
+C
+C ENTRY POINTS           SRFACE, SRFGK, EZSRFC, SETR, DRAWS, TRN32S,
+C                        CLSET, CTCELL, SRFABD
+C
+C COMMON BLOCKS          PWRZ1S, SRFBLK, SRFINT, SRFIP1
+C
+C I/O                    PLOTS
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                CONVERTED TO FORTRAN 77 AND GKS IN MARCH 1984.
+C
+C                        PREPARED FOR SIGGRAPH, AUGUST 1976.
+C
+C                        STANDARDIZED IN JANUARY 1973.
+C
+C                        WRITTEN IN DECEMBER 1971.      REPLACED K.S.+G.
+C                        ALGORITHM CALLED SOLIDS AT NCAR.
+C
+C
+C ALGORITHM              HIGHEST SO FAR IS VISIBLE FROM ABOVE.  (SEE
+C                        REFERENCE.)
+C
+C REFERENCE              WRIGHT, T.J., A TWO SPACE SOLUTION TO THE
+C                        HIDDEN LINE PROBLEM FOR PLOTTING A FUNCTION
+C                        OF TWO VARIABLES.      IEEE TRANS.     COMP.,
+C                        PP 28-33, JANUARY 1973.
+C
+C ACCURACY               IF THE ENDS OF A LINE SEGMENT ARE VISIBLE,
+C                        THE MIDDLE IS ASSUMED VISIBLE.
+C
+C TIMING                 PROPORTIONAL TO NX*NY.
+C
+C
+C INTERNAL PARAMETERS    NAME   DEFAULT  FUNCTION
+C                        ----   -------  --------
+C                        IFR        1    -1  CALL FRAME FIRST.
+C                                         0  DO NOT CALL FRAME.
+C                                        +1  CALL FRAME WHEN DONE.
+c +NOAO:  The value of ifr has been changed from its default of +1 to 0.
+c -NOAO
+C
+C                        ISTP       0    STEREO TYPE IF STEREO
+C                                        NON-ZERO.
+C                                        -1  ALTERNATING FRAMES,
+C                                                  SLIGHTLY OFFSET (FOR
+C                                                  MOVIES.  IROTS = 0).
+C                                               0  BLANK FRAME BETWEEN
+C                                                  FOR STEREO   SLIDE.
+C                                                  IROTS = 1).
+C                                        +1  BOTH ON SAME FRAME.
+C                                                  (LEFT PICTURE TO LEFT
+C                                                  SIDE.  IROTS = 0).
+C
+C                        IROTS      0     0  +Z IN VERTICAL PLOTTING
+C                                                  DIRECTION (CINE MODE).
+C                                        +1  +Z IN HORIZONTAL
+C                                                  PLOTTING DIRECTION
+C                                                  (COMIC MODE).
+C
+C                        IDRX       1    +1  DRAW LINES OF CONSTANT
+C                                                  X.
+C                                               0  DO   NOT.
+C
+C                        IDRY       1    +1  DRAW LINES OF CONSTANT
+C                                                  Y.
+C                                               0  DO   NOT.
+C
+C                        IDRZ       0    +1  DRAW LINES OF CONSTANT
+C                                                  Z (CONTOUR   LINES).
+C                                               0  DO   NOT.
+C
+C                        IUPPER         0        +1  DRAW UPPER SIDE OF
+C                                                  SURFACE.
+C                                        0  DRAW BOTH SIDES.
+C                                        -1  DRAW LOWER SIDE.
+C
+C                        ISKIRT         0        +1  DRAW A SKIRT AROUND THE
+C                                                  SURFACE.
+C                                                  BOTTOM = HSKIRT.
+C                                               0  DO   NOT.
+C
+C                        NCLA       6    APPROXIMATE NUMBER OF
+C                                        LEVELS OF CONSTANT Z THAT
+C                                        ARE DRAWN IF LEVELS ARE NOT
+C                                        SPECIFIED.  40 LEVELS
+C                                        MAXIMUM.
+C
+C                        THETA    .02    ANGLE IN RADIANS BETWEEN
+C                                        EYES FOR STEREO PAIRS.
+C
+C                        HSKIRT    0.    HEIGHT OF SKIRT
+C                                                  (IF ISKIRT   = 1).
+C
+C                        CHI       0.    HIGHEST LEVEL OF CONSTANT
+C                                        Z.
+C
+C                        CLO       0.    LOWEST LEVEL OF CONSTANT Z.
+C
+C                        CINC      0.    INCREMENT BETWEEN LEVELS.
+C
+C                          [IF CHI, CLO, OR CINC IS ZERO, A NICE
+C                               VALUE IS GENERATED AUTOMATICALLY.]
+C
+C                        IOFFP     0     FLAG TO CONTROL USE OF SPECIAL
+C                                        VALUE FEATURE.  DO NOT HAVE
+C                                        BOTH IOFFP=1 AND ISKIRT=1.
+C                                               0 FEATURE NOT   IN USE
+C                                        +1  FEATURE IN USE.  NO LINES
+C                                                  DRAWN TO DATA POINTS IN Z
+C                                                  THAT ARE EQUAL TO SPVAL.
+C
+C                        SPVAL     0.    SPECIAL VALUE USED TO MARK UN-
+C                                        KNOWN DATA WHEN IOFFP=1.
+C
+C
+C
+      DIMENSION       X(NX)      ,Y(NY)    ,Z(MX,NY), M(2,NX,NY),
+     1                S(6)
+      DIMENSION       WIN1(4)    ,VP1(4)           ,LASF(13)
+      COMMON /SRFINT/ ISRFMJ     ,ISRFMN          ,ISRFTX
+c +NOAO: common block added 4NOV85 to allow user control of viewport
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+c +NOAO: Blockdata srfabd rewritten as run time initialization
+c     EXTERNAL        SRFABD
+      call srfabd
+c -NOAO
+      CALL Q8QST4 ('GRAPHX','SRFACE','SRFACE','VERSION 01')
+C
+C     THIS DRIVER SAVES THE CURRENT NORMALIZATION TRANSFORMATION
+C     INFORMATION, DEFINES THE NORMALIZATION TRANSFORMATION
+C     APPROPRIATE FOR SRFGK, CALLS SRFGK, AND RESTORES THE ORIGINAL
+C     NORMALIZATION TRANSFORMATION.
+C
+C     GET CURRENT NORMALIZATION TRANSFORMATION NUMBER
+C
+      CALL GQCNTN (IER,NTORIG)
+C
+C     STORE WINDOW AND VIEWPORT OF NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT (NTORIG,IER,WIN1,VP1)
+      CALL GETUSV('LS',IOLLS)
+C
+C     SET WINDOW AND VIEWPORT FOR SRFGK
+C
+c     CALL SET(0.,1.,0.,1.,1.,1024.,1.,1024.,1)
+c +NOAO: viewport limits now stored in common block noaovp
+      CALL SET(vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1)
+c -NOAO
+C
+C     SET LINE COLOR TO INDIVIDUAL (SAVE CURRENT SETTING)
+C
+      CALL GQASF (IER,LASF)
+      LASFSV  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF(LASF)
+C
+C     SET LINE COLOR INDEX TO COMMON VARIABLE ISRFMJ (SAVE
+C     CURRENT SETTING)
+C
+      CALL GQPLCI (IER,LCISV)
+      CALL GSPLCI (ISRFMJ)
+C
+C     DRAW PLOT
+C
+      CALL SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C
+C     RESTORE INITIAL LINE COLOR SETTINGS
+C
+      LASF(3) = LASFSV
+      CALL GSASF(LASF)
+      CALL GSPLCI (LCISV)
+C
+C     RESTORE ORIGINAL NORMALIZATION TRANSFORMATION
+C
+      CALL SET(VP1(1),VP1(2),VP1(3),VP1(4),WIN1(1),WIN1(2),
+     -         WIN1(3),WIN1(4),IOLLS)
+      CALL GSELNT (NTORIG)
+C
+      RETURN
+      END
+      SUBROUTINE SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C
+      DIMENSION       X(NX)      ,Y(NY)   ,Z(MX,NY)  ,M(2,NX,NY) ,
+     1                S(6)
+      DIMENSION       MXS(2)     ,MXF(2) ,MXJ(2) ,MYS(2),
+     1                MYF(2)     ,MYJ(2)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX,
+     2                EYEY       ,EYEZ
+      COMMON /SRFIP1/ IFR        ,ISTP       ,IROTS      ,IDRX ,
+     1                IDRY       ,IDRZ       ,IUPPER     ,ISKIRT,
+     2                NCLA       ,THETA      ,HSKIRT     ,CHI,
+     3                CLO        ,CINC       ,ISPVAL
+c +NOAO:
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+C
+      DATA JF, IF, LY, LX, ICNST /1, 1, 2, 2, 0/
+      CALL Q8QST4 ('GRAPHX','SRFACE','SRFGK','VERSION 01')
+      BIGEST = R1MACH(2)
+      MMXX = MX
+      NNXX = NX
+      NNYY = NY
+      STER = STEREO
+      NXP1 = NNXX+1
+      NYP1 = NNYY+1
+      NLA = NCLA
+      NSPVAL = ISPVAL
+      NDRZ = IDRZ
+      IF (IDRZ .NE. 0)
+     1    CALL CLSET (Z,MMXX,NNXX,NNYY,CHI,CLO,CINC,NLA,40,CL,NCL,
+     2                ICNST,IOFFP,SPVAL,BIGEST)
+      IF (IDRZ .NE. 0) NDRZ = 1-ICNST
+      STHETA = SIN(STER*THETA)
+      CTHETA = COS(STER*THETA)
+      RX = S(1)-S(4)
+      RY = S(2)-S(5)
+      RZ = S(3)-S(6)
+      D1 = SQRT(RX*RX+RY*RY+RZ*RZ)
+      D2 = SQRT(RX*RX+RY*RY)
+      DX = 0.
+      DY = 0.
+      IF (STEREO .EQ. 0.) GO TO  20
+      D1 = D1*STEREO*THETA
+      IF (D2 .GT. 0.) GO TO  10
+      DX = D1
+      GO TO  20
+   10 AGL = ATAN2(RX,-RY)
+      DX = D1*COS(AGL)
+      DY = D1*SIN(AGL)
+   20 IROT = IROTS
+      NPIC = 1
+      IF (STER .NE. 0.) NPIC = 2
+      FACT = 1.
+      IF (NRSWT .NE. 0) FACT = RZERO/D1
+      IF (ISTP.EQ.0 .AND. STER.NE.0.) IROT = 1
+      DO 570 IPIC=1,NPIC
+         NUPPER = IUPPER
+         IF (IFR .LT. 0) CALL FRAME
+C
+C SET UP MAPING FROM FLOATING POINT 3-SPACE TO CRT SPACE.
+C
+         SIGN1 = IPIC*2-3
+         EYEX = S(1)+SIGN1*DX
+         POIX = S(4)+SIGN1*DX
+         EYEY = S(2)+SIGN1*DY
+         POIY = S(5)+SIGN1*DY
+         EYEZ = S(3)
+         POIZ = S(6)
+         LL = 0
+         XEYE = EYEX
+         YEYE = EYEY
+         ZEYE = EYEZ
+         CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0)
+         LL = IPIC+2*ISTP+3
+         IF (STER .EQ. 0.) LL = 1
+         IF (NRSWT .NE. 0) GO TO 100
+         XXMIN = X(1)
+         XXMAX = X(NNXX)
+         YYMIN = Y(1)
+         YYMAX = Y(NNYY)
+         UMIN = BIGEST
+         VMIN = BIGEST
+         ZZMIN = BIGEST
+         UMAX = -UMIN
+         VMAX = -VMIN
+         ZZMAX = -ZZMIN
+         DO  40 J=1,NNYY
+            DO  30 I=1,NNXX
+                ZZ = Z(I,J)
+                IF (IOFFP.EQ.1 .AND. ZZ.EQ.SPVAL) GO TO 30
+                ZZMAX = AMAX1(ZZMAX,ZZ)
+                ZZMIN = AMIN1(ZZMIN,ZZ)
+                CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1)
+                UMAX = AMAX1(UMAX,UT)
+                UMIN = AMIN1(UMIN,UT)
+                VMAX = AMAX1(VMAX,VT)
+                VMIN = AMIN1(VMIN,VT)
+   30             CONTINUE
+   40    CONTINUE
+         IF (ISKIRT .NE. 1) GO TO  70
+         NXSTP = NNXX-1
+         NYSTP = NNYY-1
+         DO  60 J=1,NNYY,NYSTP
+            DO  50 I=1,NNXX,NXSTP
+                CALL TRN32S (X(I),Y(J),HSKIRT,UT,VT,DUMMY,1)
+                UMAX = AMAX1(UMAX,UT)
+                UMIN = AMIN1(UMIN,UT)
+                VMAX = AMAX1(VMAX,VT)
+                VMIN = AMIN1(VMIN,VT)
+   50             CONTINUE
+   60    CONTINUE
+   70    CONTINUE
+         WIDTH = UMAX-UMIN
+         HIGHT = VMAX-VMIN
+         DIF = .5*(WIDTH-HIGHT)
+         IF (DIF)  80,100, 90
+   80    UMIN = UMIN+DIF
+         UMAX = UMAX-DIF
+         GO TO 100
+   90    VMIN = VMIN-DIF
+         VMAX = VMAX+DIF
+  100    XEYE = EYEX
+         YEYE = EYEY
+         ZEYE = EYEZ
+         CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0)
+         DO 120 J=1,NNYY
+            DO 110 I=1,NNXX
+                CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1)
+                M(1,I,J)        = UT
+                M(2,I,J)        = VT
+  110             CONTINUE
+  120    CONTINUE
+C
+C INITIALIZE UPPER AND LOWER VISIBILITY ARRAYS
+C
+         DO 130 K=1,1024
+            LIMU(K) = 0
+            LIML(K) = 1024
+  130    CONTINUE
+C
+C FIND ORDER TO DRAW LINES
+C
+         NXPASS = 1
+         IF (S(1) .GE. X(NNXX)) GO TO 160
+         IF (S(1) .LE. X(1)) GO TO 170
+         DO 140 I=2,NNXX
+            LX = I
+            IF (S(1) .LE. X(I)) GO TO 150
+  140    CONTINUE
+  150    MXS(1) = LX-1
+         MXJ(1) = -1
+         MXF(1) = 1
+         MXS(2) = LX
+         MXJ(2) = 1
+         MXF(2) = NNXX
+         NXPASS = 2
+         GO TO 180
+  160    MXS(1) = NNXX
+         MXJ(1) = -1
+         MXF(1) = 1
+         GO TO 180
+  170    MXS(1) = 1
+         MXJ(1) = 1
+         MXF(1) = NNXX
+  180    NYPASS = 1
+         IF (S(2) .GE. Y(NNYY)) GO TO 210
+         IF (S(2) .LE. Y(1)) GO TO 220
+         DO 190 J=2,NNYY
+            LY = J
+            IF (S(2) .LE. Y(J)) GO TO 200
+  190    CONTINUE
+  200    MYS(1) = LY-1
+         MYJ(1) = -1
+         MYF(1) = 1
+         MYS(2) = LY
+         MYJ(2) = 1
+         MYF(2) = NNYY
+         NYPASS = 2
+         GO TO 230
+  210    MYS(1) = NNYY
+         MYJ(1) = -1
+         MYF(1) = 1
+         GO TO 230
+  220    MYS(1) = 1
+         MYJ(1) = 1
+         MYF(1) = NNYY
+C
+C PUT ON SKIRT ON FRONT SIDE IF WANTED
+C
+  230    IF (NXPASS.EQ.2 .AND. NYPASS.EQ.2) GO TO 490
+         IF (ISKIRT .EQ. 0) GO TO 290
+         IN = MXS(1)
+         IF = MXF(1)
+         JN = MYS(1)
+         JF = MYF(1)
+         IF (NYPASS .NE. 1) GO TO 260
+         CALL TRN32S (X(1),Y(JN),HSKIRT,UX1,VX1,DUMMY,1)
+         CALL TRN32S (X(NNXX),Y(JN),HSKIRT,UX2,VX2,DUMMY,1)
+         QU = (UX2-UX1)/(X(NNXX)-X(1))
+         QV = (VX2-VX1)/(X(NNXX)-X(1))
+         YNOW = Y(JN)
+         DO 240 I=1,NNXX
+            CALL TRN32S (X(I),YNOW,HSKIRT,RU,RV,DUMMY,1)
+            CALL DRAWS (IFIX(RU),IFIX(RV),M(1,I,JN),M(2,I,JN),1,0)
+  240    CONTINUE
+         CALL DRAWS (IFIX(UX1),IFIX(VX1),IFIX(UX2),IFIX(VX2),1,1)
+         IF (IDRY .NE. 0) GO TO 260
+         DO 250 I=2,NNXX
+            CALL DRAWS (M(1,I-1,JN),M(2,I-1,JN),M(1,I,JN),M(2,I,JN),1,1)
+  250    CONTINUE
+  260    IF (NXPASS .NE. 1) GO TO 290
+         CALL TRN32S (X(IN),Y(1),HSKIRT,UY1,VY1,DUMMY,1)
+         CALL TRN32S (X(IN),Y(NNYY),HSKIRT,UY2,VY2,DUMMY,1)
+         QU = (UY2-UY1)/(Y(NNYY)-Y(1))
+         QV = (VY2-VY1)/(Y(NNYY)-Y(1))
+         XNOW = X(IN)
+         DO 270 J=1,NNYY
+            CALL TRN32S (XNOW,Y(J),HSKIRT,RU,RV,DUMMY,1)
+            CALL DRAWS (IFIX(RU),IFIX(RV),M(1,IN,J),M(2,IN,J),1,0)
+  270    CONTINUE
+         CALL DRAWS (IFIX(UY1),IFIX(VY1),IFIX(UY2),IFIX(VY2),1,1)
+         IF (IDRX .NE. 0) GO TO 290
+         DO 280 J=2,NNYY
+            CALL DRAWS (M(1,IN,J-1),M(2,IN,J-1),M(1,IN,J),M(2,IN,J),1,1)
+  280    CONTINUE
+C
+C PICK PROPER ALGORITHM
+C
+  290    LI = MXJ(1)
+         MI = MXS(1)-LI
+         NI = IABS(MI-MXF(1))
+         LJ = MYJ(1)
+         MJ = MYS(1)-LJ
+         NJ = IABS(MJ-MYF(1))
+C
+C WHEN LINE OF SIGHT IS NEARER TO PARALLEL TO THE X AXIS,
+C HAVE J LOOP OUTER-MOST, OTHERWISE HAVE I LOOP OUTER-MOST.
+C
+         IF (ABS(RX) .LE. ABS(RY)) GO TO 360
+         IF (ISKIRT.NE.0 .OR. NYPASS.NE.1) GO TO 310
+         I = MXS(1)
+         DO 300 J=2,NNYY
+            CALL DRAWS (M(1,I,J-1),M(2,I,J-1),M(1,I,J),M(2,I,J),0,1)
+  300    CONTINUE
+  310    DO 350 II=1,NNXX
+            I = MI+II*LI
+            IPLI = I+LI
+            IF (NYPASS .EQ. 1) GO TO 320
+            K = MYS(1)
+            L = MYS(2)
+            IF (IDRX .NE. 0)
+     1          CALL DRAWS (M(1,I,K),M(2,I,K),M(1,I,L),M(2,I,L),1,1)
+            IF (NDRZ.NE.0 .AND. II.NE.NI)
+     1          CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),K)
+  320             DO 340 JPASS=1,NYPASS
+                LJ = MYJ(JPASS)
+                MJ = MYS(JPASS)-LJ
+                NJ = IABS(MJ-MYF(JPASS))
+                DO 330 JJ=1,NJ
+                  J = MJ+JJ*LJ
+                  JPLJ = J+LJ
+                  IF (IDRX.NE.0 .AND. JJ.NE.NJ)
+     1                CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,JPLJ),
+     2                            M(2,I,JPLJ),1,1)
+                  IF (I.NE.MXF(1) .AND. IDRY.NE.0)
+     1                CALL DRAWS (M(1,IPLI,J),M(2,IPLI,J),M(1,I,J),
+     2                            M(2,I,J),1,1)
+                  IF (NDRZ.NE.0 .AND. JJ.NE.NJ .AND. II.NE.NNXX)
+     1                CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),
+     2                             MIN0(J,J+LJ))
+  330                CONTINUE
+  340             CONTINUE
+  350    CONTINUE
+         GO TO 430
+  360    IF (ISKIRT.NE.0 .OR. NXPASS.NE.1) GO TO 380
+         J = MYS(1)
+         DO 370 I=2,NNXX
+            CALL DRAWS (M(1,I-1,J),M(2,I-1,J),M(1,I,J),M(2,I,J),0,1)
+  370    CONTINUE
+  380    DO 420 JJ=1,NNYY
+            J = MJ+JJ*LJ
+            JPLJ = J+LJ
+            IF (NXPASS .EQ. 1) GO TO 390
+            K = MXS(1)
+            L = MXS(2)
+            IF (IDRY .NE. 0)
+     1          CALL DRAWS (M(1,K,J),M(2,K,J),M(1,L,J),M(2,L,J),1,1)
+            IF (NDRZ.NE.0 .AND. JJ.NE.NJ)
+     1          CALL CTCELL (Z,MMXX,NNXX,NNYY,M,K,MIN0(J,J+LJ))
+  390             DO 410 IPASS=1,NXPASS
+                LI = MXJ(IPASS)
+                MI = MXS(IPASS)-LI
+                NI = IABS(MI-MXF(IPASS))
+                DO 400 II=1,NI
+                  I = MI+II*LI
+                  IPLI = I+LI
+                  IF (IDRY.NE.0 .AND. II.NE.NI)
+     1                CALL DRAWS (M(1,I,J),M(2,I,J),M(1,IPLI,J),
+     2                            M(2,IPLI,J),1,1)
+                  IF (J.NE.MYF(1) .AND. IDRX.NE.0)
+     1                CALL DRAWS (M(1,I,JPLJ),M(2,I,JPLJ),M(1,I,J),
+     2                            M(2,I,J),1,1)
+                  IF (NDRZ.NE.0 .AND. II.NE.NI .AND. JJ.NE.NNYY)
+     1                CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),
+     2                             MIN0(J,J+LJ))
+  400                CONTINUE
+  410             CONTINUE
+  420    CONTINUE
+  430    IF (ISKIRT .EQ. 0) GO TO 520
+C
+C FIX UP IF SKIRT IS USED WITH LINES ONE WAY.
+C
+         IF (IDRX .NE. 0) GO TO 460
+         DO 450 IPASS=1,NXPASS
+            IF (NXPASS .EQ. 2) IF = 1+(IPASS-1)*(NNXX-1)
+            DO 440 J=2,NNYY
+                CALL DRAWS (M(1,IF,J-1),M(2,IF,J-1),M(1,IF,J),M(2,IF,J),
+     1                     1,0)
+  440             CONTINUE
+  450    CONTINUE
+  460    IF (IDRY .NE. 0) GO TO 520
+         DO 480 JPASS=1,NYPASS
+            IF (NYPASS .EQ. 2) JF = 1+(JPASS-1)*(NNYY-1)
+            DO 470 I=2,NNXX
+                CALL DRAWS (M(1,I-1,JF),M(2,I-1,JF),M(1,I,JF),M(2,I,JF),
+     1                     1,0)
+  470             CONTINUE
+  480    CONTINUE
+         GO TO 520
+C
+C ALL VISIBLE IF VIEWED FROM DIRECTLY ABOVE OR BELOW.
+C
+  490    IF (NUPPER.GT.0 .AND. S(3).LT.S(6)) GO TO 520
+         IF (NUPPER.LT.0 .AND. S(3).GT.S(6)) GO TO 520
+         NUPPER = 1
+         IF (S(3) .LT. S(6)) NUPPER = -1
+         DO 510 I=1,NNXX
+            DO 500 J=1,NNYY
+                IF (IDRX.NE.0 .AND. J.NE.NNYY)
+     1             CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,J+1),M(2,I,J+1),
+     2                          1,0)
+                IF (IDRY.NE.0 .AND. I.NE.NNXX)
+     1             CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I+1,J),M(2,I+1,J),
+     2                          1,0)
+                IF (IDRZ.NE.0 .AND. I.NE.NNXX .AND. J.NE.NNYY)
+     1             CALL CTCELL (Z,MMXX,NNXX,NNYY,M,I,J)
+  500             CONTINUE
+  510    CONTINUE
+  520    IF (STER .EQ. 0.) GO TO 560
+         IF (ISTP) 540,530,550
+  530    CALL FRAME
+  540    CALL FRAME
+         GO TO 570
+  550    IF (IPIC .NE. 2) GO TO 570
+  560    IF (IFR .GT. 0) CALL FRAME
+  570 CONTINUE
+      RETURN
+      END
+      SUBROUTINE EZSRFC (Z,M,N,ANGH,ANGV,WORK)
+      DIMENSION       Z(M,N)     ,WORK(1)
+C
+C                         WORK(2*M*N+M+N)
+C
+C PERSPECTIVE PICTURE OF A SURFACE STORED IN A TWO DIMENSIONAL ARRAY
+C VIA A VERY SHORT ARGUMENT LIST.
+C
+C ASSUMPTIONS--
+C     THE ENTIRE ARRAY IS TO BE DRAWN,
+C     THE DATA IS EQUALLY SPACED (IN THE X-Y PLANE),
+C     NO STEREO PAIRS.
+C IF THESE ASSUMPTIONS ARE NOT MET USE SRFACE.
+C
+C ARGUMENTS--
+C     Z    THE 2 DIMENSIONAL ARRAY TO BE DRAWN.
+C     M    THE FIRST DIMENSION OF Z.
+C     N    THE SECOND DIMENSION OF Z.
+C     ANGH ANGLE IN DEGREES IN THE X-Y PLANE TO THE LINE OF SIGHT
+C          (COUNTER-CLOCK WISE FROM THE PLUS-X AXIS).
+C     ANGV ANGLE IN DEGREES FROM THE X-Y PLANE TO THE LINE OF SIGHT
+C          (POSITIVE ANGLES ARE ABOVE THE MIDDLE Z, NEGATIVE BELOW).
+C     WORK A SCRATCH STORAGE DIMENSIONED AT LEAST 2*M*N+M+N.
+C
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                NOFFP      ,NSPVAL     ,SPV        ,BIGEST
+      DIMENSION       S(6)
+      DATA S(4),S(5),S(6)/0.0,0.0,0.0/
+C
+C  FACT1 IS THE PERSPECTIVE RATIO AND IS DEFINED TO BE THE RATIO
+C         MAXIMUM(LENGTH,WIDTH)/HEIGHT
+C
+C  FACT2 IS THE RATIO   (LENGTH OF LINE OF SIGHT)/MAXIMUM(LENGTH,WIDTH)
+C
+      DATA FACT1,FACT2/2.0,5.0/
+      BIGEST = R1MACH(2)
+C
+C FIND RANGE OF Z
+C
+      MX = M
+      NY = N
+      ANG1 = ANGH*3.14159265358979/180.
+      ANG2 = ANGV*3.14159265358979/180.
+      FLO = BIGEST
+      HI = -FLO
+      DO  20 J=1,NY
+         DO  10 I=1,MX
+            IF (NOFFP.EQ.1 .AND. Z(I,J).EQ.SPV) GO TO   10
+            HI = AMAX1(Z(I,J),HI)
+            FLO = AMIN1(Z(I,J),FLO)
+   10    CONTINUE
+   20 CONTINUE
+C
+C SET UP LINEAR X AND Y ARRAYS FOR SRFACE
+C
+      DELTA = (HI-FLO)/(AMAX0(MX,NY)-1.)*FACT1
+      XMIN = -(FLOAT(MX/2)*DELTA+FLOAT(MOD(MX+1,2))*DELTA)
+      YMIN = -(FLOAT(NY/2)*DELTA+FLOAT(MOD(NY+1,2))*DELTA)
+      DO  30 I=1,MX
+         WORK(I) = XMIN+FLOAT(I-1)*DELTA
+   30 CONTINUE
+      DO  40 J=1,NY
+         K = MX+J
+         WORK(K) = YMIN+FLOAT(J-1)*DELTA
+   40 CONTINUE
+C
+C SET UP EYE POSITION
+C
+      FACTE = (HI-FLO)*FACT1*FACT2
+      CANG2 = COS(ANG2)
+      S(1) = FACTE*CANG2*COS(ANG1)
+      S(2) = FACTE*CANG2*SIN(ANG1)
+      S(3) = FACTE*SIN(ANG2)+(FLO+HI)*.5
+C
+C READY
+C
+      CALL SRFACE (WORK(1),WORK(MX+1),Z,WORK(K+1),MX,MX,NY,S,0.)
+      RETURN
+      END
+      SUBROUTINE SETR (XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,R0)
+C
+C THIS ROUTINE ESTABLISHES CERTAIN CONSTANTS SO THAT SRFACE
+C PRODUCES A PICTURE WHOSE SIZE CHANGES WITH RESPECT TO THE
+C VIEWERS DISTANCE FROM THE OBJECT.  IT CAN ALSO BE USED
+C WHEN MAKING A MOVIE OF AN OBJECT EVOLVING IN TIME TO KEEP
+C IT POSITIONED PROPERLY ON THE SCREEN, SAVING COMPUTER TIME
+C IN THE BARGIN.  CALL IT WITH R0 NEGATIVE TO TURN OFF THIS
+C FEATURE.
+C PARAMETERS
+C XMIN,XMAX - RANGE OF X ARRAY THAT WILL BE PASSED TO SRFACE.
+C YMIN,YMAX - SAME IDEA, BUT FOR Y.
+C ZMIN,ZMAX - SAME IDEA, BUT FOR Z.  IF A MOVIE IS BEING
+C               MADE OF AN EVOLVING Z ARRAY, ZMIN       AND ZMAX
+C               SHOULD CONTAIN RANGE OF THE UNION       OF ALL THE Z
+C               ARRAYS.  THEY NEED NOT BE       EXACT.
+C R0             - DISTANCE BETWEEN OBSERVER    AND POINT LOOKED AT
+C               WHEN THE PICTURE IS TO FILL THE SCREEN WHEN
+C               VIEWED FROM THE DIRECTION       WHICH MAKES THE PIC-
+C               TURE BIGGEST.  IF       R0 IS NOT POSITIVE, THEN THE
+C               RELATIVE SIZE FEATURE IS TURNED OFF, AND SUB-
+C               SEQUENT PICTURES WILL FILL THE SCREEN.
+C
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX,
+     2                EYEY       ,EYEZ
+C
+C
+      CALL Q8QST4 ('GRAPHX','SRFACE','SETR','VERSION 01')
+      IF (R0)  10, 10, 20
+   10 NRSWT = 0
+      RETURN
+   20 NRSWT = 1
+      XXMIN = XMIN
+      XXMAX = XMAX
+      YYMIN = YMIN
+      YYMAX = YMAX
+      ZZMIN = ZMIN
+      ZZMAX = ZMAX
+      RZERO = R0
+      LL = 0
+      XAT = (XXMAX+XXMIN)*.5
+      YAT = (YYMAX+YYMIN)*.5
+      ZAT = (ZZMAX+ZZMIN)*.5
+      ALPHA = -(YYMIN-YAT)/(XXMIN-XAT)
+      YEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      XEYE = YEYE*ALPHA
+      YEYE = YEYE+YAT
+      XEYE = XEYE+XAT
+      ZEYE = ZAT
+      CALL TRN32S (XAT,YAT,ZAT,XEYE,YEYE,ZEYE,0)
+      XMN = XXMIN
+      XMX = XXMAX
+      YMN = YYMIN
+      YMX = YYMAX
+      ZMN = ZZMIN
+      ZMX = ZZMAX
+      CALL TRN32S (XMN,YMN,ZAT,UMN,DUMMY,DUMMIE,1)
+      CALL TRN32S (XMX,YMN,ZMN,DUMMY,VMN,DUMMIE,1)
+      CALL TRN32S (XMX,YMX,ZAT,UMX,DUMMY,DUMMIE,1)
+      CALL TRN32S (XMX,YMN,ZMX,DUMMY,VMX,DUMMIE,1)
+      UMIN = UMN
+      UMAX = UMX
+      VMIN = VMN
+      VMAX = VMX
+      BIGD = SQRT((XXMAX-XXMIN)**2+(YYMAX-YYMIN)**2+(ZZMAX-ZZMIN)**2)*.5
+      RETURN
+      END
+      SUBROUTINE DRAWS (MX1,MY1,MX2,MY2,IDRAW,IMARK)
+C
+C THIS ROUTINE DRAWS THE VISIBLE PART OF THE LINE CONNECTING
+C (MX1,MY1) AND (MX2,MY2).  IF IDRAW .NE. 0, THE LINE IS DRAWN.
+C IF IMARK .NE. 0, THE VISIBILITY ARRAY IS MARKED.
+C
+      LOGICAL               VIS1         ,VIS2
+      DIMENSION       PXS(2)     ,PYS(2)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DATA STEEP/5./
+      DATA MX, MY /0, 0/
+C
+c +NOAO: Blockdata srfabd rewritten as run time initialization
+c     EXTERNAL        SRFABD
+      call srfabd
+c -NOAO
+C MAKE LINE LEFT TO RIGHT.
+C
+      MMX1 = MX1
+      MMY1 = MY1
+      MMX2 = MX2
+      MMY2 = MY2
+      IF (MMX1.EQ.NSPVAL .OR. MMX2.EQ.NSPVAL) RETURN
+      IF (MMX1 .GT. MMX2) GO TO  10
+      NX1 = MMX1
+      NY1 = MMY1
+      NX2 = MMX2
+      NY2 = MMY2
+      GO TO  20
+   10 NX1 = MMX2
+      NY1 = MMY2
+      NX2 = MMX1
+      NY2 = MMY1
+   20 IF (NUPPER .LT. 0) GO TO 180
+C
+C CHECK UPPER VISIBILITY.
+C
+      VIS1 = NY1 .GE. (LIMU(NX1)-1)
+      VIS2 = NY2 .GE. (LIMU(NX2)-1)
+C
+C VIS1 AND VIS2 TRUE MEANS VISIBLE.
+C
+      IF (VIS1 .AND. VIS2) GO TO 120
+C
+C VIS1 AND VIS2 FALSE MEANS INVISIBLE.
+C
+      IF (.NOT.(VIS1 .OR. VIS2)) GO TO 180
+C
+C FIND CHANGE POINT.
+C
+      IF (NX1 .EQ. NX2) GO TO 110
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      NX1P1 = NX1+1
+      FNY1 = NY1
+      IF (VIS1) GO TO  60
+      DO  30 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .GT. LIMU(K)) GO TO  40
+   30 CONTINUE
+   40 IF (ABS(DY) .GE. STEEP) GO TO  90
+   50 NX1 = MX
+      NY1 = MY
+      GO TO 120
+   60 DO  70 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .LT. LIMU(K)) GO TO  80
+   70 CONTINUE
+   80 IF (ABS(DY) .GE. STEEP) GO TO 100
+      NX2 = MX-1
+      NY2 = MY
+      GO TO 120
+   90 IF (LIMU(MX) .EQ. 0) GO TO  50
+      NX1 = MX
+      NY1 = LIMU(NX1)
+      GO TO 120
+  100 NX2 = MX-1
+      NY2 = LIMU(NX2)
+      GO TO 120
+  110 IF (VIS1) NY2 = MIN0(LIMU(NX1),LIMU(NX2))
+      IF (VIS2) NY1 = MIN0(LIMU(NX1),LIMU(NX2))
+  120 IF (IDRAW .EQ. 0) GO TO 150
+C
+C DRAW VISIBLE PART OF LINE.
+C
+      IF (IROT) 130,140,130
+  130 CONTINUE
+      PXS(1) = FLOAT(NY1)
+      PXS(2) = FLOAT(NY2)
+      PYS(1) = FLOAT(1024-NX1)
+      PYS(2) = FLOAT(1024-NX2)
+      CALL GPL (2,PXS,PYS)
+      GO TO 150
+  140 CONTINUE
+      PXS(1) = FLOAT(NX1)
+      PXS(2) = FLOAT(NX2)
+      PYS(1) = FLOAT(NY1)
+      PYS(2) = FLOAT(NY2)
+      CALL GPL (2,PXS,PYS)
+  150 IF (IMARK .EQ. 0) GO TO 180
+      IF (NX1 .EQ. NX2) GO TO 170
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      FNY1 = NY1
+      DO 160 K=NX1,NX2
+         LTEMP = FNY1+FLOAT(K-NX1)*DY
+	 IF (LTEMP .GT. LIMU(K)) LIMU(K) = LTEMP
+  160 CONTINUE
+      GO TO 180
+  170 LTEMP = MAX0(NY1,NY2)
+      IF (LTEMP .GT. LIMU(NX1)) LIMU(NX1) = LTEMP
+  180 IF (NUPPER) 190,190,370
+C
+C SAME IDEA AS ABOVE, BUT FOR LOWER SIDE.
+C
+  190 IF (MMX1 .GT. MMX2) GO TO 200
+      NX1 = MMX1
+      NY1 = MMY1
+      NX2 = MMX2
+      NY2 = MMY2
+      GO TO 210
+  200 NX1 = MMX2
+      NY1 = MMY2
+      NX2 = MMX1
+      NY2 = MMY1
+  210 VIS1 = NY1 .LE. (LIML(NX1)+1)
+      VIS2 = NY2 .LE. (LIML(NX2)+1)
+      IF (VIS1 .AND. VIS2) GO TO 310
+      IF (.NOT.(VIS1 .OR. VIS2)) GO TO 370
+      IF (NX1 .EQ. NX2) GO TO 300
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      NX1P1 = NX1+1
+      FNY1 = NY1
+      IF (VIS1) GO TO 250
+      DO 220 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .LT. LIML(K)) GO TO 230
+  220 CONTINUE
+  230 IF (ABS(DY) .GE. STEEP) GO TO 280
+  240 NX1 = MX
+      NY1 = MY
+      GO TO 310
+  250 DO 260 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .GT. LIML(K)) GO TO 270
+  260 CONTINUE
+  270 IF (ABS(DY) .GE. STEEP) GO TO 290
+      NX2 = MX-1
+      NY2 = MY
+      GO TO 310
+  280 IF (LIML(MX) .EQ. 1024) GO TO 240
+      NX1 = MX
+      NY1 = LIML(NX1)
+      GO TO 310
+  290 NX2 = MX-1
+      NY2 = LIML(NX2)
+      GO TO 310
+  300 IF (VIS1) NY2 = MAX0(LIML(NX1),LIML(NX2))
+      IF (VIS2) NY1 = MAX0(LIML(NX1),LIML(NX2))
+  310 IF (IDRAW .EQ. 0) GO TO 340
+      IF (IROT) 320,330,320
+  320 CONTINUE
+      PXS(1) = FLOAT(NY1)
+      PXS(2) = FLOAT(NY2)
+      PYS(1) = FLOAT(1024-NX1)
+      PYS(2) = FLOAT(1024-NX2)
+      CALL GPL (2,PXS,PYS)
+      GO TO 340
+  330 CONTINUE
+      PXS(1) = FLOAT(NX1)
+      PXS(2) = FLOAT(NX2)
+      PYS(1) = FLOAT(NY1)
+      PYS(2) = FLOAT(NY2)
+      CALL GPL (2,PXS,PYS)
+  340 IF (IMARK .EQ. 0) GO TO 370
+      IF (NX1 .EQ. NX2) GO TO 360
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      FNY1 = NY1
+      DO 350 K=NX1,NX2
+         LTEMP = FNY1+FLOAT(K-NX1)*DY
+	 IF (LTEMP .LT. LIML(K)) LIML(K) = LTEMP
+  350 CONTINUE
+      RETURN
+  360 LTEMP = MIN0(NY1,NY2)
+      IF (LTEMP .LT. LIML(NX1)) LIML(NX1) = LTEMP
+  370 RETURN
+      END
+      SUBROUTINE TRN32S (X,Y,Z,XT,YT,ZT,IFLAG)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C IFLAG=0 ARGUMENTS
+C X,Y,Z    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.    THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C IFLAG=1 ARGUMENTS
+C X,Y,Z    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.
+C          USE IFIX(XT) AND IFIX(YT) IN GPL CALLS.
+C ZT            NOT USED.
+C IF LL (IN COMMON) =0 XT AND YT ARE IN THE SAME SCALE AS X, Y, AND Z.
+C
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN  ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT ,EYEX,
+     2                EYEY       ,EYEZ
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DIMENSION       NLU(7)     ,NRU(7)     ,NBV(7)     ,NTV(7)
+C
+C SAVE INSERTED BY BEN DOMENICO 9/8/85 BECAUSE OF ASSUMPTION THAT
+C   JUMP, JUMP2, AND JUMP3 ARE PRESERVED BETWEEN CALLS.
+C   THERE MAY BE OTHER SUCH ASSUMPTIONS AS WELL.
+C
+      SAVE
+C
+C PICTURE CORNER COORDINATES FOR LL=1
+C
+      DATA NLU(1),NRU(1),NBV(1),NTV(1)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=2
+C
+      DATA NLU(2),NRU(2),NBV(2),NTV(2)/  10, 924,  50, 964/
+C
+C PICTURE CORNER COORDINATES FOR LL=3
+C
+      DATA NLU(3),NRU(3),NBV(3),NTV(3)/ 100,1014,  50, 964/
+C
+C PICTURE CORNER COORDINATES FOR LL=4
+C
+      DATA NLU(4),NRU(4),NBV(4),NTV(4)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=5
+C
+      DATA NLU(5),NRU(5),NBV(5),NTV(5)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=6
+C
+      DATA NLU(6),NRU(6),NBV(6),NTV(6)/  10, 512, 256, 758/
+C
+C PICTURE CORNER COORDINATES FOR LL=7
+C
+      DATA NLU(7),NRU(7),NBV(7),NTV(7)/ 512,1014, 256, 758/
+C
+C STORE THE PARAMETERS OF THE SET32 CALL FOR USE WHEN
+C TRN32 IS CALLED.
+C
+      IF (IFLAG)  40, 10, 40
+   10 CONTINUE
+      ASSIGN  60 TO JUMP3
+      IF (IOFFP .EQ. 1) ASSIGN  50 TO JUMP3
+      AX = X
+      AY = Y
+      AZ = Z
+      EX = XT
+      EY = YT
+      EZ = ZT
+C
+C AS MUCH COMPUTATION AS POSSIBLE IS DONE DURING EXECUTION
+C THIS ROUTINE WHEN IFLAG=0 BECAUSE CALLS IN THAT MODE ARE INFREQUENT.
+C
+      DX = AX-EX
+      DY = AY-EY
+      DZ = AZ-EZ
+      D = SQRT(DX*DX+DY*DY+DZ*DZ)
+      COSAL = DX/D
+      COSBE = DY/D
+      COSGA = DZ/D
+      SINGA = SQRT(1.-COSGA*COSGA)
+      ASSIGN 120 TO JUMP2
+      IF (LL .EQ. 0) GO TO  20
+      ASSIGN 100 TO JUMP2
+      DELCRT = NRU(LL)-NLU(LL)
+      U0 = UMIN
+      V0 = VMIN
+      U1 = NLU(LL)
+      V1 = NBV(LL)
+      U2 = NRU(LL)-NLU(LL)
+      V2 = NTV(LL)-NBV(LL)
+      U3 = U2/(UMAX-UMIN)
+      V3 = V2/(VMAX-VMIN)
+      U4 = NRU(LL)
+      V4 = NTV(LL)
+      IF (NRSWT .EQ. 0) GO TO  20
+      U0 = -BIGD
+      V0 = -BIGD
+      U3 = U2/(2.*BIGD)
+      V3 = V2/(2.*BIGD)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE Z AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE Z AXIS, THE 3-SPACE Y AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE Z AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+   20 IF (SINGA .LT. 0.0001) GO TO  30
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   30 SINBE = SQRT(1.-COSBE*COSBE)
+      R = 1./SINBE
+      ASSIGN  80 TO JUMP
+      RETURN
+   40 CONTINUE
+      XX = X
+      YY = Y
+      ZZ = Z
+      GO TO JUMP3,( 50, 60)
+   50 IF (ZZ .EQ. SPVAL) GO TO 110
+   60 Q = D/((XX-EX)*COSAL+(YY-EY)*COSBE+(ZZ-EZ)*COSGA)
+      GO TO JUMP,( 70, 80)
+   70 XX = ((EX+Q*(XX-EX)-AX)*COSBE-(EY+Q*(YY-EY)-AY)*COSAL)*R
+      YY = (EZ+Q*(ZZ-EZ)-AZ)*R
+      GO TO  90
+   80 XX = ((EZ+Q*(ZZ-EZ)-AZ)*COSAL-(EX+Q*(XX-EX)-AX)*COSGA)*R
+      YY = (EY+Q*(YY-EY)-AY)*R
+   90 GO TO JUMP2,(100,120)
+c + NOAO: Clipping is done at the gio level and is unnecessary here.  The
+c following statements were preventing labels from being positioned properly
+c at the edges of the surface plot, even when the viewport had been reset.
+  100 xx = u1 + u3 * (fact * xx - u0)
+      yy = v1 + v3 * (fact * yy - v0)
+c 100 XX = AMIN1(U4,AMAX1(U1,U1+U3*(FACT*XX-U0)))
+c     YY = AMIN1(V4,AMAX1(V1,V1+V3*(FACT*YY-V0)))
+c -NOAO
+      GO TO 120
+  110 XX = NSPVAL
+      YY = NSPVAL
+C
+  120 XT = XX
+      YT = YY
+      RETURN
+      END
+      SUBROUTINE CLSET (Z,MX,NX,NY,CHI,CLO,CINC,NLA,NLM,CL,NCL,ICNST,
+     1                  IOFFP,SPVAL,BIGEST)
+      DIMENSION       Z(MX,NY)   ,CL(NLM)
+      DATA KK /0/
+C
+C CLSET PUTS THE VALUS OF THE CONTOUR LEVELS IN CL
+C
+      ICNST = 0
+      GLO = CLO
+      HA = CHI
+      FANC = CINC
+      CRAT = NLA
+      IF (HA-GLO)  10, 20, 50
+   10 GLO = HA
+      HA = CLO
+      GO TO  50
+   20 GLO = BIGEST
+      HA = -GLO
+      DO  40 J=1,NY
+         DO  30 I=1,NX
+            IF (IOFFP.EQ.1 .AND. Z(I,J).EQ.SPVAL) GO TO  30
+            GLO = AMIN1(Z(I,J),GLO)
+            HA = AMAX1(Z(I,J),HA)
+   30    CONTINUE
+   40 CONTINUE
+   50 IF (FANC)  60, 70, 90
+   60 CRAT = -FANC
+   70 FANC = (HA-GLO)/CRAT
+      IF (FANC) 140,140, 80
+   80 P = 10.**(IFIX(ALOG10(FANC)+500.)-500)
+      FANC = AINT(FANC/P)*P
+   90 IF (CHI-CLO) 110,100,110
+  100 GLO = AINT(GLO/FANC)*FANC
+      HA = AINT(HA/FANC)*FANC
+  110 DO 120 K=1,NLM
+         CC = GLO+FLOAT(K-1)*FANC
+         IF (CC .GT. HA) GO TO 130
+         KK = K
+         CL(K) = CC
+  120 CONTINUE
+  130 NCL = KK
+      RETURN
+  140 ICNST = 1
+      RETURN
+      END
+      SUBROUTINE CTCELL (Z,MX,NX,NY,M,I0,J0)
+C
+C CTCELL COMPUTES LINES OF CONSTANT Z (CONTOUR LINES) IN ONE
+C CELL OF THE ARRAY Z FOR THE SRFACE PACKAGE.
+C Z,MX,NX,NY ARE THE SAME AS IN SRFACE.
+C M              BY     THE TIME CTCELL IS FIRST CALLED, M CONTAINS
+C            THE TWO-SPACE PLOTTER LOCATION OF EACH Z POINT.
+C            U(Z(I,J))=M(1,I,J).  V(Z(I,J))=M(2,I,J)
+C I0,J0      THE CELL Z(I0,J0) TO Z(I0+1,J0+1) IS THE ONE TO
+C            BE CONTOURED.
+C
+      DIMENSION       Z(MX,NY)   ,M(2,NX,NY)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DATA IDUB/0/
+      R(HO,HU) = (HO-CV)/(HO-HU)
+      I1 = I0
+      I1P1 = I1+1
+      J1 = J0
+      J1P1 = J1+1
+      H1 = Z(I1,J1)
+      H2 = Z(I1,J1P1)
+      H3 = Z(I1P1,J1P1)
+      H4 = Z(I1P1,J1)
+      IF (IOFFP .NE. 1) GO TO  10
+      IF (H1.EQ.SPVAL .OR. H2.EQ.SPVAL .OR. H3.EQ.SPVAL .OR.
+     1    H4.EQ.SPVAL) RETURN
+   10 IF (AMIN1(H1,H2,H3,H4) .GT. CL(NCL)) RETURN
+      DO 110 K=1,NCL
+C
+C FOR EACH CONTOUR LEVEL, DESIDE WHICH OF THE 16 BASIC SIT-
+C UATIONS EXISTS, THEN INTERPOLATE IN TWO-SPACE TO FIND THE
+C END POINTS OF THE CONTOUR LINE SEGMENT WITHIN THIS CELL.
+C
+         CV = CL(K)
+         K1 = (IFIX(SIGN(1.,H1-CV))+1)/2
+         K2 = (IFIX(SIGN(1.,H2-CV))+1)/2
+         K3 = (IFIX(SIGN(1.,H3-CV))+1)/2
+         K4 = (IFIX(SIGN(1.,H4-CV))+1)/2
+         JUMP = 1+K1+K2*2+K3*4+K4*8
+         GO TO (120, 30, 50, 60, 70, 20, 80, 90, 90, 80,
+     1           40, 70, 60, 50, 30,110),JUMP
+   20    IDUB = 1
+   30    RA = R(H1,H2)
+         MUA = FLOAT(M(1,I1,J1))+RA*FLOAT(M(1,I1,J1P1)-M(1,I1,J1))
+         MVA = FLOAT(M(2,I1,J1))+RA*FLOAT(M(2,I1,J1P1)-M(2,I1,J1))
+         RB = R(H1,H4)
+         MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1))
+         MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1))
+         GO TO 100
+   40    IDUB = -1
+   50    RA = R(H2,H1)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1))
+         RB = R(H2,H3)
+         MUB = FLOAT(M(1,I1,J1P1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1))
+         MVB = FLOAT(M(2,I1,J1P1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1))
+         GO TO 100
+   60    RA = R(H2,H3)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1))
+         RB = R(H1,H4)
+         MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1))
+         MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1))
+         GO TO 100
+   70    RA = R(H3,H2)
+         MUA = FLOAT(M(1,I1P1,J1P1))+
+     1         RA*FLOAT(M(1,I1,J1P1)-M(1,I1P1,J1P1))
+         MVA = FLOAT(M(2,I1P1,J1P1))+
+     1         RA*FLOAT(M(2,I1,J1P1)-M(2,I1P1,J1P1))
+         RB = R(H3,H4)
+         MUB = FLOAT(M(1,I1P1,J1P1))+
+     1         RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1))
+         MVB = FLOAT(M(2,I1P1,J1P1))+
+     1         RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1))
+         IDUB = 0
+         GO TO 100
+   80    RA = R(H2,H1)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1))
+         RB = R(H3,H4)
+         MUB = FLOAT(M(1,I1P1,J1P1))+
+     1         RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1))
+         MVB = FLOAT(M(2,I1P1,J1P1))+
+     1         RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1))
+         GO TO 100
+   90    RA = R(H4,H1)
+         MUA = FLOAT(M(1,I1P1,J1))+RA*FLOAT(M(1,I1,J1)-M(1,I1P1,J1))
+         MVA = FLOAT(M(2,I1P1,J1))+RA*FLOAT(M(2,I1,J1)-M(2,I1P1,J1))
+         RB = R(H4,H3)
+         MUB = FLOAT(M(1,I1P1,J1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1P1,J1))
+         MVB = FLOAT(M(2,I1P1,J1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1P1,J1))
+         IDUB = 0
+  100    CALL DRAWS (MUA,MVA,MUB,MVB,1,0)
+         IF (IDUB)  90,110, 70
+  110 CONTINUE
+  120 RETURN
+      END
diff --git a/sys/gio/ncarutil/strmln.f b/sys/gio/ncarutil/strmln.f
new file mode 100644
index 00000000..411caed8
--- /dev/null
+++ b/sys/gio/ncarutil/strmln.f
@@ -0,0 +1,957 @@
+      SUBROUTINE STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,NSET,IER)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SUBROUTINE STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,NSET,IER)
+C
+C DIMENSION OF           U(IMAX,JPTSY) , V(IMAX,JPTSY) ,
+C ARGUMENTS              WORK(2*IMAX*JPTSY)
+C
+C LATEST REVISION        JUNE 1984
+C
+C PURPOSE                STRMLN DRAWS A STREAMLINE REPRESENTATION OF
+C                        THE FLOW FIELD. THE REPRESENTATION IS
+C                        INDEPENDENT OF THE FLOW SPEED.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                            CALL EZSTRM  (U,V,WORK,IMAX,JMAX)
+C
+C                          ASSUMPTIONS:
+C                            --THE WHOLE ARRAY IS TO BE PROCESSED.
+C                            --THE ARRAYS ARE DIMENSIONED
+C                              U(IMAX,JMAX) , V(IMAX,JMAX) AND
+C                              WORK(2*IMAX*JMAX).
+C                            --WINDOW AND VIEWPORT ARE TO BE CHOSEN
+C                              BY STRMLN.
+C                            --PERIM IS TO BE CALLED.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                            CALL STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,
+C                                         NSET,IER)
+C
+C                        THE USER MUST CALL FRAME IN THE CALLING
+C                        ROUTINE.
+C
+C                        THE USER MAY CHANGE VARIOUS INTERNAL
+C                        PARAMETERS VIA COMMON BLOCKS. SEE BELOW.
+C
+C ARGUMENTS
+C
+C ON INPUT               U, V
+C                          TWO DIMENSIONAL ARRAYS CONTAINING THE
+C                          VELOCITY FIELDS TO BE PLOTTED.
+C                          (NOTE:  IF THE U AND V COMPONENTS
+C                          ARE, FOR EXAMPLE, DEFINED IN CARTESIAN
+C                          COORDINATES AND THE USER WISHES TO PLOT THEM
+C                          ON A DIFFERENT PROJECTION (I.E., STEREO-
+C                          GRAPHIC), THEN THE APPROPRIATE
+C                          TRANSFORMATION MUST BE MADE TO THE U AND V
+C                          COMPONENTS VIA THE FUNCTIONS FU AND FV
+C                          (LOCATED IN DRWSTR).
+C
+C                        WORK
+C                          USER PROVIDED WORK ARRAY.  THE DIMENSION
+C                          OF THIS ARRAY MUST BE .GE. 2*IMAX*JPTSY.
+C                          CAUTION:  THIS ROUTINE DOES NOT CHECK THE
+C                          SIZE OF THE WORK ARRAY.
+C
+C                        IMAX
+C                          THE FIRST DIMENSION OF U AND V IN THE
+C                          CALLING PROGRAM. (X-DIRECTION)
+C
+C                        IPTSX
+C                          THE NUMBER OF POINTS TO BE PLOTTED IN THE
+C                          FIRST SUBSCRIPT DIRECTION.  (X-DIRECTION)
+C
+C                        JPTSY
+C                          THE NUMBER OF POINTS TO BE PLOTTED IN THE
+C                          SECOND SUBSCRIPT DIRECTION. (Y-DIRECTION)
+C
+C                        NSET
+C                          FLAG TO CONTROL SCALING
+C                          > 0  STRMLN ASSUMES THAT THE WINDOW
+C                               AND VIEWPORT HAVE BEEN SET BY THE
+C                               USER IN SUCH A WAY AS TO PROPERLY
+C                               SCALE THE PLOTTING INSTRUCTIONS
+C                               GENERATED BY STRMLN. PERIM IS NOT
+C                               CALLED.
+C                          = 0  STRMLN WILL ESTABLISH THE WINDOW AND
+C                               VIEWPORT TO PROPERLY SCALE THE
+C                               PLOTTING INSTRUCTIONS TO THE STANDARD
+C                               CONFIGURATION. PERIM IS CALLED TO DRAW
+C                               THE BORDER.
+C                          < 0  STRMLN ESTABLISHES THE WINDOW
+C                               AND VIEWPORT SO AS TO PLACE THE
+C                               STREAMLINES WITHIN THE LIMITS
+C                               OF THE USER'S WINDOW.  PERIM IS
+C                               NOT CALLED.
+C
+C ON OUTPUT              ONLY THE IER ARGUMENT MAY BE CHANGED. ALL
+C                        OTHER ARGUMENTS ARE UNCHANGED.
+C
+C
+C                        IER
+C                          =  0 WHEN NO ERRORS ARE DETECTED
+C                          = -1 WHEN THE ROUTINE IS CALLED WITH ICYC
+C                               .NE. 0  AND THE DATA ARE NOT CYCLIC
+C                               (ICYC IS AN INTERNAL PARAMETER
+C                               DESCRIBED BELOW); IN THIS CASE THE
+C                               ROUTINE WILL DRAW THE
+C                               STREAMLINES WITH THE NON-CYCLIC
+C                               INTERPOLATION FORMULAS.
+C
+C ENTRY POINTS           STRMLN, DRWSTR, EZSTRM, GNEWPT, CHKCYC
+C
+C COMMON BLOCKS          STR01, STR02, STR03, STR04
+C
+C REQUIRED LIBRARY       GRIDAL, GBYTES, AND THE SPPS
+C ROUTINES
+C
+C HISTORY                WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C I/O                    DRAWS STREAMLINES
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                WRITTEN IN 1979.
+C                        CONVERTED TO FORTRAN 77 AND GKS IN JUNE 1984.
+C
+C PORTABILITY            FORTRAN 77
+C
+C ALGORITHM              WIND COMPONENTS ARE NORMALIZED TO THE VALUE
+C                        OF DISPL. THE LEAST SIGNIFICANT TWO
+C                        BITS OF THE WORK ARRAY ARE
+C                        UTILIZED AS FLAGS FOR EACH GRID BOX. FLAG 1
+C                        INDICATES WHETHER ANY STREAMLINE HAS
+C                        PREVIOUSLY PASSED THROUGH THIS BOX.  FLAG 2
+C                        INDICATES WHETHER A DIRECTIONAL ARROW HAS
+C                        ALREADY APPEARED IN A BOX. JUDICIOUS USE
+C                        OF THESE FLAGS PREVENTS OVERCROWDING OF
+C                        STREAMLINES AND DIRECTIONAL ARROWS.
+C                        EXPERIENCE INDICATES THAT A FINAL PLEASING
+C                        PICTURE IS PRODUCED WHEN STREAMLINES ARE
+C                        INITIATED IN THE CENTER OF A GRID BOX. THE
+C                        STREAMLINES ARE DRAWN IN ONE DIRECTION THEN
+C                        IN THE OPPOSITE DIRECTION.
+C
+C REFERENCE              THE TECHNIQUES UTILIZED HERE ARE DESCRIBED
+C                        IN AN ARTICLE BY THOMAS WHITTAKER (U. OF
+C                        WISCONSIN) WHICH APPEARED IN THE NOTES AND
+C                        CORRESPONDENCE SECTION OF MONTHLY WEATHER
+C                        REVIEW, JUNE 1977.
+C
+C TIMING                 HIGHLY VARIABLE
+C                          IT DEPENDS ON THE COMPLEXITY OF THE
+C                          FLOW FIELD AND THE PARAMETERS:  DISPL,
+C                          DISPC , CSTOP , INITA , INITB , ITERC ,
+C                          AND IGFLG. (SEE BELOW FOR A DISCUSSION
+C                          OF THESE PARAMETERS.) IF ALL VALUES
+C                          ARE DEFAULT, THEN A SIMPLE LINEAR
+C                          FLOW FIELD FOR A 40 X 40 GRID WILL
+C                          TAKE ABOUT 0.4 SECONDS ON THE CRAY1-A;
+C                          A FAIRLY COMPLEX FLOW FIELD WILL TAKE ABOUT
+C                          1.5 SECONDS ON THE CRAY1-A.
+C
+C
+C INTERNAL PARAMETERS
+C
+C                        NAME     DEFAULT            FUNCTION
+C                        ----     -------            --------
+C
+C                        EXT       0.25      LENGTHS OF THE SIDES OF THE
+C                                            PLOT ARE PROPORTIONAL TO
+C                                            IPTSX AND JPTSY EXCEPT IN
+C                                            THE CASE WHEN MIN(IPTSX,JPT
+C                                            / MAX(IPTSX,JPTSY) .LT. EXT;
+C                                            IN THAT CASE A SQUARE
+C                                            GRAPH IS PLOTTED.
+C
+C                        SIDE      0.90      LENGTH OF LONGER EDGE OF
+C                                            PLOT. (SEE ALSO EXT.)
+C
+C                        XLT       0.05      LEFT HAND EDGE OF THE PLOT.
+C                                            (0.0 = LEFT EDGE OF FRAME)
+C                                            (1.0 = RIGHT EDGE OF FRAME)
+C
+C                        YBT       0.05      BOTTOM EDGE OF THE PLOT.
+C                                            (0.0 = BOTTOM ; 1.0 = TOP)
+C
+C                                            (YBT+SIDE AND XLT+SIDE MUST
+C                                            BE .LE. 1. )
+C
+C                        INITA     2         USED TO PRECONDITION GRID
+C                                            BOXES TO BE ELIGIBLE TO
+C                                            START A STREAMLINE.
+C                                            FOR EXAMPLE, A VALUE OF 4
+C                                            MEANS THAT EVERY FOURTH
+C                                            GRID BOX IS ELIGIBLE ; A
+C                                            VALUE OF 2 MEANS THAT EVERY
+C                                            OTHER GRID BOX IS ELIGIBLE.
+C                                            (SEE INITB)
+C
+C                        INITB     2         USED TO PRECONDITION GRID
+C                                            BOXES TO BE ELIGIBLE FOR
+C                                            DIRECTION ARROWS.
+C                                            IF THE USER CHANGES THE
+C                                            DEFAULT VALUES OF INITA
+C                                            AND/OR INITB, IT SHOULD
+C                                            BE DONE SUCH THAT
+C                                            MOD(INITA,INITB) = 0 .
+C                                            FOR A DENSE GRID TRY
+C                                            INITA=4 AND INITB=2 TO
+C                                            REDUCE THE CPU TIME.
+C
+C                        AROWL     0.33      LENGTH OF DIRECTION ARROW.
+C                                            FOR EXAMPLE, 0.33 MEANS
+C                                            EACH DIRECTIONAL ARROW WILL
+C                                            TAKE UP A THIRD OF A GRID
+C                                            BOX.
+C
+C                        ITERP     35        EVERY 'ITERP' ITERATIONS
+C                                            THE STREAMLINE PROGRESS
+C                                            IS CHECKED.
+C
+C                        ITERC     -99       THE DEFAULT VALUE OF THIS
+C                                            PARAMETER IS SUCH THAT
+C                                            IT HAS NO EFFECT ON THE
+C                                            CODE. WHEN SET TO SOME
+C                                            POSITIVE VALUE, THE PROGRAM
+C                                            WILL CHECK FOR STREAMLINE
+C                                            CROSSOVER EVERY 'ITERC'
+C                                            ITERATIONS. (THE ROUTINE
+C                                            CURRENTLY DOES THIS EVERY
+C                                            TIME IT ENTERS A NEW GRID
+C                                            BOX.) CAUTION:  WHEN
+C                                            THIS PARAMETER IS ACTIVATED
+C                                            CPU TIME WILL INCREASE.
+C
+C                        IGFLG     0         A VALUE OF ZERO MEANS THAT
+C                                            THE SIXTEEN POINT BESSEL
+C                                            INTERPOLATION FORMULA WILL
+C                                            BE UTILIZED WHERE POSSIBLE;
+C                                            WHEN NEAR THE GRID EDGES,
+C                                            QUADRATIC AND BI-LINEAR
+C                                            INTERPOLATION  WILL BE
+C                                            USED. THIS MIXING OF
+C                                            INTERPOLATION SCHEMES CAN
+C                                            SOMETIMES CAUSE SLIGHT
+C                                            RAGGEDNESS NEAR THE EDGES
+C                                            OF THE PLOT.  IF IGFLG.NE.0,
+C                                            THEN ONLY THE BILINEAR
+C                                            INTERPOLATION FORMULA
+C                                            IS USED; THIS WILL GENERALLY
+C                                            RESULT IN SLIGHTLY FASTER
+C                                            PLOT TIMES BUT A LESS
+C                                            PLEASING PLOT.
+C
+C                        IMSG      0         IF ZERO, THEN NO MISSING
+C                                            U AND V COMPONENTS ARE
+C                                            PRESENT.
+C                                            IF .NE. 0, STRMLN WILL
+C                                            UTILIZE THE
+C                                            BI-LINEAR INTERPOLATION
+C                                            SCHEME AND TERMINATE IF
+C                                            ANY DATA POINTS ARE MISSING.
+C
+C                        UVMSG     1.E+36    VALUE ASSIGNED TO A MISSING
+C                                            POINT.
+C
+C                        ICYC      0         ZERO MEANS THE DATA ARE
+C                                            NON-CYCLIC IN THE X
+C                                            DIRECTION.
+C                                            IF .NE 0, THE
+C                                            CYCLIC INTERPOLATION
+C                                            FORMULAS WILL BE USED.
+C                                            (NOTE:  EVEN IF THE DATA
+C                                            ARE CYCLIC IN X LEAVING
+C                                            ICYC = 0 WILL DO NO HARM.)
+C
+C                        DISPL     0.33      THE WIND SPEED IS
+C                                            NORMALIZED TO THIS VALUE.
+C                                            (SEE THE DISCUSSION BELOW.)
+C
+C                        DISPC     0.67      THE CRITICAL DISPLACEMENT.
+C                                            IF AFTER 'ITERP' ITERATIONS
+C                                            THE STREAMLINE HAS NOT
+C                                            MOVED THIS DISTANCE, THE
+C                                            STREAMLINE WILL BE
+C                                            TERMINATED.
+C
+C                        CSTOP     0.50      THIS PARAMETER CONTROLS
+C                                            THE SPACING BETWEEN
+C                                            STREAMLINES.  THE CHECKING
+C                                            IS DONE WHEN A NEW GRID
+C                                            BOX IS ENTERED.
+C
+C DISCUSSION OF          ASSUME A VALUE OF 0.33 FOR DISPL.  THIS
+C DISPL,DISPC            MEANS THAT IT WILL TAKE THREE STEPS TO MOVE
+C AND CSTOP              ACROSS ONE GRID BOX IF THE FLOW WAS ALL IN THE
+C                        X DIRECTION. IF THE FLOW IS ZONAL, THEN A
+C                        LARGER VALUE OF DISPL IS IN ORDER.
+C                        IF THE FLOW IS HIGHLY TURBULENT, THEN
+C                        A SMALLER VALUE IS IN ORDER. NOTE: THE SMALLER
+C                        DISPL, THE MORE THE CPU TIME.  A VALUE
+C                        OF 2 TO 4 TIMES DISPL IS A REASONABLE VALUE
+C                        FOR DISPC.  DISPC SHOULD ALWAYS BE GREATER
+C                        THAN DISPL. A VALUE OF 0.33 FOR CSTOP WOULD
+C                        MEAN THAT A MAXIMUM OF THREE STREAM-
+C                        LINES WILL BE DRAWN PER GRID BOX. THIS MAX
+C                        WILL NORMALLY ONLY OCCUR IN AREAS OF SINGULAR
+C                        POINTS.
+C
+C                                            ***************************
+C                                            ANY OR ALL OF THE ABOVE
+C                                            PARAMETERS MAY BE CHANGED
+C                                            BY UTILIZING COMMON BLOCKS
+C                                            STR02 AND/OR STR03
+C                                            ***************************
+C
+C                        UXSML     1.E-50    THE SMALLEST REAL NUMBER
+C                                            ON THE HOST COMPUTER.  THIS
+C                                            IS SET AUTOMATICALLY BY
+C                                            R1MACH.
+C
+C                        NCHK      750       THIS PARAMETER IS LOCATED
+C                                            IN DRWSTR. IT SPECIFIES THE
+C                                            LENGTH OF THE CIRCULAR
+C                                            LISTS  USED FOR CHECKING
+C                                            FOR STRMLN CROSSOVERS.
+C                                            FOR MOST PLOTS THIS NUMBER
+C                                            MAY BE REDUCED TO 500
+C                                            OR LESS AND THE PLOTS WILL
+C                                            NOT BE ALTERED.
+C
+C                        ISKIP               NUMBER OF BITS TO BE
+C                                            SKIPPED TO GET TO THE
+C                                            LEAST TWO SIGNIFICANT BITS
+C                                            IN A FLOATING POINT NUMBER.
+C                                            THE DEFAULT VALUE IS SET TO
+C                                            I1MACH(5) - 2 . THIS VALUE
+C                                            MAY HAVE TO BE CHANGED
+C                                            DEPENDING ON THE TARGET
+C                                            COMPUTER, SEE SUBROUTINE
+C                                            DRWSTR.
+C
+C
+C
+      DIMENSION       U(IMAX,JPTSY)         ,V(IMAX,JPTSY)           ,
+     1                WORK(1)
+      DIMENSION       WNDW(4)               ,VWPRT(4)
+C
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR02/  EXT , SIDE , XLT , YBT
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+C
+      SAVE
+C
+      EXT       = 0.25
+      SIDE      = 0.90
+      XLT       = 0.05
+      YBT       = 0.05
+C
+      INITA     = 2
+      INITB     = 2
+      AROWL     = 0.33
+      ITERP     = 35
+      ITERC     = -99
+      IGFLG     = 0
+      ICYC      = 0
+      IMSG      = 0
+C +NOAO
+C     UVMSG     = 1.E+36
+      uvmsg     = 1.E+16
+C -NOAO
+      DISPL     = 0.33
+      DISPC     = 0.67
+      CSTOP     = 0.50
+C
+C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ( 'GRAPHX', 'STRMLN', 'STRMLN', 'VERSION 01')
+C
+      IER = 0
+C
+C LOAD THE COMMUNICATION COMMON BLOCK WITH PARAMETERS
+C
+      IS = 1
+      IEND = IPTSX
+      JS = 1
+      JEND = JPTSY
+      IEND1 = IEND-1
+      JEND1 = JEND-1
+      IEND2 = IEND-2
+      JEND2 = JEND-2
+      XNX = FLOAT(IEND-IS+1)
+      XNY = FLOAT(JEND-JS+1)
+      ICYC1 = ICYC
+      IGFL1 = IGFLG
+      IMSG1 = 0
+C
+C IF ICYC .NE. 0 THEN CHECK TO MAKE SURE THE CYCLIC CONDITION EXISTS.
+C
+      IF (ICYC1.NE.0) CALL CHKCYC  (U,V,IMAX,JPTSY,IER)
+C
+C SAVE ORIGINAL  NORMALIZATION TRANSFORMATION NUMBER
+C
+      CALL GQCNTN ( IERR,NTORIG )
+C
+C SET UP SCALING
+C
+      IF (NSET) 10 , 20 , 60
+   10 CALL GETUSV ( 'LS' , ITYPE )
+      CALL GQNT ( NTORIG,IERR,WNDW,VWPRT )
+      CALL GETUSV('LS',IOLLS)
+      X1 = VWPRT(1)
+      X2 = VWPRT(2)
+      Y1 = VWPRT(3)
+      Y2 = VWPRT(4)
+      X3 = IS
+      X4 = IEND
+      Y3 = JS
+      Y4 = JEND
+      GO TO  55
+C
+   20 ITYPE = 1
+      X1 = XLT
+      X2 = (XLT+SIDE)
+      Y1 = YBT
+      Y2 = (YBT+SIDE)
+      X3 = IS
+      X4 = IEND
+      Y3 = JS
+      Y4 = JEND
+      IF (AMIN1(XNX,XNY)/AMAX1(XNX,XNY).LT.EXT) GO TO  50
+      IF (XNX-XNY)  30, 50, 40
+   30 X2 = (SIDE*(XNX/XNY) + XLT)
+      GO TO  50
+   40 Y2 = (SIDE*(XNY/XNX) + YBT)
+   50 CONTINUE
+C
+C CENTER THE PLOT
+C
+      DX = 0.25*( 1. - (X2-X1) )
+      DY = 0.25*( 1. - (Y2-Y1) )
+      X1 = (XLT+DX)
+      X2 = (X2+DX )
+      Y1 = (YBT+DY)
+      Y2 = (Y2+DY )
+C
+   55 CONTINUE
+C
+C SAVE NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT ( 1,IERR,WNDW,VWPRT )
+C
+C DEFINE AND SELECT NORMALIZATION TRANS, SET LOG SCALING
+C
+      CALL SET(X1,X2,Y1,Y2,X3,X4,Y3,Y4,ITYPE)
+C
+      IF (NSET.EQ.0) CALL PERIM (1,0,1,0)
+C
+   60 CONTINUE
+C
+C DRAW THE STREAMLINES
+C .   BREAK THE WORK ARRAY INTO TWO PARTS.  SEE DRWSTR FOR FURTHER
+C .   COMMENTS ON THIS.
+C
+      CALL DRWSTR (U,V,WORK(1),WORK(IMAX*JPTSY+1),IMAX,JPTSY)
+C
+C RESET NORMALIATION TRANSFORMATION 1 TO ORIGINAL VALUES
+C
+      IF (NSET .LE. 0) THEN
+        CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -           WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      ENDIF
+      CALL GSELNT (NTORIG)
+C
+      RETURN
+      END
+      SUBROUTINE DRWSTR  (U,V,UX,VY,IMAX,JPTSY)
+C
+      PARAMETER (NCHK=750)
+C
+C THIS ROUTINE DRAWS THE STREAMLINES.
+C .   THE XCHK AND YCHK ARRAYS SERVE AS A CIRCULAR LIST. THEY
+C .   ARE USED TO PREVENT LINES FROM CROSSING ONE ANOTHER.
+C
+C THE WORK ARRAY HAS BEEN BROKEN UP INTO TWO ARRAYS FOR CLARITY.  THE
+C .   TOP HALF OF WORK (CALLED UX) WILL HAVE THE NORMALIZED (AND
+C .   POSSIBLY TRANSFORMED) U COMPONENTS AND WILL BE USED FOR BOOK
+C .   KEEPING.  THE LOWER HALF OF THE WORK ARRAY (CALLED VY) WILL
+C .   CONTAIN THE NORMALIZED (AND POSSIBLY TRANSFORMED) V COMPONENTS.
+C
+      DIMENSION       U(IMAX,JPTSY)         ,V(IMAX,JPTSY)
+     1             ,  UX(IMAX,JPTSY)        ,VY(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+      COMMON /STR04/  XCHK(NCHK) ,YCHK(NCHK) , NUMCHK , UXSML
+C
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS FOR SPATIAL AND VELOCITY TRANSFORMATIONS.
+C .   (IF THE USER WISHES OTHER TRANSFORMATIONS  REPLACE THESE STATEMENT
+C .   FUNCTIONS WITH THE APPROPRIATE NEW ONES, OR , IF THE TRANSFORMA-
+C .   TIONS ARE COMPLICATED DELETE THESE STATEMENT FUNCTIONS
+C .   AND ADD EXTERNAL ROUTINES WITH THE SAME NAMES TO DO THE TRANS-
+C .   FORMING.)
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+      FU(X,Y) = X
+      FV(X,Y) = Y
+C
+C INITIALIZE
+C
+      ISKIP    = I1MACH(5) - 2
+      ISKIP1   = ISKIP + 1
+      UXSML    = R1MACH(1)
+C
+C
+      NUMCHK   = NCHK
+      LCHK = 1
+      ICHK = 1
+      XCHK(1) = 0.
+      YCHK(1) = 0.
+      KFLAG = 0
+      IZERO = 0
+      IONE = 1
+      ITWO = 2
+C
+C
+C COMPUTE THE X AND Y NORMALIZED (AND POSSIBLY TRANSFORMED)
+C .   DISPLACEMENT COMPONENTS (UX AND VY).
+C
+      DO  40 J=JS,JEND
+      DO  30 I=IS,IEND
+      IF (U(I,J).EQ.0. .AND. V(I,J).EQ.0.) GO TO  10
+      UX(I,J) = FU(U(I,J),V(I,J))
+      VY(I,J) = FV(U(I,J),V(I,J))
+      CON = DISPL/SQRT(UX(I,J)*UX(I,J) + VY(I,J)*VY(I,J))
+      UX(I,J) = CON*UX(I,J)
+      VY(I,J) = CON*VY(I,J)
+C
+      IF(UX(I,J) .EQ. 0.) UX(I,J) = CON*FU(UXSML,V(I,J))
+C
+      GO TO  20
+   10 CONTINUE
+C
+C BOOKKEEPING IS DONE IN THE LEAST SIGNIFICANT BITS OF THE UX ARRAY.
+C .   WHEN UX(I,J) IS EXACTLY ZERO THIS CAN PRESENT SOME PROBLEMS.
+C .   TO GET AROUND THIS PROBLEM SET IT TO SOME VERY SMALL NUMBER.
+C
+      UX(I,J) = FU(UXSML,0.)
+      VY(I,J) = 0.
+C
+C MASK OUT THE LEAST SIGNIFICANT TWO BITS AS FLAGS FOR EACH GRID BOX
+C .   A GRID BOX IS ANY REGION SURROUNDED BY FOUR GRID POINTS.
+C .   FLAG 1 INDICATES WHETHER ANY STREAMLINE HAS PREVIOUSLY PASSED
+C .          THROUGH THIS BOX.
+C .   FLAG 2 INDICATES WHETHER ANY DIRECTIONAL ARROW HAS ALREADY
+C .          APPEARED IN THIS BOX.
+C .   JUDICIOUS USE OF THESE FLAGS PREVENTS OVERCROWDING OF
+C .   STREAMLINES AND DIRECTIONAL ARROWS.
+C
+   20 CALL SBYTES( UX(I,J) , IZERO , ISKIP , 2 , 0 , 1 )
+C
+      IF (MOD(I,INITA).NE.0 .OR. MOD(J,INITA).NE.0)
+     1    CALL SBYTES( UX(I,J) , IONE , ISKIP1, 1 , 0 , 1 )
+      IF (MOD(I,INITB).NE.0 .OR. MOD(J,INITB).NE.0)
+     1    CALL SBYTES( UX(I,J) , IONE , ISKIP , 1 , 0 , 1 )
+C
+   30 CONTINUE
+   40 CONTINUE
+C
+   50 CONTINUE
+C
+C START A STREAMLINE. EXPERIENCE HAS SHOWN THAT A PLEASING PICTURE
+C .   WILL BE PRODUCED IF NEW STREAMLINES ARE STARTED ONLY IN GRID
+C .   BOXES THAT PREVIOUSLY HAVE NOT HAD OTHER STREAMLINES PASS THROUGH
+C .   THEM. AS LONG AS A REASONABLY DENSE PATTERN OF AVAILABLE BOXES
+C .   IS INITIALLY PRESCRIBED, THE ORDER OF SCANNING THE GRID PTS. FOR
+C .   AVAILABLE BOXES IS IMMATERIAL
+C
+C FIND AN AVAILABLE BOX FOR STARTING A STREAMLINE
+C
+      IF (KFLAG.NE.0) GO TO  90
+      DO  70 J=JS,JEND1
+      DO  60 I=IS,IEND1
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( IAND( IUX , IONE ) .EQ. IZERO ) GO TO 80
+   60 CONTINUE
+   70 CONTINUE
+C
+C MUST BE NO AVAILABLE BOXES FOR STARTING A STREAMLINE
+C
+      GO TO 190
+   80 CONTINUE
+C
+C INITILIZE PARAMETERS FOR STARTING A STREAMLINE
+C .   TURN THE BOX OFF FOR STARTING A STREAMLINE
+C .   CHECK TO SEE IF THIS BOX HAS MISSING DATA (IMSG.NE.0). IF SO ,
+C .      FIND A NEW STARTING BOX
+C
+      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
+      IF ( IMSG.EQ.0) GO TO 85
+      IF (U(I,J).EQ.UVMSG .OR. U(I,J+1).EQ.UVMSG .OR.
+     1    U(I+1,J).EQ.UVMSG .OR. U(I+1,J+1).EQ.UVMSG) GO TO 50
+C
+   85 ISAV = I
+      JSAV = J
+      KFLAG = 1
+      PLMN1 = +1.
+      GO TO 100
+   90 CONTINUE
+C
+C COME TO HERE TO DRAW IN THE OPPOSITE DIRECTION
+C
+      KFLAG = 0
+      PLMN1 = -1.
+      I = ISAV
+      J = JSAV
+  100 CONTINUE
+C
+C INITIATE THE DRAWING SEQUENCE
+C .   START ALL STREAMLINES IN THE CENTER OF A BOX
+C
+      NBOX = 0
+      ITER = 0
+      IF (KFLAG.NE.0) ICHKB = ICHK+1
+      IF (ICHKB.GT.NUMCHK) ICHKB = 1
+      X = FLOAT(I)+0.5
+      Y = FLOAT(J)+0.5
+      XBASE = X
+      YBASE = Y
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,0)
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( (KFLAG.EQ.0) .OR. (IAND( IUX , ITWO ) .NE. 0 ) ) GO TO 110
+C
+C GRID BOX MUST BE ELIGIBLE FOR A DIRECTIONAL ARROW
+C
+      CALL GNEWPT (UX,VY,IMAX,JPTSY)
+      MFLAG = 1
+      GO TO 160
+C
+  110 CONTINUE
+C
+C PLOT LOOP
+C .   CHECK TO SEE IF THE STREAMLINE HAS ENTERED A NEW GRID BOX
+C
+      IF (I.NE.IFIX(X) .OR. J.NE.IFIX(Y)) GO TO 120
+C
+C MUST BE IN SAME BOX CALCULATE THE DISPLACEMENT COMPONENTS
+C
+      CALL GNEWPT (UX,VY,IMAX,JPTSY)
+C
+C UPDATE THE POSITION AND DRAW THE VECTOR
+C
+      X = X+PLMN1*DELX
+      Y = Y+PLMN1*DELY
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,1)
+      ITER = ITER+1
+C
+C CHECK STREAMLINE PROGRESS EVERY 'ITERP' OR SO ITERATIONS
+C
+      IF (MOD(ITER,ITERP).NE.0) GO TO 115
+      IF (ABS(X-XBASE).LT.DISPC  .AND. ABS(Y-YBASE).LT.DISPC ) GO TO  50
+      XBASE = X
+      YBASE = Y
+      GO TO 110
+  115 CONTINUE
+C
+C SHOULD THE CIRCULAR LISTS BE CHECKED FOR STREAMLINE CROSSOVER
+C
+      IF ( (ITERC.LT.0) .OR. (MOD(ITER,ITERC).NE.0) ) GO TO 110
+C
+C MUST WANT THE CIRCULAR LIST CHECKED
+C
+      GO TO 130
+  120 CONTINUE
+C
+C MUST HAVE ENTERED A NEW GRID BOX  CHECK FOR THE FOLLOWING :
+C .   (1) ARE THE NEW POINTS ON THE GRID
+C .   (2) CHECK FOR MISSING DATA IF MSG  DATA FLAG (IMSG) HAS BEEN SET.
+C .   (3) IS THIS BOX ELIGIBLE FOR A DIRECTIONAL ARROW
+C .   (4) LOCATION OF THIS ENTRY VERSUS OTHER STREAMLINE ENTRIES
+C
+      NBOX = NBOX+1
+C
+C CHECK (1)
+C
+      IF (IFIX(X).LT.IS .OR. IFIX(X).GT.IEND1) GO TO  50
+      IF (IFIX(Y).LT.JS .OR. IFIX(Y).GT.JEND1) GO TO  50
+C
+C CHECK (2)
+C
+      IF ( IMSG.EQ.0) GO TO 125
+      II = IFIX(X)
+      JJ = IFIX(Y)
+      IF (U(II,JJ).EQ.UVMSG .OR. U(II,JJ+1).EQ.UVMSG .OR.
+     1    U(II+1,JJ).EQ.UVMSG .OR. U(II+1,JJ+1).EQ.UVMSG) GO TO 50
+  125 CONTINUE
+C
+C CHECK (3)
+C
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( IAND( IUX , ITWO )  .NE. 0) GO TO 130
+      MFLAG = 2
+      GO TO 160
+  130 CONTINUE
+C
+C CHECK (4)
+C
+      DO 140 LOC=1,LCHK
+      IF (ABS( X-XCHK(LOC) ).GT.CSTOP .OR.
+     1    ABS( Y-YCHK(LOC) ).GT.CSTOP) GO TO 140
+      LFLAG = 1
+      IF (ICHKB.LE.ICHK .AND. LOC.GE.ICHKB .AND. LOC.LE.ICHK) LFLAG = 2
+      IF (ICHKB.GE.ICHK .AND. (LOC.GE.ICHKB .OR. LOC.LE.ICHK)) LFLAG = 2
+      IF (LFLAG.EQ.1) GO TO  50
+  140 CONTINUE
+      LCHK = MIN0(LCHK+1,NUMCHK)
+      ICHK = ICHK+1
+      IF (ICHK.GT.NUMCHK) ICHK = 1
+      XCHK(ICHK) = X
+      YCHK(ICHK) = Y
+      I = IFIX(X)
+      J = IFIX(Y)
+      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
+      IF (NBOX.LT.5) GO TO 150
+      ICHKB = ICHKB+1
+      IF (ICHKB.GT.NUMCHK) ICHKB = 1
+  150 CONTINUE
+      GO TO 110
+C
+  160 CONTINUE
+C
+C THIS SECTION DRAWS A DIRECTIONAL ARROW BASED ON THE MOST RECENT DIS-
+C .   PLACEMENT COMPONENTS ,DELX AND DELY, RETURNED BY GNEWPT. IN EARLIE
+C .   VERSIONS THIS WAS A SEPARATE SUBROUTINE (CALLED DRWDAR). IN THAT
+C .   CASE ,HOWEVER, FX AND FY WERE DEFINED EXTERNAL SINCE THESE
+C .   FUNCTIONS WERE USED BY BOTH DRWSTR AND DRWDAR. IN ORDER TO
+C .   MAKE ALL DEFAULT TRANSFORMATIONS STATEMENT FUNCTIONS I HAVE
+C .   PUT DRWDAR  HERE AND I WILL USE MFLAG TO RETURN  TO THE CORRECT
+C .   LOCATION IN THE CODE.
+C
+      IF ( (DELX.EQ.0.) .AND. (DELY.EQ.0.) ) GO TO 50
+C
+      CALL SBYTES( UX(I,J) ,IONE , ISKIP , 1 ,0 , 1 )
+      D = ATAN2(-DELX,DELY)
+      D30 = D+0.5
+  170 YY = -AROWL*COS(D30)+Y
+      XX = +AROWL*SIN(D30)+X
+      CALL FL2INT (FX(XX,YY),FY(XX,YY),IFXX,IFYY)
+      CALL PLOTIT (IFXX,IFYY,1)
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,0)
+      IF (D30.LT.D) GO TO 180
+      D30 = D-0.5
+      GO TO 170
+  180 IF (MFLAG.EQ.1) GO TO 110
+      IF (MFLAG.EQ.2) GO TO 130
+C
+  190 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE GNEWPT (UX,VY,IMAX,JPTSY)
+C
+C INTERPOLATION ROUTINE TO CALCULATE THE DISPLACEMANT COMPONENTS
+C .   THE PHILOSPHY HERE IS TO UTILIZE AS MANY POINTS AS POSSIBLE
+C .   (WITHIN REASON) IN ORDER TO OBTAIN A PLEASING AND ACCURATE PLOT.
+C .   INTERPOLATION SCHEMES DESIRED BY OTHER USERS MAY EASILY BE
+C .   SUBSTITUTED IF DESIRED.
+C
+      DIMENSION       UX(IMAX,JPTSY)        ,VY(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+C
+      SAVE
+C
+C FDLI - DOUBLE LINEAR INTERPOLATION FORMULA
+C FBESL - BESSEL 16 PT INTERPOLATION FORMULA ( MOST USED FORMULA )
+C FQUAD - QUADRATIC INTERPOLATION FORMULA
+C
+      FDLI(Z,Z1,Z2,Z3,DX,DY) = (1.-DX)*((1.-DY)*Z +DY*Z1)
+     1                         +     DX *((1.-DY)*Z2+DY*Z3)
+      FBESL(Z,ZP1,ZP2,ZM1,DZ)=Z+DZ*(ZP1-Z+0.25*(DZ-1.)*((ZP2-ZP1-Z+ZM1)
+     1                        +0.666667*(DZ-0.5)*(ZP2-3.*ZP1+3.*Z-ZM1)))
+      FQUAD(Z,ZP1,ZM1,DZ)=Z+0.5*DZ*(ZP1-ZM1+DZ*(ZP1-2.*Z+ZM1))
+C
+      DX = X-AINT(X)
+      DY = Y-AINT(Y)
+C
+      IF( IMSG.NE.0.OR.IGFLG.NE.0) GO TO 20
+C
+      IM1 = I-1
+      IP2 = I+2
+C
+C DETERMINE WHICH INTERPOLATION FORMULA TO USE DEPENDING ON I,J LOCATION
+C .   THE FIRST CHECK IS FOR I,J IN THE GRID INTERIOR.
+C
+      IF (J.GT.JS .AND. J.LT.JEND1 .AND. I.GT.IS .AND. I.LT.IEND1)
+     1    GO TO 30
+      IF (J.EQ.JEND1 .AND. I.GT.IS .AND. I.LT.IEND1) GO TO  40
+      IF (J.EQ.JS) GO TO 20
+C
+      IF (ICYC1.EQ.1) GO TO 10
+C
+C MUST NOT BE CYCLIC
+C
+      IF (I.EQ.IS) GO TO 20
+      IF (I.EQ.IEND1) GO TO  50
+      GO TO 20
+   10 CONTINUE
+C
+C MUST BE CYCLIC IN THE X DIRECTION
+C
+      IF (I.EQ.IS .AND. J.LT.JEND1) GO TO 12
+      IF (I.EQ.IEND1 .AND. J.LT.JEND1) GO TO 14
+      IF (J.EQ.JEND1 .AND. I.EQ.IS) GO TO 16
+      IF (J.EQ.JEND1 .AND. I.EQ.IEND1) GO TO 18
+      GO TO 20
+   12 IM1 = IEND1
+      GO TO 30
+   14 IP2 = IS+1
+      GO TO 30
+   16 IM1 = IEND1
+      GO TO 40
+   18 IP2 = IS+1
+      GO TO 40
+C
+   20 CONTINUE
+C
+C DOUBLE LINEAR INTERPOLATION FORMULA. THIS SCHEME WORKS AT ALL POINTS
+C .   BUT THE RESULTING STREAMLINES ARE NOT AS PLEASING AS THOSE DRAWN
+C .   BY FBESL OR FQUAD. CURRENTLY THIS IS USED AT THIS IS UTILIZED
+C .   ONLY AT CERTAIN BOUNDARY POINTS OR IF IGFLG IS NOT EQUAL TO ZERO.
+C
+      DELX = FDLI (UX(I,J),UX(I,J+1),UX(I+1,J),UX(I+1,J+1),DX,DY)
+      DELY = FDLI (VY(I,J),VY(I,J+1),VY(I+1,J),VY(I+1,J+1),DX,DY)
+      RETURN
+   30 CONTINUE
+C
+C USE A 16 POINT BESSEL INTERPOLATION SCHEME
+C
+      UJM1 = FBESL (UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
+      UJ   = FBESL (UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
+      UJP1 = FBESL (UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
+      UJP2 = FBESL (UX(I,J+2),UX(I+1,J+2),UX(IP2,J+2),UX(IM1,J+2),DX)
+      DELX = FBESL (UJ,UJP1,UJP2,UJM1,DY)
+      VJM1 = FBESL (VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
+      VJ   = FBESL (VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
+      VJP1 = FBESL (VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
+      VJP2 = FBESL (VY(I,J+2),VY(I+1,J+2),VY(IP2,J+2),VY(IM1,J+2),DX)
+      DELY = FBESL (VJ,VJP1,VJP2,VJM1,DY)
+      RETURN
+   40 CONTINUE
+C
+C 12 POINT INTERPOLATION SCHEME APPLICABLE TO ONE ROW FROM TOP BOUNDARY
+C
+      UJM1 = FBESL (UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
+      UJ   = FBESL (UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
+      UJP1 = FBESL (UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
+      DELX = FQUAD (UJ,UJP1,UJM1,DY)
+      VJM1 = FBESL (VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
+      VJ   = FBESL (VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
+      VJP1 = FBESL (VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
+      DELY = FQUAD (VJ,VJP1,VJM1,DY)
+      RETURN
+   50 CONTINUE
+C
+C 9 POINT INTERPOLATION SCHEME FOR USE IN THE NON-CYCLIC CASE
+C .   AT I=IEND1 ; JS.LT.J AND J.LE.JEND1
+C
+      UJP1 = FQUAD (UX(I,J+1),UX(I+1,J+1),UX(IM1,J+1),DX)
+      UJ   = FQUAD (UX(I,J),UX(I+1,J),UX(IM1,J),DX)
+      UJM1 = FQUAD (UX(I,J-1),UX(I+1,J-1),UX(IM1,J-1),DX)
+      DELX = FQUAD (UJ,UJP1,UJM1,DY)
+      VJP1 = FQUAD (VY(I,J+1),VY(I+1,J+1),VY(IM1,J+1),DX)
+      VJ   = FQUAD (VY(I,J),VY(I+1,J),VY(IM1,J),DX)
+      VJM1 = FQUAD (VY(I,J-1),VY(I+1,J-1),VY(IM1,J-1),DX)
+      DELY = FQUAD (VJ,VJP1,VJM1,DY)
+      RETURN
+      END
+      SUBROUTINE EZSTRM(U,V,WORK,IMAX,JMAX)
+C
+      DIMENSION       U(IMAX,JMAX)       ,V(IMAX,JMAX)     ,WORK(1)
+C
+        SAVE
+C
+C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ( 'GRAPHX', 'STRMLN', 'EZSTRM', 'VERSION 01')
+C
+      CALL STRMLN(U,V,WORK,IMAX,IMAX,JMAX,0,IER)
+      RETURN
+      END
+      SUBROUTINE CHKCYC  (U,V,IMAX,JPTSY,IER)
+C
+C CHECK FOR CYCLIC CONDITION
+C
+      DIMENSION       U(IMAX,JPTSY)          ,V(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+C
+        SAVE
+      DO  10 J=JS,JEND
+      IF (U(IS,J).NE.U(IEND,J)) GO TO  20
+      IF (V(IS,J).NE.V(IEND,J)) GO TO  20
+   10 CONTINUE
+C
+C MUST BE CYCLIC
+C
+      RETURN
+   20 CONTINUE
+C
+C MUST NOT BE CYCLIC
+C . CHANGE THE PARAMETER AND SET IER = -1
+C
+      ICYC1 = 0
+      IER = -1
+      RETURN
+C
+C------------------------------------------------------------------
+C REVISION HISTORY
+C
+C OCTOBER 1979      FIRST ADDED TO ULIB
+C
+C OCTOBER 1980      ADDED BUGS SECTION
+C
+C JUNE    1984      REMOVED STATEMENT FUNCTIONS ANDF AND ORF,
+C                   CONVERTED TO FORTRAN77 AND GKS.
+C-------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/sysint/README b/sys/gio/ncarutil/sysint/README
new file mode 100644
index 00000000..38d7b6f8
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/README
@@ -0,0 +1,2 @@
+SYSINT - This directory contains the System Interface Routines needed
+for implementing the GKS based NCAR plotting utilities.
diff --git a/sys/gio/ncarutil/sysint/fencode.x b/sys/gio/ncarutil/sysint/fencode.x
new file mode 100644
index 00000000..1e2e37d5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/fencode.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_FORMAT	11
+
+# FENCD -- Format a real variable and return as a spp character string.
+# A packed format string is passed as an input argument to define how the
+# number is to be encoded.  The format of the format string is:
+#	format string = "(cW.D)"
+# where c is one of [EFGI], and where W and D are the field width and
+# number of decimal places or precision, respectively.
+
+procedure fencd (nchars, f_format, spp_outstr, rval)
+
+int	nchars			# desired number of output chars
+char	f_format[SZ_FORMAT] 	# SPP string containing format
+char	spp_outstr[nchars+1]    # SPP string containing encoded number
+real	rval			# value to be encoded
+
+char	fmtchar, outstr[MAX_DIGITS], spp_format[SZ_FORMAT+1]
+int	ip, op, stridxs()
+real	x
+
+begin
+	# Encode format string for SPRINTF, format "%w.d".  Start copying
+	# Fortran format at char 3, which should follow the EFGI char.
+
+	spp_format[1] = '%'
+	op = 2
+
+	if (f_format[1] != '(')
+	    call fatal (1, "Missing lparen in Ncar ENCODE format")
+	for (ip=3;  f_format[ip] != ')' && f_format[ip] != EOS;  ip=ip+1) {
+	    spp_format[op] = f_format[ip]
+	    op = op + 1
+	}
+
+	# Now add the SPP format character.  EFG are the same for sprintf as
+	# as for Fortran.  The integer format is 'd' for decimal in SPP.
+
+	fmtchar = f_format[2]
+	if (IS_UPPER(fmtchar))
+	    fmtchar = TO_LOWER (fmtchar)
+	    
+	switch (fmtchar) {
+	case 'e', 'f', 'g':
+	    spp_format[op] = fmtchar
+	case 'i':
+	    spp_format[op] = 'd'
+	default:
+	    call fatal (1, "Unknown Ncar ENCODE format code")
+	}
+	op = op + 1
+	spp_format[op] = EOS
+	x = rval
+	if (rval > 0)
+	    x = -x
+
+	# Now encode the user supplied variable and return it as a spp
+	# string.
+
+	iferr {
+	    call sprintf (outstr, MAX_DIGITS, spp_format)
+		call pargr (x)
+	} then
+	    call erract (EA_FATAL)
+
+	# Let's try adding a "+" prefix to positive numbers to set if that
+	# makes nicer plots.  Sep86 - This was not a good idea - changed to
+	# a blank.
+
+	op = stridxs ("-", outstr)
+	if (rval > 0 && op > 0) 
+	    outstr[op] = ' '
+
+	call strcpy (outstr, spp_outstr, SZ_LINE)
+end
diff --git a/sys/gio/ncarutil/sysint/fulib.x b/sys/gio/ncarutil/sysint/fulib.x
new file mode 100644
index 00000000..1951f26c
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/fulib.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# FULIB -- Print an error message processed by fortran routine uliber.
+
+procedure fulib (errcode, upkmsg, msglen)
+
+int	errcode
+char	upkmsg[ARB]		# unpacked string
+int	msglen			# number of chars in string
+
+pointer	sp, sppmsg
+
+begin
+	call smark (sp)
+	call salloc (sppmsg,  SZ_LINE, TY_CHAR)
+
+	# Construct error message string
+	call sprintf (Memc[sppmsg], SZ_LINE, "ERROR %d IN %s\n")
+	    call pargi (errcode)
+	    call pargstr (upkmsg)
+
+	# Call error with the constructed message
+	iferr (call error (errcode, Memc[sppmsg]))
+	    call erract (EA_WARN)
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/ncarutil/sysint/gbytes.x b/sys/gio/ncarutil/sysint/gbytes.x
new file mode 100644
index 00000000..b129ffbc
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/gbytes.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GBYTES -- Locally implemented bit unpacker for the NCAR extended metacode
+# translator.   3 may 84 cliff stoll
+# Required for the ncar/gks vdi metacode generator.
+#
+# Essentially this routine accepts an array which is a packed series of bits. 
+# [array BUFIN], and unpacks them into an array [array BUFOUT].  Received
+# integer INDEX is the beginning bit in BUFIN  where information is to be 
+# placed.  INDEX is zero indexed.  Received integer argument SIZE is the 
+# number of bits in each "information packet".  Received argument SKIP is the 
+# number of bits to skip between bit packets.  For more info, see page 4 of 
+# the NCAR "Implementaton details for the new metafile translator, version 1.0"
+
+procedure gbytes (bufin, bufout, index, size, skip, count)
+
+int	bufout[ARB], bufin[ARB], index, size, skip, count
+int	pack
+int	offset
+int	bitupk()	# Iraf function to unpack bits
+
+begin
+	for (pack = 1; pack <= count ; pack = pack+1) {
+	    # Offset is a bit offset into the input buffer bufin.
+	    # (offset is 1- indexed; INDEX is zero indexed)
+
+	    offset = (size + skip) * (pack - 1) + index + 1
+	    bufout(pack) = bitupk(bufin, offset, size)
+	}
+end
diff --git a/sys/gio/ncarutil/sysint/ishift.x b/sys/gio/ncarutil/sysint/ishift.x
new file mode 100644
index 00000000..580996c0
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/ishift.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ISHIFT -- integer shift.  To be used for calls to ISHIFT in NCAR routines.
+
+int procedure ishift (in_word, n)
+
+int	in_word, n
+int	new_word, bit, index, i
+int	bitupk()
+
+begin
+	if (n > NBITS_INT)
+	    call error (0, "n > NBITS_INT in ishift")
+	if (n < 0)
+	    # Right end-off shift
+	    new_word = bitupk (in_word, abs(n) + 1, NBITS_INT - abs(n))
+	else {
+	    # Left circular shift (rotate)
+	    do i = 1, NBITS_INT {
+		index = n + i
+		if (index > NBITS_INT)
+		    index = mod ((n + i), NBITS_INT)
+		bit = bitupk (in_word, i, 1)
+		call bitpak (bit, new_word, index, 1)
+	    }
+	}
+
+	return (new_word)
+end
+
+
+# IAND -- AND two integers.
+
+int procedure iand (a, b)
+
+int	a, b
+int	and()
+
+begin
+	return (and (a, b))
+end
+
+
+# IOR -- OR two integers.  
+
+int procedure ior (a, b)
+
+int	a, b
+int	or()
+
+begin
+	return (or (a, b))
+end
diff --git a/sys/gio/ncarutil/sysint/mkpkg b/sys/gio/ncarutil/sysint/mkpkg
new file mode 100644
index 00000000..f3ba6fb5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/mkpkg
@@ -0,0 +1,16 @@
+# Make the system interface for libncar.a.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	support.f
+	fencode.x	<mach.h> <error.h> <ctype.h>
+	fulib.x		<error.h>
+	ishift.x	<mach.h>
+	gbytes.x
+	sbytes.x	<mach.h>
+	spps.f
+	;
diff --git a/sys/gio/ncarutil/sysint/sbytes.x b/sys/gio/ncarutil/sysint/sbytes.x
new file mode 100644
index 00000000..4d4094c3
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/sbytes.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# SBYTES -- Locally implemented bit packer for the NCAR extended metacode
+# translator.   3 may 84 cliff stoll
+# Required for the ncar/gks vdi metacode generator.
+#
+# Essentially this routine accepts an array of "information packets"
+# [array BUFIN], and packs them into a packed array [array BUFOUT]
+# received integer argument INDEX points to the beginning bit in BUFOUT
+# where information is to be placed.  INDEX is zero indexed.
+# received integer argument SIZE is the number of bits in each "information
+# packet.  received argument SKIP is the number of bits to skip between
+# bit packets.  For more info, see page 6 of the NCAR "Implementaton
+# details for the new metafile translator, version 1.0"  
+# bufin is stuffed into bufout
+
+procedure sbytes (bufout, bufin, index, size, skip, count)
+
+int	bufout[ARB], bufin[ARB], index, size, skip, count
+int	metacode_word_length
+int	pack
+int	offset
+
+data	metacode_word_length / 16 /
+
+begin
+	if (metacode_word_length != NBITS_SHORT) 
+	    call error ( 0, " bad metacode word length in SBYTES")
+
+	for (pack = 1; pack <= count; pack = pack + 1) {
+	    # Offset is a bit offset into the output buffer bufout.
+	    # (offset is 1- indexed; INDEX is zero indexed)
+	    # see page 58 of IRAF system interface book
+
+	    offset =  (size + skip) * (pack - 1) + index + 1
+	    call bitpak (bufin[pack], bufout, offset, size)
+	}
+end
diff --git a/sys/gio/ncarutil/sysint/spps.f b/sys/gio/ncarutil/sysint/spps.f
new file mode 100644
index 00000000..4a394d9e
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/spps.f
@@ -0,0 +1,1797 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+      FUNCTION CFUX (RX)
+C
+C Given an x coordinate RX in the fractional system, CFUX(RX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CFUX=WD(I)+(RX-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I))
+      IF (LL.GE.3) CFUX=10.**CFUX
+      RETURN
+      END
+      FUNCTION CFUY (RY)
+C
+C Given a y coordinate RY in the fractional system, CFUY(RY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CFUY=WD(I)+(RY-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CFUY=10.**CFUY
+      RETURN
+      END
+      FUNCTION CMFX (IX)
+C
+C Given an x coordinate IX in the metacode system, CMFX(IX) is an x
+C coordinate in the fractional system.
+C
+      CMFX=FLOAT(IX)/32767.
+      RETURN
+      END
+      FUNCTION CMFY (IY)
+C
+C Given a y coordinate IY in the metacode system, CMFY(IY) is a y
+C coordinate in the fractional system.
+C
+      CMFY=FLOAT(IY)/32767.
+      RETURN
+      END
+      FUNCTION CMUX (IX)
+C
+C Given an x coordinate IX in the metacode system, CMUX(IX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CMUX=WD(I)+(FLOAT(IX)/32767.-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I))
+      IF (LL.GE.3) CMUX=10.**CMUX
+      RETURN
+      END
+      FUNCTION CMUY (IY)
+C
+C Given a y coordinate IY in the metacode system, CMUY(IY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CMUY=WD(I)+(FLOAT(IY)/32767.-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CMUY=10.**CMUY
+      RETURN
+      END
+      FUNCTION CPFX (IX)
+C
+C Given an x coordinate IX in the plotter system, CPFX(IX) is an x
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      CPFX=FLOAT(IX-1)/(2.**MX-1.)
+      RETURN
+      END
+      FUNCTION CPFY (IY)
+C
+C Given a y coordinate IY in the plotter system, CPFY(IY) is a y
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      CPFY=FLOAT(IY-1)/(2.**MY-1.)
+      RETURN
+      END
+      FUNCTION CPUX (IX)
+C
+C Given an x coordinate IX in the plotter system, CPUX(IX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CPUX=WD(I)+(FLOAT(IX-1)/(2.**MX-1.)-VP(1))/(VP(2)-VP(1))*
+     +           (WD(3-I)-WD(I))
+      IF (LL.GE.3) CPUX=10.**CPUX
+      RETURN
+      END
+      FUNCTION CPUY (IY)
+C
+C Given a y coordinate IY in the plotter system, CPUY(IY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CPUY=WD(I)+(FLOAT(IY-1)/(2.**MY-1.)-VP(3))/(VP(4)-VP(3))*
+     +     (WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CPUY=10.**CPUY
+      RETURN
+      END
+      FUNCTION CUFX (RX)
+C
+C Given an x coordinate RX in the user system, CUFX(RX) is an x
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        CUFX=(RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1)
+      ELSE
+        CUFX=(ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1)
+      ENDIF
+      RETURN
+      END
+      FUNCTION CUFY (RY)
+C
+C Given a y coordinate RY in the user system, CUFY(RY) is a y
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        CUFY=(RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3)
+      ELSE
+        CUFY=(ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KFMX (RX)
+C
+C Given an x coordinate RX in the fractional system, KFMX(RX) is an x
+C coordinate in the metacode system.
+C
+      KFMX=IFIX(RX*32767.)
+      RETURN
+      END
+      FUNCTION KFMY (RY)
+C
+C Given a y coordinate RY in the fractional system, KFMY(RY) is a y
+C coordinate in the metacode system.
+C
+      KFMY=IFIX(RY*32767.)
+      RETURN
+      END
+      FUNCTION KFPX (RX)
+C
+C Given an x coordinate RX in the fractional system, KFPX(RX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KFPX=1+IFIX(RX*(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KFPY (RY)
+C
+C Given a y coordinate RY in the fractional system, KFPY(RY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KFPY=1+IFIX(RY*(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KMPX (IX)
+C
+C Given an x coordinate IX in the metacode system, KMPX(IX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KMPX=1+IFIX((2.**MX-1.)*FLOAT(IX)/32767.)
+      RETURN
+      END
+      FUNCTION KMPY (IY)
+C
+C Given a y coordinate IY in the metacode system, KMPY(IY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KMPY=1+IFIX((2.**MY-1.)*FLOAT(IY)/32767.)
+      RETURN
+      END
+      FUNCTION KPMX (IX)
+C
+C Given an x coordinate IX in the plotter system, KPMX(IX) is an x
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KPMX=IFIX(32767.*FLOAT(IX-1)/(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KPMY (IY)
+C
+C Given a y coordinate IY in the plotter system, KPMY(IY) is a y
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KPMY=IFIX(32767.*FLOAT(IY-1)/(2.**MY-1.))
+      RETURN
+      END
+      FUNCTION KUMX (RX)
+C
+C Given an x coordinate RX in the user system, KUMX(RX) is an x
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        KUMX=IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*
+     +              32767.)
+      ELSE
+        KUMX=IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+
+     +              VP(1))*32767.)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUMY (RY)
+C
+C Given a y coordinate RY in the user system, KUMY(RY) is a y
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        KUMY=IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*
+     +              32767.)
+      ELSE
+        KUMY=IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+
+     +              VP(3))*32767.)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUPX (RX)
+C
+C Given an x coordinate RX in the user system, KUPX(RX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        KUPX=1+IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*
+     +              (2.**MX-1.))
+      ELSE
+        KUPX=1+IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+
+     +              VP(1))*(2.**MX-1.))
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUPY (RY)
+C
+C Given a y coordinate RY in the user system, KUPY(RY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        KUPY=1+IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*
+     +              (2.**MY-1.))
+      ELSE
+        KUPY=1+IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+
+     +              VP(3))*(2.**MY-1.))
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE CLSGKS
+C
+C IU(6), in IUTLCM, is the current metacode unit number.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C Deactivate the metacode workstation, close the workstation, and
+C close GKS.
+C
+      CALL GDAWK (IU(6))
+      CALL GCLWK (IU(6))
+      CALL GCLKS
+C
+      RETURN
+C
+      END
+      SUBROUTINE CURVE (PX,PY,NP)
+C
+      DIMENSION PX(NP),PY(NP)
+C
+C CURVE draws the curve defined by the points (PX(I),PY(I)), for I = 1
+C to NP.  All coordinates are stated in the user coordinate system.
+C
+C Define arrays to hold converted point coordinates when it becomes
+C necessary to draw the curve piecewise.
+C
+      DIMENSION QX(10),QY(10)
+C
+C If NP is less than or equal to zero, there's nothing to do.
+C
+      IF (NP.LE.0) RETURN
+C
+C If NP is exactly equal to 1, just draw a point.
+C
+      IF (NP.EQ.1) THEN
+        CALL POINT (PX(1),PY(1))
+C
+C Otherwise, draw the curve.
+C
+      ELSE
+C
+C Flush the pen-move buffer.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Save the current SET parameters.
+C
+        CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+C If the mapping defined by the last SET call was non-reversed and
+C linear in both x and y, a single polyline will suffice.
+C
+        IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1) THEN
+          CALL GPL (NP,PX,PY)
+C
+C Otherwise, piece the line together out of smaller chunks, converting
+C the coordinates for each chunk as directed by the last SET call.
+C
+        ELSE
+          DO 102 IP=1,NP,9
+            NQ=MIN0(10,NP-IP+1)
+            IF (NQ.GE.2) THEN
+              DO 101 IQ=1,NQ
+                QX(IQ)=CUFX(PX(IP+IQ-1))
+                QY(IQ)=CUFY(PY(IP+IQ-1))
+  101         CONTINUE
+              CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1)
+              CALL GPL (NQ,QX,QY)
+              CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+            END IF
+  102     CONTINUE
+        END IF
+C
+C Update the pen position.
+C
+        CALL FRSTPT (PX(NP),PY(NP))
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FL2INT (PX,PY,IX,IY)
+C
+C Given the user coordinates PX and PY of a point, FL2INT returns the
+C metacode coordinates IX and IY of that point.
+C
+C Declare the common block containing the user state variables LL, MI,
+C MX, and MY.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Declare arrays in which to retrieve the variables defining the current
+C window and viewport.
+C
+      DIMENSION WD(4),VP(4)
+C
+C Get the variables defining the current window and viewport.
+C
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+C
+C Compute IX.
+C
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        IX=IFIX(((PX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*32767.)
+      ELSE
+        IX=IFIX(((ALOG10(PX)-WD(I))/(WD(3-I)-WD(I))*
+     +                              (VP(2)-VP(1))+VP(1))*32767.)
+      ENDIF
+C
+C Compute IY.
+C
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        IY=IFIX(((PY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*32767.)
+      ELSE
+        IY=IFIX(((ALOG10(PY)-WD(I))/(WD(7-I)-WD(I))*
+     +                              (VP(4)-VP(3))+VP(3))*32767.)
+      ENDIF
+C
+C Done.
+C
+      RETURN
+C
+      END
+C
+C +NOAO - name conflict
+C
+C     SUBROUTINE FLUSH
+      subroutine mcflsh
+C
+C - NOAO
+C
+C FLUSH currently does nothing except flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FRAME
+C
+C FRAME is intended to advance to a new frame.  The GKS version clears
+C all open workstations.
+C
+C First, flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C +NOAO - Initialize utilbd 'first' flag for next plot
+      call initut
+C 
+C - NOAO
+C Get the number of open workstations.  If there are none, we're done.
+C
+      CALL GQOPWK (0,IE,NO,ID)
+      IF (NO.EQ.0) RETURN
+C
+C Otherwise, clear the open workstations.
+C
+      DO 101 I=1,NO
+        CALL GQOPWK (I,IE,NO,ID)
+        CALL GCLRWK (ID,1)
+  101 CONTINUE
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FRSTPT (PX,PY)
+C
+C Given the user coordinates PX and PY of a point, FRSTPT generates a
+C pen-up move to that point.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),0)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETSET (VL,VR,VB,VT,WL,WR,WB,WT,LF)
+C
+C GETSET returns to its caller the current values of the parameters
+C defining the mapping from the user system to the fractional system
+C (in GKS terminology, the mapping from world coordinates to normalized
+C device coordinates).
+C
+C VL, VR, VB, and VT define the viewport (in the fractional system), WL,
+C WR, WB, and WT the window (in the user system), and LF the nature of
+C the mapping, according to the following table:
+C
+C    1  -  x linear, y linear
+C    2  -  x linear, y logarithmic
+C    3  -  x logarithmic, y linear
+C    4  -  x logarithmic, y logarithmic
+C
+C Declare the common block containing the linear-log and mirror-imaging
+C flags.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Define variables to receive the GKS viewport and window.
+C
+      DIMENSION VP(4),WD(4)
+C
+C Retrieve the number of the current GKS normalization transformation.
+C
+      CALL GQCNTN (IE,NT)
+C
+C Retrieve the definition of that normalization transformation.
+C
+      CALL GQNT (NT,IE,WD,VP)
+C
+C Pass the viewport definition to the caller.
+C
+      VL=VP(1)
+      VR=VP(2)
+      VB=VP(3)
+      VT=VP(4)
+C
+C Pass the linear/log flag and a (possibly modified) window definition
+C to the caller.
+C
+      LF=LL
+C
+      IF (LL.EQ.1.OR.LL.EQ.2) THEN
+        WL=WD(1)
+        WR=WD(2)
+      ELSE
+        WL=10.**WD(1)
+        WR=10.**WD(2)
+      END IF
+C
+      IF (MI.GE.3) THEN
+        WW=WL
+        WL=WR
+        WR=WW
+      END IF
+C
+      IF (LL.EQ.1.OR.LL.EQ.3) THEN
+        WB=WD(3)
+        WT=WD(4)
+      ELSE
+        WB=10.**WD(3)
+        WT=10.**WD(4)
+      END IF
+C
+      IF (MI.EQ.2.OR.MI.GE.4) THEN
+        WW=WB
+        WB=WT
+        WT=WW
+      END IF
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETSI (IX,IY)
+C
+C Return to the user the parameters which determine the assumed size of
+C the target plotter and therefore determine how user coordinates are
+C to be mapped into plotter coordinates.
+C
+C Declare the common block containing the scaling information.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Set the user variables.
+
+      IX=MX
+      IY=MY
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETUSV (VN,IV)
+      CHARACTER*(*) VN
+C
+C This subroutine retrieves the current values of the utility state
+C variables.  VN is the character name of the variable and IV is
+C its value.
+C
+C The labelled common block IUTLCM contains all of the utility state
+C variables.
+C
+      COMMON /IUTLCM/IU(100)
+C
+C Check for the linear-log scaling variable.
+C
+      IF (VN(1:2).EQ.'LS') THEN
+        IV=IU(1)
+C
+C Check for the variable specifying the mirror-imaging of the axes.
+C
+      ELSE IF (VN(1:2).EQ.'MI') THEN
+        IV=IU(2)
+C
+C Check for the variable specifying the resolution of the plotter in x.
+C
+      ELSE IF (VN(1:2).EQ.'XF') THEN
+        IV=IU(3)
+C
+C Check for the variable specifying the resolution of the plotter in x.
+C
+      ELSE IF (VN(1:2).EQ.'YF') THEN
+        IV=IU(4)
+C
+C Check for the variable specifying the size of the pen-move buffer.
+C
+      ELSE IF (VN(1:2).EQ.'PB') THEN
+        IV=IU(5)
+C
+C Check for the variable specifying the metacode unit.
+C
+      ELSE IF (VN(1:2).EQ.'MU') THEN
+        IV=IU(6)
+C
+C Check for one of the variables specifying color and intensity.
+C
+      ELSE IF (VN(1:2).EQ.'IR') THEN
+        IV=IU(7)
+C
+      ELSE IF (VN(1:2).EQ.'IG') THEN
+        IV=IU(8)
+C
+      ELSE IF (VN(1:2).EQ.'IB') THEN
+        IV=IU(9)
+C
+      ELSE IF (VN(1:2).EQ.'IN') THEN
+        IV=IU(10)
+C
+C Check for the variable specifying the current color index.
+C
+      ELSE IF (VN(1:2).EQ.'II') THEN
+        IV=IU(11)
+C
+C Check for the variable specifying the maximum color index.
+C
+      ELSE IF (VN(1:2).EQ.'IM') THEN
+        IV=IU(12)
+C
+C Check for the variable specifying the line width scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'LW') THEN
+        IV=IU(13)
+C
+C Check for the variable specifying the marker size scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'MS') THEN
+        IV=IU(14)
+C
+C Otherwise, the variable name is unknown.
+C
+      ELSE
+        CALL SETER ('GETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2)
+C
+      ENDIF
+C
+      RETURN
+C
+      END
+      SUBROUTINE LINE (X1,Y1,X2,Y2)
+C
+C Draw a line connecting the point (X1,Y1) to the point (X2,Y2), in the
+C user coordinate system.
+C
+      CALL PLOTIF (CUFX(X1),CUFY(Y1),0)
+      CALL PLOTIF (CUFX(X2),CUFY(Y2),1)
+      RETURN
+      END
+      SUBROUTINE MXMY (IX,IY)
+C
+C Return to the user the coordinates of the current pen position, in the
+C plotter coordinate system.
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Declare the common block containing the user state variables LL, MI,
+C MX, and MY.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Return to the user the plotter-system equivalents of the values in
+C the metacode system.
+C
+      IX=1+IFIX((2.**MX-1.)*FLOAT(JX)/32767.)
+      IY=1+IFIX((2.**MY-1.)*FLOAT(JY)/32767.)
+C
+C Done.
+C
+      RETURN
+C
+      END
+C
+C + NOAO - Following subroutine 
+C     SUBROUTINE OPNGKS
+C
+C IU(6), in IUTLCM, is the current metacode unit number.
+C
+C     COMMON /IUTLCM/ IU(100)
+C
+C Force all required BLOCKDATA's to load.
+C
+C     EXTERNAL GKSBD,G01BKD,UERRBD,UTILBD
+C
+C GKS buffer size (a dummy for NCAR GKS.)
+C
+C     DATA ISZ /0/
+C
+C Open GKS, define a workstation, and activate the workstation.
+C
+C     CALL GOPKS (6,ISZ)
+C     CALL GOPWK (IU(6),2,1)
+C     CALL GACWK (IU(6))
+C
+C     RETURN
+C
+C + NOAO
+C
+C     END
+      SUBROUTINE PLOTIF (FX,FY,IP)
+C
+C Move the pen to the point (FX,FY), in the fractional cooordinate
+C system.  If IP is zero, do a pen-up move.  If IP is one, do a pen-down
+C move.  If IP is two, flush the buffer.
+C
+C The variable IU(5), in the labelled common block IUTLCM, specifies
+C the size of the pen-move buffer (between 2 and 50).
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables implementing the buffering
+C of pen moves.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system, for MXMY.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Force loading of the block data routine which initializes the contents
+C of the common blocks.
+C
+C     EXTERNAL UTILBD
+C
+C VP and WD hold viewport and window parameters obtained, when needed,
+C from GKS.
+C
+      DIMENSION VP(4),WD(4)
+C
+C + NOAO - block data utilbd has been rewritten as a run time initialization
+C
+      call utilbd
+C
+C - NOAO
+C Check for out-of-range values of the pen parameter.
+C
+      IF (IP.LT.0.OR.IP.GT.2) THEN
+        CALL SETER ('PLOTIF - ILLEGAL VALUE FOR IPEN',1,2)
+      END IF
+C
+C If a buffer flush is requested, jump.
+C
+      IF (IP.EQ.2) GO TO 101
+C
+C Limit the given coordinates to the legal fractional range.
+C
+      GX=AMAX1(0.,AMIN1(1.,FX))
+      GY=AMAX1(0.,AMIN1(1.,FY))
+C
+C Set JX and JY for a possible call to MXMY.
+C
+      JX=KFMX(GX)
+      JY=KFMY(GY)
+C
+C If the current move is a pen-down move, or if the last one was, bump
+C the pointer into the coordinate arrays and, if the current move is
+C a pen-up move, make a new entry in the array IF, which records the
+C positions of the pen-up moves.  Note that we never get two pen-up
+C moves in a row, which means that IF need be dimensioned only half as
+C large as QX and QY.
+C
+      IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN
+        NQ=NQ+1
+        IF (IP.EQ.0) THEN
+          NF=NF+1
+          IF(NF)=NQ
+        END IF
+      END IF
+C
+C Save the coordinates of the point, in the fractional coordinate
+C system.
+C
+      QX(NQ)=GX
+      QY(NQ)=GY
+C
+C If the point-coordinate buffer is full, dump the buffers; otherwise,
+C return.
+C
+      IF (NQ.LT.IU(5)) RETURN
+C
+C Dump the buffers.  If NQ is one, there's nothing to dump.  All that's
+C there is a single pen-up move.
+C
+  101 IF (NQ.LE.1) RETURN
+C
+C Get NT, the number of the current transformation, and, if it is not
+C zero, modify the current transformation so that we can use fractional
+C coordinates (normalized device coordinates, in GKS terms).
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Dump out a series of polylines, each one defined by a pen-up move and
+C a series of pen-down moves.
+C
+      DO 102 I=1,NF-1
+        CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I)))
+  102 CONTINUE
+      IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I)))
+C
+C Put the current transformation back the way it was.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Move the last pen position to the beginning of the buffer and pretend
+C there was a pen-up move to that position.
+C
+      QX(1)=QX(NQ)
+      QY(1)=QY(NQ)
+      NQ=1
+      IF(1)=1
+      NF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE PLOTIT (IX,IY,IP)
+C
+C Move the pen to the point (IX,IY), in the metacode coordinate system.
+C If IP is zero, do a pen-up move.  If IP is one, do a pen-down move.
+C If IP is two, flush the buffer.  (For the sake of efficiency, the
+C moves are buffered; "CALL PLOTIT (0,0,0)" will also flush the buffer.)
+C
+C The variable IU(5), in the labelled common block IUTLCM, specifies
+C the size of the pen-move buffer (between 2 and 50).
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables implementing the buffering
+C of pen moves.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system, for MXMY.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Force loading of the block data routine which initializes the contents
+C of the common blocks.
+C
+C     EXTERNAL UTILBD
+C
+C VP and WD hold viewport and window parameters obtained, when needed,
+C from GKS.
+C
+      DIMENSION VP(4),WD(4)
+C
+C + NOAO - Blockdata utilbd has been rewritten as a run time initialization
+C
+      call utilbd
+C
+C - NOAO
+C Check for out-of-range values of the pen parameter.
+C
+      IF (IP.LT.0.OR.IP.GT.2) THEN
+        CALL SETER ('PLOTIT - ILLEGAL VALUE FOR IPEN',1,2)
+      END IF
+C
+C If a buffer flush is requested, jump.
+C
+      IF (IP.EQ.2) GO TO 101
+C
+C Limit the given coordinates to the legal metacode range.
+C
+      JX=MAX0(0,MIN0(32767,IX))
+      JY=MAX0(0,MIN0(32767,IY))
+C
+C If the current move is a pen-down move, or if the last one was, bump
+C the pointer into the coordinate arrays and, if the current move is
+C a pen-up move, make a new entry in the array IF, which records the
+C positions of the pen-up moves.  Note that we never get two pen-up
+C moves in a row, which means that IF need be dimensioned only half as
+C large as QX and QY.
+C
+      IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN
+        NQ=NQ+1
+        IF (IP.EQ.0) THEN
+          NF=NF+1
+          IF(NF)=NQ
+        END IF
+      END IF
+C
+C Save the coordinates of the point, in the fractional coordinate
+C system.
+C
+      QX(NQ)=FLOAT(JX)/32767.
+      QY(NQ)=FLOAT(JY)/32767.
+C
+C If all three arguments were zero, or if the point-coordinate buffer
+C is full, dump the buffers; otherwise, return.
+C
+      IF (IX.EQ.0.AND.IY.EQ.0.AND.IP.EQ.0) GO TO 101
+      IF (NQ.LT.IU(5)) RETURN
+C
+C Dump the buffers.  If NQ is one, there's nothing to dump.  All that's
+C there is a single pen-up move.
+C
+  101 IF (NQ.LE.1) RETURN
+C
+C Get NT, the number of the current transformation, and, if it is not
+C zero, modify the current transformation so that we can use fractional
+C coordinates (normalized device coordinates, in GKS terms).
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Dump out a series of polylines, each one defined by a pen-up move and
+C a series of pen-down moves.
+C
+      DO 102 I=1,NF-1
+        CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I)))
+  102 CONTINUE
+      IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I)))
+C
+C Put the current transformation back the way it was.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Move the last pen position to the beginning of the buffer and pretend
+C there was a pen-up move to that position.
+C
+      QX(1)=QX(NQ)
+      QY(1)=QY(NQ)
+      NQ=1
+      IF(1)=1
+      NF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE POINT (PX,PY)
+C
+C Draws a point at (PX,PY), defined in the user coordinate system.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),0)
+      CALL PLOTIF (CUFX(PX),CUFY(PY),1)
+      RETURN
+      END
+      SUBROUTINE POINTS (PX,PY,NP,IC,IL)
+      DIMENSION PX(NP),PY(NP)
+C
+C Marks the points at positions in the user coordinate system defined
+C by ((PX(I),PY(I)),I=1,NP).  If IC is zero, each point is marked with
+C a simple point.  If IC is positive, each point is marked with the
+C single character defined by the FORTRAN-77 function CHAR(IC).  If IC
+C is negative, each point is marked with a GKS polymarker of type -IC.
+C If IL is non-zero, a curve is also drawn, connecting the points.
+C
+C Define arrays to hold converted point coordinates when it becomes
+C necessary to mark the points a few at a time.
+C
+      DIMENSION QX(10),QY(10)
+C
+C Define an array to hold the aspect source flags which may need to be
+C retrieved from GKS.
+C
+      DIMENSION LA(13)
+      CHARACTER*1 CHRTMP
+C
+C If the number of points is zero or negative, there's nothing to do.
+C
+      IF (NP.LE.0) RETURN
+C
+C Otherwise, flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Retrieve the parameters from the last SET call.
+C
+      CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+C If a linear-linear, non-mirror-imaged, mapping is being done and the
+C GKS polymarkers can be used, all the points can be marked with a
+C single polymarker call and joined, if requested, by a single polyline
+C call.
+C
+      IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1.AND.IC.LE.0) THEN
+        CALL GQASF (IE,LA)
+        IF (LA(4).EQ.0) THEN
+          CALL GQPMI (IE,IN)
+          CALL GSPMI (MAX0(-IC,1))
+          CALL GPM (NP,PX,PY)
+          CALL GSPMI (IN)
+        ELSE
+          CALL GQMK (IE,IN)
+          CALL GSMK (MAX0(-IC,1))
+          CALL GPM (NP,PX,PY)
+          CALL GSMK (IN)
+        END IF
+        IF (IL.NE.0.AND.NP.GE.2) CALL GPL (NP,PX,PY)
+C
+C Otherwise, things get complicated.  We have to do batches of nine
+C points at a time.  (Actually, we convert ten coordinates at a time,
+C so that the curve joining the points, if any, won't have gaps in it.)
+C
+      ELSE
+C
+C Initially, we have to reset either the polymarker index or the text
+C alignment, depending on how we're marking the points.
+C
+        IF (IC.LE.0) THEN
+          CALL GQASF (IE,LA)
+          IF (LA(4).EQ.0) THEN
+            CALL GQPMI (IE,IN)
+            CALL GSPMI (MAX0(-IC,1))
+          ELSE
+            CALL GQMK (IE,IN)
+            CALL GSMK (MAX0(-IC,1))
+          END IF
+        ELSE
+          CALL GQTXAL (IE,IH,IV)
+          CALL GSTXAL (2,3)
+        END IF
+C
+C Loop through the points by nines.
+C
+        DO 104 IP=1,NP,9
+C
+C Fill the little point coordinate arrays with up to ten values,
+C converting them from the user system to the fractional system.
+C
+          NQ=MIN0(10,NP-IP+1)
+          MQ=MIN0(9,NQ)
+          DO 102 IQ=1,NQ
+            QX(IQ)=CUFX(PX(IP+IQ-1))
+            QY(IQ)=CUFY(PY(IP+IQ-1))
+  102     CONTINUE
+C
+C Change the SET call to allow the use of fractional coordinates.
+C
+          CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1)
+C
+C Crank out either a polymarker or a set of characters.
+C
+          IF (IC.LE.0) THEN
+            CALL GPM (MQ,QX,QY)
+          ELSE
+            DO 103 IQ=1,MQ
+              CHRTMP = CHAR(IC)
+              CALL GTX (QX(IQ),QY(IQ),CHRTMP)
+  103       CONTINUE
+          END IF
+          IF (IL.NE.0.AND.NQ.GE.2) CALL GPL (NQ,QX,QY)
+C
+C Put the SET parameters back the way they were.
+C
+          CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+  104   CONTINUE
+C
+C Finally, we put either the polymarker index or the text alignment
+C back the way it was.
+C
+        IF (IC.LE.0) THEN
+          IF (LA(4).EQ.0) THEN
+            CALL GSPMI (IN)
+          ELSE
+            CALL GSMK (IN)
+          END IF
+        ELSE
+          CALL GSTXAL (IH,IV)
+        END IF
+C
+      END IF
+C
+C Update the pen position.
+C
+      CALL FRSTPT (PX(NP),PY(NP))
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE PWRIT (PX,PY,CH,NC,IS,IO,IC)
+      CHARACTER*(*) CH
+C
+C PWRIT is called to draw a character string in a specified position.
+C It is just like WTSTR, but has one extra argument.  NC is the number
+C of characters to be written from the string CH.
+C
+      CALL WTSTR (PX,PY,CH(1:NC),IS,IO,IC)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE SET (VL,VR,VB,VT,WL,WR,WB,WT,LF)
+C
+C SET allows the user to change the current values of the parameters
+C defining the mapping from the user system to the fractional system
+C (in GKS terminology, the mapping from world coordinates to normalized
+C device coordinates).
+C
+C VL, VR, VB, and VT define the viewport (in the fractional system), WL,
+C WR, WB, and WT the window (in the user system), and LF the nature of
+C the mapping, according to the following table:
+C
+C    1  -  x linear, y linear
+C    2  -  x linear, y logarithmic
+C    3  -  x logarithmic, y linear
+C    4  -  x logarithmic, y logarithmic
+C
+C Declare the common block containing the linear-log and mirror-imaging
+C flags.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Set the GKS viewport for transformation 1.
+C
+      CALL GSVP (1,VL,VR,VB,VT)
+C
+C Set the utility state variable controlling linear-log mapping.
+C
+      LL=MAX0(1,MIN0(4,LF))
+C
+C Set the GKS window for transformation 1.
+C
+      IF (WL.LT.WR) THEN
+        MI=1
+        QL=WL
+        QR=WR
+      ELSE
+        MI=3
+        QL=WR
+        QR=WL
+      END IF
+C
+      IF (WB.LT.WT) THEN
+        QB=WB
+        QT=WT
+      ELSE
+        MI=MI+1
+        QB=WT
+        QT=WB
+      END IF
+C
+      IF (LL.EQ.1) THEN
+        CALL GSWN (1,QL,QR,QB,QT)
+      ELSE IF (LL.EQ.2) THEN
+        CALL GSWN (1,QL,QR,ALOG10(QB),ALOG10(QT))
+      ELSE IF (LL.EQ.3) THEN
+        CALL GSWN (1,ALOG10(QL),ALOG10(QR),QB,QT)
+      ELSE
+        CALL GSWN (1,ALOG10(QL),ALOG10(QR),ALOG10(QB),ALOG10(QT))
+      END IF
+C
+C Select transformation 1 as the current one.
+C
+      CALL GSELNT (1)
+C
+      RETURN
+C
+      END
+      SUBROUTINE SETI (IX,IY)
+C
+C Allows the user to set the parameters which determine the assumed size
+C of the target plotter and therefore determine how user coordinates are
+C to be mapped into plotter coordinates.
+C
+C Declare the common block containing the scaling information.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Transfer the user's values into the common block.
+C
+      MX=MAX0(1,MIN0(15,IX))
+      MY=MAX0(1,MIN0(15,IY))
+C
+      RETURN
+C
+      END
+      SUBROUTINE SETUSV (VN,IV)
+      CHARACTER*(*) VN
+C
+C This subroutine sets the values of various utility state variables.
+C VN is the name of the variable and IV is its value.
+C
+C The labelled common block IUTLCM contains all of the utility state
+C variables.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C Define an array in which to get the GKS aspect source flags.
+C
+      DIMENSION LF(13)
+C
+C Check for the linear-log scaling variable, which can take on these
+C values:
+C
+C     1 = X linear, Y linear
+C     2 = X linear, Y log
+C     3 = X log   , Y linear
+C     4 = X log   , Y log
+C
+      IF (VN(1:2).EQ.'LS') THEN
+        IF (IV.LT.1.OR.IV.GT.4) THEN
+          CALL SETER ('SETUSV - LOG SCALE VALUE OUT OF RANGE',2,2)
+        END IF
+        IU(1)=IV
+C
+C Check for the mirror-imaging variable, which can take on these
+C values:
+C
+C     1 = X normal  , Y normal
+C     2 = X normal  , Y reversed
+C     3 = X reversed, Y normal
+C     4 = X reversed, Y reversed
+C
+      ELSE IF (VN(1:2).EQ.'MI') THEN
+        IF (IV.LT.1.OR.IV.GT.4) THEN
+          CALL SETER ('SETUSV - MIRROR-IMAGING VALUE OUT OF RANGE',3,2)
+        END IF
+        IU(2)=IV
+C
+C Check for the scale factor setting the resolution of the plotter in
+C the x direction.
+C
+      ELSE IF (VN(1:2).EQ.'XF') THEN
+        IF (IV.LT.1.OR.IV.GT.15) THEN
+          CALL SETER ('SETUSV - X RESOLUTION OUT OF RANGE',4,2)
+        END IF
+        IU(3)=IV
+C
+C Check for the scale factor setting the resolution of the plotter in
+C the y direction.
+C
+      ELSE IF (VN(1:2).EQ.'YF') THEN
+        IF (IV.LT.1.OR.IV.GT.15) THEN
+          CALL SETER ('SETUSV - Y RESOLUTION OUT OF RANGE',5,2)
+        END IF
+        IU(4)=IV
+C
+C Check for the variable specifying the size of the pen-move buffer.
+C
+      ELSE IF (VN(1:2).EQ.'PB') THEN
+        IF (IV.LT.2.OR.IV.GT.50) THEN
+          CALL SETER ('SETUSV - PEN-MOVE BUFFER SIZE OUT OF RANGE',6,2)
+        END IF
+        CALL PLOTIF (0.,0.,2)
+        IU(5)=IV
+C
+C Check for a metacode unit number.
+C
+      ELSE IF (VN(1:2).EQ.'MU') THEN
+        IF (IV.LE.0) THEN
+          CALL SETER ('SETUSV - METACODE UNIT NUMBER ILLEGAL',7,2)
+        END IF
+C
+C For the moment (1/11/85), we have to deactivate and close the old
+C workstation and open and activate a new one.  This does allow the
+C user to break up his metacode output.  It does not necessarily allow
+C for the resumption of output to a previously-written metacode file.
+C
+        CALL GDAWK (IU(6))
+        CALL GCLWK (IU(6))
+        IU(6)=IV
+        CALL GOPWK (IU(6),2,1)
+        CALL GACWK (IU(6))
+C
+C If, in the future, it becomes possible to have more than one metacode
+C workstation open at once, the following code can be used instead.
+C
+C       CALL GDAWK (IU(6))
+C       IU(6)=IV
+C       CALL GQOPWK (0,IE,NO,ID)
+C       IF (NO.NE.0) THEN
+C         DO 101 I=1,NO
+C           CALL GQOPWK (I,IE,NO,ID)
+C           IF (ID.EQ.IU(6)) GO TO 102
+C 101     CONTINUE
+C       END IF
+C       CALL GOPWK (IU(6),2,1)
+C 102   CALL GAWK (IU(6))
+C
+C Check for one of the variables setting color and intensity.
+C
+      ELSE IF (VN(1:2).EQ.'IR') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF RED INTENSITY',8,2)
+        END IF
+        IU(7)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IG') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF GREEN INTENSITY',9,2)
+        END IF
+        IU(8)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IB') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF BLUE INTENSITY',10,2)
+        END IF
+        IU(9)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IN') THEN
+        IF (IV.LT.0.OR.IV.GT.10000) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF INTENSITY',11,2)
+        END IF
+        IU(10)=IV
+C
+C Assign the intensity-controlling variables to local variables with
+C simple, meaningful names.
+C
+        IR=IU(7)
+        IG=IU(8)
+        IB=IU(9)
+        IN=IU(10)
+        II=IU(11)
+        IM=IU(12)
+C
+C Compute the floating-point red, green, and blue intensities.
+C
+        FR=FLOAT(IR)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+        FG=FLOAT(IG)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+        FB=FLOAT(IB)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+C
+C Dump the pen-move buffer before changing anything.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Set the aspect source flags for all the color indices to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF( 3)=1
+        LF( 6)=1
+        LF(10)=1
+        LF(13)=1
+        CALL GSASF (LF)
+C
+C Pick a new color index and use it for polylines, polymarkers, text,
+C and areas.
+C
+        II=MOD(II,IM)+1
+        IU(11)=II
+        CALL GSPLCI (II)
+        CALL GSPMCI (II)
+        CALL GSTXCI (II)
+        CALL GSFACI (II)
+C
+C Now, redefine the color for that color index on each open workstation.
+C
+        CALL GQOPWK (0,IE,NO,ID)
+C
+        DO 103 I=1,NO
+          CALL GQOPWK (I,IE,NO,ID)
+          CALL GSCR (ID,II,FR,FG,FB)
+  103   CONTINUE
+C
+C Check for variable resetting the color index.
+C
+      ELSE IF (VN(1:2).EQ.'II') THEN
+        IF (IV.LT.1.OR.IV.GT.IU(12)) THEN
+          CALL SETER ('SETUSV - ILLEGAL COLOR INDEX',12,2)
+        END IF
+        IU(11)=IV
+C
+        CALL PLOTIF (0.,0.,2)
+C
+        CALL GQASF (IE,LF)
+        LF( 3)=1
+        LF( 6)=1
+        LF(10)=1
+        LF(13)=1
+        CALL GSASF (LF)
+C
+        CALL GSPLCI (IV)
+        CALL GSPMCI (IV)
+        CALL GSTXCI (IV)
+        CALL GSFACI (IV)
+C
+C Check for the variable limiting the values of color index used.
+C
+      ELSE IF (VN(1:2).EQ.'IM') THEN
+        IF (IV.LT.1) THEN
+          CALL SETER ('SETUSV - ILLEGAL MAXIMUM COLOR INDEX',13,2)
+        END IF
+        IU(12)=IV
+C
+C Check for the variable setting the current line width scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'LW') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL LINE WIDTH SCALE FACTOR',14,2)
+        END IF
+        IU(13)=IV
+C
+C Dump the pen-move buffer before changing anything.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Set the aspect source flag for linewidth scale factor to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF(2)=1
+        CALL GSASF (LF)
+C
+C Redefine the line width scale factor.
+C
+        CALL GSLWSC (FLOAT(IV)/1000.)
+C
+C Check for the variable setting the current marker size scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'MS') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL MARKER SIZE SCALE FACTOR',15,2)
+        END IF
+        IU(14)=IV
+C
+C Set aspect source flag for marker size scale factor to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF(5)=1
+        CALL GSASF (LF)
+C
+C Redefine the marker size scale factor.
+C
+        CALL GSMKSC (FLOAT(IV)/1000.)
+C
+C Otherwise, the variable name is unknown.
+C
+      ELSE
+        CALL SETER ('SETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2)
+C
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE VECTOR (PX,PY)
+C
+C Draw a vector (line segment) from the current pen position to the new
+C pen position (PX,PY), in the user coordinate system, and then make
+C (PX,PY) the current pen position.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),1)
+      RETURN
+      END
+      SUBROUTINE WTSTR (PX,PY,CH,IS,IO,IC)
+C
+C WTSTR is called to draw a character string in a specified position.
+C
+C PX and PY specify, in user coordinates, the position of a point
+C relative to which a character string is to be positioned.
+C
+C CH is the character string to be written.
+C
+C IS is the desired size of the characters to be used, stated as a
+C character width in the plotter coordinate system.  The values 0, 1,
+C 2, and 3 mean 8, 12, 16, and 24, respectively.
+C
+C IO is the desired orientation angle, in degrees counterclockwise from
+C a horizontal vector pointing to the right.
+C
+C IC specifies the desired type of centering.  A negative value puts
+C (PX,PY) in the center of the left end of the character string, a zero
+C puts (PX,PY) in the center of the whole string, and a positive value
+C puts (PX,PY) in the center of the right end of the character string.
+C
+      CHARACTER*(*) CH
+C
+C Define arrays in which to save the current viewport and window.
+C
+      DIMENSION VP(4),WD(4)
+C
+C Flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Compute the coordinates of (PX,PY) in the fractional coordinate
+C system (normalized device coordinates).
+C
+      XN=CUFX(PX)
+      YN=CUFY(PY)
+C
+C Save the current window and, if necessary, redefine it so that we can
+C use normalized device coordinates.
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Save current character height, text path, character up vector, and
+C text alignment.
+C
+      CALL GQCHH (IE,OS)
+      CALL GQTXP (IE,IP)
+      CALL GQCHUP (IE,UX,UY)
+      CALL GQTXAL (IE,IX,IY)
+C
+C Define the character height.  (The final scale factor is derived from
+C the default font.)
+C
+      CALL GETUSV ('YF',MY)
+      YS=FLOAT(2**MY)
+      IF (IS.GE.0.AND.IS.LE.3) THEN
+        CS=FLOAT(8+4*IS+4*(IS/3))/YS
+      ELSE
+        CS=AMIN1(FLOAT(IS),YS)/YS
+      ENDIF
+C
+      CS=CS*25.5/27.
+C
+C + NOAO - make character size readable with IRAF font
+      cs = cs * 2.0
+C
+C - NOAO
+
+      CALL GSCHH(CS)
+C
+C Define the text path.
+C
+      CALL GSTXP (0)
+C
+C Define the character up vector.
+C
+      JO=MOD(IO,360)
+      IF (JO.EQ.0) THEN
+        CALL GSCHUP (0.,1.)
+      ELSE IF (JO.EQ.90) THEN
+        CALL GSCHUP (-1.,0.)
+      ELSE IF (JO.EQ.180) THEN
+        CALL GSCHUP (0.,-1.)
+      ELSE IF (JO.EQ.270) THEN
+        CALL GSCHUP (1.,0.)
+      ELSE IF (JO.GT.0.AND.JO.LT.180) THEN
+        CALL GSCHUP (-1.,1./TAN(FLOAT(JO)*3.1415926/180.))
+      ELSE
+        CALL GSCHUP (1.,-1./TAN(FLOAT(JO)*3.1415926/180.))
+      ENDIF
+C
+C Define the text alignment.
+C
+      CALL GSTXAL (IC+2,3)
+C
+C Plot the characters.
+C
+      CALL GTX (XN,YN,CH)
+C
+C Restore the original text attributes.
+C
+      CALL GSCHH (OS)
+      CALL GSTXP (IP)
+      CALL GSCHUP (UX,UY)
+      CALL GSTXAL (IX,IY)
+C
+C Restore the window definition.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Update the pen position.
+C
+      CALL FRSTPT (PX,PY)
+C
+C Done.
+C
+      RETURN
+C
+      END
+c + NOAO - blockdata utilbd changed to run time initialization
+      subroutine utilbd
+c     BLOCKDATA UTILBD
+C
+      logical first
+C The common block IUTLCM contains integer utility variables which are
+C user-settable by the routine SETUSV and user-retrievable by the
+C routine GETUSV.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables realizing the buffering
+C scheme used by PLOTIT/F for pen moves.  The dimension of QX and QY must
+C be an even number greater than or equal to the value of IU(5).  The
+C dimension of IF must be half that of QX and QY.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C point to which a pen move was requested by a call to PLOTIT/F.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C IU(1) contains the log scaling parameter, which may take on the
+C following possible values:
+C
+C     1 = linear-linear
+C     2 = log-linear
+C     3 = linear-log
+C     4 = log-log
+C
+c     DATA IU(1) / 1 /
+      IU(1) = 1 
+C
+C IU(2) specifies the mirror-imaging of the x and y axes, as follows:
+C
+C     1 = x normal, y normal
+C     2 = x normal, y reversed
+C     3 = x reversed, y normal
+C     4 = x reversed, y reversed
+C
+c +NOAO - logical parameter first inserted to avoid clobbering initialization
+      data first /.true./
+      if (.not. first) return
+        first = .false.
+c -NOAO
+c     DATA IU(2) / 1 /
+      IU(2) = 1 
+C
+C IU(3) specifies the assumed resolution of the plotter in the x
+C direction.  Plotter x coordinates are assumed to lie between 1 and
+C 2**IU(3), inclusive.
+C
+c     DATA IU(3) / 10 /
+      IU(3) = 10 
+C
+C IU(4) specifies the assumed resolution of the plotter in the y
+C direction.  Plotter y coordinates are assumed to lie between 1 and
+C 2**IU(4), inclusive.
+C
+c     DATA IU(4) / 10 /
+      IU(4) = 10 
+C
+C IU(5) specifies the size of the buffers used by PLOTIT/F.  Its value
+C must be greater than or equal to 2 and not greater than the dimension
+C of the variables QX and QY.  Using the value 2 effectively turns off
+C the buffering.
+C
+c     DATA IU(5) / 50 /
+      IU(5) = 50
+C
+C IU(6) specifies the current metacode unit, which is machine-dependent.
+C At NCAR, the value "1" currently (1/11/85) causes metacode to be
+C written on the file "GMETA".  Eventually, it will cause output to be
+C written on unit number 1.  At that point, the value, on the Cray at
+C least, should be changed to "4H$PLT", so that output will come out on
+C the old familiar dataset.
+C
+c     DATA IU(6) / 1 /
+      IU(6) = 1 
+C
+C IU(7), IU(8), IU(9), and IU(10) specify color and intensity, in the
+C following way (letting IR=IU(7), IG=IU(8), IB=IU(9), and IN=IU(10)):
+C
+C     The red intensity is IR/(IR+IG+IB)*IN/10000.
+C     The green intensity is IG/(IR+IG+IB)*IN/10000.
+C     The blue intensity is IB/(IR+IG+IB)*IN/10000.
+C
+C The GKS calls to set these intensities are executed in response to a
+C "CALL SETUSV ('IN',IN)", using the existing values of IR, IG, and IB.
+C Thus, to completely determine the color and the intensity, the user
+C must execute four calls, as follows:
+C
+C     CALL SETUSV ('IR',IR)
+C     CALL SETUSV ('IG',IG)
+C     CALL SETUSV ('IB',IB)
+C     CALL SETUSV ('IN',IN)
+C
+C The default values create a white line at .8 x maximum intensity.
+C
+c     DATA IU(7) / 1 /
+c     DATA IU(8) / 1 /
+c     DATA IU(9) / 1 /
+      IU(7) = 1
+      IU(8) = 1 
+      IU(9) = 1
+C
+c     DATA IU(10) / 8000 /
+      IU(10) = 8000 
+C
+C IU(11) and IU(12) specify, respectively, the last color index used
+C and the maximum number of color indices it is permissible to use.
+C
+c     DATA IU(11) / 0 /
+c     DATA IU(12) / 1 /
+      IU(11) = 0 
+      IU(12) = 1 
+C
+C IU(13)/1000 specifies the current line width scale factor.
+C
+c     DATA IU(13) / 1000 /
+      IU(13) = 1000
+C
+C IU(14)/1000 specifies the current marker size scale factor.
+C
+c     DATA IU(14) / 1000 /
+      IU(14) = 1000 
+C
+C IU(15) through IU(100) are currently undefined.
+C
+C Initialization for the routine PLOTIT/F:  For values of I between 1 and
+C NQ, (QX(I),QY(I)) is a point to which a pen move has been requested
+C by a past call to PLOTIT/F.  The coordinates are stated in the fractional
+C coordinate system.  For values of I between 1 and NF, IF(I) is the
+C index, in QX and QY, of the coordinates of a point to which a pen-up
+C move was requested.  NQ and NF are never allowed to be less than one.
+C
+c     DATA NQ,QX(1),QY(1),NF,IF(1) / 1 , 0. , 0. , 1 , 1 /
+      NQ    = 1
+      QX(1) = 0. 
+      QY(1) = 0. 
+      NF    = 1 
+      IF(1) = 1 
+C
+C JX and JY are the coordinates, in the metacode system, of the last
+C point to which a pen move was requested by a call to PLOTIT/F.
+C
+c     DATA JX,JY / 0 , 0 /
+      JX = 0 
+      JY = 0 
+C
+c -NOAO
+      return
+c
+      entry initut
+      first = .true.
+      END
diff --git a/sys/gio/ncarutil/sysint/support.f b/sys/gio/ncarutil/sysint/support.f
new file mode 100644
index 00000000..84d11ba5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/support.f
@@ -0,0 +1,581 @@
+      SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+C
+C ON INPUT     VALU      FLOATING POINT NUMBER FROM WHICH THE LABEL IS
+C                        TO BE CREATED.
+C              ASH       SEE IOFFD.
+C              IOFFD     IF IOFFD .EQ. 0, A LABEL WHICH REFLECTS THE
+C                             MAGNITUDE OF VALU IS TO BE CREATED.
+C                             .1 .LE. ABS(VALU) .LE. 99999.49999...
+C                             OR VALUE .EQ. 0.0.  THE LABEL CREATED
+C                             SHOULD HAVE 3 TO 5 CHARACTERS DEPENDING
+C                             ON THE MAGNITUDE OF VALU.  SEE IOUT.
+C                        IF IOFFD .NE. 0, A LABEL WHICH DOES NOT REFLECT
+C                             THE MAGNITUDE OF VALU IS TO BE CREATED.
+C                             ASH IS USED AS THE NORMALIZATION FACTOR.
+C                             1. .LE. ASH*ABS(VALU) .LT. 1000. OR
+C                             VALU .EQ. 0.0.  THE LABEL CREATED SHOULD
+C                             HAVE 1 TO 3 CHARACTERS, DEPENDING ON THE
+C                             MAGNITUDE OF ASH*VALU.  SEE IOUT.
+C ON OUTPUT    IOUT      CONTAINS THE LABEL CREATED.  IT SHOULD HAVE NO
+C                        LEADING BLANKS.  SEE NC.
+C              NC        THE NUMBERS IN THE LABEL IN IOUT.  SHOULD BE
+C                        1 TO 5.
+C
+      SAVE
+      CHARACTER*11 IFMT
+      CHARACTER*(*) IOUT
+C
+C IFMT MUST HOLD 11 CHARACTERS
+C
+      VAL = VALU
+      IF (IOFFD .NE. 0) GO TO 103
+      IF (VAL) 101,104,101
+  101 LOG = IFIX((ALOG10(ABS(VAL))+.00001)+5000.)-5000
+      V = VAL
+      NS = MAX0(4,MIN0(6,LOG+2))
+      ND = MIN0(3,MAX0(0,2-LOG))
+c     IF (VAL.LT.0)  NS = NS + 1
+c + NOAO - replacing ftn i/o for iraf implementation
+c 102 WRITE (IFMT,'(A2,I2,A1,I1,A1)') '(F',NS,'.',ND,')'
+  102 continue
+      ifmt(1:6) = '(f . )'
+      ifmt(3:3) = char (ns + ichar ('0'))
+      ifmt(5:5) = char (nd + ichar ('0'))
+c     WRITE (IOUT,IFMT) V
+      call encode (ns, ifmt, iout, v)
+      NC = NS
+c + NOAO
+c The following statement was making 5 digit labels (+4800) come out
+c truncated (+480) and it has been commented out.
+c     IF (LOG.GE.3)  NC = NC - 1
+c - NOAO
+      RETURN
+  103 NS = 4
+      IF (VAL.LT.0.)  NS=5
+      IF (VAL.EQ.0.)  NS=2
+      ND = 0
+      V = VAL*ASH
+      LOG = 100
+      GO TO 102
+  104 iout(1:3) = '0.0'
+      nc = 3
+c 104 NS = 3
+c     ND = 1
+c     LOG = -100
+c     V = 0.
+c     GO TO 102
+C
+C1001 FORMAT('(F',I2,'.',I1,',1H',A1,')')
+C
+      END
+C
+      SUBROUTINE ENCODE (NCHARS, FTNFMT, FTNOUT, RVAL)
+
+      INTEGER SZFMT, SZBUF
+      PARAMETER (SZFMT=11)
+      PARAMETER (SZBUF=15)
+
+      CHARACTER*(*) FTNFMT
+      CHARACTER*(*) FTNOUT
+      INTEGER*2 SPPFMT(SZFMT), SPPOUT(SZBUF)
+
+C UNPACK THE FORTRAN CHARACTER STRING, CALL FENCD TO ACTUALLY ENCODE THE
+C OUTPUT STRING, THEN PACK THE OUTPUT STRING INTO A FORTRAN STRING FOR RETURN
+C
+      CALL F77UPK (FTNFMT, SPPFMT, SZFMT)
+      CALL FENCD (NCHARS, SPPFMT, SPPOUT, RVAL)
+      CALL F77PAK (SPPOUT, FTNOUT, NCHARS)
+
+      END
+C
+C PACKAGE ERPRT77        DESCRIPTION OF INDIVIDUAL USER ENTRIES
+C                        FOLLOWS THIS PACKAGE DESCRIPTION.
+C
+C LATEST REVISION        FEBRUARY 1985
+C
+C PURPOSE                TO PROVIDE A PORTABLE, FORTRAN 77 ERROR
+C                        HANDLING PACKAGE.
+C
+C USAGE                  THESE ROUTINES ARE INTENDED TO BE USED IN
+C                        THE SAME MANNER AS THEIR SIMILARLY NAMED
+C                        COUNTERPARTS ON THE PORT LIBRARY.  EXCEPT
+C                        FOR ROUTINE SETER, THE CALLING SEQUENCES
+C                        OF THESE ROUTINES ARE THE SAME AS FOR
+C                        THEIR PORT COUNTERPARTS.
+C                        ERPRT77 ENTRY          PORT ENTRY
+C                        -------------          ----------
+C                        ENTSR                  ENTSRC
+C                        RETSR                  RETSRC
+C                        NERRO                  NERROR
+C                        ERROF                  ERROFF
+C                        SETER                  SETERR
+C                        EPRIN                  EPRINT
+C                        FDUM                   FDUMP
+C
+C I/O                    SOME OF THE ROUTINES PRINT ERROR MESSAGES.
+C
+C PRECISION              NOT APPLICABLE
+C
+C REQUIRED LIBRARY       MACHCR, WHICH IS LOADED BY DEFAULT ON
+C FILES                  NCAR'S CRAY MACHINES.
+C
+C LANGUAGE               FORTRAN 77
+C
+C HISTORY                DEVELOPED OCTOBER, 1984 AT NCAR IN BOULDER,
+C                        COLORADO BY FRED CLARE OF THE SCIENTIFIC
+C                        COMPUTING DIVISION BY ADAPTING THE NON-
+C                        PROPRIETARY, ERROR HANDLING ROUTINES
+C                        FROM THE PORT LIBRARY OF BELL LABS.
+C
+C PORTABILITY            FULLY PORTABLE
+C
+C REFERENCES             SEE THE MANUAL
+C                          PORT MATHEMATICAL SUBROUTINE LIBRARY
+C                        ESPECIALLY "ERROR HANDLING" IN SECTION 2
+C                        OF THE INTRODUCTION, AND THE VARIOUS
+C                        SUBROUTINE DESCRIPTIONS.
+C ******************************************************************
+C
+C SUBBROUTINE ENTSR(IROLD,IRNEW)
+C
+C PURPOSE               SAVES THE CURRENT RECOVERY MODE STATUS AND
+C                       SETS A NEW ONE.  IT ALSO CHECKS THE ERROR
+C                       STATE, AND IF THERE IS AN ACTIVE ERROR
+C                       STATE A MESSAGE IS PRINTED.
+C
+C USAGE                 CALL ENTSR(IROLD,IRNEW)
+C
+C ARGUMENTS
+C
+C ON INPUT               IRNEW
+C                          VALUE SPECIFIED BY USER FOR ERROR
+C                          RECOVERY
+C                          = 0 LEAVES RECOVERY UNCHANGED
+C                          = 1 GIVES  RECOVERY
+C                          = 2 TURNS  RECOVERY OFF
+C
+C ON OUTPUT              IROLD
+C                          RECEIVES THE CURRENT VALUE OF THE ERROR
+C                          RECOVERY MODE
+C
+C SPECIAL CONDITIONS     IF THERE IS AN ACTIVE ERROR STATE, THE
+C                        MESSAGE IS PRINTED AND EXECUTION STOPS.
+C
+C                        ERROR STATES -
+C                        1 - ILLEGAL VALUE OF IRNEW.
+C                        2 - CALLED WHILE IN AN ERROR STATE.
+C ******************************************************************
+C
+C SUBROUTINE RETSR(IROLD)
+C
+C PURPOSE                SETS THE RECOVERY MODE TO THE STATUS GIVEN
+C                        BY THE INPUT ARGUMENT.  A TEST IS THEN MADE
+C                        TO SEE IF A CURRENT ERROR STATE EXISTS WHICH
+C                        IS UNRECOVERABLE; IF SO, RETSR PRINTS AN
+C                        ERROR MESSAGE AND TERMINATES THE RUN.
+C
+C                        BY CONVENTION, RETSR IS USED UPON EXIT
+C                        FROM A SUBROUTINE TO RESTORE THE PREVIOUS
+C                        RECOVERY MODE STATUS STORED BY ROUTINE
+C                        ENTSR IN IROLD.
+C
+C USAGE                  CALL RETSR(IROLD)
+C
+C ARGUMENTS
+C
+C ON INPUT               IROLD
+C                          = 1 SETS FOR RECOVERY
+C                          = 2 SETS FOR NONRECOVERY
+C
+C ON OUTPUT              NONE
+C
+C SPECIAL CONDITIONS     IF THE CURRENT ERROR BECOMES UNRECOVERABLE,
+C                        THE MESSAGE IS PRINTED AND EXECUTION STOPS.
+C
+C                        ERROR STATES -
+C                          1 - ILLEGAL VALUE OF IROLD.
+C ******************************************************************
+C
+C INTEGER FUNCTION NERRO(NERR)
+C
+C PURPOSE                PROVIDES THE CURRENT ERROR NUMBER (IF ANY)
+C                        OR ZERO IF THE PROGRAM IS NOT IN THE
+C                        ERROR STATE.
+C
+C USAGE                  N = NERRO(NERR)
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NERR
+C                          CURRENT VALUE OF THE ERROR NUMBER
+C ******************************************************************
+C SUBROUTINE ERROF
+C
+C PURPOSE                TURNS OFF THE ERROR STATE BY SETTING THE
+C                        ERROR NUMBER TO ZERO
+C
+C USAGE                  CALL ERROF
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+C
+C SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+C PURPOSE                SETS THE ERROR INDICATOR AND, DEPENDING
+C                        ON THE OPTIONS STATED BELOW, PRINTS A
+C                        MESSAGE AND PROVIDES A DUMP.
+C
+C
+C USAGE                  CALL SETER(MESSG,NERR,IOPT)
+C
+C ARGUMENTS
+C
+C ON INPUT               MESSG
+C                          HOLLERITH STRING CONTAINING THE MESSAGE
+C                          ASSOCIATED WITH THE ERROR
+C
+C                        NERR
+C                          THE NUMBER TO ASSIGN TO THE ERROR
+C
+C                        IOPT
+C                          = 1 FOR A RECOVERABLE ERROR
+C                          = 2 FOR A FATAL ERROR
+C
+C                         IF IOPT = 1 AND THE USER IS IN ERROR
+C                         RECOVERY MODE, SETERR SIMPLY REMEMBERS
+C                         THE ERROR MESSAGE, SETS THE ERROR NUMBER
+C                         TO NERR, AND RETURNS.
+C
+C                         IF IOPT = 1 AND THE USER IS NOT IN ERROR
+C                         RECOVERY MODE, SETERR PRINTS THE ERROR
+C                         MESSAGE AND TERMINATES THE RUN.
+C
+C                         IF IOPT = 2 SETERR ALWAYS PRINTS THE ERROR
+C                         MESSAGE, CALLS FDUM, AND TERMINATES THE RUN.
+C
+C ON OUTPUT              NONE
+C
+C SPECIAL CONDITIONS     CANNOT ASSIGN NERR = 0, AND CANNOT SET IOPT
+C                        TO ANY VALUE OTHER THAN 1 OR 2.
+C ******************************************************************
+C
+C  SUBROUTINE EPRIN
+C
+C PURPOSE                PRINTS THE CURRENT ERROR MESSAGE IF THE
+C                        PROGRAM IS IN THE ERROR STATE; OTHERWISE
+C                        NOTHING IS PRINTED.
+C
+C USAGE                  CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+C
+C SUBROUTINE FDUM
+C
+C PURPOSE                TO PROVIDE A DUMMY ROUTINE WHICH SERVES
+C                        AS A PLACEHOLDER FOR A SYMBOLIC DUMP
+C                        ROUTINE, SHOULD IMPLEMENTORS DECIDE TO
+C                        PROVIDE SUCH A ROUTINE.
+C
+C USAGE                  CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+      SUBROUTINE ENTSR(IROLD,IRNEW)
+C
+      LOGICAL TEMP
+      IF (IRNEW.LT.0 .OR. IRNEW.GT.2)
+     1   CALL SETER(' ENTSR - ILLEGAL VALUE OF IRNEW',1,2)
+C
+      TEMP = IRNEW.NE.0
+      IROLD = I8SAV(2,IRNEW,TEMP)
+C
+C  IF HAVE AN ERROR STATE, STOP EXECUTION.
+C
+      IF (I8SAV(1,0,.FALSE.) .NE. 0) CALL SETER
+     1   (' ENTSR - CALLED WHILE IN AN ERROR STATE',2,2)
+C
+      RETURN
+C
+      END
+      SUBROUTINE RETSR(IROLD)
+C
+      IF (IROLD.LT.1 .OR. IROLD.GT.2)
+     1  CALL SETER(' RETSR - ILLEGAL VALUE OF IROLD',1,2)
+C
+      ITEMP=I8SAV(2,IROLD,.TRUE.)
+C
+C  IF THE CURRENT ERROR IS NOW UNRECOVERABLE, PRINT AND STOP.
+C
+      IF (IROLD.EQ.1 .OR. I8SAV(1,0,.FALSE.).EQ.0) RETURN
+C
+        CALL EPRIN
+        CALL FDUM
+c       STOP
+C
+      END
+      INTEGER FUNCTION NERRO(NERR)
+C
+      NERRO=I8SAV(1,0,.FALSE.)
+      NERR=NERRO
+      RETURN
+C
+      END
+      SUBROUTINE ERROF
+C
+      I=I8SAV(1,0,.TRUE.)
+      RETURN
+C
+      END
+      SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+      CHARACTER*(*) MESSG
+      COMMON /UERRF/IERF
+C
+C  THE UNIT FOR ERROR MESSAGES IS I1MACH(4)
+C
+c + NOAO -  blockdata uerrbd changed to runtime initialization subroutine
+C     FORCE LOAD OF BLOCKDATA
+C
+c     EXTERNAL UERRBD
+      call uerrbd
+c - NOAO
+      IF (IERF .EQ. 0) THEN
+      IERF = I1MACH(4)
+      ENDIF
+C
+      NMESSG = LEN(MESSG)
+      IF (NMESSG.GE.1) GO TO 10
+C
+C  A MESSAGE OF NON-POSITIVE LENGTH IS FATAL.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9000)
+c9000   FORMAT(' ERROR 1 IN SETER - MESSAGE LENGTH NOT POSITIVE.')
+        call uliber (1,' SETER - MESSAGE LENGTH NOT POSITIVE.', 80) 
+c - NOAO
+        GO TO 60
+C
+   10 CONTINUE
+      IF (NERR.NE.0) GO TO 20
+C
+C  CANNOT TURN THE ERROR STATE OFF USING SETER.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9001)
+c9001   FORMAT(' ERROR 2 IN SETER - CANNOT HAVE NERR=0'/
+c    1         ' THE CURRENT ERROR MESSAGE FOLLOWS'/)
+        call uliber (2, ' SETER - CANNOT HAVE NERR=0', 80)
+        call uliber (2, ' SETER - THE CURRENT ERROR MSG FOLLOWS', 80) 
+c - NOAO
+        CALL E9RIN(MESSG,NERR,.TRUE.)
+        ITEMP=I8SAV(1,1,.TRUE.)
+        GO TO 50
+C
+C  SET LERROR AND TEST FOR A PREVIOUS UNRECOVERED ERROR.
+C
+ 20   CONTINUE
+      IF (I8SAV(1,NERR,.TRUE.).EQ.0) GO TO 30
+C
+c + NOAO - FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9002)
+c9002   FORMAT(' ERROR    3 IN SETER -',
+c    1         ' AN UNRECOVERED ERROR FOLLOWED BY ANOTHER ERROR.'//
+c    2         ' THE PREVIOUS AND CURRENT ERROR MESSAGES FOLLOW.'///)
+        call uliber (3,' SETER - A SECOND UNRECOV ERROR SEEN.', 80)
+        call uliber (3,' SETER - THE ERROR MESSAGES FOLLOW.', 80)
+c - NOAO
+        CALL EPRIN
+        CALL E9RIN(MESSG,NERR,.TRUE.)
+        GO TO 50
+C
+C  SAVE THIS MESSAGE IN CASE IT IS NOT RECOVERED FROM PROPERLY.
+C
+ 30   CALL E9RIN(MESSG,NERR,.TRUE.)
+C
+      IF (IOPT.EQ.1 .OR. IOPT.EQ.2) GO TO 40
+C
+C  MUST HAVE IOPT = 1 OR 2.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c     WRITE(IERF,9003)
+c9003   FORMAT(' ERROR    4 IN SETER - BAD VALUE FOR IOPT'//
+c    1         ' THE CURRENT ERROR MESSAGE FOLLOWS'///)
+        call uliber (4, ' SETER - BAD VALUE FOR IOPT', 80)
+        call uliber (4, ' SETER - THE CURRENT ERR MSG FOLLOWS', 80)
+c - NOAO 
+        GO TO 50
+C
+C  TEST FOR RECOVERY.
+C
+ 40   CONTINUE
+      IF (IOPT.EQ.2) GO TO 50
+C
+      IF (I8SAV(2,0,.FALSE.).EQ.1) RETURN
+C
+      CALL EPRIN
+      CALL FDUM
+c     STOP
+C
+ 50   CALL EPRIN
+ 60   CALL FDUM
+c     STOP
+C
+      END
+      SUBROUTINE EPRIN
+C
+      CHARACTER*1 MESSG
+C
+      CALL E9RIN(MESSG,1,.FALSE.)
+      RETURN
+C
+      END
+      SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+C
+C  THIS ROUTINE STORES THE CURRENT ERROR MESSAGE OR PRINTS THE OLD ONE,
+C  IF ANY, DEPENDING ON WHETHER OR NOT SAVE = .TRUE. .
+C
+      CHARACTER*(*) MESSG
+      CHARACTER*113 MESSGP
+      INTEGER NERRP
+      LOGICAL SAVE
+      COMMON /UERRF/IERF
+      SAVE MESSGP,NERRP
+C
+C  MESSGP STORES THE FIRST 113 CHARACTERS OF THE PREVIOUS MESSAGE
+C
+C
+C  START WITH NO PREVIOUS MESSAGE.
+C
+      DATA MESSGP/'1'/
+      DATA NERRP/0/
+C
+      IF (.NOT.SAVE) GO TO 20
+C
+C  SAVE THE MESSAGE.
+C
+        NERRP=NERR
+        MESSGP = MESSG
+C
+        GO TO 30
+C
+ 20   IF (I8SAV(1,0,.FALSE.).EQ.0) GO TO 30
+C
+C  PRINT THE MESSAGE.
+C
+c + NOAO -  FTN write rewritten as call to uliber
+c     WRITE(IERF,9000) NERRP,MESSGP
+c9000 FORMAT(' ERROR ',I4,' IN ',A113)
+      call uliber (nerrp, messgp, 113)
+C
+ 30   RETURN
+C
+      END
+      INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+C
+C  IF (ISW = 1) I8SAV RETURNS THE CURRENT ERROR NUMBER AND
+C               SETS IT TO IVALUE IF SET = .TRUE. .
+C
+C  IF (ISW = 2) I8SAV RETURNS THE CURRENT RECOVERY SWITCH AND
+C               SETS IT TO IVALUE IF SET = .TRUE. .
+C
+      LOGICAL SET
+      INTEGER LERROR, LRECOV
+      SAVE LERROR,LRECOV
+C
+C  START EXECUTION ERROR FREE AND WITH RECOVERY TURNED OFF.
+C
+      DATA LERROR/0/ , LRECOV/2/
+      IF (ISW .EQ. 1) THEN
+        I8SAV = LERROR
+        IF (SET) LERROR = IVALUE
+      ELSE IF (ISW .EQ. 2) THEN
+        I8SAV = LRECOV
+        IF (SET) LRECOV = IVALUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE FDUM
+C
+C     DUMMY ROUTINE TO BE LOCALLY IMPLEMENTED
+C
+      RETURN
+      END
+C
+      SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+C
+C DIMENSION OF           NAME(1),LBRARY(1),ENTRY(1),VRSION(1)
+C ARGUMENTS
+C
+C LATEST REVISION        MARCH 1984
+C
+C PURPOSE                MONITORS LIBRARY USE BY WRITING A RECORD WITH
+C                        INFORMATION ABOUT THE CIRCUMSTANCES OF A
+C                        LIBRARY ROUTINE CALL TO THE SYSTEM ACCOUNTING
+C                        TAPE FOR LATER PROCESSING.
+C
+C NOTE---                THIS VERSION OF Q8QST4 SIMPLY RETURNS TO THE
+C                        CALLING ROUTINE.  LOCAL IMPLEMENTORS MAY WISH
+C                        TO IMPLEMENT A VERSION OF THIS ROUTINE THAT
+C                        MONITORS USE OF NCAR ROUTINES WITH LOCAL
+C                        MECHANISMS.  OTHERWISE IT WILL SAVE A SMALL
+C                        AMOUNT OF SPACE AND TIME IF CALLS TO Q8QST4 ARE
+C                        DELETED FROM ALL NSSL ROUTINES.
+C
+      CHARACTER*(*) NAME,LBRARY,ENTRY,VRSION
+C
+      RETURN
+      END
+c + NOAO -  Blockdata uerrbd rewritten as a runtime initialization subroutine
+c     BLOCKDATA UERRBD
+      subroutine uerrbd
+c
+      COMMON /UERRF/IERF
+C     DEFAULT ERROR UNIT
+c     DATA IERF/0/
+      IERF= 0
+      END
+c -NOAO
+        subroutine uliber (errcode, pkerrmsg, msglen)
+
+        character*80 pkerrmsg
+        integer errcode, msglen
+        integer*2 sppmsg(81)
+        integer SZLINE
+        parameter (SZLINE=80)
+
+c unpack the fortran character string, call fulib to output the string.
+c
+        call f77upk (pkerrmsg, sppmsg, SZLINE)
+        call fulib  (errcode, sppmsg, msglen)
+
+        end
diff --git a/sys/gio/ncarutil/tests/README b/sys/gio/ncarutil/tests/README
new file mode 100644
index 00000000..d74bb65f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/README
@@ -0,0 +1,2 @@
+This directory contains test routines for the NCAR utilities.  The files
+ending with "t.f" are the NCAR supplied fortran test routines. 
diff --git a/sys/gio/ncarutil/tests/auto10t.f b/sys/gio/ncarutil/tests/auto10t.f
new file mode 100644
index 00000000..26109f4f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/auto10t.f
@@ -0,0 +1,262 @@
+      SUBROUTINE XMPL10
+C
+C Define the data arrays.
+C
+      REAL XDRA(1201),YDRA(1201)
+C
+C Fill the data arrays.  The independent variable represents time during
+C the year (a hypothetical year with equal-length months) and is set up
+C so that the minor ticks can be lengthened to delimit the months; the
+C major ticks, though shortened to invisibility, will determine where
+C the labels go.
+C
+      DO 101 I=1,1201
+        XDRA(I)=FLOAT(I-51)
+        YDRA(I)=COSH(FLOAT(I-601)/202.)
+  101 CONTINUE
+C
+C Change the labels on the bottom and left axes.
+C
+      CALL ANOTAT ('MONTHS OF THE YEAR$','ROMAN NUMERALS$',0,0,0,0)
+C
+C Fix the minimum and maximum values on both axes and prevent AUTOGRAPH
+C from using rounded values at the ends of the axes.
+C
+      CALL AGSETF ('X/MIN.',-50.)
+      CALL AGSETF ('X/MAX.',1150.)
+      CALL AGSETI ('X/NICE.',0)
+C
+      CALL AGSETF ('Y/MIN.',1.)
+      CALL AGSETF ('Y/MAX.',10.)
+      CALL AGSETI ('Y/NICE.',0)
+C
+C Specify the spacing between major tick marks on all axes.  Note that
+C the AUTOGRAPH dummy routine AGCHNL is supplanted (below) by one which
+C supplies dates for the bottom axis and Roman numerals for the left
+C axis in place of the numeric labels one would otherwise get.
+C
+      CALL AGSETI ('  LEFT/MAJOR/TYPE.',1)
+      CALL AGSETI (' RIGHT/MAJOR/TYPE.',1)
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1)
+      CALL AGSETI ('   TOP/MAJOR/TYPE.',1)
+C
+      CALL AGSETF ('  LEFT/MAJOR/BASE.',  1.)
+      CALL AGSETF (' RIGHT/MAJOR/BASE.',  1.)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',100.)
+      CALL AGSETF ('   TOP/MAJOR/BASE.',100.)
+C
+C Suppress minor ticks on the left and right axes.
+C
+      CALL AGSETI ('  LEFT/MINOR/SPACING.',0)
+      CALL AGSETI (' RIGHT/MINOR/SPACING.',0)
+C
+C On the bottom and top axes, put one minor tick between each pair of
+C major ticks, shorten the major ticks to invisibility, and lengthen
+C the minor ticks.  The net effect is to make the minor ticks delimit
+C the beginning and end of each month, while the major ticks, though
+C invisible, cause the names of the months to be where we want them.
+C
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',1)
+      CALL AGSETI ('   TOP/MINOR/SPACING.',1)
+C
+      CALL AGSETF ('BOTTOM/MAJOR/INWARD. ',0.)
+      CALL AGSETF ('BOTTOM/MINOR/INWARD. ',.015)
+      CALL AGSETF ('   TOP/MAJOR/INWARD. ',0.)
+      CALL AGSETF ('   TOP/MINOR/INWARD. ',.015)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,1201,'EXAMPLE 10 (MODIFIED NUMERIC LABELS)$')
+C
+c     STOP
+C
+      END
+      SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE)
+C
+      CHARACTER*(*) CHRM,CHRE
+C
+C The routine AGCHNL is called by AGAXIS just after it has set up the
+C character strings comprising a numeric label along an axis.  The
+C default version does nothing.  A user may supply his own version to
+C change the numeric labels.  For each numeric label, this routine is
+C called twice by AGAXIS - once to determine how much space will be
+C required when the label is actually drawn and once just before it
+C is actually drawn.  The arguments are as follows:
+C
+C - IAXS is the number of the axis being drawn.  Its value is 1, 2, 3,
+C   or 4, implying the left, right, bottom, or top axes, respectively.
+C   The value of IAXS must not be altered.
+C
+C - VILS is the value to be represented by the numeric label, in the
+C   label system for the axis.  The value of VILS must not be altered.
+C
+C - CHRM, on entry, is a character string containing the mantissa of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  If the
+C   numeric label includes a "times" symbol, it will be represented by
+C   a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C - MCIM is the length of CHRM - the maximum number of characters that
+C   it will hold.  The value of MCIM must not be altered.
+C
+C - NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C   CHRM is changed, NCIM should be changed accordingly.
+C
+C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it
+C   is non-zero, it is the index of the appropriate character position
+C   in CHRM.  If AGCHNL changes the position of the "times" symbol in
+C   CHRM, removes it, or adds it, the value of IPXM must be changed.
+C
+C - CHRE, on entry, is a character string containing the exponent of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  CHRE
+C   may be modified.
+C
+C - MCIE is the length of CHRE - the maximum number of characters that
+C   it will hold.  The value of MCIE must not be altered.
+C
+C - NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C   CHRE is changed, NCIE should be changed accordingly.
+C
+C Define the names of the months for use on the bottom axis.
+C
+      CHARACTER*3 MONS(12)
+      DATA MONS / 'JAN','FEB','MAR','APR','MAY','JUN',
+     +            'JUL','AUG','SEP','OCT','NOV','DEC'/
+C
+C Modify the numeric labels on the left axis.
+C
+      IF (IAXS.EQ.1) THEN
+        CALL AGCORN (IFIX(VILS),CHRM,NCIM)
+        IPXM=0
+        NCIE=0
+C
+C Modify the numeric labels on the bottom axis.
+C
+      ELSE IF (IAXS.EQ.3) THEN
+        IMON=IFIX(VILS+.5)/100+1
+        CHRM(1:3)=MONS(IMON)
+        NCIM=3
+        IPXM=0
+        NCIE=0
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE AGCORN (NTGR,BCRN,NCRN)
+C
+      CHARACTER*(*) BCRN
+C
+C This routine receives an integer in NTGR and returns its Roman-numeral
+C equivalent - NCRN characters - in the character variable BCRN.  It
+C only works for integers within a limited range and it does some rather
+C unorthodox things (like using zero and minus).
+C
+C ICH1, ICH5, and IC10 are character variables used for the single-unit,
+C five-unit, and ten-unit symbols at a given level.
+C
+      CHARACTER*1 ICH1,ICH5,IC10
+C
+C Treat numbers outside the range (-4000,+4000) as infinites.
+C
+      IF (IABS(NTGR).GE.4000) THEN
+        IF (NTGR.GT.0) THEN
+          NCRN=5
+          BCRN(1:5)='(INF)'
+        ELSE
+          NCRN=6
+          BCRN(1:6)='(-INF)'
+        END IF
+        RETURN
+      END IF
+C
+C Use the symbol '0' for the zero.  The Romans never had it so good.
+C
+      IF (NTGR.EQ.0) THEN
+        NCRN=1
+        BCRN(1:1)='0'
+        RETURN
+      END IF
+C
+C Zero the character counter.
+C
+      NCRN=0
+C
+C Handle negative integers by prefixing a minus sign.
+C
+      IF (NTGR.LT.0) THEN
+        NCRN=NCRN+1
+        BCRN(NCRN:NCRN)='-'
+      END IF
+C
+C Initialize some constants.  We'll check for thousands first.
+C
+      IMOD=10000
+      IDIV=1000
+      ICH1='M'
+C
+C Find out how many thousands (hundreds, tens, units) there are and jump
+C to the proper code block for each case.
+C
+  101 INTG=MOD(IABS(NTGR),IMOD)/IDIV
+C
+      GO TO (107,104,104,104,102,103,103,103,103,106) , INTG+1
+C
+C Four - add ICH1 followed by ICH5.
+C
+  102 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH1
+C
+C Five through eight - add ICH5, followed by INTG-5 ICH1's.
+C
+  103 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH5
+C
+      INTG=INTG-5
+      IF (INTG.LE.0) GO TO 107
+C
+C One through three - add that many ICH1's.
+C
+  104 DO 105 I=1,INTG
+        NCRN=NCRN+1
+        BCRN(NCRN:NCRN)=ICH1
+  105 CONTINUE
+C
+      GO TO 107
+C
+C Nine - add ICH1, followed by IC10.
+C
+  106 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH1
+      NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=IC10
+C
+C If we're done, exit.
+C
+  107 IF (IDIV.EQ.1) RETURN
+C
+C Otherwise, tool up for the next digit and loop back.
+C
+      IMOD=IMOD/10
+      IDIV=IDIV/10
+      IC10=ICH1
+C
+      IF (IDIV.EQ.100) THEN
+        ICH5='D'
+        ICH1='C'
+      ELSE IF (IDIV.EQ.10) THEN
+        ICH5='L'
+        ICH1='X'
+      ELSE
+        ICH5='V'
+        ICH1='I'
+      END IF
+C
+      GO TO 101
+C
+      END
diff --git a/sys/gio/ncarutil/tests/autograph.x b/sys/gio/ncarutil/tests/autograph.x
new file mode 100644
index 00000000..3c2ccb14
--- /dev/null
+++ b/sys/gio/ncarutil/tests/autograph.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+procedure t_autograph()
+
+char	device[SZ_FNAME], command[SZ_LINE]
+int	ierror, wkid, junk, cmd
+int	ctoi()
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tautog (ierror)
+	if (ierror == 0)
+	    call eprintf ("Test successful\n")
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/autographt.f b/sys/gio/ncarutil/tests/autographt.f
new file mode 100644
index 00000000..25b14518
--- /dev/null
+++ b/sys/gio/ncarutil/tests/autographt.f
@@ -0,0 +1,186 @@
+      SUBROUTINE TAUTOG	(IERROR)
+C
+C LATEST REVISION	 FEBRUARY 1985
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 AUTOGRAPH AND TO TEST AUTOGRAPH ON A
+C			 SIMPLE	PROBLEM
+C
+C USAGE			 CALL TAUTOG (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN ERROR PARAMETER
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   AUTOGRAPH TEST SUCCESSFUL  .	. .  SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS WRITTEN ON UNIT 6.
+C
+C			 IN ADDITION, FOUR (4) LABELLED	FRAMES
+C			 CONTAINING THE	TWO-DIMENSIONAL	PLOTS ARE
+C			 PRODUCED ON THE MACHINE GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 AUTOGRAPH
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN IN APRIL, 1979 AND
+C			 CONVERTED TO FORTRAN 77 AND GKS IN FEBRUARY
+C			 1985.
+C
+C ALGORITHM		 TAUTOG	COMPUTES DATA FOR AUTOGRAPH SUBROUTINES
+C
+C			   EZY,	EZXY, EZMY, AND	EZMXY,
+C
+C			 AND CALLS EACH	OF THESE ROUTINES TO PRODUCE
+C			 ONE PLOT EACH.
+C
+C			 ON THREE OF THE PLOTS,	TAUTOG USES THE
+C			 AUTOGRAPH CONTROL PARAMETER ROUTINES
+C			 AGSETF, AGSETI, AND AGSETP TO SPECIFY
+C			 Y-AXIS	LABELS OR INTRODUCE LOG	SCALING.
+C
+C PORTABILITY		 FORTRAN 77
+C
+      REAL	      X(21)	 ,Y1D(21)    ,Y2D(21,5)
+C
+C X CONTAINS THE ABSCISSA VALUES FOR THE PLOTS PRODUCED	BY EZXY	AND
+C EZMXY,  Y1D CONTAINS THE ORDINATE VALUES FOR THE PLOTS PRODUCED BY
+C EZXY AND EZY,	 AND Y2D CONTAINS THE ORDINATE VALUES FOR THE PLOTS
+C PRODUCED BY EZMY AND EZMXY.
+C
+C
+C
+C
+C FILL Y1D ARRAY FOR ENTRY EZY
+C
+      DO  10 I=1,21
+	 Y1D(I)	= EXP(-.1*FLOAT(I))*COS(FLOAT(I)*.5)
+   10 CONTINUE
+C
+C     ENTRY EZY	PLOTS THE CONTENTS OF Y1D AS A FUNCTION	OF THE INTEGERS
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZY ENTRY	OF AUTOGRAPH
+C
+      CALL EZY (Y1D(1),21,'DEMONSTRATING EZY ENTRY OF AUTOGRAPH$')
+C
+	
+C
+C
+C
+C FILL X AND Y1D ARRAYS	FOR ENTRY EZXY
+C
+      DO  20 I=1,21
+	 X(I) =	FLOAT(I-1)*.314
+	 Y1D(I)	= X(I)+COS(X(I))*2.0
+   20 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  X+COS(X)*2
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','X+COS(X)*2$')
+C
+C     ENTRY EZXY PLOTS CONTENTS	OF X-ARRAY VS. Y1D-ARRAY
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZXY ENTRY OF AUTOGRAPH
+C
+      CALL EZXY	(X,Y1D,21,'DEMONSTRATING EZXY ENTRY IN AUTOGRAPH$')
+C
+C
+C
+C
+C FILL Y2D ARRAY FOR ENTRY EZMY
+C
+      DO  40 I=1,21
+	 T = .5*FLOAT(I-1)
+	 DO  30	J=1,5
+	    Y2D(I,J) = EXP(-.5*T)*COS(T)/FLOAT(J)
+   30	 CONTINUE
+   40 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  EXP(-X/2)*COS(X)*SCALE
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','EXP(-X/2)*COS(X)*SCALE$')
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     ALPHABETIC SET OF	DASHED LINE PATTERNS IS	TO BE USED.
+C
+      CALL AGSETI('DASH/SELECTOR.',-1)
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     GRAPH DRAWN IS TO	BE LOGARITHMIC IN THE X-AXIS.
+C
+      CALL AGSETI('X/LOGARITHMIC.',1)
+C
+C     ENTRY EZMY PLOTS MULTIPLE	ARRAYS AS A FUNCTION OF	THE INTEGERS
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZMY ENTRY OF AUTOGRAPH
+C
+      CALL EZMY	(Y2D,21,5,10,'DEMONSTRATING EZMY ENTRY OF AUTOGRAPH$')
+C
+C
+C
+C
+C FILL Y2D ARRAY FOR EZMXY
+C
+      DO  60 I=1,21
+	 DO  50	J=1,5
+	    Y2D(I,J) = X(I)**J+COS(X(I))
+   50	 CONTINUE
+   60 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  X**J+COS(X)
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','X**J+COS(X)$')
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     ALPHABETIC SET OF	DASHED LINE PATTERNS IS	TO BE USED.
+C
+      CALL AGSETI('DASH/SELECTOR.',-1)
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE GRAPH
+C     IS TO BE LINEAR IN THE X-AXIS AND	LOGARITHMIC IN THE Y-AXIS.
+C
+      CALL AGSETI('X/LOGARITHMIC.',0)
+      CALL AGSETI('Y/LOGARITHMIC.',1)
+C
+C     ENTRY EZMXY PLOTS	MULTIPLE ARRAYS	AS A FUNCTION OF A SINGLE
+C		  X ARRAY (OR MANY X ARRAYS)
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH
+C
+      CALL EZMXY (X,Y2D,21,5,21,
+     +		  'DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH$')
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+      RETURN
+C
+c1001 FORMAT ('	 AUTOGRAPH TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conran.x b/sys/gio/ncarutil/tests/conran.x
new file mode 100644
index 00000000..11a4ab0d
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conran.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAN -- test NCAR contour routine CONRAN.
+
+procedure t_conran ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconan (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else {
+	    call printf ("Test was not successful. ierror = %d\n")
+		call pargi (error_code)
+	}
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrant.f b/sys/gio/ncarutil/tests/conrant.f
new file mode 100644
index 00000000..a144de35
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrant.f
@@ -0,0 +1,97 @@
+      SUBROUTINE TCONAN	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAN, THE STANDARD ENTRY POINT OF THE
+C			 CONRAN	PACKAGE.
+C
+C			 THIS SAME SUBROUTINE CAN BE USED TO PRODUCE
+C			 DEMO PLOTS OF THE SMOOTH VERSION OF CONRAN
+C			 BY LOADING DASHSMTH INSTEAD OF	DASHCHAR.
+C
+C USAGE			 CALL TCONAN (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAN LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAN TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAN
+C FILES			 CONTERP
+C			 CONCOM
+C
+C LANGUAGE		 FORTRAN77
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAN TERMINATED
+C			 NORMALLY.
+C
+C PORTABILITY		 ANSI FORTRAN77	STANDARD
+C
+C     COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAN
+C
+      DIMENSION	WK(221),IWK(744),SCR(1600)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+      call conbdn
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAN',29, 0)
+C
+      CALL CONRAN(XD,YD,ZD,NDP,WK,IWK,SCR)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/tests/conraq.x b/sys/gio/ncarutil/tests/conraq.x
new file mode 100644
index 00000000..d0480e97
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conraq.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAQ -- test NCAR contour routine CONRAQ.
+
+procedure t_conraq ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconaq (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conraqt.f b/sys/gio/ncarutil/tests/conraqt.f
new file mode 100644
index 00000000..dbf211aa
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conraqt.f
@@ -0,0 +1,139 @@
+      SUBROUTINE TCONAQ	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAQ, THE QUICK ENTRY  POINT	OF THE
+C			 CONRAN	PACKAGE.
+C
+C USAGE			 CALL TCONAQ (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE.
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAQ LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAQ TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAQ
+C FILES			 CONTERP
+C
+C LANGUAGE		 FORTRAN77
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAQ TERMINATED
+C			 NORMALLY.
+C
+      COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+C
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAQ
+C
+      DIMENSION	WK(221),IWK(744)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+C
+C  SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE
+C
+      CALL ENTSR(IROLD,1)
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAQ',29)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  SET OPTION TO DISPLAY THE TRIANGULATION
+C
+      CALL CONOP1('TRI=ON')
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  CALL	CONRAQ TO CONTOUR DATA
+C
+      CALL CONRAQ(XD,YD,ZD,NDP,WK,IWK)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C
+C  CALL	FRAME, CONRAQ WILL NOT DO THIS
+C
+cCALL NEWFM
+C
+C  PRINT MESSAGE EVERYTHING OK
+C
+c     WRITE(6,10)
+c10   FORMAT(1X,'CONRAQ	TEST SUCCESSFUL, SEE PLOT TO VERIFY',
+c    1'	PERFORMANCE')
+C
+C
+      RETURN
+C
+C  IF ERROR CALL THE PORT ERROR	PRINT ROUTINE.
+C  THIS	CALL IS	NOT NECESSARY UNLESS YOU ARE IN	RECOVER	MODE.
+C  IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL  BE PRINTED
+C  AUTOMATICALLY.
+C
+ 100  CALL EPRIN
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conras.x b/sys/gio/ncarutil/tests/conras.x
new file mode 100644
index 00000000..d2b48dc2
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conras.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAS -- test NCAR contour routine CONRAS.
+
+procedure t_conras ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconas (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrast.f b/sys/gio/ncarutil/tests/conrast.f
new file mode 100644
index 00000000..c4f3ab12
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrast.f
@@ -0,0 +1,147 @@
+      SUBROUTINE TCONAS	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAS, THE SUPER ENTRY  POINT	OF THE
+C			 CONRAN	PACKAGE.
+C
+C USAGE			 CALL TCONAS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAS LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAS TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAS
+C FILES			 CONTERP
+C			 CONCOM
+C			 DASHSUPR
+C
+C SPECIALIST		 FOR INFORMATION ABOUT THIS ROUTINE OR THE
+C			 ULIB CONRAS PACKAGE, CONTACT THE SPECIALIST
+C			 NAMED IN THE ULIB CONRAS PACKAGE.
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAS TERMINATED
+C			 NORMALLY.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAS
+C
+      DIMENSION	WK(221),IWK(744),SCR(1600)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+	COMMON /RASINT/	IRASMJ,	IRASMN,	IRASTX
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+C
+C  SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE
+C
+      CALL ENTSR(IROLD,1)
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAS',29,0)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  SET OPTION TO DISPLAY THE TRIANGULATION
+C
+      CALL CONOP1('TRI=ON')
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  CALL	CONRAS TO CONTOUR DATA
+C
+      CALL CONRAS(XD,YD,ZD,NDP,WK,IWK,SCR)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C
+C  CALL	FRAME, CONRAS WILL NOT DO THIS
+C
+c	CALL NEWFM
+C
+C  PRINT MESSAGE EVERYTHING OK
+C
+c     WRITE(6,10)
+c10   FORMAT(1X,'CONRAS	TEST SUCCESSFUL, SEE PLOT TO VERIFY ',
+c    1'PERFORMANCE')
+C
+C
+      RETURN
+C
+C  IF ERROR CALL THE PORT ERROR	PRINT ROUTINE.
+C  THIS	CALL IS	NOT NECESSARY UNLESS YOU ARE IN	RECOVER	MODE.
+C  IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL  BE PRINTED
+C  AUTOMATICALLY.
+C
+ 100  CALL EPRIN
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conrcqckt.f b/sys/gio/ncarutil/tests/conrcqckt.f
new file mode 100644
index 00000000..d9d2f827
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcqckt.f
@@ -0,0 +1,114 @@
+      SUBROUTINE TCNQCK	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECQCK AND TO TEST CONRECQCK ON A SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNQCK (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECQCK TEST SUCCESSFUL  .	. . SEE	PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNQCK	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/.4267/, TY/.9765/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECQCK
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECQCK',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECQCK
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECQCK',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	 CONRECQCK TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+C---------------------------------------------------------------------
+C REVISION HISTORY
+C
+C JUNE 1984			CONVERTED TO FORTRAN 77	AND GKS
+C
+C---------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/tests/conrcsmtht.f b/sys/gio/ncarutil/tests/conrcsmtht.f
new file mode 100644
index 00000000..735d109a
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcsmtht.f
@@ -0,0 +1,122 @@
+      SUBROUTINE TCNSMT	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECSMTH AND	TO TEST	CONRECSMTH ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNSMT (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECSMTH TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNSMT	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77	STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+c      DATA TX/0.42676/,	TY/0.97656/
+      TX = 0.42676
+      TY = 0.97656
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMAIZATION TRANS NUMBER TO WRITE TITLES
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSMTH
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECSMTH',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSMTH
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECSMTH',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+c     CALL NEWFM
+C
+c      WRITE (6,1001)
+      RETURN
+C
+c 1001 FORMAT ('	CONRECSMTH TEST	SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+C
+C---------------------------------------------------------------------
+C
+C REVISION HISTORY
+C
+C     JUNE 1984			 CONVERTED TO FORTRAN 77 AND GKS
+C
+C---------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/tests/conrcsprt.f b/sys/gio/ncarutil/tests/conrcsprt.f
new file mode 100644
index 00000000..484d1ccc
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcsprt.f
@@ -0,0 +1,110 @@
+      SUBROUTINE TCNSUP	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECSUPR AND	TO TEST	CONRECSUPR ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNSUP (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECSUPR TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNSUP	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/0.4219/, TY/0.9765/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSUPR
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECSUPR',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.  ALSO THE LABELLING OF THE	HIGHS AND LOWS IS SUPRESSED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSUPR
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECSUPR',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,-1,0)
+      CALL NEWFM
+C
+      WRITE (6,1001)
+      RETURN
+C
+ 1001 FORMAT ('	CONRECSUPR TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conrec.x b/sys/gio/ncarutil/tests/conrec.x
new file mode 100644
index 00000000..2d9adfe5
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrec.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONREC -- test NCAR contour routine CONREC.
+
+procedure t_conrec ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconre (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrect.f b/sys/gio/ncarutil/tests/conrect.f
new file mode 100644
index 00000000..401aad9b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrect.f
@@ -0,0 +1,118 @@
+      SUBROUTINE TCONRE	(nplot, IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONREC	AND TO TEST CONREC ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCONRE (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONREC TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCONRE	CALL SUBROUTINES EZCNTR, CONREC, AND
+C			 PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 FORTRAN77
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+C     DATA TX/.3955/, TY/.9765/
+	data tx/.4267/, ty/.97/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION NUMBER 0
+C
+      CALL GSELNT ( 0 )
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC
+C
+c +noao: flag added to plot either EZCNTR or CONREC
+      if (nplot .eq. 1) then
+      CALL WTSTR ( TX, TY,
+     1		 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC',2,0,0 )
+      CALL EZCNTR (Z,21,25)
+      endif
+c -noao
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC
+C
+c +noao:  flag added to plot either EZCNTR of CONREC
+      if (nplot .eq. 2) then
+      CALL WTSTR ( TX ,TY,
+     1		 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC',2,0,0 )
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+      endif
+c -noao
+c     CALL NEWFM
+C
+C     WRITE (6,1001)
+      RETURN
+C
+C1001 FORMAT ('	    CONREC TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashchar.x b/sys/gio/ncarutil/tests/dashchar.x
new file mode 100644
index 00000000..77430f37
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashchar.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routine DASHCHAR
+
+procedure t_dashchar()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	 gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tdashc (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/dashchart.f b/sys/gio/ncarutil/tests/dashchart.f
new file mode 100644
index 00000000..fa583b84
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashchart.f
@@ -0,0 +1,145 @@
+      SUBROUTINE TDASHC	(IERROR)
+C
+C LATEST REVISION	 MAY 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHCHAR
+C			 AND TO	TEST DASHCHAR ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHC (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHCHAR TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHCHAR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHC	UTILIZES THE SOFTWARE DASHCHAR
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD, VECTD,
+C			 LINED AND CURVED TO DRAW FIVE CURVES ON ONE
+C			 PICTURE USING FIVE DIFFERENT DASHCHAR
+C			 PATTERNS.  EACH CURVE IS CENTERED ABOUT
+C			 SOLID AXIS LINES AND LABELLED WITH THE
+C			 CHARACTER REPRESENTATION OF THE DASHCHAR
+C			 PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY-IMPLEMENTED SUPPORT
+C ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHCHAR	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHCHAR')
+      CALL GTX (.5,.015,'IN IPAT STRINGS, A AND	D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND	DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+c + noao: no need for clearing terminal
+c     CALL NEWFM
+c - noao
+C
+      IERROR = 0
+C      WRITE (6,1001)
+C
+      RETURN
+C
+C
+C1001 FORMAT ('	  DASHCHAR TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashlinet.f b/sys/gio/ncarutil/tests/dashlinet.f
new file mode 100644
index 00000000..c857428c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashlinet.f
@@ -0,0 +1,138 @@
+      SUBROUTINE TDASHL	(IERROR)
+C
+C LATEST REVISION	 APRIL 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHLINE
+C			 AND TO	TEST DASHLINE ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHL (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHLINE TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHLINE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHL	UTILIZES THE SOFTWARE DASHLINE
+C			 SUBROUTINES DASHDB, FRSTD, VECTD, LINED AND
+C			 CURVED	TO DRAW	FIVE CURVES ON ONE PICTURE
+C			 USING FIVE DIFFERENT DASHLINE PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE BINARY REPRESENTATION OF THE
+C			 DASHLINE PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C COORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)	     ,IPAT(5)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED
+C SUPPORT ROUTINES) ARE	USED.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+C ARRAY	IPAT CONTAINS 5	DIFFERENT 16-BIT DASH PATTERNS.	 THE PATTERNS
+C CONSTRUCTED WITH BOOLEAN OPERATIONS AS ABOVE.
+C THE BINARY REPRESENTATIONS OF	THE PATTERNS ARE
+C	 0001110001111111
+C	 1111000011110000
+C	 1111110011111100
+C	 1111111100000000
+C	 1111111111111100
+C
+      IPAT(1) =	IOR (ISHIFT ( 3647,1), 1)
+      IPAT(2) =	ISHIFT (30840,1)
+      IPAT(3) =	ISHIFT (32382,1)
+      IPAT(4) =	ISHIFT (32640,1)
+      IPAT(5) =	ISHIFT (32766,1)
+C
+      DO  70 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LINED (.109,ORG,.891,ORG)
+	 CALL DASHDB (IPAT(K))
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  10	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   10	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE BINARY REPRESENTATION OF
+C	THE DASHLINE PATTERN
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+      CALL GSCHH(.012)
+C
+	 ORY = ORG+.09
+	 GO TO ( 20, 30, 40, 50, 60),K
+   20	 CALL GTX (.1,ORY,'IPAT=0001110001111111')
+	 GO TO	70
+   30	 CALL GTX (.1,ORY,'IPAT=1111000011110000')
+	 GO TO	70
+   40	 CALL GTX (.1,ORY,'IPAT=1111110011111100')
+	 GO TO	70
+   50	 CALL GTX (.1,ORY,'IPAT=1111111100000000')
+	 GO TO	70
+   60	 CALL GTX (.1,ORY,'IPAT=1111111111111100')
+C
+   70 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHLINE')
+C
+C ADVANCE FRAME
+C
+      CALL NEWFM
+C
+      IERROR = 0
+      WRITE (6,1001)
+C
+      RETURN
+C
+ 1001 FORMAT ('	  DASHLINE TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashsmth.x b/sys/gio/ncarutil/tests/dashsmth.x
new file mode 100644
index 00000000..4bca9807
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsmth.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routine DASHSMTH
+
+procedure t_dashsmth()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	 gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tdashs (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/dashsmtht.f b/sys/gio/ncarutil/tests/dashsmtht.f
new file mode 100644
index 00000000..147d5139
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsmtht.f
@@ -0,0 +1,144 @@
+      SUBROUTINE TDASHS	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHSMTH
+C			 AND TO	TEST DASHSMTH ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHSMTH TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHSMTH
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHS	UTILIZES THE SOFTWARE DASHSMTH
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD,
+C			 VECTD,	LASTD, LINED AND CURVED	TO
+C			 DRAW FIVE CURVES ON ONE PICTURE USING
+C			 FIVE DIFFERENT	DASHSMTH PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE CHARACTER REPRESENTATION OF
+C			 THE DASHSMTH PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED SUPPORT
+C ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LASTD
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHSMTH	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHSMTH')
+      CALL GTX (.5,.015,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c      WRITE (6,1001)
+C
+      RETURN
+C
+c 1001 FORMAT ('	  DASHSMTH TEST	SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashsuprt.f b/sys/gio/ncarutil/tests/dashsuprt.f
new file mode 100644
index 00000000..f35c9c8b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsuprt.f
@@ -0,0 +1,151 @@
+      SUBROUTINE TDASHP	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHSUPR
+C			 AND TO	TEST DASHSUPR ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHP (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHSUPR TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHSUPR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHP	UTILIZES THE SOFTWARE DASHSUPR
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD,
+C			 VECTD,	LASTD, LINED AND CURVED	TO
+C			 DRAW FIVE CURVES ON ONE PICTURE USING
+C			 FIVE DIFFERENT	DASHSMTH PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE CHARACTER REPRESENTATION OF
+C			 THE DASHSUPR PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C RESET	 INITIALIZES THE MODEL PICTURE ARRAY AND SHOULD	BE CALLED WITH
+C EACH NEW FRAME AND BEFORE THE	OTHER SUBROUTINES OF THE DASHSUPR
+C PACKAGE.
+C
+      CALL RESET
+C
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED PLOT PACKAGE
+C SUPPORT ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LASTD
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHSMTH	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHSUPR')
+      CALL GTX (.5,.013,'IN IPAT STRINGS, A AND	D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND	DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+      CALL NEWFM
+C
+      IERROR = 0
+      WRITE (6,1001)
+C
+      RETURN
+C
+ 1001 FORMAT ('	  DASHSUPR TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezconrec.x b/sys/gio/ncarutil/tests/ezconrec.x
new file mode 100644
index 00000000..afb0775c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezconrec.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_EZCONREC -- test NCAR contour routine EZCNTR.
+
+procedure t_ezconrec ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconre (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/ezhafton.x b/sys/gio/ncarutil/tests/ezhafton.x
new file mode 100644
index 00000000..e1cbbc2c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezhafton.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+procedure t_ezhafton
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call zhafto (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezhaftont.f b/sys/gio/ncarutil/tests/ezhaftont.f
new file mode 100644
index 00000000..b3fcee3b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezhaftont.f
@@ -0,0 +1,123 @@
+      SUBROUTINE ZHAFTO	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 EZHAFTON AND TO TEST HAFTON ON A SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL ZHAFTO (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   HAFTON TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 HALF-TONE PLOT	ARE PRODUCED ON	THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE IF THE
+C			 TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 HAFTON
+C FILES
+C
+C LANGUAGE		 ANSI FORTRAN 77
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 THAFTO	CALLS SUBROUTINES EZHFTN AND HAFTON TO
+C			 DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE LEFT	EDGE OF	THE TITLE STRING.
+C
+      DATA TX/0.0762/, TY/0.9769/
+C
+C SPECIFY SOME ARGUMENT	VALUES FOR ROUTINE HAFTON.
+C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI
+C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV
+C SPECIFIES THE	NUMBER OF UNIQUE LEVELS	BETWEEN	FLO AND	FHI,  THE
+C ABSOLUTE VALUE OF NOPT DETERMINES THE	MAPPING	OF Z ONTO THE
+C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR
+C INVERSNESS OF	THE MAPPING.
+C
+      DATA FLO/-4.0/, FHI/4.0/,	NLEV/8/, NOPT/-3/
+C
+C
+      SAVE
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE
+C
+      CALL GSELNT (0)
+C
+C
+C
+C ENTRY	EZHFTN REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON
+C
+      CALL WTSTR (TX,TY,
+     1		'DEMONSTRATION PLOT FOR	ENTRY EZHFTN OF	HAFTON',2,0,-1)
+      CALL EZHFTN (Z,21,25)
+C
+C ENTRY	HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON
+C
+c     CALL GSELNT (0)
+c     CALL WTSTR (TX,TY,
+c    1		'DEMONSTRATION PLOT FOR	ENTRY HAFTON OF	HAFTON',2,0,-1)
+c     CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	    HAFTON TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezisosrf.x b/sys/gio/ncarutil/tests/ezisosrf.x
new file mode 100644
index 00000000..21257526
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezisosrf.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine EZISOSRF
+
+procedure t_ezisos()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tisosr (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezmapg.x b/sys/gio/ncarutil/tests/ezmapg.x
new file mode 100644
index 00000000..d2f7dce1
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapg.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine SUPMAP of the EZMAPG utility.
+
+procedure t_ezmapg()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsupma (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezmapgt.f b/sys/gio/ncarutil/tests/ezmapgt.f
new file mode 100644
index 00000000..fab53ce0
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapgt.f
@@ -0,0 +1,318 @@
+      SUBROUTINE TSUPMA	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF THE
+C			 SUPMAP	AND MAPDRW ENTRYS OF EZMAPG.
+C
+C USAGE			 CALL TSUPMA (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			 = 0 IF	THE TEST WAS SUCCESSFUL
+C			 = 1 OTHERWISE
+C
+C I/O			 IF EACH CALL TO ROUTINE SUPMAP	RESULTS	IN
+C			 A NORMAL SUPMAP EXIT, THE MESSAGE
+C			   SUPMAP TEST SUCCESSFUL  . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED ON UNIT 6.
+C
+C			 TEN CONTINENTAL OUTLINE PLOTS,	EACH
+C			 RESULTING FROM	A DIFFERENT SPECIFIED
+C			 PROJECTION, ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 EZMAPG
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP	ONCE
+C			 FOR EACH OF THE NINE PROJECTION TYPES
+C			 IN SUPMAP.  SPECIFICALLY, THESE ARE
+C			   STEREOGRAPHIC
+C			   ORTHOGRAPHIC
+C			   LAMBERT CONFORMAL CONIC WITH	TWO
+C			     STANDARD PARALLELS
+C			   LAMBERT EQUAL AREA
+C			   GNOMONIC
+C			   AZIMUTHAL EQUIDISTANT
+C			   CYLINDRICAL EQUIDISTANT
+C			   MERCATOR
+C			   MOLLWEIDE TYPE
+C			 THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW
+C			 PROJECTION.
+C
+C HISTORY		 WRITTEN OCTOBER, 1976
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C COMMON BLOCK FOR SATELLITE VIEW PROJECTION
+C
+      COMMON /SATMAP/ SL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT PLOTTER GRID
+C WHERE	THE  COORDINATES RANGE FROM 0.0	TO 1.0,	THE VALUES TX
+C AND TY DEFINE	THE CENTER OF THE TITLE	STRING.
+C
+      DATA TX/0.5/, TY/0.9765/
+C
+C INITIALIZE ERROR FLAG
+C
+      IERROR = 0
+C
+C CHECK	PERFORMANCE CRITERION
+C SPECIFY PARAMETERS BEFORE EACH SUPMAP	CALL
+C
+      IPROJ = 1
+      POLAT = 80.
+      POLONG = -160.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+C
+C SELECT NORMALIZATION TRANS 0 TO WRITE	TITLE
+C
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	STEREOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c     CALL NEWFM
+      IF (IER .EQ. 0) GO TO 10
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   10 CONTINUE
+C
+C
+      IPROJ = 2
+      POLAT = 60.
+      POLONG = -120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	ORTHOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  20
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   20 CONTINUE
+C
+C
+      IPROJ = -3
+      POLAT = 45.
+      POLONG = -100.
+      ROT = 45.
+      PL1 = 50.
+      PL2 = -130.
+      PL3 = 20.
+      PL4 = -75.
+      JLTS = 2
+      JGRID = 10
+      IUSOUT = 1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	      'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION'
+     2	      ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance is handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  30
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   30 CONTINUE
+C
+C
+      IPROJ = 4
+      POLAT = 20.
+      POLONG = -40.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		'SUPMAP	DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance is handled by calling routine
+c     CALL NEWFM
+c -nooa
+      IF (IER .EQ. 0) GO TO  40
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+C     WRITE (6,1001) IPROJ
+      IERROR = 1
+   40 CONTINUE
+C
+C
+      IPROJ = 5
+      POLAT = 0.
+      POLONG = 0.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	GNOMONIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  50
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   50 CONTINUE
+C
+C
+      IPROJ = 6
+      POLAT = -20.
+      POLONG = 40.
+      JGRID = 5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	     'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION',
+     2	      2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  60
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   60 CONTINUE
+C
+C
+      IPROJ = 8
+      POLAT = -40.
+      POLONG = 80.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	   'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION'
+     2	   ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  70
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   70 CONTINUE
+C
+C
+      IPROJ = 9
+      POLAT = -60.
+      POLONG = 120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MERCATOR PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  80
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   80 CONTINUE
+C
+C
+      IPROJ = 10
+      POLAT = -80.
+      POLONG = 160.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MOLLWEIDE TYPE PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO 90
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   90 CONTINUE
+C
+C DEMONSTRATION	OF SATELLITE VIEW PROJECTION
+C
+      SL = 6.5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'EZMAPG DEMONSTRATION:	SATELLITE VIEW PROJECTION',
+     2		 2,0,0)
+      CALL MAPROJ('OR',0.0,-135.0,0.0)
+      CALL MAPSET('MA',0.0,0.0,0.0,0.0)
+      CALL MAPDRW
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+C
+C
+c     IF (IERROR .EQ. 0) WRITE (6,1002)
+c     IF (IERROR .EQ. 1) WRITE (6,1003)
+      RETURN
+C
+C
+c1001 FORMAT ('	SUPMAP RETURNED	ERROR FLAG','	IPROJ=',I4/)
+c1002 FORMAT('	   SUPMAP TEST SUCCESSFUL',24X,
+c    1	     'SEE PLOT TO VERIFY PERFORMANCE')
+c1003 FORMAT ('	    SUPMAP TEST	UNSUCCESSFUL')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezmapt.f b/sys/gio/ncarutil/tests/ezmapt.f
new file mode 100644
index 00000000..330fe6e2
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapt.f
@@ -0,0 +1,300 @@
+      SUBROUTINE TSUPMA	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF THE
+C			 SUPMAP	AND MAPDRW ENTRYS OF EZMAPG.
+C
+C USAGE			 CALL TSUPMA (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			 = 0 IF	THE TEST WAS SUCCESSFUL
+C			 = 1 OTHERWISE
+C
+C I/O			 IF EACH CALL TO ROUTINE SUPMAP	RESULTS	IN
+C			 A NORMAL SUPMAP EXIT, THE MESSAGE
+C			   SUPMAP TEST SUCCESSFUL  . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED ON UNIT 6.
+C
+C			 TEN CONTINENTAL OUTLINE PLOTS,	EACH
+C			 RESULTING FROM	A DIFFERENT SPECIFIED
+C			 PROJECTION, ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 EZMAPG
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP	ONCE
+C			 FOR EACH OF THE NINE PROJECTION TYPES
+C			 IN SUPMAP.  SPECIFICALLY, THESE ARE
+C			   STEREOGRAPHIC
+C			   ORTHOGRAPHIC
+C			   LAMBERT CONFORMAL CONIC WITH	TWO
+C			     STANDARD PARALLELS
+C			   LAMBERT EQUAL AREA
+C			   GNOMONIC
+C			   AZIMUTHAL EQUIDISTANT
+C			   CYLINDRICAL EQUIDISTANT
+C			   MERCATOR
+C			   MOLLWEIDE TYPE
+C			 THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW
+C			 PROJECTION.
+C
+C HISTORY		 WRITTEN OCTOBER, 1976
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C COMMON BLOCK FOR SATELLITE VIEW PROJECTION
+C
+      COMMON /SATMAP/ SL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT PLOTTER GRID
+C WHERE	THE  COORDINATES RANGE FROM 0.0	TO 1.0,	THE VALUES TX
+C AND TY DEFINE	THE CENTER OF THE TITLE	STRING.
+C
+      DATA TX/0.5/, TY/0.9765/
+C
+C INITIALIZE ERROR FLAG
+C
+      IERROR = 0
+C
+C CHECK	PERFORMANCE CRITERION
+C SPECIFY PARAMETERS BEFORE EACH SUPMAP	CALL
+C
+      IPROJ = 1
+      POLAT = 80.
+      POLONG = -160.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+C
+C SELECT NORMALIZATION TRANS 0 TO WRITE	TITLE
+C
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	STEREOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO 10
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   10 CONTINUE
+C
+C
+      IPROJ = 2
+      POLAT = 60.
+      POLONG = -120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	ORTHOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  20
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   20 CONTINUE
+C
+C
+      IPROJ = -3
+      POLAT = 45.
+      POLONG = -100.
+      ROT = 45.
+      PL1 = 50.
+      PL2 = -130.
+      PL3 = 20.
+      PL4 = -75.
+      JLTS = 2
+      JGRID = 10
+      IUSOUT = 1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	      'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION'
+     2	      ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  30
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   30 CONTINUE
+C
+C
+      IPROJ = 4
+      POLAT = 20.
+      POLONG = -40.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = 0
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		'SUPMAP	DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  40
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   40 CONTINUE
+C
+C
+      IPROJ = 5
+      POLAT = 0.
+      POLONG = 0.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	GNOMONIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  50
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   50 CONTINUE
+C
+C
+      IPROJ = 6
+      POLAT = -20.
+      POLONG = 40.
+      JGRID = 5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	     'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION',
+     2	      2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  60
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   60 CONTINUE
+C
+C
+      IPROJ = 8
+      POLAT = -40.
+      POLONG = 80.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	   'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION'
+     2	   ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  70
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   70 CONTINUE
+C
+C
+      IPROJ = 9
+      POLAT = -60.
+      POLONG = 120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MERCATOR PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  80
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   80 CONTINUE
+C
+C
+      IPROJ = 10
+      POLAT = -80.
+      POLONG = 160.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MOLLWEIDE TYPE PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO 90
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   90 CONTINUE
+C
+C DEMONSTRATION	OF SATELLITE VIEW PROJECTION
+C
+      SL = 6.5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'EZMAPG DEMONSTRATION:	SATELLITE VIEW PROJECTION',
+     2		 2,0,0)
+      CALL MAPROJ('OR',0.0,-135.0,0.0)
+      CALL MAPSET('MA',0.0,0.0,0.0,0.0)
+      CALL MAPDRW
+      CALL FRAME
+C
+C
+      IF (IERROR .EQ. 0) WRITE (6,1002)
+      IF (IERROR .EQ. 1) WRITE (6,1003)
+      RETURN
+C
+C
+ 1001 FORMAT ('	SUPMAP RETURNED	ERROR FLAG','	IPROJ=',I4/)
+ 1002 FORMAT('	   SUPMAP TEST SUCCESSFUL',24X,
+     1	     'SEE PLOT TO VERIFY PERFORMANCE')
+ 1003 FORMAT ('	    SUPMAP TEST	UNSUCCESSFUL')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezsurface.x b/sys/gio/ncarutil/tests/ezsurface.x
new file mode 100644
index 00000000..75abf061
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezsurface.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine EZSRF.
+
+procedure t_ezsurface()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsrfac (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test of EZSRF successful\n")
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezvelvect.x b/sys/gio/ncarutil/tests/ezvelvect.x
new file mode 100644
index 00000000..aeb5a5ab
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezvelvect.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines EZVELVEC
+
+procedure t_ezvelvect()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tvelvc (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezytst.x b/sys/gio/ncarutil/tests/ezytst.x
new file mode 100644
index 00000000..b3ac1cb1
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezytst.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+task ezytst = t_ezytst
+
+procedure t_ezytst()
+
+char	device[SZ_FNAME], title[SZ_LINE]
+int	wkid, i
+real	y_vector[512]
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	# Construct vector to be plotted
+	do i = 1, 512
+	    y_vector[i] = i
+
+	call strcpy ("TIMING TEST: 512 POINT VECTOR$", title, SZ_LINE)
+	call ezy (y_vector(1), 512, 'Timing Test: 512 Point Vector$')
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/hafton.x b/sys/gio/ncarutil/tests/hafton.x
new file mode 100644
index 00000000..63795b22
--- /dev/null
+++ b/sys/gio/ncarutil/tests/hafton.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+procedure t_hafton
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call thafto (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/haftont.f b/sys/gio/ncarutil/tests/haftont.f
new file mode 100644
index 00000000..b4cfe017
--- /dev/null
+++ b/sys/gio/ncarutil/tests/haftont.f
@@ -0,0 +1,123 @@
+      SUBROUTINE THAFTO	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 HAFTON	AND TO TEST HAFTON ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL THAFTO (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   HAFTON TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 HALF-TONE PLOT	ARE PRODUCED ON	THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE IF THE
+C			 TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 HAFTON
+C FILES
+C
+C LANGUAGE		 ANSI FORTRAN 77
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 THAFTO	CALLS SUBROUTINES EZHFTN AND HAFTON TO
+C			 DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE LEFT	EDGE OF	THE TITLE STRING.
+C
+      DATA TX/0.0762/, TY/0.9769/
+C
+C SPECIFY SOME ARGUMENT	VALUES FOR ROUTINE HAFTON.
+C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI
+C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV
+C SPECIFIES THE	NUMBER OF UNIQUE LEVELS	BETWEEN	FLO AND	FHI,  THE
+C ABSOLUTE VALUE OF NOPT DETERMINES THE	MAPPING	OF Z ONTO THE
+C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR
+C INVERSNESS OF	THE MAPPING.
+C
+      DATA FLO/-4.0/, FHI/4.0/,	NLEV/8/, NOPT/-3/
+C
+C
+      SAVE
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE
+C
+c     CALL GSELNT (0)
+C
+C
+C
+C ENTRY	EZHFTN REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON
+C
+c     CALL WTSTR (TX,TY,
+c    1		'DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON',2,0,-1)
+c     CALL EZHFTN (Z,21,25)
+C
+C ENTRY	HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON
+C
+      CALL GSELNT (0)
+      CALL WTSTR (TX,TY,
+     1		'DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON',2,0,-1)
+      CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	    HAFTON TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/isosrf.x b/sys/gio/ncarutil/tests/isosrf.x
new file mode 100644
index 00000000..1216db50
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrf.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine ISOSRFHR
+
+procedure t_isosrf()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tisosr (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/isosrfhrt.f b/sys/gio/ncarutil/tests/isosrfhrt.f
new file mode 100644
index 00000000..1d8fb249
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrfhrt.f
@@ -0,0 +1,165 @@
+      SUBROUTINE TISOHR	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE  ISOSRFHR	PACKAGE
+C
+C USAGE			 CALL TISOHR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ISOSRFHR	ROUTINES
+C			   =1 OTHERWISE
+C
+C I/O			 THIS ROUTINE REQUIRES UNIT IUNIT FOR SCRATCH
+C			 PURPOSES.  USERS SHOULD PUT THE UNITS LABELLED
+C			 COMMON	(SEE BELOW) IN THE CALLING PROGRAM,
+C			 AND ALSO SET THE VALUE	OF THE COMMON VARIABLE
+C			 IUNIT IN THE CALLING PROGRAM.
+C
+C			 IF THERE IS A NORMAL EXIT FROM	THE
+C			 ISOSRFHR  ROUTINES THE	MESSAGE
+C			   ISOSRFHR TEST SUCCESSFUL . .	. SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C			 ALSO, A SAMPLE	PLOT IS
+C			 PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  ONE MUST EXAMINE THIS	PLOT
+C			 TO DETERMINE IF THE ROUTINES HAVE
+C			 EXECUTED CORRECTLY.
+C
+C COMMON BLOCKS		 UNITS
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRFHR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THIS SUBROUTINE USES THE ROUTINES IN
+C			 THE PACKAGE  ISOSRFHR	TO DRAW	A PERSPECTIVE
+C			 DRAWING OF TWO	INTERLOCKING DOUGHNUTS
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      DIMENSION	      EYE(3)	 ,S(4)	     ,IS2(4,200) ,
+     1		      ST1(81,51,2)	     ,IOBJS(81,51)
+      COMMON /UNITS/  IUNIT
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 1 TO 1024,	THE VALUES IX AND IY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA IX/448/, IY/990/
+C
+C
+C     DEFINE THE EYE POSITION
+C
+      DATA	      EYE(1), EYE(2), EYE(3) / 200., 250., 250.	/
+C
+C     DEFINE THE OVERALL DIMENSION OF THE BOX CONTAINING THE OBJECTS
+C
+      DATA	      NU, NV, NW /  51,	81, 51 /
+C
+C     SPECIFY THE DIMENSIONS OF	THE MODEL OF THE IMAGE PLANE
+C
+      DATA	      LX, NX, NY / 4, 180, 180 /
+C
+C     SPECIFY  CRT  COORDINATES	OF THE AREA WHERE THE PICTURE
+C     IS TO BE DRAWN
+C
+      DATA	      S(1),S(2),S(3),S(4)/ 10.,1010.,10.,1010./
+      DATA	      MV / 81 /
+C
+C     SPECIFY THE LARGE	AND SMALL RADII	FOR THE	INDIVIDUAL DOUGHNUTS
+C
+      DATA	      RBIG1,RBIG2,RSML1,RSML2/ 20., 20., 6., 6.	/
+C
+      SAVE
+C
+C     CALL THE INITIALIZATION ROUTINE
+C
+      CALL INIT3D (EYE,NU,NV,NW,ST1,LX,NY,IS2,IUNIT,S)
+C
+C     INITIALIZE THE ERRROR FLAG
+C
+      IERROR = 1
+C
+C     CREATE AND PLOT DATA FOR TWO INTERLOCKING	DOUGHNUTS
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  70 IBKWDS=1,NU
+	 I = NU+1-IBKWDS
+C
+C     CREATE THE I-TH CROSS SECTION IN THE U DIRECTION OF THE
+C     THREE-DIMENSIONAL	ARRAY AND STORE	IN  IOBJS  AS ZEROS AND	ONES
+C
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       TEMP = AMIN1(FIMID**2+FJP1**2+FKP1**2-RSML1**2,
+     1				      FKMID**2+FIP2**2+FJP2**2-RSML2**2)
+	       IF (TEMP	.LE. 0.) IOBJS(J,K) = 1
+	       IF (TEMP	.GT. 0.) IOBJS(J,K) = 0
+   10	    CONTINUE
+   20	 CONTINUE
+C
+C     SET PROPER WORDS TO  1  FOR DRAWING AXES
+C
+	 IF (I .NE. 1) GO TO  50
+	 DO  30	K=1,NW
+	    IOBJS(1,K) = 1
+   30	 CONTINUE
+	 DO  40	J=1,NV
+	    IOBJS(J,1) = 1
+   40	 CONTINUE
+	 GO TO	60
+   50	 CONTINUE
+	 IOBJS(1,1) = 1
+   60	 CONTINUE
+C
+C     CALL THE DRAW AND	REMEMBER ROUTINE FOR THIS SLAB
+C
+	 CALL DANDR (NV,NW,ST1,LX,NX,NY,IS2,IUNIT,S,IOBJS,MV)
+   70 CONTINUE
+C
+C    TITLE THE PLOT
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = PAU2FX(IX)
+      YC = PAU2FY(IY)
+      CALL WTSTR(XC,YC,'DEMONSTRATION PLOT FOR ISOSRFHR',2,0,0)
+      CALL GSELNT(ICN)
+C
+C     ADVANCE THE PLOTTING DEVICE
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	  ISOSRFHR TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/isosrft.f b/sys/gio/ncarutil/tests/isosrft.f
new file mode 100644
index 00000000..1e99e02e
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrft.f
@@ -0,0 +1,137 @@
+      SUBROUTINE TISOSR	(nplot, IERROR)
+C
+C LATEST REVISION	 DECEMBER 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ISOSRF	AND TO TEST ISOSRF ON A	SINGLE PROBLEM
+C
+C USAGE			 CALL TISOSR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   ISOSRF TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS WRITTEN ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	SAMPLE
+C			 PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRF	FROM ULIB LIBRARY
+C FILES
+C
+C LANGUAGE		 STANDARD FORTRAN77
+C
+C HISTORY		 WRITTEN  BY MEMBERS OF	THE
+C			 SCIENTIFIC COMPUTING DIVISION OF NCAR,
+C			 BOULDER COLORADO
+C
+C ALGORITHM		 A FUNCTION OF THREE VARIABLES IS DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A THREE DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE CALLS EZISOS AND ISOSRF TO DRAW ISO-
+C			 VALUED	SURFACE	PLOTS OF THE FUNCTION.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      SAVE
+      DIMENSION	      T(21,31,19),SLAB(33,33),EYE(3)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 1 TO 1024,	THE VALUES IX AND IY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      REAL IX,IY
+      DATA IX/.44/, IY/.95/
+C
+      DATA NU,NV,NW/21,31,19/
+      DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
+      DATA TISO/0./
+      DATA MUVWP2/33/
+      DATA IFLAG/-7/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  30 I=1,NU
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       T(I,J,K)	= AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
+     1			  RSML1*RSML1,
+     2			    FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
+   10	    CONTINUE
+   20	 CONTINUE
+   30 CONTINUE
+C
+C DEFINE EYE POSITION
+C
+      EYE(1) = 100.
+      EYE(2) = 150.
+      EYE(3) = 125.
+C
+C LABEL	THE PLOT TO BE DRAWN BY	EZISOS
+C
+      if (nplot .eq. 1) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF',
+     1 2,0,0)
+C
+C TEST EZISOS
+C
+      CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO)
+      endif
+C
+C LABEL	THE PLOT TO BE DRAWN BY	ISOSRF
+C
+      if (nplot .eq. 2) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF',
+     1 2,0,0)
+C
+C TEST ISOSRF WITH SUBARRAY OF T
+C
+      MU=NU/2
+      MV=NV/2
+      MW=NW/2
+      MUVWP2=MAX0(MU,MV,MW)+2
+      CALL ISOSRF(T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG)
+      endif
+c     CALL FRAME
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    ISOSRF TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/mkpkg b/sys/gio/ncarutil/tests/mkpkg
new file mode 100644
index 00000000..79beff4f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/mkpkg
@@ -0,0 +1,65 @@
+# Make the x_ncartest.e executable for testing the NCAR utilities.
+	#conraq.x	<error.h> <gset.h>
+	#conraqt.f
+	#conras.x	<error.h> <gset.h>
+	#conrast.f
+	#conrcqckt.f
+	#conrcsmtht.f
+	#conrcsprt.f
+	#dashchar.x	
+	#dashchart.f
+	#dashlinet.f
+	#dashsuprt.f
+	#ezmapg.x	<error.h> <gset.h>
+	#ezmapgt.f
+	#ezmapt.f
+	#isosrfhrt.f
+
+$update libpkg.a
+$omake	x_ncartest.x
+$link	x_ncartest.o libpkg.a -lncar -lgks -o /tmp2/newncar/x_ncartest.e
+$exit
+
+libpkg.a:
+	auto10t.f
+	autograph.x	<ctype.h> <error.h> <gset.h>
+	autographt.f
+	conran.x	<error.h> <gset.h>
+	conrant.f
+	conrec.x	<error.h> <gset.h>
+	conrect.f
+	dashsmth.x	
+	dashsmtht.f
+	ezconrec.x	<error.h> <gset.h>
+	ezhafton.x	<error.h> <gset.h>
+	ezhaftont.f
+	ezisosrf.x	<error.h> <gset.h>
+	ezsurface.x	<error.h> <gset.h>
+	ezvelvect.x	<error.h> <gset.h>
+	ezytst.x	<ctype.h> <error.h> <gset.h>
+	hafton.x	<error.h> <gset.h>
+	haftont.f
+	isosrf.x	<error.h> <gset.h>
+	isosrft.f
+	oldauto.x	<ctype.h> <error.h> <gset.h>
+	oldautot.f
+	preal.x	
+	pwrity.x	
+	pwrityt.f
+	pwrzit.f
+	pwrzs.x	
+	pwrzst.f
+	pwrztt.f
+	srfacet.f
+	srftest.x	
+	srftestd.x	
+	strmln.x	<error.h> <gset.h>
+	strmlnt.f
+	surface.x	<error.h> <gset.h>
+	threed.x	<error.h> <gset.h>
+	threed2.x	<error.h> <gset.h>
+	threed2t.f
+	threedt.f
+	velvctt.f
+	velvect.x	<error.h> <gset.h>
+	;
diff --git a/sys/gio/ncarutil/tests/oldauto.x b/sys/gio/ncarutil/tests/oldauto.x
new file mode 100644
index 00000000..90287803
--- /dev/null
+++ b/sys/gio/ncarutil/tests/oldauto.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+procedure t_oldauto()
+
+char	device[SZ_FNAME], command[SZ_LINE]
+int	error_code, wkid
+int	ctoi()
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+		call exmpl1
+		call exmpl2
+		call exmpl3
+		call exmpl4
+		call exmpl5
+		call exmpl6
+		call exmpl7
+		call exmpl8
+		# call exmpl9
+		call xmpl11
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/oldautot.f b/sys/gio/ncarutil/tests/oldautot.f
new file mode 100644
index 00000000..168d5f37
--- /dev/null
+++ b/sys/gio/ncarutil/tests/oldautot.f
@@ -0,0 +1,833 @@
+      SUBROUTINE EXMPL1
+C
+C Define the data array.
+C
+      REAL YDRA(1001)
+C
+C Fill the data array.
+C
+      DO 101 I=1,1001
+        X=FLOAT(I)/20.
+        YDRA(I)=10.*(X-1.)*(X-11.)*(X-21.)*(X-31.)*(X-41.)*(X-51.)
+     +                                                 +2.E7*(FRAN()-.5)
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZY.
+C
+      CALL EZY (YDRA,1001,'EXAMPLE 1 (EZY)$')
+C
+c     STOP
+C
+      END
+      FUNCTION FRAN()
+C
+C Random-number generator.
+C
+      DATA X / 2.7182818 /
+      SAVE X
+      X=AMOD(9821.*X+.211327,1.)
+      FRAN=X
+      RETURN
+      END
+      SUBROUTINE BNDARY
+C
+C Routine to draw the plotter-frame edge.
+C
+      CALL PLOTIT (    0,    0,0)
+      CALL PLOTIT (32767,    0,1)
+      CALL PLOTIT (32767,32767,1)
+      CALL PLOTIT (    0,32767,1)
+      CALL PLOTIT (    0,    0,1)
+      RETURN
+      END
+c
+      SUBROUTINE EXMPL2
+C
+C Define the data arrays.
+C
+      REAL XDRA(4001),YDRA(4001)
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,4001
+        THETA=.0015707963267949*FLOAT(I-1)
+        RHO=SIN(2.*THETA)+.05*SIN(64.*THETA)
+        XDRA(I)=RHO*COS(THETA)
+        YDRA(I)=RHO*SIN(THETA)
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,4001,'EXAMPLE 2 (EZXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL3
+C
+C Define the data array.
+C
+      REAL YDRA(100,2)
+C
+C Fill the data array.
+C
+      DO 101 I=1,100
+        YDRA(I,1)=COS(3.14159265358979*FLOAT(I)/25.)*FLOAT(I)**2
+        YDRA(I,2)=COS(3.14159265358979*FLOAT(I)/25.)*10.**(.04*FLOAT(I))
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMY.
+C
+      CALL EZMY (YDRA,100,2,100,'EXAMPLE 3 (EZMY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL4
+C
+C Define the data arrays.
+C
+      REAL XDRA(201),YDRA(201,10)
+C
+C Fill the data arrays.
+C
+      DO 102 I=1,201
+        XDRA(I)=-1.+.02*FLOAT(I-1)
+        IF (I.GT.101) XDRA(I)=2.-XDRA(I)
+        DO 101 J=1,10
+          YDRA(I,J)=FLOAT(J)*SQRT(1.000000000001-XDRA(I)**2)/10.
+          IF (I.GT.101) YDRA(I,J)=-YDRA(I,J)
+  101   CONTINUE
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,201,10,201,'EXAMPLE 4 (EZMXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL5
+C
+C Define the data arrays.
+C
+      REAL XDRA(401,6),YDRA(401,6)
+C
+C Compute required constants.
+C
+      PI=3.14159265358979
+      PID200=PI/200.
+      PITTWO=2.*PI
+      PIT2D3=2.*PI/3.
+      PIT4D3=4.*PI/3.
+      RADOSC=SQRT(3.)/3.
+      RADOLC=SQRT(3.)/2.
+      BSSCLL=ATAN(SQRT(12.)/6.)
+      BSSCUL=ATAN(SQRT(143.)/7.)
+      BSLCLL=ATAN(SQRT(143.)/17.)
+      BSLCUL=ATAN(SQRT(2.0))
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,401
+        THETA=PID200*FLOAT(I-1)
+        XDRA(I,1)=   -.5+RADOSC*COS(THETA)
+        YDRA(I,1)=       RADOSC*SIN(THETA)
+        IF (ABS(THETA       ).GE.BSSCLL.AND.
+     +      ABS(THETA       ).LE.BSSCUL) XDRA(I,1)=1.E36
+        IF (ABS(THETA-PITTWO).GE.BSSCLL.AND.
+     +      ABS(THETA-PITTWO).LE.BSSCUL) XDRA(I,1)=1.E36
+        XDRA(I,2)=    .5+RADOSC*COS(THETA)
+        YDRA(I,2)=       RADOSC*SIN(THETA)
+        IF (ABS(THETA-PIT2D3).GE.BSSCLL.AND.
+     +      ABS(THETA-PIT2D3).LE.BSSCUL) XDRA(I,2)=1.E36
+        XDRA(I,3)=       RADOSC*COS(THETA)
+        YDRA(I,3)=RADOLC+RADOSC*SIN(THETA)
+        IF (ABS(THETA-PIT4D3).GE.BSSCLL.AND.
+     +      ABS(THETA-PIT4D3).LE.BSSCUL) XDRA(I,3)=1.E36
+        XDRA(I,4)=   -.5+RADOLC*COS(THETA)
+        YDRA(I,4)=       RADOLC*SIN(THETA)
+        IF (ABS(THETA       ).GE.BSLCLL.AND.
+     +      ABS(THETA       ).LE.BSLCUL) XDRA(I,4)=1.E36
+        IF (ABS(THETA-PITTWO).GE.BSLCLL.AND.
+     +      ABS(THETA-PITTWO).LE.BSLCUL) XDRA(I,4)=1.E36
+        XDRA(I,5)=    .5+RADOLC*COS(THETA)
+        YDRA(I,5)=       RADOLC*SIN(THETA)
+        IF (ABS(THETA-PIT2D3).GE.BSLCLL.AND.
+     +      ABS(THETA-PIT2D3).LE.BSLCUL) XDRA(I,5)=1.E36
+        XDRA(I,6)=       RADOLC*COS(THETA)
+        YDRA(I,6)=RADOLC+RADOLC*SIN(THETA)
+        IF (ABS(THETA-PIT4D3).GE.BSLCLL.AND.
+     +      ABS(THETA-PIT4D3).LE.BSLCUL) XDRA(I,6)=1.E36
+  101 CONTINUE
+C
+C Specify subscripting of XDRA and YDRA.
+C
+      CALL AGSETI ('ROW.',2)
+C
+C Make sure grid shape is such that one unit in x = one unit in y.
+C
+      CALL AGSETF ('GRID/SHAPE.',2.)
+C
+C Turn off background, then turn labels back on.
+C
+      CALL AGSETF ('BACKGROUND.',4.)
+      CALL AGSETI ('LABEL/CONTROL.',2)
+C
+C Turn off left label.
+C
+      CALL AGSETC ('LABEL/NAME.','L')
+      CALL AGSETI ('LABEL/SUPPRESSION FLAG.',1)
+C
+C Change text of bottom label.
+C
+      CALL AGSETC ('LABEL/NAME.','B')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','PURITY, BODY, AND FLAVOR$')
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,401,6,401,'EXAMPLE 5 (EZMXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL6
+C
+C Define the data arrays.
+C
+      REAL XDRA(501),YDRA(501)
+C
+      CHARACTER*35 GLAB
+      CHARACTER*23 BACK(4)
+      CHARACTER*12 LNLG(4)
+      character*1  tmp
+C Define the graph-window parameter array.
+C
+      REAL GWND (4,4)
+C
+      DATA (GWND(I,1),I=1,4) / 0.0 , 0.5 , 0.5 , 1.0 /
+      DATA (GWND(I,2),I=1,4) / 0.5 , 1.0 , 0.5 , 1.0 /
+      DATA (GWND(I,3),I=1,4) / 0.0 , 0.5 , 0.0 , 0.5 /
+      DATA (GWND(I,4),I=1,4) / 0.5 , 1.0 , 0.0 , 0.5 /
+C
+C Define variables used in setting up informational labels on the graph.
+C
+C
+      DATA BACK(1) / '(PERIMETER BACKGROUND)$' /
+      DATA BACK(2) / '(GRID BACKGROUND)$     ' /
+      DATA BACK(3) / '(HALF-AXIS BACKGROUND)$' /
+      DATA BACK(4) / '(NO BACKGROUND)$       ' /
+C
+      DATA LNLG(1) / 'LINEAR$' /
+      DATA LNLG(2) / 'LOGARITHMIC$' /
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,501
+        THETA=.031415926535898*FLOAT(I-1)
+        XDRA(I)=500.+.9*FLOAT(I-1)*COS(THETA)
+        YDRA(I)=500.+.9*FLOAT(I-1)*SIN(THETA)
+  101 CONTINUE
+C
+C
+C Do four graphs on the same frame, using different backgrounds.
+C
+      DO 102 IGRF = 1,4
+C
+C Suppress the frame advance.
+C
+      CALL AGSETI ('FRAME.',2)
+C
+C Position the graph window.
+C
+        CALL AGSETP ('GRAPH WINDOW.',GWND(1,IGRF),4)
+C
+C Declare the background type.
+C
+        CALL AGSETI ('BACKGROUND TYPE.',IGRF)
+C
+C Setting the background type may have turned the informational labels
+C off.  In that case, turn them back on.
+C
+        IF (IGRF.EQ.4) CALL AGSETI ('LABEL/CONTROL.',2)
+C
+C Set up parameters determining the linear/log nature of the axes.
+C
+        ILLX=(IGRF-1)/2
+        ILLY=MOD(IGRF-1,2)
+C
+C Declare the linear/log nature of the graph.
+C
+        CALL AGSETI ('X/LOGARITHMIC.',ILLX)
+        CALL AGSETI ('Y/LOGARITHMIC.',ILLY)
+C
+C Change the x- and y-axis labels to reflect the linear/log nature of
+C the graph.
+C
+        CALL AGSETC ('LABEL/NAME.','B')
+        CALL AGSETI ('LINE/NUMBER.',-100)
+        CALL AGSETC ('LINE/TEXT.',LNLG(ILLX+1))
+C
+        CALL AGSETC ('LABEL/NAME.','L')
+        CALL AGSETI ('LINE/NUMBER.',100)
+        CALL AGSETC ('LINE/TEXT.',LNLG(ILLY+1))
+C
+C Set up the label for the top of the graph.
+C
+c     WRITE (GLAB,1001) IGRF,BACK(IGRF)
+      glab(1:35) = 'EXAMPLE 6-                         '
+      glab(11:11) = char (igrf + ichar ('0'))
+      glab(13:35) = back (igrf)
+C
+C Draw the graph, using EZXY.
+C
+        CALL EZXY (XDRA,YDRA,501,GLAB)
+C
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Advance the frame.
+C
+      CALL FRAME
+C
+c     STOP
+C
+C Format for encode.
+C
+c1001 FORMAT ('EXAMPLE 6-',I1,' ',A23)
+      END
+c
+      SUBROUTINE EXMPL7
+C
+C Define the data arrays and the dash-pattern array.
+C
+      REAL XDRA(101),YDRA(101,9)
+      CHARACTER*28 DSHP(9)
+C
+C Declare the type of the dash-pattern-name generator.
+C
+      CHARACTER*16 AGDSHN
+C
+C Fill the data arrays and the dash pattern array.
+C
+      DO 101 I=1,101
+        XDRA(I)=-90.+1.8*FLOAT(I-1)
+  101 CONTINUE
+C
+      DO 103 J=1,9
+c       WRITE (DSHP(J),1001) J
+        dshp(j) = '$$$$$$$$$$$$$$$$$$$$$ J =   '
+	dshp(j)(27:27) = char (j + ichar ('0'))
+        FJ=J
+        DO 102 I=1,101
+          YDRA(I,J)=3.*FJ-(FJ/2700.)*XDRA(I)**2
+  102   CONTINUE
+  103 CONTINUE
+C
+C Turn on windowing.  (Some curves run outside the curve window.)
+C
+      CALL AGSETI ('WINDOWING.',1)
+C
+C Move the edges of the curve window (grid).
+C
+      CALL AGSETF ('GRID/LEFT.'  ,.10)
+      CALL AGSETF ('GRID/RIGHT.' ,.90)
+      CALL AGSETF ('GRID/BOTTOM.',.10)
+      CALL AGSETF ('GRID/TOP.'   ,.85)
+C
+C Set the x and y minimum and maximum.
+C
+      CALL AGSETF ('X/MINIMUM.',-90.)
+      CALL AGSETF ('X/MAXIMUM.',+90.)
+      CALL AGSETF ('Y/MINIMUM.',  0.)
+      CALL AGSETF ('Y/MAXIMUM.', 18.)
+C
+C Set left axis parameters.
+C
+      CALL AGSETI ('LEFT/MAJOR/TYPE.',1)
+      CALL AGSETF ('LEFT/MAJOR/BASE.',3.)
+      CALL AGSETI ('LEFT/MINOR/SPACING.',2)
+C
+C Set right axis parameters.
+C
+      CALL AGSETI ('RIGHT/FUNCTION.',1)
+      CALL AGSETF ('RIGHT/NUMERIC/TYPE.',1.E36)
+C
+C Set bottom axis parameters.
+C
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',15.)
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',2)
+C
+C Set top axis parameters.
+C
+      CALL AGSETI ('TOP/FUNCTION.',1)
+      CALL AGSETF ('TOP/NUMERIC/TYPE.',1.E36)
+C
+C Set up the dash patterns to be used.
+C
+      CALL AGSETI ('DASH/SELECTOR.',9)
+      CALL AGSETI ('DASH/LENGTH.',28)
+      DO 104 I=1,9
+        CALL AGSETC (AGDSHN(I),DSHP(I))
+  104 CONTINUE
+C
+C Set up the left label.
+C
+      CALL AGSETC ('LABEL/NAME.','L')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','HEIGHT (KILOMETERS)$')
+C
+C Set up the right label.
+C
+      CALL AGSETC ('LABEL/NAME.','R')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','PRESSURE (TONS/SQUARE FURLONG)$')
+C
+C Set up the bottom labels.
+C
+      CALL AGSETC ('LABEL/NAME.','B')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','LATITUDE (DEGREES)$')
+C
+      CALL AGSETC ('LABEL/NAME.','SP')
+      CALL AGSETF ('LABEL/BASEPOINT/X.',.000001)
+      CALL AGSETF ('LABEL/BASEPOINT/Y.',0.)
+      CALL AGSETF ('LABEL/OFFSET/Y.',-.015)
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','SP$')
+C
+      CALL AGSETC ('LABEL/NAME.','NP')
+      CALL AGSETF ('LABEL/BASEPOINT/X.',.999999)
+      CALL AGSETF ('LABEL/BASEPOINT/Y.',0.)
+      CALL AGSETF ('LABEL/OFFSET/Y.',-.015)
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','NP$')
+C
+C Set up the top label.
+C
+      CALL AGSETC ('LABEL/NAME.','T')
+      CALL AGSETI ('LINE/NUMBER.',80)
+      CALL AGSETC ('LINE/TEXT.','DISTANCE FROM EQUATOR (MILES)$')
+      CALL AGSETI ('LINE/NUMBER.',90)
+      CALL AGSETC ('LINE/TEXT.',' $')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','LINES OF CONSTANT INCRUDESCENCE$')
+      CALL AGSETI ('LINE/NUMBER.',110)
+      CALL AGSETC ('LINE/TEXT.','EXAMPLE 7 (EZMXY)$')
+C
+C Set up centered (box 6) label.
+C
+      CALL AGSETC ('LABEL/NAME.','EQUATOR')
+      CALL AGSETI ('LABEL/ANGLE.',90)
+      CALL AGSETI ('LINE/NUMBER.',0)
+      CALL AGSETC ('LINE/TEXT.','EQUATOR$')
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,101,9,101,0)
+C
+c     STOP
+C
+C Format for encode above.
+C
+c1001 FORMAT ('$$$$$$$$$$$$$$$$$$$$$''J''=''',I1,'''')
+C
+      END
+c
+      SUBROUTINE EXMPL8
+C
+C Define the data arrays.
+C
+      REAL XDRA(101),YDRA(4,101)
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,101
+        XDRA(I)=-3.14159265358979+.062831853071796*FLOAT(I-1)
+  101 CONTINUE
+C
+      DO 103 I=1,4
+        FLTI=I
+        BASE=2.*FLTI-1.
+        DO 102 J=1,101
+          YDRA(I,J)=BASE+.75*SIN(-3.14159265358979+.062831853071796*
+     +                                                  FLTI*FLOAT(J-1))
+  102   CONTINUE
+  103 CONTINUE
+C
+C Change the line-end character to a period.
+C
+      CALL AGSETC ('LINE/END.','.')
+C
+C Specify labels for x and y axes.
+C
+      CALL ANOTAT ('SINE FUNCTIONS OF T.','T.',0,0,0,0)
+C
+C Use a half-axis background.
+C
+      CALL AGSETI ('BACKGROUND.',3)
+C
+C Move x axis to the zero point on the y axis.
+C
+      CALL AGSETF ('BOTTOM/INTERSECTION/USER.',0.)
+C
+C Specify base value for spacing of major ticks on x axis.
+C
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',1.)
+C
+C Run major ticks on x axis to edge of curve window.
+C
+      CALL AGSETF ('BOTTOM/MAJOR/INWARD.',1.)
+      CALL AGSETF ('BOTTOM/MAJOR/OUTWARD.',1.)
+C
+C Position x axis minor ticks.
+C
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',9)
+C
+C Run the y axis backward.
+C
+      CALL AGSETI ('Y/ORDER.',1)
+C
+C Run plots full-scale in y.
+C
+      CALL AGSETI ('Y/NICE.',0)
+C
+C Have AUTOGRAPH scale x and y data the same.
+C
+      CALL AGSETF ('GRID/SHAPE.',.01)
+C
+C Use the alphabetic set of dashed-line patterns.
+C
+      CALL AGSETI ('DASH/SELECTOR.',-1)
+C
+C Tell AUTOGRAPH how the data arrays are dimensioned.
+C
+      CALL AGSETI ('ROW.',-1)
+C
+C Reverse the roles of the x and y arrays.
+C
+      CALL AGSETI ('INVERT.',1)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the curves.
+C
+      CALL EZMXY (XDRA,YDRA,4,4,101,'EXAMPLE 8.')
+C
+c     STOP
+C
+      END
+c
+C      SUBROUTINE EXMPL9
+CC
+CC Define the data arrays.
+CC
+C      DIMENSION XDAT(400),YDAT(400)
+CC
+CC Fill the data arrays.
+CC
+C      DO 101 I=1,400
+C        XDAT(I)=(FLOAT(I)-1.)/399.
+C  101 CONTINUE
+CC
+C      CALL GENDAT (YDAT(  1),200,200,1,3,3,+.01,+10.)
+C      CALL GENDAT (YDAT(201),200,200,1,3,3,-10.,-.01)
+CC
+CC The y data ranges over both positive and negative values.  It is
+CC desired that both ranges be represented on the same graph and that
+CC each be shown logarithmically, ignoring values in the range -.01 to
+CC +.01, in which we're not interested.  First we map each y datum into
+CC its absolute value (.01 if the absolute value is too small).  Then we
+CC take the base-10 logarithm, add 2.0001 (so as to be sure of getting a
+CC positive number), and re-attach the original sign.  We can plot the
+CC resulting y data on a linear y axis.
+CC
+C      DO 102 I=1,400
+C        YDAT(I)=SIGN(ALOG10(AMAX1(ABS(YDAT(I)),.01))+2.0001,YDAT(I))
+C  102 CONTINUE
+CC
+CC In order that the labels on the y axis should show the original values
+CC of the y data, we change the user-system-to-label-system mapping on
+CC both y axes and force major ticks to be spaced logarithmically in the
+CC label system (which will be defined by the subroutine AGUTOL in such
+CC a way as to re-create numbers in the original range).
+CC
+C      CALL AGSETI ('LEFT/FUNCTION.',1)
+C      CALL AGSETI ('LEFT/MAJOR/TYPE.',2)
+CC
+C      CALL AGSETI ('RIGHT/FUNCTION.',1)
+C      CALL AGSETI ('RIGHT/MAJOR/TYPE.',2)
+CC
+CC Change the label on the left axis to reflect what's going on.
+CC
+C      CALL AGSETC ('LABEL/NAME.','L')
+C      CALL AGSETI ('LINE/NUMBER.',100)
+C      CALL AGSETC ('LINE/TEXT.','LOG SCALING, POSITIVE AND NEGATIVE$')
+CC
+CC Draw a boundary around the edge of the plotter frame.
+CC
+Cc     CALL BNDARY
+CC
+CC Draw the curve.
+CC
+C      CALL EZXY (XDAT,YDAT,400,'EXAMPLE 9$')
+CC
+Cc     STOP
+CC
+C      END
+Cc
+C      SUBROUTINE GENDAT (DATA,IDIM,M,N,MLOW,MHGH,DLOW,DHGH)
+CC
+CC This is a routine to generate test data for two-dimensional graphics
+CC routines.  Given an array "DATA", dimensioned "IDIM x 1", it fills
+CC the sub-array ((DATA(I,J),I=1,M),J=1,N) with a two-dimensional field
+CC of data having approximately "MLOW" lows and "MHGH" highs, a minimum
+CC value of exactly "DLOW" and a maximum value of exactly "DHGH".
+CC
+CC "MLOW" and "MHGH" are each forced to be greater than or equal to 1
+CC and less than or equal to 25.
+CC
+CC The function used is a sum of exponentials.
+CC
+C      DIMENSION DATA(IDIM,1),CCNT(3,50)
+CC
+C      FOVM=9./FLOAT(M)
+C      FOVN=9./FLOAT(N)
+CC
+C      NLOW=MAX0(1,MIN0(25,MLOW))
+C      NHGH=MAX0(1,MIN0(25,MHGH))
+C      NCNT=NLOW+NHGH
+CC
+C      DO 101 K=1,NCNT
+C        CCNT(1,K)=1.+(FLOAT(M)-1.)*FRAN()
+C        CCNT(2,K)=1.+(FLOAT(N)-1.)*FRAN()
+C        IF (K.LE.NLOW) THEN
+C          CCNT(3,K)=-1.
+C        ELSE
+C          CCNT(3,K)=+1.
+C        END IF
+C  101 CONTINUE
+CC
+C      DMIN=+1.E36
+C      DMAX=-1.E36
+C      DO 104 J=1,N
+C        DO 103 I=1,M
+C          DATA(I,J)=.5*(DLOW+DHGH)
+C          DO 102 K=1,NCNT
+C            DATA(I,J)=DATA(I,J) + .5 * (DHGH-DLOW) * CCNT(3,K) *
+C     +                EXP( - ( ( FOVM*(FLOAT(I)-CCNT(1,K)) )**2 +
+C     +                         ( FOVN*(FLOAT(J)-CCNT(2,K)) )**2   ) )
+C  102     CONTINUE
+C          DMIN=AMIN1(DMIN,DATA(I,J))
+C          DMAX=AMAX1(DMAX,DATA(I,J))
+C  103   CONTINUE
+C  104 CONTINUE
+CC
+C      DO 106 J=1,N
+C        DO 105 I=1,M
+C          DATA(I,J)=(DATA(I,J)-DMIN)/(DMAX-DMIN)*(DHGH-DLOW)+DLOW
+C  105   CONTINUE
+C  106 CONTINUE
+CC
+C      RETURN
+CC
+C      END
+Cc
+C      SUBROUTINE XMPL10
+C      RETURN
+C      END
+Cc
+      SUBROUTINE XMPL11
+C
+C Create a sort of histogram.
+C
+      REAL XDRA(249),YDRA(249),WORK(204),IWRK(204)
+C
+C Fill the data arrays.  First, we define the histogram outline.  This
+C will be used in the call to FILL which fills in the area under the
+C histogram.
+C
+      XDRA(1)=0.
+      YDRA(1)=0.
+C
+      DO 101 I=2,100,2
+        XDRA(I  )=XDRA(I-1)
+        YDRA(I  )=EXP(-16.*(FLOAT(I/2)/50.-.51)**2)+.1*FRAN()
+        XDRA(I+1)=XDRA(I-1)+.02
+        YDRA(I+1)=YDRA(I)
+  101 CONTINUE
+C
+      XDRA(102)=1.
+      YDRA(102)=0.
+C
+C Then, we define lines separating the vertical boxes from each other.
+C
+      NDRA=102
+C
+      DO 102 I=3,99,2
+        XDRA(NDRA+1)=1.E36
+        YDRA(NDRA+1)=1.E36
+        XDRA(NDRA+2)=XDRA(I)
+        YDRA(NDRA+2)=0.
+        XDRA(NDRA+3)=XDRA(I)
+        YDRA(NDRA+3)=AMIN1(YDRA(I),YDRA(I+1))
+        NDRA=NDRA+3
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Suppress the frame advance.
+C
+      CALL AGSETI ('FRAME.',2)
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,249,'EXAMPLE 11 (HISTOGRAM)$')
+C
+C Use the XLIB routine FILL to fill the area defined by the data.  Note
+C that FILL is not a part of the AUTOGRAPH package.
+C
+c     CALL FILLOP ('AN',45)
+c    CALL FILLOP ('SP',128)
+c    CALL FILL (XDRA,YDRA,102,WORK,204,IWRK,204)
+C
+C Advance the frame.
+C
+c     CALL FRAME
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPLF
+C
+C Define the data array.
+C
+      DIMENSION XYCD(226)
+C
+C Fill the data array.
+C
+c     READ 1001 , XYCD
+C
+      DO 101 I=1,226
+        IF (XYCD(I).EQ.1.E36) GO TO 101
+        XYCD(I)=2.**((XYCD(I)-15.)/2.5)
+  101 CONTINUE
+C
+C Specify log/log plot.
+C
+      CALL DISPLA (0,0,4)
+C
+C Bump the line-maximum parameter past 42.
+C
+      CALL AGSETI ('LINE/MAXIMUM.',50)
+C
+C Specify x- and y-axis labels, grid background.
+C
+      CALL ANOTAT ('LOGARITHMIC, BASE 2, EXPONENTIAL LABELING$',
+     +             'LOGARITHMIC, BASE 2, NO-EXPONENT LABELING$',2,0,0,0)
+C
+C Specify the graph label.
+C
+      CALL AGSETC ('LABEL/NAME.','T')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','FINAL EXAMPLE$')
+C
+C Specify x-axis ticks and labels.
+C
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',3)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',2.)
+      CALL AGSETI ('BOTTOM/NUMERIC/TYPE.',2)
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',4)
+c     CALL AGSETI ('BOTTOM/MINOR/PATTERN.',125252B)
+C
+C Specify y-axis ticks and labels.
+C
+      CALL AGSETI ('LEFT/MAJOR/TYPE.',3)
+      CALL AGSETF ('LEFT/MAJOR/BASE.',2.)
+      CALL AGSETI ('LEFT/NUMERIC/TYPE.',3)
+      CALL AGSETI ('LEFT/MINOR/SPACING.',4)
+c     CALL AGSETI ('LEFT/MINOR/PATTERN.',125252B)
+C
+C Compute secondary control parameters.
+C
+      CALL AGSTUP (XYCD(1),1,0,113,2,XYCD(2),1,0,113,2)
+C
+C Draw the background.
+C
+      CALL AGBACK
+C
+C Draw the curve twice to make it darker.
+C
+      CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1)
+      CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Advance the frame.
+C
+c     CALL FRAME
+C
+c     STOP
+C
+C Format.
+C
+c1001 FORMAT (14E5.0)
+C
+      END
+C  1.8  2.1  2.7         1.6  4.2  1.5  5.7  1.9  6.3  2.9  6.5  4.7  6.0  6.7
+C  5.6  8.6  5.4        10.7  5.6 13.1  4.8 11.2  3.7  9.7 1E36 1E36  7.0  8.2
+C  7.7 10.6  8.2        12.6  8.2 14.3  8.0 15.3  7.7 15.6  7.5 15.1  7.4 14.0
+C  7.6 12.3  7.7        10.7  7.9  8.9  8.2  7.3  8.5  4.6  8.5  7.3  8.6  9.3
+C  8.8 10.2  9.1        10.5  9.4 10.1  9.6  9.1  9.9  7.8 10.3  6.9 11.1  7.0
+C 11.7  7.8 12.0         8.6 12.3 10.0 12.5 11.5 12.4 12.7 12.2 13.0 11.9 12.6
+C 11.7 11.7 11.6        10.5 11.7  9.3 12.0  8.6 12.5  8.6 13.0  9.0 13.8 10.1
+C 14.3 11.1 1E36        1E36 18.5 23.4 18.2 23.5 17.8 23.2 17.2 22.6 16.8 21.8
+C 16.0 20.2 15.8        19.5 16.0 19.3 16.6 19.6 17.8 20.6 17.3 19.1 16.9 17.3
+C 16.6 16.0 16.6        14.5 16.8 13.7 17.1 13.1 17.8 13.2 18.4 14.0 19.2 15.5
+C 19.8 16.8 20.3        18.0 20.9 20.1 21.1 18.9 21.1 17.4 21.1 18.9 21.2 19.7
+C  1.5 20.5 21.8        20.8 22.0 20.4 22.1 19.6 22.3 18.7 22.6 18.4 23.1 18.9
+C 23.6 20.0 24.1        21.7 24.7 22.9 25.3 23.9 24.7 22.9 24.4 21.6 24.4 20.6
+C 24.7 20.2 25.2        20.7 25.6 21.5 26.0 22.9 26.4 24.5 26.7 25.9 26.8 27.9
+C 26.6 30.0 26.4        30.3 26.2 30.0 25.7 28.0 25.5 26.1 25.3 24.9 25.3 23.9
+C 25.4 22.9 25.9        22.5 26.6 22.4 27.4 23.1 28.2 24.0 29.0 25.0 30.1 26.4
+C 1E36 1E36
diff --git a/sys/gio/ncarutil/tests/preal.x b/sys/gio/ncarutil/tests/preal.x
new file mode 100644
index 00000000..79d33218
--- /dev/null
+++ b/sys/gio/ncarutil/tests/preal.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+procedure preal (tval, rval)
+
+char	tval[ARB]
+real	rval
+
+begin
+	call eprintf ("%s %.4f\n")
+	    call pargstr (tval)
+	    call pargr (rval)
+end
diff --git a/sys/gio/ncarutil/tests/pwrity.x b/sys/gio/ncarutil/tests/pwrity.x
new file mode 100644
index 00000000..3b5c1437
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrity.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routines PWRITY
+
+procedure t_pwrity()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tpwry (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/pwrityt.f b/sys/gio/ncarutil/tests/pwrityt.f
new file mode 100644
index 00000000..5b033933
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrityt.f
@@ -0,0 +1,90 @@
+      SUBROUTINE TPWRY (IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ENTRY PWRITY OF PWRITY	AND
+C			 TO TEST PWRITY	ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TPWRY (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRITY TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS WRITTEN TO UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING
+C			 CHARACTER STRING PLOTS	IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  IN ORDER TO
+C			 DETERMINE WHETHER THE TEST WAS	SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRITY
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TPWRY CALLS PWRITY TO PLOT VARIOUS CHARACTER
+C			 STRINGS USING DIFFERENT PARAMETERS.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C INITIALIZE THE ERROR PARAMETER.
+C
+      IERROR = 0
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL GSVP	(1, 0.0, 1.0, 0.0, 1.0)
+      CALL GSWN	(1, 1.0, 1024.0, 1.0, 1024.0)
+      CALL GSELNT (1)
+      CALL SETUSV ('LS',1)
+C
+C LABEL	FRAME
+C
+      CALL PWRITY(512.0,950.0,
+     1		  'DEMONSTRATION PLOT FOR PWRITY',
+     2		  29,2,0,0)
+C
+C TEST PWRITY FOR DIFFERENT SIZE CHARACTERS.
+C
+      CALL PWRITY (10.0,900.0,'SIZE TEST',9,0,0,-1)
+      CALL PWRITY (10.0,850.0,'SIZE TEST',9,1,0,-1)
+      CALL PWRITY (10.0,775.0,'SIZE TEST',9,2,0,-1)
+      CALL PWRITY (10.0,675.0,'SIZE TEST',9,3,0,-1)
+      CALL PWRITY (10.0,525.0,'SIZE TEST',9,4,0,-1)
+      CALL PWRITY (10.0,375.0,'SIZE TEST',9,5,0,-1)
+C
+C TEST PWRITY FOR DIFFERENT CHARACTER ORIENTATIONS.
+C
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,0*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,1*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,2*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,3*90,-1)
+C
+C TEST CENTERING OPTIONS FOR PWRITY.
+C
+      CALL PWRITY (512.0,160.0,'CENTR TEST',10,2,0,0)
+      CALL PWRITY (512.0,85.0,'CENTR TEST',10,2,0,-1)
+      CALL PWRITY (512.0,235.0,'CENTR TEST',10,2,0,1)
+c
+c     CALL NEWFM
+C
+c      WRITE (6,1001)
+      RETURN
+C
+c 1001 FORMAT ('	PWRITY TEST SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrzit.f b/sys/gio/ncarutil/tests/pwrzit.f
new file mode 100644
index 00000000..7c96e926
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzit.f
@@ -0,0 +1,132 @@
+      SUBROUTINE TPWRZI	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZI IN CONJUNCTION WITH ISOSRF
+C
+C USAGE			 CALL TPWRZI (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRZI TEST SUCCESSFUL  . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING THE SAMPLE
+C			 PLOT IS PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZI,	ISOSRF
+C FILES
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A FUNCTION OF THREE VARIABLES IS DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A THREE DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE THEN CALLS ISOSRF TO DRAW AN
+C			 ISO-VALUED SURFACE PLOT OF THE	FUNCTION,
+C			 THEN PWRZI IS CALLED THREE TIMES TO
+C			 LABEL THE FRONT, SIDE,	AND BACK OF THE
+C			 PICTURE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+      DIMENSION	      T(21,31,19),SLAB(33,33),EYE(3)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/0.4375/, TY/0.9667/
+C
+      DATA NU,NV,NW/21,31,19/
+      DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
+      DATA TISO/0./
+      DATA MUVWP2/33/
+      DATA IFLAG/-7/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  30 I=1,NU
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       T(I,J,K)	= AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
+     1			  RSML1*RSML1,
+     2			    FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
+   10	    CONTINUE
+   20	 CONTINUE
+   30 CONTINUE
+C
+C DEFINE EYE POSITION
+C
+      EYE(1) = 100.
+      EYE(2) = 150.
+      EYE(3) = 125.
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C
+C LABEL	THE PLOT
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR	PWRZI',2,0,0)
+C
+C TEST ISOSRF WITH SUBARRAY OF T
+C
+      MU = NU/2
+      MV = NV/2
+      MW = NW/2
+      MUVWP2 = MAX0(MU,MV,MW)+2
+      CALL ISOSRF (T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,
+     1		   IFLAG)
+      ISIZE = 35
+      CALL PWRZI (5.,16.,.5,'FRONT',5,ISIZE,-1,3,0)
+      CALL PWRZI (11.,7.5,.5,'SIDE',4,ISIZE,2,-1,0)
+      CALL PWRZI (5.,1.,5.,' BACK BACK BACK BACK BACK',25,ISIZE,-1,3,0)
+      CALL SETUSV ('XF',10)
+      CALL SETUSV ('YF',10)
+      CALL NEWFM
+      IERROR = 0
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	     PWRZI TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrzs.x b/sys/gio/ncarutil/tests/pwrzs.x
new file mode 100644
index 00000000..f2eeec96
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzs.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routines PWRZS
+
+procedure t_przs()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tpwrzs (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/pwrzst.f b/sys/gio/ncarutil/tests/pwrzst.f
new file mode 100644
index 00000000..4067ed86
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzst.f
@@ -0,0 +1,127 @@
+      SUBROUTINE TPWRZS	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZS IN CONJUNCTION WITH SRFACE.
+C
+C USAGE			 CALL TPWRZS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST WAS SUCCESSFUL, THE MESSAGE
+C
+C			   PWRZS TEST SUCCESSFUL  . . .	 SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING THE SAMPLE
+C			 PLOT IS PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZS,	SRFACE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A FUNCTION OF TWO VARIABLES IS	DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A TWO DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE CALLS  SRFACE  TO DRAW A SURFACE
+C			 REPRESENTATION	OF THE ARRAY VALUES, AND THEN
+C			 PWRZS IS CALLED THREE TIMES TO	LABEL THE
+C			 FRONT,	SIDE, AND BACK OF THE PICTURE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+      DIMENSION	      Z(20,30)	 ,X(20)	     ,Y(30)	 ,MM(20,30,2),
+     1		      S(6)
+C
+C LOAD THE SRFACE COMMON BLOCK,	NEEDED TO SURPRESS NEWFM CALL
+C
+      COMMON /SRFIP1/ IFR	 ,ISTP	     ,IROTS	 ,IDRX	     ,
+     1		      IDRY	 ,IDRZ	     ,IUPPER	 ,ISKIRT     ,
+     2		      NCLA	 ,THETA	     ,HSKIRT	 ,CHI	     ,
+     3		      CLO	 ,CINC	     ,ISPVAL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES  TX	AND
+C TY  DEFINE THE CENTER	OF THE TITLE STRING.
+C
+      DATA TX/0.4375/, TY/0.9667/
+C
+C SPECIFY GRID LOOP INDICES, AND LINE OF SIGHT
+C
+      DATA M/20/, N/30/
+      DATA S/4.,5.,3.,0.,0.,0./
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C DEFINE FUNCTION VALUES AND STORE IN Z
+C
+      DO  10 I=1,M
+	 X(I) =	-1.+FLOAT(I-1)/FLOAT(M-1)*2.
+   10 CONTINUE
+      DO  20 J=1,N
+	 Y(J) =	-1.+FLOAT(J-1)/FLOAT(N-1)*2.
+   20 CONTINUE
+      DO  40 J=1,N
+	 DO  30	I=1,M
+	    Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2))
+   30	 CONTINUE
+   40 CONTINUE
+C
+C SET SRFACE PARAMETERS	TO SURPRESS FRAME CALL AND DRAW	CONTOURS
+      call srfabd
+C
+      IFR = 0
+      IDRZ = 1
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C LABEL	THE PLOT
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZS',2,0,0)
+C
+C DRAW SURFACE PLOT
+C
+      CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.)
+C
+C PUT PWRZS LABELS ON PICTURE
+C
+      ISIZE = 35
+      CALL PWRZS (0.,1.1,0.,'FRONT',5,ISIZE,-1,3,0)
+      CALL PWRZS (1.1,0.,0.,'SIDE',4,ISIZE,2,-1,0)
+      CALL PWRZS (0.,-1.1,.2,' BACK BACK BACK BACK BACK',25,ISIZE,-1,
+     1		  3,0)
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+C RESTORE SRFACE PARAMETERS TO DEFAULT
+C
+      IFR = 1
+      IDRZ = 0
+C
+      RETURN
+C
+C
+c1001 FORMAT ('	     PWRZS TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrztt.f b/sys/gio/ncarutil/tests/pwrztt.f
new file mode 100644
index 00000000..dcf43638
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrztt.f
@@ -0,0 +1,116 @@
+      SUBROUTINE TPWRZT	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZT IN CONJUNCTION WITH THREED.
+C
+C USAGE			 CALL TPWRZT (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRZT TEST SUCCESSFUL  . . .	 SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 CHARACTER PLOT	IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZT,	THREED
+C FILES
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TPWRZT	CALLS SUBROUTINES SET3 AND LINE3 FROM
+C			 THE ULIB THREED PACKAGE TO ESTABLISH THE
+C			 THREE SPACE-TO-TWO SPACE TRANSFORMATION
+C			 AND TO	DRAW AXIS LINES.  TPWRZT NEXT CALLS
+C			 SUBROUTINE PWRZT FROM THE ULIB	THREED
+C			 PACKAGE TO LABEL THE AXES FOR A THREE SPACE
+C			 PLOT.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C EYE CONTAINS THE (U,V,Z) COORDINATE OF THE EYE POSITION
+C
+      REAL	      EYE(3)
+      DATA EYE(1), EYE(2), EYE(3) /3.5,	3.0, 5.0/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C SUBROUTINE SET3 ESTABLISHES THE MAPPING OF THREE SPACE COORDINATES
+C ONTO THE GRAPHICS DEVICE COORDINATE SYSTEM.
+C
+      CALL SET3	(.1,.9,.1,.9,0.,1.,0.,1.,0.,1.,EYE)
+C
+C THE FOLLOWING	THREE CALLS TO LINE3 DRAW THE THREE SPACE AXES
+C
+      CALL LINE3 (0.,0.,0.,0.,0.,1.)
+      CALL LINE3 (0.,0.,0.,0.,1.,0.)
+      CALL LINE3 (0.,0.,0.,1.,0.,0.)
+C
+C SUBROUTINE PWRZ IS USED TO LABEL EACH	OF THE AXES AND	THE PLOT
+C ON INPUT TO PWRZ,
+C THE FIRST THREE PARAMETERS AND ICNT DETERMINE	THE POSITION OF	THE
+C CHARACTER STRING.
+C ISIZE	DETERMINES THE CHARACTER SIZE.
+C LINE AND ITOP	DETERMINE THE DIRECTION	AND PLANE OF THE CHARACTERS.
+C
+C
+      ICNT = 0
+      ISIZE = 30
+      LINE = 2
+      ITOP = 3
+      CALL PWRZT (0.,.5,.1,'V-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = -1
+      ITOP = 3
+      CALL PWRZT (.5,0.,.1,'U-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = 3
+      ITOP = -2
+      CALL PWRZT (0.,.1,.5,'Z-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = 2
+      ITOP = -1
+      ISIZE = 30
+      ICNT = -1
+      CALL PWRZT (.5,.2,0.,'DEMONSTRATION OF PWRZT WITH	THREED',
+     1		  34,ISIZE,LINE,ITOP,ICNT)
+C
+C A CALL TO NEWFM INDICATES THAT THE PICTURE IS	COMPLETE
+C
+      CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+      RETURN
+C
+C
+C
+c1001 FORMAT ('	     PWRZT TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/srf.com b/sys/gio/ncarutil/tests/srf.com
new file mode 100644
index 00000000..d1b4288c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srf.com
@@ -0,0 +1,4 @@
+int	ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval
+real	theta, chi, clo, cinc
+common  /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt,
+	  ncla, theta, hskirt, chi, clo, cinc, ispval
diff --git a/sys/gio/ncarutil/tests/srfacet.f b/sys/gio/ncarutil/tests/srfacet.f
new file mode 100644
index 00000000..4e5bad00
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srfacet.f
@@ -0,0 +1,150 @@
+      SUBROUTINE TSRFAC	(nplot, IERROR)
+C
+C LATEST REVISION	 MARCH 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 SRFACE	AND TO TEST SRFACE ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TSRFAC (IERROR)
+C
+C ARGUMENTS
+c +noao: additional input parameter
+c			 nplot
+c		 	   = 1, EZSRF is demonstrated
+c			   = 2, SRFACE is demonstrated
+c
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   SRFACE TEST SUCCESSFUL  . . .  SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 SURFACE PLOT ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE
+C			 IF THE	TEST WAS SUCCESSFUL, IT	IS
+C			 NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 SRFACE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 FIRST WRITTEN IN APRIL	1979, CONVERTED	TO
+C			 FORTRAN 77 AND	GKS IN MARCH 1984.
+C
+C ALGORITHM		 THE FUNCTION
+C
+C			   Z(X,Y) = .25*(X + Y + 1./((X-.1)**2+Y**2+.09)
+C					  - 1./((X+.1)**2+Y**2+.09))
+C
+C			 IS EVALUATED FOR
+C			   X = -1. TO 1. IN INCREMENTS OF .1 AND
+C			   Y = -1.2 TO 1.2 IN INCREMENTS OF .1.
+C			 TSRFAC	CALLS SUBROUTINES EZSRFC AND SRFACE
+C			 ONCE.	EACH CALL PRODUCES A SURFACE PLOT
+C			 OF THE	ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C XX CONTAINS THE X-DIRECTION COORDINATE VALUES	FOR Z(X,Y),  YY	CONTAINS
+C THE Y-DIRECTION COORDINATE VALUES FOR	Z(X,Y),	 Z CONTAINS THE	FUNCTION
+C VALUES,  S CONTAINS VALUES FOR THE LINE OF SIGHT FOR ENTRY SRFACE,
+C WORK IS A WORK ARRAY,	 ANGH CONTAINS THE ANGLE IN DEGREES IN THE X-Y
+C PLANE	TO THE LINE OF SIGHT,  ANGV CONTAINS THE ANGLE IN DEGREES FROM
+C THE X-Y PLANE	TO THE LINE OF SIGHT.
+C
+      REAL	      XX(21)	 ,YY(25)     ,Z(21,25)	 ,S(6)	     ,
+     1		      WORK(1096)
+C
+      DATA  S(1), S(2),	S(3), S(4), S(5), S(6)/
+     1	    -8.0, -6.0,	 3.0,  0.0,  0.0,  0.0/
+C
+      DATA  ANGH/45./, ANGV/15./
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.	TO 1., THE VALUES CX AND CY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA CX/.405/, CY/.97/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL XX AND YY COORDINATE ARRAYS AND Z FUNCTION VALUE	ARRAY
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 XX(I) = X
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    YY(J) = Y
+	    Z(I,J) = (X+Y+1./((X-.1)**2+Y**2+.09)-
+     1					    1./((X+.1)**2+Y**2+.09))*.25
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C EZSRFC DEMO
+C
+C LABEL	THE PLOT FOR ENTRY EZSRFC
+C
+C SET TEXT ALIGNMENT TO	CENTER THE STRING AT THE STRING	CENTER
+C AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(2,3)
+C
+C SET CHARACTER	HEIGHT
+C
+      CALL GSCHH(.016)
+C
+C PLOT CHARACTERS
+C
+      if (nplot .eq. 1) then
+      CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR EZSRFC ENTRY OF SRFACE')
+      CALL EZSRFC (Z,21,25,ANGH,ANGV,WORK)
+      endif
+C
+C
+C SRFACE DEMO
+C
+C LABEL	THE PLOT FOR ENTRY SRFACE
+C
+C SET TEXT ALIGNMENT TO	CENTER THE STRING AT THE STRING	CENTER
+C AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(2,3)
+C
+C SET CHARACTER	HEIGHT
+C
+      CALL GSCHH(.016)
+C
+C PLOT CHARACTERS
+C
+      if (nplot .eq. 2) then
+      CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR SRFACE ENTRY OF SRFACE')
+      CALL SRFACE (XX,YY,Z,WORK,21,21,25,S,0.)
+      endif
+C
+c     WRITE (6,1001)
+C
+      RETURN
+C
+C1001 FORMAT ('	    SRFACE TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/srftest.x b/sys/gio/ncarutil/tests/srftest.x
new file mode 100644
index 00000000..cf1496b7
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srftest.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+procedure srf_test()
+
+char	temp[SZ_LINE]
+real    z[20,30], x[20], y[30], s[6]
+int	mm[20,30,2]
+real	tx, ty
+int	i, j, m, n, isize
+real	xt, yt, dum
+
+int	ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval
+real	theta, chi, clo, cinc
+common  /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt,
+	  ncla, theta, hskirt, chi, clo, cinc, ispval
+
+begin
+      # Some initialization that was originally in data statements:
+      tx = 0.4375
+      ty = 0.9667
+      m = 20
+      n = 30
+      s[1] = 4.0
+      s[2] = 5.0
+      s[3] = 3.0
+      s[4] = 0.0
+      s[5] = 0.0
+      s[6] = 0.0
+
+      # Define function values and store in z
+      DO  I=1,M
+	 X(I) =	-1.+FLOAT(I-1)/FLOAT(M-1)*2.
+   
+      DO  J=1,N
+	 Y(J) =	-1.+FLOAT(J-1)/FLOAT(N-1)*2.
+   
+      DO  J=1,N {
+	 DO  I=1,M
+	    Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2))
+      }
+
+      # Initialize block data before changing parameters.
+      call srfabd
+
+      IFR = 0
+      IDRZ = 1
+
+      CALL GSELNT (0)
+      call f77pak ("DEMONSTRATION PLOT FOR PWRZS", temp, SZ_LINE)
+      CALL WTSTR (TX,TY,temp,2,0,0)
+
+      CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.)
+#
+# PUT PWRZS LABELS ON PICTURE
+#
+      ISIZE = 35
+      call f77pak ("FRONT", temp, SZ_LINE)
+      CALL PWRZS (0.,1.1,0.,temp,5,ISIZE,-1,3,0)
+      call f77pak ("SIDE", temp, SZ_LINE)
+      CALL PWRZS (1.1,0.,0.,temp,4,ISIZE,2,-1,0)
+      call f77pak (" BACK BACK BACK BACK BACK", temp, SZ_LINE)
+      CALL PWRZS (0.,-1.1,.2,temp,25,ISIZE,-1,3,0)
+#
+# RESTORE SRFACE PARAMETERS TO DEFAULT
+#
+      IFR = 1
+      IDRZ = 0
+end
diff --git a/sys/gio/ncarutil/tests/srftestd.x b/sys/gio/ncarutil/tests/srftestd.x
new file mode 100644
index 00000000..8c22ff92
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srftestd.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task srftest = t_srftest
+
+define	DUMMY	6
+
+# Rewrite of pwrzs.t.f in spp to check things out.  
+
+procedure t_srftest()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call srf_test()
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/strmln.x b/sys/gio/ncarutil/tests/strmln.x
new file mode 100644
index 00000000..2835d211
--- /dev/null
+++ b/sys/gio/ncarutil/tests/strmln.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine STRMLN
+
+procedure t_strmln()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tstrml (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/strmlnt.f b/sys/gio/ncarutil/tests/strmlnt.f
new file mode 100644
index 00000000..f2b40c69
--- /dev/null
+++ b/sys/gio/ncarutil/tests/strmlnt.f
@@ -0,0 +1,101 @@
+      SUBROUTINE TSTRML	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ROUTINE STRMLN.
+C
+C USAGE			 CALL TSTRML (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINE STRMLN.
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINE
+C			 STRMLN	THE MESSAGE
+C			   STRMLN TEST SUCCESSFUL . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 ROUTINE TSTRML	CALLS ROUTINE STRMLN TO
+C			 PRODUCE A PLOT	REPRESENTING THE  FLOW AND
+C			 MAGNITUDE OF A	VECTOR FIELD.
+C
+C PORTABILITY		 FORTRAN77
+C
+C
+C
+      REAL	      U(21,25)	 ,V(21,25)   ,WRK(1050)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/.5/,TY/.9765/
+C
+C     SET DIMENSIONS
+C
+      DATA NH,NV/21,25/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SPECIFY HORIZONTAL AND VERTICAL VECTOR COMPONENTS U AND V ON
+C THE RECTANGULAR GRID
+C
+      TPIMX = 2.*3.14/FLOAT(NH)
+      TPJMX = 2.*3.14/FLOAT(NV)
+      DO  20 J=1,NV
+	 DO  10	I=1,NH
+	 U(I,J)	= SIN(TPIMX*(FLOAT(I)-1.))
+	 V(I,J)	= SIN(TPJMX*(FLOAT(J)-1.))
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C CALL WTSTR FOR STRMLN	PLOT TITLE
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR ROUTINE STRMLN',2,
+     1		  0,0)
+C
+C DEFINE NORMALIZATION TRANSFORMATION 1, AND SET UP LOG	SCALING
+C
+      CALL GSVP	( 1, 0.1, 0.9, 0.1, 0.9	)
+      CALL GSWN	( 1, 1.0, 21., 1.0, 25.	)
+      CALL SETUSV ( 'LS' , 1 )
+C
+C SELECT NORMALIZATION TRANSFORMATION 1
+C
+      CALL GSELNT (1)
+C
+C     DRAW PERIMETER
+C
+c     CALL PERIM(1,0,1,0)
+C
+C CALL STRMLN FOR VECTOR FIELD STREAMLINES PLOT
+C
+      CALL STRMLN (U,V,WRK,NH,NH,NV,0,IER)
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    STRMLN TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/surface.x b/sys/gio/ncarutil/tests/surface.x
new file mode 100644
index 00000000..07b25e9a
--- /dev/null
+++ b/sys/gio/ncarutil/tests/surface.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines SRFACE.
+
+procedure t_surface()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsrfac (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test of SRFACE successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed.x b/sys/gio/ncarutil/tests/threed.x
new file mode 100644
index 00000000..a22d51da
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine THREED
+
+procedure t_threed()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tthree (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed2.x b/sys/gio/ncarutil/tests/threed2.x
new file mode 100644
index 00000000..224fd2c3
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed2.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine THREED with extra test program tst3d2
+
+procedure t_threed2()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tst3d2 ()
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed2t.f b/sys/gio/ncarutil/tests/threed2t.f
new file mode 100644
index 00000000..baaa8f78
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed2t.f
@@ -0,0 +1,26 @@
+	subroutine tst3d2 ()
+	real eye(3)
+	dimension u(50), v(50), w(50)
+	data eye /5., -10., 4./
+	isiz = 36
+	xs = 90. / 1024.
+	xe = 1010. / 1024.
+	ys = 90. / 1024.
+	ye = 1010. / 1024.
+	call tick43 (24, 16, 24, 16, 24, 16)
+c	call set3 (90, 1010, 90, 1010, 0., 2., -1., 1., 0., 1., eye)
+	call set3 (xs, xe, ys, ye, 0., 2., -1., 1., 0., 1., eye)
+	do 1 i = 1, 50
+	    u(i) = float(i) * .04
+	    v(i) = sin (u(i) * 6.) * float (80 - i) / 80.
+	    w(i) = .5 + sin (u(i) *3.141592) * .5
+  1	continue
+	call perim3 (2,5,1,5,1,0.)
+	call perim3 (2,5,1,5,2,-1.)
+	call perim3 (2,5,2,5,3,0.)
+	call pwrzt (2.1, -1., 0., 3hU->, 3, isiz, 1,3,-1)
+	call pwrzt (0., 1.1, 0., 3hV->, 3, isiz, 2,3,0)
+	call pwrzt (0., -1., 1.1, 2hW , 2, isiz, 3, -1, 0)
+	call fence3 (u, v, w, 50, 3, 0.)
+	end
+
diff --git a/sys/gio/ncarutil/tests/threedt.f b/sys/gio/ncarutil/tests/threedt.f
new file mode 100644
index 00000000..0cb6532d
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threedt.f
@@ -0,0 +1,129 @@
+      SUBROUTINE TTHREE	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE ROUTINE THREED.
+C
+C USAGE			 CALL TTHREE (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINE THREED.
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINE
+C			 THREED	THE MESSAGE
+C			   THREED TEST SUCCESSFUL . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN NOVEMBER 1976
+C			 CONVERTED TO GKS AND FORTRAN 77 JULY 1984
+C
+C ALGORITHM		 ROUTINE TTHREE	CALLS SET3 TO ESTABLISH	A
+C			 MAPPING BETWEEN THE PLOTTER ADDRESSES AND
+C			 THE USER'S VOLUME, AND	TO INDICATE THE
+C			 COORDINATES OF	THE EYE	POSITION FROM
+C			 WHICH THE LINES TO BE DRAWN ARE VIEWED.
+C			 NEXT, THE VOLUME PERIMETERS AND ASSOCIATED
+C			 TICK MARKS ARE	DRAWN BY CALLS TO PERIM3.
+C			 THEN THE LINES	ARE DRAWN.  THESE ARE
+C			 CERTAIN LATITUDES AND LONGITUDES OF A
+C			 SPHERE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C
+C
+      REAL EYE(3),X(31),Y(31),Z(31)
+C
+C SPECIFY ARGUMENT VALUES TO BE	USED BY	ROUTINE	SET3.  ON AN
+C ABSTRACT PLOTTER WITH	AN ADDRESS RANGE OF 0. TO 1. IN	EACH
+C COORDINATE DIRECTION,	THE VALUES  RXA, RXB, RYA, AND RYB
+C DEFINE THE PORTION OF	THE ADDRESS SPACE TO BE	USED IN	MAKING
+C THE PLOT.  UC, UD, VC, VD, WC, WD  DEFINE A VOLUME IN	USER
+C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF	THE
+C VIEWING SURFACE AS SPECIFIED BY  RXA,	RXB, RYA, AND RYB.
+C
+      DATA RXA/0.097656/, RXB/0.90236/,	RYA/0.097656/, RYB/0.90236/
+      DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./
+      DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./
+      DATA TX/0.4374/, TY/0.9570/
+C
+C DEFINE PI
+      DATA PI/3.1415926535898/
+C
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES
+C AND THE USER'S VOLUME, AND TO	INDICATE THE COORDINATES OF THE
+C EYE POSITION FROM WHICH THE LINES TO BE DRAWN	ARE VIEWED.
+C
+      CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE)
+C
+C CALL PERIM3 TO DRAW PERIMETER	LINES AND TICK MARKS
+C
+      CALL PERIM3(2,5,1,10,1,-1.)
+      CALL PERIM3(4,2,1,1,2,-1.)
+      CALL PERIM3(2,10,4,5,3,-1.)
+C
+C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 10 J=1,18
+      THETA = FLOAT(J)*PI/9.
+      CT = COS(THETA)
+      ST = SIN(THETA)
+      DO 20 K=1,31
+      PHI = FLOAT(K-16)*PI/30.
+      Z(K) = SIN(PHI)
+      CP = COS(PHI)
+      X(K) = CT*CP
+      Y(K) = ST*CP
+   20 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   10 CONTINUE
+C
+C DEFINE AND DRAW LONGITUDINAL LINES ON	THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 30 K=1,5
+      PHI = FLOAT(K-3)*PI/6.
+      SP = SIN(PHI)
+      CP = COS(PHI)
+      DO 40 J=1,31
+      TUETA = FLOAT(J-1)*PI/15.
+      X(J) = COS(TUETA)*CP
+      Y(J) = SIN(TUETA)*CP
+      Z(J) = SP
+   40 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   30 CONTINUE
+C
+C CALL WTSTR FOR THREED	PLOT TITLE
+C
+      CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0)
+      call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37,
+     * 2, 2, 3, 0)
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE(6,1001)
+      RETURN
+C
+c1001 FORMAT('	   THREED TEST SUCCESSFUL', 24X,
+c    1	     'SEE PLOT TO VERIFY PERFORMANCE')
+      END
diff --git a/sys/gio/ncarutil/tests/velvctt.f b/sys/gio/ncarutil/tests/velvctt.f
new file mode 100644
index 00000000..36e22d28
--- /dev/null
+++ b/sys/gio/ncarutil/tests/velvctt.f
@@ -0,0 +1,126 @@
+      SUBROUTINE TVELVC	(nplot, IERROR)
+C
+C LATEST REVISION   JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 SUBROUTINES VELVCT AND	EZVEC.
+C
+C USAGE			 CALL TVELVC (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINES VELVCT AND EZVEC
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINES
+C			 VELVCT	AND EZVEC THE MESSAGE
+C			   VELVCT TEST SUCCESSFUL . . .	SEE PLOTS TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN NOVEMBER 1976
+C
+C ALGORITHM		 ROUTINE TVELVC	CALLS ROUTINES EZVEC AND
+C			 VELVCT	ONCE.  EACH CALL PRODUCES A PLOT
+C			 REPRESENTING A	VECTOR FIELD.  THE VECTOR
+C			 FIELD IS OBTAINED FROM	THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09),
+C			 BY USING THE DIRECTION	OF THE Z GRADIENT
+C			 VECTORS AND THE LOGARITHM OF THE ABSOLUTE
+C			 VALUE OF THE COMPONENTS.
+C
+C
+C
+C
+      DIMENSION	      U(21,25)	 ,V(21,25)
+C
+C SPECIFY COORDS FOR PLOT TITLES
+C
+	DATA IX/94/,IY/1000/
+C
+C SPECIFY SOME OF THE ARGUMENTS	IN VELVCT CALLING SEQUENCE
+C
+      DATA FLO/0./,HI/0./,NSET/0/,LENGTH/0/,ISPV/0/,SPV/0./
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SPECIFY VELOCITY FIELD FUNCTIONS U AND V
+C
+      M	= 21
+      N	= 25
+      DO  20 I=1,M
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,N
+	    Y =	.1*FLOAT(J-13)
+	    DZDX = 1.-2.*(X-.10)/((X-.10)**2+Y**2+.09)**2+
+     1		   2.*(X+.10)/((X+.10)**2+Y**2+.09)**2
+	    DZDY = 1.-2.*Y/((X-.10)**2+Y**2+.09)**2+
+     1		   2.*Y/((X+.10)**2+Y**2+.09)**2
+	    UVMAG = ALOG(SQRT(DZDX*DZDX+DZDY*DZDY))
+	    UVDIR = ATAN2(DZDY,DZDX)
+	    U(I,J) = UVMAG*COS(UVDIR)
+	    V(I,J) = UVMAG*SIN(UVDIR)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C CALL WTSTR FOR EZVEC PLOT TITLE
+C
+c +noao: flag used to plot either velvct or ezvec
+	if (nplot .eq. 1) then
+	CALL GQCNTN(IERR,ICN)
+	CALL GSELNT(0)
+c       X = PAU2FX(IX)
+	x = cpux (ix)
+c       Y = PAU2FY(IY)
+        y = cpuy (iy)
+      CALL WTSTR (X,Y,'DEMONSTRATION PLOT FOR ENTRY EZVEC OF VELVCT',
+     1		 2,0,-1)
+	CALL GSELNT(ICN)
+C
+C CALL EZVEC FOR VELOCITY FIELD	PLOT
+C
+      CALL EZVEC (U,V,M,N)
+      endif
+c -noao
+C
+C CALL VELVCT FOR VELOCITY FIELD PLOT
+C
+c +noao: flag used to plot either velvct or ezvec
+      if (nplot .eq. 2) then
+      CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C
+C CALL WTSTR FOR VELVCT	PLOT TITLE
+C
+	CALL GQCNTN(IERR,ICN)
+	CALL GSELNT(0)
+c       X = PAU2FX(IX)
+        x = cpux (ix)
+c       Y = PAU2FY(IY)
+        y = cpuy (iy)
+      CALL WTSTR (X,Y,
+     1		 'DEMONSTRATION PLOT FOR ENTRY VELVCT OF VELVCT',2,
+     2		 0,-1)
+	CALL GSELNT(ICN)
+	endif
+c -noao
+c
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    VELVCT TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOTS TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/velvect.x b/sys/gio/ncarutil/tests/velvect.x
new file mode 100644
index 00000000..d09f1c08
--- /dev/null
+++ b/sys/gio/ncarutil/tests/velvect.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines VELVEC
+
+procedure t_velvect()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tvelvc (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/x_ncartest.x b/sys/gio/ncarutil/tests/x_ncartest.x
new file mode 100644
index 00000000..cc8b727f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/x_ncartest.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# These tasks temporarily deleted: conraq = t_conraq, conras = t_conras,
+	  #ezmapg = t_ezmapg,
+
+task	  conran = t_conran,
+       autograph = t_autograph,
+	 oldauto = t_oldauto,
+	dashsmth = t_dashsmth,
+	   pwrzs = t_przs,
+	  srface = t_surface,
+	ezsrface = t_ezsurface,
+	  conrec = t_conrec,
+	ezconrec = t_ezconrec,
+	  hafton = t_hafton,
+	  isosrf = t_isosrf,
+	ezisosrf = t_ezisos,
+	ezhafton = t_ezhafton,
+	  pwrity = t_pwrity,
+	  threed = t_threed,
+	 threed2 = t_threed2,
+	  velvec = t_velvect,
+	ezvelvec = t_ezvelvect,
+	  strmln = t_strmln
diff --git a/sys/gio/ncarutil/threbd.f b/sys/gio/ncarutil/threbd.f
new file mode 100644
index 00000000..5dbce5e0
--- /dev/null
+++ b/sys/gio/ncarutil/threbd.f
@@ -0,0 +1,56 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data threbd changed to run time initialization
+        subroutine threbd
+c     BLOCKDATA THREBD
+      COMMON /TEMPR/  RZERO
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX   ,YMIN,
+     1                YMAX       ,BIGD       ,R0     ,NLX,
+     2                NBY        ,NRX        ,NTY
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV  ,TMINV,
+     1                TMAGW      ,TMINW
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+c +noao: following flag added to prevent over-initialization
+      logical first
+      SAVE
+      data first /.true./
+      if (.not. first) then
+        return
+      endif
+      first = .false.
+
+c     DATA RZERO/0./
+      RZERO = 0.
+c
+c     DATA NLX,NBY,NRX,NTY/10,10,1010,1010/
+      NLX = 10
+      NBY = 10
+      NRX = 1010
+      NTY = 1010   
+c
+c     DATA TMAGU,TMINU,TMAGV,TMINV,TMAGW,TMINW/12.,8.,12.,8.,12.,8./
+      TMAGU = 12.
+      TMINU =  8.
+      TMAGV = 12.
+      TMINV =  8.
+      TMAGW = 12.
+      TMINW =  8.
+c
+c     DATA ITHRMJ,ITHRMN,ITHRTX/ 1,1,1/
+      ITHRMJ = 2
+      ITHRMN = 1
+      ITHRTX = 1
+c
+c -noao
+      END
diff --git a/sys/gio/ncarutil/threed.f b/sys/gio/ncarutil/threed.f
new file mode 100644
index 00000000..3b5061f4
--- /dev/null
+++ b/sys/gio/ncarutil/threed.f
@@ -0,0 +1,826 @@
+      SUBROUTINE SET3 (XA,XB,YA,YB,ULO,UHI,VLO,VHI,WLO,WHI,EYE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C THREE-DIMENSIONAL LINE DRAWING PACKAGE
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                THREED IS A PACKAGE OF SUBROUTINES THAT
+C                        PROVIDES LINE DRAWING CAPABILITIES IN
+C                        THREE-SPACE.
+C
+C USAGE                  EACH ENTRY POINT IN THIS PACKAGE IS
+C                        DESCRIBED BELOW.
+C
+C                        SET3 (XA,XB,YA,YB,UC,UD,VC,VD,WC,WD,EYE)
+C
+C                          XA, XB, YA, YB  DEFINE THE PORTION OF THE
+C                          PLOTTING SURFACE INTO WHICH THE USER'S
+C                          PLOT WILL BE PLACED.  THESE VALUES SHOULD
+C                          BE IN THE RANGE 0. TO 1.  FOR EXAMPLE, IF
+C                          ONE WANTS THE PLOT TO OCCUPY THE MAXIMUM
+C                          PLOTTING SURFACE, SET XA=0., YA=0., XB=1.,
+C                          YB=1.; IF ONE WANTS THE PLOT TO APPEAR IN
+C                          THE LOWER LEFT CORNER OF THE PLOTTING
+C                          SURFACE, SET XA=0., YA=0., XB=.5, YB=.5 .
+C
+C                          UC, UD, VC, VD, WC, AND WD DEFINE A
+C                          VOLUME IN USER-COORDINATE SPACE WHICH
+C                          WILL BE TRANSFORMED ONTO THE PLOTTING
+C                          SURFACE DEFINED BY XA, XB, YA, YB.
+C
+C                          EYE IS AN ARRAY, 3 WORDS LONG, CONTAINING THE
+C                          U, V, AND W COORDINATES OF THE EYE POSITION.
+C                          ALL LINES IN THE PLOT ARE DRAWN AS VIEWED
+C                          FROM THE EYE.  EYE IS SPECIFIED IN USER
+C                          COORDINATES AND SHOULD BE OUTSIDE THE BOX
+C                          DEFINED BY UC, UD, VC, VC, WC, AND WD.
+C
+C                        CURVE3 (U,V,W,N)
+C
+C                          DRAWS A CURVE THROUGH N POINTS.  THE
+C                          POINTS ARE DEFINED BY THE LINEAR ARRAYS
+C                          U, V, AND W WHICH ARE DIMENSIONED N OR
+C                          GREATER.
+C
+C                        LINE3 (UA,VA,WA,UB,VB,WB)
+C
+C                          DRAWS A LINE CONNECTING THE COORDINATES
+C                          (UA,VA,WA)  AND  (UB,VB,WB).
+C
+C                        FRST3 (U,V,W)
+C
+C                          POSITIONS THE PEN TO (U,V,W).
+C
+C                        VECT3 (U,V,W)
+C
+C                          DRAWS A LINE BETWEEN THE CURRENT PEN
+C                          POSITION AND THE POINT (U,V,W).  THE
+C                          CURRENT PEN POSITION BECOMES (U,V,W).
+C                          NOTE THAT A CURVE CAN BE DRAWN BY USING
+C                          A FRST3 CALL FOLLOWED BY A SEQUENCE OF
+C                          VECT3 CALLS.
+C
+C                        POINT3 (U,V,W)
+C
+C                          PLOTS A POINT AT (U,V,W) .
+C
+C                        PERIM3 (MAGR1,MINR1,MAGR2,MINR2,IWHICH,VAR)
+C
+C                          DRAWS A PERIMETER WITH TICK MARKS.
+C
+C                          IWHICH DESIGNATES THE NORMAL VECTOR TO THE
+C                          PERIMETER DRAWN (1=U, 2=V, 3=W).
+C
+C                          VAR IS THE VALUE ON THE AXIS SPECIFIED BY
+C                          INWHICH WHERE THE PERIMETER IS TO BE DRAWN.
+C
+C                          MAGR1  AND  MAGR2  SPECIFY THE
+C                          NUMBER OF MAJOR TICK MARKS TO BE DRAWN IN
+C                          THE TWO COORDINATE DIRECTIONS.
+C
+C                          MINR1  AND  MINR2  SPECIFY THE NUMBER
+C                          OF MINOR TICKS BETWEEN EACH MAJOR TICK.
+C
+C                          MAGR1, MAGR2, MINR1 AND MINR2
+C                          ARE SPECIFIED BY THE NUMBER
+C                          OF DIVISIONS(HOLES), NOT THE NUMBER OF
+C                          TICKS.  SO IF MAGR1=1, THERE WOULD BE NO
+C                          MAJOR DIVISIONS.
+C
+C                        TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
+C
+C                          TICK43 ALLOWS PROGRAM CONTROL OF TICK
+C                          MARK LENGTH IN SUBROUTINE PERIM3.
+C                          MAGU, MAGV, MAGW SPECIFY THE LENGTH,
+C                          IN PLOTTER ADDRESS UNITS OF MAJOR
+C                          DIVISION TICK MARKS ON THE U, V, AND W
+C                          AXES.  MINU, MINV, MINW SPECIFY THE LENGTH,
+C                          IN PLOTTER ADDRESS UNITS OF MINOR
+C                          DIVISION TICK MARKS ON THE U, V, AND
+C                          W AXES.
+C
+C                        FENCE3 (U,V,W,N,IOREN,BOT)
+C
+C                          THIS ENTRY IS USED TO DRAW A LINE IN THREE-
+C                          SPACE AS WELL AS A "FENCE" BETWEEN THE
+C                          LINE AND A PLANE NORMAL TO ONE OF THE
+C                          COORDINATE AXES.
+C
+C                          THE ARGUMENTS U, V, W AND N
+C                          ARE THE SAME AS FOR CURVE, DESCRIBED ABOVE.
+C
+C                          IOREN SPECIFIES THE DIRECTION IN WHICH THE
+C                          FENCE LINES ARE TO BE DRAWN (1 INDICATES
+C                          PARALLEL TO THE U-AXIS, 2 INDICATES PARALLEL
+C                          TO THE V-AXIS, AND 3 INDICATES PARALLEL TO
+C                          TO THE W-AXIS.)
+C
+C                          BOT SPECIFIES WHERE THE BOTTOM OF THE FENCE
+C                          IS TO BE DRAWN.
+C                          IF THE FENCE LINES ARE TO BE DRAWN PARALLEL
+C                          TO THE W-AXIS, AND  BOT=2., THEN THE BOTTOM
+C                          OF THE FENCE WOULD BE THE PLANE  W=2.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTES                  .  FOR DRAWING CHARACTERS IN CONJUNCTION
+C                           WITH THREED, USE THE COMPANION ROUTINE
+C                           PWRZT.
+C
+C ENTRY POINTS          FENCE3, TRN32T, FRST3, VECT3, LIN3,
+C                       POINT3, CURVE3, PSYM3, PERIM3, LINE3W,
+C                       DRAWT, TICK43, TICK3, THREBD
+C
+C COMMON BLOCKS         TEMPR, SET31, PWRZ1T, TCK31, PRM31, THRINT
+C
+C REQUIRED LIBRARY      PWRZ AND THE SPPS
+C ROUTINES
+C
+C HISTORY               WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C I/O                   PLOTS LINES.
+C
+C PRECISION             SINGLE
+C
+C LANGUAGE              FORTRAN
+C
+C ACCURACY              + OR -.5 PLOTTER ADDRESS UNITS PER CALL.
+C                       THERE IS NO CUMULATIVE ERROR.
+C
+C PORTABILITY           ANSI FORTRAN 77
+C
+C
+C
+C
+C
+      SAVE
+C
+      COMMON /TEMPR/  RZERO
+C
+      DIMENSION       EYE(3)
+C
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0         ,NLX        ,
+     2                NBY        ,NRX        ,NTY
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+C
+C
+      AVE(A,B) = (A+B)*.5
+C
+C ARITHMETIC STATEMENT FUNCTION FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C +NOAO - Blockdata threbd rewritten as run time initialization.
+C
+C     EXTERNAL        THREBD
+      call threbd
+C -NOAO
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','SET3','VERSION  1')
+C
+C SET UP FRAME SIZE
+C
+      NLX = XA*1023.+1.
+      NRX = XB*1023.+1.
+      NBY = YA*1023.+1.
+      NTY = YB*1023.+1.
+C
+C CONSTANTS FOR PWRZT
+C
+      UUMIN = ULO
+      UUMAX = UHI
+      VVMIN = VLO
+      VVMAX = VHI
+      WWMIN = WLO
+      WWMAX = WHI
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+C
+C FIND CORNERS IN 2-SPACE FOR 3-SPACE BOX CONTAINING OBJECT
+C
+      ISCALE = 0
+      ATU = AVE(SU(UUMIN),SU(UUMAX))
+      ATV = AVE(SV(VVMIN),SV(VVMAX))
+      ATW = AVE(SW(WWMIN),SW(WWMAX))
+      BIGD = 0.
+      IF (RZERO .LE. 0.) GO TO  10
+C
+C RELATIVE SIZE FEATURE IN USE.  THIS SECTION OF CODE IS NEVER
+C EXECUTED UNLESS RZERO IS SET POSITIVE IN THE CALLING PROGRAM
+C VIA COMMON BLOCK TEMPR.  RZERO  IS THE DISTANCE BETWEEN THE
+C OBSERVER AND THE POINT LOOKED AT (CENTER OF THE BOX BY DEFAULT)
+C WHEN THE INPUT BOX IS TO FILL THE SCREEN WHEN VIEWED FROM THE
+C DIRECTION WHICH MAKES THE BOX BIGGEST.  RZERO  IS THUS TO
+C BE USED TO DETERMINE THE SHAPE OF THE OBJECT.   THIS SECTION
+C OF CODE IS TO BE USED WHEN IT IS DESIRED TO KEEP THE VIEWED
+C OBJECT IN RELATIVE PERSPECTIVE ACROSS FRAMES--E.G. IN MAKING
+C MOVIES.
+C
+      ALPHA = -(VVMIN-ATV)/(UUMIN-ATU)
+      VVEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      UUEYE = VVEYE*ALPHA
+      VVEYE = VVEYE+ATV
+      UUEYE = UUEYE+ATU
+      WWEYE = ATW
+      CALL TRN32T (ATU,ATV,ATW,UUEYE,VVEYE,WWEYE,1)
+      CALL TRN32T (UUMIN,VVMIN,ATW,XMIN,DUMM,DUMM,2)
+      CALL TRN32T (UUMAX,VVMIN,WWMIN,DUMM,YMIN,DUMM,2)
+      CALL TRN32T (UUMAX,VVMAX,ATW,XMAX,DUMM,DUMM,2)
+      CALL TRN32T (UUMAX,VVMIN,WWMAX,DUMM,YMAX,DUMM,2)
+      BIGD = SQRT((UUMAX-UUMIN)**2+(VVMAX-VVMIN)**2+(WWMAX-WWMIN)**2)*.5
+      R0 = RZERO
+      GO TO  20
+   10 CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMIN),X1,Y1,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMAX),X2,Y2,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMIN),X3,Y3,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMAX),X4,Y4,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMIN),X5,Y5,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMAX),X6,Y6,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMIN),X7,Y7,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMAX),X8,Y8,DUM,2)
+      XMIN = AMIN1(X1,X2,X3,X4,X5,X6,X7,X8)
+      XMAX = AMAX1(X1,X2,X3,X4,X5,X6,X7,X8)
+      YMIN = AMIN1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+      YMAX = AMAX1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+C
+C ADD RIGHT AMOUNT TO KEEP PICTURE SQUARE
+C
+   20 WIDTH = XMAX-XMIN
+      HIGHT = YMAX-YMIN
+      DIF = .5*(WIDTH-HIGHT)
+      IF (DIF)  30, 50, 40
+   30 XMIN = XMIN+DIF
+      XMAX = XMAX-DIF
+      GO TO  50
+   40 YMIN = YMIN-DIF
+      YMAX = YMAX+DIF
+   50 ISCALE = 1
+      CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      RETURN
+      END
+      SUBROUTINE TRN32T (U,V,W,XT,YT,ZT,IENT)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C TRN32T ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.  THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C TRN32 ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.  WHEN ISCALE=0, XT AND YT ANR IN THE SAME
+C          UNITS AS U,V, AND W.  WHEN ISCALE'0, XT AND YT
+C          ARE IN PLOTTER COORDINATES.
+C ZT       NOT USED.
+C
+C
+      SAVE
+C
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0         ,NLX        ,
+     2                NBY        ,NRX        ,NTY
+C
+C DECIDE IF SET OR TRANSLATE CALL
+C
+      IF (IENT .NE. 1) GO TO  50
+C
+C STORE THE PARAMETERS OF THE SET CALL
+C FOR USE WITH THE TRANSLATION CALL
+C
+      AU = U
+      AV = V
+      AW = W
+      EU = XT
+      EV = YT
+      EW = ZT
+C
+C
+C
+C
+C
+      DU = AU-EU
+      DV = AV-EV
+      DW = AW-EW
+      D = SQRT(DU*DU+DV*DV+DW*DW)
+      COSAL = DU/D
+      COSBE = DV/D
+      COSGA = DW/D
+      AL = ACOS(COSAL)
+      BE = ACOS(COSBE)
+      GA = ACOS(COSGA)
+      SINGA = SIN(GA)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE W AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE W AXIS, THE 3-SPACE V AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE W AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+      ASSIGN  90 TO JDONE
+      IF (ISCALE)  10, 30, 10
+   10 X0 = XMIN
+      Y0 = YMIN
+      X1 = NLX
+      Y1 = NBY
+      X2 = NRX-NLX
+      Y2 = NTY-NBY
+      X3 = X2/(XMAX-XMIN)
+      Y3 = Y2/(YMAX-YMIN)
+      X4 = NRX
+      Y4 = NTY
+      FACT = 1.
+      IF (BIGD .LE. 0.) GO TO  20
+      X0 = -BIGD
+      Y0 = -BIGD
+      X3 = X2/(2.*BIGD)
+      Y3 = Y2/(2.*BIGD)
+      FACT = R0/D
+   20 DELCRT = X2
+      ASSIGN  80 TO JDONE
+   30 IF (SINGA .LT. 0.0001) GO TO  40
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   40 SINBE = SIN(BE)
+      R = 1./SINBE
+      ASSIGN  60 TO JUMP
+      RETURN
+C
+C********************  ENTRY TRN32  ************************
+C     ENTRY TRN32 (U,V,W,XT,YT,ZT)
+C
+   50 UU = U
+      VV = V
+      WW = W
+      Q = D/((UU-EU)*COSAL+(VV-EV)*COSBE+(WW-EW)*COSGA)
+      GO TO JUMP,( 60, 70)
+   60 UU = ((EW+Q*(WW-EW)-AW)*COSAL-(EU+Q*(UU-EU)-AU)*COSGA)*R
+      VV = (EV+Q*(VV-EV)-AV)*R
+      GO TO JDONE,( 80, 90)
+   70 UU = ((EU+Q*(UU-EU)-AU)*COSBE-(EV+Q*(VV-EV)-AV)*COSAL)*R
+      VV = (EW+Q*(WW-EW)-AW)*R
+      GO TO JDONE,( 80, 90)
+   80 XT = X1+X3*(FACT*UU-X0)
+      YT = Y1+Y3*(FACT*VV-Y0)
+      RETURN
+   90 XT = UU
+      YT = VV
+      RETURN
+      END
+      SUBROUTINE FRST3 (U,V,W)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','FRST3','VERSION  1')
+      XDUM = 5.
+      CALL TRN32T (U,V,W,X,Y,XDUM,2)
+      CALL PLOTIT  (32*IFIX(X),32*IFIX(Y),0)
+      RETURN
+      END
+      SUBROUTINE VECT3 (U,V,W)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','VECT3','VERSION  1')
+      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
+      IIX = 32*IFIX(X)
+      IIY = 32*IFIX(Y)
+      CALL PLOTIT  (IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT  (IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE LINE3 (UA,VA,WA,UB,VB,WB)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','LINE3','VERSION  1')
+      CALL TRN32T (UA,VA,WA,XA,YA,XDUM,2)
+      CALL TRN32T (UB,VB,WB,XB,YB,XDUM,2)
+      IIX = 32*IFIX(XB)
+      IIY = 32*IFIX(YB)
+      CALL PLOTIT (32*IFIX(XA),32*IFIX(YA),0)
+      CALL PLOTIT (IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT (IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE POINT3 (U,V,W)
+      SAVE
+      DIMENSION VWPRT(4),WNDW(4)
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','POINT3','VERSION  1')
+C
+C INQUIRE CURRENT NORMALIZATION TRANS NUMBER
+C
+      CALL GQCNTN (IERR,NTORIG)
+C
+C SAVE NORMALIZATION TRANS 1 AND CURRENT LOG SCALING
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+      CALL GETUSV ('LS',IOLLS)
+C
+C DEFINE NOMALIZATION TRANS TO BE USED WITH POLYMARKER
+C
+      CALL SET(0.0, 1.0, 0.0, 1.0, 1.0, 1024.0, 1.0, 1024.0, 1)
+C
+C SET MARKER TYPE TO 1
+C
+      CALL GSMK (1)
+      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
+      PX = X
+      PY = Y
+      CALL GPM (1,PX,PY)
+C
+C RESTORE ORIGINAL TRANS 1 AND SELECT TRANS NUMBER NTORIG
+C RESTORE LOG SCALING
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+      END
+      SUBROUTINE CURVE3 (U,V,W,N)
+      SAVE
+      DIMENSION       U(N)       ,V(N)       ,W(N)
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','CURVE3','VERSION  1')
+      CALL TRN32T (U(1),V(1),W(1),X,Y,ZDUM,2)
+      CALL PLOTIT (32*IFIX(X),32*IFIX(Y),0)
+      NN = N
+      IF (NN .LT. 2) RETURN
+      DO  10 I=2,NN
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL TRN32T (UU,VV,WW,X,Y,ZDUM,2)
+         CALL PLOTIT (32*IFIX(X),32*IFIX(Y),1)
+   10 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE PSYM3 (U,V,W,ICHAR,SIZE,IDIR,ITOP,IUP)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','PSYM3','VERSION  1')
+      IF (IUP .EQ. 2) CALL VECT3 (U,V,W)
+      CALL PWRZ (U,V,W,ICHAR,1,SIZE,IDIR,ITOP,0)
+      RETURN
+      END
+      SUBROUTINE PERIM3 (MAGR1,MINI1,MAGR2,MINI2,IWHICH,VAR)
+      SAVE
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /PRM31/  Q          ,L
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
+     1                TMAGW      ,TMINW
+C
+C THRINT COMMON BLOCK IS USED FOR SETTING COLOR INTENSITY
+C
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+      DIMENSION       LASF(13)
+C
+      TICK(T) = AMAX1(UUMAX-UUMIN,VVMAX-VVMIN,WWMAX-WWMIN)*T/1024.
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','PERIM3','VERSION  1')
+C
+C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
+C
+      CALL GQPLCI (IERR, IPLCI)
+      CALL GQASF (IERR, LASF)
+      LSV3  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF (LASF)
+C
+      MGR1 = MAGR1
+      MN1 = MINI1-1
+      MGR2 = MAGR2
+      MN2 = MINI2-1
+      MN1P1 = MAX0(MN1+1,1)
+      MN2P1 = MAX0(MN2+1,1)
+      L = MIN0(3,MAX0(1,IWHICH))
+      Q = VAR
+C
+C PICK BOUNDS
+C
+      GO TO ( 10, 30, 40),L
+   10 XMIN = VVMIN
+      XMAX = VVMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+   20 YMIN = WWMIN
+      YMAX = WWMAX
+      DELYL = TICK(TMAGW)
+      DELYS = TICK(TMINW)
+      GO TO  50
+   30 XMIN = UUMIN
+      XMAX = UUMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+      GO TO  20
+   40 XMIN = UUMIN
+      XMAX = UUMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+      YMIN = VVMIN
+      YMAX = VVMAX
+      DELYL = TICK(TMAGV)
+      DELYS = TICK(TMINV)
+C
+C PERIM
+C
+   50 CALL LINE3W (XMIN,YMIN,XMAX,YMIN)
+      CALL LINE3W (XMAX,YMIN,XMAX,YMAX)
+      CALL LINE3W (XMAX,YMAX,XMIN,YMAX)
+      CALL LINE3W (XMIN,YMAX,XMIN,YMIN)
+      IF (MGR1 .LT. 1) GO TO  90
+      DX = (XMAX-XMIN)/AMAX0(MGR1*(MN1P1),1)
+      DO  80 I=1,MGR1
+C
+C MINORS FIRST
+C
+         IF (MN1 .LE. 0) GO TO  70
+C
+C SET LINE INTENSITY TO LOW
+C
+         CALL GSPLCI (ITHRMN)
+         DO  60 J=1,MN1
+            X = XMIN+FLOAT(MN1P1*(I-1)+J)*DX
+            CALL LINE3W (X,YMIN,X,YMIN+DELYS)
+            CALL LINE3W (X,YMAX,X,YMAX-DELYS)
+   60    CONTINUE
+   70    IF (I .GE. MGR1) GO TO  90
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI (ITHRMJ)
+         X = XMIN+FLOAT(MN1P1*I)*DX
+C
+C MAJORS
+C
+         CALL LINE3W (X,YMIN,X,YMIN+DELYL)
+         CALL LINE3W (X,YMAX,X,YMAX-DELYL)
+   80 CONTINUE
+   90 IF (MGR2 .LT. 1) GO TO 130
+      DY = (YMAX-YMIN)/AMAX0(MGR2*(MN2P1),1)
+      DO 120 J=1,MGR2
+         IF (MN2 .LE. 0) GO TO 110
+         DO 100 I=1,MN2
+            Y = YMIN+FLOAT(MN2P1*(J-1)+I)*DY
+            CALL LINE3W (XMIN,Y,XMIN+DELXS,Y)
+C
+C SET LINE INTENSITY TO LOW
+C
+            CALL GSPLCI (ITHRMN)
+            CALL LINE3W (XMAX,Y,XMAX-DELXS,Y)
+  100    CONTINUE
+  110    IF (J .GE. MGR2) GO TO 130
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI (ITHRMJ)
+         Y = YMIN+FLOAT(MN2P1*J)*DY
+         CALL LINE3W (XMIN,Y,XMIN+DELXL,Y)
+         CALL LINE3W (XMAX,Y,XMAX-DELXL,Y)
+  120 CONTINUE
+C
+C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
+C
+  130 LASF(3) = LSV3
+      CALL GSASF (LASF)
+      CALL GSPLCI (IPLCI)
+      RETURN
+      END
+      SUBROUTINE LINE3W (XA,YA,XB,YB)
+      SAVE
+      COMMON /PRM31/  Q          ,L
+      GO TO ( 10, 30, 40),L
+   10 UA = Q
+      UB = Q
+      VA = XA
+      VB = XB
+   20 WA = YA
+      WB = YB
+      GO TO  50
+   30 UA = XA
+      UB = XB
+      VA = Q
+      VB = Q
+      GO TO  20
+   40 UA = XA
+      UB = XB
+      VA = YA
+      VB = YB
+      WA = Q
+      WB = Q
+   50 CALL LINE3 (UA,VA,WA,UB,VB,WB)
+      RETURN
+      END
+      SUBROUTINE DRAWT (IXA,IYA,IXB,IYB)
+      SAVE
+      CALL PLOTIT(32*IXA,32*IYA,0)
+      IIX = 32*IXB
+      IIY = 32*IYB
+      CALL PLOTIT(IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
+      SAVE
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
+     1                TMAGW      ,TMINW
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','TICK43','VERSION  1')
+      TMAGU = MAGU
+      TMINU = MINU
+      TMAGV = MAGV
+      TMINV = MINV
+      TMAGW = MAGW
+      TMINW = MINW
+      RETURN
+      END
+      SUBROUTINE TICK3 (MAG,MIN)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','TICK3','VERSION  1')
+      CALL TICK43 (MAG,MIN,MAG,MIN,MAG,MIN)
+      RETURN
+      END
+      SUBROUTINE FENCE3 (U,V,W,N,IOR,BOT)
+      SAVE
+      REAL            U(N)       ,V(N)       ,W(N)
+      DIMENSION       LASF(13)
+C
+C COMMON BLOCK THRINT IS USED FOR SETTING COLOR INTENSITY
+C
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','FENCE3','VERSION  1')
+C
+C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
+C
+      CALL GQPLCI (IERR, IPLCI)
+      CALL GQASF (IERR, LASF)
+      LSV3  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF (LASF)
+C
+      M = N
+      BASE = BOT
+      L = MAX0(1,MIN0(3,IOR))
+C
+C SET LINE INTENSITY TO LOW
+C
+      CALL GSPLCI (ITHRMN)
+      GO TO ( 10, 40, 70),L
+   10 CALL FRST3 (BASE,V(1),W(1))
+      DO  20 I=2,M
+         VV = V(I)
+         WW = W(I)
+         CALL VECT3 (BASE,VV,WW)
+   20 CONTINUE
+      DO  30 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,BASE,VV,WW)
+   30 CONTINUE
+      GO TO 100
+   40 CALL FRST3 (U(1),BASE,W(1))
+      DO  50 I=2,M
+         UU = U(I)
+         WW = W(I)
+         CALL VECT3 (UU,BASE,WW)
+   50 CONTINUE
+      DO  60 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,UU,BASE,WW)
+   60 CONTINUE
+      GO TO 100
+   70 CALL FRST3 (U(1),V(1),BASE)
+      DO  80 I=2,M
+         UU = U(I)
+         VV = V(I)
+         CALL VECT3 (UU,VV,BASE)
+   80 CONTINUE
+      DO  90 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,UU,VV,BASE)
+   90 CONTINUE
+C
+C SET LINE INTENSITY TO HIGH
+C
+  100 CALL GSPLCI (ITHRMJ)
+      CALL CURVE3 (U,V,W,M)
+C
+C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
+C
+      LASF(3) = LSV3
+      CALL GSASF (LASF)
+      CALL GSPLCI (IPLCI)
+C
+      RETURN
+C
+C REVISION HISTORY---
+C
+C JANUARY 1978     DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C FEBURARY 1979    MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C JUNE 1979        UPDATED FILE TO INCLUDE BLOCK DATA PWRZBD AND
+C                  CORRECT A COMMENTED OUT STATEMENT IN CURVE3.
+C MARCH 1980       REMOVED THE PWRZ AND PWRITZ ENTRIES.  THESE
+C                  CAPABILITIES WERE REPLACED WITH THE NEW ULIB FILE
+C                  PWRZT.
+C JULY 1984        CONVERTED TO FORTRAN 77 AND GKS
+C-----------------------------------------------------------------------
+C
+      END
+      SUBROUTINE PWRZ (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C     WRITE (6,1001)
+C     WRITE (6,1002)
+C     STOP
+C
+C1001 FORMAT (1H1//////////)
+C1002 FORMAT (' *****************************************'/
+C    1        ' *                                       *'/
+C    2        ' *                                       *'/
+C    3        ' *   THE ENTRY POINT PWRZ IS NO LONGER   *'/
+C    4        ' *   SUPPORTED.  THE CAPABILITIES OF     *'/
+C    5        ' *   THIS OLD ENTRY ARE NOW AVAILABLE    *'/
+C    6        ' *   IN THE NEW PORTABLE VERSIONS        *'/
+C    7        ' *                                       *'/
+C    8        ' *        PWRZS  FOR USE WITH SRFACE     *'/
+C    9        ' *        PWRZI  FOR USE WITH ISOSRF     *'/
+C    +        ' *        PWRZT  FOR USE WITH THREED     *'/
+C    1        ' *                                       *'/
+C    2        ' *   FOR USAGE OF THESE ROUTINES, SEE    *'/
+C    3        ' *   THE DOCUMENTATION FOR THE DESIRED   *'/
+C    4        ' *   ROUTINE.                            *'/
+C    5        ' *                                       *'/
+C    6        ' *                                       *'/
+C    7        ' *****************************************')
+C
+      END
diff --git a/sys/gio/ncarutil/veldat.f b/sys/gio/ncarutil/veldat.f
new file mode 100644
index 00000000..9baef78d
--- /dev/null
+++ b/sys/gio/ncarutil/veldat.f
@@ -0,0 +1,67 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data veldat changed to run time initialization
+c     BLOCK DATA VELDAT
+        subroutine veldat
+C
+C THIS 'ROUTINE' DEFINES THE DEFAULT VALUES OF THE VELVCT PARAMETERS.
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY,
+     +                RMN        ,RMX        ,SIDE       ,SIZE,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+C
+      COMMON /VEC2/   BIG        ,INCX       ,INCY
+C
+c     DATA     EXT /    0.25 /
+c     DATA  ICTRFG /    1         /
+c     DATA    ILAB /    0         /
+c     DATA   IOFFD /    0         /
+c     DATA   IOFFM /    0         /
+c     DATA     RMN /  160.00 /
+c     DATA     RMX / 6400.00 /
+c     DATA    SIDE /    0.90 /
+c     DATA    SIZE /  256.00 /
+c     DATA     XLT /    0.05 /
+c     DATA     YBT /    0.05 /
+c     DATA     ZMX /    0.00 /
+c     DATA    INCX /    1          /
+c     DATA    INCY /    1          /
+c
+c +noao: following flag added to prevent over-initialization
+      logical first
+        SAVE
+      data first /.true./
+      if (.not. first) then
+          return
+      endif
+      first = .false.
+
+      EXT =     0.25 
+      ICTRFG =  1    
+      ILAB =    0         
+      IOFFD =   0    
+      IOFFM =   0    
+      RMN =  160.00 
+      RMX = 6400.00 
+      SIDE =    0.90 
+      SIZE =  256.00 
+      XLT =     0.05 
+      YBT =     0.05 
+      ZMX =     0.00 
+      INCX =    1          
+      INCY =    1          
+C
+c - noao
+      END
diff --git a/sys/gio/ncarutil/velvct.f b/sys/gio/ncarutil/velvct.f
new file mode 100644
index 00000000..fd8f46c7
--- /dev/null
+++ b/sys/gio/ncarutil/velvct.f
@@ -0,0 +1,821 @@
+      SUBROUTINE VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C SUBROUTINE VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C
+C
+C DIMENSION OF           U(LU,N),V(LV,N),SPV(2)
+C ARGUMENTS
+C
+C LATEST REVISION        JULY 1984
+C
+C PURPOSE                VELVCT DRAWS A REPRESENTATION OF A TWO-
+C                        DIMENSIONAL VELOCITY FIELD BY DRAWING ARROWS
+C                        FROM EACH DATA LOCATION.  THE LENGTH OF THE
+C                        ARROW IS PROPORTIONAL TO THE STRENGTH OF THE
+C                        FIELD AT THAT LOCATION AND THE DIRECTION OF
+C                        THE ARROW INDICATES THE DIRECTION OF THE FLOW
+C                        AT THAT LOCATION.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                               CALL EZVEC (U,V,M,N)
+C
+C                          ASSUMPTIONS -
+C
+C                            --THE WHOLE ARRAY IS PROCESSED.
+C                            --THE SCALE FACTOR IS CHOSEN INTERNALLY.
+C                            --THE PERIMETER IS DRAWN.
+C                            --FRAME IS CALLED AFTER PLOTTING.
+C                            --THERE ARE NO SPECIAL VALUES.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                               CALL VELVCT (U,LU,V,LV,M,N,FLO,HI,
+C                                                 NSET,LENGTH,ISPV,SPV)
+C
+C ARGUMENTS
+C
+C ON INPUT               U,V
+C
+C                          THE (ORIGINS OF THE) TWO-DIMENSIONAL ARRAYS
+C                          CONTAINING THE VELOCITY FIELD TO BE PLOTTED.
+C                          THE VECTOR AT THE POINT (I,J) HAS MAGNITUDE
+C                          SQRT(U(I,J)**2+V(I,J)**2) AND DIRECTION
+C                          ATAN2(V(I,J),U(I,J)).  OTHER REPRESENTATIONS,
+C                          SUCH AS (R,THETA), CAN BE PLOTTED BY
+C                          CHANGING STATEMENT FUNCTIONS IN THIS ROUTINE.
+C
+C                        LU
+C
+C                          THE FIRST DIMENSION OF U IN THE CALLING
+C                          PROGRAM.
+C
+C                        LV
+C
+C                          THE FIRST DIMENSION OF V IN THE CALLING
+C                          PROGRAM.
+C
+C                        M
+C
+C                          THE NUMBER OF DATA VALUES TO BE PLOTTED IN
+C                          THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                          DIRECTION).  WHEN PLOTTING THE ENTIRE ARRAY,
+C                          LU = LV = M.
+C
+C                        N
+C
+C                          THE NUMBER OF DATA VALUES TO BE PLOTTED IN
+C                          THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                          DIRECTION).
+C
+C                        FLO
+C
+C                          THE MINIMUM VECTOR MAGNITUDE TO BE SHOWN.
+C
+C                        HI
+C
+C                          THE MAXIMUM VECTOR MAGNITUDE TO BE SHOWN. (A
+C                          VALUE LESS THAN OR EQUAL TO ZERO CAUSES THE
+C                          MAXIMUM VALUE OF SQRT(U**2+V**2) TO BE USED.)
+C
+C                        NSET
+C
+C                          FLAG TO CONTROL SCALING -
+C
+C                          IF NSET IS ZERO, VELVCT ESTABLISHES THE
+C                          WINDOW AND VIEWPORT TO PROPERLY
+C                          SCALE PLOTTING INSTRUCTIONS TO THE STANDARD
+C                          CONFIGURATION.  PERIM IS CALLED TO DRAW A
+C                          BORDER.
+C
+C                          IF NSET IS GREATER THAN ZERO, VELVCT ASSUMES
+C                          THAT THE USER HAS ESTABLISHED THE WINDOW
+C                          AND VIEWPORT IN SUCH A WAY AS TO PROPERLY
+C                          SCALE THE PLOTTING INSTRUCTIONS GENERATED
+C                          BY VELVCT.  PERIM IS NOT CALLED.
+C
+C                          IF NSET IS LESS THAN ZERO, VELVCT
+C                          PLACES THE CONTOUR PLOT
+C                          WITHIN THE LIMITS OF THE USER'S CURRENT
+C                          WINDOW AND VIEWPORT.  PERIM IS NOT CALLED.
+C
+C                        LENGTH
+C
+C                          THE LENGTH, IN PLOTTER ADDRESS UNITS (PAUS),
+C                          OF A VECTOR HAVING MAGNITUDE HI
+C                          (OR, IF HI=0, THE LENGTH IN PAUS
+C                          OF THE LONGEST VECTOR).  IF LENGTH=0, A
+C                          VALUE IS CHOSEN SUCH THAT THE LONGEST VECTOR
+C                          COULD JUST REACH TO THE TAIL OF THE NEXT
+C                          VECTOR.  IF THE HORIZONTAL AND VERTICAL
+C                          RESOLUTIONS OF THE PLOTTER ARE DIFFERENT,
+C                          LENGTH SHOULD BE NON-ZERO AND SPECIFIED AS A
+C                          HORIZONTAL DISTANCE.
+C
+C                        ISPV
+C
+C                          FLAG TO CONTROL THE SPECIAL VALUE FEATURE.
+C
+C                             0 MEANS THAT THE FEATURE IS NOT IN USE.
+C
+C                             1 MEANS THAT IF THE VALUE OF
+C                               U(I,J)=SPV(1) THE VECTOR WILL NOT BE
+C                               PLOTTED.
+C
+C                             2 MEANS THAT IF THE VALUE OF
+C                               V(I,J)=SPV(2) THE VECTOR WILL NOT BE
+C                               PLOTTED.
+C
+C                             3 MEANS THAT IF EITHER U(I,J)=SPV(1) OR
+C                               V(I,J)=SPV(2) THEN THE VECTOR WILL NOT
+C                               BE PLOTTED.
+C
+C                             4 MEANS THAT IF U(I,J)=SPV(1)
+C                               AND V(I,J)=SPV(2), THE VECTOR
+C                               WILL NOT BE PLOTTED.
+C
+C                        SPV
+C
+C                        AN ARRAY OF LENGTH 2 WHICH GIVES THE VALUE
+C                        IN THE U ARRAY AND THE VALUE IN THE V ARRAY
+C                        WHICH DENOTE MISSING VALUES.
+C                        THIS ARGUMENT IS IGNORED IF ISPV=0.
+C
+C
+C ON OUTPUT              ALL ARGUMENTS REMAIN UNCHANGED.
+C
+C NOTE                   THE ENDPOINTS OF EACH ARROW DRAWN ARE (FX(X,Y),
+C                        FY(X,Y)) AND (MXF(X,Y,U,V,SFX,SFY,MX,MY),
+C                        MYF(X,Y,U,V,SFX,SFY,MX,MY)) WHERE X=I, Y=J,
+C                        U=U(I,J), V=V(I,J), AND SFX AND SFY ARE SCALE
+C                        FACTORS.  HERE I IS THE X-INDEX AND J IS THE
+C                        Y-INDEX.  (MX,MY) IS THE LOCATION OF THE TAIL.
+C                        THUS THE ACTUAL LENGTH OF THE ARROW IS
+C                        SQRT(DX**2+DY**2) AND THE DIRECTION IS
+C                        ATAN2(DX,DY), WHERE DX=MX-MXF(...) AND
+C                        DY=MY-MYF(...).
+C
+C ENTRY POINTS           VELVCT,EZVECT,DRWVEC,VELVEC,VELDAT
+C
+C COMMON BLOCKS          VEC1,VEC2
+C
+C I/O                    PLOTS THE VECTOR FIELD.
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C REQUIRED LIBRARY       GRIDAL AND THE SPPS
+C ROUTINES
+C
+C HISTORY                WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C                        REVISED IN MAY, 1975, TO INCLUDE MXF AND MYF.
+C                        REVISED IN MARCH, 1981, TO FIX CERTAIN ERRORS;
+C                        TO USE FL2INT AND PLOTIT INSTEAD OF MXMY,
+C                        FRSTPT, AND VECTOR; AND TO MAKE THE ARROWHEADS
+C                        NARROWER.  CONVERTED TO FORTRAN77 AND GKS
+C                        IN JULY 1984.
+C
+C ALGORITHM              EACH VECTOR IS EXAMINED, POSSIBLY TRANSFORMED,
+C                        THEN PLOTTED.
+C
+C PORTABILITY            FORTRAN77
+C
+C ---------------------------------------------------------------------
+C
+C SPECIAL NOTE -
+C
+C USING THIS ROUTINE TO PUT VECTORS ON AN ARBITRARY BACKGROUND DRAWN BY
+C SUPMAP IS A BIT TRICKY.  THE ARITHMETIC STATEMENT FUNCTIONS FX AND FY
+C ARE EASY TO REPLACE.  THE PROBLEM ARISES IN REPLACING MXF AND MYF.
+C THE FOLLOWING EXAMPLE MAY BE HELPFUL. (SUPMAP IS AN ENTRY POINT IN
+C THE EZMAP PACKAGE.)
+C
+C SUPPOSE THAT WE HAVE TWO ARRAYS, CLON(36,9) AND CLAT(36,9), WHICH
+C CONTAIN THE E-W AND N-S COMPONENTS OF A WIND FLOW FIELD ON THE SURFACE
+C OF THE EARTH.  CLON(I,J) IS THE MAGNITUDE OF THE EASTERLY FLOW.
+C CLAT(I,J) IS THE MAGNITUDE OF THE NORTHERLY FLOW AT A LONGITUDE (I-1)
+C *10 DEGREES EAST OF GREENWICH AND A LATITUDE (J-1)*10 DEGREES NORTH OF
+C THE EQUATOR.  SUPMAP IS TO BE USED TO DRAW A POLAR PROJECTION OF THE
+C EARTH AND VELVCT IS TO BE USED TO SUPERIMPOSE VECTORS REPRESENTING THE
+C FLOW FIELD ON IT.  THE FOLLOWING STEPS WOULD BE NECESSARY:
+C
+C     1.  CALL SUPMAP (1,90.,0.,-90.,90.,90.,90.,90.,-4,10,0,1,IER)
+C         TO DRAW THE MAP.
+C
+C     2.  CALL VELVCT (CLON,36,CLAT,36,36,9,0.,0.,1,50,0,0.) TO PUT
+C         VECTORS ON IT.  NOTICE THAT NSET HAS THE VALUE 1 TO TELL
+C         VELVCT THAT SUPMAP HAS DONE THE REQUIRED SET CALL.
+C
+C     3.  IN ORDER TO ENSURE THAT STEP 2 WILL WORK PROPERLY, DELETE
+C         THE ARITHMETIC STATEMENT FUNCTIONS FX, FY, MXF, AND MYF
+C         FROM VELVCT AND INCLUDE THE FOLLOWING FUNCTIONS.
+C
+C     FUNCTION FX(XX,YY)
+C     CALL MAPTRN (10.*(YY-1.),10.*(XX-1.),X,Y)
+C     FX=X
+C     RETURN
+C     END
+C
+C     FUNCTION FY(XX,YY)
+C     CALL MAPTRN (10.*(YY-1.),10.*(XX-1.),X,Y)
+C     FY=Y
+C     RETURN
+C     END
+C
+C     FUNCTION MXF(XX,YY,UU,VV,SFX,SFY,MX,MY)
+C     CFCT=COS(.17453292519943*(YY-1.))
+C     CALL MAPTRN(10.*(YY-1.)         ,10.*(XX-1.)              ,X1,Y1)
+C     CALL MAPTRN(10.*(YY-1.)+1.E-6*VV,10.*(XX-1.)+1.E-6*UU/CFCT,X2,Y2)
+C     U=((X2-X1)/SQRT((X2-X1)**2+(Y2-Y1)**2))*SQRT(UU**2+VV**2)
+C     MXF=MX+IFIX(SFX*U)
+C     RETURN
+C     END
+C
+C     FUNCTION MYF(XX,YY,UU,VV,SFX,SFY,MX,MY)
+C     CFCT=COS(.17453292519943*(YY-1.))
+C     CALL MAPTRN(10.*(YY-1.)         ,10.*(XX-1.)              ,X1,Y1)
+C     CALL MAPTRN(10.*(YY-1.)+1.E-6*VV,10.*(XX-1.)+1.E-6*UU/CFCT,X2,Y2)
+C     V=((Y2-Y1)/SQRT((X2-X1)**2+(Y2-Y1)**2))*SQRT(UU**2+VV**2)
+C     MYF=MY+IFIX(SFY*V)
+C     RETURN
+C     END
+C
+C THE BASIC NOTION BEHIND THE CODING OF THE MXF AND MYF FUNCTIONS IS AS
+C FOLLOWS.  SINCE UU AND VV ARE THE LONGITUDINAL AND LATITUDINAL COMPONENTS,
+C RESPECTIVELY, OF A VELOCITY VECTOR HAVING UNITS OF DISTANCE OVER TIME,
+C 1.E-6*UU/COS(LATITUDE) AND 1.E-6*VV REPRESENT THE CHANGE IN LONGITUDE
+C AND LATITUDE, RESPECTIVELY, OF A PARTICLE MOVING WITH THE FLOW FIELD
+C FOR A VERY SHORT PERIOD OF TIME.  THE ROUTINE MAPTRN IS USED TO FIND
+C THE POSITION OF THE PARTICLE'S PROJECTION AT THE BEGINNING AND END OF
+C THAT TINY TIME SLICE AND, THEREFORE, THE DIRECTION IN WHICH TO DRAW
+C THE ARROW REPRESENTING THE VELOCITY VECTOR SO THAT IT WILL BE TANGENT
+C TO A PROJECTED FLOW LINE OF THE FIELD AT THAT POINT.  THE VALUES U
+C AND V ARE COMPUTED SO AS TO GIVE THE ARROW THE LENGTH IMPLIED BY UU
+C AND VV.  (THE CODE ENSURES THAT SQRT(U**2+V**2) IS EQUAL TO
+C SQRT(UU**2+VV**2).)  THE LENGTH OF THE ARROW REPRESENTS THE MAGNITUDE
+C OF THE VELOCITY VECTOR, UNAFFECTED BY PERSPECTIVE.  THE SCALING SET
+C UP BY VELVCT WILL THEREFORE BE APPROPRIATE FOR THE ARROWS DRAWN.
+C
+C THIS METHOD IS RATHER HEURISTIC AND HAS THREE INHERENT PROBLEMS.
+C FIRST, THE CONSTANT 1.E-6 MAY NEED TO BE MADE LARGER OR SMALLER,
+C DEPENDING ON THE MAGNITUDE OF YOUR U/V DATA.  SECOND, THE NORTH AND
+C SOUTH POLES MUST BE AVOIDED.  AT EITHER POLE, CFCT GOES TO ZERO,
+C GIVING A DIVISION BY ZERO; IN A SMALL REGION NEAR THE POLE, THE
+C METHOD MAY TRY TO USE MAPTRN WITH A LATITUDE OUTSIDE THE RANGE
+C (-90,+90).  THIRD, THE PROJECTION MUST BE SET UP SO AS TO AVOID
+C HAVING VECTOR BASEPOINTS AT THE EXACT EDGE OF THE MAP.  VECTORS
+C THERE WILL BE OF THE CORRECT LENGTH, BUT THEY MAY BE DRAWN IN THE
+C WRONG DIRECTION (WHEN THE PROJECTED PARTICLE TRACK DETERMINING THE
+C DIRECTION CROSSES THE EDGE AND REAPPEARS ELSEWHERE ON THE MAP).
+C WITH A LITTLE CARE, THE DESIRED RESULTS MAY BE OBTAINED.
+C ---------------------------------------------------------------------
+C
+C DECLARATIONS -
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB       ,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY        ,
+     +                RMN        ,RMX        ,SIDE       ,SIZE       ,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+C
+      COMMON /VEC2/   BIG        ,INCX       ,INCY
+C
+C ARGUMENT DIMENSIONS.
+C
+      DIMENSION       U(LU,N)    ,V(LV,N)    ,SPV(2)
+        CHARACTER*10    LABEL
+        REAL WIND(4), VIEW(4), IAR(4)
+C
+C ---------------------------------------------------------------------
+C
+C INTERNAL PARAMETERS OF VELVCT ARE AS FOLLOWS.  THE DEFAULT VALUES OF
+C THESE PARAMETERS ARE DECLARED IN THE BLOCK DATA ROUTINE VELDAT.
+C
+C                        NAME   DEFAULT  FUNCTION
+C                        ----   -------  --------
+C
+C                        BIG   R1MACH(2) CONSTANT USED TO INITIALIZE
+C                                        POSSIBLE SEARCH FOR HI.
+C
+C                        EXT     0.25    THE LENGTHS OF THE SIDES OF THE
+C                                        PLOT ARE PROPORTIONAL TO M AND
+C                                        N WHEN NSET IS LESS THAN OR
+C                                        EQUAL TO ZERO, EXCEPT WHEN
+C                                        MIN(M,N)/MAX(M,N) IS LESS THAN
+C                                        EXT, IN WHICH CASE A SQUARE
+C                                        GRAPH IS PLOTTED.
+C
+C                        ICTRFG    1     FLAG TO CONTROL THE POSITION OF
+C                                        THE ARROW RELATIVE TO  A BASE
+C                                        POINT AT (MX,MY).
+C
+C                                        ZERO - CENTER AT (MX,MY)
+C
+C                                        POSITIVE - TAIL AT (MX,MY)
+C
+C                                        NEGATIVE -  HEAD AT (MX,MY)
+C
+C                        ILAB      0     FLAG TO CONTROL THE DRAWING OF
+C                                        LINE LABELS.
+C
+C                                        ZERO - DO NOT DRAW THE LABELS
+C
+C                                        NON-ZERO - DRAW THE LABELS
+C
+C                        INCX      1     X-COORDINATE STEP SIZE FOR LESS
+C                                        DENSE ARRAYS.
+C
+C                        INCY      1     Y-COORDINATE STEP SIZE.
+C
+C                        IOFFD     0     FLAG TO CONTROL NORMALIZATION
+C                                        OF LABEL NUMBERS.
+C
+C                                        ZERO - INCLUDE A DECIMAL POINT
+C                                        WHEN POSSIBLE
+C
+C                                        NON-ZERO - NORMALIZE ALL LABEL
+C                                        NUMBERS BY ASH
+C
+C                        IOFFM     0     FLAG TO CONTROL PLOTTING OF
+C                                        THE MESSAGE BELOW THE PLOT.
+C
+C                                        ZERO - PLOT THE MESSAGE
+C
+C                                        NON-ZERO - DO NOT PLOT IT
+C
+C                        RMN     160.    ARROW SIZE BELOW WHICH THE
+C                                        HEAD NO LONGER SHRINKS, ON A
+C                                        2**15 X 2**15 GRID.
+C
+C                        RMX    6400.    ARROW SIZE ABOVE WHICH THE
+C                                        HEAD NO LONGER GROWS LARGER,
+C                                        ON A 2**15 X 2**15 GRID.
+C
+C                        SIDE    0.90    LENGTH OF LONGER EDGE OF PLOT.
+C                                        (SEE ALSO EXT.)
+C
+C                        SIZE    256.    WIDTH OF THE CHARACTERS IN
+C                                        VECTOR LABELS, ON A 2**15 X
+C                                        2**15 GRID.
+C
+C                        XLT     0.05    LEFT HAND EDGE OF THE PLOT.
+C                                        (0 IS THE LEFT EDGE OF THE
+C                                        FRAME, 1 THE RIGHT EDGE.)
+C
+C                        YBT     0.05    BOTTOM EDGE OF THE PLOT (0 IS
+C                                        THE BOTTOM OF THE FRAME, 1 THE
+C                                        TOP OF THE FRAME.)
+C
+C ---------------------------------------------------------------------
+C
+C INTERNAL FUNCTIONS WHICH MAY BE MODIFIED FOR DATA TRANSFORMATION -
+C
+C                        SCALE    COMPUTES A SCALE FACTOR USED IN THE
+C                                 DETERMINATION OF THE LENGTH OF THE
+C                                 VECTOR TO BE DRAWN.
+C
+C                        DIST     COMPUTES THE LENGTH OF A VECTOR.
+C
+C                        FX       RETURNS THE X INDEX AS THE
+C                                 X-COORDINATE OF THE VECTOR BASE.
+C
+C                        MXF      RETURNS THE X-COORDINATE OF THE VECTOR
+C                                 HEAD.
+C
+C                        FY       RETURNS THE Y INDEX AS THE
+C                                 Y-COORDINATE OF THE VECTOR BASE.
+C
+C                        MYF      RETURNS THE Y-COORDINATE OF THE VECTOR
+C                                 HEAD.
+C
+C                        VLAB     THE VALUE FOR THE VECTOR LABEL WHEN
+C                                 ILAB IS NON-ZERO.
+C
+      SAVE
+      DIST(XX,YY) = SQRT(XX*XX+YY*YY)
+      FX(XX,YY) = XX
+      FY(XX,YY) = YY
+      MXF(XX,YY,UU,VV,SFXX,SFYY,MXX,MYY) = MXX+IFIX(SFXX*UU)
+      MYF(XX,YY,UU,VV,SFXX,SFYY,MXX,MYY) = MYY+IFIX(SFYY*VV)
+      SCALEX(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,XX4,YY3,YY4,
+     1       LENN) = LENN/HAA
+      SCALEY(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,XX4,YY3,YY4,
+     1       LENN) = SCALEX(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,
+     2                                                 XX4,YY3,YY4,LENN)
+      VLAB(UU,VV,II,JJ) = DIST(UU,VV)
+C
+C FORCE THE BLOCK DATA ROUTINE, WHICH SETS DEFAULT VARIABLES, TO LOAD.
+C +NOAO - blockdata replaced with run time initialization.
+C
+C     EXTERNAL        VELDAT
+      call veldat
+C -NOAO
+C
+C ---------------------------------------------------------------------
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('NSSL','VELVCT','VELVCT','VERSION  6')
+C
+C INITIALIZE AND TRANSFER SOME ARGUMENTS TO LOCAL VARIABLES.
+C
+      BIG = -R1MACH(2)
+      MX = LU
+      MY = LV
+      NX = M
+      NY = N
+      GL = FLO
+      HA = HI
+      ISP = ISPV
+      NC = 0
+C
+C COMPUTE CONSTANTS BASED ON THE ADDRESSABILITY OF THE PLOTTER.
+C
+      CALL GETUSV('XF',ISX)
+      CALL GETUSV('YF',ISY)
+      ISX = 2**(15-ISX)
+      ISY = 2**(15-ISY)
+      LEN = LENGTH*ISX
+C
+C SET UP THE SCALING OF THE PLOT.
+C
+        CALL GQCNTN(IERR,IOLDNT)
+        CALL GQNT(IOLDNT,IERR,WIND,VIEW)
+        X1 = VIEW(1)
+        X2 = VIEW(2)
+        Y1 = VIEW(3)
+        Y2 = VIEW(4)
+        X3 = WIND(1)
+        X4 = WIND(2)
+        Y3 = WIND(3)
+        Y4 = WIND(4)
+        CALL GETUSV('LS',IOLLS)
+C
+C     SAVE NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT(1,IERR,WIND,VIEW)
+C
+      IF (NSET) 101,102,106
+C
+  101 X3 = 1.
+      X4 = FLOAT(NX)
+      Y3 = 1.
+      Y4 = FLOAT(NY)
+      GO TO 105
+C
+  102 X1 = XLT
+      X2 = XLT+SIDE
+      Y1 = YBT
+      Y2 = YBT+SIDE
+      X3 = 1.
+      Y3 = 1.
+      X4 = FLOAT(NX)
+      Y4 = FLOAT(NY)
+      IF (AMIN1(X4,Y4)/AMAX1(X4,Y4) .LT. EXT) GO TO 105
+C
+      IF (NX-NY) 103,105,104
+  103 X2 = XLT+SIDE*X4/Y4
+      GO TO 105
+  104 Y2 = YBT+SIDE*Y4/X4
+C
+  105 CALL SET(X1,X2,Y1,Y2,X3,X4,Y3,Y4,1)
+      IF (NSET .EQ. 0) CALL PERIM (1,0,1,0)
+C
+C CALCULATE A LENGTH IF NONE PROVIDED.
+C
+  106 IF (LEN .NE. 0) GO TO 107
+      CALL FL2INT(FX(1.,1.),FY(1.,1.),MX,MY)
+      CALL FL2INT(FX(FLOAT(1+INCX),FLOAT(1+INCY)),
+     +            FY(FLOAT(1+INCX),FLOAT(1+INCY)),LX,LY)
+      LEN = SQRT((FLOAT(MX-LX)**2+FLOAT(MY-LY)**2)/2.)
+C
+C SET UP SPECIAL VALUES.
+C
+  107 IF (ISP .EQ. 0) GO TO 108
+      SPV1 = SPV(1)
+      SPV2 = SPV(2)
+      IF (ISP .EQ. 4) SPV2 = SPV(1)
+C
+C FIND THE MAXIMUM VECTOR LENGTH.
+C
+  108 IF (HA .GT. 0.) GO TO 118
+C
+      HA = BIG
+      IF (ISP .EQ. 0) GO TO 115
+C
+      DO 114 J=1,NY,INCY
+         DO 113 I=1,NX,INCX
+            IF (ISP-2) 109,111,110
+  109       IF (U(I,J) .EQ. SPV1) GO TO 113
+            GO TO 112
+  110       IF (U(I,J) .EQ. SPV1) GO TO 113
+  111       IF (V(I,J) .EQ. SPV2) GO TO 113
+  112       HA = AMAX1(HA,DIST(U(I,J),V(I,J)))
+  113    CONTINUE
+  114 CONTINUE
+      GO TO 126
+C
+  115 DO 117 J=1,NY,INCY
+         DO 116 I=1,NX,INCX
+            HA = AMAX1(HA,DIST(U(I,J),V(I,J)))
+  116    CONTINUE
+  117 CONTINUE
+C
+C BRANCH IF NULL VECTOR SIZE.
+C
+  126 IF (HA .LE. 0.) GO TO 125
+C
+C COMPUTE SCALE FACTORS.
+C
+  118 SFX = SCALEX(M,N,INCX,INCY,HA,X1,X2,Y1,Y2,X3,X4,Y3,Y4,LEN)
+      SFY = SCALEY(M,N,INCX,INCY,HA,X1,X2,Y1,Y2,X3,X4,Y3,Y4,LEN)
+      IOFFDT = IOFFD
+      IF (GL.NE.0.0 .AND. (ABS(GL).LT.0.1 .OR. ABS(GL).GE.1.E5))
+     1    IOFFDT = 1
+      IF (HA.NE.0.0 .AND. (ABS(HA).LT.0.1 .OR. ABS(HA).GE.1.E5))
+     1    IOFFDT = 1
+      ASH = 1.0
+      IF (IOFFDT .NE. 0)
+     1    ASH = 10.**(3-IFIX(ALOG10(AMAX1(ABS(GL),ABS(HA)))-500.)-500)
+      IZFLG = 0
+C
+C COMPUTE ZMN AND ZMX, WHICH ARE USED IN DRWVEC.
+C
+      ZMN = LEN*(GL/HA)
+      ZMX = FLOAT(LEN)+.01
+C
+C DRAW THE VECTORS.
+C
+      DO 123 J=1,NY,INCY
+         DO 122 I=1,NX,INCX
+            UI = U(I,J)
+            VI = V(I,J)
+            IF (ISP-1) 121,119,120
+  119       IF (UI-SPV1) 121,122,121
+  120       IF (VI .EQ. SPV2) GO TO 122
+            IF (ISP .GE. 3) GO TO 119
+  121       X = I
+            Y = J
+            CALL FL2INT(FX(X,Y),FY(X,Y),MX,MY)
+            LX = MAX0(1,MXF(X,Y,UI,VI,SFX,SFY,MX,MY))
+            LY = MAX0(1,MYF(X,Y,UI,VI,SFX,SFY,MX,MY))
+            IZFLG = 1
+            IF (ILAB .NE. 0) CALL ENCD(VLAB(UI,VI,I,J),ASH,LABEL,NC,
+     +                                                           IOFFDT)
+            CALL DRWVEC (MX,MY,LX,LY,LABEL,NC)
+  122    CONTINUE
+  123 CONTINUE
+C
+      IF (IZFLG .EQ. 0) GO TO 125
+C
+      IF (IOFFM .NE. 0) GO TO 200
+C +NOAO - FTN internal write replaced with call to encode
+C     WRITE(LABEL,'(E10.3)')HA
+      call encode (10, '(e10.3)', label, ha)
+C -NOAO
+C
+C     TURN OFF CLIPPING SO ARROW CAN BE DRAWN
+C
+      CALL GQCLIP(IER,ICLP,IAR)
+      CALL GSCLIP(0)
+      CALL DRWVEC (28768,608,28768+LEN,608,LABEL,10)
+C
+C     RESTORE CLIPPING
+C
+      CALL GSCLIP(ICLP)
+        IX = 1+(28768+LEN/2)/ISX
+        IY = 1+(608-(5*ISX*MAX0(256/ISX,8))/4)/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR (XC,YC,
+     +                         'MAXIMUM VECTOR',MAX0(256/ISX,8),0,0)
+      CALL GSELNT(ICN)
+C
+C DONE.
+C
+      GOTO 200
+C
+C ZERO-FIELD ACTION.
+C
+  125 IX = 1+16384/ISX
+        IY = 1+16384/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR (XC,YC,
+     +                             'ZERO FIELD',MAX0(960/ISX,8),0,0)
+        CALL GSELNT(ICN)
+C
+C RESTORE TRANS 1 AND LOG SCALING AND ORIGINAL TRANS NUMBER
+C
+  200 CONTINUE
+      IF (NSET .LE. 0) THEN
+        CALL SET(VIEW(1),VIEW(2),VIEW(3),VIEW(4),
+     -           WIND(1),WIND(2),WIND(3),WIND(4),IOLLS)
+      ENDIF
+      CALL GSELNT(IOLDNT)
+      RETURN
+      END
+      SUBROUTINE EZVEC (U,V,M,N)
+C
+C THIS SUBROUTINE IS FOR THE USER WHO WANTS A QUICK-AND-DIRTY VECTOR
+C PLOT WITH DEFAULT VALUES FOR MOST OF THE ARGUMENTS.
+C
+        SAVE
+C
+      DIMENSION       U(M,N)     ,V(M,N)     ,SPVAL(2)
+C
+      DATA FLO,HI,NSET,LENGTH,ISPV,SPVAL(1),SPVAL(2) /
+     +      0.,0.,   0,     0,   0,      0.,      0. /
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('CRAYLIB','VELVCT','EZVEC','VERSION  6')
+C
+      CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPVAL)
+C +NOAO - call to frame is suppressed.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE DRWVEC (M1,M2,M3,M4,LABEL,NC)
+C
+C THIS ROUTINE IS CALLED TO DRAW A SINGLE ARROW.  IT HAS ARGUMENTS AS
+C FOLLOWS -
+C
+C     (M1,M2)  -  COORDINATE OF ARROW BASE, ON A 2**15 X 2**15 GRID.
+C     (M3,M4)  -  COORDINATE OF ARROW HEAD, ON A 2**15 X 2**15 GRID.
+C     LABEL    -  CHARACTER LABEL TO BE PUT ABOVE ARROW.
+C     NC       -  NUMBER OF CHARACTERS IN LABEL.
+C
+        SAVE
+C
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB       ,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY        ,
+     +                RMN        ,RMX        ,SIDE       ,SIZE       ,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+        CHARACTER*10 LABEL
+C
+C SOME LOCAL PARAMETERS ARE THE FOLLOWING -
+C
+C     CL     -  ARROW HEAD LENGTH SCALE FACTOR - EACH SIDE OF THE ARROW
+C               HEAD IS THIS LONG RELATIVE TO THE LENGTH OF THE ARROW
+C     ST,CT  -  SIN AND COS OF THE ARROW HEAD ANGLE
+C     PI     -  THE CONSTANT PI
+C     TWOPI  -  TWO TIMES PI
+C     OHOPI  -  ONE HALF OF PI
+C     FHOPI  -  FIVE HALVES OF PI
+C
+      DATA    CL / .25 /
+      DATA    ST / .382683432365090 /
+      DATA    CT / .923879532511287 /
+      DATA    PI / 3.14159265358979 /
+      DATA TWOPI / 6.28318530717959 /
+      DATA OHOPI / 1.57079632679489 /
+      DATA FHOPI / 7.85398163397448 /
+C
+      DIST(X,Y) = SQRT(X*X+Y*Y)
+C
+C TRANSFER ARGUMENTS TO LOCAL VARIABLES AND COMPUTE THE VECTOR LENGTH.
+C
+      N1 = M1
+      N2 = M2
+      N3 = M3
+      N4 = M4
+      DX = N3-N1
+      DY = N4-N2
+      R = DIST(DX,DY)
+C
+C SORT OUT POSSIBLE CASES, DEPENDING ON VECTOR LENGTH.
+C
+      IF (R .LE. ZMN) RETURN
+C
+      IF (R .LE. ZMX) GO TO 101
+C
+C PLOT A POINT FOR VECTORS WHICH ARE TOO LONG.
+C
+      CALL PLOTIT (N1,N2,0)
+      CALL PLOTIT (N1,N2,1)
+      CALL PLOTIT (N1,N2,0)
+      RETURN
+C
+C ADJUST THE COORDINATES OF THE VECTOR ENDPOINTS AS IMPLIED BY THE
+C CENTERING OPTION.
+C
+  101 IF (ICTRFG) 102,103,104
+C
+  102 N3 = N1
+      N4 = N2
+      N1 = FLOAT(N1)-DX
+      N2 = FLOAT(N2)-DY
+      GO TO 104
+C
+  103 N1 = FLOAT(N1)-.5*DX
+      N2 = FLOAT(N2)-.5*DY
+      N3 = FLOAT(N3)-.5*DX
+      N4 = FLOAT(N4)-.5*DY
+C
+C DETERMINE THE COORDINATES OF THE POINTS USED TO DRAW THE ARROWHEAD.
+C
+  104 C1 = CL
+C
+C SHORT ARROWS HAVE HEADS OF A FIXED MINIMUM SIZE.
+C
+      IF (R .LT. RMN) C1 = RMN*CL/R
+C
+C LONG ARROWS HAVE HEADS OF A FIXED MAXIMUM SIZE.
+C
+      IF (R .GT. RMX) C1 = RMX*CL/R
+C
+C COMPUTE THE COORDINATES OF THE HEAD.
+C
+      N5 = FLOAT(N3)-C1*(CT*DX-ST*DY)
+      N6 = FLOAT(N4)-C1*(CT*DY+ST*DX)
+      N7 = FLOAT(N3)-C1*(CT*DX+ST*DY)
+      N8 = FLOAT(N4)-C1*(CT*DY-ST*DX)
+C
+C PLOT THE ARROW.
+C
+      CALL PLOTIT (N1,N2,0)
+      CALL PLOTIT (N3,N4,1)
+      CALL PLOTIT (N5,N6,0)
+      CALL PLOTIT (N3,N4,1)
+      CALL PLOTIT (N7,N8,1)
+      CALL PLOTIT (0,0,0)
+C
+C IF REQUESTED, PUT THE VECTOR MAGNITUDE ABOVE THE ARROW.
+C
+      IF (NC .EQ. 0) RETURN
+      PHI = ATAN2(DY,DX)
+      IF (AMOD(PHI+FHOPI,TWOPI) .GT. PI) PHI = PHI+PI
+      IX = 1+IFIX(.5*FLOAT(N1+N3)+1.25*
+     +            FLOAT(ISX*MAX0(IFIX(SIZE)/ISX,8))*COS(PHI+OHOPI))/ISX
+      IY = 1+IFIX(.5*FLOAT(N2+N4)+1.25*
+     +            FLOAT(ISX*MAX0(IFIX(SIZE)/ISX,8))*SIN(PHI+OHOPI))/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR(XC,YC,
+     +           LABEL,MAX0(IFIX(SIZE)/ISX,8),
+     +                                     IFIX(57.2957795130823*PHI),0)
+        CALL GSELNT(ICN)
+      RETURN
+      END
+      SUBROUTINE VELVEC (U,LU,V,LV,M,N,FLO,HI,NSET,ISPV,SPV)
+C
+C THIS ROUTINE SUPPORTS USERS OF THE OLD VERSION OF THIS PACKAGE.
+C
+      DIMENSION       U(LU,N)    ,V(LV,N)    ,SPV(2)
+C
+        SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('CRAYLIB','VELVCT','VELVEC','VERSION  4')
+      CALL VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,0,ISPV,SPV)
+      RETURN
+      END
+C
+C REVISION HISTORY ----------------------------------------------------
+C
+C FEBRUARY, 1979   ADDED REVISION HISTORY
+C                  MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C
+C JULY, 1979       FIXED HI VECTOR TRAP AND MESSAGE INDICATING
+C                  MAXIMUM VECTOR PLOTTED.
+C
+C DECEMBER, 1979   CHANGED THE STATISTICS CALL FROM CRAYLIB TO NSSL
+C
+C MARCH, 1981      FIXED SOME FRINGE-CASE ERRORS, CHANGED THE CODE TO
+C                  USE FL2INTT AND PLOTIT INSTEAD OF MXMY, FRSTPT, AND
+C                  VECTOR, AND MADE THE ARROWHEADS NARROWER (45 DEGREES
+C                  APART, RATHER THAN 60 DEGREES APART)
+C
+C FEBRUARY, 1984   PROVIDED A DIMENSION STATEMENT FOR A VARIABLE INTO
+C                  WHICH A TEN-CHARACTER STRING WAS BEING ENCODED.  ON
+C                  THE CRAY, WHEN THE ENCODE WAS DONE, A WORD FOLLOWING
+C                  THE VARIABLE WAS CLOBBERED, BUT THIS APPARENTLY MADE
+C                  NO DIFFERENCE.  ON AT LEAST ONE OTHER MACHINE, THE
+C                  CODE BLEW UP.  (ERROR REPORTED BY GREG WOODS)
+C
+C JULY, 1984       CONVERTED TO FORTRAN77 AND GKS.
+C
+C ---------------------------------------------------------------------
diff --git a/sys/gio/nspp/README b/sys/gio/nspp/README
new file mode 100644
index 00000000..38bd1580
--- /dev/null
+++ b/sys/gio/nspp/README
@@ -0,0 +1,9 @@
+NSPP -- The NCAR System Plot Package.
+
+	portlib		portable NSPP modules
+	sysint		the system interface
+
+Usage:
+	The user must supply a subroutine called WRITEB to use the library.
+	See gio$nsppkern for an example.  The subroutine Z8ZPII should be
+	called before using NSPP to initialize the internal variables.
diff --git a/sys/gio/nspp/mkpkg b/sys/gio/nspp/mkpkg
new file mode 100644
index 00000000..3ce0021c
--- /dev/null
+++ b/sys/gio/nspp/mkpkg
@@ -0,0 +1,11 @@
+# Make the LIBNSPP.A library for the Ncar system plot package.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	@portlib
+	@sysint
+	;
diff --git a/sys/gio/nspp/portlib/README b/sys/gio/nspp/portlib/README
new file mode 100644
index 00000000..261de972
--- /dev/null
+++ b/sys/gio/nspp/portlib/README
@@ -0,0 +1,28 @@
+This directory contains the sources for the NCAR system plot package.
+The original source is in the file "plot.4.8.sav".  If any modifications
+have to be made, they will be recorded here.
+
+REVISIONS
+
+04Mar84 SET --> SPPSET
+	The name of the SET module, used to set the device window and
+	user coordinate system, was changed to SPPSET.  The module "set.x"
+	in the high level code intercepts calls by the utilities to set,
+	so that the transformations may be stored away in a file for recovery
+	by another process.
+
+05Mar84 Elimination of Fortran i/o
+	All formatted writes to mprint were commented out.
+
+05Mar48 Resolve library conflict
+	getchr --> ncgchr		[collision with fio.getchar]
+	putchr --> ncpchr		[for consistency with above]
+
+12Mar84 Moved most of the initialization from the block data z8zpbd into
+	the initialization subroutine z8zpii, called by nspp_init at
+	GOPEN time.
+
+12Dec85 SPPSET -> SET
+	Changed this guy back, as the high level interface to the system
+	plot package is no longer used.  The NCAR system plot package stuff
+	is only used by the GIO/NCAR kernel now.
diff --git a/sys/gio/nspp/portlib/axes.f b/sys/gio/nspp/portlib/axes.f
new file mode 100644
index 00000000..badf7004
--- /dev/null
+++ b/sys/gio/nspp/portlib/axes.f
@@ -0,0 +1,6 @@
+      subroutine axes (x,y)
+      call getset (idummy,idummy,idummy,idummy,xc,xd,yc,yd,idummy)
+      call line (x,yc,x,yd)
+      call line (xc,y,xd,y)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/curve.f b/sys/gio/nspp/portlib/curve.f
new file mode 100644
index 00000000..265b9811
--- /dev/null
+++ b/sys/gio/nspp/portlib/curve.f
@@ -0,0 +1,41 @@
+      subroutine curve (x,y,n)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      dimension       x(n)   ,y(n)
+c
+      kn = n
+      if (kn-1) 104,103,101
+  101 xx = x(1)
+      yy = y(1)
+      call trans
+      minst = 0
+      call put42
+      do 102 i=2,kn
+         xx = x(i)
+         yy = y(i)
+         call trans
+         minst = 1
+         call put42
+  102 continue
+      go to 104
+  103 call point (x(1),y(1))
+  104 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/dashln.f b/sys/gio/nspp/portlib/dashln.f
new file mode 100644
index 00000000..35ac6851
--- /dev/null
+++ b/sys/gio/nspp/portlib/dashln.f
@@ -0,0 +1,5 @@
+      subroutine dashln (ipat)
+      jpat = ior(ishift(ipat,6),ishift(ipat,-4))
+      call optn (4hdpat,jpat)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/fl2int.f b/sys/gio/nspp/portlib/fl2int.f
new file mode 100644
index 00000000..59939aca
--- /dev/null
+++ b/sys/gio/nspp/portlib/fl2int.f
@@ -0,0 +1,31 @@
+      subroutine fl2int (x,y,imx,imy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      nx = mx
+      ny = my
+      xx = x
+      yy = y
+      call trans
+      imx = mx
+      imy = my
+      mx = nx
+      my = ny
+      return
+      end
diff --git a/sys/gio/nspp/portlib/flash1.f b/sys/gio/nspp/portlib/flash1.f
new file mode 100644
index 00000000..39fb31c6
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash1.f
@@ -0,0 +1,42 @@
+      subroutine flash1 (ibuf,ibufl)
+      dimension       ibuf(ibufl)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      mxold = -9999
+      myold = -9999
+      call mcflsh
+      mbufa = loci(ibuf)
+      mbufl = ibufl
+      modef = 1
+      mnxsto = mjxmin
+      mnysto = mjymin
+      mxxsto = mjxmax
+      mxysto = mjymax
+      mjxmin = 32767
+      mjymin = 32767
+      mjxmax = 0
+      mjymax = 0
+      mbuflu = 0
+      return
+c
+  101 call uliber (0,
+     1             48h0flash1 called consecutively without flash2 call,
+     2             48)
+      call perror
+      return
+      end
diff --git a/sys/gio/nspp/portlib/flash2.f b/sys/gio/nspp/portlib/flash2.f
new file mode 100644
index 00000000..0f909414
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash2.f
@@ -0,0 +1,71 @@
+      subroutine flash2 (ipoint,ibuflu)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       idummy(1)
+      if (modef .ne. 1) go to 101
+      kpoint = ipoint
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 102
+      call flushb
+      nextra = 5
+      ibuflu = mbuflu+nextra
+      if (mf2er .gt. 0) go to 103
+      if (ibuflu .gt. mbufl) go to 103
+      mfwa(kpoint+1) = mbufa
+      mlwa(kpoint+1) = mbufa+mbuflu-1
+      isub = mbufa+mbuflu-loci(idummy)
+      idummy(isub+1) = mbuflu
+      idummy(isub+2) = mjxmin
+      idummy(isub+3) = mjymin
+      idummy(isub+4) = mjxmax
+      idummy(isub+5) = mjymax
+      modef = 2
+      mbufa = loci(msybuf)
+      mbufl = msblen
+      mbuflu = 0
+      mbprs(1) = mpair1
+      mbprs(2) = mpair2
+      mipair = 2
+      mflcnt = 0
+      mxold = -9999
+      myold = -9999
+      mjxmin = mnxsto
+      mjymin = mnysto
+      mjxmax = mxxsto
+      mjymax = mxysto
+      return
+c
+  101 call uliber (0,29h0flash2 called without flash1,29)
+      call perror
+      return
+  102 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,38h0first argument to flash2 out of range,38)
+      call perror
+      return
+  103 continue
+      nlen = mf2er*mbufl+ibuflu
+c     write (mprint,1002) nlen
+c
+      call uliber (0,23h0flash buffer too short,23)
+      call perror
+      return
+c
+c1001 format (27h0flash2 called with ipoint=,i5)
+c1002 format (27h0flash buffer must be about,i8,11h words long)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flash3.f b/sys/gio/nspp/portlib/flash3.f
new file mode 100644
index 00000000..ce7f36d5
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash3.f
@@ -0,0 +1,70 @@
+      subroutine flash3 (ipoint)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       idummy(1)
+      if (modef .lt. 2) go to 102
+      kpoint = ipoint
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 103
+      if (mfwa(kpoint+1) .eq. -9999) go to 102
+      call mcflsh
+      isave1 = mbufa
+      isave2 = mbuflu
+      mbufa = mfwa(kpoint+1)
+      nlentg = mlwa(kpoint+1)-mbufa+1
+      isub = mbufa+nlentg-loci(idummy)
+      nusrwc = idummy(isub+1)
+      if (nusrwc .ne. nlentg) go to 104
+      modef = -3
+  101 mbuflu = min0(nlentg,msblen)
+      if (mbuflu .gt. 0) call preout
+      nlentg = nlentg-msblen
+      mbufa = mbufa+msblen
+      if (nlentg .gt. 0) go to 101
+      mbufa = isave1
+      mbuflu = isave2
+      mxold = -9999
+      myold = -9999
+      modef = 3
+      mjxmin = min0(mjxmin,idummy(isub+2))
+      mjymin = min0(mjymin,idummy(isub+3))
+      mjxmax = max0(mjxmax,idummy(isub+4))
+      mjymax = max0(mjymax,idummy(isub+5))
+      return
+  102 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,
+     1             48h0flash3 called without call to flash1 and flash2,
+     2             48)
+      call perror
+      return
+  103 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,37h0argument out of range in flash3 call,37)
+      call perror
+      return
+  104 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,37h0user flash buffer has been corrupted,37)
+      call perror
+      return
+c
+c1001 format (27h0flash3 called with ipoint=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flash4.f b/sys/gio/nspp/portlib/flash4.f
new file mode 100644
index 00000000..9fc13238
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash4.f
@@ -0,0 +1,46 @@
+      subroutine flash4 (ifw,lwd,ipoint)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       ifw(1) ,lwd(1)
+      jfwa = loci(ifw)
+      jlwda = loci(lwd)
+      kpoint = ipoint
+      if (jfwa .gt. jlwda) go to 101
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 102
+      nextra = 5
+      mfwa(kpoint+1) = jfwa
+      mlwa(kpoint+1) = jlwda-nextra
+      nwds = jlwda-jfwa
+      modef = 4
+      return
+  101 continue
+c     write (mprint,1001) jfwa,jlwda
+c
+      call uliber (0,38h0loci(ifw).gt.loci(lwd) in flash4 call,38)
+      call perror
+      return
+  102 continue
+c     write (mprint,1002) kpoint
+c
+      call uliber (0,43h0third argument out of range in flash4 call,43)
+      call perror
+      return
+c
+c1001 format (10h0loci(ifw)=,i10,10x,9hloci(lwd)=,i10)
+c1002 format (27h0flash4 called with ipoint=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flush.f b/sys/gio/nspp/portlib/flush.f
new file mode 100644
index 00000000..07ee8418
--- /dev/null
+++ b/sys/gio/nspp/portlib/flush.f
@@ -0,0 +1,22 @@
+      subroutine mcflsh
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      call flushb
+      if (mbuflu .gt. 0) call preout
+  101 return
+      end
diff --git a/sys/gio/nspp/portlib/flushb.f b/sys/gio/nspp/portlib/flushb.f
new file mode 100644
index 00000000..7f88c29b
--- /dev/null
+++ b/sys/gio/nspp/portlib/flushb.f
@@ -0,0 +1,41 @@
+      subroutine flushb
+c     dimension       idummy(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      external        z8zpbd
+      if (mipair .eq. 16) go to 102
+      if (mipair .eq. 0) return
+      if (mipair.eq.2 .and. mflcnt.eq.0) return
+      mipp1 = mipair+1
+      do 101 i=mipp1,16
+         mbprs(i) = 40992
+  101 continue
+  102 if (mbufa .eq. -9999) mbufa = loci(msybuf)
+      mflcnt = mflcnt+1
+      call packum (mbprs,16,mbufa+mbuflu)
+      mbuflu = mbuflu+8
+      mipair = 0
+      if (modef .eq. 1) go to 103
+      if (mbuflu+8 .le. mbufl) return
+      if (mbuflu .gt. 0) call preout
+      return
+  103 if (mod(mbuflu,msblen) .eq. 0) go to 104
+      if (mbuflu+8 .le. mbufl) return
+  104 continue
+      if (mbuflu .gt. 0) call preout
+      return
+      end
diff --git a/sys/gio/nspp/portlib/frame.f b/sys/gio/nspp/portlib/frame.f
new file mode 100644
index 00000000..c8396fcd
--- /dev/null
+++ b/sys/gio/nspp/portlib/frame.f
@@ -0,0 +1,70 @@
+      subroutine frame
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      mbpair = ior(ishift(226,8),0)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if ((mipair+5) .gt. 16) call flushb
+      mbpair = ior(ishift(231,8),8)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjxmin
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjymin
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjxmax
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjymax
+      mfrend = 1
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      call flushb
+      if (mbuflu .gt. 0) call preout
+      mjxmin = 32767
+      mjymin = 32767
+      mjxmax = 0
+      mjymax = 0
+      mxold = -9999
+      myold = -9999
+      mop(1) = 0
+      mop(2) = 204
+      mop(5) = 0
+      mop(3) = 0
+      mop(4) = 128
+      mop(7) = 8
+      mop(6) = ior(1,ishift(32767,1))
+      mop(8) = 0
+      mop(9) = 0
+      mop(10) = 0
+      mfrend = 0
+      return
+c
+  101 call uliber (0,45h0frame call illegal between flash1 and flash2,
+     1             45)
+      call perror
+      return
+      end
diff --git a/sys/gio/nspp/portlib/frstpt.f b/sys/gio/nspp/portlib/frstpt.f
new file mode 100644
index 00000000..7fea3675
--- /dev/null
+++ b/sys/gio/nspp/portlib/frstpt.f
@@ -0,0 +1,30 @@
+      subroutine frstpt (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      mxold = mx
+      myold = my
+      xx = x
+      yy = y
+      call trans
+      if (iabs(mx-mxold)+iabs(my-myold) .eq. 0) return
+      minst = 0
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getopt.f b/sys/gio/nspp/portlib/getopt.f
new file mode 100644
index 00000000..10474014
--- /dev/null
+++ b/sys/gio/nspp/portlib/getopt.f
@@ -0,0 +1,37 @@
+      subroutine getopt (iopnam,iopval)
+      dimension       iopnam(1)      ,iopval(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c find index for input name
+c
+      do 101 i=1,9
+         iop = i
+         if (jlm2(iopnam) .eq. jlm2(mname(i))) go to 102
+  101 continue
+c
+      call uliber (0,36hounknown name in optn or getopt call,36)
+      call perror
+      return
+  102 if (iop .eq. 9) go to 103
+      return
+  103 do 104 i=1,3
+         call ncgchr (mop(iop),3,i,jchar)
+         call ncpchr (iopval,3,i,jchar)
+  104 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getset.f b/sys/gio/nspp/portlib/getset.f
new file mode 100644
index 00000000..7bc6b8ce
--- /dev/null
+++ b/sys/gio/nspp/portlib/getset.f
@@ -0,0 +1,28 @@
+      subroutine getset (nxa,nxb,nya,nyb,xc,xd,yc,yd,itype)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      nxa = ishift(mxa,-mshftx)+1
+      nxb = ishift(mxb,-mshftx)+1
+      xc = xxc
+      xd = xxd
+      nya = ishift(mya,-mshfty)+1
+      nyb = ishift(myb,-mshfty)+1
+      yc = yyc
+      yd = yyd
+      itype = mtype
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getsi.f b/sys/gio/nspp/portlib/getsi.f
new file mode 100644
index 00000000..400da7b1
--- /dev/null
+++ b/sys/gio/nspp/portlib/getsi.f
@@ -0,0 +1,21 @@
+      subroutine getsi (npowx,npowy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      npowx = 15-mshftx
+      npowy = 15-mshfty
+      return
+      end
diff --git a/sys/gio/nspp/portlib/grid.f b/sys/gio/nspp/portlib/grid.f
new file mode 100644
index 00000000..358045fc
--- /dev/null
+++ b/sys/gio/nspp/portlib/grid.f
@@ -0,0 +1,4 @@
+      subroutine grid (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,0,0,0,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/gridal.f b/sys/gio/nspp/portlib/gridal.f
new file mode 100644
index 00000000..814cb42e
--- /dev/null
+++ b/sys/gio/nspp/portlib/gridal.f
@@ -0,0 +1,218 @@
+      subroutine gridal (imajx,iminx,imajy,iminy,ixlab,iylab,iflg,x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c non-compact version of gridal
+c
+c     ray bovet ishft changed to ishfta patch
+      dimension       nmaj(2),nmin(2),nlab(2),nflg(2),num(2) ,zza(2) ,
+     1                zzb(2) ,zzc(2) ,zzd(2) ,ichars(5)      ,
+     2                ifmt(3,2)      ,iz(2)  ,iza(2) ,izb(2) ,imz(2) ,
+     3                izdec(2)       ,isiz(2),imajl(2)       ,
+     4                iminl(2)       ,itype(2)       ,zz(2)  ,
+     5                ishfta(2)       ,izaa(2),izbb(2),kz(4)
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+c
+c     ray bovet ishft changed to ishfta patch
+      equivalence     (xxa,zza(1))   ,(xxb,zzb(1))   ,(xxc,zzc(1))   ,
+     1                (xxd,zzd(1))   ,(mfmtx(1),ifmt(1,1)),
+     2                (mx,iz(1))     ,(mxa,iza(1))   ,(mxb,izb(1))   ,
+     3                (majx,nmaj(1)) ,(minx,nmin(1)) ,(mumx,num(1))  ,
+     4                (mxdec,izdec(1))       ,(msizx,isiz(1)),
+     5                (mmgrx,imajl(1))       ,(mmnrx,iminl(1))       ,
+     6                (mtypex,itype(1))      ,(xx,kz(1))     ,
+     7                (xx,zz(1))     ,(mshftx,ishfta(1))
+c
+c set up variables for loop
+c
+      nmaj(1) = imajx
+      nmaj(2) = imajy
+      nmin(1) = iminx
+      nmin(2) = iminy
+      nlab(1) = ixlab
+      nlab(2) = iylab
+      nflg(1) = ishift(iflg,-2)-1
+      nflg(2) = iand(iflg,3)-1
+      izaa(1) = iza(1)
+      izaa(2) = iza(2)
+      izbb(1) = izb(1)
+      izbb(2) = izb(2)
+      if (nflg(1).le.0 .and. nflg(2).le.0) go to 101
+      xx = x
+      yy = y
+      call trans
+      if (nflg(2) .gt. 0) izaa(1) = mx
+      if (nflg(1) .gt. 0) izaa(2) = my
+      if (nflg(2) .gt. 0) izbb(1) = mx
+      if (nflg(1) .gt. 0) izbb(2) = my
+  101 continue
+      call optn (4hdpat,65535)
+      do 121 i=1,2
+c
+c i=1 for x axis with ticks in y direction
+c i=2 for y axis with ticks in x direction
+c
+         if (nlab(i)) 121,102,102
+  102    continue
+c
+c ior.ne.0 posibility for x only
+c
+         ixor = (2-i)*90*mxor
+         imaj = max0(nmaj(i),1)
+         imin = max0(nmin(i),1)
+         begin = iza(i)
+         biginc = float(izb(i)-iza(i))/float(imaj)
+         smlinc = biginc/float(imin)
+         start = zzc(i)
+         dif = (zzd(i)-zzc(i))/float(imaj)
+         iop = 3-i
+c
+c iop is the opposit axis to i
+c
+         idec = izdec(iop)
+         if (idec .eq. 0) idec = izaa(iop)-izbb(iop)-655
+         if (ixor .eq. i-1) go to 103
+c
+c labels and axis are orthogonal
+c
+         icent = isign(1,idec-1)
+         go to 104
+c
+c labels and axis are parallel
+c
+  103    icent = 0
+  104    continue
+         if (itype(i) .eq. 0) go to 105
+         fact = 10.**imaj
+         if (zzc(i) .gt. zzd(i)) fact = 1./fact
+         val = zzc(i)/fact
+         delval = val
+         if (imin.le.10 .and. imaj.eq.1) imin = 9
+         if (imin .ne. 9) imin = 1
+         imaj = abs(alog10(zzd(i)/zzc(i)))+1.0001
+  105    imajp1 = imaj+1
+         iminm1 = imin-1
+         do 119 j=1,imajp1
+            part = j-1
+c
+c draw major line or tick
+c
+            call optn (4hintn,4hhigh)
+            if (itype(i) .ne. 0) go to 106
+            iz(i) = begin+part*biginc
+            go to 107
+  106       val = val*fact
+            zz(i) = val
+            kz(iop) = 1
+            call trans
+            delval = delval*fact
+            if (iz(i)-10 .gt. izb(i)) go to 120
+  107       continue
+            iz(iop) = izaa(iop)
+            minst = 0
+            call put42
+            if (nflg(i)) 108,109,109
+  108       iz(iop) = izb(iop)
+            minst = 1
+            call put42
+            go to 111
+  109       iz(iop) = izaa(iop)+imajl(iop)
+            minst = 1
+            call put42
+            if (nflg(i)) 110,110,111
+  110       iz(iop) = izb(iop)
+            minst = 0
+            call put42
+            iz(iop) = izb(iop)-imajl(iop)
+            minst = 1
+            call put42
+  111       continue
+c
+c form label if needed
+c
+            if (nlab(i) .le. 0) go to 112
+            if (itype(i) .eq. 0) val = start+part*dif
+            call encode (num(i),ifmt(1,i),ichars,val)
+c     ray bovet ishft changed to ishfta patch
+            imz(i) = ishift(iz(i),-ishfta(i))
+            imz(iop) = max0(1,ishift(izaa(iop)-idec,-ishfta(iop)))
+            njust = num(i)
+            if (icent .eq. 0) call justfy (ichars,num(i),njust)
+            call pwrit (imz(1),imz(2),ichars,njust,isiz(i),ixor,icent)
+c
+c put in minor ticks
+c
+  112       if (iminm1.le.0 .or. j.eq.imajp1) go to 119
+            call optn (4hintn,3hlow)
+            do 118 k=1,iminm1
+               if (itype(i) .ne. 0) go to 113
+               iz(i) = begin+part*biginc+float(k)*smlinc
+               go to 114
+  113          zz(i) = val+float(k)*delval
+               if (zzc(i) .gt. zzd(i)) zzi = val-float(k)*delval*.1
+               kz(iop) = 1
+               call trans
+               if (iz(i) .gt. izb(i)) go to 120
+               if (iz(i) .lt. iza(i)) go to 118
+  114          continue
+               iz(iop) = izaa(iop)
+               minst = 0
+               call put42
+               if (nflg(i)) 115,116,116
+  115          iz(iop) = izb(iop)
+               minst = 1
+               call put42
+               go to 118
+  116          iz(iop) = izaa(iop)+iminl(iop)
+               minst = 1
+               call put42
+               if (nflg(i)) 117,117,118
+  117          iz(iop) = izb(iop)
+               minst = 0
+               call put42
+               iz(iop) = izb(iop)-iminl(iop)
+               minst = 1
+               call put42
+  118       continue
+  119    continue
+         call optn (4hintn,4hhigh)
+  120    if (nflg(iop) .lt. 0) go to 121
+c
+c draw axis line
+c
+         iz(i) = iza(i)
+         iz(iop) = izaa(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izaa(iop)
+         minst = 1
+         call put42
+         if (nflg(i) .gt. 0) go to 121
+         iz(i) = iza(i)
+         iz(iop) = izb(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izb(iop)
+         minst = 1
+         call put42
+  121 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/gridl.f b/sys/gio/nspp/portlib/gridl.f
new file mode 100644
index 00000000..7de4687f
--- /dev/null
+++ b/sys/gio/nspp/portlib/gridl.f
@@ -0,0 +1,4 @@
+      subroutine gridl (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,1,1,0,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/halfax.f b/sys/gio/nspp/portlib/halfax.f
new file mode 100644
index 00000000..c996a4dd
--- /dev/null
+++ b/sys/gio/nspp/portlib/halfax.f
@@ -0,0 +1,4 @@
+      subroutine halfax (magrx,minrx,magry,minry,x,y,ixlab,iylab)
+      call gridal (magrx,minrx,magry,minry,ixlab,iylab,10,x,y)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/jlm2.f b/sys/gio/nspp/portlib/jlm2.f
new file mode 100644
index 00000000..455c1310
--- /dev/null
+++ b/sys/gio/nspp/portlib/jlm2.f
@@ -0,0 +1,7 @@
+      function jlm2 (ichar)
+      dimension       ichar(1)
+      call ncgchr (ichar,2,1,ichar1)
+      call ncgchr (ichar,2,2,ichar2)
+      jlm2 = ior(ishift(ichar1,8),ichar2)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/justfy.f b/sys/gio/nspp/portlib/justfy.f
new file mode 100644
index 00000000..f543e539
--- /dev/null
+++ b/sys/gio/nspp/portlib/justfy.f
@@ -0,0 +1,14 @@
+      subroutine justfy (ichar,len,newlen)
+      dimension       ichar(1)
+      in = 0
+      call ncgchr (1h ,1,1,iblank)
+      do 102 i=1,len
+         call ncgchr (ichar,len,i,jchar)
+         if (in .ne. 0) go to 101
+         if (jchar .eq. iblank) go to 102
+  101    in = in+1
+         call ncpchr (ichar,len,in,jchar)
+  102 continue
+      newlen = in
+      return
+      end
diff --git a/sys/gio/nspp/portlib/labmod.f b/sys/gio/nspp/portlib/labmod.f
new file mode 100644
index 00000000..94110f19
--- /dev/null
+++ b/sys/gio/nspp/portlib/labmod.f
@@ -0,0 +1,53 @@
+      subroutine labmod (ifmtx,ifmty,numx,numy,isizx,isizy,ixdec,iydec,
+     1                   ixor)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet ishft changed to ishfta patch
+      dimension       ifmtx(3)       ,ifmty(3)       ,idec(2),ishfta(2)
+      equivalence     (mxdec,idec(1)),(mshftx,ishfta(1))
+      do 101 i=1,10
+         call ncgchr (ifmtx,10,i,ichar)
+         call ncpchr (mfmtx,10,i,ichar)
+         call ncgchr (ifmty,10,i,ichar)
+         call ncpchr (mfmty,10,i,ichar)
+  101 continue
+      mumx = numx
+      mumy = numy
+      if (max0(mumx,mumy) .gt. 20) go to 103
+      msizx = isizx
+      msizy = isizy
+      mxdec = ixdec
+      mydec = iydec
+      do 102 i=1,2
+c     ray bovet ishft changed to ishfta patch
+         jdec = isign(ishift(iabs(idec(i)),ishfta(i)),idec(i))
+         if (idec(i) .eq. 0) jdec = 655
+         if (idec(i) .eq. 1) jdec = 0
+         idec(i) = jdec
+  102 continue
+      mxor = ixor
+      return
+  103 continue
+c     write (mprint,1001) mumx,mumy
+c
+      call uliber (0,36h0numx or numy .gt. 20 in labmod call,36)
+      call perror
+      return
+c
+c1001 format (6h0numx=,i5,6h numy=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/line.f b/sys/gio/nspp/portlib/line.f
new file mode 100644
index 00000000..a88330db
--- /dev/null
+++ b/sys/gio/nspp/portlib/line.f
@@ -0,0 +1,32 @@
+      subroutine line (xa,ya,xb,yb)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xa,xb,ya,yb,xx,yy
+c
+      xx = xa
+      yy = ya
+      call trans
+      minst = 0
+      call put42
+      xx = xb
+      yy = yb
+      call trans
+      minst = 1
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/mkpkg b/sys/gio/nspp/portlib/mkpkg
new file mode 100644
index 00000000..a77011d0
--- /dev/null
+++ b/sys/gio/nspp/portlib/mkpkg
@@ -0,0 +1,56 @@
+# Make the NCAR system plot package.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	axes.f
+	curve.f
+	dashln.f
+	fl2int.f
+	flash1.f
+	flash2.f
+	flash3.f
+	flash4.f
+	flush.f
+	flushb.f
+	frame.f
+	frstpt.f
+	getopt.f
+	getset.f
+	getsi.f
+	grid.f
+	gridal.f
+	gridl.f
+	halfax.f
+	jlm2.f
+	justfy.f
+	labmod.f
+	line.f
+	mxmy.f
+	option.f
+	optn.f
+	perim.f
+	periml.f
+	plotit.f
+	point.f
+	points.f
+	porgn.f
+	preout.f
+	pscale.f
+	psym.f
+	put42.f
+	putins.f
+	pwrit.f
+	pwrt.f
+	set.f
+	seti.f
+	tick4.f
+	ticks.f
+	trans.f
+	vector.f
+	z8zpbd.f
+	z8zpii.f
+	;
diff --git a/sys/gio/nspp/portlib/mxmy.f b/sys/gio/nspp/portlib/mxmy.f
new file mode 100644
index 00000000..d0045227
--- /dev/null
+++ b/sys/gio/nspp/portlib/mxmy.f
@@ -0,0 +1,21 @@
+      subroutine mxmy (imx,imy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      imx = ishift(mx,-mshftx)+1
+      imy = ishift(my,-mshfty)+1
+      return
+      end
diff --git a/sys/gio/nspp/portlib/option.f b/sys/gio/nspp/portlib/option.f
new file mode 100644
index 00000000..059a7e40
--- /dev/null
+++ b/sys/gio/nspp/portlib/option.f
@@ -0,0 +1,8 @@
+      subroutine option (icas,int,ital,ior)
+      call optn (4hcase,icas)
+      if (int .eq. 0) call optn (4hintn,3hlow)
+      if (int .eq. 1) call optn (4hintn,4hhigh)
+      call optn (4hfont,ital)
+      call optn (4horen,ior)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/optn.f b/sys/gio/nspp/portlib/optn.f
new file mode 100644
index 00000000..965356f1
--- /dev/null
+++ b/sys/gio/nspp/portlib/optn.f
@@ -0,0 +1,99 @@
+      subroutine optn (iopnam,iopval)
+      dimension       iopnam(1)      ,iopval(1)
+      dimension       ichar(3)
+      logical         skip
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+      data ihigh,ilow/2hhi,2hlo/
+c
+c find index for input name
+c
+      do 101 i=1,9
+         iop = i
+         if (jlm2(iopnam) .eq. jlm2(mname(i))) go to 102
+  101 continue
+c
+      call uliber (0,36hounknown name in optn or getopt call,36)
+      call perror
+      return
+  102 continue
+      if (iop.ne.2 .and. iop.ne.9) iopv = iopval(1)
+c
+c     if character input for intensity, change to numeric
+c
+      if (iop .ne. 2) go to 105
+      jchar = jlm2(iopval)
+      if (jchar .ne. jlm2(ihigh)) go to 103
+      iopv = 204
+      go to 105
+  103 if (jchar .ne. jlm2(ilow)) go to 104
+      iopv = 127
+      go to 105
+  104 iopv = iopval(1)
+  105 continue
+c
+c     reset option if necessary
+c
+      if (iop .ne. 9) go to 107
+      skip = modef .eq. 0
+      do 106 i=1,3
+         call ncgchr (iopval,3,i,ichar(i))
+         call ncgchr (mop(iop),3,i,jchar)
+         skip = skip .and. (jchar .eq. ichar(i))
+         call ncpchr (mop(iop),3,i,ichar(i))
+  106 continue
+      if (skip) go to 109
+      nchar = 4
+      mbpair = 1*nchar+58112
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = ior(ishift(iop,8),ichar(1))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = ior(ishift(ichar(2),8),ichar(3))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      go to 109
+  107 continue
+      if (mop(iop).eq.iopv .and. modef.eq.0) go to 109
+      mop(iop) = iopv
+      nchar = 2
+      if (iop.eq.6 .or. iop.eq.3 .or. iop.eq.4 .or. iop.eq.7) nchar = 4
+      mbpair = 1*nchar+58112
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (nchar .eq. 4) go to 108
+      mbpair = ior(ishift(iand(iop,255),8),iand(iopv,255))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      go to 109
+  108 mbpair = ishift(iop,8)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = iand(iopv,65535)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+  109 return
+      end
diff --git a/sys/gio/nspp/portlib/perim.f b/sys/gio/nspp/portlib/perim.f
new file mode 100644
index 00000000..44c29212
--- /dev/null
+++ b/sys/gio/nspp/portlib/perim.f
@@ -0,0 +1,4 @@
+      subroutine perim (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,0,0,5,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/periml.f b/sys/gio/nspp/portlib/periml.f
new file mode 100644
index 00000000..a30b839d
--- /dev/null
+++ b/sys/gio/nspp/portlib/periml.f
@@ -0,0 +1,4 @@
+      subroutine periml (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,1,1,5,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/plotit.f b/sys/gio/nspp/portlib/plotit.f
new file mode 100644
index 00000000..df048298
--- /dev/null
+++ b/sys/gio/nspp/portlib/plotit.f
@@ -0,0 +1,23 @@
+      subroutine plotit (nx,ny,npen)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      mx = max0(0,min0(nx,32767))
+      my = max0(0,min0(ny,32767))
+      minst = max0(0,min0(1,npen))
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/point.f b/sys/gio/nspp/portlib/point.f
new file mode 100644
index 00000000..efca3bd0
--- /dev/null
+++ b/sys/gio/nspp/portlib/point.f
@@ -0,0 +1,43 @@
+      subroutine point (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 256
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x
+      yy = y
+      call trans
+      minst = 0
+      call put42
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      return
+      end
diff --git a/sys/gio/nspp/portlib/points.f b/sys/gio/nspp/portlib/points.f
new file mode 100644
index 00000000..07b11c5b
--- /dev/null
+++ b/sys/gio/nspp/portlib/points.f
@@ -0,0 +1,57 @@
+      subroutine points (x,y,n,ichar,ipen)
+      dimension       x(n)   ,y(n)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      if (n .le. 0) return
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (ichar) 102,101,102
+  101 mbpair = 256
+      go to 103
+  102 call ncgchr (ichar,1,1,jchar)
+      mbpair = 512+jchar
+  103 mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x(1)
+      yy = y(1)
+      call trans
+      minst = 0
+      call put42
+      if (n .eq. 1) go to 105
+      do 104 i=2,n
+         xx = x(i)
+         yy = y(i)
+         call trans
+         minst = ipen
+         call put42
+  104 continue
+  105 mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      return
+      end
diff --git a/sys/gio/nspp/portlib/porgn.f b/sys/gio/nspp/portlib/porgn.f
new file mode 100644
index 00000000..ed2acf93
--- /dev/null
+++ b/sys/gio/nspp/portlib/porgn.f
@@ -0,0 +1,27 @@
+      subroutine porgn (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      xx = x
+      yy = y
+      call trans
+      xadd = mx-1
+      yadd = my-1
+      return
+      end
diff --git a/sys/gio/nspp/portlib/preout.f b/sys/gio/nspp/portlib/preout.f
new file mode 100644
index 00000000..ec2ead3b
--- /dev/null
+++ b/sys/gio/nspp/portlib/preout.f
@@ -0,0 +1,116 @@
+      subroutine preout
+      dimension       idummy(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c+kpno
+c Initialization moved to z8zpii.f.
+c
+      common /nsplt1/  iclrfb ,isetfb ,ibpw   ,ifwd
+c     data iclrfb/0/, isetfb/0/, ibpw/32/, ifwd/1/
+c-kpno
+c
+      kbufa = mbufa
+c
+c entry while in flash1 mode will cause restart of filling user buffer
+c if its size is exceded.  otherwise it is assumed fixed-length output
+c record size is exceded, so place for 4 bytes is reserved in user
+c buffer, to allow proper record formatting during flash3 call.
+c
+      if (modef .ne. 1) go to 101
+      if (mbuflu+4 .le. mbufl) go to 113
+      mbuflu = 0
+      mf2er = mf2er+1
+      go to 113
+c
+c if necessary, build masks for setting and clearing new-frame flag
+c
+  101 if (iclrfb .ne. 0) go to 103
+      iposn = ibpw*ifwd-21
+      isetfb = ishift(1,iposn)
+      do 102 i=1,ibpw
+         ibit = 1
+         if (i .eq. (ibpw-iposn)) ibit = 0
+         iclrfb = ior(ishift(iclrfb,1),ibit)
+  102 continue
+c
+c in flash3 mode, copy any shorter-than-record-length user buffer into
+c system buffer, to avoid possible addressing error during fixed-length
+c write.
+c
+  103 if (modef .ne. -3) go to 105
+      if (mbuflu .eq. msblen) go to 105
+      isub = kbufa-loci(idummy)+1
+      do 104 i=1,mbuflu
+         msybuf(i) = idummy(isub)
+         isub = isub+1
+  104 continue
+      kbufa = loci(msybuf)
+c
+c compute metacode byte count and put in first 16 bits of buffer.
+c       *** note that we are directly manipulating the
+c           first 32 bits of the output buffer here ***
+c
+  105 mcrout = mcrout+1
+      nbytes = -3+(ibpw*mbuflu-1)/8
+      isub = kbufa-loci(idummy)+1
+      idummy(isub) = ior(idummy(isub),ishift(nbytes,ibpw-16))
+c
+c put in first-record-of-frame flag if appropriate.  otherwise insure
+c frame flag is zeroed.  put buffer out via writeb.
+c
+      isub = kbufa-loci(idummy)+ifwd
+      if (mfrlst .ne. 1) go to 106
+      idummy(isub) = ior(idummy(isub),isetfb)
+      mfrlst = 0
+      go to 107
+  106 idummy(isub) = iand(idummy(isub),iclrfb)
+  107 if (mbuflu .eq. msblen) go to 109
+      isub = kbufa+mbuflu-loci(idummy)
+      do 108 i=mbuflu,msblen
+         isub = isub+1
+         idummy(isub) = 0
+  108 continue
+  109 call writeb (kbufa,mbuflu,munit)
+c
+c if this is last buffer of frame, call writeb with zero-byte-count
+c record, so that it may arrange that such a record follows the last
+c frame of the metafile (note that mbufa points to msybuf when get here)
+c
+      if (mfrend .ne. 1) go to 112
+      mfrlst = 1
+      isub = kbufa-loci(idummy)
+      do 110 i=1,mbuflu
+         isub = isub+1
+         idummy(isub) = 0
+  110 continue
+      do 111 i=1,16
+         mbprs(i) = 0
+  111 continue
+      mbprs(2) = ior(mpair2,2048)
+      call packum (mbprs,16,kbufa)
+      call writeb (kbufa,0,munit)
+c
+c finish up by reserving 4 bytes at start of next output buffer.
+c
+  112 mbuflu = 0
+  113 mbprs(1) = mpair1
+      mbprs(2) = mpair2
+      mipair = 2
+      mflcnt = 0
+      return
+      end
diff --git a/sys/gio/nspp/portlib/pscale.f b/sys/gio/nspp/portlib/pscale.f
new file mode 100644
index 00000000..3145d586
--- /dev/null
+++ b/sys/gio/nspp/portlib/pscale.f
@@ -0,0 +1,21 @@
+      subroutine pscale (scalex,scaley)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      xfactr = scalex*2.**mshftx
+      yfactr = scaley*2.**mshfty
+      return
+      end
diff --git a/sys/gio/nspp/portlib/psym.f b/sys/gio/nspp/portlib/psym.f
new file mode 100644
index 00000000..c16cf020
--- /dev/null
+++ b/sys/gio/nspp/portlib/psym.f
@@ -0,0 +1,27 @@
+      subroutine psym (x,y,ichr,isiz,icas,ip)
+      dimension       ichr(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       iwide(4)
+      data iwide(1),iwide(2),iwide(3),iwide(4)/256,384,512,768/
+      if (ip-1) 102,102,101
+  101 call vector (x,y)
+  102 call optn (4hcase,icas)
+      call getopt (5horien,iorn)
+      call pwrit (x,y,ichr,1,isiz,iorn,0)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/put42.f b/sys/gio/nspp/portlib/put42.f
new file mode 100644
index 00000000..5f8aac81
--- /dev/null
+++ b/sys/gio/nspp/portlib/put42.f
@@ -0,0 +1,60 @@
+      subroutine put42
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      mjxmax = max0(mx,mjxmax)
+      mjymax = max0(my,mjymax)
+      mjxmin = min0(mx,mjxmin)
+      mjymin = min0(my,mjymin)
+c
+c test if increment instruction will work
+c
+      if (iabs(mx-mxold).gt.mxmax .or. iabs(my-myold).gt.mymax)
+     1    go to 101
+c
+c construct increment instructions
+c
+      incx = (mx-mxold)/mxfac+160
+      incy = (my-myold)/myfac+32+minst*128
+c
+c put instruction in buffer
+c
+      mbpair = ior(ishift(incx,8),incy)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mxold = mx
+      myold = my
+      return
+  101 continue
+c
+c mx is first half of the instruction as it stands
+c
+      mbpair = mx
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+c
+c my needs only pen bit
+c
+      mbpair = my+ishift(minst,15)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mxold = mx
+      myold = my
+      return
+      end
diff --git a/sys/gio/nspp/portlib/putins.f b/sys/gio/nspp/portlib/putins.f
new file mode 100644
index 00000000..466ebd56
--- /dev/null
+++ b/sys/gio/nspp/portlib/putins.f
@@ -0,0 +1,59 @@
+      subroutine putins (nopcd,ins,nchar)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       ins(nchar)
+      kopcd = nopcd
+      kchar = nchar
+c
+c put in the two header bytes
+c
+      if (kopcd.lt.0 .or. kopcd.gt.63) go to 102
+      mbpair = ior(ishift(kopcd+192,8),kchar)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (kchar .eq. 0) return
+      if (kchar.lt.0 .or. kchar.ge.255) go to 103
+c
+c put character string into instruction string
+c
+      do 101 i=1,kchar,2
+         call ncgchr (ins,kchar,i,jcharl)
+         call ncgchr (ins,kchar,i+1,jcharr)
+         mbpair = ior(ishift(jcharl,8),jcharr)
+         mipair = mipair+1
+         mbprs(mipair) = mbpair
+         if (mipair .ge. 16) call flushb
+  101 continue
+      return
+  102 continue
+c     write (mprint,1001) kopcd
+c
+      call uliber (0,40h0in putins call, nopcd .lt. 0 or .ge. 63,40)
+      call perror
+      return
+  103 continue
+c     write (mprint,1002) kchar
+c
+      call uliber (0,41h0in putins call, nchar .le. 0 or .ge. 255,41)
+      call perror
+      return
+c
+c1001 format (7h0nopcd=,i10)
+c1002 format (7h0nchar=,i10)
+c
+      end
diff --git a/sys/gio/nspp/portlib/pwrit.f b/sys/gio/nspp/portlib/pwrit.f
new file mode 100644
index 00000000..56ed0fb2
--- /dev/null
+++ b/sys/gio/nspp/portlib/pwrit.f
@@ -0,0 +1,95 @@
+      subroutine pwrit (x,y,ichar,nchar,isize,ioren,icent)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      dimension       ichar(nchar)
+      dimension       iwide(4)
+      data wide,high,white /6.,7.,2./
+      data iwide(1),iwide(2),iwide(3),iwide(4)/256,384,512,768/
+c
+c copy parameters into local variables
+c
+      kchar = nchar
+      ksize = isize
+      koren = ioren
+c
+c transform character size into metacode units.
+c
+      if (ksize .gt. 3) ksize = ishift(ksize,mshftx)
+      if (ksize .le. 3) ksize = iwide(ksize+1)
+      call optn (4hcsiz,ksize)
+c
+c transform orientation.
+c
+      if (koren .lt. 0) koren = koren+360
+      if (koren .ge. 0) call optn (4horen,koren)
+c
+c pass on centering.
+c
+      call optn (4hcent,max0(0,min0(2,icent+1)))
+c
+c make coordinates global.
+c
+      xx = x
+      yy = y
+      call trans
+c
+c use real variables for convenience.
+c
+      fmx = mx
+      fmy = my
+c
+c work with radians instead of degrees.
+c 2*pi/360. approximately = .0174533
+c
+      angle = float(koren)*.0174533
+c
+c find starting point for string when considering centering option.
+c
+      cosa = cos(angle)
+      sina = sin(angle)
+      wide2 = ksize/2
+      widen = float(ksize*kchar)-float(ksize)*white/wide
+      if (icent) 103,101,102
+  101 fmx = fmx-cosa*widen*.5
+      fmy = fmy-sina*widen*.5
+      go to 103
+  102 fmx = fmx-cosa*widen
+      fmy = fmy-sina*widen
+  103 continue
+      hgt2 = (3*ksize)/4
+      nxul = fmx-cosa*wide2-sina*hgt2
+      nyul = fmy+cosa*hgt2-sina*wide2
+      nxll = fmx-cosa*wide2+sina*hgt2
+      nyll = fmy-cosa*hgt2-sina*wide2
+      nxur = fmx+cosa*widen+cosa*wide2-sina*hgt2
+      nyur = fmy+sina*widen+cosa*hgt2+sina*wide2
+      nxlr = fmx+cosa*widen+cosa*wide2+sina*hgt2
+      nylr = fmy+sina*widen-cosa*hgt2+sina*wide2
+      mjxmax = min0(32767,max0(mjxmax,nxul,nxll,nxur,nxlr))
+      mjxmin = max0(0,min0(mjxmin,nxul,nxll,nxur,nxlr))
+      mjymax = min0(32767,max0(mjymax,nyul,nyll,nyur,nylr))
+      mjymin = max0(0,min0(mjymin,nyul,nyll,nyur,nylr))
+      minst = 0
+      call put42
+      call putins (33,ichar,kchar)
+      mxold = -9999
+      myold = -9999
+      return
+      end
diff --git a/sys/gio/nspp/portlib/pwrt.f b/sys/gio/nspp/portlib/pwrt.f
new file mode 100644
index 00000000..ebb85ca5
--- /dev/null
+++ b/sys/gio/nspp/portlib/pwrt.f
@@ -0,0 +1,12 @@
+      subroutine pwrt (x,y,chars,nchar,jsiz,jor)
+      dimension       chars(1)
+      dimension       jfix(4)
+      data jfix(1),jfix(2),jfix(3),jfix(4)/128,192,256,384/
+      isiz = max0(0,min0(3,jsiz))
+      call fl2int (x,y,nx,ny)
+      call getsi (ixsave,iysave)
+      nx = max0(0,ishift(nx-(1-jor)*jfix(isiz+1),ixsave-15))
+      ny = max0(0,ishift(ny-jor*jfix(isiz+1),iysave-15))
+      call pwrit (nx,ny,chars,nchar,isiz,jor*90,-1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/set.f b/sys/gio/nspp/portlib/set.f
new file mode 100644
index 00000000..a9417d90
--- /dev/null
+++ b/sys/gio/nspp/portlib/set.f
@@ -0,0 +1,140 @@
+      subroutine set (xa,xb,ya,yb,xc,xd,yc,yd,itype)
+c
+c *************** KPNO -- name changed from set to sppset **********
+c
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xa,xb,ya,yb,xxa,xxb,yya,yyb,zz
+      logical         intt
+      dimension       zz(4)  ,mz(4)  ,zc(2)  ,zd(2)  ,zfactr(2)      ,
+     1                zadd(2),mtypez(2)
+      dimension       mshftz(2)
+      dimension       mes(2)
+      equivalence     (xxc,zc(1))    ,(xxd,zd(1))    ,(xxa,zz(1))    ,
+     1                (mxa,mz(1))    ,(xfactr,zfactr(1))     ,
+     2                (xadd,zadd(1)) ,(mtypex,mtypez(1))     ,
+     3                (mshftx,mshftz(1))     ,(temp,itemp)
+      data mes(1),mes(2)/1hx,1hy/
+      xxa = xa
+      xxb = xb
+      xxc = xc
+      xxd = xd
+      yya = ya
+      yyb = yb
+      yyc = yc
+      yyd = yd
+      mtype = itype
+      mtypex = (mtype-1)/2
+      mtypey = mod(mtype-1,2)
+c
+c find mxa, mxb, etc by mapping xxa, xxb, etc into integer space if they
+c are not integers
+c
+      do 103 i=1,4
+         k = i
+         if (k .gt. 2) k = k-2
+c     ray bovet patch to avoid small integers being set to 0
+c        temp = zz(i)
+         itemp = zz(i)
+c        if (temp .lt. 0.0) go to 106
+c
+         if (.not.(intt(temp))) go to 101
+         if (itemp.lt.0) go to 106
+         itemp = ishift(itemp-1,mshftz(k))
+         go to 102
+c     ray bovet patch to avoid small integers being set to 0
+c 101    itemp = temp*32767.
+  101    if(temp.lt.0.0) go to 106
+         itemp = temp*32767.
+c
+  102    if (itemp.lt.0 .or. itemp.gt.32767) go to 107
+         mz(i) = itemp
+  103 continue
+c
+c set up parameters for translating real input from frstpt, etc. to
+c integer plotting space
+c
+      do 105 i=1,2
+         prange = mz(i+2)-mz(i)
+         urange = zd(i)-zc(i)
+c
+c test for no range
+c
+         if (urange.eq.0. .or. prange.eq.0.) go to 108
+c
+c test for log scaling
+c
+         if (mtypez(i) .eq. 0) go to 104
+c
+c test for error
+c
+         if (zc(i) .le. 0.) go to 109
+         if (zd(i) .le. 0.) go to 110
+         urange = alog10(zd(i)/zc(i))
+         zfactr(i) = prange/urange
+         zadd(i) = float(mz(i))-zfactr(i)*alog10(zc(i))
+         go to 105
+  104    zfactr(i) = prange/urange
+         zadd(i) = float(mz(i))-zfactr(i)*zc(i)
+  105 continue
+      return
+c
+c error processing
+c
+  106 continue
+      if (i.gt.1 .and. i.lt.4) i = 5-i
+c     write (mprint,1001) i
+c
+      call uliber (0,53h0negative values not allowed in first 4 set argu
+     1ments        ,53)
+      call perror
+      return
+  107 continue
+      if (i.gt.1 .and. i.lt.4) i = 5-i
+c     write (mprint,1002) i
+c
+      call uliber (0,83h0first 4 set arguments must be real between 0 an
+     1d 1 or integers between 1 and 32767,83)
+      call perror
+      return
+  108 continue
+      i1 = i*2+3
+      i2 = i*2+4
+c     write (mprint,1003) i1,i2
+c
+      call uliber (0,31h0no range in x or y in set call,31)
+      call perror
+      return
+  109 continue
+c 109 write (mprint,1004) mes(i)
+      go to 111
+  110 continue
+c 110 write (mprint,1005) mes(i)
+c
+  111 call uliber (0,46h0non-positive argument to set with log scaling,
+     1             46)
+      call perror
+      return
+c
+c1001 format (9h0argument,i2,9h negative)
+c1002 format (9h0argument,i2,13h out of range)
+c1003 format (10h0arguments,i2,4h and,i2,14h are identical)
+c1004 format (1h0,a1,8hc .le. 0)
+c1005 format (1h0,a1,8hd .le. 0)
+c
+      end
diff --git a/sys/gio/nspp/portlib/seti.f b/sys/gio/nspp/portlib/seti.f
new file mode 100644
index 00000000..9bc9a635
--- /dev/null
+++ b/sys/gio/nspp/portlib/seti.f
@@ -0,0 +1,37 @@
+      subroutine seti (npowx,npowy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c     patch by r bovet to ensure that values are <= 12 on vax
+c     this is necessary to ensure that intt can work.
+c
+      ipowx = npowx
+      ipowy = npowy
+      if(ipowx.le.12) go to 10
+        call uliber(0,'x power input to seti cannot exceed 12
+     & on vax',80)
+         ipowx = 12
+10	continue
+      if(ipowy.le.12) go to 20
+        call uliber(0,'y power input to seti cannot exceed 12
+     & on vax',80)
+         ipowy = 12
+20	continue
+      mshftx = 15-ipowx
+      mshfty = 15-ipowy
+      return
+      end
diff --git a/sys/gio/nspp/portlib/tick4.f b/sys/gio/nspp/portlib/tick4.f
new file mode 100644
index 00000000..2f1d0ace
--- /dev/null
+++ b/sys/gio/nspp/portlib/tick4.f
@@ -0,0 +1,30 @@
+      subroutine tick4 (mgrx,mnrx,mgry,mnry)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c mmgrx(y) is the length in the x(y) direction of major tick marks
+c and is therefor used on the y(x) axis (to be consistent with mx(y)dec
+c of labmod).
+c mgrx(y) is the length of x(y) axis major tick marks.
+c similarly for mmnrx(y) and mnrx(y).
+c
+      mmgrx = isign(ishift(iabs(mgry),mshftx),mgry)
+      mmgry = isign(ishift(iabs(mgrx),mshfty),mgrx)
+      mmnrx = isign(ishift(iabs(mnry),mshftx),mnry)
+      mmnry = isign(ishift(iabs(mnrx),mshfty),mnrx)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/ticks.f b/sys/gio/nspp/portlib/ticks.f
new file mode 100644
index 00000000..96484c5d
--- /dev/null
+++ b/sys/gio/nspp/portlib/ticks.f
@@ -0,0 +1,4 @@
+      subroutine ticks (major,minor)
+      call tick4 (major,minor,major,minor)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/trans.f b/sys/gio/nspp/portlib/trans.f
new file mode 100644
index 00000000..5fe0affc
--- /dev/null
+++ b/sys/gio/nspp/portlib/trans.f
@@ -0,0 +1,52 @@
+      subroutine trans
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xx,yy
+c
+      logical         intt
+      equivalence     (zz,mz),(temp,itemp)
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = xx
+      mz = xx
+      if (intt(zz)) go to 102
+      if (mtypex .eq. 0) go to 101
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      zz = xfactr*alog10(zz)+xadd
+      go to 103
+  101 zz = xfactr*zz+xadd
+      go to 103
+  102 zz = float(ishift(mz-1,mshftx))
+  103 mx = max1(0.,amin1(32767.,zz))
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = yy
+      mz = yy
+      if (intt(zz)) go to 105
+      if (mtypey .eq. 0) go to 104
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      zz = yfactr*alog10(zz)+yadd
+      go to 106
+  104 zz = yfactr*zz+yadd
+      go to 106
+  105 zz = float(ishift(mz-1,mshfty))
+  106 my = max1(0.,amin1(32767.,zz))
+      return
+      end
diff --git a/sys/gio/nspp/portlib/vector.f b/sys/gio/nspp/portlib/vector.f
new file mode 100644
index 00000000..03b3bac8
--- /dev/null
+++ b/sys/gio/nspp/portlib/vector.f
@@ -0,0 +1,27 @@
+      subroutine vector (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      xx = x
+      yy = y
+      call trans
+      minst = 1
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/z8zpbd.f b/sys/gio/nspp/portlib/z8zpbd.f
new file mode 100644
index 00000000..4392d84a
--- /dev/null
+++ b/sys/gio/nspp/portlib/z8zpbd.f
@@ -0,0 +1,6 @@
+      subroutine z8zpbd
+c
+c kpno: only obvious constants are initialized in this block data.
+c all other initialization occurs in z8zpii.
+c
+      end
diff --git a/sys/gio/nspp/portlib/z8zpii.f b/sys/gio/nspp/portlib/z8zpii.f
new file mode 100644
index 00000000..580d9968
--- /dev/null
+++ b/sys/gio/nspp/portlib/z8zpii.f
@@ -0,0 +1,362 @@
+      subroutine z8zpii
+c+kpno
+c
+c All data statements changed to runtime assignment statements; routine
+c changed from block data to subroutine.
+c
+c-kpno
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+      common /nsplt1/  iclrfb ,isetfb ,ibpw   ,ifwd
+c
+c      variables                 use
+c      ---------                 ---
+c
+c mmajx,mmajy,mminx,   gridal arguments stored here so they will be in a
+c mminy,mxlab,mylab,   known order for insertion in the instruction
+c mflg                 stream only when ultracompact metacode is
+c                      being produced.
+c
+c mtype                scaling type of the most recent set call
+c
+c mx,my                plotter address of the pen location
+c
+c mxa,mya,mxb,myb      plotter address corresponding to the first four
+c                      arguments of the most recent set call.
+c
+c mtypex,mtypey        a decoding of mtype-- 0 = linear, 1 = log
+c
+c xxa,yya,xxb,yyb,     exact copies of the first eight parameters
+c xxc,yyc,xxd,yyd      of the most recent set call
+c
+c xfactr,yfactr,xadd,  numbers computed from the most recent set call
+c yadd                 arguments so that real valued coordinates can
+c                      be translated to integers by
+c                       mx = xfactr*xx + xadd
+c                      or
+c                       mx = xfactr*alog10(xx) + xadd
+c                      and similarly for y.
+c
+c xx,yy                most recent coordinate input to the plot package
+c
+c mfmtx,mfmty,mumx,    most recent labmod inputs except that mxdec = 0
+c mumy,msizx,msizy,    and mydec = 0 are decoded and mxdec = 1 and
+c mxdec,mydec,mxor     mydec = 1 become 0.
+c
+c mop(i),mname(i)      option names are given in mname and their
+c                      current values in mop
+c
+c mxold,myold,mxmax,   all used for increment instructions only.  mxold
+c mymax,mxfac,myfac    and myold are the plotter coordinates of the
+c                      previous point, mxmax and mymax are the greatest
+c                      distance an increment can move, and mxfac and
+c                      myfac are the number of plotter units per
+c                      increment unit (generally 1, but can be more if
+c                      compaction is important and high resolution is
+c                      not).
+c
+c modef                = 0 flash routines have not been used
+c                      = 1 most recent flash call was to flash1
+c                          (we are between flash1 and flash2 calls
+c                          and the instructions should be put in the
+c                          users buffer)
+c                      = 2 flash1 call has been closed with a
+c                          flash2 call
+c                      =-3 flash3 has been entered, but not exited,
+c                          i.e., flash3 is dumping a user buffer.
+c                      = 3 most recent flash activity is a completed
+c                          flash3 call.
+c                      = 4 most recent flash call was to flash4
+c
+c mf2er                = 0 no flash buffer overflow
+c                      = n counts the number of times the buffer
+c                          was reused so the required size can be
+c                          estimated
+c
+c mshftx,mshfty        the power of two of the ratio between the
+c                      resolution of the metacode address and the
+c                      resolution the user is working in.  in the
+c                      default case, the user assumes the plotter
+c                      is 1024 by 1024 (1024 = 2 **10).  metacode
+c                      addresses have 15 bits, so their capacity is
+c                      32,768.  thus, the default for mshftx and mshfty
+c                      is 5, and user integer coordinates are left
+c                      shifted 5 to make plotter addresses.
+c
+c mmgrx,mmgry,mmnrx,   tick mark lengths (positive values point in)
+c mmnry
+c
+c mcrout               number of metacode records that have been put
+c                      out via preout.
+c
+c mflcnt               used to count the number of flushb calls since
+c                      last mbprs initialization.  it is used to avoid
+c                      empty records which could otherwise be put out.
+c
+c mfrend               frame sets to 1 to indicate last output call of a
+c                      frame,  and resets to zero before returning.
+c
+c mfrlst               preout manipulates, based on mfrend, so that it
+c                      knows when a record is the first of a new frame.
+c
+c mjxmin,mjymin,       used to keep track of the range of the plotting
+c mjxmax,mjymax        address on the frame being created
+c
+c mnxsto,mnysto        used to hold mjxmin,... after flash1 call, and
+c mxxsto,mxysto        restore them after flash2.  mjxmin,... are ac-
+c                      cumulated anew during flash saving, and stored
+c                      in user flash buffer after flash2 call.
+c
+c mpair1,mpair2        two 16-bit pairs used to initialize each output
+c                      record, so that preout may format first 32 bits.
+c                      they are actually put into mbprs at proper times
+c
+c mprint               unit number for printing error messages too
+c                      extensive to be handled by uliber
+c
+c msybuf               buffer to hold up to a few hundred metacode
+c                      instructions
+c
+c msblen               word length of msybuf.
+c
+c mncpw                the number of characters per word on the host
+c                      computer
+c
+c minst                holds instruction op-code for the instruction
+c                      being formed
+c
+c mbufa                contains the address of the buffer for the
+c                      metacode instructions, either loci(msybuf) or
+c                      loci(user buffer) from a flash1 call
+c
+c mbuflu               the number of words of the buffer pointed to by
+c                      mbufa that have been filled with metacode or
+c                      dd80 instructions
+c
+c mfwa,mlwa            contains the first word address and the last
+c                      word address for the flash buffers
+c
+c mipair,mbprs         mbprs is used to store byte pairs of metacode
+c                      until they can be packed in an integral number
+c                      of words and placed in the buffer pointed to by
+c                      mbufa.  mipair tells how much of mbprs has been
+c                      used.
+c
+c mbufl                the length of the buffer pointed to by mbufa.
+c
+c munit                unit number for writing metacode
+c
+c small                smallest positive number on the host computer.
+c                      this is used when nonpositive numbers are plotted
+c                      with log scaling.
+c
+c
+      dimension mfssx(2), mfssy(2), mnsss(9)
+c
+      data mfssx(1)/4h(e10/
+      data mfssx(2)/4h.3) /
+      data mfssy(1)/4h(e10/
+      data mfssy(2)/4h.3) /
+c
+      data mnsss(1)/4hcase/
+      data mnsss(2)/4hintn/
+      data mnsss(3)/4horen/
+      data mnsss(4)/4hcsiz/
+      data mnsss(5)/4hfont/
+      data mnsss(6)/4hdpat/
+      data mnsss(7)/4hssiz/
+      data mnsss(8)/4hcent/
+      data mnsss(9)/4hcolr/
+c
+      do 10 i = 1, 2
+	  mfmtx(i) = mfssx(i)
+10    continue
+      do 11 i = 1, 2
+	  mfmty(i) = mfssy(i)
+11    continue
+      do 12 i = 1, 9
+	  mname(i) = mnsss(i)
+12    continue
+c
+c     data iclrfb/0/, isetfb/0/, ibpw/32/, ifwd/1/
+      iclrfb   = 0
+      isetfb   = 0
+      ibpw     = 32
+      ifwd     = 1
+c
+c     data mtype,mtypex,mtypey/1,0,0/
+      mtype    = 1
+      mtypex   = 0
+      mtypey   = 0
+c
+c     data mx,my/0,0/
+      mx       = 0
+      my       = 0
+c
+c     data xxa,yya,xxb,yyb/0.,0.,1.,1./
+      xxa      = 0.0
+      yya      = 0.0
+      xxb      = 1.0
+      yyb      = 1.0
+c
+c     data xxc,yyc,xxd,yyd/0.,0.,1.,1./
+      xxc      = 0.0
+      yyc      = 0.0
+      xxd      = 1.0
+      yyd      = 1.0
+c
+c     data mxa,mya,mxb,myb/1,1,32767,32767/
+      mxa      = 1
+      mya      = 32767
+      mxb      = 1
+      mxb      = 32767
+c
+c     data xfactr,yfactr/32767.,32767./
+      xfactr   = 32767.
+      yfactr   = 32767.
+c
+c     data xadd,yadd/1.,1./
+      xadd     = 1.0
+      yadd     = 1.0
+c
+c     data mumx,mumy/10,10/
+      mumx     = 10
+      mumy     = 10
+c
+c     data msizx,msizy/0,0/
+      msizx    = 0
+      msizy    = 0
+c
+c     data mxdec,mydec/655,655/
+      mxdec    = 655
+      mydec    = 655
+c
+c     data mxor/0/
+      mxor     = 0
+c
+c     data mop(1)/0/
+c     data mop(2)/204/
+c     data mop(3)/0/
+c     data mop(4)/128/
+c     data mop(5)/0/
+c     data mop(6)/65535/
+c     data mop(7)/8/
+c     data mop(8)/0/
+c     data mop(9)/0/
+      mop(1)   = 0
+      mop(2)   = 204
+      mop(3)   = 0
+      mop(4)   = 128
+      mop(5)   = 0
+      mop(6)   = 65535
+      mop(7)   = 8
+      mop(8)   = 0
+      mop(9)   = 0
+c
+c     data mxold,myold/-9999,-9999/
+      mxold    = -9999
+      myold    = -9999
+c
+c     data mxmax,mymax/31,31/
+      mxmax    = 31
+      mymax    = 31
+c
+c     data mxfac,myfac/1,1/
+      mxfac    = 1
+      myfac    = 1
+c
+c     data mmgrx,mmgry/385,385/
+      mmgrx    = 385
+      mmgry    = 385
+c
+c     data mmnrx,mmnry/255,255/
+      mmnrx    = 255
+      mmnry    = 255
+c
+c     data modef/0/
+      modef    = 0
+c
+c     data mncpw/4/
+      mncpw    = 4
+c
+c     data mbuflu/0/
+      mbuflu   = 0
+c
+c     data msblen/360/
+      msblen   = 360
+c
+c     data mbufl/360/
+      mbufl    = 360
+c
+c     data mf2er/0/
+      mf2er    = 0
+c
+c     data mshftx,mshfty/5,5/
+      mshftx   = 5
+      mshfty   = 5
+c
+c     data mbufa/-9999/
+      mbufa    = -9999
+c
+c     data mflcnt/0/
+      mflcnt   = 0
+c
+c     data mfrend/0/
+      mfrend   = 0
+c
+c     data mfrlst/1/
+      mfrlst   = 1
+c
+c     data mpair1/0/
+      mpair1   = 0
+c
+c     data mpair2/8192/
+      mpair2   = 8192
+c
+c     data mcrout/0/
+      mcrout   = 0
+c
+c     data mbprs(1)/0/
+      mbprs(1) = 0
+c
+c     data mbprs(2)/8192/
+      mbprs(2) = 8192
+c
+c     data mipair/2/
+      mipair   = 2
+c
+c     data mjxmax,mjymax,mjxmin,mjymin/0,0,32767,32767/
+      mjxmax   = 0
+      mjymax   = 0
+      mjxmin   = 32767
+      mjxmin   = 32767
+c
+c set to unit number for printer
+c
+c     data mprint/6/
+      mprint   = 6
+c
+c set to unit number for plotter
+c
+c     data munit/8/
+      munit     = 8
+c set to smallest positive number on the computer
+c
+c     data small/1.e-25/
+      small     = 1.e-25
+      end
diff --git a/sys/gio/nspp/sysint/README b/sys/gio/nspp/sysint/README
new file mode 100644
index 00000000..64537d9d
--- /dev/null
+++ b/sys/gio/nspp/sysint/README
@@ -0,0 +1 @@
+SYSINT -- System interface for the Ncar System Plot Package (NSPP)
diff --git a/sys/gio/nspp/sysint/encd.f b/sys/gio/nspp/sysint/encd.f
new file mode 100644
index 00000000..1dba902b
--- /dev/null
+++ b/sys/gio/nspp/sysint/encd.f
@@ -0,0 +1,78 @@
+      SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+C
+C
+C
+C
+C ON INPUT     VALU	 FLOATING POINT	NUMBER FROM WHICH THE LABEL IS
+C			 TO BE CREATED.
+C	       ASH	 SEE IOFFD.
+C	       IOFFD	 IF IOFFD .EQ. 0, A LABEL WHICH	REFLECTS THE
+C			      MAGNITUDE	OF VALU	IS TO BE CREATED.
+C			      .1 .LE. ABS(VALU)	.LE. 99999.49999...
+C			      OR VALUE .EQ. 0.0.  THE LABEL CREATED
+C			      SHOULD HAVE 3 TO 5 CHARACTERS DEPENDING
+C			      ON THE MAGNITUDE OF VALU.	 SEE IOUT.
+C			 IF IOFFD .NE. 0, A LABEL WHICH	DOES NOT REFLECT
+C			      THE MAGNITUDE OF VALU IS TO BE CREATED.
+C			      ASH IS USED AS THE NORMALIZATION FACTOR.
+C			      1. .LE. ASH*ABS(VALU) .LT. 1000. OR
+C			      VALU .EQ.	0.0.  THE LABEL	CREATED	SHOULD
+C			      HAVE 1 TO	3 CHARACTERS, DEPENDING	ON THE
+C			      MAGNITUDE	OF ASH*VALU.  SEE IOUT.
+C ON OUTPUT    IOUT	 CONTAINS THE LABEL CREATED.  IT SHOULD	HAVE NO
+C			 LEADING BLANKS.  SEE NC.
+C	       NC	 THE NUMBERS IN	THE LABEL IN IOUT.  SHOULD BE
+C			 1 TO 5.
+C
+      SAVE
+      CHARACTER*11 IFMT, IOUT
+C
+C IFMT MUST HOLD 11 CHARACTERS
+C
+      VAL = VALU
+      IF (IOFFD	.NE. 0)	GO TO 103
+      IF (VAL) 101,104,101
+  101 LOG = IFIX((ALOG10(ABS(VAL))+.00001)+5000.)-5000
+      V	= VAL
+      NS = MAX0(4,MIN0(6,LOG+2))
+      ND = MIN0(3,MAX0(0,2-LOG))
+c     IF (VAL.LT.0)  NS	= NS + 1
+c +noao: replacing ftn i/o for iraf implementation
+c 102 WRITE (IFMT,'(A2,I2,A1,I1,A1)') '(F',NS,'.',ND,')'
+  102 continue
+c     if (len (char (ns + ichar ('0'))) .eq. 2) then
+c	 ifmt(1:7) = '(f  . )'
+c	 ifmt(3:4) = char (ns + ichar ('0'))
+c	 ifmt(6:6) = char (nd + ichar ('0'))
+c     else 
+c	 ifmt(1:6) = '(f . )'
+c	 ifmt(3:3) = char (ns + ichar ('0'))
+c	 ifmt(5:5) = char (nd + ichar ('0'))
+c     endif
+c     WRITE (IOUT,IFMT)	V
+      call encode (ns, ifmt, iout, v)
+      NC = NS
+c +noao
+c The following statement was making 5 digit labels (+4800) come out
+c truncated (+480) and it has been commented out.
+c     IF (LOG.GE.3)  NC	= NC - 1
+c -noao
+      RETURN
+  103 NS = 4
+      IF (VAL.LT.0.)  NS=5
+      IF (VAL.EQ.0.)  NS=2
+      ND = 0
+      V	= VAL*ASH
+      LOG = 100
+      GO TO 102
+  104 iout(1:3) = '0.0'
+      nc = 3
+c 104 NS = 3
+c     ND = 1
+c     LOG = -100
+c     V	= 0.
+c     GO TO 102
+C
+C1001 FORMAT('(F',I2,'.',I1,',1H',A1,')')
+C
+      END
diff --git a/sys/gio/nspp/sysint/encode.f b/sys/gio/nspp/sysint/encode.f
new file mode 100644
index 00000000..e6417bee
--- /dev/null
+++ b/sys/gio/nspp/sysint/encode.f
@@ -0,0 +1,15 @@
+        subroutine encode (nchars, ftnfmt, ftnout, rval)
+
+	character*11 ftnfmt, ftnout
+	integer*2 sppfmt(12), sppout(12)
+	integer SZFMT
+	parameter (SZFMT=11)
+
+c unpack the fortran character string, call fencd to actually encode the
+c output string, then pack the output string into a fortran string for return
+c
+	call f77upk (ftnfmt, sppfmt, SZFMT)
+	call fencd (nchars, sppfmt, sppout, rval)
+	call f77pak (sppout, ftnout, SZFMT)
+
+	end
diff --git a/sys/gio/nspp/sysint/erprt77.f b/sys/gio/nspp/sysint/erprt77.f
new file mode 100644
index 00000000..a4f60e1d
--- /dev/null
+++ b/sys/gio/nspp/sysint/erprt77.f
@@ -0,0 +1,441 @@
+C PACKAGE ERPRT77	 DESCRIPTION OF	INDIVIDUAL USER	ENTRIES
+C			 FOLLOWS THIS PACKAGE DESCRIPTION.
+C
+C LATEST REVISION	 FEBRUARY 1985
+C
+C PURPOSE		 TO PROVIDE A PORTABLE,	FORTRAN	77 ERROR
+C			 HANDLING PACKAGE.
+C
+C USAGE			 THESE ROUTINES	ARE INTENDED TO	BE USED	IN
+C			 THE SAME MANNER AS THEIR SIMILARLY NAMED
+C			 COUNTERPARTS ON THE PORT LIBRARY.  EXCEPT
+C			 FOR ROUTINE SETER, THE	CALLING	SEQUENCES
+C			 OF THESE ROUTINES ARE THE SAME	AS FOR
+C			 THEIR PORT COUNTERPARTS.
+C			 ERPRT77 ENTRY		PORT ENTRY
+C			 -------------		----------
+C			 ENTSR			ENTSRC
+C			 RETSR			RETSRC
+C			 NERRO			NERROR
+C			 ERROF			ERROFF
+C			 SETER			SETERR
+C			 EPRIN			EPRINT
+C			 FDUM			FDUMP
+C
+C I/O			 SOME OF THE ROUTINES PRINT ERROR MESSAGES.
+C
+C PRECISION		 NOT APPLICABLE
+C
+C REQUIRED LIBRARY	 MACHCR, WHICH IS LOADED BY DEFAULT ON
+C FILES			 NCAR'S	CRAY MACHINES.
+C
+C LANGUAGE		 FORTRAN 77
+C
+C HISTORY		 DEVELOPED OCTOBER, 1984 AT NCAR IN BOULDER,
+C			 COLORADO BY FRED CLARE	OF THE SCIENTIFIC
+C			 COMPUTING DIVISION BY ADAPTING	THE NON-
+C			 PROPRIETARY, ERROR HANDLING ROUTINES
+C			 FROM THE PORT LIBRARY OF BELL LABS.
+C
+C PORTABILITY		 FULLY PORTABLE
+C
+C REFERENCES		 SEE THE MANUAL
+C			   PORT	MATHEMATICAL SUBROUTINE	LIBRARY
+C			 ESPECIALLY "ERROR HANDLING" IN	SECTION	2
+C			 OF THE	INTRODUCTION, AND THE VARIOUS
+C			 SUBROUTINE DESCRIPTIONS.
+C ******************************************************************
+C
+C SUBBROUTINE ENTSR(IROLD,IRNEW)
+C
+C PURPOSE		SAVES THE CURRENT RECOVERY MODE	STATUS AND
+C			SETS A NEW ONE.	 IT ALSO CHECKS	THE ERROR
+C			STATE, AND IF THERE IS AN ACTIVE ERROR
+C			STATE A	MESSAGE	IS PRINTED.
+C
+C USAGE			CALL ENTSR(IROLD,IRNEW)
+C
+C ARGUMENTS
+C
+C ON INPUT		 IRNEW
+C			   VALUE SPECIFIED BY USER FOR ERROR
+C			   RECOVERY
+C			   = 0 LEAVES RECOVERY UNCHANGED
+C			   = 1 GIVES  RECOVERY
+C			   = 2 TURNS  RECOVERY OFF
+C
+C ON OUTPUT		 IROLD
+C			   RECEIVES THE	CURRENT	VALUE OF THE ERROR
+C			   RECOVERY MODE
+C
+C SPECIAL CONDITIONS	 IF THERE IS AN	ACTIVE ERROR STATE, THE
+C			 MESSAGE IS PRINTED AND	EXECUTION STOPS.
+C
+C			 ERROR STATES -
+C			 1 - ILLEGAL VALUE OF IRNEW.
+C			 2 - CALLED WHILE IN AN	ERROR STATE.
+C ******************************************************************
+C
+C SUBROUTINE RETSR(IROLD)
+C
+C PURPOSE		 SETS THE RECOVERY MODE	TO THE STATUS GIVEN
+C			 BY THE	INPUT ARGUMENT.	 A TEST	IS THEN	MADE
+C			 TO SEE	IF A CURRENT ERROR STATE EXISTS	WHICH
+C			 IS UNRECOVERABLE; IF SO, RETSR	PRINTS AN
+C			 ERROR MESSAGE AND TERMINATES THE RUN.
+C
+C			 BY CONVENTION,	RETSR IS USED UPON EXIT
+C			 FROM A	SUBROUTINE TO RESTORE THE PREVIOUS
+C			 RECOVERY MODE STATUS STORED BY	ROUTINE
+C			 ENTSR IN IROLD.
+C
+C USAGE			 CALL RETSR(IROLD)
+C
+C ARGUMENTS
+C
+C ON INPUT		 IROLD
+C			   = 1 SETS FOR	RECOVERY
+C			   = 2 SETS FOR	NONRECOVERY
+C
+C ON OUTPUT		 NONE
+C
+C SPECIAL CONDITIONS	 IF THE	CURRENT	ERROR BECOMES UNRECOVERABLE,
+C			 THE MESSAGE IS	PRINTED	AND EXECUTION STOPS.
+C
+C			 ERROR STATES -
+C			   1 - ILLEGAL VALUE OF	IROLD.
+C ******************************************************************
+C
+C INTEGER FUNCTION NERRO(NERR)
+C
+C PURPOSE		 PROVIDES THE CURRENT ERROR NUMBER (IF ANY)
+C			 OR ZERO IF THE	PROGRAM	IS NOT IN THE
+C			 ERROR STATE.
+C
+C USAGE			 N = NERRO(NERR)
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NERR
+C			   CURRENT VALUE OF THE	ERROR NUMBER
+C ******************************************************************
+C SUBROUTINE ERROF
+C
+C PURPOSE		 TURNS OFF THE ERROR STATE BY SETTING THE
+C			 ERROR NUMBER TO ZERO
+C
+C USAGE			 CALL ERROF
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+C
+C SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+C PURPOSE		 SETS THE ERROR	INDICATOR AND, DEPENDING
+C			 ON THE	OPTIONS	STATED BELOW, PRINTS A
+C			 MESSAGE AND PROVIDES A	DUMP.
+C
+C
+C USAGE			 CALL SETER(MESSG,NERR,IOPT)
+C
+C ARGUMENTS
+C
+C ON INPUT		 MESSG
+C			   HOLLERITH STRING CONTAINING THE MESSAGE
+C			   ASSOCIATED WITH THE ERROR
+C
+C			 NERR
+C			   THE NUMBER TO ASSIGN	TO THE ERROR
+C
+C			 IOPT
+C			   = 1 FOR A RECOVERABLE ERROR
+C			   = 2 FOR A FATAL ERROR
+C
+C			  IF IOPT = 1 AND THE USER IS IN ERROR
+C			  RECOVERY MODE, SETERR	SIMPLY REMEMBERS
+C			  THE ERROR MESSAGE, SETS THE ERROR NUMBER
+C			  TO NERR, AND RETURNS.
+C
+C			  IF IOPT = 1 AND THE USER IS NOT IN ERROR
+C			  RECOVERY MODE, SETERR	PRINTS THE ERROR
+C			  MESSAGE AND TERMINATES THE RUN.
+C
+C			  IF IOPT = 2 SETERR ALWAYS PRINTS THE ERROR
+C			  MESSAGE, CALLS FDUM, AND TERMINATES THE RUN.
+C
+C ON OUTPUT		 NONE
+C
+C SPECIAL CONDITIONS	 CANNOT	ASSIGN NERR = 0, AND CANNOT SET	IOPT
+C			 TO ANY	VALUE OTHER THAN 1 OR 2.
+C ******************************************************************
+C
+C  SUBROUTINE EPRIN
+C
+C PURPOSE		 PRINTS	THE CURRENT ERROR MESSAGE IF THE
+C			 PROGRAM IS IN THE ERROR STATE;	OTHERWISE
+C			 NOTHING IS PRINTED.
+C
+C USAGE			 CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+C
+C SUBROUTINE FDUM
+C
+C PURPOSE		 TO PROVIDE A DUMMY ROUTINE WHICH SERVES
+C			 AS A PLACEHOLDER FOR A	SYMBOLIC DUMP
+C			 ROUTINE, SHOULD IMPLEMENTORS DECIDE TO
+C			 PROVIDE SUCH A	ROUTINE.
+C
+C USAGE			 CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+      SUBROUTINE ENTSR(IROLD,IRNEW)
+C
+      LOGICAL TEMP
+      IF (IRNEW.LT.0 .OR. IRNEW.GT.2)
+     1	 CALL SETER(' ENTSR - ILLEGAL VALUE OF IRNEW',1,2)
+C
+      TEMP = IRNEW.NE.0
+      IROLD = I8SAV(2,IRNEW,TEMP)
+C
+C  IF HAVE AN ERROR STATE, STOP	EXECUTION.
+C
+      IF (I8SAV(1,0,.FALSE.) .NE. 0) CALL SETER
+     1	 (' ENTSR - CALLED WHILE IN AN ERROR STATE',2,2)
+C
+      RETURN
+C
+      END
+      SUBROUTINE RETSR(IROLD)
+C
+      IF (IROLD.LT.1 .OR. IROLD.GT.2)
+     1	CALL SETER(' RETSR - ILLEGAL VALUE OF IROLD',1,2)
+C
+      ITEMP=I8SAV(2,IROLD,.TRUE.)
+C
+C  IF THE CURRENT ERROR	IS NOW UNRECOVERABLE, PRINT AND	STOP.
+C
+      IF (IROLD.EQ.1 .OR. I8SAV(1,0,.FALSE.).EQ.0) RETURN
+C
+	CALL EPRIN
+	CALL FDUM
+c       STOP
+C
+      END
+      INTEGER FUNCTION NERRO(NERR)
+C
+      NERRO=I8SAV(1,0,.FALSE.)
+      NERR=NERRO
+      RETURN
+C
+      END
+      SUBROUTINE ERROF
+C
+      I=I8SAV(1,0,.TRUE.)
+      RETURN
+C
+      END
+      SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+      CHARACTER*(*) MESSG
+      COMMON /UERRF/IERF
+C
+C  THE UNIT FOR	ERROR MESSAGES IS I1MACH(4)
+C
+c +noao:  blockdata uerrbd changed to runtime initialization subroutine
+C     FORCE LOAD OF BLOCKDATA
+C
+c     EXTERNAL UERRBD
+      call uerrbd
+c -noao
+      IF (IERF .EQ. 0) THEN
+      IERF = I1MACH(4)
+      ENDIF
+C
+      NMESSG = LEN(MESSG)
+      IF (NMESSG.GE.1) GO TO 10
+C
+C  A MESSAGE OF	NON-POSITIVE LENGTH IS FATAL.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9000)
+c9000	FORMAT(' ERROR 1 IN SETER - MESSAGE LENGTH NOT POSITIVE.')
+        call uliber (1,' SETER - MESSAGE LENGTH NOT POSITIVE.', 80) 
+c -noao
+	GO TO 60
+C
+   10 CONTINUE
+      IF (NERR.NE.0) GO	TO 20
+C
+C  CANNOT TURN THE ERROR STATE OFF USING SETER.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9001)
+c9001	FORMAT(' ERROR 2 IN SETER - CANNOT HAVE NERR=0'/
+c    1	       ' THE CURRENT ERROR MESSAGE FOLLOWS'/)
+        call uliber (2, ' SETER - CANNOT HAVE NERR=0', 80)
+        call uliber (2, ' SETER - THE CURRENT ERROR MSG FOLLOWS', 80) 
+c -noao
+	CALL E9RIN(MESSG,NERR,.TRUE.)
+	ITEMP=I8SAV(1,1,.TRUE.)
+	GO TO 50
+C
+C  SET LERROR AND TEST FOR A PREVIOUS UNRECOVERED ERROR.
+C
+ 20   CONTINUE
+      IF (I8SAV(1,NERR,.TRUE.).EQ.0) GO	TO 30
+C
+c +noao: FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9002)
+c9002	FORMAT(' ERROR	  3 IN SETER -',
+c    1	       ' AN UNRECOVERED	ERROR FOLLOWED BY ANOTHER ERROR.'//
+c    2	       ' THE PREVIOUS AND CURRENT ERROR	MESSAGES FOLLOW.'///)
+        call uliber (3,' SETER - A SECOND UNRECOV ERROR SEEN.', 80)
+        call uliber (3,' SETER - THE ERROR MESSAGES FOLLOW.', 80)
+c -noao
+	CALL EPRIN
+	CALL E9RIN(MESSG,NERR,.TRUE.)
+	GO TO 50
+C
+C  SAVE	THIS MESSAGE IN	CASE IT	IS NOT RECOVERED FROM PROPERLY.
+C
+ 30   CALL E9RIN(MESSG,NERR,.TRUE.)
+C
+      IF (IOPT.EQ.1 .OR. IOPT.EQ.2) GO TO 40
+C
+C  MUST	HAVE IOPT = 1 OR 2.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c     WRITE(IERF,9003)
+c9003	FORMAT(' ERROR	  4 IN SETER - BAD VALUE FOR IOPT'//
+c    1	       ' THE CURRENT ERROR MESSAGE FOLLOWS'///)
+        call uliber (4, ' SETER - BAD VALUE FOR IOPT', 80)
+	call uliber (4, ' SETER - THE CURRENT ERR MSG FOLLOWS', 80)
+c -noao 
+	GO TO 50
+C
+C  TEST	FOR RECOVERY.
+C
+ 40   CONTINUE
+      IF (IOPT.EQ.2) GO	TO 50
+C
+      IF (I8SAV(2,0,.FALSE.).EQ.1) RETURN
+C
+      CALL EPRIN
+      CALL FDUM
+c     STOP
+C
+ 50   CALL EPRIN
+ 60   CALL FDUM
+c     STOP
+C
+      END
+      SUBROUTINE EPRIN
+C
+      CHARACTER*1 MESSG
+C
+      CALL E9RIN(MESSG,1,.FALSE.)
+      RETURN
+C
+      END
+      SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+C
+C  THIS	ROUTINE	STORES THE CURRENT ERROR MESSAGE OR PRINTS THE OLD ONE,
+C  IF ANY, DEPENDING ON	WHETHER	OR NOT SAVE = .TRUE. .
+C
+      CHARACTER*(*) MESSG
+      CHARACTER*113 MESSGP
+      LOGICAL SAVE
+      COMMON /UERRF/IERF
+C
+C  MESSGP STORES THE FIRST 113 CHARACTERS OF THE PREVIOUS MESSAGE
+C
+C
+C  START WITH NO PREVIOUS MESSAGE.
+C
+c+noao
+c Moved save to before data statements.
+      SAVE MESSGP,NERRP
+c-noao
+      DATA MESSGP/'1'/
+      DATA NERRP/0/
+C
+      IF (.NOT.SAVE) GO	TO 20
+C
+C  SAVE	THE MESSAGE.
+C
+	NERRP=NERR
+	MESSGP = MESSG
+C
+	GO TO 30
+C
+ 20   IF (I8SAV(1,0,.FALSE.).EQ.0) GO TO 30
+C
+C  PRINT THE MESSAGE.
+C
+c +noao:  FTN write rewritten as call to uliber
+c     WRITE(IERF,9000) NERRP,MESSGP
+c9000 FORMAT(' ERROR ',I4,' IN ',A113)
+      call uliber (nerrp, messgp, 113)
+C
+ 30   RETURN
+C
+      END
+      INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+C
+C  IF (ISW = 1)	I8SAV RETURNS THE CURRENT ERROR	NUMBER AND
+C		SETS IT	TO IVALUE IF SET = .TRUE. .
+C
+C  IF (ISW = 2)	I8SAV RETURNS THE CURRENT RECOVERY SWITCH AND
+C		SETS IT	TO IVALUE IF SET = .TRUE. .
+C
+      LOGICAL SET
+C
+C  START EXECUTION ERROR FREE AND WITH RECOVERY	TURNED OFF.
+C
+c+noao
+c Moved save to before data statement.
+      SAVE LERROR,LRECOV
+      DATA LERROR/0/ , LRECOV/2/
+c-noao
+      IF (ISW .EQ. 1) THEN
+	I8SAV =	LERROR
+	IF (SET) LERROR	= IVALUE
+      ELSE IF (ISW .EQ.	2) THEN
+	I8SAV =	LRECOV
+	IF (SET) LRECOV	= IVALUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE FDUM
+C
+C     DUMMY ROUTINE TO BE LOCALLY IMPLEMENTED
+C
+      RETURN
+      END
+c +noao:  Blockdata uerrbd rewritten as a runtime initialization subroutine
+c     BLOCKDATA	UERRBD
+      subroutine uerrbd
+c
+      COMMON /UERRF/IERF
+C     DEFAULT ERROR UNIT
+c     DATA IERF/0/
+      IERF= 0
+      END
+c -noao
diff --git a/sys/gio/nspp/sysint/fencode.x b/sys/gio/nspp/sysint/fencode.x
new file mode 100644
index 00000000..fe3e37ed
--- /dev/null
+++ b/sys/gio/nspp/sysint/fencode.x
@@ -0,0 +1,79 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_FORMAT	11
+
+# FENCD -- Format a real variable and return as a spp character string.
+# A packed format string is passed as an input argument to define how the
+# number is to be encoded.  The format of the format string is:
+#	format string = "(cW.D)"
+# where c is one of [EFGI], and where W and D are the field width and
+# number of decimal places or precision, respectively.
+
+procedure fencd (nchars, f_format, spp_outstr, rval)
+
+int	nchars			# desired number of output chars
+char	f_format[SZ_FORMAT+1] 	# SPP string containing format
+char	spp_outstr[SZ_FORMAT+1] # SPP string containing encoded number
+real	rval			# value to be encoded
+
+char	fmtchar, outstr[MAX_DIGITS], spp_format[SZ_FORMAT+1]
+int	ip, op, stridx()
+real	x
+
+begin
+	# Encode format string for SPRINTF, format "%w.d".  Start copying
+	# Fortran format at char 3, which should follow the EFGI char.
+
+	spp_format[1] = '%'
+	op = 2
+
+	if (f_format[1] != '(')
+	    call fatal (1, "Missing lparen in Ncar ENCODE format")
+	for (ip=3;  f_format[ip] != ')' && f_format[ip] != EOS;  ip=ip+1) {
+	    spp_format[op] = f_format[ip]
+	    op = op + 1
+	}
+
+	# Now add the SPP format character.  EFG are the same for sprintf as
+	# as for Fortran.  The integer format is 'd' for decimal in SPP.
+
+	fmtchar = f_format[2]
+	if (IS_UPPER(fmtchar))
+	    fmtchar = TO_LOWER (fmtchar)
+	    
+	switch (fmtchar) {
+	case 'e', 'f', 'g':
+	    spp_format[op] = fmtchar
+	case 'i':
+	    spp_format[op] = 'd'
+	default:
+	    call fatal (1, "Unknown Ncar ENCODE format code")
+	}
+	op = op + 1
+	spp_format[op] = EOS
+	x = rval
+	if (rval > 0)
+	    x = -x
+
+	# Now encode the user supplied variable and return it as a spp
+	# string.
+
+	iferr {
+	    call sprintf (outstr, MAX_DIGITS, spp_format)
+		call pargr (x)
+	} then
+	    call erract (EA_FATAL)
+
+	# Let's try adding a "+" prefix to positive numbers to set if that
+	# makes nicer plots.
+
+	op = stridx ('-', outstr)
+	if (rval > 0 && op > 0) 
+	    outstr[op] = '+'
+
+	call strcpy (outstr, spp_outstr, SZ_LINE)
+end
diff --git a/sys/gio/nspp/sysint/fulib.x b/sys/gio/nspp/sysint/fulib.x
new file mode 100644
index 00000000..1951f26c
--- /dev/null
+++ b/sys/gio/nspp/sysint/fulib.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# FULIB -- Print an error message processed by fortran routine uliber.
+
+procedure fulib (errcode, upkmsg, msglen)
+
+int	errcode
+char	upkmsg[ARB]		# unpacked string
+int	msglen			# number of chars in string
+
+pointer	sp, sppmsg
+
+begin
+	call smark (sp)
+	call salloc (sppmsg,  SZ_LINE, TY_CHAR)
+
+	# Construct error message string
+	call sprintf (Memc[sppmsg], SZ_LINE, "ERROR %d IN %s\n")
+	    call pargi (errcode)
+	    call pargstr (upkmsg)
+
+	# Call error with the constructed message
+	iferr (call error (errcode, Memc[sppmsg]))
+	    call erract (EA_WARN)
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/nspp/sysint/intt.x b/sys/gio/nspp/sysint/intt.x
new file mode 100644
index 00000000..315248fd
--- /dev/null
+++ b/sys/gio/nspp/sysint/intt.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<nspp.h>
+
+# INTT -- Test whether the argument is an integer (return true) or a real
+# (return false).  This works, hopefully, because legal NCAR metacode integers
+# are always less than 2 ** 15, while real numbers will always appear to be
+# large positive or negative integers.
+
+bool procedure intt (value)
+
+int	value
+
+begin
+	return (value > 0 && value < INTT_TESTVAL)
+end
diff --git a/sys/gio/nspp/sysint/ishift.x b/sys/gio/nspp/sysint/ishift.x
new file mode 100644
index 00000000..580996c0
--- /dev/null
+++ b/sys/gio/nspp/sysint/ishift.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ISHIFT -- integer shift.  To be used for calls to ISHIFT in NCAR routines.
+
+int procedure ishift (in_word, n)
+
+int	in_word, n
+int	new_word, bit, index, i
+int	bitupk()
+
+begin
+	if (n > NBITS_INT)
+	    call error (0, "n > NBITS_INT in ishift")
+	if (n < 0)
+	    # Right end-off shift
+	    new_word = bitupk (in_word, abs(n) + 1, NBITS_INT - abs(n))
+	else {
+	    # Left circular shift (rotate)
+	    do i = 1, NBITS_INT {
+		index = n + i
+		if (index > NBITS_INT)
+		    index = mod ((n + i), NBITS_INT)
+		bit = bitupk (in_word, i, 1)
+		call bitpak (bit, new_word, index, 1)
+	    }
+	}
+
+	return (new_word)
+end
+
+
+# IAND -- AND two integers.
+
+int procedure iand (a, b)
+
+int	a, b
+int	and()
+
+begin
+	return (and (a, b))
+end
+
+
+# IOR -- OR two integers.  
+
+int procedure ior (a, b)
+
+int	a, b
+int	or()
+
+begin
+	return (or (a, b))
+end
diff --git a/sys/gio/nspp/sysint/loc.x b/sys/gio/nspp/sysint/loc.x
new file mode 100644
index 00000000..59e509b5
--- /dev/null
+++ b/sys/gio/nspp/sysint/loc.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# LOCI -- Return the zero-indexed offset of the argument in the user address
+# space, in integer units.  In other words, if A is an integer array,
+# { loci(a[2]) - loci(a[1]) } is exactly one.
+#
+# NOTE -- The original NSPP (portlib) code called this function LOC, however,
+# the Sun-4 Fortran compiler has an intrinsic function of the same name which
+# behaves slightly differently, hence the name was changed to LOCI.
+
+int procedure loci (x)
+
+int	x
+int	xaddr
+
+begin
+	# ZLOCVA returns the address of the variable in units of XCHAR.
+
+	call zlocva (x, xaddr)
+	return (xaddr / SZ_INT)
+end
diff --git a/sys/gio/nspp/sysint/mcswap.x b/sys/gio/nspp/sysint/mcswap.x
new file mode 100644
index 00000000..eb9cee7d
--- /dev/null
+++ b/sys/gio/nspp/sysint/mcswap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MCSWAP -- Swap the instructions in a metacode array.
+
+procedure mcswap (a, npix)
+
+int	a[npix]
+int	npix
+int	i, temp
+
+begin
+	do i = 1, npix, 2 {
+	    temp = a[i]
+	    a[i] = a[i+1]
+	    a[i+1] = temp
+	}
+end
diff --git a/sys/gio/nspp/sysint/mkpkg b/sys/gio/nspp/sysint/mkpkg
new file mode 100644
index 00000000..b00eb46e
--- /dev/null
+++ b/sys/gio/nspp/sysint/mkpkg
@@ -0,0 +1,24 @@
+# Make the system interface modules for libnspp.a.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	encd.f
+	encode.f
+	erprt77.f
+	fencode.x	<ctype.h> <error.h> <mach.h>
+	fulib.x		<error.h>
+	intt.x		<nspp.h>
+	ishift.x	<mach.h>
+	loc.x		<mach.h>
+	mcswap.x	
+	ncgchr.x	
+	ncpchr.x	
+	packum.x	<mach.h> <nspp.h> nspp.com
+	perror.x	
+	q8qst4.f
+	uliber.f
+	;
diff --git a/sys/gio/nspp/sysint/ncgchr.x b/sys/gio/nspp/sysint/ncgchr.x
new file mode 100644
index 00000000..5cf40b22
--- /dev/null
+++ b/sys/gio/nspp/sysint/ncgchr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NCGCHR -- Get a single character (byte) from a packed array.  Return
+# a blank if the index is out of bounds.
+
+procedure ncgchr (ichars, len_ichars, index, char_value)
+
+int	ichars[ARB]		# packed character array
+int	len_ichars		# length of the array
+int	index			# index of char to be extracted
+int	char_value		# return value
+
+char	ch
+
+begin
+	if (index < 1 || index > len_ichars)
+	    char_value = ' '
+	else {
+	    call chrupk (ichars, index, ch, 1, 1)
+	    char_value = ch
+	}
+end
diff --git a/sys/gio/nspp/sysint/ncpchr.x b/sys/gio/nspp/sysint/ncpchr.x
new file mode 100644
index 00000000..4312068d
--- /dev/null
+++ b/sys/gio/nspp/sysint/ncpchr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NCPCHR -- Put a single character (byte) into a packed array.  Do nothing if
+# the index is out of bounds.
+
+procedure ncpchr (ichars, len_ichars, index, char_value)
+
+int	ichars[ARB]		# packed character array
+int	len_ichars		# length of the array
+int	index			# index of char to be set
+int	char_value		# value to be stored
+
+char	ch[1]
+
+begin
+	if (index >= 1 && index <= len_ichars) {
+	    ch[1] = char_value
+	    call chrpak (ch, 1, ichars, index, 1)
+	}
+end
diff --git a/sys/gio/nspp/sysint/nspp.com b/sys/gio/nspp/sysint/nspp.com
new file mode 100644
index 00000000..e3cac846
--- /dev/null
+++ b/sys/gio/nspp/sysint/nspp.com
@@ -0,0 +1,40 @@
+# NSPP.COM -- The nspp system plot package common block.
+
+int	mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab
+int	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb
+int	mx     ,my     ,mtypex ,mtypey 
+real	xxa    ,yya    , xxb    ,yyb    ,xxc    ,yyc
+real	xxd    ,yyd    , xfactr ,yfactr ,xadd   ,yadd
+real	xx     ,yy
+
+# XX declared integer some places in nspp code !!!
+# on a VAX this works, but what if float not same size as int ???
+
+int	mfmtx[3]       ,mfmty[3]       ,mumx   ,mumy
+int	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop[19]
+int	mname[19]      ,mxold  ,myold  ,mxmax  ,mymax
+int	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty
+int	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst
+int	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin
+int	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto
+int	mxysto ,mprint ,msybuf[360]    ,mncpw  ,minst
+int	mbufa  ,mbuflu ,mfwa[12]       ,mlwa[12]
+int	mipair ,mbprs[16]      ,mbufl  ,munit  ,mbswap
+
+real	small
+
+common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab,
+	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb,
+	mx     ,my     ,mtypex ,mtypey ,xxa    ,yya,
+	xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd,
+	xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy,
+	mfmtx  ,mfmty  ,mumx   ,mumy,
+	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop,
+	mname  ,mxold  ,myold  ,mxmax  ,mymax,
+	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty,
+	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst,
+	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin,
+	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto,
+	mxysto ,mprint ,msybuf ,mncpw  ,minst,
+	mbufa  ,mbuflu ,mfwa   ,mlwa,
+	mipair ,mbprs  ,mbufl  ,munit  ,mbswap ,small
diff --git a/sys/gio/nspp/sysint/packum.x b/sys/gio/nspp/sysint/packum.x
new file mode 100644
index 00000000..7991658c
--- /dev/null
+++ b/sys/gio/nspp/sysint/packum.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<nspp.h>
+
+# PACKUM -- Pack an integer array containing 16 bit quantities into a buffer.
+# Each 16 bit input datum occupies one integer; the input integers may be
+# any size.  This implementation will work on most byte oriented machines,
+# but will generate a fatal error on machines with 24, 60, etc. bit words.
+
+procedure packum (a, npix, bp)
+
+int	a[ARB]			# input array, one 16-bit datum per word
+int	npix			# number of mc words
+int	bp			# LOC pointer to output buffer
+
+int	offset, dummy[1]
+int	loci()
+include	"nspp.com"
+
+begin
+	offset = bp - loci (dummy) + 1
+
+	# It is necessary to swap the order of the metacode words on some
+	# machines.  Npix is always an even number.  The swapping must be
+	# done here because the NSPP and MCTR code assumes that the bytes
+	# are ordered in a certain manner (most significant first).  Thus,
+	# when the buffer is flushed FLUSHB will set the magic bits, and
+	# if we wait and swap upon output rather than here, it will set the
+	# bits in the wrong word.
+
+	if (mbswap == YES)		# flag set from graphcap in nsppkern
+	    call mcswap (a, npix)
+
+	switch (NBITS_MCWORD) {
+	case NBITS_SHORT:
+	    call achtis (a, dummy[offset], npix)
+	case NBITS_INT:
+	    call amovi (a, dummy[offset], npix)
+	default:
+	    call fatal (1, "gio.ncar.packum: cannot pack metacode")
+	}
+end
diff --git a/sys/gio/nspp/sysint/perror.x b/sys/gio/nspp/sysint/perror.x
new file mode 100644
index 00000000..6c1cb85b
--- /dev/null
+++ b/sys/gio/nspp/sysint/perror.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PERROR -- Fatal error in NSPP.
+
+procedure perror()
+
+begin
+	call fatal (0, "Fatal error in Ncar system plot package")
+end
diff --git a/sys/gio/nspp/sysint/q8qst4.f b/sys/gio/nspp/sysint/q8qst4.f
new file mode 100644
index 00000000..0b8ca796
--- /dev/null
+++ b/sys/gio/nspp/sysint/q8qst4.f
@@ -0,0 +1,24 @@
+      SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+C
+C DIMENSION OF		 NAME(1),LBRARY(1),ENTRY(1),VRSION(1)
+C ARGUMENTS
+C
+C LATEST REVISION	 MARCH 1984
+C
+C PURPOSE		 MONITORS LIBRARY USE BY WRITING A RECORD WITH
+C			 INFORMATION ABOUT THE CIRCUMSTANCES OF	A
+C			 LIBRARY ROUTINE CALL TO THE SYSTEM ACCOUNTING
+C			 TAPE FOR LATER	PROCESSING.
+C
+C NOTE---		 THIS VERSION OF Q8QST4	SIMPLY RETURNS TO THE
+C			 CALLING ROUTINE.  LOCAL IMPLEMENTORS MAY WISH
+C			 TO IMPLEMENT A	VERSION	OF THIS	ROUTINE	THAT
+C			 MONITORS USE OF NCAR ROUTINES WITH LOCAL
+C			 MECHANISMS.  OTHERWISE	IT WILL	SAVE A SMALL
+C			 AMOUNT	OF SPACE AND TIME IF CALLS TO Q8QST4 ARE
+C			 DELETED FROM ALL NSSL ROUTINES.
+C
+      CHARACTER*(*) NAME,LBRARY,ENTRY,VRSION
+C
+      RETURN
+      END
diff --git a/sys/gio/nspp/sysint/uliber.f b/sys/gio/nspp/sysint/uliber.f
new file mode 100644
index 00000000..7dba302e
--- /dev/null
+++ b/sys/gio/nspp/sysint/uliber.f
@@ -0,0 +1,14 @@
+        subroutine uliber (errcode, pkerrmsg, msglen)
+
+	character*80 pkerrmsg
+	integer errcode, msglen
+	integer*2 sppmsg(81)
+	integer SZLINE
+	parameter (SZLINE=80)
+
+c unpack the fortran character string, call fulib to output the string.
+c
+	call f77upk (pkerrmsg, sppmsg, SZLINE)
+	call fulib  (errcode, sppmsg, msglen)
+
+	end
diff --git a/sys/gio/nsppkern/README b/sys/gio/nsppkern/README
new file mode 100644
index 00000000..0990eac0
--- /dev/null
+++ b/sys/gio/nsppkern/README
@@ -0,0 +1,399 @@
+This directory contains the source for the NSPP/GIO kernel, the interface
+between GIO and the old Ncar system plot package and associated metacode
+translators.
+
+Special graphcap entries used by this kernel:
+
+	MF		maximum frame count per metafile
+	FS		frame advance req'd at start of metafile
+	FE		frame advance req'd at end of metafile
+
+Rev 1.0 installed in March 1985.
+----------------------------------------------------------------------------
+
+Differences between Rev 1.0 and Rev 1.1 of the NSPP/GIO kernel.
+Collated at installation of Rev 1.1 on 24 April 1985.
+----------------------------------------------------------------------------
+
+gktclose.x
++ diff gktclose.x ../nsppkern.old/gktclose.x 
+12,13d11
+< 	call frame
+< 	call gkt_flush
++ echo gktclosews.x 
+gktinit.x
++ diff gktinit.x ../nsppkern.old/gktinit.x 
+49a50,59
+> 	# get the window offsets
+> 
+> 	g_xoff = ttygeti (tty, "XO")
+> 	if (g_xoff < 0)
+> 	    g_xoff = 0
+> 	g_yoff = ttygeti (tty, "YO")
+> 	if (g_yoff < 0)
+> 	    g_yoff = 0
+> 
+> 
+112d121
+< 	GKT_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+gktopenws.x
++ diff gktopenws.x ../nsppkern.old/gktopenws.x 
+98,104c98,99
+< 	if (mode == NEW_FILE) {
+< 	    # Frame call only if NEW_FILE and not first time open with
+< 	    # this device.  This prevents frame before first data.
+< 	    if (!need_open)
+< 	        call frame
+< 	    call gkt_reset
+< 	}
+---
+> 	if (mode == NEW_FILE)
+> 	    call frame()
++ echo gktpcell.x 
+gktpcell.x
++ diff gktpcell.x ../nsppkern.old/gktpcell.x 
+8a9
+> 
+12c13
+< procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+---
+> procedure gkt_putcellarray (m, nc, nr, x1,y1, x2,y2)
+17,18c18,19
+< int	ax1, ay1		# lower left corner of output window
+< int	ax2, ay2		# upper right corner of output window
+---
+> int	x1, y1			# lower left corner of output window
+> int	x2, y2			# upper right corner of output window
+20d20
+< int	x1,y1,x2,y2		# device coordinates
+22c22
+< int	nx, ny, y
+---
+> int	nx, ny
+28c28
+< bool	ca, use_orig, new_row, pr
+---
+> bool	ca, use_orig, new_row
+31,32d30
+< real	delta_y
+< int	xrep, yrep
+43c41
+< 	# Determine if can do real cell array.  If not, use character
+---
+> 	# determine if can do real cell array.  If not, use character
+49d46
+< 	pr = false
+53d49
+< 	    pr = (GKT_PIXREP(g_kt) != 0)
+65,66c61
+< 	# Input arguments (ax, ay) refer to corners of put cell array;
+< 	# we need corners of the corresponding device array.
+---
+> 	# find out how many real pixels we have to fill
+68,73c63,66
+< 	x1 = ax1
+< 	x2 = ax2
+< 	y1 = ay1
+< 	y2 = ay2
+< 	call adjust(x1,x2,xres)
+< 	call adjust(y1,y2,yres)
+---
+> 	px1 = real(x1)/GKI_MAXNDC
+> 	py1 = real(y1)/GKI_MAXNDC
+> 	px2 = real(x2)/GKI_MAXNDC
+> 	py2 = real(y2)/GKI_MAXNDC
+75,79c68,69
+< 	# Find out how many real pixels we have to fill
+< 	px1 = real(x1)/(GKI_MAXNDC+1)
+< 	py1 = real(y1)/(GKI_MAXNDC+1)
+< 	px2 = real(x2)/(GKI_MAXNDC+1)
+< 	py2 = real(y2)/(GKI_MAXNDC+1)
+---
+> 	nx = int( (px2 - px1) * (xres-1.0) + 1.5 )
+> 	ny = int( (py2 - py1) * (yres-1.0) + 1.5 )
+81,90c71
+< 	nx = int( px2 * xres ) - int( px1 * xres ) + 1
+< 	ny = int( py2 * yres ) - int( py1 * yres ) + 1
+< 
+< 	if ( ny > 1)
+< 	     delta_y = (real(y2) - real(y1))/ny
+< 	else {
+< 	     delta_y = 0.
+< 	}
+< 
+< 	# If too many data points in input, set skip.  If skip is close
+---
+> 	# if too many data points in input, set skip.  If skip is close
+92,93c73,74
+< 	# Set block replication factors - will be > 1.0 if too few input points.
+< 	# Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+---
+> 	# set block replication factors - will be > 1.0 if too few input points.
+> 	# cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+110c91,101
+< 	# Allocate storage for a row of pixels.  This is quite inefficient
+---
+> 
+> 	# try for the simplest case: 1:1 match with input data
+> 
+> 	if ( ca && (nx == nc) && (ny == nr) ) {
+> 	    call pixels( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 		nx, ny, m)
+> 	    call sfree(sp)
+> 	    return
+> 	}
+> 
+> 	# allocate storage for a row of pixels.  This is quite inefficient
+113d103
+< 	# need nx+1 in case nx odd ... pixels() wants to pad output.
+115,116c105
+< 	call salloc ( cell, nx+1, TY_SHORT)
+< 	Mems[cell + nx] = 0
+---
+> 	call salloc ( cell, nx, TY_SHORT)
+118c107
+< 	# Initialize counters
+---
+> 	# initialize counters
+125c114
+< 	# See if we can use original data ... no massaging
+---
+> 	# see if we can use original data ... no massaging
+128c117
+< 	# Note that if blockx > 1.0, skip_x must be 1.0, and vv
+---
+> 	# note that if blockx > 1.0, skip_x must be 1.0, and vv
+138,152c127
+< 	# If device can pixel replicate, use that feature where we can
+< 	if( pr) {
+< 	    if( (skip_x == 1.0) && ( int(blockx) == blockx) ) {
+< 		 xrep = int(blockx)
+< 		 use_orig = true
+< 		 nx = nc
+< 	    } else
+< 		 xrep = 1
+< 	    if( (skip_y == 1.0) && ( int(blocky) == blocky) ) {
+< 		 yrep = int(blocky)
+< 		 ny = 1
+< 	    } else
+< 		 yrep = 1
+< 	}
+< 	call pixel0(1,0,xrep,0,1,yrep)
+---
+> 	# do it
+154c129
+< 	# Do it
+---
+> 	for (i = 1;  i <= ny;  i = i + 1) {
+156c131
+< 	for ( i = 1; i <= ny ; i = i + 1) {
+---
+> 	    # Build the row data.
+158,159d132
+< 	    # Build the row data
+< 
+161c134
+< 		if ( skip_x == 1.0) {
+---
+> 		if ( skip_x == 1.0)
+163c136
+< 		} else {
+---
+> 		else {
+181d153
+< 		y = y1 + ((i - 1)*delta_y + 0.5)
+183,184c155,159
+< 		        call pixels( px1, real(y)/GKI_MAXNDC,
+< 			    nx, 1, m[element])
+---
+> 		    if ( i == 1 )
+> 		        call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 			    nx, ny, m[element])
+> 		    else
+> 		        call pixeli( 0., 0., nx, 1, m[element])
+186c161,165
+< 		        call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell])
+---
+> 		    if ( i == 1 )
+> 		        call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 			    nx, ny, Mems[cell])
+> 		    else
+> 		        call pixeli( 0., 0., nx, 1, Mems[cell])
+188,189c167
+< 	    }   
+< 	    else
+---
+> 	    } else
+192c170
+< 	    # Advance a row
+---
+> 	    # Advance a row.
+206c184
+< 	# All done, restore text parameters and release storage
+---
+> 	# all done, restore text parameters and release storage
+209c187
+< 	    call restoretx (txsave,tx)
+---
+> 	    call restoretx(txsave,tx)
+212a191
+> 
+218d196
+< pointer savep, txp
+219a198
+> pointer savep, txp
+254a234
+> 
+258d237
+< pointer savep, txp
+259a239
+> pointer savep, txp
+263c243
+< 	# Restore values
+---
+> 	# restore values
+283a264
+> 
+287c268,269
+< procedure fakepc (indata, outdata, nx,  scale)
+---
+> procedure fakepc( indata, outdata, nx,  scale)
+> 
+298c280
+< data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+---
+> data	cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+330,374d311
+< end
+< 
+< # ADJUST -- round/truncate putcell array corners to device coordinates
+< # move up lower bound if it is above center point of device cell,
+< # move down upper bound if below.  Don't allow bounds to go beyond
+< # resolution or below zero.  Do not allow bounds to cross.  Part of the
+< # assumptions behind all this is that putcells will be continguous and
+< # rows/columns must not be plotted twice.
+< 
+< procedure adjust ( lower, upper, res)
+< 
+< int	lower, upper
+< real	res
+< 
+< real	factor
+< real	low, up
+< 
+< begin
+< 	factor = res/(GKI_MAXNDC+1)
+< 	low = real(lower) * factor
+< 	up  = real(upper) * factor
+< 
+< 	# if boundaries result in same row, return
+< 	if ( int(low) == int(up) )
+< 	    return
+< 
+< 	# if low is in upper half of device pixel, round up
+< 	if ( (low - int(low)) >= 0.5 ) {
+< 	    low = int(low) + 1
+< 	    # don't go to or beyond upper bound
+< 	    if ( low < up ) {
+< 	        # ... 0.2 just for "rounding protection";
+< 		lower = (low + 0.2)/factor
+< 	        # if now reference same cell, return
+< 		if ( int(low) == int(up) )
+< 		    return
+< 	    }
+< 	}
+< 
+< 	# if "up" in bottom half of pixel, drop down one.  Note that
+< 	# due to two "==" tests above, upper will not drop below lower.
+< 	# 0.2 means drop partway down into pixel below; calling code will
+< 	# truncate.
+< 	if ( (up - int(up)) < 0.5 )
+< 	    upper = real(int(up) - 0.2)/factor
++ echo gktpl.x 
+gktpl.x
++ diff gktpl.x ../nsppkern.old/gktpl.x 
+51,52c51,52
+< 	x = p[1]
+< 	y = p[2]
+---
+> 	x = p[1] + g_xoff
+> 	y = p[2] + g_yoff
+58,59c58,59
+< 	    x = p[i]
+< 	    y = p[i+1]
+---
+> 	    x = p[i] + g_xoff
+> 	    y = p[i+1] + g_yoff
+gktpm.x
++ diff gktpm.x ../nsppkern.old/gktpm.x 
+48,49c48,49
+< 	x = p[1]
+< 	y = p[2]
+---
+> 	x = p[1] + g_xoff
+> 	y = p[2] + g_yoff
+63,64c63,64
+< 	    x = p[i]
+< 	    y = p[i+1]
+---
+> 	    x = p[i] + g_xoff
+> 	    y = p[i+1] + g_yoff
++ echo gktpmset.x 
+gkttx.x
++ diff gkttx.x ../nsppkern.old/gkttx.x 
+109,110c109,110
+< 		call pwrity (real(x)/GKI_MAXNDC,
+< 			real(y)/GKI_MAXNDC, Memc[pstring], seglen,
+---
+> 		call pwrity (real(x+g_xoff)/GKI_MAXNDC,
+> 			real(y+g_yoff)/GKI_MAXNDC, Memc[pstring], seglen,
+_____________________________________________________________________________
+
+25Apr85	gktpl.x
+	Call to optn to set line width changed to set option "inten" instead
+	of "spot size", which was not changing the line width.
+
+26Apr85 gktpm.x
+	Same change as one to gktpl.x
+
+	Character size as used in gkttx.x is a floating point number, but
+	NCAR pwry.f uses an integer value -- the conversion was causing
+	centering errors as gkttx.x would calculate a "path length" for
+	the text based on one size, and pwry.f would use a different size
+	to generate the text.  Changed pwry.f to use a floating point
+	size as an input variable, changed gkttx.x to send same.
+
+	gktpcell.x
+	Moved pixel0 call inside the "if (pr) {" statment, where it should
+	have been.
+
+	graphcap
+	Added  "pr" capablility flag to dicomed entry.  Changed character
+	height to reflect the 9 to 8 ratio that pwry uses.
+
+
+---------------------------------------------------------------------------
+Rev 1.2 10 May 1985 Dct.
+
+Fairly extensive modifications made to minimize the number of frame calls
+and metafiles generated.  Redundant CLEAR calls or clear calls immediately
+after open workstation are ignored.  Multiple frames are permitted in a
+metafile (formerly the metafile was disposed after each frame).  Graphcap
+parameters were added to control automatic frame advances at the beginning
+and end of metafiles.
+
+---------------------------------------------------------------------------
+Rev 1.3 1 June 1985 Dct.
+
+[1] Fixed a bug in polymarker; was drawing polylines.
+
+[2] Replaced the old character generation code by all new code, using the stroke
+table from the NCAR/GKS code.  Replaced "pwry.f" by the much simpler
+"gktdrawch.x".  Largely copied the stdgraph "stgtx.x", including the clipping
+logic therein.
+
+17-Aug-85 Dct.
+	Added support for the new DD graphcap parameter, used to pass device
+	dependent information to the device driver.  This information was
+	formerly encoded in a table at compile time, with the table defined
+	in <libc/kernel.h>.
diff --git a/sys/gio/nsppkern/font.com b/sys/gio/nsppkern/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/nsppkern/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/nsppkern/font.h b/sys/gio/nsppkern/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/nsppkern/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/nsppkern/gkt.com b/sys/gio/nsppkern/gkt.com
new file mode 100644
index 00000000..828b39bb
--- /dev/null
+++ b/sys/gio/nsppkern/gkt.com
@@ -0,0 +1,17 @@
+# GKTRANS common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/gktcom/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_device
diff --git a/sys/gio/nsppkern/gkt.h b/sys/gio/nsppkern/gkt.h
new file mode 100644
index 00000000..09ab7b80
--- /dev/null
+++ b/sys/gio/nsppkern/gkt.h
@@ -0,0 +1,75 @@
+# GKTRANS definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_MFRECORD	(1440/SZB_CHAR)		# metafile record size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The GKTRANS state/device descriptor.
+
+define	LEN_GKT		81
+
+define	GKT_SBUF	Memi[$1]		# string buffer
+define	GKT_SZSBUF	Memi[$1+1]		# size of string buffer
+define	GKT_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	GKT_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	GKT_POLYLINE	Memi[$1+4]		# device supports polyline
+define	GKT_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	GKT_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	GKT_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	GKT_ZRES	Memi[$1+8]		# device resolution in Z
+define	GKT_FILLSTYLE	Memi[$1+9]		# number of fill styles
+define	GKT_ROAM	Memi[$1+10]		# device supports roam
+define	GKT_ZOOM	Memi[$1+11]		# device supports zoom
+define	GKT_SELERASE	Memi[$1+12]		# device has selective erase
+define	GKT_PIXREP	Memi[$1+13]		# device supports pixel replic.
+define	GKT_STARTFRAME	Memi[$1+14]		# frame advance at metafile BOF
+define	GKT_ENDFRAME	Memi[$1+15]		# frame advance at metafile EOF
+	# extra space
+define	GKT_CURSOR	Memi[$1+20]		# last cursor accessed
+define	GKT_COLOR	Memi[$1+21]		# last color set
+define	GKT_TXSIZE	Memi[$1+22]		# last text size set
+define	GKT_TXFONT	Memi[$1+23]		# last text font set
+define	GKT_TYPE	Memi[$1+24]		# last line type set
+define	GKT_WIDTH	Memi[$1+25]		# last line width set
+define	GKT_DEVNAME	Memi[$1+26]		# name of open device
+	# extra space
+define	GKT_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	GKT_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	GKT_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	GKT_PLAP	($1+60)			# polyline attributes
+define	GKT_PMAP	($1+64)			# polymarker attributes
+define	GKT_FAAP	($1+68)			# fill area attributes
+define	GKT_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/nsppkern/gktcancel.x b/sys/gio/nsppkern/gktcancel.x
new file mode 100644
index 00000000..17679f89
--- /dev/null
+++ b/sys/gio/nsppkern/gktcancel.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	"gkt.h"
+
+# GKT_CANCEL -- Cancel any buffered output.
+
+procedure gkt_cancel (dummy)
+
+int	dummy			# not used at present
+include	"gkt.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+
+	# First we cancel any output in the FIO stream, then
+	# flush the nspp buffers.  This might, of course,
+	# put something in the FIO stream, so we cancel again.
+	# note the Fortran escape for "flush"...spp has a reserved
+	# word of the same name.
+
+	call fseti (g_out, F_CANCEL, OK)
+%	call mcflsh
+	call fseti (g_out, F_CANCEL, OK)
+	call gkt_reset()
+end
diff --git a/sys/gio/nsppkern/gktclear.x b/sys/gio/nsppkern/gktclear.x
new file mode 100644
index 00000000..4132d371
--- /dev/null
+++ b/sys/gio/nsppkern/gktclear.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"gkt.h"
+
+# GKT_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure gkt_clear (dummy)
+
+int	dummy			# not used at present
+
+int	gkt_mfopen()
+errchk	gkt_mfopen
+include	"gkt.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by calling NSPP to do a frame
+	# advance or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (GKT_ENDFRAME(g_kt) == YES)
+		call frame()
+
+	    # The call to the NSPP flush procedure must be escaped to avoid
+	    # interpretation as the FIO flush procedure.
+
+%	    call mcflsh
+
+	    g_nframes = 0
+	    call close (g_out)
+
+	    g_out = gkt_mfopen (g_tty, NEW_FILE)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (GKT_STARTFRAME(g_kt) == YES)
+		call frame()
+
+	} else {
+	    # Merely output NSPP frame instruction to start a new frame in
+	    # the same metafile.
+
+	    call frame()
+	}
+
+	# Init kernel data structures.
+	call gkt_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/nsppkern/gktclose.x b/sys/gio/nsppkern/gktclose.x
new file mode 100644
index 00000000..9ab73c34
--- /dev/null
+++ b/sys/gio/nsppkern/gktclose.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_CLOSE -- Close the nspp translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure gkt_close()
+
+include	"gkt.com"
+
+begin
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (GKT_ENDFRAME(g_kt) == YES)
+		call frame()
+
+	    # The call to the NSPP flush procedure must be escaped to avoid
+	    # interpretation as the FIO flush procedure.
+
+%	    call mcflsh
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call close (g_out)
+
+	# Free kernel data structures.
+	call mfree (GKT_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/nsppkern/gktclws.x b/sys/gio/nsppkern/gktclws.x
new file mode 100644
index 00000000..27889c7c
--- /dev/null
+++ b/sys/gio/nsppkern/gktclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure gkt_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "gkt.com"
+
+begin
+	call gkt_flush (0)
+end
diff --git a/sys/gio/nsppkern/gktcolor.x b/sys/gio/nsppkern/gktcolor.x
new file mode 100644
index 00000000..7d24368a
--- /dev/null
+++ b/sys/gio/nsppkern/gktcolor.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# nspp particulars
+# colors
+define	BLACK		1
+define	WHITE		2
+define	RED		3
+define	GREEN		4
+define	BLUE		5
+
+# GKT_COLOR  set the color option in the nspp world
+
+procedure gkt_color(index)
+
+int	index		# index for color switch statement
+include	"gkt.com"
+
+begin
+	switch (index) {
+	    case WHITE:
+		call optn (*"co", *"white")
+	    case RED:
+		call optn (*"co", *"red")
+	    case GREEN:
+		call optn (*"co", *"green")
+	    case BLUE:
+		call optn (*"co", *"blue")
+	    default:
+		call optn (*"co", *"black")
+	}
+end
diff --git a/sys/gio/nsppkern/gktdrawch.x b/sys/gio/nsppkern/gktdrawch.x
new file mode 100644
index 00000000..dd7dbeb1
--- /dev/null
+++ b/sys/gio/nsppkern/gktdrawch.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"gkt.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# GKT_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure gkt_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+real	px, py, sx, sy, coso, sino, theta
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call gkt_font (font)
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    sx = x + px * coso + py * sino
+	    sy = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call frstpt (sx / GKI_MAXNDC, sy / GKI_MAXNDC)
+	    else
+		call vector (sx / GKI_MAXNDC, sy / GKI_MAXNDC)
+	}
+end
diff --git a/sys/gio/nsppkern/gktescape.x b/sys/gio/nsppkern/gktescape.x
new file mode 100644
index 00000000..ad8ff494
--- /dev/null
+++ b/sys/gio/nsppkern/gktescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GKt_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The nspp kernel does not have any escape functions at present.
+
+procedure gkt_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/nsppkern/gktfa.x b/sys/gio/nsppkern/gktfa.x
new file mode 100644
index 00000000..4df21260
--- /dev/null
+++ b/sys/gio/nsppkern/gktfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_FILLAREA -- Fill a closed area.
+
+procedure gkt_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"gkt.com"
+
+begin
+	# Not implemented yet.
+	call gkt_polyline (p, npts)
+end
diff --git a/sys/gio/nsppkern/gktfaset.x b/sys/gio/nsppkern/gktfaset.x
new file mode 100644
index 00000000..f5851cb9
--- /dev/null
+++ b/sys/gio/nsppkern/gktfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_FASET -- Set the fillarea attributes.
+
+procedure gkt_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"gkt.com"
+
+begin
+	fa = GKT_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/nsppkern/gktflush.x b/sys/gio/nsppkern/gktflush.x
new file mode 100644
index 00000000..decb5300
--- /dev/null
+++ b/sys/gio/nsppkern/gktflush.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_FLUSH -- Flush output.
+
+procedure gkt_flush (dummy)
+
+int	dummy			# not used at present
+include	"gkt.com"
+
+begin
+	# Since the NSPP devices are not interactive, calls to FLUSH
+	# are ignored.
+end
diff --git a/sys/gio/nsppkern/gktfont.x b/sys/gio/nsppkern/gktfont.x
new file mode 100644
index 00000000..cbcb9f90
--- /dev/null
+++ b/sys/gio/nsppkern/gktfont.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"gkt.h"
+
+# GKT_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set GKT_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure gkt_font (font)
+
+int	font			# code for font to be set
+int	pk1, pk2, width
+include	"gkt.com"
+
+begin
+	pk1 = GKI_PACKREAL(1.0)
+	pk2 = GKI_PACKREAL(2.0)
+
+	width = GKT_WIDTH(g_kt)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call optn (*"inten", *"high")
+		width = pk2
+	    }
+	} else {
+	    if (GKI_UNPACKREAL(width) > 1.5) {
+		call optn (*"inten", *"low")
+		width = pk1
+	    }
+	}
+
+	GKT_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/nsppkern/gktgcell.x b/sys/gio/nsppkern/gktgcell.x
new file mode 100644
index 00000000..197bf018
--- /dev/null
+++ b/sys/gio/nsppkern/gktgcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GKT_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkt_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/nsppkern/gktinit.x b/sys/gio/nsppkern/gktinit.x
new file mode 100644
index 00000000..78ae0840
--- /dev/null
+++ b/sys/gio/nsppkern/gktinit.x
@@ -0,0 +1,194 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine GKT_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure gkt_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"gkt.com"
+include	"nspp.com"
+int	pow2()
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_GKT, TY_STRUCT)
+	    call malloc (GKT_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile (NSPP parameters).
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	GKT_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	GKT_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	GKT_SZSBUF(g_kt) = SZ_SBUF
+	GKT_NEXTCH(g_kt) = GKT_SBUF(g_kt) + 1
+	Memc[GKT_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Set up coordinate transformations.
+
+	call seti (pow2(g_xres), pow2(g_yres))
+	call set (0., 1., 0., 1., 0., 1., 0., 1., 1)
+	call z8zpii()
+
+	# Set byteswap flag for output metacode.
+	mbswap = btoi (ttygetb (tty, "BS"))
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+	# ... not relevant for nspp, but leave here anyway for now
+
+	GKT_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = GKT_NEXTCH(g_kt)
+
+	if (GKT_NCHARSIZES(g_kt) <= 0) {
+	    GKT_NCHARSIZES(g_kt) = 1
+	    GKT_CHARSIZE(g_kt,1) = 1.0
+	    GKT_CHARHEIGHT(g_kt,1) = char_height
+	    GKT_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= GKT_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		GKT_CHARSIZE(g_kt,i)   = char_size
+		GKT_CHARHEIGHT(g_kt,i) = char_height * char_size
+		GKT_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	GKT_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	GKT_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	GKT_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	GKT_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	GKT_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	GKT_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	GKT_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	GKT_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	GKT_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	GKT_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	GKT_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = GKT_NEXTCH(g_kt)
+	GKT_DEVNAME(g_kt) = nextch
+	maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	GKT_NEXTCH(g_kt) = nextch
+end
+
+
+# GKT_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure gkt_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"gkt.com"
+
+begin
+	nextch = GKT_NEXTCH(g_kt)
+	maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = GKT_SBUF(g_kt)
+
+	GKT_NEXTCH(g_kt) = nextch
+	return (strp)
+end
+
+
+# POW2 -- Return the integer base two exponent of the first power of two
+# greater than the argument.  The technique is to use successive one bit
+# shift rights to determine the index of the leftmost one-bit.
+
+int procedure pow2 (num)
+
+int	num
+int	bitshift, n, pow
+
+begin
+	bitshift = 0
+	for (n=max(1,num);  n > 0;  n=n/2)
+	    bitshift = bitshift + 1
+	pow = bitshift - 1
+
+	if (num > 2 ** pow)
+	    return (pow + 1)
+	else
+	    return (pow)
+end
diff --git a/sys/gio/nsppkern/gktline.x b/sys/gio/nsppkern/gktline.x
new file mode 100644
index 00000000..08318c91
--- /dev/null
+++ b/sys/gio/nsppkern/gktline.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"gkt.h"
+
+# GKT_LINETYPE -- Set the line type option in the nspp world.
+
+procedure gkt_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"gkt.com"
+
+begin
+	switch (index) {
+	    case GL_CLEAR:
+		linetype = 0
+	    case GL_DASHED:
+		linetype = 0FF00X
+	    case GL_DOTTED:
+		linetype = 08888X
+	    case GL_DOTDASH:
+		linetype = 0F040X
+	    default:
+		linetype = 0FFFFX	# GL_SOLID and default
+	}
+
+	call optn (*"dp", linetype)
+end
diff --git a/sys/gio/nsppkern/gktmfopen.x b/sys/gio/nsppkern/gktmfopen.x
new file mode 100644
index 00000000..97ab92f9
--- /dev/null
+++ b/sys/gio/nsppkern/gktmfopen.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<fset.h>
+include	"gkt.h"
+
+define	SZ_DDSTR	256
+
+
+# GKT_MFOPEN -- Open the NSPP metacode output file.  The device is connected
+# to FIO as a binary file.  Metacode output to the device will be spooled
+# and then disposed of to the device when the file descriptor we return is
+# later closed.
+
+int procedure gkt_mfopen (tty, mode)
+
+pointer	tty			# pointer to graphcap entry for device
+int	mode			# access mode
+
+int	fd
+pointer	sp, ddstr
+int	fopnbf(), ttygets()
+extern	zopnpl(), zardpl(), zawrpl(), zawtpl(), zsttpl(), zclspl()
+errchk	fopnbf
+
+begin
+	call smark (sp)
+	call salloc (ddstr, SZ_DDSTR, TY_CHAR)
+
+	# The DD string is used to pass device dependent information to the
+	# NSPP graphics device driver.
+
+	if (ttygets (tty, "DD", Memc[ddstr], SZ_DDSTR) <= 0)
+	    call error (1, "nsppkern: missing DD parameter in graphcap")
+
+	fd = fopnbf (Memc[ddstr], mode,
+	    zopnpl, zardpl, zawrpl, zawtpl, zsttpl, zclspl)
+
+	# Set the FIO buffer size to the size of a metafile record.
+	call fseti (fd, F_BUFSIZE, SZ_MFRECORD)
+
+	call sfree (sp)
+	return (fd)
+end
diff --git a/sys/gio/nsppkern/gktopen.x b/sys/gio/nsppkern/gktopen.x
new file mode 100644
index 00000000..41e3b19a
--- /dev/null
+++ b/sys/gio/nsppkern/gktopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_OPEN -- Install the nspp kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure gkt_open (devname, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	gkt_openws(), gkt_closews(), gkt_clear(), gkt_cancel()
+extern	gkt_flush(), gkt_polyline(), gkt_polymarker(), gkt_text()
+extern	gkt_fillarea(), gkt_putcellarray(), gkt_plset()
+extern	gkt_pmset(), gkt_txset(), gkt_faset()
+extern	gkt_escape()
+include	"gkt.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (gkt_openws)
+	dd[GKI_CLOSEWS]		= locpr (gkt_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (gkt_clear)
+	dd[GKI_CANCEL]		= locpr (gkt_cancel)
+	dd[GKI_FLUSH]		= locpr (gkt_flush)
+	dd[GKI_POLYLINE]	= locpr (gkt_polyline)
+	dd[GKI_POLYMARKER]	= locpr (gkt_polymarker)
+	dd[GKI_TEXT]		= locpr (gkt_text)
+	dd[GKI_FILLAREA]	= locpr (gkt_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (gkt_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (gkt_plset)
+	dd[GKI_PMSET]		= locpr (gkt_pmset)
+	dd[GKI_TXSET]		= locpr (gkt_txset)
+	dd[GKI_FASET]		= locpr (gkt_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (gkt_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call gkt_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/gktopenws.x b/sys/gio/nsppkern/gktopenws.x
new file mode 100644
index 00000000..2ef91e3d
--- /dev/null
+++ b/sys/gio/nsppkern/gktopenws.x
@@ -0,0 +1,104 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"gkt.h"
+
+# GKT_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure gkt_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	gkt_mfopen()
+bool	need_open, same_dev
+
+include	"gkt.com"
+include	"nspp.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[GKT_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (GKT_ENDFRAME(g_kt) == YES)
+		    call frame()
+		call close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+		iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call gkt_init (g_tty, Memc[buf])
+		call gkt_reset()
+	    }
+
+	    # Open the output file.  The device is connected to FIO as a 
+	    # binary file.  Metacode output to the device will be spooled
+	    # and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = gkt_mfopen (g_tty, mode)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (GKT_STARTFRAME(g_kt) == YES)
+		    call frame()
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+
+	    # Initialize output file descriptor in nspp common.
+	    munit = g_out
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call gkt_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/gktpcell.x b/sys/gio/nsppkern/gktpcell.x
new file mode 100644
index 00000000..e7e0ca4a
--- /dev/null
+++ b/sys/gio/nsppkern/gktpcell.x
@@ -0,0 +1,383 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include "gkt.h"
+
+# Number of grey scale symbols
+define NSYMBOL	11
+define TSIZE	(1.0/2.0)
+
+# GKT_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+
+short	m[ARB]			# cell array
+int	nc, nr			# number of pixels in X and Y
+				# (number of columns[x], rows[y]
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+int	x1,y1,x2,y2		# device coordinates
+real	px1, py1, px2, py2
+int	nx, ny, y
+real	skip_x, skip_y, sx, sy
+real	blockx, blocky, bcy
+int	i, j, startrow, element
+real	xres, yres
+pointer	sp, cell, tx, txsave
+bool	ca, use_orig, new_row, pr
+real	z_scale
+real	charheight, charwidth
+real	delta_y
+int	xrep, yrep
+
+include "gkt.com"
+
+begin
+	call smark(sp)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+
+	g_ndraw = g_ndraw + 1
+
+	skip_x = 1.0
+	skip_y = 1.0
+	blockx = 1.0
+	blocky = 1.0
+
+	# Determine if can do real cell array.  If not, use character
+	# sized boxes as pixels.  In that case, we need to save all
+	# the character attributes since we will want to force default
+	# character size, orientation, etc.
+
+	ca = (GKT_CELLARRAY(g_kt) != 0)
+	pr = false
+	if ( ca ) {
+	    xres = real(g_xres)
+	    yres = real(g_yres)
+	    pr = (GKT_PIXREP(g_kt) != 0)
+	} else {
+	    charwidth  = real(GKT_CHARWIDTH(g_kt,1))*TSIZE
+	    charheight = real(GKT_CHARHEIGHT(g_kt,1))*TSIZE
+	    xres = real(GKI_MAXNDC)/ charwidth
+	    yres = real(GKI_MAXNDC)/ charheight
+	    z_scale = 1.0 / sqrt ( real(max(NSYMBOL, GKT_ZRES(g_kt))) )
+	    tx = GKT_TXAP(g_kt)
+	    call salloc(txsave, LEN_TX, TY_INT)
+	    call savetx(txsave,tx)
+	}
+
+	# Input arguments (ax, ay) refer to corners of put cell array;
+	# we need corners of the corresponding device array.
+
+	x1 = ax1
+	x2 = ax2
+	y1 = ay1
+	y2 = ay2
+	call adjust(x1,x2,xres)
+	call adjust(y1,y2,yres)
+
+	# Find out how many real pixels we have to fill
+	px1 = real(x1)/(GKI_MAXNDC+1)
+	py1 = real(y1)/(GKI_MAXNDC+1)
+	px2 = real(x2)/(GKI_MAXNDC+1)
+	py2 = real(y2)/(GKI_MAXNDC+1)
+
+	nx = int( px2 * xres ) - int( px1 * xres ) + 1
+	ny = int( py2 * yres ) - int( py1 * yres ) + 1
+
+	if ( ny > 1)
+	     delta_y = (real(y2) - real(y1))/ny
+	else {
+	     delta_y = 0.
+	}
+
+	# If too many data points in input, set skip.  If skip is close
+	# enough to one, set it to one.
+	# Set block replication factors - will be > 1.0 if too few input points.
+	# Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+	# enough points and so *some* have to be replicated.
+
+	if ( nc > nx ) {
+	    skip_x = real(nc)/nx
+	    if ( (skip_x - 1.0)*(nx-1) < 1.0 )
+		skip_x = 1.0
+	} else
+	    blockx = real(nx)/nc
+
+	if ( nr > ny ) {
+	    skip_y = real(nr)/ny
+	    if ( (skip_y - 1.0)*(ny-1) < 1.0 )
+		skip_y = 1.0
+	} else
+	    blocky = real(ny)/nr
+
+	# Allocate storage for a row of pixels.  This is quite inefficient
+	# if the x dimension of the cell array is small, but the metacode
+	# won't be too much bigger (?).
+	# need nx+1 in case nx odd ... pixels() wants to pad output.
+
+	call salloc ( cell, nx+1, TY_SHORT)
+	Mems[cell + nx] = 0
+
+	# Initialize counters
+
+	sy = skip_y
+	bcy = blocky
+	startrow = 1
+	element = startrow
+
+	# See if we can use original data ... no massaging
+	# also set the initial value of the new_row flag, which tells
+	# if we have to rebuild the row data
+	# Note that if blockx > 1.0, skip_x must be 1.0, and vv
+
+	if ( (skip_x == 1.0) && (blockx == 1.0) ) {
+	    use_orig = true
+	    new_row  = false
+	} else {
+	    use_orig = false
+	    new_row  = true
+	}
+
+	# If device can pixel replicate, use that feature where we can
+	if( pr) {
+	    if( (skip_x == 1.0) && ( int(blockx) == blockx) ) {
+		 xrep = int(blockx)
+		 use_orig = true
+		 nx = nc
+	    } else
+		 xrep = 1
+	    if( (skip_y == 1.0) && ( int(blocky) == blocky) ) {
+		 yrep = int(blocky)
+		 ny = 1
+	    } else
+		 yrep = 1
+	    call pixel0(1,0,xrep,0,1,yrep)
+	}
+
+	# Do it
+
+	for ( i = 1; i <= ny ; i = i + 1) {
+
+	    # Build the row data
+
+	    if ( !use_orig && new_row ) {
+		if ( skip_x == 1.0) {
+		    call blockit(m[element], Mems[cell], nx, blockx)
+		} else {
+	            sx = skip_x
+	            for ( j = 1; j <= nx; j = j + 1) {
+		        Mems[cell+j-1] = m[element]
+		        element = startrow + int(sx+0.5)
+		        sx = sx + skip_x
+	            }
+		}
+		if ( !ca )
+		    if ( use_orig)
+			call fakepc(m[element], Mems[cell], nx, z_scale)
+		    else
+			call fakepc(Mems[cell], Mems[cell], nx, z_scale)
+	    }
+
+	    # Send the row data.
+
+	    if ( ca ) {
+		y = y1 + ((i - 1)*delta_y + 0.5)
+	        if ( use_orig ) {
+		        call pixels( px1, real(y)/GKI_MAXNDC,
+			    nx, 1, m[element])
+	        } else {
+		        call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell])
+	        }
+	    }   
+	    else
+		call gkt_text( x1, y1+(i-1)*int(charheight), Mems[cell], nx)
+
+	    # Advance a row
+
+	    element = startrow
+	    if ( bcy <= real(i) ) {
+		startrow = 1 + nc * int(sy+0.5)
+		element = startrow
+		sy = sy + skip_y
+	        bcy = bcy + blocky
+		new_row = true
+	    } else {
+		new_row = false
+	    }
+	}
+
+	# All done, restore text parameters and release storage
+
+	if ( !ca )
+	    call restoretx (txsave,tx)
+	call sfree(sp)
+end
+
+# SAVETX --- save the current text parameters as pointed to by "txp"
+# in the area pointed to by "savep", and then set the necessary
+# defaults.
+
+procedure savetx (savep, txp)
+pointer savep, txp
+
+include "gkt.com"
+
+begin
+	# save old values
+
+	TX_UP(savep)	   = TX_UP(txp)
+	TX_SIZE(savep)	   = TX_SIZE(txp)
+	TX_PATH(savep)	   = TX_PATH(txp)
+	TX_HJUSTIFY(savep) = TX_HJUSTIFY(txp)
+	TX_VJUSTIFY(savep) = TX_VJUSTIFY(txp)
+	TX_FONT(savep)	   = TX_FONT(txp)
+	TX_COLOR(savep)	   = TX_COLOR(txp)
+	TX_SPACING(savep)  = TX_SPACING(txp)
+
+	# set new (default) ones
+
+	TX_UP(txp)	= 90
+	TX_SIZE(txp)	= GKI_PACKREAL(TSIZE)
+	TX_PATH(txp)	= GT_RIGHT
+	TX_HJUSTIFY(txp)= GT_LEFT
+	TX_VJUSTIFY(txp)= GT_BOTTOM
+	TX_FONT(txp)	= GT_ROMAN
+	TX_COLOR(txp)	= 1
+	TX_SPACING(txp)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+end
+
+# RESTORETX --- restore the text parameters from the save area
+
+procedure restoretx (savep, txp)
+pointer savep, txp
+
+include "gkt.com"
+
+begin
+	# Restore values
+
+	TX_UP(txp)	 = TX_UP(savep)
+	TX_SIZE(txp)	 = TX_SIZE(savep)
+	TX_PATH(txp)	 = TX_PATH(savep)
+	TX_HJUSTIFY(txp) = TX_HJUSTIFY(savep)
+	TX_VJUSTIFY(txp) = TX_VJUSTIFY(savep)
+	TX_FONT(txp)	 = TX_FONT(savep)
+	TX_COLOR(txp)	 = TX_COLOR(savep)
+	TX_SPACING(txp)  = TX_SPACING(savep)
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+end
+
+# FAKEPC --- fake putcell output by using appropriately chosen text
+# characters to make grey scale.
+
+procedure fakepc (indata, outdata, nx,  scale)
+int	nx			# number of points in row
+short	indata[ARB]		# input row data
+short	outdata[ARB]		# output row data
+real	scale			# intensity scaling factor
+
+include "gkt.com"
+
+int	i
+real	temp
+char	cdata[NSYMBOL]		# characters to represent intensity
+data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+
+begin
+	#
+	for ( i = 1 ; i <= nx ; i = i + 1 ) {
+	    temp = sqrt( max(0., real(indata[i])) )
+	    outdata[i] = cdata[ min( NSYMBOL, int(NSYMBOL*scale*temp)+1 ) ]
+	}
+end
+
+# BLOCKIT -- block replication of data
+
+procedure blockit( from, to, count, factor)
+
+short	from[ARB]			# input data
+short	to[ARB]				# output data
+int	count				# number of output pixels
+real	factor				# blocking factor
+
+int	i, j
+real	bc
+
+begin
+	bc = factor
+	j = 1
+	for ( i = 1; i <= count ; i = i + 1 ) {
+	    to[i] = from[j]
+	    if ( bc <= real(i) ) {
+		j = j + 1
+		bc = bc + factor
+	    }
+	}
+end
+
+# ADJUST -- round/truncate putcell array corners to device coordinates
+# move up lower bound if it is above center point of device cell,
+# move down upper bound if below.  Don't allow bounds to go beyond
+# resolution or below zero.  Do not allow bounds to cross.  Part of the
+# assumptions behind all this is that putcells will be continguous and
+# rows/columns must not be plotted twice.
+
+procedure adjust ( lower, upper, res)
+
+int	lower, upper
+real	res
+
+real	factor
+real	low, up
+
+begin
+	factor = res/(GKI_MAXNDC+1)
+	low = real(lower) * factor
+	up  = real(upper) * factor
+
+	# if boundaries result in same row, return
+	if ( int(low) == int(up) )
+	    return
+
+	# if low is in upper half of device pixel, round up
+	if ( (low - int(low)) >= 0.5 ) {
+	    low = int(low) + 1
+	    # don't go to or beyond upper bound
+	    if ( low < up ) {
+	        # ... 0.2 just for "rounding protection";
+		lower = (low + 0.2)/factor
+	        # if now reference same cell, return
+		if ( int(low) == int(up) )
+		    return
+	    }
+	}
+
+	# if "up" in bottom half of pixel, drop down one.  Note that
+	# due to two "==" tests above, upper will not drop below lower.
+	# 0.2 means drop partway down into pixel below; calling code will
+	# truncate.
+	if ( (up - int(up)) < 0.5 )
+	    upper = real(int(up) - 0.2)/factor
+end
diff --git a/sys/gio/nsppkern/gktpl.x b/sys/gio/nsppkern/gktpl.x
new file mode 100644
index 00000000..7e7243cf
--- /dev/null
+++ b/sys/gio/nsppkern/gktpl.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"gkt.h"
+
+# GKT_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure gkt_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	i, len_p
+int	x,y
+include	"gkt.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = GKT_PLAP(g_kt)
+
+	if (GKT_TYPE(g_kt) != PL_LTYPE(pl)) {
+	    call gkt_linetype (PL_LTYPE(pl))
+	    GKT_TYPE(g_kt) = PL_LTYPE(pl)
+	}
+	if (GKT_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5)
+		call optn (*"inten", *"low")
+	    else
+		call optn (*"inten", *"high")
+	    GKT_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (GKT_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call gkt_color (PL_COLOR(pl))
+	    GKT_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	# Transform the first point from GKI coords to nspp coords and
+	# move to the transformed point.
+
+	x = p[1]
+	y = p[2]
+	call frstpt(real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+
+	# Draw the polyline.
+
+	for (i=3;  i <= len_p;  i=i+2) {
+	    x = p[i]
+	    y = p[i+1]
+	    call vector (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	}
+end
diff --git a/sys/gio/nsppkern/gktplset.x b/sys/gio/nsppkern/gktplset.x
new file mode 100644
index 00000000..9342fccc
--- /dev/null
+++ b/sys/gio/nsppkern/gktplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure gkt_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"gkt.com"
+
+begin
+	pl = GKT_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/nsppkern/gktpm.x b/sys/gio/nsppkern/gktpm.x
new file mode 100644
index 00000000..fe6a9a0a
--- /dev/null
+++ b/sys/gio/nsppkern/gktpm.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"gkt.h"
+
+# Nspp particulars.
+define	BASELW		8	# base width of line
+
+
+# GKT_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure gkt_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"gkt.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = GKT_PMAP(g_kt)
+
+	if (GKT_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call gkt_linetype (PM_LTYPE(pm))
+	    GKT_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (GKT_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    if (GKI_UNPACKREAL(PM_WIDTH(pm)) < 1.5)
+		call optn (*"inten", *"low")
+	    else
+		call optn (*"inten", *"high")
+	    GKT_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (GKT_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call gkt_color (PM_COLOR(pm))
+	    GKT_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Get to start of marker.
+	call frstpt (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	oldx = 0; oldy = 0
+
+	# Draw the polymarker.
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx && y != oldy)
+		call point (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/nsppkern/gktpmset.x b/sys/gio/nsppkern/gktpmset.x
new file mode 100644
index 00000000..8a3ebe24
--- /dev/null
+++ b/sys/gio/nsppkern/gktpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_PMSET -- Set the polymarker attributes.
+
+procedure gkt_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"gkt.com"
+
+begin
+	pm = GKT_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/nsppkern/gktreset.x b/sys/gio/nsppkern/gktreset.x
new file mode 100644
index 00000000..6e34cec4
--- /dev/null
+++ b/sys/gio/nsppkern/gktreset.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"gkt.h"
+
+# GKT_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure gkt_reset()
+
+pointer	pl, pm, fa, tx
+include	"gkt.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = GKT_PLAP(g_kt)
+	pm = GKT_PMAP(g_kt)
+	fa = GKT_FAAP(g_kt)
+	tx = GKT_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+
+	# Reset the nspp common.
+
+	call z8zpii()
+
+	# If cellarray allowed, reset pixel size to standard one.
+
+	if (GKT_CELLARRAY(g_kt) != 0)
+	    call pixel0 (1,0,1,0,1,1)
+end
diff --git a/sys/gio/nsppkern/gkttx.x b/sys/gio/nsppkern/gkttx.x
new file mode 100644
index 00000000..7aaf3c31
--- /dev/null
+++ b/sys/gio/nsppkern/gkttx.x
@@ -0,0 +1,428 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"gkt.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# GKT_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure gkt_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen 
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment()
+include	"gkt.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = GKT_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by gkt_txset, and is just a scaling factor.
+
+	GKT_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != GKT_COLOR(g_kt)) {
+	    call gkt_color (TX_COLOR(tx))
+	    GKT_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line, and invalidate last setting.
+	call gkt_linetype (GL_SOLID)
+	GKT_TYPE(g_kt) = -1
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# For nspp, have 32767 sizes, so just scale the the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = GKT_CHARHEIGHT(g_kt,1) * tsz
+	cw = GKT_CHARWIDTH(g_kt,1) * tsz
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call gkt_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"gkt.com"
+
+begin
+	tx = GKT_TXAP(g_kt)
+
+	# Get character sizes in GKI(NSPP) coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = GKT_CHARHEIGHT(g_kt,1) * sz
+	cw = GKT_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/nsppkern/gkttxset.x b/sys/gio/nsppkern/gkttxset.x
new file mode 100644
index 00000000..28ed1d32
--- /dev/null
+++ b/sys/gio/nsppkern/gkttxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_TXSET -- Set the text drawing attributes.
+
+procedure gkt_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"gkt.com"
+
+begin
+	tx = GKT_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/nsppkern/mkpkg b/sys/gio/nsppkern/mkpkg
new file mode 100644
index 00000000..e9f92d6e
--- /dev/null
+++ b/sys/gio/nsppkern/mkpkg
@@ -0,0 +1,56 @@
+# Make the NSPPKERN GIO graphics kernel.  Requires LIBNSPP.  Requires
+# a host system metacode translation task for each device.
+
+$checkout libgkt.a lib$
+$update   libgkt.a
+$checkin  libgkt.a lib$
+$call     relink
+$exit
+
+update:					# update lib$x_nsppkern.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_nsppkern.e in local directory
+	$omake  writeb.x <mach.h> <error.h> gkt.h gkt.com
+	$omake  x_nsppkern.x
+	$link	x_nsppkern.o writeb.o -lgkt -lnspp
+	;
+
+install:				# install in system library
+	$move	x_nsppkern.e bin$
+	;
+
+libgkt.a:
+	gktcancel.x	gkt.com gkt.h <fset.h>
+	gktclear.x	gkt.com gkt.h <mach.h>
+	gktclose.x	gkt.com gkt.h
+	gktclws.x	gkt.h gkt.com
+	gktcolor.x	gkt.com gkt.h
+	gktdrawch.x	font.com font.h gkt.h <gki.h> <gset.h> <math.h>
+	gktescape.x	
+	gktfa.x		gkt.com gkt.h
+	gktfaset.x	gkt.com gkt.h <gki.h>
+	gktflush.x	gkt.com gkt.h
+	gktfont.x	gkt.com gkt.h <gki.h> <gset.h>
+	gktgcell.x	
+	gktinit.x	gkt.com gkt.h nspp.com <ctype.h> <gki.h> <mach.h>
+	gktline.x	gkt.com gkt.h <gset.h>
+	gktmfopen.x	gkt.h <fset.h> <knet.h> <mach.h>
+	gktopen.x	gkt.com gkt.h <gki.h>
+	gktopenws.x	gkt.com gkt.h nspp.com <error.h> <gki.h> <mach.h>
+	gktpcell.x	gkt.com gkt.h <gki.h> <gset.h>
+	gktpl.x		gkt.com gkt.h <gki.h>
+	gktplset.x	gkt.com gkt.h <gki.h>
+	gktpm.x		gkt.com gkt.h <gki.h>
+	gktpmset.x	gkt.com gkt.h <gki.h>
+	gktreset.x	gkt.com gkt.h <gset.h> <gki.h>
+	gkttx.x		gkt.com gkt.h <gki.h> <gset.h> <math.h>
+	gkttxset.x	gkt.com gkt.h <gki.h> <gset.h>
+	pixel0.f
+	pixels.f
+	t_nsppkern.x	<error.h> <gki.h>
+	tran16.f
+	writeb.x	gkt.h <error.h> <mach.h> gkt.com
+	;
diff --git a/sys/gio/nsppkern/nspp.com b/sys/gio/nsppkern/nspp.com
new file mode 100644
index 00000000..e3cac846
--- /dev/null
+++ b/sys/gio/nsppkern/nspp.com
@@ -0,0 +1,40 @@
+# NSPP.COM -- The nspp system plot package common block.
+
+int	mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab
+int	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb
+int	mx     ,my     ,mtypex ,mtypey 
+real	xxa    ,yya    , xxb    ,yyb    ,xxc    ,yyc
+real	xxd    ,yyd    , xfactr ,yfactr ,xadd   ,yadd
+real	xx     ,yy
+
+# XX declared integer some places in nspp code !!!
+# on a VAX this works, but what if float not same size as int ???
+
+int	mfmtx[3]       ,mfmty[3]       ,mumx   ,mumy
+int	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop[19]
+int	mname[19]      ,mxold  ,myold  ,mxmax  ,mymax
+int	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty
+int	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst
+int	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin
+int	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto
+int	mxysto ,mprint ,msybuf[360]    ,mncpw  ,minst
+int	mbufa  ,mbuflu ,mfwa[12]       ,mlwa[12]
+int	mipair ,mbprs[16]      ,mbufl  ,munit  ,mbswap
+
+real	small
+
+common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab,
+	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb,
+	mx     ,my     ,mtypex ,mtypey ,xxa    ,yya,
+	xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd,
+	xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy,
+	mfmtx  ,mfmty  ,mumx   ,mumy,
+	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop,
+	mname  ,mxold  ,myold  ,mxmax  ,mymax,
+	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty,
+	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst,
+	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin,
+	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto,
+	mxysto ,mprint ,msybuf ,mncpw  ,minst,
+	mbufa  ,mbuflu ,mfwa   ,mlwa,
+	mipair ,mbprs  ,mbufl  ,munit  ,mbswap ,small
diff --git a/sys/gio/nsppkern/pixel0.f b/sys/gio/nsppkern/pixel0.f
new file mode 100644
index 00000000..df42b150
--- /dev/null
+++ b/sys/gio/nsppkern/pixel0.f
@@ -0,0 +1,58 @@
+      subroutine pixel0(dx1,dy1,n1,dx2,dy2,n2)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      data ipixop / 10/
+      mbpair = ior(ishift(ior(192, ipixop), 8), 12)
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = dx1
+      yy = dy1
+      call dtran16
+      mx1 = mx
+      mbpair = mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      my1=my
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=n1
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = dx2
+      yy = dy2
+      call dtran16
+      mbpair=mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=n2
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if(n1*n2*(mx1*my-mx*my1) .ne. 0) return
+      call uliber(0,35h vectors not independent in pixel0.,35)
+      call perror
+      end
diff --git a/sys/gio/nsppkern/pixels.f b/sys/gio/nsppkern/pixels.f
new file mode 100644
index 00000000..a7b5e039
--- /dev/null
+++ b/sys/gio/nsppkern/pixels.f
@@ -0,0 +1,74 @@
+      subroutine pixels(x0,y0,ni,nj,inten)
+      integer*2 inten(1)
+c	assume inten is a linear array rather than 2-d.  This is a change
+c	from the original code.
+c	assume nj == 1
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      data ipixop / 10/
+      mbpair = ior(ishift(ior(192, ipixop + 1), 8), 8)
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x0
+      yy = y0
+      call tran16
+      mbpair = mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=ni
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=nj
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      nni = max0(1,(ni+iand(ni,1)))
+      nnj = max0(1,nj)
+      kmax=nni*nnj
+      k=0
+      do 200 j=1,nnj
+      do 100 i=1,nni
+      if(mod(k,254).ne.0) goto 90
+      mbpair = ior(ishift(ior(192, ipixop+2),8), min0(254,kmax-k))
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+   90 ik = iand ( i, 1)
+c
+c 14Nov85 mod so that arguments to ishift are of same type
+      itmp = inten(i)
+      mbpair = ior (ishift(iand(itmp,255),8*ik),mbpair)
+c     mbpair = ior (ishift(iand(inten(i),255),8*ik),mbpair)
+c
+      if ( ik .ne. 0 ) go to 95
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+   95 k = k + 1
+  100 continue
+  200 continue
+      return
+      end
diff --git a/sys/gio/nsppkern/t_nsppkern.x b/sys/gio/nsppkern/t_nsppkern.x
new file mode 100644
index 00000000..69a5ec27
--- /dev/null
+++ b/sys/gio/nsppkern/t_nsppkern.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# NSPPKERN -- Graphics kernel for the NCAR System Plot Package graphics
+# interface.
+
+procedure t_nsppkern()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Open the graphics kernel.
+	call gkt_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call gkt_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/tran16.f b/sys/gio/nsppkern/tran16.f
new file mode 100644
index 00000000..e0503d57
--- /dev/null
+++ b/sys/gio/nsppkern/tran16.f
@@ -0,0 +1,64 @@
+      subroutine tran16
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xx,yy
+c
+      logical         intt
+      equivalence     (zz,mz),(temp,itemp)
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = xx
+      mz = xx
+      if (intt(zz)) go to 102
+      if (mtypex .eq. 0) go to 101
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      mz = 2.0*(xfactr*alog10(zz)+xadd)
+      go to 103
+  101 mz = 2.0*(xfactr*zz+xadd)
+      go to 103
+  102 mz = ishift(mz,mshftx+1)
+  103 mx = max0(0,min0(65535,mz-1))
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = yy
+      mz = yy
+      if (intt(zz)) go to 105
+      if (mtypey .eq. 0) go to 104
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      mz = 2.0*(yfactr*alog10(zz)+yadd)
+      go to 106
+  104 mz = 2.0*(yfactr*zz+yadd)
+      go to 106
+  105 mz =ishift(mz,mshfty+1)
+  106 my = max0(0,min0(65535,mz-1))
+      return
+C
+      entry DTRAN16
+C
+      zz = xx
+      if(intt(zz) .or. (zz .eq. 0.0)) goto 203
+      mz = 2.0 * xfactr * zz
+  203 mx = max0(-127,min0(127,mz))
+      zz = yy
+      if(intt(zz) .or. (zz .eq. 0.0)) goto 206
+      mz = 2.0 * yfactr * zz
+  206 my = max0(-127,min0(127,mz))
+      return
+      end
diff --git a/sys/gio/nsppkern/writeb.x b/sys/gio/nsppkern/writeb.x
new file mode 100644
index 00000000..dfcd82bb
--- /dev/null
+++ b/sys/gio/nsppkern/writeb.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	"gkt.h"
+
+.help writeb
+.nf ___________________________________________________________________________
+WRITEB -- Write an NCAR metacode record.  Always write a full record
+regardless of the buffer length; any data beyond buflen is undefined.
+If the buffer length is passed as zero, the metafile standard wants us to
+write a full (zeroed) record and backspace over it, to signify end of
+metafile if the physical metafile is subsequently closed.  Instead of
+writing the EOF record here, we leave that to the FIO close routine
+for the graphics device.
+.endhelp ______________________________________________________________________
+
+procedure writeb (metacode_buffer, buflen, mbunit)
+
+int	metacode_buffer		# LOC pointer to metacode buffer
+int	buflen			# number of words of metacode data
+int	mbunit			# FIO file descriptor !! from nspp common !!
+
+int	dummy[1], offset
+int	loci()
+include "gkt.com"
+
+begin
+	if (buflen <= 0)
+	    return
+
+	# Standard NCAR pointer technique for accessing integer arrays.  This
+	# assumes alignment of integer variables.  Convert to use IRAF
+	# pointers if this causes problems.
+
+	offset = metacode_buffer - loci (dummy) + 1
+
+        iferr (call write (mbunit, dummy[offset], SZ_MFRECORD))
+	    call erract (EA_FATAL)
+end
diff --git a/sys/gio/nsppkern/x_nsppkern.x b/sys/gio/nsppkern/x_nsppkern.x
new file mode 100644
index 00000000..4b54cba2
--- /dev/null
+++ b/sys/gio/nsppkern/x_nsppkern.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	nsppkern = t_nsppkern
diff --git a/sys/gio/nsppkern/zzdebug.x b/sys/gio/nsppkern/zzdebug.x
new file mode 100644
index 00000000..b2ae6144
--- /dev/null
+++ b/sys/gio/nsppkern/zzdebug.x
@@ -0,0 +1,472 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+include	<gset.h>
+include	"font.h"
+
+define	XS	0.216
+define	XE	0.719
+define	YS	0.214
+define	YE	0.929
+
+task	grid	= t_grid,
+	grey	= t_grey,
+	text	= t_text, 
+	seefont = t_seefont,
+	txup	= t_txup,
+	font	= t_font,
+	efont	= t_efont
+
+
+# GRID -- Test program for graphics plotting.  A labelled grid is output.
+
+procedure t_grid ()
+
+pointer	gp
+bool	redir
+char	command[SZ_LINE], image[SZ_FNAME], word[SZ_LINE]
+char	output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int	cmd, input_fd, stat, fd
+
+pointer	gopen()
+bool	streq()
+int	fstati(), open(), getline(), sscan()
+
+begin
+	# If the input has been redirected, input is read from the named
+	# command file.  If not, each image name in the input template is
+	# plotted.
+	
+	if (fstati (STDIN, F_REDIR) == YES) {
+call eprintf ("Input has been redirected\n")
+	    redir = true
+	    cmd = open (STDIN, READ_ONLY, TEXT_FILE)
+	} 
+
+	# Loop over commands until EOF
+	repeat {
+	    if (redir) {
+		if (getline (STDIN, command, SZ_LINE) == EOF)
+		    break
+		stat = sscan (command)
+		    call gargwrd (word, SZ_LINE)
+		if (!streq (word, "plot")) {
+		    # Pixel window has been stored as WCS 2
+		    call gseti (gp, G_WCS, 2)
+		    call gscan (command)
+		    next
+		} else 
+		    call gargwrd (image)
+	    } 
+
+	    call clgstr ("output", output, SZ_FNAME)
+	    if (!streq (output, "")) {
+	        call strcpy (output, output_file, SZ_FNAME)
+	        fd = open (output_file, NEW_FILE, BINARY_FILE)
+	    } else
+		fd = open ("dev$crt", NEW_FILE, BINARY_FILE)
+
+	    call clgstr ("device", device, SZ_FNAME)
+	    gp = gopen (device, NEW_FILE, fd)
+		
+	    call gseti (gp, G_XDRAWGRID, 1)
+	    call gseti (gp, G_YDRAWGRID, 1)
+	    call gseti (gp, G_NMAJOR, 21)
+	    call glabax (gp, "TEST", "NDC_X", "NDC_Y")
+	    call gline (gp, XS, YS, XE, YS)
+	    call gline (gp, XE, YS, XE, YE)
+	    call gline (gp, XE, YE, XS, YE)
+	    call gline (gp, XS, YE, XS, YS)
+	    call gmark (gp, 0.5, 0.5, GM_CROSS, 3.0, 3.0)
+	    call gtext (gp, XS, YS-0.1, "DICOMED crtpict film area")
+	    call gclose  (gp)
+	    call close   (fd)
+	}
+
+	call clpcls (input_fd)
+end
+
+
+# GREY -- test code to generate grey scale on plotters
+
+procedure t_grey()
+
+pointer	gp
+real	size
+int	i, fd, count
+short	celldata[1024]
+char	output[SZ_FNAME], device[SZ_FNAME]
+
+pointer	gopen()
+real	clgetr()
+int	open(), clgeti()
+string	fmt "hj=c;vj=c"
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	size = clgetr ("size")
+		
+	call gsetr (gp, G_TXSIZE, size)
+	call gtext (gp, .5, .9, "! !\"#$%&'()*+,-./", fmt)
+	call gtext (gp, .5, .8, "1234567890", fmt)
+	call gtext (gp, .5, .7, "ABCDEFGHIJKLMNOPQR", fmt)
+	call gtext (gp, .5, .6, "STUVWXYZ[\\]^_`", fmt)
+	call gtext (gp, .5, .5, "abcdefghijklmnopqr", fmt)
+	call gtext (gp, .5, .4, "stuvwxyz{}|~", fmt)
+
+	call gtext (gp, .5, .1, "Grey Scale Test", fmt)
+
+	count = clgeti ( "count")
+	if (count > 1024)
+	    count = 1024
+	for (i=1;  i <= count;  i=i+1)
+	    celldata[i] = i - 1
+
+	call gpcell (gp, celldata, count, 1, 0.05, 0.2, .95, 0.3)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# TEXT -- Test character drawing.
+
+procedure t_text()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	call gsetr (gp, G_TXSIZE, 1.0)
+
+	call gtext (gp, .1, .1,
+	    "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+	call gtext (gp, .1, .2,
+	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+	call gtext (gp, .1, .3,
+	    "0123456789", "hj=l,vj=b")
+	call gtext (gp, .1, .4,
+	    " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+	call gsetr (gp, G_TXSIZE, 2.0)
+
+	call gtext (gp, .1, .5,
+	    "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+	call gtext (gp, .1, .6,
+	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+	call gtext (gp, .1, .7,
+	    "0123456789", "hj=l,vj=b")
+	call gtext (gp, .1, .8,
+	    " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# SEEFONT definitions.
+define	L	.40
+define	R	.60
+define	U	.75
+define	D	.25
+define	W	(R-L)
+define	H	(U-D)
+
+
+# SEEFONT -- Draw a character from the font table.
+
+procedure t_seefont()
+
+char	ch
+pointer	gp
+real	x, y
+int	wcs, key
+char	strval[SZ_FNAME]
+
+pointer	gopen()
+int	clgcur()
+
+begin
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+	call gline (gp, L, D, R, D)
+	call gline (gp, R, D, R, U)
+	call gline (gp, R, U, L, U)
+	call gline (gp, L, U, L, D)
+
+	ch = 'A'
+	call gdrwch (gp, L, D, ch, W, H)
+
+	while (clgcur ("gcur", x, y, wcs, key, strval, SZ_FNAME) != EOF) {
+	    call gclear (gp)
+
+	    call gline (gp, L, D, R, D)
+	    call gline (gp, R, D, R, U)
+	    call gline (gp, R, U, L, U)
+	    call gline (gp, L, U, L, D)
+
+	    ch = key
+	    call gdrwch (gp, L, D, ch, W, H)
+	}
+
+	call gclose (gp)
+end
+
+
+# GDRWCH -- Draw a character of the given size and orientation at the given
+# position.
+
+procedure gdrwch (gp, x, y, ch, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x, y			# lower left NDC coords of character
+char	ch			# character to be drawn
+real	xsize, ysize		# size of character in NDC units
+
+real	px, py
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+common	/font/ chridx, chrtab
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    px = x + ((px + FONT_LEFT)   / FONT_WIDTH)  * xsize
+	    py = y + ((py + FONT_BOTTOM) / FONT_HEIGHT) * ysize
+
+	    if (pen == 0)
+		call gamove (gp, px, py)
+	    else
+		call gadraw (gp, px, py)
+	}
+end
+
+
+# TXUP -- Draw text strings with various character up vectors and paths.
+
+procedure t_txup()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+char	text[SZ_LINE]
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	call clgstr ("text", text, SZ_LINE)
+
+	call gseti (gp, G_TXHJUSTIFY, clgeti("hjustify"))
+	call gseti (gp, G_TXVJUSTIFY, clgeti("vjustify"))
+
+	call gmark (gp, .1, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .1, .2, text, "up=0,path=right")
+	# --
+	call gmark (gp, .2, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .2, .2, text, "up=45,path=right")
+	# --
+	call gmark (gp, .3, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .3, .2, text, "up=90,path=right")
+	# --
+	call gmark (gp, .4, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .4, .2, text, "up=135,path=right")
+	# --
+	call gmark (gp, .5, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .5, .2, text, "up=180,path=right")
+
+	call gmark (gp, .1, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .1, .4, text, "up=90,path=left")
+	# --
+	call gmark (gp, .2, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .2, .4, text, "up=90,path=right")
+	# --
+	call gmark (gp, .3, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .3, .4, text, "up=90,path=up")
+	# --
+	call gmark (gp, .4, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .4, .4, text, "up=90,path=down")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# FONT -- Test the font change escapes.
+
+procedure t_font()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+char	text[SZ_LINE], format[SZ_FNAME]
+int	fd, i, open()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	do i = 2, 8, 2 {
+	    call clgstr ("text", text, SZ_LINE)
+	    call clgstr ("format", format, SZ_FNAME)
+	    call gtext (gp, .2, i / 10.0, text, format)
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# EFONT -- Font editor.
+
+procedure t_efont()
+
+char	cmd[SZ_LINE]
+real	scale
+int	pen, x, y, nw, w1, w2, ch, fcn
+int	ip, i, tab1, tab2, stroke, junk
+
+int	bitupk(), ctoi(), ctor(), getline()
+short	chridx[96], chrtab[800]
+common	/font/ chridx, chrtab
+define	decode_ 91
+
+begin
+	repeat {
+	    # Get command.
+	    call clgstr ("cmd", cmd, SZ_FNAME)
+	    if (cmd[1] == 'q')
+		break
+
+	    # Decode function and integer arguments (range of words).
+	    # Format "fcn [scale] ch w1 w2".
+
+	    fcn = cmd[1]
+	    ip = 2
+
+	    scale = 0
+	    if (fcn == 'x' || fcn == 'y') 
+		if (ctor (cmd, ip, scale) <= 0)
+		    scale = 1.0
+
+	    while (IS_WHITE(cmd[ip]))
+		ip = ip + 1
+
+	    ch = cmd[ip]
+	    ip = ip + 1
+
+	    if (ctoi (cmd, ip, w1) < 0)
+		w1 = 1
+	    if (ctoi (cmd, ip, w2) < 0)
+		w2 = w1
+
+	    if (ch < CHARACTER_START || ch > CHARACTER_END)
+		next
+	    else
+		i = ch  - CHARACTER_START + 1
+
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+
+	    nw = tab2 - tab1 + 1
+	    w1 = max(1, min(nw, w1))
+	    w2 = max(1, min(nw, w2))
+
+call eprintf ("fcn=%c [%g], ch=%c, tab1=%d, tab2=%d, nw=%d, w1=%d, w2=%d\n")
+call pargi(fcn); call pargr (scale);
+call pargi(ch); call pargi(tab1); call pargi(tab2)
+call pargi(nw); call pargi(w1); call pargi(w2)
+
+	    # Functions:
+	    #
+	    #	w	write codes
+	    #	r	read and encode
+	    #   x	scale in X
+	    #   y       scale in Y
+
+	    do i = w1-1+tab1, w2-1+tab1 {
+		stroke = chrtab[i]
+		x   = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+		y   = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+		pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+		switch (fcn) {
+		case 'w':
+decode_		    call eprintf ("%2d %6d (%6o) %d %3d %3d\n")
+			call pargi (i - tab1 + 1)
+			call pargi (stroke)
+			call pargi (stroke)
+			call pargi (pen)
+			call pargi (x)
+			call pargi (y)
+		    next
+
+		case 'r':
+		    junk = getline (STDIN, cmd)
+		    ip = 1
+		    junk = ctoi (cmd, ip, pen)
+		    junk = ctoi (cmd, ip, x)
+		    junk = ctoi (cmd, ip, y)
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		case 'x':
+		    x = x * scale
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		case 'y':
+		    y = (y - FONT_BASE) * scale + FONT_BASE
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		default:
+		    call eprintf ("unknown function code\n")
+		}
+	    }
+	}
+end
diff --git a/sys/gio/sgikern/README b/sys/gio/sgikern/README
new file mode 100644
index 00000000..e944a4be
--- /dev/null
+++ b/sys/gio/sgikern/README
@@ -0,0 +1,12 @@
+SGIKERN -
+
+This directory contains the source for the simple GIO kernel, used to write
+a metacode file using only the simplest possible drawing instructions.  This
+makes it relatively easy to implement functional (but probably suboptimal)
+translators for new devices.
+
+Special graphcap entries used by this kernel:
+
+	MF		maximum frame count per metafile
+	FS		frame advance req'd at start of metafile
+	FE		frame advance req'd at end of metafile
diff --git a/sys/gio/sgikern/font.com b/sys/gio/sgikern/font.com
new file mode 100644
index 00000000..c26af8d6
--- /dev/null
+++ b/sys/gio/sgikern/font.com
@@ -0,0 +1,746 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   chridx[97]	# character index in chrtab
+short   chrwid[97]	# character width table
+short   chrtab[3363]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (chridx(i), i=001,005) /    1,    3,   32,   49,   58/
+data    (chridx(i), i=006,010) /  110,  140,  207,  228,  253/
+data    (chridx(i), i=011,015) /  278,  309,  322,  343,  350/
+data    (chridx(i), i=016,020) /  365,  372,  418,  438,  494/
+data    (chridx(i), i=021,025) /  563,  583,  632,  696,  733/
+data    (chridx(i), i=026,030) /  803,  867,  896,  931,  935/
+data    (chridx(i), i=031,035) /  948,  952,  999, 1052, 1077/
+data    (chridx(i), i=036,040) / 1139, 1174, 1223, 1281, 1330/
+data    (chridx(i), i=041,045) / 1381, 1436, 1463, 1500, 1547/
+data    (chridx(i), i=046,050) / 1583, 1626, 1653, 1703, 1748/
+data    (chridx(i), i=051,055) / 1818, 1881, 1923, 1962, 1997/
+data    (chridx(i), i=056,060) / 2021, 2060, 2097, 2131, 2160/
+data    (chridx(i), i=061,065) / 2169, 2172, 2181, 2190, 2193/
+data    (chridx(i), i=066,070) / 2214, 2263, 2303, 2335, 2378/
+data    (chridx(i), i=071,075) / 2415, 2447, 2527, 2575, 2606/
+data    (chridx(i), i=076,080) / 2640, 2682, 2704, 2778, 2826/
+data    (chridx(i), i=081,085) / 2868, 2916, 2961, 2994, 3033/
+data    (chridx(i), i=086,090) / 3052, 3086, 3108, 3140, 3173/
+data    (chridx(i), i=091,095) / 3204, 3233, 3271, 3274, 3312/
+data    (chridx(i), i=096,096) / 3335/
+
+
+# Width data.
+
+data    (chrwid(i), i=001,005) /   21,   16,   23,   26,   25/
+data    (chrwid(i), i=006,010) /   29,   31,   16,   19,   19/
+data    (chrwid(i), i=011,015) /   21,   30,   16,   30,   16/
+data    (chrwid(i), i=016,020) /   28,   25,   25,   25,   25/
+data    (chrwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (chrwid(i), i=026,030) /   25,   16,   16,   29,   30/
+data    (chrwid(i), i=031,035) /   29,   24,   32,   25,   27/
+data    (chrwid(i), i=036,040) /   26,   27,   26,   25,   28/
+data    (chrwid(i), i=041,045) /   29,   17,   21,   27,   23/
+data    (chrwid(i), i=046,050) /   31,   29,   27,   27,   27/
+data    (chrwid(i), i=051,055) /   27,   25,   25,   29,   25/
+data    (chrwid(i), i=056,060) /   29,   25,   27,   25,   19/
+data    (chrwid(i), i=061,065) /   19,   19,   21,   21,   16/
+data    (chrwid(i), i=066,070) /   25,   26,   24,   26,   24/
+data    (chrwid(i), i=071,075) /   19,   24,   28,   17,   18/
+data    (chrwid(i), i=076,080) /   27,   17,   32,   28,   25/
+data    (chrwid(i), i=081,085) /   26,   25,   22,   22,   20/
+data    (chrwid(i), i=086,090) /   28,   23,   29,   25,   24/
+data    (chrwid(i), i=091,095) /   23,   19,   13,   19,   29/
+data    (chrwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (chrtab(i), i=0001,0005) /    35,     0,   220,  4251,  4249/
+data    (chrtab(i), i=0006,0010) /  4305,   220,  4302,  4366,   220/
+data    (chrtab(i), i=0011,0015) /  4380,  4366,   284,  4443,  4441/
+data    (chrtab(i), i=0016,0020) /  4369,   202,  4233,  4232,  4295/
+data    (chrtab(i), i=0021,0025) /  4359,  4424,  4425,  4362,  4298/
+data    (chrtab(i), i=0026,0030) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0031,0035) /     0,   220,  4251,  4245,   219/
+data    (chrtab(i), i=0036,0040) /  4245,   220,  4379,  4245,   796/
+data    (chrtab(i), i=0041,0045) /  4827,  4821,   795,  4821,   796/
+data    (chrtab(i), i=0046,0050) /  4955,  4821,     0,   604,  4224/
+data    (chrtab(i), i=0051,0055) /   988,  4608,   145,  5137,    75/
+data    (chrtab(i), i=0056,0060) /  5067,     0,   416,  4483,   672/
+data    (chrtab(i), i=0061,0065) /  4739,   919,  5016,  4952,  4950/
+data    (chrtab(i), i=0066,0070) /  5078,  5080,  5018,  4955,  4764/
+data    (chrtab(i), i=0071,0075) /  4508,  4315,  4185,  4182,  4244/
+data    (chrtab(i), i=0076,0080) /  4434,  4816,  4943,  5005,  5002/
+data    (chrtab(i), i=0081,0085) /  4936,   150,  4308,  4435,  4817/
+data    (chrtab(i), i=0086,0090) /  4944,  5006,   219,  4249,  4247/
+data    (chrtab(i), i=0091,0095) /  4309,  4436,  4818,  5008,  5070/
+data    (chrtab(i), i=0096,0100) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0101,0105) /  4296,  4233,  4171,  4173,  4301/
+data    (chrtab(i), i=0106,0110) /  4299,  4235,  4236,     0,  1244/
+data    (chrtab(i), i=0111,0115) /  4167,   412,  4634,  4632,  4566/
+data    (chrtab(i), i=0116,0120) /  4437,  4309,  4183,  4185,  4251/
+data    (chrtab(i), i=0121,0125) /  4380,  4508,  4635,  4826,  5018/
+data    (chrtab(i), i=0126,0130) /  5211,  5340,   974,  4941,  4875/
+data    (chrtab(i), i=0131,0135) /  4873,  4999,  5127,  5256,  5322/
+data    (chrtab(i), i=0136,0140) /  5324,  5198,  5070,     0,  1299/
+data    (chrtab(i), i=0141,0145) /  5396,  5332,  5330,  5458,  5460/
+data    (chrtab(i), i=0146,0150) /  5397,  5333,  5268,  5202,  5069/
+data    (chrtab(i), i=0151,0155) /  4938,  4808,  4679,  4423,  4296/
+data    (chrtab(i), i=0156,0160) /  4234,  4237,  4303,  4691,  4821/
+data    (chrtab(i), i=0161,0165) /  4887,  4889,  4827,  4700,  4571/
+data    (chrtab(i), i=0166,0170) /  4505,  4502,  4563,  4688,  4939/
+data    (chrtab(i), i=0171,0175) /  5128,  5255,  5383,  5449,  5450/
+data    (chrtab(i), i=0176,0180) /   264,  4298,  4301,  4367,  4432/
+data    (chrtab(i), i=0181,0185) /   725,  4889,   791,  4827,   475/
+data    (chrtab(i), i=0186,0190) /  4503,   468,  4689,  4940,  5129/
+data    (chrtab(i), i=0191,0195) /  5256,   455,  4424,  4362,  4365/
+data    (chrtab(i), i=0196,0200) /  4431,  4691,   409,  4565,  4753/
+data    (chrtab(i), i=0201,0205) /  5004,  5193,  5320,  5384,  5449/
+data    (chrtab(i), i=0206,0210) /     0,   346,  4377,  4313,  4250/
+data    (chrtab(i), i=0211,0215) /  4251,  4316,  4380,  4443,  4440/
+data    (chrtab(i), i=0216,0220) /  4374,  4245,   219,  4314,  4378/
+data    (chrtab(i), i=0221,0225) /  4379,  4315,   281,  4440,   346/
+data    (chrtab(i), i=0226,0230) /  4374,     0,   544,  4510,  4379/
+data    (chrtab(i), i=0231,0235) /  4247,  4178,  4174,  4233,  4357/
+data    (chrtab(i), i=0236,0240) /  4482,  4608,   282,  4311,  4243/
+data    (chrtab(i), i=0241,0245) /  4237,  4297,  4358,   414,  4444/
+data    (chrtab(i), i=0246,0250) /  4377,  4307,  4301,  4359,  4420/
+data    (chrtab(i), i=0251,0255) /  4482,     0,   160,  4382,  4507/
+data    (chrtab(i), i=0256,0260) /  4631,  4690,  4686,  4617,  4485/
+data    (chrtab(i), i=0261,0265) /  4354,  4224,   410,  4567,  4627/
+data    (chrtab(i), i=0266,0270) /  4621,  4553,  4486,   286,  4444/
+data    (chrtab(i), i=0271,0275) /  4505,  4563,  4557,  4487,  4420/
+data    (chrtab(i), i=0276,0280) /  4354,     0,   412,  4443,  4561/
+data    (chrtab(i), i=0281,0285) /  4496,   412,  4496,   412,  4571/
+data    (chrtab(i), i=0286,0290) /  4433,  4496,    89,  4249,  4755/
+data    (chrtab(i), i=0291,0295) /  4819,    89,  4819,    89,  4184/
+data    (chrtab(i), i=0296,0300) /  4820,  4819,   729,  4761,  4243/
+data    (chrtab(i), i=0301,0305) /  4179,   729,  4179,   729,  4824/
+data    (chrtab(i), i=0306,0310) /  4180,  4179,     0,   665,  4744/
+data    (chrtab(i), i=0311,0315) /  4808,   665,  4825,  4808,   145/
+data    (chrtab(i), i=0316,0320) /  5329,  5328,   145,  4240,  5328/
+data    (chrtab(i), i=0321,0325) /     0,   328,  4359,  4295,  4232/
+data    (chrtab(i), i=0326,0330) /  4233,  4298,  4362,  4425,  4422/
+data    (chrtab(i), i=0331,0335) /  4356,  4227,   201,  4296,  4360/
+data    (chrtab(i), i=0336,0340) /  4361,  4297,   263,  4422,   328/
+data    (chrtab(i), i=0341,0345) /  4356,     0,   145,  5329,  5328/
+data    (chrtab(i), i=0346,0350) /   145,  4240,  5328,     0,   202/
+data    (chrtab(i), i=0351,0355) /  4233,  4232,  4295,  4359,  4424/
+data    (chrtab(i), i=0356,0360) /  4425,  4362,  4298,   201,  4296/
+data    (chrtab(i), i=0361,0365) /  4360,  4361,  4297,     0,  1184/
+data    (chrtab(i), i=0366,0370) /  4096,  4160,  1184,  5344,  4160/
+data    (chrtab(i), i=0371,0375) /     0,   476,  4379,  4248,  4179/
+data    (chrtab(i), i=0376,0380) /  4176,  4235,  4360,  4551,  4679/
+data    (chrtab(i), i=0381,0385) /  4872,  5003,  5072,  5075,  5016/
+data    (chrtab(i), i=0386,0390) /  4891,  4700,  4572,   282,  4312/
+data    (chrtab(i), i=0391,0395) /  4244,  4239,  4299,  4361,   777/
+data    (chrtab(i), i=0396,0400) /  4939,  5007,  5012,  4952,  4890/
+data    (chrtab(i), i=0401,0405) /   476,  4443,  4377,  4308,  4303/
+data    (chrtab(i), i=0406,0410) /  4362,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=0411,0415) /  4874,  4943,  4948,  4889,  4827/
+data    (chrtab(i), i=0416,0420) /  4700,     0,   474,  4551,   538/
+data    (chrtab(i), i=0421,0425) /  4616,   604,  4679,   604,  4505/
+data    (chrtab(i), i=0426,0430) /  4376,   199,  4935,   456,  4423/
+data    (chrtab(i), i=0431,0435) /   457,  4487,   585,  4743,   584/
+data    (chrtab(i), i=0436,0440) /  4807,     0,   152,  4247,  4311/
+data    (chrtab(i), i=0441,0445) /  4312,  4248,   153,  4313,  4376/
+data    (chrtab(i), i=0446,0450) /  4375,  4310,  4246,  4183,  4184/
+data    (chrtab(i), i=0451,0455) /  4250,  4315,  4508,  4764,  4955/
+data    (chrtab(i), i=0456,0460) /  5018,  5080,  5078,  5012,  4818/
+data    (chrtab(i), i=0461,0465) /  4496,  4367,  4237,  4170,  4167/
+data    (chrtab(i), i=0466,0470) /   858,  5016,  5014,  4948,   668/
+data    (chrtab(i), i=0471,0475) /  4891,  4952,  4950,  4884,  4754/
+data    (chrtab(i), i=0476,0480) /  4496,    73,  4234,  4362,  4681/
+data    (chrtab(i), i=0481,0485) /  4937,  5066,   266,  4680,  4936/
+data    (chrtab(i), i=0486,0490) /  5001,   266,  4679,  4935,  5000/
+data    (chrtab(i), i=0491,0495) /  5066,  5068,     0,   152,  4247/
+data    (chrtab(i), i=0496,0500) /  4311,  4312,  4248,   153,  4313/
+data    (chrtab(i), i=0501,0505) /  4376,  4375,  4310,  4246,  4183/
+data    (chrtab(i), i=0506,0510) /  4184,  4250,  4315,  4508,  4764/
+data    (chrtab(i), i=0511,0515) /  4955,  5017,  5014,  4948,  4755/
+data    (chrtab(i), i=0516,0520) /   795,  4953,  4950,  4884,   604/
+data    (chrtab(i), i=0521,0525) /  4827,  4889,  4886,  4820,  4691/
+data    (chrtab(i), i=0526,0530) /   467,  4755,  4882,  5008,  5070/
+data    (chrtab(i), i=0531,0535) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0536,0540) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0541,0545) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0546,0550) /   848,  5006,  5003,  4937,   595/
+data    (chrtab(i), i=0551,0555) /  4818,  4881,  4942,  4939,  4872/
+data    (chrtab(i), i=0556,0560) /  4743,   140,  4235,  4299,  4300/
+data    (chrtab(i), i=0561,0565) /  4236,     0,   601,  4679,   666/
+data    (chrtab(i), i=0566,0570) /  4744,   732,  4807,   732,  4109/
+data    (chrtab(i), i=0571,0575) /  5133,   391,  4999,   584,  4551/
+data    (chrtab(i), i=0576,0580) /   585,  4615,   713,  4871,   712/
+data    (chrtab(i), i=0581,0585) /  4935,     0,   220,  4178,  4308/
+data    (chrtab(i), i=0586,0590) /  4501,  4693,  4884,  5010,  5071/
+data    (chrtab(i), i=0591,0595) /  5069,  5002,  4872,  4679,  4487/
+data    (chrtab(i), i=0596,0600) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0601,0605) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0606,0610) /   850,  5008,  5004,  4938,   597/
+data    (chrtab(i), i=0611,0615) /  4820,  4883,  4944,  4940,  4873/
+data    (chrtab(i), i=0616,0620) /  4808,  4679,   140,  4235,  4299/
+data    (chrtab(i), i=0621,0625) /  4300,  4236,   220,  4956,   219/
+data    (chrtab(i), i=0626,0630) /  4827,   218,  4570,  4827,  4956/
+data    (chrtab(i), i=0631,0635) /     0,   793,  4888,  4952,  4953/
+data    (chrtab(i), i=0636,0640) /  4889,   858,  4890,  4825,  4824/
+data    (chrtab(i), i=0641,0645) /  4887,  4951,  5016,  5017,  4955/
+data    (chrtab(i), i=0646,0650) /  4828,  4636,  4443,  4313,  4247/
+data    (chrtab(i), i=0651,0655) /  4179,  4173,  4234,  4360,  4551/
+data    (chrtab(i), i=0656,0660) /  4679,  4872,  5002,  5069,  5070/
+data    (chrtab(i), i=0661,0665) /  5009,  4883,  4692,  4564,  4435/
+data    (chrtab(i), i=0666,0670) /  4370,  4304,   281,  4311,  4243/
+data    (chrtab(i), i=0671,0675) /  4237,  4298,  4361,   842,  5004/
+data    (chrtab(i), i=0676,0680) /  5007,  4945,   540,  4507,  4442/
+data    (chrtab(i), i=0681,0685) /  4376,  4308,  4301,  4362,  4424/
+data    (chrtab(i), i=0686,0690) /  4551,   583,  4808,  4873,  4940/
+data    (chrtab(i), i=0691,0695) /  4943,  4882,  4819,  4692,     0/
+data    (chrtab(i), i=0696,0700) /    92,  4182,   988,  5081,  5014/
+data    (chrtab(i), i=0701,0705) /  4753,  4687,  4619,  4615,   592/
+data    (chrtab(i), i=0706,0710) /  4622,  4555,  4551,   918,  4689/
+data    (chrtab(i), i=0711,0715) /  4558,  4491,  4487,  4615,    88/
+data    (chrtab(i), i=0716,0720) /  4250,  4380,  4508,  4825,  4953/
+data    (chrtab(i), i=0721,0725) /  5018,  5084,   218,  4379,  4507/
+data    (chrtab(i), i=0726,0730) /  4634,    88,  4249,  4378,  4506/
+data    (chrtab(i), i=0731,0735) /  4825,     0,   412,  4315,  4249/
+data    (chrtab(i), i=0736,0740) /  4246,  4308,  4499,  4755,  4948/
+data    (chrtab(i), i=0741,0745) /  5014,  5017,  4955,  4764,  4508/
+data    (chrtab(i), i=0746,0750) /   283,  4313,  4310,  4372,   788/
+data    (chrtab(i), i=0751,0755) /  4950,  4953,  4891,   412,  4443/
+data    (chrtab(i), i=0756,0760) /  4377,  4374,  4436,  4499,   659/
+data    (chrtab(i), i=0761,0765) /  4820,  4886,  4889,  4827,  4764/
+data    (chrtab(i), i=0766,0770) /   403,  4306,  4241,  4175,  4171/
+data    (chrtab(i), i=0771,0775) /  4233,  4296,  4487,  4743,  4936/
+data    (chrtab(i), i=0776,0780) /  5001,  5067,  5071,  5009,  4946/
+data    (chrtab(i), i=0781,0785) /  4755,   209,  4239,  4235,  4297/
+data    (chrtab(i), i=0786,0790) /   841,  5003,  5007,  4945,   403/
+data    (chrtab(i), i=0791,0795) /  4370,  4303,  4299,  4360,  4487/
+data    (chrtab(i), i=0796,0800) /   647,  4872,  4939,  4943,  4882/
+data    (chrtab(i), i=0801,0805) /  4755,     0,   203,  4298,  4362/
+data    (chrtab(i), i=0806,0810) /  4363,  4299,   851,  4881,  4816/
+data    (chrtab(i), i=0811,0815) /  4687,  4559,  4368,  4242,  4181/
+data    (chrtab(i), i=0816,0820) /  4182,  4249,  4379,  4572,  4700/
+data    (chrtab(i), i=0821,0825) /  4891,  5017,  5078,  5072,  5004/
+data    (chrtab(i), i=0826,0830) /  4938,  4808,  4615,  4423,  4296/
+data    (chrtab(i), i=0831,0835) /  4234,  4235,  4300,  4364,  4427/
+data    (chrtab(i), i=0836,0840) /  4426,  4361,  4297,   210,  4244/
+data    (chrtab(i), i=0841,0845) /  4247,  4313,   794,  4953,  5014/
+data    (chrtab(i), i=0846,0850) /  5008,  4940,  4874,   463,  4432/
+data    (chrtab(i), i=0851,0855) /  4369,  4308,  4311,  4378,  4443/
+data    (chrtab(i), i=0856,0860) /  4572,   604,  4827,  4889,  4950/
+data    (chrtab(i), i=0861,0865) /  4943,  4875,  4809,  4744,  4615/
+data    (chrtab(i), i=0866,0870) /     0,   213,  4244,  4243,  4306/
+data    (chrtab(i), i=0871,0875) /  4370,  4435,  4436,  4373,  4309/
+data    (chrtab(i), i=0876,0880) /   212,  4307,  4371,  4372,  4308/
+data    (chrtab(i), i=0881,0885) /   202,  4233,  4232,  4295,  4359/
+data    (chrtab(i), i=0886,0890) /  4424,  4425,  4362,  4298,   201/
+data    (chrtab(i), i=0891,0895) /  4296,  4360,  4361,  4297,     0/
+data    (chrtab(i), i=0896,0900) /   213,  4244,  4243,  4306,  4370/
+data    (chrtab(i), i=0901,0905) /  4435,  4436,  4373,  4309,   212/
+data    (chrtab(i), i=0906,0910) /  4307,  4371,  4372,  4308,   328/
+data    (chrtab(i), i=0911,0915) /  4359,  4295,  4232,  4233,  4298/
+data    (chrtab(i), i=0916,0920) /  4362,  4425,  4422,  4356,  4227/
+data    (chrtab(i), i=0921,0925) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0926,0930) /   263,  4422,   328,  4356,     0/
+data    (chrtab(i), i=0931,0935) /  1177,  4240,  5255,     0,   149/
+data    (chrtab(i), i=0936,0940) /  5333,  5332,   149,  4244,  5332/
+data    (chrtab(i), i=0941,0945) /   141,  5325,  5324,   141,  4236/
+data    (chrtab(i), i=0946,0950) /  5324,     0,   153,  5264,  4231/
+data    (chrtab(i), i=0951,0955) /     0,   151,  4248,  4312,  4310/
+data    (chrtab(i), i=0956,0960) /  4182,  4184,  4250,  4315,  4444/
+data    (chrtab(i), i=0961,0965) /  4700,  4891,  4954,  5016,  5014/
+data    (chrtab(i), i=0966,0970) /  4948,  4883,  4625,   794,  4953/
+data    (chrtab(i), i=0971,0975) /  4949,  4884,   604,  4827,  4889/
+data    (chrtab(i), i=0976,0980) /  4885,  4819,  4754,   465,  4558/
+data    (chrtab(i), i=0981,0985) /  4622,  4625,  4561,   458,  4489/
+data    (chrtab(i), i=0986,0990) /  4488,  4551,  4615,  4680,  4681/
+data    (chrtab(i), i=0991,0995) /  4618,  4554,   457,  4552,  4616/
+data    (chrtab(i), i=0996,1000) /  4617,  4553,     0,  1044,  5078/
+data    (chrtab(i), i=1001,1005) /  4951,  4759,  4630,  4565,  4498/
+data    (chrtab(i), i=1006,1010) /  4495,  4557,  4684,  4876,  5005/
+data    (chrtab(i), i=1011,1015) /  5071,   663,  4629,  4562,  4559/
+data    (chrtab(i), i=1016,1020) /  4621,  4684,  1047,  5071,  5069/
+data    (chrtab(i), i=1021,1025) /  5196,  5324,  5454,  5521,  5523/
+data    (chrtab(i), i=1026,1030) /  5462,  5400,  5274,  5147,  4956/
+data    (chrtab(i), i=1031,1035) /  4764,  4571,  4442,  4312,  4246/
+data    (chrtab(i), i=1036,1040) /  4179,  4176,  4237,  4299,  4425/
+data    (chrtab(i), i=1041,1045) /  4552,  4743,  4935,  5128,  5257/
+data    (chrtab(i), i=1046,1050) /  5322,  1111,  5135,  5133,  5196/
+data    (chrtab(i), i=1051,1055) /     0,   540,  4168,   473,  4935/
+data    (chrtab(i), i=1056,1060) /   537,  4999,   540,  5063,   205/
+data    (chrtab(i), i=1061,1065) /  4877,     7,  4423,   647,  5191/
+data    (chrtab(i), i=1066,1070) /    72,  4103,    72,  4295,   840/
+data    (chrtab(i), i=1071,1075) /  4807,   841,  4871,   905,  5127/
+data    (chrtab(i), i=1076,1080) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1081,1085) /   348,  4423,    28,  4892,  5083/
+data    (chrtab(i), i=1086,1090) /  5146,  5208,  5206,  5140,  5075/
+data    (chrtab(i), i=1091,1095) /  4882,   986,  5144,  5142,  5076/
+data    (chrtab(i), i=1096,1100) /   796,  5019,  5081,  5077,  5011/
+data    (chrtab(i), i=1101,1105) /  4882,   338,  4882,  5073,  5136/
+data    (chrtab(i), i=1106,1110) /  5198,  5195,  5129,  5064,  4871/
+data    (chrtab(i), i=1111,1115) /  4103,   976,  5134,  5131,  5065/
+data    (chrtab(i), i=1116,1120) /   786,  5009,  5071,  5066,  5000/
+data    (chrtab(i), i=1121,1125) /  4871,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1126,1130) /   412,  4442,   476,  4443,   200/
+data    (chrtab(i), i=1131,1135) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=1136,1140) /   328,  4551,     0,   985,  5148/
+data    (chrtab(i), i=1141,1145) /  5142,  5081,  4955,  4828,  4636/
+data    (chrtab(i), i=1146,1150) /  4443,  4313,  4247,  4180,  4175/
+data    (chrtab(i), i=1151,1155) /  4236,  4298,  4424,  4615,  4807/
+data    (chrtab(i), i=1156,1160) /  4936,  5066,  5132,   281,  4311/
+data    (chrtab(i), i=1161,1165) /  4244,  4239,  4300,  4362,   540/
+data    (chrtab(i), i=1166,1170) /  4507,  4376,  4308,  4303,  4363/
+data    (chrtab(i), i=1171,1175) /  4488,  4615,     0,   220,  4295/
+data    (chrtab(i), i=1176,1180) /   283,  4360,   348,  4423,    28/
+data    (chrtab(i), i=1181,1185) /  4764,  4955,  5081,  5143,  5204/
+data    (chrtab(i), i=1186,1190) /  5199,  5132,  5066,  4936,  4743/
+data    (chrtab(i), i=1191,1195) /  4103,   921,  5079,  5140,  5135/
+data    (chrtab(i), i=1196,1200) /  5068,  5002,   668,  4891,  5016/
+data    (chrtab(i), i=1201,1205) /  5076,  5071,  5003,  4872,  4743/
+data    (chrtab(i), i=1206,1210) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1211,1215) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1216,1220) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1221,1225) /  4551,     0,   220,  4295,   283/
+data    (chrtab(i), i=1226,1230) /  4360,   348,  4423,    28,  5148/
+data    (chrtab(i), i=1231,1235) /  5142,   338,  4818,   726,  4814/
+data    (chrtab(i), i=1236,1240) /     7,  5127,  5133,    92,  4315/
+data    (chrtab(i), i=1241,1245) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1246,1250) /  4443,   732,  5147,   860,  5146/
+data    (chrtab(i), i=1251,1255) /   924,  5145,   988,  5142,   726/
+data    (chrtab(i), i=1256,1260) /  4754,  4814,   724,  4690,  4816/
+data    (chrtab(i), i=1261,1265) /   723,  4562,  4817,   200,  4167/
+data    (chrtab(i), i=1266,1270) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1271,1275) /  4551,   711,  5128,   839,  5129/
+data    (chrtab(i), i=1276,1280) /   903,  5130,   967,  5133,     0/
+data    (chrtab(i), i=1281,1285) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1286,1290) /  4423,    28,  5148,  5142,   338/
+data    (chrtab(i), i=1291,1295) /  4818,   726,  4814,     7,  4615/
+data    (chrtab(i), i=1296,1300) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1301,1305) /  4442,   476,  4443,   732,  5147/
+data    (chrtab(i), i=1306,1310) /   860,  5146,   924,  5145,   988/
+data    (chrtab(i), i=1311,1315) /  5142,   726,  4754,  4814,   724/
+data    (chrtab(i), i=1316,1320) /  4690,  4816,   723,  4562,  4817/
+data    (chrtab(i), i=1321,1325) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1326,1330) /  4487,   328,  4551,     0,   985/
+data    (chrtab(i), i=1331,1335) /  5148,  5142,  5081,  4955,  4828/
+data    (chrtab(i), i=1336,1340) /  4636,  4443,  4313,  4247,  4180/
+data    (chrtab(i), i=1341,1345) /  4175,  4236,  4298,  4424,  4615/
+data    (chrtab(i), i=1346,1350) /  4807,  4936,  5064,  5127,  5135/
+data    (chrtab(i), i=1351,1355) /   281,  4311,  4244,  4239,  4300/
+data    (chrtab(i), i=1356,1360) /  4362,   540,  4507,  4376,  4308/
+data    (chrtab(i), i=1361,1365) /  4303,  4363,  4488,  4615,   974/
+data    (chrtab(i), i=1366,1370) /  5065,   911,  5001,  4936,   719/
+data    (chrtab(i), i=1371,1375) /  5327,   783,  5006,   847,  5005/
+data    (chrtab(i), i=1376,1380) /  1103,  5133,  1167,  5134,     0/
+data    (chrtab(i), i=1381,1385) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1386,1390) /  4423,   988,  5063,  1051,  5128/
+data    (chrtab(i), i=1391,1395) /  1116,  5191,    28,  4636,   796/
+data    (chrtab(i), i=1396,1400) /  5404,   338,  5074,     7,  4615/
+data    (chrtab(i), i=1401,1405) /   775,  5383,    92,  4315,   156/
+data    (chrtab(i), i=1406,1410) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1411,1415) /   860,  5083,   924,  5082,  1180/
+data    (chrtab(i), i=1416,1420) /  5210,  1244,  5211,   200,  4167/
+data    (chrtab(i), i=1421,1425) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1426,1430) /  4551,   968,  4935,   969,  4999/
+data    (chrtab(i), i=1431,1435) /  1097,  5255,  1096,  5319,     0/
+data    (chrtab(i), i=1436,1440) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1441,1445) /  4423,    28,  4636,     7,  4615/
+data    (chrtab(i), i=1446,1450) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1451,1455) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1456,1460) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1461,1465) /  4551,     0,   476,  4555,  4488/
+data    (chrtab(i), i=1466,1470) /  4423,   539,  4619,  4552,   604/
+data    (chrtab(i), i=1471,1475) /  4683,  4616,  4423,  4295,  4168/
+data    (chrtab(i), i=1476,1480) /  4106,  4108,  4173,  4237,  4300/
+data    (chrtab(i), i=1481,1485) /  4299,  4234,  4170,    76,  4171/
+data    (chrtab(i), i=1486,1490) /  4235,  4236,  4172,   284,  4892/
+data    (chrtab(i), i=1491,1495) /   348,  4571,   412,  4570,   668/
+data    (chrtab(i), i=1496,1500) /  4698,   732,  4699,     0,   220/
+data    (chrtab(i), i=1501,1505) /  4295,   283,  4360,   348,  4423/
+data    (chrtab(i), i=1506,1510) /  1051,  4432,   530,  5063,   594/
+data    (chrtab(i), i=1511,1515) /  5127,   596,  5191,    28,  4636/
+data    (chrtab(i), i=1516,1520) /   860,  5340,     7,  4615,   775/
+data    (chrtab(i), i=1521,1525) /  5319,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1526,1530) /   412,  4442,   476,  4443,   988/
+data    (chrtab(i), i=1531,1535) /  5147,  1180,  5147,   200,  4167/
+data    (chrtab(i), i=1536,1540) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1541,1545) /  4551,   969,  4935,   969,  5255/
+data    (chrtab(i), i=1546,1550) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1551,1555) /   348,  4423,    28,  4636,     7/
+data    (chrtab(i), i=1556,1560) /  5063,  5069,    92,  4315,   156/
+data    (chrtab(i), i=1561,1565) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1566,1570) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1571,1575) /  4487,   328,  4551,   647,  5064/
+data    (chrtab(i), i=1576,1580) /   775,  5065,   839,  5066,   903/
+data    (chrtab(i), i=1581,1585) /  5069,     0,   220,  4296,   220/
+data    (chrtab(i), i=1586,1590) /  4743,   284,  4746,   348,  4810/
+data    (chrtab(i), i=1591,1595) /  1116,  4743,  1116,  5191,  1179/
+data    (chrtab(i), i=1596,1600) /  5256,  1244,  5319,    28,  4444/
+data    (chrtab(i), i=1601,1605) /  1116,  5532,     7,  4487,   903/
+data    (chrtab(i), i=1606,1610) /  5511,    92,  4315,  1308,  5338/
+data    (chrtab(i), i=1611,1615) /  1372,  5339,   200,  4167,   200/
+data    (chrtab(i), i=1616,1620) /  4423,  1096,  5063,  1097,  5127/
+data    (chrtab(i), i=1621,1625) /  1225,  5383,  1224,  5447,     0/
+data    (chrtab(i), i=1626,1630) /   220,  4296,   220,  5191,   284/
+data    (chrtab(i), i=1631,1635) /  5130,   348,  5194,  1115,  5191/
+data    (chrtab(i), i=1636,1640) /    28,  4444,   924,  5404,     7/
+data    (chrtab(i), i=1641,1645) /  4487,    92,  4315,   988,  5211/
+data    (chrtab(i), i=1646,1650) /  1244,  5211,   200,  4167,   200/
+data    (chrtab(i), i=1651,1655) /  4423,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1656,1660) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1661,1665) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1666,1670) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1671,1675) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1676,1680) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1681,1685) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1686,1690) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1691,1695) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1696,1700) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1701,1705) /  4764,     0,   220,  4295,   283/
+data    (chrtab(i), i=1706,1710) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1711,1715) /  5083,  5146,  5208,  5205,  5139/
+data    (chrtab(i), i=1716,1720) /  5074,  4881,  4433,   986,  5144/
+data    (chrtab(i), i=1721,1725) /  5141,  5075,   796,  5019,  5081/
+data    (chrtab(i), i=1726,1730) /  5076,  5010,  4881,     7,  4615/
+data    (chrtab(i), i=1731,1735) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1736,1740) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1741,1745) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1746,1750) /  4551,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1751,1755) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1756,1760) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1761,1765) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1766,1770) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1771,1775) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1776,1780) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1781,1785) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1786,1790) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1791,1795) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1796,1800) /  4764,   330,  4492,  4621,  4685/
+data    (chrtab(i), i=1801,1805) /  4812,  4874,  4932,  4994,  5122/
+data    (chrtab(i), i=1806,1810) /  5188,  5190,   838,  4996,  5059/
+data    (chrtab(i), i=1811,1815) /  5123,   778,  4997,  5060,  5124/
+data    (chrtab(i), i=1816,1820) /  5189,     0,   220,  4295,   283/
+data    (chrtab(i), i=1821,1825) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1826,1830) /  5083,  5146,  5208,  5206,  5140/
+data    (chrtab(i), i=1831,1835) /  5075,  4882,  4434,   986,  5144/
+data    (chrtab(i), i=1836,1840) /  5142,  5076,   796,  5019,  5081/
+data    (chrtab(i), i=1841,1845) /  5077,  5011,  4882,   594,  4817/
+data    (chrtab(i), i=1846,1850) /  4879,  5001,  5063,  5191,  5257/
+data    (chrtab(i), i=1851,1855) /  5259,   907,  5065,  5128,  5192/
+data    (chrtab(i), i=1856,1860) /   721,  4880,  5066,  5129,  5193/
+data    (chrtab(i), i=1861,1865) /  5258,     7,  4615,    92,  4315/
+data    (chrtab(i), i=1866,1870) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1871,1875) /  4443,   200,  4167,   201,  4231/
+data    (chrtab(i), i=1876,1880) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=1881,1885) /   921,  5084,  5078,  5017,  4891/
+data    (chrtab(i), i=1886,1890) /  4700,  4508,  4315,  4185,  4182/
+data    (chrtab(i), i=1891,1895) /  4244,  4434,  4816,  4943,  5005/
+data    (chrtab(i), i=1896,1900) /  5002,  4936,   150,  4308,  4435/
+data    (chrtab(i), i=1901,1905) /  4817,  4944,  5006,   219,  4249/
+data    (chrtab(i), i=1906,1910) /  4247,  4309,  4436,  4818,  5008/
+data    (chrtab(i), i=1911,1915) /  5070,  5067,  5001,  4936,  4743/
+data    (chrtab(i), i=1916,1920) /  4551,  4360,  4234,  4173,  4167/
+data    (chrtab(i), i=1921,1925) /  4234,     0,    28,  4118,   476/
+data    (chrtab(i), i=1926,1930) /  4551,   539,  4616,   604,  4679/
+data    (chrtab(i), i=1931,1935) /  1052,  5142,    28,  5148,   263/
+data    (chrtab(i), i=1936,1940) /  4871,    92,  4118,   156,  4121/
+data    (chrtab(i), i=1941,1945) /   220,  4122,   348,  4123,   732/
+data    (chrtab(i), i=1946,1950) /  5147,   860,  5146,   924,  5145/
+data    (chrtab(i), i=1951,1955) /   988,  5142,   456,  4423,   457/
+data    (chrtab(i), i=1956,1960) /  4487,   585,  4743,   584,  4807/
+data    (chrtab(i), i=1961,1965) /     0,   220,  4301,  4362,  4488/
+data    (chrtab(i), i=1966,1970) /  4679,  4807,  5000,  5130,  5197/
+data    (chrtab(i), i=1971,1975) /  5211,   283,  4364,  4426,   348/
+data    (chrtab(i), i=1976,1980) /  4428,  4489,  4552,  4679,    28/
+data    (chrtab(i), i=1981,1985) /  4636,   924,  5404,    92,  4315/
+data    (chrtab(i), i=1986,1990) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1991,1995) /  4443,   988,  5211,  1244,  5211/
+data    (chrtab(i), i=1996,2000) /     0,    92,  4615,   156,  4618/
+data    (chrtab(i), i=2001,2005) /  4615,   220,  4682,   987,  4615/
+data    (chrtab(i), i=2006,2010) /    28,  4508,   732,  5212,    28/
+data    (chrtab(i), i=2011,2015) /  4250,   284,  4314,   348,  4315/
+data    (chrtab(i), i=2016,2020) /   860,  5083,  1052,  5083,     0/
+data    (chrtab(i), i=2021,2025) /   156,  4487,   220,  4492,  4487/
+data    (chrtab(i), i=2026,2030) /   284,  4556,   668,  4556,  4487/
+data    (chrtab(i), i=2031,2035) /   668,  4999,   732,  5004,  4999/
+data    (chrtab(i), i=2036,2040) /   796,  5068,  1179,  5068,  4999/
+data    (chrtab(i), i=2041,2045) /    28,  4572,   668,  4892,   988/
+data    (chrtab(i), i=2046,2050) /  5468,    28,  4315,    92,  4314/
+data    (chrtab(i), i=2051,2055) /   348,  4378,   412,  4379,  1052/
+data    (chrtab(i), i=2056,2060) /  5275,  1308,  5275,     0,    92/
+data    (chrtab(i), i=2061,2065) /  4935,   156,  4999,   220,  5063/
+data    (chrtab(i), i=2066,2070) /   923,  4232,    28,  4508,   732/
+data    (chrtab(i), i=2071,2075) /  5212,     7,  4423,   647,  5191/
+data    (chrtab(i), i=2076,2080) /    28,  4314,   284,  4314,   348/
+data    (chrtab(i), i=2081,2085) /  4315,   796,  5019,  1052,  5019/
+data    (chrtab(i), i=2086,2090) /   136,  4103,   136,  4359,   840/
+data    (chrtab(i), i=2091,2095) /  4807,   841,  4871,   841,  5127/
+data    (chrtab(i), i=2096,2100) /     0,    92,  4625,  4615,   156/
+data    (chrtab(i), i=2101,2105) /  4689,  4680,   220,  4753,  4743/
+data    (chrtab(i), i=2106,2110) /  1051,  4753,    28,  4508,   860/
+data    (chrtab(i), i=2111,2115) /  5340,   327,  4935,    28,  4251/
+data    (chrtab(i), i=2116,2120) /   348,  4315,   924,  5147,  1180/
+data    (chrtab(i), i=2121,2125) /  5147,   520,  4487,   521,  4551/
+data    (chrtab(i), i=2126,2130) /   649,  4807,   648,  4871,     0/
+data    (chrtab(i), i=2131,2135) /   988,  4188,  4182,   860,  4167/
+data    (chrtab(i), i=2136,2140) /   924,  4231,   988,  4295,    71/
+data    (chrtab(i), i=2141,2145) /  5063,  5069,   156,  4182,   220/
+data    (chrtab(i), i=2146,2150) /  4185,   284,  4186,   412,  4187/
+data    (chrtab(i), i=2151,2155) /   647,  5064,   775,  5065,   839/
+data    (chrtab(i), i=2156,2160) /  5066,   903,  5069,     0,   160/
+data    (chrtab(i), i=2161,2165) /  4224,   224,  4288,   160,  4704/
+data    (chrtab(i), i=2166,2170) /   128,  4672,     0,    28,  4868/
+data    (chrtab(i), i=2171,2175) /     0,   480,  4544,   544,  4608/
+data    (chrtab(i), i=2176,2180) /    96,  4640,    64,  4608,     0/
+data    (chrtab(i), i=2181,2185) /   278,  4505,  4630,    83,  4504/
+data    (chrtab(i), i=2186,2190) /  4819,   408,  4487,     0,     5/
+data    (chrtab(i), i=2191,2195) /  4997,     0,   348,  4315,  4249/
+data    (chrtab(i), i=2196,2200) /  4246,  4309,  4373,  4438,  4439/
+data    (chrtab(i), i=2201,2205) /  4376,  4312,  4247,   215,  4310/
+data    (chrtab(i), i=2206,2210) /  4374,  4375,  4311,   219,  4247/
+data    (chrtab(i), i=2211,2215) /   153,  4312,     0,   210,  4307/
+data    (chrtab(i), i=2216,2220) /  4371,  4369,  4241,  4243,  4308/
+data    (chrtab(i), i=2221,2225) /  4437,  4693,  4820,  4883,  4945/
+data    (chrtab(i), i=2226,2230) /  4938,  5000,  5063,   723,  4881/
+data    (chrtab(i), i=2231,2235) /  4874,  4936,   597,  4756,  4818/
+data    (chrtab(i), i=2236,2240) /  4810,  4872,  5063,  5127,   720/
+data    (chrtab(i), i=2241,2245) /  4751,  4430,  4237,  4171,  4170/
+data    (chrtab(i), i=2246,2250) /  4232,  4423,  4615,  4744,  4810/
+data    (chrtab(i), i=2251,2255) /   205,  4235,  4234,  4296,   655/
+data    (chrtab(i), i=2256,2260) /  4494,  4365,  4299,  4298,  4360/
+data    (chrtab(i), i=2261,2265) /  4423,     0,   220,  4295,  4360/
+data    (chrtab(i), i=2266,2270) /  4488,   283,  4361,    28,  4444/
+data    (chrtab(i), i=2271,2275) /  4424,   338,  4500,  4629,  4757/
+data    (chrtab(i), i=2276,2280) /  4948,  5074,  5135,  5133,  5066/
+data    (chrtab(i), i=2281,2285) /  4936,  4743,  4615,  4488,  4426/
+data    (chrtab(i), i=2286,2290) /   914,  5072,  5068,  5002,   661/
+data    (chrtab(i), i=2291,2295) /  4884,  4947,  5008,  5004,  4937/
+data    (chrtab(i), i=2296,2300) /  4872,  4743,    92,  4315,   156/
+data    (chrtab(i), i=2301,2305) /  4314,     0,   849,  4946,  4882/
+data    (chrtab(i), i=2306,2310) /  4880,  5008,  5010,  4884,  4757/
+data    (chrtab(i), i=2311,2315) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2316,2320) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2321,2325) /  5002,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2326,2330) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2331,2335) /  4361,  4424,  4551,     0,   796/
+data    (chrtab(i), i=2336,2340) /  4871,  5191,   859,  4936,   604/
+data    (chrtab(i), i=2341,2345) /  5020,  4999,   786,  4820,  4693/
+data    (chrtab(i), i=2346,2350) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2351,2355) /  4234,  4360,  4551,  4679,  4808/
+data    (chrtab(i), i=2356,2360) /  4874,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2361,2365) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2366,2370) /  4361,  4424,  4551,   668,  4891/
+data    (chrtab(i), i=2371,2375) /   732,  4890,   905,  5063,   904/
+data    (chrtab(i), i=2376,2380) /  5127,     0,   207,  5007,  5009/
+data    (chrtab(i), i=2381,2385) /  4947,  4884,  4693,  4565,  4372/
+data    (chrtab(i), i=2386,2390) /  4242,  4175,  4173,  4234,  4360/
+data    (chrtab(i), i=2391,2395) /  4551,  4679,  4872,  5002,   848/
+data    (chrtab(i), i=2396,2400) /  4945,  4883,   210,  4240,  4236/
+data    (chrtab(i), i=2401,2405) /  4298,   783,  4882,  4820,  4693/
+data    (chrtab(i), i=2406,2410) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2411,2415) /  4361,  4424,  4551,     0,   666/
+data    (chrtab(i), i=2416,2420) /  4763,  4699,  4697,  4825,  4827/
+data    (chrtab(i), i=2421,2425) /  4764,  4572,  4443,  4378,  4311/
+data    (chrtab(i), i=2426,2430) /  4295,   346,  4375,  4360,   476/
+data    (chrtab(i), i=2431,2435) /  4507,  4441,  4423,    21,  4693/
+data    (chrtab(i), i=2436,2440) /     7,  4615,   200,  4167,   201/
+data    (chrtab(i), i=2441,2445) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2446,2450) /     0,   852,  5011,  5076,  5013/
+data    (chrtab(i), i=2451,2455) /  4949,  4820,  4755,   405,  4372/
+data    (chrtab(i), i=2456,2460) /  4307,  4241,  4239,  4301,  4364/
+data    (chrtab(i), i=2461,2465) /  4491,  4619,  4748,  4813,  4879/
+data    (chrtab(i), i=2466,2470) /  4881,  4819,  4756,  4629,  4501/
+data    (chrtab(i), i=2471,2475) /   275,  4305,  4303,  4365,   653/
+data    (chrtab(i), i=2476,2480) /  4815,  4817,  4755,   405,  4436/
+data    (chrtab(i), i=2481,2485) /  4370,  4366,  4428,  4491,   523/
+data    (chrtab(i), i=2486,2490) /  4684,  4750,  4754,  4692,  4629/
+data    (chrtab(i), i=2491,2495) /   205,  4236,  4170,  4169,  4231/
+data    (chrtab(i), i=2496,2500) /  4294,  4485,  4741,  4932,  4995/
+data    (chrtab(i), i=2501,2505) /   199,  4486,  4742,  4933,    73/
+data    (chrtab(i), i=2506,2510) /  4232,  4423,  4743,  4934,  4996/
+data    (chrtab(i), i=2511,2515) /  4995,  4929,  4736,  4352,  4161/
+data    (chrtab(i), i=2516,2520) /  4099,  4100,  4166,  4359,   256/
+data    (chrtab(i), i=2521,2525) /  4225,  4163,  4164,  4230,  4359/
+data    (chrtab(i), i=2526,2530) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2531,2535) /    28,  4444,  4423,   337,  4499/
+data    (chrtab(i), i=2536,2540) /  4564,  4693,  4885,  5012,  5075/
+data    (chrtab(i), i=2541,2545) /  5136,  5127,   915,  5072,  5064/
+data    (chrtab(i), i=2546,2550) /   789,  4948,  5009,  4999,     7/
+data    (chrtab(i), i=2551,2555) /  4615,   711,  5319,    92,  4315/
+data    (chrtab(i), i=2556,2560) /   156,  4314,   200,  4167,   201/
+data    (chrtab(i), i=2561,2565) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2566,2570) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2571,2575) /  5191,  1032,  5255,     0,   220/
+data    (chrtab(i), i=2576,2580) /  4314,  4442,  4444,  4316,   284/
+data    (chrtab(i), i=2581,2585) /  4378,   219,  4443,   213,  4295/
+data    (chrtab(i), i=2586,2590) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2591,2595) /     7,  4615,    85,  4308,   149/
+data    (chrtab(i), i=2596,2600) /  4307,   200,  4167,   201,  4231/
+data    (chrtab(i), i=2601,2605) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=2606,2610) /   348,  4442,  4570,  4572,  4444/
+data    (chrtab(i), i=2611,2615) /   412,  4506,   347,  4571,   341/
+data    (chrtab(i), i=2616,2620) /  4420,  4353,  4288,   404,  4485/
+data    (chrtab(i), i=2621,2625) /  4418,   149,  4565,  4549,  4482/
+data    (chrtab(i), i=2626,2630) /  4417,  4288,  4096,  4097,  4099/
+data    (chrtab(i), i=2631,2635) /  4163,  4161,  4097,  4098,   213/
+data    (chrtab(i), i=2636,2640) /  4436,   277,  4435,     0,   220/
+data    (chrtab(i), i=2641,2645) /  4295,   283,  4360,    28,  4444/
+data    (chrtab(i), i=2646,2650) /  4423,   916,  4427,   591,  5127/
+data    (chrtab(i), i=2651,2655) /   590,  5063,   526,  4999,   725/
+data    (chrtab(i), i=2656,2660) /  5269,     7,  4615,   711,  5255/
+data    (chrtab(i), i=2661,2665) /    92,  4315,   156,  4314,   789/
+data    (chrtab(i), i=2666,2670) /  5012,  1109,  5012,   200,  4167/
+data    (chrtab(i), i=2671,2675) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2676,2680) /  4551,   905,  4871,   841,  5191/
+data    (chrtab(i), i=2681,2685) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2686,2690) /    28,  4444,  4423,     7,  4615/
+data    (chrtab(i), i=2691,2695) /    92,  4315,   156,  4314,   200/
+data    (chrtab(i), i=2696,2700) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2701,2705) /   328,  4551,     0,   213,  4295/
+data    (chrtab(i), i=2706,2710) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2711,2715) /   337,  4499,  4564,  4693,  4885/
+data    (chrtab(i), i=2716,2720) /  5012,  5075,  5136,  5127,   915/
+data    (chrtab(i), i=2721,2725) /  5072,  5064,   789,  4948,  5009/
+data    (chrtab(i), i=2726,2730) /  4999,  1041,  5203,  5268,  5397/
+data    (chrtab(i), i=2731,2735) /  5589,  5716,  5779,  5840,  5831/
+data    (chrtab(i), i=2736,2740) /  1619,  5776,  5768,  1493,  5652/
+data    (chrtab(i), i=2741,2745) /  5713,  5703,     7,  4615,   711/
+data    (chrtab(i), i=2746,2750) /  5319,  1415,  6023,    85,  4308/
+data    (chrtab(i), i=2751,2755) /   149,  4307,   200,  4167,   201/
+data    (chrtab(i), i=2756,2760) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2761,2765) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2766,2770) /  5191,  1032,  5255,  1608,  5575/
+data    (chrtab(i), i=2771,2775) /  1609,  5639,  1737,  5895,  1736/
+data    (chrtab(i), i=2776,2780) /  5959,     0,   213,  4295,   276/
+data    (chrtab(i), i=2781,2785) /  4360,    21,  4437,  4423,   337/
+data    (chrtab(i), i=2786,2790) /  4499,  4564,  4693,  4885,  5012/
+data    (chrtab(i), i=2791,2795) /  5075,  5136,  5127,   915,  5072/
+data    (chrtab(i), i=2796,2800) /  5064,   789,  4948,  5009,  4999/
+data    (chrtab(i), i=2801,2805) /     7,  4615,   711,  5319,    85/
+data    (chrtab(i), i=2806,2810) /  4308,   149,  4307,   200,  4167/
+data    (chrtab(i), i=2811,2815) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2816,2820) /  4551,   904,  4871,   905,  4935/
+data    (chrtab(i), i=2821,2825) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=2826,2830) /   469,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2831,2835) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2836,2840) /  5002,  5069,  5071,  5010,  4884/
+data    (chrtab(i), i=2841,2845) /  4693,  4565,   210,  4240,  4236/
+data    (chrtab(i), i=2846,2850) /  4298,   842,  5004,  5008,  4946/
+data    (chrtab(i), i=2851,2855) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2856,2860) /  4361,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=2861,2865) /  4873,  4940,  4944,  4883,  4820/
+data    (chrtab(i), i=2866,2870) /  4693,     0,   213,  4288,   276/
+data    (chrtab(i), i=2871,2875) /  4353,    21,  4437,  4416,   338/
+data    (chrtab(i), i=2876,2880) /  4500,  4629,  4757,  4948,  5074/
+data    (chrtab(i), i=2881,2885) /  5135,  5133,  5066,  4936,  4743/
+data    (chrtab(i), i=2886,2890) /  4615,  4488,  4426,   914,  5072/
+data    (chrtab(i), i=2891,2895) /  5068,  5002,   661,  4884,  4947/
+data    (chrtab(i), i=2896,2900) /  5008,  5004,  4937,  4872,  4743/
+data    (chrtab(i), i=2901,2905) /     0,  4608,    85,  4308,   149/
+data    (chrtab(i), i=2906,2910) /  4307,   193,  4160,   194,  4224/
+data    (chrtab(i), i=2911,2915) /   322,  4480,   321,  4544,     0/
+data    (chrtab(i), i=2916,2920) /   788,  4864,   851,  4929,   724/
+data    (chrtab(i), i=2921,2925) /  4948,  5013,  4992,   786,  4820/
+data    (chrtab(i), i=2926,2930) /  4693,  4565,  4372,  4242,  4175/
+data    (chrtab(i), i=2931,2935) /  4173,  4234,  4360,  4551,  4679/
+data    (chrtab(i), i=2936,2940) /  4808,  4874,   210,  4240,  4236/
+data    (chrtab(i), i=2941,2945) /  4298,   469,  4436,  4371,  4304/
+data    (chrtab(i), i=2946,2950) /  4300,  4361,  4424,  4551,   576/
+data    (chrtab(i), i=2951,2955) /  5184,   769,  4736,   770,  4800/
+data    (chrtab(i), i=2956,2960) /   898,  5056,   897,  5120,     0/
+data    (chrtab(i), i=2961,2965) /   213,  4295,   276,  4360,    21/
+data    (chrtab(i), i=2966,2970) /  4437,  4423,   787,  4884,  4820/
+data    (chrtab(i), i=2971,2975) /  4818,  4946,  4948,  4885,  4757/
+data    (chrtab(i), i=2976,2980) /  4628,  4498,  4431,     7,  4615/
+data    (chrtab(i), i=2981,2985) /    85,  4308,   149,  4307,   200/
+data    (chrtab(i), i=2986,2990) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2991,2995) /   328,  4551,     0,   723,  4885/
+data    (chrtab(i), i=2996,3000) /  4881,  4819,  4756,  4629,  4373/
+data    (chrtab(i), i=3001,3005) /  4244,  4179,  4177,  4239,  4366/
+data    (chrtab(i), i=3006,3010) /  4685,  4812,  4873,   148,  4177/
+data    (chrtab(i), i=3011,3015) /   144,  4367,  4686,  4813,   780/
+data    (chrtab(i), i=3016,3020) /  4808,    83,  4241,  4368,  4687/
+data    (chrtab(i), i=3021,3025) /  4814,  4876,  4873,  4808,  4679/
+data    (chrtab(i), i=3026,3030) /  4423,  4296,  4233,  4171,  4167/
+data    (chrtab(i), i=3031,3035) /  4233,     0,   218,  4300,  4361/
+data    (chrtab(i), i=3036,3040) /  4424,  4551,  4679,  4808,  4874/
+data    (chrtab(i), i=3041,3045) /   282,  4363,  4425,   218,  4444/
+data    (chrtab(i), i=3046,3050) /  4427,  4488,  4551,    21,  4693/
+data    (chrtab(i), i=3051,3055) /     0,   213,  4300,  4361,  4424/
+data    (chrtab(i), i=3056,3060) /  4551,  4743,  4872,  4937,  5003/
+data    (chrtab(i), i=3061,3065) /   276,  4363,  4425,    21,  4437/
+data    (chrtab(i), i=3066,3070) /  4427,  4488,  4551,   917,  4999/
+data    (chrtab(i), i=3071,3075) /  5319,   980,  5064,   725,  5141/
+data    (chrtab(i), i=3076,3080) /  5127,    85,  4308,   149,  4307/
+data    (chrtab(i), i=3081,3085) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=3086,3090) /    85,  4551,   149,  4553,   213/
+data    (chrtab(i), i=3091,3095) /  4617,   852,  4617,  4551,    21/
+data    (chrtab(i), i=3096,3100) /  4501,   597,  5077,    21,  4307/
+data    (chrtab(i), i=3101,3105) /   341,  4308,   725,  4948,   917/
+data    (chrtab(i), i=3106,3110) /  4948,     0,   149,  4487,   213/
+data    (chrtab(i), i=3111,3115) /  4490,   277,  4554,   661,  4554/
+data    (chrtab(i), i=3116,3120) /  4487,   661,  4999,   725,  5002/
+data    (chrtab(i), i=3121,3125) /   661,  4885,  5066,  1172,  5066/
+data    (chrtab(i), i=3126,3130) /  4999,    21,  4565,   981,  5461/
+data    (chrtab(i), i=3131,3135) /    21,  4308,   405,  4372,  1045/
+data    (chrtab(i), i=3136,3140) /  5268,  1301,  5268,     0,   149/
+data    (chrtab(i), i=3141,3145) /  4871,   213,  4935,   277,  4999/
+data    (chrtab(i), i=3146,3150) /   852,  4296,    21,  4565,   661/
+data    (chrtab(i), i=3151,3155) /  5141,     7,  4487,   583,  5127/
+data    (chrtab(i), i=3156,3160) /    85,  4308,   405,  4372,   725/
+data    (chrtab(i), i=3161,3165) /  4948,   981,  4948,   200,  4167/
+data    (chrtab(i), i=3166,3170) /   200,  4423,   776,  4743,   840/
+data    (chrtab(i), i=3171,3175) /  5063,     0,   149,  4615,   213/
+data    (chrtab(i), i=3176,3180) /  4617,   277,  4681,   916,  4681/
+data    (chrtab(i), i=3181,3185) /  4483,  4353,  4224,  4096,  4097/
+data    (chrtab(i), i=3186,3190) /  4099,  4163,  4161,  4097,  4098/
+data    (chrtab(i), i=3191,3195) /    21,  4565,   661,  5141,    85/
+data    (chrtab(i), i=3196,3200) /  4371,   405,  4372,   789,  5012/
+data    (chrtab(i), i=3201,3205) /   981,  5012,     0,   725,  4167/
+data    (chrtab(i), i=3206,3210) /   789,  4231,   853,  4295,   853/
+data    (chrtab(i), i=3211,3215) /  4181,  4177,    71,  4935,  4939/
+data    (chrtab(i), i=3216,3220) /   149,  4177,   213,  4178,   277/
+data    (chrtab(i), i=3221,3225) /  4179,   405,  4180,   519,  4936/
+data    (chrtab(i), i=3226,3230) /   647,  4937,   711,  4938,   775/
+data    (chrtab(i), i=3231,3235) /  4939,     0,   480,  4447,  4382/
+data    (chrtab(i), i=3236,3240) /  4316,  4314,  4376,  4439,  4501/
+data    (chrtab(i), i=3241,3245) /  4499,  4369,   351,  4381,  4379/
+data    (chrtab(i), i=3246,3250) /  4441,  4504,  4566,  4564,  4498/
+data    (chrtab(i), i=3251,3255) /  4240,  4494,  4556,  4554,  4488/
+data    (chrtab(i), i=3256,3260) /  4423,  4357,  4355,  4417,   271/
+data    (chrtab(i), i=3261,3265) /  4493,  4491,  4425,  4360,  4294/
+data    (chrtab(i), i=3266,3270) /  4292,  4354,  4417,  4544,     0/
+data    (chrtab(i), i=3271,3275) /   160,  4224,     0,   224,  4447/
+data    (chrtab(i), i=3276,3280) /  4510,  4572,  4570,  4504,  4439/
+data    (chrtab(i), i=3281,3285) /  4373,  4371,  4497,   351,  4509/
+data    (chrtab(i), i=3286,3290) /  4507,  4441,  4376,  4310,  4308/
+data    (chrtab(i), i=3291,3295) /  4370,  4624,  4366,  4300,  4298/
+data    (chrtab(i), i=3296,3300) /  4360,  4423,  4485,  4483,  4417/
+data    (chrtab(i), i=3301,3305) /   399,  4365,  4363,  4425,  4488/
+data    (chrtab(i), i=3306,3310) /  4550,  4548,  4482,  4417,  4288/
+data    (chrtab(i), i=3311,3315) /     0,    77,  4175,  4242,  4371/
+data    (chrtab(i), i=3316,3320) /  4499,  4626,  4879,  5006,  5134/
+data    (chrtab(i), i=3321,3325) /  5263,  5329,    79,  4241,  4370/
+data    (chrtab(i), i=3326,3330) /  4498,  4625,  4878,  5005,  5133/
+data    (chrtab(i), i=3331,3335) /  5262,  5329,  5331,     0,   284/
+data    (chrtab(i), i=3336,3340) /  4251,  4185,  4183,  4245,  4372/
+data    (chrtab(i), i=3341,3345) /  4500,  4629,  4695,  4697,  4635/
+data    (chrtab(i), i=3346,3350) /  4508,  4380,   284,  4185,  4245/
+data    (chrtab(i), i=3351,3355) /  4500,  4695,  4635,  4380,   412/
+data    (chrtab(i), i=3356,3360) /  4251,  4183,  4372,  4629,  4697/
+data    (chrtab(i), i=3361,3362) /  4508,     0/
diff --git a/sys/gio/sgikern/font.h b/sys/gio/sgikern/font.h
new file mode 100644
index 00000000..eb2e72f4
--- /dev/null
+++ b/sys/gio/sgikern/font.h
@@ -0,0 +1,29 @@
+# FONT.H -- Font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/sgikern/greek.com b/sys/gio/sgikern/greek.com
new file mode 100644
index 00000000..cb9fffdc
--- /dev/null
+++ b/sys/gio/sgikern/greek.com
@@ -0,0 +1,501 @@
+# GCHTAB -- Table of strokes for the printable GREEK characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   gchidx[97]	# character index in gchtab
+short   gchwid[97]	# character width table
+short   gchtab[2140]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (gchidx(i), i=001,005) /    1,    3,   16,   29,   38/
+data    (gchidx(i), i=006,010) /   77,  107,  154,  162,  181/
+data    (gchidx(i), i=011,015) /  200,  205,  212,  233,  240/
+data    (gchidx(i), i=016,020) /  246,  259,  297,  306,  348/
+data    (gchidx(i), i=021,025) /  392,  402,  437,  483,  510/
+data    (gchidx(i), i=026,030) /  568,  614,  645,  658,  666/
+data    (gchidx(i), i=031,035) /  673,  681,  688,  741,  767/
+data    (gchidx(i), i=036,040) /  793,  795,  806,  821,  863/
+data    (gchidx(i), i=041,045) /  874,  883,  888,  899,  901/
+data    (gchidx(i), i=046,050) /  912,  921,  930,  972,  987/
+data    (gchidx(i), i=051,055) / 1037, 1067, 1083, 1088, 1117/
+data    (gchidx(i), i=056,060) / 1143, 1182, 1207, 1242, 1244/
+data    (gchidx(i), i=061,065) / 1253, 1256, 1265, 1267, 1276/
+data    (gchidx(i), i=066,070) / 1284, 1321, 1373, 1394, 1436/
+data    (gchidx(i), i=071,075) / 1465, 1500, 1525, 1554, 1568/
+data    (gchidx(i), i=076,080) / 1610, 1635, 1655, 1679, 1699/
+data    (gchidx(i), i=081,085) / 1729, 1746, 1788, 1817, 1849/
+data    (gchidx(i), i=086,090) / 1862, 1891, 1893, 1934, 1975/
+data    (gchidx(i), i=091,095) / 2006, 2036, 2074, 2079, 2117/
+data    (gchidx(i), i=096,096) / 2126/
+
+
+# Width data.
+
+data    (gchwid(i), i=001,005) /   21,   15,   15,   26,   25/
+data    (gchwid(i), i=006,010) /   29,   30,   15,   19,   19/
+data    (gchwid(i), i=011,015) /   27,   29,   30,   29,   15/
+data    (gchwid(i), i=016,020) /   31,   25,   25,   25,   25/
+data    (gchwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (gchwid(i), i=026,030) /   25,   29,   15,   29,   31/
+data    (gchwid(i), i=031,035) /   29,   31,   32,   25,   30/
+data    (gchwid(i), i=036,040) /   21,   25,   29,   26,   23/
+data    (gchwid(i), i=041,045) /   26,   19,   25,   21,   25/
+data    (gchwid(i), i=046,050) /   21,   21,   27,   29,   27/
+data    (gchwid(i), i=051,055) /   29,   26,   19,   24,   25/
+data    (gchwid(i), i=056,060) /   27,   27,   28,   21,   19/
+data    (gchwid(i), i=061,065) /   19,   19,   21,   31,   27/
+data    (gchwid(i), i=066,070) /   28,   26,   23,   24,   23/
+data    (gchwid(i), i=071,075) /   27,   25,   27,   17,   24/
+data    (gchwid(i), i=076,080) /   25,   25,   28,   25,   23/
+data    (gchwid(i), i=081,085) /   27,   28,   24,   26,   25/
+data    (gchwid(i), i=086,090) /   25,   21,   28,   22,   28/
+data    (gchwid(i), i=091,095) /   23,   19,   19,   19,   31/
+data    (gchwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (gchtab(i), i=0001,0005) /    35,     0,   220,  4250,  4302/
+data    (gchtab(i), i=0006,0010) /  4378,  4316,   218,  4308,   201/
+data    (gchtab(i), i=0011,0015) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0016,0020) /   213,  4244,  4307,  4372,  4309/
+data    (gchtab(i), i=0021,0025) /   199,  4232,  4297,  4360,  4358/
+data    (gchtab(i), i=0026,0030) /  4292,  4227,     0,   604,  4224/
+data    (gchtab(i), i=0031,0035) /   988,  4608,   145,  5137,    75/
+data    (gchtab(i), i=0036,0040) /  5067,     0,   416,  4483,   672/
+data    (gchtab(i), i=0041,0045) /  4739,   921,  4952,  5015,  5080/
+data    (gchtab(i), i=0046,0050) /  5081,  4955,  4764,  4508,  4315/
+data    (gchtab(i), i=0051,0055) /  4185,  4183,  4245,  4308,  4435/
+data    (gchtab(i), i=0056,0060) /  4817,  4944,  5070,    87,  4309/
+data    (gchtab(i), i=0061,0065) /  4436,  4818,  4945,  5008,  5070/
+data    (gchtab(i), i=0066,0070) /  5066,  4936,  4743,  4487,  4296/
+data    (gchtab(i), i=0071,0075) /  4170,  4171,  4236,  4299,  4234/
+data    (gchtab(i), i=0076,0080) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=0081,0085) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=0086,0090) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=0091,0095) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=0096,0100) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=0101,0105) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=0106,0110) /     0,  1236,  5267,  5330,  5395/
+data    (gchtab(i), i=0111,0115) /  5396,  5333,  5269,  5204,  5138/
+data    (gchtab(i), i=0116,0120) /  5005,  4874,  4744,  4615,  4423/
+data    (gchtab(i), i=0121,0125) /  4232,  4170,  4173,  4239,  4627/
+data    (gchtab(i), i=0126,0130) /  4757,  4823,  4825,  4763,  4636/
+data    (gchtab(i), i=0131,0135) /  4507,  4441,  4439,  4500,  4625/
+data    (gchtab(i), i=0136,0140) /  4938,  5064,  5255,  5319,  5384/
+data    (gchtab(i), i=0141,0145) /  5385,   327,  4296,  4234,  4237/
+data    (gchtab(i), i=0146,0150) /  4303,  4433,   343,  4501,  5002/
+data    (gchtab(i), i=0151,0155) /  5128,  5255,     0,   218,  4251/
+data    (gchtab(i), i=0156,0160) /  4316,  4379,  4377,  4311,  4246/
+data    (gchtab(i), i=0161,0165) /     0,   608,  4574,  4443,  4311/
+data    (gchtab(i), i=0166,0170) /  4242,  4238,  4297,  4421,  4546/
+data    (gchtab(i), i=0171,0175) /  4672,   478,  4442,  4375,  4306/
+data    (gchtab(i), i=0176,0180) /  4302,  4361,  4422,  4546,     0/
+data    (gchtab(i), i=0181,0185) /    96,  4318,  4443,  4567,  4626/
+data    (gchtab(i), i=0186,0190) /  4622,  4553,  4421,  4290,  4160/
+data    (gchtab(i), i=0191,0195) /   222,  4442,  4503,  4562,  4558/
+data    (gchtab(i), i=0196,0200) /  4489,  4422,  4290,     0,   151/
+data    (gchtab(i), i=0201,0205) /  5129,  1047,  4233,     0,   664/
+data    (gchtab(i), i=0206,0210) /  4743,   144,  5264,   135,  5255/
+data    (gchtab(i), i=0211,0215) /     0,  1227,  5195,  5068,  4942/
+data    (gchtab(i), i=0216,0220) /  4754,  4691,  4564,  4436,  4307/
+data    (gchtab(i), i=0221,0225) /  4241,  4239,  4301,  4428,  4556/
+data    (gchtab(i), i=0226,0230) /  4685,  4750,  4946,  5076,  5205/
+data    (gchtab(i), i=0231,0235) /  5333,     0,   664,  4743,   152/
+data    (gchtab(i), i=0236,0240) /  5272,   144,  5264,     0,   201/
+data    (gchtab(i), i=0241,0245) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0246,0250) /   729,  4760,  4823,  4888,  4825/
+data    (gchtab(i), i=0251,0255) /   144,  5392,   713,  4744,  4807/
+data    (gchtab(i), i=0256,0260) /  4872,  4809,     0,   476,  4379/
+data    (gchtab(i), i=0261,0265) /  4248,  4179,  4176,  4235,  4360/
+data    (gchtab(i), i=0266,0270) /  4551,  4679,  4872,  5003,  5072/
+data    (gchtab(i), i=0271,0275) /  5075,  5016,  4891,  4700,  4572/
+data    (gchtab(i), i=0276,0280) /   476,  4443,  4378,  4312,  4243/
+data    (gchtab(i), i=0281,0285) /  4240,  4299,  4361,  4424,  4551/
+data    (gchtab(i), i=0286,0290) /   583,  4808,  4873,  4939,  5008/
+data    (gchtab(i), i=0291,0295) /  5011,  4952,  4890,  4827,  4700/
+data    (gchtab(i), i=0296,0300) /     0,   280,  4505,  4700,  4679/
+data    (gchtab(i), i=0301,0305) /   539,  4615,   263,  4935,     0/
+data    (gchtab(i), i=0306,0310) /   152,  4311,  4246,  4183,  4184/
+data    (gchtab(i), i=0311,0315) /  4250,  4315,  4508,  4764,  4955/
+data    (gchtab(i), i=0316,0320) /  5018,  5080,  5078,  5012,  4818/
+data    (gchtab(i), i=0321,0325) /  4496,  4367,  4237,  4170,  4167/
+data    (gchtab(i), i=0326,0330) /   668,  4891,  4954,  5016,  5014/
+data    (gchtab(i), i=0331,0335) /  4948,  4754,  4496,    73,  4234/
+data    (gchtab(i), i=0336,0340) /  4362,  4680,  4872,  5001,  5066/
+data    (gchtab(i), i=0341,0345) /   266,  4679,  4935,  5000,  5066/
+data    (gchtab(i), i=0346,0350) /  5068,     0,   152,  4311,  4246/
+data    (gchtab(i), i=0351,0355) /  4183,  4184,  4250,  4315,  4508/
+data    (gchtab(i), i=0356,0360) /  4764,  4955,  5017,  5014,  4948/
+data    (gchtab(i), i=0361,0365) /  4755,  4563,   668,  4891,  4953/
+data    (gchtab(i), i=0366,0370) /  4950,  4884,  4755,   659,  4882/
+data    (gchtab(i), i=0371,0375) /  5008,  5070,  5067,  5001,  4936/
+data    (gchtab(i), i=0376,0380) /  4743,  4487,  4296,  4233,  4171/
+data    (gchtab(i), i=0381,0385) /  4172,  4237,  4300,  4235,   849/
+data    (gchtab(i), i=0386,0390) /  5006,  5003,  4937,  4872,  4743/
+data    (gchtab(i), i=0391,0395) /     0,   666,  4743,   732,  4807/
+data    (gchtab(i), i=0396,0400) /   732,  4109,  5133,   455,  4999/
+data    (gchtab(i), i=0401,0405) /     0,   220,  4178,    82,  4308/
+data    (gchtab(i), i=0406,0410) /  4501,  4693,  4884,  5010,  5071/
+data    (gchtab(i), i=0411,0415) /  5069,  5002,  4872,  4679,  4487/
+data    (gchtab(i), i=0416,0420) /  4296,  4233,  4171,  4172,  4237/
+data    (gchtab(i), i=0421,0425) /  4300,  4235,   597,  4820,  4946/
+data    (gchtab(i), i=0426,0430) /  5007,  5005,  4938,  4808,  4679/
+data    (gchtab(i), i=0431,0435) /   220,  4956,   219,  4635,  4956/
+data    (gchtab(i), i=0436,0440) /     0,   857,  4888,  4951,  5016/
+data    (gchtab(i), i=0441,0445) /  5017,  4955,  4828,  4636,  4443/
+data    (gchtab(i), i=0446,0450) /  4313,  4247,  4179,  4173,  4234/
+data    (gchtab(i), i=0451,0455) /  4360,  4551,  4679,  4872,  5002/
+data    (gchtab(i), i=0456,0460) /  5069,  5070,  5009,  4883,  4692/
+data    (gchtab(i), i=0461,0465) /  4628,  4435,  4305,  4238,   540/
+data    (gchtab(i), i=0466,0470) /  4507,  4377,  4311,  4243,  4237/
+data    (gchtab(i), i=0471,0475) /  4298,  4424,  4551,   583,  4808/
+data    (gchtab(i), i=0476,0480) /  4938,  5005,  5006,  4945,  4819/
+data    (gchtab(i), i=0481,0485) /  4692,     0,    92,  4182,    88/
+data    (gchtab(i), i=0486,0490) /  4250,  4380,  4508,  4825,  4953/
+data    (gchtab(i), i=0491,0495) /  5018,  5084,   154,  4379,  4507/
+data    (gchtab(i), i=0496,0500) /  4825,   988,  5081,  5014,  4753/
+data    (gchtab(i), i=0501,0505) /  4687,  4620,  4615,   918,  4689/
+data    (gchtab(i), i=0506,0510) /  4623,  4556,  4551,     0,   412/
+data    (gchtab(i), i=0511,0515) /  4315,  4249,  4246,  4308,  4499/
+data    (gchtab(i), i=0516,0520) /  4755,  4948,  5014,  5017,  4955/
+data    (gchtab(i), i=0521,0525) /  4764,  4508,   412,  4379,  4313/
+data    (gchtab(i), i=0526,0530) /  4310,  4372,  4499,   659,  4884/
+data    (gchtab(i), i=0531,0535) /  4950,  4953,  4891,  4764,   403/
+data    (gchtab(i), i=0536,0540) /  4306,  4241,  4175,  4171,  4233/
+data    (gchtab(i), i=0541,0545) /  4296,  4487,  4743,  4936,  5001/
+data    (gchtab(i), i=0546,0550) /  5067,  5071,  5009,  4946,  4755/
+data    (gchtab(i), i=0551,0555) /   403,  4370,  4305,  4239,  4235/
+data    (gchtab(i), i=0556,0560) /  4297,  4360,  4487,   647,  4872/
+data    (gchtab(i), i=0561,0565) /  4937,  5003,  5007,  4945,  4882/
+data    (gchtab(i), i=0566,0570) /  4755,     0,   917,  4946,  4816/
+data    (gchtab(i), i=0571,0575) /  4623,  4559,  4368,  4242,  4181/
+data    (gchtab(i), i=0576,0580) /  4182,  4249,  4379,  4572,  4700/
+data    (gchtab(i), i=0581,0585) /  4891,  5017,  5078,  5072,  5004/
+data    (gchtab(i), i=0586,0590) /  4938,  4808,  4615,  4423,  4296/
+data    (gchtab(i), i=0591,0595) /  4234,  4235,  4300,  4363,  4298/
+data    (gchtab(i), i=0596,0600) /   463,  4432,  4306,  4245,  4246/
+data    (gchtab(i), i=0601,0605) /  4313,  4443,  4572,   604,  4827/
+data    (gchtab(i), i=0606,0610) /  4953,  5014,  5008,  4940,  4874/
+data    (gchtab(i), i=0611,0615) /  4744,  4615,     0,  1247,  5278/
+data    (gchtab(i), i=0616,0620) /  5341,  5406,  5407,  5344,  5216/
+data    (gchtab(i), i=0621,0625) /  5087,  4957,  4891,  4824,  4756/
+data    (gchtab(i), i=0626,0630) /  4616,  4548,  4482,   926,  4956/
+data    (gchtab(i), i=0631,0635) /  4888,  4748,  4680,  4613,  4547/
+data    (gchtab(i), i=0636,0640) /  4417,  4288,  4160,  4097,  4098/
+data    (gchtab(i), i=0641,0645) /  4163,  4226,  4161,     0,   213/
+data    (gchtab(i), i=0646,0650) /  4244,  4307,  4372,  4309,   199/
+data    (gchtab(i), i=0651,0655) /  4232,  4297,  4360,  4358,  4292/
+data    (gchtab(i), i=0656,0660) /  4227,     0,  1180,  4245,  5262/
+data    (gchtab(i), i=0661,0665) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0666,0670) /   149,  5397,   144,  5392,   139/
+data    (gchtab(i), i=0671,0675) /  5387,     0,   156,  5269,  4238/
+data    (gchtab(i), i=0676,0680) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0681,0685) /  1177,  4359,   147,  5395,   141/
+data    (gchtab(i), i=0686,0690) /  5389,     0,  1044,  5078,  4951/
+data    (gchtab(i), i=0691,0695) /  4759,  4630,  4565,  4498,  4495/
+data    (gchtab(i), i=0696,0700) /  4557,  4684,  4876,  5005,  5071/
+data    (gchtab(i), i=0701,0705) /   663,  4629,  4562,  4559,  4621/
+data    (gchtab(i), i=0706,0710) /  4684,  1047,  5071,  5069,  5196/
+data    (gchtab(i), i=0711,0715) /  5324,  5454,  5521,  5523,  5462/
+data    (gchtab(i), i=0716,0720) /  5400,  5274,  5147,  4956,  4764/
+data    (gchtab(i), i=0721,0725) /  4571,  4442,  4312,  4246,  4179/
+data    (gchtab(i), i=0726,0730) /  4176,  4237,  4299,  4425,  4552/
+data    (gchtab(i), i=0731,0735) /  4743,  4935,  5128,  5257,  5322/
+data    (gchtab(i), i=0736,0740) /  1111,  5135,  5133,  5196,     0/
+data    (gchtab(i), i=0741,0745) /   473,  4167,   601,  5063,   537/
+data    (gchtab(i), i=0746,0750) /  4999,   205,  4877,     7,  4423/
+data    (gchtab(i), i=0751,0755) /   711,  5191,   480,  4447,  4381/
+data    (gchtab(i), i=0756,0760) /  4379,  4441,  4568,  4696,  4825/
+data    (gchtab(i), i=0761,0765) /  4891,  4893,  4831,  4704,  4576/
+data    (gchtab(i), i=0766,0770) /     0,  1295,  5325,  5196,  5068/
+data    (gchtab(i), i=0771,0775) /  4941,  4878,  4690,  4627,  4500/
+data    (gchtab(i), i=0776,0780) /  4372,  4243,  4177,  4175,  4237/
+data    (gchtab(i), i=0781,0785) /  4364,  4492,  4621,  4686,  4882/
+data    (gchtab(i), i=0786,0790) /  4947,  5076,  5204,  5331,  5393/
+data    (gchtab(i), i=0791,0795) /  5391,     0,    35,     0,   540/
+data    (gchtab(i), i=0796,0800) /  4103,   540,  5127,   537,  5063/
+data    (gchtab(i), i=0801,0805) /    72,  5064,     7,  5127,     0/
+data    (gchtab(i), i=0806,0810) /  1176,  4824,  4567,  4438,  4308/
+data    (gchtab(i), i=0811,0815) /  4241,  4239,  4300,  4426,  4553/
+data    (gchtab(i), i=0816,0820) /  4808,  5256,   144,  5008,     0/
+data    (gchtab(i), i=0821,0825) /   540,  4615,   604,  4679,   407/
+data    (gchtab(i), i=0826,0830) /  4310,  4245,  4179,  4176,  4238/
+data    (gchtab(i), i=0831,0835) /  4301,  4492,  4812,  5005,  5070/
+data    (gchtab(i), i=0836,0840) /  5136,  5139,  5077,  5014,  4823/
+data    (gchtab(i), i=0841,0845) /  4503,   407,  4374,  4309,  4243/
+data    (gchtab(i), i=0846,0850) /  4240,  4302,  4365,  4492,   716/
+data    (gchtab(i), i=0851,0855) /  4941,  5006,  5072,  5075,  5013/
+data    (gchtab(i), i=0856,0860) /  4950,  4823,   348,  4892,   327/
+data    (gchtab(i), i=0861,0865) /  4871,     0,   220,  4295,   284/
+data    (gchtab(i), i=0866,0870) /  4359,    28,  5084,  5078,  5020/
+data    (gchtab(i), i=0871,0875) /     7,  4551,     0,   608,  4224/
+data    (gchtab(i), i=0876,0880) /   992,  4608,   147,  5139,    77/
+data    (gchtab(i), i=0881,0885) /  5069,     0,   160,  4224,   544/
+data    (gchtab(i), i=0886,0890) /  4608,     0,    28,  4615,    92/
+data    (gchtab(i), i=0891,0895) /  4617,  1052,  4615,    28,  5148/
+data    (gchtab(i), i=0896,0900) /    91,  5083,     0,    35,     0/
+data    (gchtab(i), i=0901,0905) /   540,  4167,   540,  5063,   537/
+data    (gchtab(i), i=0906,0910) /  4999,     7,  4423,   711,  5191/
+data    (gchtab(i), i=0911,0915) /     0,   278,  4505,  4630,    83/
+data    (gchtab(i), i=0916,0920) /  4504,  4819,   408,  4487,     0/
+data    (gchtab(i), i=0921,0925) /   266,  4487,  4618,    77,  4488/
+data    (gchtab(i), i=0926,0930) /  4813,   409,  4488,     0,   540/
+data    (gchtab(i), i=0931,0935) /  4443,  4313,  4247,  4179,  4176/
+data    (gchtab(i), i=0936,0940) /  4236,  4298,  4424,  4615,  4743/
+data    (gchtab(i), i=0941,0945) /  4936,  5066,  5132,  5200,  5203/
+data    (gchtab(i), i=0946,0950) /  5143,  5081,  4955,  4764,  4636/
+data    (gchtab(i), i=0951,0955) /   540,  4507,  4377,  4311,  4243/
+data    (gchtab(i), i=0956,0960) /  4240,  4300,  4362,  4488,  4615/
+data    (gchtab(i), i=0961,0965) /   647,  4872,  5002,  5068,  5136/
+data    (gchtab(i), i=0966,0970) /  5139,  5079,  5017,  4891,  4764/
+data    (gchtab(i), i=0971,0975) /     0,   220,  4295,   284,  4359/
+data    (gchtab(i), i=0976,0980) /  1052,  5127,  1116,  5191,    28/
+data    (gchtab(i), i=0981,0985) /  5404,     7,  4551,   839,  5383/
+data    (gchtab(i), i=0986,0990) /     0,   540,  4443,  4313,  4247/
+data    (gchtab(i), i=0991,0995) /  4179,  4176,  4236,  4298,  4424/
+data    (gchtab(i), i=0996,1000) /  4615,  4743,  4936,  5066,  5132/
+data    (gchtab(i), i=1001,1005) /  5200,  5203,  5143,  5081,  4955/
+data    (gchtab(i), i=1006,1010) /  4764,  4636,   540,  4507,  4377/
+data    (gchtab(i), i=1011,1015) /  4311,  4243,  4240,  4300,  4362/
+data    (gchtab(i), i=1016,1020) /  4488,  4615,   647,  4872,  5002/
+data    (gchtab(i), i=1021,1025) /  5068,  5136,  5139,  5079,  5017/
+data    (gchtab(i), i=1026,1030) /  4891,  4764,   405,  4494,   789/
+data    (gchtab(i), i=1031,1035) /  4878,   402,  4882,   401,  4881/
+data    (gchtab(i), i=1036,1040) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=1041,1045) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=1046,1050) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=1051,1055) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=1056,1060) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=1061,1065) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=1066,1070) /     0,    92,  4626,  4103,    28/
+data    (gchtab(i), i=1071,1075) /  4562,    28,  5084,  5142,  5020/
+data    (gchtab(i), i=1076,1080) /    72,  5000,     7,  5063,  5133/
+data    (gchtab(i), i=1081,1085) /  4999,     0,   160,  4224,   544/
+data    (gchtab(i), i=1086,1090) /  4608,     0,    23,  4121,  4187/
+data    (gchtab(i), i=1091,1095) /  4252,  4380,  4443,  4505,  4565/
+data    (gchtab(i), i=1096,1100) /  4551,    25,  4251,  4379,  4505/
+data    (gchtab(i), i=1101,1105) /   983,  5081,  5019,  4956,  4828/
+data    (gchtab(i), i=1106,1110) /  4763,  4697,  4629,  4615,   985/
+data    (gchtab(i), i=1111,1115) /  4955,  4827,  4697,   263,  4807/
+data    (gchtab(i), i=1116,1120) /     0,   473,  4167,   601,  5063/
+data    (gchtab(i), i=1121,1125) /   537,  4999,   205,  4877,     7/
+data    (gchtab(i), i=1126,1130) /  4423,   711,  5191,   480,  4447/
+data    (gchtab(i), i=1131,1135) /  4381,  4379,  4441,  4568,  4696/
+data    (gchtab(i), i=1136,1140) /  4825,  4891,  4893,  4831,  4704/
+data    (gchtab(i), i=1141,1145) /  4576,     0,    74,  4231,  4487/
+data    (gchtab(i), i=1146,1150) /  4363,  4239,  4178,  4182,  4249/
+data    (gchtab(i), i=1151,1155) /  4379,  4572,  4828,  5019,  5145/
+data    (gchtab(i), i=1156,1160) /  5206,  5202,  5135,  5003,  4871/
+data    (gchtab(i), i=1161,1165) /  5127,  5194,   267,  4302,  4242/
+data    (gchtab(i), i=1166,1170) /  4246,  4313,  4443,  4572,   732/
+data    (gchtab(i), i=1171,1175) /  4955,  5081,  5142,  5138,  5070/
+data    (gchtab(i), i=1176,1180) /  5003,   136,  4424,   840,  5128/
+data    (gchtab(i), i=1181,1185) /     0,   157,  4184,  1117,  5144/
+data    (gchtab(i), i=1186,1190) /   404,  4431,   852,  4879,   139/
+data    (gchtab(i), i=1191,1195) /  4166,  1099,  5126,   155,  5147/
+data    (gchtab(i), i=1196,1200) /   154,  5146,   402,  4882,   401/
+data    (gchtab(i), i=1201,1205) /  4881,   137,  5129,   136,  5128/
+data    (gchtab(i), i=1206,1210) /     0,   604,  4679,   668,  4743/
+data    (gchtab(i), i=1211,1215) /    21,  4182,  4309,  4369,  4431/
+data    (gchtab(i), i=1216,1220) /  4494,  4621,    86,  4245,  4305/
+data    (gchtab(i), i=1221,1225) /  4367,  4430,  4621,  4813,  5006/
+data    (gchtab(i), i=1226,1230) /  5071,  5137,  5205,  5270,   717/
+data    (gchtab(i), i=1231,1235) /  4942,  5007,  5073,  5141,  5270/
+data    (gchtab(i), i=1236,1240) /  5333,   412,  4956,   391,  4935/
+data    (gchtab(i), i=1241,1245) /     0,    35,     0,   160,  4224/
+data    (gchtab(i), i=1246,1250) /   224,  4288,   160,  4704,   128/
+data    (gchtab(i), i=1251,1255) /  4672,     0,    28,  4868,     0/
+data    (gchtab(i), i=1256,1260) /   480,  4544,   544,  4608,    96/
+data    (gchtab(i), i=1261,1265) /  4640,    64,  4608,     0,    35/
+data    (gchtab(i), i=1266,1270) /     0,  1106,  5392,  5198,   917/
+data    (gchtab(i), i=1271,1275) /  5328,  5003,   144,  5328,     0/
+data    (gchtab(i), i=1276,1280) /    85,  4437,  4809,   277,  4807/
+data    (gchtab(i), i=1281,1285) /  1312,  4807,     0,   533,  4436/
+data    (gchtab(i), i=1286,1290) /  4306,  4240,  4173,  4170,  4232/
+data    (gchtab(i), i=1291,1295) /  4423,  4551,  4680,  4875,  5006/
+data    (gchtab(i), i=1296,1300) /  5138,  5205,   533,  4500,  4370/
+data    (gchtab(i), i=1301,1305) /  4304,  4237,  4234,  4296,  4423/
+data    (gchtab(i), i=1306,1310) /   533,  4757,  4884,  4946,  5066/
+data    (gchtab(i), i=1311,1315) /  5128,  5191,   661,  4820,  4882/
+data    (gchtab(i), i=1316,1320) /  5002,  5064,  5191,  5255,     0/
+data    (gchtab(i), i=1321,1325) /   732,  4635,  4505,  4373,  4306/
+data    (gchtab(i), i=1326,1330) /  4238,  4168,  4096,   732,  4699/
+data    (gchtab(i), i=1331,1335) /  4569,  4437,  4370,  4302,  4232/
+data    (gchtab(i), i=1336,1340) /  4160,   732,  4956,  5083,  5146/
+data    (gchtab(i), i=1341,1345) /  5143,  5077,  5012,  4819,  4563/
+data    (gchtab(i), i=1346,1350) /   860,  5082,  5079,  5013,  4948/
+data    (gchtab(i), i=1351,1355) /  4819,   467,  4818,  4944,  5006/
+data    (gchtab(i), i=1356,1360) /  5003,  4937,  4872,  4679,  4551/
+data    (gchtab(i), i=1361,1365) /  4424,  4361,  4300,   467,  4754/
+data    (gchtab(i), i=1366,1370) /  4880,  4942,  4939,  4873,  4808/
+data    (gchtab(i), i=1371,1375) /  4679,     0,    21,  4245,  4372/
+data    (gchtab(i), i=1376,1380) /  4434,  4739,  4801,  4864,   149/
+data    (gchtab(i), i=1381,1385) /  4308,  4370,  4675,  4737,  4864/
+data    (gchtab(i), i=1386,1390) /  4992,   981,  5011,  4880,  4229/
+data    (gchtab(i), i=1391,1395) /  4098,  4096,     0,   724,  4693/
+data    (gchtab(i), i=1396,1400) /  4565,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1401,1405) /  4233,  4296,  4423,  4551,  4744/
+data    (gchtab(i), i=1406,1410) /  4875,  4942,  4945,  4883,  4632/
+data    (gchtab(i), i=1411,1415) /  4570,  4572,  4637,  4765,  4892/
+data    (gchtab(i), i=1416,1420) /  5018,   469,  4436,  4305,  4238/
+data    (gchtab(i), i=1421,1425) /  4234,  4296,   455,  4680,  4811/
+data    (gchtab(i), i=1426,1430) /  4878,  4882,  4820,  4695,  4633/
+data    (gchtab(i), i=1431,1435) /  4635,  4700,  4828,  5018,     0/
+data    (gchtab(i), i=1436,1440) /   850,  4820,  4693,  4437,  4308/
+data    (gchtab(i), i=1441,1445) /  4306,  4432,  4623,   341,  4372/
+data    (gchtab(i), i=1446,1450) /  4370,  4496,  4623,   527,  4302/
+data    (gchtab(i), i=1451,1455) /  4172,  4170,  4232,  4423,  4615/
+data    (gchtab(i), i=1456,1460) /  4744,  4874,   527,  4366,  4236/
+data    (gchtab(i), i=1461,1465) /  4234,  4296,  4423,     0,   404/
+data    (gchtab(i), i=1466,1470) /  4371,  4241,  4174,  4171,  4233/
+data    (gchtab(i), i=1471,1475) /  4296,  4423,  4615,  4808,  5002/
+data    (gchtab(i), i=1476,1480) /  5133,  5200,  5203,  5077,  4949/
+data    (gchtab(i), i=1481,1485) /  4819,  4687,  4554,  4352,    75/
+data    (gchtab(i), i=1486,1490) /  4297,  4424,  4616,  4809,  5003/
+data    (gchtab(i), i=1491,1495) /  5133,  1107,  5076,  4948,  4818/
+data    (gchtab(i), i=1496,1500) /  4687,  4553,  4416,     0,    18/
+data    (gchtab(i), i=1501,1505) /  4180,  4309,  4437,  4564,  4627/
+data    (gchtab(i), i=1506,1510) /  4688,  4684,  4616,  4416,    19/
+data    (gchtab(i), i=1511,1515) /  4244,  4500,  4627,  1045,  5074/
+data    (gchtab(i), i=1516,1520) /  5008,  4681,  4484,  4352,   981/
+data    (gchtab(i), i=1521,1525) /  5010,  4944,  4681,     0,    17/
+data    (gchtab(i), i=1526,1530) /  4115,  4245,  4437,  4500,  4498/
+data    (gchtab(i), i=1531,1535) /  4430,  4295,   277,  4436,  4434/
+data    (gchtab(i), i=1536,1540) /  4366,  4231,   334,  4562,  4692/
+data    (gchtab(i), i=1541,1545) /  4821,  4949,  5076,  5139,  5136/
+data    (gchtab(i), i=1546,1550) /  5067,  4864,   853,  5075,  5072/
+data    (gchtab(i), i=1551,1555) /  5003,  4800,     0,   277,  4238/
+data    (gchtab(i), i=1556,1560) /  4170,  4168,  4231,  4423,  4553/
+data    (gchtab(i), i=1561,1565) /  4619,   341,  4302,  4234,  4232/
+data    (gchtab(i), i=1566,1570) /  4295,     0,   848,  4883,  4820/
+data    (gchtab(i), i=1571,1575) /  4693,  4565,  4372,  4241,  4174/
+data    (gchtab(i), i=1576,1580) /  4171,  4233,  4296,  4423,  4551/
+data    (gchtab(i), i=1581,1585) /  4744,  4874,  4941,  5010,  5015/
+data    (gchtab(i), i=1586,1590) /  4954,  4891,  4764,  4572,  4443/
+data    (gchtab(i), i=1591,1595) /  4378,  4377,  4441,  4442,   469/
+data    (gchtab(i), i=1596,1600) /  4436,  4305,  4238,  4234,  4296/
+data    (gchtab(i), i=1601,1605) /   455,  4680,  4810,  4877,  4946/
+data    (gchtab(i), i=1606,1610) /  4951,  4890,  4764,     0,   277/
+data    (gchtab(i), i=1611,1615) /  4103,   341,  4167,   917,  5076/
+data    (gchtab(i), i=1616,1620) /  5140,  5077,  4949,  4820,  4560/
+data    (gchtab(i), i=1621,1625) /  4431,  4303,   335,  4558,  4680/
+data    (gchtab(i), i=1626,1630) /  4743,   335,  4494,  4616,  4679/
+data    (gchtab(i), i=1631,1635) /  4807,  4936,  5067,     0,    92/
+data    (gchtab(i), i=1636,1640) /  4316,  4443,  4506,  4568,  4938/
+data    (gchtab(i), i=1641,1645) /  5000,  5063,   220,  4442,  4504/
+data    (gchtab(i), i=1646,1650) /  4874,  4936,  5063,  5127,   533/
+data    (gchtab(i), i=1651,1655) /  4103,   533,  4167,     0,   341/
+data    (gchtab(i), i=1656,1660) /  4096,   405,  4096,   338,  4364/
+data    (gchtab(i), i=1661,1665) /  4361,  4487,  4615,  4744,  4874/
+data    (gchtab(i), i=1666,1670) /  5005,  1045,  4938,  4936,  4999/
+data    (gchtab(i), i=1671,1675) /  5191,  5321,  5387,  1109,  5002/
+data    (gchtab(i), i=1676,1680) /  5000,  5063,     0,   277,  4231/
+data    (gchtab(i), i=1681,1685) /   341,  4367,  4298,  4231,   981/
+data    (gchtab(i), i=1686,1690) /  5009,  4877,  1045,  5074,  5008/
+data    (gchtab(i), i=1691,1695) /  4877,  4747,  4553,  4424,  4231/
+data    (gchtab(i), i=1696,1700) /    85,  4437,     0,   469,  4372/
+data    (gchtab(i), i=1701,1705) /  4241,  4174,  4171,  4233,  4296/
+data    (gchtab(i), i=1706,1710) /  4423,  4551,  4744,  4875,  4942/
+data    (gchtab(i), i=1711,1715) /  4945,  4883,  4820,  4693,  4565/
+data    (gchtab(i), i=1716,1720) /   469,  4436,  4305,  4238,  4234/
+data    (gchtab(i), i=1721,1725) /  4296,   455,  4680,  4811,  4878/
+data    (gchtab(i), i=1726,1730) /  4882,  4820,     0,   468,  4295/
+data    (gchtab(i), i=1731,1735) /   468,  4359,   852,  4935,   852/
+data    (gchtab(i), i=1736,1740) /  4999,    18,  4244,  4437,  5269/
+data    (gchtab(i), i=1741,1745) /    18,  4243,  4436,  5268,     0/
+data    (gchtab(i), i=1746,1750) /    17,  4115,  4245,  4437,  4500/
+data    (gchtab(i), i=1751,1755) /  4498,  4429,  4426,  4488,  4551/
+data    (gchtab(i), i=1756,1760) /   277,  4436,  4434,  4365,  4362/
+data    (gchtab(i), i=1761,1765) /  4424,  4551,  4679,  4808,  4938/
+data    (gchtab(i), i=1766,1770) /  5069,  5136,  5205,  5209,  5147/
+data    (gchtab(i), i=1771,1775) /  5020,  4892,  4762,  4760,  4821/
+data    (gchtab(i), i=1776,1780) /  4946,  5072,  5262,   712,  4939/
+data    (gchtab(i), i=1781,1785) /  5005,  5072,  5141,  5145,  5083/
+data    (gchtab(i), i=1786,1790) /  5020,     0,   140,  4297,  4360/
+data    (gchtab(i), i=1791,1795) /  4487,  4615,  4808,  4939,  5006/
+data    (gchtab(i), i=1796,1800) /  5009,  4947,  4884,  4757,  4629/
+data    (gchtab(i), i=1801,1805) /  4436,  4305,  4238,  4096,   519/
+data    (gchtab(i), i=1806,1810) /  4744,  4875,  4942,  4946,  4884/
+data    (gchtab(i), i=1811,1815) /   533,  4500,  4369,  4302,  4096/
+data    (gchtab(i), i=1816,1820) /     0,  1109,  4565,  4372,  4241/
+data    (gchtab(i), i=1821,1825) /  4174,  4171,  4233,  4296,  4423/
+data    (gchtab(i), i=1826,1830) /  4551,  4744,  4875,  4942,  4945/
+data    (gchtab(i), i=1831,1835) /  4883,  4820,  4693,   469,  4436/
+data    (gchtab(i), i=1836,1840) /  4305,  4238,  4234,  4296,   455/
+data    (gchtab(i), i=1841,1845) /  4680,  4811,  4878,  4882,  4820/
+data    (gchtab(i), i=1846,1850) /   724,  5204,     0,   596,  4487/
+data    (gchtab(i), i=1851,1855) /   596,  4551,    18,  4244,  4437/
+data    (gchtab(i), i=1856,1860) /  5141,    18,  4243,  4436,  5140/
+data    (gchtab(i), i=1861,1865) /     0,    17,  4115,  4245,  4437/
+data    (gchtab(i), i=1866,1870) /  4500,  4498,  4364,  4361,  4487/
+data    (gchtab(i), i=1871,1875) /   277,  4436,  4434,  4300,  4297/
+data    (gchtab(i), i=1876,1880) /  4360,  4487,  4551,  4744,  4874/
+data    (gchtab(i), i=1881,1885) /  5005,  5072,  5075,  5013,  4948/
+data    (gchtab(i), i=1886,1890) /  5011,  5072,   909,  5075,     0/
+data    (gchtab(i), i=1891,1895) /    35,     0,   145,  4371,  4564/
+data    (gchtab(i), i=1896,1900) /  4501,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1901,1905) /  4232,  4295,  4423,  4552,  4683/
+data    (gchtab(i), i=1906,1910) /  4750,    75,  4233,  4296,  4424/
+data    (gchtab(i), i=1911,1915) /  4553,  4683,   590,  4683,  4744/
+data    (gchtab(i), i=1916,1920) /  4807,  4935,  5064,  5195,  5262/
+data    (gchtab(i), i=1921,1925) /  5265,  5204,  5141,  5076,  5203/
+data    (gchtab(i), i=1926,1930) /  5265,   587,  4745,  4808,  4936/
+data    (gchtab(i), i=1931,1935) /  5065,  5195,     0,   604,  4571/
+data    (gchtab(i), i=1936,1940) /  4506,  4505,  4568,  4759,  4951/
+data    (gchtab(i), i=1941,1945) /   663,  4502,  4373,  4307,  4305/
+data    (gchtab(i), i=1946,1950) /  4431,  4622,  4814,   663,  4566/
+data    (gchtab(i), i=1951,1955) /  4437,  4371,  4369,  4495,  4622/
+data    (gchtab(i), i=1956,1960) /   526,  4365,  4236,  4170,  4168/
+data    (gchtab(i), i=1961,1965) /  4294,  4612,  4675,  4673,  4544/
+data    (gchtab(i), i=1966,1970) /  4416,   526,  4429,  4300,  4234/
+data    (gchtab(i), i=1971,1975) /  4232,  4358,  4612,     0,   860/
+data    (gchtab(i), i=1976,1980) /  4544,   924,  4480,    17,  4115/
+data    (gchtab(i), i=1981,1985) /  4245,  4437,  4500,  4498,  4429/
+data    (gchtab(i), i=1986,1990) /  4426,  4552,  4744,  4873,  5068/
+data    (gchtab(i), i=1991,1995) /  5199,   277,  4436,  4434,  4365/
+data    (gchtab(i), i=1996,2000) /  4362,  4424,  4551,  4743,  4872/
+data    (gchtab(i), i=2001,2005) /  5002,  5133,  5199,  5333,     0/
+data    (gchtab(i), i=2006,2010) /   604,  4571,  4506,  4505,  4568/
+data    (gchtab(i), i=2011,2015) /  4759,  5079,  5080,  4887,  4629/
+data    (gchtab(i), i=2016,2020) /  4435,  4240,  4173,  4171,  4233/
+data    (gchtab(i), i=2021,2025) /  4423,  4613,  4675,  4673,  4608/
+data    (gchtab(i), i=2026,2030) /  4480,  4417,   662,  4499,  4304/
+data    (gchtab(i), i=2031,2035) /  4237,  4235,  4297,  4423,     0/
+data    (gchtab(i), i=2036,2040) /   480,  4447,  4382,  4316,  4314/
+data    (gchtab(i), i=2041,2045) /  4376,  4439,  4501,  4499,  4369/
+data    (gchtab(i), i=2046,2050) /   351,  4381,  4379,  4441,  4504/
+data    (gchtab(i), i=2051,2055) /  4566,  4564,  4498,  4240,  4494/
+data    (gchtab(i), i=2056,2060) /  4556,  4554,  4488,  4423,  4357/
+data    (gchtab(i), i=2061,2065) /  4355,  4417,   271,  4493,  4491/
+data    (gchtab(i), i=2066,2070) /  4425,  4360,  4294,  4292,  4354/
+data    (gchtab(i), i=2071,2075) /  4417,  4544,     0,   160,  4224/
+data    (gchtab(i), i=2076,2080) /   544,  4608,     0,   224,  4447/
+data    (gchtab(i), i=2081,2085) /  4510,  4572,  4570,  4504,  4439/
+data    (gchtab(i), i=2086,2090) /  4373,  4371,  4497,   351,  4509/
+data    (gchtab(i), i=2091,2095) /  4507,  4441,  4376,  4310,  4308/
+data    (gchtab(i), i=2096,2100) /  4370,  4624,  4366,  4300,  4298/
+data    (gchtab(i), i=2101,2105) /  4360,  4423,  4485,  4483,  4417/
+data    (gchtab(i), i=2106,2110) /   399,  4365,  4363,  4425,  4488/
+data    (gchtab(i), i=2111,2115) /  4550,  4548,  4482,  4417,  4288/
+data    (gchtab(i), i=2116,2120) /     0,   338,  4240,  4430,   533/
+data    (gchtab(i), i=2121,2125) /  4304,  4619,   208,  5392,     0/
+data    (gchtab(i), i=2126,2130) /   284,  4251,  4185,  4183,  4245/
+data    (gchtab(i), i=2131,2135) /  4372,  4500,  4629,  4695,  4697/
+data    (gchtab(i), i=2136,2139) /  4635,  4508,  4380,     0/
diff --git a/sys/gio/sgikern/ltype.dat b/sys/gio/sgikern/ltype.dat
new file mode 100644
index 00000000..a5509e21
--- /dev/null
+++ b/sys/gio/sgikern/ltype.dat
@@ -0,0 +1,28 @@
+# LTYPE.DAT -- Initialize the builtin line types for the SGI kernel.  Data
+# is given in GKI units (1.0 = 32768 units).  A segment of 32 GKI units is
+# resolved on a device with 1024 resolved pixels.
+
+data	p_seg		/1, 1, 1/
+data	p_segleft	/320, 32, 512/
+
+data	p_nseg[1]	/2/		# PL_DASHED
+data	p_penup[1,1]	/false/
+data	p_penup[1,2]	/true/
+data	p_seglen[1,1]	/320/
+data	p_seglen[1,2]	/128/
+
+data	p_nseg[2]	/2/		# PL_DOTTED
+data	p_penup[2,1]	/false/
+data	p_penup[2,2]	/true/
+data	p_seglen[2,1]	/32/
+data	p_seglen[2,2]	/128/
+
+data	p_nseg[3]	/4/		# PL_DOTDASH
+data	p_penup[3,1]	/false/
+data	p_penup[3,2]	/true/
+data	p_penup[3,3]	/false/
+data	p_penup[3,4]	/true/
+data	p_seglen[3,1]	/512/
+data	p_seglen[3,2]	/128/
+data	p_seglen[3,3]	/32/
+data	p_seglen[3,4]	/128/
diff --git a/sys/gio/sgikern/mkpkg b/sys/gio/sgikern/mkpkg
new file mode 100644
index 00000000..3dd9e943
--- /dev/null
+++ b/sys/gio/sgikern/mkpkg
@@ -0,0 +1,53 @@
+# Make the GIO/SGIKERN simple graphics kernel.
+
+$checkout libsgi.a lib$
+$update   libsgi.a
+$checkin  libsgi.a lib$
+$call     relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:	
+	$omake  x_sgikern.x
+	$link	x_sgikern.o -lsgi
+	;
+
+install:				# install in system library
+	$move	x_sgikern.e bin$
+	;
+
+libsgi.a:
+	sgicancel.x	sgi.com sgi.h
+	sgiclear.x	sgi.com sgi.h <mach.h>
+	sgiclose.x	sgi.com sgi.h
+	sgiclws.x	sgi.h sgi.com
+	sgicolor.x	sgi.com sgi.h
+	sgidrawch.x	font.com font.h greek.com sgi.com sgi.h \
+			<gki.h> <gset.h> <math.h>
+	sgiescape.x	
+	sgifa.x		sgi.com sgi.h
+	sgifaset.x	sgi.com sgi.h <gki.h>
+	sgiflush.x	sgi.com sgi.h
+	sgifont.x	sgi.com sgi.h <gki.h> <gset.h>
+	sgigcell.x	
+	sgiinit.x	sgi.com sgi.h <ctype.h> <gki.h> <mach.h>
+	sgiline.x	sgi.com sgi.h <gset.h>
+	sgiopen.x	sgi.com sgi.h <gki.h>
+	sgiopenws.x	sgi.com sgi.h <error.h> <gki.h> <mach.h>
+	sgipcell.x	sgi.com sgi.h <gki.h>
+	sgipl.x		ltype.dat sgi.com sgi.h <gki.h> <gset.h>
+	sgiplset.x	sgi.com sgi.h <gki.h>
+	sgipm.x		sgi.com sgi.h <gki.h>
+	sgipmset.x	sgi.com sgi.h <gki.h>
+	sgireset.x	sgi.com sgi.h <gset.h> <gki.h>
+	sgitx.x		font.com font.h greek.com sgi.com sgi.h \
+			<gki.h> <gset.h> <math.h>
+	sgitxset.x	sgi.com sgi.h <gki.h> <gset.h>
+	sgk.x		sgk.com sgk.h <chars.h> <gki.h> <mach.h>
+	t_sgideco.x	sgk.h <error.h> <gki.h>
+	t_sgikern.x	<error.h> <gki.h>
+	;
diff --git a/sys/gio/sgikern/sgi.com b/sys/gio/sgikern/sgi.com
new file mode 100644
index 00000000..e050183b
--- /dev/null
+++ b/sys/gio/sgikern/sgi.com
@@ -0,0 +1,17 @@
+# SGI common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/sgicom/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_device
diff --git a/sys/gio/sgikern/sgi.h b/sys/gio/sgikern/sgi.h
new file mode 100644
index 00000000..a9f1da20
--- /dev/null
+++ b/sys/gio/sgikern/sgi.h
@@ -0,0 +1,76 @@
+# SGI global definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The SGI state/device descriptor.
+
+define	LEN_SGI		81
+
+define	SGI_SBUF	Memi[$1]		# string buffer
+define	SGI_SZSBUF	Memi[$1+1]		# size of string buffer
+define	SGI_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	SGI_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	SGI_POLYLINE	Memi[$1+4]		# device supports polyline
+define	SGI_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	SGI_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	SGI_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	SGI_XRES	Memi[$1+8]		# device resolution in X
+define	SGI_YRES	Memi[$1+9]		# device resolution in Y
+define	SGI_ZRES	Memi[$1+10]		# device resolution in Z
+define	SGI_FILLSTYLE	Memi[$1+11]		# number of fill styles
+define	SGI_ROAM	Memi[$1+12]		# device supports roam
+define	SGI_ZOOM	Memi[$1+13]		# device supports zoom
+define	SGI_SELERASE	Memi[$1+14]		# device has selective erase
+define	SGI_PIXREP	Memi[$1+15]		# device supports pixel replic.
+define	SGI_STARTFRAME	Memi[$1+16]		# frame advance at metafile BOF
+define	SGI_ENDFRAME	Memi[$1+17]		# frame advance at metafile EOF
+	# extra space
+define	SGI_CURSOR	Memi[$1+20]		# last cursor accessed
+define	SGI_COLOR	Memi[$1+21]		# last color set
+define	SGI_TXSIZE	Memi[$1+22]		# last text size set
+define	SGI_TXFONT	Memi[$1+23]		# last text font set
+define	SGI_TYPE	Memi[$1+24]		# last line type set
+define	SGI_WIDTH	Memi[$1+25]		# last line width set
+define	SGI_DEVNAME	Memi[$1+26]		# name of open device
+	# extra space
+define	SGI_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	SGI_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	SGI_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	SGI_PLAP	($1+60)			# polyline attributes
+define	SGI_PMAP	($1+64)			# polymarker attributes
+define	SGI_FAAP	($1+68)			# fill area attributes
+define	SGI_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/sgikern/sgicancel.x b/sys/gio/sgikern/sgicancel.x
new file mode 100644
index 00000000..d9249d4b
--- /dev/null
+++ b/sys/gio/sgikern/sgicancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CANCEL -- Cancel any buffered output.
+
+procedure sgi_cancel (dummy)
+
+int	dummy			# not used at present
+include	"sgi.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+	call sgi_reset()
+end
diff --git a/sys/gio/sgikern/sgiclear.x b/sys/gio/sgikern/sgiclear.x
new file mode 100644
index 00000000..f2a63d29
--- /dev/null
+++ b/sys/gio/sgikern/sgiclear.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"sgi.h"
+
+# SGI_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure sgi_clear (dummy)
+
+int	dummy			# not used at present
+
+int	sgk_open()
+errchk	sgk_open
+include	"sgi.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by issuing the frame advance
+	# instruction or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (SGI_ENDFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+
+	    g_nframes = 0
+	    call sgk_close (g_out)
+	    g_out = sgk_open (Memc[SGI_DEVNAME(g_kt)], g_tty)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (SGI_STARTFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+
+	} else {
+	    # Merely output frame instruction to start a new frame in the same
+	    # metafile.
+
+	    call sgk_frame (g_out)
+	}
+
+	# Init kernel data structures.
+	call sgi_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/sgikern/sgiclose.x b/sys/gio/sgikern/sgiclose.x
new file mode 100644
index 00000000..380cd01f
--- /dev/null
+++ b/sys/gio/sgikern/sgiclose.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CLOSE -- Close the SGI translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure sgi_close()
+
+include	"sgi.com"
+
+begin
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (SGI_ENDFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call sgk_close (g_out)
+
+	# Free kernel data structures.
+	call mfree (SGI_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/sgikern/sgiclws.x b/sys/gio/sgikern/sgiclws.x
new file mode 100644
index 00000000..e7d29dd7
--- /dev/null
+++ b/sys/gio/sgikern/sgiclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure sgi_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "sgi.com"
+
+begin
+	call sgk_flush (g_out)
+end
diff --git a/sys/gio/sgikern/sgicolor.x b/sys/gio/sgikern/sgicolor.x
new file mode 100644
index 00000000..cdd13708
--- /dev/null
+++ b/sys/gio/sgikern/sgicolor.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_COLOR -- Set line drawing color.
+
+procedure sgi_color (index)
+
+int	index		# index for color switch statement
+include	"sgi.com"
+
+begin
+	# switch (index) {
+	# case WHITE:
+	# case RED:
+	# case GREEN:
+	# case BLUE:
+	# default:
+	# }
+end
diff --git a/sys/gio/sgikern/sgidrawch.x b/sys/gio/sgikern/sgidrawch.x
new file mode 100644
index 00000000..ab7500ea
--- /dev/null
+++ b/sys/gio/sgikern/sgidrawch.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"sgi.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# SGI_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+int procedure sgi_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+int	mx, my
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen, width
+int	bitupk()
+include	"font.com"
+include	"greek.com"
+include	"sgi.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call sgi_font (font)
+
+	if (font == GT_GREEK) {
+	    width = gchwid[i]
+	    tab1 = gchidx[i]
+	    tab2 = gchidx[i+1] - 1
+	} else {
+	    width = chrwid[i]
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+	}
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    if (font == GT_GREEK)
+	        stroke = gchtab[i]
+	    else
+	        stroke = chrtab[i]
+
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / width  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call sgk_move (g_out, mx, my)
+	    else
+		call sgk_draw (g_out, mx, my)
+	}
+
+	return (int(real(width) / real(FONT_WIDTH) * xsize))
+end
diff --git a/sys/gio/sgikern/sgiescape.x b/sys/gio/sgikern/sgiescape.x
new file mode 100644
index 00000000..ff2480cd
--- /dev/null
+++ b/sys/gio/sgikern/sgiescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SGI_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The SGK kernel does not have any escape functions at present.
+
+procedure sgi_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/sgikern/sgifa.x b/sys/gio/sgikern/sgifa.x
new file mode 100644
index 00000000..37793f22
--- /dev/null
+++ b/sys/gio/sgikern/sgifa.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_FILLAREA -- Fill a closed area.
+
+procedure sgi_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"sgi.com"
+
+begin
+	# This kernel doesn't have any real fill area capability yet; if
+	# fill area is enabled in the graphcap entry, just draw the outline
+	# of the area.
+
+	if (SGI_FILLAREA(g_kt) == YES)
+	    call sgi_polyline (p, npts)
+end
diff --git a/sys/gio/sgikern/sgifaset.x b/sys/gio/sgikern/sgifaset.x
new file mode 100644
index 00000000..c3810252
--- /dev/null
+++ b/sys/gio/sgikern/sgifaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_FASET -- Set the fillarea attributes.
+
+procedure sgi_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"sgi.com"
+
+begin
+	fa = SGI_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/sgikern/sgiflush.x b/sys/gio/sgikern/sgiflush.x
new file mode 100644
index 00000000..e3e1b805
--- /dev/null
+++ b/sys/gio/sgikern/sgiflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_FLUSH -- Flush output.
+
+procedure sgi_flush (dummy)
+
+int	dummy			# not used at present
+include	"sgi.com"
+
+begin
+	call sgk_flush (g_out)
+end
diff --git a/sys/gio/sgikern/sgifont.x b/sys/gio/sgikern/sgifont.x
new file mode 100644
index 00000000..808c7f56
--- /dev/null
+++ b/sys/gio/sgikern/sgifont.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"sgi.h"
+
+# SGI_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set SGI_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure sgi_font (font)
+
+int	font			# code for font to be set
+
+int	normal, bold
+int	pk1, pk2, width
+include	"sgi.com"
+
+begin
+	width = SGI_WIDTH(g_kt)
+	normal = 0
+	bold = 1
+
+	pk1 = GKI_PACKREAL(real(normal))
+	pk2 = GKI_PACKREAL(real(bold))
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call sgk_linewidth (g_out, bold)
+		width = pk2
+	    }
+	} else {
+	    if (width != pk1) {
+	        call sgk_linewidth (g_out, normal)
+		width = pk1
+	    }
+	}
+
+	SGI_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/sgikern/sgigcell.x b/sys/gio/sgikern/sgigcell.x
new file mode 100644
index 00000000..4c2bfe06
--- /dev/null
+++ b/sys/gio/sgikern/sgigcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SGI_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure sgi_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/sgikern/sgiinit.x b/sys/gio/sgikern/sgiinit.x
new file mode 100644
index 00000000..54caf25d
--- /dev/null
+++ b/sys/gio/sgikern/sgiinit.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine SGI_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure sgi_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"sgi.com"
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_SGI, TY_STRUCT)
+	    call malloc (SGI_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile.
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	SGI_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	SGI_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	SGI_SZSBUF(g_kt) = SZ_SBUF
+	SGI_NEXTCH(g_kt) = SGI_SBUF(g_kt) + 1
+	Memc[SGI_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	SGI_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = SGI_NEXTCH(g_kt)
+
+	if (SGI_NCHARSIZES(g_kt) <= 0) {
+	    SGI_NCHARSIZES(g_kt) = 1
+	    SGI_CHARSIZE(g_kt,1) = 1.0
+	    SGI_CHARHEIGHT(g_kt,1) = char_height
+	    SGI_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= SGI_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		SGI_CHARSIZE(g_kt,i)   = char_size
+		SGI_CHARHEIGHT(g_kt,i) = char_height * char_size
+		SGI_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	SGI_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	SGI_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	SGI_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	SGI_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	SGI_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	SGI_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	SGI_XRES(g_kt)	     =       ttygeti (tty, "xr")
+	SGI_YRES(g_kt)	     =       ttygeti (tty, "yr")
+	SGI_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	SGI_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	SGI_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	SGI_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	SGI_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = SGI_NEXTCH(g_kt)
+	SGI_DEVNAME(g_kt) = nextch
+	maxch = SGI_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	SGI_NEXTCH(g_kt) = nextch
+end
+
+
+# SGI_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure sgi_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"sgi.com"
+
+begin
+	nextch = SGI_NEXTCH(g_kt)
+	maxch = SGI_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = SGI_SBUF(g_kt)
+
+	SGI_NEXTCH(g_kt) = nextch
+	return (strp)
+end
diff --git a/sys/gio/sgikern/sgiline.x b/sys/gio/sgikern/sgiline.x
new file mode 100644
index 00000000..086ac158
--- /dev/null
+++ b/sys/gio/sgikern/sgiline.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"sgi.h"
+
+# SGI_LINETYPE -- Set the line type option.
+
+procedure sgi_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"sgi.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    linetype = 0
+	case GL_DASHED:
+	    linetype = 2
+	case GL_DOTTED:
+	    linetype = 3
+	case GL_DOTDASH:
+	    linetype = 4
+	default:
+	    linetype = 1		# solid
+	}
+
+	# This will be done in software in a future version of the SGI kernel.
+	# call sgk_linetype (g_out, linetype)
+end
diff --git a/sys/gio/sgikern/sgiopen.x b/sys/gio/sgikern/sgiopen.x
new file mode 100644
index 00000000..5164ecd7
--- /dev/null
+++ b/sys/gio/sgikern/sgiopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_OPEN -- Install the SGI kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure sgi_open (devname, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	sgi_openws(), sgi_closews(), sgi_clear(), sgi_cancel()
+extern	sgi_flush(), sgi_polyline(), sgi_polymarker(), sgi_text()
+extern	sgi_fillarea(), sgi_putcellarray(), sgi_plset()
+extern	sgi_pmset(), sgi_txset(), sgi_faset()
+extern	sgi_escape()
+include	"sgi.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (sgi_openws)
+	dd[GKI_CLOSEWS]		= locpr (sgi_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (sgi_clear)
+	dd[GKI_CANCEL]		= locpr (sgi_cancel)
+	dd[GKI_FLUSH]		= locpr (sgi_flush)
+	dd[GKI_POLYLINE]	= locpr (sgi_polyline)
+	dd[GKI_POLYMARKER]	= locpr (sgi_polymarker)
+	dd[GKI_TEXT]		= locpr (sgi_text)
+	dd[GKI_FILLAREA]	= locpr (sgi_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (sgi_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (sgi_plset)
+	dd[GKI_PMSET]		= locpr (sgi_pmset)
+	dd[GKI_TXSET]		= locpr (sgi_txset)
+	dd[GKI_FASET]		= locpr (sgi_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (sgi_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call sgi_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/sgiopenws.x b/sys/gio/sgikern/sgiopenws.x
new file mode 100644
index 00000000..a2a5a7eb
--- /dev/null
+++ b/sys/gio/sgikern/sgiopenws.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"sgi.h"
+
+# SGI_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure sgi_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	sgk_open()
+bool	need_open, same_dev
+include	"sgi.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[SGI_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (SGI_ENDFRAME(g_kt) == YES)
+		    call sgk_frame (g_out)
+		call sgk_close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call sgi_init (g_tty, Memc[buf])
+		call sgi_reset()
+	    }
+
+	    # Open the output file.  Metacode output to the device will be
+	    # spooled and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = sgk_open (Memc[SGI_DEVNAME(g_kt)], g_tty)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (SGI_STARTFRAME(g_kt) == YES)
+		    call sgk_frame (g_out)
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call sgi_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/sgipcell.x b/sys/gio/sgikern/sgipcell.x
new file mode 100644
index 00000000..b39e6377
--- /dev/null
+++ b/sys/gio/sgikern/sgipcell.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+define	DEF_YRES	2048	# default height of device pixel in GKI units
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# SGI_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure sgi_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+bool	ttygetb()
+include	"sgi.com"
+
+begin
+	if (ttygetb (g_tty, "BI"))
+	    call sgi_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+	else
+	    call sgi_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+end
+
+
+# SGI_BCELL -- Put cell array, optimized for a bitmap device.  In this case,
+# to get the maximum resolution at maximum efficiency it is desirable for the
+# main loop to be over device pixels, mapping the device pixel into the
+# nearest line of the input cell array.
+
+procedure sgi_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"sgi.com"
+int	and()
+
+begin
+	# Count drawing instruction, set polyline width to 1 for max y-res.
+	g_ndraw = g_ndraw + 1
+	call sgk_linewidth (g_out, 1)
+	SGI_WIDTH(g_kt) = 0
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	if (SGI_YRES(g_kt) <= 0)
+	    dy = GKI_MAXNDC / DEF_YRES
+	else
+	    dy = max (1.0, real(GKI_MAXNDC) / real(SGI_YRES(g_kt)))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call sgk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call sgk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
+
+
+# SGI_MCELL -- Put cell array, optimized for a metafile device.  In this case,
+# it is prohibitively expensive to draw into each resolvable line of the
+# output device.  It is better to set the linewidth to the width of a cell
+# array pixel, output the minimum number of drawing instructions, and let the
+# metafile device widen the lines.
+
+procedure sgi_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	yres, my, i1, i2, v, i, j
+include	"sgi.com"
+int	and()
+
+begin
+	# Count drawing instruction, clobber saved polyline width.
+	g_ndraw = g_ndraw + 1
+	SGI_WIDTH(g_kt) = 0
+
+	# Determine the width and height of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+	dy = real (ay2 - ay1) / ny
+
+	# Set the SGK line width to the height of a pixel in the cell array.
+	yres = SGI_YRES(g_kt)
+	if (yres <= 0)
+	    yres = DEF_YRES
+	call sgk_linewidth (g_out,
+	    max (1, nint (dy / (real(GKI_MAXNDC) / real(yres)))))
+
+	# Process the cell array.  The outer loop runs over lines of the input
+	# cell array; each iteration writes only one line of the output raster,
+	# but the width of the line is adjusted to the height of a pixel in
+	# the cell array (the resolution of the cell array should not exceed
+	# that of the device).
+
+	for (j=1;  j <= ny;  j=j+1) {
+	    my = int ((j - 0.5) * dy) + ay1
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call sgk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call sgk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+	}
+end
diff --git a/sys/gio/sgikern/sgipl.x b/sys/gio/sgikern/sgipl.x
new file mode 100644
index 00000000..e3eea44f
--- /dev/null
+++ b/sys/gio/sgikern/sgipl.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"sgi.h"
+
+define	MAX_LTYPES	3	# max software line type patterns (excl. solid)
+define	MAX_LSEGMENTS	4	# max line segments per pattern
+define	LT_OFFSET	1	# offset to be subtracted from ltype code
+
+
+# SGI_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure sgi_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	x, y
+int	len_p, i
+include	"sgi.com"
+
+begin
+	if (npts < 2)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = SGI_PLAP(g_kt)
+
+	if (SGI_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    call sgk_linewidth (g_out, nint (GKI_UNPACKREAL(PL_WIDTH(pl))))
+	    SGI_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (SGI_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call sgi_color (PL_COLOR(pl))
+	    SGI_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	if (PL_LTYPE(pl) == GL_CLEAR) {
+	    # Ignore clear (erase) polylines.
+	    ;
+
+	} else if (PL_LTYPE(pl) != GL_SOLID) {
+	    # Draw a dashed or dotted polyline of the indicated type.
+	    call sgi_dashline (g_out, p, npts, PL_LTYPE(pl))
+
+	} else {
+	    # Draw a solid polyline (usual case, optimized).
+
+	    # Move to the first point.
+	    x = p[1]
+	    y = p[2]
+	    call sgk_move (g_out, x, y)
+
+	    # Draw the polyline.
+	    for (i=3;  i <= len_p;  i=i+2) {
+		x = p[i]
+		y = p[i+1]
+		call sgk_draw (g_out, x, y)
+	    }
+	}
+end
+
+
+# SGI_DASHLINE -- Draw a dashed or dotted polyline using the indicated line
+# style.
+
+procedure sgi_dashline (g_out, p, npts, ltype)
+
+int	g_out			# output file
+short	p[ARB]			# the polyline points
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# desired line type
+
+bool	penup
+int	len_p, i
+real	vlen, vpos, seglen, dx, dy
+int	oldx, oldy, newx, newy, penx, peny
+int	sgi_getseg()
+
+begin
+	len_p = npts * 2
+
+	oldx = p[1]; oldy = p[2]
+	call sgk_move (g_out, oldx, oldy)
+
+	# Process each line segment in the polyline.
+	do i = 3, len_p, 2 {
+	    newx = p[i]
+	    newy = p[i+1]
+
+	    # Compute VLEN, the length of the polyline line segment to be
+	    # drawn, VPOS, the relative position along the line segment,
+	    # and DX and DY, the scale factors to be applied to VPOS to get
+	    # the x and y coordinates of a point along the line segment.
+
+	    dx = newx - oldx
+	    dy = newy - oldy
+	    vlen = sqrt (dx*dx + dy*dy)
+	    if (vlen < 1.0)			# GKI units
+		next
+
+	    dx = dx / vlen
+	    dy = dy / vlen
+	    vpos = 0.0
+
+	    # For each line segment, get segments of the line type pattern
+	    # until all of the current line segment has been drawn.  The pattern
+	    # wraps around indefinitely, following the polyline around the
+	    # vertices with concern only for the total length traversed.
+
+	    while (vlen - vpos >= 1.0) {
+		seglen = sgi_getseg (int (vlen - vpos), penup, ltype)
+		if (seglen < 1.0)
+		    break
+
+		vpos = vpos + seglen
+		penx = oldx + vpos * dx
+		peny = oldy + vpos * dy
+
+		if (penup)
+		    call sgk_move (g_out, penx, peny)
+		else
+		    call sgk_draw (g_out, penx, peny)
+	    }
+
+	    oldx = newx
+	    oldy = newy
+	}
+end
+
+
+# SGI_GETSEG -- Get a segment of a line style pattern.  The segment extends
+# from the current position in the pattern to either the next penup/pendown
+# breakpoint in the pattern, or to the point MAXLEN units further along in
+# the pattern.  When the end of the pattern is reached wrap around and
+# duplicate the pattern indefinitely.
+
+int procedure sgi_getseg (maxlen, penup, ltype)
+
+int	maxlen			# max length segment to be returned
+bool	penup			# [out] pen up or pen down type segment?
+int	ltype			# line type code
+
+int	seglen, seg, lt
+int	p_seg[MAX_LTYPES]
+int	p_nseg[MAX_LTYPES]
+int	p_segleft[MAX_LTYPES]
+bool	p_penup[MAX_LTYPES,MAX_LSEGMENTS]
+int	p_seglen[MAX_LTYPES,MAX_LSEGMENTS]
+include	"ltype.dat"
+
+begin
+	lt = max (1, min (MAX_LTYPES, ltype - LT_OFFSET))
+	seg = p_seg[lt]
+	penup = p_penup[lt,seg]
+
+	repeat {
+	    if (maxlen < p_segleft[lt]) {
+		seglen = maxlen
+		p_segleft[lt] = p_segleft[lt] - seglen
+	    } else {
+		seglen = p_segleft[lt]
+		seg = seg + 1
+		if (seg > p_nseg[lt])
+		    seg = 1
+		p_seg[lt] = seg
+		p_segleft[lt] = p_seglen[lt,seg]
+	    }
+	} until (seglen > 0)
+
+	return (seglen)
+end
diff --git a/sys/gio/sgikern/sgiplset.x b/sys/gio/sgikern/sgiplset.x
new file mode 100644
index 00000000..30038437
--- /dev/null
+++ b/sys/gio/sgikern/sgiplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure sgi_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"sgi.com"
+
+begin
+	pl = SGI_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/sgikern/sgipm.x b/sys/gio/sgikern/sgipm.x
new file mode 100644
index 00000000..e53f3f03
--- /dev/null
+++ b/sys/gio/sgikern/sgipm.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"sgi.h"
+
+# SGI_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure sgi_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"sgi.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = SGI_PMAP(g_kt)
+
+	if (SGI_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call sgi_linetype (PM_LTYPE(pm))
+	    SGI_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (SGI_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    call sgk_linewidth (g_out, nint (GKI_UNPACKREAL(PM_WIDTH(pm))))
+	    SGI_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (SGI_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call sgi_color (PM_COLOR(pm))
+	    SGI_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	oldx = 0; oldy = 0
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx || y != oldy) {
+		call sgk_move (g_out, x, y)
+		call sgk_draw (g_out, x, y)
+	    }
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/sgikern/sgipmset.x b/sys/gio/sgikern/sgipmset.x
new file mode 100644
index 00000000..0d72392f
--- /dev/null
+++ b/sys/gio/sgikern/sgipmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_PMSET -- Set the polymarker attributes.
+
+procedure sgi_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"sgi.com"
+
+begin
+	pm = SGI_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/sgikern/sgireset.x b/sys/gio/sgikern/sgireset.x
new file mode 100644
index 00000000..a97034eb
--- /dev/null
+++ b/sys/gio/sgikern/sgireset.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"sgi.h"
+
+# SGI_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure sgi_reset()
+
+pointer	pl, pm, fa, tx
+include	"sgi.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = SGI_PLAP(g_kt)
+	pm = SGI_PMAP(g_kt)
+	fa = SGI_FAAP(g_kt)
+	tx = SGI_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	SGI_TYPE(g_kt)		= -1
+	SGI_WIDTH(g_kt)		= -1
+	SGI_COLOR(g_kt)		= -1
+	SGI_TXSIZE(g_kt)	= -1
+	SGI_TXFONT(g_kt)	= -1
+end
diff --git a/sys/gio/sgikern/sgitx.x b/sys/gio/sgikern/sgitx.x
new file mode 100644
index 00000000..d0db5c58
--- /dev/null
+++ b/sys/gio/sgikern/sgitx.x
@@ -0,0 +1,459 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"sgi.h"
+include	"font.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# SGI_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure sgi_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz, offset, cosv, sinv
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, totwidth
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment(), sgi_drawchar()
+include	"sgi.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = SGI_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by sgi_txset, and is just a scaling factor.
+
+	SGI_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != SGI_COLOR(g_kt)) {
+	    call sgi_color (TX_COLOR(tx))
+	    SGI_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line.
+	if (SGI_TYPE(g_kt) != GL_SOLID) {
+	    call sgi_linetype (GL_SOLID)
+	    SGI_TYPE(g_kt) = GL_SOLID
+	}
+
+	# No discreet character sizes, so just scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = SGI_CHARHEIGHT(g_kt,1) * tsz
+	cw = SGI_CHARWIDTH(g_kt,1) * tsz
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx), cw, totwidth)
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, totwidth, x0,y0, gki_dx,gki_dy,
+	    polytext, orien)
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+	cosv = cos (-DEGTORAD(orien))
+	sinv = sin (-DEGTORAD(orien))
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    offset = sgi_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + (offset * cosv)
+		    y = y - (offset * sinv)
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font, cw, totwidth)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+int	cw			# default character width
+int	totwidth		# seg width in GKI units
+
+int 	i
+int	ip, op
+int	totlen, font
+
+include	"font.com"
+include	"greek.com"
+
+begin
+	out[1] = start_font
+	font = start_font
+	totlen = 0
+	totwidth = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+                if (text[ip] < CHARACTER_START || text[ip] > CHARACTER_END)
+                    i = '?' - CHARACTER_START + 1
+                else
+                    i = text[ip]  - CHARACTER_START + 1
+ 
+		if (font == GT_GREEK) {
+		    totwidth = totwidth + 
+			int(real(gchwid[i]) / real(FONT_WIDTH) * cw)
+		} else {
+		    totwidth = totwidth + 
+			int(real(chrwid[i]) / real(FONT_WIDTH) * cw)
+		}
+
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, totwidth, x0, y0, dx, dy, polytext,
+   orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	totwidth		# width of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"sgi.com"
+
+begin
+	tx = SGI_TXAP(g_kt)
+
+	# Get character sizes in GKI coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = SGI_CHARHEIGHT(g_kt,1) * sz
+	cw = SGI_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	#xvlen = dx * (totlen - 1)
+	if (dx > 0)
+	    xvlen = totwidth - dx 
+	else
+	    xvlen = 0
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/sgikern/sgitxset.x b/sys/gio/sgikern/sgitxset.x
new file mode 100644
index 00000000..c064d556
--- /dev/null
+++ b/sys/gio/sgikern/sgitxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_TXSET -- Set the text drawing attributes.
+
+procedure sgi_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"sgi.com"
+
+begin
+	tx = SGI_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/sgikern/sgk.com b/sys/gio/sgikern/sgk.com
new file mode 100644
index 00000000..a919e147
--- /dev/null
+++ b/sys/gio/sgikern/sgk.com
@@ -0,0 +1,49 @@
+# SGK.COM -- The common for the SGK kernel.  A common is used here for maximum
+# efficiency (minimum indirection) when rasterizing vectors and encoding
+# metacode.  The maximum bitmap size is set at compile time in sgk.h.
+
+# Booleans put here to avoid possible alignment problems.
+
+bool	mf_bitmap			# metafile type, metacode or bitmap
+bool	mf_rotate			# rotate (swap x and y)
+bool	mf_yflip			# flip y axis end for end
+bool	mf_update			# update bitmap
+bool	mf_delete			# delete metacode file after dispose
+bool	mf_debug			# print kernel debugging messages
+bool	mf_swap2			# swap every 2 bytes on output
+bool	mf_swap4			# swap every 4 bytes on output
+bool	mf_oneperfile			# store each frame in a new file
+
+common	/sgkboo/ mf_bitmap, mf_rotate, mf_yflip, mf_update, mf_delete, mf_debug,
+	mf_swap2, mf_swap4, mf_oneperfile
+
+# Everything else goes here.
+
+int	mf_fd				# file descriptor of output file
+int	mf_frame			# frame counter
+char	mf_fname[SZ_PATHNAME]		# metafile filename
+char	mf_dispose[SZ_OSCMD]		# host dispose command
+
+int	mf_op				# [MCODE] index into obuf
+short	mf_obuf[LEN_OBUF]		# metacode buffer
+
+int	mf_cx, mf_cy			# [BITMAPS] current pen position
+int	mf_nbpb				# packing factor, bits per byte
+int	mf_pxsize, mf_pysize		# physical x, y size of bitmap, bits
+int	mf_wxsize, mf_wysize		# x, y size of bitmap window, bits
+int	mf_xorigin, mf_yorigin		# origin of bitmap window
+real	mf_xscale, mf_yscale		# to convert from NDC to device coords
+int	mf_xmin, mf_xmax		# x clipping limits
+int	mf_ymin, mf_ymax		# y clipping limits
+int	mf_lenframe			# frame size, words
+int	mf_linewidth			# relative line width
+int	mf_lworigin			# device width of line size 1.0
+real	mf_lwslope			# device pixels per line size increment
+int	mf_fbuf[LEN_FBUF]		# frame buffer (BIG)
+int	mf_bitmask[BPW]			# bit mask table
+
+common	/sgkcom/ mf_fd, mf_frame, mf_op, mf_cx, mf_cy, mf_nbpb, mf_pxsize,
+	mf_pysize, mf_wxsize, mf_wysize, mf_xorigin, mf_yorigin, mf_xscale,
+	mf_yscale, mf_xmin, mf_xmax, mf_ymin, mf_ymax, mf_lenframe,
+	mf_linewidth, mf_lworigin, mf_lwslope, mf_fbuf, mf_bitmask, mf_obuf,
+	mf_fname, mf_dispose
diff --git a/sys/gio/sgikern/sgk.h b/sys/gio/sgikern/sgk.h
new file mode 100644
index 00000000..09c62d95
--- /dev/null
+++ b/sys/gio/sgikern/sgk.h
@@ -0,0 +1,7 @@
+# SGK.H -- SGK metacode definitions.
+
+define	SGK_LENMCI	3		# SGK instruction length
+define	SGK_FRAME	1		# new frame instruction
+define	SGK_MOVE	2		# move pen
+define	SGK_DRAW	3		# draw pen
+define	SGK_SETLW	4		# set line width
diff --git a/sys/gio/sgikern/sgk.x b/sys/gio/sgikern/sgk.x
new file mode 100644
index 00000000..3ed77f76
--- /dev/null
+++ b/sys/gio/sgikern/sgk.x
@@ -0,0 +1,853 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <chars.h>
+include <gki.h>
+include "sgk.h"
+
+.help sgk
+.nf ---------------------------------------------------------------------------
+SGK -- Simple graphics device interface.  The purpose of this interface is
+to provide a simple means for interfacing new plotter devices to IRAF/GIO.
+The interface works by writing a binary metacode file and then disposing of
+it by issuing a command to the host system.
+
+       g_out = sgk_open (device, tty)		# device open
+	      sgk_close (g_out)			# device close
+	      sgk_flush (g_out)			# flush output
+
+	      sgk_frame (g_out)			# start a new frame
+	       sgk_move (g_out, x, y)		# move to (x,y)
+	       sgk_draw (g_out, x, y)		# draw a vector to (x,y)
+	  sgk_linewidth (g_out, width)		# set line width (>=1)
+
+The procedures comprising the top end of the SGK interface are summarized
+above and the code is included in this file.  These procedures could be
+rewritten by the user to talk directly to a graphics device if desired,
+although the metacode file interface is likely to be simpler in most cases.
+
+The SGK kernel can produce either metacode or bitmap output.  Metacode output
+is normally preferred for intelligent plotters and for pen plotters.  Bitmap
+output is normally preferred for raster plotters.  The type of output file
+to be generated is selected by the graphcap entry for an SGI/SGK device.
+
+The METACODE FORMAT written by the SGK interface is a sequence of 16 bit integer
+words containing binary opcodes and data.  The metacode is extremely simple,
+consisting of only two drawing instructions (pen up move and pen down draw),
+a frame instruction, and an optional set line width instruction.  All text is
+rendered into vectors by the SGI kernel hence there are no text drawing
+instructions.  The SGK metacode instruction formats are summarized below.
+
+     opcode / data words 
+
+          1  0  0               # frame instruction
+          2  X  Y               # move to (x,y)
+          3  X  Y               # draw to (x,y)
+          4  W  0               # set line width (>= 1, 1=normal, 2=bold)
+
+All opcodes and data words are 16 bit positive integers encoded in the machine
+independent MII format, i.e., most significant byte first.  Only 15 bits of
+each 16 bit word are actually used.  Coordinates are specified in the range 0
+to 32767.  All instructions are zero padded to 3 words to simplify metacode
+translation programs.
+
+The BITMAP FORMAT written by the SGK is even simpler than the metacode format.
+Output consists of a binary raster file containing one or more bitmaps with no
+embedded header information.  All bitmaps in a raster file are of the same
+size.  The size is specified in the graphcap entry for the device and may be
+passed to the host dispose task on the foreign task command line if desired.
+Page offsets may also be passed on the command line, e.g., to position the
+plot on the plotter page.
+
+The following graphcap fields apply to both metacode and bitmap devices.
+
+	DD	host command to dispose of metacode file ($F)
+	DB	have the kernel print debug messages during execution
+	RM	boolean; if present, SGK will delete metacode file
+	MF	multiframe count (max frames per job)
+	NF	store each frame in a new file (rather than all in one file)
+	RO	rotate plot (swap x and y)
+	YF	y-flip plot (flip y axis) (done after rotate)
+
+The following additional fields are defined for bitmap devices.
+
+	BI	boolean; presence indicates a bitmapped or raster device
+	LO	width in device pixels of a line of size 1.0
+	LS	difference in device pixels between line sizes
+	PX	physical x size (linelen) of bitmap as stored in memory, bits
+	PY	physical y size of bitmap, i.e., number of lines in bitmap
+	XO,YO	origin of plotting window in device pixels
+	XW,YW	width of plotting window in device pixels
+	NB	number of bits to be set in each 8 bit byte output
+	BF	bit-flip each byte in bitmap (easier here than later)
+	BS	byte swap the bitmap when output (swap every two bytes)
+	WS	word swap the bitmap when output (swap every four bytes)
+
+The multiframe count (MF) limits the number of frames per job, where a job
+refers to the dispose command submitted to the host to process the frames.
+If the new file flag (NF) is absent, all frames will be stored in the same
+physical file (this holds for both metacode and bitmap frames).  If the new
+file flag (NF) is set, each frame will be stored in a separate file, with
+the N files having the names $F.1, $F.2, ... $F.N, where $F is the unique
+(root) filename generated from the template given in the DD string.  The $F
+is replaced by the root filename, rather than by a list of all the filenames,
+to keep the OS command to a reasonable length and to permit the use of host
+file templates to perform operate upon the full set of files (and to avoid
+having to choose between spaces and commas to delimit the filenames).
+For example, if MF=8 and NF=yes, then "$F.[1-8]" will match the file set
+on a UNIX host.  The template "$F.*" is less precise but would also work.
+
+The output raster will consist of PY lines each of length PX bits.  If PX is
+chosen to be a multiple of 8, there will be PX/8 bytes per line of the output
+raster.  Note that the values of PX and PY are arbitrary and should be chosen
+to simplify the code of the translator and maximize efficiency.  In particular,
+PX and PY do not in general define the maximum physical resolution of the
+device, although if NB=8 the value of PX will typically approximate the
+physical resolution in X.  If there are multiple bitmap frames per file,
+each frame will occupy an integral number of SPP char units of storage in the
+output file, with the values of any extra bits at the end of the bitmap being
+undefined (a char is 16 bits on most IRAF host machines).
+
+The plot will be rasterized in a logical window XW one-bit pixels wide and YW
+pixels high.  The first YO lines of the output raster will be zero, with the
+plotting window beginning at line YO+1.  The first XO bits of each output line
+will be zeroed, with the plotting window beginning at bit XO+1.  The bytes in
+each output line may be bit-flipped if desired, and all of the bits in each
+output byte need not be used for pixel data.  If the bit packing factor NB is
+set to 8 the plotting window will map into XW bits of storage of each output
+line.  If fewer than 8 bits are used in each output byte more than XW physical
+bits of storage will be used, e.g., if NB=4, XW*2 bits of storage are required
+for a line of the plotting window.  The unused bits are set to zero.  The
+translator can later "or" a mask into the zeroed bits, flip the data bits,
+or perform any other bytewise operation using simple lookup table mapping
+techniques.
+.endhelp ----------------------------------------------------------------------
+
+# NOTE -- The mf_physbit lookup table, used to map logical screen bits into
+# physical bits in the bitmap (for NB != 8) is equivalenced to the mf_obuf
+# array which is not otherwise used for bitmap devices.  The length of the
+# mf_obuf array must therefore be >= PX.
+
+define	mf_physbit	mf_obuf		# union these two arrays [[[NOTE]]]
+define	BPW		NBITS_INT	# nbits in an integer
+define	LEN_FBUF	(2550*3300/BPW)	# max size bitmap / frame buffer
+define	LEN_OBUF	3300		# nwords in output buffer
+define	SZ_DDSTR	256		# max size graphcap.DD
+define	SZ_OSCMD	256		# OS dispose command from graphcap.DD
+
+
+# SGK_OPEN -- Open the metacode file.  Parse the DD string from the graphcap
+# entry for the device to get the file template and OS dispose command.
+# Generate a unique file name and open the metacode file as a NEW_FILE.
+# Save the dispose command for later.
+
+int procedure sgk_open (device, tty)
+
+char	device[ARB]		# device name [NOT USED]
+pointer	tty			# pointer to graphcap descriptor
+
+char	cap[2]
+int	len_nodeprefix, byte, off, op, i, j
+pointer	sp, raw_ddstr, ddstr, devname, spool, fname, tempfn, val, ip
+
+bool	ttygetb()
+real	ttygetr()
+int	open(), ttygets(), ttygeti(), gstrcpy(), shifti()
+errchk	open, ttygets, ttygeti, ttygetb
+include	"sgk.com"
+
+begin
+	call smark (sp)
+	call salloc (raw_ddstr, SZ_DDSTR, TY_CHAR)
+	call salloc (ddstr, SZ_DDSTR, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (spool, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tempfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (val, SZ_FNAME, TY_CHAR)
+
+	# The DB flag may be set in the graphcap entry for an SGI device to
+	# print debug messages during execution.
+
+	mf_debug = ttygetb (tty, "DB")
+
+	# The DD string is used to pass device dependent information to the
+	# graphics device driver.
+
+	if (ttygets (tty, "DD", Memc[raw_ddstr], SZ_DDSTR) <= 0)
+	    call error (1, "sgikern: missing DD parameter in graphcap")
+
+	# Expand any $(XX) graphcap parameter references in the DD string.
+	op = ddstr
+	for (ip=raw_ddstr;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == '$' && Memc[ip+1] == '(' && Memc[ip-1] != '\\') {
+		# Graphcap parameter substitution.
+		call strcpy (Memc[ip+2], cap, 2)
+		if (ttygets (tty, cap, Memc[val], SZ_FNAME) <= 0) {
+		    call eprintf ("Warning: graphcap field `%s' not found\n")
+			call pargstr (cap)
+		} else {
+		    for (off=val;  Memc[off] == '#';  off=off+1)
+			;
+		    for (;  Memc[off] != EOS;  off=off+1) {
+			Memc[op] = Memc[off]
+			op = op + 1
+		    }
+		}
+		ip = ip + 4
+		    
+	    } else {
+		# Ordinary character.
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Parse the DD string into the node/device name, temp file name,
+	# and host dispose command.
+
+	# Get node and device name (e.g., "node!device,...").
+	len_nodeprefix = 0
+	ip = ddstr
+	for (op=devname;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		if (Memc[ip-1] == '\\') {
+		    Memc[op-1] = ','
+		    ip = ip - 1
+		} else {
+		    ip = ip + 1
+		    break
+		}
+	    } else {
+		if (Memc[ip] == FNNODE_CHAR)
+		    len_nodeprefix = op - devname + 1
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Get spoolfile root name.
+	op = spool + gstrcpy (Memc[devname], Memc[spool], len_nodeprefix)
+	for (;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		if (Memc[ip-1] == '\\') {
+		    Memc[op-1] = ','
+		    ip = ip - 1
+		} else {
+		    ip = ip + 1
+		    break
+		}
+	    } else {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Get OS pathname of spoofile.
+	call mktemp (Memc[spool], Memc[tempfn], SZ_PATHNAME)
+	call fmapfn (Memc[tempfn], mf_fname, SZ_PATHNAME)
+	call strupk (mf_fname, mf_fname, SZ_PATHNAME)
+
+	# Get pathname of spoolfile on the remote node.  The call to
+	# ki_fmapfn() is currently necessary to translate the filename for
+	# the remote node, but may be replaced by the usual fmapfn() in a
+	# future version of the kernel interface.
+
+	call ki_fmapfn (Memc[tempfn], Memc[fname], SZ_PATHNAME)
+	call strupk (Memc[fname], Memc[fname], SZ_PATHNAME)
+
+	if (mf_debug) {
+	    call eprintf ("sgk: open device %s, outfile = %s\n")
+		call pargstr (Memc[devname])
+		call pargstr (mf_fname)
+	}
+
+	# Copy OS command for disposing of metacode file into common, replacing
+	# all $F sequences in the command by the OS pathname of the spool file.
+
+	op = gstrcpy (Memc[devname], mf_dispose, len_nodeprefix) + 1
+
+	for (;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == '$' && Memc[ip-1] == '\\') {
+		# Escape a $.
+		mf_dispose[op-1] = '$'
+
+	    } else if (Memc[ip] == '$' && Memc[ip+1] == 'F') {
+		# Filename substitution.
+		for (i=fname;  Memc[i] != EOS;  i=i+1) {
+		    mf_dispose[op] = Memc[i]
+		    op = op + 1
+		}
+		ip = ip + 1
+
+	    } else {
+		# Ordinary character.
+		mf_dispose[op] = Memc[ip]
+		op = op + 1
+	    }
+
+	mf_dispose[op] = EOS
+
+	# Remove (delete) metacode file after issuing OS dispose command?
+	mf_delete = ttygetb (tty, "RM")
+
+	# Store each frame in a new file?
+	mf_oneperfile = ttygetb (tty, "NF")
+
+	mf_update = false
+	mf_frame = 1
+
+	# Open a new metacode file.
+	if (mf_oneperfile)
+	    call sgk_mkfname (mf_fname, mf_frame, Memc[fname], SZ_FNAME)
+	else
+	    call strcpy (mf_fname, Memc[fname], SZ_FNAME)
+
+	if (mf_debug) {
+	    call eprintf ("sgk: open frame %2d, outfile = %s\n")
+		call pargi (mf_frame)
+		call pargstr (Memc[fname])
+	}
+	mf_fd = open (Memc[fname], NEW_FILE, BINARY_FILE)
+
+	# Rotate plot (swap x,y)?  Y-flip plot?
+	mf_rotate = ttygetb (tty, "RO")
+	mf_yflip  = ttygetb (tty, "YF")
+
+	# Raster (bitmap) or metacode device?
+	mf_bitmap = ttygetb (tty, "BI")
+
+	if (mf_bitmap) {
+	    # Bitmap output; initialize bitmap parameters.
+
+	    mf_pxsize   = ttygeti (tty, "PX")
+	    mf_pysize   = ttygeti (tty, "PY")
+	    mf_xorigin  = ttygeti (tty, "XO")
+	    mf_yorigin  = ttygeti (tty, "YO")
+	    mf_wxsize   = ttygeti (tty, "XW")
+	    mf_wysize   = ttygeti (tty, "YW")
+	    mf_nbpb	= ttygeti (tty, "NB")
+	    mf_swap2	= ttygetb (tty, "BS")
+	    mf_swap4	= ttygetb (tty, "WS")
+
+	    mf_lworigin = max (1, ttygeti (tty, "LO"))
+	    mf_lwslope  = ttygetr (tty, "LS")
+	    mf_lenframe = (mf_pxsize * mf_pysize + BPW-1) / BPW
+
+	    if (mf_wxsize == 0)
+		mf_wxsize = mf_pxsize - mf_xorigin
+	    if (mf_wysize == 0)
+		mf_wysize = mf_pysize - mf_yorigin
+	    if (mf_nbpb == 0)
+		mf_nbpb = NBITS_BYTE
+
+	    mf_linewidth = mf_lworigin
+	    mf_cx = 0
+	    mf_cy = 0
+
+	    mf_xmin = mf_xorigin
+	    mf_ymin = mf_yorigin
+	    mf_xmax = mf_xmin + mf_wxsize - 1
+	    mf_ymax = mf_ymin + mf_wysize - 1
+
+	    mf_xscale = real(mf_wxsize) / real(GKI_MAXNDC)
+	    mf_yscale = real(mf_wysize) / real(GKI_MAXNDC)
+
+	    if (mf_lenframe > LEN_FBUF)
+		call error (1, "sgikern: bitmap too large")
+
+	    # Initialize the bit mask table.  If it is necessary to bit-flip
+	    # bytes in the bitmap, we can do that here by flipping each byte
+	    # of the word mask.  Bit flipping can be done during rasterization
+	    # at no additional cost, but is an expensive operation if done
+	    # later with a filter.
+
+	    if (ttygetb (tty, "BF")) {
+		do j = 1, (BPW/NBITS_BYTE)
+		    do i = 1, NBITS_BYTE {
+			off = (j - 1) * NBITS_BYTE
+			mf_bitmask[off+i] = shifti (1, off + NBITS_BYTE - i)
+		    }
+	    } else {
+		do i = 1, BPW
+		    mf_bitmask[i] = shifti (1, i - 1)
+	    }
+
+	    # Initialize the bit offset lookup table.  This gives the physical
+	    # x-offset into the lookup table of each addressable x-coordinate
+	    # on the device.  If NB is NBITS_BYTE the mapping is one-to-one.
+	    # Note that the table contains zero-indexed bit offsets.
+
+	    do i = 1, mf_pxsize {
+		byte = (i - 1) / mf_nbpb
+		mf_physbit[i] = min (mf_pxsize,
+		    byte * NBITS_BYTE + (i - (byte * mf_nbpb))) - 1
+	    }
+
+	    if (mf_debug) {
+		call eprintf ("bitmap [%d,%d] origin=[%d,%d] wsize=[%d,%d]\n")
+		    call pargi (mf_pxsize);  call pargi (mf_pysize)
+		    call pargi (mf_xorigin); call pargi (mf_yorigin)
+		    call pargi (mf_wxsize);  call pargi (mf_wysize)
+	    }
+
+	} else {
+	    # Metacode output; initialize the metacode output buffer.
+	    mf_op = 1
+	    if (mf_debug)
+		call eprintf ("metafile device\n")
+	}
+
+	call sfree (sp)
+	return (mf_fd)
+end
+
+
+# SGK_CLOSE -- Close the metacode spool file and dispose of it to a host system
+# metacode translation task.  Delete the spool file when the OS command
+# completes, unless it has already been deleted by the task run.
+
+procedure sgk_close (fd)
+
+int	fd			# output stream [NOT USED]
+
+int	i
+pointer	sp, fname
+int	oscmd()
+errchk	sgk_flush, close, oscmd
+include	"sgk.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	if (mf_debug)
+	    call eprintf ("close device\n")
+
+	if (mf_bitmap)
+	    call sgk_frame (mf_fd)
+	else
+	    call sgk_flush (mf_fd)
+
+	if (mf_debug) {
+	    call eprintf ("dispose: %s\n")
+		call pargstr (mf_dispose)
+	}
+
+	if (mf_fd != NULL) {
+	    call close (mf_fd)
+	    mf_fd = NULL
+	}
+
+	# Send the dispose command to the host system.
+	if (mf_dispose[1] != EOS)
+	    if (oscmd (mf_dispose, "", "", "") != OK)
+		call eprintf ("Warning: SGK graphics output dispose error\n")
+
+	# Delete the metacode or raster file if so indicated in the graphcap
+	# entry for the device.
+
+	if (mf_delete) {
+	    if (mf_debug) {
+		call eprintf ("delete metafile %s\n")
+		    call pargstr (mf_fname)
+	    }
+	    if (mf_oneperfile) {
+		do i = 1, mf_frame {
+		    call sgk_mkfname (mf_fname, i, Memc[fname], SZ_FNAME)
+		    iferr (call delete (Memc[fname]))
+			;
+		}
+	    } else iferr (call delete (mf_fname))
+		;
+	}
+
+	call sfree (sp)
+end
+
+
+# SGK_FLUSH -- Flush any buffered metacode output.
+
+procedure sgk_flush (fd)
+
+int	fd			# output stream [NOT USED]
+include	"sgk.com"
+
+begin
+	if (!mf_bitmap && mf_op > 1) {
+	    if (mf_debug)
+		call eprintf ("flush graphics output\n")
+	    call miiwrites (mf_fd, mf_obuf, mf_op-1)
+	    mf_op = 1
+	}
+
+	if (mf_fd != NULL)
+	    call flush (mf_fd)
+end
+
+
+# SGK_FRAME -- Output a frame advance instruction.
+
+procedure sgk_frame (fd)
+
+int	fd			# output stream [NOT USED]
+include	"sgk.com"
+
+begin
+	# Ignore frame commands if frame is empty.
+	if (!mf_update)
+	    return
+
+	if (mf_debug)
+	    call eprintf ("start a new frame\n")
+
+	if (mf_bitmap) {
+	    # Write the bitmap to the output raster-file.
+
+	    if (mf_swap2)
+		call bswap2 (mf_fbuf, 1, mf_fbuf, 1,
+		    mf_lenframe * SZ_INT * SZB_CHAR)
+	    if (mf_swap4)
+		call bswap4 (mf_fbuf, 1, mf_fbuf, 1,
+		    mf_lenframe * SZ_INT * SZB_CHAR)
+
+	    call write (mf_fd, mf_fbuf, mf_lenframe * SZ_INT)
+
+	} else {
+	    # Write the SGI frame instruction to the output mcode-file.
+
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_FRAME
+	    mf_obuf[mf_op+1] = 0
+	    mf_obuf[mf_op+2] = 0
+	    mf_op = mf_op + SGK_LENMCI
+	}
+
+	mf_frame = mf_frame + 1
+	mf_update = false
+end
+
+
+# SGK_MOVE -- Output a pen move instruction.
+
+procedure sgk_move (fd, x, y)
+
+int	fd			# output stream [NOT USED]
+int	x, y			# point to move to
+
+include	"sgk.com"
+
+begin
+	if (mf_bitmap) {
+	    if (mf_rotate) {
+		mf_cx = y
+		mf_cy = x
+	    } else {
+		mf_cx = x
+		mf_cy = y
+	    }
+
+	    if (mf_yflip)
+		mf_cy = GKI_MAXNDC - mf_cy
+
+	    # Convert to zero indexed coordinates and clip at boundary.
+	    # Allow room for line width shift near boundary.
+
+	    mf_cx = max (mf_xmin, min (mf_xmax,
+		int (mf_cx * mf_xscale) + mf_xorigin))
+	    mf_cy = max (mf_ymin, min (mf_ymax,
+		int (mf_cy * mf_yscale) + mf_yorigin))
+
+	} else {
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_MOVE
+	    if (mf_rotate) { 
+		mf_obuf[mf_op+1] = y
+		mf_obuf[mf_op+2] = x
+	    } else {
+		mf_obuf[mf_op+1] = x
+		mf_obuf[mf_op+2] = y
+	    }
+	    if (mf_yflip)
+		mf_obuf[mf_op+2] = GKI_MAXNDC - mf_obuf[mf_op+2]
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_DRAW -- Output a pen draw instruction.
+
+procedure sgk_draw (fd, a_x, a_y)
+
+int	fd			# output stream [NOT USED]
+int	a_x, a_y		# point to draw to
+
+char	fname[SZ_FNAME]
+int	xshift, yshift, dx, dy
+int	new_x, new_y, x1, y1, x2, y2, n, i
+int	open()
+errchk	open, close
+include	"sgk.com"
+
+begin
+	if (mf_rotate) {
+	    new_x = a_y
+	    new_y = a_x
+	} else {
+	    new_x = a_x
+	    new_y = a_y
+	}
+
+	if (mf_yflip)
+	    new_y = GKI_MAXNDC - new_y
+
+	if (!mf_update) {
+	    # We are called when the first drawing instruction is output for a
+	    # new frame.  We clear the bitmap or close and open a new frame
+	    # file here, rather than at sgk_frame() time, as we do not want
+	    # to initialize the frame buffer or open a new frame file unless
+	    # we are actually going to write into the frame.
+
+	    # Zero out all the bits in a bitmap.
+	    if (mf_bitmap)
+		call aclri (mf_fbuf, mf_lenframe)
+
+	    # Open a new frame file if the one frame per file flag is set.
+	    if (mf_oneperfile && mf_frame > 1) {
+		if (mf_fd != NULL)
+		    call close (mf_fd)
+		call sgk_mkfname (mf_fname, mf_frame, fname, SZ_FNAME)
+		if (mf_debug) {
+		    call eprintf ("sgk: open frame %2d, outfile = %s\n")
+			call pargi (mf_frame)
+			call pargstr (fname)
+		}
+		mf_fd = open (fname, NEW_FILE, BINARY_FILE)
+	    }
+
+	    mf_update = true
+	}
+
+	if (mf_bitmap) {
+	    # Convert to zero indexed coordinates and clip at boundary.
+	    # Allow room for line width shift near boundary.
+
+	    new_x = max (mf_xmin, min (mf_xmax,
+		int (new_x * mf_xscale) + mf_xorigin))
+	    new_y = max (mf_ymin, min (mf_ymax,
+		int (new_y * mf_yscale) + mf_yorigin))
+
+	    if (mf_linewidth <= 1)
+		call sgk_vector (mf_cx, mf_cy, new_x, new_y)
+	    else {
+		# Redraw the vector several times with small normal shifts to
+		# produce a wider line.
+
+		xshift = 0
+		yshift = 0
+
+		if (abs (new_x - mf_cx) > abs (new_y - mf_cy)) {
+		    dx = 0
+		    dy = 1
+		} else {
+		    dx = 1
+		    dy = 0
+		}
+
+		do i = 1, mf_linewidth {
+		    x1 = mf_cx + xshift
+		    y1 = mf_cy + yshift
+		    x2 = new_x + xshift
+		    y2 = new_y + yshift
+
+		    call sgk_vector (x1, y1, x2, y2)
+
+		    n = (i + 1) / 2
+		    if (and (i, 1) == 0) {
+			xshift =  dx * n
+			yshift =  dy * n
+		    } else {
+			xshift = -dx * n
+			yshift = -dy * n
+		    }
+		}
+	    }
+
+	    # Update the current pen position, and set the update flag so that
+	    # the bitmap will be written to the output file.
+
+	    mf_cx = new_x
+	    mf_cy = new_y
+
+	} else {
+	    # Output a metacode draw instruction.
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_DRAW
+	    mf_obuf[mf_op+1] = new_x
+	    mf_obuf[mf_op+2] = new_y
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_VECTOR -- Write a vector (line) of unit width into the bitmap.  The line
+# endpoints are expressed in physical device coordinates.
+
+procedure sgk_vector (a_x1, a_y1, a_x2, a_y2)
+
+int	a_x1, a_y1			# start point of line
+int	a_x2, a_y2			# end point of line
+
+real	dydx, dxdy
+long	fbit, wbit, word
+int	wpln, mask, dx, dy, x, y, x1, y1, x2, y2, or()
+include	"sgk.com"
+
+begin
+	x1 = a_x1; y1 = a_y1
+	x2 = a_x2; y2 = a_y2
+
+	dx = x2 - x1
+	dy = y2 - y1
+
+	if (abs(dx) > abs(dy)) {
+	    if (x1 > x2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dy == 0 && mf_nbpb == NBITS_BYTE) {
+		# Somewhat optimized code for the case of a horiz. vector.
+
+		fbit = y1 * mf_pxsize + x1
+		word = fbit / BPW
+		wbit = and (fbit, BPW-1)
+
+		do x = x1, x2 {
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		    wbit = wbit + 1
+		    if (wbit >= BPW) {
+			wbit = 0
+			word = word + 1
+		    }
+		}
+
+	    } else {
+		# The general case for a mostly-X vector.
+
+		dydx = real(dy) / real(dx)
+		do x = x1, x2 {
+		    y = int ((x - x1) * dydx) + y1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else if (dy != 0) {
+	    if (y1 > y2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dx == 0) {
+		# Optimized code for the case of a vertical vector.
+
+		fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+		word = fbit / BPW + 1
+		wbit = and (fbit, BPW-1)
+		wpln = (mf_pxsize + BPW-1) / BPW
+		mask = mf_bitmask[wbit+1]
+
+		do y = y1, y2 {
+		    mf_fbuf[word] = or (mf_fbuf[word], mask)
+		    word = word + wpln
+		}
+
+	    } else {
+		# The general case of a mostly-Y vector.
+
+		dxdy = real(dx) / real(dy)
+		do y = y1, y2 {
+		    x = int ((y - y1) * dxdy) + x1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else {
+	    # Plot a single point (dx=dy=0).
+
+	    fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+	    word = fbit / BPW
+	    wbit = and (fbit, BPW-1)
+	    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+	}
+end
+
+
+# SGK_LINEWIDTH -- Output a line width set instruction.
+
+procedure sgk_linewidth (fd, width)
+
+int	fd			# output stream [NOT USED]
+int	width			# new line width
+
+int	gap
+include	"sgk.com"
+
+begin
+	if (mf_bitmap) {
+	    # Set the line width in device pixels.
+	    mf_linewidth = max (1, mf_lworigin + int ((width-1) * mf_lwslope))
+
+	    # Set the clipping limits.  Allow for shifting to widen lines.
+	    gap = mf_linewidth - 1
+	    mf_xmin = mf_xorigin + gap
+	    mf_ymin = mf_yorigin + gap
+	    mf_xmax = mf_xorigin + (mf_wxsize - 1) - gap
+	    mf_ymax = mf_yorigin + (mf_wysize - 1) - gap
+
+	} else {
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_SETLW
+	    mf_obuf[mf_op+1] = width
+	    mf_obuf[mf_op+2] = 0
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_MKFNAME -- Make the name of file N of a multiframe set.
+
+procedure sgk_mkfname (root, num, outstr, maxch)
+
+char	root[ARB]		# root filename
+int	num			# file number
+char	outstr[maxch]		# receives new filename
+int	maxch
+
+begin
+	call sprintf (outstr, maxch, "%s.%d")
+	    call pargstr (root)
+	    call pargi (num)
+end
diff --git a/sys/gio/sgikern/t_sgideco.x b/sys/gio/sgikern/t_sgideco.x
new file mode 100644
index 00000000..57dae876
--- /dev/null
+++ b/sys/gio/sgikern/t_sgideco.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+include	"sgk.h"
+
+define	LEN_MCBUF	3000
+
+
+# SGIDECODE -- Decode an SGI metacode file, printing the decoded metacode
+# instructions on the standard output.
+
+procedure t_sgidecode()
+
+pointer	sp, fname, mcbuf, ip, itop
+int	fd, list, verbose, gkiunits, nwords
+
+bool	clgetb()
+int	clpopni(), clgfil(), clplen(), open(), btoi(), miireads()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (mcbuf, LEN_MCBUF, TY_SHORT)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	if (clgetb ("generic")) {
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Print header if new file.
+	    if (clplen (list) > 1) {
+		call printf ("\n# METAFILE `%s':\n")
+		    call pargstr (Memc[fname])
+	    }
+
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode.
+
+	    itop = mcbuf
+	    ip   = mcbuf
+
+	    repeat {
+		if (ip >= itop) {
+		    # Refill buffer.
+		    nwords = miireads (fd, Mems[mcbuf], LEN_MCBUF)
+		    if (nwords == EOF)
+			break
+		    itop = mcbuf + nwords
+		    ip = mcbuf
+		}
+		
+		switch (Mems[ip]) {
+		case SGK_FRAME:
+		    call printf ("new_frame\n")
+		case SGK_MOVE:
+		    if (gkiunits == YES) {
+			call printf ("move (%d, %d)\n")
+			    call pargs (Mems[ip+1])
+			    call pargs (Mems[ip+2])
+		    } else {
+			call printf ("move (%0.5f, %0.5f)\n")
+			    call pargr (real(Mems[ip+1]) / real(GKI_MAXNDC))
+			    call pargr (real(Mems[ip+2]) / real(GKI_MAXNDC))
+		    }
+		case SGK_DRAW:
+		    if (gkiunits == YES) {
+			call printf ("draw (%d, %d)\n")
+			    call pargs (Mems[ip+1])
+			    call pargs (Mems[ip+2])
+		    } else {
+			call printf ("draw (%0.5f, %0.5f)\n")
+			    call pargr (real(Mems[ip+1]) / real(GKI_MAXNDC))
+			    call pargr (real(Mems[ip+2]) / real(GKI_MAXNDC))
+		    }
+		case SGK_SETLW:
+		    call printf ("set_linewidth (%d)\n")
+			call pargs (Mems[ip+1])
+		default:
+		    call printf ("unknown instruction\n")
+		}
+
+		ip = ip + SGK_LENMCI
+	    }
+
+	    call close (fd)
+	}
+
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/t_sgikern.x b/sys/gio/sgikern/t_sgikern.x
new file mode 100644
index 00000000..359a87ad
--- /dev/null
+++ b/sys/gio/sgikern/t_sgikern.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# SGIKERN -- Generic graphics kernel for the standard plotter output.  The whole
+# package is copied as much as possible from the stdgraph package.
+
+procedure t_sgikern()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Open the graphics kernel.
+	call sgi_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call sgi_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/x_sgikern.x b/sys/gio/sgikern/x_sgikern.x
new file mode 100644
index 00000000..797820c2
--- /dev/null
+++ b/sys/gio/sgikern/x_sgikern.x
@@ -0,0 +1,5 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	stdplot		= t_sgikern,
+	sgikern		= t_sgikern,
+	sgidecode	= t_sgidecode
diff --git a/sys/gio/stdgraph/README b/sys/gio/stdgraph/README
new file mode 100644
index 00000000..6007b9b1
--- /dev/null
+++ b/sys/gio/stdgraph/README
@@ -0,0 +1,77 @@
+gio$stdgraph
+
+    This directory contains the source and executables for the STDGRAPH and
+GKIDECODE graphics kernels.  The two kernels are implemented both as libraries
+and as executable tasks.
+
+	gkidecode	This kernel is used standalone to examine GKI
+			metafiles.  The real work is done by the GKIPRINT
+			library module in the GIO package.
+
+	stdgraph	A graphics kernel for graphics terminals.  Implemented
+			both as the library "libstdg.a" and as the kernel task
+			STDGRAPH.  The library is required for this kernel to
+			permit inclusion of the stdgraph kernel in the CL
+			process.
+
+Both kernels are available as CL callable tasks in the executable file
+x_kernel.e.
+
+
+GKIPRINT -- Graphics kernel for decoding metacode.  This graphics kernel
+formats metacode instructions into readable form and prints them on the output
+file.  The gkiprint kernel is useful for examining metafiles and for
+debugging kernels which drive specific devices.  The driver consists of the
+following procedures:
+
+	     gkp_openws (devname, n, mode)
+	    gkp_closews (devname, n)
+	    gkp_mftitle (title, n)			**
+	      gkp_clear (dummy)
+	     gkp_cancel (dummy)
+	      gkp_flush (dummy)
+	   gkp_polyline (p, npts)
+	 gkp_polymarker (p, npts)
+	       gkp_text (x, y, text, n)
+	   gkp_fillarea (p, npts)
+       gkp_getcellarray (m, nx, ny, x1,y1, x2,y2)
+       gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+	  gkp_setcursor (x, y, cursor)
+	      gkp_plset (gki)
+	      gkp_pmset (gki)
+	      gkp_txset (gki)
+	      gkp_faset (gki)
+	  gkp_getcursor (cursor)
+	     gkp_escape (fn, instruction, nwords)	**
+	     gkp_setwcs (wcs, nwords)			**
+	     gkp_getwcs (wcs, nwords)			**
+	    gkp_unknown (gki)				**
+
+A GKI driven device driver may implement any subset of these procedures.
+The starred procedures should be omitted by most drivers.  In particular,
+the SETWCS and GETWCS instructions are internal instructions which should
+be ignored by ordinary device drivers.  The procedure names may be anything,
+but the arguments lists must be as shown.  All coordinates are in GKI units,
+0 to 32767.  Character strings are passed in ASCII, one character per metacode
+word.  Whenever a GKI character string appears as an array argument in the
+argument list of a procedure, the count N of the number of characters in the
+string follows as the next argument.  GKI character strings are not EOS
+delimited.  Polyline, polymarker, and fillarea data is passed as an array
+of (x,y) points P, in GKI coordinates, defining the polyline or polygon to
+be plotted.
+
+One additional procedure, GKP_INSTALL, is called by the main program of the
+graphics kernel task to install the debugging driver, i.e., to fill the DD
+array with the entry point addresses of the driver procedures.  For a normal
+driver this function is performed by a user supplied procedure named
+GKOPEN (graphics kernel open).  The user supplied kernel procedures will
+be called to execute each instruction as the instructions are decoded by the
+main routine.  The user supplied procedure GKCLOSE will be called when
+interpretation ends and the task is about to exit.
+
+		 gkopen (dd)
+		gkclose ()
+
+Do not confuse GKOPEN and GKCLOSE, which open and close the graphics kernel,
+with GKI_OPENWS and GKI_CLOSEWS, the metacode instructions used to direct
+an opened kernel to open and close workstations.
diff --git a/sys/gio/stdgraph/font.com b/sys/gio/stdgraph/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/stdgraph/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/stdgraph/font.h b/sys/gio/stdgraph/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/stdgraph/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/stdgraph/mkpkg b/sys/gio/stdgraph/mkpkg
new file mode 100644
index 00000000..8530f2c9
--- /dev/null
+++ b/sys/gio/stdgraph/mkpkg
@@ -0,0 +1,80 @@
+# Make the STDGRAPH GIO graphics kernel.
+
+$checkout libstg.a lib$
+$update   libstg.a
+$checkin  libstg.a lib$
+$exit
+
+update:					# update lib$x_stdgraph.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_stdgraph.e in local directory
+	$omake	x_stdgraph.x
+	$link	x_stdgraph.o -lstg
+	;
+
+install:				# install in system library
+	$move	x_stdgraph.e bin$
+	;
+
+libstg.a:
+	# $set xflags = "$(xflags) -qfx"
+
+	stgcancel.x	stdgraph.com stdgraph.h <fset.h>
+	stgclear.x	stdgraph.com stdgraph.h
+	stgclose.x	stdgraph.com stdgraph.h
+	stgclws.x	stdgraph.h <ttset.h> stdgraph.com
+	stgctrl.x	stdgraph.com stdgraph.h
+	stgdeact.x	stdgraph.com stdgraph.h <gset.h> <ttset.h>
+	stgdraw.x	stdgraph.com stdgraph.h
+	stgdrawch.x	font.com font.h stdgraph.com stdgraph.h <gki.h>\
+			<gset.h> <math.h>
+	stgencode.x	stdgraph.com stdgraph.h <ctype.h>
+	stgescape.x	
+	stgfa.x		stdgraph.com stdgraph.h
+	stgfaset.x	stdgraph.com stdgraph.h <gki.h>
+	stgfilter.x	stdgraph.com stdgraph.h <ttset.h> <chars.h> <fset.h>
+	stgflush.x	stdgraph.com stdgraph.h
+	stggcell.x	
+	stggcur.x	stdgraph.com stdgraph.h
+	stggdisab.x	stdgraph.com stdgraph.h
+	stggim.x	stdgraph.com stdgraph.h <chars.h> <ctype.h> <fset.h>\
+			<mach.h> <gescape.h> <gki.h> <gim.h>
+	stggenab.x	stdgraph.com stdgraph.h
+	stggrstr.x	stdgraph.com stdgraph.h
+	stginit.x	stdgraph.com stdgraph.h <ctype.h> <gki.h> <gset.h>\
+			<mach.h>
+	stglkcur.x	stdgraph.com stdgraph.h <gset.h>
+	stgmove.x	stdgraph.com stdgraph.h
+	stgonerr.x	stdgraph.com stdgraph.h
+	stgonint.x	stdgraph.h <config.h> <xwhen.h>
+	stgopen.x	stdgraph.com stdgraph.h <gki.h> <gset.h>
+	stgopenws.x	stdgraph.com stdgraph.h <error.h> <gki.h> <ttset.h>\
+			<chars.h> <finfo.h>
+	stgoutput.x	stdgraph.com stdgraph.h
+	stgoutstr.x	stdgraph.com stdgraph.h
+	stgpcell.x	stdgraph.com stdgraph.h <gki.h>
+	stgpl.x		stdgraph.com stdgraph.h
+	stgplset.x	stdgraph.com stdgraph.h <gki.h>
+	stgpm.x		stdgraph.com stdgraph.h
+	stgpmset.x	stdgraph.com stdgraph.h <gki.h>
+	stgrcur.x	stdgraph.com stdgraph.h <chars.h> <config.h> <error.h>\
+			<fset.h> <gki.h> <gset.h> <ttset.h>
+	stgreact.x	stdgraph.com stdgraph.h <gset.h> <ttset.h>
+	stgres.x	stdgraph.com stdgraph.h <gki.h>
+	stgreset.x	stdgraph.com stdgraph.h <gset.h>
+	stgrtty.x	stdgraph.com stdgraph.h <chars.h> <fset.h>
+	stgscur.x	stdgraph.com stdgraph.h
+	stgtx.x		stdgraph.com stdgraph.h <gki.h> <gset.h> <mach.h>\
+			<math.h>
+	stgtxqual.x	stdgraph.com stdgraph.h <gset.h>
+	stgtxset.x	stdgraph.com stdgraph.h <gki.h> <gset.h>
+	stgtxsize.x	stdgraph.com stdgraph.h <gki.h>
+	stgunkown.x	
+	stgwtty.x	stdgraph.com stdgraph.h <ctype.h> <chars.h>
+	t_gkideco.x	<error.h> <gki.h>
+	t_showcap.x	stdgraph.h <ctype.h>
+	t_stdgraph.x	<error.h> <gki.h> <gset.h>
+	;
diff --git a/sys/gio/stdgraph/stdgraph.com b/sys/gio/stdgraph/stdgraph.com
new file mode 100644
index 00000000..3d3c43c5
--- /dev/null
+++ b/sys/gio/stdgraph/stdgraph.com
@@ -0,0 +1,46 @@
+# STDGRAPH common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.  For maximum efficiency the polyline generation and
+# coordinate transformation datums are kept in the common.
+
+pointer	g_sg				# stdgraph graphics descriptor
+pointer	g_tty				# graphcap descriptor
+pointer	g_term				# termcap descriptor for terminal
+pointer	g_pbtty				# script graphcap, playback mode
+int	g_nopen				# open count for the kernel
+int	g_active			# workstation is open for graphics i/o
+int	g_enable			# graphics is enabled
+int	g_message			# message mode (output text)
+pointer	g_msgbuf			# message buffer (input text)
+int	g_msgbuflen			# allocated size of message buffer
+int	g_msglen			# amount of data in message
+int	g_keycol			# used to show keys in playback mode
+int	g_keyline			# used to show keys in playback mode
+pointer	g_xy				# pointer to coord encoding string
+int	g_stream			# graphics stream (metacode)
+int	g_in, g_out			# input, output streams to device
+int	g_ucaseout			# stty ucaseout status flag
+int	g_xres, g_yres			# desired device resolution
+int	g_dxres, g_dyres		# scale down to resolution coords
+real	g_dx, g_dy			# scale GKI to window coords
+int	g_x1, g_y1			# origin of device window
+int	g_x2, g_y2			# upper right corner of device window
+int	g_lastx, g_lasty		# used to clip unresolved points
+int	g_hardchar			# controls use of hardware character gen
+int	g_cursor			# user override of logical cursor
+int	g_reg[NREGISTERS]		# encoder registers
+char	g_mem[SZ_MEMORY]		# encoder memory
+char	g_device[SZ_GDEVICE]		# device name for forced device output
+char	g_pbdevice[SZ_GDEVICE]		# device name of playback script
+char	g_hixy[TEK_XRES]		# lookup tables for tek encoding
+char	g_lox[TEK_XRES]			# 	"		"
+char	g_loy[TEK_YRES]			# 	"		"
+
+common	/stgcom/ g_sg, g_tty, g_term, g_pbtty, g_nopen, g_active, g_enable,
+	g_message, g_msgbuf, g_msgbuflen, g_msglen,
+	g_keycol, g_keyline, g_xy, g_stream, g_in, g_out,
+	g_ucaseout, g_xres, g_yres, g_dxres, g_dyres, g_dx, g_dy, g_x1,
+	g_y1, g_x2, g_y2, g_lastx, g_lasty, g_hardchar, g_cursor, g_reg,
+	g_mem, g_device, g_pbdevice, g_hixy, g_lox, g_loy
diff --git a/sys/gio/stdgraph/stdgraph.h b/sys/gio/stdgraph/stdgraph.h
new file mode 100644
index 00000000..de216065
--- /dev/null
+++ b/sys/gio/stdgraph/stdgraph.h
@@ -0,0 +1,98 @@
+# STDGRAPH definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		2048			# initial string buffer size
+define	SZ_MEMORY	1024			# encoder memory size
+define	SZ_GDEVICE	256			# force output to named device
+define	SZ_UIFNAME	199			# user interface file name
+define	SZ_MSGBUF	4096			# default size message buffer
+define	FLUSH_MEMORY	117			# time to flush encoded polyline
+define	LEN_STACK	20			# encoder stack size
+define	NREGISTERS	12			# number of encoder registers
+define	E_IOP		11			# encoder i/o pointer register
+define	E_TOP		12			# encoder top memory register
+define	LONG_POLYLINE	50			# big enough to post X_INT
+define	PADCHAR		0			# used to gen. delays
+
+# The user can have private copies of UI specifications in GUIDIR.
+define	GUIDIR		"guidir"
+
+# The STDGRAPH state/device descriptor.
+
+define	LEN_SG		91
+
+define	SG_SBUF		Memi[$1]		# string buffer
+define	SG_SZSBUF	Memi[$1+1]		# size of string buffer
+define	SG_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	SG_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	SG_POLYLINE	Memi[$1+4]		# polyline output permitted
+define	SG_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	SG_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	SG_ENCODEXY	Memi[$1+7]		# format for encoding coords
+define	SG_STARTDRAW	Memi[$1+8]		# pointer to DS string
+define	SG_ENDDRAW	Memi[$1+9]		# pointer to DE string
+define	SG_STARTMOVE	Memi[$1+10]		# pointer to VS string
+define	SG_ENDMOVE	Memi[$1+11]		# pointer to VE string
+define	SG_STARTMARK	Memi[$1+12]		# pointer to MS string
+define	SG_ENDMARK	Memi[$1+13]		# pointer to ME string
+define	SG_STARTFILL	Memi[$1+14]		# pointer to FS string
+define	SG_ENDFILL	Memi[$1+15]		# pointer to FE string
+define	SG_STARTTEXT	Memi[$1+16]		# start text draw
+define	SG_ENDTEXT	Memi[$1+17]		# end text draw
+define	SG_CURSOR	Memi[$1+18]		# last cursor accessed
+define	SG_UPDCURSOR	Memi[$1+19]		# update cursor pos before read
+define	SG_CURSOR_X	Memi[$1+20]		# current cursor X position
+define	SG_CURSOR_Y	Memi[$1+21]		# current cursor Y position
+define	SG_COLOR	Memi[$1+22]		# last color set
+define	SG_TXSIZE	Memi[$1+23]		# last text size set
+define	SG_TXFONT	Memi[$1+24]		# last text font set
+define	SG_PLTYPE	Memi[$1+25]		# last line type set
+define	SG_FASTYLE	Memi[$1+26]		# last fill area style set
+define	SG_PLWIDTH	Memi[$1+27]		# last line width set
+define	SG_DEVNAME	Memi[$1+28]		# name of open device
+define	SG_UIFNAME	Memi[$1+29]		# user interface file name
+define	SG_UIFDATE	Memi[$1+30]		# UI file date
+			# empty
+define	SG_CHARHEIGHT	Memi[$1+40+$2-1]	# character height
+define	SG_CHARWIDTH 	Memi[$1+50+$2-1]	# character width
+define	SG_CHARSIZE	Memr[P2R($1+60+$2-1)]	# text sizes permitted
+define	SG_PLAP		($1+70)			# polyline attributes
+define	SG_PMAP		($1+74)			# polymarker attributes
+define	SG_FAAP		($1+78)			# fill area attributes
+define	SG_TXAP		($1+81)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
+
+# TEK 4012 definitions for optimized tek coordinate encoding.
+
+define	TEK_XRES	1024
+define	TEK_YRES	780
diff --git a/sys/gio/stdgraph/stgcancel.x b/sys/gio/stdgraph/stgcancel.x
new file mode 100644
index 00000000..d47e24df
--- /dev/null
+++ b/sys/gio/stdgraph/stgcancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	"stdgraph.h"
+
+# STG_CANCEL -- Cancel any buffered output.
+
+procedure stg_cancel (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call fseti (g_out, F_CANCEL, YES)
+	call stg_reset()
+end
diff --git a/sys/gio/stdgraph/stgclear.x b/sys/gio/stdgraph/stgclear.x
new file mode 100644
index 00000000..9573c972
--- /dev/null
+++ b/sys/gio/stdgraph/stgclear.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_CLEAR -- Clear the workstation screen.  All attribute packets are
+# initialized to their default values when the screen is cleared.
+
+procedure stg_clear (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call stg_ctrl ("CL")
+	call stg_reset()
+end
diff --git a/sys/gio/stdgraph/stgclose.x b/sys/gio/stdgraph/stgclose.x
new file mode 100644
index 00000000..3d7eb70b
--- /dev/null
+++ b/sys/gio/stdgraph/stgclose.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_CLOSE -- Close the STDGRAPH kernel.  Free all storage associated with the
+# stdgraph descriptor.  Note that the stdgraph kernel may be multiply opened
+# (connected to two or more graphics steams, e.g., both STDGRAPH and STDIMAGE),
+# hence we do not physically close down until the last stream is closed.
+
+procedure stg_close()
+
+include	"stdgraph.com"
+
+begin
+	g_nopen = g_nopen - 1
+
+	if (g_nopen <= 0) {
+	    call stg_deactivatews (0)
+	    call flush (g_out)
+	    call mfree (SG_SBUF(g_sg), TY_CHAR)
+	    call mfree (g_sg, TY_STRUCT)
+
+	    if (g_tty != NULL) {
+		call ttycdes (g_tty)
+		g_tty = NULL
+	    }
+
+	    if (g_term != NULL) {
+		call ttycdes (g_term)
+		g_term = NULL
+	    }
+
+	    if (g_pbtty != NULL) {
+		call ttycdes (g_pbtty)
+		g_pbtty = NULL
+	    }
+
+	    if (g_msgbuf != NULL) {
+		call mfree (g_msgbuf, TY_CHAR)
+		g_msgbuf = NULL
+		g_msgbuflen = 0
+		g_msglen = 0
+	    }
+
+	    g_nopen = 0
+	}
+end
diff --git a/sys/gio/stdgraph/stgclws.x b/sys/gio/stdgraph/stgclws.x
new file mode 100644
index 00000000..137784cd
--- /dev/null
+++ b/sys/gio/stdgraph/stgclws.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	"stdgraph.h"
+
+# STG_CLOSEWS -- Close the named workstation.  Output the termination string,
+# if any, and flush the output.  Buffer deallocation is handled by STGCLOSE.
+
+procedure stg_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+
+include "stdgraph.com"
+
+begin
+	call stg_ctrl ("CW")
+	call flush (g_out)
+
+	g_active = NO
+	g_enable = NO
+
+	# Reenable stty ucaseout mode if it was set when the workstation
+	# was activated.
+
+	if (g_ucaseout == YES)
+	    call ttseti (g_out, TT_UCASEOUT, YES)
+end
diff --git a/sys/gio/stdgraph/stgctrl.x b/sys/gio/stdgraph/stgctrl.x
new file mode 100644
index 00000000..6689de8a
--- /dev/null
+++ b/sys/gio/stdgraph/stgctrl.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+define	SZ_PROGRAM	256
+
+# STG_CTRL -- Fetch an encoder format string from the graphcap entry and
+# use it to encode zero, one, or two integer arguments into a control string.
+# Put the control string to the output device.
+
+procedure stg_ctrl (cap)
+
+char	cap[ARB]		# name of device capability to be encoded
+pointer	sp, prog
+int	stg_encode(), ttygets()
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+	call salloc (prog, SZ_PROGRAM, TY_CHAR)
+
+	# Fetch the program from the graphcap file.  Zero is returned if the
+	# device does not have the named capability, in which case the function
+	# is inapplicable and should be ignored.
+
+	if (ttygets (g_tty, cap, Memc[prog], SZ_PROGRAM) > 0) {
+	    # Encode the output string and write the encoded string to the
+	    # output file.
+	    g_reg[E_IOP] = 1
+	    if (stg_encode (Memc[prog], g_mem, g_reg) == OK) {
+		g_mem[g_reg[E_IOP]] = EOS
+		call ttyputs (g_out, g_tty, g_mem, 1)
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STG_CTRL1 -- Encode one integer argument.
+
+procedure stg_ctrl1 (cap, arg1)
+
+char	cap[ARB]		# device capability
+int	arg1
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	call stg_ctrl (cap)
+end
+
+
+# STG_CTRL2 -- Encode two integer arguments.
+
+procedure stg_ctrl2 (cap, arg1, arg2)
+
+char	cap[ARB]		# device capability
+int	arg1, arg2
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	call stg_ctrl (cap)
+end
+
+
+# STG_CTRL3 -- Encode three integer arguments.
+
+procedure stg_ctrl3 (cap, arg1, arg2, arg3)
+
+char	cap[ARB]		# device capability
+int	arg1, arg2, arg3
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	g_reg[3] = arg3
+	call stg_ctrl (cap)
+end
diff --git a/sys/gio/stdgraph/stgdeact.x b/sys/gio/stdgraph/stgdeact.x
new file mode 100644
index 00000000..b11e4a07
--- /dev/null
+++ b/sys/gio/stdgraph/stgdeact.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_DEACTIVATEWS -- Deactivate the workstation, i.e., disable graphics,
+# leaving the terminal in text mode.  Note that it is the CW (close
+# workstation) sequence which is actually output, since the GD sequence is
+# used only to write single lines of text to the status line.
+
+procedure stg_deactivatews (flags)
+
+int	flags			# action modifier flags
+
+char	buf[1]
+int	stg_readtty(), and()
+include	"stdgraph.com"
+
+begin
+	if (g_out <= 0)
+	    return
+
+	# The g_active and g_out test permits us to be called before the
+	# kernel is opened and causes redundant calls to be ignored.
+
+	if (g_active == YES) {
+	    # Pause before deactivating?
+	    if (and (flags, AW_PAUSE) != 0) {
+		call stg_putline (g_out, "\n[Hit return to continue]\n")
+		while (stg_readtty (STDIN, buf, 1) != EOF)
+		    if (buf[1] == '\r' || buf[1] == '\n')
+			break
+	    }
+
+	    # Deactivate the workstation.
+	    call stgctrl ("CW")
+
+	    g_active = NO
+	    g_enable = NO
+
+	    # Reenable stty ucaseout mode if it was set when the workstation
+	    # was activated.
+
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, YES)
+	}
+
+	# Clear the text screen?
+	if (and (flags, AW_CLEAR) != 0 && g_term != NULL)
+	    call ttyclear (g_out, g_term)
+
+	call flush (g_out)
+end
diff --git a/sys/gio/stdgraph/stgdraw.x b/sys/gio/stdgraph/stgdraw.x
new file mode 100644
index 00000000..ae5a4ace
--- /dev/null
+++ b/sys/gio/stdgraph/stgdraw.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_DRAW -- Output a device draw line-segment instruction to draw from the
+# current position to the position (x,y) in GKI coordinates.
+
+procedure stg_draw (x, y)
+
+int	x, y			# destination
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Transform the first point from GKI coords to device coords and
+	# draw to the transformed point.
+
+	call ttyputs (g_out, g_tty, Memc[SG_STARTDRAW(g_sg)], 1)
+
+	g_reg[1] = x * g_dx + g_x1
+	g_reg[2] = y * g_dy + g_y1
+	g_reg[E_IOP] = 1
+	if (stg_encode (Memc[g_xy], g_mem, g_reg) == OK)
+	    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+	
+	call ttyputs (g_out, g_tty, Memc[SG_ENDDRAW(g_sg)], 1)
+end
diff --git a/sys/gio/stdgraph/stgdrawch.x b/sys/gio/stdgraph/stgdrawch.x
new file mode 100644
index 00000000..fd317d2b
--- /dev/null
+++ b/sys/gio/stdgraph/stgdrawch.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+define	MAXPTS		40	# max points in a char drawing polyline
+
+
+# STG_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure stg_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+pointer	pl, tx
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen, mx, my
+int	save_ltype, save_lwidth, save_color
+int	bitupk()
+include	"font.com"
+include	"stdgraph.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	if (SG_TXFONT(g_sg) != font) {
+	    call stg_ctrl1 ("TF", font - GT_ROMAN + 1)
+	    SG_TXFONT(g_sg) = font
+	}
+
+	# Since we will be using the polyline generator, set the polyline
+	# linetype to solid and save the current linetype for later restoration.
+
+	pl = SG_PLAP(g_sg)
+	tx = SG_TXAP(g_sg)
+	save_color = PL_COLOR(pl)
+	save_ltype = PL_LTYPE(pl)
+	save_lwidth = PL_WIDTH(pl)
+	PL_COLOR(pl) = TX_COLOR(tx)
+	PL_LTYPE(pl) = GL_SOLID
+	PL_WIDTH(pl) = 1
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call sgch_move (mx, my)
+	    else
+		call sgch_draw (mx, my)
+	}
+
+	# Flush any remaining points.
+	call sgch_flush()
+
+	# Restore polyline linetype and color.
+	PL_LTYPE(pl) = save_ltype
+	PL_WIDTH(pl) = save_lwidth
+	PL_COLOR(pl) = save_color
+end
+
+
+# SGCH_MOVE -- Start accumulating a new polyline.
+
+procedure sgch_move (mx, my)
+
+int	mx, my
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	call sgch_flush()
+
+	pl[1] = mx
+	pl[2] = my
+	op = 3
+end
+
+
+# SGCH_DRAW -- Add a point to the polyline.
+
+procedure sgch_draw (mx, my)
+
+int	mx, my
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	pl[op] = mx
+	pl[op+1] = my
+	op = min (MAXPTS, op + 2)
+end
+
+
+# SGCH_FLUSH -- Flush the polyline to the output device.
+
+procedure sgch_flush()
+
+int	npts
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	if (op > 2) {
+	    npts = op / 2
+	    call stg_polyline (pl, npts)
+	}
+	op = 1
+end
diff --git a/sys/gio/stdgraph/stgencode.x b/sys/gio/stdgraph/stgencode.x
new file mode 100644
index 00000000..3c7a6ffb
--- /dev/null
+++ b/sys/gio/stdgraph/stgencode.x
@@ -0,0 +1,539 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stdgraph.h"
+
+.help stg_encode
+.nf _________________________________________________________________________
+STG_ENCODE -- Table driven binary encoder/decoder.  The encoder (which can
+also decode) processes a format string, also referred to as a program, to
+either encode an output string or decode an input string.  Internally the
+encoder operates in two modes, copy mode and execute mode.  In copy mode
+all format characters are copied to the output except the following special
+characters:
+
+	'	escape next character (literal)
+	%	begin a formatted output string
+	(	switch to execute mode (stack driven, RPN interpreter)
+
+An ( appearing in the format string causes a mode switch to execute mode.
+In execute mode characters are metacode instructions to be executed.  An
+unescaped ) causes reversion to copy mode.  Parens may not be nested; an
+( in execute mode is an instruction to push the binary value of ( on the
+stack, and an ) in copy mode is copied to the output as a character.  In
+execute mode the following characters are recognized as special instructions.
+All other characters are instructions too, telling the encoder to push the
+ASCII value of the character on the stack.
+
+	'	escape next character (recognized everywhere)
+	%	formatted output
+	)	revert to copy mode
+	#nnn	push signed decimal integer number nnn
+	$ 	switch case construct
+	.	pop number from stack and place in output string
+	,	get next character from input string and push on stack
+	&	modulus (similar to AND of low bits)
+	+	add (similar to OR)
+	-	subtract (similar to AND)
+	*	multiply (shift left if pwr of 2)
+	/	divide (shift right if pwr of 2)
+	<	less than (0=false, 1=true)
+	> 	greater than (0=false, 1=true)
+	=	equals (0=false, 1=true)
+	;	branch if: <bool> <offset> ;.  The ; is at offset zero.
+       0-9	push register
+	!N	pop stack into register N
+	!!	pop N from stack and output an N millisecond delay
+
+The encoder communicates with the outside world via three general purpose
+data structures.
+
+	registers	0-9 (integer only)
+	memory		char array
+	program		char array
+
+The registers are used for parameter input and output as well as for storing
+intermediate results.  R 1-3 are used for input and output arguments.  R 4-9
+and R0 (R10) are reserved for use by the program.  R11 is the i/o pointer into
+encoder memory, used for character input and output.  R12 should contain the
+maximum memory address upon input.  Memory may be used for anything but is
+normally used only for the input string or output string.  The program is the
+format string.
+
+Further documentation is given in the GIO reference manual.
+.endhelp _____________________________________________________________________
+
+define	SZ_FORMAT	10		# max length printf format
+define	SZ_NUMSTR	10		# encoded numeric string
+
+define	R1	registers[1]		# argument
+define	R2	registers[2]		# argument
+define	R3	registers[3]		# argument
+define	R4	registers[4]		# scratch
+define	R5	registers[5]		# scratch
+define	R6	registers[6]		# scratch
+define	R7	registers[7]		# scratch
+define	R8	registers[8]		# scratch
+define	R9	registers[9]		# scratch
+define	R0	registers[10]		# scratch
+define	IOP	registers[11]		# i/o pointer into encoder memory
+define	TOP	registers[12]		# max memory location
+
+# Inline macros.
+
+define	memory_overflow_	1
+define	stack_underflow_	2
+define	stack_overflow_		3
+
+define	input	{$1=memory[iop];iop=iop+1}
+define	output	{memory[iop]=($1);iop=iop+1;if(iop>top)goto memory_overflow_}
+define	push	{stack[sp]=($1);sp=sp+1}
+define	pop	{sp=sp-1;$1=stack[sp]}
+
+
+# STG_ENCODE -- Interpret a program, encoding values passed in registers into
+# memory, or decoding memory into registers.
+
+int procedure stg_encode (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	x, y, num, ch, status
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase
+common	/sgecom/ pc, sp, iop, top, incase, stack
+int	sge_execute()
+include	"stdgraph.com"
+
+begin
+	# TEK format, %t.  This format deserves special treatment due to the
+	# prevalence of tektronix compatible graphics terminals.
+
+	if (program[1] == '%' && program[2] == 't') {
+	    x = R1
+	    y = R2
+	    iop = IOP + 4
+	    if (iop > top)
+		goto memory_overflow_
+
+	    memory[iop-4] = g_hixy[y+1]
+	    memory[iop-3] = g_loy[y+1]
+	    memory[iop-2] = g_hixy[x+1]
+	    memory[iop-1] = g_lox[x+1]
+
+	    IOP = iop
+	    if (program[3] == EOS)
+		return (OK)
+	}
+
+	# Process a general format string (as well as any chars following the
+	# %t format).
+
+	incase = NO
+	iop    = IOP
+	top    = TOP
+	pc     = 1
+	sp     = 1
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    if (ch == '%' && program[pc] != EOS) {
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Extract a general format specification and use it to
+		    # encode the number on top of the stack.
+		    pop (num)
+		    if (sp < 1) {
+			IOP = iop
+			return (stack_underflow_)
+		    } else
+			call sge_printf (num, memory, iop, top, program, pc)
+		}
+
+	    } else if (ch == '(' && program[pc] != EOS) {
+		# Switch to execute mode.
+		status = sge_execute (program, memory, registers)
+		if (status != OK)
+		    return (status)
+
+	    } else if (ch == '\'' && program[pc] != EOS) {
+		# Escape next character.
+		output (program[pc])
+		pc = pc + 1
+
+	    } else {
+		# Copy an ordinary character to the output string.
+		output (ch)
+	    }
+	}
+
+	IOP = iop
+	return (OK)
+
+memory_overflow_
+	IOP = iop
+	return (memory_overflow_)
+end
+
+
+# SGE_EXECUTE -- Execute a metacode program stored in encoder memory starting
+# at the location of the PC.  The stack, program counter, i/o pointer, and
+# registers are shared by the copy and execute mode procedures via common.
+
+int procedure sge_execute (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	num, ch, a, b, neg, x, y
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase, msec, npad, baud, envgeti(), btoi()
+common	/sgecom/ pc, sp, iop, top, incase, stack
+include	"stdgraph.com"
+errchk	envgeti
+
+begin
+	# Execute successive single character instructions until either ) or
+	# EOS is seen.  On a good host machine this case will be compiled as
+	# a vectored goto with a loop overhead of only a dozen or so machine
+	# instructions per loop.
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+
+	    switch (ch) {
+	    case '\'':
+		# Escape next character (recognized everywhere).
+		ch = program[pc]
+		if (ch != EOS) {
+		    # Push ASCII value of character.
+		    push (ch)
+		    pc = pc + 1
+		}
+
+	    case '%':
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Formatted output.
+		    if (program[pc] != EOS) {
+			pop (num)
+			call sge_printf (num, memory, iop, top, program, pc)
+		    } else
+			output (ch)
+		}
+
+	    case ')':
+		# End interpreter mode.
+		return (OK)
+
+	    case '#':
+		# Push signed decimal integer number.
+		neg = NO
+		if (program[pc] == '-') {
+		    neg = YES
+		    pc = pc + 1
+		}
+
+		num = 0
+		while (IS_DIGIT (program[pc])) {
+		    num = num * 10 + TO_INTEG (program[pc])
+		    pc = pc + 1
+		}
+
+		if (neg == YES)
+		    push (-num)
+		else
+		    push (num)
+
+	    case '$':
+		# Switch case instruction.
+
+		if (incase == NO) {
+		    # Pop the switch off the stack.
+		    pop (num)
+
+		    # Search for case number 'num'.
+		    for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			if (ch == '$') {
+			    # End of switch statement.
+			    pc = pc + 1
+			    incase = NO
+			    break
+
+			} else if (program[pc+1] == '-') {
+			    # Range of cases.
+			    a = TO_INTEG (ch)
+			    b = TO_INTEG (program[pc+2])
+			    pc = pc + 3
+			    if (a <= num && num <= b) {
+				incase = YES
+				break
+			    }
+			} else if (ch == 'D' || TO_INTEG(ch) == num) {
+			    # Default or requested case.
+			    pc = pc + 1
+			    incase = YES
+			    break
+
+			}
+
+			# Advance to the next case.  Leave pc pointing to the
+			# N of case $N.
+
+			if (ch != '$' && incase == NO) {
+			    while (program[pc] != EOS && program[pc] != '$')
+				pc = pc + 1
+			    if (program[pc] == '$')
+				pc = pc + 1
+			}
+		    }
+
+		} else {
+		    # $ encountered delimiting a case.  Search forward for
+		    # $$ or EOS.
+
+		    if (program[pc] != '$')
+			for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			    pc = pc + 1
+			    if (ch == '$' && program[pc] == '$')
+				break
+			}
+
+		    if (program[pc] == '$')
+			pc = pc + 1
+
+		    incase = NO
+		}
+
+	    case '.':
+		# Pop number from stack and place in output string as a
+		# binary character.
+		pop (num)
+		output (num)
+
+	    case ',':
+		# Get next character from input string and push on stack.
+		input (num)
+		push (num)
+
+	    case '&':
+		# Modulus (similar to AND of low bits).
+		pop (b)
+		pop (a)
+		push (mod (a, b))
+
+	    case '+':
+		# Add (similar to OR).
+		pop (b)
+		pop (a)
+		push (a + b)
+
+	    case '-':
+		# Subtract (similar to AND).
+		pop (b)
+		pop (a)
+		push (a - b)
+
+	    case '*':
+		# Multiply (shift left if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a * b)
+
+	    case '/':
+		# Divide (shift right if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a / b)
+
+	    case '<':
+		# Less than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a < b))
+
+	    case '>':
+		# Greater than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a > b))
+
+	    case '=':
+		# Equals (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a == b))
+
+	    case ';':
+		# If 2nd value on stack is true add 1st value on stack to PC.
+		# Example: "12<#-8;".  The ; is at offset zero.
+		pop (a)
+		pop (b)
+		if (b != 0)
+		    pc = pc - 1 + a
+
+	    case '0':
+		# Push contents of register 0 (10).
+		push (R0)
+	    case '1':
+		# Push contents of register 1.
+		push (R1)
+	    case '2':
+		# Push contents of register 2.
+		push (R2)
+	    case '3':
+		# Push contents of register 3.
+		push (R3)
+	    case '4':
+		# Push contents of register 4.
+		push (R4)
+	    case '5':
+		# Push contents of register 5.
+		push (R5)
+	    case '6':
+		# Push contents of register 6.
+		push (R6)
+	    case '7':
+		# Push contents of register 7.
+		push (R7)
+	    case '8':
+		# Push contents of register 8.
+		push (R8)
+	    case '9':
+		# Push contents of register 9.
+		push (R9)
+
+	    case '!':
+		if (program[pc] == '!') {
+		    # !!: Pop stack and generate delay.
+		    pc = pc + 1
+		    pop (msec)
+		    iferr (baud = envgeti ("ttybaud"))
+			baud = 9600
+		    npad = real(msec) * (real(baud) / 8. / 1000.)
+		    while (npad > 0) {
+			output (PADCHAR)
+			npad = npad - 1
+		    }
+		} else {
+		    # !N: Pop stack into register N.
+		    num = TO_INTEG (program[pc])
+		    if (num >= 0 && num <= 9) {
+			if (num == 0)
+			    num = 10
+			pop (registers[num])
+			pc = pc + 1
+		    } else
+			output (ch)
+		}
+
+	    default:
+		# Push ASCII value of character.
+		push (ch)
+	    }
+
+	    if (sp <= 0)
+		return (stack_underflow_)
+	    if (sp > LEN_STACK)
+		return (stack_overflow_)
+	}
+
+	return (OK)
+
+memory_overflow_
+	return (memory_overflow_)
+end
+
+
+# SGE_PRINTF -- Process a %.. format specification.  The number to be encoded
+# has already been popped from the stack into the first argument.  The encoded
+# number is returned in memory at IOP, leaving IOP positioned to the first
+# char following the encoded number.  The format used to encode the number is
+# extracted from the program starting at PC.  PC is left pointing to the first
+# character following the format.
+
+procedure sge_printf (number, memory, iop, top, program, pc)
+
+int	number			# number to be encoded
+char	memory[top]		# output buffer
+int	iop			# index of first char to be written	(in/out)
+int	top			# size of output buffer
+char	program[ARB]		# contains printf format string
+int	pc			# index of first char of format string	(in/out)
+
+char	format[SZ_FORMAT]
+char	numstr[SZ_NUMSTR]
+int	op, ch, junk
+int	gstrcpy(), itoc()
+
+begin
+	# Extract format %w.dC, a string of digits, -, or ., delimited by a
+	# letter.  The format %w.dr is followed by a single character which
+	# must also be included in the format string.
+
+	format[1] = '%'
+	op = 2
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    format[op] = ch
+	    op = op + 1
+	    if (IS_LOWER(ch)) {
+		if (ch == 'r' && program[pc] != EOS) {
+		    # Radix digit follows %r.
+		    format[op] = program[pc]
+		    op = op + 1
+		    pc = pc + 1
+		}
+		break
+	    }
+	}
+	format[op] = EOS
+
+	# Encode the number using the extracted format string.  The case of
+	# a simple decimal encoding is optimized.
+
+	if (format[2] == 'd')
+	    junk = itoc (number, numstr, SZ_NUMSTR)
+	else {
+	    iferr {
+		call sprintf (numstr, SZ_NUMSTR, format)
+		    call pargi (number)
+	    } then
+		numstr[1] = EOS
+	}
+
+	# Move the encoded number to encoder memory, advancing the i/o
+	# pointer and taking care not to overrun memory.  Leave the iop
+	# pointing AT, not after, the EOS output by gstrcpy.
+
+	iop = iop + gstrcpy (numstr, memory[iop], top - iop + 1)
+end
diff --git a/sys/gio/stdgraph/stgescape.x b/sys/gio/stdgraph/stgescape.x
new file mode 100644
index 00000000..b52ffd0c
--- /dev/null
+++ b/sys/gio/stdgraph/stgescape.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STGESCAPE.X -- Stdgraph kernel escape handing code.  This is the interface
+# between the stdgraph kernel and any supported escape packages.  These driver
+# routines return TRUE if they recognize the escape and it is private to the
+# package, FALSE if the other escape packages may also be interested in the
+# routine.
+#
+#	stg_escape		standard GKI escape entry point
+#
+#	sge_wstran		transform and output escape
+#	sge_spoolesc		process and escape into frame buffer	
+#
+# To add support for a new package of escapes, and entry for the driver routine
+# for each family of escapes must be added to each of these procedures.
+
+
+# STG_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The stdgraph kernel does not have any escape functions at present.
+
+procedure stg_escape (fn, instruction, nwords)
+
+int	fn			#I function code
+short	instruction[ARB]	#I instruction data words
+int	nwords			#I length of instruction
+
+bool	sgm_execute()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_execute (fn, instruction, nwords))
+	    return
+end
+
+
+# SGE_WSTRAN -- Stdgraph escape handling routine called by an interactive
+# client (e.g the CL in cursor mode) to apply the workstation transformation
+# to a escape and execute the escape.  This routine is called for all
+# escapes regardless of whether any transformation is necessary, leaving
+# it up to the escape code to decide what to do.
+
+procedure sge_wstran (fn, instruction, x1,y1, x2,y2)
+
+int	fn			#I escape sequence function opcode
+short	instruction[ARB]	#I escape instruction data
+real	x1, y1			#I NDC coords of display rect
+real	x2, y2			#I NDC coords of display rect
+
+bool	sgm_wstran()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_wstran (fn, instruction, x1,y1, x2,y2))
+	    return
+end
+
+
+# SGE_WSENABLE -- Stdgraph escape handling routine called by an
+# interactive client (e.g the CL in cursor mode) to test whether cursor mode
+# scaling of graphics instructions is enabled when cursor mode zoom/pan is
+# done.  Cursor mode scaling may be disabled if the kernel or graphics device
+# does the scaling itself.
+
+bool procedure sge_wsenable ()
+
+bool	enable
+bool	sgm_wsenable()
+
+begin
+	if (sgm_wsenable (enable))
+	    return (enable)
+end
+
+
+# SGE_SPOOLESC -- Stdgraph escape handling routine called by an interactive
+# client (e.g the CL in cursor mode) to retain, delete, or edit an escape
+# instruction stored in a frame buffer.  Ordinary drawing instructions are
+# normally retained.  If the instruction should only be executed when issued
+# it should be deleted.  Sometimes an instruction is edited or replaced by
+# a different one to be executed the next time the buffered graphics is drawn.
+# Sometimes when an instruction is seen earlier instructions must be edited
+# or deleted.  This routine is called for all escapes, it is up to the escape
+# code to decide what to do.  The delete instruction callback is called as
+# delete_fcn(tr,gki) to delete the instruction pointed to by GKI.
+
+procedure sge_spoolesc (tr, gki, fn, instruction, bp, buftop, delete_fcn)
+
+pointer	tr			#I arg to delete_fcn
+pointer	gki			#I pointer to escape instruction
+int	fn			#U escape sequence function opcode
+short	instruction[ARB]	#U escape instruction data
+pointer	bp			#I frame buffer pointer
+pointer	buftop			#I top+1 of buffered data
+int	delete_fcn		#I function called to delete an instruction
+
+bool	sgm_spoolesc()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_spoolesc (tr, gki, fn, instruction, bp, buftop, delete_fcn))
+	    return
+end
diff --git a/sys/gio/stdgraph/stgfa.x b/sys/gio/stdgraph/stgfa.x
new file mode 100644
index 00000000..10cf4d61
--- /dev/null
+++ b/sys/gio/stdgraph/stgfa.x
@@ -0,0 +1,115 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_FILLAREA -- Fill a closed area.  The area is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs outlining the
+# area to be filled.
+
+procedure stg_fillarea (p, npts)
+
+short	p[ARB]			#I points defining area outline
+int	npts			#I number of points, i.e., (x,y) pairs
+
+pointer	fa
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update fillarea attributes if necessary.
+
+	fa = SG_FAAP(g_sg)
+	if (SG_COLOR(g_sg) != FA_COLOR(fa)) {
+	    call stg_ctrl1 ("FC", FA_COLOR(fa))
+	    SG_COLOR(g_sg) = FA_COLOR(fa)
+	}
+	if (SG_FASTYLE(g_sg) != FA_STYLE(fa)) {
+	    call stg_ctrl1 ("FT", FA_STYLE(fa))
+	    SG_FASTYLE(g_sg) = FA_STYLE(fa)
+	}
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the fillarea.  If the startfill sequence is defined we assume
+	# that the device can draw a multipoint fillarea.
+
+	if (Memc[SG_STARTFILL(g_sg)] != EOS) {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		# Output start fillarea sequence.
+		call ttyputs (g_out, g_tty, Memc[SG_STARTFILL(g_sg)], 1)
+		n = len_p
+
+		# Encode the points of the fillarea outline (or move to the
+		# single point to be drawn).
+
+		g_lastx = -1	# clip unresolved points only in the interior
+		g_lasty = -1	# of the area being drawn.
+
+		g_reg[E_IOP] = 1
+		do i = ip, n, 2 {
+		    sx = p[i]
+		    sy = p[i+1]
+
+		    # Discard the point if it is not resolved.
+		    lowres_x = sx / g_dxres
+		    lowres_y = sy / g_dyres
+		    if (lowres_x == g_lastx && lowres_y == g_lasty)
+			next
+
+		    g_lastx = lowres_x
+		    g_lasty = lowres_y
+
+		    # Transform point into the device window.
+		    sx = int (sx * g_dx) + g_x1
+		    sy = int (sy * g_dy) + g_y1
+
+		    # Encode the point, appending encoded bytes to g_mem.
+		    # Tek encoding is treated as a special case since it is
+		    # so common; the encoder is used for non-Tek encodings.
+
+		    if (tek_encoding) {
+			iop = g_reg[E_IOP] + 4
+			g_mem[iop-4] = g_hixy[sy+1]
+			g_mem[iop-3] = g_loy[sy+1]
+			g_mem[iop-2] = g_hixy[sx+1]
+			g_mem[iop-1] = g_lox[sx+1]
+			g_reg[E_IOP] = iop
+		    } else {
+			g_reg[1] = sx
+			g_reg[2] = sy
+			if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			    break
+		    }
+
+		    # Flush buffer if nearly full.
+		    if (g_reg[E_IOP] > FLUSH_MEMORY) {
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+			g_reg[E_IOP] = 1
+		    }
+		}
+		ip = n
+
+		# Flush any output remaining in encoder memory.
+		if (g_reg[E_IOP] > 1) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+
+		# Output end polymarker sequence, or draw the point.
+		call ttyputs (g_out, g_tty, Memc[SG_ENDFILL(g_sg)], 1)
+	    }
+	} else {
+	    # If can't do a fill area, just draw the area outline.
+	    call stg_polyline (p, npts)
+	}
+end
diff --git a/sys/gio/stdgraph/stgfaset.x b/sys/gio/stdgraph/stgfaset.x
new file mode 100644
index 00000000..d5b4c4e7
--- /dev/null
+++ b/sys/gio/stdgraph/stgfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_FASET -- Set the fillarea attributes.
+
+procedure stg_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"stdgraph.com"
+
+begin
+	fa = SG_FAAP(g_sg)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/stdgraph/stgfilter.x b/sys/gio/stdgraph/stgfilter.x
new file mode 100644
index 00000000..674f190f
--- /dev/null
+++ b/sys/gio/stdgraph/stgfilter.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	<chars.h>
+include	<fset.h>
+include	"stdgraph.h"
+
+define	MAXCH	16
+define	RESET	"reset"
+
+
+# SGF_POST_FILTER -- Post the stdgraph tty input filter to the VOS tty driver.
+# This input filter is used to intercept and process escape sequences sent by
+# the terminal to the IRAF client, to notify the client of events such as a
+# terminal reset.
+
+procedure sgf_post_filter (fd)
+
+int	fd			#I terminal file
+
+int	locpr()
+extern	sgf_ttyfilter()
+
+begin
+	# Install stdgraph filter in terminal driver.
+	call ttseti (fd, TT_FILTER, locpr(sgf_ttyfilter))
+	call ttseti (fd, TT_FILTERKEY, ESC)
+
+	# Register escapes with terminal.
+	call stg_outstr ("EZ", RESET)
+	call stg_outstr ("ER", "R")
+end
+
+
+# SGF_TTYFILTER -- Terminal input filter.
+
+procedure sgf_ttyfilter (fd, buf, maxch, status)
+
+int	fd			#I input file
+char	buf[ARB]		#U input buffer
+int	maxch			#I max chars in buffer
+int	status			#U number of chars in buffer
+
+char	escape[MAXCH]
+char	svbuf[MAXCH+4]
+int	ip, op, sp, ch, iomode
+
+bool	streq()
+int	sgf_getchar(), fstati()
+include	"stdgraph.com"
+define	failed_ 91
+
+begin
+	# Disable the filter if reading from the terminal in nonblocking
+	# raw mode.  We shouldn't receive a stdgraph escape at such a time,
+	# and this code isn't prepared to deal with nonblocking i/o.  This
+	# case occurs, e.g., during a screen size query, where the terminal
+	# returns an escape sequence to the client (in nonblocking raw mode).
+
+	iomode = fstati (STDIN, F_IOMODE)
+	if (and (iomode, IO_NDELAY) != 0)
+	    return
+
+	# The escape sequence is of the form "ESC P <text> ESC \", the ANSI
+	# device control string (DCS).  This escape sequence is recognized by
+	# the vt100 terminal emulator in xgterm, which will accumulate and
+	# ignore the sequence.  This is important because when a terminal
+	# (xgterm) reset occurs when IRAF is not reading from the terminal in
+	# raw mode, the character are echoed to the terminal and would be
+	# printed on the screen if not recognized by the terminal as an
+	# escape.  By using a known escape which xgterm ignores the escape is
+	# transmitted without being seen by (and probably confusing) the
+	# user.  If the reset occurs while in graphics mode and a cursor read
+	# is in progress, the terminal will be in raw mode and the sequence
+	# will not be echoed, hence the problem does not occur.
+
+	ip = 1
+	sp = 1
+	ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	if (ch != ESC)
+	    goto failed_
+	ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	if (ch != 'P')
+	    goto failed_
+
+	# Accumulate escape data string.
+	op = 1
+	repeat {
+	    ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	    if (ch < 0 || op > MAXCH)
+		goto failed_
+	    if (ch == ESC) {
+		escape[op] = EOS
+		ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+		break
+	    } else {
+		escape[op] = ch
+		op = op + 1
+	    }
+	}
+
+	# Process the escape.
+	if (streq (escape, RESET)) {
+	    call stg_reset()
+	    call ttseti (fd, TT_FILTER, NULL)
+	    if (g_sg != NULL)
+		SG_UIFDATE(g_sg) = 0
+	} else				# add additional escapes here
+	    goto failed_
+
+	# Edit the input buffer to remove the escape.
+	op = 1
+	for (  ;  ip <= status && op <= maxch;  ip=ip+1) {
+	    buf[op] = buf[ip]
+	    op = op + 1
+	}
+	status = op - 1
+	return
+
+failed_
+	# Unrecognized escape.  Append any newly read data to the input
+	# buffer and return all the data.
+
+	if (sp > 1) {
+	    call amovc (svbuf, buf[status+1], sp - 1)
+	    status = status + sp - 1
+	}
+end
+
+
+# SGF_GETCHAR -- Get a character from the input terminal.  ERR or EOF is
+# returned if the input is exhausted.  If reading in raw mode additional
+# reads will be performed as necessary.
+
+int procedure sgf_getchar (fd, svbuf, sp, buf, ip, maxch, nchars)
+
+int	fd			#I input file
+char	svbuf[ARB]		#O save chars as they are read
+int	sp			#U pointer into save buffer
+char	buf[ARB]		#U input buffer
+int	ip			#I input index
+int	maxch			#I max chars in buffer
+int	nchars			#U number of chars in buffer
+
+int	ch
+int	status
+
+begin
+	if (ip > nchars) {
+	    if (maxch == 1) {
+		call zgetty (fd, svbuf[sp], maxch, status)
+		if (status <= 0)
+		    return (ERR)
+		ch = svbuf[sp]
+		sp = sp + 1
+		return (ch)
+	    } else
+		return (EOF)
+	}
+
+	ch = buf[ip]
+	ip = ip + 1
+
+	return (ch)
+end
diff --git a/sys/gio/stdgraph/stgflush.x b/sys/gio/stdgraph/stgflush.x
new file mode 100644
index 00000000..aada3927
--- /dev/null
+++ b/sys/gio/stdgraph/stgflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_FLUSH -- Flush output.
+
+procedure stg_flush (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call flush (g_out)
+end
diff --git a/sys/gio/stdgraph/stggcell.x b/sys/gio/stdgraph/stggcell.x
new file mode 100644
index 00000000..2a9aea8c
--- /dev/null
+++ b/sys/gio/stdgraph/stggcell.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STG_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure stg_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.  Won't do much for a graphics terminal,
+	# but should be functionional.
+end
diff --git a/sys/gio/stdgraph/stggcur.x b/sys/gio/stdgraph/stggcur.x
new file mode 100644
index 00000000..08f2b8b7
--- /dev/null
+++ b/sys/gio/stdgraph/stggcur.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GETCURSOR -- Get the position of a cursor.  The cursor value is returned
+# as a GKI structure on the graphics metacode stream.
+
+procedure stg_getcursor (cursor)
+
+int	cursor			#I cursor to be read or 0
+
+int	cur, cn
+int	key, sx, sy, raster, rx, ry
+include	"stdgraph.com"
+
+begin
+	# If cursor=0 read the last cursor referenced, e.g., in a write.
+	if (cursor > 0) {
+	    SG_CURSOR(g_sg) = cursor
+	    cur = cursor
+	} else
+	    cur = max (1, SG_CURSOR(g_sg))
+
+	# Restore graphics mode in case the user has forgotten the \n while
+	# writing to the status line.
+
+	if (g_enable == NO)
+	    call stg_genab()
+
+	# If the user has locked the logical cursor override runtime selection.
+	if (g_cursor > 0)
+	    cur = g_cursor
+
+	# Restore the software cursor position before reading?
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    sx = SG_CURSOR_X(g_sg)
+	    sy = SG_CURSOR_Y(g_sg)
+	    if (sx != 0 && sy != 0)
+		call stg_setcursor (sx, sy, cur)
+	}
+
+	# Physically read the cursor and return value to caller.
+	call stg_readcursor (cur, cn, key, sx, sy, raster, rx, ry)
+	call gki_retcursorvalue (g_stream, cn, key, sx, sy, raster, rx, ry)
+	call flush (g_stream)
+
+	# Save the new position of the cursor for next time.
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    SG_CURSOR_X(g_sg) = sx
+	    SG_CURSOR_Y(g_sg) = sy
+	}
+end
diff --git a/sys/gio/stdgraph/stggdisab.x b/sys/gio/stdgraph/stggdisab.x
new file mode 100644
index 00000000..42ddec62
--- /dev/null
+++ b/sys/gio/stdgraph/stggdisab.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GDISAB -- Disable graphics, i.e., issue the GD control sequence.
+
+procedure stg_gdisab()
+
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES && g_out > 0) {
+	    call stgctrl ("GD")
+	    call flush (g_out)
+	    g_enable = NO
+	}
+end
diff --git a/sys/gio/stdgraph/stggenab.x b/sys/gio/stdgraph/stggenab.x
new file mode 100644
index 00000000..5e350e33
--- /dev/null
+++ b/sys/gio/stdgraph/stggenab.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GENAB -- Enable graphics, i.e., issue the GE control sequence.
+
+procedure stg_genab()
+
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES && g_out > 0) {
+	    call stgctrl ("GE")
+	    call flush (g_out)
+	    g_enable = YES
+	}
+end
diff --git a/sys/gio/stdgraph/stggim.x b/sys/gio/stdgraph/stggim.x
new file mode 100644
index 00000000..a71cd448
--- /dev/null
+++ b/sys/gio/stdgraph/stggim.x
@@ -0,0 +1,919 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<chars.h>
+include	<ctype.h>
+include	<fset.h>
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+include	"stdgraph.h"
+
+# STGGIM.X -- GIO.GIM gterm imaging escapes for the stdgraph kernel.  The
+# routines in this file decode GKI escape instructions and encode serial
+# byte sequences which are sent to the server to execute the instruction.
+# In some cases the server returns a response which is decoded here and
+# encoded as a GKI return value which is returned to the client.
+
+define	SZ_PATBUF	512
+define	MAX_ARGS	32
+define  TIMEOUT		10000
+
+
+# SGM_EXECUTE -- Test whether the given instruction is a GIM escape, and
+# if so execute it.  Return true if the instruction was recognized and
+# executed.
+
+bool procedure sgm_execute (fn, gim, nwords)
+
+int	fn			#I function code
+short	gim[ARB]		#I instruction data words
+int	nwords			#I length of gim
+
+int	raster
+common	/sgmcom/ raster
+
+begin
+	switch (fn) {
+	case GKI_OPENWS, GKI_CLEAR:
+	    call sgm_output ("RI", gim, GIM_RASTERINIT_LEN)
+	    return (false)
+
+	case GIM_RASTERINIT:
+	    call sgm_output ("RI", gim, GIM_RASTERINIT_LEN)
+	case GIM_CREATERASTER:
+	    call sgm_output ("CR", gim, GIM_CREATERASTER_LEN)
+	case GIM_DESTROYRASTER:
+	    call sgm_output ("DR", gim, GIM_DESTROYRASTER_LEN)
+	case GIM_QUERYRASTER:
+	    call sgm_queryraster (gim)
+	case GIM_SETRASTER:
+	    raster = gim[GIM_SETRASTER_RN]
+	    call sgm_output ("SR", gim, GIM_SETRASTER_LEN)
+	case GIM_WRITEPIXELS:
+	    call sgm_writepixels (gim)
+	case GIM_READPIXELS:
+	    call sgm_readpixels (gim)
+	case GIM_REFRESHPIXELS:
+	    call sgm_output ("RX", gim, GIM_REFRESHPIXELS_LEN)
+	case GIM_SETPIXELS:
+	    call sgm_output ("SP", gim, GIM_SETPIXELS_LEN)
+	case GIM_WRITECMAP:
+	    call sgm_writecmap (gim)
+	case GIM_READCMAP:
+	    call sgm_readcmap (gim)
+	case GIM_LOADCMAP:
+	    call sgm_output ("LM", gim, GIM_LOADCMAP_LEN)
+	case GIM_FREECMAP:
+	    call sgm_output ("FL", gim, GIM_FREECMAP_LEN)
+	case GIM_WRITEIOMAP:
+	    call sgm_iomapwrite (gim)
+	case GIM_READIOMAP:
+	    call sgm_iomapread (gim)
+	case GIM_INITMAPPINGS:
+	    call sgm_output ("IM", gim, GIM_INITMAPPINGS_LEN)
+	case GIM_FREEMAPPING:
+	    call sgm_output ("FM", gim, GIM_FREEMAPPING_LEN)
+	case GIM_COPYRASTER:
+	    call sgm_output ("CP", gim, GIM_COPYRASTER_LEN)
+	case GIM_SETMAPPING:
+	    call sgm_output ("SM", gim, GIM_SETMAPPING_LEN)
+	case GIM_GETMAPPING:
+	    call sgm_getmapping (gim)
+	case GIM_ENABLEMAPPING:
+	    call sgm_output ("MN", gim, GIM_ENABLEMAPPING_LEN)
+	case GIM_DISABLEMAPPING:
+	    call sgm_output ("MD", gim, GIM_DISABLEMAPPING_LEN)
+	case GIM_REFRESHMAPPING:
+	    call sgm_output ("RF", gim, GIM_REFRESHMAPPING_LEN)
+
+	default:
+	    return (false)
+	}
+
+	return (true)
+end
+
+
+# SGM_WSTRAN -- Transform and output a GIM escape.  Ignore escapes we
+# know nothing about.  TRUE is returned if the escape is one which is private
+# to the GIM interface.
+
+bool procedure sgm_wstran (fn, gim, rx1,ry1, rx2,ry2)
+
+int	fn			#I escape sequence function opcode
+short	gim[ARB]		#I escape instruction data
+real	rx1,ry1			#I NDC coords of display rect
+real	rx2,ry2			#I NDC coords of display rect
+
+real	scale
+pointer	sp, n_gim
+bool	status, xflip, yflip
+int	width, height, dst, src, dt
+int	wx1, wy1, wx2, wy2, p1, p2
+int	sx1, sy1, sx2, sy2, snx, sny
+int	dx1, dy1, dx2, dy2, dnx, dny
+int	n_dx1, n_dy1, n_dx2, n_dy2, n_dnx, n_dny
+int	n_sx1, n_sy1, n_sx2, n_sy2
+int	w_dx1, w_dy1, w_dx2, w_dy2
+bool	sgm_execute()
+define	exe_ 91
+
+begin
+	switch (fn) {
+	case GIM_RASTERINIT, GIM_INITMAPPINGS,
+	    GIM_CREATERASTER, GIM_DESTROYRASTER, GIM_QUERYRASTER,
+	    GIM_GETMAPPING, GIM_ENABLEMAPPING, GIM_DISABLEMAPPING,
+	    GIM_REFRESHMAPPING, GIM_FREEMAPPING,
+	    GIM_READPIXELS, GIM_WRITEPIXELS, GIM_REFRESHPIXELS, GIM_SETPIXELS,
+	    GIM_WRITECMAP, GIM_READCMAP, GIM_LOADCMAP, GIM_FREECMAP,
+	    GIM_WRITEIOMAP, GIM_READIOMAP,
+	    GIM_COPYRASTER, GIM_SETRASTER:
+
+	    # These instructions do not require any transformation.
+	    status = sgm_execute (fn, gim, 0)
+
+	case GIM_SETMAPPING:
+	    # Edit setmapping instructions which write to the display window.
+	    # Raster 0 is the display window; only display window coordinates
+	    # are affected by the workstation transformation.
+
+	    src = gim[GIM_SETMAPPING_SR]
+	    dst = gim[GIM_SETMAPPING_DR]
+	    dt  = gim[GIM_SETMAPPING_DT]
+
+	    if (dst == 0 && src != dst) {
+		call smark (sp)
+		call salloc (n_gim, GIM_SETMAPPING_LEN, TY_SHORT)
+
+		xflip = false
+		yflip = false
+
+		# Convert the display rect NDC coordinates to window pixels
+		# or GKI units, depending upon which coordinate system is
+		# in use.  Note that for NDC the Y axis is flipped relative
+		# to display window pixel coordinates.
+
+		if (dt == CT_PIXEL) {
+		    call sgm_winsize (width, height)
+		    wx1 = rx1 * (width - 1);  wy1 = (1.0 - ry2) * (height - 1)
+		    wx2 = rx2 * (width - 1);  wy2 = (1.0 - ry1) * (height - 1)
+		} else {
+		    width = GKI_MAXNDC + 1;  height = GKI_MAXNDC + 1
+		    wx1 = rx1 * (width - 1);  wy1 = ry1 * (height - 1)
+		    wx2 = rx2 * (width - 1);  wy2 = ry2 * (height - 1)
+		}
+
+		sx1 = gim[GIM_SETMAPPING_SX]
+		snx = gim[GIM_SETMAPPING_SW]
+		sy1 = gim[GIM_SETMAPPING_SY]
+		sny = gim[GIM_SETMAPPING_SH]
+		sx2 = sx1 + snx - 1;  sy2 = sy1 + sny - 1 
+
+		dx1 = gim[GIM_SETMAPPING_DX]
+		dnx = gim[GIM_SETMAPPING_DW]
+		if (dnx < 0) {
+		    dnx = -dnx
+		    xflip = !xflip
+		}
+		dy1 = gim[GIM_SETMAPPING_DY]
+		dny = gim[GIM_SETMAPPING_DH]
+		if (dny < 0) {
+		    dny = -dny
+		    yflip = !yflip
+		}
+		dx2 = dx1 + dnx - 1;  dy2 = dy1 + dny - 1 
+
+		# Compute the intersection of the destination (screen) rect
+		# of the mapping with the region of the screen WS mapped by
+		# the workstation transformation.
+
+		n_dx1 = max (wx1, dx1);  n_dy1 = max (wy1, dy1)
+		n_dx2 = min (wx2, dx2);  n_dy2 = min (wy2, dy2)
+
+		# If the rectangles do not intersect set up a null mapping
+		# to temporarily disable the mapping.
+
+		n_dnx = n_dx2 - n_dx1 + 1;  n_dny = n_dy2 - n_dy1 + 1
+		if (n_dnx <= 0 || n_dny <= 0) {
+		    call amovs (gim, Mems[n_gim], GIM_SETMAPPING_LEN)
+		    Mems[n_gim+GIM_SETMAPPING_SX-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SW-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SY-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SH-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DX-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DW-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DY-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DH-1] = 0
+		    goto exe_
+		}
+
+		# Compute the source rect which maps to the new (intersection)
+		# destination rect.
+
+		if (snx == 1 || dnx == 1) {
+		    n_sx1 = sx1
+		    n_sx2 = sx2
+		} else {
+		    scale = real(snx - 1) / real(dnx - 1)
+		    n_sx1 = max(0, min(GKI_MAXNDC,
+			nint((n_dx1 - dx1) * scale + sx1)))
+		    n_sx2 = max(0, min(GKI_MAXNDC,
+			nint((n_dx2 - dx2) * scale + sx2)))
+		    if (xflip) {
+			p1 = sx1 + (sx2 - n_sx2)
+			p2 = sx2 - (n_sx1 - sx1)
+			n_sx1 = p1;  n_sx2 = p2
+		    }
+		}
+
+		if (sny == 1 || dny == 1) {
+		    n_sy1 = sy1
+		    n_sy2 = sy2
+		} else {
+		    scale = real(sny - 1) / real(dny - 1)
+		    n_sy1 = max(0, min(GKI_MAXNDC,
+			nint((n_dy1 - dy1) * scale + sy1)))
+		    n_sy2 = max(0, min(GKI_MAXNDC,
+			nint((n_dy2 - dy2) * scale + sy2)))
+		    if (yflip) {
+			p1 = sy1 + (sy2 - n_sy2)
+			p2 = sy2 - (n_sy1 - sy1)
+			n_sy1 = p1;  n_sy2 = p2
+		    }
+		}
+
+		# Scale the destination rect by the amount needed to make the
+		# WS rect fill the full display window.
+
+		if (wx1 == wx2) {
+		    w_dx1 = 0
+		    w_dx1 = width - 1
+		} else {
+		    scale = real(width - 1) / real(wx2 - wx1)
+		    w_dx1 = max(0, min(GKI_MAXNDC,
+			nint((n_dx1 - wx1) * scale)))
+		    w_dx2 = max(0, min(GKI_MAXNDC,
+			nint((n_dx2 - wx1) * scale)))
+		}
+
+		if (wy1 == wy2) {
+		    w_dy1 = 0
+		    w_dy1 = height - 1
+		} else {
+		    scale = real(height - 1) / real(wy2 - wy1)
+		    w_dy1 = max(0, min(GKI_MAXNDC,
+			nint((n_dy1 - wy1) * scale)))
+		    w_dy2 = max(0, min(GKI_MAXNDC,
+			nint((n_dy2 - wy1) * scale)))
+		}
+
+		# Construct the edited instruction.
+		call amovs (gim, Mems[n_gim], GIM_SETMAPPING_LEN)
+		Mems[n_gim+GIM_SETMAPPING_SX-1] = n_sx1
+		Mems[n_gim+GIM_SETMAPPING_SW-1] = n_sx2 - n_sx1 + 1
+		Mems[n_gim+GIM_SETMAPPING_SY-1] = n_sy1
+		Mems[n_gim+GIM_SETMAPPING_SH-1] = n_sy2 - n_sy1 + 1
+		Mems[n_gim+GIM_SETMAPPING_DX-1] = w_dx1
+		Mems[n_gim+GIM_SETMAPPING_DY-1] = w_dy1
+
+		n_dnx = max(0, min(GKI_MAXNDC, w_dx2 - w_dx1 + 1))
+		if (gim[GIM_SETMAPPING_DW] < 0)
+		    n_dnx = -n_dnx
+		Mems[n_gim+GIM_SETMAPPING_DW-1] = n_dnx
+
+		n_dny = max(0, min(GKI_MAXNDC, w_dy2 - w_dy1 + 1))
+		if (gim[GIM_SETMAPPING_DH] < 0)
+		    n_dny = -n_dny
+		Mems[n_gim+GIM_SETMAPPING_DH-1] = n_dny
+
+exe_
+		# Execute the edited instruction.
+		status = sgm_execute (fn, Mems[n_gim], 0)
+		call sfree (sp)
+
+	    } else
+		status = sgm_execute (fn, gim, 0)
+
+	default:
+	    status = false
+	}
+
+	return (status)
+end
+
+
+# SGM_WSENABLE -- Test if client scaling of graphics drawing instructions is
+# enabled.  For the stdgraph kernel, these transformations are disabled if
+# the raster is other than zero, in which case the graphics server does the
+# scaling.
+
+bool procedure sgm_wsenable (enable)
+
+bool	enable
+int	raster
+common	/sgmcom/ raster
+
+begin
+	enable = (raster == 0)
+	return (true)
+end
+
+
+# SGM_SPOOLESC -- Process a GIM escape into a frame buffer.  All GIM escapes 
+# are executed when first issued; we just determine whether the escapes are
+# preserved in the frame buffer to be executed when the frame is redrawn.
+# Ignore escapes we know nothing about.  TRUE is returned if the escape is
+# one which is private to the GIM interface, i.e., if the escape has been
+# processed fully by sgm_spoolesc.
+
+bool procedure sgm_spoolesc (tr, gki, fn, gim, bp, buftop, delete_fcn)
+
+pointer tr			#I arg to delete_fcn
+pointer gki			#I pointer to escape instruction
+int	fn			#U escape sequence function opcode
+short	gim[ARB]		#U escape instruction data
+pointer bp			#I frame buffer pointer
+pointer buftop			#I top+1 of buffered data
+int	delete_fcn		#I function called to delete an instruction
+
+pointer	ip, itop, esc
+int	nleft, length, opcode, escape, mp
+
+begin
+	switch (fn) {
+	case GIM_RASTERINIT, GIM_INITMAPPINGS, GIM_FREEMAPPING,
+	    GIM_CREATERASTER, GIM_DESTROYRASTER, GIM_QUERYRASTER,
+	    GIM_GETMAPPING, GIM_ENABLEMAPPING, GIM_DISABLEMAPPING,
+	    GIM_REFRESHMAPPING, GIM_WRITEPIXELS, GIM_READPIXELS,
+	    GIM_REFRESHPIXELS, GIM_SETPIXELS, GIM_COPYRASTER,
+	    GIM_WRITEIOMAP, GIM_READIOMAP, GIM_WRITECMAP, GIM_READCMAP,
+	    GIM_LOADCMAP, GIM_FREECMAP:
+
+	    # These escapes are only executed once.
+	    call zcall2 (delete_fcn, tr, gki)
+
+	case GIM_SETRASTER:
+	    ;  # Preserve this instruction.
+
+	case GIM_SETMAPPING:
+	    # This escape is saved in the frame buffer and rexecuted when
+	    # the frame is redrawn.  This allows the server to buffer the
+	    # image data, but still allows the graphics to be redrawn and
+	    # possibly rescaled in cursor mode.  Rexecution of copyraster
+	    # after a screen clear will cause any rasters created and written
+	    # to with createraster/writepixels to be redrawn on the screen.
+
+	    ip = bp
+	    itop = gki
+
+	    while (ip < itop) {
+		# Search for the beginning of the next instruction.
+		while (Mems[ip] != BOI && ip < itop)
+		    ip = ip + 1
+
+		nleft = itop - ip
+		if (nleft < 3)
+		    break
+		else {
+		    length = Mems[ip+GKI_HDR_LENGTH-1]
+		    if (length > nleft)
+			break
+
+		    opcode = Mems[ip+GKI_HDR_OPCODE-1]
+		    escape = Mems[ip+GKI_ESCAPE_FN-1]
+
+		    # Disable instruction if same mapping number.
+		    if (opcode == GKI_ESCAPE && escape == GIM_SETMAPPING) {
+			esc = ip + GKI_ESCAPE_DC - 1
+			mp = Mems[esc+GIM_SETMAPPING_MP-1]
+			if (mp == gim[GIM_SETMAPPING_MP])
+			    Mems[ip+GKI_HDR_OPCODE-1] = GKI_UNKNOWN
+		    }
+
+		    ip = ip + length
+		}
+	    }
+
+	default:
+	    return (false)
+	}
+
+	return (true)
+end
+
+
+# SGM_WINSIZE -- Get the graphics window size in display pixels.
+
+procedure sgm_winsize (width, height)
+
+int	width, height		#O window size
+
+short	gim_query[GIM_QUERYRASTER_LEN]
+short	retval[GIM_RET_QRAS_LEN]
+
+begin
+	gim_query[GIM_QUERYRASTER_RN] = 0
+	call sgm_query ("QR", gim_query, GIM_QUERYRASTER_LEN,
+	    "Qr", retval, GIM_RET_QRAS_LEN)
+	width  = retval[GIM_RET_QRAS_NX]
+	height = retval[GIM_RET_QRAS_NY]
+end
+
+
+# SGM Private Functions.
+# ---------------------------
+
+# SGM_QUERYRASTER -- Return the attributes of a raster.
+
+procedure sgm_queryraster (gim)
+
+short	gim[ARB]			#I encoded instruction
+short	retval[GIM_RET_QRAS_LEN]
+include	"stdgraph.com"
+
+begin
+	call sgm_query ("QR", gim, GIM_QUERYRASTER_LEN,
+	    "Qr", retval, GIM_RET_QRAS_LEN)
+	call write (g_stream, retval, GIM_RET_QRAS_LEN * SZ_SHORT)
+	call flush (g_stream)
+end
+
+
+# SGM_WRITEPIXELS -- Write a block of pixels to a raster.
+
+procedure sgm_writepixels (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+char	bias
+pointer	sp, bp
+int	nx, ny, npix, i
+include	"stdgraph.com"
+
+begin
+	# Send the write-pixels escape sequence.
+	call sgm_output ("WP", gim, GIM_WRITEPIXELS_LEN)
+
+	# For the moment this code assumes 8 bit pixels.
+	nx = gim[GIM_WRITEPIXELS_NX]
+	ny = gim[GIM_WRITEPIXELS_NY]
+	npix = nx * ny
+
+	call smark (sp)
+	call salloc (bp, npix, TY_CHAR)
+	bias = 040B
+
+	# Send the pixel data encoded in printable ASCII.
+	call achtbc (gim[GIM_WRITEPIXELS_DATA], Memc[bp], npix)
+	do i = 1, npix
+	    Memc[bp+i-1] = Memc[bp+i-1] + bias
+	call write (g_out, Memc[bp], npix)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_READPIXELS -- Read a block of pixels from a raster and return it
+# to the client.
+
+procedure sgm_readpixels (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp
+int	sv_iomode, ch
+int	npix, nx, ny, i
+short	retval[GIM_RET_RPIX_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-pixels escape sequence.
+	call sgm_output ("RP", gim, GIM_READPIXELS_LEN)
+	call flush (g_out)
+
+	# For the moment this code assumes 8 bit pixels.
+	nx = gim[GIM_READPIXELS_NX]
+	ny = gim[GIM_READPIXELS_NY]
+	npix = nx * ny
+
+	call smark (sp)
+	call salloc (bp, npix, TY_CHAR)
+
+	# Get the pixel data.  This is a block of pixel data encoded as for
+	# writepixels (040 bias), bracked by ESC at the front and a single
+	# control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < npix) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	npix = i
+
+	# Send the RPIX header to the client.
+	retval[GIM_RET_RPIX_NP] = npix
+	call write (g_stream, retval, GIM_RET_RPIX_LEN * SZ_SHORT)
+
+	# Return the data to the client.
+	call achtcb (Memc[bp], Memc[bp], npix)
+	call write (g_stream, Memc[bp], (npix + SZB_CHAR-1) / SZB_CHAR)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_WRITECMAP -- Write to a segment of the colormap.
+
+procedure sgm_writecmap (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+short	mask
+pointer	sp, bp, op
+int	ncells, nchars, ip, i
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+
+	# Send the write-colormap escape sequence.
+	call sgm_output ("WM", gim, GIM_WRITECMAP_LEN)
+
+	# Each cell consists of a RGB triplet encoded 2 chars per color.
+	ncells = gim[GIM_WRITECMAP_NC]
+	nchars = ncells * 3 * 2
+
+	call salloc (bp, nchars, TY_CHAR)
+	ip = GIM_WRITECMAP_DATA
+	op = bp
+
+	mask = 017B
+	do i = 1, ncells*3 {
+	    Memc[op] =      gim[ip] / 16   + 040B;  op = op + 1
+	    Memc[op] = and (gim[ip], mask) + 040B;  op = op + 1
+	    ip = ip + 1
+	}
+
+	call write (g_out, Memc[bp], nchars)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_READCMAP -- Read a segment of the colormap.
+
+procedure sgm_readcmap (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp, cm, ip
+int	sv_iomode, ncells, nchars, ch, i
+short	retval[GIM_RET_RCMAP_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-cmap escape sequence.
+	call sgm_output ("RM", gim, GIM_READCMAP_LEN)
+	call flush (g_out)
+
+	# Each cell consists of a RGB triplet encoded 2 chars per color.
+	ncells = gim[GIM_READCMAP_NC]
+	nchars = ncells * 3 * 2
+
+	call smark (sp)
+	call salloc (bp, nchars, TY_CHAR)
+	call salloc (cm, ncells * 3, TY_SHORT)
+
+	# Get the colormap data.  This is a block of RGB colormap triplets
+	# encoded 2 bytes per color, bracked by a ESC at the front and a
+	# single control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < nchars) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	ncells = i / (3 * 2)
+
+	# Decode the packed colormap data.
+	ip = bp
+	do i = 1, ncells * 3 {
+	    Mems[cm+i-1] = (Memc[ip] - 040B) * 16 + (Memc[ip+1] - 040B)
+	    ip = ip + 2
+	}
+
+	# Send the read-cmap header to the client.
+	retval[GIM_RET_RCMAP_NC] = ncells
+	call write (g_stream, retval, GIM_RET_RCMAP_LEN * SZ_SHORT)
+
+	# Return the colormap data to the client.
+	call write (g_stream, Mems[cm], (ncells * 3) * SZ_SHORT)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_IOMAPWRITE -- Write to the iomap.
+
+procedure sgm_iomapwrite (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+short	mask
+pointer	sp, bp, op
+int	ncells, nchars, ip, i
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+
+	# Send the write-iomap escape sequence.
+	call sgm_output ("WO", gim, GIM_WRITEIOMAP_LEN)
+
+	# Each cell consists of a single short integer colormap index
+	# encoded 2 chars per cell.
+
+	ncells = gim[GIM_WRITEIOMAP_NC]
+	nchars = ncells * 2
+
+	call salloc (bp, nchars, TY_CHAR)
+	ip = GIM_WRITEIOMAP_DATA
+	op = bp
+
+	mask = 017B
+	do i = 1, ncells {
+	    Memc[op] =      gim[ip] / 16   + 040B;  op = op + 1
+	    Memc[op] = and (gim[ip], mask) + 040B;  op = op + 1
+	    ip = ip + 1
+	}
+
+	call write (g_out, Memc[bp], nchars)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_IOMAPREAD -- Read a segment of the iomap.
+
+procedure sgm_iomapread (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp, data, ip
+int	sv_iomode, ncells, nchars, ch, i
+short	retval[GIM_RET_RIOMAP_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-iomap escape sequence.
+	call sgm_output ("RO", gim, GIM_READIOMAP_LEN)
+	call flush (g_out)
+
+	# The data is encoded two bytes per short integer value.
+	ncells = gim[GIM_READIOMAP_NC]
+	nchars = ncells * 2
+
+	call smark (sp)
+	call salloc (bp, nchars, TY_CHAR)
+	call salloc (data, ncells, TY_SHORT)
+
+	# Get the iomap data.  This is a block of iomap values encoded
+	# 2 bytes per value, bracked by a ESC at the front and a single
+	# control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < nchars) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	ncells = i / 2
+
+	# Decode the packed iomap data.
+	ip = bp
+	do i = 1, ncells {
+	    Mems[data+i-1] = (Memc[ip] - 040B) * 16 + (Memc[ip+1] - 040B)
+	    ip = ip + 2
+	}
+
+	# Send the read-iomap header to the client.
+	retval[GIM_RET_RIOMAP_NC] = ncells
+	call write (g_stream, retval, GIM_RET_RIOMAP_LEN * SZ_SHORT)
+
+	# Return the iomap data to the client.
+	call write (g_stream, Mems[data], ncells * SZ_SHORT)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_GETMAPPING -- Return the attributes of a mapping.
+
+procedure sgm_getmapping (gim)
+
+short	gim[ARB]			#I encoded instruction
+short	retval[GIM_RET_GMAP_LEN]
+include	"stdgraph.com"
+
+begin
+	call sgm_query ("GM", gim, GIM_GETMAPPING_LEN,
+	    "Gm", retval, GIM_RET_GMAP_LEN)
+	call write (g_stream, retval, GIM_RET_GMAP_LEN * SZ_SHORT)
+	call flush (g_stream)
+end
+
+
+# SGM_OUTPUT -- Format and output a control sequence to the graphics server
+# device.
+
+procedure sgm_output (cap, gim, nargs)
+
+char	cap[ARB]			#I graphcap capability name
+short	gim[ARB]			#I instruction (array of int args)
+int	nargs				#I number of arguments
+
+int	ival, i
+pointer	sp, fmt, ctrl
+include	"stdgraph.com"
+int	ttygets()
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+
+	if (ttygets (g_tty, cap, Memc[fmt], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[fmt])
+		do i = 1, nargs {
+		    # Pass the argument as an integer to avoid INDEF
+		    # processing of -32767, a valid GKI value.
+		    ival = gim[i]
+		    iferr (call pargi (ival))
+			;
+		}
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	}
+
+	call sfree (sp)
+end
+
+
+# SGM_QUERY -- Output an inquiry control sequence to the server and read and
+# decode the server's response.
+
+procedure sgm_query (query_cap, gim, nargs, retval_cap, retval, nout)
+
+char	query_cap[ARB]			#I server query cap name
+short	gim[ARB]			#I query instruction (args)
+int	nargs				#I number of args for server query
+char	retval_cap[ARB]			#I cap name for return value format
+short	retval[ARB]			#O decoded output arguments
+int	nout				#I number of output arguments
+
+int	index[MAX_ARGS]
+pointer	sp, ctrl, patbuf, pat, buf, ip, op
+int	sv_iomode, arg, ch, nchars, start, value, ival, i
+int	patmake(), patindex(), ttyread(), ctoi()
+int	ttygets(), fstati(), gstrcpy()
+include	"stdgraph.com"
+define	done_ 91
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (pat, SZ_LINE, TY_CHAR)
+	call salloc (patbuf, SZ_PATBUF, TY_CHAR)
+
+	call aclrs (retval, nout)
+
+	# Set raw mode i/o.
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Pass the query on to the server.
+	if (ttygets (g_tty, query_cap, Memc[pat], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[pat])
+		do i = 1, nargs {
+		    # Pass the argument as an integer to avoid INDEF
+		    # processing of -32767, a valid GKI value.
+		    ival = gim[i]
+		    iferr (call pargi (ival))
+			;
+		}
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	    call flush (g_out)
+
+	} else
+	    goto done_
+
+	# Encode a pattern to match the server's response as given by the
+	# pattern in retval_cap.
+
+        if (ttygets (g_tty, retval_cap, Memc[pat], SZ_LINE) <= 0)
+	    goto done_
+
+        # Process the retval_cap string, used to specify the format of the
+	# string returned by the server, to map the %N fields therein into
+        # the pattern strings "%[0-9]*", noting the index positions of the
+        # pattern substrings for later decoding.
+
+	call aclri (index, MAX_ARGS)
+	arg = 0
+
+	op = buf
+	for (ip=pat;  Memc[ip] != EOS;  ip=ip+1) {
+	    if (Memc[ip] == '%') {
+		if (Memc[ip+1] == '%') {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		    ip = ip + 1
+		} else {
+		    op = op + gstrcpy ("%[0-9]*", Memc[op], ARB)
+		    ip = ip + 1
+
+		    # Arguments are %1 ... %9, %a, %b, etc.
+		    ch = Memc[ip]
+		    if (IS_DIGIT(ch))
+			i = TO_INTEG(ch)
+		    else if (IS_UPPER(ch))
+			i = ch - 'A' + 10
+		    else
+			i = ch - 'a' + 10
+
+		    arg = arg + 1
+		    i = min(MAX_ARGS, max(1, i))
+		    index[i] = arg
+		}
+	    } else if (Memc[ip] == '[') {
+		Memc[op] = '\\';  op = op + 1
+		Memc[op] = '[' ;  op = op + 1
+	    } else {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	}
+
+	Memc[op] = EOS
+	if (patmake (Memc[buf], Memc[patbuf], SZ_PATBUF) >= SZ_PATBUF)
+	    goto done_
+
+	# Scan the input stream from the server until data matching the
+	# response pattern is received, or a timeout occurs.
+
+	nchars = ttyread (g_in, g_tty,Memc[buf],SZ_LINE,Memc[patbuf], TIMEOUT)
+	if (nchars > 0) {
+	    do i = 1, nout {
+		value = 0
+		if (index[i] > 0) {
+		    start = patindex (Memc[patbuf], index[i])
+		    if (ctoi (Memc[buf], start, value) <= 0)
+			value = 0
+		}
+		retval[i] = value
+	    }
+	}
+done_
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stggrstr.x b/sys/gio/stdgraph/stggrstr.x
new file mode 100644
index 00000000..946b52d9
--- /dev/null
+++ b/sys/gio/stdgraph/stggrstr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GRSTREAM -- Set the FD of the graphics stream, from which we shall read
+# metacode instructions and to which we shall return cell arrays and cursor
+# values.
+
+procedure stg_grstream (stream)
+
+int	stream			# FD of the new graphics stream
+include	"stdgraph.com"
+
+begin
+	g_stream = stream
+end
diff --git a/sys/gio/stdgraph/stginit.x b/sys/gio/stdgraph/stginit.x
new file mode 100644
index 00000000..3e393be4
--- /dev/null
+++ b/sys/gio/stdgraph/stginit.x
@@ -0,0 +1,193 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_INIT -- Initialize the stdgraph data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine STG_RESET initializes the attribute
+# packets when the screen is cleared.
+
+procedure stg_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+bool	first_time
+int	maxch, i, junk
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+pointer	stg_gstring()
+int	ttygets(), ttygeti(), btoi(), stg_encode(), gstrcpy()
+include	"stdgraph.com"
+data	first_time /true/
+
+begin
+	# One time initialization.
+	if (first_time) {
+	    # Initialize the Tek 4012 coordinate encoding lookup tables.
+	    do i = 1, TEK_XRES {
+		g_hixy[i] = (i-1) / 40B + 40B
+		g_lox[i]  = mod ((i-1), 40B) + 100B
+	    }
+	    do i = 1, TEK_YRES
+		g_loy[i]  = mod ((i-1), 40B) + 140B
+
+	    first_time = false
+	}
+
+	# Allocate the stdgraph descriptor and the string buffer.
+	call calloc (g_sg, LEN_SG, TY_STRUCT)
+	call malloc (SG_SBUF(g_sg), SZ_SBUF, TY_CHAR)
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	SG_SZSBUF(g_sg) = SZ_SBUF
+	SG_NEXTCH(g_sg) = SG_SBUF(g_sg) + 1
+	Memc[SG_SBUF(g_sg)] = EOS
+
+	# Set the software device resolution and the coordinate transformations
+	# to the resolution space and from GKI to device coords.  The values
+	# g_[xy]res were initialized when the kernel was opened by the main
+	# program.
+
+	call stg_resolution (g_xres, g_yres)
+
+	# Initialize the encoder.  The graphcap parameter LR contains encoder
+	# instructions to perform any device dependent initialization required.
+
+	call aclri (g_reg, NREGISTERS)
+	nextch = SG_NEXTCH(g_sg)
+
+	g_reg[E_IOP] = 1
+	g_reg[E_TOP] = SZ_MEMORY
+	if (ttygets (tty, "LR", Memc[nextch], SZ_SBUF-1) > 0)
+	    junk = stg_encode (Memc[nextch], g_mem, g_reg)
+
+	# If the device does not support hardware character generation, set
+	# txquality to high to get software character generation.
+
+	if (!ttygetb (tty, "tx"))
+	    g_hardchar = GT_HIGH
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discrete character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	SG_NCHARSIZES(g_sg) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = SG_NEXTCH(g_sg)
+
+	if (SG_NCHARSIZES(g_sg) <= 0) {
+	    SG_NCHARSIZES(g_sg) = 1
+	    SG_CHARSIZE(g_sg,1) = 1.0
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= SG_NCHARSIZES(g_sg);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		SG_CHARSIZE(g_sg,i)   = char_size
+		SG_CHARHEIGHT(g_sg,i) = char_height * char_size
+		SG_CHARWIDTH(g_sg,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the stdgraph
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	SG_POLYLINE(g_sg)   = btoi (ttygetb (tty, "PL"))
+	SG_POLYMARKER(g_sg) = btoi (ttygetb (tty, "pm"))
+	SG_FILLAREA(g_sg)   = btoi (ttygetb (tty, "fa"))
+
+	SG_ENCODEXY(g_sg)   = stg_gstring ("XY")
+	g_xy = SG_ENCODEXY(g_sg)
+
+	SG_STARTDRAW(g_sg)  = stg_gstring ("DS")
+	SG_ENDDRAW(g_sg)    = stg_gstring ("DE")
+	SG_STARTMOVE(g_sg)  = stg_gstring ("VS")
+	SG_ENDMOVE(g_sg)    = stg_gstring ("VE")
+	SG_STARTMARK(g_sg)  = stg_gstring ("MS")
+	SG_ENDMARK(g_sg)    = stg_gstring ("ME")
+	SG_STARTFILL(g_sg)  = stg_gstring ("FS")
+	SG_ENDFILL(g_sg)    = stg_gstring ("FE")
+	SG_STARTTEXT(g_sg)  = stg_gstring ("TS")
+	SG_ENDTEXT(g_sg)    = stg_gstring ("TE")
+
+	# Initialize the input parameters.
+	SG_CURSOR(g_sg) = 0
+	SG_UPDCURSOR(g_sg)  = btoi (ttygetb (tty, "UC"))
+	SG_CURSOR_X(g_sg)   = 0
+	SG_CURSOR_Y(g_sg)   = 0
+
+	# Save the device string in the descriptor.
+	nextch = SG_NEXTCH(g_sg)
+	SG_DEVNAME(g_sg) = nextch
+	maxch = SG_SBUF(g_sg) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+
+	# Initialize the UIFNAME field.
+	SG_UIFNAME(g_sg) = nextch
+	Memc[nextch] = EOS
+	nextch = nextch + SZ_UIFNAME + 1
+	SG_NEXTCH(g_sg) = nextch
+end
+
+
+# STG_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure stg_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"stdgraph.com"
+
+begin
+	nextch = SG_NEXTCH(g_sg)
+	maxch = SG_SBUF(g_sg) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = SG_SBUF(g_sg)
+
+	SG_NEXTCH(g_sg) = nextch
+	return (strp)
+end
diff --git a/sys/gio/stdgraph/stglkcur.x b/sys/gio/stdgraph/stglkcur.x
new file mode 100644
index 00000000..6152534b
--- /dev/null
+++ b/sys/gio/stdgraph/stglkcur.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_LOCKCURSOR -- Lock the logical cursor number.  Called interactively by
+# cursor mode in response to a ":.cursor N" command by the user.  When the
+# cursor is not locked the logical cursor may be selected under program
+# control.
+
+procedure stg_lockcursor (new_cursor)
+
+int	new_cursor		# desired new logical cursor
+include	"stdgraph.com"
+
+begin
+	g_cursor = new_cursor
+end
diff --git a/sys/gio/stdgraph/stgmove.x b/sys/gio/stdgraph/stgmove.x
new file mode 100644
index 00000000..5f7396a3
--- /dev/null
+++ b/sys/gio/stdgraph/stgmove.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_MOVE -- Output a device move instruction to move to the position (x,y)
+# in GKI coordinates.
+
+procedure stg_move (x, y)
+
+int	x, y			# destination
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Transform the first point from GKI coords to device coords and
+	# move to the transformed point.
+
+	call ttyputs (g_out, g_tty, Memc[SG_STARTMOVE(g_sg)], 1)
+
+	g_reg[1] = x * g_dx + g_x1
+	g_reg[2] = y * g_dy + g_y1
+	g_reg[E_IOP] = 1
+	if (stg_encode (Memc[g_xy], g_mem, g_reg) == OK)
+	    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+	
+	call ttyputs (g_out, g_tty, Memc[SG_ENDMOVE(g_sg)], 1)
+end
diff --git a/sys/gio/stdgraph/stgonerr.x b/sys/gio/stdgraph/stgonerr.x
new file mode 100644
index 00000000..047c6152
--- /dev/null
+++ b/sys/gio/stdgraph/stgonerr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_ONERROR -- Called when error recovery takes place to deactivate the
+# stdgraph workstation, i.e., take the terminal out of graphics mode.  If
+# this is not done error messages will be written as vectors.
+
+procedure stg_onerror (errcode)
+
+int	errcode
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES)
+	    call stg_deactivatews (0)
+end
diff --git a/sys/gio/stdgraph/stgonint.x b/sys/gio/stdgraph/stgonint.x
new file mode 100644
index 00000000..2aed03ee
--- /dev/null
+++ b/sys/gio/stdgraph/stgonint.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<xwhen.h>
+include	"stdgraph.h"
+
+# STG_ONINT -- Interrupt handler for the stdgraph kernel.  If an interrupt
+# occurs while we are posted to an exception, branch to the last ZSVJMP.
+# (This library procedure is not currently used by the kernel).
+
+procedure stg_onint (vex, next_handler)
+
+int	vex			# virtual exception
+int	next_handler		# next exception handler in chain
+int	jmpbuf[LEN_JUMPBUF]
+common	/stgxin/ jmpbuf
+
+begin
+	call xer_reset()
+	call zdojmp (jmpbuf, vex)
+end
diff --git a/sys/gio/stdgraph/stgopen.x b/sys/gio/stdgraph/stgopen.x
new file mode 100644
index 00000000..47fb2b61
--- /dev/null
+++ b/sys/gio/stdgraph/stgopen.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_OPEN -- Install the STDGRAPH kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure stg_open (devname, dd, in, out, xres, yres, hardchar)
+
+char	devname[ARB]		# if nonnull, force output to device
+int	dd[ARB]			# device table to be initialized
+int	in			# input file
+int	out			# output file
+int	xres			# number of resolved pixels in X
+int	yres			# number of resolved pixels in Y
+int	hardchar		# use hardware character generator
+
+bool	first_time
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+
+extern	stg_openws(), stg_closews(), stg_clear(), stg_cancel()
+extern	stg_flush(), stg_polyline(), stg_polymarker(), stg_text()
+extern	stg_fillarea(), stg_putcellarray(), stg_setcursor(), stg_plset()
+extern	stg_pmset(), stg_txset(), stg_faset(), stg_getcursor()
+extern	stg_getcellarray(), stg_escape()
+extern	stg_reactivatews(), stg_deactivatews()
+include	"stdgraph.com"
+data	first_time /true/
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	if (first_time) {
+	    g_nopen = 0
+	    g_sg = NULL
+	    g_tty = NULL
+	    g_term = NULL
+	    g_pbtty = NULL
+	    g_cursor = 0
+	    first_time = false
+	}
+
+	g_in   = in
+	g_out  = out
+	g_xres = xres
+	g_yres = yres
+	g_nopen = g_nopen + 1
+	g_stream = STDGRAPH
+	g_hardchar = hardchar
+	g_active = NO
+	g_enable = NO
+	g_message = NO
+	g_msgbuf = NULL
+	g_msgbuflen = 0
+	g_msglen = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+	dd[GKI_OPENWS]		= locpr (stg_openws)
+	dd[GKI_CLOSEWS]		= locpr (stg_closews)
+	dd[GKI_REACTIVATEWS]	= locpr (stg_reactivatews)
+	dd[GKI_DEACTIVATEWS]	= locpr (stg_deactivatews)
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (stg_clear)
+	dd[GKI_CANCEL]		= locpr (stg_cancel)
+	dd[GKI_FLUSH]		= locpr (stg_flush)
+	dd[GKI_POLYLINE]	= locpr (stg_polyline)
+	dd[GKI_POLYMARKER]	= locpr (stg_polymarker)
+	dd[GKI_TEXT]		= locpr (stg_text)
+	dd[GKI_FILLAREA]	= locpr (stg_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (stg_putcellarray)
+	dd[GKI_SETCURSOR]	= locpr (stg_setcursor)
+	dd[GKI_PLSET]		= locpr (stg_plset)
+	dd[GKI_PMSET]		= locpr (stg_pmset)
+	dd[GKI_TXSET]		= locpr (stg_txset)
+	dd[GKI_FASET]		= locpr (stg_faset)
+	dd[GKI_GETCURSOR]	= locpr (stg_getcursor)
+	dd[GKI_GETCELLARRAY]	= locpr (stg_getcellarray)
+	dd[GKI_ESCAPE]		= locpr (stg_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call stg_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgopenws.x b/sys/gio/stdgraph/stgopenws.x
new file mode 100644
index 00000000..a70a51f7
--- /dev/null
+++ b/sys/gio/stdgraph/stgopenws.x
@@ -0,0 +1,220 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<ttset.h>
+include	<error.h>
+include	<chars.h>
+include	<finfo.h>
+include	"stdgraph.h"
+
+# STG_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, followed by initialization of the device itself.
+
+procedure stg_openws (devname, n, mode)
+
+short	devname[ARB]		#I device name (actually device[,uifname])
+int	n			#I length of device name
+int	mode			#I access mode
+
+bool	reinit
+long	fi[LEN_FINFO]
+int	dummy, init_file
+pointer	sp, ip, op, buf, device, uifname, fname
+
+pointer	ttygdes(), ttyodes()
+bool	ttygetb(), strne(), streq()
+int	ttygets(), open(), ttstati(), finfo(), gstrcpy()
+int	nowhite(), envfind(), strlen(), fnroot(), access()
+extern	stg_onerror()
+include	"stdgraph.com"
+define	ow_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_PATHNAME, n), TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Open a termcap descriptor for the terminal too, in case we need
+	# to talk to the terminal as a terminal.
+
+	if (g_term == NULL)
+	    iferr (g_term = ttyodes ("terminal"))
+		g_term = NULL
+
+	# If we are appending merely reactivate the device without performing
+	# any initialization.
+
+	if (g_sg != NULL && mode == APPEND) {
+	    if (g_active == NO) {
+		g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+		if (g_ucaseout == YES)
+		    call ttseti (g_out, TT_UCASEOUT, NO)
+
+		g_active = YES
+		g_enable = YES
+	    }
+	    goto ow_
+	}
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Parse the "device,uifname" specification into the two fields.
+	device = buf
+	uifname = NULL
+	for (ip=buf;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		Memc[ip] = EOS
+		if (Memc[ip+1] != EOS)
+		    uifname = ip + 1
+		if (nowhite (Memc[uifname], Memc[uifname], ARB) == 0)
+		    uifname = NULL
+		break
+	    }
+
+	# If the kernel is already open for this device skip most of the
+	# initialization.  If already open for a different device free
+	# storage before reinitialization.
+
+	reinit = true
+	if (g_sg != NULL)
+	    if (strne (Memc[device], Memc[SG_DEVNAME(g_sg)])) {
+		call mfree (SG_SBUF(g_sg), TY_CHAR)
+		call mfree (g_sg, TY_STRUCT)
+		reinit = true
+	    } else
+		reinit = false
+
+	# Reinitialize the kernel datastructures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+
+	if (reinit) {
+	    if (g_tty != NULL) {
+		call ttycdes (g_tty)
+		g_tty = NULL
+	    }
+
+	    iferr (g_tty = ttygdes (Memc[device])) {
+		g_tty = ttygdes ("4012")
+		call erract (EA_WARN)
+	    }
+
+	    # Initialize data structures.
+	    call stg_init (g_tty, Memc[device])
+	}
+
+	call stg_reset()
+
+	if (g_active == NO) {
+	    # Must disable stty ucaseout mode when in graphics mode, else
+	    # plotting commands may be modified by the terminal driver.
+
+	    g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, NO)
+
+	    # Post ONERROR cleanup routine.
+	    call onerror (stg_onerror)
+	    g_active = YES
+	    g_enable = YES
+	}
+
+	# If no UI file was specified but the device has the EM capability,
+	# use the default UI if any specified in the graphcap entry.  If the
+	# EM capability is missing, ignore any uifname specified when the
+	# device was opened.
+
+	if (ttygetb (g_tty, "EM")) {
+	    if (uifname == NULL) {
+		uifname = buf + strlen(Memc[device]) + 1
+		if (ttygets (g_tty, "ED", Memc[uifname], ARB) <= 0)
+		    uifname = NULL
+	    }
+
+	    # If the user has a version of the named UI file in their GUIDIR,
+	    # use that instead.
+
+	    if (envfind (GUIDIR, Memc[fname], SZ_PATHNAME) > 0) {
+		op = fname + strlen (Memc[fname])
+		op = op + fnroot (Memc[uifname], Memc[op],
+		    fname + SZ_PATHNAME - op)
+		op = op + gstrcpy (".gui", Memc[op], fname + SZ_PATHNAME - op)
+		if (access (Memc[fname], 0, 0) == YES)
+		    uifname = fname
+	    }
+
+	    # If the UI is already running and has not been modified there
+	    # is no need to download it again.
+
+	    if (g_sg != NULL)
+		if (streq (Memc[uifname], Memc[SG_UIFNAME(g_sg)]))
+		    if (finfo (Memc[uifname], fi) != ERR)
+			if (SG_UIFDATE(g_sg) == FI_MTIME(fi))
+			    uifname = NULL
+	} else {
+	    # Ignore UI file if no EM capability.
+	    Memc[SG_UIFNAME(g_sg)] = EOS
+	    SG_UIFDATE(g_sg) = 0
+	    uifname = NULL
+	}
+
+	# Open and Initialize the device.  Output contents of UI definition
+	# file if any, followed by graphics device initialization file,
+	# if any.
+
+	if (mode == NEW_FILE) {
+	    # Output UI definition file.
+	    if (uifname != NULL) {
+		iferr (init_file = open (Memc[uifname], READ_ONLY, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    call stg_ctrl ("OW")
+		} else {
+		    call flush (g_out)
+		    call stg_ctrl ("EM")
+
+		    # Download the UI.
+		    call putline (g_out, "server ")
+		    iferr (call fcopyo (init_file, g_out))
+			call erract (EA_WARN)
+		    call close (init_file)
+
+		    # Record particulars of active UI file.
+		    call strcpy (Memc[uifname], Memc[SG_UIFNAME(g_sg)],
+			SZ_UIFNAME)
+		    if (finfo (Memc[uifname], fi) != ERR)
+			SG_UIFDATE(g_sg) = FI_MTIME(fi)
+		    call sgf_post_filter (g_out)
+
+		    call putci (g_out, US)
+		    call flush (g_out)
+		}
+	    } else
+		call stg_ctrl ("OW")
+
+	    # Output device graphics initialization file if any.
+	    if (ttygets (g_tty, "IF", Memc[buf], SZ_FNAME) > 0) {
+		iferr (init_file = open (Memc[buf], READ_ONLY, TEXT_FILE))
+		    call erract (EA_WARN)
+		iferr (call fcopyo (init_file, g_out))
+		    call erract (EA_WARN)
+		call close (init_file)
+	    }
+
+	    # Clear the screen if device is being opened in new_file mode.
+	    call stg_clear (dummy)
+
+	} else
+ow_	    call stg_ctrl ("OW")
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgoutput.x b/sys/gio/stdgraph/stgoutput.x
new file mode 100644
index 00000000..098af6e7
--- /dev/null
+++ b/sys/gio/stdgraph/stgoutput.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_OUTPUT2 -- Encode two arguments using the program given and write the
+# encoded character string to the output file.
+
+procedure stg_output2 (fd, program, arg1, arg2)
+
+int	fd			# output file
+char	program[ARB]		# encoder program defining encoding
+int	arg1			# argument to be placed in register 1
+int	arg2			# argument to be placed in register 2
+
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Set up encoder.
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	g_reg[E_IOP] = 1
+
+	# Encode the output string and write the encoded string to the output
+	# file.
+	if (stg_encode (g_xy, g_mem, g_reg) == OK)
+	    call write (fd, g_mem, g_reg[E_IOP] - 1)
+end
diff --git a/sys/gio/stdgraph/stgoutstr.x b/sys/gio/stdgraph/stgoutstr.x
new file mode 100644
index 00000000..2d854e75
--- /dev/null
+++ b/sys/gio/stdgraph/stgoutstr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_OUTSTR -- Format and output a control sequence containing a string
+# string argument to the output device.
+
+procedure stg_outstr (cap, strval)
+
+char	cap[ARB]			#I graphcap capability name
+char	strval[ARB]			#I string data
+
+pointer	sp, fmt, ctrl
+include	"stdgraph.com"
+int	ttygets()
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+
+	if (ttygets (g_tty, cap, Memc[fmt], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[fmt])
+		call pargstr (strval)
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgpcell.x b/sys/gio/stdgraph/stgpcell.x
new file mode 100644
index 00000000..476d90cf
--- /dev/null
+++ b/sys/gio/stdgraph/stgpcell.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# STG_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure stg_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"stdgraph.com"
+int	and()
+
+begin
+	# Set polyline width to 1 for max y-res.
+	call stg_ctrl1 ("LW", 1)
+	SG_PLWIDTH(g_sg) = 1
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	dy = max (1.0, real(GKI_MAXNDC) / real(g_yres))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call stg_move (int ((i1-1) * dx + ax1), my)
+		    call stg_draw (int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
diff --git a/sys/gio/stdgraph/stgpl.x b/sys/gio/stdgraph/stgpl.x
new file mode 100644
index 00000000..894a92c3
--- /dev/null
+++ b/sys/gio/stdgraph/stgpl.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure stg_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update polyline attributes if necessary.
+
+	pl = SG_PLAP(g_sg)
+	if (SG_PLTYPE(g_sg) != PL_LTYPE(pl)) {
+	    call stg_ctrl1 ("LT", PL_LTYPE(pl))
+	    SG_PLTYPE(g_sg) = PL_LTYPE(pl)
+	}
+	if (SG_PLWIDTH(g_sg) != PL_WIDTH(pl)) {
+	    call stg_ctrl1 ("LW", PL_WIDTH(pl))
+	    SG_PLWIDTH(g_sg) = PL_WIDTH(pl)
+	}
+	if (SG_COLOR(g_sg) != PL_COLOR(pl)) {
+	    call stg_ctrl1 ("LC", PL_COLOR(pl))
+	    SG_COLOR(g_sg) = PL_COLOR(pl)
+	}
+
+	# Transform the first point from GKI coords to device coords and
+	# move to the transformed point.
+
+	sx = p[1]; sy = p[2]
+	call stg_move (sx, sy)
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the polyline.  If the device has the "polyline" capability
+	# we can encode and output successive points without enclosing each
+	# individual point in the startdraw and enddraw strings.
+
+	for (ip=3;  ip <= len_p;  ip=ip+2) {
+	    # Output start draw sequence.
+	    call ttyputs (g_out, g_tty, Memc[SG_STARTDRAW(g_sg)], 1)
+
+	    # Determine number of points to output.
+	    if (SG_POLYLINE(g_sg) == YES)
+		n = len_p
+	    else
+		n = ip + 2
+
+	    # Encode the points of the polyline.
+
+	    g_lastx = -1	# clip unresolved points only in the interior
+	    g_lasty = -1	# of the polyline being drawn.
+
+	    g_reg[E_IOP] = 1
+	    do i = ip, n, 2 {
+		sx = p[i]
+		sy = p[i+1]
+
+		# Discard the point if it is not resolved.
+		lowres_x = sx / g_dxres
+		lowres_y = sy / g_dyres
+		if (lowres_x == g_lastx && lowres_y == g_lasty)
+		    next
+
+		g_lastx = lowres_x
+		g_lasty = lowres_y
+
+		# Transform point into the device window.
+		sx = int (sx * g_dx) + g_x1
+		sy = int (sy * g_dy) + g_y1
+
+		# Encode the point, appending encoded bytes to g_mem.  Tek
+		# encoding is treated as a special case since it is so common;
+		# the encoder is used for non-Tek encodings.
+
+		if (tek_encoding) {
+		    iop = g_reg[E_IOP] + 4
+		    g_mem[iop-4] = g_hixy[sy+1]
+		    g_mem[iop-3] = g_loy[sy+1]
+		    g_mem[iop-2] = g_hixy[sx+1]
+		    g_mem[iop-1] = g_lox[sx+1]
+		    g_reg[E_IOP] = iop
+		} else {
+		    g_reg[1] = sx
+		    g_reg[2] = sy
+		    if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			break
+		}
+
+		# Flush buffer if nearly full.
+		if (g_reg[E_IOP] > FLUSH_MEMORY) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+	    }
+	    ip = n
+
+	    # Flush any output remaining in encoder memory.
+	    if (g_reg[E_IOP] > 1) {
+		call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		g_reg[E_IOP] = 1
+	    }
+
+	    # Output end draw sequence.
+	    call ttyputs (g_out, g_tty, Memc[SG_ENDDRAW(g_sg)], 1)
+	}
+end
diff --git a/sys/gio/stdgraph/stgplset.x b/sys/gio/stdgraph/stgplset.x
new file mode 100644
index 00000000..c435feb5
--- /dev/null
+++ b/sys/gio/stdgraph/stgplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure stg_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"stdgraph.com"
+
+begin
+	pl = SG_PLAP(g_sg)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = max (1, nint (GKI_UNPACKREAL (gki[GKI_PLSET_LW])))
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/stdgraph/stgpm.x b/sys/gio/stdgraph/stgpm.x
new file mode 100644
index 00000000..3808d63b
--- /dev/null
+++ b/sys/gio/stdgraph/stgpm.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs, each of which
+# is to be plotted as a point.  If the marker start sequence MS is defined the
+# polymarker will be drawn as <markstart> <p1> ... <pN> <markend>, otherwise
+# ther marker is draw using the polyline move and draw commands to draw each
+# individual point.
+
+procedure stg_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update polymarker attributes if necessary.
+
+	pm = SG_PMAP(g_sg)
+	if (SG_COLOR(g_sg) != PM_COLOR(pm)) {
+	    call stg_ctrl1 ("MC", PM_COLOR(pm))
+	    SG_COLOR(g_sg) = PM_COLOR(pm)
+	}
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the polymarker.  If the startmark sequence is defined we assume
+	# that the device can draw a multipoint polymarker, else low level move
+	# and draw sequences are used.
+
+	if (Memc[SG_STARTMARK(g_sg)] != EOS) {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		# Output start marker sequence [revised to use the encoder].
+		call ttyputs (g_out, g_tty, Memc[SG_STARTMARK(g_sg)], 1)
+		n = len_p
+
+		# Encode the points of the polymarker (or move to the single
+		# point to be drawn).
+
+		g_lastx = -1	# clip unresolved points only in the interior
+		g_lasty = -1	# of the polymarker being drawn.
+
+		g_reg[E_IOP] = 1
+		do i = ip, n, 2 {
+		    sx = p[i]
+		    sy = p[i+1]
+
+		    # Discard the point if it is not resolved.
+		    lowres_x = sx / g_dxres
+		    lowres_y = sy / g_dyres
+		    if (lowres_x == g_lastx && lowres_y == g_lasty)
+			next
+
+		    g_lastx = lowres_x
+		    g_lasty = lowres_y
+
+		    # Transform point into the device window.
+		    sx = int (sx * g_dx) + g_x1
+		    sy = int (sy * g_dy) + g_y1
+
+		    # Encode the point, appending encoded bytes to g_mem.
+		    # Tek encoding is treated as a special case since it is
+		    # so common; the encoder is used for non-Tek encodings.
+
+		    if (tek_encoding) {
+			iop = g_reg[E_IOP] + 4
+			g_mem[iop-4] = g_hixy[sy+1]
+			g_mem[iop-3] = g_loy[sy+1]
+			g_mem[iop-2] = g_hixy[sx+1]
+			g_mem[iop-1] = g_lox[sx+1]
+			g_reg[E_IOP] = iop
+		    } else {
+			g_reg[1] = sx
+			g_reg[2] = sy
+			if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			    break
+		    }
+
+		    # Flush buffer if nearly full.
+		    if (g_reg[E_IOP] > FLUSH_MEMORY) {
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+			g_reg[E_IOP] = 1
+		    }
+		}
+		ip = n
+
+		# Flush any output remaining in encoder memory.
+		if (g_reg[E_IOP] > 1) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+
+		# Output end polymarker sequence, or draw the point.
+		call ttyputs (g_out, g_tty, Memc[SG_ENDMARK(g_sg)], 1)
+	    }
+	} else {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		sx = p[ip];  sy = p[ip+1]
+		call stg_move (sx, sy)
+		call stg_draw (sx, sy)
+	    }
+	}
+end
diff --git a/sys/gio/stdgraph/stgpmset.x b/sys/gio/stdgraph/stgpmset.x
new file mode 100644
index 00000000..6651564f
--- /dev/null
+++ b/sys/gio/stdgraph/stgpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_PMSET -- Set the polymarker attributes.
+
+procedure stg_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"stdgraph.com"
+
+begin
+	pm = SG_PMAP(g_sg)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = max (1, nint (GKI_UNPACKREAL (gki[GKI_PMSET_MW])))
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/stdgraph/stgrcur.x b/sys/gio/stdgraph/stgrcur.x
new file mode 100644
index 00000000..e0ab890a
--- /dev/null
+++ b/sys/gio/stdgraph/stgrcur.x
@@ -0,0 +1,425 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<error.h>
+include	<chars.h>
+include	<ttset.h>
+include	<gset.h>
+include	<fset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+define	MAX_LENCUR	17
+define	MAX_KEYLINES	30
+define	KEYSIZE		1
+define	QUIT		'q'
+define	GO		'g'
+
+# STG_READCURSOR -- Physically read the cursor, returning the cursor position
+# in GKI coordinates and the keystroke value as output arguments.  The cursor
+# value string is read in raw mode with interrupts disabled.  Receipt of the
+# EOF character or CR causes EOF to be returned as the key value.
+#
+# The cursor is described by two parameters, a pattern string (CD) and a string
+# length parameter (CN).
+#
+#	CD	A pattern specifying either the delimiter sequence if
+#		len_curval > 0, or the entire cursor value string if
+#		len_curval <= 0.
+#
+#	CN	If no pattern is given, CN is the number of characters to be
+#		read and automatic error detection is not possible.  If a
+#		pattern is given, a negative CN specifies the minimum number
+# 		of characters in the cursor value string, with the pattern
+#		being used to match the characters in the actual cursor value
+#		string.  A positive CN specifies a fixed length cursor value
+#		string, which which case the pattern is used only to determine
+#		when a valid cursor value string has been received.
+#
+# The cursor read algorithm tries to ignore unsolicited input and recover from
+# bad cursor reads, or loss of hardware cursor mode during a cursor read, e.g.,
+# if the screen is accidentally cleared or the terminal otherwise initialized.
+#
+# The physical cursor read sequence is implemented by the stg_rdcursor routine.
+# The purpose of the higher level routine is to support STTY playback mode.
+# In playback mode, terminal input is taken from a logfile rather than from
+# the physical terminal; this is used to prepare automatic scripts to test
+# software and for demos.  If playback mode is enabled and `verify' is enabled,
+# the logged cursor position will be read, a WC will be issued to move the
+# cursor to that position, and then the physical cursor will be read and the
+# return value discard, returning the logged position to the calling program.
+# In playback mode with `verify' disabled, we need only disable the RC
+# instruction and read the logged cursor position; the physical cursor is
+# never turned on.
+
+procedure stg_readcursor (cursor, cn, key, sx, sy, raster, rx, ry)
+
+int	cursor		#I cursor to be read
+int	cn		#O cursor which was read
+int	key		#O keystroke which terminated cursor read
+int	sx, sy		#O screen coordinates of cursor in GKI units
+int	raster		#O raster number
+int	rx, ry		#O raster coordinates of cursor in GKI units
+
+short	texts[4]
+char	textc[4], ch
+pointer	sp, pbdevice, tx, o_tx
+int	delay, nchars, mx, my, i, j, k
+bool	playback_mode, pbverify_mode
+
+bool	strne()
+pointer	ttygdes()
+int	ttstati(), ttstats(), ctocc()
+errchk	ttygdes, syserr
+include	"stdgraph.com"
+define	samedev_ 91
+
+begin
+	playback_mode = (ttstati (STDIN, TT_PLAYBACK) == YES)
+
+	if (!playback_mode) {
+	    call stg_rdcursor (g_tty, cursor, YES,
+		cn, key, sx, sy, raster, rx, ry)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (pbdevice, SZ_GDEVICE, TY_CHAR)
+	call salloc (o_tx, LEN_TX, TY_STRUCT)
+
+	# The playback script may have been generated on a different graphics
+	# terminal than the one we are playing it back on.  Open the graphcap
+	# descriptor for the device used when the script was recorded.  This
+	# must be used when decoding cursor input from the logfile.  If device
+	# name not recorded in logfile, try to make do with the descriptor for
+	# the current stdgraph device.
+
+	if (ttstats (STDIN, TT_GDEVICE, Memc[pbdevice], SZ_GDEVICE) <= 0) {
+	    # Device name not recorded in logfile.
+	    call syserr (SYS_STTYNOGDEV)
+
+	} else if (g_pbtty == NULL || strne (g_pbdevice, Memc[pbdevice])) {
+	    # Device name was recorded; try to load graphcap for it if not
+	    # already loaded.
+
+	    if (g_pbtty != NULL)
+		call ttycdes (g_pbtty)
+	    iferr (g_pbtty = ttygdes (Memc[pbdevice])) {
+		g_pbtty = NULL
+		call erract (EA_ERROR)
+	    }
+
+	    call strcpy (Memc[pbdevice], g_pbdevice, SZ_GDEVICE)
+	}
+
+	# Set the playback delay to 0 msec while reading the cursor, else
+	# the multicharacter cursor read will take forever.  We issue the
+	# delay below, ourselves, one per cursor read.
+
+	delay = ttstati (STDIN, TT_PBDELAY)
+	call ttseti (STDIN, TT_PBDELAY, 0)
+
+	# Read the logged cursor position with RC disabled.
+	call stg_rdcursor (g_pbtty, cursor, NO,
+	    cn, key, sx, sy, raster, rx, ry)
+
+	# Determine if verify mode is set for this cursor read.  This must
+	# be done after the call to stg_rdcursor to permit processing of
+	# any \{ .. \} in the logfile.
+
+	pbverify_mode = (ttstati (STDIN, TT_PBVERIFY) == YES)
+
+	# Set passthru mode to read/write the device directly.
+	call ttseti (STDIN, TT_PASSTHRU, YES)
+
+	# Encode the logged keystroke as a character string.
+	if (key == EOF) {
+	    call strcpy ("EOF", textc, 4)
+	    nchars = 3
+	} else if (key <= ' ') {
+	    ch = key
+	    nchars = ctocc (ch, textc, 4)
+	} else {
+	    nchars = 1
+	    textc[1] = key
+	}
+
+	# Pack the string in a short array for the GKI operator.
+	call achtcs (textc, texts, nchars)
+
+	# Set the text drawing attributes.
+	tx = SG_TXAP(g_sg)
+	call amovi (Memi[tx], Memi[o_tx], LEN_TX)
+	TX_SIZE(tx) = KEYSIZE
+	TX_HJUSTIFY(tx) = GT_LEFT
+	TX_VJUSTIFY(tx) = GT_BOTTOM
+
+	# Echo the key character in graphics mode on the top line of the screen,
+	# duplicating the text drawn at the cursor position.
+
+	mx = nint ((g_keycol + 0.5) * SG_CHARWIDTH(g_sg,1))
+	my = GKI_MAXNDC - nint ((g_keyline + 0.2) * SG_CHARHEIGHT(g_sg,KEYSIZE))
+
+	call stg_text (mx, my, texts, nchars)
+	g_keyline = g_keyline + 1
+	if (g_keyline > MAX_KEYLINES) {
+	    g_keycol = g_keycol + 1
+	    g_keyline = 1
+	}
+
+	# Echo the logged keystroke at the position of the cursor.  This may
+	# not always be readable, but at least it marks the cursor position.
+
+	call stg_text (sx, sy, texts, nchars)
+
+	if (pbverify_mode) {
+	    # Issue a WC to set the cursor position, and perform a normal
+	    # cursor read in passthru mode, discarding the return value.
+
+	    call stg_setcursor (sx, sy, cursor)
+	    call stg_rdcursor (g_tty, cursor, YES, i, i, j, k, i, j, k)
+
+	    # User wants to terminate playback mode?
+	    if (k == QUIT || k == INTCHAR) {
+		call ttseti (STDIN, TT_PLAYBACK, NO)
+		call stg_ctrl ("GD")
+		call putline (STDOUT, "[playback mode terminated]")
+		call stg_ctrl ("GE")
+		call flush (STDOUT)
+		call zwmsec (500)
+		if (k == INTCHAR)
+		    key = EOF
+	    } else if (k == GO)
+		call ttseti (STDIN, TT_PBVERIFY, NO)
+	} else
+	    call zwmsec (delay)
+
+	# Restore everything modified earlier.
+	call ttseti (STDIN, TT_PASSTHRU, NO)
+	call ttseti (STDIN, TT_PBDELAY, delay)
+	call amovi (Memi[o_tx], Memi[tx], LEN_TX)
+
+	call sfree (sp)
+end
+
+
+# STG_RDCURSOR -- Physically read the cursor; an internal routine called only
+# by the stg_readcursor procedure.  A lower level routine is needed since
+# two cursor reads may be required in STTY playback mode, one to read the
+# logged cursor position and another to read the physical cursor to synch
+# with the user.  This is the real cursor read routine; the only concession
+# to playback mode is the `output_rc' switch, to disable output of the RC
+# instruction to the terminal, so that the routine does only input from the
+# logical device.
+
+procedure stg_rdcursor (tty, cursor, output_rc, cn, key, sx,sy, raster, rx,ry)
+
+pointer	tty		#I graphcap descriptor
+int	cursor		#I cursor to be read
+int	output_rc	#I flag to output the RC instruction
+int	cn		#O cursor which was read
+int	key		#O keystroke which terminated cursor read
+int	sx, sy		#O cursor screen position in GKI coords
+int	raster		#O raster number
+int	rx, ry		#O cursor raster position in GKI coords
+
+pointer	decodecur, delimcur, pattern, patbuf, sp, otop
+int	len_pattern, len_curval, sv_iomode, nchars, ip, op, i1, i2, ch
+
+bool	ttygetb()
+int	getci(), stg_encode()
+int	ttygets(), ttygeti(), gstrcpy(), gpatmatch(), patmake(), fstati()
+include	"stdgraph.com"
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (pattern, SZ_LINE, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+	call salloc (decodecur, SZ_LINE, TY_CHAR)
+	call salloc (delimcur, SZ_FNAME, TY_CHAR)
+
+	key = EOF
+
+	# Make sure there is a cursor before going any further.
+	if (!ttygetb (g_tty, "RC"))
+	    goto quit_
+
+	len_curval = ttygeti (tty, "CN")
+	if (ttygets (tty, "SC", Memc[decodecur], SZ_LINE) <= 0)
+	    goto quit_
+
+	len_pattern = 0
+	if (ttygets (tty, "CD", Memc[delimcur], SZ_FNAME) > 0)
+	    len_pattern = gstrcpy (Memc[delimcur], Memc[pattern], SZ_LINE)
+
+	# Either len_curval or pattern must be given, preferably both.
+	if (len_curval == 0 && len_pattern == 0)
+	    goto quit_
+
+	# Encode the cursor value pattern, which may be either a pattern
+	# matching the entire cursor value, or just the delimiter.  The value
+	# of len_curval may be negative if a pattern is given, but must be
+	# positive otherwise.  If the pattern is a delimiter string, append
+	# the $ metacharacter to match only at the end of the string.
+
+	if (len_pattern > 0) {
+	    if (len_curval > 0) {
+		Memc[pattern+len_pattern] = '$'
+		len_pattern = len_pattern + 1
+		Memc[pattern+len_pattern] = EOS
+	    }
+	    if (patmake (Memc[pattern], Memc[patbuf], SZ_LINE) == ERR)
+		goto quit_
+	} else if (len_curval < 0)
+	    len_curval = -len_curval
+
+	# Set raw mode on the input file (the graphics terminal).
+	call flush (STDOUT); call flush (STDERR)
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	repeat {
+	    # Initiate a cursor read.
+	    if (output_rc == YES) {
+		call stg_ctrl1 ("RC", cursor)
+		call flush (g_out)
+	    }
+
+	    # Read the cursor value string.  If a pattern is given accumulate
+	    # at least abs(len_curval) characters and stop when the pattern
+	    # is matched, returning the last len_curval characters if
+	    # len_curval > 0, else the matched substring.  If no pattern is
+	    # given simply accumulate len_curval characters.  The number of
+	    # characters we will accumulate in one iteration is limited to
+	    # MAX_LENCUR to permit retransmission of the RC control sequence
+	    # in the event that hardware cursor mode is accidentally cleared.
+
+	    for (op=1;  op <= MAX_LENCUR;  op=op+1) {
+		g_mem[op] = getci (g_in, key)
+		g_mem[op+1] = EOS
+
+		if (key == EOF) {
+		    # Turn off raw input mode and return EOF.
+		    key = EOF
+		    if (sv_iomode != IO_RAW)
+			call fseti (g_in, F_IOMODE, sv_iomode)
+		    goto quit_
+
+		} else if (len_pattern > 0) {
+		    # A pattern string was given.  Once the minimum number of
+		    # chars have been accumulated, try to match the pattern,
+		    # which may match either the cursor string delimiter (in
+		    # the case of a fixed length cursor value), or the entire
+		    # cursor string (which may then be variable length).
+
+		    if (op < abs(len_curval))
+			next
+		    else if (gpatmatch (g_mem[1], Memc[patbuf], i1,i2) > 0) {
+			if (len_curval > 0)
+			    ip = op - len_curval + 1 	# fixed length cur
+			else
+			    ip = i1			# variable length cur
+			break
+		    }
+
+		} else if (op >= len_curval) {
+		    # No pattern was given.  Terminate the cursor read once
+		    # the len_curval characters have been accumulated.
+
+		    ip = 1
+		    break
+		}
+	    }
+
+	    # We have received too many characters, indicating that cursor
+	    # mode was lost and the user has been pounding on the keyboard
+	    # trying to get the cursor back.  Discard the chars, restart
+	    # the cursor and try again.
+
+	    if (op > MAX_LENCUR)
+		op = -1
+
+	} until (op >= abs(len_curval) || len_curval == 0)
+
+	# Decode the cursor value string and return the position and key
+	# as output values.  Return the cursor position in GKI coordinates.
+	# If extra characters were typed, e.g., before the cursor was turned
+	# on, and the cursor has a delimiter string, the extra characters will
+	# have been read into low memory and we should be able to ignore them
+	# and still get a valid read.
+
+	g_reg[E_IOP] = ip
+	call aclri (g_reg, 7)
+	if (stg_encode (Memc[decodecur], g_mem, g_reg) != OK)
+	    call syserr (SYS_GGCUR)
+
+	# Multiple cursors are not implemented yet so just echo input.
+	cn  = cursor
+
+	# Standard cursor value.
+	sx  = nint ((g_reg[1] - g_x1) / g_dx)
+	sy  = nint ((g_reg[2] - g_y1) / g_dy)
+	key = g_reg[3]
+
+	# Only some devices return the following fields.  Note that FX,FY
+	# are returned by stg_encode in GKI coordinates.
+
+	nchars = g_reg[4]
+	raster = g_reg[5]
+	if (raster == 0) {
+	    rx = sx
+	    ry = sy
+	} else {
+	    rx = g_reg[6]
+	    ry = g_reg[7]
+	}
+
+	# If the NCHARS field is nonzero then a data block of length nchars
+	# follows the cursor value struct returned by the terminal.  Read this
+	# into the g_msgbuf message buffer.  The client makes a subsequent
+	# call to stg_readtty to access this data, otherwise it is discarded
+	# in the next cursor read.
+
+	if (nchars > 0) {
+	    if (nchars > g_msgbuflen) {
+		g_msgbuflen = (nchars + SZ_MSGBUF - 1) / SZ_MSGBUF * SZ_MSGBUF
+		call realloc (g_msgbuf, g_msgbuflen, TY_CHAR)
+	    }
+
+	    # We should encode this data transfer in a way that permits
+	    # detection and recovery from lost data.  For the moment, the
+	    # following assumes that nchars of data will actually be received.
+
+	    op = g_msgbuf
+	    otop = g_msgbuf + nchars
+	    while (op < otop && getci (g_in, ch) != EOF) {
+		Memc[op] = ch
+	        op = op + 1
+	    }
+	    g_msglen = op - g_msgbuf
+	    Memc[op] = EOS
+
+	} else
+	    g_msglen = 0
+
+	# Turn off raw input mode.
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+
+	# Return EOF if any EOF character (e.g., <ctrl/z> or <ctrl/d>) or the
+	# interrupt character is typed.
+
+	if (key == EOFCHAR || key == INTCHAR || key == '\004' || key == '\032')
+	    key = EOF
+quit_
+	# Terminate the cursor read.
+	if (output_rc == YES) {
+	    call stg_ctrl1 ("RE", cursor)
+	    call flush (g_out)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgreact.x b/sys/gio/stdgraph/stgreact.x
new file mode 100644
index 00000000..21c2a821
--- /dev/null
+++ b/sys/gio/stdgraph/stgreact.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<ttset.h>
+include	"stdgraph.h"
+
+# STG_REACTIVATEWS -- Reactivate the workstation, i.e., enable graphics.
+
+procedure stg_reactivatews (flags)
+
+int	flags			# action flags (handled by cursor mode)
+
+int	junk
+int	ttstati(), ttyctrl(), and()
+extern	stg_onerror()
+include	"stdgraph.com"
+
+begin
+	if (g_active == NO) {
+	    junk = ttyctrl (g_out, g_tty, "OW", 1)
+
+	    # Post error handler to be called if we abort.
+	    call onerror (stg_onerror)
+
+	    g_active = YES
+	    g_enable = YES
+
+	    # Must disable stty ucaseout mode when in graphics mode, else
+	    # plotting commands may be modified by the terminal driver.
+
+	    g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, NO)
+
+	    # Clear the graphics screen?
+	    if (and (flags, AW_CLEAR) != 0)
+		call stg_clear (0)
+
+	    call flush (g_out)
+	}
+end
diff --git a/sys/gio/stdgraph/stgres.x b/sys/gio/stdgraph/stgres.x
new file mode 100644
index 00000000..d6355bd9
--- /dev/null
+++ b/sys/gio/stdgraph/stgres.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_RESOLUTION -- Set the "soft" device resolution.  When plotting GKI
+# coordinates are transformed into a space with the indicated resolution and
+# unresolved points are discarded, before transforming to device coordinates.
+# We must set up both the transformation to resolution space and the
+# transformation to device space.
+
+procedure stg_resolution (xres, yres)
+
+int	xres				# device X resolution
+int	yres				# device Y resolution
+int	nx, ny
+int	ttygeti()
+include	"stdgraph.com"
+
+begin
+	if (g_tty == NULL) {
+	    g_xres = xres
+	    g_yres = yres
+	    return
+	}
+
+	# Set the resolution value in the stdgraph common only if a nonzero
+	# value is given.  A value of zero does not change the resolution.
+
+	if (xres > 0)
+	    g_xres = xres
+	if (yres > 0)
+	    g_yres = yres
+
+
+	# If we still have a zero resolution then we use the full resolution
+	# of the device.  The 3/4 reduction in resolution is needed to clip
+	# points that would be unresolved due to integer truncation effects.
+
+	if (g_xres <= 0) {
+	    g_xres = ttygeti (g_tty, "xr")
+	    if (g_xres <= 0)
+		g_xres = 1024
+	    g_xres = max (2, g_xres * 3 / 4)
+	}
+	if (g_yres <= 0) {
+	    g_yres = ttygeti (g_tty, "yr")
+	    if (g_yres <= 0)
+		g_yres = 1024
+	    g_yres = max (2, g_yres * 3 / 4)
+	}
+
+	# Set up coordinate transformations.  The first transformation is from
+	# GKI coordinates to device resolution coordinates (0:xres-1,0:yres-1)
+	# and is defined by xres, yres, and GKI_MAXNDC.  Clipping of unresolved
+	# points is performed after this first transformation.  The second
+	# transformation maps resolved points into the device window.
+
+	# GKI -> resolution coords.
+	g_dxres = max (1, (GKI_MAXNDC + 1) / g_xres)
+	g_dyres = max (1, (GKI_MAXNDC + 1) / g_yres)
+
+	g_x1 = ttygeti (g_tty, "X1")
+	g_y1 = ttygeti (g_tty, "Y1")
+	g_x2 = ttygeti (g_tty, "X2")
+	g_y2 = ttygeti (g_tty, "Y2")
+	nx   = g_x2 - g_x1 + 1
+	ny   = g_y2 - g_y1 + 1
+
+	if (nx <= 1 || ny <= 1) {
+	    call eprintf ("openws: illegal graphics device window\n")
+	    nx = g_xres
+	    ny = g_yres
+	}
+
+	# GKI -> window coords.
+	g_dx = real (nx - 1) / GKI_MAXNDC
+	g_dy = real (ny - 1) / GKI_MAXNDC
+
+	# The last point in resolution coords is used to clip unresolved
+	# points when drawing polylines.
+
+	g_lastx = -1
+	g_lasty = -1
+end
diff --git a/sys/gio/stdgraph/stgreset.x b/sys/gio/stdgraph/stgreset.x
new file mode 100644
index 00000000..0f2fd1e2
--- /dev/null
+++ b/sys/gio/stdgraph/stgreset.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_RESET -- Reset the state of the stdgraph common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure stg_reset()
+
+pointer	pl, pm, fa, tx
+include	"stdgraph.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = SG_PLAP(g_sg)
+	pm = SG_PMAP(g_sg)
+	fa = SG_FAAP(g_sg)
+	tx = SG_TXAP(g_sg)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	  = 1
+	PL_WIDTH(pl)	  = 1
+	PL_COLOR(pl)	  = 1
+	PM_COLOR(pm)	  = 1
+	FA_STYLE(fa)	  = 1
+	FA_COLOR(fa)	  = 1
+	TX_UP(tx)	  = 90
+	TX_SIZE(tx)	  = 1
+	TX_PATH(tx)	  = GT_RIGHT
+	TX_HJUSTIFY(tx)	  = GT_LEFT
+	TX_VJUSTIFY(tx)	  = GT_BOTTOM
+	TX_FONT(tx)	  = GT_ROMAN
+	TX_COLOR(tx)	  = 1
+	TX_SPACING(tx)	  = 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	SG_COLOR(g_sg)	  = -1
+	SG_TXSIZE(g_sg)	  = -1
+	SG_TXFONT(g_sg)	  = -1
+	SG_PLTYPE(g_sg)   = -1
+	SG_FASTYLE(g_sg)  = -1
+	SG_PLWIDTH(g_sg)  = -1
+	g_lastx		  = -1
+	g_lasty		  = -1
+	g_keycol	  = 1
+	g_keyline	  = 1
+	g_message	  = NO
+	g_msglen	  = 0
+end
diff --git a/sys/gio/stdgraph/stgrtty.x b/sys/gio/stdgraph/stgrtty.x
new file mode 100644
index 00000000..237a7c7b
--- /dev/null
+++ b/sys/gio/stdgraph/stgrtty.x
@@ -0,0 +1,137 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<chars.h>
+include	"stdgraph.h"
+
+# STG_READTTY -- Read a line of text from the graphics terminal.
+# If the workstation is currently activated the read is performed in raw mode,
+# presumably with the cursor positioned to the end of a prompt string on the
+# status line.  The workstation will have been put into text mode and the
+# cursor positioned to the status line by an immediately preceding call to
+# stg_writetty, which is called by pseudofile i/o when the user task writes
+# to STDOUT or STDERR while the workstation is activated.  The input sequence
+# terminates when the user types return or newline, causing exit with
+# transmission of the GE sequence to restore the terminal to graphics mode.
+
+int procedure stg_readtty (fd, obuf, maxch)
+
+int	fd			#I input stream	[NOT USED]
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars to read
+
+int	nchars, op, ch
+int	read(), getci(), fstati()
+include	"stdgraph.com"
+errchk	read, getci, ttyctrl
+string	delstr "\010 \010"
+
+begin
+	call flush (STDERR)
+	call flush (STDOUT)
+
+	if (g_active == NO) {
+	    # Workstation in normal text mode; normal text input.
+	    return (read (STDIN, obuf, maxch))
+
+	} else if (g_msglen > 0) {
+	    # The message data has already been transmitted and resides in
+	    # the message buffer.
+
+	    nchars = min (maxch, g_msglen)
+	    call amovc (Memc[g_msgbuf], obuf, nchars)
+	    obuf[nchars+1] = EOS
+	    g_msglen = 0
+	    return (nchars)
+
+	} else {
+	    # Workstation is activated; read status line in raw mode.
+	    # If already in rew mode, read a single char with no echo.
+	    # Note that genable is not automatic in raw input mode.
+
+	    if (g_enable == YES)
+		call stg_gdisab()
+
+	    if (fstati (g_in, F_RAW) == YES) {
+		if (getci (g_in, ch) == EOF) {
+		    obuf[1] = EOS
+		    return (EOF)
+		} else if (ch == '\004' || ch == '\032') {
+		    obuf[1] = EOS
+		    return (EOF)
+		} else {
+		    obuf[1] = ch
+		    obuf[2] = EOS
+		    return (1)
+		}
+	    } else
+		call fseti (g_in, F_RAW, YES)
+
+	    for (op=1;  getci (g_in, ch) != EOF;  op=min(maxch,op)) {
+		switch (ch) {
+		case EOF, '\004', '\032':		# EOF
+		    call stg_genab()
+		    break
+		case '\n', '\r':
+		    obuf[op] = '\n'
+		    op = op + 1
+		    call putline (g_out, "\r\n")
+		    call stg_genab()
+		    break
+		case INTCHAR, '\025':			# <ctrl/u>
+		    for (;  op > 1;  op=op-1)
+			call putline (g_out, delstr)
+		case BS, '\177':
+		    if (op > 1) {
+			call putline (g_out, delstr)
+			op = op - 1
+		    } else {
+			call stg_genab()
+			break				# exit
+		    }
+		default:
+		    call putci (g_out, ch)
+		    obuf[op] = ch
+		    op = op + 1
+		}
+		call flush (g_out)
+	    }
+
+	    obuf[op] = EOS
+	    call fseti (g_in, F_RAW, NO)
+
+	    if (op > 1)
+		return (op - 1)
+	    else
+		return (EOF)
+	}
+end
+
+
+# STG_GETLINE -- Get a line of text from the graphics terminal, reading from
+# the status line if the workstation is activated, and doing a normal text
+# read otherwise.
+
+int procedure stg_getline (fd, obuf)
+
+int	fd			#I input file
+char	obuf[SZ_LINE]		#O output buffer
+
+int	stg_readtty()
+
+begin
+	return (stg_readtty (fd, obuf, SZ_LINE))
+end
+
+
+# STG_MSGLEN -- This routine is called to determine if there is any message
+# data buffered in the kernel, to be returned in the next call to stg_readtty.
+
+int procedure stg_msglen (fd)
+
+int	fd			#I input file
+include	"stdgraph.com"
+
+begin
+	return (g_msglen)
+end
diff --git a/sys/gio/stdgraph/stgscur.x b/sys/gio/stdgraph/stgscur.x
new file mode 100644
index 00000000..e40d4a3d
--- /dev/null
+++ b/sys/gio/stdgraph/stgscur.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_SETCURSOR -- Set the position of a cursor.
+
+procedure stg_setcursor (x, y, cursor)
+
+int	x, y			# new position of cursor
+int	cursor			# cursor to be set
+int	mx, my, cur
+include	"stdgraph.com"
+
+begin
+	# If cursor=0, write the cursor last referenced.
+	if (cursor > 0) {
+	    SG_CURSOR(g_sg) = cursor
+	    cur = cursor
+	} else
+	    cur = max (1, SG_CURSOR(g_sg))
+
+	# If the user has locked the logical cursor override runtime selection.
+	if (g_cursor > 0)
+	    cur = g_cursor
+
+	# Restore the software cursor position before reading?
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    SG_CURSOR_X(g_sg) = x
+	    SG_CURSOR_Y(g_sg) = y
+	}
+
+	mx = max(g_x1, min(g_x2, nint (x * g_dx) + g_x1))
+	my = max(g_y1, min(g_y2, nint (y * g_dy) + g_y1))
+
+	call stg_ctrl3 ("WC", mx, my, cur)
+end
diff --git a/sys/gio/stdgraph/stgtx.x b/sys/gio/stdgraph/stgtx.x
new file mode 100644
index 00000000..ff5abae2
--- /dev/null
+++ b/sys/gio/stdgraph/stgtx.x
@@ -0,0 +1,528 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<mach.h>
+include	<gki.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.  Two levels of character quality are implemented: MEDIUM and HIGH,
+# wherein characters are generated in software, and everything else, wherein
+# the characters are generated by the hardware.
+
+procedure stg_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+bool	hard
+real	x, y
+int	x1, x2, y1, y2, mx, my
+int	x0, y0, dx, dy, ch, cw, sz
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, orien, hwsz
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment(), stg_encode()
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	if (g_enable == NO)
+	    call stg_genab()
+
+	# Set pointer to the text attribute structure.
+	tx = SG_TXAP(g_sg)
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, dx,dy, polytext, orien)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  If software (!hard)
+	# character generation is indicated then size 1 is simply scaled by
+	# the indicated factor, otherwise the text size is  converted to a
+	# hardware size index by stg_txsize.
+
+	call stx_chars (tx, ch, cw, hwsz, hard, orien)
+	sz = TX_SIZE(tx)
+
+	if (hard)
+	    if (SG_TXSIZE(g_sg) != sz) {
+		call stg_ctrl1 ("TH", hwsz)
+		SG_TXSIZE(g_sg) = sz
+	    }
+
+	if (TX_COLOR(tx) != SG_COLOR(g_sg)) {
+	    call stg_ctrl1 ("TC", TX_COLOR(tx))
+	    SG_COLOR(g_sg) = TX_COLOR(tx)
+	}
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+	# All computations are in GKI coordinates.
+
+	x = x0
+	y = y0
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    if (hard)
+		if (SG_TXFONT(g_sg) != font) {
+		    call stg_ctrl1 ("TF", font - GT_ROMAN + 1)
+		    SG_TXFONT(g_sg) = font
+		}
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= 0 && x2 <= GKI_MAXNDC &&
+			y1 >= 0 && y2 <= GKI_MAXNDC) {
+
+			break
+
+		    } else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= 0 || x2 >= GKI_MAXNDC ||
+			y1 <= 0 || y2 >= GKI_MAXNDC) {
+
+			break
+
+		    } else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+		if (hard) {
+		    g_reg[1] = xstart * g_dx + g_x1
+		    g_reg[2] = ystart * g_dy + g_y1
+		    g_reg[E_IOP] = 1
+		    if (stg_encode (Memc[SG_STARTTEXT(g_sg)],g_mem,g_reg) == OK)
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		}
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		# Draw the characters.
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    if (hard)
+			call putc (g_out, Memc[ip])
+		    else {
+			mx = nint(x)
+			my = nint(y)
+			call stg_drawchar (Memc[ip], mx,my, cw, ch, orien, font)
+			x = x + dx
+			y = y + dy
+		    }
+
+		    ip = ip + 1
+		    seglen = seglen - 1
+		}
+
+		x = newx
+		y = newy
+		ip = op
+
+		if (hard) {
+		    g_reg[E_IOP] = 1
+		    if (stg_encode (Memc[SG_ENDTEXT(g_sg)], g_mem, g_reg) == OK)
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+bool	hard
+int	up, path, hwsz, ch, cw, i
+real	dir, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"stdgraph.com"
+
+begin
+	tx = SG_TXAP(g_sg)
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Get character sizes in GKI(NSPP) coords.
+	call stx_chars (tx, ch, cw, hwsz, hard, orien)
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# If hardware character generation is enabled the character up vector
+	# is constrained to 90 degrees.  Flip the direction in which characters
+	# will be drawn if necessary to draw from left to right or from top
+	# down, the readable directions.
+
+	if (hard) {
+	    # Constrain the up vector.
+	    orien = 0
+
+	    # Flip direction vector if in 2nd or 3rd quadrant.
+	    i = nint(dir)
+	    if (i < 0)
+		i = i + 360
+	    if (i >= 90 && i < 180)
+		i = i + 180
+	    if (i >= 360)
+		i = i - 360
+	    dir = real(i)
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if ((path == GT_UP || path == GT_DOWN) ||
+	    (hard && abs(cosv) < .9)) {
+	    p = ch * space
+	} else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
+
+
+# STX_CHARS -- Get the character drawing parameters, i.e., the size of a
+# character in X and Y and whether or not to use the hardware character
+# generator.  The decision whether or not to use the hardware character
+# generator is based on the text attribute QUALITY, unless overridden by
+# the g_hardchar switch in common (set explicitly in cursor mode or by a
+# stdgraph task parameter).
+
+procedure stx_chars (tx, ch, cw, hwsz, hard, orien)
+
+pointer	tx			# pointer to text attribute structure
+int	ch, cw			# character height, width, GKI coords
+int	hwsz			# size index if hardware character
+bool	hard			# use/dontuse hardware character generation
+int	orien			# rotation angle of character (0=normal)
+
+int	sz, quality
+real	txsize, aspect, q
+int	stg_txsize()
+real	ttygetr()
+include	"stdgraph.com"
+
+begin
+	sz = TX_SIZE(tx)
+	if (g_hardchar == 0)
+	    quality = TX_QUALITY(tx)
+	else
+	    quality = g_hardchar
+	hard = (quality != GT_MEDIUM && quality != GT_HIGH)
+
+	# Get character size in GKI units.
+	if (hard) {
+	    hwsz = stg_txsize (sz)
+	    ch = SG_CHARHEIGHT(g_sg,hwsz)
+	    cw = SG_CHARWIDTH (g_sg,hwsz)
+
+	} else {
+	    # If character generation is in software scale character sizes
+	    # by the size of the size 1 hardware character.  If the character
+	    # is rotated correct for the device aspect ratio so that the
+	    # character comes out the same size regardless of the orientation.
+
+	    txsize = GKI_UNPACKREAL(sz)
+	    cw = SG_CHARWIDTH (g_sg,1) * txsize
+	    ch = SG_CHARHEIGHT(g_sg,1) * txsize
+
+	    if (orien != 0) {
+		aspect = ttygetr (g_tty, "ar")
+		if (aspect > EPSILON && abs (aspect - 1.0) > .01) {
+		    q = 1.0 + abs(sin(real(orien))) * (aspect - 1.0)
+		    cw = cw / q
+		    ch = ch * q
+		}
+	    }
+	}
+end
diff --git a/sys/gio/stdgraph/stgtxqual.x b/sys/gio/stdgraph/stgtxqual.x
new file mode 100644
index 00000000..122cf303
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxqual.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_TXQUALITY -- Select the type of character generator to be used.  If the
+# selected flag value is 0 this decision will be deferred to the set text
+# attribute instruction at runtime (default).
+
+procedure stg_txquality (quality)
+
+int	quality			# text generation quality flag
+include	"stdgraph.com"
+
+begin
+	g_hardchar = quality
+end
diff --git a/sys/gio/stdgraph/stgtxset.x b/sys/gio/stdgraph/stgtxset.x
new file mode 100644
index 00000000..8db3e8c3
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxset.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_TXSET -- Set the text drawing attributes.
+
+procedure stg_txset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	tx
+include	"stdgraph.com"
+
+begin
+	tx = SG_TXAP(g_sg)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	# Unpack the packed-real character spacing parameter.
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+
+	# The character size is left as a packed real as we must defer the
+	# decision to use a discreet hardware character size or to draw
+	# characters in software.
+
+	TX_SIZE(tx)	= gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/stdgraph/stgtxsize.x b/sys/gio/stdgraph/stgtxsize.x
new file mode 100644
index 00000000..71829e04
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxsize.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_TXSIZE -- Given the relative character size as a packed real, select
+# the discreet closest device character size.
+
+int procedure stg_txsize (pksize)
+
+int	pksize			# packed real relative character size
+int	i, best_size
+real	txsize, diff, least_diff
+include	"stdgraph.com"
+
+begin
+	txsize = GKI_UNPACKREAL (pksize)
+
+	best_size = 1
+	least_diff = abs (txsize - SG_CHARSIZE(g_sg,1))
+
+	do i = 2, SG_NCHARSIZES(g_sg) {
+	    diff = abs (txsize - SG_CHARSIZE(g_sg,i))
+	    if (diff < least_diff) {
+		best_size = i
+		least_diff = diff
+	    }
+	}
+
+	return (best_size)
+end
diff --git a/sys/gio/stdgraph/stgunkown.x b/sys/gio/stdgraph/stgunkown.x
new file mode 100644
index 00000000..55327b62
--- /dev/null
+++ b/sys/gio/stdgraph/stgunkown.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STG_UNKNOWN -- The unknown instruction.  Called by the interpreter whenever
+# an unrecognized opcode is encountered.  Should never be called.
+
+procedure stg_unknown (gki)
+
+short	gki[ARB]		# the GKI instruction
+int	fd, verbose
+common	/stgcom/ fd, verbose
+
+begin
+	call fprintf (fd, "unknown\n")
+end
diff --git a/sys/gio/stdgraph/stgwtty.x b/sys/gio/stdgraph/stgwtty.x
new file mode 100644
index 00000000..c01bd93c
--- /dev/null
+++ b/sys/gio/stdgraph/stgwtty.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	"stdgraph.h"
+
+# STG_WRITETTY -- Write one or more lines of text to the terminal in text
+# mode.  If the workstation is currently activated normal output is to the
+# status line, otherwise output is to the indicated stream (STDOUT or
+# STDERR).  If the worstation is activated and the text to be output is
+# preceded by the EM code, the text is a message being sent by GIO to a user
+# interface parameter, and the text is passed on as is without formatting for
+# the status line.
+#
+# Terminal output is directed to the status line by the GD sequence, and
+# graphics output is reenabled by the GE sequence.  The output text should
+# consist of only a single line, but if multiple lines are present they are
+# output line by line, without the trailing newline, since the status line
+# can display only a single line of text.
+#
+# NOTE - If output occurs while in graphics mode and the output text is newline
+# terminated, the GE (graphics enable) sequence is output to restore the
+# terminal to graphics mode before exiting.  If the text is not newline
+# terminated, e.g., if it is a prompt, the workstation is left in alpha mode,
+# ready for a read from STDIN.  Thus one can write a prompt to STDOUT and read
+# the user response from STDIN, while in graphics mode.
+#
+# This procedure is called by pseudofile i/o (gio/cursor/prpsio) whenever a
+# task writes to STDOUT or STDERR.
+
+procedure stg_writetty (fd, text, nchars)
+
+int	fd			#I output stream
+char	text[ARB]		#I text to be output
+int	nchars			#I nchars to be written
+
+int	ip, delim
+pointer	sp, lbuf, op
+include	"stdgraph.com"
+bool	ttygetb()
+errchk	write
+
+begin
+	if (g_active == NO) {
+	    # Workstation not activated (normal text mode); normal text output.
+	    call write (fd, text, nchars)
+	    call flush (fd)
+
+	} else if (text[1] == EM || g_message == YES) {
+	    # Workstation is activated; the output text is a message to be
+	    # sent to a UI parameter.  The output stream is assumed to be
+	    # flushed before and after a UI message, so we assume that the
+	    # control codes used to bracket the message are the first and
+	    # last characters in the output write packets.  Multiple writes
+	    # may be used to write output text, and messages can be any
+	    # length.  If the output device does not support messaging (no
+	    # "EM" capability) the messages are discarded.
+
+	    g_message = YES
+	    if (ttygetb (g_tty, "EM"))
+		call write (g_out, text, nchars)
+	    delim = text[nchars]
+	    if (delim == GS || delim == US)
+		g_message = NO
+
+	} else {
+	    # Workstation is activated; write to status line.  Writing
+	    # anything when graphics is enabled causes the status line to be
+	    # cleared; newline causes a graphics enable; the string "\n\n"
+	    # will always clear the status line and leave the terminal in
+	    # graphics mode, regardless of the state of g_enable when issued.
+
+	    call smark (sp)
+	    call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	    if (g_enable == YES)
+		call stg_gdisab()
+
+	    op = lbuf
+	    for (ip=1;  ip <= nchars;  ip=ip+1) {
+		if (text[ip] == '\n') {
+		    if (g_enable == YES)
+			call stg_gdisab()
+		    if (op > lbuf)
+			call write (g_out, Memc[lbuf], op-lbuf)
+		    call stg_genab()
+		    op = lbuf
+		} else {
+		    Memc[op] = text[ip]
+		    op = min (lbuf+SZ_LINE, op+1)
+		}
+	    }
+
+	    # Output a partial line, leaving graphics disabled.
+	    if (op > lbuf) {
+		if (g_enable == YES)
+		    call stg_gdisab()
+		call write (g_out, Memc[lbuf], op-lbuf)
+	    }
+
+	    call flush (g_out)
+	    call sfree (sp)
+	}
+end
+
+
+# STG_PUTLINE -- Output an EOS delimited line of text to the graphics terminal
+# with stg_writetty.
+
+procedure stg_putline (fd, text)
+
+int	fd			# output file
+char	text[ARB]		# EOS delimited line of text
+int	strlen()
+
+begin
+	call stg_writetty (fd, text, strlen(text))
+end
diff --git a/sys/gio/stdgraph/t_gkideco.x b/sys/gio/stdgraph/t_gkideco.x
new file mode 100644
index 00000000..200cf33a
--- /dev/null
+++ b/sys/gio/stdgraph/t_gkideco.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# GKIDECODE -- Decode the contents of one or more metacode files, printing
+# the decoded metacode instructions in readable form on the standard output.
+
+procedure t_gkidecode()
+
+int	fd, list, verbose, gkiunits
+pointer	gki, sp, fname
+int	dd[LEN_GKIDD]
+
+bool	clgetb()
+int	clpopni(), clgfil(), clplen(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	if (clgetb ("generic")) {
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Set up the decoding graphics kernel.
+	call gkp_install (dd, STDOUT, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Print header if new file.
+	    if (clplen (list) > 1) {
+		call printf ("\n# METAFILE '%s':\n")
+		    call pargstr (Memc[fname])
+	    }
+
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    } else
+		call gkp_grstream (fd)
+
+	    # Process the metacode.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF)
+		call gki_execute (Mems[gki], dd)
+
+	    call close (fd)
+	}
+
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/t_showcap.x b/sys/gio/stdgraph/t_showcap.x
new file mode 100644
index 00000000..ddb8407c
--- /dev/null
+++ b/sys/gio/stdgraph/t_showcap.x
@@ -0,0 +1,210 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stdgraph.h"
+
+define	SZ_PROGRAM		256
+define	MAXARGSTR		15
+
+
+# SHOWCAP - Show the ascii control string sent to a device to implement a
+# control function.  Useful for testing graphcap entries.
+
+procedure t_showcap()
+
+char	cap[2]
+int	g_reg[NREGISTERS]
+char	g_mem[SZ_MEMORY]
+char	argstr[MAXARGSTR]
+int	arg1, arg2, arg3, op, len_prog, status, nchars
+pointer	tty, sp, prog, ip, cmd
+pointer	ttygdes(), ttycaps()
+int	stg_encode(), ctoi(), getline(), strncmp()
+int	ttygets(), ctowrd(), strlen()
+bool	ttygetb(), streq()
+define	getargs_ 91
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (prog, SZ_PROGRAM, TY_CHAR)
+
+	# Print instructions.
+	call printf ("cmd :  `set' device\n")
+	call printf ("    |  `*' (to dump full graphcap entry\n")
+	call printf ("    |  cc [arg1 [arg2 [arg3]]]\n")
+	call printf ("    ;\n")
+	call printf ("\n")
+	call printf ("cc  :   a two chararacter capcode (e.g., 'cm')\n")
+	call printf ("    |   an encoder program (non alpha first char)\n")
+	call printf ("    ;\n")
+	call printf ("\n")
+
+	# Interpret and translate control commands until EOF or "bye"
+	# is typed.
+
+	tty = NULL
+
+	repeat {
+	    # Prompt for input.
+	    call printf ("* ")
+	    call flush (STDOUT)
+
+	    if (getline (STDIN, Memc[cmd]) == EOF) {
+		call printf ("\n")
+		break
+	    }
+
+	    for (ip=cmd;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+
+	    if (Memc[ip] == '\n') {
+		next
+	    } else if (strncmp (Memc[ip], "set", 3) == 0) {
+		ip = ip + 3
+		len_prog = ctowrd (Memc, ip, Memc[prog], SZ_PROGRAM)
+		if (tty != NULL)
+		    call ttycdes (tty)
+		tty = ttygdes (Memc[prog])
+		call sgc_dump (STDOUT, Memc[ttycaps(tty)],
+		    strlen (Memc[ttycaps(tty)]))
+		next
+	    } else if (Memc[ip] == '*') {
+		call sgc_dump (STDOUT, Memc[ttycaps(tty)],
+		    strlen (Memc[ttycaps(tty)]))
+		next
+	    } else if (!IS_ALPHA (Memc[ip])) {
+		len_prog = ctowrd (Memc, ip, Memc[prog], SZ_PROGRAM)
+		cap[1] = EOS
+		goto getargs_
+	    } else if (strncmp (Memc[ip], "bye", 3) == 0)
+		break
+
+	    # Parse command with optional arguments, e.g., "RC 1".
+	    # Extract 2 character capability name (required).
+
+	    op = 1
+	    while (IS_ALNUM(Memc[ip])) {
+		cap[op] = Memc[ip]
+		ip = ip + 1
+		op = min (2, op + 1)
+	    }
+	    cap[3] = EOS
+getargs_
+	    # Argument type depends on whether encoding or decoding.
+	    if (streq ("SC", cap)) {
+		nchars = ctowrd (Memc, ip, argstr, MAXARGSTR)
+		if (nchars == 0) {
+		    call printf ("SC must have 1 contiguous string argument\n")
+		    next
+		}
+
+	    } else {
+		# Extract up to three arguments (optional).
+		if (ctoi (Memc, ip, arg1) <= 0)
+		    arg1 = 0
+		if (ctoi (Memc, ip, arg2) <= 0)
+		    arg2 = 0
+		if (ctoi (Memc, ip, arg3) <= 0)
+		    arg3 = 0
+	    }
+
+	    # Fetch the program from the graphcap file.  Zero is returned if
+	    # the device does not have the named capability, in which case
+	    # the function is inapplicable and should be ignored.
+
+	    if (cap[1] != EOS)
+		if (tty == NULL) {
+		    call printf ("use `set' to specify device name\n")
+		    next
+		} else
+		    len_prog = ttygets (tty, cap, Memc[prog], SZ_PROGRAM)
+
+	    if (len_prog > 0) {
+		if (Memc[prog] == '#')
+		    call sgc_dump (STDOUT, Memc[prog+1], len_prog - 1)
+		else {
+		    # Dump the program on the standard output.
+		    if (cap[1] != EOS) {
+			call printf ("program:  ")
+			call sgc_dump (STDOUT, Memc[prog], len_prog)
+		    }
+
+		    # Set memory or registers depending on whether encoding or
+		    # decoding.
+		    if (streq ("SC", cap))
+			call strcpy (argstr, g_mem, nchars)
+
+		    else {
+			g_reg[1] = arg1
+			g_reg[2] = arg2
+			g_reg[3] = arg3
+		    }
+		    g_reg[E_IOP] = 1
+		    g_reg[E_TOP] = SZ_MEMORY
+
+		    # If scan_cursor, decode the input string and write the
+		    # registers to the output file.  Else, encode the output
+		    # string and write the encoded string to the output file.
+
+		    status = stg_encode (Memc[prog], g_mem, g_reg) 
+		    if (status == OK) {
+			nchars = g_reg[E_IOP] - 1
+
+			if (streq ("SC", cap)) {
+			    call printf ("X(R1)=%d, Y(R2)=%d, key=%c\n")
+				call pargi (g_reg[1])
+				call pargi (g_reg[2])
+				call pargi (g_reg[3])
+			} else {
+			    call printf ("encoding: ")
+			    call sgc_dump (STDOUT, g_mem, nchars)
+			}
+
+		    } else
+			call printf ("error encoding control string\n")
+			call printf ("      status = %d\n")
+			    call pargi (status)
+		}
+
+	    } else if (len_prog == 0)
+		if (ttygetb (tty, cap))
+		    call printf ("boolean capability is true\n")
+
+	    else {
+		call printf ("device capability `%s' not found\n")
+		    call pargstr (cap)
+	    }
+	}
+
+	if (tty != NULL)
+	    call ttycdes (tty)
+	call sfree (sp)
+end
+
+
+# SGC_DUMP -- Dump a sequence of ascii characters in printable form.
+
+procedure sgc_dump (fd, data, nchars)
+
+int	fd			# output file
+char	data[ARB]		# chars to be dumped
+int	nchars
+
+int	ip
+int	col
+
+begin
+	col = 1
+	for (ip=1;  ip <= nchars;  ip=ip+1) {
+	    call putcc (fd, data[ip])
+	    if (data[ip] == ':' && col > 60) {
+		call putci (fd, '\\')
+		call putci (fd, '\n')
+		col = 1
+	    } else
+		col = col + 1
+	}
+
+	call putci (fd, '\n')
+end
diff --git a/sys/gio/stdgraph/t_stdgraph.x b/sys/gio/stdgraph/t_stdgraph.x
new file mode 100644
index 00000000..8d6856fc
--- /dev/null
+++ b/sys/gio/stdgraph/t_stdgraph.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gki.h>
+
+define	SZ_TXQUALITY	1
+
+# STDGRAPH -- Graphics kernel for the standard graphics output (interactive
+# graphics terminal).
+
+procedure t_stdgraph()
+
+int	fd, list
+char	txquality[SZ_TXQUALITY]
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits, xres, yres, quality
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi(), clgeti()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	    quality = 0
+	    xres = 0
+	    yres = 0
+
+	} else {
+	    debug = btoi (clgetb ("debug"))
+	    if (debug == YES) {
+		verbose = btoi (clgetb ("verbose"))
+		gkiunits = btoi (clgetb ("gkiunits"))
+	    }
+
+	    # Get the quality parameter for the text generator.
+	    call clgstr ("txquality", txquality, SZ_TXQUALITY)
+	    switch (txquality[1]) {
+	    case 'l':
+		quality = GT_LOW
+	    case 'm':
+		quality = GT_MEDIUM
+	    case 'h':
+		quality = GT_HIGH
+	    default:
+		quality = 0
+	    }
+
+	    xres     = clgeti ("xres")
+	    yres     = clgeti ("yres")
+	}
+
+	# Open the graphics kernel.
+
+	call stg_open (Memc[devname], dev, STDIN, STDOUT, xres, yres, quality)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    } else
+		call stg_grstream (fd)
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF)
+		switch (Mems[gki+GKI_HDR_OPCODE-1]) {
+		case GKI_CLOSEWS, GKI_DEACTIVATEWS, GKI_REACTIVATEWS:
+		    # These instructions are passed directly to the kernel via
+		    # the PSIOCTRL stream at runtime, but are ignored in
+		    # metacode to avoid unnecessary mode switching of the
+		    # terminal.
+		    ;
+		default:
+		    if (debug == YES)
+			call gki_execute (Mems[gki], deb)
+		    call gki_execute (Mems[gki], dev)
+		}
+
+	    call close (fd)
+	}
+
+	# Make sure we finish with CLOSEWS so that the terminal is left in
+	# text mode.
+
+	call stg_closews (NULL, NULL)
+
+	# Finish up.
+	call gkp_close()
+	call stg_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/x_stdgraph.x b/sys/gio/stdgraph/x_stdgraph.x
new file mode 100644
index 00000000..37c5a055
--- /dev/null
+++ b/sys/gio/stdgraph/x_stdgraph.x
@@ -0,0 +1,5 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	gkidecode = t_gkidecode,
+	stdgraph  = t_stdgraph,
+	showcap   = t_showcap
diff --git a/sys/gio/stdgraph/zzdebug.x b/sys/gio/stdgraph/zzdebug.x
new file mode 100644
index 00000000..ce11d4ea
--- /dev/null
+++ b/sys/gio/stdgraph/zzdebug.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	slio = t_slio
+
+procedure t_slio()
+
+pointer	gp
+char	lbuf[SZ_LINE]
+real	x[5], y[5]
+
+pointer	gopen()
+int	getline()
+
+begin
+	x[1] = .25;  y[1] = .25
+	x[2] = .75;  y[2] = .25
+	x[3] = .75;  y[3] = .75
+	x[4] = .25;  y[4] = .75
+	x[5] = .25;  y[5] = .25
+
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	call gpline (gp, x, y, 5)
+	call gflush (gp)
+
+	call putline (STDOUT, "enter text: ")
+	call flush (STDOUT)
+
+	if (getline (STDIN, lbuf) != EOF) {
+	    call zwmsec (3000)
+	    call printf ("text = %s")
+		call pargstr (lbuf)
+	    call flush (STDOUT)
+	}
+
+	call zwmsec (3000)
+	call gclose (gp)
+end
diff --git a/sys/gio/wcstogki.x b/sys/gio/wcstogki.x
new file mode 100644
index 00000000..e0591402
--- /dev/null
+++ b/sys/gio/wcstogki.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_WCSTOGKI -- Transform world coordinates to GKI coordinates using the
+# cached transformation parameters.  There are three possible types of scaling
+# on either axis, linear, log, and "elog".  The latter is a piecewise log
+# scaling function defined for all X, i.e., for negative as well as positive
+# X (see elogr.x).  If a negative number is transformed with normal log
+# scaling it is treated as an indefinite, i.e., plotted as a gap in the plot.
+
+procedure gpl_wcstogki (gp, wx, wy, mx, my)
+
+pointer	gp			# graphics device descriptor
+real	wx, wy			# world coordinates of point
+real	mx, my			# metacode coordinates of point
+
+real	x, y
+real	elogr()
+include	"gpl.com"
+
+begin
+	# Update cached transformation parameters if device changes, cache
+	# has been invalidated, or the current WCS has been changed.
+
+	if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+	    
+	# Transform the coordinates.
+
+	if (xtran == LINEAR) {
+	    x = wx
+	} else if (xtran == LOG) {
+	    if (wx <= 0) {
+		call gpl_flush()
+		return
+	    } else
+		x = log10 (wx)
+	} else
+	    x = elogr (wx)
+
+	if (ytran == LINEAR) {
+	    y = wy
+	} else if (ytran == LOG) {
+	    if (wy <= 0) {
+		call gpl_flush()
+		return
+	    } else
+		y = log10 (wy)
+	} else
+	    y = elogr (wy)
+
+	# Return real rather than int GKI coordinates to avoid digitization
+	# errors in a sequence of draws relative to the current pen position.
+
+	mx = max (0.0, min (real(GKI_MAXNDC),
+	    ((x - wxorigin) * xscale) + mxorigin))
+	my = max (0.0, min (real(GKI_MAXNDC),
+	    ((y - wyorigin) * yscale) + myorigin))
+end
diff --git a/sys/gio/zzdebug.x b/sys/gio/zzdebug.x
new file mode 100644
index 00000000..e806ee23
--- /dev/null
+++ b/sys/gio/zzdebug.x
@@ -0,0 +1,392 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+
+define	MAXPTS		20
+
+task	plot1, plot2, plot3, plot4, plot5, plot6, plot7, plot8,
+	balls, ticks, vdm
+
+
+procedure plot1()
+
+real	v[5]
+int	i
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 5
+	    v[i] = i ** 2
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gswind (gp, 1., 5., INDEF, INDEF)
+	call gascale (gp, v, 5, 2)
+	call glabax (gp, "Y = X ** 2", "X-AXIS", "Y-AXIS")
+	call gvline (gp, v, 5, 1., 5.)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot2()
+
+int	i
+real	x[512], y[512]
+real	xc, yc, xs, ys
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 16.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	xc = 8
+	yc = .25
+	xs = 3.2
+	ys = 0.1
+
+	do i = 1, 10 {
+	    call gmark (gp, xc, yc, GM_CIRCLE, -xs, -ys)
+	    xc = xc + xs / 5
+	    yc = yc + ys / 5
+	    xs = xs * 1.25
+	    ys = ys * 1.5
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot3()
+
+int	i
+real	x[512], y[512]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 8.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot4()
+
+int	i
+real	x[512], y[512]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = (i - 256.0) / 4.
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 2.0 * 1E4
+	    else
+		y[i] = (sin (x[i]) / x[i] + 1.0) * 1E4
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_YTRAN, GW_LOG)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "Log of The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot5()
+
+int	fd
+int	open(), clgeti()
+real	x1, x2, clgetr()
+pointer	gp, gopen()
+
+begin
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	x1 = clgetr ("x1")
+	x2 = clgetr ("x2")
+
+	call gseti (gp, G_NMINOR, clgeti ("nminor"))
+	call gseti (gp, G_XTRAN, GW_LOG)
+	call gseti (gp, G_YTRAN, GW_LOG)
+	call gsetr (gp, G_MINORWIDTH, 1.0)
+	call gswind (gp, x1, x2, 0.001, 1000.0)
+	call glabax (gp, "Log Scaling", "X-AXIS", "Y-AXIS")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot6()
+
+int	i
+long	seed
+real	size, urand()
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+data	seed /3/
+
+begin
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_ASPECT, clgeti("aspect"))
+	call glabax (gp, "", "", "")
+
+	do i = 1, 300 {
+	    size = real (nint (urand(seed) * 4 + .5))
+	    call gmark (gp, urand(seed), urand(seed), GM_BOX, size, size)
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot7()
+
+int	i
+real	x[8192], y[8192]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 8192 {
+	    x[i] = ((i - 4096.0) / 128.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	    y[i] = y[i] + cos ((i-1) * 0.392699) * .001
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 8192, 1)
+	call gascale (gp, y, 8192, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 8192)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure balls()
+
+int	i, j, m, npts, nsteps
+long	seed
+real	p[MAXPTS,2], d[MAXPTS,2]
+real	urand()
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+
+begin
+	npts = max(1, min(MAXPTS, clgeti ("npoints")))
+	nsteps = max (10, clgeti ("nsteps"))
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	# call glabax (gp, "Bouncing Balls", "", "")
+
+	# Set the initial conditions.
+	do i = 1, npts
+	    do j = 1, 2 {
+		p[i,j] = urand (seed)
+		d[i,j] = max (0.01, urand (seed) * .1)
+		if (mod (i, 2) == 0)
+		    d[i,j] = -d[i,j]
+	    }
+
+	# Draw the trajectories.
+	do m = 1, nsteps
+	    do i = 1, npts {
+		call gseti (gp, G_PMLTYPE, GL_CLEAR)
+		call gmark (gp, p[i,1], p[i,2], GM_DIAMOND, 4., 4.)
+
+		do j = 1, 2 {
+		    p[i,j] = p[i,j] + d[i,j]
+		    if (p[i,j] < 0) {
+			p[i,j] = -p[i,j]
+			d[i,j] = -d[i,j]
+		    } else if (p[i,j] > 1) {
+			p[i,j] = 1 - (p[i,j] - 1)
+			d[i,j] = -d[i,j]
+		    }
+		}
+	    
+		call gseti (gp, G_PMLTYPE, GL_SOLID)
+		call gmark (gp, p[i,1], p[i,2], GM_DIAMOND, 4., 4.)
+
+		call gflush (gp)
+	    }
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure ticks()
+
+real	x1, x2, p1, p2
+int	rough_nticks
+int	logflag
+real	tick1, step, linearity
+
+bool	clgetb()
+int	btoi(), clgeti()
+real	gt_linearity(), clgetr(), elogr()
+
+begin
+	x1 = clgetr ("x1")
+	x2 = clgetr ("x2")
+	rough_nticks = clgeti ("nticks")
+	logflag = btoi (clgetb ("log"))
+
+	if (logflag == YES) {
+	    p1 = elogr (x1)
+	    p2 = elogr (x2)
+	} else {
+	    p1 = x1
+	    p2 = x2
+	}
+
+	linearity = gt_linearity (x1, x2)
+	call gtickr (p1, p2, rough_nticks, logflag, tick1, step)
+
+	call printf ("tick1=%g, step=%g, linearity=%g\n")
+	    call pargr (tick1)
+	    call pargr (step)
+	    call pargr (linearity)
+end
+
+
+procedure plot8()
+
+int	i
+real	x[512], y[512]
+int	fd
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 8.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWAXES, 1)
+	call gseti (gp, G_SETAXISPOS, YES)
+	call gsetr (gp, G_AXISPOS1, 0.0)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "", "", "")
+	call gpline (gp, x, y, 512)
+	call gtext (gp, -20., 0.80, "The Sinc Function", "hj=c,vj=b")
+	call gtext (gp, -20., 0.75, "y = sin(x) / x", "hj=c,vj=b")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# VDM -- Test output of a plot to the virtual device metafile.
+
+procedure vdm()
+
+real	v[5]
+int	i
+pointer	gp, gopen()
+
+begin
+	do i = 1, 5
+	    v[i] = i ** 2
+
+	gp = gopen ("vdm", NEW_FILE, STDGRAPH)
+
+	call gswind (gp, 1., 5., INDEF, INDEF)
+	call gascale (gp, v, 5, 2)
+	call glabax (gp, "Y = X ** 2", "X-AXIS", "Y-AXIS")
+	call gvline (gp, v, 5, 1., 5.)
+
+	call gclose (gp)
+end
diff --git a/sys/gty/README b/sys/gty/README
new file mode 100644
index 00000000..6687b5ce
--- /dev/null
+++ b/sys/gty/README
@@ -0,0 +1,8 @@
+# GTY -- This directory contains the generalized termcap style database
+# reader.  Adapted from iraf$sys/tty/.
+
+		  gty = gtyopen (termcap_file, device, ufields)
+		       gtyclose (gty)
+		   cp = gtycaps (gty)
+	     pval = gtyget[bir] (gty, cap)
+	       nchars = gtygets (gty, cap, outstr, maxch)
diff --git a/sys/gty/gty.h b/sys/gty/gty.h
new file mode 100644
index 00000000..72516859
--- /dev/null
+++ b/sys/gty/gty.h
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTY package definitions.
+
+define	MAX_TC_NESTING	8		# max nesting of tc=term references
+
+# Mapping function used to map capcodes ("cm", etc.) into unique integers.
+define	ENCODE		($1[1]*128+$1[2])
+
+# TTY descriptor structure.  Full termcap entry is the 'caplist' string.
+# The caplist is indexed at open time to permit a binary search for
+# capabilities at run time.
+
+define	T_MEMINCR	512		# increment if overflow occurs
+define	T_OFFCAP	415		# struct offset to caplist field
+define	MAX_CAPS	200		# maximum capabilities
+define	LEN_DEFTTY	1024		# initial length of tty structure
+
+define	T_LEN		Memi[$1]	# length of tty structure
+define	T_OP		Memi[$1+1]	# offset into caplist
+define	T_NCAPS		Memi[$1+11]	# number of capabilities
+define	T_CAPLEN	Memi[$1+12]	# length of caplist, chars
+			# (extra space)
+define	T_CAPCODE	Memi[$1+15]	# cap code array: c1*128+c2
+define	T_CAPINDEX	Memi[$1+215]	# cap index array
+define	T_CAPLIST	Memc[P2C($1+415)]	# termcap entry
diff --git a/sys/gty/gtycaps.x b/sys/gty/gtycaps.x
new file mode 100644
index 00000000..ad9b4828
--- /dev/null
+++ b/sys/gty/gtycaps.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "gty.h"
+
+# GTYCAPS -- Return a pointer to the caplist field of an open GTY descriptor.
+
+pointer procedure gtycaps (gty)
+
+pointer gty                     # tty descriptor
+
+begin
+        return (P2C (gty + T_OFFCAP))
+end
diff --git a/sys/gty/gtyclose.x b/sys/gty/gtyclose.x
new file mode 100644
index 00000000..c8ddd67d
--- /dev/null
+++ b/sys/gty/gtyclose.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYCLOSE -- Close the tty terminal descriptor opened with TTYOPEN.
+
+procedure gtyclose (tty)
+
+pointer	tty
+
+begin
+	call mfree (tty, TY_STRUCT)
+end
diff --git a/sys/gty/gtygetb.x b/sys/gty/gtygetb.x
new file mode 100644
index 00000000..53d5f31e
--- /dev/null
+++ b/sys/gty/gtygetb.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYGETB -- Determine whether or not a capability exists for a device.
+# If there is any entry at all, the capability exists.
+
+bool procedure gtygetb (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+pointer	ip
+int	gty_find_capability()
+
+begin
+	return (gty_find_capability (tty, cap, ip) == YES)
+end
diff --git a/sys/gty/gtygeti.x b/sys/gty/gtygeti.x
new file mode 100644
index 00000000..9b196a7e
--- /dev/null
+++ b/sys/gty/gtygeti.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYGETI -- Get an integer valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as an integer, zero is
+# returned.  Integer capabilities have the format ":xx#dd:".
+
+int procedure gtygeti (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+int	ival
+pointer	ip
+int	gty_find_capability(), ctoi()
+
+begin
+	if (gty_find_capability (tty, cap, ip) == NO)
+	    return (0)
+	else if (Memc[ip] != '#')
+	    return (0)
+	else {
+	    ip = ip + 1				# skip the '#'
+	    if (ctoi (Memc, ip, ival) == 0)
+		return (0)
+	    else
+		return (ival)
+	}
+end
diff --git a/sys/gty/gtygetr.x b/sys/gty/gtygetr.x
new file mode 100644
index 00000000..fb50f3e0
--- /dev/null
+++ b/sys/gty/gtygetr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTYGETR -- Get a real valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as a number, zero is
+# returned.  Real valued capabilities have the format ":xx#num:".
+
+real procedure gtygetr (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+
+char	numstr[MAX_DIGITS]
+int	np, op
+pointer	ip
+double	dval
+int	gty_find_capability(), ctod()
+
+begin
+	if (gty_find_capability (tty, cap, ip) == NO)
+	    return (0.0)
+	else if (Memc[ip] != '#')
+	    return (0.0)
+	else {
+	    # Extract the number into numstr.  Cannot convert in place in
+	    # the table because the ":" delimiter will by interpreted by
+	    # ctod as for a sexagesimal number.
+	    op = 1
+	    for (ip=ip+1;  op <= MAX_DIGITS && Memc[ip] != ':';  ip=ip+1) {
+		numstr[op] = Memc[ip]
+		op = op + 1
+	    }
+	    numstr[op] = EOS
+	    np = 1
+	    if (ctod (numstr, np, dval) == 0)
+		return (0.0)
+	    else
+		return (dval)
+	}
+end
diff --git a/sys/gty/gtygets.x b/sys/gty/gtygets.x
new file mode 100644
index 00000000..1f66cf88
--- /dev/null
+++ b/sys/gty/gtygets.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+
+# GTYGETS -- Get the string value of a capability.  Process all termcap escapes.
+# These are:
+# 
+# 	\E		ascii esc (escape)
+# 	^X		control-X (i.e., ^C=03B, ^Z=032B, etc.)
+# 	\[nrtbf]	newline, return, tab, backspace, formfeed
+# 	\ddd		octal value of character
+# 	\^		the character ^
+# 	\\		the character \
+# 
+# The character ':' may not be placed directly in a capability string; it
+# should be given as \072 instead.  The null character is represented as \200;
+# all characters are masked to 7 bits upon output by TTYPUTS, hence \200
+# is sent to the terminal as NUL.
+
+int procedure gtygets (tty, cap, outstr, maxch)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+char	outstr[ARB]		# receives cap string
+int	maxch			# size of outstr
+
+char	ch
+pointer	ip
+int	op, junk, temp
+int	gty_find_capability(), cctoc()
+
+begin
+	op = 1
+
+	if (gty_find_capability (tty, cap, ip) == YES) {
+	    # Skip the '=' which follows the two character capability name.
+	    if (Memc[ip] == '=')
+		ip = ip + 1
+
+	    # Extract the string, processing all escapes.
+	    for (ch=Memc[ip];  ch != ':';  ch=Memc[ip]) {
+		if (ch == '^') {
+		    ip = ip + 1
+		    temp = Memc[ip]
+		    ch = mod (temp, 40B)
+		} else if (ch == '\\') {
+		    switch (Memc[ip+1]) {
+		    case 'E':
+			ip = ip + 1
+			ch = ESC
+		    case '^', ':', '\\':
+			ip = ip + 1
+			ch = Memc[ip]
+		    default:
+			junk = cctoc (Memc, ip, ch)
+			ip = ip - 1
+		    }
+		}
+
+		outstr[op] = ch
+		op = op + 1
+		ip = ip + 1
+		if (op >= maxch)
+		    break
+	    }
+	}
+
+	outstr[op] = EOS
+	return (op-1)
+end
diff --git a/sys/gty/gtyindex.x b/sys/gty/gtyindex.x
new file mode 100644
index 00000000..b91456ca
--- /dev/null
+++ b/sys/gty/gtyindex.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<chars.h>
+include	"gty.h"
+
+# GTY_INDEX_CAPS -- Prepare an index into the caplist string, stored in
+# the tty descriptor.  Each two character capability name maps into a unique
+# integer code, called the capcode.  We prepare a list of capcodes, keeping
+# only the first such code encountered in the case of multiple entries.
+# The offset of the capability in the caplist string is associated with each
+# capcode.  When these lists have been prepared, they are sorted to permit
+# a binary search for capabilities at runtime.
+
+procedure gty_index_caps (tty, t_capcode, t_capindex, ncaps)
+
+pointer	tty
+int	t_capcode[ARB], t_capindex[ARB]
+int	ncaps
+
+pointer	ip, caplist
+int	i, swap, capcode, temp
+int	gty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	ip = caplist
+
+	# Scan the caplist and prepare the capcode and capindex lists.
+	for (ncaps=0;  ncaps <= MAX_CAPS;  ) {
+	    # Advance to the next capability field.  Normal exit occurs
+	    # when ':' is followed immediately by EOS.
+
+	    while (Memc[ip] != ':' && Memc[ip] != EOS)
+		ip = ip + 1
+	    if (Memc[ip+1] == EOS || Memc[ip] == EOS)
+		break
+
+	    ip = ip + 1					# skip the ':'
+	    capcode = gty_encode_capability (Memc[ip])
+
+	    # Is the capcode already in the list?  If not found, add it to
+	    # the list.
+	    for (i=1;  i <= ncaps && t_capcode[i] != capcode;  i=i+1)
+		;
+	    if (i > ncaps) {				# not found
+		ncaps = ncaps + 1
+		t_capcode[ncaps] = capcode
+		t_capindex[ncaps] = ip - caplist + 1
+	    }
+	}
+
+	if (ncaps > MAX_CAPS)
+	    call syserr (SYS_TTYOVFL)
+
+	# A simple interchange sort is sufficient here, even though it would
+	# not be hard to interface to qsort.  The longest termcap entries are
+	# about 50 caps, and the time req'd to sort such a short list is
+	# negligible compared to the time spent searching the termcap file.
+
+	if (ncaps > 1)
+	    repeat {
+		swap = 0
+		do i = 1, ncaps-1
+		    if (t_capcode[i] > t_capcode[i+1]) {
+			temp = t_capcode[i]
+			t_capcode[i] = t_capcode[i+1]
+			t_capcode[i+1] = temp
+			temp = t_capindex[i]
+			t_capindex[i] = t_capindex[i+1]
+			t_capindex[i+1] = temp
+			swap = 1
+		    }
+	    } until (swap == 0)
+end
+
+
+# GTY_FIND_CAPABILITY -- Search the caplist for the named capability.
+# If found, return the char pointer IP to the first char of the value field,
+# and YES as the function value.  If the first char in the capability string
+# is '@', the capability "is not present".
+
+int procedure gty_find_capability (tty, cap, ip)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character name of capability
+pointer	ip			# pointer to capability string
+
+int	capcode, capnum
+int	gty_binsearch(), gty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	if (tty == NULL)
+	    call syserr (SYS_TTYINVDES)
+
+	capcode = gty_encode_capability (cap)
+	capnum = gty_binsearch (capcode, T_CAPCODE(tty), T_NCAPS(tty))
+
+	if (capnum > 0) {
+	    # Add 2 to skip the two capname chars.
+	    ip = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR) +
+		T_CAPINDEX(tty+capnum-1) - 1 + 2
+	    if (Memc[ip] != '@')
+		return (YES)
+	}
+
+	return (NO)
+end
+
+
+# GTY_BINSEARCH -- Perform a binary search of the capcode array for the
+# indicated capability.  Return the array index of the capability if found,
+# else zero.
+
+int procedure gty_binsearch (capcode, t_capcode, ncaps)
+
+int	capcode
+int	t_capcode[ARB], ncaps
+int	low, high, pos, ntrips
+define	err_ 91
+
+begin
+	pos = 0
+	low = 1
+	high = ncaps
+	if (high < low)
+	    goto err_
+
+	# Cut range of search in half until code is found, or until range
+	# vanishes (high - low <= 1).  If neither high or low is the one,
+	# code is not found in the list.
+
+	do ntrips = 1, ncaps {
+	    pos = (high - low) / 2 + low
+	    if (t_capcode[low] == capcode)
+		return (low)
+	    else if (t_capcode[high] == capcode)
+		return (high)
+	    else if (pos == low)			# (high-low)/2 == 0
+		return (0)				# not found
+	    else if (t_capcode[pos] < capcode)
+		low = pos
+	    else
+		high = pos
+	}
+
+	# Search cannot fail to converge unless there is a bug in the software
+	# somewhere.
+err_
+	call syserr (SYS_TTYBINSRCH)
+end
+
+
+# GTY_ENCODE_CAPABILITY -- Encode the two character capability string
+# as a unique integer value.
+
+int procedure gty_encode_capability (cap)
+
+char	cap[ARB]
+
+begin
+	return (ENCODE(cap))
+end
diff --git a/sys/gty/gtyopen.x b/sys/gty/gtyopen.x
new file mode 100644
index 00000000..d566f2d1
--- /dev/null
+++ b/sys/gty/gtyopen.x
@@ -0,0 +1,305 @@
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<chars.h>
+include	"gty.h"
+
+# GTYOPEN -- Scan the named TERMCAP style file for the entry for the named
+# device, and if found allocate a TTY descriptor structure, leaving the
+# termcap entry for the device in the descriptor.  If any UFIELDS are given
+# these will be prepended to the output device capability list, overriding
+# the device file entries.  If no termcap file is named (null string) then
+# UFIELDS is taken as the device entry and opened on a GTY descriptor.
+
+pointer procedure gtyopen (termcap_file, device, ufields)
+
+char	termcap_file[ARB]	#I termcap file to be scanned
+char	device[ARB]		#I name of device to be extracted
+char	ufields[ARB]		#I user specified capabilities
+
+int	nchars, ip
+pointer	caplist, tty, op
+errchk	calloc, realloc, gty_index_caps
+pointer	coerce()
+int	strlen()
+
+begin
+	# Allocate and initialize the tty descriptor structure.
+	call calloc (tty, LEN_DEFTTY, TY_STRUCT)
+
+	T_LEN(tty) = LEN_DEFTTY
+	T_OP(tty) = 1
+
+	# Place any user specified capabilities in the caplist.  These will
+	# override any values given in the file entry.
+
+	for (ip=1;  ufields[ip] != EOS && ufields[ip] != ':';  ip=ip+1)
+	    ;
+	nchars = strlen (ufields[ip])
+	if (nchars > 0) {
+	    caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	    call strcpy (ufields[ip], Memc[caplist], T_LEN(tty) - T_OFFCAP)
+	    op = caplist + nchars
+	    if (Memc[op-1] == ':')
+		op = op - 1
+	    Memc[op] = EOS
+	    T_OP(tty) = op - caplist + 1
+	    T_CAPLEN(tty) = T_OP(tty)
+	}
+
+	# Scan the source file, if given.
+	if (termcap_file[1] != EOS)
+	    iferr (call gty_scan_termcap_file (tty, termcap_file, device)) {
+		call mfree (tty, TY_STRUCT)
+		call erract (EA_ERROR)
+	    }
+
+	# Call realloc to return any unused space in the descriptor.
+	T_LEN(tty) = T_OFFCAP + (T_OP(tty) + SZ_STRUCT-1) / SZ_STRUCT
+	call realloc (tty, T_LEN(tty), TY_STRUCT)
+
+	# Prepare index of fields in the descriptor, so that we can more
+	# efficiently search for fields later.
+
+	call gty_index_caps (tty, T_CAPCODE(tty), T_CAPINDEX(tty),
+	    T_NCAPS(tty))
+
+	return (tty)
+end
+
+
+# TTY_SCAN_TERMCAP_FILE -- Open and scan the named TERMCAP format database
+# file for the named device.  Fetch termcap entry, expanding any and all
+# "tc" references by repeatedly rescanning file.
+
+procedure gty_scan_termcap_file (tty, termcap_file, devname)
+
+pointer	tty			# tty descriptor structure
+char	termcap_file[ARB]	# termcap format file to be scanned
+char	devname[ARB]		# termcap entry to be scanned for
+
+int	fd, ntc
+pointer	sp, device, ip, op, caplist
+int	open(), strlen(), strncmp()
+pointer	coerce()
+errchk	open, syserrs
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+
+	fd = open (termcap_file, READ_ONLY, TEXT_FILE)
+	call strcpy (devname, Memc[device], SZ_FNAME)
+
+	ntc = 0
+	repeat {
+	    iferr (call gty_fetch_entry (fd, Memc[device], tty)) {
+		call close (fd)
+		call erract (EA_ERROR)
+	    }
+
+	    # Back up to start of last field in entry.
+	    caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	    ip = caplist + T_OP(tty)-1 - 2
+	    while (ip > caplist && Memc[ip] != ':')
+		ip = ip - 1
+
+	    # If last field is "tc", backup op so that the tc field gets
+	    # overwritten with the referenced entry.
+
+	    if (strncmp (Memc[ip+1], "tc", 2) == 0) {
+		# Check for recursive tc reference.
+		ntc = ntc + 1
+		if (ntc > MAX_TC_NESTING) {
+		    call close (fd)
+		    call syserrs (SYS_TTYTC, Memc[device])
+		}
+
+		# Set op to point to the ":" in ":tc=file".
+		T_OP(tty) = ip - caplist + 1
+
+		# Get device name from tc field, and loop again to fetch new
+		# entry.
+		ip = ip + strlen (":tc=")
+		for (op=device;  Memc[ip] != EOS && Memc[ip] != ':';  ip=ip+1) {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+		call seek (fd, BOFL)
+	    } else
+		break
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# GTY_FETCH_ENTRY -- Search the termcap file for the named entry, then read
+# the colon delimited capabilities list into the caplist field of the tty
+# descriptor.  If the caplist field fills up, allocate more space.
+
+procedure gty_fetch_entry (fd, device, tty)
+
+int	fd
+char	device[ARB]
+pointer	tty
+
+char	ch, lastch
+bool	device_found
+pointer	sp, ip, op, otop, lbuf, alias, caplist
+
+char	getc()
+bool	streq()
+pointer	coerce()
+int	getline(), gty_extract_alias()
+errchk	getline, getc, realloc, salloc
+define	errtn_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf,  SZ_LINE,  TY_CHAR)
+	call salloc (alias, SZ_FNAME, TY_CHAR)
+
+	# Locate entry.  First line of each termcap entry contains a list
+	# of aliases for the device.  Only first lines and comment lines
+	# are left justified.
+
+	repeat {
+	    # Skip comment and continuation lines and blank lines.
+	    device_found = false
+
+	    if (getc (fd, ch) == EOF)
+		goto errtn_
+
+	    if (ch == '\n') {
+		# Skip a blank line.
+		next
+	    } else if (ch == '#' || IS_WHITE (ch)) {
+		# Discard the rest of the line and continue.
+		if (getline (fd, Memc[lbuf]) == EOF)
+		    goto errtn_
+		next
+	    }
+
+	    # Extract list of aliases.  The first occurrence of ':' marks
+	    # the end of the alias list and the beginning of the caplist.
+
+	    Memc[lbuf] = ch
+	    op = lbuf + 1
+
+	    for (;  getc(fd,ch) != ':';  op=op+1) {
+		Memc[op] = ch
+		if (ch == EOF || ch == '\n') {
+		    goto errtn_
+		}
+	    }
+	    Memc[op] = EOS
+
+	    ip = lbuf
+	    while (gty_extract_alias (Memc, ip, Memc[alias], SZ_FNAME) > 0) {
+		if (device[1] == EOS || streq (Memc[alias], device)) {
+		    device_found = true
+		    break
+		} else if (Memc[ip] == '|')
+		    ip = ip + 1				# skip delimiter
+	    }
+
+	    # Skip rest of line if no match.
+	    if (!device_found) {
+		if (getline (fd, Memc[lbuf]) == EOF) {
+		    goto errtn_
+		}
+	    }
+	} until (device_found)
+
+	# Caplist begins at first ':'.  Each line has some whitespace at the
+	# beginning which should be skipped.  Escaped newline implies
+	# continuation.
+
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	op = caplist + T_OP(tty) - 1
+	otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR)
+
+	# We are already positioned to the start of the caplist.
+	Memc[op] = ':'
+	op = op + 1
+	lastch = ':'
+
+	# Extract newline terminated caplist string.
+	while (getc (fd, ch) != EOF) {
+	    if (ch == '\\') {				# escaped newline?
+		if (getc (fd, ch) == '\n') {
+		    while (getc (fd, ch) != EOF)
+			if (!IS_WHITE(ch))
+			    break
+		    if (ch == EOF || ch == '\n')
+			goto errtn_
+		    # Avoid null entries ("::").
+		    if (ch == ':' && lastch == ':')
+			next
+		    else
+			Memc[op] = ch
+		} else {				# no, keep both chars
+		    Memc[op] = '\\'
+		    op = op + 1
+		    Memc[op] = ch
+		}
+	    } else if (ch == '\n') {			# normal exit
+		Memc[op] = EOS
+		T_OP(tty) = op - caplist + 1
+		T_CAPLEN(tty) = T_OP(tty)
+		call sfree (sp)
+		return
+	    } else
+		Memc[op] = ch
+
+	    # Increase size of buffer if necessary.  Note that realloc may 
+	    # move the buffer, so we must recalculate op and otop.
+
+	    lastch = ch
+	    op = op + 1
+	    if (op >= otop) {
+		T_OP(tty) = op - caplist + 1
+		T_LEN(tty) = T_LEN(tty) + T_MEMINCR
+		call realloc (tty, T_LEN(tty), TY_STRUCT)
+		op = caplist + T_OP(tty) - 1
+		otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR)
+	    }
+	}
+
+errtn_
+ 	call sfree (sp)
+	call syserrs (SYS_TTYDEVNF, device)
+end
+
+
+# GTY_EXTRACT_ALIAS -- Extract a device alias string from the header of
+# a termcap entry.  The alias string is terminated by '|' or ':'.  Leave
+# ip pointing at the delimiter.  Return number of chars in alias string.
+
+int procedure gty_extract_alias (str, ip, outstr, maxch)
+
+char	str[ARB]		# first line of termcap entry
+int	ip			# on input, first char of alias
+char	outstr[ARB]
+int	maxch
+
+char	ch
+int	op
+
+begin
+	op = 1
+	for (ch=str[ip];  ch != '|' && ch != ':' && ch != EOS;  ch=str[ip]) {
+	    outstr[op] = ch
+	    op = min (maxch, op) + 1
+	    ip = ip + 1
+	}
+	outstr[op] = EOS
+
+	if (ch == EOS)
+	    return (0)
+	else
+	    return (op-1)
+end
diff --git a/sys/gty/mkpkg b/sys/gty/mkpkg
new file mode 100644
index 00000000..20dff77f
--- /dev/null
+++ b/sys/gty/mkpkg
@@ -0,0 +1,29 @@
+# Update the GTY portion of libsys.a.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+zzdebug:
+	$checkout libsys.a lib$
+	$update   libsys.a
+	$checkin  libsys.a lib$
+
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+	$omake	zzdebug.x
+	$link	-z zzdebug.o
+	;
+
+libsys.a:
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+
+	gtycaps.x	gty.h
+	gtyclose.x	
+	gtygetb.x	
+	gtygeti.x	
+	gtygetr.x	<mach.h>
+	gtygets.x	<chars.h>
+	gtyindex.x	gty.h <chars.h>
+	gtyopen.x	gty.h <chars.h> <ctype.h> <error.h>
+	;
diff --git a/sys/gty/zzdebug.x b/sys/gty/zzdebug.x
new file mode 100644
index 00000000..c8171b4c
--- /dev/null
+++ b/sys/gty/zzdebug.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	dump = t_dump
+
+# DUMP -- Dump a termcap (GTY) device entry.
+
+procedure t_dump()
+
+char	fname[SZ_FNAME]
+char	device[SZ_FNAME]
+char	ufields[SZ_LINE]
+
+pointer	gty
+pointer	gtyopen()
+pointer	gtycaps()
+
+begin
+	call clgstr ("fname", fname, SZ_FNAME)
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("ufields", ufields, SZ_LINE)
+
+	gty = gtyopen (fname, device, ufields)
+	call printf ("%s\n")
+	    call pargstr (Memc[gtycaps(gty)])
+	call gtyclose (gty)
+end
diff --git a/sys/imfort/README b/sys/imfort/README
new file mode 100644
index 00000000..f1fd0a60
--- /dev/null
+++ b/sys/imfort/README
@@ -0,0 +1,98 @@
+			    The IMFORT Interface
+			 Doug Tody, September 1986
+
+
+1. INTRODUCTION
+
+    The IMFORT interface is a host level Fortran programming environment for
+IRAF.  Fortran programs (or C programs) may be written at the host level
+with full access to the facilities of the host environment, plus limited
+access to the IRAF environment via the IMFORT interface.  Such host level
+programs may be interfaced to the IRAF CL as foreign tasks and called with
+arguments on the command line, like ordinary IRAF tasks.
+
+The chief advantage of the IMFORT interface is that it allows existing host
+Fortran programs to be interfaced to IRAF with minimum effort.  The IMFORT
+interface also provides a way for the scientist-user to extend the IRAF
+environment with their own programs, without need to learn to use the much
+more complex IRAF VOS programming environment.  Of course, the VOS is a much
+more powerful environment and VOS programs tend to be much more portable than
+host Fortran programs, so the VOS environment should be used for large
+programming projects.
+
+The IMFORT interface is described in detail in the document "A User's Guide
+to Fortran Programming in the IRAF Environment".  A summary of the interface
+procedures follows.  The IMFORT routines make use of the IRAF kernel for all
+i/o, and of the FMTIO and VOPS packages for miscellaneous functions, hence
+programs using IMFORT must be linked with LIBSYS, LIBVOPS, and LIBOS.
+
+
+2. INTERFACE PROCEDURES
+
+2.1 COMMAND LINE ACCESS
+
+		clnarg (nargs)
+		clrawc (outstr, ier)
+           clarg[cird] (argno, [cird]val, ier)
+
+
+2.2 IMAGE ACCESS
+
+2.2.1 General
+
+		imopen (f77nam, acmode, im, ier)
+		imopnc (nimage, o_im, n_im, ier)
+		imcrea (f77nam, axlen, naxis, pixtype, ier)
+		imclos (im, ier)
+
+		imflsh (im, ier)
+		imgsiz (im, axlen, naxis, pixtype, ier)
+		imhcpy (o_im, n_im, ier)
+		impixf (im, pixfd, pixfil, pixoff, szline, ier)
+
+		imemsg (ier, errmsg)
+
+
+2.2.2 Image Header Keyword Access
+
+		imacck (im, keyw)
+		imaddk (im, keyw, dtype, comm, ier)
+		imdelk (im, keyw, ier)
+		imtypk (im, keyw, dtype, comm, ier)
+
+	  imakw[bcdir] (im, keyw, [bcdir]val, comm, ier)
+	  imgkw[bcdir] (im, keyw, [bcdir]val, ier)
+	  impkw[bcdir] (im, keyw, [bcdir]val, ier)
+
+		imokwl (im, patstr, sortit, kwl, ier)
+		imgnkw (kwl, outstr, ier)
+		imckwl (kwl, ier)
+
+
+2.2.3 Image Pixel Access
+
+	     imgl1[rs] (im, buf, ier)
+	     imgl2[rs] (im, buf, lineno, ier)
+	     imgl3[rs] (im, buf, lineno, bandno, ier)
+	     imgs1[rs] (im, buf, i1, i2, ier)
+	     imgs2[rs] (im, buf, i1, i2, j1, j2, ier)
+	     imgs3[rs] (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+	     impl1[rs] (im, buf, ier)
+	     impl2[rs] (im, buf, lineno, ier)
+	     impl3[rs] (im, buf, lineno, bandno, ier)
+	     imps1[rs] (im, buf, i1, i2, ier)
+	     imps2[rs] (im, buf, i1, i2, j1, j2, ier)
+	     imps2[rs] (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+
+2.3. BINARY FILE I/O (low level)
+
+		bfaloc (fname, nchars, status)
+	   fd = bfopen (fname, acmode, advice)
+		bfclos (fd, status)
+       nchars = bfbsiz (fd)
+	 chan = bfchan (fd)
+       nchars = bfread (fd, buf, nchars, offset)
+       nchars = bfwrit (fd, buf, nchars, offset)
+	 stat = bfflsh (fd)
diff --git a/sys/imfort/bfio.x b/sys/imfort/bfio.x
new file mode 100644
index 00000000..ff2d059d
--- /dev/null
+++ b/sys/imfort/bfio.x
@@ -0,0 +1,496 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include <fio.h>
+include	"imfort.h"
+
+.help bfio
+.nf --------------------------------------------------------------------------
+BFIO -- Binary file i/o.
+
+The IMFORT interface needs its own little binary file i/o interface to deal
+with the complexities of blocking and deblocking data in hardware disk blocks.
+A little buffering is also desirable to reduce the number of disk transfers
+required to read through an image.
+
+		bfaloc (fname, nchars, status)
+	fp =	bfopen (fname, acmode, advice)
+
+		bfalcx (fname, nchars, status)
+	fp =	bfopnx (fname, acmode, advice)
+	nc =	bfbsiz (fp)				# get block size
+	nc =	bffsiz (fp)				# get file size
+	chan =  bfchan (fp)				# get channel
+		bfclos (fp, status)
+
+	stat =	bfread (fp, buf, nchars, offset)	# random i/o
+	stat =	bfwrit (fp, buf, nchars, offset)
+
+	stat =  bfseek (fp, offset)			# sequential i/o
+	stat =  bfrseq (fp, buf, nchars)
+	stat =  bfwseq (fp, buf, nchars)
+
+	stat =	bfflsh (fp)				# flush buffered output
+
+where
+	fname	host file name (no virtual filenames here)
+	acmode	access mode (READ_ONLY, etc.)
+	advice	SEQUENTIAL or RANDOM
+	fd	file descriptor, a struct pointer
+	buf	char user data buffer
+	nchars	amount of data to transfer, SPP chars
+	offset	file offset of transfer, SPP chars, 1 indexed
+	stat	nchars transferred or ERR
+
+The advice parameter determines the size of the internal buffer allocated
+by BFIO.  A small buffer is allocated for random access, a large buffer for
+sequential access.  Sequential is usually best.  If advice is a large number
+it is taken to be the actual block size in chars.
+.endhelp --------------------------------------------------------------------
+
+define	LEN_BFIO	10
+define	BF_CHAN		Memi[$1]		# OS channel
+define	BF_ACMODE	Memi[$1+1]		# access mode
+define	BF_BUFP		Memi[$1+2]		# buffer pointer
+define	BF_BUFSIZE	Memi[$1+3]		# buffer capacity, chars
+define	BF_BUFCHARS	Memi[$1+4]		# amount of data in buffer
+define	BF_BUFOFFSET	Memi[$1+5]		# file offset of buffer
+define	BF_FILEOFFSET	Memi[$1+6]		# file offset for seq i/o
+define	BF_UPDATE	Memi[$1+7]		# write buffer to disk
+define	BF_BLKSIZE	Memi[$1+8]		# device block size
+
+define	SZ_RANBUF	2048			# SPP chars
+define	SZ_SEQBUF	131072
+define	READ		0
+define	WRITE		1
+
+
+# BFOPEN -- Fortran callable version of BFOPNX.
+
+int procedure bfopen (fname, acmode, advice)
+
+%	character*(*) fname
+int	acmode			# SPP access mode, as in FIO
+int	advice			# seq. or random, or bufsize in chars
+
+char	sppname[SZ_PATHNAME]
+pointer	bfopnx()
+
+begin
+	call f77upk (fname, sppname, SZ_PATHNAME)
+	return (bfopnx (sppname, acmode, advice))
+end
+
+
+# BFALOC -- Fortran callable version of BFALCX.
+
+procedure bfaloc (fname, nchars, status)
+
+%	character*(*) fname
+int	nchars			# size of file to be allocated
+int	status			# receives status
+
+char	sppname[SZ_PATHNAME]
+
+begin
+	call f77upk (fname, sppname, SZ_PATHNAME)
+	call strpak (sppname, sppname, SZ_PATHNAME)
+	call zfaloc (sppname, nchars * SZB_CHAR, status)
+end
+
+
+# BFOPNX -- Open a binary file (SPP version).
+
+pointer procedure bfopnx (fname, acmode, advice)
+
+char	fname[ARB]		# HOST filename
+int	acmode			# SPP access mode, as in FIO
+int	advice			# seq. or random, or bufsize in chars
+
+pointer	bp, fp
+long	blksize
+char	osfn[SZ_PATHNAME]
+int	chan, bufsize
+int	bfmode()
+errchk	malloc
+
+begin
+	# Open or create the file.
+	call strpak (fname, osfn, SZ_PATHNAME)
+	call zopnbf (osfn, bfmode(acmode), chan)
+	if (chan == ERR)
+	    return (ERR)
+
+	# Allocate and initialize file descriptor and i/o buffer.
+	call malloc (fp, LEN_BFIO, TY_STRUCT)
+
+	# Pick a buffer size.
+	if (advice == RANDOM)
+	    bufsize = SZ_RANBUF
+	else if (advice == SEQUENTIAL)
+	    bufsize = SZ_SEQBUF
+	else
+	    bufsize = advice
+
+	call zsttbf (chan, FSTT_BLKSIZE, blksize)
+	blksize = blksize / SZB_CHAR
+	bufsize = (bufsize + blksize - 1) / blksize * blksize
+	call malloc (bp, bufsize, TY_CHAR)
+
+	BF_CHAN(fp)       = chan
+	BF_ACMODE(fp)     = acmode
+	BF_BUFP(fp)       = bp
+	BF_BUFSIZE(fp)    = bufsize
+	BF_BUFCHARS(fp)   = 0
+	BF_BUFOFFSET(fp)  = 0
+	BF_FILEOFFSET(fp) = 1
+	BF_UPDATE(fp)     = NO
+	BF_BLKSIZE(fp)    = blksize
+
+	return (fp)
+end
+
+
+# BFCLOS -- Close a BFIO binary file.
+
+procedure bfclos (fp, status)
+
+pointer	fp			# BFIO file descriptor
+int	status
+int	bfflsh()
+
+begin
+	if (BF_UPDATE(fp) == YES) {
+	    status = bfflsh (fp)
+	    if (status == ERR)
+		return
+	}
+
+	call zclsbf (BF_CHAN(fp), status)
+	call mfree (BF_BUFP(fp), TY_CHAR)
+	call mfree (fp, TY_STRUCT)
+end
+
+
+# BFALCX -- Allocate a fixed size binary file.
+
+procedure bfalcx (fname, nchars, status)
+
+char	fname[ARB]		# HOST filename
+int	nchars			# size of file to be allocated
+int	status			# receives status
+
+char	osfn[SZ_PATHNAME]
+
+begin
+	call strpak (fname, osfn, SZ_PATHNAME)
+	call zfaloc (osfn, nchars * SZB_CHAR, status)
+end
+
+
+# BFBSIZ -- Return the device block size in chars.
+
+int procedure bfbsiz (fp)
+
+pointer	fp			# BFIO file descriptor
+
+begin
+	return (BF_BLKSIZE(fp))
+end
+
+
+# BFFSIZ -- Return the file size in chars.
+
+int procedure bffsiz (fp)
+
+pointer	fp			# BFIO file descriptor
+int	nbytes
+
+begin
+	call zsttbf (BF_CHAN(fp), FSTT_FILSIZE, nbytes)
+	if (nbytes == ERR)
+	    return (ERR)
+	else
+	    return ((nbytes + SZB_CHAR-1) / SZB_CHAR)
+end
+
+
+# BFCHAN -- Return the channel of the file.
+
+int procedure bfchan (fp)
+
+pointer	fp			# BFIO file descriptor
+
+begin
+	return (BF_CHAN(fp))
+end
+
+
+# BFREAD -- Read an arbitrary number of chars from a binary file at an
+# arbitrary offset.
+
+int procedure bfread (fp, buf, nchars, offset)
+
+pointer	fp			# BFIO file descriptor
+char	buf[ARB]		# user data buffer
+int	nchars			# nchars of data to be read
+long	offset			# file offset
+
+pointer	bp
+long	off, off1, off2
+int	ip, op, nleft, chunk
+int	bffill()
+
+begin
+	off1  = BF_BUFOFFSET(fp)
+	off2  = off1 + BF_BUFCHARS(fp)
+	off   = offset
+	nleft = nchars
+	op    = 1
+	bp    = BF_BUFP(fp)
+
+	while (nleft > 0) {
+	    # Fault in new buffer if file offset falls outside current buffer.
+	    if (off1 <= 0 || off < off1 || off >= off2)
+		if (bffill (fp, off, nleft, READ) == ERR)
+		    return (ERR)
+		else {
+		    off1 = BF_BUFOFFSET(fp)
+		    off2 = off1 + BF_BUFCHARS(fp)
+		}
+
+	    # Return as much data as possible from the current buffer and
+	    # advance all the pointers when done.
+
+	    ip = off - off1
+	    chunk = min (nleft, BF_BUFCHARS(fp) - ip)
+	    if (chunk <= 0)
+		break
+	    call amovc (Memc[bp+ip], buf[op], chunk)
+
+	    nleft = nleft - chunk
+	    off   = off + chunk
+	    op    = op + chunk
+	}
+
+	if (nleft >= nchars)
+	    return (EOF)
+	else
+	    return (nchars - nleft)
+end
+
+
+# BFWRIT -- Write an arbitrary number of chars to a binary file at an
+# arbitrary offset.
+
+int procedure bfwrit (fp, buf, nchars, offset)
+
+pointer	fp			# BFIO file descriptor
+char	buf[ARB]		# user data buffer
+int	nchars			# nchars of data to be written
+long	offset			# file offset
+
+pointer	bp
+long	off, off1, off2
+int	ip, op, nleft, chunk
+int	bffill()
+
+begin
+	off1  = BF_BUFOFFSET(fp)
+	off2  = off1 + BF_BUFSIZE(fp)
+	off   = offset
+	nleft = nchars
+	ip    = 1
+	bp    = BF_BUFP(fp)
+
+	while (nleft > 0) {
+	    # Fault in new buffer if file offset falls outside current buffer.
+	    if (off1 <= 0 || off < off1 || off >= off2)
+		if (bffill (fp, off, nleft, WRITE) == ERR)
+		    return (ERR)
+		else {
+		    off1 = BF_BUFOFFSET(fp)
+		    off2 = off1 + BF_BUFSIZE(fp)
+		}
+
+	    # Move as much data as possible into the current buffer and
+	    # advance all the pointers when done.
+
+	    op = off - off1
+	    chunk = min (nleft, BF_BUFSIZE(fp) - op)
+	    call amovc (buf[ip], Memc[bp+op], chunk)
+	    BF_BUFCHARS(fp) = max (BF_BUFCHARS(fp), off+chunk - off1)
+	    BF_UPDATE(fp) = YES
+
+	    nleft = nleft - chunk
+	    off   = off + chunk
+	    ip    = ip + chunk
+	}
+
+	return (nchars)
+end
+
+
+# BFRSEQ -- Sequential read from a file.  Successive reads advance through
+# the file.
+
+int procedure bfrseq (fp, buf, nchars)
+
+pointer	fp			#I BFIO file descriptor
+char	buf[ARB]		#I user data buffer
+int	nchars			#I nchars of data to be read
+
+int	status
+int	bfread()
+
+begin
+	status = bfread (fp, buf, nchars, BF_FILEOFFSET(fp))
+	if (status > 0)
+	    BF_FILEOFFSET(fp) = BF_FILEOFFSET(fp) + status
+
+	return (status)
+end
+
+
+# BFWSEQ -- Sequential write to a file.  Successive writes advance through
+# the file.
+
+int procedure bfwseq (fp, buf, nchars)
+
+pointer	fp			#I BFIO file descriptor
+char	buf[ARB]		#O user data buffer
+int	nchars			#I nchars of data to be written
+
+int	status
+int	bfwrit()
+
+begin
+	status = bfwrit (fp, buf, nchars, BF_FILEOFFSET(fp))
+	if (status > 0)
+	    BF_FILEOFFSET(fp) = BF_FILEOFFSET(fp) + status
+
+	return (status)
+end
+
+
+# BFSEEK -- Set the file offset for sequential i/o using bf[rw]seq.
+# If called as bfseek(fp,0) the current file offset is returned without
+# changing the file position.
+
+int procedure bfseek (fp, offset)
+
+pointer	fp			#I BFIO file descriptor
+int	offset			#I desired file offset (1-indexed)
+
+int	bffsiz()
+int	old_offset
+
+begin
+	old_offset = BF_FILEOFFSET(fp)
+
+	switch (offset) {
+	case BOF:
+	    BF_FILEOFFSET(fp) = 1
+	case EOF:
+	    BF_FILEOFFSET(fp) = bffsiz(fp) + 1
+	default:
+	    if (offset > 0)
+		BF_FILEOFFSET(fp) = offset
+	}
+
+	return (old_offset)
+end
+
+
+# BFFILL -- Move the BFIO buffer so that it contains the indicated offset.
+# Flush the buffer to disk first if it has been written into.
+
+int procedure bffill (fp, offset, nchars, rwflag)
+
+pointer	fp			# BFIO descriptor
+long	offset			# desired file offset
+int	nchars			# nchars that will be read/written later
+int	rwflag			# read or write when we return?
+
+long	bufoff
+int	status, bufsize
+int	bfflsh()
+
+begin
+	if (BF_UPDATE(fp) == YES)
+	    if (bfflsh (fp) == ERR)
+		return (ERR)
+
+	bufsize = BF_BUFSIZE(fp)
+	bufoff = ((offset - 1) / bufsize) * bufsize + 1
+	BF_BUFOFFSET(fp) = bufoff
+
+	# If we are being called prior to a write, and the entire buffer
+	# is being written into, there is no point in filling the buffer
+	# from the file.  Also, if the file is open WRITE_ONLY, we do not
+	# read from the file.
+
+	if ((BF_ACMODE(fp) == WO) ||
+	    (offset == bufoff && nchars >= bufsize && rwflag == WRITE))
+	    return (nchars)
+
+	# Fill the buffer from the file.
+	call zardbf (BF_CHAN(fp), Memc[BF_BUFP(fp)], BF_BUFSIZE(fp) * SZB_CHAR,
+	    (bufoff - 1) * SZB_CHAR + 1)
+	call zawtbf (BF_CHAN(fp), status)
+
+	if (status == ERR)
+	    return (ERR)
+
+	BF_BUFCHARS(fp) = status / SZB_CHAR
+	return (BF_BUFCHARS(fp))
+end
+
+
+# BFFLSH -- Flush the BFIO buffer.
+
+int procedure bfflsh (fp)
+
+pointer	fp				# BFIO file descriptor
+int	status
+
+begin
+	if (BF_UPDATE(fp) == NO)
+	    return (OK)
+	else
+	    BF_UPDATE(fp) = NO
+
+	# Flush the buffer to the file.
+	call zawrbf (BF_CHAN(fp), Memc[BF_BUFP(fp)], BF_BUFCHARS(fp) * SZB_CHAR,
+	    (BF_BUFOFFSET(fp) - 1) * SZB_CHAR + 1)
+	call zawtbf (BF_CHAN(fp), status)
+
+	if (status == ERR)
+	    return (ERR)
+	else
+	    return (status / SZB_CHAR)
+end
+
+
+# BFMODE -- Map the IMFORT/BFIO access mode into the file access mode
+# expected by the IRAF kernel.
+
+int procedure bfmode (acmode)
+
+int	acmode			# IMFORT access mode
+
+begin
+	switch (acmode) {
+	case RO:
+	    return (READ_ONLY)
+	case WO:
+	    return (WRITE_ONLY)
+	case RW:
+	    return (READ_WRITE)
+	case NF:
+	    return (NEW_FILE)
+	default:
+	    return (READ_ONLY)
+	}
+end
diff --git a/sys/imfort/clargs.x b/sys/imfort/clargs.x
new file mode 100644
index 00000000..c383b570
--- /dev/null
+++ b/sys/imfort/clargs.x
@@ -0,0 +1,232 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+.help clargs
+.nf --------------------------------------------------------------------------
+CLARGS.X -- Command Line Argument access package for IMFORT.
+
+The CLARGS package provides access to the foreign task command line, if any,
+passed to the IMFORT program when it was run.  The raw command line may be
+obtained as a string, the individual arguments may be extracted as strings,
+or arguments may be decoded as integer or floating point values.
+
+	clnarg (nargs)			# get number of command line arguments
+	clargc (argno, sval, ier)	# get argument argno as a string
+	clargi (argno, ival, ier)	# get argument argno as an integer
+	clargr (argno, rval, ier)	# get argument argno as a real
+	clargd (argno, dval, ier)	# get argument argno as a double
+	clrawc (cmdstr, ier)		# get entire raw command line
+
+Command line arguments are delimited by whitespace.  String arguments do not
+have to be quoted; string arguments containing whitespace must be quoted.
+FMTIO is used to decode numeric arguments, hence the IRAF notations are
+recognized for radix specification (octal, hex) and for sexagesimal input.
+
+Note that a Fortran program using IMFORT may be interfaced to the IRAF CL
+as a foreign task, using the CLARGS interface to pass foreign task command
+line arguments to the Fortran program, allowing user written Fortran programs
+to be called from within CL scripts as well as interactively.
+.endhelp ---------------------------------------------------------------------
+
+
+# CLARGC -- Return the indicated whitespace delimited command line argument
+# as a string.
+
+procedure clargc (argno, outstr, ier)
+
+int	argno				# desired argument
+%	character*(*) outstr
+int	ier
+
+int	u_nargs
+int	u_argp[MAX_ARGS]
+char	u_sbuf[SZ_CMDLINE]
+common	/argcom/ u_nargs, u_argp, u_sbuf
+
+begin
+	call cl_initargs (ier)
+	if (ier > 0)
+	    return
+
+	if (argno < 1 || argno > u_nargs)
+	    ier = IE_NEXARG
+	else {
+	    call f77pak (u_sbuf[u_argp[argno]], outstr, len(outstr))
+	    ier = OK
+	}
+end
+
+
+# CLARGI -- Return the indicated whitespace delimited command line argument
+# as an integer.
+
+procedure clargi (argno, ival, ier)
+
+int	argno			# desired argument
+int	ival			# integer value of argument
+int	ier
+
+double	dval
+
+begin
+	call clargd (argno, dval, ier)
+	if (ier == OK)
+	    ival = dval		# (integer overflow if large exponent)
+end
+
+
+# CLARGR -- Return the indicated whitespace delimited command line argument
+# as a real.
+
+procedure clargr (argno, rval, ier)
+
+int	argno			# desired argument
+real	rval			# integer value of argument
+int	ier
+
+double	dval
+
+begin
+	call clargd (argno, dval, ier)
+	if (ier == OK)
+	    rval = dval
+end
+
+
+# CLARGD -- Return the indicated whitespace delimited command line argument
+# as a double.
+
+procedure clargd (argno, dval, ier)
+
+int	argno			# desired argument
+double	dval			# double floating value of argument
+int	ier
+
+int	ip, gctod()
+
+int	u_nargs
+int	u_argp[MAX_ARGS]
+char	u_sbuf[SZ_CMDLINE]
+common	/argcom/ u_nargs, u_argp, u_sbuf
+
+begin
+	call cl_initargs (ier)
+	if (ier > 0)
+	    return
+
+	if (argno < 1 || argno > u_nargs)
+	    ier = IE_NEXARG
+	else {
+	    ip = u_argp[argno]
+	    if (gctod (u_sbuf, ip, dval) <= 0) {
+		ier = IE_NONNUMARG
+		call im_seterrop (ier, u_sbuf[ip])
+	    } else
+		ier = OK
+	}
+end
+
+
+# CLNARG -- Return the number of command line arguments.
+
+procedure clnarg (nargs)
+
+int	nargs
+int	ier
+
+int	u_nargs
+int	u_argp[MAX_ARGS]
+char	u_sbuf[SZ_CMDLINE]
+common	/argcom/ u_nargs, u_argp, u_sbuf
+
+begin
+	call cl_initargs (ier)
+	if (ier != OK)
+	    nargs = 0
+	else
+	    nargs = u_nargs
+end
+
+
+# CL_INITARGS -- The first time we are called, read the raw command line
+# and parse it into the individual argument strings in the ARGCOM common.
+# After the first call the common is set and we are a no-op.
+
+procedure cl_initargs (ier)
+
+int	ier
+
+int	status, op
+bool	first_time
+pointer	sp, cmd, token, ip
+data	first_time /true/
+int	ctowrd(), gstrcpy()
+
+int	u_nargs
+int	u_argp[MAX_ARGS]
+char	u_sbuf[SZ_CMDLINE]
+common	/argcom/ u_nargs, u_argp, u_sbuf
+
+begin
+	if (!first_time) {
+	    ier = OK
+	    return
+	}
+
+	call smark (sp)
+	call salloc (cmd, SZ_CMDLINE, TY_CHAR)
+	call salloc (token, SZ_CMDLINE, TY_CHAR)
+
+	call zgcmdl (Memc[cmd], SZ_CMDLINE, status)
+	if (status <= 0) {
+	    ier = IE_GCMDLN
+	    call sfree (sp)
+	    return
+	}
+	
+	call strupk (Memc[cmd], Memc[cmd], SZ_CMDLINE)
+	u_nargs = 0
+	ip = cmd
+	op = 1
+
+	while (ctowrd (Memc, ip, Memc[token], SZ_CMDLINE) > 0) {
+	    u_nargs = u_nargs + 1
+	    u_argp[u_nargs] = op
+	    op = op + gstrcpy (Memc[token], u_sbuf[op], SZ_CMDLINE-op+1) + 1
+	}
+
+	ier = OK
+	first_time = false
+	call sfree (sp)
+end
+
+
+# CLRAWC -- Get the raw command line passed by the host system when the calling
+# program was run.  This should be the command line entered in the CL when the
+# program was called, assuming that the program is implemented as a foreign task
+# in the CL.
+
+procedure clrawc (outstr, ier)
+
+%	character*(*) outstr
+int	ier
+
+int	status
+pointer	sp, cmd
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_CMDLINE, TY_CHAR)
+
+	call zgcmdl (Memc[cmd], SZ_CMDLINE, status)
+	if (status <= 0)
+	    ier = IE_GCMDLN
+	else {
+	    call strupk (Memc[cmd], Memc[cmd], SZ_CMDLINE)
+	    call f77pak (Memc[cmd], outstr, len(outstr))
+	    ier = OK
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/db/README b/sys/imfort/db/README
new file mode 100644
index 00000000..1503a949
--- /dev/null
+++ b/sys/imfort/db/README
@@ -0,0 +1,120 @@
+IMFORT/DB -- Image header keyword access for IMFORT (20Apr86)
+
+    This directory contains a version of the imio/db package, modified for
+IMFORT.  The modifications consisted of [1] elimination of calls to the
+various printf routines, so that only pure code (no external dependencies
+or use of VOS i/o) is linked into the Fortran program, [2] deleted imgnfn
+template stuff, [3] added provision for comments when adding new keywords,
+[4] changed datatype code to integer uniformly.  Error checking is still
+used but should be iferr-ed and turned into an IER code in the Fortran
+binding.
+
+
+Old IDBI readme docs:
+----------------------------------------
+
+			Image Header Database Interface
+				dct 16-Apr-85
+
+1. Overview
+
+    This directory contains the first version of the image header database
+interface.  In this implementation the image header is a variable length fixed
+format binary structure.  The first, fixed format, part of the image header
+contains the standard fields in binary and is fixed in size.  This is followed
+by the so called "user area", a string buffer containing a sequence of
+variable length, newline delimited FITS format keyword=value header cards.
+When an image is open a large user area is allocated to permit the addition
+of new parameters without filling up the buffer.  When the header is
+subsequently updated on disk only as much disk space is used as is needed to
+store the actual header.
+
+This format header is upwards compatible with the old image header format,
+hence old images and programs do not have to be modified to use the IMIO
+release supporting database accesss.  In the future image headers will be
+maintained under DBIO, but the routines in the image header database interface
+are not exected to change.  The actual disk format of images will of course
+change when we switch over to the  DBIO headers.
+
+
+
+2. Functions
+
+	get,g - get the value of a field
+	put,p - set the value of a field
+	add,a - add a new field to a database
+	  acc - determine if the named field exists
+
+
+3. Procedures
+
+       value = imget[bcsilrdx] (im, "field")
+		        imgstr (im, "field", outstr, maxch)
+	       imput[bcsilrdx] (im, "field", value)
+		        impstr (im, "field", value)
+       	       imadd[bcsilrdx] (im, "field", def_value)
+		        imastr (im, "field", def_value)
+		        imaddf (im, "field", "datatype")
+	          y/n = imaccf (im, "field")
+
+             list = imofnl[su] (im, template)
+                  nch = imgnfn (im, outstr, maxch)
+                        imcfnl (im)
+
+
+
+4. Description
+
+    New parameters will typically be added to the image header with either
+one of the typed procedures IMADD_ or with the lower level procedure IMADDF.
+The former procedures permit the parameter to be created and the value
+initialized all in one call, while the latter only creates the parameter.
+In addition, the typed IMADD_ procedures may be used to update the values
+of existing parameters (it is not considered an error if the parameter
+already exists).  The principal limitation of the typed procedures is that
+they may only be used to add or set parameters of a standard datatype.
+The IMADDF procedure will permit creation of parameters with more descriptive
+datatypes (domains) when the interface is recut upon DBIO.
+
+The value of any parameter may be fetched with one of the IMGET functions.
+The IMACCF function may be used (like ACCESS for a file) to determine
+whether a parameter exists.
+
+The database interface may be used to access any field of the image header,
+including the following standard fields.  Note that the nomenclature has
+been changed slightly to make it more consistent with FITS.  Additional
+standard fields will be defined in the future.
+
+
+	  keyword     type                 description
+
+	i_naxis		i	number of axes (dimensionality)
+	i_naxis[1-7]	l	length of an axis ("i_naxis1", etc.)
+	i_pixtype	i	pixel datatype (SPP integer code)
+	i_minpixval	r	minimum pixel value
+	i_maxpixval	r	maximum pixel value
+	i_ctime		l	time of image creation
+	i_mtime		l	time of last modify
+	i_limtime	l	time when limits (minmax) were last updated
+	i_title		s	title string
+
+
+The names of the standard fields share an "i_" prefix to reduce the possibility
+of collisions with data dependent keywords, to identify the standard fields in
+sorted listings, to allow use of pattern matching to discriminate between the
+standard fields and user fields, and so on.  For the convenience of the user,
+the "i_" prefix may be omitted provided the resultant name does not match the
+name of a user parameter.  It is however recommended that the full name be
+used in all applications software.
+
+
+5. Restrictions
+
+    The use of FITS format as the internal format for storing fields in this
+version of the interface places restrictions on the size of field names and
+of the string value of string valued parameters.  Field names are currently
+limited to eight characters or less and case is ignored (since FITS requires
+upper case).  The eight character limit does not apply to the standard fields.
+String values are limited to at most 68 characters.  If put string is passed
+a longer string it will be silently truncated.  Trailing whitespace and
+newlines are chopped when a string value is read.
diff --git a/sys/imfort/db/idb.h b/sys/imfort/db/idb.h
new file mode 100644
index 00000000..a430f01f
--- /dev/null
+++ b/sys/imfort/db/idb.h
@@ -0,0 +1,22 @@
+# IDB.H -- Image header database interface.  In this version of the interface
+# the standard image header fields are maintained in binary in a fixed
+# structure and the user fields are maintained in FITS format (text) in the
+# a string buffer following the binary image header.
+
+define	IDB_RECLEN		80		# length of a FITS record (card)
+define	IDB_STARTVALUE		10		# first column of value field
+define	IDB_ENDVALUE		30		# last  column of value field
+define	IDB_LENNUMERICRECORD	80		# length of new numeric records
+define	IDB_LENSTRINGRECORD	80		# length of new string records
+
+# Standard header keywords accessible via the database interface.
+
+define	I_CTIME			1
+define	I_MTIME			2
+define	I_LIMTIME		3
+define	I_MINPIXVAL		4
+define	I_MAXPIXVAL		5
+define	I_NAXIS			6
+define	I_PIXFILE		7
+define	I_PIXTYPE		8
+define	I_TITLE			9
diff --git a/sys/imfort/db/idbfind.x b/sys/imfort/db/idbfind.x
new file mode 100644
index 00000000..cc9000ec
--- /dev/null
+++ b/sys/imfort/db/idbfind.x
@@ -0,0 +1,124 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"../imfort.h"
+include	"idb.h"
+
+# IDB_FINDRECORD -- Search the image database for a particular record given
+# the key.  The record number (a positive nonzero integer) is returned if
+# the record is found, else 0.  
+
+int procedure idb_findrecord (im, key, rp)
+
+pointer	im			# image descriptor
+char	key[ARB]		# record key
+pointer	rp			# char record pointer (output)
+
+pointer	sp, pat, patbuf, ukey, lkey, ip, ua
+int	recno, nchars, lch, uch, ch, junk, i
+int	patmake(), patmatch(), gstrcpy()
+
+begin
+	call smark (sp)
+	call salloc (pat, SZ_FNAME, TY_CHAR)
+	call salloc (ukey, SZ_FNAME, TY_CHAR)
+	call salloc (lkey, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+
+	# Search for the FIRST occurrence of a record with the given key.
+	# If the key is abbreviated and multiple keys are matched, the first
+	# record matched is used.
+
+	ua = IM_USERAREA(im)
+	rp = NULL
+	recno = 1
+
+	if (IM_UABLOCKED(im) < 0) {
+	    # At image open time this flag is set by IMMAP to -1 to indicate
+	    # that the user area record type is not known.  An IKI kernel may
+	    # subsequently set the flag to yes/no, else we determine the
+	    # record type by inspection the first time we are called.  If the
+	    # user area is empty the record type is set to blocked; IDB always
+	    # writes blocked records.
+
+	    IM_UABLOCKED(im) = YES
+	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
+		for (nchars=0;  Memc[ip] != EOS;  nchars=nchars+1) {
+		    if (Memc[ip] == '\n')
+			break
+		    ip = ip + 1
+		}
+		if (nchars != IDB_RECLEN) {
+		    IM_UABLOCKED(im) = NO
+		    break
+		}
+	    }
+	}
+
+	if (IM_UABLOCKED(im) == NO) {
+	    # Variable length, newline terminated records, EOS terminated
+	    # record group.
+
+	    call strcpy ("^{", Memc[pat], SZ_FNAME)
+	    call strcat (key,  Memc[pat], SZ_FNAME)
+	    call strcat ("}[ =]",  Memc[pat], SZ_FNAME)
+	    junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE)
+
+	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
+		if (patmatch (Memc[ip], Memc[patbuf]) > 0) {
+		    rp = ip
+		    break
+		}
+		while (Memc[ip] != '\n' && Memc[ip] != EOS)
+		    ip = ip + 1
+		recno = recno + 1
+	    }
+
+	} else {
+	    # Fixed length (80 character), newline terminated records, EOS
+	    # terminated record group.  Simple fast search, fixed length
+	    # records.  Case insensitive keyword match.
+
+	    nchars = gstrcpy (key, Memc[lkey], SZ_FNAME)
+	    call strlwr (Memc[lkey])
+	    lch = Memc[lkey]
+
+	    nchars = gstrcpy (key, Memc[ukey], SZ_FNAME)
+	    call strupr (Memc[ukey])
+	    uch = Memc[ukey]
+
+	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+IDB_RECLEN+1) {
+		ch = Memc[ip]
+		if (ch == EOS)
+		    break
+		else if (ch != lch && ch != uch)
+		    next
+		else {
+		    ch = Memc[ip+nchars]
+		    if (ch != ' ' && ch != '=')
+			next
+		}
+
+		# First char matches; check rest of string.
+		do i = 1, nchars-1 {
+		    ch = Memc[ip+i]
+		    if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) {
+			ch = 0
+			break
+		    }
+		}
+		if (ch != 0) {
+		    rp = ip		# match
+		    break
+		}
+
+		recno = recno + 1
+	    }
+	}
+
+	call sfree (sp)
+	if (rp == NULL)
+	    return (0)
+	else
+	    return (recno)
+end
diff --git a/sys/imfort/db/idbgstr.x b/sys/imfort/db/idbgstr.x
new file mode 100644
index 00000000..0b997884
--- /dev/null
+++ b/sys/imfort/db/idbgstr.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<imhdr.h>
+include	"idb.h"
+
+define	TY_STRING	(-1)
+
+# IDB_GETSTRING -- Get the string value of a standard header parameter.  If the
+# actual type of the parameter is not string the value is encoded as a string.
+# The length of the string is returned as the function value.  ERR is returned
+# if the string cannot be found.
+
+int procedure idb_getstring (im, key, outstr, maxch)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+long	lval
+double	dval
+int	dtype, axis
+int	gstrcpy(), idb_kwlookup(), idb_naxis(), ltoc(), dtoc()
+define	encode_ 91
+
+begin
+	# The keywords "naxis1", "naxis2", etc. are treated as a special case.
+	if (idb_naxis (key, axis) == YES)
+	    if (axis > 0) {
+		dtype = TY_LONG
+		lval  = IM_LEN(im,axis)
+		goto encode_
+	    }
+	    
+	switch (idb_kwlookup (key)) {
+	case I_CTIME:
+	    dtype = TY_LONG
+	    lval = IM_CTIME(im)
+	case I_LIMTIME:
+	    dtype = TY_LONG
+	    lval = IM_LIMTIME(im)
+	case I_MAXPIXVAL:
+	    dtype = TY_REAL
+	    if (IS_INDEFR (IM_MAX(im)))
+		dval = INDEFD
+	    else
+		dval = IM_MAX(im)
+	case I_MINPIXVAL:
+	    dtype = TY_REAL
+	    if (IS_INDEFR (IM_MIN(im)))
+		dval = INDEFD
+	    else
+		dval = IM_MIN(im)
+	case I_MTIME:
+	    dtype = TY_LONG
+	    lval = IM_MTIME(im)
+	case I_NAXIS:
+	    dtype = TY_LONG
+	    lval = IM_NDIM(im)
+	case I_PIXFILE:
+	    return (gstrcpy (IM_PIXFILE(im), outstr, maxch))
+	case I_PIXTYPE:
+	    dtype = TY_LONG
+	    lval = IM_PIXTYPE(im)
+	case I_TITLE:
+	    return (gstrcpy (IM_TITLE(im), outstr, maxch))
+	default:
+	    outstr[1] = EOS
+	    return (ERR)
+	}
+
+encode_
+	if (dtype == TY_LONG)
+	    return (ltoc (lval, outstr, maxch))
+	else
+	    return (dtoc (dval, outstr, maxch, 15, 'g', maxch))
+end
diff --git a/sys/imfort/db/idbkwlu.x b/sys/imfort/db/idbkwlu.x
new file mode 100644
index 00000000..4f56e033
--- /dev/null
+++ b/sys/imfort/db/idbkwlu.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<imhdr.h>
+include	"idb.h"
+
+# IDB_KWLOOKUP -- Look up a keyword in the dictionary of standard header
+# keywords, returning the magic integer code of the keyword or zero.
+
+int procedure idb_kwlookup (key)
+
+char	key[ARB]		# keyword to be looked up
+int	index, ip, ch
+pointer	sp, kwname
+int	strdic(), strncmp(), strlen()
+string	keywords "|ctime|mtime|limtime|datamin|datamax|naxis\
+|pixfile|pixtype|title|"
+
+begin
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+
+	# Look the string up in the dictionary of standard keywords.  Note that
+	# the "i_" prefix is omitted in the dictionary.  Minimum match abbrev.
+	# are permitted.  The order of the keywords in the dictionary must
+	# agree with the defined codes in the header file.  A standard keyword
+	# is recognized with or without the "i_" prefix.
+
+	if (key[1] == 'i' && key[2] == '_')
+	    ip = 3
+	else
+	    ip = 1
+
+	# Check for a reference to one of the NAXIS keywords.
+	if (key[ip] == 'n')
+	    if (strncmp (key[ip], "naxis", 5) == 0) {
+		ch = key[ip+5]
+		if (ch == EOS || IS_DIGIT(ch)) {
+		    call sfree (sp)
+		    return (I_NAXIS)
+		}
+	    }
+
+	# Look up keyword in dictionary.  Abbreviations are not permitted.
+	index = strdic (key[ip], Memc[kwname], SZ_FNAME, keywords)
+	if (index != 0)
+	    if (strlen(key[ip]) != strlen(Memc[kwname]))
+		index = 0
+
+	call sfree (sp)
+	return (index)
+end
diff --git a/sys/imfort/db/idbnaxis.x b/sys/imfort/db/idbnaxis.x
new file mode 100644
index 00000000..3b898403
--- /dev/null
+++ b/sys/imfort/db/idbnaxis.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# IDB_NAXIS -- Determine if the named keyword is one of the NAXIS* keywords,
+# and if so return the value of the numeric suffix.
+
+int procedure idb_naxis (keyw, axnum)
+
+char	keyw[ARB]		# keyword name
+int	axnum			# receives numeric axis code (0=no suffix)
+
+int	ch, ip
+int	strncmp(), ctoi()
+
+begin
+	if (strncmp (keyw, "i_naxis", 7) == 0)
+	    ip = 8
+	else if (strncmp (keyw, "naxis", 5) == 0)
+	    ip = 6
+	else
+	    return (NO)
+
+	ch = keyw[ip]
+	if (!IS_DIGIT(ch) && ch != ' ' && ch != EOS)
+	    return (NO)
+
+	if (ctoi (keyw, ip, axnum) <= 0)
+	    axnum = 0
+
+	return (YES)
+end
diff --git a/sys/imfort/db/idbpstr.x b/sys/imfort/db/idbpstr.x
new file mode 100644
index 00000000..35835730
--- /dev/null
+++ b/sys/imfort/db/idbpstr.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<mach.h>
+include	"idb.h"
+
+# IDB_PUTSTRING -- Set the value of a standard header parameter given the new
+# value of the parameter encoded as a string.  If actual type of the parameter
+# is non string the value must be decoded.  ERR is returned if the key is not
+# a standard header parameter or if the key is known but the value cannot be
+# decoded.
+
+int procedure idb_putstring (im, key, strval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	strval[ARB]		# string value of parameter
+
+long	lval
+double	dval
+bool	numeric
+int	ip, axis
+int	idb_kwlookup(), idb_naxis(), ctod()
+long	clktime()
+
+begin
+	ip = 1
+	numeric = (ctod (strval, ip, dval) > 0)
+	if (numeric) {
+	    if (IS_INDEFD (dval))
+		lval = INDEFL
+	    else if (real(MAX_LONG) < abs(dval))
+		lval = INDEFL
+	    else
+		lval = nint (dval)
+	}
+
+	# The keywords "naxis1", "naxis2", etc. are treated as a special case.
+	if (idb_naxis (key, axis) == YES)
+	    if (axis > 0) {
+		if (numeric)
+		    IM_LEN(im,axis) = lval
+		else
+		    return (ERR)
+	    }
+	    
+	# Lookup the keyword in the dictionary and set the value of the
+	# header parameter.  If the parameter is string valued copy the
+	# string value and return immediately.
+
+	switch (idb_kwlookup (key)) {
+	case I_CTIME:
+	    if (numeric)
+		IM_CTIME(im) = lval
+	case I_LIMTIME:
+	    if (numeric)
+		IM_LIMTIME(im) = lval
+	case I_MAXPIXVAL:
+	    if (numeric) {
+		IM_MAX(im) = dval
+		IM_LIMTIME(im) = clktime (long(0))
+	    }
+	case I_MINPIXVAL:
+	    if (numeric) {
+		IM_MIN(im) = dval
+		IM_LIMTIME(im) = clktime (long(0))
+	    }
+	case I_MTIME:
+	    if (numeric)
+		IM_MTIME(im) = lval
+	case I_NAXIS:
+	    if (numeric)
+		IM_NDIM(im) = lval
+	case I_PIXFILE:
+	    call strcpy (strval, IM_PIXFILE(im), SZ_IMPIXFILE)
+	    return (OK)
+	case I_PIXTYPE:
+	    if (numeric)
+		IM_PIXTYPE(im) = lval
+	case I_TITLE:
+	    call strcpy (strval, IM_TITLE(im), SZ_IMTITLE)
+	    return (OK)
+	default:
+	    return (ERR)
+	}
+
+	# We make it here only if the actual keyword is numeric, so return
+	# ERR if the keyword value was nonnumeric.
+
+	if (numeric)
+	    return (OK)
+	else
+	    return (ERR)
+end
diff --git a/sys/imfort/db/imaccf.x b/sys/imfort/db/imaccf.x
new file mode 100644
index 00000000..60e4e9f3
--- /dev/null
+++ b/sys/imfort/db/imaccf.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMACCF -- Test if the named field exists.  NO is returned if the key is not
+# found, YES otherwise.
+
+int procedure imaccf (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# name of the new parameter
+int	idb_kwlookup(), idb_findrecord()
+pointer	rp
+
+begin
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/imfort/db/imaddb.x b/sys/imfort/db/imaddb.x
new file mode 100644
index 00000000..a3161377
--- /dev/null
+++ b/sys/imfort/db/imaddb.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDB -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddb (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_BOOL, comment)
+	call imputb (im, key, value)
+end
diff --git a/sys/imfort/db/imaddd.x b/sys/imfort/db/imaddd.x
new file mode 100644
index 00000000..55a6f591
--- /dev/null
+++ b/sys/imfort/db/imaddd.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDD -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddd (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_DOUBLE, comment)
+	call imputd (im, key, value)
+end
diff --git a/sys/imfort/db/imaddf.x b/sys/imfort/db/imaddf.x
new file mode 100644
index 00000000..e6bda15e
--- /dev/null
+++ b/sys/imfort/db/imaddf.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"../imfort.h"
+include	"idb.h"
+
+# IMADDF -- Add a user field to the image header.  It is an error if the named
+# field already exists.
+
+procedure imaddf (im, key, datatype, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# name of the new parameter
+int	datatype		# datatype of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	max_lenuserarea
+pointer	sp, keyname, rp, ua, op
+int	idb_kwlookup(), idb_findrecord(), strlen()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case.
+	call strcpy (key, Memc[keyname], SZ_FNAME)
+	call strupr (Memc[keyname])
+
+	# Check for a redefinition.
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    call syserrs (SYS_IDBREDEF, key)
+	
+	# Open the user area string for appending.  If the user area is not
+	# empty the last character must be the newline record delimiter,
+	# else the new record we add will be invalid.
+
+	max_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU + 1) * SZ_STRUCT
+	ua = IM_USERAREA(im)
+
+	for (rp=ua;  Memc[rp] != EOS;  rp=rp+1)
+	    ;
+	if (rp - ua + IDB_RECLEN + 1 >= max_lenuserarea)
+	    call syserrs (SYS_IDBOVFL, key)
+
+	if (rp > ua && Memc[rp-1] != '\n') {
+	    Memc[rp] = '\n'
+	    rp = rp + 1
+	}
+
+	# Append the new record with an uninitialized value field.  Keyword
+	# value pairs are encoded in FITS format.
+
+	do op = rp, rp + IDB_RECLEN		# blank fill card
+	    Memc[op] = ' '
+
+	# Add the "= 'value' / comment".
+	call amovc (Memc[keyname], Memc[rp], strlen(Memc[keyname]))
+	Memc[rp+9-1] = '='
+	if (datatype == TY_CHAR) {
+	    Memc[rp+11-1] = '\''
+	    Memc[rp+20-1] = '\''
+	}
+
+	# Add the comment field.
+	Memc[rp+32-1] = '/'
+	call amovc (comment, Memc[rp+34-1],
+	    min (IDB_RECLEN-34+1, strlen(comment)))
+
+	# Terminate the card.
+	Memc[rp+IDB_RECLEN] = '\n'
+	Memc[rp+IDB_RECLEN+1] = EOS
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/db/imaddi.x b/sys/imfort/db/imaddi.x
new file mode 100644
index 00000000..527baaf0
--- /dev/null
+++ b/sys/imfort/db/imaddi.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDI -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddi (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+int	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_INT, comment)
+	call imputi (im, key, value)
+end
diff --git a/sys/imfort/db/imaddl.x b/sys/imfort/db/imaddl.x
new file mode 100644
index 00000000..a707eab3
--- /dev/null
+++ b/sys/imfort/db/imaddl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDL -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddl (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_LONG, comment)
+	call imputl (im, key, value)
+end
diff --git a/sys/imfort/db/imaddr.x b/sys/imfort/db/imaddr.x
new file mode 100644
index 00000000..ad4eee81
--- /dev/null
+++ b/sys/imfort/db/imaddr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDR -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddr (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_REAL, comment)
+	call imputr (im, key, value)
+end
diff --git a/sys/imfort/db/imadds.x b/sys/imfort/db/imadds.x
new file mode 100644
index 00000000..b4a01595
--- /dev/null
+++ b/sys/imfort/db/imadds.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDS -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imadds (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+char	comment[ARB]		# comment describing new parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_SHORT, comment)
+	call imputs (im, key, value)
+end
diff --git a/sys/imfort/db/imastr.x b/sys/imfort/db/imastr.x
new file mode 100644
index 00000000..03736f38
--- /dev/null
+++ b/sys/imfort/db/imastr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTR -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastr (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+char	comment[ARB]		# comment string
+int	imaccf()
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, TY_CHAR, comment)
+	call impstr (im, key, value)
+end
diff --git a/sys/imfort/db/imdelf.x b/sys/imfort/db/imdelf.x
new file mode 100644
index 00000000..78be8a88
--- /dev/null
+++ b/sys/imfort/db/imdelf.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"idb.h"
+
+# IMDELF -- Delete a user field from the image header.  It is an error if the
+# named field does not exist.
+
+procedure imdelf (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# name of the new parameter
+
+int	off
+pointer	rp, sp, keyname
+int	idb_kwlookup(), idb_findrecord(), stridxs()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case.
+	call strcpy (key, Memc[keyname], SZ_FNAME)
+	call strupr (Memc[keyname])
+
+	# Cannot delete standard header keywords.
+	if (idb_kwlookup (key) > 0)
+	    call syserrs (SYS_IDBNODEL, key)
+
+	# Verify that the named user field exists.
+	if (idb_findrecord (im, key, rp) <= 0)
+	    call syserrs (SYS_IDBDELNXKW, key)
+	
+	# Delete the field.
+	off = stridxs ("\n", Memc[rp])
+	if (off > 0)
+	    call strcpy (Memc[rp+off], Memc[rp], ARB)
+	else
+	    Memc[rp] = EOS
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/db/imgatr.x b/sys/imfort/db/imgatr.x
new file mode 100644
index 00000000..5d600cfa
--- /dev/null
+++ b/sys/imfort/db/imgatr.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"idb.h"
+
+# IMGATR -- Get the attribute fields (type code and comment) of a header
+# keyword.  A separate, normally typed, call is required to get the keyword
+# value.
+
+procedure imgatr (im, key, dtype, comm, maxch)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+int	dtype			# receives datatype code
+char	comm[ARB]		# output string to comment field
+int	maxch
+
+int	op
+pointer	rp, ip
+int	idb_getstring(), idb_findrecord(), imgftype()
+errchk	syserrs, imgftype
+
+begin
+	# Get the field datatype.
+	dtype = imgftype (im, key)
+
+	# Check for a standard header parameter first.
+	if (idb_getstring (im, key, comm, maxch) != ERR) {
+	    comm[1] = EOS
+	    return
+	}
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Extract the comment field.
+	for (ip=rp+IDB_ENDVALUE;  Memc[ip] != '/' && Memc[ip] != '\n';  ip=ip+1)
+	    ;
+	if (Memc[ip] == '/') {
+	    for (ip=ip+1;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    for (op=1;  Memc[ip] != '\n';  ip=ip+1) {
+		comm[op] = Memc[ip]
+		op = op + 1
+	    }
+	    comm[op] = EOS
+	} else
+	    comm[1] = EOS
+end
diff --git a/sys/imfort/db/imgetb.x b/sys/imfort/db/imgetb.x
new file mode 100644
index 00000000..aba16f97
--- /dev/null
+++ b/sys/imfort/db/imgetb.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"idb.h"
+
+# IMGETB -- Get an image header parameter of type boolean.  False is returned
+# if the parameter cannot be found or if the value is not true.
+
+bool procedure imgetb (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+pointer	rp
+pointer	idb_findrecord()
+
+begin
+	if (idb_findrecord (im, key, rp) == 0)
+	    return (false)
+	else
+	    return (Memc[rp+IDB_ENDVALUE-1] == 'T')
+end
diff --git a/sys/imfort/db/imgetc.x b/sys/imfort/db/imgetc.x
new file mode 100644
index 00000000..f56ecb9d
--- /dev/null
+++ b/sys/imfort/db/imgetc.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETC -- Get an image header parameter of type char.
+
+char procedure imgetc (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+long	imgetl()
+
+begin
+	return (imgetl (im, key))
+end
diff --git a/sys/imfort/db/imgetd.x b/sys/imfort/db/imgetd.x
new file mode 100644
index 00000000..01a71cb1
--- /dev/null
+++ b/sys/imfort/db/imgetd.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idb.h"
+
+# IMGETD -- Get an image header parameter of type double floating.  If the
+# named parameter is a standard parameter return the value directly,
+# else scan the user area for the named parameter and decode the value.
+
+double procedure imgetd (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+int	ip
+double	dval
+pointer	sp, sval
+int	ctod()
+errchk	syserrs, imgstr
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_LINE, TY_CHAR)
+
+	ip = 1
+	call imgstr (im, key, Memc[sval], SZ_LINE)
+	if (ctod (Memc[sval], ip, dval) == 0)
+	    call syserrs (SYS_IDBTYPE, key)
+
+	call sfree (sp)
+	return (dval)
+end
diff --git a/sys/imfort/db/imgeti.x b/sys/imfort/db/imgeti.x
new file mode 100644
index 00000000..8da2878e
--- /dev/null
+++ b/sys/imfort/db/imgeti.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETI -- Get an image header parameter of type integer.
+
+int procedure imgeti (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, imgetl()
+errchk	imgetl
+
+begin
+	lval = imgetl (im, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFI)
+	else
+	    return (lval)
+end
diff --git a/sys/imfort/db/imgetl.x b/sys/imfort/db/imgetl.x
new file mode 100644
index 00000000..817715c0
--- /dev/null
+++ b/sys/imfort/db/imgetl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETL -- Get an image header parameter of type long integer.
+
+long procedure imgetl (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, imgetd()
+errchk	imgetd
+
+begin
+	dval = imgetd (im, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFL)
+	else
+	    return (nint (dval))
+end
diff --git a/sys/imfort/db/imgetr.x b/sys/imfort/db/imgetr.x
new file mode 100644
index 00000000..b1c6c67a
--- /dev/null
+++ b/sys/imfort/db/imgetr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETR -- Get an image header parameter of type real.
+
+real procedure imgetr (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, imgetd()
+errchk	imgetd
+
+begin
+	dval = imgetd (im, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFR)
+	else
+	    return (dval)
+end
diff --git a/sys/imfort/db/imgets.x b/sys/imfort/db/imgets.x
new file mode 100644
index 00000000..39f2fcfd
--- /dev/null
+++ b/sys/imfort/db/imgets.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETS -- Get an image header parameter of type short integer.
+
+short procedure imgets (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, imgetl()
+errchk	imgetl
+
+begin
+	lval = imgetl (im, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFS)
+	else
+	    return (lval)
+end
diff --git a/sys/imfort/db/imgftype.x b/sys/imfort/db/imgftype.x
new file mode 100644
index 00000000..246219d5
--- /dev/null
+++ b/sys/imfort/db/imgftype.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"idb.h"
+
+# IMGFTYPE -- Get the datatype of a particular field of an image header.  Since
+# the internal format is FITS, there are four primary datatypes, boolean (T|F),
+# string (quoted), integer and real.
+
+int procedure imgftype (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+
+pointer	rp
+int	axis, ch, ip
+int	idb_findrecord(), idb_kwlookup(), idb_naxis()
+errchk	syserrs
+
+begin
+	# The standard header keywords "naxis1", "naxis2", etc. are treated
+	# as a special case.
+
+	if (idb_naxis (key, axis) == YES)
+	    return (TY_LONG)
+
+	# Handle the standard header keywords.
+
+	switch (idb_kwlookup (key)) {
+	case I_CTIME:
+	    return (TY_LONG)
+	case I_LIMTIME:
+	    return (TY_LONG)
+	case I_MAXPIXVAL:
+	    return (TY_REAL)
+	case I_MINPIXVAL:
+	    return (TY_REAL)
+	case I_MTIME:
+	    return (TY_LONG)
+	case I_NAXIS:
+	    return (TY_LONG)
+	case I_PIXFILE:
+	    return (TY_CHAR)
+	case I_PIXTYPE:
+	    return (TY_LONG)
+	case I_TITLE:
+	    return (TY_CHAR)
+	}
+
+	# If we get here then the named parameter is not a standard header
+	# keyword.
+
+	if (idb_findrecord (im, key, rp) > 0) {
+	    # Check for quoted string.
+	    ch = Memc[rp+IDB_STARTVALUE]
+	    if (ch == '\'')
+		return (TY_CHAR)
+
+	    # Check for boolean field.
+	    ch = Memc[rp+IDB_ENDVALUE-1]
+	    if (ch == 'T' || ch == 'F')
+		return (TY_BOOL)
+
+	    # If field contains only digits it must be an integer.
+	    for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+		ch = Memc[rp+ip-1]
+		if (! (IS_DIGIT(ch) || IS_WHITE(ch)))
+		    return (TY_REAL)
+	    }
+	    
+	    return (TY_INT)
+	}
+
+	call syserrs (SYS_IDBKEYNF, key)
+end
diff --git a/sys/imfort/db/imgnfn.x b/sys/imfort/db/imgnfn.x
new file mode 100644
index 00000000..88969645
--- /dev/null
+++ b/sys/imfort/db/imgnfn.x
@@ -0,0 +1,338 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	"../imfort.h"
+include	"idb.h"
+
+.help imgnfn
+.nf --------------------------------------------------------------------------
+IMGNFN -- Template expansion for header keywords.
+
+	list =	imofnl[su] (im, template)	# open list
+	nch =	    imgnfn (im, outstr, maxch)	# get next field name
+		    imcfnl (im)			# close list
+
+IMOFNLS opens the list sorted, whereas IMOFNLU opens it unsorted.  Both std.
+and user header keywords are included in the list.
+.endhelp ---------------------------------------------------------------------
+
+define	MAX_FIELDS	128
+define	SZ_SBUF		1024
+define	LEN_FNSTRUCT	(10+MAX_FIELDS)
+
+define	FN_NENTRIES	Memi[$1]	# number of field names in list
+define	FN_NEXT		Memi[$1+1]	# next string to be returned
+define	FN_SBUF		Memi[$1+2]	# pointer to string buffer
+			# open
+define	FN_STRP		Memi[$1+10+$2-1]	# array of str ptrs
+define	FN_FIELDNAME	Memc[FN_STRP($1,$2)]	# reference a string
+
+
+# IMGNFN -- Get the next header field name matching the given template from an
+# image header database.  Sorting of the field list is optional.  A prior call
+# to IMOFNL[SU] is necessary to open the sorted or unsorted list.
+
+int procedure imgnfn (fn, outstr, maxch)
+
+pointer	fn			# field name list descriptor
+char	outstr[ARB]		# output string
+int	maxch
+
+int	strnum
+int	gstrcpy()
+
+begin
+	strnum = FN_NEXT(fn)
+	if (strnum > FN_NENTRIES(fn))
+	    return (EOF)
+	FN_NEXT(fn) = strnum + 1
+
+	return (gstrcpy (FN_FIELDNAME(fn,strnum), outstr, maxch))
+end
+
+
+# IMOFNLS -- Open a sorted field name list.
+
+pointer procedure imofnls (im, template)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+pointer	imofnl()
+
+begin
+	return (imofnl (im, template, YES))
+end
+
+
+# IMOFNLU -- Open an unsorted field name list.
+
+pointer procedure imofnlu (im, template)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+pointer	imofnl()
+
+begin
+	return (imofnl (im, template, NO))
+end
+
+
+# IMCFNL -- Close the image header field name list and return all associated
+# storage.
+
+procedure imcfnl (fn)
+
+pointer	fn			# field name list descriptor
+
+begin
+	call mfree (FN_SBUF(fn), TY_CHAR)
+	call mfree (fn, TY_STRUCT)
+end
+
+
+# IMOFNL -- Open an image header field name list, either sorted or unsorted.
+# A template is a list of patterns delimited by commas.
+
+pointer procedure imofnl (im, template, sort)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+int	sort			# sort flag
+
+bool	escape
+int	tp, nstr, ch, junk, first_string, nstrings, nmatch, i
+pointer	sp, ip, op, fn, kwname, sbuf, pattern, patcode, nextch
+int	patmake(), patmatch(), strlen()
+errchk	syserr
+
+begin
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+	call salloc (pattern, SZ_FNAME, TY_CHAR)
+	call salloc (patcode, SZ_LINE,  TY_CHAR)
+
+	# Allocate field list descriptor.
+	call calloc (fn, LEN_FNSTRUCT, TY_STRUCT)
+	call malloc (sbuf, SZ_SBUF, TY_CHAR)
+
+	FN_SBUF(fn) = sbuf
+	nextch = sbuf
+	nstr = 0
+	tp = 1
+
+	# Extract each comma delimited template, expand upon image header
+	# field list, sort if desired, and add strings to list.
+
+	while (template[tp] != EOS && template[tp] != '\n') {
+	    # Advance to next field.
+	    while (IS_WHITE(template[tp]) || template[tp] == ',')
+		tp = tp + 1
+
+	    # Extract pattern.  Enclose pattern in ^{} so that the match will
+	    # occur only at the beginning of each line and will be case
+	    # insensitive (req'd for FITS format).
+
+	    op = pattern
+	    Memc[op] = '^'
+	    op = op + 1
+	    Memc[op] = '{'
+	    op = op + 1
+
+	    # A field name of the form "$", "$x", etc. is not matched against
+	    # the actual image field list, but is included in the output field
+	    # list as a literal.
+
+	    ch = template[tp]
+	    escape = (ch == '$')
+
+	    while (! (IS_WHITE(ch) || ch == '\n' || ch == ',' || ch == EOS)) {
+		# Map "*" into "?*".
+		if (ch == '*') {
+		    Memc[op] = '?'
+		    op = op + 1
+		}
+
+		Memc[op] = ch
+		op = op + 1
+		tp = tp + 1
+		ch = template[tp]
+	    }
+
+	    Memc[op] = '}'
+	    op = op + 1
+	    Memc[op] = EOS
+
+	    # If the pattern is a literal, put it in the output list without
+	    # matching it against the image field list.
+
+	    if (escape) {
+		# Omit the leading "^{" and the trailing "}".
+		ip = pattern + 2
+		op = op - 1
+		Memc[op] = EOS
+		call imfn_putkey (Memc[ip], FN_STRP(fn,1), nstr, nextch, sbuf)
+
+	    } else {
+		# Encode pattern.
+		junk = patmake (Memc[pattern], Memc[patcode], SZ_LINE)
+
+		# Scan database and extract all field names matching the
+		# pattern.  Mark number of first string for the sort.
+
+		first_string = nstr + 1
+
+		# First find any standard header keywords matching the pattern.
+		call imfn_stdkeys (im, Memc[patcode], FN_STRP(fn,1), nstr,
+		    nextch, sbuf)
+
+		# Now scan the user area.
+		for (ip=IM_USERAREA(im);  Memc[ip] != EOS;  ip=ip+1) {
+		    # Skip entries that are not keywords.
+		    if (Memc[ip+8] != '=')
+			next
+
+		    # Extract keyword name.
+		    Memc[kwname+8] = EOS
+		    do i = 1, 8 {
+			ch = Memc[ip+i-1]
+			if (ch == ' ') {
+			    Memc[kwname+i-1] = EOS
+			    break
+			} else
+			    Memc[kwname+i-1] = ch
+		    }
+
+		    # Check for a match.
+		    if (Memc[kwname] != EOS) {
+			# Put key in list if it matches.
+			nmatch = patmatch (Memc[kwname], Memc[patcode]) - 1
+			if (nmatch > 0 && nmatch == strlen(Memc[kwname]))
+			    call imfn_putkey (Memc[ip],
+				FN_STRP(fn,1), nstr, nextch, sbuf)
+		    }
+
+		    # Advance to the next record.
+		    if (IM_UABLOCKED(im) == YES)
+			ip = ip + IDB_RECLEN
+		    else {
+			while (Memc[ip] != '\n' && Memc[ip] != EOS)
+			    ip = ip + 1
+		    }
+
+		    if (Memc[ip] == EOS)
+			break
+		}
+
+		# Sort the newly added keywords.
+		nstrings = nstr - first_string + 1
+		if (sort == YES && nstrings > 1)
+		    call strsrt (FN_STRP(fn,first_string), Memc, nstrings)
+	    }
+	}
+
+	FN_NENTRIES(fn) = nstr
+	FN_NEXT(fn)     = 1
+
+	call sfree (sp)
+	return (fn)
+end
+
+
+# IMFN_STDKEYS -- Match a pattern (encoded) against the list of standard header
+# keywords, both with and without the "i_" prefix.  Add the full name (with i_
+# prefix) of each name matched to the keyword list.  Note that by default,
+# only the "user" keywords are matched in this way, although any keyword can
+# be accessed if its name is known (i.e., not all keywords are visible).
+
+procedure imfn_stdkeys (im, patcode, strp, nstr, nextch, sbuf)
+
+pointer	im			# image descriptor
+char	patcode[ARB]		# encoded pattern
+pointer	strp[ARB]		# array of string pointers
+int	nstr			# current number of strings
+pointer	nextch			# next available char in string buffer
+pointer	sbuf			# string buffer
+
+bool	validfield
+int	ip, index
+pointer	sp, op, key
+int	patmatch()
+errchk	imfn_putkey
+
+# NOTE index values below depend upon position in this string.
+string	keywords "|naxis|naxis1|naxis2|naxis3|pixtype|datamin|datamax|\
+ctime|mtime|limtime|title|"
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	call strcpy ("i_", Memc[key], SZ_FNAME)
+	index = 1
+
+	for (ip=2;  keywords[ip] != EOS;  ip=ip+1) {
+	    # Do not put dimensions NAXIS1, NAXIS2, etc. higher than the
+	    # actual image dimension into the matched list.
+
+	    validfield = true
+	    if (index >= 2 && index <= 4)
+		validfield = (index - 1 <= IM_NDIM(im))
+
+	    # Extract keyword into buffer, after the "i_".
+	    for (op=key+2;  keywords[ip] != '|';  op=op+1) {
+		Memc[op] = keywords[ip]
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+
+	    if (validfield)
+		if (patmatch (Memc[key],   patcode) > 0 ||
+		    patmatch (Memc[key+2], patcode) > 0) {
+
+		    call imfn_putkey (Memc[key], strp, nstr, nextch, sbuf)
+		}
+
+	    index = index + 1
+	}
+
+	call sfree (sp)
+end
+
+
+# IMFN_PUTKEY -- Put a keyword into the keyword list.
+
+procedure imfn_putkey (key, strp, nstr, nextch, sbuf)
+
+char	key[ARB]		# keyword name (etc.)
+pointer	strp[ARB]		# array of string pointers
+int	nstr			# current number of strings
+pointer	nextch			# next available char in string buffer
+pointer	sbuf			# string buffer
+
+int	ch, ip
+errchk	syserr
+
+begin
+	# Append keyword to the string buffer.
+	nstr = nstr + 1
+	if (nstr > MAX_FIELDS)
+	    call syserr (SYS_IMFNOVFL)
+	strp[nstr] = nextch
+
+	ip = 1
+	ch = key[ip]
+
+	while (ch != '=' && ch != ' ' && ch != EOS) {
+	    Memc[nextch] = ch
+	    nextch = nextch + 1
+	    if (nextch >= sbuf + SZ_SBUF)
+		call syserr (SYS_IMFNOVFL)
+	    ip = ip + 1
+	    ch = key[ip]
+	}
+
+	Memc[nextch] = EOS
+	nextch = nextch + 1
+end
diff --git a/sys/imfort/db/imgstr.x b/sys/imfort/db/imgstr.x
new file mode 100644
index 00000000..bf3272a5
--- /dev/null
+++ b/sys/imfort/db/imgstr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"idb.h"
+
+# IMGSTR -- Get an image header parameter of type string.  If the named
+# parameter is a standard parameter return the value directly, else scan
+# the user area for the named parameter and decode the value.
+
+procedure imgstr (im, key, outstr, maxch)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+pointer	rp
+int	ip, op
+int	idb_getstring(), idb_findrecord(), ctowrd(), strlen()
+errchk	syserrs
+
+begin
+	# Check for a standard header parameter first.
+	if (idb_getstring (im, key, outstr, maxch) != ERR)
+	    return
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	ip = IDB_STARTVALUE
+	if (ctowrd (Memc[rp], ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
diff --git a/sys/imfort/db/impstr.x b/sys/imfort/db/impstr.x
new file mode 100644
index 00000000..fba9f8af
--- /dev/null
+++ b/sys/imfort/db/impstr.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idb.h"
+
+# IMPSTR -- Put an image header parameter of type string.  If the named
+# parameter is a standard parameter of type other than string, decode the
+# string and set the binary value of the parameter.  If the parameter is
+# a nonstandard one we can do a simple string edit, since user parameters
+# are stored in the user area in string form.  The datatype of the parameter
+# must be preserved by the edit, i.e., parameters of actual datatype string
+# must be quoted and left justified and other parameters must be unquoted
+# and right justified in the value field.
+
+procedure impstr (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+char	value[ARB]		# new parameter value
+
+pointer	rp, ip, vp
+int	ncols, n, i
+bool	string_valued
+int	idb_putstring(), idb_findrecord(), strlen()
+errchk	syserrs
+
+begin
+	# Check for a standard header parameter first.
+	if (idb_putstring (im, key, value) != ERR)
+	    return
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.
+
+	string_valued = false
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1)
+	    if (Memc[rp+ip-1] == '\'') {
+		string_valued = true
+		break
+	    }
+
+	vp = rp + IDB_STARTVALUE - 1
+	n  = strlen (value)
+
+	# If we have a long string value, give it the whole card.
+	ncols = IDB_ENDVALUE - IDB_STARTVALUE + 1
+	if (string_valued && n > 21 - 3)
+	    ncols = IDB_RECLEN - IDB_STARTVALUE + 1
+
+	# Blank fill the value field.
+	do i = 1, ncols
+	    Memc[vp+i-1] = ' '
+
+	# Encode the new value of the parameter in a field of width 21
+	# (or larger in the case of long string values) including a leading
+	# blank and the quotes if string valued.
+
+	if (string_valued) {
+	    n = min (ncols - 3, n)
+	    Memc[vp+2-1] = '\''
+	    call amovc (value, Memc[vp+3-1], n)
+	    Memc[vp+ncols-1] = '\''
+	} else {
+	    n = min (ncols - 1, n)
+	    call amovc (value, Memc[vp+ncols-1-n+1], n)
+	}
+end
diff --git a/sys/imfort/db/imputb.x b/sys/imfort/db/imputb.x
new file mode 100644
index 00000000..a211f464
--- /dev/null
+++ b/sys/imfort/db/imputb.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTB -- Put an image header parameter of type boolean.
+
+procedure imputb (im, key, bval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+bool	bval			# parameter value
+char	sval[2]
+
+begin
+	if (bval)
+	    sval[1] = 'T'
+	else
+	    sval[1] = 'F'
+	sval[2] = EOS
+
+	call impstr (im, key, sval)
+end
diff --git a/sys/imfort/db/imputd.x b/sys/imfort/db/imputd.x
new file mode 100644
index 00000000..fc633c23
--- /dev/null
+++ b/sys/imfort/db/imputd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPUTD -- Put an image header parameter of type double.
+
+procedure imputd (im, key, dval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+double	dval			# double precision value
+
+int	junk, i
+pointer	sp, sval
+int	dtoc(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+        # Reduce the precision of the encoded value if necessary to fit in
+        # the FITS value field.  Start with NDIGITS_DP-1 as the precision
+        # estimate NDIGITS_DP is only approximate, and if we make up half a
+        # digit of precision the result can be 1.00000000000000001 instead
+        # of 1.0.
+
+        for (i=NDIGITS_DP-1;  i >= NDIGITS_RP;  i=i-1) {
+	    junk = dtoc (dval, Memc[sval], SZ_FNAME, i, 'g', SZ_FNAME)
+            if (strlen (Memc[sval]) < 20)
+                break
+        }
+
+	# Write the new value to the header.
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/db/imputi.x b/sys/imfort/db/imputi.x
new file mode 100644
index 00000000..a4ccdd31
--- /dev/null
+++ b/sys/imfort/db/imputi.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTI -- Put an image header parameter of type integer.
+
+procedure imputi (im, key, ival)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+int	ival			# parameter value
+long	lval
+
+begin
+	if (IS_INDEFI (ival))
+	    lval = INDEFL
+	else
+	    lval = ival
+	call imputl (im, key, lval)
+end
diff --git a/sys/imfort/db/imputl.x b/sys/imfort/db/imputl.x
new file mode 100644
index 00000000..3af988a9
--- /dev/null
+++ b/sys/imfort/db/imputl.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTL -- Put an image header parameter of type long integer.
+
+procedure imputl (im, key, lval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+long	lval			# parameter value
+
+int	junk
+pointer	sp, sval
+int	ltoc()
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	junk = ltoc (lval, Memc[sval], SZ_FNAME)
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/db/imputr.x b/sys/imfort/db/imputr.x
new file mode 100644
index 00000000..27668a62
--- /dev/null
+++ b/sys/imfort/db/imputr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTR -- Put an image header parameter of type real.
+
+procedure imputr (im, key, rval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+real	rval			# parameter value
+double	dval
+
+begin
+	if (IS_INDEFR (rval))
+	    dval = INDEFD
+	else
+	    dval = rval
+	call imputd (im, key, dval)
+end
diff --git a/sys/imfort/db/imputs.x b/sys/imfort/db/imputs.x
new file mode 100644
index 00000000..6b0f763f
--- /dev/null
+++ b/sys/imfort/db/imputs.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTS -- Put an image header parameter of type short integer.
+
+procedure imputs (im, key, sval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+short	sval			# parameter value
+long	lval
+
+begin
+	if (IS_INDEFS (sval))
+	    lval = INDEFL
+	else
+	    lval = sval
+	call imputl (im, key, lval)
+end
diff --git a/sys/imfort/db/mkpkg b/sys/imfort/db/mkpkg
new file mode 100644
index 00000000..4ce6acd4
--- /dev/null
+++ b/sys/imfort/db/mkpkg
@@ -0,0 +1,42 @@
+# Update the IMFORT image header database interface.
+
+$checkout libimfort.a lib$
+$update   libimfort.a
+$checkin  libimfort.a lib$
+$exit
+
+libimfort.a:
+	idbfind.x	../imfort.h idb.h <imhdr.h>
+	idbgstr.x	idb.h <ctype.h> <imhdr.h>
+	idbkwlu.x	idb.h <ctype.h> <imhdr.h>
+	idbnaxis.x	<ctype.h>
+	idbpstr.x	idb.h <ctype.h> <imhdr.h> <mach.h>
+	imaccf.x	
+	imaddb.x	
+	imaddd.x	
+	imaddf.x	../imfort.h idb.h <imhdr.h>
+	imaddi.x	
+	imaddl.x	
+	imaddr.x	
+	imadds.x	
+	imastr.x	
+	imdelf.x	idb.h <imhdr.h>
+	imgatr.x	idb.h <ctype.h>
+	imgetb.x	idb.h
+	imgetc.x	
+	imgetd.x	idb.h
+	imgeti.x	
+	imgetl.x	
+	imgetr.x	
+	imgets.x	
+	imgftype.x	idb.h <ctype.h>
+	imgnfn.x	../imfort.h idb.h <ctype.h> <imhdr.h>
+	imgstr.x	idb.h <ctype.h>
+	impstr.x	idb.h
+	imputb.x	
+	imputd.x	<mach.h>
+	imputi.x	
+	imputl.x	
+	imputr.x	
+	imputs.x	
+	;
diff --git a/sys/imfort/doc/TODO b/sys/imfort/doc/TODO
new file mode 100644
index 00000000..662fc249
--- /dev/null
+++ b/sys/imfort/doc/TODO
@@ -0,0 +1,3 @@
+IMFORT docs updates needed:
+
+    o	Add description of IM[SG]DIR, 'imdir' semantics.  (6/1/89)
diff --git a/sys/imfort/doc/bfaloc.hlp b/sys/imfort/doc/bfaloc.hlp
new file mode 100644
index 00000000..470042bc
--- /dev/null
+++ b/sys/imfort/doc/bfaloc.hlp
@@ -0,0 +1,32 @@
+.help bfaloc Sep86 imfort.bfio
+.ih
+NAME
+bfaloc -- create and preallocate storage for a binary file
+.ih
+SYNOPSIS
+.nf
+subroutine bfaloc (fname, nchars, status)
+
+character*(*)	fname		#I host name of new file
+integer		nchars		#I size of file in "chars"
+integer		status		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIbfaloc\fR procedure creates a new file \fIfname\fR and preallocates
+space for at least \fInchars\fR SPP char units of storage.  The contents of
+the file are unitialized.
+.ih
+RETURN VALUE
+A negative status value indicates either that the file could not be created
+(e.g., due to insufficient permission), or that the requested amount of space
+could not be allocated.  A positive or zero status indicates that the operation
+succeeded.
+.ih
+NOTES
+On some systems, storage may not physically be allocated until the file is
+written into.
+.ih
+SEE ALSO
+bfopen
+.endhelp
diff --git a/sys/imfort/doc/bfbsiz.hlp b/sys/imfort/doc/bfbsiz.hlp
new file mode 100644
index 00000000..aeea7912
--- /dev/null
+++ b/sys/imfort/doc/bfbsiz.hlp
@@ -0,0 +1,22 @@
+.help bfbsiz Sep86 imfort.bfio
+.ih
+NAME
+bfbsiz -- get the buffer size in chars of a binary file
+.ih
+SYNOPSIS
+.nf
+integer function bfbsiz (fd)
+
+integer		fd		#I BFIO file descriptor of open file
+.fi
+.ih
+DESCRIPTION
+The \fIbfbsiz\fR function is used to query the size in SPP char units of
+storage of the internal BFIO file buffer.
+.ih
+RETURN VALUE
+The size of the BFIO file buffer in chars is returned as the function value.
+.ih
+SEE ALSO
+bffsiz, bfchan
+.endhelp
diff --git a/sys/imfort/doc/bfchan.hlp b/sys/imfort/doc/bfchan.hlp
new file mode 100644
index 00000000..9641b971
--- /dev/null
+++ b/sys/imfort/doc/bfchan.hlp
@@ -0,0 +1,27 @@
+.help bfchan Sep86 imfort.bfio
+.ih
+NAME
+bfchan -- return the kernel i/o channel of an open BFIO file
+.ih
+SYNOPSIS
+.nf
+integer function bfchan (fd)
+
+integer		fd		#I BFIO file descriptor of open file
+.fi
+.ih
+DESCRIPTION
+The \fIbfchan\fR procedure is used to get the i/o channel assigned to the
+file at open time by the binary file driver in the IRAF kernel.
+This may be used as input to the \fIzfiobf\fR binary file driver primitives
+if the lowest possible level of binary file i/o is desired (short of talking
+directly to the host system).  The \fIzfiobf\fR procedures provide a direct
+(unbuffered), block oriented, asynchronous binary file i/o interface.
+.ih
+RETURN VALUE
+The i/o channel assigned to the file by the \fIzfiobf\fR binary file driver
+at open time is returned as the function value.
+.ih
+SEE ALSO
+The manual pages for the binary file driver.
+.endhelp
diff --git a/sys/imfort/doc/bfclos.hlp b/sys/imfort/doc/bfclos.hlp
new file mode 100644
index 00000000..83b8e856
--- /dev/null
+++ b/sys/imfort/doc/bfclos.hlp
@@ -0,0 +1,27 @@
+.help bfclos Sep86 imfort.bfio
+.ih
+NAME
+bfclos -- close a file opened for binary file i/o
+.ih
+SYNOPSIS
+.nf
+subroutine bfclos (fd, status)
+
+integer		fd		#I BFIO file descriptor of open file
+integer		status		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIbfclos\fR procedure closes a file previously opened with \fIbfopen\fR,
+freeing the file descriptor and any other system resources associated with the
+file descriptor.  The output buffer is automatically flushed before the file
+is closed.
+.ih
+RETURN VALUE
+A negative status indicates failure, e.g., either a write error occurred
+when the output buffer was flushed, or the file descriptor \fIfd\fR was
+invalid.
+.ih
+SEE ALSO
+bfopen
+.endhelp
diff --git a/sys/imfort/doc/bfflsh.hlp b/sys/imfort/doc/bfflsh.hlp
new file mode 100644
index 00000000..3dc676a0
--- /dev/null
+++ b/sys/imfort/doc/bfflsh.hlp
@@ -0,0 +1,26 @@
+.help bfflsh Sep86 imfort.bfio
+.ih
+NAME
+bfflsh -- flush any buffered output data to disk
+.ih
+SYNOPSIS
+.nf
+integer function bfflsh (fd)
+
+integer		fd		#I BFIO file descriptor of open file
+.fi
+.ih
+DESCRIPTION
+The \fIbfflsh\fR procedure flushes any buffered output data to a binary
+file opened for read-write access.
+.ih
+RETURN VALUE
+A negative status indicates failure, e.g., a write error on the file.
+.ih
+NOTES
+If the buffer has already been flushed or the file was opened for read-only
+access, \fIbfflsh\fR is a no-op.
+.ih
+SEE ALSO
+bfwrit
+.endhelp
diff --git a/sys/imfort/doc/bffsiz.hlp b/sys/imfort/doc/bffsiz.hlp
new file mode 100644
index 00000000..4385b270
--- /dev/null
+++ b/sys/imfort/doc/bffsiz.hlp
@@ -0,0 +1,24 @@
+.help bffsiz Sep86 imfort.bfio
+.ih
+NAME
+bffsiz -- get the size in chars of a binary file
+.ih
+SYNOPSIS
+.nf
+integer function bffsiz (fd)
+
+integer		fd		#I BFIO file descriptor of open file
+.fi
+.ih
+DESCRIPTION
+The \fIbffsiz\fR function is used to query the size in SPP char units of
+storage of a binary file previously opened with \fIbfopen\fR.  This is useful,
+for example, when writing at the end of file, since the BFIO write function
+requires an absolute file offset as input.
+.ih
+RETURN VALUE
+The current size of the file in chars is returned as the function value.
+.ih
+SEE ALSO
+bfbsiz, bfchan
+.endhelp
diff --git a/sys/imfort/doc/bfopen.hlp b/sys/imfort/doc/bfopen.hlp
new file mode 100644
index 00000000..a345d4fa
--- /dev/null
+++ b/sys/imfort/doc/bfopen.hlp
@@ -0,0 +1,32 @@
+.help bfopen Sep86 imfort.bfio
+.ih
+NAME
+bfopen -- open a file for binary file i/o
+.ih
+SYNOPSIS
+.nf
+integer function bfopen (fname, acmode, advice)
+
+character*(*)	fname		#I host name of file to be opened
+integer		acmode		#I file access mode (1=RO,3=RW,5=NF)
+integer		advice		#I type of access (1=random,2=seq.)
+.fi
+.ih
+DESCRIPTION
+The \fIbfopen\fR procedure either opens an existing file for binary
+file i/o (\fIacmode\fR 1=read-only or 3=read-write), or creates a new,
+zero length file and opens it for binary file i/o with read-write
+access mode (\fIacmode\fR 5=new-file).  The \fIadvice\fR parameter
+controls the size of the internal file buffer allocated at open time.
+The possible values are 1 (random access, small buffer), or 2 (sequential
+access, large buffer); anything larger is taken to be the actual size
+of the buffer.  Note that the size of the buffer must be an integral
+multiple of the size of a disk block.
+.ih
+RETURN VALUE
+The BFIO file descriptor (\fIfd\fR) is returned as the function value if
+the file is successfully opened, otherwise a negative value is returned.
+.ih
+SEE ALSO
+bfaloc, bfclos
+.endhelp
diff --git a/sys/imfort/doc/bfread.hlp b/sys/imfort/doc/bfread.hlp
new file mode 100644
index 00000000..2345dfa3
--- /dev/null
+++ b/sys/imfort/doc/bfread.hlp
@@ -0,0 +1,31 @@
+.help bfread Sep86 imfort.bfio
+.ih
+NAME
+bfread -- read from a binary file at the specified offset
+.ih
+SYNOPSIS
+.nf
+integer function bfread (fd, buf, nchars, offset)
+
+integer		fd		#I BFIO file descriptor of open file
+typeless	buf(*)		#O buffer to receive file data
+integer		nchars		#I number of SPP chars to read
+integer		offset		#I 1-indexed char offset into file
+.fi
+.ih
+DESCRIPTION
+The \fIbfread\fR procedure reads \fInchars\fR char units of storage from
+the file opened on file descriptor \fIfd\fR starting at the one-indexed
+char file offset \fIoffset\fR.  Any number of chars may be read starting
+at any char file offset.
+.ih
+RETURN VALUE
+The actual number of char units of storage read is returned as the function
+value; a read at end of file results in zero chars being read.  A negative
+function value indicates that the read failed for some reason, e.g., the
+file descriptor was invalid, the file offset was out of range, or an actual
+physical read error occurred.
+.ih
+SEE ALSO
+bfwrit
+.endhelp
diff --git a/sys/imfort/doc/bfwrit.hlp b/sys/imfort/doc/bfwrit.hlp
new file mode 100644
index 00000000..510ad92f
--- /dev/null
+++ b/sys/imfort/doc/bfwrit.hlp
@@ -0,0 +1,38 @@
+.help bfwrit Sep86 imfort.bfio
+.ih
+NAME
+bfwrit -- write to a binary file at the specified offset
+.ih
+SYNOPSIS
+.nf
+integer function bfwrit (fd, buf, nchars, offset)
+
+integer		fd		#I BFIO file descriptor of open file
+typeless	buf(*)		#I buffer containing file data
+integer		nchars		#I number of SPP chars to be written
+integer		offset		#I 1-indexed char offset into file
+
+.fi
+.ih
+DESCRIPTION
+The \fIbfwrit\fR procedure writes \fInchars\fR char units of storage from
+the user supplied buffer to the file opened on file descriptor \fIfd\fR
+starting at the one-indexed char file offset \fIoffset\fR.  Any number of
+chars may be written starting at any char file offset.
+.ih
+RETURN VALUE
+The actual number of char units of storage written is returned as the function
+value; it is probably an error if this is not equal to \fInchars\fR.
+A negative function value indicates that the write failed for some reason,
+e.g., the file descriptor was invalid, the file offset was out of range,
+or an actual physical write error occurred.
+.ih
+NOTES
+The entire contents of the internal BFIO file buffer are always written,
+even when writing at the end of file, hence it is not possible to write
+odd-sized files with the BFIO interface (partial blocks can however be
+read with \fIbfread\fR).
+.ih
+SEE ALSO
+bfread
+.endhelp
diff --git a/sys/imfort/doc/clarg.hlp b/sys/imfort/doc/clarg.hlp
new file mode 100644
index 00000000..c924ebc7
--- /dev/null
+++ b/sys/imfort/doc/clarg.hlp
@@ -0,0 +1,42 @@
+.help clarg Sep86 imfort
+.ih
+NAME
+clarg -- fetch and decode the value of a command line argument
+.ih
+SYNOPSIS
+.nf
+subroutine clargc (argno, cval, ier)
+subroutine clargi (argno, ival, ier)
+subroutine clargr (argno, rval, ier)
+subroutine clargd (argno, dval, ier)
+
+integer		argno		#I index of argument to be decoded
+integer		ier		#O status return
+
+character*(*)	cval		#O string value of argument
+integer		ival		#O integer value of argument
+real		rval		#O real value of argument
+doubleprecision	dval		#O double value of argument
+.fi
+.ih
+DESCRIPTION
+The four \fIclarg\fR procedures are used to fetch and decode the value of
+the indexed command line argument; the first argument is number one.
+Any argument may be returned as a string with \fIclargc\fR.
+Numeric arguments are decoded using the IRAF formatted i/o primitives,
+hence octal constants (`B' suffix), hex constants (`X' suffix),
+and sexagesimal numbers are all legal as input.
+.ih
+RETURN VALUE
+A status of zero indicates that the indexed argument was present on the
+command line and could be decoded in the manner specified.
+
+.nf
+IE_GCMDLN:	cannot read command line string
+IE_NEXARG:	nonexistent command line argument referenced
+IE_NONNUMARG:	command line argument cannot be decoded as a number
+.fi
+.ih
+SEE ALSO
+clnarg, clrawc
+.endhelp
diff --git a/sys/imfort/doc/clnarg.hlp b/sys/imfort/doc/clnarg.hlp
new file mode 100644
index 00000000..c7321931
--- /dev/null
+++ b/sys/imfort/doc/clnarg.hlp
@@ -0,0 +1,24 @@
+.help clnarg Sep86 imfort
+.ih
+NAME
+clnarg -- get the number of arguments on the command line
+.ih
+SYNOPSIS
+.nf
+subroutine clnarg (nargs)
+
+integer		nargs		#O the number of arguments
+.fi
+.ih
+DESCRIPTION
+The \fIclnarg\fR subroutine returns the number of whitespace delimited
+(or quoted) arguments given on the command line when the calling program
+was invoked.
+.ih
+RETURN VALUE
+The number of arguments, or zero if there were no arguments or if the
+command line cannot be accessed for some reason (there is no error return).
+.ih
+SEE ALSO
+clarg, clrawc
+.endhelp
diff --git a/sys/imfort/doc/clrawc.hlp b/sys/imfort/doc/clrawc.hlp
new file mode 100644
index 00000000..09b2891d
--- /dev/null
+++ b/sys/imfort/doc/clrawc.hlp
@@ -0,0 +1,35 @@
+.help clrawc Sep86 imfort
+.ih
+NAME
+clrawc -- return the raw command line as a string
+.ih
+SYNOPSIS
+.nf
+subroutine clrawc (outstr, ier)
+
+character*(*)	outstr		#O receives the command line string
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIclrawc\fR procedure returns the raw command line as a string,
+i.e., all the argument strings are concatenated together with spaces
+between successive arguments.
+.ih
+RETURN VALUE
+A status of zero indicates that the task was called with a nonnull command
+string.  An error status indicates that the program was called without any
+arguments.
+
+IE_GCMDLN:	cannot read command line string
+.ih
+NOTES
+Normally it is preferable to use the \fIclarg\fR procedures to decode
+and return the values of the individual arguments.  Note that decoding
+the argument list with a list-directed read against \fIoutstr\fR is in
+violation of the Fortran 77 standard, and probably would not work anyhow,
+since the string arguments are not quoted.
+.ih
+SEE ALSO
+clnarg, clarg
+.endhelp
diff --git a/sys/imfort/doc/imacck.hlp b/sys/imfort/doc/imacck.hlp
new file mode 100644
index 00000000..75e922c9
--- /dev/null
+++ b/sys/imfort/doc/imacck.hlp
@@ -0,0 +1,27 @@
+.help imacck Sep86 imfort
+.ih
+NAME
+imacck -- determine if the named header keyword exists
+.ih
+SYNOPSIS
+.nf
+subroutine imacck (im, keyw, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of keyword to be accessed
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimacck\fR procedure is used to test if the named header keyword
+can be accessed, i.e., if it exists.
+.ih
+RETURN VALUE
+A zero status return indicates that the header does indeed have such a
+keyword.
+
+IE_NEXKW:	nonexistent header keyword referenced
+.ih
+SEE ALSO
+imtypek, imaddk, imokwl
+.endhelp
diff --git a/sys/imfort/doc/imaddk.hlp b/sys/imfort/doc/imaddk.hlp
new file mode 100644
index 00000000..e796d168
--- /dev/null
+++ b/sys/imfort/doc/imaddk.hlp
@@ -0,0 +1,55 @@
+.help imaddk Sep86 imfort
+.ih
+NAME
+imaddk -- add a new keyword to an image header
+.ih
+SYNOPSIS
+.nf
+subroutine imaddk (im, keyw, dtype, comm, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of the new keyword
+integer		dtype		#I keyword datatype code
+character*(*)	comm		#I comment string describing keyword
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimaddk\fR procedure is used to add a new keyword to the header of
+an existing, open image.  The datatype of the new keyword must be specified
+at creation time; the possible datatype codes for header keywords are given
+in the following table.
+
+.nf
+	1	boolean (logical)
+	2	character string
+	3,4,5	short integer, don't-care integer, long integer
+	6,7	real or double precision floating
+.fi
+
+A comment string may optionally be given to describ the keyword, i.e.,
+its function or purpose.  The comment string is printed in image header
+listings and is propagated onto FITS tapes.
+.ih
+RETURN VALUE
+A zero status is returned if there is space for the new keyword, and the
+keyword does not redefine an existing keyword.
+
+.nf
+SYS_IDBREDEF:	attempt to redefine an image header keyword
+SYS_IDBOVFL:	out of space in image header
+.fi
+.ih
+NOTES
+The precision of a keyword name is currently limited to eight characters
+(longer keyword names will be silently truncated), and all user defined
+keyword names are rendered into upper case.  This is necessary to permit
+use of the FITS image format to transport images.
+An alternative to the relatively low level \fIimaddk\fR procedure is provided
+by the \fIimakw\fR procedures, which will not add a new keyword if the named
+keyword already exists, which also set the value of the new keyword, and which
+avoid the need to use a datatype code.
+.ih
+SEE ALSO
+imdelk, imacck, imakw
+.endhelp
diff --git a/sys/imfort/doc/imakw.hlp b/sys/imfort/doc/imakw.hlp
new file mode 100644
index 00000000..cd447806
--- /dev/null
+++ b/sys/imfort/doc/imakw.hlp
@@ -0,0 +1,50 @@
+.help imakw Sep86 imfort
+.ih
+NAME
+imakw -- add or set the value of an image header keyword
+.ih
+SYNOPSIS
+.nf
+subroutine imakwb (im, keyw, bval, comm, ier)
+subroutine imakwc (im, keyw, cval, comm, ier)
+subroutine imakwi (im, keyw, ival, comm, ier)
+subroutine imakwr (im, keyw, rval, comm, ier)
+subroutine imakwd (im, keyw, dval, comm, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of the keyword to be set
+character*(*)	comm		#I comment string describing keyword
+integer		ier		#O status return
+
+logical		bval		#I logical (boolean) keyword value
+character*(*)	cval		#I character string keyword value
+integer		ival		#I integer keyword value
+real		rval		#I real keyword value
+doubleprecision	dval		#I double precision keyword value
+.fi
+.ih
+DESCRIPTION
+The \fIimakw\fR procedures are used to set the values of image header keywords.
+If the named keyword does not already exist, a new keyword of the indicated
+datatype is first added and then the value of the new keyword is set,
+otherwise the value of the existing keyword is updated.
+The comment string is used only if a new keyword is created.
+Automatic datatype conversion is provided when updating the value of
+an existing keyword, i.e., if the keyword already exists there is some
+flexibility in the choice of the datatype of the \fIimakw\fR procedure
+to be used.
+.ih
+RETURN VALUE
+A zero status is returned if the named keyword exists, is writable, and if
+the datatype coercion implied is permissible, or if the named keyword is
+not found but can be added.
+
+.nf
+SYS_IDBOVFL:	out of space in image header
+SYS_IDBREDEF:	attempt to redefine an image header keyword
+SYS_IDBTYPE:	illegal header parameter data type conversion
+.fi
+.ih
+SEE ALSO
+imaddk, imacck, impkw, imgkw
+.endhelp
diff --git a/sys/imfort/doc/imclos.hlp b/sys/imfort/doc/imclos.hlp
new file mode 100644
index 00000000..c771a961
--- /dev/null
+++ b/sys/imfort/doc/imclos.hlp
@@ -0,0 +1,39 @@
+.help imclos Sep86 imfort
+.ih
+NAME
+imclos -- close an image
+.ih
+SYNOPSIS
+.nf
+subroutine imclos (im, ier)
+
+integer		im		#I image descriptor of open image
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+An image opened with \fIimopen\fR or \fIimopnc\fR should be closed with
+\fIimclos\fR when the image operation is complete.  The close operation
+flushes any buffered output pixel data, updates the header if necessary,
+closes the header and pixel files, and frees any system resources
+associated with the image descriptor.
+.ih
+RETURN VALUE
+A zero status is returned if the image descriptor is valid and the header
+and pixel files could be updated and closed without any errors.
+
+.nf
+IE_CLSHDR:	error closing image header file
+IE_CLSPIX:	error closing image pixel file
+IE_UPDHDR:	error updating image header file
+IE_UPDRO:	image header modified but image was opened read only
+.fi
+.ih
+NOTES
+If an image is erroneously opened read-only by a program which updates the
+image header, no error condition will occur until the image is closed,
+hence the \fIimclos\fR status return should always be checked.
+.ih
+SEE ALSO
+imopen, imopnc
+.endhelp
diff --git a/sys/imfort/doc/imcrea.hlp b/sys/imfort/doc/imcrea.hlp
new file mode 100644
index 00000000..9b7381f7
--- /dev/null
+++ b/sys/imfort/doc/imcrea.hlp
@@ -0,0 +1,55 @@
+.help imcrea Nov86 imfort
+.ih
+NAME
+imcrea -- create a new image
+.ih
+SYNOPSIS
+.nf
+subroutine imcrea (image, axlen, naxis, dtype, ier)
+
+character*(*)	image		#I host name of the new image
+integer		axlen(7)	#I length of each axis
+integer		naxis		#I number of axes
+integer		dtype		#I pixel datatype
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimcrea\fR procedure is used to create a new image from scratch,
+using only the information passed via the command line arguments.
+The image name \fIimname\fR is the host system filename of the new image,
+although the extension (".imh") may be omitted if desired.  The dimensionality
+of the new image is given by \fInaxis\fR, and the length in pixels of each
+axis is given by the first few elements of the array \fIaxlen\fR.
+In the current implementation of IMFORT the dimensionality of an image
+should not exceed three.  There are no restrictions on the size of an image.
+
+The datatype to be used to store the pixels in the new image is given by
+the integer code \fIdtype\fR.  Only two pixel datatypes are currently
+supported, i.e., \fIdtype\fR=3 for short integer pixels, and \fIdtype\fR=6
+for type real pixels.
+
+Both the image header file and the pixel file are created, and storage is
+allocated for the pixel array in the pixel file.  A subsequent call to
+\fIimopen\fR is required to access the new image.  The size, dimensionality,
+and datatype of the new image cannot be changed once the image has been
+created.
+.ih
+RETURN VALUE
+A nonzero error code is returned if either the header file or the pixel
+file cannot be created for some reason, or if any of the input arguments
+are invalid.
+
+.nf
+IE_NAXIS:	wrong number of axes on image
+IE_AXLEN:	length of each image axis must be .ge. 1
+IE_PIXTYPE:	image pixel type must be short or real
+IE_CREHDR:	cannot create image
+IE_WRHDR:	error writing to image header file
+IE_ALCPIX:	cannot create or allocate space for pixel file
+IE_ACCPIX:	error writing into pixel file during image create
+.fi
+.ih
+SEE ALSO
+imopen, imopnc, imdele, imrnam
+.endhelp
diff --git a/sys/imfort/doc/imdele.hlp b/sys/imfort/doc/imdele.hlp
new file mode 100644
index 00000000..b80e5692
--- /dev/null
+++ b/sys/imfort/doc/imdele.hlp
@@ -0,0 +1,29 @@
+.help imdele Sep86 imfort
+.ih
+NAME
+imdele -- delete an image
+.ih
+SYNOPSIS
+.nf
+subroutine imdele (image, ier)
+
+character*(*)	image		#I host name of image to be deleted
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimdele\fR procedure deletes an image, i.e., the both the header file
+and the pixel file (if any).
+.ih
+RETURN VALUE
+A zero status is returned if the image exists and was successfully deleted.
+It is not an error if there is no pixel file.
+
+.nf
+IE_IMDELNEXIM:	attempt to delete a nonexistent image
+IE_IMDELETE:	cannot delete image
+.fi
+.ih
+SEE ALSO
+imrnam, imcrea
+.endhelp
diff --git a/sys/imfort/doc/imdelk.hlp b/sys/imfort/doc/imdelk.hlp
new file mode 100644
index 00000000..d654447e
--- /dev/null
+++ b/sys/imfort/doc/imdelk.hlp
@@ -0,0 +1,36 @@
+.help imdelk Sep86 imfort
+.ih
+NAME
+imdelk -- delete a header keyword
+.ih
+SYNOPSIS
+.nf
+subroutine imdelk (im, keyw, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of keyword to be deleted
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimdelk\fR procedure is used to delete a user defined image header
+keyword, e.g., a keyword previously created with \fIimaddk\fR or with one
+of the \fIimakw\fR procedures.
+.ih
+RETURN VALUE
+A zero status is returned if the named keyword existed, was a user defined
+keyword (rather an a protected system keyword), and was successfully deleted.
+
+.nf
+SYS_IDBNODEL:	cannot delete image header keyword
+SYS_IDBDELNXKW:	attempt to delete a nonexistent image header keyword
+.fi
+.ih
+NOTES
+It is not an error to delete a keyword from the header of an image opened for
+read-only access, but an error status will be returned at \fIimclos\fR or
+\fIimflsh\fR time since the header cannot be updated on disk.
+.ih
+SEE ALSO
+imaddk, imakw, imacck
+.endhelp
diff --git a/sys/imfort/doc/imemsg.hlp b/sys/imfort/doc/imemsg.hlp
new file mode 100644
index 00000000..32b1677c
--- /dev/null
+++ b/sys/imfort/doc/imemsg.hlp
@@ -0,0 +1,31 @@
+.help imemsg Sep86 imfort
+.ih
+NAME
+imemsg -- convert an IMFORT error code into an error message
+.ih
+SYNOPSIS
+.nf
+subroutine imemsg (ier, errmsg)
+
+integer		ier		#I an IMFORT error code
+character*(*)	errmsg		#O the corresponding error message
+.fi
+.ih
+DESCRIPTION
+The \fIimemsg\fR procedure converts a positive integer error code,
+such as is returned by the IMFORT procedures in the event of an error,
+into the corresponding error message string.  In cases where the error
+was associated with a named object, e.g., a file or image, the operand
+name will be enclosed in parenthesis and appended to the base error
+message string returned to the user.
+.ih
+RETURN VALUE
+The error message string, or "imfort error (unrecognized error code)" if
+called with an unknown error code.
+.ih
+SEE ALSO
+.nf
+The individual manual pages for the symbolic names of the error codes
+imfort$imfort.h and lib$syserr.h for the integer error codes.
+.fi
+.endhelp
diff --git a/sys/imfort/doc/imflsh.hlp b/sys/imfort/doc/imflsh.hlp
new file mode 100644
index 00000000..d1d184f3
--- /dev/null
+++ b/sys/imfort/doc/imflsh.hlp
@@ -0,0 +1,39 @@
+.help imflsh Sep86 imfort
+.ih
+NAME
+imflsh -- flush any buffered image data to disk
+.ih
+SYNOPSIS
+.nf
+subroutine imflsh (im, ier)
+
+integer		im		#I image descriptor of open image
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimflsh\fR procedure flushes any buffered image data to disk.  Both the
+image header and pixel file are updated if either has been modified since
+the image was opened, or since the last call to \fIimflsh\fR.  All buffered
+image data is automatically flushed when an image is closed with \fIimclos\fR.
+Explicit calls to \fIimflsh\fR are rarely needed since synchronization occurs
+automatically when the image is closed, but may be desirable in applications
+where the image will be open for a substantial period of time, increasing the
+possibility of a program abort or interrupt before the image is closed.
+Calling \fIimflsh\fR on an image opened for read-only access is harmless.
+.ih
+RETURN VALUE
+A zero status is returned if no image data has been modified and an update
+is not necessary, or if either the header or pixel data has been modified and
+the update was successful.  The most likely cause of an update failure is lack
+of write permission on the image.
+
+.nf
+IE_FLUSH:	error flushing buffered data to pixel file
+IE_UPDHDR:	error updating image header file
+IE_UPDRO:	image header modified but image was opened read only
+.fi
+.ih
+SEE ALSO
+imclos
+.endhelp
diff --git a/sys/imfort/doc/imfort.hd b/sys/imfort/doc/imfort.hd
new file mode 100644
index 00000000..c37b96cd
--- /dev/null
+++ b/sys/imfort/doc/imfort.hd
@@ -0,0 +1,44 @@
+# Helpdir for the IMFORT package.
+
+zawset		hlp = doc$zawset.hlp,	src = os$zawset.c
+
+$imfort	= "sys$imfort/"
+$doc	= "sys$imfort/doc/"
+
+bfaloc		hlp = doc$bfaloc.hlp,	src = imfort$bfaloc.x
+bfbsiz		hlp = doc$bfbsiz.hlp,	src = imfort$bfbsiz.x
+bfchan		hlp = doc$bfchan.hlp,	src = imfort$bfchan.x
+bfclos		hlp = doc$bfclos.hlp,	src = imfort$bfclos.x
+bfflsh		hlp = doc$bfflsh.hlp,	src = imfort$bfflsh.x
+bffsiz		hlp = doc$bffsiz.hlp,	src = imfort$bffsiz.x
+bfopen		hlp = doc$bfopen.hlp,	src = imfort$bfopen.x
+bfread		hlp = doc$bfread.hlp,	src = imfort$bfread.x
+bfwrit		hlp = doc$bfwrit.hlp,	src = imfort$bfwrit.x
+clarg		hlp = doc$clarg.hlp,	src = imfort$clarg.x
+clnarg		hlp = doc$clnarg.hlp,	src = imfort$clnarg.x
+clrawc		hlp = doc$clrawc.hlp,	src = imfort$clrawc.x
+imacck		hlp = doc$imacck.hlp,	src = imfort$imacck.x
+imaddk		hlp = doc$imaddk.hlp,	src = imfort$imaddk.x
+imakw		hlp = doc$imakw.hlp,	src = imfort$imakw.x
+imclos		hlp = doc$imclos.hlp,	src = imfort$imclos.x
+imcrea		hlp = doc$imcrea.hlp,	src = imfort$imcrea.x
+imdele		hlp = doc$imdele.hlp,	src = imfort$imdele.x
+imdelk		hlp = doc$imdelk.hlp,	src = imfort$imdelk.x
+imemsg		hlp = doc$imemsg.hlp,	src = imfort$imemsg.x
+imflsh		hlp = doc$imflsh.hlp,	src = imfort$imflsh.x
+imgkw		hlp = doc$imgkw.hlp,	src = imfort$imgkw.x
+imgl		hlp = doc$imgl.hlp,	src = imfort$imgl.x
+imgs		hlp = doc$imgs.hlp,	src = imfort$imgs.x
+imgsiz		hlp = doc$imgsiz.hlp,	src = imfort$imgsiz.x
+imhcpy		hlp = doc$imhcpy.hlp,	src = imfort$imhcpy.x
+imokwl		hlp = doc$imokwl.hlp,	src = imfort$imokwl.x
+imgnkw		hlp = doc$imokwl.hlp,	src = imfort$imokwl.x
+imckwl		hlp = doc$imokwl.hlp,	src = imfort$imokwl.x
+imopen		hlp = doc$imopen.hlp,	src = imfort$imopen.x
+imopnc		hlp = doc$imopnc.hlp,	src = imfort$imopnc.x
+impixf		hlp = doc$impixf.hlp,	src = imfort$impixf.x
+impkw		hlp = doc$impkw.hlp,	src = imfort$impkw.x
+impl		hlp = doc$impl.hlp,	src = imfort$impl.x
+imps		hlp = doc$imps.hlp,	src = imfort$imps.x
+imrnam		hlp = doc$imrnam.hlp,	src = imfort$imrnam.x
+imtypk		hlp = doc$imtypk.hlp,	src = imfort$imtypk.x
diff --git a/sys/imfort/doc/imfort.ms b/sys/imfort/doc/imfort.ms
new file mode 100644
index 00000000..cc0c1919
--- /dev/null
+++ b/sys/imfort/doc/imfort.ms
@@ -0,0 +1,1711 @@
+.RP
+.TL
+A User's Guide to Fortran Programming in IRAF
+.br
+The IMFORT Interface
+.AU
+Doug Tody
+.AI
+.K2 "" "" "*"
+September 1986
+
+.AB
+The IMFORT interface is a Fortran programming environment suitable for general
+Fortran programming, with special emphasis on batch image processing.
+IMFORT is intended for use primarily by the scientist/user who occasionally
+needs to write a program for their own personal use, but who does not program
+often enough to make it worthwhile learning a larger, more complex but fully
+featured programming environment.  IMFORT is therefore a small interface which
+is easy to learn and use, and which relies heavily upon host system (non-IRAF)
+facilities which the user is assumed to already be familiar with.
+Facilities are provided for accessing command line arguments, reading and
+writing IRAF images, and returning output to the CL.  Provisions are made
+for editing, compiling, linking, and debugging programs without need to leave
+the IRAF environment, making use of familiar host system editing and debugging
+tools wherever possible.
+.AE
+
+.NH
+Introduction
+.PP
+The IMFORT interface is a library of Fortran callable subroutines which can
+be called from a host system Fortran program to perform such operations as
+fetching the arguments given on the command line when the task was invoked,
+or accessing the header or pixel information in an IRAF image (bulk data frame).
+Since the result is a host program rather than an IRAF program, only limited
+access to the facilities provided by the runtime IRAF system is possible,
+but on the other hand one has full access to the facilities provided by the
+host system.  Programs which use IMFORT may be run as ordinary host system
+programs outside of IRAF, or may be interfaced to the IRAF command language
+(CL) as CL callable tasks.  Within the IRAF environment these user written,
+non-IRAF tasks behave much like ordinary IRAF tasks, allowing background
+execution, use of i/o redirection and pipes, evaluation of expressions on
+the command line, programmed execution in scripts, and so on.
+
+.NH 2
+Who Should Use IMFORT
+.PP
+The most significant feature of the IMFORT interface is that it is designed
+for use by \fIhost\fR Fortran programs.  The scientist/user will often already
+be using such programs when IRAF becomes available.  IMFORT allows these
+pre-existing programs to be modified to work within the IRAF environment
+with a minimum of effort and with minimum changes to the existing program.
+The only alternative is to rework these programs as \fIIRAF\fR programs,
+but few existing Fortran programs could (or should) survive such a transition
+without being completely rewritten.  If the program in question is useful
+enough such a rewrite might be warranted, but in most cases this will not
+be practical, hence something like the IMFORT interface is clearly needed
+to keep these old programs alive until they are no longer needed.
+.PP
+The second goal of the IMFORT interface is to provide a way for the user to
+add their own programs to IRAF without having to invest a lot of time learning
+the full blown IRAF programming environment.  IMFORT makes it possible for
+the user to begin writing useful programs within hours of their first exposure
+to the system.  It is possible that the IMFORT interface will provide all the
+capability that some users will ever need, especially when supplemented by other
+(non-IRAF) Fortran callable libraries available on the local host machine.
+Programs developed in this way are bound to have portability and other
+problems, but it should be up to the developer and user of the software to
+decide whether these problems are worth worrying about.  IMFORT is simply
+a \fItool\fR, to be used as one sees fit; there is no attempt to dictate to
+the user how they should write their programs.
+.PP
+The alternative to IMFORT, if applications programming within IRAF is the goal,
+is the IRAF SPP/VOS programming environment.  The SPP/VOS programming
+environment is a fully featured scientific programming environment which
+carefully addresses all the software engineering issues avoided by IMFORT.
+The VOS is a large and complex environment and therefore takes longer to learn
+than IMFORT, but it provides all the facilities needed by large applications
+hence is \fIeasier\fR to use than simpler interfaces like IMFORT, if one is
+faced with the already difficult task of coding a large program or package.
+Furthermore, the SPP/VOS environment fully addresses the problems of
+portability and device independence, critical issues for applications which
+must be supported and used simultaneously on a range of machines over a
+period of years, during which time the software is likely to be continually
+evolving.  An overview of the SPP/VOS programming environment is given in
+\fIThe IRAF Data Reduction and Analysis System\fR, February 1986, by the author.
+.PP
+In summary, IMFORT is intended for use to interface old Fortran programs to
+IRAF with a minimum of effort, and as an entry level programming environment
+which new users can learn to use in a few hours.  Experienced users,
+professional programmers, and developers of large applications will find that
+they can accomplish more with less effort once they have learned to use the
+more fully featured SPP/VOS programming environment.
+
+.bp
+.NH
+Getting Started
+.PP
+Although programs which use IMFORT can and often will be invoked from the
+host system command interpreter, it is likely that such programs will also
+be used interactively in combination with the tasks provided by the standard
+IRAF system.  For example, the IRAF graphics and image display facilities
+are likely to be used to examine the results of an image operation performed
+by a user written Fortran/IMFORT program.  Indeed, the standard IRAF tasks
+are likely to be used for testing new IMFORT programs as well as reducing data
+with old ones, so we shall assume that software development will take place
+from within the IRAF environment.  Since IRAF provides full access to the
+facilities of the host system at all times, there is little reason not to
+work from within the IRAF environment.
+.PP
+As a first step, let's see what is required to enter, compile, link, and
+execute a small Fortran program which does nothing more than print the
+message \fLhello, world!\fR on the terminal.  We shall assume that the
+reader has read the \fICL User's Guide\fR and is already familiar with
+basic CL command entry, the OS escape facility, the editor interface and so on.
+The first step is to call up the editor to enter the program into a file:
+.DS
+\fLcl> edit hello.f\fR
+.DE
+Note that the filename extension is ".f", which is what IRAF uses for
+Fortran files.  The extension will be mapped into the local host system
+equivalent when IRAF communicates with the host system, but when working
+in the IRAF environment the IRAF name should be used.
+.LP
+Once in the editor, enter the following program text:
+.DS
+\fLprogram hello
+write (*,*) 'hello, world!'
+stop
+end\fR
+.DE
+The next step is to compile and link the \fLhello\fR program.  This is done
+by the command \fIfc\fR (\fIf\fRortran-\fIc\fRompile), which produces an
+object file \fLhello.o\fR and an executable program file \fLhello.e\fR.
+Note that the \fIfc\fR task is defined in the default \fIuser\fR package in
+your \fLLOGIN.CL\fR file, hence a \fImkiraf\fR may be required to regenerate
+the \fLLOGIN.CL\fR file if the file is old or has been modified.
+.DS
+\fLcl> fc hello.f\fR
+.DE
+Since the \fLhello\fR program is a host Fortran program, it can be executed
+immediately with an OS escape, e.g., \fL!hello.e\fR on UNIX, or
+\fL!run hello\fR on VMS.  A better approach if the task has command line
+arguments is to use the IRAF \fIforeign task\fR facility to define the
+program as a new IRAF task, as we shall see in the next section.
+
+.NH 2
+Example 1:  Plotting a function
+.PP
+As a slightly more complicated example, let's construct a program to compute
+and plot a function using command line arguments to input the function
+parameters, with output consisting of a simple ASCII table sampling the
+computed function.  Our example computes the Planck function, which gives the
+emissivity of a blackbody as a function of wavelength and temperature.
+The sample program is shown in Figure 1.  Source code for this and all other
+examples in this paper may be found in the IRAF directory \fLimfort$tasks\fR.
+
+.DS
+\fL
+.ps 8
+.vs 9p
+c PLANCK -- Compute the Planck blackbody radiation distribution for a
+c given temperature and wavelength region.
+c
+c       usage:  planck temperature lambda1 lambda2
+c
+c The temperature is specified in degrees Kelvin and the wavelength
+c region in microns (1u=10000A).  100 [x,y] data points defining the
+c curve are output.
+c ----------------------------------------------------------------------
+
+        program planck
+
+        character*80    errmsg
+        integer         nargs, ier, i
+        real            w1, w2, dw, cm, t
+        real            xv(100), yv(100)
+
+c --- Get the temperature in degrees kelvin.
+        call clargr (1, t, ier)
+        if (ier .ne. 0) then
+            write (*, '('' temperature (degrees kelvin): '',$)')
+            read (*,*) t
+        endif
+
+c --- Get the wavelength region to be computed.
+        call clnarg (nargs)
+        if (nargs .ge. 3) then
+            call clargr (2, w1, ier)
+            if (ier .ne. 0) goto 91
+            call clargr (3, w2, ier)
+            if (ier .ne. 0) goto 91
+        else
+            write (*, '('' start wavelength (microns): '',$)')
+            read (*,*) w1
+            write (*, '('' end wavelength (microns): '',$)')
+            read (*,*) w2
+        endif
+
+c --- Compute the blackbody curve.
+        dw = (w2 - w1) / 99.0
+        do 10 i = 1, 100
+            xv(i) = ((i-1) * dw) + w1
+            cm = xv(i) * 1.0E-4
+            yv(i) = (3.74185E-5 * (cm ** -5)) /
+     *          (2.71828 ** (1.43883 / (cm * t)) - 1.0)
+ 10     continue
+
+c --- Print the curve as a table.
+        do 20 i = 1, 100
+            write (*, '(f7.4, g12.4)') xv(i), yv(i)
+ 20     continue
+
+        stop
+
+c --- Error exit. 
+ 91     call imemsg (ier, errmsg)
+        write (*, '('' Error: '', a80)') errmsg
+        stop
+        end\fR
+.DE
+.vs
+.ps
+.sp
+.ce
+Figure 1.  Sample program to compute the Planck function\(dd
+.FS
+\(ddThe trailing \fL$\fR carriage control code used in the format strings in
+the \fLWRITE\fR statements in this and the other sample Fortran programs
+is nonstandard Fortran and may not be available on all host machines.
+Its function is to defeat the carriage-return linefeed so that the user's
+response may be entered on the same line as the prompt.
+.FE
+
+.PP
+This example serves to demonstrate the use of the IMFORT \fIclarg\fR procedures
+to fetch the command line arguments, and the use of i/o redirection to capture
+the output to generate the plot.  The command line to an IMFORT program consists
+of a sequence of arguments delimited by spaces or tabs.  The subroutine
+\fIclnarg\fR returns the number of arguments present on the command line when
+the task was called.  The \fIclargr\fR, \fIclargi\fR, etc. procedures fetch
+and decode the values of the individual arguments.  Virtually all IMFORT
+procedures include an integer output variable \fIier\fR in their argument list;
+a zero status indicates success, anything else indicates failure and the actual
+error code identifies the cause of the problem.  The \fIimemsg\fR procedure
+may be called to convert IMFORT error codes into error message strings, as in
+the example.
+.PP
+Once the program has been entered and compiled and linked with \fIfc\fR,
+we must declare the program as a foreign task to the CL.  If this is not
+done the program can still be run via an OS escape, but none of the advanced
+CL features will be available, e.g., background execution, command line
+expression evaluation, i/o redirection, and so on.  The technique used to
+declare a foreign task is machine dependent since it depends upon the syntax
+of the host command interpreter.  For example, to declare the new CL foreign
+task \fIplanck\fR on a UNIX system, we enter the following command:
+.DS
+\fLcl> task $planck = $planck.e\fR
+.DE
+The same thing can be achieved on a VMS system with the following
+declaration (it can be simplified by moving the VMS foreign task declaration
+to your \fLLOGIN.COM\fR file):
+.DS
+\fLcl> task $planck = "$planck:==\\\\$\fIdisk\fP:[\fIdir\fP...]planck.exe!planck"\fR
+.DE
+The \fL$\fR characters are required to tell the CL that the new task does
+not have a parameter file, and is a foreign task rather than a regular
+IRAF task.  The \fL!\fR in the VMS example is used to delimit multiple DCL
+commands; the command shown defines the DCL foreign task \fIplanck\fR and
+then executes it.  The use of the \fItask\fR statement to declare foreign
+tasks is discussed in detail in \(sc3.3.
+.PP
+We have written the program in such a way that the arguments will be queried
+for if not given on the command line, so if we enter only the name of the
+command, an interaction such as the following will occur:
+.DS
+\fLcl> planck
+temperature (degrees kelvin): 3000
+start wavelength (microns): .1
+end wavelength (microns): 4\fR
+.DE
+Note that if the output of the \fIplanck\fR task is redirected this input
+mechanism will \fInot\fR work, since the queries will be redirected along
+with the output.  Hence if we use a pipe to capture the output, as in the
+following example, the arguments must be given on the command line.
+.DS
+\fLcl> planck 3000 0.1 4.0 | graph
+.DE
+This command will compute and plot the emissivity for a 3000 degree kelvin
+blackbody from 0.1 to 4.0 microns (1000 to 40000 angstroms).
+.PP
+An interesting alternative way to implement the above program would be to
+output the function curve as a line in an image, rather than as a table of
+numbers.  For example, a two dimensional image could be generated wherein
+each line corresponds to a different temperature.  \fIGraph\fR or \fIimplot\fR
+could then be used to plot curves or overplot families of curves; this would
+be more efficient than the technique employed in our sample program.
+Image access via IMFORT is illustrated in our next example.
+
+.NH 2
+Example 2:  Compute the range of pixel values in an image
+.PP
+The program shown in Figure 2 opens the named image, examines each line in
+the image to determine the minimum and maximum pixel values, keeping a running
+tally until the entire image has been examined (there is no provision for
+detecting and ignoring bad pixels in the image).  The newly computed minimum
+and maximum pixel values are then updated in the image header as well as
+printed on the standard output.
+.DS
+\fL
+.ps 8
+.vs 9p
+c MINMAX -- Compute the minimum and maximum pixel values in an image.
+c The new values are printed as well as updated in the image header.
+c
+c       usage:  minmax image
+c ----------------------------------------------------------------------
+
+        program minmax
+
+        character*80    image, errmsg
+        real            pix(4096), dmin, dmax, vmin, vmax
+        integer         im, axlen(7), naxis, dtype, ier, j
+
+c --- Get image name.
+        call clargc (1, image, ier)
+        if (ier .ne. 0) then
+            write (*, '('' enter image name: '',$)')
+            read (*,*) image
+        endif
+
+c --- Open the image for readwrite access (we need to update the header).
+        call imopen (image, 3, im, ier)
+        if (ier .ne. 0) goto 91
+        call imgsiz (im, axlen, naxis, dtype, ier)
+        if (ier .ne. 0) goto 91
+
+c --- Read through the image and compute the limiting pixel values.
+        do 10 j = 1, axlen(2)
+            call imgl2r (im, pix, j, ier)
+            if (ier .ne. 0) goto 91
+            call alimr (pix, axlen(1), vmin, vmax)
+            if (j .eq. 1) then
+                dmin = vmin
+                dmax = vmax
+            else
+                dmin = min (dmin, vmin)
+                dmax = max (dmax, vmax)
+            endif
+ 10     continue
+
+c --- Update the image header.
+        call impkwr (im, 'datamin', dmin, ier)
+        if (ier .ne. 0) goto 91
+        call impkwr (im, 'datamax', dmax, ier)
+        if (ier .ne. 0) goto 91
+
+c --- Clean up.
+        call imclos (im, ier)
+        if (ier .ne. 0) goto 91
+        write (*, '(a20, 2 g12.5)') image, dmin, dmax
+        stop
+
+c --- Error exit.
+ 91     call imemsg (ier, errmsg)
+        write (*, '('' Error: '', a80)') errmsg
+        stop
+        end\fR
+.DE
+.vs
+.ps
+.sp
+.ce
+Figure 2.  Compute the min and max pixel values in an image
+
+.PP
+The program as written can only deal with images of one or two dimensions,
+of pixel type short (16 bit integer) or real (32 bit floating), with a line
+length not to exceed 4096 pixels per line.  We could easily change the program
+to deal with images of up to three dimensions, but the IMFORT interface does
+not provide dynamic memory allocation facilities so there is always going
+to be an upper limit on the line length if we use the simple get line i/o
+procedure \fIimgl2r\fR, as shown.  The use of fixed size buffers simplifies
+the program, however, and is not expected to be a serious problem in most
+IMFORT applications.
+.PP
+The \fIalimr\fR subroutine in the previous example is from the IRAF VOPS
+(vector operators) package.  The function of \fIalimr\fR is to compute
+the limiting (min and max) pixel values in a vector of type real, the
+function type being indicated by the \fIlim\fR, and the pixel datatype by
+the \fIr\fR.  The VOPS package provides many other such vector operators,
+and is discussed further in \(sc 4.4.
+
+.NH 2
+Example 3:  Copy an image
+.PP
+Our final example (Figure 3) shows how to create a new image as a copy of
+some existing image.  This can be used as a template to create any binary
+image operator, i.e., any program which computes some transformation upon
+an existing image, writing a new image as output.
+.PP
+By now the functioning of this procedure should be self evident.
+The only thing here which is at all subtle is the subroutine \fIimopnc\fR,
+used to open (create) a new copy of an existing image.  The open new copy
+operation creates a new image the same size and datatype as the old
+image, and copies the image header of the old image to the new image.
+Any user keywords in the header of the old image will be automatically
+passed to the new image, without requiring that the calling program
+have explicit knowledge of the contents of the image header.
+.PP
+Note that the program is written to work only on pixels of type real,
+hence will be inefficient if used to copy images of type short-integer.
+A more efficient approach for a general image copy operator would be
+to add a conditional test on the variable \fLdtype\fR, executing a
+different copy-loop for each datatype, to avoid having to convert from
+integer to real and back again when copying a short-integer image.
+The short-integer equivalents of \fIimgl3r\fR (get line, 3 dim image,
+type real) and \fIimpl3r\fR (put line, 3 dim image, type real) are
+called \fIimgl3s\fR and \fIimpl3s\fR.
+.PP
+The program as written will work for images of up to three dimensions,
+even though it is written to deal with only the three dimensional case.
+This works because the length of the "unused" axes in an image is
+set to one when the image is created.  A program passed an image of
+higher dimension than it is written for will also work, but will not
+process all of the data.  IMFORT does not support image sections,
+so only the first few lines of the image will be accessible to such
+a program.
+
+.PP
+Additional useful examples of Fortran programs using IMFORT are given in
+\fLimfort$tasks\fR.  These include utility programs to make test images,
+print the contents of an image header, print the values of the pixels in
+a subraster, and so on.  You may wish to copy the source for these to your
+own workspace for use as is, or for use as templates to construct similar
+programs.
+
+.DS
+\fL
+.ps 8
+.vs 9p
+c IMCOPY -- Copy an image.  Works for images of up to three dimensions
+c with a pixel type of short or real and up to 4096 pixels per line.
+c
+c       usage:  imcopy oldimage newimage
+c ---------------------------------------------------------------------
+
+        program imcopy
+
+        real            pix(4096)
+        character*80    oimage, nimage, errmsg
+        integer         ncols, nlines, nbands, j, k, oim, nim
+        integer         ier, axlen(7), naxis, dtype, nargs
+
+c --- Get command line arguments.
+        call clnarg (nargs)
+        if (nargs .eq. 2) then
+            call clargc (1, oimage, ier)
+            if (ier .ne. 0) goto 91
+            call clargc (2, nimage, ier)
+            if (ier .ne. 0) goto 91
+        else
+            write (*, '('' input image: '',$)')
+            read (*,*) oimage
+            write (*, '('' output image: '',$)')
+            read (*,*) nimage
+        endif
+
+c --- Open the input image and create a new-copy output image.
+        call imopen (oimage, 1, oim, ier)
+        if (ier .ne. 0) goto 91
+        call imopnc (nimage, oim, nim, ier)
+        if (ier .ne. 0) goto 91
+
+c --- Determine the size and pixel type of the image being copied.
+        call imgsiz (oim, axlen, naxis, dtype, ier)
+        if (ier .ne. 0) goto 91
+
+        ncols  = axlen(1)
+        nlines = axlen(2)
+        nbands = axlen(3)
+
+c --- Copy the image.
+	do 15 k = 1, nbands
+	    do 10 j = 1, nlines
+		call imgl3r (oim, pix, j, k, ier)
+		if (ier .ne. 0) goto 91
+		call impl3r (nim, pix, j, k, ier)
+		if (ier .ne. 0) goto 91
+ 10         continue
+ 15     continue
+
+c --- Clean up.
+        call imclos (oim, ier)
+        if (ier .ne. 0) goto 91
+        call imclos (nim, ier)
+        if (ier .ne. 0) goto 91
+
+        stop
+
+c --- Error actions.
+ 91     call imemsg (ier, errmsg)
+        write (*, '('' Error: '', a80)') errmsg
+        stop
+        end\fR
+.DE
+.vs
+.ps
+.sp
+.ce
+Figure 3.  Image copy program
+
+.bp
+.NH
+The IMFORT Programming Environment
+.PP
+IRAF provides a small programming environment for the development of host
+Fortran programs using the IMFORT interface.  This environment consists
+of the general CL tools, e.g., the editor, the \fIpage\fR and \fIlprint\fR
+tasks, etc., plus a few special tools, namely, the \fIfc\fR compile/link
+utility and the foreign task facility.  In this section we discuss these
+special tools and facilities.  Information is also provided for linking
+to the IMFORT libraries if program development is to take place at the host
+system level.
+.PP
+The classic third generation program development cycle (ignoring such minor
+details as designing the software) is edit \(em compile/link \(em debug.
+The edit phase uses the CL \fIedit\fR task, an interface to the host system
+editor of choice.  The compile/link phase is performed by the \fIfc\fR utility.
+The debug phase is optional and is generally only necessary for large programs.
+The host system debug tool is used; while IRAF does not provide a special
+interface to the host debug tool, one can easily be constructed using the
+foreign task facility if desired.
+.PP
+Programs which use the IMFORT interface are inevitably host system dependent
+to some degree, since they are host programs.  In the interests of providing
+the user with concrete examples, the discussion in this section must therefore
+delve into the specifics of certain host operating systems.  We have chosen
+to use UNIX and VMS in the examples, since most IRAF implementations run on
+one or the other of these operating systems.  The ties between the IMFORT
+programming environment and the host system are quite simple, however, so it
+should not be difficult to see how to modify the examples for a different host.
+
+.NH 2
+The FC Compile/Link Utility
+.PP
+The \fIfc\fR utility provides a consistent, machine independent interface to
+the host system compiler and linker which is convenient and easy to use.
+In addition, \fIfc\fR provides a means for linking host programs with the
+IRAF libraries without having to type a lot, and without having to build
+host command scripts.  All of the IRAF libraries are accessible via \fIfc\fR,
+not just IMFORT (\fLlib$libimfort.a\fR) and the IRAF system libraries used
+by IMFORT, but all the other IRAF libraries as well, e.g., the math libraries.
+.PP
+The default action of \fIfc\fR is to compile and link the files listed on the
+command line, i.e., source files in various languages, object modules, and
+libraries.  Any source files are first turned into object modules, then the
+objects are linked in the order given, searching any libraries in the order
+in which they are encountered on the command line (the IMFORT libraries are
+searched automatically, after any libraries listed on the command line).
+By default, the root name of the new executable will be the same as that of
+the first file listed on the command line; a different name may be assigned
+with the \fI-o\fR switch if desired.
+.LP
+The syntax of the \fIfc\fR command is as follows:
+.DS
+\fLfc [\fIswitches\fP] \fIfile\fL [\fIfile ...\fL] [-o \fIexefile\fL]\fR
+.DE
+The most interesting switches are as follows:
+.in 0.5i
+.IP \fB-c\fR
+Compile but do not link.
+.IP \fB-l\fIlibrary\fR
+.br
+Link to the named IRAF library.  On a UNIX host this switch may also be
+used to reference the UNIX libraries.  The \fI-llibrary\fR reference
+should be given in the file list at the point at which you want the
+library to be searched.  The \fI-l\fR causes \fIfc\fR to look in a set
+of standard places for the named library; user libraries should be
+referenced directly by the filename of the library.
+.IP \fB-o\fR\ \fIexefile\fR
+.br
+Override the default name for the executable file produced by the linker.
+.IP \fB-x\fR
+Compile and link for debugging.
+.in
+
+.LP
+Since the \fIfc\fR command line can contain many different types of objects,
+a filename extension is required to identify the object type.  The IRAF
+filename extensions \fImust\fR be used; these are listed in the table below.
+
+.TS
+box center;
+cb s
+ci | ci
+c | l.
+IRAF Filename Extensions
+_
+extn	usage
+=
+\.a	object library
+\.c	C source file
+\.e	executable
+\.f	Fortran source file
+\.o	object module
+\.s	Assembler source file
+\.x	SPP source file
+.TE
+
+.PP
+The \fIfc\fR utility is easy to learn and use.  Here are a few examples
+illustrating the most common usage of the utility.  To compile and link the
+Fortran program \fLprog.f\fR, producing the executable program \fLprog.e\fR:
+.DS
+\fLcl> fc prog.f\fR
+.DE
+To compile the file \fLutil.f\fR to produce the object \fLutil.o\fR,
+without linking anything:
+.DS
+\fLcl> fc -c util.f\fR
+.DE
+To link \fLprog.o\fR and \fLutil.o\fR, producing the executable program
+\fLprog.e\fR:
+.DS
+\fLcl> fc prog.o util.o\fR
+.DE
+To do the same thing, producing an executable named \fLfoo.e\fR instead
+of \fLprog.e\fR:
+.DS
+\fLcl> fc prog.o util.o -o foo.e\fR
+.DE
+To compile and link \fLprog.f\fR for debugging:
+.DS
+\fLcl> fc -x prog.f\fR
+.DE
+To link \fLprog.o\fR with the IRAF library \fLlib$libdeboor.a\fR (the DeBoor
+spline package), producing the executable \fLprog.e\fR as output:
+.DS
+\fLcl> fc prog.o -ldeboor\fR
+.DE
+To do the same thing, spooling the output in the file \fLspool\fR and
+running the whole thing in the background:
+.DS
+\fLcl> fc prog.o -ldeboor >& spool &\fR
+.DE
+To link instead with the library \fLlibfoo.a\fR, in the current directory
+(note that in this case the library is a module and not a switch):
+.DS
+\fLcl> fc prog.o libfoo.a\fR
+.DE
+.LP
+Just about any combination of switches and modules that makes sense will
+work.  The order of libraries in the argument list is important, as they
+will be searched in the order in which they are listed on the command line.
+.PP
+The \fIfc\fR utility is actually just a front-end to the standard IRAF
+compiler \fIxc\fR, as we shall see in \(sc3.3.  See the manual page for
+\fIxc\fR for additional information.
+
+.NH 2
+Host Level Linking to the IMFORT Libraries
+.PP
+In some cases it may be desirable to use host system facilities to compile
+and link programs which use the IMFORT interface.  The procedure for doing
+this is host dependent and is completely up to the user, who no doubt will
+already have a preferred technique worked out.  All one needs to know in
+this situation are the names of the libraries to be linked, and the order
+in which they are to be linked.  The libraries are as follows, using the
+IRAF filenames for the libraries.  All the libraries listed are referenced
+internally by the IMFORT code hence are required.
+
+.TS
+center;
+l l.
+lib$libimfort.a	IMFORT itself
+lib$libsys.a	Contains certain pure code modules used by IMFORT
+lib$libvops.a	The VOPS vector operators library
+hlib$libos.a	The IRAF kernel (i/o primitives)
+.TE
+.LP
+The host pathnames of these libraries will probably be evident, given the
+host pathname of the IRAF root directory (\fIlib\fR is a subdirectory of
+the IRAF root directory).  If in doubt, the \fIosfn\fR intrinsic function may
+be used while in the CL to print the host pathname of the desired library.
+For example,
+.DS
+\fLcl> = osfn ("lib$libimfort.a")\fR
+.DE
+will cause the CL to print the host pathname of the main IMFORT library.
+
+.NH 2
+Calling Host Programs from the CL
+.PP
+Since Fortran programs which use IMFORT are host programs rather than IRAF
+programs, the CL \fIforeign task\fR interface is used to connect the programs
+to the CL as CL callable tasks.  The foreign task interface may also be used
+to provide custom CL task interfaces to other host system utilities, e.g.,
+the debugger or the librarian.
+.PP
+The function of the \fItask\fR statement in the CL is to make a new task
+known to the CL.  The CL must know the name of the new task, the name of
+the package to which it is to be added, whether or not the new task has a
+parameter file, the type of task being defined, and the name of the file in
+which the task resides.  At present new tasks are always added to the
+"current" package.  The possible types of tasks are normal IRAF executable
+tasks, CL script tasks, and foreign tasks.  Our interest here is only in the
+forms of the task statement used to declare foreign tasks.  There are two
+such forms at present.  The simplest is the following:
+.DS
+\fLtask $\fItaskname\fR [, \fL$\fItaskname\fR...]\fL = $foreign\fR
+.DE
+This form is used when the command to be sent to the host system to run
+the task is identical to the name by which the task is known to the CL.
+Note that any number of new tasks may be declared at one time with this
+form of the task statement.  The \fL$\fR prefixing each \fItaskname\fR
+tells the CL that the task does not have a parameter file.  The \fL$foreign\fR
+tells the CL that the new tasks are foreign tasks and that the host command
+is the same as \fItaskname\fR.  For example, most systems have a system
+utility \fImail\fR which is used to read or send electronic mail.
+To declare the \fImail\fR task as an IRAF foreign task, we could enter
+the following declaration, and then just call the \fImail\fR task from
+within the CL like any other IRAF task.
+.DS
+\fLtask $mail = $foreign\fR
+.DE
+The more general form of the foreign task statement is shown below.
+The host command string must be quoted if it contains blanks or any other
+special characters; \fL$\fR is a reserved character and must be escaped
+to be included in the command sent to the host system.
+.DS
+\fLtask $\fItaskname\fL = $\fIhost_command_string\fR
+.DE
+In this form of the task statement, the command to be sent to the host system
+to execute the new IRAF task may be any string.  For example, on a VMS host,
+we might want to define the \fImail\fR task so that outgoing messages are
+always composed in the editor.  This could be set up by adding the \fL/EDIT\fR
+switch to the command sent to VMS:
+.DS
+\fLtask $mail = $mail/edit\fR
+.DE
+Foreign task statements which reference user-written Fortran programs often
+refer to the program by its filename.  For the task to work regardless of the
+current directory, either the full pathname of the executable file must be
+given, or some provision must be made at the host command interpreter level
+to ensure that the task can be found.
+.PP
+When a foreign task is called from the CL, the CL builds up the command string
+to be sent to the host command interpreter by converting each command line
+argument to a string and appending it to \fIhost_command_string\fR preceded
+by a space.  This is the principal difference between the foreign task
+interface and the low level OS escape facility: in the case of a foreign task,
+the command line is fully parsed, permitting general expression evaluation,
+i/o redirection, background execution, minimum match abbreviations, and so on.
+.PP
+In most cases this simple method of composing the command to be sent to the
+host system is sufficient.  There are occasional cases, however, where it is
+desirable to \fIembed\fR the command line arguments somewhere in the string
+to be sent to the host system.  A special \fIargument substitution\fR notation
+is provided for this purpose.  In this form of the task statement,
+\fIhost_command_string\fR contains special symbols which are replaced by the
+CL command line arguments to form the final host command string.
+These special symbols are defined in the table below.
+
+.TS
+center;
+c l.
+$0	replaced by \fItaskname\fR
+$1, $2, ..., $9	replaced by the indicated argument string
+$\(**	replaced by the entire argument list
+$(N)	use host equivalent of filename argument N (1-9 or \(**)
+.TE
+
+.PP
+An example of this form of the task statement is the \fIfc\fR task discussed
+in \(sc3.1.  As we noted earlier, \fIfc\fR is merely a front-end to the more
+general IRAF HSI command/link utility \fIxc\fR.  In fact, \fIfc\fR is
+implemented as a foreign task defined in the default \fIuser\fR package in
+the \fLLOGIN.CL\fR file.  The task declaration used to define \fIfc\fR is
+shown below.  The task statement shown is for UNIX; the VMS version is
+identical except that the \fL-O\fR switch must be quoted else DCL will convert
+it to lower case.  In general, foreign task statements are necessarily
+machine dependent, since their function is to send a command to the host system.
+.DS
+\fLtask $fc = "$xc -h -O $\(** -limfort -lsys -lvops -los"\fR
+.DE
+The argument substitution facility is particularly useful when the host
+command template consists of several statements to be executed by the
+host command interpreter in sequence each time the CL foreign task is called.
+In this case, a delimiter character of some sort is required to delimit
+the host command interpreter statements.  Once again, this is host system
+dependent, since the delimiter character to be used is defined by the syntax
+of the host command interpreter.  On UNIX systems the command delimiter
+character is semicolon (`\fB;\fR').  VMS DCL does not allow multiple
+statements to be given on a single command line, but the IRAF interface
+to DCL does, using the exclamation character (`\fB!\fR'), which is the
+comment character in DCL.
+.PP
+The \fL$()\fR form of argument substitution is useful for foreign tasks
+with one or more filename arguments.  The indicated argument or arguments
+are taken to be IRAF virtual filenames, and are mapped into their host
+filename equivalents to build up the host command string.  For example,
+assume that we have an IMFORT task \fIphead\fR, the function of which is
+to print the header of an image in FITS format on the standard output
+(there really is such a program - look in \fLimfort$tasks/phead.f\fR).
+We might declare the task as follows (assuming that \fIphead\fR means
+something to the host system):
+.DS
+\fLtask $phead = "$phead $(*)"\fR
+.DE
+We could then call the new task from within the CL to list the header
+of, for example, the standard test image \fLdev$pix\fR, and page the output:
+.DS
+\fLcl> phead dev$pix | page\fR
+.DE
+Or we could direct the output to the line printer:
+.DS
+\fLcl> phead dev$pix | lpr\fR
+.DE
+Filename translation is available for all forms of argument substitution
+symbols, e.g., \fL$(1)\fR, \fL$(2)\fR, \fL$(\(**)\fR, and so on; merely
+add the parenthesis.
+.PP
+It is suggested that new foreign task statements, if not typed in
+interactively, be added to the \fIuser\fR package in your \fLLOGIN.CL\fR file,
+so that the definitions are not discarded when you log out of the CL or exit
+a package.  If you want to make the new tasks available to other IRAF users
+they can be added to the \fIlocal\fR package by adding the task statements
+to the file \fLlocal$tasks/local.cl\fR.  If this becomes unwieldy the
+next step is to define a new package and add it to the system; this is not
+difficult to do, but it is beyond the scope of this manual to explain how
+to do so.
+
+.NH 3
+Example 1 Revisited
+.PP
+Now that we are familiar with the details of the foreign task statement,
+it might be useful to review the examples of foreign task statements given
+in \(sc2.1, which introduced the \fIplanck\fR task.  The UNIX example given
+was as follows:
+.DS
+\fLcl> task $planck = $planck.e\fR
+.DE
+This is fine, but only provided the \fIplanck\fR task is called from the
+directory containing the executable.  To enable the executable to be called
+from any directory we can use a UNIX pathname instead, e.g.,
+.DS
+\fLcl> task $planck = $/usr/jones/iraf/tasks/planck.e\fR
+.DE
+Alternatively, one could place all such tasks in a certain directory, and
+either define the pathname of the directory as a shell environment variable
+to be referenced in the task statement, or include the task's directory in
+the shell search path.  There are many other possibilities, of course, but
+it would be inappropriate to enumerate them here.
+.LP
+The VMS example given earlier was the following:
+.DS
+\fLcl> task $planck = "$planck:==\\\\$\fIdisk\fP:[\fIdir\fP...]planck.exe!planck"\fR
+.DE
+The command string at the right actually consists of two separate DCL commands
+separated by the VMS/IRAF DCL command delimiter `\fB!\fR'.  If we invent a
+pathname for the executable, we can write down the the first command:
+.DS
+\fL$ planck :== $usr\\\\$2:[jones.iraf.tasks]planck.exe\fR
+.DE
+This is a DCL command which defines the new DCL foreign task \fIplanck\fR.
+We could shorten the CL foreign task statement by moving the DCL declaration
+to our DCL \fLLOGIN.COM\fR file; this has the additional benefit of allowing
+the task to be called directly from DCL, but is not as self-contained.
+If this were done the CL task statement could be shortened to the following.
+.DS
+\fLcl> task $planck = $foreign\fR
+.DE
+The same thing could be accomplished in Berkeley UNIX by defining a cshell
+\fIalias\fR for the task in the user's \fL.cshrc\fR file.
+
+.NH 2
+Debugging IMFORT Programs
+.PP
+Programs written and called from within the IRAF environment can be debugged
+using the host system debug facility without any inconvenience.  The details
+of how to use the debugger are highly dependent upon the host system since
+the debugger is a host facility, but a few examples should help the reader
+understand what is involved.
+.PP
+Berkeley UNIX provides two debug tools, the assembly language debugger
+\fIadb\fR and the source language debugger \fIdbx\fR.  Both are implemented
+as UNIX tasks and are called from within the IRAF environment as tasks,
+with the name of the program to be debugged as a command line argument
+(this example assumes that \fIadb\fR is a defined foreign task):
+.DS
+\fLcl> adb planck.e\fR
+.DE
+The program is then run with a debugger command, passing any command line
+arguments to the program as part of the debugger run-program command.
+Programs do not have to be compiled in any special way to be debugged
+with \fIadb\fR; programs should be compiled with \fIfc -x\fR to be debugged
+with \fIdbx\fR.
+.PP
+In VMS, the debugger is not a separate task but rather a shareable image
+which is linked directly into the program to be debugged.  To debug a program,
+the program must first be linked with \fIfc -x\fR.  The program is then run
+by simply calling it in the usual way from the CL, with any arguments given
+on the command line.  When the program runs it comes up initially in the
+debugger, and a debugger command (\fIgo\fR) is required to execute the user
+program.  Note that if the program is run directly with \fLrun/debug\fR
+there is no provision for passing an argument list to the task.
+
+.NH 2
+Calling IMFORT from Languages other than Fortran
+.PP
+Although our discussion and examples have concentrated exclusively on the
+use of the IMFORT library in host Fortran programs, the library is in fact
+language independent, i.e., it uses only low level, language independent
+system facilities and can therefore be called from any language available
+on the host system.  The method by which Fortran subroutines and functions
+are called from another language, e.g., C or assembler, is highly machine
+dependent and it would be inappropriate for us to go into the details here.
+Note that \fIfc\fR may be used to compile and link C or assembler programs
+as well as Fortran programs.
+
+.NH 2
+Avoiding Library Name Collisions
+.PP
+Any program which uses IMFORT is being linked against the main IRAF system
+libraries, which together contain some thousands of external procedure names.
+Only a few hundred of these are likely to be linked into a host program,
+but there is always the chance that a user program module will have the
+same external name as one of the modules in the IRAF libraries.
+If such a library collision should occur, at best one would get an error
+message from the linker, and at worst one would end up with a program
+which fails mysteriously at run time.
+.PP
+At present there is no utility which can search a user program for externals
+and cross check these against the list of externals in the IRAF system
+libraries.  A database of external names is however available in the file
+\fLlib$names\fR; this contains a sorted list of all the Fortran callable
+external names defined by procedures in the \fIimfort\fR, \fIex\fR, \fIsys\fR,
+\fIvops\fR, and \fIos\fR libraries (the \fIex\fR library is however not
+searched when linking IMFORT programs).
+.PP
+The \fImatch\fR task may be used to check individual user external names
+against the name list, or a host utility may be used for the same purpose.
+For example, to determine if the module \fIsubnam\fR is present in any
+of the IRAF system libraries:
+.DS
+\fLcl> match subnam lib$names\fR
+.DE
+The names database is also useful for finding the names of all the procedures
+sharing a particular package prefix.  For example,
+.DS
+\fLcl> match "^cl" lib$names | table\fR
+.DE
+will find all the procedures whose names begin with the prefix "cl" and
+print them as a table (the \fIlists\fR package must be loaded first).
+
+.bp
+.NH
+The IMFORT Library
+.PP
+In this section we survey the procedures provided by the IMFORT interface,
+grouped according to the function they perform.  There are currently four main
+groups: the command line access procedures, the image access procedures,
+the vector operators (VOPS), and a small binary file i/o package.  With the
+exception of the VOPS procedures, all of the IMFORT routines were written
+especially for IMFORT and are not called in standard IRAF programs.
+The VOPS procedures are standard IRAF procedures, but are included in the
+IMFORT interface because they are coded at a sufficiently low level that they
+can be linked into any program, and they tend to be useful in image processing
+applications such as IMFORT is designed for.
+.PP
+The ANSI Fortran-77 standard requires that all names in Fortran programs have
+six or fewer characters.  To eliminate guesswork, the names of all the IMFORT
+procedures are exactly six characters long and the names adhere to a
+\fBnaming convention\fR.  The first one or two characters in each name
+identify the package or group to which the procedure belongs, e.g.,
+\fIcl\fR for the command line access package, \fIim\fR for the image
+access package, and so on.  The package prefix is followed by the function name,
+and lastly a datatype code identifying the datatype upon which the procedure
+operates, in cases where multiple versions of the procedure are available for
+a range of datatypes.
+.DS
+\fIpackage_prefix // function_code // type_suffix\fR
+.DE
+The type suffix codes have already been introduced in the examples.  They are
+the same as are used throughout IRAF.  The full set is \fB[bcsilrdx]\fR, as
+illustrated in the following table (not all are used in the IMFORT procedures).
+
+.TS
+center box;
+cb s s s
+ci | ci | ci | ci
+c | l | c | l.
+Standard IRAF Datatypes
+_
+suffix	name	code	typical fortran equivalent
+=
+b	bool	1	\fLLOGICAL\fR
+c	char	2	\fLINTEGER\(**2\fR (non-ANSI)
+s	short	3	\fLINTEGER\(**2\fR (non-ANSI)
+i	int	4	\fLINTEGER\fR
+l	long	5	\fLINTEGER\(**4\fR (non-ANSI)
+r	real	6	\fLREAL\fR
+d	double	7	\fLDOUBLE PRECISION\fR
+x	complex	8	\fLCOMPLEX\fR
+.TE
+.PP
+The actual mapping of IRAF datatypes into host system datatypes is machine
+dependent, i.e., \fIshort\fR may not map into INTEGER\(**2 on all machines.
+This should not matter since the datatype in which data is physically stored
+internally is hidden from user programs by the IMFORT interface.
+.PP
+In cases where multiple versions of a procedure are available for operands
+of different datatypes, a special nomenclature is used to refer to the class
+as a whole.  For example,
+.DS
+\fLclarg[cird] (argno, [cird]val, ier)\fR 
+.DE
+denotes the set of four procedures \fIclargc, clargi, clargr\fR, and
+\fIclargd\fR.  The datatype of the output operand (\fIcval, ival\fR, etc.)
+must match the type specified by the procedure name.
+.PP
+With the exception of the low level binary file i/o procedures (BFIO),
+all IMFORT procedures are implemented as subroutines rather than functions,
+for reasons of consistency and to avoid problems with mistyping of undeclared
+functions by the Fortran compiler.
+
+.NH 2
+Command Line Access
+.PP
+The command line access procedures are used to decode the arguments present
+on the command line when the IMFORT program was invoked.  This works both
+when the program is called from the IRAF CL, and when the program is called
+from the host system command interpreter.  The command line access procedures
+are summarized in Figure 4, below.
+
+.TS
+center;
+n.
+\fLclnarg (\&nargs)\fR
+\fLclrawc (\&outstr, ier)\fR
+\fLclarg[cird] (\&argno, [cird]val, ier)\fR
+.TE
+.sp
+.ce
+Figure 4.  Command Line Access Procedures
+
+.PP
+The \fIclnarg\fR procedure returns the number of command line arguments;
+zero is returned if an error occurs or if there were no command line arguments.
+The \fIclargc\fR, \fIclargi\fR, etc., procedures are used to fetch and decode
+the individual arguments; \fIclargc\fR returns a character string, \fIclargi\fR
+returns an integer, and so on.  A nonzero \fIier\fR status indicates either
+that the command line did not contain the indexed argument, or that the
+argument could not be decoded in the manner specified.  Character string
+arguments must be quoted on the command line if they contain any blanks or
+tabs, otherwise quoting is not necessary.  The rarely used \fIclrawc\fR
+procedure returns the entire raw command line as a string.
+
+.NH 2
+Image Access
+.PP
+The image access procedures form the bulk of the IMFORT interface.  There are
+three main categories of image access procedures, namely, the general image
+management procedures (open, close, create, get size, etc.), the header access
+procedures (used to get and put the values of header keywords), and the pixel
+i/o procedures, used to read and write image data.
+.PP
+IMFORT currently supports images of up to three dimensions,
+of type short-integer or real.
+There is no builtin limit on the size of an image, although
+the size of image a particular program can deal with is normally limited by
+the size of a statically allocated buffer in the user program.  IMFORT does
+not map IRAF virtual filenames, hence host dependent names must be used when
+running a program which uses IMFORT.
+.PP
+IMFORT currently supports only the OIF image format, and images must be
+of type short-integer or real.  Since normal IRAF programs support images of
+up to seven disk datatypes with a dimensionality of up to seven, as well as
+completely different image formats than that expected by IMFORT (e.g., STF),
+if you are not careful IRAF can create images which IMFORT programs cannot
+read (don't omit the error checking!).  In normal use, however,
+types short-integer and real are by far the most common and images with
+more than two dimensions are rare, so these are not expected to be serious
+limitations.
+
+.NH 3
+General Image Access Procedures
+.PP
+The general image access and management procedures are listed in Figure 5.
+An image must be opened with \fIimopen\fR or \fIimopnc\fR before header access
+or pixel i/o can occur.  The image open procedures return an
+\fIimage descriptor\fR (an integer magic number) which uniquely identifies
+the image in all subsequent accesses until the image is closed.
+When the operation is completed, an image must be closed with \fIimclos\fR to
+flush any buffered output, update the image header, and free any resources
+associated with the image descriptor.  The maximum number of images which
+can be open at any one time is limited by the maximum number of open file
+descriptors permitted by the host operating system.
+.PP
+New images are created with \fIimopnc\fR and \fIimcrea\fR.  The \fIimopnc\fR
+procedure creates a new copy of an existing image, copying the header of
+the old image to the new image but not the data.  The new copy image must
+be the same size and datatype as the old image.  For complete control over
+the attributes of a new image the \fIimcrea\fR procedure must be used.
+The \fIimopnc\fR operation is equivalent to an \fIimopen\fR followed by an
+\fIimgsiz\fR to determine the size and datatype of the old image, followed by
+an \fIimcrea\fR to create the new image, followed by an \fIimhcpy\fR to copy
+the header of the old image to the new image and then two \fIimclos\fR calls
+to close both images.
+.PP
+Note that \fIimgsiz always returns seven elements in the output array axlen\fR,
+regardless of the actual dimensionality of the image; this is so that current
+programs will continue to work in the future if IMFORT is extended to support
+images of dimensionality higher than three.  Images may be deleted with
+\fIimdele\fR, or renamed with \fIimrnam\fR; the latter may also be used to
+move an image to a different directory.  The \fIimflsh\fR procedure is used
+to flush any buffered output pixel data to an image opened for writing.
+
+.TS
+center;
+n.
+\fLimopen (\&image, acmode, im, ier)      \fRacmode: 1=RO,3=RW
+\fLimopnc (\&nimage, oim, nim, ier)       \fRacmode: always RW
+\fLimclos (\&im, ier)\fR
+
+\fLimcrea (\&image, axlen, naxis, dtype, ier)\fR
+\fLimdele (\&image, ier)\fR
+\fLimrnam (\&oldnam, newnam, ier)\fR
+
+\fLimflsh (\&im, ier)\fR
+\fLimgsiz (\&im, axlen, naxis, dtype, ier)\fR
+\fLimhcpy (\&oim, nim, ier)\fR
+\fLimpixf (\&im, pixfd, pixfil, pixoff, szline, ier)\fR
+.TE
+.sp
+.ce
+Figure 5.  General Image Access Procedures
+
+.PP
+The \fIimpixf\fR procedure may be used to obtain the physical attributes
+of the pixel file, i.e., the pixel file name, the one-indexed \fIchar\fR
+offset to the first pixel, and the physical line length of an image as stored
+in the pixel file (the image lines may be aligned on device block boundaries).
+These parameters may be used to bypass the IMFORT pixel i/o procedures to
+directly access the pixels if desired (aside from the blocking of lines to
+fill device blocks, the pixels are stored as in a Fortran array).
+The BFIO file descriptor of the open pixel file is also returned, allowing
+direct access to the pixel file via BFIO if desired.  If lower level (e.g.,
+host system) i/o facilities are to be used, \fIbfclos\fR or \fIimclos\fR
+should be called to close the pixel file before reopening it with the foreign
+i/o system.
+.PP
+Direct access to the pixel file is not recommended since it makes a program
+dependent upon the details of how the pixels are stored on disk; such a
+program may not work with future versions of the IMFORT interface, nor with
+implementations of the IMFORT interface for different (non-OIF) physical image
+storage formats.  Direct access may be warranted when performing a minimum
+modification hack of an old program to make it work in the IRAF environment,
+or in applications with unusually demanding performance requirements,
+where the (usually negligible) overhead of the BFIO buffer is unacceptable.
+Note that in many applications, the reduction in disk accesses provided by
+the large BFIO buffer outweighs the additional cpu cycles required for memory
+to memory copies into and out of the buffer.
+
+.NH 3
+Image Header Keyword Access
+.PP
+The image header contains a small number of standard fields plus an arbitrary
+number of user or application defined fields.  Each image has its own header
+and IMFORT does not in itself make any association between the header parameters
+of different images.  The header access procedures are summarized in Figure 6.
+Note that the \fIimgsiz\fR procedure described in the previous section is the
+most convenient way to obtain the size and datatype of an open image, although
+the same thing can be achieved by a series of calls to obtain the values of
+the individual keywords, using the procedures described in this section.
+
+.TS
+center;
+n.
+\fLimacck (\&im, keyw, ier)\fR
+\fLimaddk (\&im, keyw, dtype, comm, ier)\fR
+\fLimdelk (\&im, keyw, ier)\fR
+\fLimtypk (\&im, keyw, dtype, comm, ier)\fR
+
+\fLimakw[bcdir] (\&im, keyw, [bcdir]val, comm, ier)\fR
+\fLimgkw[bcdir] (\&im, keyw, [bcdir]val, ier)\fR
+\fLimpkw[bcdir] (\&im, keyw, [bcdir]val, ier)\fR
+
+\fLimokwl (\&im, patstr, sortit, kwl, ier)\fR
+\fLimgnkw (\&kwl, outstr, ier)\fR
+\fLimckwl (\&kwl, ier)\fR
+.TE
+.sp
+.ce
+Figure 6.  Image Header Access Procedures
+
+.PP
+Both the standard and user defined header parameters may be accessed via the
+procedures introduced in this section.  The \fIimacck\fR procedure tests for
+the existence of the named keyword, returning a zero \fIier\fR if the keyword
+exists.  New keywords may be added to the image header with \fIimaddk\fR,
+and old keywords may be deleted with \fIimdelk\fR.  The datatype of a keyword
+may be determined with \fIimtypk\fR.  The attributes of a keyword are its
+name, datatype, value, and an optional comment string describing the
+significance of the parameter.  The comment string is normally invisible
+except when the header is listed, but may be set when a new keyword is added
+to the header, or fetched with \fIimtypk\fR.
+.PP
+The most commonly used procedures are likely to be the \fIimgkw\fR and
+\fIimpkw\fR families of procedures, used to get and put the values of named
+keywords; these procedures require that the keyword already be present in
+the header.  The \fIimakw\fR procedures should be used instead of the
+\fIimpkw\fR procedures if it is desired that a keyword be automatically added
+to the header if not found, before setting the new value.  Automatic datatype
+conversion is performed if the requested datatype does not match the actual
+datatype of the keyword.
+.PP
+The \fIkeyword list\fR package is the only way to obtain information from
+the header without knowing in advance the names of the header keywords.
+The \fIimokwl\fR procedure opens a keyword list consisting of all header
+keywords matching the given pattern, returning a \fIlist descriptor\fR to
+be used as input to the other procedures in the package.  Successive
+keyword \fInames\fR are returned in calls to \fIimgnkw\fR; a nonzero
+\fIier\fR is returned when the end of the list is reached.  The keyword
+name is typically used as input to other procedures such as \fIimtypk\fR
+or one of the \fIimgkw\fR procedures to obtain further information about
+the keyword.  A keyword list should be closed with \fIimckwl\fR when it is
+no longer needed to free system resources associated with the list descriptor.
+
+.TS
+center box;
+cb s s
+ci | ci | ci
+l | c | l.
+Standard Image Header User Keywords
+_
+name	datatype	description
+=
+naxis	int	number of axes (dimensionality)
+naxis[1:3]	int	length of each axis, pixels
+pixtype	int	pixel datatype
+datamin	real	minimum pixel value
+datamax	real	maximum pixel value
+ctime	int	image creation time
+mtime	int	image modification time
+limtime	int	time min/max last updated
+title	string	image title string (for plots etc.)
+.TE
+
+.PP
+The keyword list pattern string follows the usual IRAF conventions; some
+useful patterns are "\(**", which matches the entire header, and "i_", which
+matches only the standard header keywords (the standard header keywords are
+really named "i_naxis", "i_pixtype", etc., although the "i_" may be omitted
+in most cases).  A pattern which does not include any pattern matching
+metacharacters is taken to be a prefix string, matching all keywords whose
+names start with the pattern string.
+.PP
+An image must be opened with read-write access for header updates to have
+any effect.  An attempt to update a header without write permission will
+not produce an error status return until \fIimclos\fR is called to update
+the header on disk (and close the image).
+
+.NH 3
+Image Pixel Access
+.PP
+The IMFORT image pixel i/o procedures are used to get and put entire image
+lines to N-dimensional images, or to get and put N-dimensional subrasters
+to N-dimensional images.  In all cases the caller supplies a buffer into
+which the pixels are to be put, or from which the pixels are to be taken.
+The pixel i/o procedures are summarized in Figure 7.
+.PP
+As shown in the figure, there are four main classes of pixel i/o procedures,
+the get-line, put-line, get-section, and put-section procedures.  The get-line
+and put-line procedures are special cases of the get/put section procedures,
+provided for programming convenience in the usual line by line sequential
+image operator (they are also slightly more efficient than the subraster
+procedures for line by line i/o).  It is illegal to reference out of bounds
+and \fIi1\fR must be less than or equal to \fIi2\fR (IMFORT will not flip
+lines); the remaining subscripts may be swapped if desired.  Access may be
+completely random if desired, but sequential access (in storage order) implies
+fewer buffer faults and is more efficient.
+
+.KS
+.TS
+center;
+n.
+\fLim[gp]l1[rs] (\&im, buf, ier)\fR
+\fLim[gp]l2[rs] (\&im, buf, lineno, ier)\fR
+\fLim[gp]l3[rs] (\&im, buf, lineno, bandno, ier)\fR
+\fLim[gp]s1[rs] (\&im, buf, i1, i2, ier)\fR
+\fLim[gp]s2[rs] (\&im, buf, i1, i2, j1, j2, ier)\fR
+\fLim[gp]s3[rs] (\&im, buf, i1, i2, j1, j2, k1, k2, ier)\fR
+.TE
+.sp
+.ce
+Figure 7.  Image Pixel I/O Procedures
+.KE
+
+.PP
+Type short and type real versions of each i/o procedure are provided.
+The type real procedures may be used to access images of either type short
+or type real, with automatic datatype conversion being provided if the disk
+and program datatypes do not match.  The type short-integer i/o procedures
+may only be used with type short images.
+.PP
+The user who is familiar with the type of image i/o interface which maps
+the pixel array into virtual memory may wonder why IMFORT uses the more old
+fashioned buffered technique.  There are two major reasons why this approach
+was chosen.  Firstly, the virtual memory mapping technique, in common use on
+VMS systems, is \fInot portable\fR.  On a host which does not support the
+mapping of file segments into paged memory, the entire image must be copied
+into paged memory when the image is opened, then copied again when the image
+operation takes place, then copied once again from memory to disk when the
+image is closed.  Needless to say this is very inefficient, particularly for
+large images, and some of our applications deal with images 2048 or even 6000
+pixels square.
+.PP
+Even on a machine that supports mapping of file segments into memory, mapped
+access will probably not be efficient for sequential access to large images,
+since it causes the system to page heavily; data pages which will never be
+used again fill up the system page caches, displacing text pages that must
+then be paged back in.  This happens on even the best systems, and on a system
+that does not implement virtual memory efficiently, performance may suffer
+greatly.
+.PP
+A less obvious reason is that mapping the image directly into memory violates
+the principle of \fIdata independence\fR, i.e., a program which uses this
+type of interface has a builtin dependence on the particular physical image
+storage format in use when the program was developed.  This rules out even
+such simple interface features as automatic datatype conversion, and prevents
+the expansion of the interface in the future, e.g., to provide such attractive
+features as an image section capability (as in the real IRAF image interface),
+network access to images stored on a remote node, support for pixel storage
+schemes other than line storage mode (e.g., isotropic mappings or sparse image
+storage), and so on.  
+.PP
+The majority of image operations are either sequential whole-image operations
+or operations upon subrasters, and are just as easily programmed with a
+buffered interface as with a memory mapped interface.  The very serious
+drawbacks of the memory mapped interface dictate that it not be used except
+in special applications that must randomly access individual pixels in an
+image too large to be read in as a subraster.
+
+.NH 2
+Error Handling
+.PP
+The IMFORT error handling mechanism is extremely simple.  All procedures in
+which an error condition can occur return a nonzero \fIier\fR error code
+if an error occurs.  The value of \fIier\fR identifies which of many possible
+errors actually occurred.  These error codes may be converted into error
+message strings with the following procedure:
+.DS
+\fLimemsg (\&ier, errmsg)\fR
+.DE
+It is suggested that every main program contain an error handling section at
+the end of the program which calls \fIimemsg\fR and halts program execution
+with an informative error message, as in the examples in \(sc2.
+This is especially helpful when debugging new programs.
+
+.NH 2
+Vector Operators
+.PP
+The vector operators (VOPS) package is a subroutine library implementing
+a large number of primitive operations upon one dimensional vectors of any
+datatype.  Some of the operations implemented by the VOPS routines are
+non-trivial to implement, in which case the justification for a library
+subroutine is clear.  Even in the simplest cases, however, the use of a
+VOPS procedure is advantageous because it provides scope for optimizing
+all programs which use the VOPS operator, without having to modify the
+calling programs.  For example, if the host machine has vector hardware
+or special machine instructions (e.g., the block move and bitfield instructions
+of the VAX), the VOPS operator can be optimized in a machine dependent way
+to take advantage of the special capabilities of the hardware, without
+compromising the portability of the applications software using the procedure.
+.PP
+The VOPS procedures adhere to the naming convention described in \(sc4.
+The package prefix is \fIa\fR, the function code is always three characters,
+and the remaining one or two characters define the datatype or types upon
+which the procedure operates.  For example, \fIaaddr\fR performs a vector
+add upon type real operands.  If the character \fIk\fR is added to the
+three character function name, one of the operands will be a scalar.
+For example, \fIaaddkr\fR adds a scalar to a vector, with both the scalar
+and the vector being of type real.
+.PP
+Most vector operators operate upon operands of a single datatype: one notable
+exception is the \fIacht\fR (change datatype) operator, used to convert a
+vector from one datatype to another.  For example, \fIachtbi\fR will unpack
+each byte in a byte array into an integer in the output array, providing a
+capability that cannot be implemented in portable Fortran.  Any datatype
+suffix characters may be substituted for the \fIbi\fR, to convert a vector
+from any datatype to any other datatype.
+.PP
+In general, there are are three main classes of vector operators, the
+\fIunary\fR operators, the \fIbinary\fR operators, and the \fIprojection\fR
+operators.  The unary operators perform some operation upon a single input
+vector, producing an output vector as the result.  The binary operators
+perform some operation upon two input vectors, producing an output vector
+as the result.  The projection operators compute some function of a single
+input vector, producing a scalar function value (rather than a vector) as
+the result.  Unary operators typically have three arguments, binary
+operators four, and projection operators two arguments and one output
+function value.  For example, \fIaabsi\fR is the unary absolute value
+vector operator, type integer (here, \fIa\fR is the input vector, \fIb\fR
+is the output vector, and \fInpix\fR is the number of vector elements):
+.DS
+\fLaabsi (a, b, npix)\fR
+.DE
+A typical example of a binary operator is the vector add operator, \fIaaddr\fR.
+Here, \fIa\fR and \fIb\fR are the input vectors, and \fIc\fR is the output
+vector:
+.DS
+\fLaaddr (a, b, c, npix)\fR
+.DE
+In all cases except where the output vector contains fewer elements than one
+of the input vectors, the output vector may be the same as one of the input
+vectors.  A full range of datatypes are provided for each vector operator,
+except that there are no boolean vector operators (integer is used instead),
+and \fIchar\fR and \fIcomplex\fR are only partially implemented, since they
+are not sensible datatypes for many vector operations.  In any case, the VOPS
+\fIchar\fR is the SPP char and should be avoided in Fortran programs.
+.PP
+Once these rules are understood, the calling sequence of a particular VOPS
+operator can usually be predicted with little effort.  The more complex
+operators, of course, may have special arguments, and some study is typically
+required to determine their exact function and how they are used.  A list of
+the VOPS operators currently provided is given below (the datatype suffix
+characters must be added to the names shown to form the full procedure names).
+
+.TS
+center;
+n.
+aabs -\& Absolute value of a vector
+aadd -\& Add two vectors
+aaddk -\& Add a vector and a scalar
+aand -\& Bitwise boolean AND of two vectors
+aandk -\& Bitwise boolean AND of a vector and a scalar
+aavg -\& Compute the mean and standard deviation of a vector
+abav -\& Block average a vector
+abeq -\& Vector equals vector
+abeqk -\& Vector equals scalar
+abge -\& Vector greater than or equal to vector
+abgek -\& Vector greater than or equal to scalar
+abgt -\& Vector greater than vector
+abgtk -\& Vector greater than scalar
+able -\& Vector less than or equal to vector
+ablek -\& Vector less than or equal to scalar
+ablt -\& Vector less than vector
+abltk -\& Vector less than scalar
+abne -\& Vector not equal to vector
+abnek -\& Vector not equal to scalar
+abor -\& Bitwise boolean OR of two vectors
+abork -\& Bitwise boolean OR of a vector and a scalar
+absu -\& Block sum a vector
+acht -\& Change datatype of a vector
+acjgx -\& Complex conjugate of a complex vector
+aclr -\& Clear (zero) a vector
+acnv -\& Convolve two vectors
+acnvr -\& Convolve a vector with a real kernel
+adiv -\& Divide two vectors
+adivk -\& Divide a vector by a scalar
+adot -\& Dot product of two vectors
+advz -\& Vector divide with divide by zero detection
+aexp -\& Vector to a real vector exponent
+aexpk -\& Vector to a real scalar exponent
+afftr -\& Forward real discrete fourier transform
+afftx -\& Forward complex discrete fourier transform
+aglt -\& General piecewise linear transformation
+ahgm -\& Accumulate the histogram of a series of vectors
+ahiv -\& Compute the high (maximum) value of a vector
+aiftr -\& Inverse real discrete fourier transform
+aiftx -\& Inverse complex discrete fourier transform
+aimg -\& Imaginary part of a complex vector
+alim -\& Compute the limits (minimum and maximum values) of a vector
+alln -\& Natural logarithm of a vector
+alog -\& Logarithm of a vector
+alov -\& Compute the low (minimum) value of a vector
+altr -\& Linear transformation of a vector
+alui -\& Vector lookup and interpolate (linear)
+alut -\& Vector transform via lookup table
+amag -\& Magnitude of two vectors (sqrt of sum of squares)
+amap -\& Linear mapping of a vector with clipping
+amax -\& Vector maximum of two vectors
+amaxk -\& Vector maximum of a vector and a scalar
+amed -\& Median value of a vector
+amed3 -\& Vector median of three vectors
+amed4 -\& Vector median of four vectors
+amed5 -\& Vector median of five vectors
+amgs -\& Magnitude squared of two vectors (sum of squares)
+amin -\& Vector minimum of two vectors
+amink -\& Vector minimum of a vector and a scalar
+amod -\& Modulus of two vectors
+amodk -\& Modulus of a vector and a scalar
+amov -\& Move (copy or shift) a vector
+amovk -\& Move a scalar into a vector
+amul -\& Multiply two vectors
+amulk -\& Multiply a vector and a scalar
+aneg -\& Negate a vector (change the sign of each pixel)
+anot -\& Bitwise boolean NOT of a vector
+apkx -\& Pack a complex vector given the real and imaginary parts
+apol -\& Polynomial evaluation
+apow -\& Vector to an integer vector power
+apowk -\& Vector to an integer scalar power
+arav -\& Mean and standard deviation of a vector with pixel rejection
+arcp -\& Reciprocal of a scalar and a vector
+arcz -\& Reciprocal with detection of divide by zero
+arlt -\& Vector replace pixel if less than scalar
+argt -\& Vector replace pixel if greater than scalar
+asel -\& Vector select from two vectors based on boolean flag vector
+asok -\& Selection of the Kth smallest element of a vector
+asqr -\& Square root of a vector
+asrt -\& Sort a vector in order of increasing pixel value
+assq -\& Sum of squares of a vector
+asub -\& Subtract two vectors
+asubk -\& Subtract a scalar from a vector
+asum -\& Sum of a vector
+aupx -\& Unpack the real and imaginary parts of a complex vector
+awsu -\& Weighted sum of two vectors
+awvg -\& Mean and standard deviation of a windowed vector
+axor -\& Bitwise boolean XOR (exclusive or) of two vectors
+axork -\& Bitwise boolean XOR (exclusive or) of a vector and a scalar
+.TE
+
+.PP
+A non-trivial example of the use of vector operators is the case of bilinear
+interpolation on a two dimensional image.  The value of each pixel in the
+output image is a linear sum of the values of four pixels in the input image.
+The obvious solution is to set up a do-loop over the pixels in each line of
+the output image, computing the linear sum over four pixels from the input
+image for each pixel in the output line; this is repeated for each line in the
+output image.
+.PP
+The solution using the VOPS operators involves the \fIalui\fR (vector look up
+and interpolate) and \fIawsu\fR (weighted sum) vector operators.  A lookup table
+defining the X-coordinate in the input image of each pixel in a line of the
+output image is first generated.  Then, for each line of the output image,
+the two lines from the input image which will contribute to the output image
+line are extracted.  \fIAlui\fR is used to interpolate each line in X, then
+\fIawsu\fR is used to form the weighted sum to interpolate in the Y direction.
+This technique is especially efficient when bilinear interpolation is being
+used to expand the image, in which case the \fIalui\fR interpolated X-vectors,
+for example, are computed once but then used to generate several lines of
+the output image by taking the weighted sum, a simple and fast operation.
+When moving sequentially up through the image, the high X-vector becomes the
+low X-vector for the next pair of input lines, hence only a single call to
+\fIalui\fR is required to set up the next region.
+.PP
+The point of this example is that many or most image operations can be
+expressed in terms of primitive one dimensional vector operations,
+regardless of the dimensionality of the image being operated upon.
+The resultant algorithm will often run more efficiently even on a conventional
+scalar machine than the equivalent nonvectorized code, and will probably run
+efficiently without modification on a vector machine.
+.PP
+Detailed specification sheets (manual pages) are not currently available for
+the VOPS procedures.  A summary of the calling sequences is given in the file
+\fLvops$vops.syn\fR, which can be paged or printed by that name while in the
+CL, assuming that the system has not been stripped and that the sources are
+still on line.  The lack of documentation is really not a problem for these
+operators, since they are all fairly simple, and it is easy to page the source
+file (in the \fIvops\fR directory) to determine the exact calling sequence.
+For example, to examine the source for \fIawsu\fR, type
+.DS
+\fLcl> page vops$awsu.gx\fR
+.DE
+to page the generic source, regardless of the specific datatype of interest.
+If you have trouble deciphering the generic source,
+use \fLxc -f file.x\fR to produce the Fortran translation
+of one of the type specific files in the subdirectories
+\fLvops$ak\fR and \fLvops$lz\fR.
+
+.NH 2
+Binary File I/O (BFIO)
+.PP
+The IMFORT binary file i/o package (BFIO) is a small package, written
+originally as an internal package for use by the IMFORT image i/o routines
+for accessing header and pixel files (the VOS FIO package could not be used
+in IMFORT without linking the entire IRAF/VOS runtime system into the Fortran
+program).  Despite its original conception as an internal package, the package
+provides a useful capability and is portable, hence has been included in the
+IMFORT interface definition.  Nonetheless, the user should be warned that BFIO
+is a fairly low level interface and some care is required to use it safely.
+If other suitable facilities are available it may be better to use those,
+although few interfaces will be found which are simpler or more efficient
+than BFIO for randomly accessing pre-existing or preallocated binary files.
+.PP
+The principal capability provided by BFIO is the ability to randomly access
+a binary file, reading or writing an arbitrary number of char-units of storage
+at any (one-indexed) char offset in the file.  The file itself is a non-record
+structured file containing no embedded record manager information,
+hence is suitable for access by any program, including non-Fortran programs,
+and for export to other machines (this is usually not the case with a Fortran
+unformatted direct access file).  Unlike the mainline IMFORT procedures,
+many of the BFIO procedures are integer functions returning a positive count
+value if the operation is successful (e.g., the number of char units of storage
+read or written), or a negative value if an error occurs.  Zero is returned
+for a read at end of file.
+
+.TS
+center;
+n.
+\fLbfaloc (\&fname, nchars, status)\fR
+\fLfd = bfopen (\&fname, acmode, advice)   \fRacmode: 1=RO,3=RW,5=NF
+\fLbfclos (\&fd, status)              \fRadvice: 1=random,2=seq
+
+\fLnchars = bfread (\&fd, buf, nchars, offset)\fR
+\fLnchars = bfwrit (\&fd, buf, nchars, offset)\fR
+
+\fLnchars = bfbsiz (\&fd)\fR
+\fLnchars = bffsiz (\&fd)\fR
+\fLchan = bfchan (\&fd)\fR
+\fLstat = bfflsh (\&fd)\fR
+.TE
+.sp
+.ce
+Figure 8.  Low Level Binary File I/O Procedures
+
+.PP
+BFIO binary files may be preallocated with \fIbfaloc\fR, or created with
+\fIbfopen\fR and then initialized by writing at the end of file.
+Preallocating a file is useful when the file size is known in advance, e.g.,
+when creating the pixel file for a new image.  The contents of a file
+allocated with \fIbfaloc\fR are uninitialized.  To extend a file by writing
+at the end of file the file size must be known; the file size may be obtained
+by calling \fIbffsiz\fR on the open file.
+.PP
+Before i/o to a file can occur, the file must be opened with \fIbfopen\fR.
+The \fIbfopen\fR procedure returns as its function value an integer
+\fIfile descriptor\fR which is used to refer to the file in all subsequent
+accesses until the file is closed with \fIbfclos\fR.  Binary data is read
+from the file with \fIbfread\fR, and written to the file with \fIbfwrit\fR.
+Any amount of data may be read or written in a single call to \fIbfread\fR
+or \fIbfwrit\fR.  All user level i/o is synchronous and data is buffered
+internally by BFIO to minimize disk transfers and provide for the blocking
+and deblocking of data into device blocks.  Any buffered output data may be
+flushed to disk with \fIbfflsh\fR.  The function \fIbfchan\fR returns the
+descriptor of the raw i/o channel as required by the IRAF binary file driver.
+.PP
+BFIO manages an internal buffer, necessary for efficient sequential i/o and
+to hide the device block size from the user program.  Larger buffers are
+desirable for sequential i/o on large files; smaller buffers are best for
+small files or for randomly accessing large files.  The buffer size may be
+set at \fIbfopen\fR time with the \fIadvice\fR parameter.  An \fIadvice\fR
+value of 1 implies random access and causes a small buffer to be allocated;
+a value of 2 implies sequential access and causes a large buffer to be
+allocated.  Any other value is taken to be the actual buffer size in chars,
+but care must be used since the value specified must be some multiple of the
+device block size, and less than the maximum transfer size permitted by the
+kernel file driver.  Note that when writing at end of file, the full contents
+of the internal buffer will be written, even if the entire buffer contents
+were not written into in a \fIbfwrit\fR call.  The buffer size in chars is
+returned by \fIbfbsiz\fR.
+.PP
+Since BFIO is a low level interface, the file offset must always be specified
+when reading from or writing to the file, even when the file is being accessed
+sequentially.  Contrary to what one might think, file offsets are one-indexed
+in the Fortran tradition, and are specified in units of \fIchars\fR.
+Do not confuse \fIchar\fR with the Fortran \fLCHARACTER\fR; \fIchar\fR is the
+fundamental unit of storage in IRAF, the smallest datum which can be accessed
+as an integer quantity with the host Fortran compiler, normally
+\fLINTEGER\(**2\fR (16 bits or two bytes on all current IRAF hosts).
+
+.bp
+.SH
+Appendix:  Manual Pages for the Imfort Procedures
+.PP
+This section presents the ``manual pages'' for the IMFORT and BFIO procedures.
+The manual pages present the exact technical specifications of each procedure,
+i.e., the procedure name and arguments (not necessarily obvious in the case of
+a typed family of procedures), the datatypes and dimensions of the arguments,
+and a precise description of the operation of the procedure.
+Each procedure is presented on a separate page for ease of reference.
+.PP
+The following conventions have been devised to organize the information
+presented in this section:
+.RS
+.IP \(bu
+The manual pages are presented in alphabetical order indexed by the procedure
+name.
+.IP \(bu
+A single manual page is used to present an entire family of procedures which
+differ only in the datatype of their primary operand.  The name on the manual
+page is the generic name of the family, e.g., \fIclargi\fR, \fIclargr\fR, etc.,
+are described in the manual page \fIclarg\fR.
+.IP \(bu
+In some cases it makes sense to describe several related procedures with a
+single manual page.  An example is the keyword-list package, consisting of
+the procedures \fIimokwl\fR, \fIimgnkw\fR, and \fIimckwl\fR.  In such a case,
+since the procedures have different names the manual page for the group is
+duplicated for each procedure in the group, so that the user will not have
+to guess which name the manual page is filed under.
+.IP \(bu
+The \fIsynopsis\fR section of each manual page defines the calling sequence of
+each procedure, the datatypes and dimensions of the arguments, and notes
+whether each argument is an input argument (\fL#I\fR) or an output argument
+(\fL#O\fR).
+.IP \(bu
+The \fIreturn value\fR section describes the conditions required for
+successful execution of the procedure, normally indicated by a zero status
+in \fIier\fR.  A symbolic list of the possible error codes is also given.
+The numeric values of these error codes are defined in \fLimfort$imfort.h\fR
+and in \fLlib$syserr.h\fR, but the exact numeric codes should be used only for
+debugging purposes or passed on to the \fIimemsg\fR procedure to get the error
+message string.  The numeric error codes are likely to change in future versions
+of the interface hence their values should not be "wired into" programs.
+.RE
+.PP
+Manual pages for the VOPS procedures are not included since VOPS is not really
+part of the IMFORT interface, and it is not yet clear if the VOPS procedures
+are complex enough to justify the production of individual manual pages.
diff --git a/sys/imfort/doc/imfort.toc b/sys/imfort/doc/imfort.toc
new file mode 100644
index 00000000..b68c5b69
--- /dev/null
+++ b/sys/imfort/doc/imfort.toc
@@ -0,0 +1,54 @@
+.LP
+.ps +2
+.ce
+\fBContents\fR
+.ps
+.sp 3
+.sp
+1.\h'|0.4i'\fBIntroduction\fP\l'|5.6i.'\0\01
+.br
+\h'|0.4i'1.1.\h'|0.9i'Who Should Use IMFORT\l'|5.6i.'\0\01
+.sp
+2.\h'|0.4i'\fBGetting Started\fP\l'|5.6i.'\0\03
+.br
+\h'|0.4i'2.1.\h'|0.9i'Example 1:  Plotting a function\l'|5.6i.'\0\03
+.br
+\h'|0.4i'2.2.\h'|0.9i'Example 2:  Compute the range of pixel values in an image\l'|5.6i.'\0\06
+.br
+\h'|0.4i'2.3.\h'|0.9i'Example 3:  Copy an image\l'|5.6i.'\0\07
+.sp
+3.\h'|0.4i'\fBThe IMFORT Programming Environment\fP\l'|5.6i.'\0\09
+.br
+\h'|0.4i'3.1.\h'|0.9i'The FC Compile/Link Utility\l'|5.6i.'\0\09
+.br
+\h'|0.4i'3.2.\h'|0.9i'Host Level Linking to the IMFORT Libraries\l'|5.6i.'\0\11
+.br
+\h'|0.4i'3.3.\h'|0.9i'Calling Host Programs from the CL\l'|5.6i.'\0\11
+.br
+\h'|0.9i'3.3.1.\h'|1.5i'Example 1 Revisited\l'|5.6i.'\0\13
+.br
+\h'|0.4i'3.4.\h'|0.9i'Debugging IMFORT Programs\l'|5.6i.'\0\14
+.br
+\h'|0.4i'3.5.\h'|0.9i'Calling IMFORT from Languages other than Fortran\l'|5.6i.'\0\15
+.br
+\h'|0.4i'3.6.\h'|0.9i'Avoiding Library Name Collisions\l'|5.6i.'\0\15
+.sp
+4.\h'|0.4i'\fBThe IMFORT Library\fP\l'|5.6i.'\0\16
+.br
+\h'|0.4i'4.1.\h'|0.9i'Command Line Access\l'|5.6i.'\0\17
+.br
+\h'|0.4i'4.2.\h'|0.9i'Image Access\l'|5.6i.'\0\17
+.br
+\h'|0.9i'4.2.1.\h'|1.5i'General Image Access Procedures\l'|5.6i.'\0\18
+.br
+\h'|0.9i'4.2.2.\h'|1.5i'Image Header Keyword Access\l'|5.6i.'\0\19
+.br
+\h'|0.9i'4.2.3.\h'|1.5i'Image Pixel Access\l'|5.6i.'\0\20
+.br
+\h'|0.4i'4.3.\h'|0.9i'Error Handling\l'|5.6i.'\0\22
+.br
+\h'|0.4i'4.4.\h'|0.9i'Vector Operators\l'|5.6i.'\0\22
+.br
+\h'|0.4i'4.5.\h'|0.9i'Binary File I/O (BFIO)\l'|5.6i.'\0\26
+.sp
+\h'|0.4i'\fBAppendix A:\fR  Manual Pages for the IMFORT Procedures\l'|5.6i.'\0\28
diff --git a/sys/imfort/doc/imgkw.hlp b/sys/imfort/doc/imgkw.hlp
new file mode 100644
index 00000000..412113da
--- /dev/null
+++ b/sys/imfort/doc/imgkw.hlp
@@ -0,0 +1,41 @@
+.help imgkw Sep86 imfort
+.ih
+NAME
+imgkw -- get the value of an image header keyword
+.ih
+SYNOPSIS
+.nf
+subroutine imgkwb (im, keyw, bval, ier)
+subroutine imgkwc (im, keyw, cval, ier)
+subroutine imgkwi (im, keyw, ival, ier)
+subroutine imgkwr (im, keyw, rval, ier)
+subroutine imgkwd (im, keyw, dval, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of the keyword to be set
+integer		ier		#O status return
+
+logical		bval		#O logical (boolean) keyword value
+character*(*)	cval		#O character string keyword value
+integer		ival		#O integer keyword value
+real		rval		#O real keyword value
+doubleprecision	dval		#O double precision keyword value
+.fi
+.ih
+DESCRIPTION
+The \fIimgkw\fR procedures are used to get the values of image header keywords.
+Automatic datatype conversion is provided, hence the datatype requested need
+not be an exact match to the actual datatype of the keyword.
+.ih
+RETURN VALUE
+A zero status is returned if the named keyword exists and if the datatype
+coercion implied is permissible.
+
+.nf
+SYS_IDBKEYNF:	image header keyword not found
+SYS_IDBTYPE:	illegal header parameter data type conversion
+.fi
+.ih
+SEE ALSO
+impkw, imaddk, imacck
+.endhelp
diff --git a/sys/imfort/doc/imgl.hlp b/sys/imfort/doc/imgl.hlp
new file mode 100644
index 00000000..389031ae
--- /dev/null
+++ b/sys/imfort/doc/imgl.hlp
@@ -0,0 +1,48 @@
+.help imgl Sep86 imfort
+.ih
+NAME
+.nf
+imgl -- get (read) an image line
+.fi
+.ih
+SYNOPSIS
+.nf
+subroutine imgl1r (im, rbuf, ier)
+subroutine imgl1s (im, sbuf, ier)
+subroutine imgl2r (im, rbuf, lineno, ier)
+subroutine imgl2s (im, sbuf, lineno, ier)
+subroutine imgl3r (im, rbuf, lineno, bandno, ier)
+subroutine imgl3s (im, sbuf, lineno, bandno, ier)
+
+integer		im		#I image descriptor of open image
+real		rbuf(*)		#O output pixel buffer, type real
+integer*2	sbuf(*)		#O output pixel buffer, type short
+integer		lineno		#I line (row) number (1:axlen(2))
+integer		bandno		#I band number (1:axlen(3))
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimgl\fR procedures are used to get a line (row) from an image.
+Procedures are provided for images of from one to three dimensions,
+of pixel type short integer or real.  The type real procedures may be
+applied to images of either type, but the type short procedures may only
+be used to access images of type short.  The output buffer must provide
+storage for at least \fIaxlen(1)\fR pixels or a buffer overrun will occur.
+.ih
+RETURN VALUE
+A zero status is returned if the referenced image line is in-bounds and
+the actual pixel datatype of the image is one of the types permitted by
+the particular operator called.
+
+.nf
+IE_NOTSHORT:	imfort short integer i/o requires a type short image
+IE_PIXTYPE:	image pixel type must be short or real
+IE_RDPIX:	error reading image pixel file
+IE_YOOB:	image y coordinates out of range
+IE_ZOOB:	image z coordinates out of range
+.fi
+.ih
+SEE ALSO
+impl, imgs, imps
+.endhelp
diff --git a/sys/imfort/doc/imgs.hlp b/sys/imfort/doc/imgs.hlp
new file mode 100644
index 00000000..73ba756b
--- /dev/null
+++ b/sys/imfort/doc/imgs.hlp
@@ -0,0 +1,54 @@
+.help imgs Sep86 imfort
+.ih
+NAME
+.nf
+imgs -- get (read) an image section
+.fi
+.ih
+SYNOPSIS
+.nf
+subroutine imgs1r (im, rbuf, i1,i2, ier)
+subroutine imgs1s (im, sbuf, i1,i2, ier)
+subroutine imgs2r (im, rbuf, i1,i2, j1,j2, ier)
+subroutine imgs2s (im, sbuf, i1,i2, j1,j2, ier)
+subroutine imgs3r (im, rbuf, i1,i2, j1,j2, k1,k2, ier)
+subroutine imgs3s (im, sbuf, i1,i2, j1,j2, k1,k2, ier)
+
+integer		im		#I image descriptor of open image
+real		rbuf(*)		#O output pixel buffer, type real
+integer*2	sbuf(*)		#O output pixel buffer, type short
+integer		i1, i2		#I range of columns to be extracted
+integer		j1, j2		#I range of lines to be extracted
+integer		k1, k2		#I range of bands to be extracted
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimgs\fR procedures are used to get a section (subraster) from an image.
+Procedures are provided for images of from one to three dimensions,
+of pixel type short integer or real.  The type real procedures may be
+applied to images of either type, but the type short procedures may only
+be used to access images of type short.  The output buffer must provide
+space for at least (i1-i2+1) pixels (\fIgs1\fR), ((j2-j1+1) * (i2-i1+1)) pixels
+(\fIgs2\fR), or ((k2-k1+1) * (j2-j1+1) * (i2-i1+1)) pixels (\fIgs3\fR).
+The pixels are returned in Fortran storage order.  The column index \fIi2\fR
+must be greater than or equal to \fIi1\fR, but the remaining subscripts may
+be swapped if desired.
+.ih
+RETURN VALUE
+A zero status is returned if the referenced image section is in-bounds and
+the actual pixel datatype of the image is one of the types permitted by
+the particular operator called.
+
+.nf
+IE_NOTSHORT:	imfort short integer i/o requires a type short image
+IE_PIXTYPE:	image pixel type must be short or real
+IE_RDPIX:	error reading image pixel file
+IE_XOOB:	image x coordinates out of range or out of order
+IE_YOOB:	image y coordinates out of range
+IE_ZOOB:	image z coordinates out of range
+.fi
+.ih
+SEE ALSO
+imps, imgl, impl
+.endhelp
diff --git a/sys/imfort/doc/imgsiz.hlp b/sys/imfort/doc/imgsiz.hlp
new file mode 100644
index 00000000..bd2e3972
--- /dev/null
+++ b/sys/imfort/doc/imgsiz.hlp
@@ -0,0 +1,51 @@
+.help imgsiz Sep86 imfort
+.ih
+NAME
+imgsiz -- determine the size and datatype of an open image
+.ih
+SYNOPSIS
+.nf
+subroutine imgsiz (im, axlen, naxis, dtype, ier)
+
+integer		im		#I image descriptor of open image
+integer		axlen(7)	#O length of each axis
+integer		naxis		#O number of axes (dimensionality)
+integer		dtype		#O pixel datatype
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimgsiz\fR procedure is called to determine the dimensionality, size,
+and datatype of an open image, i.e., the physical attributes of the pixel
+array.  Upon output, \fIaxlen\fR will contain the length of each axis of
+the image, where \fIaxlen(1)\fR is the number of pixels in each image line
+(the number of columns), \fIaxlen(2)\fR is the number of lines in each band
+of the image, \fIaxlen(3)\fR is the number of bands, and so on.
+Seven array elements are returned regardless of the actual dimensionality of
+the image; the lengths of the excess axes are set to one.  The logical
+dimensionality of the image is returned in \fInaxis\fR.  A code identifying
+the datatype of the pixels is returned in \fIpixtype\fR; the range of possible
+pixel datatypes is enumerated in the table below.
+
+.nf
+	3	short integer (usually 16 bits signed)
+	4	integer (generally the same as long integer)
+	5	long integer (usually 32 bits signed)
+	6	single precision floating (real)
+	7	double precision floating
+	8	complex
+       11	unsigned short (16 bits unsigned)
+.fi
+
+Note that although the image storage format may support all of these datatypes,
+IMFORT is currently only capable of accessing images of type short or real.
+.ih
+RETURN VALUE
+A zero status is returned for any valid open image, i.e., provided the image
+descriptor given is valid.
+
+IE_MAGIC:	illegal imfort image descriptor
+.ih
+SEE ALSO
+imgkwi, imcrea
+.endhelp
diff --git a/sys/imfort/doc/imhcpy.hlp b/sys/imfort/doc/imhcpy.hlp
new file mode 100644
index 00000000..3a36816d
--- /dev/null
+++ b/sys/imfort/doc/imhcpy.hlp
@@ -0,0 +1,30 @@
+.help imhcpy Sep86 imfort
+.ih
+NAME
+imhcpy -- copy an image header
+.ih
+SYNOPSIS
+.nf
+subroutine imhcpy (oim, nim, ier)
+
+integer		oim		#I image descriptor of input image
+integer		nim		#I image descriptor of output image
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimhcpy\fR procedure is used to copy the non-pixel fields in the header
+of one image to another image, given the runtime descriptors of the two images.
+The images must previously have been opened with \fIimopen\fR or \fIimopnc\fR.
+The header fields which are \fInot\fR copied are those describing the physical
+attributes the pixel array, i.e., the number of axes, the physical dimensions
+of the image, the pixel datatype code, and the minimum and maximum pixel values.
+.ih
+RETURN VALUE
+A zero status will be returned provided both image descriptors are valid.
+
+IE_MAGIC:	illegal imfort image descriptor
+.ih
+SEE ALSO
+imgsiz, imgkw, impkw
+.endhelp
diff --git a/sys/imfort/doc/imokwl.hlp b/sys/imfort/doc/imokwl.hlp
new file mode 100644
index 00000000..6e860cb7
--- /dev/null
+++ b/sys/imfort/doc/imokwl.hlp
@@ -0,0 +1,65 @@
+.help imokwl,imgnkw,imckwl Sep86 imfort
+.ih
+NAME
+.nf
+imokwl -- open an image header keyword list
+imgnkw -- get the next keyword from the list
+imckwl -- close the keyword list
+.fi
+.ih
+SYNOPSIS
+.nf
+subroutine imokwl (im, patstr, sortit, kwl, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	patstr		#I pattern matching subset of keywords
+logical		sortit		#I sort the list by keyword name?
+integer		kwl		#O keyword list descriptor
+integer		ier		#O status return
+
+subroutine imgnkw (kwl, outstr, ier)
+
+integer		kwl		#I keyword list descriptor
+character*(*)	outstr		#O the next keyword name
+integer		ier		#O status return
+
+subroutine imckwl (kwl, ier)
+
+integer		kwl		#I keyword list descriptor
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The keyword list package is used to define some subset of the keywords in an
+image header, and then read successive elements of the set, i.e., read back
+the keyword names.  The keyword names are normally used as input to
+\fIimtypk\fR or one of the \fIimgkw\fR procedures to obtain additional
+information about each keyword.  The keyword list package is the only means
+whereby a program can examine the contents of an image header without knowing
+in advance the names of the individual header keywords.  A typical application
+of the keyword list package is listing the contents of an image header.
+
+The pattern string \fIpatstr\fR is used to specify the subset of header keywords
+to be used to form the output list.  Some useful values are "*", which returns
+the names of all header keywords, and "i_", which returns the names of only the
+standard header keywords.  If the pattern string does not contain any pattern
+matching meta-characters it is treated as a prefix string (e.g., as "^patstr*").
+.ih
+RETURN VALUE
+The \fIimokwl\fR procedure returns a nonzero status only if it runs out of
+storage for the keyword list.  It is not an error for a list to be empty.
+The \fIimgnkw\fR procedure returns a nonzero status when the end of the
+keyword list is reached.
+
+.nf
+SYS_IMFNOVFL:	out of space for header keyword name list
+IE_EOF:		end of file or list detected
+.fi
+.ih
+NOTES
+An example illustrating the use of the keyword list package may be found
+in imfort$tasks/phead.f.
+.ih
+SEE ALSO
+imtypk, imgkw
+.endhelp
diff --git a/sys/imfort/doc/imopen.hlp b/sys/imfort/doc/imopen.hlp
new file mode 100644
index 00000000..3df3ca51
--- /dev/null
+++ b/sys/imfort/doc/imopen.hlp
@@ -0,0 +1,35 @@
+.help imopen Sep86 imfort
+.ih
+NAME
+imopen -- open an existing image
+.ih
+SYNOPSIS
+.nf
+subroutine imopen (image, acmode, im, ier)
+
+character*(*)	image		#I host image to be opened
+integer		acmode		#I access mode
+integer		im		#O receives image descriptor
+integer		ier		#O status code
+.fi
+.ih
+DESCRIPTION
+The \fIimopen\fR procedure is used to open an existing image for either
+read only access (\fIacmode\fR=1) or read write access (\fIacmode\fR=3).
+The image name must be the host system filename of the image, although
+the extension may be omitted if desired.  If the image open is successful
+an image descriptor is returned in \fIim\fR.
+.ih
+RETURN VALUE
+A nonzero status code is returned if the image does not exist or cannot
+be opened with the indicated access mode.
+
+.nf
+IE_OPEN:	cannot open image
+IE_NOTIMH:	attempt to access a non-image file as an image
+IE_OPNPIX:	cannot open pixel file
+.fi
+.ih
+SEE ALSO
+imclos, imcrea, imopnc, imdele, imrnam
+.endhelp
diff --git a/sys/imfort/doc/imopnc.hlp b/sys/imfort/doc/imopnc.hlp
new file mode 100644
index 00000000..b4f5d9a9
--- /dev/null
+++ b/sys/imfort/doc/imopnc.hlp
@@ -0,0 +1,49 @@
+.help imopnc Sep86 imfort
+.ih
+NAME
+imopnc -- open a new copy of an existing image
+.ih
+SYNOPSIS
+.nf
+imopnc (nimage, oim, nim, ier)
+
+character*(*)	nimage		#I host name of the new image
+integer		oim		#I image descriptor of existing image
+integer		nim		#O image descriptor of the new image
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimopnc\fR procedure is used to open a new copy of an existing image,
+copying the non-pixel fields of the old image header to the new image.
+The new image must be the same size and datatype as the old image.
+The new image is created, the header information is copied, and the pixel
+file is allocated, but no pixel data is copied, and the \fIdatamin\fR and
+\fIdatamax\fR fields of the image header are reset to zero.  The new image
+is opened for read-write access and the image descriptor of the new image
+is returned in \fInim\fR.
+.ih
+RETURN VALUE
+A zero status value is returned if the operation is successful, i.e., if
+\fIoim\fR is a valid image descriptor of an existing image already opened
+with \fIimopen\fR or \fIimopnc\fR, the new image was successfully created,
+and the header was successfully copied.
+
+.nf
+IE_ACCPIX:	error writing into pixel file during image create
+IE_ALCPIX:	cannot create or allocate space for pixel file
+IE_CREHDR:	cannot create image
+IE_MAGIC:	illegal imfort image descriptor
+IE_OPEN:	cannot open image
+IE_OPNPIX:	cannot open pixel file
+IE_UPDHDR:	error updating image header file
+.fi
+.ih
+NOTES
+If it is desired that the new image be of a different size or datatype than
+the old image, the new image must be explicitly created with \fIimcrea\fR,
+opened with \fIimopen\fR, and the old header copied with \fIimhcpy\fR.
+.ih
+SEE ALSO
+imcrea, imopen, imgsiz, imhcpy, imclos
+.endhelp
diff --git a/sys/imfort/doc/impixf.hlp b/sys/imfort/doc/impixf.hlp
new file mode 100644
index 00000000..b5ccb335
--- /dev/null
+++ b/sys/imfort/doc/impixf.hlp
@@ -0,0 +1,53 @@
+.help impixf Sep86 imfort
+.ih
+NAME
+impixf -- get the physical attributes of the pixel file
+.ih
+SYNOPSIS
+.nf
+subroutine impixf (im, pixfd, pixfil, pixoff, szline, ier)
+
+integer		im		#I image descriptor of open image
+integer		pixfd		#O BFIO file descriptor of pixel file
+character*(*)	pixfil		#O host filename of pixel file
+integer		pixoff		#O 1-indexed "char" offset of pixels
+integer		szline		#O "chars" per physical image line
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimpixf\fR procedure is used to obtain information describing the
+physical layout of the pixel segment of an image in a binary disk file.
+The pixel array of an image accessible via the IMFORT interface is stored
+externally in the host file \fIpixfil\fR in line storage mode (as in a
+Fortran array).  Each line of the image is stored as a contiguous array of
+pixels accessible via a BFIO \fIbfread\fR or \fIbfwrit\fR request at the
+offset of the first pixel in the line.  The first image line (beginning at
+pixel [1,1,1,...]) is stored at the file offset given by \fIpixoff\fR.
+Each line consumes exactly \fIszline\fR chars of storage; lines may be
+blocked to fill an integral number of disk blocks for more efficient access,
+hence \fIszline\fR is not directly computable from \fIaxlen(1)\fR.
+
+Since \fIimpixf\fR is called on an open image, the pixel file will already
+have been opened for random access buffered binary file i/o via the BFIO
+interface.  The BFIO file descriptor of the open pixel file is returned in
+\fIpixfd\fR.  This may be used in conjunction with BFIO to directly access
+the pixel data.  If the pixel data is to be accessed via explicit calls
+to lower level host system facilities, the image should first be closed
+with \fIimclos\fR to avoid possible problems with having the same file
+opened multiple times.
+.ih
+RETURN VALUE
+A zero status is returned for any image which has a valid image descriptor.
+
+IE_MAGIC:	illegal imfort image descriptor
+.ih
+NOTES
+Programs which make use of the information provided by \fIimpixf\fR have
+explicit knowledge of the physical image storage format and hence may not
+work with future versions of the IMFORT interface supporting new physical
+image storage formats.
+.ih
+SEE ALSO
+imgsiz, imgs, imps, imgl, impl, bfread, bfwrit
+.endhelp
diff --git a/sys/imfort/doc/impkw.hlp b/sys/imfort/doc/impkw.hlp
new file mode 100644
index 00000000..8381e828
--- /dev/null
+++ b/sys/imfort/doc/impkw.hlp
@@ -0,0 +1,51 @@
+.help impkw Sep86 imfort
+.ih
+NAME
+impkw -- set the value of an image header keyword
+.ih
+SYNOPSIS
+.nf
+subroutine impkwb (im, keyw, bval, ier)
+subroutine impkwc (im, keyw, cval, ier)
+subroutine impkwi (im, keyw, ival, ier)
+subroutine impkwr (im, keyw, rval, ier)
+subroutine impkwd (im, keyw, dval, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of the keyword to be set
+integer		ier		#O status return
+
+logical		bval		#I logical (boolean) keyword value
+character*(*)	cval		#I character string keyword value
+integer		ival		#I integer keyword value
+real		rval		#I real keyword value
+doubleprecision	dval		#I double precision keyword value
+.fi
+.ih
+DESCRIPTION
+The \fIimpkw\fR procedures are used to set the values of existing image
+header keywords.  It is an error if the named keyword does not already
+exist; the \fIimakw\fR procedures should be used if one wants the keyword
+to be automatically added if not found, but if the keyword is known
+to exist it is preferable to use the \fIimpkw\fR procedures since they
+are more efficient and will detect misspelled keyword names and foreign
+images.  Automatic datatype conversion is provided, i.e., it is not
+necessary to know the exact datatype of a keyword to update its value.
+.ih
+RETURN VALUE
+A zero status is returned if the named keyword exists, is writable, and if
+the datatype coercion implied is permissible.
+
+.nf
+SYS_IDBKEYNF:	image header keyword not found
+SYS_IDBTYPE:	illegal header parameter data type conversion
+.fi
+.ih
+NOTES
+It is not an error to update the value of a keyword in an image opened
+for read-only access, but an error status will be returned at \fIimclos\fR or
+\fIimflsh\fR time since the header cannot be updated on disk.
+.ih
+SEE ALSO
+imacck, imakw, imgkw
+.endhelp
diff --git a/sys/imfort/doc/impl.hlp b/sys/imfort/doc/impl.hlp
new file mode 100644
index 00000000..4081f69f
--- /dev/null
+++ b/sys/imfort/doc/impl.hlp
@@ -0,0 +1,49 @@
+.help impl Sep86 imfort
+.ih
+NAME
+.nf
+impl -- put (rewrite) an image line
+.fi
+.ih
+SYNOPSIS
+.nf
+subroutine impl1r (im, rbuf, ier)
+subroutine impl1s (im, sbuf, ier)
+subroutine impl2r (im, rbuf, lineno, ier)
+subroutine impl2s (im, sbuf, lineno, ier)
+subroutine impl3r (im, rbuf, lineno, bandno, ier)
+subroutine impl3s (im, sbuf, lineno, bandno, ier)
+
+integer		im		#I image descriptor of open image
+real		rbuf(*)		#I output pixel buffer, type real
+integer*2	sbuf(*)		#I output pixel buffer, type short
+integer		lineno		#I line (row) number (1:axlen(2))
+integer		bandno		#I band number (1:axlen(3))
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimpl\fR procedures are used to rewrite a line (row) of an image.
+Procedures are provided for images of from one to three dimensions,
+of pixel type short integer or real.  The type real procedures may be
+applied to images of either type, but the type short procedures may only
+be used to access images of type short.  The input buffer should contain
+\fIaxlen(1)\fR pixels ready to be written to the image when the \fIimpl\fR
+procedure is called.
+.ih
+RETURN VALUE
+A zero status is returned if the referenced image line is in-bounds and
+the actual pixel datatype of the image is one of the types permitted by
+the particular operator called.
+
+.nf
+IE_NOTSHORT:	imfort short integer i/o requires a type short image
+IE_PIXTYPE:	image pixel type must be short or real
+IE_WRPIX:	error writing image pixel file
+IE_YOOB:	image y coordinates out of range
+IE_ZOOB:	image z coordinates out of range
+.fi
+.ih
+SEE ALSO
+imgl, imgs, imps
+.endhelp
diff --git a/sys/imfort/doc/imps.hlp b/sys/imfort/doc/imps.hlp
new file mode 100644
index 00000000..6850f052
--- /dev/null
+++ b/sys/imfort/doc/imps.hlp
@@ -0,0 +1,54 @@
+.help imps Sep86 imfort
+.ih
+NAME
+.nf
+imps -- put (rewrite) an image section
+.fi
+.ih
+SYNOPSIS
+.nf
+subroutine imps1r (im, rbuf, i1,i2, ier)
+subroutine imps1s (im, sbuf, i1,i2, ier)
+subroutine imps2r (im, rbuf, i1,i2, j1,j2, ier)
+subroutine imps2s (im, sbuf, i1,i2, j1,j2, ier)
+subroutine imps3r (im, rbuf, i1,i2, j1,j2, k1,k2, ier)
+subroutine imps3s (im, sbuf, i1,i2, j1,j2, k1,k2, ier)
+
+integer		im		#I image descriptor of open image
+real		rbuf(*)		#I output pixel buffer, type real
+integer*2	sbuf(*)		#I output pixel buffer, type short
+integer		i1, i2		#I range of columns to be updated
+integer		j1, j2		#I range of lines to be updated
+integer		k1, k2		#I range of bands to be updated
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimps\fR procedures are used to rewrite a section (subraster) of an image.
+Procedures are provided for images of from one to three dimensions,
+of pixel type short integer or real.  The type real procedures may be
+applied to images of either type, but the type short procedures may only
+be used to access images of type short.  The output buffer should contain
+at least (i1-i2+1) pixels (\fIps1\fR), ((j2-j1+1) * (i2-i1+1)) pixels
+(\fIps2\fR), or ((k2-k1+1) * (j2-j1+1) * (i2-i1+1)) pixels (\fIps3\fR).
+The pixels are assumed to be in Fortran storage order.  The column index
+\fIi2\fR must be greater than or equal to \fIi1\fR, but the remaining
+subscripts may be swapped if desired.
+.ih
+RETURN VALUE
+A zero status is returned if the referenced image line is in-bounds and
+the actual pixel datatype of the image is one of the types permitted by
+the particular operator called.
+
+.nf
+IE_NOTSHORT:	imfort short integer i/o requires a type short image
+IE_PIXTYPE:	image pixel type must be short or real
+IE_WRPIX:	error writing image pixel file
+IE_XOOB:	image x coordinates out of range or out of order
+IE_YOOB:	image y coordinates out of range
+IE_ZOOB:	image z coordinates out of range
+.fi
+.ih
+SEE ALSO
+imgs, imgl, impl
+.endhelp
diff --git a/sys/imfort/doc/imrnam.hlp b/sys/imfort/doc/imrnam.hlp
new file mode 100644
index 00000000..03ba6d6b
--- /dev/null
+++ b/sys/imfort/doc/imrnam.hlp
@@ -0,0 +1,35 @@
+.help imrnam Sep86 imfort
+.ih
+NAME
+imrnam -- rename an image
+.ih
+SYNOPSIS
+.nf
+subroutine imrnam (oldnam, newnam, ier)
+
+character*(*)	oldnam		#I host name of existing image
+character*(*)	newnam		#I new host name for image
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimrnam\fR procedure renames an image, i.e., changes the filenames
+of both the header and pixel files.  An image may be renamed to a different
+directory if desired, in effect moving the image to the new directory.
+.ih
+RETURN VALUE
+A zero status is returned if the image exists and was successfully renamed.
+
+.nf
+IE_IMRNAMNEXIM:	attempt to rename a nonexistent image
+IE_IMRENAME:	cannot rename image
+.fi
+.ih
+NOTES
+Since the filename of the pixel file associated with an image may be
+saved in the image header, it is not advisable to use an ordinary file
+rename operator to rename an image.
+.ih
+SEE ALSO
+imdele, imcrea
+.endhelp
diff --git a/sys/imfort/doc/imtypk.hlp b/sys/imfort/doc/imtypk.hlp
new file mode 100644
index 00000000..b8f3b4b0
--- /dev/null
+++ b/sys/imfort/doc/imtypk.hlp
@@ -0,0 +1,33 @@
+.help imtypk Sep86 imfort
+.ih
+NAME
+imtypk -- get the type information for a header keyword
+.ih
+SYNOPSIS
+.nf
+subroutine imtypk (im, keyw, dtype, comm, ier)
+
+integer		im		#I image descriptor of open image
+character*(*)	keyw		#I name of the new keyword
+integer		dtype		#O keyword datatype code
+character*(*)	comm		#O comment string describing keyword
+integer		ier		#O status return
+.fi
+.ih
+DESCRIPTION
+The \fIimtypk\fR procedure is used to fetch the information defining
+the type and usage of an image header keyword, i.e., the datatype code
+and comment string.  Knowledge of the keyword datatype may be required
+before accessing the value of a keyword to avoid a format conversion error
+if only the name of the keyword is known (e.g., when using the keyword-list
+package).  The \fIimtypk\fR procedure is the only means currently available
+for retrieving the comment string associated with a header keyword.
+.ih
+RETURN VALUE
+A zero status is returned if the named keyword exists.
+
+SYS_IDBKEYNF:	image header keyword not found
+.ih
+SEE ALSO
+imaddk, imacck
+.endhelp
diff --git a/sys/imfort/imacck.x b/sys/imfort/imacck.x
new file mode 100644
index 00000000..ef6b3314
--- /dev/null
+++ b/sys/imfort/imacck.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMACCK -- Test if the named keyword exists.  IER=0 is returned if the
+# parameter exists.
+
+procedure imacck (im, key, ier)
+
+pointer	im			# image descriptor
+%	character*(*) key
+int	ier
+
+pointer	sp, kp
+int	imaccf()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (key, Memc[kp], SZ_KEYWORD)
+	if (imaccf (im, Memc[kp]) == YES)
+	    ier = OK
+	else {
+	    ier = IE_NEXKW
+	    call im_seterrop (ier, Memc[kp])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imaddk.x b/sys/imfort/imaddk.x
new file mode 100644
index 00000000..0e6054dc
--- /dev/null
+++ b/sys/imfort/imaddk.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMADDK -- Add a new keyword to the image header.
+
+procedure imaddk (im, keyw, dtype, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+int	dtype
+%	character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_LINE, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (comm, Memc[cp], SZ_LINE)
+
+	iferr (call imaddf (im, Memc[kp], dtype, Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imakwb.x b/sys/imfort/imakwb.x
new file mode 100644
index 00000000..9b857c17
--- /dev/null
+++ b/sys/imfort/imakwb.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMAKWB -- Add a new keyword of type bool.
+
+procedure imakwb (im, keyw, bval, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+bool	bval
+%       character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (comm, Memc[cp], SZ_VALSTR)
+
+	iferr (call imaddb (im, Memc[kp], bval, Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imakwc.x b/sys/imfort/imakwc.x
new file mode 100644
index 00000000..00e8f7d0
--- /dev/null
+++ b/sys/imfort/imakwc.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMAKWC -- Add a new keyword of type string.
+
+procedure imakwc (im, keyw, sval, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+%	character*(*) sval
+%	character*(*) comm
+int	ier
+
+pointer	sp, kp, vp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (vp, SZ_VALSTR, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (sval, Memc[vp], SZ_VALSTR)
+	call f77upk (comm, Memc[cp], SZ_VALSTR)
+
+	iferr (call imastr (im, Memc[kp], Memc[vp], Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imakwd.x b/sys/imfort/imakwd.x
new file mode 100644
index 00000000..72467cd6
--- /dev/null
+++ b/sys/imfort/imakwd.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMAKWD -- Add a new keyword of type double.
+
+procedure imakwd (im, keyw, dval, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+double	dval
+%       character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (comm, Memc[cp], SZ_VALSTR)
+
+	iferr (call imaddd (im, Memc[kp], dval, Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imakwi.x b/sys/imfort/imakwi.x
new file mode 100644
index 00000000..be9e51f4
--- /dev/null
+++ b/sys/imfort/imakwi.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMAKWI -- Add a new keyword of type int.
+
+procedure imakwi (im, keyw, ival, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+int	ival
+%       character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (comm, Memc[cp], SZ_VALSTR)
+
+	iferr (call imaddi (im, Memc[kp], ival, Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imakwr.x b/sys/imfort/imakwr.x
new file mode 100644
index 00000000..5e1b9f48
--- /dev/null
+++ b/sys/imfort/imakwr.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMAKWR -- Add a new keyword of type real.
+
+procedure imakwr (im, keyw, rval, comm, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+real	rval
+%       character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (comm, Memc[cp], SZ_VALSTR)
+
+	iferr (call imaddr (im, Memc[kp], rval, Memc[cp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imclos.x b/sys/imfort/imclos.x
new file mode 100644
index 00000000..c182877a
--- /dev/null
+++ b/sys/imfort/imclos.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMCLOS -- Close an IMFORT image.  If the image was opened read only the
+# header file will already have been closed, otherwise it must be updated
+# if it has been modified.
+
+procedure imclos (im, ier)
+
+pointer	im			# image descriptor
+int	ier			# receives error status
+
+int	status
+
+begin
+	call imflsh (im, ier)
+
+	# Close the pixel file.
+	if (IM_PIXFP(im) != NULL) {
+	    call bfclos (IM_PIXFP(im), status)
+	    if (status == ERR && ier == OK)
+		ier = IE_CLSPIX
+	}
+
+	# Close the header file.
+	if (IM_HDRFP(im) != NULL) {
+	    call bfclos (IM_HDRFP(im), status)
+	    if (status == ERR && ier == OK)
+		ier = IE_CLSHDR
+	}
+
+	if (IM_LINEBUFP(im) != NULL)
+	    call mfree (IM_LINEBUFP(im), TY_SHORT)
+	call mfree (im, TY_STRUCT)
+end
diff --git a/sys/imfort/imcrea.x b/sys/imfort/imcrea.x
new file mode 100644
index 00000000..ab8e8ca9
--- /dev/null
+++ b/sys/imfort/imcrea.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMCREA -- Create a new image of the indicated size and pixel type.
+# Fortran callable version.
+
+procedure imcrea (f77nam, axlen, naxis, pixtype, ier)
+
+%       character*(*) f77nam
+int	axlen[ARB]		# receives axis lengths
+int	naxis			# receives number of axes
+int	pixtype			# receives pixel type
+int	ier			# receives error status
+
+char	fname[SZ_PATHNAME]
+
+begin
+	# Convert character string to SPP string.
+	call f77upk (f77nam, fname, SZ_PATHNAME)
+	call imcrex (fname, axlen, naxis, pixtype, ier)
+end
diff --git a/sys/imfort/imcrex.x b/sys/imfort/imcrex.x
new file mode 100644
index 00000000..5a5bce1e
--- /dev/null
+++ b/sys/imfort/imcrex.x
@@ -0,0 +1,170 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	<fio.h>
+include	"imfort.h"
+include	"oif.h"
+
+# IMCREX -- Create a new image of the indicated size and pixel type.
+# Both the header and pixel file are created at the same time.  For
+# simplicity we put both files in the same directory.  The name of the
+# pixel file is the same as that of the header file, but with the
+# extension ".pix".
+
+procedure imcrex (image, axlen, naxis, pixtype, ier)
+
+char	image[ARB]		#I HOST filename of image
+int	axlen[IM_MAXDIM]	#I axis lengths
+int	naxis			#I number of axes
+int	pixtype			#I pixel type
+int	ier			#O receives error status
+
+int	fp, status, ip, i
+long	pfsize, clktime, cputime
+pointer	sp, hdrfile, pixfile, osfn, root, extn, sval, im
+
+pointer	bfopnx()
+int	imwrhdr(), ctoi()
+define	done_ 91
+define	operr_ 92
+errchk	calloc
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_FNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	# Verify image size and datatype operands.
+	ier = OK
+	if (naxis < 1 || naxis > MAX_NAXIS)
+	    ier = IE_NAXIS
+	if (ier == OK)
+	    do i = 1, naxis
+		if (axlen[i] < 1)
+		    ier = IE_AXLEN
+	if (ier == OK)
+	    if (pixtype != TY_SHORT && pixtype != TY_REAL)
+		ier = IE_PIXTYPE
+	if (ier != OK) {
+	    call im_seterrop (ier, image)
+	    goto done_
+	}
+
+	# Construct the name of the image header file.
+	call imf_parse (image, Memc[root], Memc[extn])
+	if (Memc[extn] == EOS)
+	    call strcpy (OIF_HDREXTN, Memc[extn], SZ_FNAME)
+
+	call strcpy (Memc[root], Memc[hdrfile], SZ_FNAME)
+	call strcat (".", Memc[hdrfile], SZ_FNAME)
+	call strcat (Memc[extn], Memc[hdrfile], SZ_FNAME)
+
+	# Check to see if the new image would overwrite an existing one.
+	# This is an error, unless "clobber" is defined in the user
+	# environment.
+
+	call strpak (Memc[hdrfile], Memc[osfn], SZ_PATHNAME)
+	call zfacss (Memc[osfn], 0, 0, status)
+	if (status == YES) {
+	    call strpak ("clobber", Memc[sval], SZ_FNAME)
+	    call zgtenv (Memc[sval], Memc[sval], SZ_FNAME, status)
+	    if (status != ERR) {
+		call imdelx (image, ier)
+		if (ier != OK) {
+		    ier = IE_CREHDR
+		    goto operr_
+		}
+	    } else {
+		ier = IE_CLOBBER
+		goto operr_
+	    }
+	}
+
+	# Create the new image.
+	fp = bfopnx (Memc[hdrfile], NF, RANDOM)
+	if (fp == ERR) {
+	    ier = IE_CREHDR
+operr_	    call sfree (sp)
+	    call im_seterrop (ier, Memc[hdrfile])
+	    return
+	}
+
+	# Allocate and initialize the image header.
+	call calloc (im, LEN_IMDES + LEN_IMHDR, TY_STRUCT)
+	call zgtime (clktime, cputime)
+
+	call strcpy ("imhdr", IM_MAGIC(im), SZ_IMMAGIC)
+	call amovi (axlen, IM_LEN(im,1), naxis)
+	IM_ACMODE(im) = NEW_IMAGE
+	IM_NDIM(im) = naxis
+	IM_PIXTYPE(im) = pixtype
+	IM_HDRLEN(im) = LEN_IMHDR
+	IM_CTIME(im) = clktime
+	IM_MTIME(im) = clktime
+	Memc[IM_USERAREA(im)] = EOS
+	call imf_initoffsets (im, SZ_DEVBLK)
+	pfsize = IM_HGMOFF(im) - 1
+
+	# Get the image format version for new images.
+	call strpak (ENV_OIFVER, Memc[sval], SZ_FNAME)
+	call zgtenv (Memc[sval], Memc[sval], SZ_FNAME, status)
+	if (status != ERR) {
+	    ip = 1
+	    call strupk (Memc[sval], Memc[sval], SZ_FNAME)
+	    if (ctoi (Memc[sval], ip, IM_HDRVER(im)) <= 0)
+		IM_HDRVER(im) = DEF_VERSION
+	} else
+	    IM_HDRVER(im) = DEF_VERSION
+
+	# Get a unique pixel file name.
+	call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (Memc[hdrfile], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call imf_mkpixfname (im, Memc[pixfile], SZ_IMPIXFILE, ier)
+	if (ier != OK)
+	    goto done_
+
+	# Write the image header and close the header file.
+	if (imwrhdr (fp, im, TY_IMHDR) == ERR) {
+	    call bfclos (fp, status)
+	    status = ERR
+	} else
+	    call bfclos (fp, status)
+
+	if (status == ERR) {
+	    ier = IE_WRHDR
+	    call im_seterrop (ier, Memc[hdrfile])
+	    return
+	}
+
+	# Create the pixel storage file.
+	call bfalcx (Memc[pixfile], pfsize, status)
+	if (status == ERR) {
+	    ier = IE_ALCPIX
+	    call im_seterrop (ier, Memc[pixfile])
+	    goto done_
+	}
+
+	# Write the backpointing pixel header into the pixel file.
+	fp = bfopnx (Memc[pixfile], WO, RANDOM)
+	if (fp == ERR) {
+	    status = ERR
+	} else if (imwrhdr (fp, im, TY_PIXHDR) == ERR) {
+	    call bfclos (fp, status)
+	    status = ERR
+	} else
+	    call bfclos (fp, status)
+
+	call mfree (im, TY_STRUCT)
+	if (status == ERR) {
+	    ier = IE_ACCPIX
+	    call im_seterrop (ier, Memc[pixfile])
+	} else
+	    ier = OK
+done_
+	call sfree (sp)
+end
diff --git a/sys/imfort/imdele.x b/sys/imfort/imdele.x
new file mode 100644
index 00000000..9112021c
--- /dev/null
+++ b/sys/imfort/imdele.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMDELE -- Delete an image (both the header file and the pixel file).
+# It is not an error if there is no pixel file.
+
+procedure imdele (image, ier)
+
+%	character*(*) image
+int	ier			# receives error status
+
+pointer	sp, imname
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_PATHNAME, TY_CHAR)
+
+	call f77upk (image, Memc[imname], SZ_PATHNAME)
+	call imdelx (Memc[imname], ier)
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imdelk.x b/sys/imfort/imdelk.x
new file mode 100644
index 00000000..f23c6d79
--- /dev/null
+++ b/sys/imfort/imdelk.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMDELK -- Delete the named header keyword.
+
+procedure imdelk (im, keyw, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+int	ier
+
+pointer	sp, kp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imdelf (im, Memc[kp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imdelx.x b/sys/imfort/imdelx.x
new file mode 100644
index 00000000..d49451fc
--- /dev/null
+++ b/sys/imfort/imdelx.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<protect.h>
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMDELX -- Delete an image (both the header file and the pixel file).
+# It is not an error if there is no pixel file.
+
+procedure imdelx (image, ier)
+
+char	image[ARB]		#I image to be deleted
+int	ier			#O receives error status
+
+int	status
+pointer	im, sp, hdrfile, pixfile, ip
+int	stridxs()
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	# Get the OS pathnames of the header and pixel files.
+
+	call imopnx (image, RO, im, ier)
+	if (ier != OK) {
+	    ier = IE_IMDELNEXIM
+	    goto quit_
+	} else {
+	    call strcpy (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	    call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), Memc[pixfile],
+		SZ_PATHNAME)
+	    ip = pixfile + stridxs ("!", Memc[pixfile])
+	    call strcpy (Memc[ip], Memc[pixfile], SZ_PATHNAME)
+	    call imclos (im, ier)
+	    if (ier != OK)
+		goto quit_
+	}
+
+	call strpak (Memc[hdrfile], Memc[hdrfile], SZ_FNAME)
+	call strpak (Memc[pixfile], Memc[pixfile], SZ_PATHNAME)
+
+	# Verify that the header file exists.
+	call zfacss (Memc[hdrfile], 0, 0, status)
+	if (status == NO) {
+	    ier = IE_IMDELNEXIM
+	    goto quit_
+	}
+
+	# Remove any file delete protection from the image header file.
+	# Do not complain if the header is not protected, or if there is
+	# no pixel file to be deleted.
+
+	call zfprot (Memc[hdrfile], REMOVE_PROTECTION, status)
+	call zfdele (Memc[hdrfile], status)
+
+	if (status == ERR)
+	    ier = IE_IMDELETE
+	else {
+	    call zfacss (Memc[pixfile], 0, 0, status)
+	    if (status == NO)
+		ier = OK
+	    else {
+		call zfdele (Memc[pixfile], status)
+		if (status == ERR)
+		    ier = IE_IMDELETE
+	    }
+	}
+
+quit_
+	if (ier != OK)
+	    call im_seterrop (ier, image)
+	call sfree (sp)
+end
diff --git a/sys/imfort/imemsg.x b/sys/imfort/imemsg.x
new file mode 100644
index 00000000..68855b68
--- /dev/null
+++ b/sys/imfort/imemsg.x
@@ -0,0 +1,168 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"imfort.h"
+
+define	SZ_OPNAME	64
+
+# IMEMSG -- Translate an IMFORT or VOS error code into a message string.
+
+procedure imemsg (ier, errmsg)
+
+int	ier			# error code
+%	character*(*) errmsg
+
+pointer	sp, ostr
+int	e_ier
+char	e_opname[SZ_OPNAME]
+common	/imemcm/ e_ier, e_opname
+
+begin
+	switch (ier) {
+	case IE_ACCPIX:
+%	    errmsg = 'error writing into pixel file during image create'
+	case IE_ALCPIX:
+%	    errmsg = 'cannot create or allocate space for pixel file'
+	case IE_CLSHDR:
+%	    errmsg = 'error closing image header file'
+	case IE_CLSPIX:
+%	    errmsg = 'error closing image pixel file'
+	case IE_CREHDR:
+%	    errmsg = 'cannot create image'
+	case IE_FLUSH:
+%	    errmsg = 'error flushing buffered data to pixel file'
+	case IE_GCMDLN:
+%	    errmsg = 'cannot read command line string'
+	case IE_IMDELETE:
+%	    errmsg = 'cannot delete image'
+	case IE_IMDELNEXIM:
+%	    errmsg = 'attempt to delete a nonexistent image'
+	case IE_IMRENAME:
+%	    errmsg = 'cannot rename image'
+	case IE_IMRNAMNEXIM:
+%	    errmsg = 'attempt to rename a nonexistent image'
+	case IE_MAGIC:
+%	    errmsg = 'illegal imfort image descriptor'
+	case IE_NEXARG:
+%	    errmsg = 'nonexistent command line argument referenced'
+	case IE_NEXKW:
+%	    errmsg = 'nonexistent header keyword referenced'
+	case IE_NONNUMARG:
+%	    errmsg = 'cannot decode numeric argument'
+	case IE_NOTIMH:
+%	    errmsg = 'attempt to access a non-image file as an image'
+	case IE_NOTSHORT:
+%	    errmsg = 'image is not of type short'
+	case IE_OPEN:
+%	    errmsg = 'cannot open image'
+	case IE_OPNPIX:
+%	    errmsg = 'cannot open pixel file'
+	case IE_PIXTYPE:
+%	    errmsg = 'image pixel type must be short or real'
+	case IE_RDPIX:
+%	    errmsg = 'error reading image pixel file'
+	case IE_UPDHDR:
+%	    errmsg = 'error updating image header file'
+	case IE_UPDRO:
+%	    errmsg = 'image header modified but image opened read only'
+	case IE_WRHDR:
+%	    errmsg = 'error writing to image header file'
+	case IE_WRPIX:
+%	    errmsg = 'error writing image pixel file'
+	case IE_XOOB:
+%	    errmsg = 'image x coordinates out of range or out of order'
+	case IE_YOOB:
+%	    errmsg = 'image y coordinates out of range'
+	case IE_ZOOB:
+%	    errmsg = 'image z coordinates out of range'
+	case IE_EOF:
+%	    errmsg = 'end of file or list detected'
+	case IE_NAXIS:
+%	    errmsg = 'wrong number of axes on image'
+	case IE_AXLEN:
+%	    errmsg = 'length of each image axis must be .ge. 1'
+	case IE_MKDIR:
+%	    errmsg = 'cannot create pixel subdirectory'
+	case IE_PFNNUNIQ:
+%	    errmsg = 'cannot create unique pixel file name'
+	case IE_CLOBBER:
+%	    errmsg = 'new image would overwrite existing image'
+
+	case SYS_IDBDELNXKW:
+%	    errmsg = 'attempt to delete unknown header keyword'
+	case SYS_IDBKEYNF:
+%	    errmsg = 'image header keyword not found'
+	case SYS_IDBNODEL:
+%	    errmsg = 'cannot delete image header keyword'
+	case SYS_IDBOVFL:
+%	    errmsg = 'out of space in image header'
+	case SYS_IDBREDEF:
+%	    errmsg = 'attempt to redefine an image header keyword'
+	case SYS_IDBTYPE:
+%	    errmsg = 'illegal header parameter data type conversion'
+	case SYS_IMFNOVFL:
+%	    errmsg = 'out of space for header keyword name list'
+
+	default:
+%	    errmsg = 'imfort error (unrecognized error code)'
+	}
+
+	# If the current error code agrees with that of the most recently
+	# posted operand name, add the operand name to the error string.
+
+	if (ier == e_ier && e_opname[1] != EOS) {
+	    call smark (sp)
+	    call salloc (ostr, SZ_LINE, TY_CHAR)
+
+	    call f77upk (errmsg, Memc[ostr], SZ_LINE)
+	    call strcat (" (", Memc[ostr], SZ_LINE)
+	    call strcat (e_opname, Memc[ostr], SZ_LINE)
+	    call strcat (")", Memc[ostr], SZ_LINE)
+	    call f77pak (Memc[ostr], errmsg, len(errmsg))
+
+	    call sfree (sp)
+	}
+end
+
+
+# IM_SETERROP -- Called to set the operand name when an error occurs, so that
+# it may be included in the error message string without being passed back to
+# the user program.
+
+procedure im_seterrop (ier, opname)
+
+int	ier			# current error code
+char	opname[ARB]		# associated operand name
+
+int	e_ier
+char	e_opname[SZ_OPNAME]
+common	/imemcm/ e_ier, e_opname
+
+begin
+	e_ier = ier
+	call strcpy (opname, e_opname, SZ_OPNAME)
+end
+
+
+# IM_SETERRIM -- A variation on im_seterrop, used to set the image name as
+# the error operand, given the image descriptor.
+
+procedure im_seterrim (ier, im)
+
+int	ier			# current error code
+pointer	im			# image descriptor
+
+int	junk
+pointer	sp, opname
+int	fnroot()
+
+begin
+	call smark (sp)
+	call salloc (opname, SZ_OPNAME, TY_CHAR)
+
+	junk = fnroot (IM_HDRFILE(im), Memc[opname], TY_CHAR)
+	call im_seterrop (ier, Memc[opname])
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imfdir.x b/sys/imfort/imfdir.x
new file mode 100644
index 00000000..90d9ca79
--- /dev/null
+++ b/sys/imfort/imfdir.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# IMFDIR -- Routines for setting or retrieving the "imdir" (pixel file storage
+# directory) for IMFORT.
+#
+#	      im[sg]dir (dir)		# set/get imdir - F77 versions
+#		imsdirx (dir)		# set imdir - SPP version
+#	  nch = imgdirx (dir, maxch)	# get imdir - SPP version
+#
+# By default, pixel files are stored in the same directory as the header file,
+# using a HDR$ pathname in the image header.  If the user wishes they can
+# explicitly set the directory into which all further pixel files will be
+# placed, until another call to the set-imdir routine.
+
+
+# IMSDIR -- Set the value of `imdir' for imfort.
+
+procedure imsdir (dir)
+
+%	character*(*) dir
+
+char	imdir[SZ_PATHNAME]
+common	/imdcom/ imdir
+
+begin
+	call imdinit()
+	call f77upk (dir, imdir, SZ_PATHNAME)
+end
+
+
+# IMGDIR -- Get the value of `imdir' for imfort.
+
+procedure imgdir (dir)
+
+%	character*(*) dir
+
+char	imdir[SZ_PATHNAME]
+common	/imdcom/ imdir
+
+begin
+	call imdinit()
+	call f77pak (imdir, dir, len(dir))
+end
+
+
+# IMSDIRX -- Set the value of `imdir' for imfort, SPP version.
+
+procedure imsdirx (dir)
+
+char	dir[ARB]		#I new value of imdir
+
+char	imdir[SZ_PATHNAME]
+common	/imdcom/ imdir
+
+begin
+	call imdinit()
+	call strcpy (dir, imdir, SZ_PATHNAME)
+end
+
+
+# IMGDIRX -- Get the value of `imdir' for imfort, SPP version.
+
+int procedure imgdirx (dir, maxch)
+
+char	dir[maxch]		#O receives value of imdir
+int	maxch
+
+int	gstrcpy()
+char	imdir[SZ_PATHNAME]
+common	/imdcom/ imdir
+
+begin
+	call imdinit()
+	return (gstrcpy (imdir, dir, maxch))
+end
+
+
+# IMDINIT -- Runtime initialization of the imdir common.
+
+procedure imdinit()
+
+int	status
+char	envvar[5]
+bool	first_time
+data	first_time /true/
+
+char	imdir[SZ_PATHNAME]
+common	/imdcom/ imdir
+
+begin
+	if (first_time) {
+	    # Check the host environment for the default IMDIR.
+	    call strpak ("imdir", envvar, 5)
+	    call zgtenv (envvar, imdir, SZ_PATHNAME, status)
+	    if (status < 0) {
+		call strpak ("IMDIR", envvar, 5)
+		call zgtenv (envvar, imdir, SZ_PATHNAME, status)
+	    }
+
+	    # Use the builtin default HDR$ if not defined in host enviroment.
+	    if (status < 0)
+		call strcpy (HDR, imdir, SZ_PATHNAME)
+	    else
+		call strupk (imdir, imdir, SZ_PATHNAME)
+
+	    first_time = false
+	}
+end
diff --git a/sys/imfort/imfgpfn.x b/sys/imfort/imfgpfn.x
new file mode 100644
index 00000000..d8fe9567
--- /dev/null
+++ b/sys/imfort/imfgpfn.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# IMF_GPIXFNAME -- Convert a logical pixfile name into a physical pathname.
+
+procedure imf_gpixfname (pixfile, hdrfile, path, maxch)
+
+char	pixfile[ARB]		# pixfile name
+char	hdrfile[ARB]		# header file name (gives hdr directory)
+char	path[maxch]		# receives pathname
+int	maxch
+
+int	ip, nchars
+pointer	sp, fname, op
+int	strncmp(), fnldir()
+
+begin
+	# Merely return pathname if not case "HDR$".
+	if (strncmp (pixfile, HDR, STRLEN_HDR) != 0) {
+	    call zfpath (pixfile, path, maxch, nchars)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Get host pathname of pixel file directory.
+	nchars = fnldir (hdrfile, Memc[fname], SZ_PATHNAME)
+	call zfpath (Memc[fname], path, maxch, nchars)
+
+	# Fold in any subdirectories from the pixfile name.
+	# (as in HDR$pixels/).
+
+	op = fname
+	nchars = 0
+
+	for (ip=STRLEN_HDR+1;  pixfile[ip] != EOS;  ip=ip+1) {
+	    if (pixfile[ip] == '/') {
+		Memc[op] = EOS
+		call zfsubd (path, maxch, Memc[fname], nchars)
+		op = fname
+	    } else {
+		Memc[op] = pixfile[ip]
+		op = op + 1
+	    }
+	}
+
+	# Tack on the pixel file name, which was left in the fname buf.
+	if (op > fname) {
+	    Memc[op] = EOS
+	    if (nchars > 0)
+		call strcpy (Memc[fname], path[nchars+1], maxch-nchars)
+	    else
+		call strcat (Memc[fname], path, maxch)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imflsh.x b/sys/imfort/imflsh.x
new file mode 100644
index 00000000..5ae36b2f
--- /dev/null
+++ b/sys/imfort/imflsh.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMFLSH -- Flush any buffered image data, i.e., synchronize the in-core
+# version of an image with that on disk.
+
+procedure imflsh (im, ier)
+
+pointer	im			# image descriptor
+int	ier
+
+int	status
+int	bfflsh()
+
+begin
+	ier = OK
+
+	# Flush any buffered output pixel data.
+	status = bfflsh (IM_PIXFP(im))
+	if (status == ERR)
+	    ier = IE_FLUSH
+
+	# Update the image header if it has been modified.
+	if (IM_HDRFP(im) != NULL) {
+	    if (IM_UPDATE(im) == YES) {
+		call imf_updhdr (im, status)
+		if (status == ERR && ier == OK)
+		    ier = IE_UPDHDR
+	    }
+	} else if (IM_UPDATE(im) == YES && ier == OK)
+	    ier = IE_UPDRO
+end
diff --git a/sys/imfort/imfmkpfn.x b/sys/imfort/imfmkpfn.x
new file mode 100644
index 00000000..58fc1fea
--- /dev/null
+++ b/sys/imfort/imfmkpfn.x
@@ -0,0 +1,137 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"imfort.h"
+include	"oif.h"
+
+# IMF_MKPIXFNAME -- Generate the pixel file name.  Leave the logical pixfile
+# name in the image header, and return the pathname to the pixel file in the
+# output argument.
+
+procedure imf_mkpixfname (im, pixfile, maxch, ier)
+
+pointer	im			#I image descriptor	
+char	pixfile[maxch]		#O receives pathname to pixfile
+int	maxch			#I max chars out
+int	ier			#O exit status code
+
+int	status, n
+char	suffix[2], hdr[STRLEN_HDR]
+pointer	sp, imdir, osdir, root, extn, subdir, fname, ip, op
+int	fnroot(), fnldir(), strncmp(), imgdirx()
+string	pixextn OIF_PIXEXTN
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (imdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (osdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (root,   SZ_PATHNAME, TY_CHAR)
+	call salloc (subdir, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname,  SZ_PATHNAME, TY_CHAR)
+	call salloc (extn,   SZ_FNAME, TY_CHAR)
+
+	ier = OK
+
+	# Get the logical directory where the pixel file goes.
+	n = imgdirx (Memc[imdir], SZ_PATHNAME)
+
+	# If the imdir name begins with "HDR$", put the pixfile in same
+	# directory as the header or in a subdirectory, else put the pixel
+	# file in the named directory.  If the pixel file goes in a HDR
+	# subdirectory, create the directory if it does not already exist.
+	# For IMFORT programs which are subject to the whims of the host
+	# system, be a little forgiving about the case of the HDR$.
+
+	call strcpy (Memc[imdir], hdr, STRLEN_HDR)
+	call strupr (hdr)
+
+	if (strncmp (hdr, HDR, STRLEN_HDR) == 0) {
+	    call amovc (HDR, Memc[imdir], STRLEN_HDR)
+
+	    ip = imdir + STRLEN_HDR
+	    for (op=subdir;  Memc[ip] != EOS && Memc[ip] != '/';  ip=ip+1) {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	    
+	    # Make the subdirectory if it does not already exist.
+	    if (Memc[subdir] != EOS) {
+		n = fnldir (IM_HDRFILE(im), Memc[osdir], SZ_PATHNAME)
+		call zfpath (Memc[osdir], Memc[fname], SZ_PATHNAME, n)
+		call zfsubd (Memc[fname], SZ_PATHNAME, Memc[subdir], n)
+
+		call strpak (Memc[fname], Memc[fname], SZ_PATHNAME)
+		call zfacss (Memc[fname], 0, DIRECTORY_FILE, status)
+
+		if (status == NO) {
+		    call zfmkdr (Memc[fname], status)
+		    if (status == ERR) {
+			ier = IE_MKDIR
+			goto done_
+		    }
+		}
+	    }
+	} else
+	    call zfpath (Memc[imdir], Memc[imdir], SZ_PATHNAME, n)
+
+	# Make up the root name of the new pixel file.
+	if (fnroot (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME) <= 0)
+	    call strcpy (pixextn, Memc[fname], SZ_PATHNAME)
+	call strcat (".", Memc[fname], SZ_PATHNAME)
+	call strcat (pixextn, Memc[fname], SZ_PATHNAME)
+	call imf_trans (Memc[fname], Memc[root], Memc[extn])
+
+	# Get a unique pixel file name.  If a file with the default pixel
+	# file name already exists in the current IMDIR, a suffix is found
+	# for the file which results in a unique file name (there is a
+	# concurrency loophole in this which can cause the uniqueness
+	# constraint to fail, but this is unlikely).
+
+	suffix[1] = 'a'
+	suffix[2] = 'a'
+	suffix[3] = EOS
+
+	for (n=0;  ;  n=n+1) {
+	    # Construct filename "imdir$root.pix".
+	    call strcpy (Memc[imdir], IM_PIXFILE(im), SZ_PATHNAME)
+	    call strcat (Memc[root], IM_PIXFILE(im), SZ_PATHNAME)
+	    call strcat (".", IM_PIXFILE(im), SZ_PATHNAME)
+	    call strcat (pixextn, IM_PIXFILE(im), SZ_PATHNAME)
+
+	    call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), pixfile, maxch)
+
+	    # Ensure that the filename is unique.
+	    call strpak (pixfile, Memc[fname], SZ_PATHNAME)
+	    call zfacss (Memc[fname], 0, 0, status)
+
+	    if (status == YES) {
+		if (n == 0) {
+		    for (op=root;  Memc[op] != EOS;  op=op+1)
+			;
+		} else {
+		    if (suffix[2] == 'z') {
+			suffix[2] = 'a'
+			if (suffix[1] == 'z') {
+			    ier = IE_PFNNUNIQ
+			    goto done_
+			} else
+			    suffix[1] = suffix[1] + 1
+		    } else
+			suffix[2] = suffix[2] + 1
+		}
+
+		call strcpy (suffix, Memc[op], 2)
+	    } else
+		break
+	}
+
+done_
+	# Set the error message operand name if an error occurred.
+	if (ier != OK)
+	    call im_seterrop (ier, IM_HDRFILE(im))
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imfort.h b/sys/imfort/imfort.h
new file mode 100644
index 00000000..0b03100f
--- /dev/null
+++ b/sys/imfort/imfort.h
@@ -0,0 +1,65 @@
+# IMFORT.H -- IMFORT global definitions
+
+define	MAX_NAXIS	3		# max axes in an imfort image
+define	LEN_USERAREA	64000		# max space for user header keywords
+define	SZ_KEYWORD	8		# max chars in a keyword name (FITS)
+define	SZ_VALSTR	80		# max chars in a keyword record (FITS)
+define	SZ_CMDLINE	256		# max length host command line
+define	MAX_ARGS	32		# max command line arguments
+define	SZ_DEVBLK	256		# alignment factor for pixel file
+define	DEF_VERSION	2		# default file version
+
+define	ENV_OIFVER	"oifversion"	# default format for new images
+
+define	RO		1		# read only
+define	WO		2		# write only
+define	RW		3		# read write
+define	NF		5		# new file
+
+define	IM_HDRFP	Memi[$1]	# header file descriptor
+define	IM_PIXFP	Memi[$1+1]	# pixel file descriptor
+define	IM_ACMODE	Memi[$1+2]	# image access mode
+define	IM_UPDATE	Memi[$1+3]	# need to update image header on disk
+define	IM_LINESIZE	Memi[$1+4]	# image physical line length, chars
+define	IM_LINEBUFP	Memi[$1+5]	# line buffer pointer
+define	IM_SZPIXEL	Memi[$1+6]	# pixel size, chars
+define	IM_SWAP		Memi[$1+7]	# swap pixels
+define	IM_LENHDRMEM	Memi[$1+8]	# buffer length of std hdr + user area
+define	IM_UABLOCKED	Memi[$1+9]	# is user area blocked to 80 cols/card
+
+define	IE_ACCPIX	01		# error codes
+define	IE_ALCPIX	02
+define	IE_CLSHDR	03
+define	IE_CLSPIX	04
+define	IE_CREHDR	05
+define	IE_IMDELETE	06
+define	IE_IMDELNEXIM	07
+define	IE_IMRENAME	08
+define	IE_IMRNAMNEXIM	09
+define	IE_EOF		10
+define	IE_FLUSH	11
+define	IE_GCMDLN	12
+define	IE_MAGIC	13
+define	IE_NEXARG	14
+define	IE_NEXKW	15
+define	IE_NONNUMARG	16
+define	IE_NOTIMH	17
+define	IE_NOTSHORT	18
+define	IE_OPEN		19
+define	IE_OPNPIX	20
+define	IE_PIXTYPE	21
+define	IE_RDPIX	22
+define	IE_UPDHDR	23
+define	IE_UPDRO	24
+define	IE_WRHDR	25
+define	IE_WRPIX	26
+define	IE_XOOB		27
+define	IE_YOOB		28
+define	IE_ZOOB		29
+define	IE_NAXIS	30
+define	IE_AXLEN	31
+define	IE_MKDIR	32
+define	IE_PFNNUNIQ	33
+define	IE_CLOBBER	34
+
+define	IE_EOF		99
diff --git a/sys/imfort/imfparse.x b/sys/imfort/imfparse.x
new file mode 100644
index 00000000..ebcf7484
--- /dev/null
+++ b/sys/imfort/imfparse.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# IMF_PARSE -- Parse an image name into the root pathname and filename
+# extension, if any.  Only the known image type extensions are recognized
+# as extensions, hence this routine cannot be used to parse general filenames.
+
+procedure imf_parse (image, root, extn)
+
+char	image[ARB]		# input image name
+char	root[SZ_PATHNAME]	# output root pathname
+char	extn[MAX_LENEXTN]	# output extension
+
+int	delim, ip, op
+pointer	sp, pattern, osfn
+int	strmatch(), strlen()
+string	ex HDR_EXTENSIONS
+
+begin
+	call smark (sp)
+	call salloc (pattern, SZ_FNAME, TY_CHAR)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	# Parse the image name into the root and extn fields.  The portion
+	# of the filename excluding any directory specification is also
+	# escape sequence encoded.
+
+	call imf_trans (image, root, extn)
+
+	# Search the list of legal imagefile extensions.  If the extension
+	# given is not found in the list, tack it back onto the root and
+	# return a null extension.  This is necessary if we are to allow
+	# dot delimited fields within image names without requiring the
+	# user to supply the image type extension.  For example, "im.c"
+	# and "im.c.imh" must refer to the same image - ".c" is part of
+	# the image name, not an image type extension.
+	#
+	# Note - EX is a string of the form "|imh|hhh|...|". (iki.h).
+
+	if (strlen(extn) == LEN_EXTN) {
+	    delim = ex[1]
+	    for (ip=2;  ex[ip] != EOS;  ip=ip+1) {
+		op = pattern
+		while (ex[ip] != delim && ex[ip+1] != EOS) {
+		    Memc[op] = ex[ip]
+		    op = op + 1
+		    ip = ip + 1
+		}
+		Memc[op] = EOS
+		if (strmatch (extn, Memc[pattern]) > 0) {
+		    call sfree (sp)
+		    return
+		}
+	    }
+	}
+
+	# Not a legal image header extension.  Restore the extn field to the
+	# root and null the extn.  Tacking on the dummy extension .foo and
+	# later discarding it ensures that the root name is properly encoded
+	# for the local host.
+
+	if (strlen(extn) > 0) {
+	    call strcpy (image, Memc[osfn], SZ_PATHNAME)
+	    call strcat (".foo", Memc[osfn], SZ_PATHNAME)
+	    call imf_trans (Memc[osfn], root, extn)
+	    extn[1] = EOS
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imftrans.x b/sys/imfort/imftrans.x
new file mode 100644
index 00000000..f758c3da
--- /dev/null
+++ b/sys/imfort/imftrans.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# IMF_TRANS -- Translate a host filename into root (includes directory
+# prefix) and extension fields.  FIO escape sequence encoding is used on
+# the portion of the filename excluding the directory prefix.  Legal host
+# filenames are unaffected by the translation except for case conversions,
+# i.e., only constructs which are not legal in host filenames are affected
+# by the translation, allowing legal host filenames to be passed through
+# without change.
+
+procedure imf_trans (fname, root, extn)
+
+char	fname[ARB]			#I input filename
+char	root[SZ_PATHNAME]		#O root portion of filename
+char	extn[MAX_LENEXTN]		#O extn portion of filename
+
+int	o_root, o_extn, ip, op
+int	gstrcpy()
+
+begin
+	# Copy out the directory prefix, if any, unchanged.
+	call zfnbrk (fname, o_root, o_extn)
+	op = gstrcpy (fname, root, o_root-1) + 1
+	ip = o_root
+
+	# Perform escape sequence encoding and parse into root and extn.
+	call vfn_encode (fname, ip, root[op], o_root, extn, o_extn)
+end
diff --git a/sys/imfort/imfupdhdr.x b/sys/imfort/imfupdhdr.x
new file mode 100644
index 00000000..4381fe7e
--- /dev/null
+++ b/sys/imfort/imfupdhdr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+include	"oif.h"
+
+# IMF_UPDHDR -- Update the image header.
+
+procedure imf_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+pointer	fp
+int	imwrhdr()
+
+begin
+	fp = IM_HDRFP(im)
+	if (imwrhdr (fp, im, TY_IMHDR) != ERR)
+	    IM_UPDATE(im) = NO
+end
diff --git a/sys/imfort/imgkwb.x b/sys/imfort/imgkwb.x
new file mode 100644
index 00000000..8aad973a
--- /dev/null
+++ b/sys/imfort/imgkwb.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMGKWB -- Return the value of the named header keyword as a boolean.
+
+procedure imgkwb (im, keyw, bval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+bool	bval
+int	ier
+
+pointer	sp, kp
+bool	imgetb()
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (bval = imgetb (im, Memc[kp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else
+	    ier = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imgkwc.x b/sys/imfort/imgkwc.x
new file mode 100644
index 00000000..675e2488
--- /dev/null
+++ b/sys/imfort/imgkwc.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMGKWC -- Return the value of the named header keyword as a character
+# string.
+
+procedure imgkwc (im, keyw, sval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+%	character*(*) sval
+int	ier
+
+pointer	sp, kp, vp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (vp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imgstr (im, Memc[kp], Memc[vp], SZ_VALSTR)) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    call f77pak (Memc[vp], sval, ARB)
+	    ier = OK
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imgkwd.x b/sys/imfort/imgkwd.x
new file mode 100644
index 00000000..cd3c679d
--- /dev/null
+++ b/sys/imfort/imgkwd.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMGKWD -- Return the value of the named header keyword as a double.
+
+procedure imgkwd (im, keyw, dval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+double	dval
+int	ier
+
+pointer	sp, kp
+double	imgetd()
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (dval = imgetd (im, Memc[kp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else
+	    ier = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imgkwi.x b/sys/imfort/imgkwi.x
new file mode 100644
index 00000000..3c30b113
--- /dev/null
+++ b/sys/imfort/imgkwi.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMGKWI -- Return the value of the named header keyword as an integer.
+
+procedure imgkwi (im, keyw, ival, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+int	ival
+int	ier
+
+pointer	sp, kp
+int	imgeti(), errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (ival = imgeti (im, Memc[kp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else
+	    ier = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imgkwr.x b/sys/imfort/imgkwr.x
new file mode 100644
index 00000000..fb330fc4
--- /dev/null
+++ b/sys/imfort/imgkwr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMGKWR -- Return the value of the named header keyword as a real.
+
+procedure imgkwr (im, keyw, rval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+real	rval
+int	ier
+
+pointer	sp, kp
+real	imgetr()
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (rval = imgetr (im, Memc[kp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else
+	    ier = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imgl1r.x b/sys/imfort/imgl1r.x
new file mode 100644
index 00000000..43541a55
--- /dev/null
+++ b/sys/imfort/imgl1r.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL1R -- Get a line from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imgl1r (im, buf, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	# Convert the datatype if necessary.
+	if (IM_PIXTYPE(im) == TY_SHORT)
+	    call achtsr (buf, buf, npix)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgl1s.x b/sys/imfort/imgl1s.x
new file mode 100644
index 00000000..6784f637
--- /dev/null
+++ b/sys/imfort/imgl1s.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL1S -- Get a line from an image of type short.  It is illegal to reference
+# out of bounds.
+
+procedure imgl1s (im, buf, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify that the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgl2r.x b/sys/imfort/imgl2r.x
new file mode 100644
index 00000000..5756bdfe
--- /dev/null
+++ b/sys/imfort/imgl2r.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL2R -- Get a line from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imgl2r (im, buf, lineno, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (lineno-1) * IM_LINESIZE(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	# Convert the datatype if necessary.
+	if (IM_PIXTYPE(im) == TY_SHORT)
+	    call achtsr (buf, buf, npix)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgl2s.x b/sys/imfort/imgl2s.x
new file mode 100644
index 00000000..ea8596e1
--- /dev/null
+++ b/sys/imfort/imgl2s.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL2S -- Get a line from an image of type short.  It is illegal to reference
+# out of bounds.
+
+procedure imgl2s (im, buf, lineno, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Verify that the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (lineno-1) * IM_LINESIZE(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgl3r.x b/sys/imfort/imgl3r.x
new file mode 100644
index 00000000..e705df58
--- /dev/null
+++ b/sys/imfort/imgl3r.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL3R -- Get a line from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imgl3r (im, buf, lineno, bandno, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	bandno			# band number
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (bandno < 1 || bandno > IM_LEN(im,3)) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) +
+	    ((bandno-1) * IM_LEN(im,2) + (lineno-1)) * IM_LINESIZE(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	# Convert the datatype if necessary.
+	if (IM_PIXTYPE(im) == TY_SHORT)
+	    call achtsr (buf, buf, npix)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgl3s.x b/sys/imfort/imgl3s.x
new file mode 100644
index 00000000..48134f90
--- /dev/null
+++ b/sys/imfort/imgl3s.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGL3S -- Get a line from an image of type short.  It is illegal to reference
+# out of bounds.
+
+procedure imgl3s (im, buf, lineno, bandno, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	bandno			# band number
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (bandno < 1 || bandno > IM_LEN(im,3)) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Verify that the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) +
+	    ((bandno-1) * IM_LEN(im,2) + (lineno-1)) * IM_LINESIZE(im)
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs1r.x b/sys/imfort/imgs1r.x
new file mode 100644
index 00000000..509cf2f1
--- /dev/null
+++ b/sys/imfort/imgs1r.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS1R -- Get a section from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.  It is
+# illegal to reference out of bounds.
+
+procedure imgs1r (im, buf, i1, i2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (i1-1) * IM_SZPIXEL(im)
+
+	# Read data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	# Convert the datatype if necessary.
+	if (IM_PIXTYPE(im) == TY_SHORT)
+	    call achtsr (buf, buf, npix)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs1s.x b/sys/imfort/imgs1s.x
new file mode 100644
index 00000000..7ad0ba31
--- /dev/null
+++ b/sys/imfort/imgs1s.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS1S -- Get a section from 1 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imgs1s (im, buf, i1, i2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	ier
+
+long	offset
+int	nchars, npix
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (i1-1) * SZ_SHORT
+
+	# Read one line of data.
+	if (nchars != bfread (IM_PIXFP(im), buf, nchars, offset)) {
+	    ier = IE_RDPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Swap bytes if necessary.
+	call imswap (im, buf, nchars)
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs2r.x b/sys/imfort/imgs2r.x
new file mode 100644
index 00000000..bac775c8
--- /dev/null
+++ b/sys/imfort/imgs2r.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS2R -- Get a section from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.  It is
+# illegal to reference out of bounds.
+
+procedure imgs2r (im, buf, i1, i2, j1, j2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	j1, j2			# line number
+int	ier
+
+long	offset
+int	nchars, npix, j, op
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * IM_SZPIXEL(im)
+	op = 1
+
+	do j = j1, j2 {
+	    # Compute offset into pixel file.
+	    offset = IM_PIXOFF(im) + (j-1) * IM_LINESIZE(im) +
+		(i1-1) * IM_SZPIXEL(im)
+
+	    # Read one line of data.
+	    if (nchars != bfread (IM_PIXFP(im), buf[op], nchars, offset)) {
+		ier = IE_RDPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	    # Swap bytes if necessary.
+	    call imswap (im, buf[op], nchars)
+
+	    # Convert the datatype if necessary.
+	    if (IM_PIXTYPE(im) == TY_SHORT)
+		call achtsr (buf[op], buf[op], npix)
+
+	    op = op + npix
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs2s.x b/sys/imfort/imgs2s.x
new file mode 100644
index 00000000..48b421df
--- /dev/null
+++ b/sys/imfort/imgs2s.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS2S -- Get a section from 2 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imgs2s (im, buf, i1, i2, j1, j2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	j1, j2			# first, last lines
+int	ier
+
+long	offset
+int	nchars, npix, op, j
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+	op = 1
+
+	do j = j1, j2 {
+	    # Compute offset into pixel file.
+	    offset = IM_PIXOFF(im) +
+		((j-1) * IM_LINESIZE(im) + (i1-1)) * SZ_SHORT
+
+	    # Read one line of data.
+	    if (nchars != bfread (IM_PIXFP(im), buf[op], nchars, offset)) {
+		ier = IE_RDPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	    # Swap bytes if necessary.
+	    call imswap (im, buf[op], nchars)
+
+	    op = op + npix
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs3r.x b/sys/imfort/imgs3r.x
new file mode 100644
index 00000000..77124a48
--- /dev/null
+++ b/sys/imfort/imgs3r.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS3R -- Get a section from an image of type short or real.  Automatic
+# datatype conversion from short to real is performed if necessary.  It is
+# illegal to reference out of bounds.
+
+procedure imgs3r (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	j1, j2			# line numbers
+int	k1, k2			# band numbers
+int	ier
+
+long	offset
+int	nchars, npix, j, k, op
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (k1 < 1 || k2 > IM_LEN(im,3) || k1 > k2) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * IM_SZPIXEL(im)
+	op = 1
+
+	do k = k1, k2 {
+	    do j = j1, j2 {
+		# Compute offset into pixel file.
+		offset = IM_PIXOFF(im) + (i1-1) * IM_SZPIXEL(im) +
+		    ((k-1) * IM_LEN(im,2) + (j-1)) * IM_LINESIZE(im)
+
+		# Read one line of data.
+		if (nchars != bfread (IM_PIXFP(im), buf[op], nchars, offset)) {
+		    ier = IE_RDPIX
+		    call im_seterrim (ier, im)
+		    return
+		}
+
+		# Swap bytes if necessary.
+		call imswap (im, buf[op], nchars)
+
+		# Convert the datatype if necessary.
+		if (IM_PIXTYPE(im) == TY_SHORT)
+		    call achtsr (buf[op], buf[op], npix)
+
+		op = op + npix
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imgs3s.x b/sys/imfort/imgs3s.x
new file mode 100644
index 00000000..83c23716
--- /dev/null
+++ b/sys/imfort/imgs3s.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGS3S -- Get a section from 3 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imgs3s (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	j1, j2			# first, last lines
+int	k1, k2			# first, last bands
+int	ier
+
+long	offset
+int	nchars, npix, op, j, k
+int	bfread()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (k1 < 1 || k2 > IM_LEN(im,3) || k1 > k2) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+	op = 1
+
+	do k = k1, k2 {
+	    do j = j1, j2 {
+		# Compute offset into pixel file.
+		offset = IM_PIXOFF(im) + (i1-1) * SZ_SHORT +
+		    ((k-1) * IM_LEN(im,2) + (j-1)) * IM_LINESIZE(im)
+
+		# Read one line of data.
+		if (nchars != bfread (IM_PIXFP(im), buf[op], nchars, offset)) {
+		    ier = IE_RDPIX
+		    call im_seterrim (ier, im)
+		    return
+		}
+
+		# Swap bytes if necessary.
+		call imswap (im, buf[op], nchars)
+
+		op = op + npix
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imgsiz.x b/sys/imfort/imgsiz.x
new file mode 100644
index 00000000..c8161286
--- /dev/null
+++ b/sys/imfort/imgsiz.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMGSIZ -- Get the physical attributes (size and type) of an image.
+
+procedure imgsiz (im, axlen, naxis, pixtype, ier)
+
+pointer	im			# image descriptor
+int	axlen[IM_MAXDIM]	# receives axis lengths
+int	naxis			# receives number of axes
+int	pixtype			# receives pixel type
+int	ier			# receives error status
+
+bool	strne()
+
+begin
+	if (strne (IM_MAGIC(im), "imhdr"))
+	    ier = IE_MAGIC
+	else {
+	    call amovl (IM_LEN(im,1), axlen, IM_MAXDIM)
+	    naxis = IM_NDIM(im)
+	    pixtype = IM_PIXTYPE(im)
+	    ier = OK
+	}
+end
diff --git a/sys/imfort/imhcpy.x b/sys/imfort/imhcpy.x
new file mode 100644
index 00000000..27d4321c
--- /dev/null
+++ b/sys/imfort/imhcpy.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMHCPY -- Copy the non-pixel fields of an existing image header to a new
+# image header.  Only fields not set by IMCREA are copied.
+
+procedure imhcpy (o_im, n_im, ier)
+
+pointer	o_im		# old image
+pointer	n_im		# new image
+int	ier
+
+int	junk
+pointer	sp, root, o_ua, n_ua
+string	imhdr "imhdr"
+int	fnroot()
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+
+	if (strne (IM_MAGIC(o_im), imhdr) || strne (IM_MAGIC(n_im), imhdr)) {
+	    ier = IE_MAGIC
+	    call sfree (sp)
+	    return
+	}
+
+	o_ua = IM_USERAREA(o_im)
+	n_ua = IM_USERAREA(n_im)
+
+	# Copy the non-pixel fields.
+	call strcpy (IM_TITLE(o_im), IM_TITLE(n_im), SZ_IMTITLE)
+	call strcpy (IM_HISTORY(o_im), IM_HISTORY(n_im), SZ_IMHIST)
+	call strcpy (Memc[o_ua], Memc[n_ua], ARB)
+
+	# Record the inheritance in the history buffer.
+	junk = fnroot (IM_HDRFILE(o_im), Memc[root], SZ_FNAME)
+	call strcat ("New copy of ", IM_HISTORY(n_im), SZ_IMHIST)
+	call strcat (Memc[root], IM_HISTORY(n_im), SZ_IMHIST)
+	call strcat ("\n", IM_HISTORY(n_im), SZ_IMHIST)
+
+	IM_UPDATE(n_im) = YES
+
+	ier = OK
+	call sfree (sp)
+end
diff --git a/sys/imfort/imhv1.h b/sys/imfort/imhv1.h
new file mode 100644
index 00000000..a9a37874
--- /dev/null
+++ b/sys/imfort/imhv1.h
@@ -0,0 +1,75 @@
+# IMHV1.H -- Version 1 of the OIF binary file header (April 1988).
+
+define	V1_MAGIC	"imhdr"			# file identification tag
+define	V1_PMAGIC	"impix"			# file identification tag
+define	V1_VERSION	1			# header version number
+
+define	SZ_V1IMPIXFILE	79			# name of pixel storage file
+define	SZ_V1IMHDRFILE	79			# name of header storage file
+define	SZ_V1IMTITLE	79			# image title string
+define	SZ_V1IMHIST	511			# image history record
+define	SZ_V1BUNIT	9			# brightness units string
+define	SZ_V1CTYPE	9			# coord axes units string
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V1IMHDR	513			# length of std header
+define	LEN_V1PIXHDR	183			# length of pixel file header
+define	V1U		LEN_V1IMHDR		# offset to user fields
+define	IM_V1USERAREA	(P2C($1+V1U))		# user area (database)
+
+# Disk resident header.
+define	IM_V1MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V1HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V1PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V1NDIM	Memi[$1+5]		# number of dimensions
+define	IM_V1LEN	Meml[$1+$2+6-1]		# length of the dimensions
+define	IM_V1PHYSLEN	Meml[$1+$2+13-1]	# physical length (as stored)
+define	IM_V1SSMTYPE	Meml[$1+20]		# type of subscript mapping
+define	IM_V1LUTOFF	Meml[$1+21]		# offset to subscript map luts
+define	IM_V1PIXOFF	Meml[$1+22]		# offset of the pixels
+define	IM_V1HGMOFF	Meml[$1+23]		# offset of hgm pixels
+define	IM_V1BLIST	Meml[$1+24]		# offset of bad pixel list
+define	IM_V1SZBLIST	Meml[$1+25]		# size of bad pixel list
+define	IM_V1NBPIX	Meml[$1+26]		# number of bad pixels
+define	IM_V1CTIME	Meml[$1+27]		# time of image creation
+define	IM_V1MTIME	Meml[$1+28]		# time of last modify
+define	IM_V1LIMTIME	Meml[$1+29]		# time min,max computed
+define	IM_V1MAX	Memr[P2R($1+30)]	# max pixel value
+define	IM_V1MIN	Memr[P2R($1+31)]	# min pixel value
+define	IM_V1HGM	($1+33)			# histogram descriptor
+define	IM_V1CTRAN	($1+52)			# coordinate transformations
+define	IM_V1PIXFILE	Memc[P2C($1+103)]	# name of pixel storage file
+define	IM_V1HDRFILE	Memc[P2C($1+143)]	# name of header storage file
+define	IM_V1TITLE	Memc[P2C($1+183)]	# image name string
+define	IM_V1HISTORY	Memc[P2C($1+223)]	# history comment string
+
+# The Histogram structure (field IM_HGM)
+define	LEN_HGMSTRUCT	20
+define	HGM_TIME	Meml[$1]		# time when hgm was computed
+define	HGM_LEN		Meml[$1+1]		# number of bins in hgm
+define	HGM_NPIX	Meml[$1+2]		# npix used to compute hgm
+define	HGM_MIN		Memr[P2R($1+3)]		# min hgm value
+define	HGM_MAX		Memr[P2R($1+4)]		# max hgm value
+define	HGM_INTEGRAL	Memr[P2R($1+5)]		# integral of hgm
+define	HGM_MEAN	Memr[P2R($1+6)]		# mean value
+define	HGM_VARIANCE	Memr[P2R($1+7)]		# variance about mean
+define	HGM_SKEWNESS	Memr[P2R($1+8)]		# skewness of hgm
+define	HGM_MODE	Memr[P2R($1+9)]		# modal value of hgm
+define	HGM_LCUT	Memr[P2R($1+10)]	# low cutoff value
+define	HGM_HCUT	Memr[P2R($1+11)]	# high cutoff value
+# next available field: ($1+12)
+
+# The Coordinate Transformation Structure (IM_CTRAN)
+define	LEN_CTSTRUCT	50
+define	CT_VALID	Memi[$1]		# (y/n) is structure valid?
+define	CT_BSCALE	Memr[P2R($1+1)]		# pixval scale factor
+define	CT_BZERO	Memr[P2R($1+2)]		# pixval offset
+define	CT_CRVAL	Memr[P2R($1+$2+3-1)]	# value at pixel
+define	CT_CRPIX	Memr[P2R($1+$2+10-1)]	# index of pixel
+define	CT_CDELT	Memr[P2R($1+$2+17-1)]	# increment along axis
+define	CT_CROTA	Memr[P2R($1+$2+24-1)]	# rotation angle
+define	CT_BUNIT	Memc[P2C($1+31)]	# pixval ("brightness") units
+define	CT_CTYPE	Memc[P2C($1+36)]	# coord units string
+# next available field: ($1+41)
diff --git a/sys/imfort/imhv2.h b/sys/imfort/imhv2.h
new file mode 100644
index 00000000..d7eaa1f7
--- /dev/null
+++ b/sys/imfort/imhv2.h
@@ -0,0 +1,43 @@
+# IMHV2.H -- Version 2 of the OIF binary file header (March 1997).
+
+define	V2_MAGIC	"imhv2"			# file identification tag
+define	V2_PMAGIC	"impv2"			# file identification tag
+define	V2_VERSION	2			# header version
+
+define	SZ_V2IMPIXFILE	255			# name of pixel storage file
+define	SZ_V2IMHDRFILE	255			# name of header storage file
+define	SZ_V2IMTITLE	383			# image title string
+define	SZ_V2IMHIST	1023			# image history record
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V2IMHDR	1024			# length of std header
+define	LEN_V2PIXHDR	293			# length of pixel file header
+define	V2U		LEN_V2IMHDR		# offset to user fields
+define	IM_V2USERAREA	(P2C($1+V2U))		# user area (database)
+
+# Disk resident header.
+define	IM_V2MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V2HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V2PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V2SWAPPED	Memi[$1+5]		# pixels are byte swapped
+define	IM_V2NDIM	Memi[$1+6]		# number of dimensions
+define	IM_V2LEN	Meml[$1+$2+7-1]		# length of the dimensions
+define	IM_V2PHYSLEN	Meml[$1+$2+14-1]	# physical length (as stored)
+define	IM_V2SSMTYPE	Meml[$1+21]		# type of subscript mapping
+define	IM_V2LUTOFF	Meml[$1+22]		# offset to subscript map luts
+define	IM_V2PIXOFF	Meml[$1+23]		# offset of the pixels
+define  IM_V2HGMOFF	Meml[$1+24]		# offset of hgm pixels
+define  IM_V2BLIST	Meml[$1+25]		# offset of bad pixel list
+define  IM_V2SZBLIST	Meml[$1+26]		# size of bad pixel list
+define  IM_V2NBPIX	Meml[$1+27]		# number of bad pixels
+define	IM_V2CTIME	Meml[$1+28]		# time of image creation
+define	IM_V2MTIME	Meml[$1+29]		# time of last modify
+define	IM_V2LIMTIME	Meml[$1+30]		# time min,max computed
+define	IM_V2MAX	Memr[P2R($1+31)]	# max pixel value
+define	IM_V2MIN	Memr[P2R($1+32)]	# min pixel value
+define	IM_V2PIXFILE	Memc[P2C($1+37)]	# name of pixel storage file
+define	IM_V2HDRFILE	Memc[P2C($1+165)]	# name of header storage file
+define	IM_V2TITLE	Memc[P2C($1+293)]	# image name string
+define	IM_V2HISTORY	Memc[P2C($1+485)]	# history comment string
diff --git a/sys/imfort/imioff.x b/sys/imfort/imioff.x
new file mode 100644
index 00000000..9ba8c57e
--- /dev/null
+++ b/sys/imfort/imioff.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<imhdr.h>
+include	"oif.h"
+
+# IMF_INITOFFSETS -- Initialize the physical dimensions of a new image.
+# Compute and set the absolute file offsets of the major components of the
+# pixel storage file.
+
+procedure imf_initoffsets (im, dev_block_size)
+
+pointer	im
+int	dev_block_size
+long	offset, temp1, temp2
+int	ndim, dim, sz_pixel, lblksize, pblksize, sizeof()
+
+begin
+	sz_pixel = sizeof (IM_PIXTYPE(im))
+	pblksize = max (dev_block_size, SZ_VMPAGE)
+	lblksize = dev_block_size
+
+	# Allow space for the pixhdr pixel storage file header.  Advance
+	# "offset" to the next device block boundary.
+
+	offset = LEN_PIXHDR * SZ_MII_INT
+	call imf_align (offset, pblksize)
+
+	# Set the offset of the pixel storage area.  Compute the physical
+	# dimensions of the axes of the image.  If image compression is
+	# selected, the logical and physical lengths of the axes will be
+	# the same.  Otherwise, the physical length of each line of the
+	# image will be increased to fill an integral number of device blocks.
+
+	IM_PIXOFF(im) = offset
+	call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	ndim = IM_NDIM(im)
+
+	# If ndim was not explicitly set, compute it by counting the number
+	# of nonzero dimensions.
+
+	if (ndim == 0) {
+	    for (ndim=1;  IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM;
+	    ndim=ndim+1)
+		;
+	    ndim = ndim - 1
+	    IM_NDIM(im) = ndim
+	}
+
+	# Set the unused higher dimensions to 1.  This makes is possible to
+	# access the image as if it were higher dimensional, and in a way it
+	# truely is.
+
+	do dim = ndim + 1, IM_MAXDIM
+	    IM_LEN(im,dim) = 1
+
+	temp1 = offset + IM_LEN(im,1) * sz_pixel
+	temp2 = temp1
+	call imf_align (temp2, lblksize)
+
+	# Only block lines if the packing density is above a certain threshold.
+	if (real(temp1-offset) / real(temp2-offset) >= IM_PACKDENSITY)
+	    IM_PHYSLEN(im,1) = (temp2 - offset) / sz_pixel
+
+	# Set the offsets of the histogram pixels and the bad pixel list.
+	offset = IM_PHYSLEN(im,1)
+	do dim = 2, ndim
+	    offset = offset * IM_LEN(im,dim)
+	offset = (offset * sz_pixel) + IM_PIXOFF(im)
+	call imf_align (offset, lblksize)
+
+	IM_HGMOFF(im) = offset
+	IM_BLIST(im)  = offset
+end
+
+
+# IMF_ALIGN -- Advance "offset" to the next block boundary.
+
+procedure imf_align (offset, blksize)
+
+long	offset
+int	blksize, diff
+
+begin
+	diff = mod (offset-1, max (1, blksize))
+	if (diff != 0)
+	    offset = offset + (blksize - diff)
+end
diff --git a/sys/imfort/imokwl.x b/sys/imfort/imokwl.x
new file mode 100644
index 00000000..6c215892
--- /dev/null
+++ b/sys/imfort/imokwl.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+.help imgnkw
+.nf --------------------------------------------------------------------------
+IMGNKW.X -- Header keyword list package.  A template is used to select some
+subset of the header keywords, then successive elements are read from the list
+in sequence until the end of the list is reached.
+
+	imokwl (im, template, sortflag, kwl, ier)
+	imgnkw (kwl, kwname, ier)
+	imckwl (kwl, ier)
+
+Standard IRAF pattern matching is used in the template: `*' matches all header
+keywords, including the standard fields ("i_" prefix).
+.endhelp ---------------------------------------------------------------------
+
+# IMOKWL -- Open the keyword list.
+
+procedure imokwl (im, patstr, sortit, kwl, ier)
+
+pointer	im				# imfort image descriptor
+%	character*(*) patstr
+bool	sortit				# sort the list?
+pointer	kwl				# receives list handle
+int	ier
+
+pointer	sp, pp
+int	errcode()
+pointer	imofnls(), imofnlu()
+
+begin
+	call smark (sp)
+	call salloc (pp, SZ_LINE, TY_CHAR)
+
+	call f77upk (patstr, Memc[pp], SZ_LINE)
+	iferr {
+	    if (sortit)
+		kwl = imofnls (im, Memc[pp])
+	    else
+		kwl = imofnlu (im, Memc[pp])
+	} then {
+	    ier = errcode()
+	} else
+	    ier = OK
+
+	call sfree (sp)
+end
+
+
+# IMGNKW -- Return the next keyword from the list.
+
+procedure imgnkw (kwl, outstr, ier)
+
+pointer	kwl				# image descriptor
+%	character*(*) outstr
+int	ier
+
+int	nchars
+pointer	sp, kp, ip
+pointer	imgnfn()
+int	errcode(), strncmp()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_FNAME, TY_CHAR)
+
+	iferr (nchars = imgnfn (kwl, Memc[kp], SZ_FNAME)) {
+	    ier = errcode()
+	} else if (nchars == EOF) {
+	    call f77pak ("END", outstr, len(outstr))
+	    ier = IE_EOF
+	} else {
+	    ip = kp
+	    if (strncmp (Memc[kp], "i_", 2) == 0)
+		ip = ip + 2
+	    call f77pak (Memc[ip], outstr, len(outstr))
+	    ier = OK
+	}
+
+	call sfree (sp)
+end
+
+
+# IMCKWL -- Close the keyword list.
+
+procedure imckwl (kwl, ier)
+
+pointer	kwl			# image descriptor
+int	ier
+int	errcode()
+
+begin
+	iferr (call imcfnl (kwl))
+	    ier = errcode()
+	else
+	    ier = OK
+end
diff --git a/sys/imfort/imopen.x b/sys/imfort/imopen.x
new file mode 100644
index 00000000..c8ec5f8b
--- /dev/null
+++ b/sys/imfort/imopen.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMOPEN -- Open an existing imagefile.  Fortran callable version.
+
+procedure imopen (f77nam, acmode, im, ier)
+
+%       character*(*) f77nam
+int	acmode			# image access mode (RO, WO)
+pointer	im			# receives image descriptor pointer
+int	ier			# receives error status
+
+char	fname[SZ_PATHNAME]
+
+begin
+	# Unpack character string into SPP string.
+	call f77upk (f77nam, fname, SZ_PATHNAME)
+	call imopnx (fname, acmode, im, ier)
+end
diff --git a/sys/imfort/imopnc.x b/sys/imfort/imopnc.x
new file mode 100644
index 00000000..4b5a6155
--- /dev/null
+++ b/sys/imfort/imopnc.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMOPNC -- Open a new copy of an existing image, with the same dimensions,
+# size, pixel type, and non-pixel header fields as the original, but without
+# copying any of the pixel data.  The new image is left open for read-write
+# access and a descriptor for the new image is returned as an argument.
+
+procedure imopnc (nimage, o_im, n_im, ier)
+
+%	character*(*) nimage
+pointer	o_im, n_im		# old, new image descriptors
+int	ier
+
+int	naxis, pixtype, junk, i
+int	axlen[IM_MAXDIM]
+define	quit_ 91
+
+begin
+	n_im = NULL
+
+	# Get the physical parameters of the old image.
+	pixtype = IM_PIXTYPE(o_im)
+	naxis = IM_NDIM(o_im)
+	do i = 1, naxis
+	    axlen[i] = IM_LEN(o_im,i)
+
+	# Create and open the new image.
+	call imcrea (nimage, axlen, naxis, pixtype, ier)
+	if (ier != OK)
+	    goto quit_
+	call imopen (nimage, RW, n_im, ier)
+	if (ier != OK)
+	    goto quit_
+
+	# Pass the header of the old image to the new.
+	call imhcpy (o_im, n_im, ier)
+	if (ier != OK)
+	    goto quit_
+
+	return
+
+quit_
+	# Error recovery.
+	if (n_im != NULL)
+	    call imclos (n_im, junk)
+end
diff --git a/sys/imfort/imopnx.x b/sys/imfort/imopnx.x
new file mode 100644
index 00000000..48af54b8
--- /dev/null
+++ b/sys/imfort/imopnx.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<imhdr.h>
+include	<mach.h>
+include	"imfort.h"
+include	"oif.h"
+
+# IMOPNX -- Open an existing imagefile.  Only host system filenames are
+# permitted, image sections are not permitted, no out of bounds references,
+# and so on.
+
+procedure imopnx (image, acmode, im, ier)
+
+char	image[ARB]	#I HOST name of image header file
+int	acmode		#I image access mode (RO, WO)
+pointer	im		#O receives image descriptor pointer
+int	ier		#O receives error status
+
+pointer	sp, pix_fp, hdr_fp
+pointer	pixfile, hdrfile, root, extn, envvar, valstr
+int	len_hdrmem, len_ua, status, ip
+
+pointer	bfopnx()
+long	clktime()
+int	imrdhdr(), sizeof(), stridxs(), ctoi()
+errchk	calloc
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_FNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+	call salloc (envvar, SZ_FNAME, TY_CHAR)
+	call salloc (valstr, SZ_FNAME, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	# Construct name of image header file.
+	call imf_parse (image, Memc[root], Memc[extn])
+	if (Memc[extn] == EOS)
+	    call strcpy ("imh", Memc[extn], SZ_FNAME)
+
+	call strcpy (Memc[root], Memc[hdrfile], SZ_FNAME)
+	call strcat (".", Memc[hdrfile], SZ_FNAME)
+	call strcat (Memc[extn], Memc[hdrfile], SZ_FNAME)
+
+	# Open image header file.
+	hdr_fp = bfopnx (Memc[hdrfile], acmode, RANDOM)
+	if (hdr_fp == ERR) {
+	    call sfree (sp)
+	    ier = IE_OPEN
+	    call im_seterrop (ier, Memc[hdrfile])
+	    return
+	}
+
+	# Determine the user area size.
+	len_ua = -1
+	call strpak ("min_lenuserarea", Memc[envvar], SZ_FNAME)
+	call zgtenv (Memc[envvar], Memc[valstr], SZ_FNAME, status)
+	if (status > 0) {
+	    ip = 1
+	    call strupk (Memc[valstr], Memc[valstr], SZ_FNAME)
+	    if (ctoi (Memc[valstr], ip, len_ua) <= 0)
+		len_ua = -1
+	}
+	if (len_ua < 0)
+	    len_ua = LEN_USERAREA
+
+	# Allocate image descriptor.
+	len_hdrmem = LEN_IMHDR + (len_ua / SZ_MII_INT)
+	call calloc (im, LEN_IMDES + len_hdrmem, TY_STRUCT)
+
+	IM_ACMODE(im) = acmode
+
+	# Read image header into descriptor.  Close the file after reading in
+	# the header if we are opening the image read only.
+
+	if (imrdhdr (hdr_fp, im, len_ua, TY_IMHDR) == ERR) {
+	    call bfclos (hdr_fp, status)
+	    call mfree (im, TY_STRUCT)
+	    call sfree (sp)
+	    ier = IE_NOTIMH
+	    call im_seterrop (ier, Memc[hdrfile])
+	    return
+	} else if (acmode == RO) {
+	    call bfclos (hdr_fp, status)
+	    hdr_fp = NULL
+	}
+
+	# Get the name of the pixel storage file from the image header,
+	# strip any node name prefix, and open the file.  Quit if the
+	# file cannot be opened.
+
+	call strcpy (Memc[hdrfile], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), Memc[pixfile],
+	    SZ_PATHNAME)
+	ip = pixfile + stridxs ("!", Memc[pixfile])
+	pix_fp = bfopnx (Memc[ip], acmode, SEQUENTIAL)
+
+	if (pix_fp == ERR) {
+	    call mfree (im, TY_STRUCT)
+	    call sfree (sp)
+	    ier = IE_OPNPIX
+	    call im_seterrop (ier, Memc[ip])
+	    return
+	}
+
+	# Initialize the runtime image descriptor and return.
+
+	IM_HDRFP(im)     = hdr_fp
+	IM_PIXFP(im)     = pix_fp
+	IM_LINESIZE(im)  = IM_PHYSLEN(im,1) * sizeof (IM_PIXTYPE(im))
+	IM_SZPIXEL(im)   = sizeof (IM_PIXTYPE(im))
+	IM_LENHDRMEM(im) = len_hdrmem
+	IM_LINEBUFP(im)  = NULL
+	IM_UABLOCKED(im) = -1
+
+	# If opening the image with write permission, assume that the image
+	# data will be modified (invalidating datamin/datamax).
+
+	if (acmode != RO)
+	    IM_MTIME(im) = clktime (long(0))
+
+	ier = OK
+	call sfree (sp)
+end
diff --git a/sys/imfort/impixf.x b/sys/imfort/impixf.x
new file mode 100644
index 00000000..a1e3beab
--- /dev/null
+++ b/sys/imfort/impixf.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPIXF -- Called on an open image to return the BFIO file descriptor of the
+# pixel file, and all important physical parameters describing where and how
+# the pixels are stored.  This information may be used to directly access the
+# pixel file, in particularly demanding applications.  Both the BFIO descriptor
+# and the (host) pixel file name are returned, with the expectation that the
+# caller will either use BFIO to directly access the pixel file, or call BFCLOS
+# to close the file, and reopen it under some other i/o package.
+#
+# NOTE - Use of this interface implies explicit knowledge of the physical
+# storage schema, hence programs which use this information may cease to work
+# in the future if the image storage format changes, e.g., if an IMFORT
+# interface is implemented for some storage format other than OIF.
+
+procedure impixf (im, pixfd, pixfil, pixoff, szline, ier)
+
+pointer	im			# image descriptor
+int	pixfd			# receives BFIO file descriptor of pixel file
+%	character*(*) pixfil
+int	pixoff			# one-indexed char offset to the pixels
+int	szline			# nchars used to store each image line
+int	ier
+
+pointer	sp, osfn, ip
+int	stridxs()
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	if (strne (IM_MAGIC(im), "imhdr"))
+	    ier = IE_MAGIC
+	else {
+	    call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), Memc[osfn],
+		SZ_PATHNAME)
+	    ip = osfn + stridxs ("!", Memc[osfn])
+	    call f77pak (Memc[ip], pixfil, len(pixfil))
+
+	    pixfd  = IM_PIXFP(im)
+	    pixoff = IM_PIXOFF(im)
+	    szline = IM_LINESIZE(im)
+	    ier = OK
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impkwb.x b/sys/imfort/impkwb.x
new file mode 100644
index 00000000..c37bde01
--- /dev/null
+++ b/sys/imfort/impkwb.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMPKWB -- Set the value of the named header keyword as a boolean.
+
+procedure impkwb (im, keyw, bval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+bool	bval
+int	ier
+
+pointer	sp, kp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imputb (im, Memc[kp], bval)) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impkwc.x b/sys/imfort/impkwc.x
new file mode 100644
index 00000000..307f2fc5
--- /dev/null
+++ b/sys/imfort/impkwc.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMPKWC -- Set the value of the named header keyword as a character string.
+
+procedure impkwc (im, keyw, sval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+%	character*(*) sval
+int	ier
+
+pointer	sp, kp, vp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (vp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	call f77upk (sval, Memc[vp], SZ_VALSTR)
+	iferr (call impstr (im, Memc[kp], Memc[vp])) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impkwd.x b/sys/imfort/impkwd.x
new file mode 100644
index 00000000..8e6694c3
--- /dev/null
+++ b/sys/imfort/impkwd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMPKWD -- Set the value of the named header keyword as a double.
+
+procedure impkwd (im, keyw, dval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+double	dval
+int	ier
+
+pointer	sp, kp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imputd (im, Memc[kp], dval)) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impkwi.x b/sys/imfort/impkwi.x
new file mode 100644
index 00000000..fe9ef656
--- /dev/null
+++ b/sys/imfort/impkwi.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMPKWI -- Set the value of the named header keyword as an integer.
+
+procedure impkwi (im, keyw, ival, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+int	ival
+int	ier
+
+pointer	sp, kp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imputi (im, Memc[kp], ival)) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impkwr.x b/sys/imfort/impkwr.x
new file mode 100644
index 00000000..caacb3d7
--- /dev/null
+++ b/sys/imfort/impkwr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMPKWR -- Set the value of the named header keyword as a real.
+
+procedure impkwr (im, keyw, rval, ier)
+
+pointer	im			# imfort image descriptor
+%       character*(*) keyw
+real	rval
+int	ier
+
+pointer	sp, kp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imputr (im, Memc[kp], rval)) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    ier = OK
+	    IM_UPDATE(im) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/impl1r.x b/sys/imfort/impl1r.x
new file mode 100644
index 00000000..9c742dad
--- /dev/null
+++ b/sys/imfort/impl1r.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL1R -- Put a line to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure impl1r (im, buf, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix
+int	imwpix()
+errchk	malloc
+
+begin
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im)
+
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    # Convert the pixels before writing to the pixel file.
+	    call achtrs (buf, Mems[bp], npix)
+
+	    # Write one line of data.
+	    if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	} else {
+	    # Write one line of data.
+	    if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/impl1s.x b/sys/imfort/impl1s.x
new file mode 100644
index 00000000..9faa62d4
--- /dev/null
+++ b/sys/imfort/impl1s.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL1S -- Put a line to a 1 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure impl1s (im, buf, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	ier
+
+long	offset
+int	nchars, npix
+int	imwpix()
+
+begin
+	# Verify the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * SZ_SHORT
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im)
+
+	# Write one line of data.
+	if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+	    ier = IE_WRPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/impl2r.x b/sys/imfort/impl2r.x
new file mode 100644
index 00000000..a837a92a
--- /dev/null
+++ b/sys/imfort/impl2r.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL2R -- Put a line to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure impl2r (im, buf, lineno, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix
+int	imwpix()
+errchk	malloc
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (lineno-1) * IM_LINESIZE(im)
+
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    # Convert the pixels from real to short before writing to the
+	    # pixel file.
+
+	    call achtrs (buf, Mems[bp], npix)
+
+	    # Write one line of data.
+	    if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	} else {
+	    # Write one line of data.
+	    if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/impl2s.x b/sys/imfort/impl2s.x
new file mode 100644
index 00000000..27f77731
--- /dev/null
+++ b/sys/imfort/impl2s.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL2S -- Put a line to a 2 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure impl2s (im, buf, lineno, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	ier
+
+long	offset
+int	nchars, npix
+int	imwpix()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Verify the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * SZ_SHORT
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (lineno-1) * IM_LINESIZE(im)
+
+	# Write one line of data.
+	if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+	    ier = IE_WRPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/impl3r.x b/sys/imfort/impl3r.x
new file mode 100644
index 00000000..2ecbd67c
--- /dev/null
+++ b/sys/imfort/impl3r.x
@@ -0,0 +1,75 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL3R -- Put a line to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure impl3r (im, buf, lineno, bandno, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	bandno			# band number
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix
+int	imwpix()
+errchk	malloc
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (bandno < 1 || bandno > IM_LEN(im,3)) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) +
+	    ((bandno-1) * IM_LEN(im,2) + (lineno-1)) * IM_LINESIZE(im)
+
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    # Convert the pixels from real to short before writing to the
+	    # pixel file.
+
+	    call achtrs (buf, Mems[bp], npix)
+
+	    # Write one line of data.
+	    if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	} else {
+	    # Write one line of data.
+	    if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/impl3s.x b/sys/imfort/impl3s.x
new file mode 100644
index 00000000..5f7d48c9
--- /dev/null
+++ b/sys/imfort/impl3s.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPL3S -- Put a line to a 3 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure impl3s (im, buf, lineno, bandno, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	lineno			# line number
+int	bandno			# band number
+int	ier
+
+long	offset
+int	nchars, npix
+int	imwpix()
+
+begin
+	# Verify in bounds.
+	if (lineno < 1 || lineno > IM_LEN(im,2)) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (bandno < 1 || bandno > IM_LEN(im,3)) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Verify the image is of type short.
+	if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = IM_LEN(im,1)
+	nchars = npix * SZ_SHORT
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) +
+	    ((bandno-1) * IM_LEN(im,2) + (lineno-1)) * IM_LINESIZE(im)
+
+	# Write one line of data.
+	if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+	    ier = IE_WRPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps1r.x b/sys/imfort/imps1r.x
new file mode 100644
index 00000000..cef58a26
--- /dev/null
+++ b/sys/imfort/imps1r.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS1R -- Put a section to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imps1r (im, buf, i1, i2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix
+int	imwpix()
+errchk	malloc
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = (i2 - i1 + 1)
+	nchars = npix * IM_SZPIXEL(im)
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (i1-1) * IM_SZPIXEL(im)
+
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    # Convert the pixels from real to short before writing to the
+	    # pixel file.
+
+	    call achtrs (buf, Mems[bp], npix)
+
+	    # Write one line of data.
+	    if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	} else {
+	    # Write one line of data.
+	    if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps1s.x b/sys/imfort/imps1s.x
new file mode 100644
index 00000000..198025fb
--- /dev/null
+++ b/sys/imfort/imps1s.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS1S -- Put a section to a 1 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imps1s (im, buf, i1, i2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	ier
+
+long	offset
+int	nchars, npix
+int	imwpix()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+
+	# Compute offset into pixel file.
+	offset = IM_PIXOFF(im) + (i1-1) * SZ_SHORT
+
+	# Write one line of data.
+	if (nchars != imwpix (im, buf, nchars, offset, 0)) {
+	    ier = IE_WRPIX
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps2r.x b/sys/imfort/imps2r.x
new file mode 100644
index 00000000..8306e701
--- /dev/null
+++ b/sys/imfort/imps2r.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS2R -- Put a section to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imps2r (im, buf, i1, i2, j1, j2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	j1, j2			# line number
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix, ip, j
+int	imwpix()
+errchk	malloc
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = (i2 - i1 + 1)
+	nchars = npix * IM_SZPIXEL(im)
+	ip = 1
+
+	do j = j1, j2 {
+	    # Compute offset into pixel file.
+	    offset = IM_PIXOFF(im) + (j-1) * IM_LINESIZE(im) +
+		(i1-1) * IM_SZPIXEL(im)
+
+	    if (IM_PIXTYPE(im) == TY_SHORT) {
+		# Convert the pixels from real to short before writing to the
+		# pixel file.
+
+		call achtrs (buf[ip], Mems[bp], npix)
+
+		# Write one line of data.
+		if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+		    ier = IE_WRPIX
+		    call im_seterrim (ier, im)
+		    return
+		}
+
+	    } else {
+		# Write one line of data.
+		if (nchars != imwpix (im, buf[ip], nchars, offset, 0)) {
+		    ier = IE_WRPIX
+		    call im_seterrim (ier, im)
+		    return
+		}
+	    }
+
+	    ip = ip + npix
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps2s.x b/sys/imfort/imps2s.x
new file mode 100644
index 00000000..81ee8baa
--- /dev/null
+++ b/sys/imfort/imps2s.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS2S -- Put a section to a 2 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imps2s (im, buf, i1, i2, j1, j2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	j1, j2			# first, last lines
+int	ier
+
+long	offset
+int	nchars, npix, ip, j
+int	imwpix()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+	ip = 1
+
+	do j = j1, j2 {
+	    # Compute offset into pixel file.
+	    offset = IM_PIXOFF(im) +
+		((j-1) * IM_LINESIZE(im) + (i1-1)) * SZ_SHORT
+
+	    # Write one line of data.
+	    if (nchars != imwpix (im, buf[ip], nchars, offset, 0)) {
+		ier = IE_WRPIX
+		call im_seterrim (ier, im)
+		return
+	    }
+
+	    ip = ip + npix
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps3r.x b/sys/imfort/imps3r.x
new file mode 100644
index 00000000..9b099612
--- /dev/null
+++ b/sys/imfort/imps3r.x
@@ -0,0 +1,91 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS3R -- Put a section to an image of type short or real.  Automatic
+# datatype conversion from real to short is performed if necessary.
+# It is illegal to reference out of bounds.
+
+procedure imps3r (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+pointer	im			# image descriptor
+real	buf[ARB]		# user data buffer
+int	i1, i2			# first, last column
+int	j1, j2			# line numbers
+int	k1, k2			# band numbers
+int	ier
+
+pointer	bp
+long	offset
+int	nchars, npix, ip, j, k
+int	imwpix()
+errchk	malloc
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (k1 < 1 || k2 > IM_LEN(im,3) || k1 > k2) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT && IM_PIXTYPE(im) != TY_REAL) {
+	    ier = IE_PIXTYPE
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	# Need an extra line buffer for the type conversion in this case.
+	if (IM_PIXTYPE(im) == TY_SHORT) {
+	    bp = IM_LINEBUFP(im)
+	    if (bp == NULL) {
+		call malloc (bp, IM_LEN(im,1), TY_SHORT)
+		IM_LINEBUFP(im) = bp
+	    }
+	}
+
+	npix = (i2 - i1 + 1)
+	nchars = npix * IM_SZPIXEL(im)
+	ip = 1
+
+	do k = k1, k2 {
+	    do j = j1, j2 {
+		# Compute offset into pixel file.
+		offset = IM_PIXOFF(im) + (i1-1) * IM_SZPIXEL(im) +
+		    ((k-1) * IM_LEN(im,2) + (j-1)) * IM_LINESIZE(im)
+
+		if (IM_PIXTYPE(im) == TY_SHORT) {
+		    # Convert the pixels from real to short before writing to
+		    # the pixel file.
+
+		    call achtrs (buf[ip], Mems[bp], npix)
+
+		    # Write one line of data.
+		    if (nchars != imwpix (im, Mems[bp], nchars, offset, 1)) {
+			ier = IE_WRPIX
+			call im_seterrim (ier, im)
+			return
+		    }
+
+		} else {
+		    # Write one line of data.
+		    if (nchars != imwpix (im, buf[ip], nchars, offset, 0)) {
+			ier = IE_WRPIX
+			call im_seterrim (ier, im)
+			return
+		    }
+		}
+
+		ip = ip + npix
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imps3s.x b/sys/imfort/imps3s.x
new file mode 100644
index 00000000..74578e92
--- /dev/null
+++ b/sys/imfort/imps3s.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMPS3S -- Put a section to a 3 dimensional image of type short.
+# No automatic datatype conversion is performed.  It is illegal to reference
+# out of bounds.
+
+procedure imps3s (im, buf, i1, i2, j1, j2, k1, k2, ier)
+
+pointer	im			# image descriptor
+short	buf[ARB]		# user data buffer
+int	i1, i2			# first, last columns
+int	j1, j2			# first, last lines
+int	k1, k2			# first, last bands
+int	ier
+
+long	offset
+int	nchars, npix, ip, j, k
+int	imwpix()
+
+begin
+	# Verify in bounds.
+	if (i1 < 1 || i2 > IM_LEN(im,1) || i1 > i2) {
+	    ier = IE_XOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (j1 < 1 || j2 > IM_LEN(im,2) || j1 > j2) {
+	    ier = IE_YOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (k1 < 1 || k2 > IM_LEN(im,3) || k1 > k2) {
+	    ier = IE_ZOOB
+	    call im_seterrim (ier, im)
+	    return
+	} else if (IM_PIXTYPE(im) != TY_SHORT) {
+	    ier = IE_NOTSHORT
+	    call im_seterrim (ier, im)
+	    return
+	}
+
+	npix = i2 - i1 + 1
+	nchars = npix * SZ_SHORT
+	ip = 1
+
+	do k = k1, k2 {
+	    do j = j1, j2 {
+		# Compute offset into pixel file.
+		offset = IM_PIXOFF(im) + (i1-1) * SZ_SHORT +
+		    ((k-1) * IM_LEN(im,2) + (j-1)) * IM_LINESIZE(im)
+
+		# Write one line of data.
+		if (nchars != imwpix (im, buf[ip], nchars, offset, 0)) {
+		    ier = IE_WRPIX
+		    call im_seterrim (ier, im)
+		    return
+		}
+
+		ip = ip + npix
+	    }
+	}
+
+	ier = OK
+end
diff --git a/sys/imfort/imrdhdr.x b/sys/imfort/imrdhdr.x
new file mode 100644
index 00000000..74597811
--- /dev/null
+++ b/sys/imfort/imrdhdr.x
@@ -0,0 +1,200 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <imhdr.h>
+include "imfort.h"
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+
+# IMRDHDR -- Read the image header.  Either the main image header or the
+# pixel file header can be read.
+
+int procedure imrdhdr (fp, im, uchars, htype)
+
+pointer	fp			#I header file descriptor
+pointer	im			#I image descriptor
+int	uchars			#I maxchars of user area data to read
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1
+char	immagic[SZ_IMMAGIC]
+int	sulen_userarea, hdrlen, nchars, status
+
+bool	streq()
+int	i_miirdc(), i_miirdi(), i_miirdl(), i_miirdr()
+int	btoi(), bfrseq(), bfseek()
+
+define	readerr_ 91
+
+begin
+	# Determine the file type.
+	if (bfseek (fp, BOFL) == ERR)
+	    return (ERR)
+	if (bfrseq (fp, immagic, SZ_IMMAGIC) != SZ_IMMAGIC)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V1_PMAGIC)) {
+	    # V1 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V1_MAGIC)) {
+	    # Old V1 image header.
+
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    if (bfseek (fp, BOFL) == ERR) {
+		call sfree (sp)
+		return (ERR)
+	    }
+	    nchars = LEN_V1IMHDR * SZ_MII_INT
+	    if (bfrseq (fp, IM_V1MAGIC(v1), nchars) != nchars) {
+		call sfree (sp)
+		return (ERR)
+	    }
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V1_VERSION
+
+	    # The following is the length of the user area in SU.
+	    sulen_userarea = IM_V1HDRLEN(v1) - LEN_V1IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    IM_SWAP(im) = NO
+	    IM_SWAPPED(im) = -1
+	    IM_PIXTYPE(im) = IM_V1PIXTYPE(v1)
+
+	    IM_NDIM(im) = IM_V1NDIM(v1)
+	    call amovl (IM_V1LEN(v1,1), IM_LEN(im,1), IM_MAXDIM)
+	    call amovl (IM_V1PHYSLEN(v1,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+
+	    IM_SSMTYPE(im) = IM_V1SSMTYPE(v1)
+	    IM_LUTOFF(im) = IM_V1LUTOFF(v1)
+	    IM_PIXOFF(im) = IM_V1PIXOFF(v1)
+	    IM_HGMOFF(im) = IM_V1HGMOFF(v1)
+	    IM_CTIME(im) = IM_V1CTIME(v1)
+	    IM_MTIME(im) = IM_V1MTIME(v1)
+	    IM_LIMTIME(im) = IM_V1LIMTIME(v1)
+	    IM_MAX(im) = IM_V1MAX(v1)
+	    IM_MIN(im) = IM_V1MIN(v1)
+
+	    call strcpy (IM_V1PIXFILE(v1), IM_PIXFILE(im), SZ_IMPIXFILE)
+	    call strcpy (IM_V1HDRFILE(v1), IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call strcpy (IM_V1TITLE(v1), IM_TITLE(im), SZ_IMTITLE)
+	    call strcpy (IM_V1HISTORY(v1), IM_HISTORY(im), SZ_IMHIST)
+
+	    # Read and output the user area.
+	    if (uchars > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (bfrseq (fp, Memc[IM_USERAREA(im)], nchars) <= 0)
+		    return (ERR)
+	    }
+
+	    call sfree (sp)
+	    return (OK)
+	}
+
+	# Check for a new format header.
+	if (bfseek (fp, BOFL) == ERR)
+	    return (ERR)
+	if (i_miirdc (fp, immagic, SZ_IMMAGIC) < 0)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V2_PMAGIC)) {
+	    # V2 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V2_MAGIC)) {
+	    # Newer V2 image header.
+	    status = ERR
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V2_VERSION
+
+	    # "sulen_userarea" is the length of the user area in SU.
+	    if (i_miirdi (fp, hdrlen, 1) != 1)
+		goto readerr_
+	    sulen_userarea = hdrlen - LEN_V2IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    if (i_miirdi (fp, IM_PIXTYPE(im), 1) != 1)
+		goto readerr_
+
+	    # Determine whether to byte swap the pixels.
+	    if (i_miirdi (fp, IM_SWAPPED(im), 1) != 1)
+		goto readerr_
+
+	    IM_SWAP(im) = NO
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT, TY_USHORT:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP2)
+	    case TY_INT, TY_LONG:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP4)
+	    case TY_REAL:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP4)
+	    case TY_DOUBLE:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP8)
+	    }
+
+	    # Read the fixed-format fields of the header.
+	    if (i_miirdi (fp, IM_NDIM(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdi (fp, IM_LEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_PHYSLEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_SSMTYPE(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_LUTOFF(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_PIXOFF(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_HGMOFF(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_BLIST(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_SZBLIST(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_NBPIX(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_CTIME(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_MTIME(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdl (fp, IM_LIMTIME(im), 1) < 0)
+		goto readerr_
+
+	    if (i_miirdr (fp, IM_MAX(im), 1) < 0)
+		goto readerr_
+	    if (i_miirdr (fp, IM_MIN(im), 1) < 0)
+		goto readerr_
+
+	    if (i_miirdc (fp, IM_PIXFILE(im), SZ_V2IMPIXFILE) < 0)
+		goto readerr_
+	    if (i_miirdc (fp, IM_HDRFILE(im), SZ_V2IMHDRFILE) < 0)
+		goto readerr_
+	    if (i_miirdc (fp, IM_TITLE(im), SZ_V2IMTITLE) < 0)
+		goto readerr_
+	    if (i_miirdc (fp, IM_HISTORY(im), SZ_V2IMHIST) < 0)
+		goto readerr_
+
+	    # Read the variable-length user area.
+	    if (uchars > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (i_miirdc (fp, Memc[IM_USERAREA(im)], nchars) < 0)
+		    goto readerr_
+	    }
+
+	    status = OK
+readerr_
+	    return (status)
+	}
+
+	return (ERR)
+end
diff --git a/sys/imfort/imrnam.x b/sys/imfort/imrnam.x
new file mode 100644
index 00000000..333ff5da
--- /dev/null
+++ b/sys/imfort/imrnam.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"imfort.h"
+include	"oif.h"
+
+# IMRNAM -- Rename an image (both the header and pixel files).  It is not an
+# error if there is no pixel file.  The rename operator can be used to move
+# an image to a different directory.
+
+procedure imrnam (oimage, nimage, ier)
+
+%	character*(*) oimage
+%	character*(*) nimage
+int	ier
+
+int	status
+pointer	sp, im, ip
+pointer	root, extn, osfn
+pointer	old_hfn, new_hfn
+pointer	old_pfn, new_pfn
+pointer	o_osfn, n_osfn
+
+bool	strne()
+int	stridxs()
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+	call salloc (old_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_pfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_pfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (n_osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (o_osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+
+	ier = OK
+
+	# Construct filename of new image header file.
+	call f77upk (nimage, Memc[new_hfn], SZ_PATHNAME)
+	call imf_parse (Memc[new_hfn], Memc[root], Memc[extn])
+	if (Memc[extn] == EOS)
+	    call strcpy (OIF_HDREXTN, Memc[extn], SZ_FNAME)
+
+	call strcpy (Memc[root], Memc[new_hfn], SZ_FNAME)
+	call strcat (".", Memc[new_hfn], SZ_FNAME)
+	call strcat (Memc[extn], Memc[new_hfn], SZ_FNAME)
+
+	# Open existing image, make sure that it exists.
+	call imopen (oimage, RW, im, ier)
+	if (ier != OK) {
+	    ier = IE_IMRNAMNEXIM
+	    goto quit_
+	}
+
+	# Perform clobber checking and delete any old image with the new
+	# name, if clobber is enabled.
+
+	call f77upk (oimage, Memc[o_osfn], SZ_PATHNAME)
+	call f77upk (nimage, Memc[n_osfn], SZ_PATHNAME)
+	if (strne (Memc[o_osfn], Memc[n_osfn])) {
+	    call strpak (Memc[new_hfn], Memc[osfn], SZ_PATHNAME)
+	    call zfacss (Memc[osfn], 0, 0, status)
+	    if (status == YES) {
+		call strpak ("clobber", Memc[osfn], SZ_FNAME)
+		call zgtenv (Memc[osfn], Memc[osfn], SZ_FNAME, status)
+		if (status != ERR) {
+		    call imdele (nimage, ier)
+		    if (ier != OK) {
+			ier = IE_IMRENAME
+			goto quit_
+		    }
+		} else {
+		    ier = IE_CLOBBER
+		    call f77upk (nimage, Memc[osfn], SZ_PATHNAME)
+		    call im_seterrop (ier, Memc[osfn])
+		    call sfree (sp)
+		    return
+		}
+	    }
+	}
+
+	# Our task here is nontrivial as the pixel file must be renamed as
+	# well as the header file, e.g., since renaming the header file may
+	# move it to a different directory, and the PIXFILE field in the
+	# image header may indicate that the pixel file is in the same dir
+	# as the header.  Must open image, get pixfile name from the header,
+	# and generate the new pixfile name.
+
+	call strcpy (IM_HDRFILE(im), Memc[old_hfn], SZ_PATHNAME)
+
+	if (IM_PIXFILE(im) != EOS) {
+	    # Get old pixel file name.
+	    call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im),
+		Memc[old_pfn], SZ_PATHNAME)
+	    ip = old_pfn + stridxs ("!", Memc[old_pfn])
+	    call strcpy (Memc[ip], Memc[old_pfn], SZ_PATHNAME)
+
+	    # Construct the new pixel file name.
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_PATHNAME)
+	    call imf_mkpixfname (im, Memc[new_pfn], SZ_PATHNAME, ier)
+	    if (ier != OK)
+		goto quit_
+
+	    ip = new_pfn + stridxs ("!", Memc[new_pfn])
+	    call strcpy (Memc[ip], Memc[new_pfn], SZ_PATHNAME)
+
+	    # Update the image header (save new pixel file name).
+	    IM_UPDATE(im) = YES
+
+	} else {
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_PATHNAME)
+	    Memc[old_pfn] = EOS
+	}
+
+	call imclos (im, ier)
+	if (ier != OK)
+	    goto quit_
+
+	call strpak (Memc[old_hfn], Memc[old_hfn], SZ_PATHNAME)
+	call strpak (Memc[old_pfn], Memc[old_pfn], SZ_PATHNAME)
+	call strpak (Memc[new_hfn], Memc[new_hfn], SZ_PATHNAME)
+	call strpak (Memc[new_pfn], Memc[new_pfn], SZ_PATHNAME)
+
+	# Rename the header and pixel files.  It is not an error if
+	# there is no pixel file.
+
+	call zfrnam (Memc[old_hfn], Memc[new_hfn], status)
+	if (status == ERR)
+	    ier = IE_IMRENAME
+	else if (Memc[old_pfn] != EOS) {
+	    call zfrnam (Memc[old_pfn], Memc[new_pfn], status)
+	    if (status == ERR)
+		ier = IE_IMRENAME
+	}
+
+quit_
+	call f77upk (oimage, Memc[old_hfn], SZ_PATHNAME)
+	call im_seterrop (ier, Memc[old_hfn])
+	call sfree (sp)
+end
diff --git a/sys/imfort/imswap.x b/sys/imfort/imswap.x
new file mode 100644
index 00000000..9bed0ebc
--- /dev/null
+++ b/sys/imfort/imswap.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "imfort.h"
+
+
+# IMSWAP -- Swap bytes in pixel data if indicated for this host and image.
+
+procedure imswap (im, buf, nchars)
+
+pointer	im
+char	buf[ARB]
+int	nchars
+
+int	nbytes
+
+begin
+	if (IM_SWAP(im) == NO)
+	    return
+
+	nbytes = nchars * SZB_CHAR
+	switch (IM_SZPIXEL(im) * SZB_CHAR) {
+	case 2:
+	    call bswap2 (buf, 1, buf, 1, nbytes)
+	case 4:
+	    call bswap4 (buf, 1, buf, 1, nbytes)
+	case 8:
+	    call bswap8 (buf, 1, buf, 1, nbytes)
+	}
+end
diff --git a/sys/imfort/imtypk.x b/sys/imfort/imtypk.x
new file mode 100644
index 00000000..03c71d21
--- /dev/null
+++ b/sys/imfort/imtypk.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imfort.h"
+
+# IMTYPK -- Get the datatype and comment string for a keyword.
+
+procedure imtypk (im, keyw, dtype, comm, ier)
+
+pointer	im			# image descriptor
+%	character*(*) keyw
+int	dtype			# receives datatype code
+%	character*(*) comm
+int	ier
+
+pointer	sp, kp, cp
+int	errcode()
+
+begin
+	call smark (sp)
+	call salloc (kp, SZ_KEYWORD, TY_CHAR)
+	call salloc (cp, SZ_VALSTR, TY_CHAR)
+
+	call f77upk (keyw, Memc[kp], SZ_KEYWORD)
+	iferr (call imgatr (im, Memc[kp], dtype, Memc[cp], len(comm))) {
+	    ier = errcode()
+	    call im_seterrop (ier, Memc[kp])
+	} else {
+	    call f77pak (Memc[cp], comm, len(comm))
+	    ier = OK
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imfort/imwpix.x b/sys/imfort/imwpix.x
new file mode 100644
index 00000000..905d2c5c
--- /dev/null
+++ b/sys/imfort/imwpix.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	"imfort.h"
+
+# IMWPIX -- Write a block of pixels to an image.  This is equivalent to
+# a binary file write to the pixel file (bfwrit) except that the pixels
+# are swapped if necessary.
+
+int procedure imwpix (im, buf, nchars, offset, inplace)
+
+pointer	im			#I image descriptor
+char	buf[ARB]		#I pixel data
+int	nchars			#I nchars of data to be written
+int	offset			#I file offset in pixel file
+int	inplace			#I nonzero if ok to modify input data buffer
+
+pointer	sp, bp
+int	nbytes, status
+int	bfwrit()
+
+begin
+	# Just write out the data if no swapping is required.
+	if (IM_SWAP(im) == NO)
+	    return (bfwrit (IM_PIXFP(im), buf, nchars, offset))
+
+	# Swap, but use the input buffer directly.
+	if (inplace != 0) {
+	    call imswap (im, buf, nchars)
+	    return (bfwrit (IM_PIXFP(im), buf, nchars, offset))
+	}
+
+	# We need to swap into a private buffer.
+	call smark (sp)
+	call salloc (bp, nchars, TY_CHAR)
+
+	# Swap into the output buffer.
+	nbytes = nchars * SZB_CHAR
+	switch (IM_SZPIXEL(im) * SZB_CHAR) {
+	case 2:
+	    call bswap2 (buf, 1, Memc[bp], 1, nbytes)
+	case 4:
+	    call bswap4 (buf, 1, Memc[bp], 1, nbytes)
+	case 8:
+	    call bswap8 (buf, 1, Memc[bp], 1, nbytes)
+	}
+
+	status = bfwrit (IM_PIXFP(im), Memc[bp], nchars, offset)
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/imfort/imwrhdr.x b/sys/imfort/imwrhdr.x
new file mode 100644
index 00000000..a9c0176f
--- /dev/null
+++ b/sys/imfort/imwrhdr.x
@@ -0,0 +1,256 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <imhdr.h>
+include "imfort.h"
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+# IMWRHDR -- Write an OIF image header.
+
+int procedure imwrhdr (fp, im, htype)
+
+pointer	fp			#I header file descriptor
+pointer	im			#I image descriptor
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1, fname
+int	status, hdrlen, len_userarea
+int	bfseek(), bfwseq(), i_miiwrc(), i_miiwri(), i_miiwrl(), i_miiwrr()
+int	strlen()
+
+define	v1done_  91
+define	v2start_ 92
+define	v2done_  93
+
+begin
+	switch (IM_HDRVER(im)) {
+	case V1_VERSION:
+	    # Old V1 image header.
+	    # ----------------------
+
+	    status = ERR
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		call strcpy (V1_MAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1IMHDR
+	    case TY_PIXHDR:
+		call strcpy (V1_PMAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1PIXHDR
+	    default:
+		goto v1done_
+	    }
+
+	    # The following is the length of the user area in chars.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    IM_V1HDRLEN(v1) = LEN_V1IMHDR +
+		(len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    IM_V1PIXTYPE(v1) = IM_PIXTYPE(im)
+	    IM_V1NDIM(v1) = IM_NDIM(im)
+	    call amovl (IM_LEN(im,1), IM_V1LEN(v1,1), IM_MAXDIM)
+	    call amovl (IM_PHYSLEN(im,1), IM_V1PHYSLEN(v1,1), IM_MAXDIM)
+
+	    IM_V1SSMTYPE(v1) = IM_SSMTYPE(im)
+	    IM_V1LUTOFF(v1) = IM_LUTOFF(im)
+	    IM_V1PIXOFF(v1) = IM_PIXOFF(im)
+	    IM_V1HGMOFF(v1) = IM_HGMOFF(im)
+	    IM_V1CTIME(v1) = IM_CTIME(im)
+	    IM_V1MTIME(v1) = IM_MTIME(im)
+	    IM_V1LIMTIME(v1) = IM_LIMTIME(im)
+	    IM_V1MAX(v1) = IM_MAX(im)
+	    IM_V1MIN(v1) = IM_MIN(im)
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V1IMPIXFILE)
+		goto v1done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V1IMHDRFILE)
+		goto v1done_
+
+	    call strcpy (IM_PIXFILE(im), IM_V1PIXFILE(v1), SZ_V1IMPIXFILE)
+	    call strcpy (IM_HDRFILE(im), IM_V1HDRFILE(v1), SZ_V1IMHDRFILE)
+	    call strcpy (IM_TITLE(im), IM_V1TITLE(v1), SZ_V1IMTITLE)
+	    call strcpy (IM_HISTORY(im), IM_V1HISTORY(v1), SZ_V1IMHIST)
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR)
+		call fpathname (IM_HDRFILE(im), IM_V1PIXFILE(v1),
+		    SZ_V1IMPIXFILE)
+
+	    # Write the file header.
+	    if (bfseek (fp, BOFL) == ERR)
+		goto v1done_
+	    if (bfwseq (fp, IM_V1MAGIC(v1), hdrlen * SZ_MII_INT) == ERR)
+		goto v1done_
+
+	    # Write the user area.
+	    if (htype == TY_IMHDR)
+		if (bfwseq (fp, Memc[IM_USERAREA(im)], len_userarea) == ERR)
+		    goto v1done_
+
+	    status = OK
+v1done_
+	    call sfree (sp)
+
+	case V2_VERSION:
+	    # Newer V2 image header.
+	    # ----------------------
+v2start_
+	    status = ERR
+	    call smark (sp)
+	    call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	    if (bfseek (fp, BOFL) == ERR)
+		goto v2done_
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		if (i_miiwrc (fp, V2_MAGIC, SZ_IMMAGIC) == ERR)
+		    goto v2done_
+		hdrlen = LEN_V2IMHDR
+	    case TY_PIXHDR:
+		if (i_miiwrc (fp, V2_PMAGIC, SZ_IMMAGIC) == ERR)
+		    goto v2done_
+		hdrlen = LEN_V2PIXHDR
+	    default:
+		goto v2done_
+	    }
+
+	    # The following is the length of the user area in SU.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    hdrlen = LEN_V2IMHDR + (len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    if (i_miiwri (fp, hdrlen, 1) == ERR)
+		goto v2done_
+	    if (i_miiwri (fp, IM_PIXTYPE(im), 1) == ERR)
+		goto v2done_
+
+	    # Record the byte swapping used for this image.  When writing a
+	    # new image we use the native data type of the host and don't
+	    # swap bytes, so IM_SWAPPED is YES if the host architecture is
+	    # byte swapped.
+
+	    switch (IM_ACMODE(im)) {
+	    case NEW_IMAGE, NEW_COPY, TEMP_FILE:
+		IM_SWAPPED(im) = -1
+		switch (IM_PIXTYPE(im)) {
+		case TY_SHORT, TY_USHORT:
+		    IM_SWAPPED(im) = BYTE_SWAP2
+		case TY_INT, TY_LONG:
+		    IM_SWAPPED(im) = BYTE_SWAP4
+		case TY_REAL:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP4
+		case TY_DOUBLE:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP8
+		}
+	    default:
+		# IM_SWAPPED should already be set in header.
+	    }
+
+	    if (i_miiwri (fp, IM_SWAPPED(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwri (fp, IM_NDIM(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_LEN(im,1), IM_MAXDIM) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_PHYSLEN(im,1), IM_MAXDIM) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_SSMTYPE(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_LUTOFF(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_PIXOFF(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_HGMOFF(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_BLIST(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_SZBLIST(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_NBPIX(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_CTIME(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_MTIME(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrl (fp, IM_LIMTIME(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrr (fp, IM_MAX(im), 1) == ERR)
+		goto v2done_
+	    if (i_miiwrr (fp, IM_MIN(im), 1) == ERR)
+		goto v2done_
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V2IMPIXFILE)
+		goto v2done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V2IMHDRFILE)
+		goto v2done_
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR) {
+		call aclrc (Memc[fname], SZ_PATHNAME)
+		call fpathname (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+		if (i_miiwrc (fp, Memc[fname], SZ_V2IMPIXFILE) == ERR)
+		    goto v2done_
+		status = OK
+		goto v2done_
+	    } else if (i_miiwrc (fp, IM_PIXFILE(im), SZ_V2IMPIXFILE) == ERR)
+		goto v2done_
+
+	    call oif_trim (IM_HDRFILE(im), SZ_V2IMHDRFILE)
+	    if (i_miiwrc (fp, IM_HDRFILE(im), SZ_V2IMHDRFILE) == ERR)
+		goto v2done_
+
+	    call oif_trim (IM_TITLE(im), SZ_V2IMTITLE)
+	    if (i_miiwrc (fp, IM_TITLE(im), SZ_V2IMTITLE) == ERR)
+		goto v2done_
+
+	    call oif_trim (IM_HISTORY(im), SZ_V2IMHIST)
+	    if (i_miiwrc (fp, IM_HISTORY(im), SZ_V2IMHIST) == ERR)
+		goto v2done_
+
+	    # Write the variable-length user area.
+	    if (i_miiwrc (fp, Memc[IM_USERAREA(im)], len_userarea) == ERR)
+		goto v2done_
+
+	    status = OK
+v2done_	
+	    call sfree (sp)
+
+	default:
+	    IM_HDRVER(im) = V2_VERSION
+	    goto v2start_
+	}
+
+	return (status)
+end
+
+
+# OIF_TRIM -- Trim trailing garbage at the end of a string.  This does not
+# affect the value of the string, but makes the contents of the output file
+# clearer when examined with file utilities.
+
+procedure oif_trim (s, nchars)
+
+char	s[ARB]
+int	nchars
+
+int	n
+int	strlen()
+
+begin
+	n = strlen(s) + 1
+	call aclrc (s[n], nchars - n)
+end
diff --git a/sys/imfort/mii.x b/sys/imfort/mii.x
new file mode 100644
index 00000000..4934a08e
--- /dev/null
+++ b/sys/imfort/mii.x
@@ -0,0 +1,314 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mii.h>
+
+
+# MII.X -- This is a stand-alone port of the miiread/miiwrite routines from
+# etc/osb, modified for IMFORT to use bfio.
+#
+#	status = i_miirdi (fp, spp, maxelem)
+#	status = i_miirdl (fp, spp, maxelem)
+#	status = i_miirdr (fp, spp, maxelem)
+#
+#	status = i_miiwri (fp, spp, nelem)
+#	status = i_miiwrl (fp, spp, nelem)
+#	status = i_miiwrr (fp, spp, nelem)
+#
+#	status = i_miirdc (fp, spp, maxchars)
+#	status = i_miiwrc (fp, spp, nchars)
+
+
+# MIIRDI -- Read a block of data stored externally in MII integer format.
+# Data is returned in the format of the local host machine.
+
+int procedure i_miirdi (fp, spp, maxelem)
+
+pointer	fp			#I input file
+int	spp[ARB]		#O receives data
+int	maxelem			#I max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), bfrseq()
+
+begin
+	pksize = miipksize (maxelem, MII_INT)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_INT) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = bfrseq (fp, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_INT))
+		call miiupki (Memc[bp], spp, nelem, TY_INT)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = bfrseq (fp, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_INT))
+		call miiupki (spp, spp, nelem, TY_INT)
+	    }
+	}
+
+	return (nelem)
+end
+
+
+# MIIRDL -- Read a block of data stored externally in MII long integer format.
+# Data is returned in the format of the local host machine.
+
+int procedure i_miirdl (fp, spp, maxelem)
+
+pointer	fp			#I input file
+long	spp[ARB]		#O receives data
+int	maxelem			#I max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), bfrseq()
+
+begin
+	pksize = miipksize (maxelem, MII_LONG)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_LONG) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = bfrseq (fp, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_LONG))
+		call miiupkl (Memc[bp], spp, nelem, TY_LONG)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = bfrseq (fp, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_LONG))
+		call miiupkl (spp, spp, nelem, TY_LONG)
+	    }
+	}
+
+	return (nelem)
+end
+
+
+# MIIRDR -- Read a block of data stored externally in MII real format.
+# Data is returned in the format of the local host machine.
+
+int procedure i_miirdr (fp, spp, maxelem)
+
+pointer	fp			#I input file
+real	spp[ARB]		#O receives data
+int	maxelem			# max number of data elements to be read
+
+pointer	sp, bp
+int	pksize, nchars, nelem
+int	miipksize(), miinelem(), bfrseq()
+
+begin
+	pksize = miipksize (maxelem, MII_REAL)
+	nelem  = EOF
+
+	if (pksize > maxelem * SZ_REAL) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, pksize, TY_CHAR)
+
+	    nchars = bfrseq (fp, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_REAL))
+		call miiupkr (Memc[bp], spp, nelem, TY_REAL)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = bfrseq (fp, spp, pksize)
+	    if (nchars != EOF) {
+		nelem = min (maxelem, miinelem (nchars, MII_REAL))
+		call miiupkr (spp, spp, nelem, TY_REAL)
+	    }
+	}
+
+	return (nelem)
+end
+
+
+# MIIWRI -- Write a block of data to a file in MII integer format.
+# The input data is in the host system native binary format.
+
+int procedure i_miiwri (fp, spp, nelem)
+
+pointer	fp			#I output file
+int	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize, status
+int	miipksize(), bfwseq()
+
+begin
+	status = OK
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_INT)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipaki (spp, Memc[bp], nelem, TY_INT)
+	if (bfwseq (fp, Memc[bp], bufsize) == ERR)
+	    status = ERR
+
+	call sfree (sp)
+	return (status)
+end
+
+
+# MIIWRL -- Write a block of data to a file in MII long integer format.
+# The input data is in the host system native binary format.
+
+int procedure i_miiwrl (fp, spp, nelem)
+
+pointer	fp			#I output file
+long	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize, status
+int	miipksize(), bfwseq()
+
+begin
+	status = OK
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_LONG)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipakl (spp, Memc[bp], nelem, TY_LONG)
+	if (bfwseq (fp, Memc[bp], bufsize) == ERR)
+	    status = ERR
+
+	call sfree (sp)
+	return (status)
+end
+
+
+# MIIWRR -- Write a block of data to a file in MII real format.
+# The input data is in the host system native binary format.
+
+int procedure i_miiwrr (fp, spp, nelem)
+
+pointer	fp			#I output file
+real	spp[ARB]		#I native format data to be written
+int	nelem			#I number of data elements to be written
+
+pointer	sp, bp
+int	bufsize, status
+int	miipksize(), bfwseq()
+
+begin
+	status = OK
+	call smark (sp)
+
+	bufsize = miipksize (nelem, MII_REAL)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipakr (spp, Memc[bp], nelem, TY_REAL)
+	if (bfwseq (fp, Memc[bp], bufsize) == ERR)
+	    status = ERR
+
+	call sfree (sp)
+	return (status)
+end
+
+
+# MIIRDC -- Read a block of character data stored externally in MII format.
+# Data is returned in the machine independent character format.
+
+int procedure i_miirdc (fp, spp, maxchars)
+
+pointer	fp			#I input file
+char	spp[ARB]		#O receives data
+int	maxchars		#I max number of chars to be read
+
+pointer	sp, bp
+int	pksize, nchars
+int	miipksize(), miinelem(), bfrseq()
+
+begin
+	pksize = miipksize (maxchars, MII_BYTE)
+	nchars = max (maxchars, pksize)
+
+	if (nchars > maxchars) {
+	    # Read data into local buffer and unpack into user buffer.
+
+	    call smark (sp)
+	    call salloc (bp, nchars, TY_CHAR)
+
+	    nchars = bfrseq (fp, Memc[bp], pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, miinelem (nchars, MII_BYTE))
+		call miiupk8 (Memc[bp], spp, nchars, TY_CHAR)
+	    }
+
+	    call sfree (sp)
+	
+	} else {
+	    # Read data into user buffer and unpack in place.
+
+	    nchars = bfrseq (fp, spp, pksize)
+	    if (nchars != EOF) {
+		nchars = min (maxchars, miinelem (nchars, MII_BYTE))
+		call miiupk8 (spp, spp, nchars, TY_CHAR)
+	    }
+	}
+
+	return (nchars)
+end
+
+
+# MIIWRC -- Write a block of character data to a file in MII format.
+# The input data is assumed to be in a machine independent format. 
+
+int procedure i_miiwrc (fp, spp, nchars)
+
+pointer	fp			#I output file
+char	spp[ARB]		#I data to be written
+int	nchars			#I number of chars units to be written
+
+pointer	sp, bp
+int	bufsize, status
+int	miipksize(), bfwseq()
+
+begin
+	status = OK
+	call smark (sp)
+
+	bufsize = miipksize (nchars, MII_BYTE)
+	call salloc (bp, bufsize, TY_CHAR)
+
+	call miipak8 (spp, Memc[bp], nchars, TY_CHAR)
+	if (bfwseq (fp, Memc[bp], bufsize) == ERR)
+	    status = ERR
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/imfort/mkpkg b/sys/imfort/mkpkg
new file mode 100644
index 00000000..3eb70a52
--- /dev/null
+++ b/sys/imfort/mkpkg
@@ -0,0 +1,85 @@
+# Make the IMFORT library.
+
+$checkout libimfort.a lib$
+$update   libimfort.a
+$checkin  libimfort.a lib$
+$exit
+
+libimfort.a:
+	#$set XFLAGS	= "$XFLAGS -/DBLD_KERNEL"
+	$set XFLAGS	= "$(XFLAGS) -/DBLD_KERNEL"
+	@db
+
+	bfio.x		imfort.h <config.h> <mach.h> <fio.h>
+	clargs.x	imfort.h
+	imacck.x	imfort.h
+	imaddk.x	imfort.h
+	imakwb.x	imfort.h
+	imakwc.x	imfort.h
+	imakwd.x	imfort.h
+	imakwi.x	imfort.h
+	imakwr.x	imfort.h
+	imclos.x	imfort.h
+	imcrea.x	
+	imcrex.x	imfort.h oif.h <fio.h> <imhdr.h> <mach.h>
+	imdele.x	
+	imdelk.x	imfort.h
+	imdelx.x	imfort.h <imhdr.h> <protect.h>
+	imemsg.x	imfort.h <imhdr.h>
+	imfdir.x	oif.h
+	imfgpfn.x	oif.h
+	imflsh.x	imfort.h
+	imfmkpfn.x	imfort.h oif.h <imhdr.h>
+	imfparse.x	oif.h
+	imftrans.x	oif.h
+	imfupdhdr.x	imfort.h oif.h <imhdr.h>
+	imgkwb.x	imfort.h
+	imgkwc.x	imfort.h
+	imgkwd.x	imfort.h
+	imgkwi.x	imfort.h
+	imgkwr.x	imfort.h
+	imgl1r.x	imfort.h <imhdr.h>
+	imgl1s.x	imfort.h <imhdr.h>
+	imgl2r.x	imfort.h <imhdr.h>
+	imgl2s.x	imfort.h <imhdr.h>
+	imgl3r.x	imfort.h <imhdr.h>
+	imgl3s.x	imfort.h <imhdr.h>
+	imgs1r.x	imfort.h <imhdr.h>
+	imgs1s.x	imfort.h <imhdr.h>
+	imgs2r.x	imfort.h <imhdr.h>
+	imgs2s.x	imfort.h <imhdr.h>
+	imgs3r.x	imfort.h <imhdr.h>
+	imgs3s.x	imfort.h <imhdr.h>
+	imgsiz.x	imfort.h <imhdr.h>
+	imhcpy.x	imfort.h <imhdr.h>
+	imioff.x	oif.h <config.h> <imhdr.h> <mach.h>
+	imokwl.x	imfort.h
+	imopen.x	
+	imopnc.x	imfort.h <imhdr.h>
+	imopnx.x	imfort.h oif.h <config.h> <imhdr.h> <mach.h>
+	impixf.x	imfort.h <imhdr.h>
+	impkwb.x	imfort.h
+	impkwc.x	imfort.h
+	impkwd.x	imfort.h
+	impkwi.x	imfort.h
+	impkwr.x	imfort.h
+	impl1r.x	imfort.h <imhdr.h>
+	impl1s.x	imfort.h <imhdr.h>
+	impl2r.x	imfort.h <imhdr.h>
+	impl2s.x	imfort.h <imhdr.h>
+	impl3r.x	imfort.h <imhdr.h>
+	impl3s.x	imfort.h <imhdr.h>
+	imps1r.x	imfort.h <imhdr.h>
+	imps1s.x	imfort.h <imhdr.h>
+	imps2r.x	imfort.h <imhdr.h>
+	imps2s.x	imfort.h <imhdr.h>
+	imps3r.x	imfort.h <imhdr.h>
+	imps3s.x	imfort.h <imhdr.h>
+	imrdhdr.x	imfort.h imhv1.h imhv2.h oif.h <imhdr.h> <mach.h>
+	imrnam.x	imfort.h oif.h <imhdr.h>
+	imswap.x	imfort.h <mach.h>
+	imtypk.x	imfort.h
+	imwpix.x	imfort.h <imhdr.h> <mach.h>
+	imwrhdr.x	imfort.h imhv1.h imhv2.h oif.h <imhdr.h> <mach.h>
+	mii.x		<mii.h>
+	;
diff --git a/sys/imfort/oif.h b/sys/imfort/oif.h
new file mode 100644
index 00000000..43345e09
--- /dev/null
+++ b/sys/imfort/oif.h
@@ -0,0 +1,16 @@
+# OIF.H -- IKI/OIF internal definitions.
+
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	LEN_EXTN	3		# actual length imagefile extension
+define	OIF_HDREXTN	"imh"		# imheader filename extension
+define	OIF_PIXEXTN	"pix"		# pixel file extension
+define	LEN_PIXHDR	512		# length of PIXHDR structure
+define	COMPRESS	NO		# disable alignment of image lines?
+define	DEF_VERSION	2		# default file version
+define	HDR_EXTENSIONS	"|^imh|"	# legal header file extensions
+
+define	HDR		"HDR$"		# stands for header directory
+define	STRLEN_HDR	4
+
+define	TY_IMHDR	1		# main imagefile header
+define	TY_PIXHDR	2		# pixel file header
diff --git a/sys/imfort/tasks/README b/sys/imfort/tasks/README
new file mode 100644
index 00000000..9eb3e075
--- /dev/null
+++ b/sys/imfort/tasks/README
@@ -0,0 +1,20 @@
+IMIO$IMFORT/ZZDEBUG -
+
+    This directory contains a set of Fortran programs used to test the IMFORT
+software, and to provide real working examples illustrating the use of the
+IMFORT interface in host Fortran programs.
+
+	hello.f		prints `hello, world!'
+	imcopy.f	copy an image
+	imdel.f		delete an image
+	imren.f		rename an image
+	keyw.f		test header keyword access
+	minmax.f	update datamin, datamax
+	mkim.f		make a test image, pix[i,j] = j * 100 + i
+	pcube.f		print a subraster, e.g., of a MKIM test image
+	phead.f		print an image header in FITS format
+	planck.f	compute the planck function
+	readim.f	test sequential read through an image
+
+To compile individual programs:		cl> fc prog.f
+To define the tasks to the CL:		cl> cl < tasks.cl (edit tasks.cl first)
diff --git a/sys/imfort/tasks/args.f b/sys/imfort/tasks/args.f
new file mode 100644
index 00000000..b484c4cd
--- /dev/null
+++ b/sys/imfort/tasks/args.f
@@ -0,0 +1,33 @@
+c ARGS -- Test the command line argument interface.
+c
+c	usage:  args [arg1 [arg2 ...]]
+c ------------------------------------------------------------------------
+
+	program args
+
+	character*80	argstr
+	integer		nargs, ier, i
+
+c --- Test raw command line access.
+	call clrawc (argstr, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' clrawc returns status '', i3)') ier
+	else
+	    write (*, '('' clrawc: '', a80)') argstr
+	endif
+
+c --- Test parsed command line access.
+	call clnarg (nargs)
+	write (*, '('' nargs = '', i3)') nargs
+
+	do 10 i = 1, nargs
+	    call clargc (i, argstr, ier)
+	    if (ier .ne. 0) then
+		write (*, '('' unexpected error '', i3)') ier
+	    else
+		write (*, '(i4, 2x, a70)') i, argstr
+	    endif
+ 10	continue
+
+	stop
+	end
diff --git a/sys/imfort/tasks/hello.f b/sys/imfort/tasks/hello.f
new file mode 100644
index 00000000..f1649f31
--- /dev/null
+++ b/sys/imfort/tasks/hello.f
@@ -0,0 +1,6 @@
+c HELLO -- Sample Fortran program to demonstate compile/link.
+
+	program hello
+	write (*,*) 'hello, world!'
+	stop
+	end
diff --git a/sys/imfort/tasks/imcopy.f b/sys/imfort/tasks/imcopy.f
new file mode 100644
index 00000000..c81f5f05
--- /dev/null
+++ b/sys/imfort/tasks/imcopy.f
@@ -0,0 +1,81 @@
+c IMCOPY -- Copy an image of up to 2048 pixels per line.  Works for images of
+c up to three dimensions with a pixel type of either short or real.
+c
+c	usage:  imcopy oldimage newimage
+c ----------------------------------------------------------------------------
+
+	program imcopy
+
+	real		rpix(2048)
+	integer*2	spix(4096)
+	equivalence	(rpix, spix)
+	character*80	oimage, nimage, errmsg
+	integer		ncols, nlines, nbands, j, k, oim, nim
+	integer		ier, axlen(7), naxis, pixtype, nargs
+
+c --- Get command line arguments.
+	call clnarg (nargs)
+	if (nargs .eq. 2) then
+	    call clargc (1, oimage, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargc (2, nimage, ier)
+	    if (ier .ne. 0) goto 91
+	else
+	    write (*, '('' input image: '',$)')
+	    read (*,*) oimage
+	    write (*, '('' output image: '',$)')
+	    read (*,*) nimage
+	endif
+
+c --- Open the input image.
+	call imopen (oimage, 1, oim, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Create a new output image with the same header and size as the
+c	input image.
+
+	call imopnc (nimage, oim, nim, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Determine the size and pixel type of the image being copied.
+	call imgsiz (oim, axlen, naxis, pixtype, ier)
+	if (ier .ne. 0) goto 91
+	ncols  = axlen(1)
+	nlines = axlen(2)
+	nbands = axlen(3)
+
+c --- Copy the image.
+	if (pixtype .eq. 3) then
+	    do 15 k = 1, nbands
+		do 10 j = 1, nlines
+		    call imgl3s (oim, spix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+		    call impl3s (nim, spix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+ 10	        continue
+ 15	    continue
+	else
+	    do 25 k = 1, nbands
+		do 20 j = 1, nlines
+		    call imgl3r (oim, rpix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+		    call impl3r (nim, rpix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+ 20	        continue
+ 25	    continue
+	endif
+
+c --- Clean up.
+	call imclos (oim, ier)
+	if (ier .ne. 0) goto 91
+	call imclos (nim, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c -- Error actions.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/imdel.f b/sys/imfort/tasks/imdel.f
new file mode 100644
index 00000000..d7b65ab9
--- /dev/null
+++ b/sys/imfort/tasks/imdel.f
@@ -0,0 +1,29 @@
+c IMDEL -- Delete an image.
+c
+c	usage:  imdel imagename
+c ----------------------------------------------------------------------
+
+	program imdel
+
+	integer		ier
+	character*80	image, errmsg
+
+c --- Get the name of the image to be deleted.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Delete the image.
+	call imdele (image, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/imren.f b/sys/imfort/tasks/imren.f
new file mode 100644
index 00000000..ea70a1e4
--- /dev/null
+++ b/sys/imfort/tasks/imren.f
@@ -0,0 +1,36 @@
+c IMREN -- Rename an image.
+c
+c	usage:  imren oldname newname
+c ----------------------------------------------------------------------
+
+	program imren
+
+	integer		nargs, ier
+	character*80	oname, nname, errmsg
+
+c --- Get the old and new names of the image to be renamed.
+	call clnarg (nargs)
+	if (nargs .ge. 2) then
+	    call clargc (1, oname, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargc (2, nname, ier)
+	    if (ier .ne. 0) goto 91
+	else
+	    write (*, '('' enter old image name: '',$)')
+	    read (*,*) oname
+	    write (*, '('' enter new image name: '',$)')
+	    read (*,*) nname
+	endif
+
+c --- Rename the image.
+	call imrnam (oname, nname, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/keyw.f b/sys/imfort/tasks/keyw.f
new file mode 100644
index 00000000..ee235f51
--- /dev/null
+++ b/sys/imfort/tasks/keyw.f
@@ -0,0 +1,116 @@
+c KEYW -- Test the image header get/put interface routines.
+c
+c	usage:  keyw imagename
+c ----------------------------------------------------------------------------
+
+	program keyw
+
+	character*80	image, errmsg
+	character*8	keywrd, option
+	character*80	valstr, commnt
+	integer		ncols, nlines, dtype
+	integer		im, ier, axlen(7), naxis
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+	ncols  = axlen(1)
+	nlines = axlen(2)
+
+c --- Interpreter loop.
+ 10	continue
+	write (*, '('' enter command (quit,gkw[cir],pkw[cir],addk,delk): '',$)')
+	read (*,*) option
+
+	if (option .eq. 'pkwc') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) valstr
+	    call impkwc (im, keywrd, valstr, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'pkwi') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) ival
+	    call impkwi (im, keywrd, ival, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'pkwr') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) rval
+	    call impkwr (im, keywrd, rval, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'gkwc') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwc (im, keywrd, valstr, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', valstr
+	    goto 10
+
+	else if (option .eq. 'gkwi') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwi (im, keywrd, ival, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', ival
+	    goto 10
+
+	else if (option .eq. 'gkwr') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwr (im, keywrd, rval, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', rval
+	    goto 10
+
+	else if (option .eq. 'addk') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' keyword datatype: '',$)')
+	    read (*,*) dtype
+	    write (*, '('' comment field: '',$)')
+	    read (*,*) commnt
+	    call imaddk (im, keywrd, dtype, commnt, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', rval
+	    goto 10
+
+	else if (option .eq. 'delk') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imdelk (im, keywrd, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	endif
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/minmax.f b/sys/imfort/tasks/minmax.f
new file mode 100644
index 00000000..34edaea5
--- /dev/null
+++ b/sys/imfort/tasks/minmax.f
@@ -0,0 +1,56 @@
+c MINMAX -- Compute the minimum and maximum pixel values in an image.
+c The new values are printed as well as updated in the image header.
+c
+c	usage:  minmax image
+c ----------------------------------------------------------------------
+
+	program minmax
+
+	character*80	image, errmsg
+	real		pix(8192), dmin, dmax, vmin, vmax
+	integer		im, axlen(7), naxis, dtype, ier, j
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image for readwrite access (we need to update the header).
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Read through the image and compute the limiting pixel values.
+	do 10 j = 1, axlen(2)
+	    call imgl2r (im, pix, j, ier)
+	    if (ier .ne. 0) goto 91
+	    call alimr (pix, axlen(1), vmin, vmax)
+	    if (j .eq. 1) then
+		dmin = vmin
+		dmax = vmax
+	    else
+		dmin = min (dmin, vmin)
+		dmax = max (dmax, vmax)
+	    endif
+ 10	continue
+
+c --- Update the image header.
+	call impkwr (im, 'datamin', dmin, ier)
+	if (ier .ne. 0) goto 91
+	call impkwr (im, 'datamax', dmax, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+	write (*, '(1x, a20, 2 g12.5)') image, dmin, dmax
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/mkim.f b/sys/imfort/tasks/mkim.f
new file mode 100644
index 00000000..7aec2b24
--- /dev/null
+++ b/sys/imfort/tasks/mkim.f
@@ -0,0 +1,75 @@
+c MKIM -- Make a two dimensional test image of type short or real.  The pixel
+c values go 1, 2, 3, etc. in storage order.
+c
+c 	usage:  mkim image ncols nlines [dtype] [pixdir]
+c
+c The data type defaults to type short if not specified on the command line.
+c ---------------------------------------------------------------------------- 
+
+	program mkim
+
+	character*80	image, errmsg, pixdir
+	integer		im, ier, axlen(7), naxis, dtype
+	integer		nlines, ncols, i, j
+	real		pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Get image size.
+	call clargi (2, ncols, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' ncols: '',$)')
+	    read (*,*) ncols
+	endif
+	call clargi (3, nlines, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' nlines: '',$)')
+	    read (*,*) nlines
+	endif
+
+c --- Get pixel datatype (optional).
+	call clargi (4, dtype, ier)
+	if (ier .ne. 0) dtype = 3
+
+c --- Get pixel directory (optional).
+	call clargc (5, pixdir, ier)
+	if (ier .eq. 0) then
+	    call imsdir (pixdir)
+	endif
+
+	axlen(1) = ncols
+	axlen(2) = nlines
+	naxis    = 2
+
+c --- Create the image.
+	call imcrea (image, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Open the image for writing, and write the data.
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+
+	do 20 j = 1, nlines
+	    do 10 i = 1, ncols
+		pix(i) = (j-1) * ncols + i
+ 10	    continue
+	    call impl2r (im, pix, j, ier)
+	    if (ier .ne. 0) goto 91
+ 20	continue
+
+c --- Close the image and quit.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/pcube.f b/sys/imfort/tasks/pcube.f
new file mode 100644
index 00000000..89dd3651
--- /dev/null
+++ b/sys/imfort/tasks/pcube.f
@@ -0,0 +1,108 @@
+c PCUBE -- Extract a subraster (image cube) from an image and print
+c the values on the standard output.  This is used with a standard
+c test image to verify that the IMFORT interface is working correctly.
+c
+c	usage:  pcube image i1 i2 [j1 j2 [k1 k2]]
+c ---------------------------------------------------------------------
+
+	program pcube
+
+	character*80	image, errmsg
+	integer		i1, i2, j1, j2, k1, k2
+	integer		im, ier, axlen(7), naxis, dtype, nargs
+	real		pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Get subraster coordinates.
+	call clnarg (nargs)
+	if (nargs .lt. 3) then
+	    write (*, '('' enter subraster coordinates (i1 i2 j1 j2): '',$)')
+	    read (*,*) i1, i2, j1, j2
+	    k1 = 1
+	    k2 = 1
+	else
+	    call clargi (2, i1, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargi (3, i2, ier)
+	    if (ier .ne. 0) goto 91
+
+	    if (nargs .ge. 5) then
+		call clargi (4, j1, ier)
+		if (ier .ne. 0) goto 91
+		call clargi (5, j2, ier)
+		if (ier .ne. 0) goto 91
+	    else
+		j1 = 1
+		j2 = 1
+	    endif
+
+	    if (nargs .ge. 7) then
+		call clargi (6, k1, ier)
+		if (ier .ne. 0) goto 91
+		call clargi (7, k2, ier)
+		if (ier .ne. 0) goto 91
+	    else
+		k1 = 1
+		k2 = 1
+	    endif
+	endif
+
+c --- Extract the subraster.
+	call imgs3r (im, pix, i1, i2, j1, j2, k1, k2, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Print the pixel values.
+	call pcuber (pix, i2-i1+1, j2-j1+1, k2-k1+1, i1,i2, j1,j2, k1,k2)
+
+c --- Close the input image and quit.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error handler.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
+
+
+c PCUBER -- Print pixel values, 3d subraster, type real.
+c ----------------------------------------------------------------
+
+	subroutine pcuber (pix, nx,ny,nz, i1,i2, j1,j2, k1,k2)
+
+	integer		nx, ny, nz
+	real		pix(nx,ny,nz)
+	integer		i1, i2, j1, j2, k1, k2
+	integer		i, j, k
+
+	nx = i2 - i1 + 1
+	ny = j2 - j1 + 1
+	nz = k2 - k1 + 1
+
+	do 20 k = k1, k2
+	    write (*, '('' band '', i3)') k
+
+	    print 81, i1, i2, j1, j2
+	    do 10 j = 1, ny
+		print 82, j-1+j1, (pix(i,j,k), i = 1, nx)
+ 10	    continue
+ 20	continue
+
+ 81	format (' subraster at ', 4 i4)
+ 82	format (' line ', i4, 8 (1x, f7.0))
+
+	end
diff --git a/sys/imfort/tasks/phead.f b/sys/imfort/tasks/phead.f
new file mode 100644
index 00000000..4a54b584
--- /dev/null
+++ b/sys/imfort/tasks/phead.f
@@ -0,0 +1,155 @@
+c PHEAD -- Print the header of the named image in FITS format, one keyword
+c per line.  A pattern may optionally be specified to list some subset of the
+c header keywords.
+c
+c	usage:  phead image [pattern]
+c ----------------------------------------------------------------------------
+
+	program phead
+
+	character*20	kwname
+	character*80	image, patstr, errmsg
+	integer		im, kwl, ier
+	logical		sortit
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Get pattern string (list everything if no pattern given).
+	call clargc (2, patstr, ier)
+	if (ier .ne. 0) then
+	    patstr = '*'
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Open the keyword list and print each keyword in FITS format on the
+c     standard output device.
+
+	sortit = .false.
+	call imokwl (im, patstr, sortit, kwl, ier)
+
+ 10	continue
+	call imgnkw (kwl, kwname, ier)
+	if (ier .ne. 0) goto 20
+	    call putkey (im, kwname, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+ 20	continue
+
+	call imckwl (kwl, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '(1x, '' Error: '', a80)') errmsg
+
+	stop
+	end
+
+
+c PUTKEY -- Read the value and comment fields of the named image header
+c keyword, and print the value of the keyword in FITS format on the
+c standard output device.
+c
+c     000000000111111111122222222223333333333444444444455555555556
+c     123456789012345678901234567890123456789012345678901234567890
+c     keyword =                  xxx / comment
+c     keyword = 'sval    '           / comment
+c
+c Datatype codes: 1=bool, 2=char, 3,4,5=int, 6,7=real/double, 8=complex
+c Only codes 1, 2, 4, and 6 (bool,char,int,real) are returned by IMTYPK.
+c ------------------------------------------------------------------------
+
+	subroutine putkey (im, kwname, ier)
+
+	integer		im
+	character*(*)	kwname
+
+	logical		bval
+	character*68	sval
+	integer		ival
+	doubleprecision dval
+
+	character*18	valstr
+	character*47	comstr
+	character*70	lngstr
+	integer		nchars, dtype, ier, i
+
+c --- Get the keyword data type and comment information.
+	call imtypk (im, kwname, dtype, comstr, ier)
+	if (ier .ne. 0) return
+
+c --- Print the value of the keyword in FITS format.  The format depends
+c     upon the datatype of the parameter.
+
+	if (dtype .eq. 1) then
+	    call imgkwb (im, kwname, bval, ier)
+	    if (ier .ne. 0) return
+	    write (*, 10) kwname, bval, comstr
+ 10	    format (1x, a8, '= ', l20, ' / ', a47)
+
+	else if (dtype .ge. 3 .and. dtype .le. 5) then
+	    call imgkwi (im, kwname, ival, ier)
+	    if (ier .ne. 0) return
+	    write (*, 20) kwname, ival, comstr
+ 20	    format (1x, a8, '= ', i20, ' / ', a47)
+
+	else if (dtype .eq. 6 .or. dtype .eq. 7) then
+	    call imgkwd (im, kwname, dval, ier)
+	    if (ier .ne. 0) return
+	    if (abs(dval) .lt. 1.0E6 .and. abs(dval) .ge. 1.0E-1) then
+	        write (*, 30) kwname, dval, comstr
+ 30	        format (1x, a8, '= ', f20.2, ' / ', a47)
+	    else
+	        write (*, 31) kwname, dval, comstr
+ 31	        format (1x, a8, '= ', e20.12, ' / ', a47)
+	    endif
+
+	else
+	    call imgkwc (im, kwname, sval, ier)
+	    if (ier .ne. 0) return
+
+	    nchars = len(sval) - 1
+	    do 40 i = nchars, 9, -1
+		if (sval(i:i) .ne. ' ') goto 41
+		nchars = i - 1
+ 40	    continue
+ 41	    continue
+
+	    if (nchars .le. 8) then
+		write (*, 45) kwname, sval, comstr
+ 45	    	format (1x, a8, '= ''', a8, '''', 10x, ' / ', a47)
+	    else if (nchars .le. 18) then
+		valstr = sval
+		write (*, 46) kwname, valstr, comstr
+ 46	    	format (1x, a8, '= ''', a18, '''', ' / ', a47)
+	    else
+		nchars = min (nchars, len(lngstr) - 2)
+		lngstr(1:1) = ''''
+		do 47 i = 1, nchars
+		    lngstr(i+1:i+1) = sval(i:i)
+ 47		continue
+		lngstr(nchars+2:nchars+2) = ''''
+		do 48 i = nchars + 3, len(lngstr)
+		    lngstr(i:i) = ' '
+ 48		continue
+		write (*, 49) kwname, lngstr
+ 49	    	format (1x, a8, '= ', a69)
+	    endif
+	endif
+
+	ier = 0
+	end
diff --git a/sys/imfort/tasks/planck.f b/sys/imfort/tasks/planck.f
new file mode 100644
index 00000000..520183c0
--- /dev/null
+++ b/sys/imfort/tasks/planck.f
@@ -0,0 +1,59 @@
+c PLANCK -- Compute the Planck blackbody radiation distribution for a
+c given temperature and wavelength region.
+c
+c       usage:  planck temperature lambda1 lambda2
+c
+c The temperature is specified in degrees Kelvin and the wavelength
+c region in microns (1u=10000A).  100 [x,y] data points defining the
+c curve are output.
+c ----------------------------------------------------------------------
+
+        program planck
+
+	character*80	errmsg
+        integer         nargs, ier, i
+        real            w1, w2, dw, cm, t
+        real            xv(100), yv(100)
+
+c --- Get the temperature in degrees kelvin.
+        call clargr (1, t, ier)
+        if (ier .ne. 0) then
+            write (*, '('' temperature (degrees kelvin): '',$)')
+            read (*,*) t
+        endif
+
+c --- Get the wavelength region to be computed.
+        call clnarg (nargs)
+        if (nargs .ge. 3) then
+            call clargr (2, w1, ier)
+            if (ier .ne. 0) goto 91
+            call clargr (3, w2, ier)
+            if (ier .ne. 0) goto 91
+        else
+            write (*, '('' start wavelength (microns): '',$)')
+            read (*,*) w1
+            write (*, '('' end wavelength (microns): '',$)')
+            read (*,*) w2
+        endif
+
+c --- Compute the blackbody curve.
+        dw = (w2 - w1) / 99.0
+        do 10 i = 1, 100
+            xv(i) = ((i-1) * dw) + w1
+            cm = xv(i) * 1.0E-4
+            yv(i) = (3.74185E-5 * (cm ** -5)) /
+     *          (2.71828 ** (1.43883 / (cm * t)) - 1.0)
+ 10	continue
+
+c --- Print the curve as a table.
+        do 20 i = 1, 100
+	    write (*, '(1x, f7.4, g12.4)') xv(i), yv(i)
+ 20	continue
+
+	stop
+
+c --- Error exit. 
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/readim.f b/sys/imfort/tasks/readim.f
new file mode 100644
index 00000000..466da0e0
--- /dev/null
+++ b/sys/imfort/tasks/readim.f
@@ -0,0 +1,53 @@
+c READIM -- Read through an image and count the lines (used for timing tests).
+c Tests line sequential i/o.
+c
+c	usage:  readim image
+c ----------------------------------------------------------------------------
+
+	program readim
+
+	character*80	image, errmsg
+	integer		ncols, nlines, nbands, j, k
+	integer		im, ier, axlen(7), naxis, dtype
+	integer*2	pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+	ncols  = axlen(1)
+	nlines = axlen(2)
+	nbands = axlen(3)
+
+c --- Read through the image.
+	do 20 k = 1, nbands
+	    do 10 j = 1, nlines
+		call imgl3s (im, pix, j, k, ier)
+		if (ier .ne. 0) goto 91
+ 10	    continue
+ 20	continue
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	print 81, nlines, image
+ 81	format (' read ', i4, ' lines from image ', a64)
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/tasks.unix b/sys/imfort/tasks/tasks.unix
new file mode 100644
index 00000000..13aa52fb
--- /dev/null
+++ b/sys/imfort/tasks/tasks.unix
@@ -0,0 +1,18 @@
+# Declare the IMFORT test/demo tasks as CL foreign tasks [MACHDEP].
+# Usage: uncomment the appropriate declarations, and type `cl < tasks.cl'.
+# NOTE - requires that "iraf" be defined in the host environment. 
+
+task $args = "$${iraf}sys/imfort/tasks/args.e $1 $2 $3 $4 $5"
+task $hello = "$${iraf}sys/imfort/tasks/hello.e"
+task $imcopy = "$${iraf}sys/imfort/tasks/imcopy.e $(*)"
+task $imdel = "$${iraf}sys/imfort/tasks/imdel.e $(*)"
+task $imren = "$${iraf}sys/imfort/tasks/imren.e $(*)"
+task $keyw = "$${iraf}sys/imfort/tasks/keyw.e"
+task $minmax = "$${iraf}sys/imfort/tasks/minmax.e $(*)"
+task $mkim = "$${iraf}sys/imfort/tasks/mkim.e $(1) $2 $3 $4 $(5)"
+task $pcube = "$${iraf}sys/imfort/tasks/pcube.e $(1) $2 $3 $4 $5 $6 $7"
+task $phead = "$${iraf}sys/imfort/tasks/phead.e $(1) $2"
+task $planck = "$${iraf}sys/imfort/tasks/planck.e"
+task $readim = "$${iraf}sys/imfort/tasks/readim.e $(*)"
+
+keep
diff --git a/sys/imfort/tasks/tasks.vms b/sys/imfort/tasks/tasks.vms
new file mode 100644
index 00000000..2be943f4
--- /dev/null
+++ b/sys/imfort/tasks/tasks.vms
@@ -0,0 +1,17 @@
+# Declare the IMFORT test/demo tasks as CL foreign tasks [MACHDEP].
+# Usage: uncomment the appropriate declarations, and type `cl < tasks.cl'.
+
+task $args = "$args:==\$irafdisk:[iraf.sys.imfort.tasks]args.exe!args $1 $2 $3 $4 $5"
+task $hello = "$hello:==\$irafdisk:[iraf.sys.imfort.tasks]hello.exe!hello"
+task $imcopy = "$imcopy:==\$irafdisk:[iraf.sys.imfort.tasks]imcopy.exe!imcopy $(*)"
+task $imdel = "$imdel:==\$irafdisk:[iraf.sys.imfort.tasks]imdel.exe!imdel $(*)"
+task $imren = "$imren:==\$irafdisk:[iraf.sys.imfort.tasks]imren.exe!imren $(*)"
+task $keyw = "$keyw:==\$irafdisk:[iraf.sys.imfort.tasks]keyw.exe!keyw"
+task $minmax = "$minmax:==\$irafdisk:[iraf.sys.imfort.tasks]minmax.exe!minmax $(*)"
+task $mkim = "$mkim:==\$irafdisk:[iraf.sys.imfort.tasks]mkim.exe!mkim $(*) $2 $3 $4"
+task $pcube = "$pcube:==\$irafdisk:[iraf.sys.imfort.tasks]pcube.exe!pcube $(*) $2 $3 $4 $5 $6 $7"
+task $phead = "$phead:==\$irafdisk:[iraf.sys.imfort.tasks]phead.exe!phead $(1) $2"
+task $planck = "$planck:==\$irafdisk:[iraf.sys.imfort.tasks]planck.exe!planck"
+task $readim = "$readim:==\$irafdisk:[iraf.sys.imfort.tasks]readim.exe!readim $(*)"
+
+keep
diff --git a/sys/imio/README b/sys/imio/README
new file mode 100644
index 00000000..2e7228bf
--- /dev/null
+++ b/sys/imio/README
@@ -0,0 +1,210 @@
+Image i/o.  Coded May 1983, D. Tody.
+
+This initial implementation of IMIO, described in the ".hlp" design file,
+provides most of the functionality of the IMIO interface, but is not
+fully optimized internally.  Features include:
+
+    (1)	7 disk datatypes (ushort, silrdx).
+    (2)	6 in-core datatypes (the standard silrdx).
+    (3) Images of up to 7 dimensions are supported internally, though
+	only images of up to 3 dimensions are currently supported in the
+	interface.
+    (4)	Fully automatic multidimensional buffer allocation, resizing,
+	and deallocation.
+    (5) Arbitrary number of input buffers, allocated in a round robin
+	fashion, need not be the same size or dimension.
+    (5) Fully automatic type conversion.
+    (6) General image sections, coordinate flip, and subsampling.
+    (7) Both "compressed" and "block aligned" storage modes are
+	supported, with IMIO automatically selecting the optimal
+	choice during image creation.  The device blocksize is a
+	runtime variable.
+
+
+Planned future improvements:
+
+    (1)	Boundary extension.
+    (3) Optimization to the get/put line procedures to work directly
+	out of the FIO buffers when possible.
+    (3) Addition of the get/put pixel procedures.
+    (4) The image header is currently a simple binary file (structure).
+	Only one image header structure per header file is permitted.
+	Will be modified to use database facilities, and to permit
+	embedded image headers.
+    (5) Support for the unsigned byte disk datatype.
+
+
+FV NOTES:  I've made the following bug fixes:
+
+In imioff:
+   The setting of IM_PHYSDIM was taken outside the loop called when
+   IM_NDIM was zero.  There is was no way to set IM_PHYSDIM in the programmer
+   interface.
+
+In imhdr.h:
+   The offset to the user area IMU was changed from 603 to 613.  This was
+   a typo?
+
+In impnln:
+   The coerce statement is wrong since imgobf calls coerce to the
+   appropriate data type.
+
+In impnln:
+   There was a typo which did not set ve.
+
+------------------------
+
+Review image interface.  Device namining convention, use of explicit
+pathnames.  File read/write permissions required.  Why didn't imdopen
+work.
+
+Remove imdmap.x from system library, put in libim.a.
+
+
+Nov 84
+	Optimized line at a time i/o.  Added capability to reference directly
+into the FIO buffer.  This greatly improved the efficiency of simple image
+operations (no section, type conversion, etc.), without reducing the generality
+of the interface.
+
+
+---------------------------------------------------------------------------
+IMIO Modifications, April 1985
+
+
+1. Boundary Extension
+
+	types:		constant, nearest, reflect, wrap
+	parameters:	nbndrypix, tybndry, bndrypixval
+
+
+2. Database Access
+
+    New fields may be added to an image with IMADD.  The value of an existing
+field is set with one of the IMPUT procedures; automatic type conversion will
+be performed if necessary and permissible.  The value of an existing field is
+fetched with an IMGET procedure.  The image database interface is both forward
+and backward compatible, i.e., no changes are required to current programs and
+the same interface (ignoring minor semantic details) will be available when
+image headers are moved into DBIO.
+
+
+Functions
+
+	get,g - get the value of a field
+	put,p - set the value of a field
+	add,a - add a new field to a database
+	  acc - determine if the named field exists
+	  del - delete a field
+       gftype - get field datatype
+          gfn - get field name (matching a template)
+
+
+Procedures
+
+       value = imget[bcsilrdx] (im, "field")
+		        imgstr (im, "field", outstr, maxch)
+	       imput[bcsilrdx] (im, "field", value)
+		        impstr (im, "field", value)
+       	       imadd[bcsilrdx] (im, "field", def_value)
+		        imastr (im, "field", def_value)
+		        imaddf (im, "field", "datatype")
+	          y/n = imaccf (im, "field")
+			imdelf (im, "field")
+	       type = imgftype (im, "field")
+
+	     list = imofnl[us] (im, template)
+	   nchars/EOF = imgnfn (list, outstr, maxch)
+			imcfnl (list)
+
+
+The database interface may be used to access any field of the image header,
+including the following standard fields.  Note that the nomenclature has
+been changed slightly to make it more consistent with FITS.  Additional
+standard fields will be defined in the future.
+
+
+	  keyword     type                 description
+
+	i_naxis		i	number of axes (dimensionality)
+	i_naxis[1-7]	l	length of an axis ("i_naxis1", etc.)
+	i_pixtype	i	pixel datatype (SPP integer code)
+	i_minpixval	r	minimum pixel value
+	i_maxpixval	r	maximum pixel value
+	i_ctime		l	time of image creation
+	i_mtime		l	time of last modify
+	i_limtime	l	time when limits (minmax) were last updated
+	i_title		s	title string
+
+
+The following additional field names are recognized, but may disappear in the
+future:
+
+	i_history	s	history record (a string buffer at present)
+	i_pixfile	s	pathname of the pixel storage file
+
+
+The names of the standard fields share an "i_" prefix to reduce the possibility
+of collisions with data dependent keywords, to identify the standard fields in
+sorted listings, to allow use of pattern matching to discriminate between the
+standard fields and user fields, and so on.  The use of the "i_" prefix is
+made optional for the convenience of the interactive user, but the full name
+should always be used in compiled programs.
+
+
+3. Subfile Management (not implemented)
+
+    A subfile B of file A is a file which is logically subordinate to A but
+which is physically a separate file to the host operating system.  A subfile
+need not reside in the same directory as the main file.
+
+FIO shall provide support for subfiles as an abstract datatype.  For each
+ordinary file there shall optionally be zero or one subfile index files with
+the same root name as the main file but with the extension .zsf.  The index
+file, if present, shall list the subfiles of the main file.  The operations
+supported by FIO for subfiles shall include the following:
+
+
+	add a subfile to index and return pathname
+	delete a subfile from index and return pathname
+	get the pathname of a subfile
+	delete both index entry and physical file
+	delete a file and all subfiles
+
+
+It is important that FIO maintain the mapping of a subfile name to a physical
+file name to permit moves, copies, renames, etc. of files and their subfiles.
+Having to open the index file to get the pathname of a subfile is however
+inefficient.  To achieve both flexibility and efficiency the system packages
+IMIO and DBIO will cache the names of subfiles to eliminate most accesses to
+the index files.
+
+
+	add a subfile:
+	    add subfile to the index
+	    cache pathname
+
+	open subfile:
+	    repeat {
+		open subfile using cached pathname
+		if (file cannot be opened) {
+		    call fio to get the pathname of the subfile
+		    if (different from cached pathname) {
+			update cached pathname
+			next
+		    } else
+			error: cannot open file
+		} else {
+		    read file header and verify that this is our subfile
+		    if (not our subfile) {
+			close file
+			call fio to get the pathname of the subfile
+			if (different from cached pathname) {
+			    update cached pathname
+			    next
+			} else
+			    error: not our subfile
+		    } else
+			break			# success
+		}
+	    }
diff --git a/sys/imio/db/README b/sys/imio/db/README
new file mode 100644
index 00000000..cf7f9c1c
--- /dev/null
+++ b/sys/imio/db/README
@@ -0,0 +1,105 @@
+			Image Header Database Interface
+				dct 16-Apr-85
+
+1. Overview
+
+    This directory contains the first version of the image header database
+interface.  In this implementation the image header is a variable length fixed
+format binary structure.  The first, fixed format, part of the image header
+contains the standard fields in binary and is fixed in size.  This is followed
+by the so called "user area", a string buffer containing a sequence of
+variable length, newline delimited FITS format keyword=value header cards.
+When an image is open a large user area is allocated to permit the addition
+of new parameters without filling up the buffer.  When the header is
+subsequently updated on disk only as much disk space is used as is needed to
+store the actual header.
+
+This format header is upwards compatible with the old image header format,
+hence old images and programs do not have to be modified to use the IMIO
+release supporting database accesss.  In the future image headers will be
+maintained under DBIO, but the routines in the image header database interface
+are not exected to change.  The actual disk format of images will of course
+change when we switch over to the  DBIO headers.
+
+
+
+2. Functions
+
+	get,g - get the value of a field
+	put,p - set the value of a field
+	add,a - add a new field to a database
+	  acc - determine if the named field exists
+
+
+3. Procedures
+
+       value = imget[bcsilrdx] (im, "field")
+		        imgstr (im, "field", outstr, maxch)
+	       imput[bcsilrdx] (im, "field", value)
+		        impstr (im, "field", value)
+       	       imadd[bcsilrdx] (im, "field", def_value)
+		        imastr (im, "field", def_value)
+		        imaddf (im, "field", "datatype")
+	          y/n = imaccf (im, "field")
+
+             list = imofnl[su] (im, template)
+                  nch = imgnfn (im, outstr, maxch)
+                        imcfnl (im)
+
+
+
+4. Description
+
+    New parameters will typically be added to the image header with either
+one of the typed procedures IMADD_ or with the lower level procedure IMADDF.
+The former procedures permit the parameter to be created and the value
+initialized all in one call, while the latter only creates the parameter.
+In addition, the typed IMADD_ procedures may be used to update the values
+of existing parameters (it is not considered an error if the parameter
+already exists).  The principal limitation of the typed procedures is that
+they may only be used to add or set parameters of a standard datatype.
+The IMADDF procedure will permit creation of parameters with more descriptive
+datatypes (domains) when the interface is recut upon DBIO.
+
+The value of any parameter may be fetched with one of the IMGET functions.
+The IMACCF function may be used (like ACCESS for a file) to determine
+whether a parameter exists.
+
+The database interface may be used to access any field of the image header,
+including the following standard fields.  Note that the nomenclature has
+been changed slightly to make it more consistent with FITS.  Additional
+standard fields will be defined in the future.
+
+
+	  keyword     type                 description
+
+	i_naxis		i	number of axes (dimensionality)
+	i_naxis[1-7]	l	length of an axis ("i_naxis1", etc.)
+	i_pixtype	i	pixel datatype (SPP integer code)
+	i_minpixval	r	minimum pixel value
+	i_maxpixval	r	maximum pixel value
+	i_ctime		l	time of image creation
+	i_mtime		l	time of last modify
+	i_limtime	l	time when limits (minmax) were last updated
+	i_title		s	title string
+
+
+The names of the standard fields share an "i_" prefix to reduce the possibility
+of collisions with data dependent keywords, to identify the standard fields in
+sorted listings, to allow use of pattern matching to discriminate between the
+standard fields and user fields, and so on.  For the convenience of the user,
+the "i_" prefix may be omitted provided the resultant name does not match the
+name of a user parameter.  It is however recommended that the full name be
+used in all applications software.
+
+
+5. Restrictions
+
+    The use of FITS format as the internal format for storing fields in this
+version of the interface places restrictions on the size of field names and
+of the string value of string valued parameters.  Field names are currently
+limited to eight characters or less and case is ignored (since FITS requires
+upper case).  The eight character limit does not apply to the standard fields.
+String values are limited to at most 68 characters.  If put string is passed
+a longer string it will be silently truncated.  Trailing whitespace and
+newlines are chopped when a string value is read.
diff --git a/sys/imio/db/idb.h b/sys/imio/db/idb.h
new file mode 100644
index 00000000..327ce3d2
--- /dev/null
+++ b/sys/imio/db/idb.h
@@ -0,0 +1,24 @@
+# IDB.H -- Image header database interface.  In this version of the interface
+# the standard image header fields are maintained in binary in a fixed
+# structure and the user fields are maintained in FITS format (text) in the
+# a string buffer following the binary image header.
+
+define	IDB_RECLEN		80		# length of a FITS record (card)
+define	IDB_STARTVALUE		10		# first column of value field
+define	IDB_ENDVALUE		30		# last  column of value field
+define	IDB_LENNUMERICRECORD	80		# length of new numeric records
+define	IDB_LENSTRINGRECORD	80		# length of new string records
+define	IDB_SZFITSKEY		8		# max length FITS keyword
+
+# Standard header keywords accessible via the database interface.
+
+define	I_CTIME			1
+define	I_HISTORY		2
+define	I_LIMTIME		3
+define	I_MAXPIXVAL		4
+define	I_MINPIXVAL		5
+define	I_MTIME			6
+define	I_NAXIS			7
+define	I_PIXFILE		8
+define	I_PIXTYPE		9
+define	I_TITLE			10
diff --git a/sys/imio/db/idbcard.x b/sys/imio/db/idbcard.x
new file mode 100644
index 00000000..38ea36fb
--- /dev/null
+++ b/sys/imio/db/idbcard.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+.help IDBCARD
+.nf -------------------------------------------------------------------------
+Card i/o package, for reading through the FITS area of the image header.
+
+	         idb = idb_open (im, ualen)
+       recno|EOF = idb_nextcard (idb, rp)
+		      idb_close (idb)
+
+This is a very simple package, used only to hide the details of how to
+access successive image header cards.  The main routine returns a char
+pointer to successive cards until the end of the header is reached.
+This is convenient for efficient read access to the header; direct i/o
+to the image header may be accomplished by using STROPEN to open the
+header buffer on a file descriptor.
+
+This entire interface assumes that the header is stored in FITS format,
+which is an implementation detail of the current IMIO interface.  Hence,
+this interface is internal to IMIO.
+.endhelp --------------------------------------------------------------------
+
+define	LEN_IDB		6
+define	IDB_IM		Memi[$1]		# image descriptor
+define	IDB_UA		Memi[$1+1]		# pointer to user area
+define	IDB_UALEN	Memi[$1+2]		# length of user area
+define	IDB_RECPTR	Memi[$1+3]		# current record pointer
+define	IDB_RECNO	Memi[$1+4]		# current record number
+define	IDB_BLOCKED	Memi[$1+5]		# cards blank filled?
+
+
+# IDB_OPEN -- Open the FITS area for for card i/o.
+
+pointer procedure idb_open (im, ualen)
+
+pointer	im			#I image descriptor
+int	ualen			#O size of storage area
+
+int	n
+pointer	idb, ip
+errchk	malloc
+
+begin
+	call malloc (idb, LEN_IDB, TY_STRUCT)
+
+	IDB_IM(idb) = im
+	IDB_UA(idb) = IM_USERAREA(im)
+	IDB_UALEN(idb) = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
+	IDB_RECPTR(idb) = IM_USERAREA(im)
+	IDB_RECNO(idb) = 1
+
+	if (IM_UABLOCKED(im) < 0) {
+	    # At image open time this flag is set by IMMAP to -1 to indicate
+	    # that the user area record type is not known.  An IKI kernel may
+	    # subsequently set the flag to yes/no, else we determine the
+	    # record type by inspection the first time we are called.  If the
+	    # user area is empty the record type is set to blocked; IDB always
+	    # writes blocked records.
+
+	    IM_UABLOCKED(im) = YES
+	    for (ip=IM_USERAREA(im);  Memc[ip] != EOS;  ip=ip+1) {
+		for (n=0;  Memc[ip] != EOS;  n=n+1) {
+		    if (Memc[ip] == '\n')
+			break
+		    ip = ip + 1
+		}
+		if (n != IDB_RECLEN) {
+		    IM_UABLOCKED(im) = NO
+		    break
+		}
+	    }
+	}
+
+	IDB_BLOCKED(idb) = IM_UABLOCKED(im)
+	ualen = IDB_UALEN(idb)
+	return (idb)
+end
+
+
+# IDB_NEXTCARD -- Return a pointer to the next card in the FITS header.
+# EOF is returned at the end of the header.
+
+int procedure idb_nextcard (idb, recptr)
+
+pointer	idb			#I pointer to IDB descriptor
+pointer	recptr			#O pointer to card
+
+int	recno
+pointer	ip, i
+
+begin
+	# Reference current card.
+	recno = IDB_RECNO(idb)
+	recptr = IDB_RECPTR(idb)
+
+	# Advance to the next card.
+	ip = recptr
+	if (IDB_BLOCKED(idb) == NO) {
+	    if (Memc[ip] != EOS)		# skip blank lines
+		ip = ip + 1
+	    do i = ip, ip+IDB_RECLEN
+		if (Memc[i] == EOS) {
+		    ip = i
+		    break
+		} else if (Memc[i] == '\n') {
+		    ip = i + 1
+		    break
+		}
+	} else
+	    ip = ip + IDB_RECLEN + 1
+
+	IDB_RECNO(idb) = recno + 1
+	IDB_RECPTR(idb) = ip
+
+	if (Memc[recptr] == EOS || recptr >= IDB_UA(idb) + IDB_UALEN(idb))
+	    return (EOF)
+	else
+	    return (recno)
+end
+
+
+# IDB_CLOSE -- Free the IDB descriptor.
+
+procedure idb_close (idb)
+
+pointer	idb			#I pointer to IDB descriptor
+
+begin
+	call mfree (idb, TY_STRUCT)
+end
diff --git a/sys/imio/db/idbfind.x b/sys/imio/db/idbfind.x
new file mode 100644
index 00000000..f98acb7e
--- /dev/null
+++ b/sys/imio/db/idbfind.x
@@ -0,0 +1,145 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+# IDB_FINDRECORD -- Search the image database for a particular record given
+# the key.  The record number (a positive nonzero integer) is returned if
+# the record is found, else 0.  
+
+int procedure idb_findrecord (im, key, rp)
+
+pointer	im			# image descriptor
+char	key[ARB]		# record key
+pointer	rp			# char record pointer (output)
+
+pointer	sp, pat, patbuf, ukey, lkey, ip, ua
+int	recno, nchars, lch, uch, ch, junk, n, i
+int	patmake(), patmatch(), stridxs(), gstrcpy()
+
+begin
+	call smark (sp)
+	call salloc (pat, SZ_FNAME, TY_CHAR)
+	call salloc (ukey, SZ_FNAME, TY_CHAR)
+	call salloc (lkey, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+
+	# Prepare U/L FITS keywords, truncated to 8 chars.
+	nchars = gstrcpy (key, Memc[lkey], IDB_SZFITSKEY)
+	call strlwr (Memc[lkey])
+	nchars = gstrcpy (key, Memc[ukey], IDB_SZFITSKEY)
+	call strupr (Memc[ukey])
+
+	# Search for the FIRST occurrence of a record with the given key.
+	# If the key is abbreviated and multiple keys are matched, the first
+	# record matched is used.
+
+	ua = IM_USERAREA(im)
+	rp = NULL
+	recno = 1
+
+	if (IM_UABLOCKED(im) < 0) {
+	    # At image open time this flag is set by IMMAP to -1 to indicate
+	    # that the user area record type is not known.  An IKI kernel may
+	    # subsequently set the flag to yes/no, else we determine the
+	    # record type by inspection the first time we are called.  If the
+	    # user area is empty the record type is set to blocked; IDB always
+	    # writes blocked records.
+
+	    IM_UABLOCKED(im) = YES
+	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
+		for (n=0;  Memc[ip] != EOS;  n=n+1) {
+		    if (Memc[ip] == '\n')
+			break
+		    ip = ip + 1
+		}
+		if (n != IDB_RECLEN) {
+		    IM_UABLOCKED(im) = NO
+		    break
+		}
+	    }
+	}
+
+	if (IM_UABLOCKED(im) == NO) {
+	    # Variable length, newline terminated records, EOS terminated
+	    # record group.
+
+	    call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]")
+		call pargstr (Memc[ukey])
+	    junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE)
+
+	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
+		if (patmatch (Memc[ip], Memc[patbuf]) > 0) {
+		    rp = ip
+		    break
+		}
+		#if (Memc[ip] != EOS)
+		#    ip = ip + 1
+		while (Memc[ip] != '\n' && Memc[ip] != EOS)
+		    ip = ip + 1
+		recno = recno + 1
+	    }
+
+	} else {
+	    # Fixed length (80 character), newline terminated records, EOS
+	    # terminated record group.
+
+	    if (stridxs ("*?[]", Memc[ukey]) > 0) {
+		# Pattern matching search.
+		call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]")
+		    call pargstr (Memc[ukey])
+		junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE)
+
+		for (ip=ua;  Memc[ip] != EOS;  ip=ip+IDB_RECLEN+1) {
+		    if (patmatch (Memc[ip], Memc[patbuf]) > 0) {
+			rp = ip
+			break
+		    }
+		    recno = recno + 1
+		}
+
+	    } else {
+		# Simple fast search, fixed length records.  Case insensitive
+		# keyword match.
+
+		lch = Memc[lkey]
+		uch = Memc[ukey]
+
+		for (ip=ua;  Memc[ip] != EOS;  ip=ip+IDB_RECLEN+1) {
+		    ch = Memc[ip]
+		    if (ch == EOS)
+			break
+		    else if (ch != lch && ch != uch)
+			next
+		    else {
+			# Abbreviations are not permitted.
+			ch = Memc[ip+nchars]
+			if (ch != ' ' && ch != '=')
+			    next
+		    }
+
+		    # First char matches; check rest of string.
+		    do i = 1, nchars-1 {
+			ch = Memc[ip+i]
+			if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) {
+			    ch = 0
+			    break
+			}
+		    }
+		    if (ch != 0) {
+			rp = ip		# match
+			break
+		    }
+
+		    recno = recno + 1
+		}
+	    }
+	}
+
+	call sfree (sp)
+	if (rp == NULL)
+	    return (0)
+	else
+	    return (recno)
+end
diff --git a/sys/imio/db/idbfstr.x b/sys/imio/db/idbfstr.x
new file mode 100644
index 00000000..1087ca02
--- /dev/null
+++ b/sys/imio/db/idbfstr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+
+# IDB_FILSTR -- Filter a string, removing any tabs or control characters.
+# This is used to clean up strings we want to put in image headers.  A count
+# of the output, filtered string is returned as the function value.  Tabs or
+# newlines in the input are replaced by blanks.  Illegal or unprintable
+# control characters in the input are deleted.
+
+int procedure idb_filstr (s1, s2, maxch)
+
+char	s1[ARB]				#I input string
+char	s2[ARB]				#O output string
+int	maxch				#I max chars out
+
+int	op, ch, i
+
+begin
+	op = 1
+
+	do i = 1, ARB {
+	    ch = s1[i]
+	    if (ch == EOS)
+		break
+	    else if (ch == '\t' || ch == '\n')
+		ch = ' '
+	    else if (!IS_PRINT (ch))
+		next
+
+	    s2[op] = ch
+	    op = op + 1
+	    if (op > maxch)
+		break
+	}
+
+	s2[op] = EOS
+	return (op - 1)
+end
diff --git a/sys/imio/db/idbgstr.x b/sys/imio/db/idbgstr.x
new file mode 100644
index 00000000..ffa43ff9
--- /dev/null
+++ b/sys/imio/db/idbgstr.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<imhdr.h>
+include	"idb.h"
+
+define	TY_STRING	(-1)
+
+# IDB_GETSTRING -- Get the string value of a standard header parameter.  If the
+# actual type of the parameter is not string the value is encoded as a string.
+# The length of the string is returned as the function value.  ERR is returned
+# if the string cannot be found.
+
+int procedure idb_getstring (im, key, outstr, maxch)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+long	lval
+real	rval
+int	dtype, axis, ip
+int	gstrcpy(), idb_kwlookup(), strncmp(), ltoc(), strlen()
+define	encode_ 91
+
+begin
+	# A standard keyword is recognized with or without the "i_" prefix.
+	if (key[1] == 'i' && key[2] == '_')
+	    ip = 3
+	else
+	    ip = 1
+
+	# The keywords "naxis1", "naxis2", etc. are treated as a special case.
+	if (strncmp (key[ip], "naxis", 5) == 0)
+	    if (IS_DIGIT(key[ip+5]) && key[ip+6] == EOS) {
+		dtype = TY_LONG
+		axis  = TO_INTEG(key[ip+5])
+		lval  = IM_LEN(im,axis)
+		goto encode_
+	    }
+	    
+	switch (idb_kwlookup (key[ip])) {
+	case I_CTIME:
+	    dtype = TY_LONG
+	    lval = IM_CTIME(im)
+	case I_HISTORY:
+	    dtype = TY_STRING
+	    return (gstrcpy (IM_HISTORY(im), outstr, maxch))
+	case I_LIMTIME:
+	    dtype = TY_LONG
+	    lval = IM_LIMTIME(im)
+	case I_MAXPIXVAL:
+	    dtype = TY_REAL
+	    rval = IM_MAX(im)
+	case I_MINPIXVAL:
+	    dtype = TY_REAL
+	    rval = IM_MIN(im)
+	case I_MTIME:
+	    dtype = TY_LONG
+	    lval = IM_MTIME(im)
+	case I_NAXIS:
+	    dtype = TY_LONG
+	    lval = IM_NDIM(im)
+	case I_PIXFILE:
+	    return (gstrcpy (IM_PIXFILE(im), outstr, maxch))
+	case I_PIXTYPE:
+	    dtype = TY_LONG
+	    lval = IM_PIXTYPE(im)
+	case I_TITLE:
+	    return (gstrcpy (IM_TITLE(im), outstr, maxch))
+	default:
+	    outstr[1] = EOS
+	    return (ERR)
+	}
+
+encode_
+	if (dtype == TY_LONG)
+	    return (ltoc (lval, outstr, maxch))
+	else {
+	    call sprintf (outstr, maxch, "%g")
+		call pargr (rval)
+	    return (strlen (outstr))
+	}
+end
diff --git a/sys/imio/db/idbkwlu.x b/sys/imio/db/idbkwlu.x
new file mode 100644
index 00000000..5b3ee553
--- /dev/null
+++ b/sys/imio/db/idbkwlu.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<imhdr.h>
+
+# IDB_KWLOOKUP -- Look up a keyword in the dictionary of standard header
+# keywords, returning the magic integer code of the keyword or zero.
+
+int procedure idb_kwlookup (key)
+
+char	key[ARB]		# keyword to be looked up
+int	index, ip, ch
+pointer	sp, kwname
+int	strdic(), strncmp(), strlen()
+string	keywords "|ctime|history|limtime|maxpixval|minpixval|mtime|naxis\
+|pixfile|pixtype|title|"
+
+begin
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+
+	# Look the string up in the dictionary of standard keywords.  Note that
+	# the "i_" prefix is omitted in the dictionary.  The order of the
+	# keywords in the dictionary must agree with the defined codes in the
+	# header file.  A standard keyword is recognized with or without the
+	# "i_" prefix.
+
+	if (key[1] == 'i' && key[2] == '_')
+	    ip = 3
+	else
+	    ip = 1
+
+	# Check for a reference to one of the NAXIS keywords.
+	if (key[ip] == 'n')
+	    if (strncmp (key[ip], "naxis", 5) == 0) {
+		ch = key[ip+5]
+		if (ch == EOS || (IS_DIGIT(ch) && key[ip+6] == EOS)) {
+		    call sfree (sp)
+		    return (7)
+		}
+	    }
+
+	# Look up keyword in dictionary.  Abbreviations are not permitted.
+	index = strdic (key[ip], Memc[kwname], SZ_FNAME, keywords)
+	if (index != 0)
+	    if (strlen(key[ip]) != strlen(Memc[kwname]))
+		index = 0
+
+	call sfree (sp)
+	return (index)
+end
diff --git a/sys/imio/db/idbpstr.x b/sys/imio/db/idbpstr.x
new file mode 100644
index 00000000..e2facd75
--- /dev/null
+++ b/sys/imio/db/idbpstr.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	"idb.h"
+
+# IDB_PUTSTRING -- Set the value of a standard header parameter given the new
+# value of the parameter encoded as a string.  If actual type of the parameter
+# is non string the value must be decoded.  ERR is returned if the key is not
+# a standard header parameter.  An error action is taken if the key is known
+# but the value cannot be decoded.
+
+int procedure idb_putstring (im, key, strval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	strval[ARB]		# string value of parameter
+
+double	dval
+bool	numeric
+int	ip, axis
+int	strncmp(), gstrcpy(), idb_kwlookup(), ctod(), strlen()
+
+begin
+	# Determine if the given string value is numeric.  This is true if
+	# it consists of a single numeric token of a reasonable length.
+
+	ip = 1
+	numeric = false
+	if (strlen (strval) < MAX_DIGITS)
+	    if (ctod (strval, ip, dval) > 0) {
+		while (IS_WHITE (strval[ip]) || strval[ip] == '\n')
+		    ip = ip + 1
+		numeric = (strval[ip] == EOS)
+	    }
+
+	# A standard keyword is recognized with or without the "i_" prefix.
+	if (key[1] == 'i' && key[2] == '_')
+	    ip = 3
+	else
+	    ip = 1
+
+	# The keywords "naxis1", "naxis2", etc. are treated as a special case.
+	if (strncmp (key[ip], "naxis", 5) == 0)
+	    if (IS_DIGIT(key[ip+5]) && key[ip+6] == EOS) {
+		axis = TO_INTEG(key[ip+5])
+		if (numeric && axis >= 1 && axis <= IM_NDIM(im)) {
+		    IM_LEN(im,axis) = nint(dval)
+		    return (OK)
+		} else
+		    call syserrs (SYS_IDBTYPE, key)
+	    }
+	    
+	# Lookup the keyword in the dictionary and set the value of the
+	# header parameter.  If the parameter is string valued copy the
+	# string value and return immediately.
+
+	switch (idb_kwlookup (key[ip])) {
+	case I_CTIME:
+	    if (numeric)
+		IM_CTIME(im) = nint(dval)
+	case I_HISTORY:
+	    return (gstrcpy (strval, IM_HISTORY(im), SZ_IMHIST))
+	case I_LIMTIME:
+	    if (numeric)
+		IM_LIMTIME(im) = nint(dval)
+	case I_MAXPIXVAL:
+	    if (numeric)
+		IM_MAX(im) = dval
+	case I_MINPIXVAL:
+	    if (numeric)
+		IM_MIN(im) = dval
+	case I_MTIME:
+	    if (numeric)
+		IM_MTIME(im) = nint(dval)
+	case I_NAXIS:
+	    if (numeric)
+		IM_NDIM(im) = nint(dval)
+	case I_PIXFILE:
+	    return (gstrcpy (strval, IM_PIXFILE(im), SZ_IMPIXFILE))
+	case I_PIXTYPE:
+	    if (numeric)
+		IM_PIXTYPE(im) = nint(dval)
+	case I_TITLE:
+	    return (gstrcpy (strval, IM_TITLE(im), SZ_IMTITLE))
+	default:
+	    return (ERR)
+	}
+
+	# If we make it through the switch, i.e., do not execute a return
+	# statement, then the key was recognized and is of a numeric datatype.
+	# If the value was successfully decoded as numeric then all is well,
+	# else the value could not be decoded and we have an error.
+
+	if (!numeric)
+	    call syserrs (SYS_IDBTYPE, key)
+	else
+	    return (OK)
+end
diff --git a/sys/imio/db/imaccf.x b/sys/imio/db/imaccf.x
new file mode 100644
index 00000000..60e4e9f3
--- /dev/null
+++ b/sys/imio/db/imaccf.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMACCF -- Test if the named field exists.  NO is returned if the key is not
+# found, YES otherwise.
+
+int procedure imaccf (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# name of the new parameter
+int	idb_kwlookup(), idb_findrecord()
+pointer	rp
+
+begin
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/imio/db/imaddb.x b/sys/imio/db/imaddb.x
new file mode 100644
index 00000000..f60f435a
--- /dev/null
+++ b/sys/imio/db/imaddb.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDB -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddb (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "b")
+	call imputb (im, key, value)
+end
diff --git a/sys/imio/db/imaddd.x b/sys/imio/db/imaddd.x
new file mode 100644
index 00000000..f5811b79
--- /dev/null
+++ b/sys/imio/db/imaddd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDD -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddd (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "d")
+	call imputd (im, key, value)
+end
diff --git a/sys/imio/db/imaddf.x b/sys/imio/db/imaddf.x
new file mode 100644
index 00000000..e2328f78
--- /dev/null
+++ b/sys/imio/db/imaddf.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+# IMADDF -- Add a user field to the image header.  It is an error if the named
+# field already exists.
+
+procedure imaddf (im, key, datatype)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char	datatype[ARB]		#I string permits generalization to domains
+
+pointer	rp, sp, keyname, ua, ip
+int	fd, max_lenuserarea, curlen, buflen, nchars
+int	idb_kwlookup(), idb_findrecord()
+int	stropen(), strlen(), idb_filstr(), nowhite()
+errchk	syserrs, stropen, fprintf, pargstr, pargi
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case, not to
+	# exceed 8 characters in length.  [Nov97 - This is not entirely 
+	# correct, FITS does not require upper case, however we don't want
+	# to change this at this time.]
+
+	nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY)
+	nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Check for a redefinition.
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    call syserrs (SYS_IDBREDEF, key)
+	
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area.  If the buffer fills we must allow one extra char for
+	# the EOS delimiter; since storage for the image descriptor was
+	# allocated in struct units the storage allocator will not have
+	# allocated space for the extra EOS char.
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea)
+		call syserrs (SYS_IDBOVFL, key)
+	    else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+	fd = stropen (Memc[ua+curlen], max_lenuserarea-curlen, APPEND)
+
+	# Append the new record with an uninitialized value field.
+	iferr {
+	    call fprintf (fd, "%-8s= %s%*t\n")
+		call pargstr (Memc[keyname])
+		if (datatype[1] == 'c') {
+		    call pargstr ("'        '")
+		    call pargi (IDB_LENSTRINGRECORD + 1)
+		} else {
+		    call pargstr ("")
+		    call pargi (IDB_LENNUMERICRECORD + 1)
+		}
+
+	} then {
+	    # Out of space in the user area.  Discard the truncated card at the
+	    # end of the buffer by backing up to the last newline and writing
+	    # an EOS.
+
+	    call close (fd)
+	    for (ip=ua+max_lenuserarea-1;  ip > ua;  ip=ip-1)
+		if (Memc[ip] == '\n') {
+		    Memc[ip+1] = EOS
+		    break
+		}
+	    call syserrs (SYS_IDBOVFL, key)
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imaddi.x b/sys/imio/db/imaddi.x
new file mode 100644
index 00000000..76653e66
--- /dev/null
+++ b/sys/imio/db/imaddi.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDI -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddi (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+int	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "i")
+	call imputi (im, key, value)
+end
diff --git a/sys/imio/db/imaddl.x b/sys/imio/db/imaddl.x
new file mode 100644
index 00000000..9064f6c4
--- /dev/null
+++ b/sys/imio/db/imaddl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDL -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddl (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "l")
+	call imputl (im, key, value)
+end
diff --git a/sys/imio/db/imaddr.x b/sys/imio/db/imaddr.x
new file mode 100644
index 00000000..e07dbb53
--- /dev/null
+++ b/sys/imio/db/imaddr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDR -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaddr (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "r")
+	call imputr (im, key, value)
+end
diff --git a/sys/imio/db/imadds.x b/sys/imio/db/imadds.x
new file mode 100644
index 00000000..e1b9f1a1
--- /dev/null
+++ b/sys/imio/db/imadds.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMADDS -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imadds (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "s")
+	call imputs (im, key, value)
+end
diff --git a/sys/imio/db/imastr.x b/sys/imio/db/imastr.x
new file mode 100644
index 00000000..d87c1828
--- /dev/null
+++ b/sys/imio/db/imastr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTR -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastr (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "c")
+	call impstr (im, key, value)
+end
diff --git a/sys/imio/db/imdelf.x b/sys/imio/db/imdelf.x
new file mode 100644
index 00000000..e8365e22
--- /dev/null
+++ b/sys/imio/db/imdelf.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"idb.h"
+
+# IMDELF -- Delete a user field from the image header.  It is an error if the
+# named field does not exist.
+
+procedure imdelf (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# name of the new parameter
+
+int	off
+pointer	rp, sp, keyname
+int	idb_kwlookup(), idb_findrecord(), stridxs()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case.
+	call strcpy (key, Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Cannot delete standard header keywords.
+	if (idb_kwlookup (key) > 0)
+	    call syserrs (SYS_IDBNODEL, key)
+
+	# Verify that the named user field exists.
+	if (idb_findrecord (im, key, rp) <= 0)
+	    call syserrs (SYS_IDBDELNXKW, key)
+	
+	# Delete the field.
+	off = stridxs ("\n", Memc[rp])
+	if (off > 0)
+	    call strcpy (Memc[rp+off], Memc[rp], ARB)
+	else
+	    Memc[rp] = EOS
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imgetb.x b/sys/imio/db/imgetb.x
new file mode 100644
index 00000000..cd7ed03f
--- /dev/null
+++ b/sys/imio/db/imgetb.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idb.h"
+
+# IMGETB -- Get an image header parameter of type boolean.  False is returned
+# if the parameter cannot be found or if the value is not true.
+
+bool procedure imgetb (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+pointer	rp
+pointer	idb_findrecord()
+
+begin
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+	else
+	    return (Memc[rp+IDB_ENDVALUE-1] == 'T')
+end
diff --git a/sys/imio/db/imgetc.x b/sys/imio/db/imgetc.x
new file mode 100644
index 00000000..f56ecb9d
--- /dev/null
+++ b/sys/imio/db/imgetc.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETC -- Get an image header parameter of type char.
+
+char procedure imgetc (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+long	imgetl()
+
+begin
+	return (imgetl (im, key))
+end
diff --git a/sys/imio/db/imgetd.x b/sys/imio/db/imgetd.x
new file mode 100644
index 00000000..01a71cb1
--- /dev/null
+++ b/sys/imio/db/imgetd.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idb.h"
+
+# IMGETD -- Get an image header parameter of type double floating.  If the
+# named parameter is a standard parameter return the value directly,
+# else scan the user area for the named parameter and decode the value.
+
+double procedure imgetd (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+int	ip
+double	dval
+pointer	sp, sval
+int	ctod()
+errchk	syserrs, imgstr
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_LINE, TY_CHAR)
+
+	ip = 1
+	call imgstr (im, key, Memc[sval], SZ_LINE)
+	if (ctod (Memc[sval], ip, dval) == 0)
+	    call syserrs (SYS_IDBTYPE, key)
+
+	call sfree (sp)
+	return (dval)
+end
diff --git a/sys/imio/db/imgeti.x b/sys/imio/db/imgeti.x
new file mode 100644
index 00000000..8da2878e
--- /dev/null
+++ b/sys/imio/db/imgeti.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETI -- Get an image header parameter of type integer.
+
+int procedure imgeti (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, imgetl()
+errchk	imgetl
+
+begin
+	lval = imgetl (im, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFI)
+	else
+	    return (lval)
+end
diff --git a/sys/imio/db/imgetl.x b/sys/imio/db/imgetl.x
new file mode 100644
index 00000000..817715c0
--- /dev/null
+++ b/sys/imio/db/imgetl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETL -- Get an image header parameter of type long integer.
+
+long procedure imgetl (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, imgetd()
+errchk	imgetd
+
+begin
+	dval = imgetd (im, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFL)
+	else
+	    return (nint (dval))
+end
diff --git a/sys/imio/db/imgetr.x b/sys/imio/db/imgetr.x
new file mode 100644
index 00000000..b1c6c67a
--- /dev/null
+++ b/sys/imio/db/imgetr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETR -- Get an image header parameter of type real.
+
+real procedure imgetr (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, imgetd()
+errchk	imgetd
+
+begin
+	dval = imgetd (im, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFR)
+	else
+	    return (dval)
+end
diff --git a/sys/imio/db/imgets.x b/sys/imio/db/imgets.x
new file mode 100644
index 00000000..39f2fcfd
--- /dev/null
+++ b/sys/imio/db/imgets.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGETS -- Get an image header parameter of type short integer.
+
+short procedure imgets (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, imgetl()
+errchk	imgetl
+
+begin
+	lval = imgetl (im, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFS)
+	else
+	    return (lval)
+end
diff --git a/sys/imio/db/imgftype.x b/sys/imio/db/imgftype.x
new file mode 100644
index 00000000..12ee9048
--- /dev/null
+++ b/sys/imio/db/imgftype.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"idb.h"
+
+# IMGFTYPE -- Get the datatype of a particular field of an image header.  Since
+# the internal format is FITS, there are four primary datatypes, boolean (T|F),
+# string (quoted), integer and real.
+
+int procedure imgftype (im, key)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+
+pointer	rp
+int	ch, ip
+int	idb_findrecord(), idb_kwlookup()
+errchk	syserrs
+
+begin
+	# Check for a standard header keyword.
+	switch (idb_kwlookup (key)) {
+	case I_CTIME:
+	    return (TY_LONG)
+	case I_HISTORY:
+	    return (TY_CHAR)
+	case I_LIMTIME:
+	    return (TY_LONG)
+	case I_MAXPIXVAL:
+	    return (TY_REAL)
+	case I_MINPIXVAL:
+	    return (TY_REAL)
+	case I_MTIME:
+	    return (TY_LONG)
+	case I_NAXIS:
+	    return (TY_LONG)
+	case I_PIXFILE:
+	    return (TY_CHAR)
+	case I_PIXTYPE:
+	    return (TY_LONG)
+	case I_TITLE:
+	    return (TY_CHAR)
+	}
+
+	# If we get here then the named parameter is not a standard header
+	# keyword.
+
+	if (idb_findrecord (im, key, rp) > 0) {
+	    # Check for quoted string.
+	    ch = Memc[rp+IDB_STARTVALUE]
+	    if (ch == '\'')
+		return (TY_CHAR)
+
+	    # Check for boolean field.
+	    ch = Memc[rp+IDB_ENDVALUE-1]
+	    if (ch == 'T' || ch == 'F')
+		return (TY_BOOL)
+
+	    # If field contains only digits it must be an integer.
+	    for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+		ch = Memc[rp+ip-1]
+		if (! (IS_DIGIT(ch) || IS_WHITE(ch)))
+		    return (TY_REAL)
+	    }
+	    
+	    return (TY_INT)
+	}
+
+	call syserrs (SYS_IDBKEYNF, key)
+end
diff --git a/sys/imio/db/imgnfn.x b/sys/imio/db/imgnfn.x
new file mode 100644
index 00000000..2dca4d9f
--- /dev/null
+++ b/sys/imio/db/imgnfn.x
@@ -0,0 +1,339 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+.help imgnfn
+.nf --------------------------------------------------------------------------
+IMGNFN -- Template expansion for image header keywords.
+
+	list =	imofnl[su] (im, template)	# open list
+	nch =	    imgnfn (im, outstr, maxch)	# get next field name
+		    imcfnl (im)			# close list
+
+IMOFNLS opens the list sorted, whereas IMOFNLU opens it unsorted.  Both std.
+and user header keywords are included in the list.
+.endhelp ---------------------------------------------------------------------
+
+define	MAX_FIELDS	1024
+define	SZ_SBUF		8192
+define	LEN_FNSTRUCT	(10+MAX_FIELDS)
+
+define	FN_NENTRIES	Memi[$1]	# number of field names in list
+define	FN_NEXT		Memi[$1+1]	# next string to be returned
+define	FN_SBUF		Memi[$1+2]	# pointer to string buffer
+			# open
+define	FN_STRP		Memi[$1+10+$2-1]	# array of str ptrs
+define	FN_FIELDNAME	Memc[FN_STRP($1,$2)]	# reference a string
+
+
+# IMGNFN -- Get the next field name matching the given template from an image
+# header database.  Sorting of the field list is optional.  A prior call to
+# IMOFNL[SU] is necessary to open the sorted or unsorted list.
+
+int procedure imgnfn (fn, outstr, maxch)
+
+pointer	fn			# field name list descriptor
+char	outstr[ARB]		# output string
+int	maxch
+
+int	strnum
+int	gstrcpy()
+
+begin
+	strnum = FN_NEXT(fn)
+	if (strnum > FN_NENTRIES(fn))
+	    return (EOF)
+	FN_NEXT(fn) = strnum + 1
+
+	return (gstrcpy (FN_FIELDNAME(fn,strnum), outstr, maxch))
+end
+
+
+# IMOFNLS -- Open a sorted field name list.
+
+pointer procedure imofnls (im, template)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+pointer	imofnl()
+
+begin
+	return (imofnl (im, template, YES))
+end
+
+
+# IMOFNLU -- Open an unsorted field name list.
+
+pointer procedure imofnlu (im, template)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+pointer	imofnl()
+
+begin
+	return (imofnl (im, template, NO))
+end
+
+
+# IMCFNL -- Close the image header field name list and return all associated
+# storage.
+
+procedure imcfnl (fn)
+
+pointer	fn			# field name list descriptor
+
+begin
+	call mfree (FN_SBUF(fn), TY_CHAR)
+	call mfree (fn, TY_STRUCT)
+end
+
+
+# IMOFNL -- Open an image header field name list, either sorted or unsorted.
+# A template is a list of patterns delimited by commas.
+
+pointer procedure imofnl (im, template, sort)
+
+pointer	im			# image descriptor
+char	template[ARB]		# field name template
+int	sort			# sort flag
+
+bool	escape
+int	tp, nstr, ch, junk, first_string, nstrings, nmatch, i
+pointer	sp, ip, op, fn, kwname, sbuf, pattern, patcode, nextch
+int	patmake(), patmatch(), strlen()
+errchk	syserr
+
+begin
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+	call salloc (pattern, SZ_FNAME, TY_CHAR)
+	call salloc (patcode, SZ_LINE,  TY_CHAR)
+
+	# Allocate field list descriptor.
+	call calloc (fn, LEN_FNSTRUCT, TY_STRUCT)
+	call malloc (sbuf, SZ_SBUF, TY_CHAR)
+
+	FN_SBUF(fn) = sbuf
+	nextch = sbuf
+	nstr = 0
+	tp = 1
+
+	# Extract each comma delimited template, expand upon image header
+	# field list, sort if desired, and add strings to list.
+
+	while (template[tp] != EOS && template[tp] != '\n') {
+	    # Advance to next field.
+	    while (IS_WHITE(template[tp]) || template[tp] == ',')
+		tp = tp + 1
+
+	    # Extract pattern.  Enclose pattern in ^{} so that the match will
+	    # occur only at the beginning of each line and will be case
+	    # insensitive (req'd for FITS format).
+
+	    op = pattern
+	    Memc[op] = '^'
+	    op = op + 1
+	    Memc[op] = '{'
+	    op = op + 1
+
+	    # A field name of the form "$", "$x", etc. is not matched against
+	    # the actual image field list, but is included in the output field
+	    # list as a literal.
+
+	    ch = template[tp]
+	    escape = (ch == '$')
+
+	    while (! (IS_WHITE(ch) || ch == '\n' || ch == ',' || ch == EOS)) {
+		# Map "*" into "?*".
+		if (ch == '*') {
+		    Memc[op] = '?'
+		    op = op + 1
+		}
+
+		Memc[op] = ch
+		op = op + 1
+		tp = tp + 1
+		ch = template[tp]
+	    }
+
+	    Memc[op] = '}'
+	    op = op + 1
+	    Memc[op] = EOS
+
+	    # If the pattern is a literal, put it in the output list without
+	    # matching it against the image field list.
+
+	    if (escape) {
+		# Omit the leading "^{" and the trailing "}".
+		ip = pattern + 2
+		op = op - 1
+		Memc[op] = EOS
+		call imfn_putkey (Memc[ip], FN_STRP(fn,1), nstr, nextch, sbuf)
+
+	    } else {
+		# Encode pattern.
+		junk = patmake (Memc[pattern], Memc[patcode], SZ_LINE)
+
+		# Scan database and extract all field names matching the
+		# pattern.  Mark number of first string for the sort.
+
+		first_string = nstr + 1
+
+		# First find any standard header keywords matching the pattern.
+		call imfn_stdkeys (im, Memc[patcode], FN_STRP(fn,1), nstr,
+		    nextch, sbuf)
+
+		# Now scan the user area.
+		for (ip=IM_USERAREA(im);  Memc[ip] != EOS;  ip=ip+1) {
+		    # Skip entries that are not keywords.
+		    if (Memc[ip+8] == '=') {
+
+			# Extract keyword name.
+			Memc[kwname+8] = EOS
+			do i = 1, 8 {
+			    ch = Memc[ip+i-1]
+			    if (ch == ' ') {
+				Memc[kwname+i-1] = EOS
+				break
+			    } else
+				Memc[kwname+i-1] = ch
+			}
+
+			# Check for a match.
+			if (Memc[kwname] != EOS) {
+			    # Put key in list if it matches.
+			    nmatch = patmatch (Memc[kwname], Memc[patcode]) - 1
+			    if (nmatch > 0 && nmatch == strlen(Memc[kwname]))
+				call imfn_putkey (Memc[ip],
+				    FN_STRP(fn,1), nstr, nextch, sbuf)
+			}
+		    }
+
+		    # Advance to the next record.
+		    if (IM_UABLOCKED(im) == YES)
+			ip = ip + IDB_RECLEN
+		    else {
+			while (Memc[ip] != '\n' && Memc[ip] != EOS)
+			    ip = ip + 1
+		    }
+
+		    if (Memc[ip] == EOS)
+			break
+		}
+
+		# Sort the newly added keywords.
+		nstrings = nstr - first_string + 1
+		if (sort == YES && nstrings > 1)
+		    call strsrt (FN_STRP(fn,first_string), Memc, nstrings)
+	    }
+	}
+
+	FN_NENTRIES(fn) = nstr
+	FN_NEXT(fn)     = 1
+
+	call sfree (sp)
+	return (fn)
+end
+
+
+# IMFN_STDKEYS -- Match a pattern (encoded) against the list of standard header
+# keywords, both with and without the "i_" prefix.  Add the full name (with i_
+# prefix) of each name matched to the keyword list.
+
+procedure imfn_stdkeys (im, patcode, strp, nstr, nextch, sbuf)
+
+pointer	im			# image descriptor
+char	patcode[ARB]		# encoded pattern
+pointer	strp[ARB]		# array of string pointers
+int	nstr			# current number of strings
+pointer	nextch			# next available char in string buffer
+pointer	sbuf			# string buffer
+
+pointer	sp, op, key
+bool	validfield, match
+int	ip, index, nmatch
+int	patmatch(), strlen()
+
+string	keywords "|ctime|history|limtime|maxpixval|minpixval|mtime|naxis\
+|naxis1|naxis2|naxis3|naxis4|naxis5|naxis6|naxis7|pixfile|pixtype|title|"
+errchk	imfn_putkey
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	call strcpy ("i_", Memc[key], SZ_FNAME)
+	index = 1
+
+	for (ip=2;  keywords[ip] != EOS;  ip=ip+1) {
+	    # Do not put dimensions NAXIS1, NAXIS2, etc. higher than the
+	    # actual image dimension into the matched list.
+
+	    validfield = true
+	    if (index >= 8 && index <= 14)
+		validfield = (index - 7 <= IM_NDIM(im))
+
+	    # Extract keyword into buffer, after the "i_".
+	    for (op=key+2;  keywords[ip] != '|';  op=op+1) {
+		Memc[op] = keywords[ip]
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+
+	    if (validfield) {
+		nmatch = patmatch (Memc[key], patcode) - 1
+		match = (nmatch > 0 && nmatch == strlen(Memc[key]))
+		if (!match) {
+		    nmatch = patmatch (Memc[key+2], patcode) - 1
+		    match = (nmatch > 0 && nmatch == strlen(Memc[key+2]))
+		}
+		if (match)
+		    call imfn_putkey (Memc[key], strp, nstr, nextch, sbuf)
+	    }
+
+	    index = index + 1
+	}
+
+	call sfree (sp)
+end
+
+
+# IMFN_PUTKEY -- Put a keyword into the keyword list.
+
+procedure imfn_putkey (key, strp, nstr, nextch, sbuf)
+
+char	key[ARB]		# keyword name (etc.)
+pointer	strp[ARB]		# array of string pointers
+int	nstr			# current number of strings
+pointer	nextch			# next available char in string buffer
+pointer	sbuf			# string buffer
+
+int	ch, ip
+errchk	syserr
+
+begin
+	# Append keyword to the string buffer.
+	nstr = nstr + 1
+	if (nstr > MAX_FIELDS)
+	    call syserr (SYS_IMFNOVFL)
+	strp[nstr] = nextch
+
+	ip = 1
+	ch = key[ip]
+
+	while (ch != '=' && ch != ' ' && ch != EOS) {
+	    Memc[nextch] = ch
+	    nextch = nextch + 1
+	    if (nextch >= sbuf + SZ_SBUF)
+		call syserr (SYS_IMFNOVFL)
+	    ip = ip + 1
+	    ch = key[ip]
+	}
+
+	Memc[nextch] = EOS
+	nextch = nextch + 1
+end
diff --git a/sys/imio/db/imgstr.x b/sys/imio/db/imgstr.x
new file mode 100644
index 00000000..53a77d4c
--- /dev/null
+++ b/sys/imio/db/imgstr.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"idb.h"
+
+# IMGSTR -- Get an image header parameter of type string.  If the named
+# parameter is a standard parameter return the value directly, else scan
+# the user area for the named parameter and decode the value.  A special
+# check is required for embedded single quotes as per the FITS standard.
+
+procedure imgstr (im, key, outstr, maxch)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+pointer	rp
+int	ip, op
+int	idb_getstring(), idb_findrecord(), ctowrd(), strlen()
+errchk	syserrs
+
+begin
+	# Check for a standard header parameter first.
+	if (idb_getstring (im, key, outstr, maxch) != ERR)
+	    return
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	ip = IDB_STARTVALUE
+	if (ctowrd (Memc[rp], ip, outstr, maxch) > 0) {
+	    # Check for embedded single quotes which are represented as ''.
+	    repeat {
+		if (Memc[rp+ip-1] != '\'')
+		    break
+		call strcat ("'", outstr, maxch)
+		op = strlen (outstr) + 1
+		if (ctowrd (Memc[rp], ip, outstr[op], maxch-op) == 0)
+		    break
+	    }
+
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
diff --git a/sys/imio/db/impstr.x b/sys/imio/db/impstr.x
new file mode 100644
index 00000000..4f4985cf
--- /dev/null
+++ b/sys/imio/db/impstr.x
@@ -0,0 +1,120 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idb.h"
+
+# IMPSTR -- Put an image header parameter of type string.  If the named
+# parameter is a standard parameter of type other than string, decode the
+# string and set the binary value of the parameter.  If the parameter is
+# a nonstandard one we can do a simple string edit, since user parameters
+# are stored in the user area in string form.  The datatype of the parameter
+# must be preserved by the edit, i.e., parameters of actual datatype string
+# must be quoted and left justified and other parameters must be unquoted
+# and right justified in the value field.
+
+procedure impstr (im, key, value)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	value[ARB]		#I new parameter value
+
+bool	string_valued
+int	nchars, ch, i
+pointer	rp, ip, op, sp, val, start, text, cmmt
+int	idb_putstring(), idb_findrecord(), idb_filstr()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Filter the value string to remove any undesirable characters.
+	nchars = idb_filstr (value, Memc[text], SZ_LINE)
+
+	# Check for a standard header parameter first.
+	if (idb_putstring (im, key, Memc[text]) != ERR) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.  Skip the value and treat the rest of
+	# the line as a comment to be preserved.
+
+	string_valued = false
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1)
+		;
+
+	    if (Memc[rp+ip-1] == '\'') {
+		# Skip string value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    if (ch == '\n')
+			break
+		    Memc[rp+i] = ' '
+		    if (ch == '\'')
+			break
+		}
+
+		string_valued = true
+		break
+
+	    } else {
+		# Skip numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		    Memc[rp+i-1] = ' '
+		}
+		break
+	    }
+	}
+
+	# Skip whitespace before any comment.
+	for (ip = i; Memc[rp+ip-1] == ' '; ip=ip+1)
+	    ;
+
+	# Save comment.  Include a leading space and add a / if missing.
+	Memc[cmmt] = ' '
+	for (i = 1; Memc[rp+ip-1] != '\n'; ip=ip+1) {
+	    if (i == 1 && Memc[rp+ip-1] != '/') {
+		Memc[cmmt+i] = '/'
+		i = i + 1
+	    }
+	    Memc[cmmt+i] = Memc[rp+ip-1]
+	    Memc[rp+ip-1] = ' '
+	    i = i + 1
+	}
+	Memc[cmmt+i] = EOS
+
+	# Encode the new value of the parameter.
+	if (string_valued) {
+	   call sprintf (Memc[val], SZ_LINE, " '%-0.68s%11t'%22t%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	} else {
+	    call sprintf (Memc[val], SZ_LINE, "%21s%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	}
+
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE - 1
+	start = op
+	for (ip=val;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputb.x b/sys/imio/db/imputb.x
new file mode 100644
index 00000000..a211f464
--- /dev/null
+++ b/sys/imio/db/imputb.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTB -- Put an image header parameter of type boolean.
+
+procedure imputb (im, key, bval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+bool	bval			# parameter value
+char	sval[2]
+
+begin
+	if (bval)
+	    sval[1] = 'T'
+	else
+	    sval[1] = 'F'
+	sval[2] = EOS
+
+	call impstr (im, key, sval)
+end
diff --git a/sys/imio/db/imputd.x b/sys/imio/db/imputd.x
new file mode 100644
index 00000000..ccd5339a
--- /dev/null
+++ b/sys/imio/db/imputd.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPUTD -- Put an image header parameter of type double.
+
+procedure imputd (im, key, dval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+double	dval			# double precision value
+
+pointer	sp, sval
+int	i, strlen()
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	# Reduce the precision of the encoded value if necessary to fit in
+	# the FITS value field.  Start with NDIGITS_DP-1 as the precision
+	# estimate NDIGITS_DP is only approximate, and if we make up half a
+	# digit of precision the result can be 1.00000000000000001 instead
+	# of 1.0.
+
+	for (i=NDIGITS_DP-1;  i >= NDIGITS_RP;  i=i-1) {
+	    call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+		call pargi (i)
+		call pargd (dval)
+	    if (strlen (Memc[sval]) < 20)
+		break
+	}
+
+	# Write the new value to the header.
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputh.x b/sys/imio/db/imputh.x
new file mode 100644
index 00000000..39467366
--- /dev/null
+++ b/sys/imio/db/imputh.x
@@ -0,0 +1,161 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+define	LEN_HISTSTR	70	# length of a history string on a FITS card
+
+# IMPUTH -- Add a FITS-like history/comment field to the image header.
+# Only keywords HISTORY, COMMENT, or "        " (eight spaces) are allowed!
+# (At least for the present - in the future this routine will probably
+# append FITS cards to a distinct FITS-table appearing as a table parameter
+# in the generalized image header.  Also, since it is not yet decided how
+# image history will be handled in the future, there is no guarantee that
+# this routine will remain unchanged - it may change or be obsoleted.)
+
+procedure imputh (im, key, text)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char	text[ARB]		#I the history string to be added
+
+pointer	sp, keyname, instr, outstr, ua
+int	fd, max_lenuserarea, curlen, buflen, nchars
+int	ip, op, in_last_blank, out_last_blank
+
+bool	streq()
+int	stropen(), strlen(), idb_filstr()
+errchk	syserrs, stropen, fprintf
+
+begin
+	call smark (sp)
+	call salloc (instr, SZ_LINE, TY_CHAR)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+	call salloc (outstr, LEN_HISTSTR, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case.
+	call strcpy (key, Memc[keyname], SZ_FNAME)
+	call strupr (Memc[keyname])
+
+	# Only standard FITS HISTORY keywords are allowed.
+	if (!(streq(Memc[keyname],"HISTORY") ||
+	    streq(Memc[keyname],"COMMENT") ||
+	    streq(Memc[keyname],"        "))) {
+
+	    call eprintf ("IMPUTH: Invalid history keyword `%s' ignored\n")
+		call pargstr (key)
+	    call sfree (sp)
+	    return
+	}
+	
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area.  If the buffer fills we must allow one extra char for
+	# the EOS delimiter; since storage for the image descriptor was
+	# allocated in struct units the storage allocator will not have
+	# allocated space for the extra EOS char.
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea)
+		call syserrs (SYS_IDBOVFL, key)
+	    else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+	# Open a file descriptor on the userarea buffer.
+	fd = stropen (Memc[ua+curlen], max_lenuserarea-curlen, APPEND)
+
+	# Filter the input string to remove any undesirable characters.
+	nchars = idb_filstr (text, Memc[instr], SZ_LINE)
+
+	# Append the HISTORY or COMMENT record to the user area.
+	iferr {
+	    if (nchars <= LEN_HISTSTR ) {
+		# This is the easy case: the HISTORY string will fit in
+		# one record.
+
+		call fprintf (fd, "%-8s  %s%*t\n")
+		    call pargstr (Memc[keyname])
+		    call pargstr (Memc[instr])
+		    call pargi (IDB_LENSTRINGRECORD + 1)
+
+	    } else {
+		# Not the simple case; break up the string into pieces that 
+		# will fit into LEN_HISTSTR, preferably on word boundaries.
+
+		for (ip=1;  Memc[instr+ip-1] != EOS;  ) {
+		    # If no blanks are found in HISTORY string, make sure
+		    # all of it gets output anyway.
+
+		    in_last_blank = ip + LEN_HISTSTR - 1
+		    out_last_blank = LEN_HISTSTR
+
+		    # Copy the string to the output buffer, marking the
+		    # last blank found.
+
+		    do op = 1, LEN_HISTSTR {
+			if (IS_WHITE (Memc[instr+ip-1])) {
+			    in_last_blank = ip
+			    out_last_blank = op
+			} else if (Memc[instr+ip-1] == EOS)
+			    break
+
+			Memc[outstr+op-1] = Memc[instr+ip-1]
+			ip = ip + 1
+		    }
+
+		    # The output string is full; close it off properly
+		    # and get ready for the next round (if any).
+
+		    Memc[outstr+op-1] = EOS
+		    if (Memc[instr+ip-1] != EOS) {
+			# Break at last word boundary if in a word.
+			if (!IS_WHITE (Memc[instr+ip-1])) {
+			    Memc[outstr+out_last_blank] = EOS
+			    ip = in_last_blank + 1
+			}
+
+			# Skip leading whitespace on next line.
+			while (IS_WHITE(Memc[instr+ip-1]))
+			    ip = ip + 1
+		    }
+
+		    # Write out the FITS HISTORY card.
+		    call fprintf (fd, "%-8s  %s%*t\n")
+			call pargstr (Memc[keyname])
+			call pargstr (Memc[outstr])
+			call pargi (IDB_LENSTRINGRECORD + 1)
+		}
+	    }
+
+	} then {
+	    # Out of space in the user area.  Discard the truncated card
+	    # at the end of the buffer by backing up to the last newline and
+	    # writing an EOS.
+
+	    call close (fd)
+	    for (ip=ua+max_lenuserarea-1;  ip > ua;  ip=ip-1)
+		if (Memc[ip] == '\n') {
+		    Memc[ip+1] = EOS
+		    break
+		}
+	    call syserrs (SYS_IDBOVFL, key)
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputi.x b/sys/imio/db/imputi.x
new file mode 100644
index 00000000..8be50d16
--- /dev/null
+++ b/sys/imio/db/imputi.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTI -- Put an image header parameter of type integer.
+
+procedure imputi (im, key, ival)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+int	ival			# parameter value
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargi (ival)
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputl.x b/sys/imio/db/imputl.x
new file mode 100644
index 00000000..3bc0d64c
--- /dev/null
+++ b/sys/imio/db/imputl.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTL -- Put an image header parameter of type long integer.
+
+procedure imputl (im, key, lval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+long	lval			# parameter value
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargl (lval)
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputr.x b/sys/imio/db/imputr.x
new file mode 100644
index 00000000..13a5e0c3
--- /dev/null
+++ b/sys/imio/db/imputr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPUTR -- Put an image header parameter of type real.
+
+procedure imputr (im, key, rval)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+real	rval			# parameter value
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+	    call pargi (NDIGITS_RP)
+	    call pargr (rval)
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imputs.x b/sys/imio/db/imputs.x
new file mode 100644
index 00000000..98fd61d8
--- /dev/null
+++ b/sys/imio/db/imputs.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPUTS -- Put an image header parameter of type short integer.
+
+procedure imputs (im, key, value)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+short	value			# parameter value
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargs (value)
+	call impstr (im, key, Memc[sval])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/db/imrenf.x b/sys/imio/db/imrenf.x
new file mode 100644
index 00000000..3b1bf7a6
--- /dev/null
+++ b/sys/imio/db/imrenf.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	"idb.h"
+
+# IMRENF -- Rename a user field keyword. It is an error if the
+# named field does not exist.
+
+procedure imrenf (im, oldkey, newkey)
+
+pointer	im			# image descriptor
+char	oldkey[ARB]		# old keyword
+char	newkey[ARB]		# new keyword
+
+int	off
+pointer	rp, sp, keyname
+int	idb_kwlookup(), idb_findrecord(), stridxs()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	# FITS format requires that the keyword name be upper case.
+	call strcpy (oldkey, Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Cannot delete standard header keywords.
+	if (idb_kwlookup (oldkey) > 0)
+	    call syserrs (SYS_IDBNODEL, oldkey)
+
+	# Verify that the named user field exists.
+	if (idb_findrecord (im, oldkey, rp) <= 0)
+	    call syserrs (SYS_IDBDELNXKW, oldkey)
+	
+	# Rename the keyword.
+	call sprintf (Memc[keyname], IDB_SZFITSKEY, "%-8.8s")
+	    call pargstr (newkey)
+	call strupr (Memc[keyname])
+	call amovc (Memc[keyname], Memc[rp], 8)
+	
+	call sfree (sp)
+end
diff --git a/sys/imio/db/mkpkg b/sys/imio/db/mkpkg
new file mode 100644
index 00000000..2d8888df
--- /dev/null
+++ b/sys/imio/db/mkpkg
@@ -0,0 +1,44 @@
+# Update the image header database interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	idbcard.x	idb.h <imhdr.h> <imio.h>
+	idbfind.x	idb.h <imhdr.h> <imio.h>
+	idbfstr.x	<ctype.h>
+	idbgstr.x	idb.h <ctype.h> <imhdr.h>
+	idbkwlu.x	<ctype.h> <imhdr.h>
+	idbpstr.x	idb.h <ctype.h> <imhdr.h> <mach.h>
+	imaccf.x	
+	imaddb.x	
+	imaddd.x	
+	imaddf.x	idb.h <fset.h> <imhdr.h> <imio.h>
+	imaddi.x	
+	imaddl.x	
+	imaddr.x	
+	imadds.x	
+	imastr.x	
+	imdelf.x	idb.h <imhdr.h>
+	imgetb.x	idb.h
+	imgetc.x	
+	imgetd.x	idb.h
+	imgeti.x	
+	imgetl.x	
+	imgetr.x	
+	imgets.x	
+	imgftype.x	idb.h <ctype.h>
+	imgnfn.x	idb.h <ctype.h> <imhdr.h> <imio.h>
+	imgstr.x	idb.h <ctype.h>
+	impstr.x	idb.h
+	imputb.x	
+	imputd.x	<mach.h>
+	imputh.x	idb.h <ctype.h> <imhdr.h> <imio.h>
+	imputi.x	
+	imputl.x	
+	imputr.x	<mach.h>
+	imputs.x	
+	imrenf.x	idb.h <imhdr.h>
+	;
diff --git a/sys/imio/dbc/README b/sys/imio/dbc/README
new file mode 100644
index 00000000..4e6a89ac
--- /dev/null
+++ b/sys/imio/dbc/README
@@ -0,0 +1,29 @@
+October 4, 2004
+
+These routines represent an extension to the imio header routines manipulation.
+Most of them have a new parameter which is the FITS header comment field. 
+The routine names have changed slighly to avoid collision and to have some 
+meaning; e.g. the ending 'c' for comment.
+
+There are a couple of new routines to handle only comments.
+
+Nelson Zarate
+
+
+imakbc.x:# IMAKBC -- Add a new field to the image header and initialize to the value
+imakdc.x:# IMAKDC -- Add a new field to the image header and initialize to the value
+imakic.x:# IMAKIC -- Add a new field to the image header and initialize to the value
+imaklc.x:# IMAKLC -- Add a new field to the image header and initialize to the value
+imakrc.x:# IMAKRC -- Add a new field to the image header and initialize to the value
+imaksc.x:# IMAKSC -- Add a new field to the image header and initialize to the value
+imastrc.x:# IMASTRC -- Add a new field to the image header and initialize to the value
+imgcom.x:# IMGCOM -- Get the comment field for a keyword.
+impcom.x:# IMPCOM -- Change the comment field for a keyword.
+impkbc.x:# IMPKBC -- Put an image header parameter of type boolean.
+impkdc.x:# IMPKDDC -- Put an image header parameter of type double.
+impkic.x:# IMPKIC -- Put an image header parameter of type integer.
+impklc.x:# IMPKLC -- Put an image header parameter of type long integer.
+impkrc.x:# IMPKRC -- Put an image header parameter of type real.
+imdrmcom.x:# IMDRMCOM -- Remove the comment field for a keyword.
+impksc.x:# IMPKSC -- Put an image header parameter of type short integer.
+impstrc.x:# IMPSTRC -- Put an image header parameter of type string.  If the named
diff --git a/sys/imio/dbc/idbc.h b/sys/imio/dbc/idbc.h
new file mode 100644
index 00000000..3c254469
--- /dev/null
+++ b/sys/imio/dbc/idbc.h
@@ -0,0 +1,27 @@
+# IDB.H -- Image header database interface.  In this version of the interface
+# the standard image header fields are maintained in binary in a fixed
+# structure and the user fields are maintained in FITS format (text) in the
+# a string buffer following the binary image header.
+
+define	IDB_RECLEN		80		# length of a FITS record (card)
+define	IDB_STARTVALUE		10		# first column of value field
+define	IDB_ENDVALUE		30		# last  column of value field
+define	IDB_LENNUMERICRECORD	80		# length of new numeric records
+define	IDB_LENSTRINGRECORD	80		# length of new string records
+define	IDB_SZFITSKEY		8		# max length FITS keyword
+
+# Standard header keywords accessible via the database interface.
+
+define	I_CTIME			1
+define	I_HISTORY		2
+define	I_LIMTIME		3
+define	I_MAXPIXVAL		4
+define	I_MINPIXVAL		5
+define	I_MTIME			6
+define	I_NAXIS			7
+define	I_PIXFILE		8
+define	I_PIXTYPE		9
+define	I_TITLE			10
+
+define  BEFORE                  1
+define  AFTER			2
diff --git a/sys/imio/dbc/imakbc.x b/sys/imio/dbc/imakbc.x
new file mode 100644
index 00000000..2871370d
--- /dev/null
+++ b/sys/imio/dbc/imakbc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKBC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakbc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "b")
+	call impkbc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakbci.x b/sys/imio/dbc/imakbci.x
new file mode 100644
index 00000000..3fe64116
--- /dev/null
+++ b/sys/imio/dbc/imakbci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKBCI -- Insert a new field to the image header after the given keyword 
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakbci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "b", baf)
+	call impkbc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakdc.x b/sys/imio/dbc/imakdc.x
new file mode 100644
index 00000000..787c496d
--- /dev/null
+++ b/sys/imio/dbc/imakdc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKDC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakdc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "d")
+	call impkdc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakdci.x b/sys/imio/dbc/imakdci.x
new file mode 100644
index 00000000..c63a9a5a
--- /dev/null
+++ b/sys/imio/dbc/imakdci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKDCI -- Insert a new field to the image header  after the given keyword 
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakdci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "d", baf)
+	call impkdc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakic.x b/sys/imio/dbc/imakic.x
new file mode 100644
index 00000000..10594d2a
--- /dev/null
+++ b/sys/imio/dbc/imakic.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKIC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakic (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+int	value			# new or initial value of parameter
+char	comment[ARB]
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "i")
+	call impkic (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakici.x b/sys/imio/dbc/imakici.x
new file mode 100644
index 00000000..02177184
--- /dev/null
+++ b/sys/imio/dbc/imakici.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKICI -- Insert a new field to the image header after the given keyword
+# and initialize to the value given.  It is not an error if the parameter
+# already exists.
+
+procedure imakici (im, key, value, comment, pkey, baf)
+
+pointer im                      # image descriptor
+char    key[ARB]                # parameter or field value
+int     value                   # new or initial value of parameter
+char    comment[ARB]
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int     imaccf()
+errchk  imaccf, iminfi
+
+begin
+        if (imaccf (im, key) == NO)
+            call iminfi (im, key, pkey, "i", baf)
+        call impkic (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaklc.x b/sys/imio/dbc/imaklc.x
new file mode 100644
index 00000000..3cb323c1
--- /dev/null
+++ b/sys/imio/dbc/imaklc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKLC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaklc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+char	comment[ARB]
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "l")
+	call impklc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaklci.x b/sys/imio/dbc/imaklci.x
new file mode 100644
index 00000000..9b74c82f
--- /dev/null
+++ b/sys/imio/dbc/imaklci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKLCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaklci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+char	comment[ARB]
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "l", baf)
+	call impklc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakrc.x b/sys/imio/dbc/imakrc.x
new file mode 100644
index 00000000..ff13efdf
--- /dev/null
+++ b/sys/imio/dbc/imakrc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKRC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakrc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+char	comment[ARB]		
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "r")
+	call impkrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakrci.x b/sys/imio/dbc/imakrci.x
new file mode 100644
index 00000000..74114d90
--- /dev/null
+++ b/sys/imio/dbc/imakrci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKRCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakrci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+char	comment[ARB]		
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "r", baf)
+	call impkrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaksc.x b/sys/imio/dbc/imaksc.x
new file mode 100644
index 00000000..e6f2c4ac
--- /dev/null
+++ b/sys/imio/dbc/imaksc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKSC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaksc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+char	comment[ARB]		
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "s")
+	call impksc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaksci.x b/sys/imio/dbc/imaksci.x
new file mode 100644
index 00000000..2bed12b0
--- /dev/null
+++ b/sys/imio/dbc/imaksci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKSCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaksci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+char	comment[ARB]		
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "s", baf)
+	call impksc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imastrc.x b/sys/imio/dbc/imastrc.x
new file mode 100644
index 00000000..4620db46
--- /dev/null
+++ b/sys/imio/dbc/imastrc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTRC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastrc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+char	comment[ARB]		# 
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "c")
+	call impstrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imastrci.x b/sys/imio/dbc/imastrci.x
new file mode 100644
index 00000000..f5154906
--- /dev/null
+++ b/sys/imio/dbc/imastrci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTRCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastrci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+char	comment[ARB]		# 
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "c", baf)
+	call impstrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imdrmcom.x b/sys/imio/dbc/imdrmcom.x
new file mode 100644
index 00000000..4a10f2df
--- /dev/null
+++ b/sys/imio/dbc/imdrmcom.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMDRMCOM -- Remove the comment field for a keyword.
+
+procedure imdrmcom (im, key)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+
+bool	string_valued
+int	ch, i, ti, j, n
+pointer	rp, ip, op, sp, val, start, text, cmmt
+int	idb_findrecord()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	for (i=0; i<SZ_LINE; i=i+1)
+	    Memc[text+i] = ' '
+	Memc[text+SZ_LINE] = EOS
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.
+
+	string_valued = false
+	ti = text
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1) {
+		Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+	    }
+	    if (Memc[rp+ip-1] == '\'') {
+		# Get string value.
+	        Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n')
+			break
+		    if (ch == '\'')
+			break
+		}
+		break
+
+	    } else {
+		# Numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		}
+#		if (ch == ' ')
+#		    ti = ti - 1
+		break
+	    }
+	}
+
+	n = 0
+	do j = i, IDB_RECLEN {
+	   ch = Memc[rp+j]
+	   Memc[cmmt+n] = ch
+	   n = n + 1
+	   if (ch == '\n') {
+	       n = n - 1
+	       break
+	   }
+	}
+	Memc[cmmt+n] = EOS 
+
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE + ti-text - 1 
+	start = op
+	for (ip=ti;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/imgcom.x b/sys/imio/dbc/imgcom.x
new file mode 100644
index 00000000..504c0c55
--- /dev/null
+++ b/sys/imio/dbc/imgcom.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include <ctype.h>
+include	"idbc.h"
+
+# IMGCOM -- Get the comment field for a keyword.
+
+procedure imgcom (im, key, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	comment[ARB]		#O comment string
+
+bool	string_valued
+int	ch, i, n, j, ic, op
+pointer	rp, ip, sp, buf
+int	idb_findrecord(), ctowrd(), stridx(), idb_getstring()
+errchk	syserrs
+
+define  end_ 91
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+        # Special fields do not have comment.
+        if (key[1] == 'i' && key[2] == '_') {  
+	    comment[1] = EOS
+	    return
+        }
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+        ip = IDB_STARTVALUE
+        if (ctowrd (Memc[rp], ip, Memc[buf], SZ_LINE) <= 0) {
+	    comment[1] = EOS
+	    goto end_
+        }
+ 
+	# Look for '/'
+        while (ip < IDB_RECLEN && (Memc[rp+ip] != '/'))
+             ip = ip + 1
+        if (ip == IDB_RECLEN) {
+	   comment[1] = EOS
+	   goto end_
+        }
+        op = rp+ip+1
+        while (op < IDB_RECLEN+rp && (IS_WHITE(Memc[op]) || Memc[op] == '\n'))
+             op = op + 1
+
+        # Copy comment section
+        for (i = 1; Memc[op] != '\n' && op < IDB_RECLEN+rp; op=op+1) {
+            comment[i] = Memc[op]
+            i = i + 1
+        }
+        # Trim
+	i = i - 1
+        while (i >= 1 && IS_WHITE(comment[i]))
+	   i = i - 1
+
+        comment[i+1] = EOS
+end_
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/iminfi.x b/sys/imio/dbc/iminfi.x
new file mode 100644
index 00000000..0ddfb540
--- /dev/null
+++ b/sys/imio/dbc/iminfi.x
@@ -0,0 +1,111 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+# IMADDFI -- Insert a user field in the image header after the specified 
+# keyword.  It is an error if the named field already exists.
+
+#procedure imaddfi (im, key, pkey, datatype, baf)
+procedure iminfi (im, key, pkey, datatype, baf)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char	pkey[ARB]		#I 'key' will be inserted bef/after pkey
+char	datatype[ARB]		#I string permits generalization to domains
+int     baf			# I Insert BEFORE or AFTER
+
+pointer	rp, sp, keyname, ua, ip
+int	fd, max_lenuserarea, curlen, buflen, nchars, piv
+int	idb_kwlookup(), idb_findrecord()
+int	strlen(), idb_filstr(), nowhite()
+char	card[IDB_RECLEN+1]
+errchk	syserrs, sprintf, pargstr, pargi
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY)
+	nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Check for a redefinition.
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    call syserrs (SYS_IDBREDEF, key)
+	
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area. 
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	if (curlen+81 >= max_lenuserarea) {
+	    IM_HDRLEN(im)  = LEN_IMHDR  + 
+	            (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT
+	    IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	    buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	    max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	}
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea) {
+		call syserrs (SYS_IDBOVFL, key)
+	    } else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+        # Find keyw_after
+	if (idb_findrecord (im, pkey, rp) == 0) {
+	    # Keyw not found. Append the new keyword.
+	    rp = ua+curlen
+	    baf = BEFORE
+        } else {
+            # Shift cards after pivot or before pivot
+	    if (baf == AFTER)
+	        piv = rp
+            else
+	        piv = rp - IDB_RECLEN - 1
+	    for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) {
+	        call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN)
+            }
+	}
+        Memc[ua+curlen+IDB_RECLEN]='\n'
+	Memc[ua+curlen+IDB_RECLEN+1]=EOS
+
+	# Form a card with keyword name and placeholder for value.
+	call sprintf (card, IDB_RECLEN+10, "%-8s= %s%*t\n")
+	    call pargstr (Memc[keyname])
+	    if (datatype[1] == 'c') {
+	        call pargstr ("'        '")
+		call pargi (IDB_LENSTRINGRECORD + 1)
+	    } else {
+		call pargstr ("")
+		call pargi (IDB_LENNUMERICRECORD + 1)
+	    }
+
+        # Replace keyword at the position rp+81.
+	if (baf == AFTER)
+            call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN)
+        else
+            call amovc (card, Memc[rp], IDB_RECLEN)
+
+#for (ip=1; ip<5; ip=ip+1) {
+#call eprintf("<%40.40s>\n")
+#   call pargstr(Memc[rp-(2-ip)*(IDB_RECLEN+1)])
+#}
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impcom.x b/sys/imio/dbc/impcom.x
new file mode 100644
index 00000000..b110536e
--- /dev/null
+++ b/sys/imio/dbc/impcom.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMPCOM -- Change the comment field for a keyword.
+
+procedure impcom (im, key, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	comment[ARB]		#I comment string
+
+bool	string_valued
+int	ch, i, ti, j
+pointer	rp, ip, op, sp, val, start, text, cmmt
+int	idb_findrecord()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.
+
+	string_valued = false
+	ti = text
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1) {
+		Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+	    }
+	    if (Memc[rp+ip-1] == '\'') {
+		# Get string value.
+	        Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n')
+			break
+		    if (ch == '\'')
+			break
+		}
+		do j = i, IDB_ENDVALUE-2 {
+	           Memc[ti] = ' ' ; ti=ti+1
+	        }
+		break
+
+	    } else {
+		# Skip numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		}
+		if (ch == ' ')
+		    ti = ti - 1
+		do j = i, IDB_ENDVALUE {
+	           Memc[ti] = ' ' ; ti=ti+1
+	        }
+		break
+	    }
+	}
+	Memc[ti]=EOS
+        if (comment[1] != EOS) {
+	    call strcat (" / ", Memc[ti], SZ_LINE)
+            for (i=1; comment[i] == ' '; i=i+1)
+                ;
+            call strcat (comment[i], Memc[ti], SZ_LINE)
+        } else {
+	    do j = i, IDB_RECLEN {
+	       Memc[ti] = ' ' ; ti=ti+1
+	    }
+	}
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE + ti-text - 1 
+	start = op
+	for (ip=ti;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkbc.x b/sys/imio/dbc/impkbc.x
new file mode 100644
index 00000000..fb28eacd
--- /dev/null
+++ b/sys/imio/dbc/impkbc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKBC -- Put an image header parameter of type boolean.
+
+procedure impkbc (im, key, bval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+bool	bval			# parameter value
+char	comment[ARB]		# 
+char	sval[2]
+
+begin
+	if (bval)
+	    sval[1] = 'T'
+	else
+	    sval[1] = 'F'
+	sval[2] = EOS
+
+	call impstrc (im, key, sval, comment)
+end
diff --git a/sys/imio/dbc/impkdc.x b/sys/imio/dbc/impkdc.x
new file mode 100644
index 00000000..6eb671f3
--- /dev/null
+++ b/sys/imio/dbc/impkdc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPKDDC -- Put an image header parameter of type double.
+
+procedure impkdc (im, key, dval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+double	dval			# double precision value
+char	comment[ARB]		# 
+
+pointer	sp, sval
+int	i, strlen()
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	# Reduce the precision of the encoded value if necessary to fit in
+	# the FITS value field.  Start with NDIGITS_DP-1 as the precision
+	# estimate NDIGITS_DP is only approximate, and if we make up half a
+	# digit of precision the result can be 1.00000000000000001 instead
+	# of 1.0.
+
+	for (i=NDIGITS_DP-1;  i >= NDIGITS_RP;  i=i-1) {
+	    call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+		call pargi (i)
+		call pargd (dval)
+	    if (strlen (Memc[sval]) < 20)
+		break
+	}
+
+	# Write the new value to the header.
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkic.x b/sys/imio/dbc/impkic.x
new file mode 100644
index 00000000..3acb0fbd
--- /dev/null
+++ b/sys/imio/dbc/impkic.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKIC -- Put an image header parameter of type integer.
+
+procedure impkic (im, key, ival, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+int	ival			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargi (ival)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impklc.x b/sys/imio/dbc/impklc.x
new file mode 100644
index 00000000..7ef227ff
--- /dev/null
+++ b/sys/imio/dbc/impklc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKLC -- Put an image header parameter of type long integer.
+
+procedure impklc (im, key, lval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+long	lval			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargl (lval)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkrc.x b/sys/imio/dbc/impkrc.x
new file mode 100644
index 00000000..1f1459dd
--- /dev/null
+++ b/sys/imio/dbc/impkrc.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPKRC -- Put an image header parameter of type real.
+
+procedure impkrc (im, key, rval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+real	rval			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+	    call pargi (NDIGITS_RP)
+	    call pargr (rval)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impksc.x b/sys/imio/dbc/impksc.x
new file mode 100644
index 00000000..0a74d0f0
--- /dev/null
+++ b/sys/imio/dbc/impksc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKSC -- Put an image header parameter of type short integer.
+
+procedure impksc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+short	value			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargs (value)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impstrc.x b/sys/imio/dbc/impstrc.x
new file mode 100644
index 00000000..0a11782e
--- /dev/null
+++ b/sys/imio/dbc/impstrc.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMPSTRC -- Put an image header parameter of type string.  If the named
+# parameter is a standard parameter of type other than string, decode the
+# string and set the binary value of the parameter.  If the parameter is
+# a nonstandard one we can do a simple string edit, since user parameters
+# are stored in the user area in string form.  The datatype of the parameter
+# must be preserved by the edit, i.e., parameters of actual datatype string
+# must be quoted and left justified and other parameters must be unquoted
+# and right justified in the value field.
+
+procedure impstrc (im, key, value, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	value[ARB]		#I new parameter value
+char	comment[ARB]		#I comment string
+
+bool	string_valued
+int	nchars, ch, i
+pointer	rp, ip, op, sp, val, start, text, cmmt, slen
+int	idb_putstring(), idb_findrecord(), idb_filstr(), strlen()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Filter the value string to remove any undesirable characters.
+	nchars = idb_filstr (value, Memc[text], SZ_LINE)
+
+	# Check for a standard header parameter first.
+	if (idb_putstring (im, key, Memc[text]) != ERR) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.  Skip the value and treat the rest of
+	# the line as a comment to be preserved.
+
+	string_valued = false
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1)
+		;
+
+	    if (Memc[rp+ip-1] == '\'') {
+		# Skip string value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    if (ch == '\n')
+			break
+		    Memc[rp+i] = ' '
+		    if (ch == '\'')
+			break
+		}
+
+		string_valued = true
+		break
+
+	    } else {
+		# Skip numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		    Memc[rp+i-1] = ' '
+		}
+		break
+	    }
+	}
+
+	# Skip whitespace before any comment.
+	for (ip = i; Memc[rp+ip-1] == ' '; ip=ip+1)
+	    ;
+
+	call strcpy (" / ", Memc[cmmt], IDB_RECLEN)
+	call strcat (comment, Memc[cmmt], IDB_RECLEN)
+
+	# Put enough blanks to erase the old comment.
+        slen = strlen(Memc[cmmt])
+	for (i=slen+1; i<=71-slen; i=i+1)
+	    Memc[cmmt+i-1] = ' '
+	Memc[cmmt+i-1] = EOS
+
+	# Encode the new value of the parameter.
+	if (string_valued) {
+	   call sprintf (Memc[val], SZ_LINE, " '%-0.68s%11t'%22t%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	} else {
+	    call sprintf (Memc[val], SZ_LINE, "%21s%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	}
+
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE - 1
+	start = op
+	for (ip=val;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/imputextf.x b/sys/imio/dbc/imputextf.x
new file mode 100644
index 00000000..151f13e4
--- /dev/null
+++ b/sys/imio/dbc/imputextf.x
@@ -0,0 +1,185 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+define	LEN_HISTSTR	71	# length of a history string on a FITS card
+define  CLEN            81
+
+# IMPUTXTF -- Insert a text file in the user area with HISTORY card.
+# The file cannot have control characters in it; only the FITS standard
+# character set is supported.  The text is broken in records long enough
+# to fit words; i.e. it tries not to split words. The file can have 
+# imbedded tabs and they will be expanded.
+
+procedure imputextf (im, file, pkey, baf)
+
+pointer	im			#I image descriptor
+char	file[ARB]		#I the text file to be inserted and appended
+char    pkey[ARB]               #I Pivot keyword to insert 'key'
+int     baf                     #I Insert BEFORE or AFTER
+
+pointer	ua, rp, piv, ip, op
+int	max_lenuserarea, curlen, buflen, jump, nlines
+int	old_curlen, k, nshift
+char    blk
+
+int	strlen(), idb_findrecord()
+errchk	syserrs
+
+begin
+	# FITS format requires that the keyword name be upper case.
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	# Determine the number of lines before inserting into the UA
+	call imrartxt (ua, file, nlines, NO)
+
+        old_curlen=curlen
+        curlen = curlen + nlines*CLEN
+        if (curlen+81 >= max_lenuserarea) {
+            IM_HDRLEN(im)  = LEN_IMHDR  +
+                    (curlen + 10*36*CLEN + SZ_STRUCT-1) / SZ_STRUCT
+            IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+            call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+            buflen = LEN_IMDES + IM_LENHDRMEM(im)
+            max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	    ua = IM_USERAREA(im)
+        }
+
+	blk=' '
+	# Find pivot keyword 
+        if (idb_findrecord (im, pkey, rp) == 0) {
+            # Keyw not found. Append the new keywords.
+            piv = ua + old_curlen
+        } else {
+            # Shift cards after or before pivot.
+            if (baf == AFTER)
+                piv = rp + CLEN
+            else
+                piv = rp 
+        
+            jump=nlines*CLEN
+
+	    # Shift cards down from the pivot point. 
+	    nshift = (ua+old_curlen - piv)/CLEN 
+	    ip = ua + old_curlen 
+            do k = 1, nshift {
+	        ip = ip - CLEN
+		op = jump + ip
+		call amovc (Memc[ip], Memc[op], CLEN)
+	    }
+        }
+
+	# Append the HISTORY records to the user area.
+	call imrartxt (piv, file, nlines, YES)
+
+end
+
+
+# IMRARTXT -- Internal routines to count the number of lines transfered to the
+# UA as HISTORY records.
+
+procedure imrartxt (piv, fname, nlines, insert)
+
+pointer piv	#I UA address to start inserting kw
+char	fname[ARB]
+int	nlines
+int	insert
+
+char	line[IDB_RECLEN+1], blk, lf
+pointer	sp, ln, buf, urp
+int 	ip, op, fd, in_last_blank, out_last_blank, blen, len, w, k
+int	save_ip
+int	open(), getline(), strlen()
+
+begin
+	call smark(sp)
+	call salloc (ln, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	fd = open(fname, READ_ONLY, TEXT_FILE)
+        nlines= 0
+	blk=' '
+	lf='\12'
+	call strcpy ("HISTORY  ", Memc[buf], 9)
+	Memc[buf+IDB_LENSTRINGRECORD]='\n'
+	Memc[buf+IDB_LENSTRINGRECORD+1]=EOS
+        urp = piv
+	while(getline(fd, Memc[ln]) != EOF) {
+		for (ip=1;  Memc[ln+ip-1] != EOS;  ) {
+		    # If no blanks are found in HISTORY string, make sure
+		    # all of it gets output anyway.
+
+		    in_last_blank = ip + LEN_HISTSTR - 1
+		    out_last_blank = LEN_HISTSTR
+
+		    # Copy the string to the output buffer, marking the
+		    # last blank found.
+
+		    for (op=1; op <= LEN_HISTSTR; op=op+1) {
+			if (Memc[ln+ip-1] == lf) {
+			    ip=ip+1
+			}    
+			if (IS_WHITE (Memc[ln+ip-1])) {
+			    # Detab input text.
+			    if (Memc[ln+ip-1] == '\t') {
+				if(ip-save_ip == 1)
+				   w=8
+				else
+				   w=9-op+(op/9)*8
+				for(k=0;k<w;k=k+1) {
+				    line[op+k] = blk
+				}
+				save_ip=ip
+				op = op + w - 1
+				ip = ip + 1
+				in_last_blank = ip
+				out_last_blank = op
+				next
+			    }
+			    in_last_blank = ip
+			    out_last_blank = op
+			} else if (Memc[ln+ip-1] == EOS) 
+			    break
+			line[op] = Memc[ln+ip-1]
+			ip = ip + 1
+		    }
+		    # The output string is full; close it off properly
+		    # and get ready for the next round (if any).
+		    line[op] = EOS
+		    if (Memc[ln+ip-1] != EOS) {
+			# Break at last word boundary if in a word.
+			if (!IS_WHITE (Memc[ln+ip-1])) {
+			    line[out_last_blank+1] = EOS
+			    ip = in_last_blank + 1
+			}
+
+			# Skip leading whitespace on next line.
+			while (IS_WHITE(Memc[ln+ip-1]))
+			    ip = ip + 1
+		    }
+		    nlines = nlines + 1
+
+		    if (insert == YES) {
+			# Write out the FITS HISTORY card.
+			len = strlen(line)
+			blen = IDB_LENSTRINGRECORD - len - 9 
+			call amovc (line, Memc[buf+9], len)
+			call amovkc (blk, Memc[buf+9+len], blen)
+
+			call amovc (Memc[buf], Memc[urp], IDB_RECLEN+1)
+			urp = urp + IDB_RECLEN + 1
+		    }
+		}
+	}
+
+        call close(fd)
+        call sfree(sp)
+end
diff --git a/sys/imio/dbc/imputhi.x b/sys/imio/dbc/imputhi.x
new file mode 100644
index 00000000..0d1de5a9
--- /dev/null
+++ b/sys/imio/dbc/imputhi.x
@@ -0,0 +1,113 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+# IMPHIS -- Insert a user field in the image header after the specified 
+# keyword.  It is an error if the named field already exists.
+
+procedure imphis (im, key, text, pkey, baf)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char    text[ARB]               #I the history string to be added
+char	pkey[ARB]		#I 'key' will be inserted bef/after pkey
+int     baf			# I Insert BEFORE or AFTER
+
+pointer	rp, sp, keyname, ua, ip, instr
+int	max_lenuserarea, curlen, buflen, nchars, piv
+int	idb_findrecord()
+bool    streq()
+int	strlen(), idb_filstr(), nowhite()
+char	card[IDB_RECLEN+1]
+errchk	syserrs, sprintf, pargstr, pargi
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+	call salloc (instr, SZ_LINE, TY_CHAR)
+
+	nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY)
+	nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Only standard FITS HISTORY keywords are allowed.
+        if (!(streq(Memc[keyname],"HISTORY") ||
+            streq(Memc[keyname],"COMMENT") ||
+            streq(Memc[keyname],"ADD_BLAN"))) {
+            call sfree (sp)
+            return
+        }
+
+        if (streq(Memc[keyname],"ADD_BLAN")) {
+           call strcpy ("        ", Memc[keyname],  SZ_FNAME)
+	}
+	   
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area. 
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	if (curlen+81 >= max_lenuserarea) {
+	    IM_HDRLEN(im)  = LEN_IMHDR  + 
+	            (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT
+	    IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	    buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	    max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	}
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea) {
+		call syserrs (SYS_IDBOVFL, key)
+	    } else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+        # Find keyw_after
+	if (idb_findrecord (im, pkey, rp) == 0) {
+            # Keyw not found. Append the new keyword.
+            rp = ua+curlen
+            baf = BEFORE
+        } else {
+            # Shift cards after pivot or before pivot
+	    if (baf == AFTER)
+	        piv = rp
+            else
+	        piv = rp - IDB_RECLEN - 1
+	    for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) {
+	        call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN)
+            }
+        }
+        Memc[ua+curlen+IDB_RECLEN]='\n'
+	Memc[ua+curlen+IDB_RECLEN+1]=EOS
+
+        # Filter the input string to remove any undesirable characters.
+        nchars = idb_filstr (text, Memc[instr], SZ_LINE)
+
+	# Form a card with keyword name and placeholder for value.
+	call sprintf (card, IDB_RECLEN+10, "%-8s %-71s\n")
+	    call pargstr (Memc[keyname])
+	    call pargstr (Memc[instr])
+
+        # Replace keyword at the position rp+81.
+	if (baf == AFTER)
+            call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN)
+        else
+            call amovc (card, Memc[rp], IDB_RECLEN)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/mkpkg b/sys/imio/dbc/mkpkg
new file mode 100644
index 00000000..1997f6b6
--- /dev/null
+++ b/sys/imio/dbc/mkpkg
@@ -0,0 +1,36 @@
+# Update the image header database interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	imakbc.x
+	imakbci.x
+	imakdc.x
+	imakdci.x
+	imakic.x
+	imakici.x
+	imaklc.x
+	imaklci.x
+	imakrc.x
+	imakrci.x
+	imaksc.x
+	imaksci.x
+	imastrc.x
+	imastrci.x
+	imgcom.x        idbc.h <ctype.h>
+	iminfi.x        idbc.h <fset.h> <imhdr.h> <imio.h>
+	impcom.x        idbc.h
+	impkbc.x
+	impkdc.x        <mach.h>
+	impkic.x
+	impklc.x
+	impkrc.x        <mach.h>
+	impksc.x
+	imdrmcom.x      idbc.h
+	impstrc.x       idbc.h
+	imputextf.x     idbc.h <ctype.h> <imhdr.h> <imio.h>
+	imputhi.x       idbc.h <fset.h> <imhdr.h> <imio.h>
+	;
diff --git a/sys/imio/doc/IMH.hlp b/sys/imio/doc/IMH.hlp
new file mode 100644
index 00000000..0599843b
--- /dev/null
+++ b/sys/imio/doc/IMH.hlp
@@ -0,0 +1,219 @@
+.help imio Mar86 "Image I/O Modifications"
+.ce
+\fBImage I/O Modifications to Support Multiple Data Formats\fR
+.ce
+Doug Tody
+.ce
+March 16, 1986
+
+.nh
+Introduction
+
+    The primary purpose of this revision of IMIO was to add support for
+multiple disk data formats.  This was done by defining a new interface
+called IMH, which hides the details of how images are stored on disk from
+the IMIO code.  IMIO is concerned only with image i/o based on an internal
+image descriptor.  IMIO calls IMH to perform all imagefile management
+operations, but accesses the pixel data directly using the FIO interface.
+The IMH interface initially supports only the old IRAF and SDAS image formats,
+but may be extended to support other formats in the future if necessary.
+The IMH interface should be reusable in the future when IMIO is layered
+upon DBIO.
+
+A secondary purpose of this revision was to make several minor enhancements
+to IMIO to better support groups of images.  The image template syntax
+has been extended to provide a special selection syntax for specifying the
+subset of the images in a group or set of groups to be operated upon.
+Minor changes were made to the filenames of the files used to store IRAF
+format images to make identification of the header and pixel files easier.
+The image database interface (IDB) has been extended to permit the storage
+of one dimensional arrays in the image header.  IMIO was modified to use the
+static file driver rather than the regular binary file driver to access
+pixel data.
+
+.nh
+Image Templates
+.nh 2
+Image Template Syntax
+
+    An image template is an expression used to specify the set or group of
+images to be operated upon.  The current image template syntax is upwards
+compatible with the planned DBIO record select/project syntax.  The full
+syntax is as follows.
+
+	images [,images ...]
+
+where \fIimages\fR is an expression built up from some combination of the
+following constructs:
+
+.nf
+	@listfile	take strings from a listfile
+	pattern		expand pattern against database
+	str // str	concatenate strings
+	{select}	select elements from a set
+	[section]	append image section
+.fi
+
+
+These elements may appear in any order, although not all orderings make
+sense.  The \fIpattern\fR string may contain any of the standard pattern
+matching characters, but the pattern matching meta-characters {} (ignore
+case) and [] (character class) must be escaped to avoid interpretation as
+the subset selection and image section operators.  An \fIimages\fR string
+may contain at most one list construct, i.e., listfile reference, pattern,
+or selection set.  The \fIselect\fR expression is limited to a range list
+at present.  The range list syntax uses the : range syntax, i.e.,
+"from[:to[:by]]".  Some examples are given below.  None of templates shown
+in these examples need be quoted if entered in the CL command mode.
+
+
+.nf
+	pix			one image
+	pix.0013		one image
+	@pics			list of images
+	pix[*,-*]		one image section
+	@pics[*,-*]		list of image sections
+	pix.*			all pix.whatever images in cwd
+	pix.*//.flat		same, but append ".flat" to image name
+	pix.*//.flat[*,5]	same, but append image section too
+	pix{1,4,9:21}		pix.0001, pix.0004, and 9 through 21
+	pix{1,4,9:21}[1:10,5]	same, but append section to each one
+.fi
+
+
+Note that \fIselect\fR expressions are expanded without checking to see if the
+named images actually exist.  Image names are formed by concatenating the
+image number encoded as a four digit string, padding with zeroes at the left
+as in the examples.
+
+.nh 2
+Image Template Procedures
+
+    The image template package (IMT) is an existing package.  The calling
+sequences are identical to those of the FNT (FIO filename template) package
+and have not been changed in this release of the package.  Extensive changes
+have however been made internally, and the new package has been installed
+in IMIO.  The old package has been removed from the XTOOLS library.  To use
+the new version of the package, all one need do is relink.
+
+
+.ks
+.nf
+	list = imtopen (template)
+      nimages = imtlen (list)
+	        imtrew (list)
+ nchars|EOF = imtgetim (list, fname, maxch)
+	      imtclose (list)
+.fi
+.ke
+
+
+An image template is expanded into a list of image names or image sections
+with \fBimtopen\fR.  The list is not globally sorted, however sublists
+generated by pattern matching are sorted before appending the sublist to
+the final list.  The number of images or image sections in a list is given by
+\fBimtlen\fR.  Images are read sequentially from the list with \fBimtgetim\fR,
+which returns EOF when the end of the list is reached.  The list may be
+rewound with \fBimtrew\fR.  An image template list should be closed with
+\fBimtclose\fR to return the buffers used to store the list and its
+descriptor.
+
+.nh
+The Image Header Access Interface (IMH)
+
+    The image header access interface (IMH) is a new interface in this release
+of IMIO.  The purposes of the IMH interface are to hide knowledge of how images
+are stored on disk from the rest of the system, and to make it possible to
+support multiple image storage formats.  IMIO is not aware that there are
+multiple image storage formats.  When called to open an existing image,
+IMH determines the image format and calls the appropriate lower level access
+procedure to read the image header.  A standard set of IMH callable interface
+procedures are required for each supported storage format.
+
+The IMH package is intended as an internal IMIO package and should not normally
+be called by packages other than IMIO.
+
+
+.ks
+.nf
+	im = imh_open (image, acmode, o_im)	# open/create header
+	     imh_opix (im, acmode)		# open/create pixels
+	   imh_update (im)			# update header
+	    imh_close (im)			# close image
+
+     y/n = imh_access (image, type)		# test if image exists
+	   imh_delete (image)			# delete an image
+	   imh_rename (oldname, newname)	# rename an image
+	     imh_copy (oldname, newname)	# copy an image
+.fi
+.ke
+
+
+The \fIimh_open\fR procedure will open an existing image, create a new
+image, or make a new copy of an existing image (preserving the header
+of the old image but not the pixels).  A pointer to an IMIO binary image
+descriptor is returned; when opening an existing image, the primary
+function of \fIimh_open\fR is to map the disk image header, stored in
+whatever format, into the IMIO fixed format binary descriptor.
+
+The \fIimh_opix\fR procedure must be called after the header has been opened
+before any pixel i/o can be done to the image.  In the case of a new image
+the size attributes of the new image are not fixed until \fIimh_opix\fR is
+called (giving the high level code time to set the size parameters in the
+image descriptor).  It is not necessary to call \fIimh_opix\fR if only the
+header of an existing image is to be accessed.
+
+The \fIimh_access\fR procedure is provided to test if the named image
+exists (no test is made to determine if the image is also accessible).
+An integer code identifying the storage format of the image, e.g., old
+IRAF or SDAS, is returned in the \fItype\fR argument.  Currently, the type
+of an image is indicated by the filename extension of the header file.
+
+The \fIimh_rename\fR and \fIimh_copy\fR procedures are in principle not
+required since the operations can be performed at a high level with the
+procedures already provided, but the IMH operators can carry out the
+operations more efficiently and without the possibility of information being
+lost, since they have knowledge of the physical storage format.
+
+.nh
+Physical Data Formats
+
+    The only two physical (disk) data formats currently supported are the
+old IRAF format and the STScI SDAS format.  The IMH interface makes it
+relatively straightforward for other sites to interface their local format
+if necessary, or to support multiple versions of the same format.
+
+IMH will automatically read images stored in any of the supported formats.
+When making a NEW_COPY image, IMH will generate a new image in the same
+format as the existing input image.  When making a NEW_IMAGE type image,
+the value of the environment variable \fBimtype\fR determines the type of
+image to be created.  The recognized values of \fBimtype\fR are shown below.
+
+.ks
+.nf
+	not defined		old iraf format
+	imtype = "oiraf"	old iraf format
+	imtype = "sdas"		SDAS/SOGS format
+.fi
+.ke
+
+The format in which an image is stored is indicated by the filename extension
+of the header file.  The filename extension is not specified in image names
+or templates above the IMH interface, but is visible to the user in a
+directory listing.
+
+.ks
+.nf
+	.imh			old iraf format header
+	.hhh			SDAS/SOGS format header
+.fi
+.ke
+
+The current IMH interface is implemented in such a way that the semantics
+of the two image storage formats are essentially equivalent, i.e., applications
+programs should work consistently regardless of the storage format used.
+In order to achieve this, the SDAS group format is fully supported only
+when reading existing group format images.  On output, images stored in
+SDAS format are stored in separate files (gcount=1).  The IRAF image template
+is more flexible than the SDAS group format, simplifies programming, and
+provides much the same basic capability.
diff --git a/sys/imio/doc/Notes b/sys/imio/doc/Notes
new file mode 100644
index 00000000..b7f6675c
--- /dev/null
+++ b/sys/imio/doc/Notes
@@ -0,0 +1,177 @@
+IMIO modifications to support SDAS format imagefiles
+----------------------------------------------------------------
+
+1. EXISTING DATA FORMATS
+
+
+1.1 IRAF Data Format (pre-DBIO)
+
+Characteristics:
+
+    o	Header: binary data structure + fits card image string buffer
+    o	Pixels: binary pixhdr + pixels (can be block aligned)
+    o	Many datatypes supported
+    o	One image per imagefile
+    o	Pixel file may be stored in different directory than header file
+    o	Header file is protected from deletion
+
+Disadvantages:
+
+    o	Can lose track of pixel file if header is deleted.
+    o	Since each image is stored in a separate pair of files,
+	    directories can be large.
+    o	The storage format is machine dependent.
+
+Modifications in this release:
+
+    o	Add .imh extension to image header file
+    o	Add .pix extension to pixel file, make root name same as that
+	    of the header file
+    o	If IMDIR = "", put pixel file in same directory as the header.
+	    This avoids use a pathname in the header, hence the images
+	    are relocatable, but forces one to work on a scratch device.
+
+
+
+1.2 SDAS Data Format
+
+Characteristics:
+
+    o	Images are physically stored in group format
+    o   FITS group header + binary image headers
+    o   Pixfile format: [pixels + group header] * ngroups
+	    nothing is aligned on block boundaries
+    o   Pixel and header files stored in same directory
+    o	Header file extension .hhh, pixel file extension .hhd
+
+Disadvantages:
+
+    o	Images cannot be added to a group; the number of images in a
+	    group must be specified when the group is created.
+    o	The individual images in a group cannot be deleted; only the
+	    entire group can be deleted.
+    o	The format of the image headers for the individual images in
+	    a group is fixed at create time; new parameters cannot be
+	    added to the individual image headers (new parameters can
+	    however be added which apply to the group as a whole).
+    o	The images in a group must all be of the same size and datatype
+	    (this is probably not a serious disadvantage).
+    o	The storage format is machine dependent.
+
+
+2. IMAGEFILE ACCESS
+
+    o   Open/create image
+    o	Make new_copy image
+    o   Access pixel segment
+    o   Close image
+    o	Test if image exists (and determine type)
+    o   Delete image
+    o   Rename image
+
+
+2.1 Open Image
+
+	generate header filename
+	open/create header file
+	allocate image descriptor
+	if (existing image)
+	    read image header into descriptor
+	else
+	    initialize descriptor
+	return pointer to descriptor
+
+
+2.2 Access Pixel Segment
+
+	All image size parameters must be determined at pixfile creation
+	time.
+
+	if (new segment) {
+	    fill in descriptor
+	    if (new pixel file)
+		allocate pixel file
+	    else
+		open pixel file r/w
+	    update header
+	} else
+	    open pixel file
+
+
+2.3 Close Image
+
+	if (header has been modified)
+	    update header
+	close pixfile
+	close header
+
+
+
+3. SPECIFICATIONS
+
+3.1 Image Header Access
+
+    To minimize changes to existing code, the IMIO internal data structures
+will not be modified.  The principal change to the structure of the existing
+interface is the replacement of the direct calls to the FIO open, close, read,
+write, etc. procedures called to access the image header in mass storage by
+calls to a new interface IH (Image Header access).  The new interface will
+hide the disk image format from IMIO.  Interface subroutines will be provided
+only for the IRAF and SDAS image formats, although in principle the interface
+will be extensible to other formats as well.
+
+Ideally the IH interface should be coded using only relatively low level
+VOS and kernel facilities (i.e., no high level FIO, no error handling) so that
+it may be used by the IMFORT interface and called from host Fortran programs,
+as well as by IMIO.
+
+
+	im =     ihopen (image, group, acmode)
+		 ihopix (im)
+		ihclose (im)
+
+
+IHOPEN returns the standard IMIO image descriptor, consisting of the internal
+IMIO fields, the binary image header structure IMHDR, and the "user area",
+a sequence of FITS card images stored in memory a string buffer, i.e.,
+each card image is represented as a stripped, newline delimited sequence of
+characters, with an EOS following the last card.
+
+The GROUP argument to IHOPEN permits access to the individual elements of
+a group format imagefile.  Group format is supported for both imagefile
+formats, the principal difference being that the individual images are
+stored in separate files in the old IRAF format, and in a single pair of
+images in the SDAS format.
+
+The individual images in a group format imagefile appear as separate,
+independent images in IMIO.  Several images in a group format imagefile may
+be simultaneously open (the files are physically opened only once).
+The group header parameters are duplicated for each image in the group.
+If the images are stored in the old IRAF format on disk the values of these
+parameters may vary from image to image, otherwise (SDAS format) they are
+the same for all members of the group.  The number of images in a group is
+fixed at image creation time.
+
+
+3.2 Image Sections and Templates
+
+    The image section notation recognized by IMMAP may include a group
+specifier (set selection expression) as well as a section specifier.
+The full syntax is "image{group}[section]", e.g.,
+
+	pix{3}[*,5]
+
+where { is the set selection operator, and [ is the familiar array subscript
+or subsection operator.
+
+The image template notation has also been generalized to support group format
+image data.  The general form of a template element is
+
+	image{groups}[section]
+
+where [section] applies to each image in the group.  For example, the template
+
+	aa{4},bb{1,3:5},cc{12:15}[*,-*]
+
+expands as image 4 of group AA, images 1, 3, 4, and 5 of group BB, and images
+12 through 15 of group CC flipped in Y.
diff --git a/sys/imio/doc/bench.ms b/sys/imio/doc/bench.ms
new file mode 100644
index 00000000..05717208
--- /dev/null
+++ b/sys/imio/doc/bench.ms
@@ -0,0 +1,73 @@
+.OM
+.TO
+Steve Ridgway
+.FR
+Doug Tody
+.SU
+Performance of IRAF Image I/O
+.PP
+As Caty reported in her memo of 15 November, the timings of the \fIimarith\fR
+task were surprisingly poor, i.e., approximately 20 cpu seconds for the
+addition of two 200 column by 800 line short integer images, producing a
+short integer image as output (a "short" integer is 16 bits).
+A look at the code for \fIimarith\fR revealed
+that the internal computations were being done in double precision floating,
+regardless of the datatype of the images on disk.
+I was not aware of this and I appreciate having it brought to my attention.
+Fixing \fIimarith\fR took several hours and nearly cut the timings in half.
+.PP
+When I orginally implemented IMIO I planned to eventually make three major
+optimizations (as noted in the program plan and system interface reference
+manual):
+.RS
+.LP \(bu
+Optimize the special case of line by line i/o with no automatic type
+conversion, image sectioning, boundary extension, etc.
+.LP \(bu
+Provide direct access into the FIO file buffers when possible to eliminate
+the memory to memory copy to and from the IMIO and FIO buffers.
+.LP \(bu
+Implement a optimal static file driver for UNIX to eliminate the overhead
+of copying the data through the system buffer cache, and to permit
+overlapped i/o.
+.RE
+.LP
+I have gone ahead and implemented the first two optimizations; this took
+a day and the changes were entirely internal to the interface,
+requiring no changes to user code and no loss of machine independence.
+After these changes were made to IMIO I ran several benchmarks with the
+following results.  All benchmarks were for images with 16 bit integer pixels.
+.TS
+center box tab(|);
+ci ci ci ci ci ci ci
+r  n  n  n  nb n  n.
+operation|open/close|line ovhead|kernel op|total user time|%opt|systime
+-
+(c=a+b)[200,800]|.38|1.43|1.69|3.50|48%|3.82
+(c=a+b)[800,800]|.38|1.43|6.94|8.75|79%|12.16
+minmax[800,800]|.05|0.59|11.39|12.03|95%|2.66
+.TE
+.PP
+The columns in the table show the operation tested by the benchmark (two image
+additions, each involving three images, and a computation of the minimum and
+maximum of a single image), the overhead involved in opening and closing the
+images (same operation on a [1,1] image), the total overhead to process the
+image lines, the time consumed by the kernel operation, the total user time
+for the task, the degree of optimality (ratio of time spent in the kernel
+vector operation to the total time for the task),
+and the system (UNIX kernel) time required.
+.PP
+In short, the time required by the original benchmark has decreased from
+20 seconds to 3.5 seconds, disregarding the system time.  In this worst
+case benchmark we still manage to come within 48% of the optimal time of
+1.69 seconds for a VAX 11/750.
+.PP
+The short integer vector addition kernel operator was hand optimized in
+assembler for these benchmarks to provide a true measure of the degree
+of optimality.  The actual unoptimized UNIX vector addition operator is
+slightly slower.
+The last column, labelled "systime", shows the cpu time consumed
+by the UNIX kernel moving the pixels to and from disk; this is the time
+that will be eliminated by the static file driver optimization.
+Once the static file driver is optimized any further optimizations
+will be difficult.
diff --git a/sys/imio/doc/imfort.doc b/sys/imio/doc/imfort.doc
new file mode 100644
index 00000000..6eef0dc6
--- /dev/null
+++ b/sys/imio/doc/imfort.doc
@@ -0,0 +1,72 @@
+Jun 19:	IRAF images may now be read and written from Fortran programs.
+	The interface is simple and efficient, but limited in capability.
+	If a more sophisticated interface is required one may call Fortran
+	subroutines from SPP main programs (templates are available for
+	accessing 1 and 2 dimensional images in this fashion), or program
+	directly in SPP.
+
+	1. Documentation from the source file
+
+	IMFORT -- Fortran interface to IRAF images.  This interface permits a
+	Fortran program to read or write an existing IRAF image.  There is
+	currently no provision for creating new images or deleting old images
+	from Fortran.  The interface routines are as follows:
+
+	      im = imopen (image, mode, ndim, len_axes)
+		   imclos (im)
+
+		imget[sr] (im, buf, x1, x2, linenum)
+		imput[sr] (im, buf, x1, x2, linenum)
+
+	where
+		input integer	im, x1, x2, linenum
+		input character	image, mode
+		output integer	ndim, len_axes(7)
+		pixel		buf(*)
+
+		imgets,imputs are for short integer (integer*2) pixels
+		imgetr,imputr are for real pixels
+
+	An image must be opened with IMOPEN before it can be accessed.  Legal
+	access modes are 'r', 'w', and 'rw'.  The number of dimensions and
+	the length of the axes are returned in ndim and len_axes; the latter
+	should be dimensioned for at least 7 dimensions.  All coordinates are
+	1-indexed.  The variable "im" is an integer.  The get and put routines
+	will perform datatype conversion if necessary.  The imget and imput
+	routines will abort program execution if there is an error.
+
+
+	2. Usage
+
+	Source files (minimal documentation in imfort.c header):
+
+		/iraf/sys/imio/mhdr.c.h
+		/iraf/sys/imio/imfort.c
+
+	Libraries:
+
+		/usr/lib/libiraf.a		-liraf on f77 cmd line
+		/usr/lib/libvops.a		-lvops on f77 cmd line
+
+	e.g.,
+		f77 myprog.f -liraf -lvops -o myprog
+
+	or if called in SPP
+
+		cl> xc myprog.x, lib=iraf
+
+
+	3. Example
+
+		integer	im
+		integer axlen(7), ndim
+		integer imopen
+		integer*2 pix(1024)
+
+		im = imopen ('/tmp2/iraf/images/m74', 'r', ndim, axlen)
+		write (*,*) ndim, axlen
+		call imgets (im, pix, 10,15, 5)
+		write (*,*) pix(1), pix(5)
+		stop
+		end
+
diff --git a/sys/imio/doc/imio.2.ms b/sys/imio/doc/imio.2.ms
new file mode 100644
index 00000000..0727179f
--- /dev/null
+++ b/sys/imio/doc/imio.2.ms
@@ -0,0 +1,331 @@
+.DA May 7, 1985
+.OM
+.TO
+distribution
+.FR
+Doug Tody
+.SU
+New release of image i/o, etc.
+.PP
+The new release of IMIO has been installed in the system for a week now and
+appears to be bug free.  This memo summarizes the changes/additions in this
+new version of the interface, and introduces the new "image database" tools
+\fIhedit\fR and \fIhselect\fR as well.
+.NH
+Summary of Changes in the Current Release
+.PP
+The following changes or additions have been made to the IMIO interface and
+the \fIimages\fR package.
+.RS
+.IP \(bu
+IMIO now has the ability to perform (optionally) automatic boundary extension
+to satisfy out of bounds pixel references.
+.IP \(bu
+A preliminary database interface has been added to IMIO.
+.IP \(bu
+Image headers are now variable length and use only the amount of disk space
+required to store the header (excluding byte packing).
+.IP \(bu
+Two new database utility tasks \fIhedit\fR and \fIhselect\fR have been
+added to the \fIimages\fR package.  Both use the new library subroutine
+\fIevexpr\fR, now installed in the FMTIO package.
+.IP \(bu
+A new task \fIimshift\fR has been added to the \fIimages\fR package to
+perform shifts of two dimensional images using full two dimensional
+interpolation.  The related tasks \fIgeomap\fR and \fIgeotran\fR are
+currently being worked on.  Some filtering and convolution tasks should
+also be available soon.  All of these tasks use the new boundary extension
+feature of IMIO.
+.RE
+.PP
+The new release of IMIO is upward compatible with previous versions and should
+require no changes to or even recompilation of existing code.  The basic image
+header structure is unchanged hence existing images and image headers are still
+accessible.  Copying of old images still on disk with \fIimcopy\fR may however
+be desirable to reduce disk consumption (the old headers were wasteful of
+storage).
+.PP
+This release of IMIO introduces some database tools and concepts which
+should help us understand the role the DBIO interface and DBMS package will
+play in image processing applications in the near future.  The current database
+interface has serious functional limitations and is inefficient for operations
+which operate upon entire databases (e.g., the \fIselect\fR operation),
+but does provide a basic and much needed image database capability.
+.NH
+Planned Future Developments
+.PP
+This new release of IMIO is expected to remain unchanged until DBIO is
+completed, at which time a new version of the interface will be released.
+This next release is expected to be upward compatible with the current
+interface except in cases where the applications task has detailed knowledge
+of the current image header structure.  Applications which directly access
+the "user area" of the current header, or which use certain header fields
+such as IM_HISTORY, will have to be modified as these data structures will
+change in the next release.
+.PP
+Applications which use only \fIimmap\fR, \fIimunmap\fR, IM_PIXTYPE,
+IM_NDIM, IM_LEN, and the basic i/o procedures should not have to be changed.
+The new interface will provide different facilities to do the same things
+but we can probably emulate the old interface to allow plenty of time to
+convert the old code.  Of course, the new interface will provide new facilities
+which we did not formerly have and which we will want to use, and therefore
+we will eventually have to modify all existing image tasks.
+.PP
+Perhaps more seriously, we are not going to be able to maintain the ability
+to read the existing binary image files when the DBIO version of IMIO is
+released.  At that time, all disk resident images will have to be processed
+to FITS format and thence into the new DBIO image format.  We will keep the
+old binary for the FITS writer task around for an indefinite period after
+the changeover to make this possible.
+
+.NH
+Modifications to the Current Interface
+.NH 2
+Boundary extension
+.PP
+Automatic boundary extension is useful in applications such as filtering via
+convolution, since the convolution kernel will extend beyond the boundary of
+the image when near the boundary, and in applications which operate upon
+subrasters, for the same reason.  When reading from an image with boundary
+extension in effect, IMIO will generate artificial values for the out of
+bounds pixels using one of the techniques listed below.  When writing to an
+image with boundary extension in effect, the out of bounds pixels are
+discarded.
+.PP
+By default, an out of bounds pixel reference will result in an error message
+from IMIO.  Consider an image line of length 5 pixels.  The statement
+.DS
+\fL
+	buf = imgs1r (im, -1, 7)
+\fR
+.DE
+references out of bounds by 2 pixels on either end of the image line,
+referencing a total of 5+2+2=9 pixels.  If boundary extension is enabled
+and the get section completes successfully then \fIMemr[buf]\fR will reference
+the pixel at X = -1, and \fIMemr[buf+2]\fR will reference the first inbounds
+pixel.
+.PP
+When an image is first opened zero pixels of boundary extension are
+selected, and any out of bounds references will result in an error.
+To enable boundary extension \fIimseti\fR must be called on the open
+image to specify the number of pixels of boundary extension permitted
+before an out of bounds error occurs.
+.DS
+\fL
+        include <imset.h>
+        call imseti (im, IM_NBNDRYPIX, 2)
+.DE
+\fR
+.LP
+If boundary extension is enabled the type of boundary extension desired
+should also be set.  The possibilities are defined in \fI<imset.h>\fR and
+are summarized below.
+.DS
+\fL
+        BT_CONSTANT     return constant if out of bounds
+        BT_NEAREST      return nearest boundary pixel
+        BT_REFLECT      reflect back into image
+        BT_WRAP         wrap around to other side
+        BT_PROJECT      project about boundary
+.ce
+\fR
+\fBTypes of Boundary Extension\fR
+.DE
+.LP
+The type of boundary extension is set with the imset parameter IM_TYBNDRY.
+If the BT_CONSTANT option is selected the constant value should be set with
+an \fIimseti\fR or \fIimsetr\fR call to set the parameter IM_BNDRYPIXVAL.
+Boundary extension works for images of any dimension up to 7 (the current
+IMIO limit).  A single IM_NBNDRYPIX value is used for all dimensions.
+This value is used only for bounds checking, hence the value should be set
+to the maximum out of bounds reference expected for any dimension.
+Larger values do not "cost more" than small ones.  An actual out of bounds
+reference is however more expensive than an inbounds reference.
+.NH 2
+Image Database Interface
+.PP
+The image database interface is the IMIO interface to the database
+containing the image headers.  In this implementation the image header is
+a variable length binary structure.  The first, fixed format, part of the
+image header contains the standard fields in binary and is fixed in size.
+This is followed by the so called "user area", a string buffer containing
+a sequence of variable length, newline delimited FITS format keyword=value
+header cards.  When an image is opened a large user area is allocated to permit
+the addition of new parameters without filling up the buffer.  When the
+header is subsequently updated on disk only as much disk space is used as
+is needed to store the actual header.
+.PP
+The new header format is upwards compatible with the old image header format,
+hence old images and programs do not have to be modified to use the latest
+release of IMIO.  In the future image headers will be maintained under DBIO,
+but the routines in the image header database interface described in this
+section are not exected to change.
+The actual disk format of images will of course change when we switch
+over to the DBIO headers.  While the physical storage format of header will
+change completely under DBIO, the logical schema will change very little,
+i.e., our mental picture of an image header will be much as it is now.
+The main difference will be the consolidation of many images into a few files,
+and real support in the image header for bad pixels, history, and coordinate
+transformations.  In addition a number of restrictions on the "user fields"
+will be lifted, the remaining distinctions between the standard and user
+fields will disappear, and database operations will be much more efficient
+than they are now.
+.NH 3
+Library Procedures
+.PP
+The IMIO library procedures comprising the current image database interface
+are summarized in the table below.
+.DS
+\fL
+       value = imget[bcsilrd_] (im, field)
+                        imgstr (im, field, outstr, maxch)
+               imput[bcsilrd_] (im, field, value)
+                        impstr (im, field, value)
+               imadd[bcsilrd_] (im, field, def_value)
+                        imastr (im, field, def_value)
+                        imaddf (im, field, datatype)
+                        imdelf (im, field)
+                  y/n = imaccf (im, field)
+
+             list = imofnl[su] (im, template)
+           nchars/EOF = imgnfn (list, fieldname, maxch)
+                        imcfnl (list)
+
+where
+	pointer	im, list
+	char[]	field, outstr, datatype, template, fieldname
+\fR
+.ce
+\fBImage Database Interface Procedures\fR
+.DE
+.PP
+New parameters will typically be added to the image header with either
+one of the typed \fIimadd\fR procedures or with the lower level \fIimaddf\fR
+procedure.
+The former procedures permit the parameter to be created and the value
+initialized all in one call, while the latter only creates the parameter.
+In addition, the typed \fIimadd\fR procedures may be used to update the values
+of existing parameters, i.e., it is not considered an error if the parameter
+already exists.  The principal limitation of the typed procedures is that
+they may only be used to add or set parameters of a standard datatype.
+The \fIimaddf\fR procedure will permit creation of parameters with more
+descriptive datatypes (abstract datatypes or domains) when the interface is
+recut upon DBIO.  There is no support in the current interface for domains.
+.PP
+The value of any parameter may be fetched with one of the \fIimget\fR functions.
+\fIBe careful not to confuse \fBimgets\fI with \fBimgstr\fI
+(or \fBimputs\fI with \fBimpstr\fI) when
+fetching or storing the string value of a field\fR.  Full automatic type
+conversion is provided.  Any field may be read or written as a string,
+and the usual type conversions are permitted for the numeric datatypes.
+.PP
+The \fIimaccf\fR function may be used (like the FIO \fIaccess\fR procedure)
+to determine whether a field exists.  Fields are deleted with \fIimdelf\fR;
+it is an error to attempt to delete a nonexistent field.
+.PP
+The field name list procedures \fIimofnl[su]\fR, \fIimgnfn\fR,
+and \fIimcfnl\fR procedures are similar to the familiar file template
+facilities, except that the @file notation is not supported.  The template
+is expanded upon an image header rather than a directory.  Unsorted lists
+are the most useful for image header fields.  If sorting is enabled each
+comma delimited pattern in the template is sorted separately, rather than
+globally sorting the entire template after expansion.  Minimum match is
+permitted when expanding the template, another difference from file
+templates.  Only actual, full length field names are placed in the output
+list.
+.NH 3
+Standard Fields
+.PP
+The database interface may be used to access any field of the image header,
+including the following standard fields.  Note that the nomenclature has
+been changed slightly to make it more consistent with FITS.  Additional
+standard fields will be defined in the future.  These names and their
+usage may change in the next release of IMIO.
+.DS
+\fI
+	  keyword     type                 description
+\fL
+        i_ctime         l       time of image creation
+        i_history       s       history string buffer
+        i_limtime       l       time when limits (minmax) were last updated
+        i_maxpixval     r       maximum pixel value
+        i_minpixval     r       minimum pixel value
+        i_mtime         l       time of last modify
+        i_naxis         i       number of axes (dimensionality)
+        i_naxis[1-7]    l       length of an axis ("i_naxis1", etc.)
+        i_pixfile       s       pixel storage file
+        i_pixtype       i       pixel datatype (SPP integer code)
+        i_title         s       title string
+\fR
+.ce
+\fBStandard Header Fields\fR
+.DE
+.PP
+The names of the standard fields share an "i_" prefix to reduce the possibility
+of collisions with user field names, to identify the standard fields in
+sorted listings, to allow use of pattern matching to discriminate between the
+standard fields and user fields, and so on.  For the convenience of the user,
+the "i_" prefix may be omitted provided the resultant name does not match the
+name of a user parameter.  It is however recommended that the full name be
+used in all applications software.
+.NH 3
+Restrictions
+.PP
+The use of FITS format as the internal format for storing fields in this
+version of the interface places restrictions on the size of field names and
+of the string value of string valued parameters.  Field names are currently
+limited to eight characters or less and case is ignored (since FITS requires
+upper case).  The eight character limit does not apply to the standard fields.
+String values are limited to at most 68 characters.  If put string is passed
+a longer string it will be silently truncated.  Trailing whitespace and
+newlines are chopped when a string value is read.
+
+.NH
+Database Utility Tasks
+.PP
+Two image database utility tasks have been implemented, \fIhedit\fR and
+\fIhselect\fR.  \fIHedit\fR is the so called header editor, used to modify,
+add, or delete selected fields of selected images.  The \fIhselect\fR task
+is used to select images that satisfy a selection criteria given as a boolean
+expression, printing a subset of the fields of these images on the standard
+output in list form.  Manual pages are attached.
+.PP
+Both of these tasks gain most of their power from use of the \fIevexpr\fR
+utility procedure, now available in FMTIO.  The \fIevexpr\fR procedure takes
+as input an algebraic expression (character string), parses and evaluates
+the expression, and returns as output the value of the expression.
+.DS
+\fL
+	include <evexpr.h>
+	pointer	evexpr()
+
+	o = evexpr (expr, getop, ufcn)
+
+where
+	o	Is a pointer to an operand structure
+	expr	Is a character string
+	getop	Is either NULL or the \fIlocpr\fL address
+		  of a user supplied procedure called during
+		  expression evaluation to get the value of
+		  an external operand.
+	ufcn	Is either NULL or the \fIlocpr\fL address
+		  of a user supplied procedure called during
+		  expression evaluation to satisfy a call to
+		  an external function.
+\fR
+.DE
+The operand structure is defined in \fB<evexpr.h>\fR.  The best documentation
+currently available for the operators and functions provided by \fIevexpr\fR
+will be found in the manual page(s) for \fIhedit\fR.  Additional documentation
+will be found with the sources.  The expression evaluation procedure is
+probably the single largest procedure in the system (in terms of kilobytes
+added to an executable) and should not be used unless it is needed, but it can
+greatly increase the power of a task in the right application.
+.CT
+IRAF
+Larry Goad
+George Jacoby
+Richard Wolff
+Steve Ridgway (fyi)
+Jeanette Barnes (fyi)
+Ed Anderson (fyi)
diff --git a/sys/imio/doc/imio.doc b/sys/imio/doc/imio.doc
new file mode 100644
index 00000000..daa72a52
--- /dev/null
+++ b/sys/imio/doc/imio.doc
@@ -0,0 +1,232 @@
+				IRAF IMIO OVERVIEW
+				    7 May 1986
+
+
+
+1. DATA MANAGEMENT ROUTINES
+
+include <imhdr.h>
+
+	       im = immap (image, mode, oim)
+		  imunmap (im)
+
+		 imdelete (image)
+		 imrename (oldname, newname)
+
+where
+	struct	imhdr *im, *oim;	image header/descriptor
+	char	image[];		image name or image section
+	int	mode;			ro, wo, rw, new_image, new_copy
+
+important header parameters:
+
+	im->im_naxis			number of axes
+	im->im_axlen[i]			axis lengths
+	im->im_pixtype			pixel datatype
+	im->im_datamin			min pixel value
+	im->im_datamax			max pixel value
+	im->im_title			title string
+
+
+Existing images are normally opened either read only or read write.
+New images are opened either new_image or new_copy.  In the latter case,
+the third argument is a pointer to the image descriptor of an existing
+image, with the new image inheriting the non-data attributes of the
+existing image header.  This latter feature is important for data
+independence.
+
+The IMIO interface supports images of up to naxis=7.  In a sense, all images
+are multidimensional, with the higher, unused axis lengths set to 1.
+An N dimensional image may therefore be accessed by a program coded to
+operate upon an M dimensional image.
+
+The image section facility greatly inceases the flexibility of the IMIO
+interface.  Image sections are specified as part of the image name input
+to IMOPEN, and are not visible to the applications program, which sees
+a somewhat smaller image, or an image of lesser dimensionality.  Some examples
+are shown below.
+
+
+	section				refers to
+
+	pix[]			whole image
+	pix[i,j]		the pixel value (scalar) at [i,j]
+	pix[*,*]		whole image, two dimensions
+	pix[*,-*]		flip y-axis
+	pix[*,*,b]		band B of three dimensional image
+	pix[*,*:s]		subsample in y by S
+	pix[*,l]		line L of image
+	pix[c,*]		column C of image
+	pix[i1:i2,j1:j2]	subraster of image
+	pix[i1:i2:sx,j1:j2:sy]	subraster with subsampling
+
+
+Sections are implemented by defining a linear transformation upon the
+pixel coordinates input when image i/o takes place.  All image data
+transfers can be represented as subrasters defined by corner points
+pointed to by the vectors VS and VE, each of length NAXIS.  If an image
+section is specified, the IMIO i/o routines merely transform these
+vectors into PVS and PVE, the physical coordinates of the referenced
+subraster, before doing any i/o.
+
+
+2. IMIO OPTIONS
+
+    IMIO options may be set and queried with the IMSET and IMSTAT procedures,
+shown below.
+
+		imseti (im, option, int_value)
+		imsetr (im, option, real_value)
+
+	 int = imstati (im, option)
+	real = imstatr (im, option)
+
+The options currently supported are shown below (from <imset.h>).
+
+
+# IMSET.H -- Definitions for IMIO user settable options
+
+define	IM_ADVICE		1	# RANDOM or SEQUENTIAL
+define	IM_NBUFS		2	# number of input buffers
+define	IM_COMPRESS		3	# align lines on device blocks?
+define	IM_NBNDRYPIX		4	# width of boundary region
+define	IM_TYBNDRY		5	# type of boundary extension
+define	IM_FLAGBADPIX		6	# set bad pix to INDEF
+define	IM_PIXFD		7	# pixfile fd (special devices)
+define	IM_WHEADER		8	# update image header at unmap time
+define	IM_BNDRYPIXVAL		9	# for option IM_CONSTANT
+
+
+# Types of Boundary Extension
+
+define	BT_CONSTANT		1	# return constant if out of bounds
+define	BT_NEAREST		2	# return nearest boundary pixel
+define	BT_REFLECT		3	# reflect back into image
+define	BT_WRAP			4	# wrap around to other side
+define	BT_PROJECT		5	# project about boundary
+
+
+The most useful options are the multiple input buffers and boundary extension,
+used to implement filtering operators.
+
+
+3. IMIO I/O ROUTINES
+
+    There are two basic approaches used in image interfaces: images may be
+mapped into virtual memory, or accessed via conventional file i/o.  IMIO
+provides both but emphasizes the latter, since it is more portable, more
+efficient for sequential image operations, and because it provides data
+independence.  All buffering is handled internally by the interface to
+simplify the interface (externally), and to provide the control necessary
+for sophisticated features and optimizations.
+
+IMIO currently provides three classes of i/o routines: [1] get/put line
+random, [2] get/put line sequential, and [3] get/put subraster random.
+
+
+3.1 Get/Put Line Random (for images of known dimension)
+
+	ptr = im[gp]l[123][usilrdx] (im, line [, band [, ...]])
+e.g.,
+	(short *) = imgl1s (im)			# get line from 1d short image
+	(short *) = imgl2s (im, lineno)		# get line from 2d short image
+	(real *)  = imgl2r (im, lineno)		# get line from 2d real image
+	(short *) = impl2s (im, lineno)		# put line to 2d short image
+	(real *)  = imgl3r (im, line, band)	# get from 3d image
+
+
+3.2 Get/Put Line Sequential (for images of any dimension)
+
+	int = im[gp]nl[usilrdx] (im, ptr, v)
+e.g.,
+	(EOF?) = imgnlr (im, ptr, v)		# get next line, real
+	(EOF?) = impnls (im, ptr, v)		# put next line, short
+
+Here, STAT is either EOF or not EOF, with EOF being returned when the last
+line of the image has been read.  The output argument PTR is set to point
+to the buffer containing the input pixels, or the buffer into which the
+output pixels are to be written.  The vector V, of length IM_MAXDIM, points
+to the next line of the image to be read.  It is set initially to [1,1,1,...]
+by the user (assuming the entire image is to be accessed), and is automatically
+updated by IMIO in each call.
+
+
+3.3 Get/Put Subraster Random
+
+	ptr = im[gp]s[123][usilrdx]
+e.g.,
+	(short *) = imgs2s (im, x1,x2, y1,y2)	# get 2d subraster, short
+	(real *)  = imps1r (im, x1,x2)		# put 1d subraster, real
+
+These routines (and indeed all the i/o routines) can be used for either
+sequential or random accesses.  The subraster routines must be used to
+reference outside the boundary in X.
+
+
+3.4 Other I/O Routines
+
+    Other, lower level routines are provided for unusual applications for which
+the above routines are not suited.
+
+	ptr = im[pg]gs[usilrdx] (im, vs, ve, ndim)
+
+The above puts/gets a general section of any dimension.  The vectors VS and VE
+define the starting and ending corners of the subraster to be accessed.
+An IMFLUSH routine is provided for flushing the output buffer (remember the
+delayed write).
+
+
+In all cases, no buffers are allocated until i/o takes place, allowing IMSET
+calls to set options after the image has been opened.  In the case of a new
+image (or new copy image), the pixel file is not allocated until i/o takes
+place, giving the user time to set the number of axes, size of each axis,
+pixel type, etc. after the image has been opened.
+
+
+4. STORAGE FORMATS
+
+    IMIO stores images on disk in line storage mode, like a multidimensional
+Fortran array.  Image lines are normally padded out to an integral number
+of disk blocks to increase i/o efficiency.  We store the header information
+separately from the pixels, since the header is variable length.  The pixel
+storage file is preallocated and fixed in size.  We call this a "static file".
+A special FIO driver is provided for static files to provide optimal i/o.
+Since the file is not dynamically extended at run time and the physical
+blocks allocated for the file do not move about, it is possible to bypass
+the host files system to directly access the data with a low level interface.
+
+
+5. EXAMPLE (SPP)
+
+
+# IMCOPY -- Copy an image.  The header information is preserved.  The output
+# image has the same size, dimensionality, and pixel type as the input image.
+# An image section may however be used to copy a subsection of the input image.
+
+procedure imcopy (in_image, out_image)
+
+char	in_image[ARB]
+char	out_image[ARB]
+
+int	npix
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+pointer	in, out, l1, l2
+pointer	immap(), imgnlr(), impnlr()
+
+begin
+	# Open/create the images.
+	in  = immap (in_image, READ_ONLY, 0)
+	out = immap (out_image, NEW_COPY, im_a)
+
+	# Initialize position vectors to line 1, column 1, band 1, ...
+	call amovkl (long(1), v1, IM_MAXDIM)
+	call amovkl (long(1), v2, IM_MAXDIM)
+	npix = IM_LEN(in,1)
+
+	# Copy the image.
+	while (imgnlr (in, l1, v1) != EOF && impnlr (out, l2, v2) != EOF)
+	    call amovr (Memr[l1], Memr[l2], npix)
+	
+	call imunmap (in)
+	call imunmap (out)
+end
diff --git a/sys/imio/doc/imio.hlp b/sys/imio/doc/imio.hlp
new file mode 100644
index 00000000..8eb96159
--- /dev/null
+++ b/sys/imio/doc/imio.hlp
@@ -0,0 +1,1185 @@
+.help imio May83 "Image I/O Routines"
+.sh
+The Image Header
+
+    The major difference between the prototype IMIO interface, and the final
+interface, concerns the way in which the image header is implemented and
+accessed.  In the prototype version, we will simply read the entire header
+into core and access it as an ordinary (dynamically allocated) structure.
+
+
+.nf
+	ptr =	immap (fname, mode, hdrsize/hdrptr)
+	      imunmap (hdrptr)
+.fi
+
+
+The final resolution of how image headers are implemented depends on how
+we decide to implement virtual structures in the spp language.  The immap
+calls, and the techniques used to access the fields of the image header,
+can be expected to change.
+
+.sh
+Pixel I/O
+
+    The calling sequences for the i/o routines, described below, hopefully will
+not have to be changed.  We will eventually add GETPIX and PUTPIX statements
+to the subset preprocessor language, to automatically generate the appropriate
+low level calls.
+
+A generic, polymorphic GETPIX or PUTPIX statement is translated into a
+reference to a low level Fortran function.  The transformation is governed
+by the following subprogram name generating function:
+
+
+.rj (108 total)
+GETPIX, PUTPIX -->  im[gp][pls][123][silrdx]
+
+
+.ks
+.nf
+For example (get, type real):
+
+	ptr =	imgp1r (hdrptr, x, npix)		# get pixels
+	ptr =	imgp2r (hdrptr, x, y, npix)
+	ptr =	imgp3r (hdrptr, x, y, z, npix)
+
+	ptr =	imgl1r (hdrptr)				# get line
+	ptr =	imgl2r (hdrptr, y)
+	ptr =	imgl3r (hdrptr, y, z)
+
+	ptr =	imgs1r (hdrptr, x1, x2)			# get section
+	ptr =	imgs2r (hdrptr, x1, x2, y1, y2)
+	ptr =	imgs3r (hdrptr, x1, x2, y1, y2, z1, z2)
+.fi
+.ke
+
+
+The IM?P?? procedures access a list of pixels, the coordinates of which
+are given by the X, Y, Z, etc. arrays given as arguments.  Note that random
+access of individual pixels is provided as a special case (npix=1).
+
+The IM?L?? routines access the lines of an image, and the IM?S?? routines
+operate on general, but connected, subsections of images.
+
+
+.sh
+Restrictions Imposed by the Initial Prototype:
+
+    IMMAP, IMMAPNC, IMUNMAP will be implemented for image headers that are
+simple binary structures (not self describing), subject to the restriction
+that a file may contain only a single header.  An arbitrary selection of user
+defined fields will follow the standard header.  The entire header will
+be read into core and accessed as a simple incore structure.
+
+The pixels, and other variable size image substructures, will be stored
+in separate files, as in the general plan.  All of the standard data types
+will be implemented in the disk space.  The initial implementation will
+support only type REAL pixels in program space.
+
+The following i/o routines will be implemented in the first release of
+the prototype:
+
+.rj (12 total)
+	im[gp][sc][123][r]
+
+In words, we will be able to read and write lines and sections, with the
+applications program manipulating type REAL pixels internally.  The full
+range of data types will be permitted in the image file as stored on disk.
+Up to three dimensional images are permitted.
+
+.sh
+IMSET Options
+
+    The prototype need not provide multiple buffering and boundary extension
+initially.
+
+.sh
+Implementation
+
+    Little effort should be made to make the prototype optimal.  All
+buffering will be locally allocated, and data will be copied to and from
+the FIO buffers (the FIO buffers will not be directly accessed).  Special
+cases will not be optimized.  The most general entry points are IMGGSR
+and IMPGSR (get/put general section).  Initially, all of the other entry
+points can be defined in terms of these.
+
+
+.ks
+.nf
+Structure of the input procedures (type REAL): 
+
+	imgl1r
+	imgl2r
+	imgl3r
+	imgs1r
+	imgs2r
+	imgs3r
+		imggsr
+			imggsc
+				imgibf
+					imopsf
+					calloc
+					imcssz
+					realloc
+					malloc
+					mfree
+				imsslv
+				imrdpx
+					imsoob
+					imnote
+					seek
+					read
+				imflip
+			imupkr
+
+  (datatype dependent) | (datatype independent)
+.fi
+.ke
+
+
+
+The output procedures are structured somewhat differently, because the
+transfer of a section occurs sometime after a "put section" returns,
+rather than immediately as in the input procedures.  Since the output
+is buffered for a delayed write, we must have an IMFLUSH entry point, and
+IMUNMAP must flush the output buffer before unmapping an image.
+
+
+.ks
+.nf
+Structure of the output procedures (type REAL): 
+
+	impl1r
+	impl2r
+	impl3r
+	imps1r		imunmap
+	imps2r		   |
+	imps3r		   |
+		impgsr     |
+			imflush
+				imflsr
+					imflsh
+						imflip
+						imwrpx
+							imsoob
+							imnote
+							imwrite
+								fstatus
+								seek
+								write
+					impakr
+
+			imgobf
+				imopsf
+				calloc
+				imcssz
+				realloc
+				malloc
+				mfree
+
+          (datatype dependent) | (datatype independent)
+.fi
+.ke
+
+
+.sh
+Semicode for the Basic I/O Routines
+
+    The IMGGS? and IMPGS? procedures get and put general N-dimensional
+image sections of a specific datatype.  There is no intrinsic limit on
+the maximum number of dimensions, and the full range (8) of disk datatypes
+are easily supported.  The subscript for a particular dimension may run
+either forward or backward.  The semicode is written generically, allowing
+code to be machine generated for all program space datatypes (6).
+
+We do not address the problems of boundary extension and multiple buffering
+here, but these features can be easily added in the future.  This version
+of IMIO assumes that pixels are stored on disk in line storage mode, with
+no interlacing of bands.
+
+
+IMGGS? gets a general section, and converts it to the datatype indicated
+by the type suffix.
+
+
+.ks
+.nf
+pointer procedure imggs$t (imdes, vs, ve)
+
+imdes	pointer to image descriptor structure
+vs,ve	coordinates of starting and ending points
+
+begin
+	bp = imggsc (imdes, vs, ve, TY_PIXEL, totpix)
+	if (imdes.pixtype != TY_PIXEL)
+	    call imupk$t (*bp, *bp, totpix, imdes.pixtype)
+	return (coerce (bp, TY_CHAR, TY_PIXEL))
+end
+.fi
+.ke
+
+
+
+IMGGSC gets a general section from an imagefile into a buffer.  Upon
+exit, the buffer contains the requested section, with the pixels still
+in the same datatype they were in the imagefile.  The buffer is made
+large enough to accommodate the pixels in either datatype.
+
+
+.ks
+.nf
+pointer procedure imggsc (imdes, vs, ve, dtype, totpix)
+
+imdes	pointer to image descriptor structure
+vs,ve	coordinates of starting and ending points
+dtype	datatype of pixels required by calling program
+bp	pointer to CHAR buffer to hold pixels
+
+begin
+	# Get an (input) buffer to put the pixels into.   Prepare the
+	# section descriptor vectors V, VINC.
+
+	bp = imgibf (imdes, vs, ve, dtype)
+	call imsslv (imdes, vs, ve, v, vinc, npix)
+
+	# Extract the pixels.  IMRPIX reads a contiguous array of
+	# pixels into the buffer at the specified offset, incrementing
+	# the offset when done.  The pixels are type converted if
+	# necessary.
+
+	offset = 0
+
+	repeat {
+	    call imrdpx (imdes, *(bp+offset), v, npix)
+	    if (vinc[1] < 0)
+		call imflip (*(bp+offset), npix, sizeof(imdes.pixtype))
+	    offset = offset + npix
+
+	    for (d=2;  d <= imdes.ndim;  d=d+1) {
+		v[d] += vinc[d]
+		if ((v[d] - ve[d] == vinc[d]) && d < imdes.ndim)
+		    v[d] = vs[d]
+		else {
+		    d = 0
+		    break
+		}
+	    }
+	} until (d >= imdes.ndim)
+
+	totpix = offset
+	return (bp)
+end
+.fi
+.ke
+
+
+
+
+
+Prepare the section descriptor vectors V and VINC.  V is a vector specifying
+the coordinates at which the next i/o transfer will take place.  VINC is
+a vector specifying the loop step size.
+
+
+.ks
+.nf
+procedure imsslv (imdes, vs, ve, v, vinc, npix)
+
+begin
+	# Determine the direction in which each dimension is to be
+	# traversed.
+
+	do i = 1, imdes.ndim
+	    if (vs[i] <= ve[i])
+		vinc[i] = 1
+	    else
+		vinc[i] = -1
+
+	# Initialize the extraction vector (passed to IMRDS? to read a
+	# contiguous array of pixels).  Compute length of a line.
+
+	do i = 1, imdes.ndim
+	    v[i] = vs[i]
+
+	if (vs[1] > ve[1]) {
+	    v[1] = ve[1]
+	    npix = vs[1] - ve[1] + 1
+	} else
+	    npix = ve[1] - vs[1] + 1
+end
+.fi
+.ke
+
+
+
+
+
+The put-section procedure must write the contents of the output buffer
+to the image, using the section parameters saved during the previous call.
+The new section parameters are then saved, and the buffer pointer is
+returned to the calling program.  The calling program subsequently fills
+the buffer, and the sequence repeats.
+
+
+.ks
+.nf
+pointer procedure impgs$t (imdes, vs, ve)
+
+imdes	pointer to image descriptor structure
+vs,ve	coordinates of starting and ending points
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	call imflush (imhdr)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, TY_PIXEL)
+	imdes.flush_epa = loc (imfls$t)
+
+	return (bp)
+end
+.fi
+.ke
+
+
+
+Flush the output buffer, if a put procedure has been called, and the
+buffer has not yet been flushed.  The output buffer is flushed automatically
+whenever a put procedure is called, when an image is unmapped, or when
+the applications program calls IMFLUSH.
+
+
+.ks
+.nf
+procedure imfls$t (imdes)
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (imdes.flush == YES) {
+	    bdes = imdes.obdes
+	    bp = bdes.bufptr
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (imdes.pixtype != TY_PIXEL)
+		call impak$t (*bp, *bp, bdes.npix, imdes.pixtype)
+	    call imflsh (imdes)
+
+	    imdes.flush = NO
+	}
+end
+.fi
+.ke
+
+
+.ks
+.nf
+procedure imflsh (imdes)
+
+begin
+	# Determine the direction in which each dimension is to be
+	# traversed.
+
+	bdes = imdes.obdes
+	call imsslv (imdes, bdes.vs, bdes.ve, v, vinc, npix)
+
+	# Write out the pixels.  IMWRPX writes a contiguous array of
+	# pixels at the specified offset.
+
+	offset = 0
+
+	repeat {
+	    if (vinc[1] < 0)
+		call imflip (*(bp+offset), npix, sizeof(imdes.pixtype))
+	    call imwrpx (imdes, *(bp+offset), v, npix)
+	    offset = offset + npix
+
+	    for (d=2;  d <= imdes.ndim;  d=d+1) {
+		v[d] += vinc[d]
+		if ((v[d] - ve[d] == vinc[d]) && d < imdes.ndim)
+		    v[d] = vs[d]
+		else {
+		    d = 0
+		    break
+		}
+	    }
+	} until (d >= imdes.ndim)
+end
+.fi
+.ke
+
+
+
+
+Read a contiguous array of NPIX pixels, starting at the point defined by
+the vector V, into the callers buffer.
+
+
+.ks
+.nf
+procedure imrdpx (imdes, buf, v, npix)
+
+begin
+	# Check that the access does not reference out of bounds.
+
+	if (imsoob (imdes, v, npix))
+	    call imerr (imname, subscript_out_of_range)
+
+	# Seek to the point V in the pixel storage file.  Compute size
+	# of transfer.
+
+	call seek (imdes.pfd, imnote (imdes, v))
+	nchars = npix * sizeof (imdes.pixtype)
+
+	# Read in the data.
+	if (read (imdes.pfd, buf, nchars, junk) != nchars)
+	    call imerr (imname, missing_pixels)
+end
+.fi
+.ke
+
+
+
+Write a contiguous array of NPIX pixels, starting at the point defined by
+the vector V, into the pixel storage file.
+
+
+.ks
+.nf
+procedure imwrpx (imdes, buf, v, npix)
+
+begin
+	# Check that the access does not reference out of bounds.
+
+	if (imsoob (imdes, v, npix))
+	    call imerr (imname, subscript_out_of_range)
+
+	# Seek to the point V in the pixel storage file.  Note that
+	# when writing to a new image, the next transfer may occur
+	# at a point beyond the current end of file.  If so, write
+	# out zeros until the desired offset (which is in bounds)
+	# is reached.
+
+	file_offset = imnote (imdes, v)
+	if (file_offset > imdes.file_size)
+	    [write zeros until the desired offset is reached]
+	else
+	    call seek (imdes.pfd, file_offset)
+
+	# Compute size of transfer.  If transferring an entire line,
+	# increase size of transfer to the physical line length,
+	# to avoid having to enblock the data.  NOTE: buffer must
+	# be large enough to guarantee no memory violation.
+
+	if (v[1] == 1 && npix == imdes.len[1])
+	    nchars = imdes.physlen[1] * sizeof (imdes.pixtype)
+	else
+	    nchars = npix * sizeof (imdes.pixtype)
+
+	call write (imdes.pfd, buf, nchars)
+	imdes.file_size = max (imdes.file_size, file_offset+nchars)
+end
+.fi
+.ke
+
+
+
+
+IMNOTE computes the physical offset of a particular pixel in the
+pixel storage file.  If the disk datatype is UBYTE, this is the offset
+of the char containing the subscripted byte.
+
+
+.ks
+.nf
+long procedure imnote (imdes, v)
+
+begin
+	pixel_offset = v[1]
+	for (i=2;  i <= imdes.ndim;  i=i+1)
+	    pixel_offset += (v[i]-1) * imdes.physlen[i]
+
+	char_offset0 = (pixel_offset-1) * sizeof (imdes.pixtype)
+	return (imdes.pixoff + char_offset0)
+end
+.fi
+.ke
+
+
+
+Convert a vector of any datatype to type PIXEL ($t).  The input and
+output vectors may be the same, without loss of data.  The input and
+output datatypes may be the same, in which case no conversion is
+performed.
+
+
+.ks
+.nf
+procedure imupk$t (a, b, npix, dtype)
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtu$t (a, b, npix)
+	case TY_SHORT:
+	    call achts$t (a, b, npix)
+	case TY_INT:
+	    call achti$t (a, b, npix)
+	case TY_LONG:
+	    call achtl$t (a, b, npix)
+	case TY_REAL:
+	    call achtr$t (a, b, npix)
+	case TY_DOUBLE:
+	    call achtd$t (a, b, npix)
+	case TY_COMPLEX:
+	    call achtx$t (a, b, npix)
+	default:
+	    call syserr (unknown_datatype_in_imagefile)
+	}
+end
+.fi
+.ke
+
+
+
+Convert a vector of type PIXEL ($t) to any datatype.  The input and
+output vectors may be the same, without loss of data.  The input and
+output datatypes may be the same, in which case no conversion is
+performed.
+
+
+.ks
+.nf
+procedure impak$t (a, b, npix, dtype)
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call acht$tu (a, b, npix)
+	case TY_SHORT:
+	    call acht$ts (a, b, npix)
+	case TY_INT:
+	    call acht$ti (a, b, npix)
+	case TY_LONG:
+	    call acht$tl (a, b, npix)
+	case TY_REAL:
+	    call acht$tr (a, b, npix)
+	case TY_DOUBLE:
+	    call acht$td (a, b, npix)
+	case TY_COMPLEX:
+	    call acht$tx (a, b, npix)
+	default:
+	    call syserr (unknown_datatype_in_imagefile)
+	}
+end
+.fi
+.ke
+
+
+.sh
+Data Structure Management
+
+    When an image is mapped, buffer space is allocated for a copy of
+the image header, and for the image descriptor (used by IMIO while an
+image is mapped).  When the first i/o transfer is done on an image,
+either an input or an output data buffer will be created.  The size of
+this buffer is governed by the size of the transfer, and by the datatypes
+of the pixels on disk and in program space.
+
+If a new image is being written, the pixel storage file is created at
+the time of the first PUTPIX operation.  The physical characteristics
+of the new image, defined by the image header of the new image, are
+unalterable once the first i/o operation has occurred.  Accordingly,
+the number of dimensions, length of the dimensions, datatype of the
+pixels on disk, and so on must be set (in the image header structure)
+before writing to the new image.
+
+The only exception to this rule may be the addition of new lines to a
+two dimensional image stored in line storage mode, or the addition of
+new bands to a multiband image stored in band sequential (noninterlaced)
+mode.  It is not always possible to modify the dimensions or size of
+an existing image.
+
+It is possible to preallocate space for an image (using FALOC).  This
+may result in a more nearly contiguous file, and may make writing a
+new image slightly more efficient, since it will not be necessary
+to write blocks of zeros in IMPGS?.  Preallocation will occur
+automatically in systems where it is desirable.
+
+.sh
+Pixel Buffer Management
+
+    There may be any number of input buffers per image, but only a single
+output buffer.  By default there is only a single input buffer.  The input
+and output buffers are distinct: the same buffer is never used for both
+input and output (unlike FIO).
+
+The size of a buffer may range from one pixel, to the entire image (or
+larger if boundary extension is in use).  If multiple buffers are in use,
+all buffers do not have to be the same size.  The size of a buffer may
+vary from one GETPIX or PUTPIX call to the next.
+
+If multiple input buffers are in use, buffers are allocated in a strictly
+round robin fashion, one per GETPIX call.  Several buffers may contain
+data from the same part of the image.  Once the desired number of buffers
+have been filled, a buffer "goes away" with each subsequent GETPIX call.
+
+
+IMGIBF gets an input buffer.  When called to get a line or section,
+the vectors VS and VE specify the subsection to be extracted.
+This information is saved in the buffer descriptor, along with the
+datatype of the pixels and the dimension of the section.
+
+When IMGIBF is called to get a list of pixels, VS and VE would have to be
+replaced by a set of NPIX such vectors, to fully specify the section.
+It is impractical to save this much information in the buffer descriptor,
+so when creating a buffer to contain a list of pixels, VS and VE are faked
+to indicate a one dimensional section of the appropriate size.
+
+
+
+
+.ks
+.nf
+pointer procedure imgibf (imdes, vs, ve, dtype)
+
+imdes	image descriptor
+vs,ve	define the number of pixels to be buffered
+dtype	the datatype of the pixels in the program
+
+begin
+	# If first input transfer, allocate and initialize array of
+	# input buffer descriptors.
+
+	if (imdes.ibdes == NULL) {
+	    call imopsf (imdes)
+	    call calloc (imdes.ibdes, LEN_BDES * imdes.nbufs, TY_STRUCT)
+	}
+
+	# Compute pointer to the next input buffer descriptor.
+	# Increment NGET, the count of the number of GETPIX calls.
+
+	bdes = &imdes.ibdes [mod (imdes.nget, imdes.nbuf) + 1]
+	imdes.nget += 1
+
+	# Compute the size of the buffer needed.  Check buffer
+	# descriptor to see if the old buffer is the right size.
+	# If so, use it, otherwise make a new one.
+
+	nchars = imcssz (imdes, vs, ve, dtype)
+
+	if (nchars < bdes.bufsize)
+	    call realloc (bdes.bufptr, nchars, TY_CHAR)
+	else if (nchars > bdes.bufsize) {
+	    call mfree (bdes.bufptr, TY_CHAR)
+	    call malloc (bdes.bufptr, nchars, TY_CHAR)
+	}
+
+	# Save section coordinates, datatype in buffer descriptor, and
+	# return buffer pointer to calling program.
+
+	bdes.bufsize = nchars
+	bdes.dtype = dtype
+	bdes.npix = totpix
+
+	do i = 1, imdes.ndim {
+	    bdes.vs[i] = vs[i]
+	    bdes.ve[i] = ve[i]
+	}
+
+	return (coerce (bdes.bufptr, TY_CHAR, dtype)
+end
+.fi
+.ke
+
+
+
+
+.ks
+.nf
+pointer procedure imgobf (imdes, vs, ve, dtype)
+
+imdes	image descriptor
+vs,ve	define the number of pixels to be buffered
+dtype	the datatype of the pixels in the program
+
+begin
+	# If first write, and if new image, create pixel storage file,
+	# otherwise open pixel storage file.  Allocate and initialize
+	# output buffer descriptor.
+
+	if (imdes.obdes == NULL) {
+	    call imopsf (imdes)
+	    call calloc (imdes.obdes, LEN_BDES, TY_STRUCT)
+	}
+
+	bdes = imdes.obdes
+
+	# Compute the size of buffer needed.  Add a few extra chars
+	# to guarantee that there won't be a memory violation when
+	# writing a full physical length line.
+
+	nchars = imcssz (imdes, vs, ve, dtype) +
+	(imdes.physlen[1] - imdes.len[1]) * sizeof (imdes.pixtype)
+
+	if (nchars < bdes.bufsize)
+	    call realloc (bdes.bufptr, nchars, TY_CHAR)
+	else if (nchars > bdes.bufsize) {
+	    call mfree (bdes.bufptr, TY_CHAR)
+	    call malloc (bdes.bufptr, nchars, TY_CHAR)
+	}
+
+	# Save section coordinates, datatype of pixels in buffer
+	# descriptor, and return buffer pointer to calling program.
+
+	bdes.bufsize = nchars
+	bdes.dtype = dtype
+	bdes.npix = totpix
+
+	do i = 1, imdes.ndim {
+	    bdes.vs[i] = vs[i]
+	    bdes.ve[i] = ve[i]
+	}
+
+	return (coerce (bdes.bufptr, TY_CHAR, dtype)
+end
+.fi
+.ke
+
+
+
+Given two vectors describing the starting and ending coordinates
+of an image section, compute and return the amount of storage needed
+to contain the section.  Sufficient storage must be allocated to
+hold the largest datatype pixels which will occupy the buffer.
+
+
+
+.ks
+.nf
+long procedure imcssz (imdes, vs, ve, dtype)
+
+begin
+	pix_size = max (sizeof(imdes.pixtype), sizeof(dtype))
+	npix = 0
+
+	do i = 1, imdes.ndim
+	    if (vs[i] <= ve[i])
+		npix *= ve[i] - vs[i] + 1
+	    else
+		npix *= vs[i] - ve[i] + 1
+
+	return (npix * pix_size)
+end
+.fi
+.ke
+
+
+.sh
+Mapping and unmapping Image Structures
+
+    An imagefile must be "mapped" to an image structure before the
+structure can be accessed.  The map operation associates a file with
+a defined structure.
+
+The IMMAP procedure must allocate a buffer for the image header
+structure, and for the image descriptor structure.  If an existing
+imagefile is being mapped, the header is copied into memory from
+the imagefile.  If a new image is being mapped, the header structure
+is allocated and initialized.
+
+If an image is being mapped as a "new copy", a new header
+structure is created which is a copy of the header of an image which
+has already been mapped.  The entire image header, including any
+application specific fields, is copied.
+
+After copying an image header for a NEW_COPY image, the header field
+containing the name of the pixel storage file is cleared.  A "new copy"
+image structure does not inherit any pixels.  Any similar substructures
+which describe the attributes of the pixels (i.e., the blank pixel
+list, the histogram) must also be initialized.
+
+Note that the "image descriptor" buffer allocated below actually 
+contains the image descriptor, followed by the standard image header
+(at offset IMHDR_OFF), followed by any user fields.  If an existing
+image structure is being mapped, the caller supplies the length of
+the user area of the header as the third argument to IMMAP.
+
+IMMAP returns a pointer to the first field of the standard header
+as the function value.  The image descriptor is invisible to the
+calling program.
+
+
+
+.ks
+.nf
+pointer procedure immap (fname, mode, hdr_arg)
+
+begin
+	# Add code here to handle section suffixes in imagefile
+	# name strings (e.g. "image[*,5]").
+
+	# Open image header file.
+	hfd = open (fname, mmap[mode], BINARY_FILE)
+
+	# Allocate buffer for image descriptor/image header.  Note
+	# the dual use of the HDR_ARG argument.
+
+	if (mode == NEW_COPY)
+	    sz_imhdr = hdr_arg.sz_imhdr
+	else
+	    sz_imhdr = (LEN_IMHDR + int(hdr_arg)) * SZ_STRUCT
+
+	call calloc (imdes, SZ_IMDES + sz_imhdr, TY_STRUCT)
+	imhdr = imdes + IMHDR_OFF
+
+	[initialize the image descriptor, including the default
+	image section (optionally set by user with suffix above).]
+
+	# Initialize the mode dependent fields of the image header.
+	switch (mode) {
+	case NEW_COPY:
+	    call im_init_newcopy (imdes, hdr_arg)
+	case NEW_IMAGE:
+	    [initialize the image header]
+	default:
+	    call seek (hfd, BOFL)
+	    n = read (hfd, Memi[imhdr], sz_imhdr)
+	    if (n < SZ_IMHDR || strne (IM_MAGIC(imhdr), "imhdr")) {
+		call mfree (imdes)
+		call imerr (fname, file_not_an_imagefile)
+	    } else if (mode == READ_ONLY)
+		call close (hfd)
+	}
+
+	[initialize those fields of the image header which are not
+	dependent on the mode of access.]
+
+	return (imhdr_pointer)
+end
+.fi
+.ke
+
+
+
+
+.ks
+.nf
+procedure imunmap (imhdr)
+
+begin
+	imdes = imhdr - IMHDR_OFF
+
+	# Flush the output buffer, if necessary.
+	call imflush (imhdr)
+
+	# Append the bad pixel list.
+	if (the bad pixel list has been modified) {
+	    if (file_size < blist_offset)
+		[write out zeros until the offset of the bad pixel
+		list is reached]
+	    [append the bad pixel list]
+	    [free buffer space used by bad pixel list]
+	}
+
+	call close (imdes.pfd)
+
+	# Update the image header, if necessary (count of bad pixels,
+	# minimum and maximum pixel values, etc.).
+
+	if (imdes.update == YES) {
+	    if (no write permission on image)
+		call imerr (imname, cannot_update_imhdr)
+	    call imuphdr (imdes)
+	    call close (imdes.hfd)
+	}
+
+	# Free buffer space.
+	for (i=1;  i <= imdes.nbufs;  i=i+1)
+	    call mfree (imdes.ibdes[i].bufptr, TY_CHAR)
+	call mfree (imdes.obdes.bufptr, TY_CHAR)
+	call mfree (imdes, TY_STRUCT)
+end
+.fi
+.ke
+
+
+IMFLUSH indirectly references a typed flush procedure, the entry point
+address of which was saved in the image descriptor at the time of the
+last IMPGS? call.  The problem here is that IMFLUSH must work properly
+regardless of the data type of the pixels in the output buffer.  To
+ensure this, and to avoid having to link in the full matrix of 48 type
+conversion routines, we call LOC in the put-section procedure to reference
+the appropriate typed flush routine.
+
+
+
+.ks
+.nf
+procedure imflush (imhdr)
+
+begin
+	if (imdes.flush == YES)
+	    call zcall1 (imdes.flush_epa, imdes)
+end
+.fi
+.ke
+
+
+
+The following procedure is called by the IMGOBF and IMGIBF routines
+to open the pixel storage file, during the first PUTPIX operation on
+a file.
+
+
+.ks
+.nf
+procedure imopsf (imdes)
+
+begin
+	switch (imdes.mode) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    imdes.pfd = open (imdes.pixfile, imdes.mode, BINARY_FILE)
+	    if (read (imdes.pfd, pix_hdr, SZ_PIXHDR) < SZ_IMMAGIC)
+		call imerr (imname, cannot_read_pixel_storage_file)
+	    else if (strne (pix_hdr.im_magic, "impix"))
+		call imerr (imname, not_a_pixel_storage_file)
+
+	case NEW_COPY, NEW_FILE, TEMP_FILE:
+	    # Get the block size for device "imdir$", and initialize
+	    # the physical dimensions of the image, and the absolute
+	    # file offsets of the major components of the pixel storage
+	    # file.
+
+	    dev_block_size = fdevblk ("imdir$")
+	    [initialize im_physlen, im_pixels, im_hgmoff fields
+	    in image header structure]
+
+	    # Open the new pixel storage file (preallocate space if
+	    # enabled on local system).  Call FADDLN to tell FIO that
+	    # the pixfile is subordinate to the header file (for delete,
+	    # copy, etc.).  Save the physical pathname of the pixfile
+	    # in the image header, in case "imdir$" changes.
+
+	    call mktemp ("imdir$im", temp, SZ_FNAME)
+	    call fpathname (temp, imhdr.pixfile, SZ_PATHNAME)
+
+	    if (preallocation of imagefiles is enabled)
+		call falloc (imhdr.pixfile, sz_pixfile)
+	    imdes.pfd = open (imdes.pixfile, NEW_FILE, BINARY_FILE)
+	    call faddln (imdes.imname, imdes.pixfile)
+
+	    # Write small header into pixel storage file.  Allows
+	    # detection of headerless pixfiles, and reconstruction
+	    # of header if it gets lost.
+
+	    [write pix_hdr header structure to pixel storage file]
+
+	default:
+	    call imerr (imname, illegal_access_mode)
+	}
+end
+.fi
+.ke
+
+
+.sh
+Data Structures
+
+    An imagefile consists of two separate files.  The first file contains
+the image header.  In the prototype, there may be only a single header per
+header file.  The header consists of the standard image header, followed
+by an arbitrary number of user defined fields.
+
+The standard part of the image header has a fixed structure.  All the variable
+size components of an image are stored in the pixel storage file.  The
+name of the pixel storage file, and the offsets to the various components
+of the image, are stored in the image header.  The name of the image header
+file is in turn stored in the header area of the pixel storage file,
+making it possible to detect headerless images.
+
+The pixel storage file contains a small header, followed by the pixels
+(aligned on a block boundary), optionally followed by a fixed size
+histogram, and a variable size bad pixel list.
+
+
+.ks
+.nf
+		   Structure of an Imagefile
+
+		---------            ---------
+		    |       <----        |
+		 standard  ---->       header 
+		  image                  |
+		  header               PIXELS
+		    |                    |
+		   user              histogram      (optional)
+		  fields                 |
+		    |                   bad
+		   \|/                 pixel        (optional)
+		----------              list
+		                         |
+		                        \|/
+				     ---------
+.fi
+.ke
+
+
+The image header file, which is small, will reside in the users own
+directory.  The pixel storage file is generated and manipulated 
+transparently to the applications program and the user, and resides
+in the temporary files system, in the logical directory "imdir$".
+
+Storing the parts of an image in two separate files does cause problems.
+The standard file operators, like DELETE, COPY, RENAME, and so on,
+either cannot be used to manipulate imagefiles, or must know about
+imagefiles.
+
+To solve this problem, without requiring FIO to know anything about IMIO
+or VSIO data structures, two operators will be added to FIO.  The first
+will tell FIO that file 'A' has a subordinate file 'B' associated with
+it.  Any number of subordinate files may be associated with a file.
+The information will be maintained as a list of file names in an invisible
+text file in the same directory as file 'A'.
+
+The second operator will delete the link to a subordinate file.  The FIO
+procedures DELETE and RENAME will check for subordinate files, as will CL
+utilities like COPY.
+
+.sh
+The Standard Image Header
+
+    The standard fields of an image header describe the physical
+characteristics of the image (required to access the pixels), plus
+a few derived or historic attributes, which are commonly associated
+with images as used in scientific applications.
+
+
+.ks
+.nf
+struct imhdr {
+	char	im_magic[5]		# contains the string "imhdr"
+	long	im_hdrlen		# length of image header
+	int	im_pixtype		# datatype of the pixels
+	int	im_ndim			# number of dimensions
+	long	im_len[MAXDIM]		# length of the dimensions
+	long	im_physlen[MAXDIM]	# physical length (as stored)
+	long	im_pixels		# offset of the pixels
+	long	im_hgmoff		# offset of hgm pixels
+	long	im_blist		# offset of bad pixel list
+	long	im_szblist		# size of bad pixel list
+	long	im_nbpix		# number of bad pixels
+	long	im_cdate		# date of image creation
+	long	im_mdate		# date of last modify
+	real	im_max			# max pixel value
+	real	im_min			# min pixel value
+	struct	histogram im_hgm	# histogram descriptor
+	struct	coord_tran im_coord	# coordinate transformations
+	char	im_pixfile[SZ_PATHNAME]	# name of pixel storage file
+	char	im_name[SZ_IMNAME]	# image name string
+	char	im_history[SZ_IMHIST]	# history comment string
+}
+.fi
+.ke
+
+
+
+The histogram structure, if valid, tells where in the pixel storage file
+the histogram is stored, and in addition summarizes the principal
+attributes of the histogram.  All of these quantities are directly
+calculable, except for the last three.  The modal value is determined
+by centering on the (major) peak of the histogram.  LCUT and HCUT define
+an area, centered on the modal value, which contains a certain fraction
+of the total integral.
+
+
+.ks
+.nf
+struct histogram {
+	int	hgm_valid		# YES if histogram is valid
+	int	hgm_len			# number of bins in hgm
+	long	hgm_npix		# npix used to compute hgm
+	real	hgm_min			# min hgm value
+	real	hgm_max			# max hgm value
+	real	hgm_integral		# integral of hgm
+	real	hgm_mean		# mean value
+	real	hgm_variance		# variance about mean
+	real	hgm_skewness		# skewness of hgm
+	real	hgm_mode		# modal value of hgm
+	real	hgm_lcut		# low cutoff value
+	real	hgm_hcut		# high cutoff value
+}
+.fi
+.ke
+
+
+
+The coordinate transformation descriptor is used to map pixel coordinates
+to some user defined virtual coordinate system, (useful when displaying the
+contents of an image).  For lack of a significantly better scheme, we have
+simply adopted the descriptor defined by the FITS standard.
+
+
+.ks
+.nf
+struct coord_tran {
+	real	im_bscale		# pixval scale factor
+	real	im_bzero		# pixval offset
+	real	im_crval[MAXDIM]	# value at pixel
+	real	im_crpix[MAXDIM]	# index of pixel
+	real	im_cdelt[MAXDIM]	# increment along axis
+	real	im_crota[MAXDIM]	# rotation angle
+	char	im_bunit[SZ_BUNIT]	# pixval ("brightness") units
+	char	im_ctype[SZ_IMCTYPE,MAXDIM]	# coord units
+}
+.fi
+.ke
+
+
+
+The image and buffer descriptors are used internally by IMIO while
+doing i/o on a mapped image.  The image descriptor structure is
+allocated immediately before the image header, is transparent to the
+applications program, and is used to maintain runtime data, which
+does not belong in the image header.
+
+
+.ks
+.nf
+struct image_descriptor {
+	long	file_size			# size of pixfile
+	long	nget				# number getpix calls
+	int	nbufs				# number of in buffers
+	int	flush				# flush outbuf?
+	int	update				# update header?
+	int	pfd				# pixfile fd
+	int	hfd				# header file fd
+	int	flush_epa			# epa of imfls? routine
+	struct	buffer_descriptor *ibdes	# input bufdes
+	struct	buffer_descriptor *obdes	# output bufdes
+	char	imname[SZ_FNAME]		# imagefile name
+}
+.fi
+.ke
+
+
+
+.ks
+.nf
+struct buffer_descriptor {
+	char	*bufptr			# buffer pointer
+	int	dtype			# datatype of pixels
+	long	npix			# number of pixels in buf
+	long	bufsize			# buffer size, chars
+	long	vs[MAXDIM]		# section start vector
+	long	ve[MAXDIM]		# section end vector
+}
+.fi
+.ke
diff --git a/sys/imio/doc/imio.ms b/sys/imio/doc/imio.ms
new file mode 100644
index 00000000..2302a8ff
--- /dev/null
+++ b/sys/imio/doc/imio.ms
@@ -0,0 +1,295 @@
+.ce
+\fBThe IRAF Image I/O Interface\fR
+.ce
+\fIDesign Strategies\fR
+.ce
+\fIStatus and Plans\fR
+.sp
+.ce
+Doug Tody
+.ce
+November 1983
+.sp 3
+.NH
+Introduction
+.PP
+Bulk data arrays are accessed in IRAF SPP programs via the Image I/O
+(IMIO) interface.  IMIO is used to create, read, and write IRAF
+\fBimagefiles\fR.  The term \fBimage\fR refers to data arrays of one, two,
+or more dimensions.  Each "imagefile" actually consists of two files:
+the \fBheader file\fR and the \fBpixel storage file\fR.  Seven disk datatypes
+are currently supported.
+.PP
+The IMIO calling sequences are summarized in the \fIProgrammer's Crib
+Sheet\fR.  There is as yet no Reference Manual or User's Guide for the package.
+Our intention in this document is merely to introduce IMIO, to summarize its
+capabilities, and note what is planned for the future.
+.NH
+Structure
+.PP
+The basic structure of an applications program which uses IMIO is shown
+below.  In the current implementation of IMIO the image header is a simple
+binary structure, but this will change when DBIO (the database interface)
+is implemented.  The pixel storage file is accessed via FIO (the IRAF File
+I/O interface) which permits arbitrarily large buffers and double or multiple
+buffered i/o.  All buffers are dynamically allocated and deallocated using
+the facilities provided by the MEMIO interface.
+
+.DS
+.cs 1 22
+Command Language
+        (applications program)
+                IMIO
+                        DBIO
+                        FIO
+                                OS   |
+                        MEMIO        |  (operating system)
+                                OS   |
+
+
+        (system independent)  |  (system dependent)
+.DE
+.cs 1
+
+.NH
+Summary of What is Provided by the Current Interface
+.PP
+The IMIO interface code is mostly concerned with pixel buffer allocation and
+manipulation, and with mapping requests to read and write image sections
+into file i/o calls.  FIO handles all low level i/o.  The efficiency of FIO
+for sequential image access stems from the fact that the FIO buffers may
+be made as large as desired transparently to the outside world (i.e., IMIO),
+the number of FIO buffers is variable, and full read-ahead and write-behind
+are implemented (provided the OS provides asynchronous i/o facilities).
+.PP
+IMIO currently provides the following functions/features:
+
+.RS
+.IP (1)
+7 disk datatypes (ushort, silrdx).
+.IP (2)
+6 in-core datatypes (the standard silrdx).
+.IP (3)
+Images of up to 7 dimensions are currently supported.  The maximum
+dimensionality is a sysgen parameter.
+.IP (4)
+Fully automatic multidimensional buffer allocation, resizing,
+and deallocation.  There is no fixed limit on the size of a buffer (a subraster
+may actually exceed the size of the image if boundary extension is employed).
+The size of an image is limited only by the resources of the machine.
+.IP (5)
+An arbitrary number of input buffers (default 1) may be used to access an
+image.  Buffers are allocated in a round robin fashion, and need not be the
+same size, dimension, or datatype.  This feature is especially useful for
+convolutions, block averaging, and similar operators.
+.IP (6)
+Fully automatic type conversion on both input and output.  Conversion occurs
+only when data is accessed, so one need not type convert the entire image
+to access a subraster.
+.IP (7)
+IMIO implements general image sections (described below), coordinate flip,
+and subsampling.
+.IP (8)
+The dimensionality of the image expected by the applications code and the
+actual dimension of an image need not agree.  If an operator expects a one
+dimensional image, for example, it may be used to operate on any line, column,
+or pillar of a three dimensional image, on both input and output (see
+discussion on image sections below).
+.IP (9)
+Both "compressed" and "block aligned" storage modes are supported, with IMIO
+automatically selecting the optimal choice during image creation (if the
+packing efficiency is not above a certain threshold then image lines are
+not block aligned).  The device blocksize is determined at runtime and
+devices with different blocksizes may coexist.
+.IP (10)
+IMIO may be advised if i/o is to be either highly sequential or highly
+random; the buffering strategy will be modified to increase i/o efficiency.
+.IP (11)
+Pixel storage files may reside on special devices if desired.  For example,
+the current \fBdisplay\fR routine accesses the image display device as a random
+access imagefile via the standard IMIO interface.  This was easy to do
+because FIO is device independent and allows new devices to be interfaced
+dynamically at run time (other examples of special "devices" are the CL,
+magtapes, and strings).
+.IP (12)
+The image header file, which is small, is normally placed in the user's
+own directory system.  The pixel storage file, on the other hand, is often
+very large and is normally placed in a different filesystem.  This is
+transparent to the user, and has the advantage that bulk data does not
+have to be backed up on tape when the user disk is backed up, and throughput
+is often higher because the pixel filesystem can be optimized for large
+transfers and more nearly contiguous files.
+.IP (13)
+An image opened with the mode "new_copy" inherits the full image header
+of an existing image, including all user defined fields, minus the pixels
+and minus all fields which depend on the actual values of the pixels.
+.RE
+
+.PP
+The basic i/o facilities are described in the crib sheet.  In short, we
+have procedures to get or put pixels, lines, or sections.  The put calls
+are identical to the get calls and all buffer allocation and manipulation
+is performed by IMIO.  The pixel access routines access a list of pixels
+(described by one, two, or more integer arrays giving the coordinates of
+the pixels, which are fetched in storage order to minimize seeks).
+An additional set of calls are available for accessing all of the lines
+in an image sequentially in storage order, regardless of the dimensionality
+of the image (as in the FITS reader).
+.NH
+Planned Enhancements to IMIO
+.PP
+The following enhancements are currently planned for IMIO; they are
+arranged more or less with the highest priority items first.  The DBIO
+header, boundary extension facilities, and bad pixel list features are
+of the highest priority and will be implemented within the next few months.
+
+.RS
+.IP (1)
+Replacement of the current rather rigid binary header by the highly
+extensible yet efficient DBIO header.
+.IP (2)
+Automatic boundary extension by any of the following techniques:
+nearest neighbor, reflection, projection, wrap around, indefinite,
+constant, apodize.  Useful for convolutions and subraster extraction
+near the boundary of an image.
+.IP (3)
+Bad pixel list manipulation.  A list of bad pixels will optionally be
+associated with each image.  The actual value of each "bad" pixel in the
+image will be a reasonable, artificially generated value.  Programs which
+do not need to know about bad pixels, such as simple pointwise image
+operators, will see only reasonable values.  IMIO will provide routines to
+merge (etc.) bad pixel lists in simple pointwise image operations.
+Operators which need to be able to deal with bad pixels, such as surface
+fitting routines, will advise IMIO to replace the bad pixels with the
+value INDEF upon input.
+.IP (4)
+Implement the pixel access routines (\fBimgp__\fR and \fBimpp__\fR).
+Currently only the line and section routines are implemented.  The section
+routines may be used to access individual pixels, but this involves quite
+a bit of overhead and disk seeks are not optimized.
+.IP (5)
+Optimization to the get/put line procedures to work directly
+out of the FIO buffers when possible for increased efficiency.
+.IP (6)
+IMIO (and FIO) dynamically allocate all buffers.  Eventually we will add
+an "advice" option permitting buffers to be allocated in a region
+of memory which is \fIshared\fR with a bit-mapped array processor. 
+The VOPS primitives, already used extensively for vector operations,
+will be interfaced to the AP and applications sofware will then make use
+of the AP without modification and without introducing any device
+dependence.  Note that CSPI is currently marketing a 7 Mflop bit-mapped
+AP for the VAX, and Masscomp provides a similar device for their 680000 based
+supermicro.
+.IP (6)
+Support for the unsigned byte disk datatype.
+.DE
+
+.PP
+Long range improvements include language support for image sections in
+the successor to the SPP (subset) language compiler, and extensions for
+block storage mode of images on disk.  Currently all images are stored on
+disk in line storage mode (i.e., like a Fortran array).
+.NH
+Image Sections
+.PP
+Image sections are used to specify the region of an image to be operated
+upon.  The essential idea is that when the user passes the name of an
+image to a task, a special notation is employed which specifies the section
+of the image to be operated upon.  The image section is decoded by IMIO
+at "immap" time and is completely transparent to the applications code
+(when a section is used, the image appears smaller to the applications
+program).  If no section is specified then the entire image is accessed.
+.PP
+For example, suppose we want to display the image "pix" in frame 1 of the
+image display, using all the default parameters:
+
+.nf
+	cl> display pix, 1
+.fi
+
+This works fine as long as "pix" is a one or two dimensional image.  If it
+is a three dimensional image, we will see only the first band.  To display
+some other band, we must specify a two-dimensional \fIsection\fR of the
+three dimensional image:
+
+.nf
+	cl> display pix[*,*,5], 1
+	cl> display pix[5], 1
+.fi
+
+Either command above would display band 5 of the three dimensional image
+(higher dimensional images are analogous).  To display a dimensional image
+with the columns flipped:
+
+.nf
+	cl> display pix[*,\(mi*], 1
+.fi
+
+This command flips the y-axis.  To display a subraster:
+
+.nf
+	cl> display pix[30:40,310:300], 1
+.fi
+
+would display the indicated eleven pixel square subraster.  To display a
+2048 square image on a 512 square display by means of subsampling:
+
+.nf
+	cl> display pix[*:4,*:4], 1
+.fi
+.NH
+Use of Virtual Memory
+.PP
+The current implementation of IMIO does not make use of any virtual memory
+facilities.  We have had little incentive to do so because 4.1BSD Berkeley
+UNIX does not have a very good implementation of virtual memory (few systems
+do, it seems - DG/AOS, which is what CTIO runs, does not have a
+good implemenation either).  Various strategies can, however, be employed
+to take advantage of virtual memory on a machine which provides good
+virtual memory facilities.
+.PP
+One technique is to use IMIO to "extract a subraster" which is in fact
+the entire image.  The current implementation of IMIO would copy rather
+than map the image, but \fIif\fR no type conversion were required,
+if no section was specified, if the image was not block-aligned,
+and if referencing out of bounds was not required,
+IMIO could instead map the image directly into virtual memory.
+This would be an easy enhancement to make to IMIO because all data is
+accessed with pointers.  The code fragment in the following example
+demonstrates how this is done in the current version of IMIO.
+
+.DS
+.cs 1 22
+int     ncols, nlines
+pointer header, raster
+pointer immap(), imgs2r()
+
+begin
+        # Open or "map" the image.  "Imagefile" is a file name
+        # or a file name with section subscript appended.
+
+        header = immap (imagefile, READ_ONLY, 0)
+
+        ncols  = IM_LEN (header, 1)
+        nlines = IM_LEN (header, 2)
+
+        # Read or map entire image into memory.  Pixels are
+        # converted to type real if necessary.
+
+        raster = imgs2r (header, 1, ncols, 1, nlines)
+        
+        # Call SPP or Fortran subroutine to process type real
+        # image.  Note how the pointer "raster" is dereferenced.
+
+        call subroutine (Memr[raster], ncols, nlines)
+            ...
+.DE
+.cs 1
+
+.PP
+Another, slightly different approach would be to allocate a single FIO
+buffer and map it onto the entire file.  This would require no modifications
+to IMIO, rather one would modify the "file fault" code in FIO.
+This scheme would more efficiently support random access (to image lines or
+subrasters) on a virtual machine without introducing a real dependence
+on virtual memory.
diff --git a/sys/imio/iki/README b/sys/imio/iki/README
new file mode 100644
index 00000000..14b0f3f5
--- /dev/null
+++ b/sys/imio/iki/README
@@ -0,0 +1,383 @@
+			Image Kernel Interface (IKI)
+				Doug Tody
+			       08 May 1986
+
+
+1. INTRODUCTION
+
+    The IKI is the interface between IMIO and some particular image storage
+format.  IMIO itself has no knowledge of the storage format.  The primary
+function of the IKI is to access image headers, mapping the host header
+storage format into the IMIO image header descriptor and vice versa.
+The IKI is responsible for all image management operations, including
+opening/creating/updating headers, opening/creating pixfiles (pixel storage
+files), deleting, renaming, and copying images, checking for the existence
+of images, and so on.
+
+The IKI can support an arbitrary number of different storage formats.
+Each format requires a set of format dependent driver subroutines implementing
+the standard IKI functions.  The IKI will dynamically select the driver to be
+used to access a particular format at runtime.  New drivers may be dynamically
+loaded at runtime, in a way similar to that used for FIO.  While IMIO directly
+accesses the pixel storage file via binary FIO for efficiency reasons, the
+pixfile is opened by the IKI driver, hence a special driver may be used if
+desired.  For example, this feature may be used to access image display frame
+as a pixfile, or an image stored in archival format on an optical disk.
+
+
+2. STRUCTURE
+
+    The role played by the IKI and format specific IKI drivers in the image
+i/o subsystem is illustrated in the figure below.
+
+
+	       IMIO		Format independent; primarily does i/o to
+	         | 		the pixel file.  The image header is read
+		 |		into a dynamically allocated descriptor at
+		 |		open time.
+		 |
+		IKI		Selects driver to be used.  Maintains table
+		 |		of open images, handles cleanup during error
+		 |		recovery.
+		 |
+	     (drivers)		Physically accesses/creates/deletes etc. an
+				image stored in a particular format.  Maps
+				the header stored in some particular external
+				format into the standardized IMIO descriptor.
+				Responsible for opening/creating the pixfile,
+				returning a FIO file descriptor to IMIO, which
+				directly accesses the pixel data.
+
+
+The format specific driver packages are written in SPP using only standard
+VOS i/o facilities, e.g., FIO and MEMIO.  This is necessary due to the use
+of an SPP descriptor structure to maintain the incore version of the image
+header, due to the need to return an FIO file descriptor to IMIO, and so on.
+To add support for a new format, one need only add a new driver to the IKI
+and relink the system.
+
+
+3. LOGICAL SCHEMA
+
+    The logical schema of the current IKI is highly constrained by the fact
+that the IKI is an add-on to the existing IMIO interface.  It is not worthwhile
+in this revision to try to address the limitations/design flaws of the initial
+IMIO interface, hence our intention is to add the IKI in such a way that few
+changes are required to IMIO, and no changes are required to programs which
+use IMIO.  One or two further major revisions are planned before the final
+interface is realized.  The concept of the IKI is here to stay, but the current
+interface attempts only to address the immediate need to support multiple
+image formats with the least impact on current software.
+
+An image consists of a header and a pixel array stored in a random access
+binary file.  Images may be grouped together into an array or "cluster" of
+images, with the individual images being accessed by a one indexed subscript
+appended to the cluster name, e.g., "pix[3]" refers to image 3 of the cluster
+"pix".  To create a cluster containing more than one image a / followed by
+the cluster size may be included in the cluster index, e.g., "pix[3/10]" to
+create a cluster of 10 images and write into image 3.  An image section may
+optionally be appended to access some subset of the pixels in the image, e.g.,
+"pix[3][*,5]".  Lastly, if the image is stored as a disk file, the filename
+extension of the header file may be given to explicitly indicate the image
+format (IKI driver) to be used to access the image.
+
+A full specification (referencing an existing image) might therefore be
+"pix.hhh[3][*,5]", where the ".hhh" extension indicates that the cluster is
+physically stored in an SDAS GEIS (group format) data structure, the "[3]"
+indicates image 3, and the "[*,5]" is a conventional IMIO image section.
+If the minimal specification "pix" were given, the IKI would determine that
+"pix" was a GEIS format image, accessing the entire contents of image [1].
+As an aside, note that image sections are handled entirely by IMIO and are
+not seen at the IKI level.  Likewise, the cluster subscript is parsed by
+IMIO and passed to the IKI as an integer argument.
+
+
+	IM_PIXTYPE	int		pixel type (usilrdx)
+	IM_NDIM		int		number of axes (0:7)
+	IM_LEN		long[7]		logical length of each axis (>=1)
+	IM_PHYSLEN	long[7]		physical length of each axis (>=1)
+	IM_CLINDEX	int		index of image in cluster
+	IM_CLSIZE	int		number of images in cluster
+	IM_PIXOFF	long		char file offset to the pixels
+	IM_CTIME	long		image creation time
+	IM_MTIME	long		most recent image modification time
+	IM_LIMTIME	long		time when max/min last updated
+	IM_MAX		real		maximum pixel value
+	IM_MIN		real		minimum pixel value
+	IM_PIXFILE	char*80		pathname of pixel file (optional)
+	IM_TITLE	char*80		image title string
+
+
+The important fields of the IMIO image descriptor are summarized above, along
+with their datatype and length in the case of arrays.  This is from the original
+IMIO design and has not been modified in any way, except for the addition of the
+cluster fields to the runtime descriptor.  The IKI drivers directly read and
+write these fields in the image descriptor.
+
+In addition to these standard fields (for which the IKI driver must supply
+reasonable values at open time) the image descriptor contains a "user area"
+containing an arbitrary sequence of keyword=value parameters encoded in
+FITS character format.  The FITS cards are trimmed at the right and
+concatenated into an EOS delimited string with newline characters delimiting
+each card.  All host format specific header parameters should be passed to
+IMIO in the user area.  In the case of group format images, the user area
+will contain both the group parameters (parameters shared by the entire group
+of images) and the group header parameters (parameters for the individual
+image in the group specified at open time).  IMIO makes no distinction
+between the two types of parameters.  All header parameters are available
+to the high level applications code via the IMIO/IDBI interface.
+
+
+4. IKI INTERFACE PROCEDURES
+
+    The IMIO code calls only the IKI procedures and has no knowledge of the
+IKI drivers, or of which driver has been connected to a particular image
+descriptor.  The high level IKI procedures are summarized below.  The interface
+is fairly small due to the use of the descriptor to maintain all information
+describing the image, and due to the fact that IMIO directly accesses the
+pixel data via FIO.
+
+
+	       iki_open (im, image, group, gcount, acmode, o_im)
+	      iki_close (im)
+	       iki_opix (im)			# open/create pixfile
+	     iki_updhdr (im)			# update image header
+
+	       iki_copy (oldname, newname)	# fast copy of entire group
+	     iki_delete (group)			# delete entire group
+	     iki_rename (oldname, newname)	# rename entire group
+
+         k = iki_access (image, acmode)		# test existence, legal extn
+	   iki_lddriver (open,close,		# install new driver
+			 opix,updhdr, access,copy,delete,rename)
+
+
+The OPEN procedure opens or creates the indicated image in the named cluster.
+In the case of a new image or new copy image, only the header is created by
+the open call; the pixfile is not created until the OPIX routine is called,
+allowing the high level code time to set the image dimensions, datatype,
+number of groups, etc., in the image descriptor.  Once OPIX has been called
+to create a new group, the number of axes, size of each axis, pixel type,
+etc. is fixed.
+
+In the case of image stored in the SDAS/GEIS group format, all of the images
+in a cluster (group) must be of the same size, must have the same header
+parameters, and the header parameters must be defined when the group is
+created (new parameters or images cannot be added to the group later).
+The first open call for a image will allocate space for all images in the
+cluster, but only the indicated image will be initialized in the first call.
+Multiple images may be simultaneously open in the same cluster, and the same
+image may be multiply opened on independent logical FIO file descriptors.
+
+The high level IRAF software has little or no knowledge of the physical
+association of images into clusters.  In particular, the high level software
+is ignorant about the SDAS/GEIS image storage format, but this need not
+prevent processing of these images.  The main limitations of the group
+format derive from the fact that new images can neither be added to nor
+deleted from to a group format cluster, and new parameters cannot be added
+to a group header.  To create a group format image via IMIO, one will normally
+make a NEW_COPY copy of an existing group format image (to define the fields
+of the group headers), specifing the number of images in the new group in
+the cluster size field of the image name specification.  For example, writing
+to the new image "pix[3/10]" will cause a cluster of 10 images to be created
+and image 3 to be initialized.  Subsequent calls to write to either "pix[I]"
+or "pix[I/10]" will be necessary to initialize the remaining images in the
+cluster.
+
+
+5. KERNEL PROCEDURES
+
+    Each supported image format requires a dedicated set of kernel procedures
+to be called by the IKI to access images stored in that format.  The calling
+sequences for these procedures are shown below.
+
+
+               xxx_open (im, root, extn, cl_index, cl_size, acmode, status)
+              xxx_close (im, status)
+               xxx_opix (im, status)
+             xxx_updhdr (im, status)
+
+             xxx_access (root, extn, acmode, status)
+               xxx_copy (old_root, old_extn, new_root, new_extn, status)
+             xxx_delete (root, extn, status)
+             xxx_rename (old_root, old_extn, new_root, new_extn, status)
+
+
+Here, the package prefix "xxx" is OIF for the old IRAF image format, and STF
+for the STScI/SDAS GEIS format.  Note that the OPEN procedure fills in selected
+fields in a preallocated image descriptor rather than allocating the descriptor
+itself.  Image names are parsed into root, extension, cl_index, etc. fields by
+the IKI or higher level code, to further simplify the kernel code.  The IKI
+verifies the existence or nonexistence of all operand images before calling
+a kernel procedure, hence the kernel procedures need not perform these
+functions.  The kernel procedures should return an ERR status if they cannot
+perform their function for some reason (rather than take an error action).
+The locpr() entry point addresses of the kernel procedures are saved in a
+runtime table maintained by the IKI.
+
+The syntax and semantics of the kernel procedures are discussed in detail below.
+Since the interface routines have full access to the IMIO descriptors, it is
+important to realize what does and does not have to be set.
+
+
+5.1 IMAGE OPEN PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+include	"xxx.h"
+
+# XXX_OPEN -- Open/create an image.
+
+procedure oif_open (im, root, extn, cl_index, cl_size, acmode, status)
+
+pointer	im			# image descriptor (allocated by IMIO)
+char	root[ARB]		# root image name
+char	extn[ARB]		# extension, if any
+int	cl_index		# index of image to be opened
+int	cl_size			# number of images in cluster
+int	acmode			# access mode
+int	status			# return status (OK|ERR)
+
+begin
+	1.  Construct the filename of the header file and open or create the
+	    image header file.
+
+	2.  If opening an existing image, read the image header and fill in
+	    the following fields of the IMIO image header descriptor.  If
+	    creating a new image set only the field IM_HDRFILE.
+
+	    IM_PIXTYPE		# datatype of the pixels		**
+	    IM_NDIM		# number of dimensions			**
+	    IM_LEN		# length of the dimensions		**
+
+	    IM_CTIME		# time of image creation
+	    IM_MTIME		# time of last modify
+	    IM_LIMTIME		# time min,max computed
+	    IM_MAX		# max pixel value
+	    IM_MIN		# min pixel value
+	    IM_PIXFILE		# name of pixel storage file
+	    IM_HDRFILE		# name of header storage file
+	    IM_TITLE		# image name string
+	    IM_HISTORY		# history comment string
+
+	    The really essential fields are marked with a ** at the right.
+	    CTIME, PIXFILE, HDRFILE, TITLE, and HISTORY are for information
+	    only.  MTIME and LIMTIME are used to determine if the min/max
+	    pixel values are up to date, and the actual values do not matter
+	    provided the conclusion about the min/max values is correct.
+
+	3.  If opening an existing image, call IMIO to set those fields of the
+	    image header/descriptor describing the format in which the pixels
+	    are stored in the pixel storage file.
+
+		[] call imioff (im, pixoff, COMPRESS, blklen)
+
+	    where
+		    pixoff	FIO file offset of first pixel.
+		    compress	Set to NO to enable alignment of image
+				  lines on block boundaries, to YES for
+				  compressed byte stream image.
+		    blklen	Device block size, chars.  Set to 1 to
+				  defeat all block alignment.
+
+	    If opening a new image, this step may be left until the OPIX
+	    primitive is called.
+
+	3.  If the kernel procedures use their own internal descriptor,
+	    allocate and initialize the descriptor and save a pointer to
+	    it in IM_KDES(im).
+
+	4.  Set return status.
+end
+
+
+5.2  OPEN PIXEL FILE PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+include	"xxx.h"
+
+# XXX_OPIX -- Open (or create) the pixel storage file.  Call IMIO to set the
+# file offsets and buffer sizes. 
+
+procedure xxx_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+begin
+	1.  Opening existing image:
+	    1.1 Open pixel file read only or read write.
+
+	2.  Opening (creating) new image:
+	    2.1 Call IMIO to set the offset parameters, assuming this was not
+		already done in the OPEN primitive:
+
+		    [] call imioff (im, pixoff, COMPRESS, blklen)
+
+	    2.2 Using the file size computed by imioff or determined by more
+		format specific means, open (falloc) the pixel storage file.
+		The IM_HGMOFF field of the image header is set by imioff
+		to the file offset of the end of the image.
+
+	3.  Call IMIO to set the i/o buffer parameters:
+
+		    [] call imsetbuf (pfd, im)
+
+	    This sets the FIO buffer size and the IM_FAST parameter.
+	    The buffer size should be set before doing any i/o on the
+	    pixel file.  If in doubt, skip the call and simply set
+	    IM_FAST(im) = NO (i/o will be suboptimal but not too bad).
+
+	4.  Save the pixfile FIO file descriptor (required for pixel i/o)
+	    in the image descriptor:
+
+		    [] IM_PFD(im) = pfd
+end
+
+
+5.3  UPDATE HEADER PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+
+# XXX_UPDHDR -- Update the image header.
+
+procedure xxx_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+begin	
+	1.  Update the values of the standard logical image header fields
+	    in the physical image header, e.g., PIXTYPE, NDIM, LEN, and CTIME
+	    (for new images), MTIME, LIMTIME, MIN, MAX (any image).
+
+	2.  Save the "user fields" in the physical image header.  Some of
+	    these may have been inserted in the user area by the kernel open
+	    procedure, others may have been added by IRAF programs or by
+	    the user since the image was opened.
+end
+
+
+5.4  CLOSE IMAGE PRIMITIVE
+
+include <imio.h>
+
+# XXX_CLOSE -- Close an image.
+
+procedure xxx_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+begin
+	1.  If the pixel file has been opened, close it.  Note that if no
+	    pixel i/o was done to the image, the pixel file will never have
+	    been opened.
+
+	2.  If the header file is still open, close it.
+
+	3.  If a special kernel descriptor was allocated at image open time
+	    by the kernel, deallocate it.
+end
diff --git a/sys/imio/iki/fxf/Notes b/sys/imio/iki/fxf/Notes
new file mode 100644
index 00000000..2a2fd74d
--- /dev/null
+++ b/sys/imio/iki/fxf/Notes
@@ -0,0 +1,81 @@
+Fits kernel notes / unresolved issues
+----------------------------------------------------------------------------
+
+Extraneous env variables - put in fkinit
+
+    ENV_DEFIMTYPE   "imtype"
+    ENV_FITSCACHE   "fitscache"
+
+
+Rename
+
+    minhdrlns
+
+
+Cache
+
+    hard upper limit - is this a restriction?
+    convert from common to dynamic descriptor
+    referenced:  open delete rename rfits updhdr
+
+Extensions
+    should not use imtype to set extension (this is copied from STF which
+    also has the same problem)
+
+Defaults / ksection / fkinit
+    should overwrite be allowed in fkinit? (fxfopen)
+
+check on file clobber
+
+
+----------------------------------------------------------------------------
+Extension, default image type
+
+imtype
+    The purpose of imtype is to control the types of images automatically
+    created by the system if no image extension is specified.
+
+    new image - determines default image type
+    new copy  - determines default image type if noinherit 
+    no extn   - up to kernel whether this is legal
+
+    imtype = [(oif|fxf|plf|qpf|stf) | <any-valid-extn>] [[no]inherit]
+
+    save format codes ("oif" etc) in driver descriptors
+    extensions are mapped to drivers using imextn
+
+
+imextn
+    map file extensions to image type (kernel)
+    default extension for new images of a given type
+
+    imextn = "oif:imh stf:hhh,??h fits:,fits,fit
+
+    or possibly imextn = "imh:oif hhh,??h:stf fits,fit:fit
+
+    kernels:	oif fxf plf qpf stf
+
+	     iki_extninit (imtype, def_imtype, imextn, def_imextn)
+	    iki_validextn (kernel, extn)
+     status = iki_getextn (kernel, index, extn, maxch)
+
+    Initialize extension processing stuff at iki_init time - only once when
+    the process starts up.
+
+    nextn
+    { kernel extn patbuf }
+    sbuf, sbufused
+    defimtype
+    inherit
+
+IKI - add kernel arg to:
+    access
+    copy
+    delete
+    open
+    rename
+
+
+
+
+
diff --git a/sys/imio/iki/fxf/README b/sys/imio/iki/fxf/README
new file mode 100644
index 00000000..9c723b94
--- /dev/null
+++ b/sys/imio/iki/fxf/README
@@ -0,0 +1,5 @@
+# IKI/FXF -- Fits extension image kernel.
+# There is a document describing the differents FK supported parameters:
+#   iraf.noao.edu/iraf/web/docs/fitsuserguide.html
+# A PS file of this can be found in iraf.noao.edu/iraf/docs/fitsuserguide.ps.Z
+
diff --git a/sys/imio/iki/fxf/fxf.h b/sys/imio/iki/fxf/fxf.h
new file mode 100644
index 00000000..c4e6188b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxf.h
@@ -0,0 +1,172 @@
+# FITS.H -- IKI/FITS internal definitions.
+
+define	FITS_ORIGIN	"NOAO-IRAF FITS Image Kernel July 2003"
+
+define	FITS_LENEXTN	4		# max length imagefile extension
+define	SZ_DATATYPE	16		# size of datatype string (eg "REAL*4")
+define	SZ_EXTTYPE	20		# size of exttype string (eg BINTABLE)
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+define	DEF_PHULINES	0		# initial allocation for PHU
+define	DEF_EHULINES	0		# initial allocation for EHU
+define	DEF_PADLINES	0		# initial value for extra lines in HU
+define	DEF_PLMAXLEN	32768		# default max PLIO encoded line length
+define	DEF_PLDEPTH	0		# default PLIO mask depth
+
+define	FITS_BLOCK_BYTES 2880		# FITS logical block length (bytes)
+define	FITS_BLOCK_CHARS 1440		# FITS logical block length (spp chars)
+define	FITS_STARTVALUE 10		# first column of value field
+define	FITS_ENDVALUE	30		# last	column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	LEN_CARD	80		# length of FITS card.
+define	LEN_UACARD	81		# size of a Userarea line.
+define	LEN_OBJECT	63		# maximum length of a FITS string value
+define	LEN_FORMAT	40		# maximum length of a TFORM value
+define	NO_KEYW		-1		# indicates no keyword is present.
+
+define	MAX_OFFSETS	100		# max number of offsets per cache entry.
+define	MAX_CACHE	60		# max number of cache entries.
+define	DEF_CACHE	10		# default number of cache entries.
+
+define	DEF_HDREXTN	"fits"		# default header file extension
+define	ENV_FKINIT	"fkinit"	# FITS kernel initialization
+
+define	DEF_ISOCUTOVER	0		# date when ISO format dates kick in
+define	ENV_ISOCUTOVER	"isodates"	# environment override for default
+
+define	FITS_BYTE	8	# Bits in a FITS byte
+define	FITS_SHORT	16	# Bits in a FITS short
+define	FITS_LONG	32	# Bits in a FITS long
+define	FITS_REAL	-32	# 32 Bits FITS IEEE float representation
+define	FITS_DOUBLE	-64	# 64 Bits FITS IEEE double representation
+
+define	COL_VALUE	11	# Starting column for parameter values
+define	NDEC_REAL	7	# Precision of real
+define	NDEC_DOUBLE	14	# Precision of double
+
+define	FITS_LEN_CHAR	(((($1) + 1439)/1440)* 1440)
+
+# Extension subtypes.
+define	FK_PLIO		1
+
+# Mapping of FITS Keywords to IRAF image header.  All unrecognized keywords
+# are stored here.
+
+#define	UNKNOWN	 Memc[($1+IMU-1)*SZ_MII_INT+1]
+define	UNKNOWN	 Memc[($1+IMU-1)*SZ_STRUCT+1]
+
+
+# FITS image descriptor, used internally by the FITS kernel.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_FITDES	500
+define	LEN_FITBASE	400
+
+define	FIT_ACMODE	Memi[$1]	# image access mode
+define	FIT_PFD		Memi[$1+1]	# pixel file descriptor
+define	FIT_PIXOFF	Memi[$1+2]	# pixel offset
+define	FIT_TOTPIX	Memi[$1+3]	# size of image in pixfile, chars
+define	FIT_IO		Memi[$1+4]	# FITS I/O channel
+define	FIT_ZCNV	Memi[$1+5]	# set if on-the-fly conversion needed
+define	FIT_IOSTAT	Memi[$1+6]	# i/o status for zfio routines
+define  FIT_TFORMP      Memi[$1+7]      # TFORM keyword value pointer
+define  FIT_TTYPEP      Memi[$1+8]      # TTYPE keyword value pointer
+define  FIT_TFIELDS     Memi[$1+9]      # number of fields in binary table
+define  FIT_PCOUNT      Memi[$1+10]     # PCOUNT keyword value
+			# extra space
+define	FIT_BSCALE	Memd[P2D($1+16)]
+define	FIT_BZERO	Memd[P2D($1+18)]
+define	FIT_BITPIX	Memi[$1+20]	# bits per pixel
+define	FIT_NAXIS	Memi[$1+21]	# number of axes in image
+define	FIT_LENAXIS	Memi[$1+22+$2-1]# 35:41 = [7] max
+define	FIT_ZBYTES	Memi[$1+30]	# Status value for FIT_ZCNV mode
+define	FIT_HFD		Memi[$1+31]	# Header file descriptor
+define	FIT_PIXTYPE	Memi[$1+32]
+define	FIT_CACHEHDR	Memi[$1+33]	# Cached main header unit's address.
+define	FIT_CACHEHLEN	Memi[$1+34]	# Lenght of the above.
+define	FIT_IM		Memi[$1+35]	# Has the 'im' descriptor value 
+define	FIT_GROUP	Memi[$1+36]
+define	FIT_NEWIMAGE	Memi[$1+37]	# Newimage flag
+define	FIT_HDRPTR	Memi[$1+38]	# Header data Xtension pointer
+define	FIT_PIXPTR	Memi[$1+39]	# Pixel data Xtension pointer
+define	FIT_NUMOFFS	Memi[$1+40]	# Number of offsets in cache header.
+define	FIT_EOFSIZE	Memi[$1+41]	# Size in char of file before append.
+define	FIT_XTENSION	Memi[$1+42]	# Yes, if an Xtension has been read.
+define	FIT_INHERIT	Memi[$1+43]	# INHERIT header keyword value.
+define	FIT_EXTVER	Memi[$1+44]	# EXTVER value (integer only)
+define	FIT_EXPAND	Memi[$1+45]	# Expand the header?
+define	FIT_MIN		Memr[P2R($1+46)]# Minimum pixel value
+define	FIT_MAX		Memr[P2R($1+47)]# Maximum pixel value
+define	FIT_MTIME	Meml[$1+48]	# Time of last mod. for FITS unit 
+define	FIT_SVNANR	Memr[P2R($1+49)]
+define	FIT_SVNAND	Memd[P2D($1+50)]
+define	FIT_SVMAPRIN	Memi[$1+52]
+define	FIT_SVMAPROUT	Memi[$1+53]
+define	FIT_SVMAPDIN	Memi[$1+54]
+define	FIT_SVMAPDOUT	Memi[$1+55]
+define	FIT_EXTEND	Memi[$1+56]	# FITS extend keyword
+define	FIT_PLMAXLEN	Memi[$1+57]	# PLIO maximum linelen
+			# extra space
+define	FIT_EXTTYPE	Memc[P2C($1+70)]  # extension type
+define	FIT_FILENAME	Memc[P2C($1+110)] # FILENAME value 
+define	FIT_EXTNAME	Memc[P2C($1+150)] # EXTNAME value 
+define	FIT_DATATYPE	Memc[P2C($1+190)] # datatype string
+define	FIT_TITLE	Memc[P2C($1+230)] # title string
+define	FIT_OBJECT	Memc[P2C($1+270)] # object string
+define  FIT_EXTSTYPE    Memc[P2C($1+310)] # FITS extension subtype
+			# extra space
+
+# The FKS terms carry the fkinit or kernel section arguments.
+define	FKS_APPEND	Memi[$1+400]	# YES, NO append an extension
+define	FKS_INHERIT	Memi[$1+401]	# YES, NO inherit the main header
+define	FKS_OVERWRITE	Memi[$1+402]	# YES, NO overwrite an extension
+define	FKS_DUPNAME	Memi[$1+403]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXTVER	Memi[$1+404]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXPAND	Memi[$1+405]	# YES, NO expand the header
+define	FKS_PHULINES	Memi[$1+406]	# Allocated lines in PHU
+define	FKS_EHULINES	Memi[$1+407]	# Allocated lines in EHU
+define	FKS_PADLINES	Memi[$1+408]	# Additional lines for HU
+define	FKS_NEWFILE	Memi[$1+409]	# YES, NO force newfile
+define	FKS_CACHESIZE	Memi[$1+410]	# size of header cache
+define  FKS_SUBTYPE     Memi[$1+411]	# BINTABLE subtype
+define	FKS_EXTNAME	Memc[P2C($1+412)] # EXTNAME value
+			# extra space
+
+
+# Reserved FITS keywords known to this code.
+
+define	FK_KEYWORDS "|bitpix|datatype|end|naxis|naxisn|simple|bscale|bzero\
+|origin|iraf-tlm|filename|extend|irafname|irafmax|irafmin|datamax\
+|datamin|xtension|object|pcount|extname|extver|nextend|inherit\
+|zcmptype|tform|ttype|tfields|date|"
+
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_NAXIS	4
+define	KW_NAXISN	5
+define	KW_SIMPLE	6
+define	KW_BSCALE	7
+define	KW_BZERO	8
+define	KW_ORIGIN	9
+define	KW_IRAFTLM	10
+define	KW_FILENAME	11
+define	KW_EXTEND	12
+define	KW_IRAFNAME	13
+define	KW_IRAFMAX	14
+define	KW_IRAFMIN	15
+define	KW_DATAMAX	16
+define	KW_DATAMIN	17
+define	KW_XTENSION	18
+define	KW_OBJECT	19
+define	KW_PCOUNT	20
+define	KW_EXTNAME	21
+define	KW_EXTVER	22
+define	KW_NEXTEND	23
+define	KW_INHERIT	24
+define  KW_ZCMPTYPE     25
+define  KW_TFORM        26
+define  KW_TTYPE        27
+define  KW_TFIELDS      28
+define  KW_DATE         29
diff --git a/sys/imio/iki/fxf/fxfaccess.x b/sys/imio/iki/fxf/fxfaccess.x
new file mode 100644
index 00000000..860724f0
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfaccess.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fxf.h"
+
+
+# FXF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.  Returns status = YES or NO.
+
+procedure fxf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O status code
+
+int	i
+pointer	sp, fname, kextn
+int	access(), iki_validextn(), iki_getextn(), btoi()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (kextn, FITS_LENEXTN, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	status = NO
+
+	# If no extension was given, look for a file with the default
+	# extension, and return the actual extension if an image with the
+	# default extension is found.
+
+	if (extn[1] == EOS) {
+	    do i = 1, ARB {
+		if (iki_getextn (kernel, i, Memc[kextn], FITS_LENEXTN) <= 0)
+		    break
+		call iki_mkfname (root, Memc[kextn], Memc[fname], SZ_PATHNAME)
+		if (access (Memc[fname], acmode, 0) == YES) {
+		    call strcpy (Memc[kextn], extn, FITS_LENEXTN)
+		    status = YES
+		    break
+		}
+	    }		
+	} else if (iki_validextn (kernel, extn) == kernel) {
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	    if (access (Memc[fname], acmode, 0) == YES)
+		status = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfaddpar.x b/sys/imio/iki/fxf/fxfaddpar.x
new file mode 100644
index 00000000..ce7849f5
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfaddpar.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include "fxf.h"
+
+# FXF_ADDPAR -- Encode a parameter in FITS format and add it to the FITS format
+# IMIO userarea.
+
+procedure fxf_addpar (im, pname, dtype, pval)
+
+pointer	im			#I image descriptor
+char	pname[ARB]		#I parameter name
+int	dtype			#I SPP datatype of parameter
+char	pval[ARB]		#I string encoded parameter value
+
+bool	bval
+real	rval
+double	dval
+short	sval
+long	lval
+int	ival, ip, junk
+int	ctoi(), ctor(), ctod()
+errchk	imadds, imaddl, imaddr, imaddd, imastr
+
+begin
+	ip  = 1
+
+	switch (dtype) {
+	case TY_BOOL:
+	    bval = (pval[1] == 'T')
+	    call imaddb (im, pname, bval)
+	case TY_SHORT:
+	    junk = ctoi (pval, ip, ival)
+	    sval = ival
+	    call imadds (im, pname, sval)
+	case TY_INT, TY_LONG:
+	    junk = ctoi (pval, ip, ival)
+	    lval = ival
+	    call imaddl (im, pname, lval)
+	case TY_REAL:
+	    junk = ctor (pval, ip, rval)
+	    call imaddr (im, pname, rval)
+	case TY_DOUBLE:
+	    junk = ctod (pval, ip, dval)
+	    call imaddd (im, pname, dval)
+	default:
+	    call imastr (im, pname, pval)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfcache.com b/sys/imio/iki/fxf/fxfcache.com
new file mode 100644
index 00000000..c38317aa
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfcache.com
@@ -0,0 +1,24 @@
+# FXFCACHE.COM -- Named common block used to cache filenames and image
+# extension information.
+#
+# ##### This should be reimplemented to use a small package (i.e. functions)
+# ##### rather than global common.  rf_fname below is using a lot of memory.
+# ##### Dynamic memory allocation or a packed string buffer should be used
+# ##### instead.  Not worth fixing though until the cache code is redone.
+
+int	rf_cachesize
+pointer rf_fit[MAX_CACHE]		# FITS descriptor
+pointer rf_hdrp[MAX_CACHE]		# Fits headers pointer
+pointer rf_pixp[MAX_CACHE]		# Fits pixels pointer
+pointer rf_pextn[MAX_CACHE]		# EXTNAME pointer
+pointer rf_pextv[MAX_CACHE]		# EXTVER pointer
+int	rf_lru[MAX_CACHE]		# Lowest value is oldest slot
+long	rf_time[MAX_CACHE]		# Time when entry was cached
+long	rf_mtime[MAX_CACHE]		# Modify time of file in cache
+int	rf_hdr[MAX_CACHE]		# FITS Primary header data
+int	rf_fitslen[MAX_CACHE]		# Size Primary header data
+char	rf_fname[SZ_PATHNAME,MAX_CACHE] # Header file pathname
+
+common /fxflcachec/ rf_time, rf_mtime
+common /fxfcachec/ rf_cachesize, rf_fit, rf_hdrp, rf_pixp, rf_pextn,
+       rf_pextv, rf_lru, rf_hdr, rf_fitslen, rf_fname
diff --git a/sys/imio/iki/fxf/fxfclose.x b/sys/imio/iki/fxf/fxfclose.x
new file mode 100644
index 00000000..72313316
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfclose.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <imhdr.h>
+include <imio.h>
+include	"fxf.h"
+
+# FXF_CLOSE -- Close a FITS format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure fxf_close (im, status)
+
+pointer	im		#I image descriptor
+int	status		#O status value
+
+pointer fit
+errchk	close
+
+begin
+	fit = IM_KDES(im)
+
+	# Reset the IEEE interface to its original state.
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY:
+	    call ieesnanr (FIT_SVNANR(fit))
+	    call ieesmapr (FIT_SVMAPRIN(fit), FIT_SVMAPROUT(fit))
+	    call ieesnand (FIT_SVNAND(fit))
+	    call ieesmapd (FIT_SVMAPDIN(fit), FIT_SVMAPDOUT(fit))
+	default:
+	    ;
+	}
+
+	# Close the fits file.
+	if (IM_PFD(im) != NULL) 
+	    call close (IM_PFD(im))
+	
+	# Deallocate the FIT descriptor.
+	call mfree (fit, TY_STRUCT)
+
+	status = OK
+end
diff --git a/sys/imio/iki/fxf/fxfcopy.x b/sys/imio/iki/fxf/fxfcopy.x
new file mode 100644
index 00000000..3fb4d51b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfcopy.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<error.h>
+
+# FXF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure fxf_copy (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		#I old image root name
+char	oextn[ARB]		#I old image extn
+char	nroot[ARB]		#I new image root name
+char	nextn[ARB]		#I old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, nhdr_fname
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	iferr (call fcopy (Memc[ohdr_fname], Memc[nhdr_fname]))
+	    call erract (EA_WARN)
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/fxf/fxfctype.x b/sys/imio/iki/fxf/fxfctype.x
new file mode 100644
index 00000000..f916e344
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfctype.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<ctype.h>
+include	"fxf.h"
+
+
+# FXF_CTYPE -- Determine the type of a FITS card. 
+
+int procedure fxf_ctype (card, kwindex)
+
+char	card[ARB]			#I FITS card (or keyword)
+int	kwindex				#O index number, if any
+
+pointer sp, kwname
+char	kw[SZ_KEYWORD]
+int	index, ch, i, ip
+int	strncmp(), strdic(), strlen(), ctoi()
+string  keywords FK_KEYWORDS
+
+begin
+	call smark (sp)
+	call salloc (kwname, LEN_CARD, TY_CHAR)
+
+	# Check for a reference to one of the NAXIS keywords.
+	kwindex= 0
+	if (card[1] == 'N')
+	    if (strncmp (card, "NAXIS", 5) == 0) {
+		ch = card[6]
+		if (ch == EOS || (IS_DIGIT(ch) && card[7] == ' ')) {
+		    kwindex = TO_INTEG(ch)
+		}
+		call sfree (sp)
+		return (KW_NAXIS)
+	    }
+
+	# See if it is one of the "T"-prefixed (binary table) keywords.
+	if (card[1] == 'T') {
+	    ip = 6
+	    if (strncmp (card, "TFORM", 5) == 0) {
+		if (ctoi (card, ip,  kwindex) < 1)
+		    kwindex = 0
+		call sfree (sp)
+		return (KW_TFORM)
+	    }
+	    if (strncmp (card, "TTYPE", 5) == 0) {
+		if (ctoi (card, ip,  kwindex) < 1)
+		    kwindex = 0
+		call sfree (sp)
+		return (KW_TTYPE)
+	    }
+	}
+
+	# Get keyword name in lower case with no blanks. 
+        do i = 1, SZ_KEYWORD {
+	    if (IS_WHITE(card[i])) {
+		kw[i] = EOS
+		break
+	    } else if (IS_UPPER(card[i]))
+		kw[i] = TO_LOWER (card[i])
+	    else
+		kw[i] = card[i]
+	}
+
+	# Look up keyword in dictionary.  Abbreviations are not permitted.
+	index = strdic (kw, Memc[kwname], LEN_CARD, keywords)
+	if (index != 0)
+	    if (strlen(kw) != strlen(Memc[kwname]))
+		index = 0
+
+	call sfree (sp)
+	return (index)
+end
diff --git a/sys/imio/iki/fxf/fxfdelete.x b/sys/imio/iki/fxf/fxfdelete.x
new file mode 100644
index 00000000..ae7fbffc
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfdelete.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include "fxf.h"
+
+# FXF_DELETE -- Delete a FITS file.  NOTE: it is not possible to delete an
+# individual extension at this time.
+
+procedure fxf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I header file extension
+int	status			#O status value
+
+int	cindx
+pointer	sp, fname, im, tmp
+pointer	immapz()
+bool    streq()
+
+errchk  syserrs
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+        call salloc (tmp, SZ_PATHNAME, TY_CHAR)
+
+	call fxf_init()
+	status = OK
+
+	# Get the file extension if not given.
+        if (extn[1] == EOS) {
+	    call fxf_access (kernel, root, extn, READ_ONLY, status)
+	    if (status == NO) {
+		call sfree (sp)
+		status = ERR
+		return
+	    }
+	}
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call strcpy (Memc[fname], Memc[tmp], SZ_PATHNAME)
+	call strcat ("[0]", Memc[tmp], SZ_PATHNAME)
+	iferr (im = immapz (Memc[tmp], READ_ONLY, 0))
+	    call syserrs (SYS_FXFDELMEF, Memc[fname])
+	else
+	    call imunmap (im)
+
+	iferr (call delete (Memc[fname]))
+	    call erract (EA_WARN)
+
+	# Remove the image from the FITS cache if found.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+	    if (streq (Memc[fname], rf_fname[1,cindx])) {
+		call mfree (rf_pextv[cindx], TY_INT)
+		call mfree (rf_pextn[cindx], TY_CHAR)
+		call mfree (rf_pixp[cindx], TY_INT)
+		call mfree (rf_hdrp[cindx], TY_INT)
+		call mfree (rf_fit[cindx], TY_STRUCT)
+		call mfree (rf_hdr[cindx], TY_CHAR)
+		rf_fit[cindx] = NULL
+		rf_lru[cindx] = 0
+		rf_fname[1,cindx] = EOS
+	    }
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfencode.x b/sys/imio/iki/fxf/fxfencode.x
new file mode 100644
index 00000000..ea2e83dd
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfencode.x
@@ -0,0 +1,348 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <time.h>
+include "fxf.h"
+
+# FXFENCODE.X -- Routines to encode a keyword, its value and a comment into
+# a FITS card.
+#
+#	fxf_encode_axis (root, keyword, axisno)
+#	fxf_encode_date (ctime, datestr, szdate, format, cutover)
+#
+#	    fxf_encodeb (keyword, param, card, comment)
+#	    fxf_encodei (keyword, param, card, comment)
+#	    fxf_encodel (keyword, param, card, comment)
+#	    fxf_encoder (keyword, param, card, comment, precision)
+#	    fxf_encoded (keyword, param, card, comment, precision)
+#	    fxf_encodec (keyword, param, maxch, card, comment)
+#
+#	       fxf_akwc (keyword, value, len, comment, pn)
+#	       fxf_akwb (keyword, value, comment, pn)
+#	       fxf_akwi (keyword, value, comment, pn)
+#	       fxf_akwr (keyword, value, comment, precision, pn)
+#	       fxf_akwd (keyword, value, comment, precision, pn)
+#
+# Encode_axis adds an axis number to a keyword ("rootXXX").  Encode_date
+# encodes the current date as a string in the form "dd/mm/yy".
+
+
+# FXF_ENCODEB -- Encode a boolean parameter into a FITS card.
+
+procedure fxf_encodeb (keyword, param, card, comment)
+
+char	keyword[ARB]	# FITS keyword
+int	param		# integer parameter equal to YES/NO
+char	card[ARB]	# FITS card image
+char	comment[ARB]	# FITS comment string
+
+char	truth
+
+begin
+	if (param == YES)
+	    truth = 'T'
+	else
+	    truth = 'F'
+
+	call sprintf (card, LEN_CARD, "%-8.8s= %20c / %-47.47s")
+	    call pargstr (keyword)
+	    call pargc (truth)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODEI -- Encode an integer parameter into a FITS card.
+
+procedure fxf_encodei (keyword, param, card, comment)
+
+char	keyword[ARB]	# FITS keyword
+int	param		# integer parameter
+char	card[ARB]	# FITS card image
+char	comment[ARB]	# FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODEL -- Encode a long parameter into a FITS card.
+
+procedure fxf_encodel (keyword, param, card, comment)
+
+char	keyword[ARB]		# FITS keyword
+long	param			# long integer parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargl (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODER -- Encode a real parameter into a FITS card.
+
+procedure fxf_encoder (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		# FITS keyword
+real	param			# real parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment card
+int	precision		# precision of real
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargr (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODED -- Encode a double parameter into a FITS card.
+
+procedure fxf_encoded (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		# FITS keyword
+double	param			# double parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment string
+int	precision		# FITS precision
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargd (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODE_AXIS -- Add the axis number to axis dependent keywords.
+
+procedure fxf_encode_axis (root, keyword, axisno)
+
+char	root[ARB]		# FITS root keyword
+char	keyword[ARB]		# FITS keyword
+int	axisno			# FITS axis number
+
+int	len, strlen()
+
+begin
+	call strcpy (root, keyword, SZ_KEYWORD)
+	len = strlen (keyword)
+	call sprintf (keyword, SZ_KEYWORD, "%*.*s%d")
+	    call pargi (-len)
+	    call pargi (len)
+	    call pargstr (root)
+	    call pargi (axisno)
+end
+
+
+# FXF_ENCODEC -- Procedure to encode an IRAF string parameter into a FITS card.
+
+procedure fxf_encodec (keyword, param, maxch, card, comment)
+
+char	keyword[LEN_CARD]	# FITS keyword
+char	param[LEN_CARD]		# FITS string parameter
+int	maxch			# maximum chars in value string
+char	card[LEN_CARD+1]	# FITS card image
+char	comment[LEN_CARD]	# comment string
+
+int	nblanks, maxchar, slashp
+
+begin
+	maxchar = max(8, min (maxch, LEN_OBJECT))
+	slashp = 32 
+	nblanks = LEN_CARD - (slashp + 1)
+	if (maxchar >= 19) {
+	   slashp = 1
+	   nblanks = max (LEN_OBJECT - maxchar - slashp+3, 1)
+	}
+
+	call sprintf (card, LEN_CARD, "%-8.8s= '%*.*s' %*t/ %*.*s")
+	    call pargstr (keyword)
+	    call pargi (-maxchar)
+	    call pargi (maxchar)
+	    call pargstr (param)
+	    call pargi (slashp)
+	    call pargi (-nblanks)
+	    call pargi (nblanks)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODE_DATE -- Encode the current date as a string value.
+#
+# New Y2K format:	yyyy-mm-ddThh:mm:sec
+# Old FITS format:	dd/mm/yy
+# Old TLM format:	hh:mm:ss (dd/mm/yyyy)
+#
+# We still write the old format for dates 1999 or less.
+
+procedure fxf_encode_date (ctime, datestr, maxch, format, cutover)
+
+long	ctime			#I time value to be encoded
+char	datestr[ARB]		#O string containing the date
+int	maxch			#I number of chars in the date string
+char	format[ARB]		#I desired date format for old dates
+int	cutover			#I write new format for years >= cutover
+
+int	tm[LEN_TMSTRUCT], nchars
+int	dtm_encode_hms()
+long	lsttogmt()
+bool	streq()
+
+begin
+	# Find out what year it is.
+	call brktime (ctime, tm)
+
+	# Encode in ISO format for years >= cutover year.
+
+	if (TM_YEAR(tm) >= cutover) {
+	    # ISO format is used for all new date stamps.
+	    call brktime (lsttogmt(ctime), tm)
+	    nchars = dtm_encode_hms (datestr, maxch,
+		TM_YEAR(tm), TM_MONTH(tm), TM_MDAY(tm),
+		TM_HOUR(tm), TM_MIN(tm), double(TM_SEC(tm)), 0, 0)
+
+	} else if (streq (format, "TLM")) {
+	    # TLM format is for old-format DATE-TLM keywords.
+	    call sprintf (datestr, maxch, "%02d:%02d:%02d (%02d/%02d/%d)")
+		call pargi (TM_HOUR(tm))
+		call pargi (TM_MIN(tm))
+		call pargi (TM_SEC(tm))
+		call pargi (TM_MDAY(tm))
+		call pargi (TM_MONTH(tm))
+		call pargi (TM_YEAR(tm))
+
+	} else {
+	    # The default otherwise is the old FITS format.
+	    call sprintf (datestr, maxch, "%02d/%02d/%02d")
+		call pargi (TM_MDAY(tm))
+		call pargi (TM_MONTH(tm))
+		call pargi (mod(TM_YEAR(tm),100))
+
+	}
+end
+
+
+# FXF_AKWC -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwc (keyword, value, len, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# keyword name
+char	value[ARB]		# keyword value
+int	len			# length of value
+char	comment[ARB]		# comment
+pointer pn			# pointer to a char area
+char	card[LEN_CARD]
+
+begin
+	call fxf_encodec (keyword, value, len, card, comment)
+	call amovc (card, Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+end
+
+
+# FXF_AKWB -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwb (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value (YES, NO)
+char	comment[ARB]		# I Comment
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encodeb (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWI -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwi (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encodei (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWR -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwr (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+real	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encoder (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWD -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwd (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+double	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encoded (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfexpandh.x b/sys/imio/iki/fxf/fxfexpandh.x
new file mode 100644
index 00000000..9e00d582
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfexpandh.x
@@ -0,0 +1,375 @@
+include <imio.h>
+include <imhdr.h>
+include <mii.h>
+include <fset.h>
+include <mach.h>
+include <syserr.h>
+include "fxf.h"
+
+define MIN_BUFSIZE     2880
+
+
+# FXF_EXPANDH -- Routine to expand all the headers of a MEF file. The calling
+# routine only requires that extension 'group' be expanded but when dealing
+# with large MEF files with many extensions this procedure can take a long
+# time if the application code wants to expand more than one header.
+# fxf_expandh will expand all the headers in the file so they will have at 
+# least 'nlines' blank cards.
+
+procedure fxf_expandh (in_fd, out_fd, nlines, group, nbks, hdroff, pixoff)
+
+int	in_fd		#I input file descriptor
+int	out_fd		#I output file descriptor
+int	nlines		#I minimum number of blank cards
+int	group		#I group that initiated the expansion
+int	nbks		#I numbers of blocks to expand group 'group'
+int	hdroff		#O new offset for beginning of 'group' 
+int	pixoff		#0 new offset for beginning of data
+
+pointer hd, ip, op, buf
+char	line[80], endl[80]
+int	gn, newc, k, nchars, nbk, hsize
+int	fxf_xaddl(), read()
+
+int	bufsize, psize, rem, hoffset, poffset
+int	note(), fstati()
+errchk	malloc, read, write
+
+begin
+	# In case nlines is zero set a minimum > 0.
+	nlines = max (nlines, 10)
+
+	# Initialize a blank line.
+	call amovks (" ", line, LEN_CARD)
+
+	# Initialize END card image.
+	call amovc ("END", endl, 3)
+	call amovks (" ", endl[4], LEN_CARD-3)
+
+	call fseti (in_fd, F_ADVICE, SEQUENTIAL)
+	call fseti (out_fd, F_ADVICE, SEQUENTIAL)
+
+	bufsize = max (MIN_BUFSIZE, fstati (in_fd, F_BUFSIZE))
+	call malloc (buf, bufsize, TY_CHAR)
+
+	gn = 0
+	hd = buf
+
+	repeat { 
+	    hd = buf
+	    if (group == gn) 
+	        hdroff = note(out_fd)
+
+	    # Read and write header information. The last block must 
+	    # have the END card and is output from this routine.
+
+	    iferr (call fxf_xhrd (in_fd, out_fd, Memc[buf], bufsize, hoffset, 
+		poffset, hsize))
+		    break
+	    
+	    # Determine the number of cards to expand. newc is in blocks
+	    # of 36 cards. 0, 36, 72, ...
+
+	    newc = fxf_xaddl (buf, hsize, nlines)
+
+	    # expand the given group at least one block
+	    if (newc == 0 && nbks > 0 && group == gn)
+		newc = nbks * 36
+
+	    # OP points to the top of the last block read, IP to the bottom.
+	    op = buf + hsize - FITS_BLOCK_BYTES
+	    ip = buf + hsize
+
+	    if (newc == 0) {
+		# Leave space for the END card.
+	        ip = ip - 80
+	    } else {
+	        # Write current buffer before writing blanks.
+		call miipak (Memc[op], Memc[op], FITS_BLOCK_BYTES, 
+		    TY_CHAR,MII_BYTE)
+		call write (out_fd, Memc[op], FITS_BLOCK_CHARS)
+
+		# Use the same buffer space since we are using blanks
+		ip = ip - FITS_BLOCK_BYTES
+		op = ip
+	    }
+
+	    # Write the blank cards.
+	    do k = 1, newc-1 {
+	        call amovc (line, Memc[ip], LEN_CARD)
+	        ip = ip + LEN_CARD
+		if (mod (k,36) == 0) {
+		    # We have more than one block of blanks.
+		    call miipak (Memc[op], Memc[op], nchars, TY_CHAR, MII_BYTE)
+		    call write (out_fd, Memc[op], FITS_BLOCK_CHARS)
+
+		    # Notice we used the same buffer space
+		    ip = ip - FITS_BLOCK_BYTES
+		    op = ip
+	        }
+	    }
+	    
+	    # Finally the END card.
+	    call amovc (endl, Memc[ip], LEN_CARD)
+	    nchars = 2880
+	    call miipak (Memc[op], Memc[op], nchars, TY_CHAR, MII_BYTE)
+	    call write (out_fd, Memc[op], nchars/2)
+
+	    # Get the number of blocks of pixel data to copy.  We are not
+	    # changing anything; it is straight copy.
+
+	    psize = (hoffset - poffset)
+
+	    nbk = psize / bufsize
+	    rem = mod(psize,bufsize)
+
+            if (group == gn)
+		pixoff = note(out_fd)
+
+	    do k = 1, nbk {
+		nchars = read (in_fd, Memc[buf], bufsize)
+		call write (out_fd, Memc[buf], bufsize)
+	    }
+	    if (rem > 0) {
+		nchars = read (in_fd, Memc[buf], rem)
+		call write (out_fd, Memc[buf], rem)
+	    }
+	    gn = gn + 1
+	}
+ 
+	call mfree (buf, TY_CHAR)
+end
+
+
+# FXF_XHRD -- Procedure to read 2880 bytes blocks of header from 'in'
+# and copy them to 'out'.  The last block read contains the END card
+# and is pass to the calling routine which will write it out to 'out.
+
+procedure fxf_xhrd (in, out, buf, bufsize, hoffset, poffset, hsize)
+
+int	in		#I Input file descriptor
+int	out		#I output file descriptor
+char	buf[ARB]	#I Working buffer
+int	bufsize		#I Workign buffer size
+int	hoffset		#O Header offset for next group
+int	poffset		#O Data offset for current group
+int	hsize		#O Number of cards read in header
+
+pointer	sp, hb
+int	nblks, totpix, i, j, ip, nchars
+int	strncmp(), note(), read()
+bool	end_card, fxf_xn_decode_blk1()
+
+include "fxfcache.com"
+errchk  syserr, read, write
+
+begin
+	call smark (sp)
+	call salloc (hb, 1440, TY_CHAR)
+
+	hoffset = note (in)
+
+	# Read first block of header.
+	nchars = read (in, Memc[hb], FITS_BLOCK_CHARS)
+	if (nchars == EOF) {
+	    call sfree (sp)
+	    call syserr (SYS_FXFRFEOF)
+	}
+
+	call miiupk (Memc[hb], buf, FITS_BLOCK_BYTES, MII_BYTE,TY_CHAR)
+	end_card = fxf_xn_decode_blk1 (buf, totpix)
+	if (!end_card) {
+	    call miipak (buf, Memc[hb], FITS_BLOCK_BYTES, TY_CHAR, MII_BYTE)
+	    call write (out, Memc[hb], FITS_BLOCK_CHARS)
+	}
+	ip = FITS_BLOCK_BYTES + 1
+
+	nblks = 1
+	if (!end_card) {
+	    # Continue reading header until the block with END
+	    # which is the last before the data block.
+
+	    while (read (in, Memc[hb], FITS_BLOCK_CHARS) != EOF) {
+	        call miiupk (Memc[hb], buf[ip], FITS_BLOCK_BYTES,
+		    MII_BYTE,TY_CHAR)
+
+		# Look for the END card
+		do i = 0, 35 {
+		   j = ip + i*LEN_CARD
+		   if (buf[j] == 'E') {
+		       if (strncmp (buf[j], "END     ", 8) == 0)
+			   end_card = true
+		   }
+		}
+	        nblks = nblks + 1
+		if (end_card)
+		    break
+	        call miipak (buf[ip], Memc[hb], FITS_BLOCK_BYTES, 
+		    TY_CHAR, MII_BYTE)
+		call write (out, Memc[hb], FITS_BLOCK_CHARS)
+	        ip = ip + FITS_BLOCK_BYTES
+
+		# If the header is really big we can run out of
+		# buffer space. Revert back to the beginning.
+
+		if (ip > bufsize) {
+		    ip = 1
+		    nblks = 1
+		}
+	    }
+	}
+
+	hsize = nblks * 36 * LEN_CARD
+
+	# We are at the beginning of the pixel area.
+	poffset = note (in)
+	
+	# Get the beginnning of the next header.
+	hoffset = poffset + totpix
+
+	call sfree (sp)
+end
+
+
+# FXF_XN_DECODE_BLK1 -- Function that return true if the 1st block of a header
+# contains the END card. The size of the pixel are is also returned.
+
+bool procedure fxf_xn_decode_blk1 (buf, datalen)
+
+char	buf[ARB]		#I header data buffer
+int	datalen			#O length of data area in chars
+
+char	card[LEN_CARD]
+int	totpix, nbytes, index, k, i, pcount, bitpix, naxis, ip
+int	len_axis[7]
+int	fxf_ctype()
+bool	end_card
+errchk	syserr, syserrs
+
+begin
+	# Read successive lines of the 1st header block
+	pcount = 0
+
+	end_card = false
+	do k = 0, 35 {
+	    ip = k*LEN_CARD + 1
+	    
+	    # Copy into a one line buffer, we need to EOS mark.
+	    call strcpy (buf[ip], card, LEN_CARD)
+	    switch (fxf_ctype (card, index)) {
+	    case KW_END:
+		end_card = true
+		break
+	    case KW_PCOUNT:
+		call fxf_geti (card, pcount)
+	    case KW_BITPIX:
+		call fxf_geti (card, bitpix)
+	    case KW_NAXIS:
+		if (index == 0) {
+		    call fxf_geti (card, naxis)
+		    if (naxis < 0 )
+			call syserr (SYS_FXFRFBNAXIS)
+	  	} else
+		    call fxf_geti (card, len_axis[index])
+	    default:
+	        ;
+	    }
+	}
+
+	# Calculate the length of the data area of the current extension,
+	# measured in SPP chars and rounded up to an integral number of FITS
+	# logical blocks.
+
+	if (naxis != 0) {
+	    totpix =  len_axis[1]
+	    do i = 2, naxis
+		totpix = totpix * len_axis[i]
+
+	    # Compute the size of the data area (pixel matrix plus PCOUNT)
+	    # in bytes.  Be careful not to overflow a 32 bit integer.
+
+	    nbytes = (totpix + pcount) * (abs(bitpix) / NBITS_BYTE)
+
+	    # Round up to fill the final 2880 byte FITS logical block.
+	    nbytes = ((nbytes + 2880-1) / 2880) * 2880
+
+	    datalen = nbytes / SZB_CHAR
+
+	} else
+	    datalen = 0
+
+	return (end_card)
+end
+
+
+# FXF_XADDL -- Algorithm to find the number of blank cards stored in the
+# input buffer.  This is the number from the end of the buffer up to the
+# last non blank card (excluding the END card).  The function returns the
+# number of extra header cards (in multiple of 36) that is necessary to 
+# add to the current header.
+
+int procedure fxf_xaddl (hd, ncua, nlines)
+
+pointer hd		#U header area pointer
+int	ncua		#I number of characters in the user area
+int	nlines		#I minimum number of header lines to be added 
+
+int	ip, nbc, k, ncards, nkeyw
+int	strncmp()
+
+begin
+	# Go to the end of buffer and get last line pointer
+	ip = hd + ncua - LEN_CARD
+	
+	# See if line is blank.
+	nbc = 0
+	while (ip > hd) {
+	    # Check for nonblank card
+	    do k = 0, LEN_CARD-1 
+		if (Memc[ip+k] != ' ')
+		    break
+
+	    # Since we are counting from the bottom, the first keyword
+	    # (except END) would end counting.
+
+	    if (k != LEN_CARD && k != 0)   # nonblank keyw card reached
+		break
+	    else if (k == 0) {
+		# Just bypass END and continue looking for blank cards
+		if (strncmp ("END     ", Memc[ip], 8) == 0) {
+		    # Clear this card as it will be written at the 
+		    # end of the output header.
+		    call amovkc (" ", Memc[ip], LEN_CARD)
+	    	    ip = ip - LEN_CARD
+		    next
+		} else
+		    break
+	    } else
+		nbc = nbc + 1
+	    ip = ip - LEN_CARD
+	}
+
+	# Calculate the number of keywords right before the last blank
+	# card and right after the last non-blank keyword, excluding the
+	# END card
+
+	nkeyw = (ip-hd)/80 + 1
+
+	ncards = ncua / LEN_CARD
+
+	# Calculate the complement with respect to 36
+	ncards = ((ncards + 35)/36)*36 - ncards
+	nbc = nbc + ncards
+
+
+	if (nbc < nlines) {
+	    # Lets add nlines-nbc cards to the header
+	    ncards = nlines - nbc
+
+	    # Adjust to a 36 cards boundary.
+	    ncards = 36 - mod (ncards, 36) + ncards
+	} else
+	    ncards = 0
+
+	return (ncards)
+end
diff --git a/sys/imio/iki/fxf/fxfget.x b/sys/imio/iki/fxf/fxfget.x
new file mode 100644
index 00000000..87b80d4f
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfget.x
@@ -0,0 +1,182 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<ctype.h>
+include	"fxf.h"
+
+# FXFGET.X -- Procedures used to get (decode) typed values from FITS cards.
+#
+#	  fxf_get[bird] (card, value)
+#	       fxf_gstr (card, outstr, maxch)
+#	     fxf_getcmt (card, comment, maxch)
+#	       fxf_gltm (time, date, limtime)
+#
+# The value is returned in the output argument.  Zero is returned if the
+# conversion fails.
+
+
+# FXF_GETI -- Return the integer value of a FITS encoded card.
+
+procedure fxf_geti (card, ival)
+
+char	card[ARB]		# card to be decoded
+int	ival			# receives integer value
+
+int	ip, ctoi()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# FXF_GETR -- Return the real value of a FITS encoded card.
+
+procedure fxf_getr (card, rval)
+
+char	card[ARB]		# card to be decoded
+real	rval			# receives integer value
+
+int	ip, ctor()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctor (sval, ip, rval) <= 0)
+	    rval = 0.0
+end
+
+
+# FXF_GETD -- Return the double value of a FITS encoded card.
+
+procedure fxf_getd (card, dval)
+
+char	card[ARB]		# card to be decoded
+double	dval			# receives integer value
+
+int	ip, ctod()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctod (sval, ip, dval) <= 0)
+	    dval = 0.0
+end
+
+
+# FXF_GETB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure fxf_getb (card, bval)
+
+char	card[ARB]		# card to be decoded
+int	bval			# receives YES/NO
+
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# FXF_GSTR -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure fxf_gstr (card, outstr, maxch)
+
+char	card[ARB]		# FITS card to be decoded
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# FXF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure fxf_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
+
+
+# FXF_GLTM -- Procedure to convert an input time stream with hh:mm:ss
+# and date stream dd/mm/yy into seconds from jan 1st 1980.
+
+procedure fxf_gltm (time, date, limtime)
+
+char    time[ARB], date[ARB]
+int	limtime
+
+int	month_to_days[12], adays
+int     hr,mn,sec,days,month,year, ip, iy, days_per_year, ctoi(), i
+data    month_to_days / 0,31,59,90,120,151,181,212,243,273,304,334/
+
+begin
+
+	ip = 1;  ip = ctoi (time, ip, hr)
+	ip = 1;  ip = ctoi (time[4], ip, mn)
+	ip = 1;  ip = ctoi (time[7], ip, sec)
+
+	sec = sec + mn * 60 + hr * 3600
+
+	ip = 1;  ip = ctoi (date, ip, days)
+	ip = 1;  ip = ctoi (date[4], ip, month)
+	ip = 1;  ip = ctoi (date[7], ip, year)
+
+	days_per_year = 0
+	iy = year + 1900
+	do i = 1, iy - 1980
+	   days_per_year = days_per_year + 365
+
+	adays = (year - 80) / 4
+	if (month > 2)
+	    adays = adays + 1
+
+	days = adays + days-1 + days_per_year + month_to_days[month]
+	limtime = sec + days * 86400
+end
diff --git a/sys/imio/iki/fxf/fxfhextn.x b/sys/imio/iki/fxf/fxfhextn.x
new file mode 100644
index 00000000..7f8a879d
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfhextn.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <imhdr.h>
+include <imio.h>
+include	"fxf.h"
+
+
+# FXF_GETHDREXTN -- Get the default header file extension.
+
+procedure fxf_gethdrextn (im, o_im, acmode, outstr, maxch)
+
+pointer im, o_im		#I image descriptors
+int	acmode			#I image access mode
+char	outstr[ARB]		#O receives header extension
+int	maxch			#I max chars out
+
+bool	inherit
+int	kernel, old_kernel
+int	fnextn(), iki_getextn(), iki_getpar()
+
+begin
+	# Use the same extension as the input file if this is a new copy
+	# image of the same type as the input and inherit is enabled.
+	# If we have to get the extension using iki_getextn, the default
+	# extension for a new image is the first extension defined (index=1).
+
+	kernel = IM_KERNEL(im)
+
+	old_kernel = 0
+	if (acmode == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	inherit = (iki_getpar ("inherit") == YES)
+	if (inherit && acmode == NEW_COPY && kernel == old_kernel) {
+	    if (fnextn (IM_HDRFILE(im), outstr, maxch) <= 0)
+		call strcpy (DEF_HDREXTN, outstr, maxch)
+	} else if (iki_getextn (kernel, 1, outstr, maxch) < 0)
+	    call strcpy (DEF_HDREXTN, outstr, maxch)
+end
diff --git a/sys/imio/iki/fxf/fxfksection.x b/sys/imio/iki/fxf/fxfksection.x
new file mode 100644
index 00000000..cb37b4e5
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfksection.x
@@ -0,0 +1,475 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include <ctotok.h>
+include <lexnum.h>
+include <imhdr.h>
+include "fxf.h"
+
+# FXFKSECTION.X -- Routines to parse the FITS kernel section into 
+# parameter names and values.
+
+define	KS_EXTNAME	1
+define	KS_EXTVER	2
+define	KS_APPEND	3
+define	KS_NOAPPEND	4
+define	KS_OVERWRITE	5
+define	KS_DUPNAME	6
+define	KS_INHERIT	7
+define	KS_NOINHERIT    8 
+define	KS_NODUPNAME	9
+define	KS_NOOVERWRITE	10
+define	KS_EXPAND	11
+define	KS_PHULINES	12
+define	KS_EHULINES	13
+define	KS_PADLINES	14
+define	KS_NOEXPAND	15
+define	KS_CACHESIZE	16
+define	KS_TYPE		17
+define	ERROR           -2
+
+
+# FXF_KSECTION -- Procedure to parse and analyze a string of the form:
+#
+#     "keyword=value,keyword+,keyword-,..."
+# e.g.,
+#     "[extname=]name,[extver=]23,append,inherit+,overwrite+,dupname-"
+#
+# The 'extver' numeric field is position dependent if it does not have
+# the parameter name.  The 'group' output variable is not -1 when specified
+# as the 1st number in the section.
+
+procedure fxf_ksection (ksection, fit, group)
+
+char 	ksection[ARB]		#I String with kernel section
+pointer fit			#I Fits structure pointer
+int	group			#O Extension number
+
+bool    extn
+char    outstr[LEN_CARD]
+char 	identif[LEN_CARD]
+int     ip, jp, nident, nexpr, junk, nch, ty, token, ival
+int	lex_type, fxf_ks_lex(), ctoi(), ctotok(), lexnum()
+errchk	syserr, syserrs
+
+begin
+       # The default values should have been already initialized 
+       # with a call fxf_ksinit().
+
+       ip = 1
+       nexpr = 0
+       nident = 0
+       extn = false
+       group = -1
+       identif[1] = EOS
+
+       repeat {
+	   # Advance to the next keyword.
+	   token = ctotok (ksection, ip, outstr, LEN_CARD)
+
+	   switch (token) {
+	   case TOK_EOS:
+	       break
+	   case TOK_NEWLINE:
+	       break
+
+	   case TOK_NUMBER:
+	       if (nexpr != 1 && nexpr != 2 && extn) 
+		   call syserr (SYS_FXFKSNV)
+	       jp = 1
+	       ty = lexnum (outstr, jp, nch)
+	       if (ty != LEX_DECIMAL)
+		   call syserr (SYS_FXFKSNDEC)
+	       jp = 1
+	       junk = ctoi (outstr, jp, ival)
+	       if (nexpr == 0) {
+		   group = ival
+		   identif[1] = 1
+	       } else
+	           FKS_EXTVER(fit) = ival
+	       nexpr = nexpr + 1
+
+	   case TOK_PUNCTUATION:
+	       if (outstr[1] == ',' && identif[1] == EOS)
+		   call syserr (SYS_FXFKSSYN)
+
+	   case TOK_STRING:
+	       if (nexpr != 0 && nexpr != 1)
+		   call syserr (SYS_FXFKSSVAL)
+	       call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
+	       nexpr = nexpr + 1
+	       extn = true
+
+	   case TOK_IDENTIFIER:
+	       nident = nident + 1
+	       call strcpy (outstr, identif, LEN_CARD] 
+	       call strlwr (outstr)
+	       lex_type = fxf_ks_lex (outstr)
+
+	       # look for =<value>, + or -
+	       if (lex_type > 0) {
+	   	   call fxf_ks_gvalue (lex_type, ksection, ip, fit)
+	       } else {
+	           if (nexpr == 0 || nexpr == 1)
+		       call strcpy (identif, FKS_EXTNAME(fit), LEN_CARD)
+	           else
+		       call syserr (SYS_FXFKSSVAL)
+	       }
+	       nexpr = nexpr + 1
+	       extn = true
+
+	   default:
+		call syserr (SYS_FXFKSSYN)
+	   }
+	}	   
+end
+
+
+# FXF_KS_LEX -- Map an identifier into a FITS kernel parameter code.
+
+int procedure fxf_ks_lex (outstr)
+
+char    outstr[ARB]
+
+int	len, strlen(), strncmp()
+errchk	syserr, syserrs
+
+begin
+	len = strlen (outstr)
+
+	# Allow for small string to be taken as extname values and not
+	# kernel paramaters; like 'ap' instead of 'ap(ppend)'.
+	if (len < 3)
+	    return(0)
+
+	# See if it is extname or extver.
+	if (strncmp (outstr, "ext", 3) == 0 && len < 8 ) {
+	    if (len == 3)
+	        call syserr (SYS_FXFKSEXT)
+	    if (strncmp (outstr[4], "name", len-3) == 0)
+		return (KS_EXTNAME)
+	    else if (strncmp (outstr[4], "ver", len-3) == 0)
+		return (KS_EXTVER)
+
+	# Check for the "no" versions of selected keywords.
+	} else if (strncmp (outstr, "no", 2) == 0 && len < 12) {
+	    if (strncmp (outstr[3], "append", len-2) == 0)
+	        return (KS_NOAPPEND)
+	    if (strncmp (outstr[3], "inherit", len-2) == 0)
+	        return (KS_NOINHERIT)
+	    if (strncmp (outstr[3], "overwrite", len-2) == 0)
+	        return (KS_NOOVERWRITE)
+	    if (strncmp (outstr[3], "dupname", len-2) == 0)
+	        return (KS_NODUPNAME)
+	    if (strncmp (outstr[3], "expand", len-2) == 0)
+		return (KS_NOEXPAND)
+	}
+
+	# Other kernel keywords.
+	if (strncmp (outstr, "inherit", len) == 0)
+	    return (KS_INHERIT)
+	if (strncmp (outstr, "overwrite", len) == 0)
+	    return (KS_OVERWRITE)
+	if (strncmp (outstr, "dupname", len) == 0)
+	    return (KS_DUPNAME)
+	if (strncmp (outstr, "append", len) == 0)
+	    return (KS_APPEND)
+	if (strncmp (outstr, "noappend", len) == 0)
+	    return (KS_NOAPPEND)
+	if (strncmp (outstr, "type", len) == 0)
+	    return (KS_TYPE)
+	if (strncmp (outstr, "expand", len) == 0)
+	    return (KS_EXPAND)
+	if (strncmp (outstr, "phulines", len) == 0)
+	    return (KS_PHULINES)
+	if (strncmp (outstr, "ehulines", len) == 0)
+	    return (KS_EHULINES)
+	if (strncmp (outstr, "padlines", len) == 0)
+	    return (KS_PADLINES)
+	if (strncmp (outstr, "cachesize", len) == 0)
+	    return (KS_CACHESIZE)
+
+	return (0)	# not recognized; probably a value
+end
+
+
+# FXF_KS_GVALUE -- Given a parameter code get its value at the 'ip' character
+# position in the 'ksection' string.  Put the values in the FKS structure.
+
+procedure fxf_ks_gvalue (param, ksection, ip, fit)
+
+int	param			#I parameter code
+char	ksection[ARB]		#I Ksection
+int	ip			#I Current parsing pointer in ksection
+pointer	fit			#U Update the values in the FKS structure
+
+pointer sp, ln
+int     jp, token
+int	ctotok()
+errchk	syserr, syserrs
+
+begin
+	jp = ip
+
+	call smark (sp)
+	call salloc (ln, LEN_CARD, TY_CHAR)
+
+	# See if the parameter value is given as par=<value> or '+/-'
+	if (ctotok (ksection, jp, Memc[ln], LEN_CARD) == TOK_OPERATOR) {
+	    if (Memc[ln] == '=' ) {
+		token = ctotok (ksection, jp, Memc[ln], LEN_CARD)
+		if (token != TOK_IDENTIFIER &&
+			token != TOK_STRING && token != TOK_NUMBER) {
+		    call syserr (SYS_FXFKSSYN)
+		} else {
+		    call fxf_ks_val (Memc[ln], param, fit)
+		    ip = jp
+	        }
+	    } else if (Memc[ln] == '+' || Memc[ln] == '-') {
+		call fxf_ks_pm (Memc[ln], param, fit)
+		ip = jp
+	    }
+	} else {
+	    switch (param) {
+	    case  KS_APPEND:
+		FKS_APPEND(fit) = YES
+	    case  KS_NOAPPEND:
+		FKS_APPEND(fit) = NO
+	    case  KS_OVERWRITE:
+		FKS_OVERWRITE(fit) = YES
+	    case  KS_NOOVERWRITE:
+		FKS_OVERWRITE(fit) = NO
+	    case  KS_DUPNAME:
+		FKS_DUPNAME(fit) = YES
+	    case  KS_INHERIT:
+		FKS_INHERIT(fit) = YES
+	    case  KS_NOINHERIT:
+		FKS_INHERIT(fit) = NO
+	    case  KS_EXPAND:
+		FKS_EXPAND(fit) = YES
+	    case  KS_NOEXPAND:
+		FKS_EXPAND(fit) = NO
+	    default:
+		call syserr (SYS_FXFKSSYN)
+	    }
+	} 
+
+	call sfree (sp)
+end
+
+
+# FXF_KS_VALUE -- Returns the value of a parameter in the kernel section.
+
+procedure fxf_ks_val (outstr, param, fit)
+
+char	outstr[ARB] 		#I Input string with value		
+int	param			#I Parameter code
+pointer fit			#U Fits kernel descriptor
+
+int	ty, ip, ival, nchars
+int	lexnum(), ctoi(), strcmp()
+errchk	syserr, syserrs
+
+begin
+	call strlwr (outstr)
+	if (strcmp (outstr, "yes") == 0)
+	    ival = YES
+	else if (strcmp (outstr, "no") == 0)
+	    ival = NO
+	else
+	    ival = ERROR
+
+	switch (param) {
+	case  KS_EXTNAME:
+	    call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
+
+	case  KS_TYPE:
+	    call strlwr (outstr)
+	    if (strcmp ("mask", outstr) == 0)
+		FKS_SUBTYPE(fit) = FK_PLIO
+	    else
+		call syserrs (SYS_FXFKSINVAL, "type")
+	case KS_EXTVER:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0)
+	        call syserrs (SYS_FXFKSINVAL, "extver")
+	    FKS_EXTVER(fit) = ival
+
+	case KS_APPEND:
+	    if (ival != ERROR)
+	        FKS_APPEND(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "append")
+
+	case KS_OVERWRITE:
+	    if (ival != ERROR)
+	        FKS_OVERWRITE(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "overwrite")
+
+	case KS_DUPNAME:
+	    if (ival != ERROR)
+	        FKS_DUPNAME(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "dupname")
+
+	case KS_INHERIT:
+	    if (ival != ERROR)
+	        FKS_INHERIT(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "inherit")
+
+	case KS_EXPAND:
+	    if (ival != ERROR)
+	        FKS_EXPAND(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "expand")
+
+	case KS_PHULINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "phulines")
+	    FKS_PHULINES(fit) = ival
+
+	case KS_EHULINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "ehulines")
+	    FKS_EHULINES(fit) = ival
+
+	case KS_PADLINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "padlines")
+	    FKS_PADLINES(fit) = ival
+
+	case KS_CACHESIZE:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "cachesize")
+	    FKS_CACHESIZE(fit) = ival
+
+	default:
+            call syserr (SYS_FXFKSSYN)
+	}
+end
+
+
+# FXF_KS_PM -- Return the character YES or NO based on the value '+' or '-'
+ 
+procedure fxf_ks_pm (pm, param, fit)
+
+char	pm[1]		#I contains "+" or "-"
+int	param		#I Parameter code
+pointer fit		#U Fits kernel descriptor
+
+int	ival
+errchk	syserr, syserrs
+
+begin
+	if (pm[1] == '+') 
+	   ival = YES
+	else
+	   ival = NO
+
+	switch (param) {
+	case KS_APPEND:
+	    FKS_APPEND(fit) = ival
+	case KS_OVERWRITE:
+	    FKS_OVERWRITE(fit) = ival
+	case KS_DUPNAME:
+	    FKS_DUPNAME(fit) = ival
+	case KS_INHERIT:
+	    FKS_INHERIT(fit) = ival
+	case KS_EXPAND:
+	    FKS_EXPAND(fit) = ival
+	default:
+	    call syserr (SYS_FXFKSSYN)
+	}
+end
+
+
+# FXF_KS_ERRORS -- Handle an error condition in the kernel section.
+
+procedure fxf_ks_errors (fit, acmode)
+
+pointer fit 			#I fits kernel descriptor
+int	acmode			#I image access mode
+
+int	group
+errchk	syserr, syserrs
+
+begin
+	group = FIT_GROUP(fit)
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (FIT_NEWIMAGE(fit) == YES)
+		iferr (call syserrs (SYS_FOPNNEXFIL, IM_HDRFILE(FIT_IM(fit))))
+		    call erract (EA_WARN)
+	    if (acmode == APPEND)
+		call syserrs (SYS_FXFKSNOVR, "APPEND")
+	    if (group == -1 &&
+		    (FKS_EXTNAME(fit) == EOS && IS_INDEFL(FKS_EXTVER(fit))))
+		call syserr (SYS_FXFKSOVR)
+	} else {
+	    switch (acmode) {
+	    case NEW_COPY:
+		if (group != -1 && FKS_APPEND(fit) == NO)
+		    call syserr (SYS_FXFKSBOP)
+	    case NEW_IMAGE:
+		if (group != -1)
+		    call syserrs (SYS_FXFKSNEXT, "NEW_IMAGE" )
+	    case APPEND:
+	        if (group != -1)
+		    call syserrs (SYS_FXFKSNEXT, "APPEND" )
+	    }
+        }
+end			
+
+
+# FXF_KSINIT -- Initialize default values for ks parameters.
+
+procedure fxf_ksinit (fit)
+
+pointer	fit			#I fits kernel descriptor
+
+begin
+	FKS_EXTNAME(fit)   = EOS
+	FKS_SUBTYPE(fit)   = NO
+	FKS_EXTVER(fit)    = INDEFL
+	FKS_APPEND(fit)    = NO
+	FKS_OVERWRITE(fit) = NO
+	FKS_DUPNAME(fit)   = NO
+	FKS_EXPAND(fit)    = YES
+	FKS_PHULINES(fit)  = DEF_PHULINES
+	FKS_EHULINES(fit)  = DEF_EHULINES
+	FKS_PADLINES(fit)  = DEF_PADLINES
+	FKS_INHERIT(fit)   = YES
+	FKS_CACHESIZE(fit) = DEF_CACHE
+end
diff --git a/sys/imio/iki/fxf/fxfmkcard.x b/sys/imio/iki/fxf/fxfmkcard.x
new file mode 100644
index 00000000..81bb3ab7
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfmkcard.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+# FXF_MK_CARD --  Fetch a single line from a string parameter, padding it to
+# a maximum of maxcols characters and trimmimg the delim character.
+
+procedure fxf_make_card (instr, ip, card, col_out, maxcols, delim)
+
+char	instr[ARB]	#I input string
+int	ip		#U input string pointer, updated at each call
+char	card[ARB]	#O FITS card image
+int	col_out		#I pointer to column in card
+int	maxcols		#I maximum columns in card
+int	delim		#I 1 character string delimiter
+
+int	op
+
+begin
+	op = col_out
+
+	# Copy string
+	while (op <= maxcols && instr[ip] != EOS && instr[ip] != delim) {
+	    card[op] = instr[ip]
+	    ip = ip + 1
+	    op = op + 1
+	}
+
+	# Fill remainder of card with blanks
+	while (op <= maxcols ) {
+	    card[op] = ' '
+	    op = op + 1
+	}
+
+	if (instr[ip] == delim)
+	    ip = ip + 1
+end
diff --git a/sys/imio/iki/fxf/fxfnull.x b/sys/imio/iki/fxf/fxfnull.x
new file mode 100644
index 00000000..ce3baece
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfnull.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include "fxf.h"
+
+# FXF_NULL -- Null driver entry point.
+
+procedure fxf_null()
+
+errchk	syserr, syserrs
+
+begin
+	call syserr (SYS_FXFFKNULL)
+end
diff --git a/sys/imio/iki/fxf/fxfopen.x b/sys/imio/iki/fxf/fxfopen.x
new file mode 100644
index 00000000..bceed618
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfopen.x
@@ -0,0 +1,1014 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <finfo.h>
+include <fset.h>
+include <mii.h>
+include <mach.h>
+include	"fxf.h"
+
+
+# FXF_OPEN -- Open/create a FITS format image with extensions.
+
+procedure fxf_open (kernel, im, o_im, root, extn, ksection, group, gc_arg,
+	acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I other descriptor for NEW_COPY image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I [extname,extver,overwrite,append,inherit..]
+int	group			#I index of group to be accessed
+int	gc_arg			#I [NOT USED]
+int	acmode			#I access mode
+int	status			#O status flag to calling routine
+
+long	fi[LEN_FINFO]
+int	newimage, i, gn, ksinh, type, fmode
+pointer	sp, path, fit_extn, ua, o_fit, fit
+bool    pre_read, fks_extn_or_ver, dyh, fsec, plio
+int	fxf_check_dup_extnv(), itoc(), strcmp(), strncmp()
+int     open(), access(), imgeti(), fstatl(), finfo(), fxf_header_size()
+pointer pl_open()
+
+errchk	fmkcopy, calloc, open, fxf_rheader, fxf_prhdr, fxf_gaccess
+errchk	fxf_fclobber, fxf_ksection, fxf_alloc, syserr, syserrs
+errchk  fxf_check_group
+define	duperr_ 91
+define	err_ 92
+
+begin
+	call smark (sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+	call salloc (fit_extn, FITS_LENEXTN, TY_CHAR)
+	call fxf_init()
+	ua = IM_USERAREA(im)
+
+	fmode = acmode
+
+	# Allocate internal FITS image descriptor.
+	call fxf_alloc (fit)
+
+	IM_KDES(im) = fit
+	IM_HFD(im) = NULL
+	FIT_IM(fit) = im
+	call amovki (1, FIT_LENAXIS(fit,1), IM_MAXDIM)
+
+	# Generate full header file name.
+	if (extn[1] == EOS) {
+	    call fxf_gethdrextn (im, o_im, fmode, Memc[fit_extn], FITS_LENEXTN)
+	    call iki_mkfname (root, Memc[fit_extn], Memc[path], SZ_PATHNAME)
+	    call strcpy (Memc[fit_extn], extn, FITS_LENEXTN)
+	} else                                 
+	    call iki_mkfname (root, extn, Memc[path], SZ_PATHNAME)
+
+	# Header and pixel filename are the same.
+	call strcpy (Memc[path], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (IM_HDRFILE(im), IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	newimage = NO
+	if (access (IM_HDRFILE(im), 0, 0) == NO)
+	    newimage = YES
+	FIT_NEWIMAGE(fit) = newimage 
+
+	# Initialize kernel section default values.
+	call fxf_ksinit (fit)
+
+	# For simplicity treat the APPEND mode as NEW_IMAGE.  For the FK
+	# is the same.
+
+	if (fmode == APPEND)
+	    fmode = NEW_IMAGE
+	FIT_ACMODE(fit) = fmode
+
+	# Read fkinit and ksection and check that the extension number
+	# specifications therein and the IMIO cluster index "group" are
+	# consistent.
+
+	call fxf_check_group (im, ksection, fmode, group, ksinh)
+
+	fks_extn_or_ver = FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit))
+
+	# Check if a file section is necessary.
+	fsec = (fks_extn_or_ver || group >= 0)
+	call fxf_gaccess (im, fsec)
+
+	# The previous call could have changed FIT_NEWIMAGE; reset value.
+	newimage = FIT_NEWIMAGE(fit)
+
+	if (fks_extn_or_ver)
+	   FIT_GROUP(fit) = -1
+
+	# See if we want to write a dummy primary unit.
+	#
+	# For PLIO, if creating a new output file and we want to create a
+	# BINTABLE, create a dummy header.  Otherwise see if a type is
+	# requested, in which case we would need to create a dummmy header
+	# if no file is present yet.
+
+	type = 0
+	if (FKS_SUBTYPE(fit) == FK_PLIO)
+	    type = FK_PLIO
+
+	dyh = false
+	if (newimage == YES && (fks_extn_or_ver || type > 0)) {
+	    call fxf_dummy_header (im, status)
+	    if (status == ERR)
+		goto err_ 
+	    newimage = NO
+	    dyh = true
+	    if (fmode == NEW_COPY && type == FK_PLIO) 
+		FIT_PIXOFF(fit) = fxf_header_size(im) + FITS_BLOCK_CHARS
+	}
+	if (newimage == NO) {
+	    if (finfo (IM_HDRFILE(im), fi) != ERR)
+		FIT_EOFSIZE(fit) = (FI_SIZE(fi)+SZB_CHAR-1)/SZB_CHAR + 1
+	    else
+		call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+	}
+
+	if (newimage == YES)
+	    FKS_OVERWRITE(fit) = NO
+	else
+	    FIT_XTENSION(fit) = YES
+
+	FIT_NEWIMAGE(fit) = newimage
+
+	# If all these conditions are met then set the pre_read flag.
+	pre_read = (fks_extn_or_ver ||
+	    FKS_OVERWRITE(fit) == YES || FKS_INHERIT(fit) == YES)
+
+	if (newimage == NO && fmode != READ_ONLY) {
+	    # See that INHERIT makes sense if it has been set by
+	    # 'fkinit' when reading a file with PHU (naxis != 0).
+
+	    if (FKS_INHERIT(fit) == YES && group != 0) {
+		gn = 0
+		iferr (call fxf_prhdr (im, gn)) {
+		    FKS_INHERIT(fit) = NO
+
+		    # Issue an error only if the inherit is in the filename.
+		    if (fmode == NEW_COPY && ksinh == YES)
+			call syserr (SYS_FXFBADINH)
+	        } else if (FIT_NAXIS(fit) != 0)
+		    FKS_INHERIT(fit) = NO
+
+	        # Reset the pre_read flag.
+		pre_read = ((FKS_DUPNAME(fit) == NO && 
+		    FKS_INHERIT(fit) == YES) || FKS_OVERWRITE(fit) == YES)
+	    }
+
+	    if (pre_read && fmode != NEW_COPY && !dyh)
+	        call fxf_prhdr (im, group)
+
+	    if (access (IM_HDRFILE(im), fmode, 0) == NO)
+		call syserrs (SYS_FNOWRITEPERM, IM_HDRFILE(im))
+	}
+
+	switch (fmode) {
+	case NEW_IMAGE, APPEND:
+	    if (newimage == NO) {
+	        # Make sure the UA is empty when overwriting.
+	        if (pre_read && FKS_OVERWRITE(fit) == YES)  
+		    Memc[ua] = EOS
+		 
+	        if (FKS_DUPNAME(fit) == NO)
+	            if (fxf_check_dup_extnv (im, group) == YES)
+		        goto duperr_
+	    } else {
+		# See if it is necessary to invalidate the cache entry for the
+		# current filename. It could happen that the user has deleted
+		# the filename and a new file with the same is created.
+
+		call fxf_check_old_name (im)
+	    }
+	    
+	    if (FKS_INHERIT(fit) == YES)
+		FIT_INHERIT(fit) = YES
+
+	    # Initialize a new copy of a PLIO image mask.
+	    if (type == FK_PLIO) 
+		IM_PL(im) = pl_open (NULL)
+
+	case NEW_COPY:
+	    # Completely new copy of an existing image. This could mean a
+	    # new file or append a new image to an existing file.
+
+	    # Initialize a new copy of a PLIO image mask.
+	    if (type == FK_PLIO) {
+		IM_PL(im) = pl_open (NULL)
+	        if (IM_PL(o_im) != NULL)
+	            call fxf_plpf (im)
+	    }
+
+	    if (newimage == YES || FKS_APPEND(fit) == NO) 
+		call fxf_check_old_name (im)
+
+	    # For a PLIO mask, make sure there are no SUBYTPE keywords in
+	    # the UA since this will be rewritten by fxf_updhdr().
+	    
+	    if (IM_PL(o_im) != NULL)
+		call fxf_clean_pl (im)
+
+	    if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		o_fit = IM_KDES(o_im)
+	        call strcpy (FIT_EXTTYPE(o_fit), FIT_EXTTYPE(fit), SZ_EXTTYPE)
+		call strcpy (FIT_EXTNAME(o_fit), FIT_EXTNAME(fit), LEN_CARD)
+		FIT_EXTVER(fit) =  FIT_EXTVER(o_fit) 
+
+		# Reset the value of the keyword INHERIT in the new_copy
+		# image if the input has a no_inherit in the filename.
+
+		FIT_INHERIT(fit) = NO
+		call fxf_filter_keyw (im, "INHERIT")
+
+		# Change the value only if explicitly done in the output
+		# kernel section.
+
+		if (FKS_INHERIT(fit) == YES)
+	            FIT_INHERIT(fit) = YES
+
+	    } else {
+		# Reblock if old image is imh for example.
+		if (IM_UABLOCKED(im) != YES)
+		    call fxf_reblock (im)
+
+		# See if the old image have EXTNAME or EXTVER keywords.
+		# Notice that old image does not have to be of FITS type.
+
+		iferr (call imgstr (o_im,"EXTNAME",FIT_EXTNAME(fit),LEN_CARD))
+		    FIT_EXTNAME(fit) = EOS
+		iferr (FIT_EXTVER(fit) = imgeti (o_im, "EXTVER"))
+		    FIT_EXTVER(fit) = INDEFL
+		call strcpy ("IMAGE", FIT_EXTTYPE(fit), SZ_EXTTYPE)
+	    }
+
+	    # Delete ORIGIN keyword, since we are going to put a new one.
+	    call fxf_filter_keyw (im, "ORIGIN")
+
+	    # Now that we have a new_copy of the input FITS structure,
+	    # initialize some of its members.
+
+	    FIT_HFD(fit) = NULL
+	    FIT_NEWIMAGE(fit) = newimage
+	    if (newimage == NO)
+		FIT_XTENSION(fit) = YES
+	    FIT_ACMODE(fit) = fmode
+	    if (FKS_APPEND(fit) != YES)
+	        FIT_GROUP(fit) = group
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+
+            if (FKS_OVERWRITE(fit) == NO) {
+		if (FKS_EXTNAME(fit) == EOS)
+		    call strcpy (FIT_EXTNAME(fit), FKS_EXTNAME(fit), LEN_CARD)
+		else
+		    call imastr (im, "EXTNAME", FKS_EXTNAME(fit))
+    
+		if (IS_INDEFL(FKS_EXTVER(fit)))
+		    FKS_EXTVER(fit) =  FIT_EXTVER(fit) 
+		else
+		    call imaddi (im, "EXTVER", FKS_EXTVER(fit))
+
+		# We need to pre_read extensions headers to check for
+		# duplicates with these extname and extver.
+
+		if (FKS_EXTNAME(fit) != EOS ||!IS_INDEFL(FKS_EXTVER(fit))) 
+		    pre_read = true
+	    }
+
+	    if (newimage == NO && !dyh) {
+	        if (pre_read) {
+		    iferr (call fxf_prhdr (im, group))
+			;
+	        }
+
+		# Check for duplicated EXTNAME and/or EXTVER if any of the
+		# following conditions are met.
+
+		if (FKS_DUPNAME(fit) == NO && FKS_OVERWRITE(fit) == NO && 
+		    (fks_extn_or_ver || FIT_EXTNAME(fit) != EOS || 
+		    !IS_INDEFL(FIT_EXTVER(fit)))) {
+		    if (fxf_check_dup_extnv (im, group) == YES)
+		        goto duperr_
+		}
+	    }
+
+	    FIT_NAXIS(fit) = IM_NDIM(im)
+	    do i = 1, IM_NDIM(im)
+		FIT_LENAXIS(fit,i) = IM_LEN(im,i)
+
+	    # Inherit datatype of input template image if specified,
+	    # otherwise default datatype to real.
+
+	    if (IM_PIXTYPE(o_im) != NULL)
+		IM_PIXTYPE(im) = IM_PIXTYPE(o_im)
+	    else
+		IM_PIXTYPE(im) = TY_REAL
+
+	default:
+	    # No Overwrite allowed in READ_ONLY or READ_WRITE.
+	    FKS_OVERWRITE(fit) = NO
+
+	    # Check that we have single FITS file.
+	    if (!fsec && group == -1)
+	        group = 0
+
+	    # Open an existing image.
+            iferr (call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME))
+		goto err_
+	    if (fmode == READ_WRITE)
+		IM_HFD(im) = open (Memc[path], READ_WRITE, BINARY_FILE)
+	    else
+		IM_HFD(im) = open (Memc[path], READ_ONLY, BINARY_FILE)
+
+	    iferr (call fxf_rheader (im, group, fmode)) {
+		call close (IM_HFD(im))
+		call mfree (fit, TY_STRUCT)
+		call sfree (sp)
+		status = ERR
+		call erract (EA_ERROR)
+	    }
+
+	    if (group == 0) 
+	        FIT_XTENSION(fit) = NO
+	    else
+	        FIT_XTENSION(fit) = YES
+
+	    # Some non-iraf fits files might have keywords that are
+	    # imcompatible with our header. For example if hediting the header,
+	    # make sure that they are eliminated.
+
+	    if (fmode == READ_WRITE)
+	       call fxf_discard_keyw (im)
+
+	    FIT_EOFSIZE(fit) = fstatl (IM_HFD(im), F_FILESIZE) + 1
+
+	    # PLIO.  If we read the header of a PLIO_1 compressed image file
+	    # then it is a PL file; now read the data.
+
+	    plio = (strncmp (FIT_EXTSTYPE(fit), "PLIO_1", 6) == 0)
+	    if (plio)  {
+		call fxf_plread (im)
+
+		# We need to setup the IMIO descriptor if we need to write
+		# over a section; in particular IM_PFD needs to be defined.
+
+		if (fmode == READ_WRITE)
+		    call fxf_plpf (im)
+	    }
+
+	    # Close the header file.
+	    call close (IM_HFD(im))
+	    IM_HFD(im) = NULL
+
+	    # Do not allow the user to see any non_IMAGE extensions.
+	    if (strcmp ("IMAGE", FIT_EXTTYPE(fit)) != 0 &&
+		    strcmp ("SIMPLE", FIT_EXTTYPE(fit)) != 0 && !plio)
+		call syserrs (SYS_IKIEXTN, IM_NAME(im))
+	}
+
+	FIT_HFD(fit) = IM_HFD(im)
+	status = OK
+
+	call sfree (sp)
+	return
+duperr_
+	i = itoc (group, Memc[path], LEN_CARD)
+	call syserrs (SYS_FXFOPEXTNV, Memc[path])
+err_
+	status = ERR
+	call mfree (fit, TY_STRUCT)
+	call sfree (sp)
+end
+
+
+# FXF_ALLOC -- Initialize memory for the FIT descriptor.
+
+procedure fxf_alloc (fit)
+
+pointer fit	 		#I input fits descriptor
+
+errchk	calloc
+
+begin
+	call calloc (fit, LEN_FITDES, TY_STRUCT)
+
+	FIT_GROUP(fit) = -1
+	FIT_PIXTYPE(fit) = NULL
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+	FIT_XTENSION(fit) = NO
+	FIT_INHERIT(fit) = NO
+	FIT_EOFSIZE(fit) = 0
+	FIT_EXTNAME(fit) = EOS
+	FIT_EXTVER(fit) = INDEFL
+end
+
+
+# FXF_INIT -- Initialize any runtime FITS kernel descriptors to their
+# process startup state.
+
+procedure fxf_init()
+
+int	i
+bool	first_time
+data	first_time /true/
+
+include "fxfcache.com"
+
+begin
+	# Disable the hdrcache until it is fully initialized in rfitshdr.
+	if (first_time) {
+	    rf_cachesize = 0
+	    do i = 1, MAX_CACHE {
+		rf_fit[i] = 0
+	    }
+
+	    first_time = false
+	}
+end
+
+
+# FXF_KS_RDHDR -- Procedure to preread the FITS headers up to group
+# 'group'.  The idea is to have the offset pointers in memory since the
+# can be overwritten or when no group (i.e. -1) is given and the extname or
+# extver are specified.
+
+procedure fxf_prhdr (im, group)
+
+pointer	im  	 		#I image descriptor
+int	group			#I maximum group number to read
+
+int	poff, extv
+pointer	fit, lim, lfit, sp, path
+errchk	fpathname, open, syserr, fxf_alloc, calloc
+int	open(), imgeti()
+
+begin
+	call smark (sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	# We will use a local temporary imio and fit structures.
+#	call calloc (lim, LEN_IMDES+LEN_IMHDR+MIN_LENUSERAREA, TY_STRUCT)
+	call calloc (lim, LEN_IMDES+IM_LENHDRMEM(im), TY_STRUCT)
+
+	call fxf_alloc (lfit)
+
+	IM_KDES(lim) = lfit
+	fit = IM_KDES(im)
+
+	FIT_GROUP(lfit) = group
+	FIT_ACMODE(lfit) = FIT_ACMODE(fit)
+	call strcpy (FKS_EXTNAME(fit), FKS_EXTNAME(lfit), LEN_CARD)
+	FKS_EXTVER(lfit) = FKS_EXTVER(fit)
+
+	iferr (extv = imgeti (im, "EXTVER"))
+	     extv = INDEFL
+
+	FKS_OVERWRITE(lfit) = FKS_OVERWRITE(fit)
+	FKS_DUPNAME(lfit) = FKS_DUPNAME(fit)
+        FKS_INHERIT(lfit) = FKS_INHERIT(fit)
+        FKS_CACHESIZE(lfit) = FKS_CACHESIZE(fit)
+
+	# Open an existing image.
+        call strcpy (IM_HDRFILE(im), IM_HDRFILE(lim), SZ_PATHNAME)
+        call strcpy (IM_NAME(im), IM_NAME(lim), SZ_PATHNAME)
+
+        call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME)
+	IM_HFD(lim) = open (Memc[path], READ_ONLY, BINARY_FILE)
+
+	IM_LENHDRMEM(lim) = IM_LENHDRMEM(im)
+
+	# If we want to inherit the global header we need to read
+	# the group specified in the filename.
+
+	iferr (call fxf_rfitshdr (lim, group, poff)) {
+	     call close (IM_HFD(lim))
+             call mfree (lfit, TY_STRUCT)
+	     call mfree (lim, TY_STRUCT)
+	     call sfree (sp)
+	     call erract (EA_ERROR)
+
+	} else {
+	    call close (IM_HFD(lim))
+	    call sfree (sp)
+	    if (FKS_OVERWRITE(fit) == YES)
+		FIT_GROUP(fit) = FIT_GROUP(lfit)
+   	    group = FIT_GROUP(lfit)
+
+	    # Now set the offset pointers to the original 'fit' struct.
+	    FIT_HDRPTR(fit) = FIT_HDRPTR(lfit)
+	    FIT_PIXPTR(fit) = FIT_PIXPTR(lfit)
+	    FIT_EXTEND(fit) = FIT_EXTEND(lfit)
+
+	    FIT_CACHEHDR(fit) = FIT_CACHEHDR(lfit)
+	    FIT_CACHEHLEN(fit) = FIT_CACHEHLEN(lfit)
+
+	    FIT_NAXIS(fit) = FIT_NAXIS(lfit)
+	    FIT_INHERIT(fit) = FIT_INHERIT(lfit)
+	    FIT_PLMAXLEN(fit) = FIT_PLMAXLEN(lfit)
+
+	    IM_CTIME(im) = IM_CTIME(lim)
+
+	    call mfree (lfit, TY_STRUCT)
+	    call mfree (lim, TY_STRUCT)
+
+  	    if (extv != INDEFL)
+	        call imaddi (im, "EXTVER", extv)
+	}
+end
+
+
+# FXF_DUMMY_HEADER -- Built a minimum Primary Fits header.  This is
+# necessary in case we are creating an IMAGE extension and we don't 
+# want to put any information in the PHU.
+
+procedure fxf_dummy_header (im, status)
+
+pointer im 			#I image descriptor
+int	status			#O status flag
+
+char    blank[1]	
+pointer sp, path, spp, mii, pn, n
+int	iso_cutover, fd, nblanks, size_rec
+
+int	strlen(), open(), envgeti()
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (spp, FITS_BLOCK_BYTES, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+
+	iferr {
+	    call fpathname (IM_HDRFILE(IM), Memc[path], SZ_PATHNAME)
+	    fd = open (Memc[path], NEW_FILE, BINARY_FILE)
+	} then {
+	    call sfree (sp)
+	    status = ERR
+	    return
+	}
+
+	pn = spp
+	call fxf_akwb ("SIMPLE", YES, "FITS STANDARD", pn)
+	call fxf_akwi ("BITPIX", 8, "Character information", pn)
+	call fxf_akwi ("NAXIS", 0, "No image data array present", pn)
+	call fxf_akwb ("EXTEND", YES, "File may contain extensions", pn)
+        call fxf_akwc ("ORIGIN", FITS_ORIGIN,
+	    strlen(FITS_ORIGIN), "FITS file originator", pn)
+
+	# Dates after iso_cutover use ISO format dates.
+	iferr (iso_cutover = envgeti (ENV_ISOCUTOVER))
+	    iso_cutover = DEF_ISOCUTOVER
+
+	# Encode the DATE keyword.
+        call fxf_encode_date (clktime(long(0)), Memc[path], LEN_CARD,
+	    "ISO", 2000)
+	call fxf_akwc ("DATE", Memc[path],
+	    strlen(Memc[path]), "Date FITS file was generated", pn)
+
+	blank[1] = ' '
+        call amovkc (blank[1], Memc[pn], LEN_CARD)
+	call amovc ("END", Memc[pn], 3)
+	pn = pn + LEN_CARD
+
+	n = pn - spp
+	size_rec = FITS_BLOCK_CHARS
+        nblanks = FITS_BLOCK_BYTES - n
+	call amovkc (blank[1], Memc[spp+n], nblanks)
+	call miipak (Memc[spp], Memi[mii], size_rec*2, TY_CHAR, MII_BYTE)
+	call write (fd, Memi[mii], size_rec)
+
+	call close (fd)
+
+	call sfree (sp)
+end
+
+
+# FXF_CHECK_DUP_EXTN_VER --- Function to check for a duplicate EXTNAME or
+# EXTVER in the FITS file open with NEW_COPY mode. The filename specification
+# does not have EXTNAME nor EXTVER in the ksection.
+# Returns YES if there are duplicates.
+
+int procedure fxf_check_dup_extnv (im, group)
+
+pointer im			#I image descriptor
+int	group			#O extension number where there is a duplicate
+
+int	cindx
+pointer extn, extv, sp, hdrfile, fit, poff
+int	fxf_extnv_error()
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	fit = IM_KDES(im)
+	
+	do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+	        extn = rf_pextn[cindx]
+	        extv = rf_pextv[cindx]
+	        poff = rf_pixp[cindx]      # pixel offset -1 if EOF
+	        group = 1
+
+	        # Now compare the input image FIT_EXT(NAME,VER) with
+	        # the cache values of the NEW_COPY images.
+
+	        while (Memc[extn+LEN_CARD*group] != EOS || 
+		    !IS_INDEFL(Memi[extv+group]) || Memi[poff+group] != -1) {
+		    if (fxf_extnv_error (fit, group, extn, extv) == YES) {
+		        call sfree (sp)
+		        if (FKS_OVERWRITE(fit) == YES)
+		            return (NO)
+	                else
+		            return (YES)
+		    } else
+		        group = group + 1
+	        } 
+	    }
+	}
+
+	call sfree (sp)
+	return (NO)
+end
+
+
+# FXF_CHECK_OLD_NAME -- Check is the filename is already in cache for a
+# NEWIMAGE == YES mode; if so, make the entry obsolete.
+
+procedure fxf_check_old_name (im)
+
+pointer im				#I image descriptor
+
+int	cindx
+pointer sp, hdrfile, fit
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	fit = IM_KDES(im)
+	do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+	        next
+
+	    # Verify that we have the correct file.
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+                call mfree (rf_pextv[cindx], TY_INT)
+                call mfree (rf_pextn[cindx], TY_CHAR)
+                call mfree (rf_pixp[cindx], TY_INT)
+                call mfree (rf_hdrp[cindx], TY_INT)
+                call mfree (rf_fit[cindx], TY_STRUCT)
+                call mfree (rf_hdr[cindx], TY_CHAR)
+	        rf_fit[cindx] = NULL
+	        rf_mtime[cindx] = 0      # invalidate cache entry
+	        rf_fname[1,cindx] = EOS
+	        break
+            }		
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_REBLOCK -- If the user area is not blocked to fixed length records, e.g.,
+# as is possible in a new copy image, reblock it fixed length.
+
+procedure fxf_reblock (im)
+
+pointer	im				#I image descriptor
+
+pointer	sp, lbuf, op, ua
+int	fd, spool, nlines, nchars, sz_userarea, len_hdrmem
+errchk	stropen, open, getline, putline, realloc, seek, fcopyo
+int	open(), stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], ARB, READ_ONLY)
+	spool = open ("rb_spool", READ_WRITE, SPOOL_FILE)
+	
+	# Reblock into a spool file, counting the lines.
+	for (nlines=0;  ;  nlines=nlines+1) {
+	    nchars = getline (fd, Memc[lbuf])
+	    if (nchars <= 0)
+		break
+
+	    for (op=nchars;  op <= LEN_CARD;  op=op+1)
+		Memc[lbuf+op-1] = ' '
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+	    call putline (spool, Memc[lbuf])
+	}
+
+	call close (fd)
+
+	# Reallocate header the right size.
+	sz_userarea = nlines * (LEN_CARD+1) + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Move spooled data back to user area.
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], sz_userarea, NEW_FILE)
+	call seek (spool, BOFL)
+	call fcopyo (spool, fd)
+
+	IM_UABLOCKED(im) = YES
+	call close (fd)
+	call close (spool)
+	call sfree (sp)
+end
+
+
+# FXF_FCLOBBER -- Clobber an existing FITS file.  We use the environment
+# variable 'clobber' rather than 'imclobber' because is a file and not
+# an image.
+
+procedure fxf_fclobber (file)
+
+char	file			#I input filename to delete
+
+int	cindx
+bool    streq()
+include	"fxfcache.com"
+
+begin
+	iferr (call delete (file))
+	    call filerr (file, SYS_FCANTCLOB)
+				     
+	# Remove the name from the cache.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+
+	    # Verify that we have the correct file.
+	    if (streq (file, rf_fname[1,cindx])) {
+		if (rf_fit[cindx] != NULL) {
+		    call mfree (rf_pextv[cindx], TY_INT)
+		    call mfree (rf_pextn[cindx], TY_CHAR)
+		    call mfree (rf_pixp[cindx], TY_INT)
+		    call mfree (rf_hdrp[cindx], TY_INT)
+		    call mfree (rf_fit[cindx], TY_STRUCT)
+		    call mfree (rf_hdr[cindx], TY_CHAR)
+                    rf_fit[cindx] = NULL
+		}
+	    }
+	}
+end
+
+
+# FXF_ACCESS -- Check if a file section is necessary to access any
+# particular extension.
+
+procedure fxf_gaccess (im, fsec)
+
+pointer	im		#I image descriptor
+bool	fsec		#I true if extname,extver or group have values
+
+bool	mef
+int	acmode, fit, newimage, group
+bool    envgetb(), fnullfile()
+errchk	syserr, syserrs, fxf_fclobber
+
+begin
+	fit = IM_KDES(im)
+	acmode = FIT_ACMODE(fit) 
+	newimage = FIT_NEWIMAGE(fit)
+
+	if (acmode == READ_ONLY || acmode == READ_WRITE) {
+	    # If no file section then see if it is a MEF by prereading an
+	    # extension.
+
+	    if (!fsec) {
+		group = 1
+		mef = false
+		ifnoerr (call fxf_prhdr (im, group))
+		    mef = true
+		else {
+		    # Flag error if the group does not exist and overwrite+.
+		    if (FKS_OVERWRITE(fit) == YES)
+		        call syserrs (SYS_FXFEXTNF, IM_NAME(im))
+		}
+		# Multi-extension file but no extension was specified.
+		if (mef)
+		    call syserrs (SYS_FXFOPNOEXTNV, IM_NAME(im))
+		FIT_GROUP(fit) = 0
+		FIT_XTENSION(fit) = NO
+	    }
+	}
+	
+	switch (acmode) {
+	case NEW_COPY, NEW_IMAGE, APPEND:
+	    if (envgetb ("imclobber")) {
+		if (newimage == NO) {
+	            if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) {
+		        # Clobber the file.
+		        call fxf_fclobber (IM_HDRFILE(im))
+		        FIT_NEWIMAGE(fit) = YES
+		    }
+		}
+	    } else {
+	        if (newimage == NO)
+		    if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) {
+			if (!fnullfile (IM_HDRFILE(im)))
+			    call syserrs (SYS_IKICLOB, IM_HDRFILE(im))
+		    }
+	   }
+	default:
+	    ;
+	}
+
+end
+
+
+# FXF_CHECK_GROUP -- Check for group specification from fkinit, ksection
+# and cluster index are equal when specifified and they are also compatible
+# when (extname,extver) is in the kernel sections.
+
+procedure fxf_check_group (im, ksection, acmode, group, ksinh)
+
+pointer	im			#I imio descriptor
+char	ksection[ARB]		#I kernel section
+int	acmode			#I fits unit extension mode
+int	group			#U extension number in the image section
+int	ksinh			#O INHERIT value from the filename ksection
+
+pointer sp, ks, fit
+bool    fks_extn_or_ver, inherit_override	
+int	igroup, kgroup, fgroup, tgroup, sv_inherit, newimage, append
+bool    fnullfile()
+int	envgets()
+
+errchk  syserrs, fxf_ks_error
+
+begin
+	call smark (sp)
+	call salloc (ks, SZ_LINE, TY_CHAR)
+
+	fit = IM_KDES(im)
+	newimage = FIT_NEWIMAGE(fit)
+
+	# Set the FKINIT defaults; these override the builtin defaults.
+	fgroup = -1
+	igroup = -1
+
+	FKS_APPEND(fit) = NO_KEYW
+	if (envgets (ENV_FKINIT, Memc[ks], SZ_LINE) != 0)
+	    call fxf_ksection (Memc[ks], fit, igroup)
+
+	append = FKS_APPEND(fit)
+
+	sv_inherit = FKS_INHERIT(fit)
+	FKS_INHERIT(fit) = NO_KEYW
+	FKS_APPEND(fit) = NO_KEYW
+
+	# Parse the kernel section.
+	call fxf_ksection (ksection, fit, kgroup)
+	ksinh = FKS_INHERIT(fit)
+
+	# Check for various error conditions.
+	if (FKS_OVERWRITE(fit) == YES && FKS_APPEND(fit) == YES)
+	    call syserrs (SYS_FXFKSNOVR, "append")
+
+	if (append == NO_KEYW && FKS_APPEND(fit) == NO_KEYW)
+	    FKS_APPEND(fit) = NO
+	else if (append != NO_KEYW)
+	    FKS_APPEND(fit) = append
+
+	if (append == YES && FKS_OVERWRITE(fit) == YES)
+	    FKS_APPEND(fit) = NO
+
+	if (group != -1) {
+	    if (kgroup != -1 && group != kgroup)
+	        call syserrs (SYS_FXFKSBADGR, IM_NAME(im))
+	    else if (igroup != -1 && group != igroup)
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = group
+	} else if (kgroup != -1) {
+	    if (group != -1 && group != kgroup)
+	        call syserrs (SYS_FXFKSBADGR, IM_NAME(im))
+	    else if (igroup != -1 && group != igroup)
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = kgroup
+	} else if (igroup != -1) {
+	    if ((group != -1 && group != igroup) ||
+		    (kgroup != -1 && kgroup != igroup))
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = igroup
+        }	       
+	group = fgroup      
+
+	# Pre-read the data header.  This is done after processing the user
+	# ksection as we need to get the extname/extver if any.
+	# EXTNAME or EXTVER has priority when defined over group.
+
+	fks_extn_or_ver =
+	    (FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit)))
+
+	tgroup = fgroup
+	if (fks_extn_or_ver) 
+	    tgroup = -1
+
+	if (newimage == NO && !fnullfile (IM_HDRFILE(im))) {
+	    iferr (call fxf_prhdr (im, tgroup)) {
+		# If group does not exist and over+, it is an error.
+		if (FKS_OVERWRITE(fit) == YES)
+		    call syserrs (SYS_FXFEXTNF, IM_NAME(im))
+	        else
+		    call erract (EA_ERROR)
+	    }   
+	}
+
+	if (fgroup != -1 && tgroup != fgroup && fks_extn_or_ver)
+	    call syserrs (SYS_FXFKSBADEXN, IM_NAME(im))
+
+	if (fgroup == -1 && fks_extn_or_ver)
+	    group = tgroup
+
+	FIT_EXPAND(fit) = FKS_EXPAND(fit)
+
+	# For overwrite we need to force group to be the kernel section
+	# extension number. 
+
+	if (FKS_OVERWRITE(fit) == YES)
+	    FIT_GROUP(fit) = max(kgroup,group)
+	else
+	    FIT_GROUP(fit) = group
+
+	if (FKS_APPEND(fit) == YES)
+	    FIT_GROUP(fit) = -1
+
+	# See if there are some error conditions with the ksection.
+	call fxf_ks_errors (fit, acmode)
+
+	# Check to see if the user ksection sets the inherit flag.  If so
+	# this overrides all the defaults, including the data header.
+
+	inherit_override = (FKS_INHERIT(fit) != NO_KEYW)
+	if (!inherit_override)
+	    FKS_INHERIT(fit) = sv_inherit
+
+	# A data header has precedence over the more global fkinit.
+	# If inherit is disabled in the data header don't enable it here.
+
+	if (!inherit_override && FIT_INHERIT(fit) == NO)
+	    FKS_INHERIT(fit) = NO
+
+	call sfree (sp)
+end
+
+
+# FXF_CLEAN_PL -- Filter PLIO keywords from the UA.
+
+procedure fxf_clean_pl (im)
+
+pointer	im	#I image descriptor
+
+begin
+	#### (This is incredibly inefficient...)
+	call fxf_filter_keyw (im, "TFORM1")
+	call fxf_filter_keyw (im, "TFIELDS")
+	call fxf_filter_keyw (im, "ZIMAGE")
+	call fxf_filter_keyw (im, "ZCMPTYPE")
+	call fxf_filter_keyw (im, "ZBITPIX")
+	call fxf_filter_keyw (im, "ZNAXIS")
+	call fxf_filter_keyw (im, "ZNAXIS1")
+	call fxf_filter_keyw (im, "ZNAXIS2")
+	call fxf_filter_keyw (im, "ZTILE1")
+	call fxf_filter_keyw (im, "ZTILE2")
+	call fxf_filter_keyw (im, "ZNAME1")
+	call fxf_filter_keyw (im, "ZVAL1")
+end
diff --git a/sys/imio/iki/fxf/fxfopix.x b/sys/imio/iki/fxf/fxfopix.x
new file mode 100644
index 00000000..0401601b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfopix.x
@@ -0,0 +1,746 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <mach.h>
+include	"fxf.h"
+include	<fset.h>
+
+define	MIN_BUFSIZE  512
+
+
+# FXF_OPIX -- Open (or create) the pixel storage file.
+
+procedure fxf_opix (im, status)
+
+pointer	im			#I image descriptor
+int	status 			#O return status
+
+pointer sp, fn, fit
+char    pathname[SZ_PATHNAME]
+int	compress, blklen, pixoff, filesize
+int	i, hdr_size, sz_pixfile, sz_fitfile, junk, npix
+extern  fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int	strncmp(), fxf_header_size(), fxf_totpix()
+int     strlen(), fopnbf(), fstatl(), itoc()
+
+include	<szpixtype.inc>
+
+define  err_ 91
+define  endowr_ 92
+
+begin
+	call smark (sp)
+	call salloc (fn, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+	fit = IM_KDES(im)
+
+	compress = YES
+	blklen   = 1
+	pixoff   = 1
+
+	# Tell IMIO where the pixels are.  Append the 'fit' mem descriptor
+	# to filename so that low level zfiofit routines can use it.
+
+        call strcpy (IM_HDRFILE(im), Memc[fn], SZ_PATHNAME)
+	call strcat ("_", Memc[fn], SZ_PATHNAME)
+	i = strlen (Memc[fn])
+	junk = itoc (fit, Memc[fn+i], SZ_PATHNAME) 
+        iferr (call fpathname (Memc[fn], pathname, SZ_PATHNAME))
+	    goto err_
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    call fxf_overwrite_unit (fit, im)
+	    goto endowr_
+	}
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY:
+	    # Turn on IEEE mapping on input only.
+	    call ieegnanr (FIT_SVNANR(fit))
+	    call ieegmapr (FIT_SVMAPRIN(fit), FIT_SVMAPROUT(fit))
+	    call ieegnand (FIT_SVNAND(fit))
+	    call ieegmapd (FIT_SVMAPDIN(fit), FIT_SVMAPDOUT(fit))
+	    call ieesnanr (0.0)
+	    call ieemapr (YES, NO)
+	    call ieesnand (0.0D0)
+	    call ieemapd (YES, NO)
+
+	    # If the FIT datatype is BYTE or SHORT with scaling then
+	    # convert to TY_SHORT and TY_REAL respectively before
+	    # releasing the data to the upper level calls. This is
+	    # because IMIO does not support BYTE datatype and the need
+	    # to scale 16 bits to 32 bits.
+	    
+	    # Do not open pixel portion if it is empty or is not
+	    # an IMAGE type.
+
+	    if ((strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		 strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) || 
+		 IM_NDIM(im) <= 0) {
+
+	        goto err_
+	    }
+
+	    FIT_IM(fit) = im
+	    iferr (IM_PFD(im) = fopnbf (pathname, IM_ACMODE(im),
+		    fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+	        IM_PFD(im) = NULL
+	        goto err_
+	    }
+	    
+	    FIT_TOTPIX(fit) = fxf_totpix(im)
+	    filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	    FIT_PFD(fit) = IM_PFD(im)
+
+	case NEW_COPY, NEW_IMAGE, APPEND:
+	    # See if the application has set the number of dimensions.
+	    call fxf_chk_ndim (im)
+	    FIT_PIXTYPE(fit) = IM_PIXTYPE(im)
+	    npix = fxf_totpix (im)
+	    FIT_NAXIS(fit) = IM_NDIM(im)
+	    call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+
+	    call fxf_discard_keyw (im)
+	    FIT_TOTPIX(fit) = npix
+
+	    # Do not allow BSCALE and BZERO in the UA when making a new copy or
+	    # new image if bitpix is negative. Except for ushort
+
+	    if (IM_PIXTYPE(im) != TY_USHORT) {
+		call fxf_filter_keyw (im, "BSCALE")
+		call fxf_filter_keyw (im, "BZERO")
+	    }
+
+	    # Hdr_size is in char units. (i.e. 1440 chars per FITS block).
+	    hdr_size = fxf_header_size (im)
+
+            # Reset the scaling parameter because in NEW_COPY mode there
+	    # should not be scaled pixels.  The previous call will get these
+	    # values from the input image.
+
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+
+	    sz_pixfile = npix * pix_size[IM_PIXTYPE(im)]
+
+	    # The pixel file needs to be a multiple of 1440 chars.
+	    sz_pixfile = FITS_LEN_CHAR (sz_pixfile)
+	    sz_fitfile = sz_pixfile + hdr_size
+
+	    if (FIT_NEWIMAGE(fit) == YES)
+	       call falloc (IM_PIXFILE(im), sz_fitfile) 
+	      
+	    FIT_IM(fit) = im
+
+	    iferr (IM_PFD(im) = fopnbf (pathname, READ_WRITE,
+		    fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+		IM_PFD(im) = NULL
+		call erract (EA_FATAL)
+		goto err_
+	    }
+
+	    FIT_PFD(fit) = IM_PFD(im)
+	    filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	    FIT_EOFSIZE(fit) = filesize + 1
+
+	    if (FIT_NEWIMAGE(fit) == NO) {
+	        # Now we are appending a new IMAGE extension.
+	        # Write a blank header in order to append the
+	        # pixels after it.
+
+	        pixoff = filesize + hdr_size + 1
+
+		# Update the offset for the blank write to follow which uses
+		# a local file driver tied to the IM_PFD descriptor and not
+		# the normal FIO.
+                FIT_PIXOFF(fit) = pixoff
+
+	        # Update filesize
+	        filesize = filesize + sz_fitfile
+	        call fxf_write_blanks (IM_PFD(im), hdr_size)
+	    } else 
+	        pixoff = hdr_size + 1
+
+            FIT_PIXOFF(fit) = pixoff
+	    call imioff (im, pixoff, compress, blklen)
+
+	    IM_HFD(im) = NULL
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+endowr_
+	FIT_PFD(fit) = IM_PFD(im)
+	FIT_HFD(fit) = IM_HFD(im)
+
+	# The following statement is to pass the datatype at the low
+	# level fits read and write routines. The datatype value can
+	# change after the image is open. Hopefully the value of 'im'
+	# will remain static.
+	
+	FIT_IM(fit) = im
+	status = OK
+
+ 	call sfree (sp)
+	return
+err_
+	status = ERR
+        call sfree (sp)
+end
+ 
+
+# FXF_HEADER_SIZE -- Function to calculate the header size that would go 
+# into the output file extension.
+
+int procedure fxf_header_size (im)
+
+pointer im 				#I Image descriptor
+
+bool	inherit
+int	merge, hdr_size
+pointer op, fit, sp, tb, pb
+int	nheader_cards, ualen, ulines, clines
+int	strlen()
+
+begin
+	fit = IM_KDES(im)
+        inherit = false
+
+	# Fks_inherit is a combined value.
+        if (FKS_INHERIT(fit) == YES)
+	    inherit = true
+
+	call fxf_mandatory_cards (im, nheader_cards)
+
+	if (FIT_NEWIMAGE(fit) == NO && inherit) {
+	    # See if current UA keywords are in the global header, if not
+	    # there put it in a spool file. At the end, the spool file size is
+	    # the output extension header size to be use in fitupdhdr.
+
+	    # Check if the file is still in cache. We need CACHELEN and
+            # CACHEHDR. 
+
+            call fxf_not_incache (im)
+
+	    op = IM_USERAREA(im)
+	    ualen = strlen (Memc[op])
+	    ulines = ualen / LEN_UACARD
+	    clines = FIT_CACHEHLEN(fit) / LEN_UACARD
+
+	    call smark (sp)
+	    call salloc (tb, ualen+1, TY_CHAR)
+
+	    merge = NO
+	    pb = tb
+
+	    # Now select those lines from the UA (pointed by op) that are
+	    # not in the cache and accumulate them in 'pb'.
+
+	    call fxf_match_str (op, ulines, FIT_CACHEHDR(fit), clines,merge,pb)
+	    Memc[pb+1] = EOS
+	    ualen = strlen (Memc[tb])
+
+	    call sfree (sp)
+
+	} else {
+	    op = IM_USERAREA(im)
+	    ualen = strlen (Memc[op])
+	}
+
+	ulines = ualen / LEN_UACARD + nheader_cards + FKS_PADLINES(fit)
+
+	##### Note: PHULINES is not currently used, should be implemented
+	##### Not clear to me if this code here is used for the PHU since
+	##### it is in opix!
+
+	# See if the application has set a minumum number of card for the UA.
+
+	ulines = max (ulines, FKS_EHULINES(fit))
+
+	# The user area contains new_lines (81 chars, LEN_UACARD).  Scale to
+	# 80 chars (LEN_CARD).  Ualen is in bytes.
+
+	ualen = ulines * LEN_CARD 
+
+	# Calculate the number of header FITS blocks in chars.
+	hdr_size = FITS_LEN_CHAR (ualen / 2)
+
+	return (hdr_size)
+end
+
+
+# FXF_BYTE_SHORT -- This routine is obsolete and has been deleted, but is
+# being preserved for the V2.11.2 patch so that a new shared library version
+# does not have to be created.  It can be deleted in the next major release.
+
+procedure fxf_byte_short (im, fname)
+
+pointer	im
+char	fname[ARB]
+
+begin
+end
+
+
+# FXF_WRITE_BLANKS --Procedure to append a blank header to an existing
+# file, preparing to write data after it.
+
+procedure fxf_write_blanks (fd, size)
+
+int	fd			#I File descriptor
+int	size			#I New size (chars) to allocate.
+
+pointer sp, bf
+int	nblocks,i, fits_lenc
+
+begin
+	call smark (sp)
+
+	# Length of a FITS block (2880) in chars.
+	fits_lenc = FITS_BLOCK_BYTES/SZB_CHAR
+	call salloc (bf, fits_lenc, TY_INT)
+	call amovki (0, Memi[bf], fits_lenc)
+
+	size = FITS_LEN_CHAR(size)
+	nblocks = size / fits_lenc
+
+	call seek (fd, EOF)
+	do i = 1, nblocks 
+	    call write (fd, Memi[bf], fits_lenc)
+
+	call sfree (sp)
+end
+
+
+# FXF_MANDATORY_CARDS --  Count the required FITS header cards.
+# The cards for the Main Unit are: SIMPLE, BITPIX, NAXIS, 
+# EXTEND, ORIGIN, DATE, IRAF_TLM, OBJECT and END; 
+# 'IM_NDIM(im)', DATAMIN and DATAMAX will be put out
+# only if the LIMTIME > MTIME.
+# would  take care of NAXISi. For an Extension unit, the cards are:
+# XTENSION, BITPIX, NAXIS, PCOUNT, GCOUNT, ORIGIN, DATE, INHERIT,
+# EXTNAME, IRAF_TLM, OBJECT and END; IM_NDIM(im) takes care of
+# NAXISi. Same as above for DATAMIN, DATAMAX.
+# If these cards are in the main header, reduce the number of
+# mandatory cards that are going to be created at closing time
+# (in fitupdhdr).
+	  
+procedure fxf_mandatory_cards (im, nheader_cards)
+
+pointer im			#I im structure
+int	nheader_cards		#O Number of mandatory cards in header.
+
+pointer ua
+int	ncards, rp, fit, acmode
+int	idb_findrecord()
+
+begin
+	ua = IM_USERAREA(im)
+	fit = IM_KDES(im)
+
+	if (FIT_NEWIMAGE(fit) == YES)		# create a PHU
+	    ncards = 9 + IM_NDIM(im) 
+	else					# create an EHU
+	    ncards = 12 + IM_NDIM(im) 
+
+	if (idb_findrecord (im, "PCOUNT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "PCOUNT")
+	}
+	if (idb_findrecord (im, "GCOUNT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "GCOUNT")
+	}
+	if (idb_findrecord (im, "EXTNAME", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "EXTNAME")
+	}
+	if (idb_findrecord (im, "INHERIT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "INHERIT")
+	}
+	if (idb_findrecord (im, "EXTEND", rp) > 0)  {
+	    if (FIT_XTENSION(fit) == NO)  {
+	        ncards = ncards - 1
+	    } else {
+		# Delete the keyword from the UA because EXTEND is not
+		# recommended in XTENSION units.
+
+	        call fxf_filter_keyw (im, "EXTEND")
+	    }
+	}
+
+	if (idb_findrecord (im, "ORIGIN", rp) > 0)
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "DATE", rp) > 0 ) 
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "IRAF-TLM", rp) > 0) 
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "OBJECT", rp) > 0) 
+	    ncards = ncards - 1
+
+	# See if we need to add one more mandatory card when an EXTVER value
+	# was specified when appending a new extension.
+
+	if (FIT_NEWIMAGE(fit) == NO && idb_findrecord(im,"EXTVER",rp) == 0) {
+	    # Keyword does not exist.
+	    acmode = IM_ACMODE(im)
+	    if ((acmode == NEW_IMAGE || acmode == NEW_COPY) && 
+		FKS_EXTVER(fit) != INDEFL )
+	    ncards = ncards + 1
+	}
+
+	# We want to keep BSCALE and BZERO in the UA in case we are 
+	# editing the values. Is up to the user or application
+	# responsability to deal with the change in pixel value when reading.
+	# If we are reading pixels the values will change according to the
+	# input BSCALE and BZERO. If we are adding BSCALE and BZERO before 
+	# accessing any pixels, these will get scale. If adding or
+	# changing right before closing the image, the pixel value will be 
+	# unchanged.
+
+	# See if BSCALE and BZERO are in the UA for ushort, otherwise
+	# increase the number.
+
+	if (IM_PIXTYPE(im) == TY_USHORT) {
+	    if (idb_findrecord (im, "BSCALE", rp) == 0) 
+	        ncards = ncards + 1
+	    if (idb_findrecord (im, "BZERO", rp) == 0) 
+	        ncards = ncards + 1
+        }
+	nheader_cards = ncards
+end
+
+
+# FXF_OVERWRITE_UNIT -- Overwrite an existent extension. A temporary file
+# is created that contains the current file upto the extension before the
+# one to be overwrite.
+
+procedure fxf_overwrite_unit (fit, im)
+
+pointer	fit			#I Fits descriptor
+pointer	im			#I Image descriptor
+
+pointer sp, file, mii
+int	pixoff, compress, blklen, sz_fitfile, i, group, filesize
+int	junk, in_fd, out_fd, nblocks, nk, hdr_size, sz_pixfile
+extern  fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int	fnroot(), open(), read(), fxf_totpix(), strncmp(), itoc()
+int	strlen(), fopnbf(), fstatl(), fxf_header_size()
+
+include	<szpixtype.inc>
+
+errchk	syserr, syserrs
+define  err_ 91
+
+begin
+	group = FIT_GROUP(fit)
+
+	# Do not overwrite extensions that are not IMAGE.
+	if (group != 0 && strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) {
+
+	    call syserr (SYS_FXFOVRBEXTN)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (file, SZ_FNAME, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	
+	junk = fnroot (IM_HDRFILE(im), Memc[file], SZ_FNAME)
+
+	# Keep the temporary filename in IM_PIXFILE(im).
+	call mktemp (Memc[file], IM_PIXFILE(im), SZ_PATHNAME)
+	call strcat (".fits", IM_PIXFILE(im), SZ_PATHNAME)
+
+	# If we want to overwrite the first group there is nothing
+	# to copy first.
+
+	if (group != 0) {
+	    # Copy from the old file up to hdr_off[group] into a temporary file.
+	    in_fd = open (IM_HDRFILE(im), READ_ONLY, BINARY_FILE)
+	    out_fd = open (IM_PIXFILE(im), NEW_FILE, BINARY_FILE)
+	    nblocks = Memi[FIT_HDRPTR(fit)+group]/ FITS_BLOCK_CHARS
+	    do nk = 1, nblocks {
+		junk = read (in_fd, Memi[mii], FITS_BLOCK_CHARS)
+		call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+	    }
+	    call close (in_fd)
+	    call close (out_fd)
+	}
+
+	FIT_NAXIS(fit) = IM_NDIM(im)
+	call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+	
+	FIT_TOTPIX(fit) = fxf_totpix(im)
+
+	# Do not allow BSCALE and BZERO in the UA when making a new copy or
+	# new image if bitpix is negative. Except for ushort.
+
+	if (IM_PIXTYPE(im) != TY_USHORT) {
+	    call fxf_filter_keyw (im, "BSCALE")
+	    call fxf_filter_keyw (im, "BZERO")
+	}
+
+	# The new copy header should not have the following keywords:
+	# GROUPS, PSIZE and that could come from a GEIS file. 
+
+	call fxf_discard_keyw (im)
+	hdr_size = fxf_header_size (im)
+
+	# Reset the scaling parameter because in NEW_COPY mode there
+	# should not be scaled pixels. The previous call will get these
+	# values from the input image.
+
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+
+        call fpathname (IM_PIXFILE(im), Memc[file], SZ_PATHNAME)
+	call strcat("_", Memc[file], SZ_PATHNAME)
+	i = strlen(Memc[file])
+	junk = itoc (fit, Memc[file+i], SZ_PATHNAME) 
+
+	# The pixel file needs to be a multiple of 1440 chars.
+	sz_pixfile = fxf_totpix(im) * pix_size[IM_PIXTYPE(im)]
+	sz_pixfile = FITS_LEN_CHAR(sz_pixfile)
+	sz_fitfile = sz_pixfile + hdr_size
+
+	if (group == 0)
+	   call falloc (IM_PIXFILE(im), sz_fitfile)
+
+	FIT_IM(fit) = im
+	iferr (IM_PFD(im) = fopnbf (Memc[file], READ_WRITE,
+		fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+
+	    IM_PFD(im) = NULL
+	    goto err_
+	}
+
+	filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	FIT_EOFSIZE(fit) = filesize + 1
+	# Now write a blank header.
+	if (group != 0) {
+	    call amovki (0, Memi[mii], FITS_BLOCK_CHARS)
+	    nblocks = hdr_size/FITS_BLOCK_CHARS
+	    FIT_HFD(fit) = -1
+
+	    call seek (IM_PFD(im), EOF)
+	    do nk = 1, nblocks 
+		call write (IM_PFD(im), Memi[mii], FITS_BLOCK_CHARS)
+	    
+	    pixoff = filesize + hdr_size + 1
+	    filesize = filesize + sz_fitfile
+	} else
+	   pixoff = hdr_size + 1
+
+
+	FIT_PIXOFF(fit) = pixoff
+	IM_HFD(im) = NULL
+
+	blklen = 1
+	compress = YES
+	call imioff (im, pixoff, compress, blklen)
+
+        FIT_PFD(fit) = IM_PFD(im)
+	FIT_HFD(fit) = IM_HFD(im)
+		 
+	call sfree (sp)
+	return
+err_
+	call syserr (SYS_FXFOVRTOPN)
+        call sfree (sp)
+end
+
+
+# TOTPIX -- Calculate the total number of pixels in the image.
+
+int procedure fxf_totpix (im) 
+
+pointer im			#I image descriptor
+int	i, pix, ndim
+
+begin
+	ndim = IM_NDIM(im)
+	if (ndim == 0)
+	    return (0)
+
+	pix = IM_LEN(im,1)
+	do i = 2, ndim
+	    pix = pix * IM_LEN(im,i)
+
+	return (pix)
+end
+
+
+# FXF_DISCARD_FITS_KEYW -- Exclude certain keywords from a new copy image.
+
+procedure fxf_discard_keyw (im)
+
+pointer im 			#I image descriptor
+pointer fit
+
+begin
+	fit = IM_KDES(im)
+
+	call fxf_filter_keyw (im, "GROUPS")
+	call fxf_filter_keyw (im, "PSIZE")
+	call fxf_filter_keyw (im, "BLOCKED")
+	call fxf_filter_keyw (im, "IRAFNAME")
+	call fxf_filter_keyw (im, "IRAF-BPX")
+	call fxf_filter_keyw (im, "IRAFTYPE")
+
+	if (FIT_NEWIMAGE(fit) == NO)
+	    call fxf_filter_keyw (im, "EXTEND")
+
+	# Create a PHU.
+	if (FIT_NEWIMAGE(fit) == YES) {
+	    call fxf_filter_keyw (im, "PCOUNT")
+	    call fxf_filter_keyw (im, "GCOUNT")
+	    call fxf_filter_keyw (im, "INHERIT")
+	    call fxf_filter_keyw (im, "EXTNAME")
+	    call fxf_filter_keyw (im, "EXTVER")
+	    call fxf_filter_keyw (im, "EXTLEVEL")
+	}
+end
+
+
+# FXF_FILTER_KEYW -- Delete the names keyword from the userarea.
+
+procedure fxf_filter_keyw (im, key)
+
+pointer	im	 	 #I image descriptor
+char	key[ARB] 	 #I keyword name to delete from USERAREA.
+
+pointer rp
+int     off
+int     idb_findrecord(), stridxs()
+
+begin
+	# Verify that the named user field exists.
+	if (idb_findrecord (im, key, rp) <= 0)
+	    return
+
+        # Delete the field.
+        off = stridxs ("\n", Memc[rp])
+	if (off > 0)
+	    call strcpy (Memc[rp+off], Memc[rp], ARB)
+	else
+	    Memc[rp] = EOS
+end
+
+
+# FXF_FALLOC -- Preallocate space on disk by writing blanks.
+
+procedure fxf_falloc (fname, size)
+
+char	fname[ARB]	#I filename
+int	size      	#I size to preallocate in chars
+
+pointer sp, cp
+int	nb,i, fd
+errchk  open, write
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (cp, FITS_BLOCK_CHARS, TY_CHAR)
+	
+        call amovkc (' ', Memc[cp], FITS_BLOCK_CHARS)
+	nb = size / FITS_BLOCK_CHARS
+	fd = open (fname, NEW_FILE, BINARY_FILE)
+
+	do i = 1, nb
+	    call write (fd, Memc[cp], FITS_BLOCK_CHARS)
+
+	call flush (fd)
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# FXF_CKH_NDIM -- Check that the application has indeed set the number
+# of dimension, otherwise count the axes.
+
+procedure fxf_chk_ndim (im)
+
+pointer im		#I imio descriptor
+int	ndim		#I number of dimension for image
+
+begin
+	ndim = IM_NDIM(im)
+
+	# If ndim was not explicitly set, compute it by counting the number
+	# of nonzero dimensions.
+
+	if (ndim == 0) {
+	    for (ndim=1;  IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM; ndim=ndim+1)
+	        ;
+	    ndim = ndim - 1
+	    IM_NDIM(im) = ndim
+	}
+end
+
+        
+# FXF_NOT_INCACHE -- Procedure to find whether the file is in the
+# cache. It could happen that the slot with the entry might have been
+# freed to make room for another file. We want to have valid pointers
+# for FIT_CACHEHDR and FIT_CACHELEN since the calling routine will use them.
+
+procedure fxf_not_incache (im)
+
+pointer im                      #I image descriptor
+
+int     cindx, group, sfit[4]
+pointer sp, hdrfile, fit
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+        call salloc (hdrfile, SZ_PATHNAME, TY_CHAR) 
+
+        call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+        fit = IM_KDES(im)
+
+        do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+                next
+
+            if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+                call sfree (sp)
+                return      
+            }
+        }
+        sfit[1]= FIT_NAXIS(fit)
+        sfit[2] = FIT_INHERIT(fit)
+        sfit[3] = FIT_PLMAXLEN(fit)
+        sfit[4] = IM_CTIME(im)  
+
+        group = max (0, FIT_GROUP(fit))
+
+        call fxf_prhdr(im,group)
+
+        FIT_NAXIS(fit) = sfit[1]
+        FIT_INHERIT(fit) = sfit[2]
+        FIT_PLMAXLEN(fit) = sfit[3]
+        IM_CTIME(im) = sfit[4]
+
+        call sfree (sp)
+        return
+end
+
diff --git a/sys/imio/iki/fxf/fxfpak.x b/sys/imio/iki/fxf/fxfpak.x
new file mode 100644
index 00000000..01db148d
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfpak.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <mach.h>
+include "fxf.h"
+
+
+# FXF_PAK_DATA -- Convert npix elements of type pixtype as needed for storage
+# in a FITS file.  All floating point data will be converted to IEEE format.
+# The input and output buffers may be the same if desired.
+
+procedure fxf_pak_data (ibuf, obuf, npix, pixtype)
+
+char    ibuf[ARB]		#I input data buffer
+char    obuf[ARB]		#I output data buffer
+int	npix			#I number of pixels in buffer
+int	pixtype			#I input pixel datatype
+
+int	nbytes, nchars
+errchk	syserr
+
+include <szpixtype.inc>
+
+begin
+	### Possibly the MII conversion routines should be used here as
+	### they handle all these datatypes (except maybe ushort).
+
+	nchars = npix * pix_size[pixtype]
+	nbytes = nchars * SZB_CHAR
+
+	switch (pixtype) {
+	case TY_USHORT:
+	    call fxf_altmu (ibuf, obuf, npix)
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (obuf, 1, obuf, 1, nbytes)
+
+	case TY_SHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (ibuf, 1, obuf, 1, nbytes)
+	    else
+		call amovc (ibuf, obuf, nchars)
+
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (ibuf, 1, obuf, 1, nbytes)
+	    else
+		call amovc (ibuf, obuf, nchars)
+
+	case TY_REAL:
+	    call ieevpakr (ibuf, obuf, npix)
+
+	case TY_DOUBLE:
+	    call ieevpakd (ibuf, obuf, npix)
+
+	default:
+	   call syserr (SYS_FXFPKDTYP)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfplread.x b/sys/imio/iki/fxf/fxfplread.x
new file mode 100644
index 00000000..4d4c3e83
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfplread.x
@@ -0,0 +1,160 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <plset.h>
+include <imhdr.h>
+include <imio.h>
+include <mach.h>
+include "fxf.h"
+
+
+# FXF_PLREAD -- Read a PLIO mask stored in a FITS binary table extension
+# and load it into an image descriptor.
+#
+# There is a builtin assumption in this code (also in fxf_plwrite) that
+# masks will not be more than 3-dimensional.  This could be generalized
+# if necessary, but we have never seen a mask of dimensionality higher
+# than 3.  The dimensionality, size, and depth of the mask is preserved.
+
+procedure fxf_plread (im)
+
+pointer	im			#I image descriptor
+
+char	kwname[SZ_KEYWORD]
+pointer sp, fk, pl, lp, ip, ix
+long	data_offset, data_len, heap_offset, llen, loff
+int	naxes, axlen[IM_MAXDIM], depth, maxlen
+int	fd, i, j, nelem, nlines, v[PL_MAXDIM], maxoff, nbytes
+
+long	note()
+bool	streq()
+int	imgeti(), pl_create(), miireadi(), miireads()
+errchk	imgeti, pl_create, miireadi, miireads, seek, pl_update, syserrs
+
+begin
+	call smark (sp)
+
+	fk = IM_KDES(im)
+	fd = IM_HFD(im)
+
+	# The maximum encoded line list length is (normally) passed in via
+	# the binary table format keywords, and stored in FIT_PLMAXLEN.
+
+	maxlen = FIT_PLMAXLEN(fk)
+	if (maxlen <= 0)
+	    maxlen = DEF_PLMAXLEN
+
+	# Scratch buffer for encoded line lists.
+	call salloc (lp, maxlen, TY_SHORT)
+
+	# Get the dimensionality and size of the stored mask.
+	call amovki (1, axlen, IM_MAXDIM)
+	naxes = imgeti (im, "ZNAXIS")
+	call fxf_filter_keyw (im, "ZNAXIS")
+	do i = 1, naxes {
+	    call sprintf (kwname, LEN_CARD, "ZNAXIS%d")
+		call pargi(i)
+	    axlen[i] = imgeti (im, kwname)
+	    call fxf_filter_keyw (im, kwname)
+	    call sprintf (kwname, LEN_CARD, "ZTILE%d")
+		call pargi(i)
+	    call fxf_filter_keyw (im, kwname)
+	}
+
+	# Get the mask depth, passed as compression algorithm parameter
+	# number 1 for a PLIO-compressed image.
+
+	depth = DEF_PLDEPTH
+	ifnoerr (call imgstr (im, "ZNAME1", kwname, SZ_KEYWORD)) {
+	    if (streq (kwname, "depth"))
+		iferr (depth = imgeti (im, "ZVAL1"))
+		    depth = DEF_PLDEPTH
+	    call fxf_filter_keyw (im, "ZNAME1")
+	    call fxf_filter_keyw (im, "ZVAL1")
+	    call fxf_filter_keyw (im, "ZBITPIX")
+	    call fxf_filter_keyw (im, "ZIMAGE")
+	}
+
+	# Create an initially empty mask of the given size.
+	pl = pl_create (naxes, axlen, depth)
+
+	# Create a buffer for the line list index (maxdim 3 assumed).
+	nlines = axlen[3] * axlen[2]
+	call salloc (ix, nlines * 2, TY_INT)
+
+	# Compute the file offsets of the table data and heap areas.  The
+	# file position is assumed to be already positioned at the start
+	# of the data area of the file.
+
+	data_offset = note (fd)
+	data_len = FIT_LENAXIS(fk,3) * FIT_LENAXIS(fk,2) * FIT_LENAXIS(fk,1)
+	heap_offset = data_offset + data_len/SZB_CHAR
+
+	# Read the line list index from the input file.  The index contains
+	# one entry for every line in the (possibly multidimensional) image.
+	# Each entry consists of two integer values, the length of the
+	# stored line list, and the heap offset (in bytes) of the stored list.
+
+	nelem = miireadi (fd, Memi[ix], nlines * 2)
+	if (nelem != nlines * 2)
+	    call syserrs (SYS_FXFRMASK, IM_NAME(im))
+	
+	# Find out the maximum offset value to determine if they were
+	# written using the 2 byte units rather than the standard (byte unit)
+
+	maxoff = 0
+        ip = ix
+	do j = 1, axlen[3] {
+            do i = 1, axlen[2] {
+	       maxoff = max (maxoff, Memi[ip+1]+2*Memi[ip]) 
+   	       ip = ip + 2
+	    }
+	}
+
+	if (maxoff < (FIT_PCOUNT(fk) - maxoff/2)) {
+	    nbytes = 1
+        } else {	
+	    nbytes = 2
+	}
+
+	# Read the line list data and insert it into the PLIO mask.  
+	# pl_update will be called for each line of the mask even if multiple
+	# lines point to the same line list data, but pl_update will sort
+	# all this out and restore the multiple references as the mask is
+	# built.
+
+	ip = ix
+	v[1] = 1
+
+	do j = 1, axlen[3] {
+	    v[3] = j
+	    do i = 1, axlen[2] {
+		v[2] = i
+
+		llen = Memi[ip]
+
+		# This offset on the table data is in byte units, convert
+		# to short.
+
+		loff = Memi[ip+1] / nbytes
+
+		call seek (fd, heap_offset + loff)
+		nelem = miireads (fd, Mems[lp], llen)
+		if (nelem != llen)
+		    call syserrs (SYS_FXFRMASK, IM_NAME(im))
+
+		call pl_update (pl, v, Mems[lp])
+
+		ip = ip + 2
+	    }
+	}
+
+	# Set up IMIO descriptor.
+	call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+	call amovl (axlen, IM_PHYSLEN(im,1), IM_MAXDIM)
+        IM_NDIM(im) = naxes
+	IM_PIXTYPE(im) = TY_INT
+	IM_PL(im) = pl
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfplwrite.x b/sys/imio/iki/fxf/fxfplwrite.x
new file mode 100644
index 00000000..65909dcb
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfplwrite.x
@@ -0,0 +1,418 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <mach.h>
+include <imio.h>
+include <imhdr.h>
+include <mii.h>
+include <plset.h>
+include <pmset.h>
+include "fxf.h"
+
+
+# FXFPLWRITE.X -- Routines to handle masks in FITS extensions.
+#
+#	 fxf_plwrite     (im, fd)
+#	 fxf_plinfo      (im, maxlen, pcount, depth)
+#	 fxf_pl_adj_heap (im, hdr_fd, pcount)
+#        fxf_copy_adj    (im, in_fd, hdroff, poff, datasize)
+#	 fxf_plpf        (im)
+#
+
+
+# FXF_PLWRITE -- Write the data from a PLIO mask into the data area of a
+# FITS compressed image (ZIMAGE) binary table extension.  The data is
+# written to the file pointed to by file descriptor FD.
+#
+# The data to be written consists of the data for the ZIMAGE binary table
+# records, followed by the heap area of the BINTABLE extension, which
+# contains the actual encoded line lists.  For simplicity we assume that
+# the table contains only one column, the COMPRESSED_DATA column, which is
+# of type variable length integer array.  Each element of this column is a
+# BINTABLE variable length array descriptor which physically consists of two
+# integer values: an integer giving the length of the stored array (encoded
+# line list), followed by an integer (in byte unit) giving the offset of 
+# the array data (encoded line list) in the heap area.  Multiple variable 
+# length array descriptors may point to the same stored array, and in 
+# fact PLIO uses this feature to implement compression in the Y direction 
+# (adjacent mask lines will point to the same encoded line list).  
+# The code here supports masks of up to 3 dimensions.
+
+procedure fxf_plwrite (im, fd)
+
+pointer	im			#I image descriptor
+int	fd			#I output file descriptor
+
+int	i, j, v_in[PL_MAXDIM], lp_len
+int	naxes, axlen[PL_MAXDIM], depth
+int	heap_offset, ep_off, lp_off, vararray[2]
+pointer	pl, lp, op, emptyline, lastline
+
+int	pl_llen()
+pointer	pl_access(), pl_emptyline()
+errchk	pl_access
+
+begin
+	pl = IM_PL(im)
+	call pl_gsize (pl, naxes, axlen, depth)
+
+	# Write the COMPRESSED_DATA table column.  This is an index giving
+	# the length and heap offset of the encoded PLIO line list for each
+	# line of the image.  Multiple image lines (index entries) may point
+	# to the same stored line list: this happens if a mask line is empty
+	# (the empty line) or if successive lines are all the same.  For the
+	# sake of simplicity, only masks of up to 3 dimensions are supported.
+
+	op = 0
+	heap_offset = 0
+	emptyline = pl_emptyline (pl)
+	ep_off = -1
+	lastline = NULL
+	lp_off = -1
+	call amovkl(long(1), v_in, PL_MAXDIM)
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+
+		if (lp == emptyline && ep_off >= 0)
+		    op = ep_off
+	        else if (lp == lastline)
+		    op = lp_off
+		else
+		    op = heap_offset
+
+		vararray[1] = lp_len
+
+		# The offsets on the FITS BINTABLE is in byte unit 
+		# as establish by the FITS standard.
+
+		vararray[2] = op * 2              # Byte offset
+
+		call miiwritei (fd, vararray, 2)
+
+		lastline = lp
+		lp_off = op 
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = op
+
+		if (op == heap_offset)
+		    heap_offset = heap_offset + lp_len
+	    }
+	}
+	# Now write the line list data to the heap area.  The logic here must
+	# follow that above or the line offsets won't match.
+
+	ep_off = -1
+	lp_off = -1
+	lastline = NULL
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+
+		if (lp == emptyline && ep_off >= 0)
+		    next
+		else if (lp == lastline)
+		    next
+
+		call miiwrites (fd, Mems[lp], lp_len)
+
+		lastline = lp
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = 0
+	    }
+	}
+end
+
+
+# FXF_PLINFO -- Examine a PLIO mask and compute the maximum length of an
+# encoded line list, and the storage in bytes required to store the mask
+# data in the heap area of a FITS binary table.
+
+procedure fxf_plinfo (im, maxlen, pcount, depth)
+
+pointer	im			#I image descriptor
+int	maxlen			#O maximum line list length
+int	pcount			#O storage required to store mask (bytes)
+int	depth			#O mask depth
+
+int	naxes, axlen[PL_MAXDIM]
+int	i, j, v_in[PL_MAXDIM], lp_len
+int	heap_offset, ep_off, lp_off
+pointer	pl, lp, op, emptyline, lastline
+
+int	pl_llen()
+pointer	pl_access(), pl_emptyline()
+errchk	pl_access
+
+begin
+	pl = IM_PL(im)
+	call pl_gsize (pl, naxes, axlen, depth)
+
+	op = 0
+	maxlen = 0
+	heap_offset = 0
+	emptyline = pl_emptyline (pl)
+	ep_off = -1
+	lastline = NULL
+	lp_off = -1
+	call amovkl(long(1), v_in, PL_MAXDIM)
+
+	# The following must duplicate the logic above for determining what
+	# gets written to the heap area.  All we are doing here is computing
+	# the amount of heap storage required to store the compressed mask.
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+		maxlen = max (maxlen, lp_len)
+
+		if (lp == emptyline && ep_off >= 0)
+		    op = ep_off
+		else if (lp == lastline)
+		    op = lp_off
+		else
+		    op = heap_offset
+
+		lastline = lp
+		lp_off = op
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = op
+
+		if (op == heap_offset)
+		    heap_offset = heap_offset + lp_len
+	    }
+	}
+
+	pcount = heap_offset * (SZ_SHORT * SZB_CHAR)
+end
+
+
+# FXF_PL_ADJ_HEAP -- Resize heap when we have a hole bigger than 2880 bytes
+# or if we overwrite the next extension.
+
+procedure fxf_pl_adj_heap (im, hdr_fd, pcount)
+
+pointer	im			#I imio descriptor
+int	hdr_fd			#U file descriptor
+int	pcount			#I new heap size in bytes
+
+pointer fk, hdrp, pixp
+int	datasize, hdroff, diff, nb, group, i
+
+begin
+	fk = IM_KDES(im)
+
+	# Calculate the size of the TABLE data. (8 bytes per line)
+	datasize = FIT_LENAXIS(fk,1)*FIT_LENAXIS(fk,2)*
+		FIT_LENAXIS(fk,3)
+	datasize = (datasize + pcount)/SZB_CHAR
+
+	call fxf_not_incache(im)
+	hdrp = FIT_HDRPTR(fk)
+	pixp = FIT_PIXPTR(fk)
+	group = FIT_GROUP(fk)
+
+	hdroff = Memi[hdrp+group]
+
+	# Calculate the amount of space left  or grown in the heap
+	# as a result of the READ-WRITE operation on the data.
+
+	diff = datasize - (Memi[hdrp+group+1] - Memi[pixp+group])
+	
+	# See if the new data overwrites the next unit or
+	# there is a hole with more than 2880 bytes.
+
+	if ( (diff > 0) || ((-diff / 2880) > 0) ) {
+
+	    # Adjust the header and pixel offset for subsequent groups.
+	    # Add header size.
+	    datasize = datasize + Memi[pixp+group] - Memi[hdrp+group]
+	    call fxf_copy_adj (im, hdr_fd, hdroff, Memi[hdrp+group+1], datasize)
+
+	    if (diff > 0)
+		nb = FITS_LEN_CHAR (diff)
+	    else
+		nb = (diff / 1440) * 1440
+
+	    # Update FK cache offset values
+	    do i = group+1, FIT_NUMOFFS(fk) {
+	        Memi[hdrp+i] = Memi[hdrp+i] + nb
+		if (Memi[pixp+i] > 0) {
+		    Memi[pixp+i] = Memi[pixp+i] + nb
+		} else
+		    break
+	    }
+	}
+end
+
+
+# FXF_COPY_ADJ -- Make a copy of the input file extending or shrinking
+# the heap area.
+
+procedure fxf_copy_adj (im, in_fd, hdroff, poff, datasize)
+	
+pointer	im		#I Imio descriptor
+int	in_fd		#I Input file descriptor
+int	hdroff		#I Header offset
+int 	poff		#I Pixel offset
+int	datasize	#I New FITS unit size
+
+pointer sp, tempfile, outname
+int	nchars, junk, inoff, out_fd, size
+int	fnldir(), fnroot(), open(), note()
+errchk	open, note, seek, close, delete, rename
+errchk	fxf_make_adj_copy, fxf_write_blanks
+
+begin
+	call smark (sp)
+	call salloc (tempfile, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_FNAME, TY_CHAR)
+
+	nchars = fnldir (IM_HDRFILE(im), Memc[tempfile], SZ_FNAME)
+	junk = fnroot (IM_HDRFILE(im), Memc[tempfile+nchars], SZ_FNAME)
+	call mktemp (Memc[tempfile], Memc[outname], SZ_PATHNAME)
+	call strcat (".fits", Memc[outname], SZ_PATHNAME)
+
+	inoff = note (in_fd)
+	out_fd = open (Memc[outname], NEW_FILE, BINARY_FILE)
+
+	call fxf_make_adj_copy (in_fd, out_fd, hdroff, poff, datasize)
+
+	# Pad to 2880 bytes block
+	size =  note (out_fd) - 1
+	size = mod(size, FITS_BLOCK_CHARS)
+	if (size != 0) {
+	    size = FITS_BLOCK_CHARS - size
+	    call fxf_write_blanks (out_fd, size)
+	}
+
+	size = note (out_fd) - 1
+	call close (in_fd)
+	call delete (IM_HDRFILE(im))
+	call rename (Memc[outname], IM_HDRFILE(im))
+
+	in_fd = out_fd
+	call seek (in_fd, inoff)
+	call sfree (sp)
+end
+
+
+# FXF_PLPF -- Initialize IMIO dependencies when dealing with a PLIO
+# image mask.
+
+procedure fxf_plpf (im)
+
+pointer im				#I IMIO descriptor
+
+int	pfd
+pointer	sp, imname, ref_im
+int	sv_acmode, sv_update, ndim, i, depth
+errchk	iki_opix, open
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_IMNAME, TY_CHAR)
+
+	# Complete the initialization of a mask image.
+	ref_im = IM_PLREFIM(im)
+
+	sv_acmode = IM_ACMODE(im)
+	sv_update = IM_UPDATE(im)
+	call strcpy (IM_NAME(im), Memc[imname], SZ_IMNAME)
+
+	if (ref_im != NULL) {
+	    # Create a mask the same size as the physical size of the
+	    # reference image.  Inherit any image section from the
+	    # reference image.
+
+	    IM_NDIM(im) = IM_NDIM(ref_im)
+	    IM_NPHYSDIM(im) = IM_NPHYSDIM(ref_im)
+	    IM_SECTUSED(im) = IM_SECTUSED(ref_im)
+	    call amovl (IM_LEN(ref_im,1), IM_LEN(im,1), IM_MAXDIM)
+	    call amovl (IM_PHYSLEN(ref_im,1),IM_PHYSLEN(im,1),IM_MAXDIM)
+	    call amovl (IM_SVLEN(ref_im,1), IM_SVLEN(im,1), IM_MAXDIM)
+	    call amovl (IM_VMAP(ref_im,1), IM_VMAP(im,1), IM_MAXDIM)
+	    call amovl (IM_VOFF(ref_im,1), IM_VOFF(im,1), IM_MAXDIM)
+	    call amovl (IM_VSTEP(ref_im,1), IM_VSTEP(im,1), IM_MAXDIM)
+
+	    # Tell PMIO to use this image as the reference image.
+	    call pm_seti (IM_PL(im), P_REFIM, im)
+
+	} else if (sv_acmode == NEW_IMAGE || sv_acmode == NEW_COPY) {
+	    # If ndim was not explicitly set, compute it by counting
+	    # the number of nonzero dimensions.
+
+	    ndim = IM_NDIM(im)
+	    if (ndim == 0) {
+		ndim = 1
+		while (IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM)
+		    ndim = ndim + 1
+		ndim = ndim - 1
+		IM_NDIM(im) = ndim
+	    }
+
+	    # Make sure dimension stuff makes sense.
+	    if (ndim < 0 || ndim > IM_MAXDIM)
+		call imerr (IM_NAME(im), SYS_IMNDIM)
+
+	    do i = 1, ndim
+		if (IM_LEN(im,i) <= 0)
+		    call imerr (IM_NAME(im), SYS_IMDIMLEN)
+
+	    # Set the unused higher dimensions to 1.  This makes it
+	    # possible to access the image as if it were higher
+	    # dimensional, and in a way it truely is.
+
+	    do i = ndim + 1, IM_MAXDIM
+		IM_LEN(im,i) = 1
+
+	    IM_NPHYSDIM(im) = ndim
+	    call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	    call amovl (IM_LEN(im,1), IM_SVLEN(im,1), IM_MAXDIM)
+	    if (sv_acmode == NEW_IMAGE)
+		call amovkl (long(1), IM_VSTEP(im,1), IM_MAXDIM)	
+
+	    depth = PL_MAXDEPTH
+	    if (and (IM_PLFLAGS(im), PL_BOOL) != 0)
+                 depth = 1
+	    call pl_ssize (IM_PL(im), IM_NDIM(im), IM_LEN(im,1), depth)
+
+	}
+
+	call strcpy (Memc[imname], IM_NAME(im), SZ_IMNAME)
+	IM_ACMODE(im) = sv_acmode
+	IM_UPDATE(im) = sv_update
+	IM_PIXOFF(im) = 1	
+	IM_HGMOFF(im) = NULL
+	IM_BLIST(im) = NULL
+	IM_HFD(im) = NULL
+
+	pfd = open ("dev$null", READ_WRITE, BINARY_FILE)
+	IM_PFD(im) = pfd
+
+	# Execute this even if pixel file has already been opened.
+	call imsetbuf (IM_PFD(im), im)
+
+	# "Fast i/o" in the conventional sense no IMIO buffering)
+	# is not permitted for mask images, since IMIO must buffer
+	# the pixels, which are generated at run time.
+
+	if (IM_FAST(im) == YES) {
+	    IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_FAST)
+	    IM_FAST(im) = NO
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfrcard.x b/sys/imio/iki/fxf/fxfrcard.x
new file mode 100644
index 00000000..e025283e
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrcard.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <mii.h>
+include "fxf.h"
+
+# FXF_READ_CARD -- Read a FITS header card.
+
+int procedure fxf_read_card (fd, ibuf, obuf, ncards)
+
+int	fd			#I Input file descriptor
+char	ibuf[ARB]		#I input buffer
+char    obuf[ARB]		#O Output buffer
+int	ncards			#I ncards read so far
+
+int	ip, nchars_read
+int	read()
+errchk	read
+
+begin
+	# We read one FITS block first, read card from it until 36
+	# cards have been processed, where we read again.
+
+	if (mod (ncards, 36) == 0) {
+	    nchars_read = read (fd, ibuf, FITS_BLOCK_CHARS)
+	    if (nchars_read ==  EOF)
+	        return (EOF)
+	    call miiupk (ibuf, ibuf, FITS_BLOCK_BYTES, MII_BYTE, TY_CHAR)
+	    ip = 1
+	}
+	
+	call amovc (ibuf[ip], obuf, LEN_CARD)
+	ip = ip + LEN_CARD
+
+	return (LEN_CARD)
+end
diff --git a/sys/imio/iki/fxf/fxfrdhdr.x b/sys/imio/iki/fxf/fxfrdhdr.x
new file mode 100644
index 00000000..7cfc7855
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrdhdr.x
@@ -0,0 +1,176 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"fxf.h"
+
+
+# FXF_RHEADER -- Read a FITS header into the image descriptor and the 
+# internal FITS descriptor.
+
+procedure fxf_rheader (im, group, acmode)
+
+pointer	im			#I image descriptor
+int	group			#I group number to read
+int	acmode			#I access mode
+
+long	pixoff,	mtime
+pointer	sp, fit, lbuf, poff
+int	compress, devblksz, i, impixtype
+bool    bfloat, lscale, lzero
+bool    fxf_fpl_equald()
+int	strncmp()
+
+errchk	fxf_rfitshdr, realloc, syserr, syserrs
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	FIT_MAX(fit) = 0.0
+	FIT_MIN(fit) = 0.0
+	FIT_MTIME(fit) = 0.0
+	FIT_IM(fit) = im
+	FIT_OBJECT(fit) = EOS
+	IM_CLSIZE(im) = 0
+
+	# Read the header unit number 'group', setting the values of the 
+	# reserved fields in the FIT descriptor saving it in the FITS cache.
+
+	call fxf_rfitshdr (im, group, poff)
+
+	IM_MIN(im) = FIT_MIN(fit)
+	IM_MAX(im) = FIT_MAX(fit)
+	IM_MTIME(im) = FIT_MTIME(fit)
+	call strcpy (FIT_OBJECT(fit), IM_TITLE(im), LEN_CARD)
+
+	# If there is no group specification in the filename, group is -1;
+	# new group number is in FIT_GROUP.
+
+	group = FIT_GROUP(fit)
+	IM_CLINDEX(im) = group
+
+	# Process the reserved keywords (set in the FIT descriptor) into the
+	# corresponding fields of the IMIO descriptor.
+
+	if (acmode != NEW_COPY) {
+	    IM_NDIM(im) = FIT_NAXIS(fit)		# IM_NDIM
+	    do i = 1, IM_NDIM(im) {			# IM_LEN
+		IM_LEN(im,i) = FIT_LENAXIS(fit,i)
+		if (IM_LEN(im,i) == 0) {
+		    IM_NDIM(im) = 0
+		    break
+	        }
+	    }
+	}
+
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+
+	FIT_PIXTYPE(fit) = NULL
+	FIT_ZCNV(fit) = NO
+
+	switch (FIT_BITPIX(fit)) {
+	case  8:
+	    FIT_PIXTYPE(fit) = TY_UBYTE
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_SHORT              # convert from byte to short
+	    FIT_ZCNV(fit) = YES
+	case 16:
+	    FIT_PIXTYPE(fit) = TY_SHORT
+	    if (bfloat) {
+		impixtype = TY_REAL
+	        FIT_ZCNV(fit) = YES
+	    } else
+		impixtype = TY_SHORT
+
+	    if ((strncmp ("USHORT", FIT_DATATYPE(fit), 6) == 0) ||
+		    (lscale && fxf_fpl_equald (32768.0d0, FIT_BZERO(fit),4))) {
+		impixtype = TY_USHORT
+	        FIT_ZCNV(fit) = NO
+	    }
+	case 32:
+	    FIT_PIXTYPE(fit) = TY_INT
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_INT
+	case -32:
+	    FIT_PIXTYPE(fit) = TY_REAL
+	    impixtype = TY_REAL
+	case -64:
+	    FIT_PIXTYPE(fit) = TY_DOUBLE
+	    impixtype = TY_DOUBLE
+	default:
+	    impixtype = ERR
+	}
+
+	IM_PIXTYPE(im) = impixtype
+
+	IM_NBPIX(im)   = 0			# no. bad pixels
+	mtime = IM_MTIME(im)
+		
+	if (IM_MAX(im) > IM_MIN(im))
+	   IM_LIMTIME(im) = mtime + 1		# time max/min last updated
+	else
+	   IM_LIMTIME(im) = mtime - 1		# Invalidate DATA(MIN,MAX)
+	IM_HISTORY(im) = EOS
+
+	# Call up IMIO to set up the remaining image header fields used to
+	# define the physical offsets of the pixels in the pixfile.
+
+	compress = YES		# do not align image lines on blocks
+	devblksz = 1		# disable all alignment
+
+	pixoff = Memi[poff+group]
+	FIT_PIXOFF(fit) = pixoff
+	call imioff (im, pixoff, compress, devblksz)
+	
+	call sfree (sp)
+end
+
+
+# FXF_FPL_EQUALD -- Compare 2 double precision quantities up to a precision
+# given by a tolerance.
+
+bool procedure fxf_fpl_equald (x, y, it)
+
+double	x, y		#I Input quantities to be compare for equality
+int	it		#I Tolerance factor of 10 to compare the values
+
+int	ex, ey
+double	x1, x2, normx, normy, tol
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normd (x, normx, ex)
+	call fp_normd (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILOND * 10.0D0 * it
+	    x1 = 1.0D0 + abs (normx - normy)
+	    x2 = 1.0D0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfrename.x b/sys/imio/iki/fxf/fxfrename.x
new file mode 100644
index 00000000..677c02dd
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrename.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<error.h>
+include "fxf.h"
+
+
+# FIT_RENAME -- Rename a fits file. NOTE: There is no prevision at this
+# time to rename an extension.
+
+procedure fxf_rename (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		#I old image root name
+char	oextn[ARB]		#I old image extn
+char	nroot[ARB]		#I new image root name
+char	nextn[ARB]		#I old image extn
+int	status			#O status value
+
+pointer	sp
+int	cindx
+pointer	ohdr_fname, nhdr_fname
+bool	streq()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+
+	call fxf_init()
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	if (!streq (Memc[ohdr_fname], Memc[nhdr_fname])) {
+	    iferr (call rename (Memc[ohdr_fname], Memc[nhdr_fname]))
+		call erract (EA_WARN)
+	 
+	    # Update the cache with the new name.
+	    do cindx=1, rf_cachesize {
+	        if (rf_fit[cindx] == NULL)
+		    next
+	        # Rename the cached entry.
+	        if (streq (Memc[ohdr_fname], rf_fname[1,cindx]))
+		    call strcpy (Memc[nhdr_fname], rf_fname[1,cindx], SZ_FNAME)
+	    }
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfrfits.x b/sys/imio/iki/fxf/fxfrfits.x
new file mode 100644
index 00000000..30a8d5f7
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrfits.x
@@ -0,0 +1,1322 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <time.h>
+include <ctype.h>
+include <imhdr.h>
+include <imio.h>
+include <finfo.h>
+include <fset.h>
+include <mach.h>
+include <imset.h>
+include <error.h>
+include "fxf.h"
+
+# FXFRFITS.X -- Routines to load FITS header in memory and set up the cache
+# mechanism.
+
+define	LEN_UACARD_100	 8100
+define	LEN_UACARD_5	 405
+
+
+# FXF_RFITSHDR -- Procedure to read one or more FITS header while caching
+# the primary header, set the FITS memory structure for each
+# filename, the header and pixel offset from the beginning
+# and the EXTNAME and EXTVER value for each extension.
+
+procedure fxf_rfitshdr (im, group, poff)
+
+pointer im		#I image descriptor
+int	group		#I Group number to read
+int	poff		#O char offset the the pixel area in the FITS image
+
+long	fi[LEN_FINFO]
+pointer hoff,totpix, extn, extv
+pointer sp, fit, o_fit, lbuf, hdrfile, hdr
+int	cindx, cfit, user, fitslen, offs_count
+int	in, spool, slot, i, nrec1440, acmode
+
+bool	initialized, reload, extname_or_ver, ext_append
+data	initialized /false/
+int	rf_refcount
+
+bool	streq()
+long	cputime(), fstatl()
+
+int	finfo(), open(), stropen(), getline()
+
+errchk	putline, syserrs, seek, calloc, realloc, syserr
+errchk	fpathname, calloc, fxf_load_header, fxf_skip_xtn, fxf_read_xtn
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the header file cache on the first call.  The kernel
+	# doesn't appear to work with the cache completely deactivated, so
+	# the minimum cachesize is 1.
+
+	if (!initialized) {
+	    rf_refcount = 0
+	    do i = 1, MAX_CACHE
+		rf_fit[i] = 0
+	    rf_cachesize = max(1, min(MAX_CACHE, FKS_CACHESIZE(IM_KDES(im))))
+	    initialized = true
+	} else
+	    rf_refcount = rf_refcount + 1
+
+	o_fit = IM_KDES(im)
+	reload = false
+	slot = 1
+	# Get file system info on the desired header file.
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	if (finfo (Memc[hdrfile], fi) == ERR) 
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+        acmode = FIT_ACMODE(o_fit)
+	ext_append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	repeat {
+	    # Search the header file cache for the named image.
+	    do cindx = 1, rf_cachesize {
+		if (rf_fit[cindx] == NULL) {
+		   slot = cindx
+		   next
+		}
+		if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		    # File is in cache; is cached entry still valid?
+		    # If we are appending extension, do not reload from
+		    # disk.
+
+		    if (FI_MTIME(fi) != rf_mtime[cindx] && !ext_append) {
+			# File modify date has changed, reuse slot.
+			slot = cindx
+			break
+		    } 
+		    
+		    # For every non-empty file the fxf_open() call
+		    # pre reads every PHU, so that when the fxf_rdhdr()
+		    # comes, the cache entry is already here.
+
+		    # Return the cached header.
+		    rf_lru[cindx] = rf_refcount
+		    cfit = rf_fit[cindx]
+		    FIT_XTENSION(cfit) = FIT_XTENSION(o_fit)
+		    FIT_ACMODE(cfit) = FIT_ACMODE(o_fit)
+		    FIT_EXPAND(cfit) = FIT_EXPAND(o_fit)
+
+		    # Load Extend value from cache header entry to
+		    # the current fit struct entry.
+
+		    FIT_EXTEND(o_fit) = FIT_EXTEND(cfit)
+
+		    call amovi (FIT_ACMODE(cfit), FIT_ACMODE(o_fit),
+			LEN_FITBASE)
+		    hoff = rf_hdrp[cindx]
+		    poff = rf_pixp[cindx]
+		    extn = rf_pextn[cindx]
+		    extv = rf_pextv[cindx]
+		    FIT_GROUP(o_fit) = group
+		    FIT_HDRPTR(o_fit) = hoff
+		    FIT_PIXPTR(o_fit) = poff
+
+		    extname_or_ver = (FKS_EXTNAME(o_fit) != EOS ||
+			!IS_INDEFL (FKS_EXTVER(o_fit)))
+
+		    # If the group number or extname_or_ver has not been
+		    # specified we need to load the group number where there
+		    # is data i.e., FIT_NAXIS != 0. The 'cfit' structure would
+		    # have this group number.
+
+		    if (group == -1 && !extname_or_ver) {
+			if (FIT_GROUP(cfit) != -1) {
+			    group = FIT_GROUP(cfit)
+			    FIT_GROUP(o_fit) = group
+
+			} else if (FIT_NAXIS(cfit) != 0) {
+			    # See if the main FITS unit has data when
+			    # group = -1 is specified.
+
+			    group = 0
+			    FIT_GROUP(cfit) = 0
+			    FIT_GROUP(o_fit) = 0
+			}	
+		    }
+
+		    # The main header has already been read at this point,
+		    # now merge with UA.
+
+		    if (group == 0) {
+			hdr = rf_hdr[cindx]
+			fitslen = rf_fitslen[cindx]
+			FIT_EXTEND(o_fit) = FIT_EXTEND(cfit)
+			call fxf_merge_w_ua (im, hdr, fitslen)
+
+		    } else {
+			# Read intermediate xtension headers if not in
+			# hoff and poff yet.
+			offs_count = FIT_NUMOFFS(cfit)
+			call fxf_read_xtn (im,
+			    cfit, group, hoff, poff, extn, extv)
+		    } 
+
+		    # IM_CTIME takes the value of the DATE keyword
+		    if (IM_CTIME(im)==0) {
+			IM_CTIME(im) = FI_CTIME(fi)
+		    }
+
+		    # FIT_MTIME takes the value of keyword IRAF-TLM.
+		    # If not present use the mtime from the finfo value.
+
+		    if (FIT_MTIME(cfit) == 0) {
+			FIT_MTIME(cfit) = FI_MTIME(fi)
+		    }
+
+		    # Invalidate entry if cache is disabled.
+		    if (rf_cachesize <= 0)
+			rf_time[cindx] = 0
+
+		    call sfree (sp)
+		    return				# IN CACHE
+
+		} else {
+		    # Keep track of least recently used slot.
+		    if (rf_lru[cindx] < rf_lru[slot])
+			slot = cindx
+		}
+	    }
+
+	    # Either the image header is not in the cache, or the cached
+	    # entry is invalid.	 Prepare the given cache slot and read the
+	    # header into it.
+
+	    # Free old save buffer and descriptor.
+	    if (rf_fit[slot] != NULL) {
+		call mfree (rf_pextv[slot], TY_INT)
+		call mfree (rf_pextn[slot], TY_CHAR)
+		call mfree (rf_pixp[slot], TY_INT)
+		call mfree (rf_hdrp[slot], TY_INT)
+		call mfree (rf_fit[slot], TY_STRUCT)
+		call mfree (rf_hdr[slot], TY_CHAR)
+		rf_fit[slot] = NULL
+		rf_lru[slot] = 0
+		rf_fname[1,slot] = EOS
+	    }
+
+	    # Allocate a spool file for the FITS data.
+	    spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	    # Allocate cache version of FITS descriptor.
+	    call calloc (fit, LEN_FITBASE, TY_STRUCT)
+	    call calloc (hoff, MAX_OFFSETS, TY_INT) 
+	    call calloc (poff, MAX_OFFSETS, TY_INT) 
+	    call calloc (extn, MAX_OFFSETS*LEN_CARD, TY_CHAR) 
+	    call calloc (extv, MAX_OFFSETS, TY_INT) 
+
+	    # Initialize the entries.
+	    call amovki (INDEFL, Memi[extv], MAX_OFFSETS)
+	    call aclrc (Memc[extn], MAX_OFFSETS)
+	    call amovki (-1, Memi[poff], MAX_OFFSETS)
+
+	    FIT_GROUP(fit) = -1
+	    FIT_HDRPTR(fit) = hoff
+	    FIT_PIXPTR(fit) = poff
+	    FIT_NUMOFFS(fit) = MAX_OFFSETS
+	    FIT_ACMODE(fit) = FIT_ACMODE(o_fit)
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+	    FIT_XTENSION(fit) = NO
+	    FIT_EXTNAME(fit) = EOS
+	    FIT_EXTVER(fit) = INDEFL
+	    FIT_EXTEND(fit) = -3
+
+	    # Initialize the cache entry.
+	    call strcpy (Memc[hdrfile], rf_fname[1,slot], SZ_PATHNAME)
+	    rf_fit[slot] = fit
+	    rf_hdrp[slot] = hoff
+	    rf_pixp[slot] = poff
+	    rf_pextn[slot] = extn
+	    rf_pextv[slot] = extv
+	    rf_lru[slot] = rf_refcount
+	    rf_mtime[slot] = FI_MTIME(fi)
+
+	    if (!reload)
+		rf_time[slot] = cputime (0)
+
+	    reload = true
+
+	    in = IM_HFD(im)
+	    call seek (in, BOFL)
+	    
+	    # Read main FITS header and copy to spool fd.
+	    FIT_IM(fit) = im
+	    call amovki (1, FIT_LENAXIS(fit,1), IM_MAXDIM)
+
+	    call fxf_load_header (in, fit, spool, nrec1440, totpix)
+
+
+	    # Record group 0 (PHU) as having just been read.
+	    FIT_GROUP(fit) = 0
+
+	    call seek (spool, BOFL)
+	    fitslen = fstatl (spool, F_FILESIZE)
+
+	    # Prepare cache area to store the FITS header.
+	    call calloc (hdr, fitslen, TY_CHAR)
+	    user = stropen (Memc[hdr], fitslen, NEW_FILE)
+	    rf_hdr[slot] = hdr
+	    rf_fitslen[slot] = fitslen
+	    FIT_CACHEHDR(fit) = hdr
+	    FIT_CACHEHLEN(fit) = fitslen
+
+	    # Append the saved FITS cards to saved cache.
+	    while (getline (spool, Memc[lbuf]) != EOF) 
+		call putline (user, Memc[lbuf])
+
+	    call close (user)
+	    call close (spool)
+	    
+	    # Group 0 (i.e. Main Fits unit)
+	    Memi[hoff] = 1	       # beginning of primary h.u.
+	    Memi[poff] = nrec1440 + 1  # first pixel data of main u.
+
+	    # Set group 1 offsets.
+	    Memi[hoff+1] = Memi[poff] + totpix
+	    Memi[poff+1] = -1
+	}
+
+        call sfree (sp)
+end
+
+
+# FXF_READ_XTN -- Procedure to read a FITS extension header and at the same
+# time make sure that the EXTNAME and EXTVER values are not repeated 
+# with those in the cache.
+
+procedure fxf_read_xtn (im, cfit, igroup, hoff, poff, extn, extv)
+
+pointer im			#I Image descriptor
+pointer cfit			#I Cached FITS descriptor
+int	igroup			#I Group number to process
+pointer hoff			#I Pointer to header offsets array
+pointer poff			#I Pointer to pixel offsets array
+pointer extn			#I Pointer to extname's array
+pointer extv			#I Pointer to extver's array
+
+char	messg[SZ_LINE]
+pointer lfit, sp, po, ln
+int	spool, ig, acmode, i
+int	fitslen, xtn_hd, nrec1440, totpix, in, group
+int	strcmp(), getline()
+long	offset, fstatl()
+int	open(), fxf_extnv_error()
+bool	ext_append, get_group
+
+errchk	fxf_load_header, fxf_skip_xtn, syserr, syserrs
+define	rxtn_ 91
+
+begin
+	# Allocate a spool file for the FITS header.
+	spool = open ("FITSHDRX", READ_WRITE, SPOOL_FILE)
+
+	lfit = IM_KDES(im)
+	group = FIT_GROUP(lfit)
+	acmode = FIT_ACMODE(lfit)
+	ext_append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+
+	# If we have 'overwrite' in the ksection then look for the
+	# existent extname/extver we want to overwrite since we don't
+	# want to append.
+
+	if (FKS_OVERWRITE(lfit) == YES)
+	    ext_append = false
+
+	# See if we want to look at an extension given the EXT(NAME,VER)
+	# field in the ksection.
+
+	if (FKS_EXTNAME(lfit) != EOS || !IS_INDEFL (FKS_EXTVER(lfit))) {
+	    ig = 1
+	    repeat {
+		call fseti (spool, F_CANCEL, YES)
+		xtn_hd = NO
+
+		# Has last extension header been read?
+		if (Memi[poff+ig] <= 0) { 
+		    iferr {
+			call fxf_skip_xtn (im,
+			    ig, cfit, hoff, poff, extn, extv, spool)
+			xtn_hd = YES
+		    } then {
+			if (ext_append) {
+			    # We have reach the end of extensions.
+			    FIT_GROUP(lfit) = -1    # message for fxf_updhdr
+			    return
+			} else {
+			    call fxf_form_messg (lfit, messg)
+			    call syserrs (SYS_FXFRFNEXTNV, messg)
+			}
+		    } else {	
+			# If we want to append an extension then.
+			if (ext_append && FKS_DUPNAME(lfit) == NO)
+			    if (fxf_extnv_error (lfit, ig, extn, extv) == YES) {
+				call fxf_form_messg (lfit, messg)
+				call syserrs (SYS_FXFOPEXTNV, messg)
+			    } 
+		    }
+		}
+
+		if (fxf_extnv_error (lfit, ig, extn, extv) == YES) {
+		    # We have matched either or both FKS_EXTNAME and FKS_EXTVER
+		    # with the values in the cache.
+
+		    if (ext_append && FKS_DUPNAME(lfit) == NO)	{
+			call fxf_form_messg (lfit, messg)
+			call syserrs (SYS_FXFOPEXTNV, messg)
+		    } 
+		    group = ig
+		    FIT_GROUP(lfit) = ig
+		    goto rxtn_
+
+		} else {
+		    ig = ig + 1
+		    next
+		}
+	    }
+
+	} else {
+	    # No extname or extver specified.
+	    # Read through the Extensions until group number is reached;
+	    # if no number is supplied, read until EOF to load header and
+	    # pixel offsets necessary to append and extension.
+	    
+	    if (igroup == -1 && FIT_GROUP(cfit) == -1)
+		group = MAX_INT
+
+	    # We are trying to get the first group that meets these condition.
+	    get_group = (FIT_GROUP(cfit) == -1 && igroup == -1) 
+
+	    do ig = 0, group  {
+		xtn_hd = NO
+
+		# Has last extension header been read?
+		if (Memi[poff+ig] <= 0 ) {
+		    call fseti (spool, F_CANCEL, YES)
+		    iferr {
+			call fxf_skip_xtn (im,
+			    ig, cfit, hoff, poff, extn, extv, spool)
+			xtn_hd = YES
+		    } then {
+			if (ext_append) {
+			    # We have reach the end of extensions.
+			    FIT_GROUP(lfit) = -1    # message for fxf_updhdr
+			    return
+			} else {
+			    call syserrs (SYS_FXFRFEOF, IM_NAME(im))
+			    return
+			}
+		    }
+
+		    # Mark the first group that contains an image
+		    # i.e. naxis != 0. 
+
+		    if (FIT_NAXIS(lfit) != 0 && 
+			    strcmp ("IMAGE", FIT_EXTTYPE(lfit)) == 0) {
+			if (get_group) {
+			    FIT_GROUP(cfit) = ig   # save on cache fits struct
+			    FIT_GROUP(lfit) = ig   # also on current
+			    break
+			} else if (FIT_GROUP(cfit) <= 0)
+			    FIT_GROUP(cfit) = ig 
+		    }
+	       }
+	    }
+	}
+rxtn_
+	if (xtn_hd == NO) {
+	    in = IM_HFD(im)
+	    offset = Memi[hoff+group]
+	    call seek (in, offset)
+	    FIT_IM(lfit) = im
+	    call fseti (spool, F_CANCEL, YES)
+	    call fxf_load_header (in, lfit, spool, nrec1440, totpix)
+	}
+
+	# If requested a non supported BINTABLE format, post an error
+	# message and return to the caller.
+
+	if (strcmp(FIT_EXTTYPE(lfit), "BINTABLE") == 0) {
+	    if (strcmp(FIT_EXTSTYPE(lfit), "PLIO_1") != 0) {
+	        call close (spool)
+		call syserrs (SYS_IKIEXTN, IM_NAME(im))
+            }
+	}
+	
+	# Merge Image Extension header to the user area.
+	fitslen = fstatl (spool, F_FILESIZE)
+
+	# Copy the spool array into a static array. We cannot reliable
+	# get the pointer from the spool file.
+	call smark (sp)
+	call salloc (ln, LEN_UACARD, TY_CHAR)
+
+	if (po != NULL)
+	    call mfree(po, TY_CHAR)
+	call calloc (po, fitslen+1, TY_CHAR)
+
+	i = po
+	call seek (spool, BOFL)
+	while (getline (spool, Memc[ln]) != EOF) {
+
+	    call amovc (Memc[ln], Memc[i], LEN_UACARD)
+	    i = i + LEN_UACARD
+	}
+	Memc[i] = EOS
+
+	# Make the user aware that they cannot use inheritance
+	# if the PDU contains a data array.
+
+	if (Memi[poff] != Memi[hoff+1]) {
+	    if (FKS_INHERIT(lfit) == YES) {
+		call syserr (SYS_FXFBADINH)
+	    }
+	} else {
+	    # Disable inheritance if PHDU has a DU.
+	    if (Memi[poff+0] != Memi[hoff+1])
+		FIT_INHERIT(lfit) = NO
+	}
+
+	# Reset the value of FIT_INHERIT if FKS_INHERIT is set
+	if (FKS_INHERIT(lfit) != NO_KEYW)
+	    FIT_INHERIT(lfit) = FKS_INHERIT(lfit)
+
+	if (FIT_TFIELDS(lfit) > 0) {
+	    fitslen = fitslen + FIT_TFIELDS(lfit)*LEN_UACARD
+	    call realloc (po, fitslen, TY_CHAR)
+        }
+
+	call fxf_merge_w_ua (im, po, fitslen)
+
+	call mfree (po, TY_CHAR)
+
+	call sfree (sp)
+	call close (spool)
+end
+
+
+# FXF_EXTNV_ERROR -- Integer boolean function (YES,NO) to find out if the
+# value of kernel section parameter FKS_EXTNAME and FKS_EXTVER are not
+# repeated in the cache pointed by extn and extv.
+
+int procedure fxf_extnv_error (fit, ig, extn, extv)
+
+pointer fit			#I fit descriptor
+int	ig			#I extension number
+pointer extn, extv		#I pointers to arrays for extname and extver 
+
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+int	fxf_strcmp_lwr()
+
+begin
+	bxtn = (FKS_EXTNAME(fit) != EOS)
+	bxtv = (!IS_INDEFL (FKS_EXTVER(fit)))
+
+	if (bxtn)
+	    bxtn_eq =
+		(fxf_strcmp_lwr(FKS_EXTNAME(fit), Memc[extn+LEN_CARD*ig]) == 0)
+	if (bxtv)
+	    bxtv_eq = (FKS_EXTVER(fit) == Memi[extv+ig])
+	
+	if (bxtn && bxtv) {
+	    # Since both FKS_EXTNAME and FKS_EXTVER are defined, see if they
+	    # repeated in the cache.
+
+	    bval = (bxtn_eq && bxtv_eq)
+
+	} else if (bxtn && !bxtv) {
+	    # We have a duplicated in this case when extver in the image
+	    # header is INDEFL.
+
+	    bval = bxtn_eq
+
+	} else if (!bxtn && bxtv) {
+	    # If the FKS_EXTNAME is not defined (i.e. EOS) and the FKS_EXTVER
+	    # value is the same as the cached, then we have a match.
+
+	    bval = bxtv_eq 
+
+	} else
+	    bval = false
+	
+	if (bval)
+	    return (YES)
+	else
+	    return (NO)
+end
+
+
+# FXF_SKIP_XTN -- Skip over a FITS extension.  The procedure will read the
+# current extension header and calculates the respectives offset for later
+# usage.
+
+procedure fxf_skip_xtn (im, group, cfit, hoff, poff, extn, extv, spool)
+
+pointer im			#I image descriptor
+int	group			#I groupheader number to read
+pointer cfit			#I cached fits descriptor
+pointer hoff			#I extension header offset
+pointer poff			#I extension data offset
+pointer extn			#I points to the array of extname
+pointer extv			#I points to the arrays of extver
+
+pointer sp, lfit, fit, hdrfile
+bool    streq()
+int	spool, in, nrec1440, totpix, i, k, cindx
+long	offset
+errchk	fxf_load_header
+int	strcmp()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (lfit, LEN_FITBASE, TY_STRUCT)
+        call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fit = IM_KDES(im)
+
+	# Allocate more memory for offsets in case we are pass MAX_OFFSETS.
+	if (group >= FIT_NUMOFFS(cfit)) {
+	    FIT_NUMOFFS(cfit) = FIT_NUMOFFS(cfit) + MAX_OFFSETS 
+	    call realloc (hoff, FIT_NUMOFFS(cfit), TY_INT)
+	    call realloc (poff, FIT_NUMOFFS(cfit), TY_INT)
+	    call realloc (extn, FIT_NUMOFFS(cfit)*LEN_CARD, TY_CHAR)
+	    call realloc (extv, FIT_NUMOFFS(cfit), TY_INT)
+
+	    offset = FIT_NUMOFFS(cfit) - MAX_OFFSETS
+	    call amovki (INDEFL, Memi[extv+offset], MAX_OFFSETS)
+	    call amovki (-1, Memi[poff+offset], MAX_OFFSETS)
+
+	    do i = 0,  MAX_OFFSETS-1  {
+		k = (offset+i)*LEN_CARD
+		Memc[extn+k] = EOS
+	    }
+	 
+	    # Update the fits structure with the new pointer values
+	    call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	    fit = IM_KDES(im)
+	    do cindx = 1, rf_cachesize {
+	        if (rf_fit[cindx] == NULL)
+	            next
+	        if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+	            rf_pextn[cindx] = extn
+		    rf_pextv[cindx] = extv
+		    rf_hdrp[cindx] = hoff
+		    rf_pixp[cindx] = poff
+		    FIT_HDRPTR(fit) = hoff
+		    FIT_PIXPTR(fit) = poff
+	        }
+	    }
+	}
+		
+	in = IM_HFD(im)
+	offset = Memi[hoff+group]
+
+	call seek (in, offset)
+	lfit = IM_KDES(im)
+	FIT_IM(lfit) = im
+	call fxf_load_header (in, lfit, spool, nrec1440, totpix)
+
+	# Record the first group that has NAXIS !=0 and is an IMAGE.
+	if (FIT_GROUP(cfit) == -1) {
+	    if (FIT_NAXIS(lfit) != 0 &&
+		    strcmp ("IMAGE", FIT_EXTTYPE(lfit)) == 0)
+		FIT_GROUP(cfit) = group
+	}
+
+	Memi[poff+group] = Memi[hoff+group] + nrec1440
+	# The offset for the beginning of next group.
+	Memi[hoff+group+1] = Memi[poff+group] + totpix
+
+	# Mark next group pixel offset in case we are at EOF.
+	Memi[poff+group+1] = -1
+	call strcpy (FIT_EXTNAME(lfit), Memc[extn+LEN_CARD*group], LEN_CARD) 
+	Memi[extv+group] = FIT_EXTVER(lfit)
+
+	call sfree (sp)
+end
+
+
+# FXF_LOAD_HEADER -- Load a FITS header from a file descriptor into a
+# spool file.
+
+procedure fxf_load_header (in, fit, spool, nrec1440, datalen)
+
+int	in			#I input FITS header file descriptor
+pointer fit			#I FITS descriptor
+int	spool			#I spool output file descriptor
+int	nrec1440		#O number of 1440 char records output
+int	datalen			#O length of data area in chars
+
+int	ncols
+pointer lbuf, sp, im, stime, fb, ttp
+int	totpix, nchars, nbytes, index, ncards, simple, i, pcount, junk
+int	fxf_read_card(), fxf_ctype(), ctoi(), strsearch()
+bool	fxf_fpl_equald()
+errchk	syserr, syserrs
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (stime, LEN_CARD, TY_CHAR)
+	call salloc (fb, FITS_BLOCK_BYTES, TY_CHAR)
+
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+	FIT_EXTNAME(fit) = EOS
+	FIT_EXTVER(fit) = INDEFL
+	im = FIT_IM(fit)
+
+	# Read successive lines of the FITS header. 
+	nrec1440 = 0
+	pcount = 0
+	ncards = 0
+
+	repeat {
+	    # Get the next input line.
+	    nchars = fxf_read_card (in, Memc[fb], Memc[lbuf], ncards)
+	    if (nchars == EOF) {
+		call close (spool)
+		call syserrs (SYS_FXFRFEOF, IM_NAME(im))
+            }
+	    ncards = ncards + 1
+
+	    # A FITS header card already has 80 chars, just add the newline.
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+
+	    # Process the header card.
+	    switch (fxf_ctype (Memc[lbuf], index)) {
+	    case KW_END:
+		nrec1440 = FITS_LEN_CHAR(ncards*40)
+		break
+	    case KW_SIMPLE:
+		call strcpy ("SIMPLE", FIT_EXTTYPE(fit), SZ_EXTTYPE)
+		call fxf_getb (Memc[lbuf], simple)
+		FIT_EXTEND(fit) = NO_KEYW
+		if (simple == NO)
+		    call syserr (SYS_FXFRFSIMPLE)
+	    case KW_EXTEND:
+		call putline (spool, Memc[lbuf])
+		call fxf_getb (Memc[lbuf], FIT_EXTEND(fit)) 
+	    case KW_XTENSION:
+		FIT_XTENSION(fit) = YES 
+		call fxf_gstr (Memc[lbuf], FIT_EXTTYPE(fit), SZ_EXTTYPE)
+	    case KW_EXTNAME:
+		call fxf_gstr (Memc[lbuf], FIT_EXTNAME(fit), LEN_CARD)
+		call putline (spool, Memc[lbuf])
+	    case KW_EXTVER:
+		call fxf_geti (Memc[lbuf], FIT_EXTVER(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_ZCMPTYPE:
+		call fxf_gstr (Memc[lbuf], FIT_EXTSTYPE(fit), SZ_EXTTYPE)
+	    case KW_PCOUNT:
+		call fxf_geti (Memc[lbuf], pcount)
+		call putline (spool, Memc[lbuf])
+		FIT_PCOUNT(fit) = pcount
+	    case KW_INHERIT:
+		call fxf_getb (Memc[lbuf], FIT_INHERIT(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_BITPIX:
+		call fxf_geti (Memc[lbuf], FIT_BITPIX(fit))
+	    case KW_DATATYPE:
+		call fxf_gstr (Memc[lbuf], FIT_DATATYPE(fit), SZ_DATATYPE)
+	    case KW_NAXIS:
+		if (index == 0) {
+		    call fxf_geti (Memc[lbuf], FIT_NAXIS(fit))
+		    if (FIT_NAXIS(fit) < 0 )
+			call syserr (SYS_FXFRFBNAXIS)
+	  	} else
+		    call fxf_geti (Memc[lbuf], FIT_LENAXIS(fit,index))
+	    case KW_BSCALE:
+		call fxf_getd (Memc[lbuf], FIT_BSCALE(fit))
+		# If BSCALE is like 1.00000011 reset to 1.0.
+		if (fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 4))
+		    FIT_BSCALE(fit) = 1.0d0
+		call putline (spool, Memc[lbuf])
+	    case KW_BZERO:
+		call fxf_getd (Memc[lbuf], FIT_BZERO(fit))
+		# If BZERO is like 0.00000011 reset to 0.0.
+		if (fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 4))
+		    FIT_BZERO(fit) = 0.0d0
+		call putline (spool, Memc[lbuf])
+	    case KW_DATAMAX:
+		call fxf_getr (Memc[lbuf], FIT_MAX(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_DATAMIN:
+		call fxf_getr (Memc[lbuf], FIT_MIN(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_TFIELDS:
+		# Allocate space for TFORM and TTYPE keyword values
+		call fxf_geti (Memc[lbuf], ncols)
+		FIT_TFIELDS(fit) = ncols
+		if (FIT_TFORMP(fit) != NULL) {
+		    call mfree (FIT_TFORMP(fit), TY_CHAR)
+		    call mfree (FIT_TTYPEP(fit), TY_CHAR)
+	        }
+		call calloc (FIT_TFORMP(fit), ncols*LEN_FORMAT, TY_CHAR)
+		call calloc (FIT_TTYPEP(fit), ncols*LEN_OBJECT, TY_CHAR)
+	    case KW_TFORM:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		if (index == 1) {
+		    # PLMAXLEN is used to indicate the maximum line list
+		    # length for PLIO masks in bintables.  The syntax
+		    # "PI(maxlen)" is used in bintables to pass the max
+		    # vararray length for a column.
+
+		    i = strsearch (Memc[stime], "PI(") 
+		    if (i > 0)
+			junk = ctoi (Memc[stime], i, FIT_PLMAXLEN(fit))
+		}
+	    case KW_TTYPE:
+		ttp = FIT_TTYPEP(fit) + (index-1)*LEN_OBJECT
+		call fxf_gstr (Memc[lbuf], Memc[ttp], LEN_CARD)
+	    case KW_OBJECT:
+		# Since only OBJECT can go into the header and IM_TITLE has its
+		# values as well, we need to save both to see which one has
+		# changed at closing time.
+
+		call fxf_gstr (Memc[lbuf], FIT_OBJECT(fit), LEN_CARD)
+		if (FIT_OBJECT(fit) == EOS)
+		    call strcpy ("        ", FIT_OBJECT(fit), SZ_KEYWORD)
+		call strcpy (FIT_OBJECT(fit), FIT_TITLE(fit), LEN_CARD)
+		call strcpy (FIT_OBJECT(fit), IM_TITLE(im), LEN_CARD)
+		call putline (spool, Memc[lbuf])
+	    case KW_IRAFTLM:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		call fxf_date2limtime (Memc[stime], FIT_MTIME(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_DATE:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		call fxf_date2limtime (Memc[stime], IM_CTIME(im))
+		call putline (spool, Memc[lbuf])
+	    default:
+		call putline (spool, Memc[lbuf])
+	    }
+	}
+
+	# Calculate the length of the data area of the current extension,
+	# measured in SPP chars and rounded up to an integral number of FITS
+	# logical blocks.
+
+	if (FIT_NAXIS(fit) != 0) {
+	    totpix =  FIT_LENAXIS(fit,1)
+	    do i = 2, FIT_NAXIS(fit)
+		totpix = totpix * FIT_LENAXIS(fit,i)
+
+	    # Compute the size of the data area (pixel matrix plus PCOUNT)
+	    # in bytes.  Be careful not to overflow a 32 bit integer.
+
+	    nbytes = (totpix + pcount) * (abs(FIT_BITPIX(fit)) / NBITS_BYTE)
+
+	    # Round up to fill the final 2880 byte FITS logical block.
+	    nbytes = ((nbytes + 2880-1) / 2880) * 2880
+
+	    datalen = nbytes / SZB_CHAR
+
+	} else
+	    datalen = 0
+
+	call sfree (sp)
+end
+
+
+# FXF_MERGE_W_UA --  Merge a spool user area with the im_userarea.
+
+procedure fxf_merge_w_ua (im, userh, fitslen) 
+
+pointer im		#I image descriptor
+int	userh		#I pointer to user area spool
+int	fitslen		#I length in chars of the user area
+
+bool	inherit
+pointer sp, lbuf, ua, ln
+int	elen, elines, nbl, i, k
+int	sz_userarea, merge, len_hdrmem, fit, clines, ulines
+bool	fxf_is_blank()
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (ln, LEN_UACARD, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	# FIT_INHERIT has the logically combined value of the fkinit inherit's
+	# value, if any; the ksection value, if any and the INHERIT value in
+	# the extension header.
+
+	inherit = (FIT_INHERIT(fit) == YES)
+	inherit = (inherit && (FIT_GROUP(fit) != 0))
+
+	# Reallocate the image descriptor to allow space for the spooled user
+	# FITS cards plus a little extra for new parameters.
+
+	sz_userarea = fitslen + SZ_EXTRASPACE
+	# Add size of main header if necessary.
+	if (inherit)
+	    sz_userarea = sz_userarea + FIT_CACHEHLEN(fit)
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+
+	# Copy the extension header to the USERAREA if not inherit or copy
+	# the global header plus the extension header if inherit is set.
+
+	if (fitslen > 0) {
+	    ua = IM_USERAREA(im)
+	    elen = fitslen
+
+	    if (inherit) {
+		# First, copy those cards in the global header that 
+		# are not in the current extension header.
+
+		clines = strlen (Memc[FIT_CACHEHDR(fit)])
+		ulines = strlen (Memc[userh])
+		clines = clines / LEN_UACARD
+		ulines = ulines / LEN_UACARD
+		merge = YES
+		call fxf_match_str (FIT_CACHEHDR(fit),
+		    clines, userh, ulines, merge, ua)
+		elen = LEN_UACARD * ulines
+	    }
+
+	    # Append the extension header to the UA.
+	    elines = elen / LEN_UACARD
+	    k = userh
+	    nbl = 0
+
+	    do i = 1, elines {
+		call strcpy (Memc[k], Memc[ln], LEN_UACARD)
+		if (fxf_is_blank (Memc[ln]))
+		    nbl = nbl + 1
+		else {
+		    # If there are blank cards, add them.
+		    if (nbl > 0)
+			call fxf_blank_lines (nbl, ua)
+		    call amovc (Memc[ln], Memc[ua], LEN_UACARD)
+		    ua = ua + LEN_UACARD
+		}
+		k = k + LEN_UACARD
+	    }
+
+	    Memc[ua] = EOS
+	}	
+	call sfree (sp)
+end
+
+
+# FXF_STRCMP_LWR -- Compare 2 strings in lower case mode.
+
+int procedure fxf_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]		#I strings to be compare for equality
+
+int	istat
+pointer sp, l1, l2
+int	strcmp()
+
+begin
+	call smark (sp)
+	call salloc (l1, LEN_CARD, TY_CHAR)
+	call salloc (l2, LEN_CARD, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], LEN_CARD)
+	call strcpy (s2, Memc[l2], LEN_CARD)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree (sp)
+	return (istat)
+end
+
+
+# FXF_DATE2LIMTIME -- Convert the IRAF_TLM string (used to record the IMIO
+# time of last modification of the image) into a long integer limtime
+# compatible with routine cnvtime().  The year must be 1980 or later.
+# The input date string has one of the following forms:
+#
+# Old format:			"hh:mm:ss (dd/mm/yyyy)"
+# New (Y2K/ISO) format:		"YYYY-MM-DDThh:mm:ss
+
+procedure fxf_date2limtime (datestr, limtime)
+
+char	datestr[ARB]	#I fixed format date string
+long	limtime		#O output limtime (LST seconds from 1980.0)
+
+double	dsec
+int	hours,minutes,seconds,day,month,year
+int     status, iso, flags, ip, m, d, y
+int	dtm_decode_hms(), btoi(), ctoi()
+long    gmttolst()
+double  jd
+
+begin
+	iso = btoi (datestr[3] != ':')
+	status = OK
+
+	if (iso == YES) {
+	    status = dtm_decode_hms (datestr,
+		year,month,day, hours,minutes,dsec, flags)
+
+	    # If the decoded date string is old style FITS then the HMS
+	    # values are indefinite, and we need to set them to zero.
+
+	    if (and(flags,TF_OLDFITS) != 0) {
+		hours = 0
+		minutes = 0
+		seconds = 0
+	    } else {
+ 		if (IS_INDEFD(dsec)) {
+                    hours   = 0
+                    minutes = 0
+                    seconds = 0
+		} else
+                    seconds = nint(dsec)
+            }
+	} else {
+	    ip = 1;  ip = ctoi (datestr,     ip, hours)
+	    ip = 1;  ip = ctoi (datestr[4],  ip, minutes)
+	    ip = 1;  ip = ctoi (datestr[7],  ip, seconds)
+	    ip = 1;  ip = ctoi (datestr[11], ip, day)
+	    ip = 1;  ip = ctoi (datestr[14], ip, month)
+	    ip = 1;  ip = ctoi (datestr[17], ip, year)
+	}
+
+	if (status == ERR || year < 1980) {
+	    limtime = 0
+	    return
+	}
+
+	seconds = seconds + minutes * 60 + hours * 3600
+
+        # Calculate the Julian day from jan 1, 1980. Algorithm taken
+	# from astutil/asttools/asttimes.x.
+
+        y = year
+	if (month > 2)
+	    m = month + 1
+	else {
+	    m = month + 13
+	    y = y - 1
+	}
+
+	# Original: jd = int (JYEAR * y) + int (30.6001 * m) + day + 1720995
+        # -723244.5 is the number of days to add to get 'jd' from jan 1, 1980.
+
+	jd = int (365.25 * y) + int (30.6001 * m) + day - 723244.5
+	if (day + 31 * (m + 12 * y) >= 588829) {
+	    d = int (y / 100)
+	    m = int (y / 400)
+	    jd = jd + 2 - d + m
+	}
+	jd = jd - 0.5 
+        day = jd
+
+	limtime = seconds + day * 86400
+	if (iso == YES)
+	    limtime = gmttolst (limtime)
+end
+
+
+# FIT_MATCH_STR -- FITS header pattern matching algorithm.  Match mostly one
+# line of lenght LEN_UACARD with the buffer pointed by str; if pattern is not
+# in str, put it in the 'out' buffer.
+
+procedure fxf_match_str (pat, plines, str, slines, merge, po)
+
+pointer pat		#I buffer with pattern
+int	plines		#I number of pattern
+pointer str		#I string to compare the pattern with
+int	slines		#I number of lines in str
+int	merge		#I flag to indicate merging or unmerge
+pointer po		#I matching pattern accumulation pointer
+
+char	line[LEN_UACARD]
+pointer sp, pt, tpt, tst, ps, pkp
+int	nbl, l, k, j, i, strncmp(), nbkw, nsb, cmplen
+int	stridxs()
+
+begin
+	call smark (sp)
+	call salloc (tpt, LEN_UACARD_100+1, TY_CHAR)
+	call salloc (tst, LEN_UACARD_5+1, TY_CHAR)
+
+	Memc[tpt] = EOS
+	Memc[tst] = EOS
+
+	# The temporary buffer is non blank only when it has a blank
+	# keyword following by a comentary:
+
+	#1) '	       '		   / Comment to the block of keyw
+	#2) KEYWORD = Value
+
+	nbl = 0
+	nbkw = 0
+	pt = pat - LEN_UACARD
+
+	for (k=1;  k <= plines;  k=k+1) {
+	    pt = pt + LEN_UACARD
+	    call strcpy (Memc[pt], line, LEN_UACARD)
+
+	    # Do not pass these keywords if merging.
+	    if (merge == YES) {
+		if (strncmp (line, "COMMENT ", 8) == 0 ||
+		    strncmp (line, "HISTORY ", 8) == 0 ||
+		    strncmp (line, "OBJECT  ", 8) == 0 ||
+		    strncmp (line, "EXTEND  ", 8) == 0 ||
+		    strncmp (line, "ORIGIN  ", 8) == 0 ||
+		    strncmp (line, "IRAF-TLM", 8) == 0 ||
+		    strncmp (line, "DATE    ", 8) == 0 ) {
+
+		    next 
+	        }
+	    }	
+	    if (line[1] == ' ') {
+	        call fxf_accum_bufp (line, tpt, nbkw, nbl)
+	        next
+	    }
+
+	    if (Memc[tpt] != EOS) {  
+		nbkw = nbkw + 1
+	        call strcat (line, Memc[tpt], LEN_UACARD_100)
+	        Memc[tst] = EOS
+
+	        # Now that we have a buffer with upto 100 lines, we take its 
+	        # last 5 card and we are going to compare it with upto 5 
+	        # lines (that can contain blank lines in between).
+
+	        pkp = tpt + LEN_UACARD*(nbkw-1)
+	        ps = str - LEN_UACARD
+	        nsb = 0
+
+		do j = 1, slines {
+		    ps = ps + LEN_UACARD
+		    call strcpy (Memc[ps], line, LEN_UACARD)
+
+		    if (line[1] == ' ') {
+			call fxf_accum_buft (line, tst, nsb)
+			next
+
+		    } else if (Memc[tst] != EOS) {
+			nsb = nsb + 1
+			call strcat (line, Memc[tst], LEN_UACARD_5)
+
+			# To begin compare the first character in the
+			# keyword line.
+
+			if (Memc[pkp] == line[1]) {
+			    if (strncmp (Memc[pkp-LEN_UACARD*(nsb-1)],
+				    Memc[tst], LEN_UACARD*nsb) == 0) {
+				nsb = 0
+				break
+			    }
+			}	  
+
+			nsb = 0
+			Memc[tst] = EOS
+		    }
+		}
+
+	        if (j == slines+1) {
+		    if (nbl > 0)
+		        call fxf_blank_lines (nbl, po)
+		    i = tpt
+		    do l = 1, min(100, nbkw) {
+		        call amovc (Memc[i], Memc[po], LEN_UACARD)
+		        i = i + LEN_UACARD
+		        po = po + LEN_UACARD
+		    }
+	        } else {
+		    pt = pt - LEN_UACARD	# push back last line
+		    k = k - 1
+	        }
+
+	        Memc[tpt] = EOS	
+	        nbkw = 0
+	        nbl = 0	
+
+	    } else {
+		# One line to compare.
+		ps = str - LEN_UACARD
+		cmplen = min (stridxs("=", Memc[pt]), LEN_UACARD)
+		if (cmplen == 0)
+		    cmplen = LEN_UACARD
+
+#	        if (merge == YES)
+#		    cmplen = SZ_KEYWORD
+
+	        do j = 1, slines {
+		    ps = ps + LEN_UACARD
+		    if (Memc[ps] == Memc[pt]) {
+			if (merge == NO)
+			    cmplen = LEN_CARD 
+		        if (strncmp (Memc[ps], Memc[pt], cmplen) == 0) {
+			    nbl = 0
+			    break
+			}
+		    }   
+	        }
+
+	        if (j == slines+1) {
+		    if (nbl > 0)
+		        call fxf_blank_lines (nbl, po)
+
+		    call amovc (line, Memc[po], LEN_UACARD)
+		    po = po + LEN_UACARD
+		    nbl = 0
+	        } 
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_ACCUM_BUFP -- Accumulate blank keyword cards (No keyword and a / card
+# only) and the blank lines in between.
+
+procedure fxf_accum_bufp (line, tpt, nbkw, nbl)
+
+char	line[LEN_UACARD]	#I input card from the pattern buffer
+pointer tpt			#I pointer to the buffer
+int	nbkw			#U number of blank keyword card
+int	nbl			#U number of blank card before the 1st bkw
+
+char	keyw[SZ_KEYWORD]		
+bool	fxf_is_blank()	
+
+begin
+	call strcpy (line, keyw, SZ_KEYWORD)
+
+	if (fxf_is_blank (line)) {
+	    # Accumulate blank cards in between bkw cards.
+	    if (nbkw > 0 && nbkw < 100) {
+		call strcat (line, Memc[tpt], LEN_UACARD_100)
+		nbkw = nbkw + 1
+	    } else if (nbkw >= 100) {
+		nbkw = nbkw - 1
+	    } else
+		nbl = nbl + 1
+
+	} else if (fxf_is_blank (keyw)) {
+	    nbkw = nbkw + 1
+
+	    # We have a blank keyword, but the card is not blank, maybe it is
+	    # a '/ comment' card.  Start accumulating upto 100 blank kwy lines.
+
+	    if (nbkw < 100)
+		call strcat (line, Memc[tpt], LEN_UACARD_100)
+	    else
+		nbkw = nbkw - 1
+	}
+end
+
+
+# FXF_ACCUM_BUFT -- Accumulate blank keyword keeping track of the blank cards.
+
+procedure fxf_accum_buft (line, tst, nsb)
+
+char	line[LEN_UACARD]	#I input card from the target buffer
+pointer tst			#I pointer to output buffer
+int	nsb			#U number of consecutives blank cards
+
+char	keyw[SZ_KEYWORD]
+bool	fxf_is_blank()	
+
+begin
+	call strcpy (line, keyw, SZ_KEYWORD)
+
+	if (fxf_is_blank (line)) {
+	    if (nsb > 0 && nsb < 5) {
+		call strcat (line, Memc[tst], LEN_UACARD_5)
+		nsb = nsb + 1
+	    } else if (nsb > 4)
+		nsb = nsb - 1 
+	} else if (fxf_is_blank (keyw)) {
+	    # We want to pick the last blank kwy only.
+	    call strcpy (line, Memc[tst], LEN_UACARD_5)
+	    nsb = 1
+	}
+end
+
+
+# FXF_BLANK_LINES -- Write a number of blank lines into output buffer.
+
+procedure fxf_blank_lines (nbl, po)
+
+int	nbl			#U number of blank lines to write
+pointer po			#I output buffer pointer
+
+char	blk[1]
+int	i
+
+begin
+	blk[1] = ' '
+	do i = 1, nbl {
+	    call amovkc (blk[1], Memc[po], LEN_UACARD)
+	    po = po +  LEN_UACARD
+	    Memc[po-1] = '\n'
+	}
+	nbl = 0
+end
+
+
+# FXF_IS_BLANK -- Determine is the string is blank.
+
+bool procedure fxf_is_blank (line)
+
+char line[ARB]			#I input string
+int  i
+
+begin
+	for (i=1; IS_WHITE(line[i]); i=i+1)
+	   ;
+
+	if (line[i] == NULL || line[i] == '\n')
+	    return (true)
+	else
+	    return (false)
+end
+
+
+# FXF_FORM_MESSG -- Form string from extname, extver.
+
+procedure fxf_form_messg (fit, messg)
+
+pointer fit			#I fits descriptor
+char	messg[ARB]		#O string
+
+begin
+	if (!IS_INDEFL (FKS_EXTVER(fit))) {
+	    call sprintf (messg, LEN_CARD, "'%s,%d'")
+		call pargstr (FKS_EXTNAME(fit))
+		call pargi (FKS_EXTVER(fit)) 
+	} else {
+	    call sprintf (messg, LEN_CARD, "'%s'")
+		call pargstr (FKS_EXTNAME(fit))
+	}			
+end
diff --git a/sys/imio/iki/fxf/fxfupdhdr.x b/sys/imio/iki/fxf/fxfupdhdr.x
new file mode 100644
index 00000000..40a24763
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfupdhdr.x
@@ -0,0 +1,1478 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <finfo.h>
+include	<fio.h>
+include	<fset.h>
+include <mii.h>
+include <time.h>
+include <mach.h>
+include	"fxf.h"
+
+# FXFUPDHDR.X -- Routines to update the header of an image extension on
+# disk.
+
+define  SZ_DATESTR    24
+
+
+# FXF_UPDHDR -- Update the FITS header file.  This is done by writing an
+# entire new header file and then replacing the old header file with the
+# new one.  This is necessary since the header file is a text file and text
+# files cannot be randomly updated.
+
+procedure fxf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+pointer	sp, fit, mii, poff
+pointer	outname, fits_file, tmp1, tmp2
+bool    adjust_header, overwrite, append
+int	i, nchars_ua, hdr_fd, group, hdr_off, size
+int	npad, nlines, pixoff, grp_pix_off, nbks
+int	acmode, in_fd, diff, hdr_acmode, in_off, nchars, subtype
+int	read(), fxf_hdr_offset(), access(), strncmp()
+int	open(), fstatl(), fnldir(), strlen(), stridxs()
+bool	fnullfile()
+
+errchk  open, read, write, fxf_header_diff, fxf_write_header, fxf_make_adj_copy
+errchk  fxf_set_cache_time, syserr, syserrs, imerr
+errchk  fxf_expandh, fxf_not_incache, fxf_ren_tmp, fxf_update_extend
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	call salloc (fits_file, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tmp1, max(SZ_PATHNAME,SZ_FNAME*2), TY_CHAR)
+	call salloc (tmp2, max(SZ_PATHNAME,SZ_FNAME*2), TY_CHAR)
+
+	acmode = IM_ACMODE(im)
+	fit = IM_KDES(im)
+	status = OK
+
+	# For all intents and purposes the APPEND access mode is the same
+	# as NEW_IMAGE under the FK.  Let's simplify the code as the user
+	# has requested APPEND.
+
+        if (acmode == APPEND)
+	    acmode = NEW_IMAGE
+
+	if (acmode == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	if (fnullfile (IM_HDRFILE(im))) {
+	    call sfree (sp)
+	    return
+	}
+
+	group = FIT_GROUP(fit)
+
+        subtype = 0
+	if ((FKS_SUBTYPE(fit) == FK_PLIO || 
+		(strncmp("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)) && 
+		(IM_PL(im) != NULL))
+	    subtype = FK_PLIO
+
+	if (FIT_EXTTYPE(fit) != EOS && group != -1) {
+	    if (strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		    strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0 &&
+		    subtype == 0) {
+		call syserr (SYS_FXFUPHBEXTN)
+	    }
+	}
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (group == 0) {
+		# We are overwriting the main unit.
+	        FIT_NEWIMAGE(fit) = YES
+	    }
+
+	    group = -1
+	    acmode = NEW_IMAGE
+
+	    if (IM_PFD(im) == NULL) 
+	        call fxf_overwrite_unit (fit, im)
+
+	    call strcpy (IM_PIXFILE(im), Memc[fits_file], SZ_FNAME)
+
+	} else
+	    call strcpy (IM_HDRFILE(im), Memc[fits_file], SZ_FNAME)
+	
+	# Calculate the header offset corresponding to group number 'group'. 
+	FIT_IM(fit) = im
+	hdr_off = fxf_hdr_offset (group, fit, IM_PFD(im), acmode)
+
+	# If the pixfile has not been created, open new one.  This could
+	# happen if the don't write any pixels to the data portion of the file.
+
+	if (IM_PFD(im) == NULL && (acmode == NEW_COPY || acmode == NEW_IMAGE)) {
+	    FIT_NAXIS(fit) = 0
+	    if (FIT_NEWIMAGE(fit) == YES)
+	        hdr_acmode = NEW_FILE
+	    else {
+	        # We want to append a new extension with no data.
+	        hdr_acmode = READ_WRITE
+	    }
+	} else {
+	    call close(IM_PFD(im))	
+	    hdr_acmode = READ_WRITE
+	}
+
+	append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+
+	# Calculate header difference. The difference between the original
+	# header length at open time and now. The user could have added or
+	# deleted header keywords.
+
+	call fxf_header_diff (im, group, acmode, hdr_off, diff, nchars_ua)
+
+	# PLIO
+	if (subtype == FK_PLIO && append) 
+	    diff = 0
+
+	# Adjust header only when we need to expand. We fill with trailing 
+	# blanks in case diff .gt. 0. (Reduce header size).
+
+	adjust_header = (diff < 0)
+	if (adjust_header && FIT_EXPAND(fit) == NO) {
+	    call syserr (SYS_FXFUPHEXP)
+	    adjust_header = false
+	}
+
+	overwrite = (FKS_OVERWRITE(fit) == YES)
+	if (adjust_header || overwrite) {
+	    # We need to change the size of header portion in the middle of
+	    # the file. The best thing to do is to make a copy in the output
+	    # filename directory.
+
+	    i = strlen (IM_PIXFILE(im))
+	    nchars = fnldir (IM_PIXFILE(im), Memc[outname], SZ_PATHNAME)
+	    if (nchars > 80 && i > 100) {
+		i = stridxs ("!", Memc[outname])
+	        call strcpy ("tmp$", Memc[outname+i], SZ_PATHNAME-i)
+	    }
+	    call strcpy (Memc[outname], Memc[tmp2], SZ_FNAME)
+            call mktemp ("fx", Memc[tmp1], SZ_PATHNAME)
+	    call strcat (".fits", Memc[tmp1], SZ_PATHNAME)
+	    call strcat ("A", Memc[outname], SZ_PATHNAME)
+	    call strcat (Memc[tmp1], Memc[outname], SZ_PATHNAME)
+	    call strcat ("B", Memc[tmp2], SZ_PATHNAME)
+	    call strcat (Memc[tmp1], Memc[tmp2], SZ_PATHNAME)
+	    in_fd = open (Memc[fits_file], READ_ONLY, BINARY_FILE)
+	    if (access (Memc[outname], 0, 0) == YES)
+		call delete (Memc[outname])
+	    hdr_fd = open (Memc[outname], NEW_FILE, BINARY_FILE)
+
+            # Now expand the current group at least one block of 36 cards
+	    # and guarantee that the other groups in the file will have at
+	    # least 'nlines' of blank cards at the end of the header unit.
+
+	    nlines= FKS_PADLINES(fit)
+	    IM_HFD(im) = in_fd
+
+	    if (adjust_header && acmode != NEW_COPY && 
+		FIT_XTENSION(fit) == YES) {
+		nbks = -diff/1440     # number of blocks to expand
+		call fxf_expandh (in_fd, hdr_fd, nlines, group, nbks,
+		    hdr_off, pixoff)
+		nchars_ua = pixoff - hdr_off
+		# Reload PHU from file if necessary
+	        call fxf_not_incache(im)
+		poff = FIT_PIXPTR(fit)
+		Memi[poff+group] = pixoff
+	    } else {
+		if (append)
+		    grp_pix_off = FIT_PIXOFF(fit)
+		else {
+		    # Reload PHU from file if necessary
+	            call fxf_not_incache(im)
+		    grp_pix_off = Memi[FIT_PIXPTR(fit)+group]
+		}
+		call fxf_make_adj_copy (in_fd, hdr_fd,
+		    hdr_off, grp_pix_off, nchars_ua)
+	    }
+	    diff = 0
+	    group = -1
+
+	    # Reset the time so we can read a fresh header next time.
+	    call fxf_set_cache_time (im, overwrite)
+	} else {
+	    hdr_fd = open (Memc[fits_file], hdr_acmode, BINARY_FILE)
+	    # Do not clear if we are creating a Bintable with type PLIO_1.
+	    if (subtype != FK_PLIO)
+	        IM_PFD(im) = NULL
+	    IM_HFD(im) = NULL
+	}
+
+	if (FIT_NEWIMAGE(fit) == YES)
+	    call seek (hdr_fd, BOF)
+	else if (hdr_off != 0)
+	    call seek (hdr_fd, hdr_off)
+	   
+	if (acmode == NEW_COPY)
+	    call fxf_setbitpix (im, fit)
+
+	# Lets changed the value of FIT_MTIME that will be used as the mtime for
+	# this updated file. This time them will be different in other
+	# executable's FITS cache, hence rereading the PHU. 
+	# We need to use FIT_MTIME since it reflec the value of keyword
+	# IRAF_TLM which could have just recently been modified, hence adding
+	# the 4 seconds.
+	
+        if (abs(FIT_MTIME(fit) - clktime(long(0))) > 60)
+	    FIT_MTIME(fit) = clktime(long(0))
+
+	# We cannot use clktime() directly since the previuos value
+	# of FIT_MTIME might already have a 4 secs increment.
+
+        FIT_MTIME(fit) = FIT_MTIME(fit) + 4
+
+	# Now write default cards and im_userarea to disk.
+	nchars_ua = nchars_ua + diff
+	call fxf_write_header (im, fit, hdr_fd, nchars_ua, group)
+
+ 	size = fstatl (hdr_fd, F_FILESIZE)
+	npad = FITS_BLOCK_CHARS - mod(size,FITS_BLOCK_CHARS)
+
+	# If we are appending a new extension, we need to write padding to
+	# 2880 bytes blocks at the end of the file.
+
+	if (mod(npad,FITS_BLOCK_CHARS) > 0 &&
+		(FIT_NEWIMAGE(fit) == YES || append)) {
+	    call amovki (0, Memi[mii], npad)
+	    call flush (hdr_fd)
+	    call seek (hdr_fd, EOF)
+	    call write (hdr_fd, Memi[mii], npad)
+	}
+	call flush (hdr_fd)
+
+	# Now open the original file and skip to the beginning of (group+1)
+	# to begin copying into hdr_fd. (end of temporary file in tmp$).
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (overwrite) {
+		call close (in_fd)
+		if (access (IM_PIXFILE(im), 0, 0) == YES)
+		    call delete (IM_PIXFILE(im))
+		call strcpy (Memc[outname], IM_PIXFILE(im), SZ_FNAME)
+	    }		
+
+	    in_fd = open (IM_HDRFILE(im), READ_ONLY, BINARY_FILE)
+	    group = FIT_GROUP(fit)
+	    call fxf_not_incache (im)
+	    in_off = Memi[FIT_HDRPTR(fit)+group+1]
+	    call seek (hdr_fd, EOF)
+	    call seek (in_fd, in_off)
+	    size = FITS_BLOCK_CHARS
+
+	    while (read (in_fd, Memi[mii], size) != EOF) 
+		call write (hdr_fd, Memi[mii], size)
+
+	    call close (hdr_fd)
+	    call close (in_fd)
+
+	    call fxf_ren_tmp (IM_PIXFILE(im), IM_HDRFILE(im), Memc[tmp2], 1, 1)
+
+	    # Change the acmode so we can change the modification and
+	    # this way reset the cache for this file.
+
+	    IM_ACMODE(im) = READ_WRITE
+	    call fxf_over_delete(im)
+
+	} else {
+	    if (adjust_header || overwrite)
+	        call close (in_fd)
+	    call close (hdr_fd)
+
+            # If the header has been expanded then rename the temp file
+	    # to the original name.
+	    if (adjust_header)
+		call fxf_ren_tmp (Memc[outname], IM_PIXFILE(im),
+		    Memc[tmp2], 1, 1)
+	}
+
+	# Make sure we reset the modification time for the cached header
+	# since we have written a new version. This way the header will
+	# be read from disk next time the file is accessed.
+
+        if (IM_ACMODE(im) == READ_WRITE || overwrite)  {
+           # The modification time of a file in the cache can be different
+	   # from another mod entry in another executable. We need to make
+	   # sure that the mod time has changed in more than a second so that
+	   # the other executable can read the header from disk and not
+	   # from the cache entry. The FIT_MTIME value has already been
+	   # changed by adding 4 seconds. (See above).
+
+           call futime (IM_HDRFILE(im), NULL, FIT_MTIME(fit))
+#           call futime (IM_HDRFILE(im), NULL, clktime(long(0))+4)
+	}
+
+	if (FIT_GROUP(fit) == 0 || FIT_GROUP(fit) == -1)
+	   call fxf_set_cache_time (im, false)
+
+	# See if we need to add or change the value of EXTEND in the PHU.
+	if (FIT_XTENSION(fit) == YES && 
+	   (FIT_EXTEND(fit) == NO_KEYW || FIT_EXTEND(fit) == NO)) {
+		call fxf_update_extend (im)
+	   }
+
+	call sfree (sp)
+end
+
+
+# FXF_HDR_OFFSET -- Function to calculate the header offset for group number
+# 'group'.
+
+int procedure fxf_hdr_offset (group, fit, pfd, acmode)
+
+int	group			#I extension number
+pointer	fit			#I fits descriptor
+pointer	pfd			#I pixel file descriptor
+int	acmode			#I image acmode
+
+int	hdr_off
+
+begin
+	if (FIT_NEWIMAGE(fit) == YES)
+	    return (0)
+
+	# Look for the beginning of the current group.
+	if (group == -1) {
+	    # We are appending or creating a new FITS IMAGE.
+	    hdr_off = FIT_EOFSIZE(fit)
+	} else {
+	    call fxf_not_incache (FIT_IM(fit))
+	    hdr_off = Memi[FIT_HDRPTR(fit)+group]
+        }
+	
+	# If pixel file descriptor is empty for a newcopy or newimage
+	# in an existent image then the header offset is EOF.
+
+	if (pfd == NULL && (acmode == NEW_COPY || acmode == NEW_IMAGE))
+	    hdr_off = EOF
+
+	return (hdr_off)
+end
+
+
+# FXF_HEADER_DIFF -- Get the difference between the original header at open
+# time and the one at closing time.
+
+procedure fxf_header_diff (im, group, acmode, hdr_off, diff, ualen)
+
+pointer	im			#I image descriptor
+int	group			#I extension number
+int	acmode			#I emage acmode
+int	hdr_off			#I header offset for group
+int	diff			#O difference
+int	ualen			#O new header length
+
+char	temp[LEN_CARD]
+pointer	hoff, poff, sp, pb, tb
+int	ua, fit, hdr_size, pixoff, clines, ulines, len, padlines
+int     merge, usize, excess, nheader_cards, rp, inherit, kmax, kmin
+int     strlen(), imaccf(), imgeti(), strcmp(), idb_findrecord()
+int	btoi(), strncmp()
+bool    imgetb()
+
+errchk  open, fcopyo
+
+begin
+	fit = IM_KDES(im)
+	inherit = NO
+
+	FIT_INHERIT(fit) = FKS_INHERIT(fit)
+
+	# In READ_WRITE mode get the UA value of INHERIT only if it has
+	# change after _open().
+
+	if (acmode == READ_WRITE) {
+	    if (imaccf (im, "INHERIT") == YES) {
+		inherit = btoi (imgetb (im, "INHERIT"))
+		if (inherit != FKS_INHERIT(fit))
+		    FIT_INHERIT(fit) = inherit
+	    }
+	}
+
+	# Allow inheritance only for extensions.
+	inherit = FIT_INHERIT(fit)
+	if (FIT_GROUP(fit) == 0) {
+	    inherit = NO
+  	    FIT_INHERIT(fit) = inherit
+	}
+	# Scale the pixel offset to be zero base rather than the EOF base.
+	if (FIT_NEWIMAGE(fit) == NO) {
+	    pixoff = FIT_PIXOFF(fit) - FIT_EOFSIZE(fit)
+	} else {
+	    if ((hdr_off == EOF || hdr_off == 0)&&
+		(IM_NDIM(im) == 0 || FIT_NAXIS(fit) == 0)) {
+	        diff = 0
+	        return
+	    }
+	    pixoff = FIT_PIXOFF(fit) - 1
+	}
+
+	ua = IM_USERAREA(im)
+
+	if (FIT_NEWIMAGE(fit) == NO && inherit == YES) {
+	    # Form an extension header by copying cards in the UA that
+	    # do not belong in the global header nor in the old
+	    # extension header if the image is open READ_WRITE.
+
+	    # Check if the file is still in cache. We need CACHELEN and
+            # CACHEHDR. 
+
+            call fxf_not_incache (im)
+
+	    len = strlen (Memc[ua])
+	    ulines = len / LEN_UACARD
+	    clines = FIT_CACHEHLEN(fit) / LEN_UACARD
+
+	    call smark (sp)
+	    call salloc (tb, len+1, TY_CHAR)
+
+	    # Now select those lines in UA that are not in fit_cache and
+	    # put them in 'pb'.
+
+	    pb = tb
+	    merge = NO
+	    call fxf_match_str (ua, ulines,
+		FIT_CACHEHDR(fit), clines, merge, pb)
+	    Memc[pb] = EOS
+	    ualen = strlen (Memc[tb])
+
+	    # Now copy the buffer pointed by 'pb' to UA.
+	    call strcpy (Memc[tb], Memc[ua], ualen)
+
+	    call sfree (sp)
+	}
+
+	# See also fitopix.x for an explanation of this call.
+	call fxf_mandatory_cards (im, nheader_cards)
+
+	kmax = idb_findrecord (im, "DATAMAX", rp)
+	kmin = idb_findrecord (im, "DATAMIN", rp)
+
+	if (IM_LIMTIME(im) < IM_MTIME(im)) {
+	    # Keywords should not be in the UA.
+	    if (kmax > 0)
+	        call imdelf (im, "DATAMAX")
+	    if (kmin > 0)
+	        call imdelf (im, "DATAMIN")
+
+	} else {
+	    # Now update the keywords.  If they are not in the UA we need
+	    # to increase the number of mandatory cards.
+
+	    if (kmax == 0)
+		nheader_cards = nheader_cards + 1
+	    if (kmin == 0)
+		nheader_cards = nheader_cards + 1
+        }	     
+
+	# Determine if OBJECT or IM_TITLE have changed. IM_TITLE has
+	# priority.
+
+        # If FIT_OBJECT is empty, then there was no OBJECT card at read
+	# time. If OBJECT is present now, then it was added now. If OBJECT
+	# was present but not now, the keyword was deleted.
+
+	temp[1] = EOS
+	if (imaccf (im, "OBJECT") == YES) {
+	    call imgstr (im, "OBJECT", temp, LEN_CARD)
+	    # If its value is blank, then temp will be NULL
+	    if (temp[1] == EOS)
+		call strcpy ("       ", temp, LEN_CARD)
+	}
+
+	if (temp[1] != EOS)
+	    call strcpy (temp, FIT_OBJECT(fit), LEN_CARD)
+	else
+	    nheader_cards = nheader_cards - 1
+
+	if (FIT_OBJECT(fit) == EOS) {
+	    if (strcmp (IM_TITLE(im), FIT_TITLE(fit)) != 0) {
+		call strcpy (IM_TITLE(im), FIT_OBJECT(fit), LEN_CARD)
+		# The OBJECT keyword will be added.
+		nheader_cards = nheader_cards + 1
+	    }
+	} else {
+	    # See if OBJECT has been deleted from UA.
+	    if (temp[1] == EOS)
+		FIT_OBJECT(fit) = EOS
+	    if (strcmp (IM_TITLE(im), FIT_TITLE(fit)) != 0)
+		call strcpy (IM_TITLE(im), FIT_OBJECT(fit), LEN_CARD)
+	}
+
+
+	# Too many mandatory cards if we are using the PHU in READ_WRITE mode.
+	# Because fxf_mandatory_cards gets call with FIT_NEWIMAGE set to NO,
+	# i.e. an extension. (12-9=3)
+
+	if (FIT_XTENSION(fit) == NO && FIT_NEWIMAGE(fit) == NO)
+	    nheader_cards = nheader_cards - 3
+
+	if (FIT_NEWIMAGE(fit) == NO && FIT_XTENSION(fit) == YES) {
+
+	    # Now take EXTNAME and EXTVER keywords off the UA if they are in
+	    # there. The reason being they can be out of order.
+
+	    iferr (call imgstr (im, "EXTNAME", FIT_EXTNAME(fit), LEN_CARD)) {
+		FIT_EXTNAME(fit) = EOS
+		if (FKS_EXTNAME(fit) != EOS) {
+		   call strcpy (FKS_EXTNAME(fit), FIT_EXTNAME(fit), LEN_CARD)
+		} else {
+		   # We will not create EXTNAME keyword in the output header
+		   nheader_cards = nheader_cards - 1
+		}
+	    } else {
+		call imdelf (im, "EXTNAME")
+		nheader_cards = nheader_cards + 1
+	    }
+
+	    if (imaccf (im, "EXTVER") == YES) {
+		FIT_EXTVER(fit) = imgeti (im, "EXTVER")
+		call imdelf (im, "EXTVER")
+		nheader_cards = nheader_cards + 1
+	    }
+	    if (imaccf (im, "PCOUNT") == YES) {
+		call imdelf (im, "PCOUNT")
+		nheader_cards = nheader_cards + 1
+	    }
+	    if (imaccf (im, "GCOUNT") == YES) {
+		call imdelf (im, "GCOUNT")
+		nheader_cards = nheader_cards + 1
+	    }
+	 
+	    if (IS_INDEFL(FIT_EXTVER(fit)) && !IS_INDEFL(FKS_EXTVER(fit)))
+		FIT_EXTVER(fit) = FKS_EXTVER(fit)
+	}
+
+	# Finally if we are updating a BINTABLE with a PLIO_1 mask we need
+	# to add 3 to the mandatory cards since TFIELDS, TTYPE1, nor
+	# TFORM1 are included.   ### Ugh!!
+	# Also add the Z cards.
+
+	if (strncmp ("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)
+	    nheader_cards = nheader_cards + 3 + 6 + IM_NDIM(im)*2
+
+	# Compute current header size rounded to a header block.
+	usize = strlen (Memc[ua]) 
+	len = (usize / LEN_UACARD + nheader_cards) * LEN_CARD 
+	len = FITS_LEN_CHAR(len / 2)
+
+	# Ask for more lines if the header can or needs to be expanded.
+	padlines = FKS_PADLINES(fit)
+
+	# Here we go over the FITS header area already allocated?
+	if (acmode == READ_WRITE || acmode == WRITE_ONLY) {
+	    call fxf_not_incache(im)
+	    hoff = FIT_HDRPTR(fit)
+	    poff = FIT_PIXPTR(fit)
+	    hdr_size = Memi[poff+group] - Memi[hoff+group]
+	    ualen = len
+	    diff = hdr_size - ualen
+	    # If the header needs to be expanded add on the pad lines.
+	    if (diff < 0) {
+		ualen = (usize/LEN_UACARD + nheader_cards + padlines) * LEN_CARD
+		ualen = FITS_LEN_CHAR(ualen / 2)
+	    }
+	    diff = hdr_size - ualen
+	} else if ((hdr_off == EOF || hdr_off == 0) && 
+	    (IM_NDIM(im) == 0 || FIT_NAXIS(fit) == 0)) {
+	    hdr_size = len
+	    ualen = len
+	} else {
+	    hdr_size = pixoff
+	    # The header can expand so add on the pad lines.
+	    ualen = (usize / LEN_UACARD + nheader_cards + padlines) * LEN_CARD
+	    ualen = FITS_LEN_CHAR(ualen / 2)
+	    diff = hdr_size - ualen
+        }
+
+        if (diff < 0 && FIT_EXPAND(fit) == NO) {
+	    # We need to reduce the size of the UA becuase we are not
+	    # going to expand the header.
+	    excess = mod (nheader_cards * 81 + usize, 1458)
+	    excess = excess + (((-diff-1400)/1440)*1458)
+	    Memc[ua+usize-excess] = EOS
+	    usize = strlen (Memc[ua]) 
+	    ualen = (usize / LEN_UACARD + nheader_cards) * LEN_CARD 
+	    ualen = FITS_LEN_CHAR(ualen / 2)
+	}
+end
+
+
+# FXF_WRITE_HDR -- Procedure to write header unit onto the PHU or EHU.
+
+procedure fxf_write_header (im, fit, hdr_fd, nchars_ua, group)
+
+pointer	 im		  	#I image structure
+pointer	 fit     		#I fits structure
+int	 hdr_fd  		#I FITS header file descriptor
+int	 nchars_ua		#I header size
+int	group			#I group number
+
+char	temp[SZ_FNAME] 
+bool	xtension, ext_append
+pointer	sp, spp, mii, rp, uap
+char    card[LEN_CARD], blank, keyword[SZ_KEYWORD], datestr[SZ_DATESTR] 
+int	iso_cutover, n, i, sz_rec, up, nblanks, acmode, nbk, len, poff, diff
+int     pos, pcount, depth, subtype, maxlen, ndim
+
+long	clktime()
+int	imaccf(), strlen(), fxf_ua_card(), envgeti()
+int	idb_findrecord(), strncmp(), btoi()
+bool	fxf_fpl_equald(), imgetb(), itob()
+long    note()
+errchk  write 
+
+begin
+	call smark (sp)
+	call salloc (spp, FITS_BLOCK_CHARS*5, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+
+	# Write out the standard, reserved header parameters.
+	n = spp
+	blank = ' '
+	acmode = FIT_ACMODE(fit)
+	ext_append = ((acmode == NEW_IMAGE || acmode == NEW_COPY) &&
+	    (FKS_EXTNAME(fit) != EOS || !IS_INDEFL (FKS_EXTVER(fit))))
+
+	xtension = (FIT_XTENSION(fit) == YES)
+	if (FIT_NEWIMAGE(fit) == YES)
+	    xtension = false
+
+	subtype =0
+	if ((FKS_SUBTYPE(fit) == FK_PLIO || 
+		(strncmp("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)) &&
+		IM_PL(im) != NULL) {
+
+	    subtype = FK_PLIO
+	    ext_append = true
+	}
+
+	# PLIO.  Write BINTABLE header for a PLIO mask.
+	if (subtype == FK_PLIO) {
+
+	    if (IM_PFD(im) != NULL) {
+		call fxf_plinfo (im, maxlen, pcount, depth)
+
+		# If we old heap has change in size, we need to
+		# resize it.
+
+		if (acmode == READ_WRITE && pcount != FIT_PCOUNT(fit))
+		    call fxf_pl_adj_heap (im, hdr_fd, pcount)
+	    } else {
+		pcount = FIT_PCOUNT(fit)
+		depth = DEF_PLDEPTH
+	    }
+
+	    ndim = IM_NDIM(im)
+	    call fxf_akwc ("XTENSION", "BINTABLE", 8, "Mask extension", n)
+	    call fxf_akwi ("BITPIX", 8, "Bits per pixel", n)
+	    call fxf_akwi ("NAXIS", ndim, "Number of axes", n)
+	    call fxf_akwi ("NAXIS1", 8, "Number of bytes per line", n)
+	    do i = 2, ndim {
+		call fxf_encode_axis ("NAXIS", keyword, i)
+	        call fxf_akwi (keyword, IM_LEN(im,i), "axis length", n)
+	    }
+	    call fxf_akwi ("PCOUNT", pcount, "Heap size in bytes", n)
+	    call fxf_akwi ("GCOUNT", 1, "Only one group", n)
+
+	    if (imaccf (im, "TFIELDS") == NO)
+		call fxf_akwi ("TFIELDS", 1, "1 Column field", n)
+	    if (imaccf (im, "TTYPE1") == NO) {
+		call fxf_akwc ("TTYPE1", "COMPRESSED_DATA", 16,
+		    "Type of PLIO_1 data", n)
+	    }
+	    call sprintf (card, LEN_CARD, "PI(%d)")
+		call pargi(maxlen) 
+	    call fxf_filter_keyw (im, "TFORM1")
+	    len = strlen (card)
+	    call fxf_akwc ("TFORM1", card, len, "Variable word array", n)
+
+	} else {
+	    if (xtension)
+		call fxf_akwc ("XTENSION", "IMAGE", 5, "Image extension", n)
+	    else
+		call fxf_akwb ("SIMPLE", YES, "Fits standard", n)
+
+	    if (FIT_NAXIS(fit) == 0 || FIT_BITPIX(fit) == 0) 
+		call fxf_setbitpix (im, fit)
+
+	    call fxf_akwi ("BITPIX", FIT_BITPIX(fit), "Bits per pixel", n)
+	    call fxf_akwi ("NAXIS", FIT_NAXIS(fit), "Number of axes", n)
+
+	    do i = 1, FIT_NAXIS(fit) {
+		call fxf_encode_axis ("NAXIS", keyword, i)
+		call fxf_akwi (keyword, FIT_LENAXIS(fit,i), "Axis length", n)
+	    }
+	
+	    if (xtension) {
+		call fxf_akwi ("PCOUNT", 0, "No 'random' parameters", n)
+		call fxf_akwi ("GCOUNT", 1, "Only one group", n)
+	    } else {
+		if (imaccf (im, "EXTEND") == NO)
+		    i = NO
+		else {
+		   # Keyword exists but it may be in the wrong position. 
+		   # Remove it and write it now.
+
+		   i = btoi (imgetb (im, "EXTEND"))
+		   call fxf_filter_keyw (im, "EXTEND") 
+		}
+		if (FIT_EXTEND(fit) == YES)
+		    i = YES
+		call fxf_akwb ("EXTEND", i, "File may contain extensions", n)
+		FIT_EXTEND(fit) = YES
+	    }
+	}
+
+        # Delete BSCALE and BZERO just in case the application puts them
+        # in the UA after the pixels have been written. The keywords
+        # should not be there since the FK does not allow reading pixels
+        # with BITPIX -32 and BSCALE and BZERO. If the application
+        # really wants to circumvent this restriction the code below
+        # will defeat that. The implications are left to the application.
+        # This fix is put in here to save the ST Hstio interface to be
+        # a victim of the fact that in v2.12 the BSCALE and BZERO keywords
+        # are left in the header for the user to see or change. Previous
+        # FK versions, the keywords were deleted from the UA.
+
+        if ((IM_PIXTYPE(im) == TY_REAL || IM_PIXTYPE(im) == TY_DOUBLE)
+                && (FIT_TOTPIX(fit) > 0 && FIT_BITPIX(fit) <= 0)) {
+
+             call fxf_filter_keyw (im, "BSCALE")
+             call fxf_filter_keyw (im, "BZERO")
+        }
+
+	# Do not write BSCALE and BZERO if they have the default 
+	# values (1.0, 0.0).
+
+	if (IM_PIXTYPE(im) == TY_USHORT) {
+	    call fxf_filter_keyw (im, "BSCALE") 
+	    call fxf_akwd ("BSCALE", 1.0d0,
+		"REAL = TAPE*BSCALE + BZERO", NDEC_REAL, n)
+	    call fxf_filter_keyw (im, "BZERO") 
+	    call fxf_akwd ("BZERO", 32768.0d0,  "", NDEC_REAL, n)
+	} else if (FIT_PIXTYPE(fit) != TY_REAL &&
+	    FIT_PIXTYPE(fit) != TY_DOUBLE && IM_ACMODE(im) != NEW_COPY) {
+	    # Now we have TY_SHORT or TY_(INT,LONG).
+	    # Check the keywords only if they have non_default values.
+
+	    # Do not add the keywords if they have been deleted.
+	    if (!fxf_fpl_equald(1.0d0, FIT_BSCALE(fit), 4)) {
+	        if ((imaccf (im, "BSCALE") == NO) && 
+		     fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 4)) {
+		    call fxf_akwd ("BSCALE",  FIT_BSCALE(fit),
+			"REAL = TAPE*BSCALE + BZERO", NDEC_REAL, n)
+	        }
+	    }
+	    if (!fxf_fpl_equald(0.0d0, FIT_BZERO(fit), 4) ) {
+	        if (imaccf (im, "BZERO") == NO &&
+		    fxf_fpl_equald (1.0d0, FIT_BZERO(fit), 4))
+		    call fxf_akwd ("BZERO", FIT_BZERO(fit),  "", NDEC_REAL, n)
+	    }
+	}
+
+        uap = IM_USERAREA(im)
+
+	if (idb_findrecord (im, "ORIGIN", rp) == 0)  {
+	    call strcpy (FITS_ORIGIN, temp, LEN_CARD)
+	    call fxf_akwc ("ORIGIN",
+		temp, strlen(temp), "FITS file originator", n)
+	} else if (rp - uap > 10*81) {
+	    # Out of place; do not change the value.
+	    call imgstr (im, "ORIGIN", temp, LEN_CARD)
+	    call fxf_filter_keyw (im, "ORIGIN")
+	    call fxf_akwc ("ORIGIN",
+		temp, strlen(temp), "FITS file originator", n)
+	}
+
+	if (xtension) {
+	    # Update the cache in case these values have changed
+	    # in the UA.
+	    call fxf_set_extnv (im)
+
+	    if (FIT_EXTNAME(fit) != EOS) {
+	        call strcpy (FIT_EXTNAME(fit), temp, LEN_CARD)
+	        call fxf_akwc ("EXTNAME",
+		    temp, strlen(temp), "Extension name", n)
+	    }
+	    if (!IS_INDEFL (FIT_EXTVER(fit))) {
+	        call fxf_akwi ("EXTVER",
+		    FIT_EXTVER(fit), "Extension version", n)
+	    }
+            if (idb_findrecord (im, "INHERIT", rp) > 0) {
+		# See if keyword is at the begining of the UA
+		if (rp - uap > 11*81) {
+		    call fxf_filter_keyw (im, "INHERIT")
+		    call fxf_akwb ("INHERIT",
+			FIT_INHERIT(fit), "Inherits global header", n)
+		} else if (acmode != READ_WRITE)
+		    call imputb (im, "INHERIT", itob(FIT_INHERIT(fit)))
+	    } else {
+		call fxf_akwb ("INHERIT",
+		    FIT_INHERIT(fit), "Inherits global header", n)
+	    }
+	}
+
+	# Dates after iso_cutover use ISO format dates.
+	iferr (iso_cutover = envgeti (ENV_ISOCUTOVER))
+	    iso_cutover = DEF_ISOCUTOVER
+
+	# Encode the "DATE" keyword (records create time of imagefile).
+	call fxf_encode_date (clktime(long(0)), datestr, SZ_DATESTR,
+	    "ISO", iso_cutover)
+	len = strlen (datestr)
+
+	if (idb_findrecord (im, "DATE", rp) == 0) {
+	    # Keyword is not in the UA, created with current time
+	    call fxf_akwc ("DATE",
+		datestr, len, "Date FITS file was generated", n)
+	} else { 
+	    if (acmode == READ_WRITE) {
+		# Keep the old DATE, change only the IRAF-TLM keyword value
+		call imgstr (im, "DATE", datestr, SZ_DATESTR)
+	    }
+	    # See if the keyword is out of order.
+	    if (rp - uap > 12*81) {  
+		call fxf_filter_keyw (im, "DATE")
+
+		call fxf_akwc ("DATE",
+		    datestr, len, "Date FITS file was generated", n)
+	    } else
+	        call impstr (im, "DATE", datestr) 
+	}
+
+	# Encode the "IRAF_TLM" keyword (records time of last modification).
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    FIT_MTIME(fit) = IM_MTIME(im)
+	}
+
+	call fxf_encode_date (FIT_MTIME(fit), datestr, SZ_DATESTR, "TLM", 2010)
+#	call fxf_encode_date (clktime(long(0))+4, datestr, SZ_DATESTR, "TLM", 2010)
+	len = strlen (datestr)
+
+	if (idb_findrecord (im, "IRAF-TLM", rp) == 0) {
+	    call fxf_akwc ("IRAF-TLM",
+		datestr, len, "Time of last modification", n)
+	} else if (rp - uap > 13*81) {  
+	    call fxf_filter_keyw (im, "IRAF-TLM")
+	    call fxf_akwc ("IRAF-TLM",
+		datestr, len, "Time of last modification", n)
+	} else 
+	    call impstr (im, "IRAF-TLM", datestr) 
+
+	# Create DATA(MIN,MAX) keywords only if they have the real 
+	# min and max of the data.
+
+	if (IM_LIMTIME(im) >= IM_MTIME(im)) {
+	    if (idb_findrecord (im, "DATAMIN", rp) == 0) {
+		call fxf_akwr ("DATAMIN",
+		    IM_MIN(im), "Minimum data value", NDEC_REAL, n)
+	    } else
+		call imputr (im, "DATAMIN", IM_MIN(im))
+
+	    if (idb_findrecord (im, "DATAMAX", rp) == 0) {
+		call fxf_akwr ("DATAMAX",
+		    IM_MAX(im), "Maximum data value",NDEC_REAL, n)
+	    } else
+		call imputr (im, "DATAMAX", IM_MAX(im))
+	}
+
+	if (FIT_OBJECT(fit) != EOS) {
+	    if (idb_findrecord (im, "OBJECT", rp) == 0) {
+	        call fxf_akwc ("OBJECT", FIT_OBJECT(fit), 
+		    strlen (FIT_OBJECT(fit)), "Name of the object observed", n)
+	    } else if (rp - uap > 14*81) {  
+	        call fxf_filter_keyw (im, "OBJECT")
+	        call fxf_akwc ("OBJECT", FIT_OBJECT(fit),
+		    strlen (FIT_OBJECT(fit)), "Name of the object observed", n)
+	   } else 
+	        call impstr (im, "OBJECT", FIT_OBJECT(fit))
+	}
+
+	# Write Compression keywords for PLIO BINTABLE.
+#	if (subtype == FK_PLIO && IM_PFD(im) != NULL && ext_append) {
+	if (subtype == FK_PLIO) { 
+	    call fxf_akwb ("ZIMAGE", YES, "Is a compressed image", n)
+	    call fxf_akwc ("ZCMPTYPE", "PLIO_1", 6, "IRAF image masks", n) 
+	    call fxf_akwi ("ZBITPIX", 32, "BITPIX for uncompressed image",n)
+
+	    # We use IM_NDIM and IM_LEN here because FIT_NAXIS and _LENAXIS
+	    # are not available for NEW_IMAGE mode.
+
+	    ndim = IM_NDIM(im)
+	    call fxf_akwi ("ZNAXIS", ndim, "NAXIS for uncompressed image",n)
+	    do i = 1, ndim {
+	        call fxf_encode_axis ("ZNAXIS", keyword, i)
+	        call fxf_akwi (keyword, IM_LEN(im,i),  "Axis length", n)
+	    }
+	    call fxf_encode_axis ("ZTILE", keyword, 1)
+	    call fxf_akwi (keyword, IM_LEN(im,1), "Axis length", n)
+	    do i = 2, ndim {
+		call fxf_encode_axis ("ZTILE", keyword, i)
+		call fxf_akwi (keyword, 1, "Axis length", n)
+	    }
+	    call fxf_encode_axis ("ZNAME", keyword, 1)
+	    call fxf_akwc (keyword, "depth", 5, "PLIO mask depth", n)
+	    call fxf_encode_axis ("ZVAL", keyword, 1)
+	    call fxf_akwi (keyword, depth, "Parameter value", n)
+	}
+
+	# Write the UA now.
+	up = 1
+	nbk = 0
+	n = n - spp 
+	sz_rec = 1440
+	while (fxf_ua_card (fit, im, up, card) == YES) {
+	    call amovc (card, Memc[spp+n], LEN_CARD)
+	    n = n + LEN_CARD
+
+	    if (n == 2880) {
+		nbk = nbk + 1
+		call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+		call write (hdr_fd, Memi[mii], sz_rec)
+		n = 0
+	    }
+	}
+
+	# Write the last record.
+	nblanks = 2880 - n
+	call amovkc (blank, Memc[spp+n], nblanks)
+	rp = spp+n+nblanks-LEN_CARD
+
+	# If there are blocks of trailing blanks, write them now.
+	if (n > 0)
+	    nbk = nbk + 1
+	diff = nchars_ua - nbk * 1440
+	if (diff > 0) {
+	    if (n > 0) {
+		call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+		call write (hdr_fd, Memi[mii], sz_rec)
+	    }
+
+	    if (group < 0) {
+		# We are writing blocks of blanks on a new_copy
+		# image which has group=-1 here. Use diff.
+
+		nbk = diff / 1440
+	    } else {
+		pos = note (hdr_fd)
+		call fxf_not_incache(im)
+		poff = FIT_PIXPTR(fit)
+		nbk = (Memi[poff+group] - pos)
+		nbk = nbk / 1440
+	    }
+	    call amovkc (blank, Memc[spp], 2880)
+	    call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+	    do i = 1, nbk-1
+		call write (hdr_fd, Memi[mii], sz_rec)
+	   
+	    call amovkc (blank, Memc[spp], 2880)
+	    rp = spp+2880-LEN_CARD
+	}
+
+	call amovc ("END", Memc[rp], 3)
+	call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+	call write (hdr_fd, Memi[mii], sz_rec)
+	# PLIO: write the mask data to the new extension.
+	if (subtype == FK_PLIO && IM_PFD(im) != NULL) {
+	    call fxf_plwrite (im, hdr_fd)
+	    IM_PFD(im) = NULL
+	}
+
+	call flush (hdr_fd)
+	call  sfree (sp)
+end
+
+
+# FXF_UA_CARD  -- Fetch a single line from the user area, trim newlines and
+# pad with blanks to size LEN_CARD in order to create an unknown keyword card.
+# At present user area information is assumed to be in the form of FITS card
+# images, less then or equal to 80 characters and delimited by a newline.
+
+int procedure fxf_ua_card (fit, im, up, card)
+
+pointer fit			#I points to the fits descriptor
+pointer	im			#I pointer to the IRAF image
+int	up			#I next character in the unknown string
+char	card[ARB]		#O FITS card image
+
+char	cval
+int	stat, diff
+char	chfetch()
+int	strmatch()
+
+begin
+	if (chfetch (UNKNOWN(im), up, cval) == EOS)
+	    return (NO)
+	else {
+	    up = up - 1
+	    stat = NO
+
+	    while (stat == NO)  {
+	        diff = up
+	        call fxf_make_card (UNKNOWN(im), up, card, 1, LEN_CARD, '\n')
+	        diff = up - diff
+		if (card[1] == EOS)
+		    break
+
+	        if (strmatch (     card, "^GROUPS  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^GCOUNT  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^PCOUNT  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^BLOCKED ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^PSIZE   ") != 0)
+		    stat = NO
+	        else
+		    stat = YES
+	    }
+
+	    return (stat)
+	}
+end
+
+
+# FXF_SETBITPIX -- Set the FIT_BITPIX to the pixel datatype value.
+
+procedure fxf_setbitpix (im, fit)
+
+pointer	im			#I image descriptor 
+pointer fit			#I fit descriptor
+
+int	datatype
+errchk	syserr, syserrs
+
+begin
+	datatype = IM_PIXTYPE(im)
+
+	switch (datatype) {
+	case TY_SHORT, TY_USHORT:
+	    FIT_BITPIX(fit) = FITS_SHORT
+	case TY_INT, TY_LONG:
+	    FIT_BITPIX(fit) = FITS_LONG
+	case TY_REAL:
+	    FIT_BITPIX(fit) = FITS_REAL
+	case TY_DOUBLE:
+	    FIT_BITPIX(fit) = FITS_DOUBLE
+	default:
+	    call flush (STDOUT)
+	    call syserr (SYS_FXFUPHBTYP)
+	}
+end
+
+
+# FXF_MAKE_ADJ_COPY -- Copy a FITS file into a new one, changing the size
+# of a fits header.
+
+procedure fxf_make_adj_copy (in_fd, out_fd, hdr_off, pixoff, chars_ua)
+
+int	in_fd		#I input FITS descriptor
+int	out_fd		#I output FITS descriptor
+int	hdr_off		#I offset to be beginning of the ua to be resized
+int	pixoff		#I offset to be pixel area following hdroff
+int	chars_ua	#I size of the new UA (user area) in units of chars
+
+pointer	mii, sp
+int	nk, nblocks, junk, size_ua
+errchk  read, write
+int	read()
+
+begin
+	call smark (sp)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+
+	# Number of 1440 chars block up to the beginning of the UA to change.
+	nblocks = hdr_off / FITS_BLOCK_CHARS
+
+	# Copy  everything up to hdroff.
+	call seek (in_fd, BOF)
+	do nk = 1, nblocks {
+	    junk = read (in_fd, Memi[mii], FITS_BLOCK_CHARS)
+	    call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+	}
+
+	# Size of the new UA.
+	size_ua = FITS_LEN_CHAR(chars_ua)
+	nblocks = size_ua / FITS_BLOCK_CHARS
+	
+	# Put a blank new header in the meantime.
+	call amovki( 0, Memi[mii], FITS_BLOCK_CHARS)
+	do nk = 1, nblocks
+	    call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+
+	# Position after the current input header to continue 
+	# copying.
+
+	call flush (out_fd)
+	call seek (in_fd, pixoff)
+	call fcopyo (in_fd, out_fd)
+	call flush (out_fd)
+	call sfree (sp)
+end
+
+
+# FXF_SET_CACHE_MTIME -- Procedure to reset the modification time on the
+# cached entry for the file pointed by 'im'.
+
+procedure fxf_set_cache_time (im, overwrite)
+
+pointer im			#I image descriptor
+bool    overwrite		#I invalidate entry if true
+
+pointer sp, hdrfile, fit
+long    fi[LEN_FINFO]
+int	finfo(), cindx
+errchk	syserr, syserrs
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	if (finfo (Memc[hdrfile], fi) == ERR)
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		# Reset cache
+		if (IM_ACMODE(im) == READ_WRITE || overwrite) {
+		    # Invalidate entry.
+		    call mfree (rf_pextv[cindx], TY_INT)
+		    call mfree (rf_pextn[cindx], TY_CHAR)
+		    call mfree (rf_pixp[cindx], TY_INT)
+		    call mfree (rf_hdrp[cindx], TY_INT)
+		    call mfree (rf_fit[cindx], TY_STRUCT)
+		    call mfree (rf_hdr[cindx], TY_CHAR)
+		    rf_fname[1,cindx] = EOS
+		    rf_mtime[cindx] = 0
+	     	    rf_fit[cindx] = NULL
+
+		} else {
+		    # While we are appending we want to keep the cache entry
+		    # in the slot.
+		    rf_mtime[cindx] = FI_MTIME(fi)
+		}
+		break
+	    }
+	}
+
+	call sfree (sp)
+end	
+
+
+# FXF_SET_EXTNV -- Procedure to write UA value of EXTNAME and EXTVER
+# into the cache slot.
+
+procedure fxf_set_extnv (im)
+
+pointer im			#I image descriptor
+
+pointer fit, sp, hdrfile
+int	cindx, ig, extn, extv
+errchk	syserr, syserrs
+bool    bxtn, bxtv
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+	fit = IM_KDES(im)
+	ig = FIT_GROUP(fit)
+
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		bxtn = (FIT_EXTNAME(fit) != EOS)
+		bxtv = (!IS_INDEFL (FIT_EXTVER(fit)))
+		# Reset cache
+		if (IM_ACMODE(im) == READ_WRITE) {
+		    if (bxtn) {
+			extn = rf_pextn[cindx]
+		        # Just replace the value
+			call strcpy (FIT_EXTNAME(fit), Memc[extn+LEN_CARD*ig],
+			    LEN_CARD)
+		    }
+		    if (bxtv) {
+			extv = rf_pextv[cindx]
+		        # Just replace the value
+			Memi[extv+ig] = FIT_EXTVER(fit)
+		    }
+		}
+		break
+	    }
+	}
+
+	call sfree (sp)
+end	
+
+
+# FXF_REN_TMP -- Rename input file to output file.
+#
+# The output file may already exists in which case it is replaced.
+# Because this operation is critical it is heavily error checked and
+# has retries to deal with networking cases.
+
+procedure fxf_ren_tmp (in, out, tmp, ntry, nsleep)
+
+char 	in[ARB]			#I file to replace output
+char    out[ARB]		#O output file (replaced if it exists)
+char	tmp[ARB]		#I temporary name for in until rename succeeds
+int	ntry			#I number of retries for rename
+int	nsleep			#I Number of seconds to sleep before retry
+
+int	i, stat, err, access(), protect(), errget()
+bool	replace, prot
+pointer	errstr
+
+errchk	access, protect, rename, delete, salloc
+
+begin
+#call eprintf ("fxf_ren_tmp (%s, %s, %s, %d %d)\n")
+#call pargstr (in)
+#call pargstr (out)
+#call pargstr (tmp)
+#call pargi (ntry)
+#call pargi (nsleep)
+	err = 0; errstr = NULL
+
+	iferr {
+	    # Move original output out of the way.
+	    # Don't delete it in case of an error.
+	    replace = (access (out, 0, 0) == YES)
+	    prot = false
+	    if (replace) {
+	        prot = (protect (out, QUERY_PROTECTION) == YES)
+		if (prot)
+		    stat = protect (out, REMOVE_PROTECTION)
+		do i = 0, max(0,ntry) {
+#call eprintf ("1 rename (%s, %s)\n")
+#call pargstr (out)
+#call pargstr (tmp)
+		    ifnoerr (call rename (out, tmp)) {
+			err = 0
+		        break
+		    }
+		    if (errstr == NULL)
+		        call salloc (errstr, SZ_LINE, TY_CHAR)
+		    err = errget (Memc[errstr], SZ_LINE)
+		    if (err == 0)
+		        err = SYS_FMKCOPY
+		    call tsleep (nsleep)
+		}
+		if (err > 0)
+		    call error (err, Memc[errstr])
+	    }
+
+	    # Now rename the input to the output.
+	    do i = 0, max(0,ntry) {
+#call eprintf ("2 rename (%s, %s)\n")
+#call pargstr (in)
+#call pargstr (out)
+		ifnoerr (call rename (in, out)) {
+		    err = 0
+		    break
+		}
+		if (errstr == NULL)
+		    call salloc (errstr, SZ_LINE, TY_CHAR)
+		err = errget (Memc[errstr], SZ_LINE)
+		if (err == 0)
+		    err = SYS_FMKCOPY
+		call tsleep (nsleep)
+	    }
+	    if (err > 0)
+		call error (err, Memc[errstr])
+	    if (prot)
+		stat = protect (out, SET_PROTECTION)
+
+	    # If the rename has succeeded delete the original data.
+	    if (replace) {
+#call eprintf ("delete (%s)\n")
+#call pargstr (tmp)
+	        call delete (tmp)
+	    }
+	} then
+	    call erract (EA_ERROR)
+end
+
+
+# FXF_OVER_TMP -- Rename an entry from the cache.
+
+procedure fxf_over_delete (im)
+
+pointer im			#I image descriptor
+
+pointer fname, sp
+bool	streq()
+int	cindx
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+
+        # Remove the image from the FITS cache if found.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+	    if (streq (Memc[fname], rf_fname[1,cindx])) {
+		call mfree (rf_pextv[cindx], TY_INT)
+		call mfree (rf_pextn[cindx], TY_CHAR)
+		call mfree (rf_pixp[cindx], TY_INT)
+		call mfree (rf_hdrp[cindx], TY_INT)
+		call mfree (rf_fit[cindx], TY_STRUCT)
+		call mfree (rf_hdr[cindx], TY_CHAR)
+		rf_fit[cindx] = NULL
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_UPDATE_EXTEND -- Add or change the value of the EXTEND keyword in PHU.
+# Sometimes the input PHU has not been created by the FK and the EXTEND keyw
+# might not be there as the standard tells when an extension is appended
+# to a file.
+
+procedure fxf_update_extend (im)
+
+pointer	im			#I image descriptor	
+
+pointer sp, hdrfile, tmp1, tmp2
+int	fd, fdout, i, nch, nc, cfit
+char	line[LEN_CARD], blank, cindx
+bool	streq()
+int	open(), naxis, read(), strncmp(), fnroot()
+long    note()
+errchk	open, fxf_ren_tmp
+
+include "fxfcache.com"
+define	cfit_ 91
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	fd = open (IM_HDRFILE(im), READ_WRITE, BINARY_FILE)
+
+	# Look for EXTEND keyword and change its value in place.
+	nc = 0
+	while (read (fd, line, 40) != EOF) {
+	    nc = nc + 1
+	    call achtbc (line, line, LEN_CARD)
+	    if (strncmp ("EXTEND  ", line, 8) == 0) {
+		line[30] = 'T'
+	        call seek (fd, note(fd)-40)
+		call achtcb (line, line, LEN_CARD)
+		call write (fd, line, 40)
+		call close (fd)
+		goto cfit_
+	    } else if (strncmp ("END     ", line, 8) == 0) 
+		break
+	}
+
+	# The EXTEND card is not in the header. Insert it after the
+	# last NAXISi in a temporary file, rename after this.
+	
+	call salloc (tmp1, SZ_FNAME, TY_CHAR)
+	i = fnroot (IM_HDRFILE(im), Memc[tmp1], SZ_FNAME)
+	call mktemp (Memc[tmp1], Memc[tmp1], SZ_FNAME)
+
+	fdout = open (Memc[tmp1], NEW_FILE, BINARY_FILE)
+
+	call seek (fd, BOF)
+	do i = 0, nc-2 {
+	    nch = read (fd, line, 40)
+	    call write (fdout, line, 40)
+	    call achtbc(line, line, LEN_CARD)
+	    if (strncmp ("NAXIS   ", line, 8) == 0) 
+	        call fxf_geti (line, naxis)
+	    else if (strncmp ("NAXIS", line, 5)  == 0){
+		if ((line[6] - '0') == naxis) {
+		    # Now create the EXTEND card in the output file.
+		    call fxf_encodeb ("EXTEND", YES, line, 
+		        "File may contain extensions")
+		    call achtcb (line, line , LEN_CARD)
+		    call write (fdout, line, 40)
+	        }
+	    }
+	}
+
+	if (mod (nc, 36) == 0) {
+	    # We have to write one END card and 35 blank card.
+	    blank = ' '
+	    call amovkc (blank, line, 80)
+	    call amovc ("END", line, 3)
+	    call achtcb (line, line , LEN_CARD)
+	    call write (fdout, line, 40)
+	    call amovkc (blank, line, 80)
+	    call achtcb (line, line , LEN_CARD)
+	    for (i=1;  i < 36;  i=i+1)
+		call write (fdout, line, 40)
+	} else {
+	    nch = read (fd, line, 40)
+	    call write (fdout, line, 40)
+	}
+
+	# Read one more line to synchronize.
+	nch = read (fd, line, 40)
+
+	# Copy the rest of the file. 
+	call fcopyo (fd, fdout)
+	
+	call close (fd)
+	call close (fdout)
+
+	call salloc (tmp2, SZ_FNAME, TY_CHAR)
+	call strcpy (Memc[tmp1], Memc[tmp2], SZ_FNAME)
+	call strcat ("A", Memc[tmp2], SZ_FNAME)
+	call fxf_ren_tmp (Memc[tmp1], IM_HDRFILE(im), Memc[tmp2], 1, 1)
+
+cfit_
+	# Now reset the value in the cache
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		# Reset cache
+		cfit = rf_fit[cindx]
+		FIT_EXTEND(cfit) = YES
+		break
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfupk.x b/sys/imio/iki/fxf/fxfupk.x
new file mode 100644
index 00000000..b6b158ae
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfupk.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <mach.h>
+include "fxf.h"
+
+# FXFUPK.X -- Routines to upack an IEEE vector into native format.
+#
+#	fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+#	      fxf_altmr (a, b, npix, bscale, bzero)
+#	      fxf_altmd (a, b, npix, bscale, bzero)
+#	      fxf_altmu (a, b, npix)
+#	      fxf_astmr (a, b, npix, bscale, bzero)
+
+define	NBITS_DOU	(SZB_CHAR * SZ_DOUBLE)
+define	IOFF		1
+
+
+# FITUPK -- Unpack cbuf in place from FITS binary format to local machine type.
+
+procedure fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+
+char	cbuf[ARB]		#U buffer with input,output data
+int	npix			#I number of pixels in buffer
+int	pixtype			#I input pixtype
+double	bscale			#I scale factor to applied to input data
+double	bzero			#I offset to applied to input data
+
+int	nchars, nbytes
+bool	fp_equald()
+errchk	syserr
+
+include <szpixtype.inc>
+
+begin
+        nchars = npix * pix_size[pixtype]
+	nbytes = nchars * SZB_CHAR
+
+	switch (pixtype) {
+	case TY_SHORT, TY_USHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (cbuf, 1, cbuf, 1, nbytes)
+	    if (pixtype == TY_USHORT)
+		call fxf_altmu (cbuf, cbuf, npix)
+
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+
+	case TY_REAL:
+	    ### Rather than perform this test redundantly a flag should be
+	    ### passed in from the high level code telling the routine whether
+	    ### or not it should apply the scaling.  Testing for floating
+	    ### point equality (e.g. bscale != 1.0) is not portable.
+
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl32 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkr (cbuf, cbuf, npix)
+	   
+	case TY_DOUBLE:
+	    ### Same as above.
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl64 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkd (cbuf, cbuf, npix)
+	   
+	default:
+	    call syserr (SYS_FXFUPKDTY)
+	}
+end
+
+
+# FXF_ALTMR -- Scale a real array.
+
+procedure fxf_altmr (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = 1, npix
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+
+# FXF_ALTMD -- Scale a double array.
+
+procedure fxf_altmd (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+double	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	### int and double are not the same size so if this operation is
+	### to allow an in-place conversion it must go right to left instead
+	### of left to right.
+
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+
+
+# FXF_ALTMU -- Scale an array to unsigned short.
+
+procedure fxf_altmu (a, b, npix)
+
+short	 a[ARB]			 #I input array
+char	 b[ARB]			 #O output array
+int	 npix			 #I number of pixels
+
+int	i
+pointer sp, ip
+
+begin
+	call smark (sp)
+	call salloc (ip, npix+1, TY_INT)
+		 
+	do i = 1, npix
+	    Memi[ip+i] = a[i] + 32768
+
+	call achtlu (Memi[ip+1], b, npix)
+	call sfree (sp)
+end
+
+
+# FXF_ASTMR -- Scale an input short array into a real.
+
+procedure fxf_astmr (a, b, npix, bscale, bzero)
+
+short	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+
diff --git a/sys/imio/iki/fxf/mkpkg b/sys/imio/iki/fxf/mkpkg
new file mode 100644
index 00000000..859d6f47
--- /dev/null
+++ b/sys/imio/iki/fxf/mkpkg
@@ -0,0 +1,42 @@
+# Build or update the FITS kernel.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	fxfaccess.x	fxf.h
+	fxfaddpar.x	<imhdr.h> <imio.h> <mach.h> fxf.h
+	fxfclose.x	fxf.h <imhdr.h> <imio.h>
+	fxfcopy.x	<error.h>
+	fxfctype.x	fxf.h <ctype.h>
+	fxfdelete.x	<error.h> <imhdr.h> fxf.h fxfcache.com
+	fxfencode.x	fxf.h <time.h>
+	fxfexpandh.x	fxf.h fxfcache.com <fset.h> <imhdr.h> <imio.h>\
+			<mach.h> <mii.h>
+	fxfget.x	fxf.h <ctype.h>
+	fxfhextn.x	fxf.h <imhdr.h> <imio.h>
+	fxfksection.x	<error.h> fxf.h <ctotok.h> <imhdr.h> <lexnum.h>
+	fxfmkcard.x	
+	fxfnull.x	fxf.h
+	fxfopen.x	fxf.h fxfcache.com <error.h> <imhdr.h> <imio.h>\
+			fxfcache.com <finfo.h> <fset.h> <mach.h> <mii.h>\
+			<pmset.h>
+	fxfopix.x	fxf.h <fset.h> <imhdr.h> <imio.h> <error.h> <mach.h>
+	fxfpak.x	fxf.h <mach.h>
+	fxfplread.x	fxf.h <imhdr.h> <imio.h> <mach.h> <plset.h>
+	fxfplwrite.x	fxf.h <imio.h> <mach.h> <mii.h> <plset.h> <pmset.h>\
+			<imhdr.h>
+	fxfrcard.x	fxf.h <mii.h>
+	fxfrdhdr.x	fxf.h <imhdr.h> <imio.h> <mach.h>
+	fxfrename.x	<error.h> fxf.h fxfcache.com
+	fxfrfits.x	fxf.h fxfcache.com <ctype.h> <finfo.h> <fset.h>\
+			<imhdr.h> <imio.h> <imset.h> <mach.h> <time.h>
+	fxfupdhdr.x	fxf.h <fio.h> <fset.h> <imhdr.h> <imio.h>\
+			fxfcache.com <error.h> <finfo.h> <mach.h> <mii.h>\
+			<time.h>
+	fxfupk.x	fxf.h <mach.h>
+	zfiofxf.x	fxf.h <fio.h> <fset.h> <imhdr.h> <imio.h> <knet.h>\
+			<mach.h>
+	;
diff --git a/sys/imio/iki/fxf/zfiofxf.x b/sys/imio/iki/fxf/zfiofxf.x
new file mode 100644
index 00000000..97b36264
--- /dev/null
+++ b/sys/imio/iki/fxf/zfiofxf.x
@@ -0,0 +1,546 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <mach.h>
+include <knet.h>
+include <fio.h>
+include <fset.h>
+include <imio.h>
+include <imhdr.h>
+include	"fxf.h"
+
+# ZFIOFXF -- FITS kernel virtual file driver.   This maps the actual
+# FITS file into the virtual pixel file expected by IMIO.
+
+
+# FXFZOP -- Open the file driver for i/o.  The filename has appended the
+# string "_nnnnn", where 'nnnnn' is the FIT descriptor to the structure
+# defined in "fit.h".
+
+procedure fxfzop (pkfn, mode, status)
+
+char	pkfn[ARB]		#I packed virtual filename from FIO
+int	mode			#I file access mode (ignored)
+int	status			#O output status - i/o channel if successful
+
+pointer im, fit
+int	ip, indx, channel, strldx(), ctoi()
+bool	lscale, lzero, bfloat, fxf_fpl_equald()
+char    fname[SZ_PATHNAME]
+
+begin
+	# Separate the FIT descriptor from the file name.
+	call strupk (pkfn, fname, SZ_PATHNAME)
+
+        ip = strldx ("_", fname)
+	indx = ip + 1
+	if (ctoi (fname, indx, fit) <= 0) {
+	   status = ERR
+	   return
+	}
+
+	# Determine if we have a Fits Kernel non supported
+	# data format; i.e. Bitpix -32 or -64 and BSCALE and/or
+	# BZERO with non default values.
+
+	### Only "low level" routines can be falled from a file driver:
+	### high level routines like syserr cannot be used due to
+	### recursion/reentrancy problems.
+	# We are calling syserrs at this level because we want to
+	# give the application the freedom to manipulate the FITS header
+	# at will and not imposing restriction at that level.
+
+	im = FIT_IM(fit)
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	#bfloat = (!lscale || !lzero)
+	#if (bfloat && (FIT_BITPIX(fit) == -32 || FIT_BITPIX(fit) == -64)) {
+	#    FIT_IOSTAT(fit) = ERR
+	#    #call syserrs (SYS_FXFRDHSC,IM_HDRFILE(im))
+	#    status = ERR
+	#    return
+	#}
+
+	fname[ip] = EOS
+	call strpak (fname, fname, SZ_PATHNAME)
+
+	# Open the file.
+	call zopnbf (fname, mode, channel)
+	if (channel == ERR) {
+	   status = ERR
+	   return
+	}
+
+	status = fit
+	FIT_IO(fit) = channel
+end
+
+
+# FITZCL -- Close the FIT binary file driver.
+
+procedure fxfzcl (chan, status)
+
+int	chan			#I FIT i/o channel
+int	status			#O output status
+
+pointer fit
+
+begin
+	fit = chan
+	call zclsbf (FIT_IO(fit), status)
+end
+
+
+# FXFZRD --  Read the FIT file (header and pixel data).  An offset pointer
+# needs to be set to point to the data portion of the file. If we are reading
+# pixel data, the scale routine fxf_unpack_data is called.  We need to keep
+# a counter (npix_read) with the current number of pixels unpacked since we
+# don't want to convert beyond the total number of pixels; where the last
+# block of data read can contain zeros or garbage up to a count of 2880 bytes.
+
+procedure fxfzrd (chan, obuf, nbytes, boffset)
+
+int	chan			#I FIT i/o channel
+char	obuf[ARB]		#O output buffer
+int	nbytes			#I nbytes to be read
+int	boffset			#I file offset at which read commences
+
+pointer fit, im
+int	ip, pixtype, nb
+int	status, totpix, npix
+int	datasizeb, pixoffb, nb_skipped, i
+double  dtemp
+real    rtemp, rscale, roffset
+
+include <szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+	FIT_IOSTAT(fit) = OK
+
+	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+	if (FIT_ZCNV(fit) == YES) {
+	    if (FIT_PIXTYPE(fit) != TY_REAL && FIT_PIXTYPE(fit) != TY_DOUBLE) {
+	       call fxf_cnvpx (im, totpix, obuf, nbytes, boffset)
+	       return
+	    } 
+	}
+
+	pixtype = IM_PIXTYPE(im)
+	datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	pixoffb = (FIT_PIXOFF(fit) - 1) * SZB_CHAR + 1
+
+	# We can read the data directly into the caller's output buffer as 
+	# any FITS kernel input conversions are guaranteed to not make the
+	# data smaller.  
+
+	call zardbf (FIT_IO(fit), obuf, nbytes, boffset)
+	call zawtbf (FIT_IO(fit), status)
+	if (status == ERR) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	### boffset is 1-indexed, so one would expect (boffset/SZB_CHAR) to
+	### be ((boffset - 1) * SZB_CHAR + 1).  This is off by one from what
+	### is being calculated, so if PIXOFF and boffset point to the same
+	### place IP will be one, which happens to be the correct array index. 
+	### Nonehtless expressions like this should be written out so that
+	### they can be verified easily by reading them.  Any modern compiler
+	### will optimize the expression, we don't have to do this in the
+	### source code.
+
+	ip = FIT_PIXOFF(fit) - boffset/SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	nb_skipped = boffset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (status + nb_skipped, datasizeb)
+	else
+	    nb = min (status, datasizeb - nb_skipped)
+	npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+
+	if (FIT_ZCNV(fit) == YES) {
+	    if (FIT_PIXTYPE(fit) == TY_REAL) {
+		# This is for scaling -32 (should not be allowed)
+		call fxf_zaltrr(obuf[ip], npix, FIT_BSCALE(fit), FIT_BZERO(fit))
+            } else if (FIT_PIXTYPE(fit) == TY_DOUBLE) {
+	        # This is for scaling -64 data (should not be allowed)
+		call fxf_zaltrd(obuf[ip], npix, FIT_BSCALE(fit), FIT_BZERO(fit))
+            }	    
+        } else {
+	   call fxf_unpack_data (obuf[ip],
+	       npix, pixtype, FIT_BSCALE(fit), FIT_BZERO(fit)) 
+        }
+end
+
+procedure fxf_zaltrr (data, npix, bscale, bzero)
+
+real data[ARB], rt
+int    npix
+double bscale, bzero
+
+int i
+
+begin
+	call ieevupkr (data, data, npix)
+        do i = 1, npix {
+	   data[i] = data[i] * bscale + bzero
+        }
+end
+
+
+procedure fxf_zaltrd (data, npix, bscale, bzero)
+
+double data[ARB]
+int    npix
+double bscale, bzero
+
+int i
+
+begin
+	call ieevupkd (data, data, npix)
+        do i = 1, npix
+	   data[i] = data[i] * bscale + bzero
+end
+
+
+ 
+# FXFZWR -- Write to the output file. 
+
+procedure fxfzwr (chan, ibuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	ibuf[ARB]		#O data buffer
+int	nbytes			#I nbytes to be written
+int	boffset			#I file offset
+
+pointer fit, im, sp, obuf
+bool	noconvert, lscale, lzero, bfloat
+int	ip, op, pixtype, npix, totpix, nb, nchars, i
+int	datasizeb, pixoffb, nb_skipped, obufsize
+
+bool	fxf_fpl_equald()
+
+include	<szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+	FIT_IOSTAT(fit) = OK
+
+	# We don't have to pack the data if it is integer and we don't need
+	# to byte swap; the data buffer can be written directly out.
+
+
+	# Determine if we are writing into an scaled floating point data
+	# unit; i.e. bitpix > 0 and BSCALE or/and BZERO with non default
+	# values.  This is an error since we are not supporting this
+	# combination for writing at this time.
+
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+	if (bfloat &&
+		(IM_PIXTYPE(im) == TY_REAL || IM_PIXTYPE(im) == TY_DOUBLE)) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	pixtype = IM_PIXTYPE(im)
+	noconvert = ((pixtype == TY_SHORT && BYTE_SWAP2 == NO) ||
+	    ((pixtype == TY_INT || pixtype == TY_LONG) && BYTE_SWAP4 == NO))
+
+	if (noconvert) {
+	    call zawrbf (FIT_IO(fit), ibuf, nbytes, boffset)
+	    return
+	}
+
+	# Writing pixel data to an image is currently illegal if on-the-fly
+	# conversion is in effect, as on-the-fly conversion is currently only
+	# available for reading.
+
+	if (FIT_ZCNV(fit) == YES) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+        }		
+
+	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+	datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	pixoffb = (FIT_PIXOFF(fit) - 1) * SZB_CHAR + 1
+
+	### Same comments as for fxfzrd apply here.
+	### There doesn't appear to be any support here for byte data like
+	### in fxfzwr.  This must mean that byte images are read-only.
+	### This shouldn't be necessary, but we shouldn't try to do anything
+	### about it until the fxf_byte_short issue is addressed.
+
+	ip = FIT_PIXOFF(fit) - boffset / SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	nb_skipped = boffset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (nbytes + nb_skipped, datasizeb)
+	else
+	    nb = min (nbytes, datasizeb - nb_skipped)
+	npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+
+	if (npix == 0) 
+	    return
+
+	# We don't do scaling (e.g. BSCALE/BZERO) when writing.  All the
+	# generated FITS files in this interface are ieee fits standard.
+	### I didn't look into it but I don't understand this; when accessing
+	### a BSCALE image read-write, it should be necessary to scale both
+	### when reading and writing if the application sees TY_REAL pixels.
+	### When writing a new image I suppose the application would take
+	### care of any scaling.
+
+	# Convert any pixel data in the input buffer to the binary format
+	# required for FITS and write it out.  Any non-pixel data in the
+	# buffer should be left as-is.
+
+	obufsize = (nbytes + SZB_CHAR-1) / SZB_CHAR
+
+	call smark (sp)
+	call salloc (obuf, obufsize, TY_CHAR)
+
+	# Preserve any leading non-pixel data.
+	op = 1
+	if (ip > 1) {
+	    nchars = min (obufsize, ip - 1) 
+	    call amovc (ibuf[1], Memc[obuf], nchars)
+	    op = op + nchars
+	}
+
+	# Convert and output the pixels.
+	call fxf_pak_data (ibuf[ip], Memc[obuf+op-1], npix, pixtype)
+	op = op + npix * pix_size[pixtype]
+
+	# Preserve any remaining non-pixel data.
+	nchars = obufsize - op + 1
+	if (nchars > 0)
+	    call amovc (ibuf[op], Memc[obuf+op-1], nchars)
+
+	# Write out the data.
+	call zawrbf (FIT_IO(fit), Memc[obuf], nbytes, boffset)
+
+	call sfree (sp)
+end
+
+
+# FXFZWT -- Return the number of bytes transferred in the last i/o request.
+
+procedure fxfzwt (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O i/o channel status
+
+pointer fit, im
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+
+	# A file driver returns status for i/o only in the AWAIT routine;
+	# hence any i/o errors occurring in the FK itself are indicated by
+	# setting FIT_IOSTAT.  Otherwise the actual i/o operation must have
+	# been submitted, and we call zawtbf to wait for i/o, and get status.
+
+	if (FIT_IOSTAT(fit) != OK)
+	    status = FIT_IOSTAT(fit)
+	else
+	    call zawtbf (FIT_IO(fit), status)
+
+	# FIT_ZBYTES has the correct number of logical bytes that need
+	# to be passed to fio since we are expanding the buffer size
+	# from byte to short or real and short to real.
+
+	if (status > 0) {
+	    if (FIT_PIXTYPE(fit) == TY_UBYTE)
+		status = FIT_ZBYTES(fit)
+	    else if (FIT_PIXTYPE(fit) == TY_SHORT && IM_PIXTYPE(im) == TY_REAL)
+		status = FIT_ZBYTES(fit)
+	}
+end
+
+
+# FXFZST -- Query device/file parameters.
+
+procedure fxfzst (chan, param, value)
+
+int	chan			#I FIT i/o channel
+int	param			#I parameter to be returned
+int	value			#O parameter value
+
+pointer fit, im
+int	i, totpix, szb_pixel, szb_real
+
+include	<szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+
+    	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+        szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+	szb_real = SZ_REAL * SZB_CHAR
+
+	call zsttbf (FIT_IO(fit), param, value)
+
+	if (param == FSTT_FILSIZE) {
+	    switch (FIT_PIXTYPE(fit)) {
+	    case TY_SHORT:
+		if (IM_PIXTYPE(im) == TY_REAL) {
+		    value = value + int ((totpix * SZ_SHORT * SZB_CHAR) /
+			2880. + .5) * 2880
+		}
+	    case TY_UBYTE:
+		if (IM_PIXTYPE(im) == TY_SHORT)
+		    value = value + int (totpix/2880. + 0.5)*2880
+	        else if (IM_PIXTYPE(im) == TY_REAL)
+		    value = value + int(totpix*(szb_real-1)/2880. + 0.5) * 2880
+            }
+	}
+end
+
+
+# FXF_CNVPX -- Convert FITS type BITPIX = 8 to SHORT or REAL depending
+# on the value of BSCALE, BZERO (1, 32768 is already iraf supported as ushort
+# and is not treated in here). If BITPIX=16 and BSCALE and BZERO are 
+# non-default then the pixels are converted to REAL.
+
+procedure fxf_cnvpx (im, totpix, obuf, nbytes, boffset)
+
+pointer im			#I Image descriptor
+int	totpix			#I Total number of pixels		
+char    obuf[ARB]		#O Output data buffer
+int	nbytes			#I Size in bytes of the output buffer
+int	boffset			#I Byte offset into the virtual image
+
+pointer sp, buf, fit, op
+double	bscale, bzero
+int	ip, nelem, pfactor
+int	pixtype, nb, buf_size, bzoff, nboff
+int	status, offset, npix
+int	datasizeb, pixoffb, nb_skipped
+
+include	<szpixtype.inc>
+
+begin
+	fit = IM_KDES(im)
+	bscale = FIT_BSCALE(fit)
+	bzero  = FIT_BZERO(fit)
+
+	ip = FIT_PIXOFF(fit) - boffset/SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	# The beginning of the data portion in bytes.
+	pixoffb = (FIT_PIXOFF(fit)-1) * SZB_CHAR + 1
+	
+	# Determine the factor to applied: size(im_pixtype)/size(fit_pixtype)
+	if (FIT_PIXTYPE(fit) == TY_UBYTE) {
+	    if (IM_PIXTYPE(im) == TY_REAL)
+		pfactor = SZ_REAL * SZB_CHAR
+	    else  					# TY_SHORT
+		pfactor = SZB_CHAR
+	    datasizeb = totpix
+	} else if (FIT_PIXTYPE(fit) == TY_SHORT) {
+	    pfactor = SZ_REAL / SZ_SHORT
+	    pixtype = TY_SHORT
+	    datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	} else {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	# We need to map the virtual image of type im_pixtype to the actual
+	# file of type fit_pixtype. 'nbytes' is the number of bytes to read
+	# from the virtual image. To find out how many fit_pixtype bytes 
+	# we need to read from disk we need to subtract the FITS
+	# header size (if boffset is 1) from nbytes and then divide
+	# the resultant value by the convertion factor.
+	# We then add the size of the header if necessary.
+
+	# Determine the offset into the pixel area.
+	nboff = boffset - pixoffb
+	if (nboff > 0) {
+	    nelem = nboff / pfactor
+	    offset = nelem + pixoffb
+	} else  {
+	    # Keep the 1st boffset.
+	    bzoff = boffset
+	    offset = boffset
+	}
+
+	# Calculates the number of elements to convert. We keep the offset from
+	# the beginning of the unit (bzoff) and not from file's 1st byte.
+
+	nelem = nbytes - (pixoffb - bzoff + 1)
+	nelem = nelem / pfactor
+	buf_size = nelem + (pixoffb - bzoff + 1)
+	if (buf_size*pfactor > nbytes && ip == 1)
+	    buf_size = (nbytes - 1) / pfactor + 1 
+
+	# Allocate space for TY_SHORT
+	call smark(sp)
+	call salloc (buf, buf_size/SZB_CHAR, TY_SHORT)
+	    
+	call zardbf (FIT_IO(fit), Mems[buf], buf_size, offset)
+	call zawtbf (FIT_IO(fit), status)
+	if (status == ERR) {
+	    FIT_IOSTAT(fit) = ERR
+	    call sfree (sp)
+	    return
+	}
+	    
+	# Map the number of bytes of datatype FIT_PIXTYPE to 
+	# IM_PIXTYPE for use in zfxfwt().
+	     
+	if (status*pfactor >= nbytes)
+	    FIT_ZBYTES(fit) = nbytes
+	else
+	    FIT_ZBYTES(fit) = status * pfactor
+
+	nb_skipped = offset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (status + nb_skipped, datasizeb)
+	else
+	    nb = min (status, datasizeb - nb_skipped)
+
+	switch (FIT_PIXTYPE(fit)) {
+	case TY_UBYTE:
+	    npix = max (0, nb)
+	    if (IM_PIXTYPE(im) == TY_SHORT)
+		call achtbs (Mems[buf+ip-1], obuf[ip], npix)
+	    else {
+		# Scaled from byte to REAL.
+		call achtbl (Mems[buf+ip-1], obuf[ip], npix)
+		call fxf_altmr (obuf[ip], obuf[ip], npix, bscale, bzero)
+	    }
+	case TY_SHORT:
+	    op = buf + ip - 1
+	    npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (Mems[op], 1, Mems[op], 1, npix*SZB_CHAR)
+	    call fxf_astmr (Mems[op], obuf[ip], npix, bscale, bzero)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/iki.com b/sys/imio/iki/iki.com
new file mode 100644
index 00000000..1c8ef719
--- /dev/null
+++ b/sys/imio/iki/iki.com
@@ -0,0 +1,10 @@
+# IKI.COM -- Image Kernel Interface global common.
+
+int	k_nkernels, k_nextn, k_sbufused, k_defimtype, k_inherit
+int	k_kernel[MAX_IMEXTN], k_extn[MAX_IMEXTN], k_pattern[MAX_IMEXTN]
+int	k_table[LEN_KERNEL,MAX_KERNELS]
+char	k_kname[SZ_KNAME,MAX_KERNELS]
+char	k_sbuf[SZ_IKISBUF]
+
+common	/ikicom/ k_nkernels, k_nextn, k_sbufused, k_defimtype, k_inherit,
+	k_kernel, k_extn, k_pattern, k_table, k_kname, k_sbuf
diff --git a/sys/imio/iki/iki.h b/sys/imio/iki/iki.h
new file mode 100644
index 00000000..be7a6bc0
--- /dev/null
+++ b/sys/imio/iki/iki.h
@@ -0,0 +1,35 @@
+# IKI.H -- Image Kernel Interface global definitions.
+
+define	MAX_KERNELS	10		# max loaded IKI kernels
+define	MAX_LENEXTN	4		# max length header filename extension
+define	MIN_LENEXTN	2		# min length header filename extension
+define	MAX_IMEXTN	64		# max image extension patterns
+define	SZ_IKISBUF	512		# string buffer for IKI common
+define	SZ_KNAME	4		# internal kernel name "oif,fxf,.."
+
+# IMTYPE specifies the default type for new images.
+define	ENV_IMTYPE	"imtype"
+define	DEF_IMTYPE	"oif,noinherit"
+
+# IMEXTN specifies the mapping between image types and file extensions.
+define	ENV_IMEXTN	"imextn"
+define	DEF_IMEXTN	"oif:imh fxf:fits,fit plf:pl qpf:qp stf:hhh,??h"
+
+# The standard test image.
+define	STD_TESTIMAGE	"dev$pix"
+define	DEF_TESTIMAGE	"dev$pix.imh"
+
+define	LEN_KERNEL	9		# length of a kernel entry in k_table
+define	IKI_KNAME	k_kname[1,$1]	# image kernel name
+define	IKI_OPEN	k_table[1,$1]	# open/create image
+define	IKI_CLOSE	k_table[2,$1]	# close image
+define	IKI_OPIX	k_table[3,$1]	# open/create pixel file
+define	IKI_UPDHDR	k_table[4,$1]	# update image header
+define	IKI_ACCESS	k_table[5,$1]	# test existence or legal type
+define	IKI_COPY	k_table[6,$1]	# fast copy of entire image
+define	IKI_DELETE	k_table[7,$1]	# delete image
+define	IKI_RENAME	k_table[8,$1]	# rename image
+define	IKI_FLAGS	k_table[9,$1]	# driver flags
+
+# IKI driver flags.
+define	IKF_NOCREATE	1		# kernel cannot create new images
diff --git a/sys/imio/iki/ikiaccess.x b/sys/imio/iki/ikiaccess.x
new file mode 100644
index 00000000..83736b4f
--- /dev/null
+++ b/sys/imio/iki/ikiaccess.x
@@ -0,0 +1,128 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include "iki.h"
+
+# IKI_ACCESS -- Determine if the named image exists, and if so, return the
+# the index of the IKI kernel to be used to access the image, else return 0 if
+# the named image is not found.  If multiple images exist with the same name
+# (e.g. but with different image types) then ERR is returned.  An NEW_IMAGE
+# access mode may be specified to associate an extension with an image kernel
+# without testing for the existence of an image.  If the input image name did
+# not specify an extension or what appeared to be an extension was just a .
+# delimited field, we will patch up the ROOT and EXTN strings to the real
+# values.
+
+int procedure iki_access (image, root, extn, acmode)
+
+char	image[ARB]		#I image/group name
+char	root[ARB]		#O image/group file name
+char	extn[ARB]		#O image/group file extension
+int	acmode
+
+bool	first_time
+int	i, k, status, op
+pointer	sp, osroot, fname, textn, fextn, ip
+data	first_time /true/
+
+bool	fnullfile()
+int	gstrcpy(), strlen()
+errchk	fpathname, syserrs
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (osroot, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (textn, MAX_LENEXTN, TY_CHAR)
+	call salloc (fextn, MAX_LENEXTN, TY_CHAR)
+
+	# The first call makes sure the IKI kernels are loaded into the kernel
+	# table.
+
+	if (first_time) {
+	    call iki_init()
+	    first_time = false
+	}
+
+	call iki_parse (image, root, extn)
+	if (fnullfile (root)) {
+	    call sfree (sp)
+	    return (1)
+	}
+
+	repeat {
+	    # Convert to absolute pathname to render names like file
+	    # and ./file equivalent.  Add a dummy file extension first
+	    # to cause escape sequence encoding of any .DDDD etc. files
+	    # which may be part of the root image name.
+
+	    op = gstrcpy (root, Memc[fname], SZ_PATHNAME)
+	    call strcpy (".x", Memc[fname+op], SZ_PATHNAME-op+1)
+	    call fpathname (Memc[fname], Memc[osroot], SZ_PATHNAME)
+	    Memc[osroot+strlen(Memc[osroot])-2] = EOS
+
+	    # Escape any $ in the pathname since we are still in VOS land.
+	    op = 1
+	    for (ip=osroot;  Memc[ip] != EOS;  ip=ip+1) {
+		if (Memc[ip] == '$' || Memc[ip] == '[') {
+		    root[op] = '\\'
+		    op = op + 1
+		}
+		root[op] = Memc[ip]
+		op = op + 1
+	    }
+
+	    root[op] = EOS
+
+	    # Select an image kernel by calling the access function in each
+	    # loaded kernel until somebody claims the image.  If multiple
+	    # kernels claim the image the image specification (name) is
+	    # ambiguous and we don't know which image was intended, an error.
+	    # Note that in the case of a new image, the access function
+	    # tests only the legality of the extn.
+
+	    k = 0
+	    for (i=1;  i <= k_nkernels;  i=i+1) {
+		call strcpy (extn, Memc[textn], MAX_LENEXTN)
+		call zcall5 (IKI_ACCESS(i), i,root,Memc[textn],acmode,status)
+
+		if (status == YES) {
+		    if (k == 0) {
+			# Stop on the first access if an explicit extension
+			# was given.
+
+			k = i
+			call strcpy (Memc[textn], Memc[fextn], MAX_LENEXTN)
+			if (extn[1] != EOS)
+			    break
+
+		    } else {
+			# The image name is ambiguous.
+			call sfree (sp)
+			return (ERR)
+		    }
+		}
+	    }
+
+	    # Valid image using kernel K.
+	    if (k != 0) {
+		call strcpy (Memc[fextn], extn, MAX_LENEXTN)
+		call sfree (sp)
+		return (k)
+	    }
+
+	    # If the search failed and an extension was given, maybe what
+	    # we thought was an extension was really just part of the root
+	    # filename.  Try again with the extn folded into the root.
+
+	    if (status == NO && extn[1] != EOS) {
+		call strcpy (image, root, SZ_PATHNAME)
+		extn[1] = EOS
+	    } else
+		break
+	}
+
+	call sfree (sp)
+	return (0)
+end
diff --git a/sys/imio/iki/ikiclose.x b/sys/imio/iki/ikiclose.x
new file mode 100644
index 00000000..e4b2ced9
--- /dev/null
+++ b/sys/imio/iki/ikiclose.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <imio.h>
+include "iki.h"
+
+# IKI_CLOSE -- Physically close an image opened under the IKI.  It is not
+# necessary to update the image header or flush any pixel data, as IMIO will
+# already have performed those functions.
+
+procedure iki_close (im)
+
+pointer	im			#I image descriptor
+
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_CLOSE(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKICLOSE, IM_NAME(im))
+end
diff --git a/sys/imio/iki/ikicopy.x b/sys/imio/iki/ikicopy.x
new file mode 100644
index 00000000..31df1970
--- /dev/null
+++ b/sys/imio/iki/ikicopy.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_COPY -- Fast copy of an entire image or group of images.  This function
+# is provided at the IKI level since the kernel has explicit knowledge of the
+# storage format and hence may be able to copy the image by means much simpler
+# and faster way than those available to the high level software.
+
+procedure iki_copy (old, new)
+
+char	old[ARB]		#I name of old image
+char	new[ARB]		#I name of new image
+
+int	k, n, status
+pointer	sp, old_root, old_extn, new_root, new_extn
+int	iki_access()
+bool	streq()
+errchk	syserrs
+
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (old_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (new_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the old image exists and determine its type.
+	k = iki_access (old, Memc[old_root], Memc[old_extn], READ_ONLY)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, old)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, old)
+
+	# Make sure we will not be clobbering an existing image.  Ignore
+	# attempts to rename an image onto itself.
+
+	n = iki_access (new, Memc[new_root], Memc[new_extn], 0)
+	if (n > 0) {
+	    if (streq (Memc[old_root], Memc[new_root]))
+		if (streq (Memc[old_extn], Memc[new_extn])) {
+		    call sfree (sp)
+		    return
+		}
+	    call syserrs (SYS_IKICLOB, new)
+	} else {
+	    # New name is new root plus legal extn for old image.
+	    call iki_parse (new, Memc[new_root], Memc[new_extn])
+	    call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+	}
+
+	# Copy the image.
+	call zcall6 (IKI_COPY(k), k, Memc[old_root], Memc[old_extn],
+	    Memc[new_root], Memc[new_extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKICOPY, old)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikidelete.x b/sys/imio/iki/ikidelete.x
new file mode 100644
index 00000000..a172980b
--- /dev/null
+++ b/sys/imio/iki/ikidelete.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_DELETE -- Delete an image or group of images.
+
+procedure iki_delete (image)
+
+char	image[ARB]		#I name of image
+
+int	k, status
+pointer	sp, root, extn
+int	iki_access()
+bool	fnullfile()
+
+errchk	syserrs
+include	"iki.com"
+
+begin
+	if (fnullfile (image))
+	    return
+
+	call smark (sp)
+	call salloc (root, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the image exists and determine its type.
+	k = iki_access (image, Memc[root], Memc[extn], 0)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, image)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, image)
+
+	# Delete the image.
+	call zcall4 (IKI_DELETE(k), k, Memc[root], Memc[extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIDEL, image)
+	
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiextn.x b/sys/imio/iki/ikiextn.x
new file mode 100644
index 00000000..a5f2aa12
--- /dev/null
+++ b/sys/imio/iki/ikiextn.x
@@ -0,0 +1,372 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <imhdr.h>
+include "iki.h"
+
+# IKIEXTN.X -- Image extension handling.  This package is used to map image
+# file extensions to image types and vice versa.
+#
+#	       iki_extninit (imtype, def_imtype, imextn, def_imextn)
+#    status = iki_validextn (kernel, extn)
+#      status = iki_getextn (kernel, index, extn, maxch)
+#        value = iki_getpar (param)
+#
+# iki_extninit initializes the image extension handling package.  This parses
+# the lists of extensions and patterns and builds an internal descriptor which
+# will be used by the other routines for extension handling.  iki_validextn
+# tests whether a given extension is valid for a particular image kernel
+# (type of image).  iki_getextn is used with an index argument to get a list
+# of the extensions for a particular image type.  iki_getpar queries the value
+# of IKI global parameters.
+
+define	SZ_IMTYPE	128
+define	SZ_IMEXTN	1024
+
+
+# IKI_EXTNINIT -- Initialize the image extension handling package.  This is
+# typically done once when IKI is first initialized.  Changes to the image
+# typing environment made subsequently have no effect unless the package is
+# reinitialized.
+
+int procedure iki_extninit (env_imtype, def_imtype, env_imextn, def_imextn)
+
+char	env_imtype[ARB]			#I imtype environment variable
+char	def_imtype[ARB]			#I default imtype value string
+char	env_imextn[ARB]			#I imextn environment variable
+char	def_imextn[ARB]			#I default imextn value string
+
+int	kset[MAX_KERNELS]
+pointer	sp, ip, ip_save, imtype, imextn, strval
+int	op, delim, status, nchars, i, j, kernel
+int	envfind(), iki_getfield(), gstrcpy(), iki_validextn()
+bool	streq(), envgetb()
+
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (imtype, SZ_IMTYPE, TY_CHAR)
+	call salloc (imextn, SZ_IMEXTN, TY_CHAR)
+	call salloc (strval, SZ_FNAME, TY_CHAR)
+
+	status = OK
+
+	# Get the imtype string.  The value of the env_imtype variable is used
+	# if the variable is found, otherwise the default is used.
+
+	Memc[imtype] = EOS
+	if (env_imtype[1] != EOS)
+	    if (envfind (env_imtype, Memc[imtype], SZ_IMTYPE) <= 0)
+		Memc[imtype] = EOS
+	if (Memc[imtype] == EOS)
+	    call strcpy (def_imtype, Memc[imtype], SZ_IMTYPE)
+
+	# Get the imextn string.  The value of the env_imextn variable is used
+	# if the variable is found, otherwise the default is used.
+
+	Memc[imextn] = EOS
+	if (env_imextn[1] != EOS)
+	    if (envfind (env_imextn, Memc[imextn], SZ_IMEXTN) <= 0)
+		Memc[imextn] = EOS
+	if (Memc[imextn] == EOS)
+	    call strcpy (def_imextn, Memc[imextn], SZ_IMEXTN)
+
+	# Process imextn.  This specifies the set of valid extensions for
+	# each image type.  This must be done before processing imtype below,
+	# since iki_validextn can be used when processing imtype.  The imextn
+	# string is of the form "<kernel>:<extn>[,<extn>...] ..." where 
+	# <kernel> is the IKI kernel name (k_kname) and <extn> is a regular
+	# expression to be used to test for a matching file extension.
+	# For example, imextn = "oif:imh stf:hhh,??h fits:,fits,fit".
+
+	k_nextn = 0
+	k_sbufused = 0
+	call aclri (kset, MAX_KERNELS)
+
+	# Process the user extension string first followed by the builtin
+	# defaults.  Anything given in the user string takes precedence
+	# while anything omitted uses the builtin defaults instead (if there
+	# is no user imextn this processes the default string twice).
+
+	do i = 1, 2 {
+	    if (i > 1)
+		call strcpy (def_imextn, Memc[imextn], SZ_IMEXTN)
+
+	    ip = imextn
+	    while (Memc[ip] != EOS && IS_WHITE(Memc[ip]))
+		ip = ip + 1
+
+	    repeat {
+		# Get the kernel name.
+		if (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) <= 0)
+		    break
+		call strlwr (Memc[strval])
+		if (delim != ':') {
+		    status = ERR
+		    break
+		}
+
+		# Lookup kernel.
+		kernel = 0
+		do j = 1, k_nkernels {
+		    if (streq (Memc[strval], k_kname[1,j])) {
+			kernel = j
+			break
+		    }
+		}
+		if (kernel <= 0) {
+		    status = ERR
+		    break
+		}
+
+		# Process the list of extension patterns.
+		op = k_sbufused + 1
+		ip_save = ip
+
+		while (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) > 0) {
+		    # call strlwr (Memc[strval])
+
+		    # Skip it if we already have something for this kernel.
+		    if (kset[kernel] == 0) {
+			# Get a new extension descriptor.
+			if (k_nextn >= MAX_IMEXTN) {
+			    status = ERR
+			    break
+			} else
+			    k_nextn = k_nextn + 1
+
+			# Save the kernel index associated with this extension.
+			k_kernel[k_nextn] = kernel
+
+			# Save the extension string.
+			k_extn[k_nextn] = op
+			nchars = gstrcpy(Memc[strval],k_sbuf[op],SZ_IKISBUF-op)
+			op = op + nchars + 1
+
+			# Save the strmatch pattern for the extension.
+			k_pattern[k_nextn] = op
+			k_sbuf[op] = '^';  op = op + 1
+			nchars = gstrcpy(Memc[strval],k_sbuf[op],SZ_IKISBUF-op)
+			op = op + nchars + 1
+		    }
+
+		    ip_save = ip
+		    if (delim != ',')
+			break
+		}
+
+		kset[kernel] = 1
+		k_sbufused = op - 1
+
+	    } until (Memc[ip] == EOS)
+	}
+
+	# Process imtype.  This sets the default image type for new images.
+	# For example, imtype = "oif,inherit" would create OIF (.imh) images
+	# by default, inheriting the old image type if a newcopy image is
+	# being written.
+
+	k_defimtype = 1
+	k_inherit = NO
+	ip = imtype
+	kernel = 0
+
+	while (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) > 0) {
+	    call strlwr (Memc[strval])
+
+	    # Check for the inherit/noinherit keywords.
+	    if (streq (Memc[strval], "inherit")) {
+		k_inherit = YES
+		next
+	    }
+	    if (streq (Memc[strval], "noinherit")) {
+		k_inherit = NO
+		next
+	    }
+
+	    # Scan the kernels to see if we have a kernel name.
+	    if (kernel <= 0)
+		do i = 1, k_nkernels
+		    if (streq (Memc[strval], k_kname[1,i])) {
+			kernel = i
+			break
+		    }
+
+	    # Check for a valid imagefile extension.
+	    if (kernel <= 0)
+		kernel = iki_validextn (0, Memc[strval])
+	}
+
+	if (kernel <= 0)
+	    status = ERR
+	else
+	    k_defimtype = kernel
+
+	if (envgetb ("ikidebug"))
+	    call iki_debug ("IKI debug:", STDERR, 0)
+
+	call sfree (sp)
+	return (status)
+end
+
+
+# IKI_VALIDEXTN -- Determine if the given imagefile extension is valid for
+# the given image kernel (image type).  If kernel=0 the extensions for all
+# kernels are examined.  If a valid match is found the kernel index is
+# returned as the function value, otherwise 0 is returned.
+
+int procedure iki_validextn (kernel, extn)
+
+int	kernel				#I kernel index, zero for all kernels
+char	extn[ARB]			#I extension to be tested
+
+int	i, ip
+int	strmatch()
+include	"iki.com"
+
+begin
+	do i = 1, k_nextn
+	    if (kernel == 0 || k_kernel[i] == kernel) {
+		ip = strmatch (extn, k_sbuf[k_pattern[i]])
+		if (ip > 0 && extn[ip] == EOS)
+		    return (k_kernel[i])
+	    }
+
+	return (0)
+end
+
+
+# IKI_GETEXTN -- Get an entry from the list of valid extensions (actually
+# extension patterns) for the given image kernel.  If kernel=0 all entries
+# are returned.  The kernel index for the output extension is returned as
+# the function value.  ERR is returned if the requested extension does not
+# exist.
+
+int procedure iki_getextn (kernel, index, extn, maxch)
+
+int	kernel				#I kernel index, zero for all kernels
+int	index				#I extension number (1 indexed)
+char	extn[ARB]			#O extension
+int	maxch				#I max chars out
+
+int	i, n
+include	"iki.com"
+
+begin
+	n = 0
+	do i = 1, k_nextn
+	    if (kernel == 0 || k_kernel[i] == kernel) {
+		n = n + 1
+		if (index == n) {
+		    call strcpy (k_sbuf[k_extn[i]], extn, maxch)
+		    return (k_kernel[i])
+		}
+	    }
+
+	return (ERR)
+end
+
+
+# IKI_GETPAR -- Return the value of an IKI global parameter (integer valued).
+
+int procedure iki_getpar (param)
+
+char	param[ARB]			#I parameter name
+
+bool	streq()
+include	"iki.com"
+
+begin
+	if (streq (param, "inherit"))
+	    return (k_inherit)
+	else if (streq (param, "defimtype"))
+	    return (k_defimtype)
+end
+
+
+# IKI_GETFIELD -- Get the next field from a punctuation or whitespace
+# delimited list.  The length of the field is returned as the function value.
+# EOF is returned at the end of the list.  Zero can be returned if a field
+# is zero length, e.g. in "foo,,foo" the second field is zero length.
+
+int procedure iki_getfield (ip, outstr, maxch, delim)
+
+pointer	ip				#U string pointer
+char	outstr[ARB]			#O receives string
+int	maxch				#I max chars out
+int	delim				#O delimiter char
+
+int	op, ch
+
+begin
+	# Skip any leading whitespace.
+	while (Memc[ip] != EOS && IS_WHITE(Memc[ip]))
+	    ip = ip + 1
+
+	# Check for end of list.
+	if (Memc[ip] == EOS || Memc[ip] == '\n')
+	    return (EOF)
+
+	op = 1
+	for (ch=Memc[ip];  ch != EOS && !IS_WHITE(ch);  ch=Memc[ip]) {
+	    if (ch == ',' || ch == ':' || ch == ';')
+		break
+	    else {
+		outstr[op] = ch
+		op = op + 1
+	    }
+	    ip = ip + 1
+	}
+
+	delim = ch
+	if (delim != EOS)
+	    ip = ip + 1
+
+	outstr[op] = EOS
+	return (op - 1)
+end
+
+
+# IKI_DEBUG -- Print debug information on the IKI internal data structures.
+
+procedure iki_debug (str, fd, flags)
+
+char	str[ARB]			#I title string
+int	fd				#I output file
+int	flags				#I (not used)
+
+int	i
+include	"iki.com"
+
+begin
+	# Print global variables.
+	call fprintf (fd, "%s nkernels=%d sbufused=%d deftype=%d ")
+	    call pargstr (str)
+	    call pargi (k_nkernels)
+	    call pargi (k_sbufused)
+	    call pargi (k_defimtype)
+	call fprintf (fd, "inherit=%d nextn=%d\n")
+	    call pargi (k_inherit)
+	    call pargi (k_nextn)
+
+	# List the installed kernels.
+	call fprintf (fd, "installed kernels ")
+	do i = 1, k_nkernels {
+	    call fprintf (fd, "%s=%d ")
+		call pargstr (k_kname[1,i])
+		call pargi (i)
+	}
+	call fprintf (fd, "\n")
+	
+	# Print the extension table.
+	do i = 1, k_nextn {
+	    call fprintf (fd, "%6s %d (%s) %s\n")
+		call pargstr (k_sbuf[k_extn[i]])
+		call pargi (k_kernel[i])
+		call pargstr (k_kname[1,k_kernel[i]])
+		call pargstr (k_sbuf[k_pattern[i]])
+	}
+
+	call flush (fd)
+end
diff --git a/sys/imio/iki/ikiinit.x b/sys/imio/iki/ikiinit.x
new file mode 100644
index 00000000..41de76b6
--- /dev/null
+++ b/sys/imio/iki/ikiinit.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"iki.h"
+
+# IKI_INIT -- Initialize the IKI kernel table, i.e., load all the standard
+# kernels into the table.  Additional kernels may be dynamically added at
+# run time for special applications.
+
+procedure iki_init()
+
+extern	oif_open(), oif_close(), oif_opix(), oif_updhdr(),
+	oif_access(), oif_copy(), oif_delete(), oif_rename()
+extern	fxf_open(), fxf_close(), fxf_opix(), fxf_updhdr(),
+	fxf_access(), fxf_copy(), fxf_delete(), fxf_rename()
+extern	plf_open(), plf_close(), plf_null(), plf_updhdr(),
+	plf_access(), plf_copy(), plf_delete(), plf_rename()
+extern	qpf_open(), qpf_close(), qpf_opix(), qpf_updhdr(),
+	qpf_access(), qpf_copy(), qpf_delete(), qpf_rename()
+extern	stf_open(), stf_close(), stf_opix(), stf_updhdr(),
+	stf_access(), stf_copy(), stf_delete(), stf_rname()
+
+bool	first_time
+data	first_time /true/
+int	iki_extninit()
+include	"iki.com"
+
+begin
+	if (!first_time)
+	    return
+
+	k_nkernels = 0
+
+	# Load the original IRAF format (OIF) kernel.
+	call iki_lddriver ("oif", oif_open, oif_close, oif_opix, oif_updhdr,
+	    oif_access, oif_copy, oif_delete, oif_rename, 0)
+
+	# Load the FITS image kernel (FXF).
+	call iki_lddriver ("fxf", fxf_open, fxf_close, fxf_opix, fxf_updhdr,
+	    fxf_access, fxf_copy, fxf_delete, fxf_rename, 0)
+
+	# Load the PLIO mask image mini-kernel (PLF - not a full kernel).
+	call iki_lddriver ("plf", plf_open, plf_close, plf_null, plf_updhdr,
+	    plf_access, plf_copy, plf_delete, plf_rename, 0)
+
+	# Load the QPOE photon image kernel (QPF).
+	call iki_lddriver ("qpf", qpf_open, qpf_close, qpf_opix, qpf_updhdr,
+	    qpf_access, qpf_copy, qpf_delete, qpf_rename, IKF_NOCREATE)
+
+	# Load the SDAS GEIS format (STF) kernel.
+	call iki_lddriver ("stf", stf_open, stf_close, stf_opix, stf_updhdr,
+	    stf_access, stf_copy, stf_delete, stf_rname, 0)
+
+	# Initialize the extension-based image typing mechanism.
+	if (iki_extninit (ENV_IMTYPE, DEF_IMTYPE, ENV_IMEXTN, DEF_IMEXTN) < 0)
+	    ;
+
+	first_time = false
+end
diff --git a/sys/imio/iki/ikildd.x b/sys/imio/iki/ikildd.x
new file mode 100644
index 00000000..256e7e70
--- /dev/null
+++ b/sys/imio/iki/ikildd.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_LDDRIVER -- Load an IKI kernel into the kernel table, i.e., make a new
+# kernel entry in the table containing the entry point address of each of the
+# kernel procedures.
+
+procedure iki_lddriver (kname, ex_open, ex_close, ex_opix, ex_updhdr,
+	ex_access, ex_copy, ex_delete, ex_rename, flags)
+
+char	kname[ARB]
+extern	ex_open(), ex_close(), ex_opix(), ex_updhdr()
+extern	ex_access(), ex_copy(), ex_delete(), ex_rename()
+int	locpr()
+int	flags
+
+include	"iki.com"
+errchk	syserr
+
+begin
+	if (k_nkernels + 1 > MAX_KERNELS)
+	    call syserr (SYS_IKIKTBLOVFL)
+	else
+	    k_nkernels = k_nkernels + 1
+	    
+	call strcpy (kname, IKI_KNAME(k_nkernels), SZ_KNAME)
+	IKI_OPEN(k_nkernels)	= locpr (ex_open)
+	IKI_CLOSE(k_nkernels)	= locpr (ex_close)
+	IKI_OPIX(k_nkernels)	= locpr (ex_opix)
+	IKI_UPDHDR(k_nkernels)	= locpr (ex_updhdr)
+	IKI_ACCESS(k_nkernels)	= locpr (ex_access)
+	IKI_COPY(k_nkernels)	= locpr (ex_copy)
+	IKI_DELETE(k_nkernels)	= locpr (ex_delete)
+	IKI_RENAME(k_nkernels)	= locpr (ex_rename)
+	IKI_FLAGS(k_nkernels)	= flags
+end
diff --git a/sys/imio/iki/ikimkfn.x b/sys/imio/iki/ikimkfn.x
new file mode 100644
index 00000000..a224f728
--- /dev/null
+++ b/sys/imio/iki/ikimkfn.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"iki.h"
+
+# IKI_MKFNAME -- Manufacture a filename from the root and extension fields
+# given.
+
+procedure iki_mkfname (root, extn, fname, maxch)
+
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I filename extension
+char	fname[maxch]		#O output filename
+int	maxch			#I max chars out
+
+int	op
+int	gstrcpy()
+bool	fnullfile()
+
+begin
+	op = gstrcpy (root, fname, maxch) + 1
+	if (extn[1] != EOS && !fnullfile (root)) {
+	    fname[op] = '.'
+	    op = op + 1
+	    call strcpy (extn, fname[op], maxch-op+1)
+	}
+end
diff --git a/sys/imio/iki/ikiopen.x b/sys/imio/iki/ikiopen.x
new file mode 100644
index 00000000..f60a672d
--- /dev/null
+++ b/sys/imio/iki/ikiopen.x
@@ -0,0 +1,153 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <imio.h>
+include "iki.h"
+
+# IKI_OPEN -- Open or create an image.  If opening an existing image, determine
+# the type of image and open it with the corresponding kernel.  If creating a
+# new image, the value of the environment variable IMTYPE determines the type
+# of image to be created, i.e., the kernel to be used to open the image.  If
+# opening a new copy image, create an image of the same type as the existing
+# image.
+
+procedure iki_open (n_im, image, ksection, cl_index, cl_size, acmode, o_im)
+
+pointer	n_im			#I descriptor of new image (to be filled in)
+char	image[ARB]		#I name of image or cl_index to be opened
+char	ksection[ARB]		#I information to be passed on to kernel
+int	cl_index		#I index of image within cl_index
+int	cl_size			#I number of images in cl_index
+int	acmode			#I access mode
+pointer	o_im			#I existing image descriptor, if new_copy
+
+bool	inherit
+pointer	sp, root, extn, textn, fextn
+int	status, clmode, i, k
+errchk	syserrs, zcalla
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (textn, MAX_LENEXTN, TY_CHAR)
+	call salloc (fextn, MAX_LENEXTN, TY_CHAR)
+
+	# Compute the access mode for the ACCESS test, below.  If opening an
+	# existing image, all we want to do here is test for the existence of
+	# the image.  If opening a new image, use new image mode.
+
+	if ((acmode == NEW_IMAGE || acmode == NEW_COPY))
+	    clmode = NEW_IMAGE
+	else
+	    clmode = 0
+
+	# Parse the image name into the root and extn fields.
+	call iki_parse (image, Memc[root], Memc[extn])
+
+	# If we are opening a new image and an explicit extension is given
+	# this determines the type of image to be created.  Otherwise if we
+	# are opening a new copy image and type inheritance is enabled, the
+	# new image will be the same type as the old one.  Otherwise (new
+	# image, type not specified or inherited) the default image type 
+	# specified by the IMTYPE mechanism is used.  If opening an existing
+	# image the access method of each image kernel is called until a
+	# kernel recognizes the image.
+
+	repeat {
+	    # Is type inheritance permitted?
+	    inherit = (k_inherit == YES)
+	    if (inherit && acmode == NEW_COPY)
+		inherit = (and (IKI_FLAGS(IM_KERNEL(o_im)), IKF_NOCREATE) == 0)
+
+	    # Select the kernel to be used.
+	    if (acmode == NEW_COPY && Memc[extn] == EOS && inherit) {
+		# Inherit the same type as an existing image.
+		k = IM_KERNEL(o_im)
+		break
+
+	    } else if (clmode == NEW_IMAGE && Memc[extn] == EOS) {
+		# Use the default type for new images.
+		k = k_defimtype
+		break
+
+	    } else {
+		# Select an image kernel by calling the access function in each
+		# loaded kernel until somebody claims the image.  In the case
+		# of a new image, the access function tests only the legality
+		# of the extn.  If no extn is given but the imagefile has an
+		# extension, the access procedure will fill in the extn field.
+
+		k = 0
+		for (i=1;  i <= k_nkernels;  i=i+1) {
+		    call strcpy (Memc[extn], Memc[textn], MAX_LENEXTN)
+		    call zcall5 (IKI_ACCESS(i), i, Memc[root], Memc[textn],
+			clmode, status)
+
+		    if (status == YES) {
+			if (k == 0) {
+			    # Stop on the first match if an explicit extension
+			    # was given.
+
+			    k = i
+			    call strcpy (Memc[textn], Memc[fextn], MAX_LENEXTN)
+			    if (Memc[extn] != EOS)
+				break
+
+			} else if (Memc[extn] == EOS) {
+			    # If no extension was given and we match multiple
+			    # files then we have an ambiguous name and k=ERR.
+
+			    k = ERR
+			    break
+			}
+		    }
+		}
+
+		# Update the selected extn field.
+		if (k > 0)
+		    call strcpy (Memc[fextn], Memc[extn], MAX_LENEXTN)
+
+		# If the search failed and an extension was given, maybe what
+		# we thought was an extension was really just part of the root
+		# filename.  Try again with the extn folded into the root.
+
+		if (k == 0 && Memc[extn] != EOS) {
+		    call strcpy (image, Memc[root], SZ_PATHNAME)
+		    Memc[extn] = EOS
+		} else
+		    break
+	    }
+	}
+
+	# The image name is ambiguous; we don't know which image to open.
+	# This can only happen when opening an existing image and multiple
+	# images exist matching the name given.  It is permissible to create
+	# multiple images with the same name but different types.
+
+	if (k == ERR)
+	    call syserrs (SYS_IKIAMBIG, IM_NAME(n_im))
+
+	# Illegal image type or image does not exist.
+	if (k == 0) {
+	    if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+		call syserrs (SYS_IKIEXTN, IM_NAME(n_im))
+	    else
+		call syserrs (SYS_IKIOPEN, IM_NAME(n_im))
+	}
+
+	# Set the image kernel (format) to be used.
+	IM_KERNEL(n_im) = k
+
+	# Open/create the image.  Save the kernel index in the image header
+	# so that subsequent IKI routines know which kernel to use.
+
+	call zcalla (IKI_OPEN(k), k, n_im, o_im, Memc[root], Memc[extn],
+	    ksection, cl_index, cl_size, acmode, status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIOPEN, IM_NAME(n_im))
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiopix.x b/sys/imio/iki/ikiopix.x
new file mode 100644
index 00000000..33b3a9bc
--- /dev/null
+++ b/sys/imio/iki/ikiopix.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"iki.h"
+
+# IKI_OPIX -- Open or create the pixel storage file, if any.  We are called by
+# IMIO when i/o is first done to the image.  In the case of a new image, IMIO
+# will already have set up the IM_NDIM and IM_LEN fields of the image header.
+
+procedure iki_opix (im)
+
+pointer	im			#I image descriptor
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_OPIX(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKIOPIX, IM_NAME(im))
+end
diff --git a/sys/imio/iki/ikiparse.x b/sys/imio/iki/ikiparse.x
new file mode 100644
index 00000000..3ffb7d6c
--- /dev/null
+++ b/sys/imio/iki/ikiparse.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "iki.h"
+
+# IKI_PARSE -- Parse an image name into the root pathname and filename
+# extension, if any.  Only the known image type extensions are recognized
+# as extensions, hence this routine cannot be used to parse general filenames.
+
+procedure iki_parse (image, root, extn)
+
+char	image[ARB]			#I input image name
+char	root[SZ_PATHNAME]		#U output root pathname
+char	extn[MAX_LENEXTN]		#O output extension
+
+pointer	sp, imname
+int	ip, op, dot
+int	strlen(), iki_validextn()
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_PATHNAME, TY_CHAR)
+
+	dot = 0
+	op  = 1
+
+	# The following is a backwards-compatibility kludge.  If the image
+	# name we are given is the canonical standard test image STD_TESTIMAGE
+	# ("dev$pix") replace the name with the fully qualified name
+	# DEF_TESTIMAGE.  This is necessary to avoid ambiguous image name
+	# errors due to pix.imh and pix.hhh being in the same directory; these
+	# are well known names, neither of which can easily be changed.
+
+	if (streq (image, STD_TESTIMAGE))
+	    call strcpy (DEF_TESTIMAGE, Memc[imname], SZ_PATHNAME)
+	else
+	    call strcpy (image, Memc[imname], SZ_PATHNAME)
+
+	# Copy image name to root and mark the position of the last dot.
+	for (ip=1;  Memc[imname+ip-1] != EOS;  ip=ip+1) {
+	    root[op] = Memc[imname+ip-1]
+	    if (root[op] == '.')
+		dot = op
+	    op = op + 1
+	}
+
+	root[op] = EOS
+	extn[1]  = EOS
+
+	# Reject . delimited fields longer than the maximum extension length.
+	if (op - dot - 1 > MAX_LENEXTN)
+	    dot = NULL
+
+	# If found extension, chop the root and fill in the extn field.
+	# If no extension found, we are all done.
+
+	if (dot == NULL) {
+	    call sfree (sp)
+	    return
+	} else {
+	    root[dot] = EOS
+	    call strcpy (root[dot+1], extn, MAX_LENEXTN)
+	}
+
+	# Search the list of legal imagefile extensions.  If the extension
+	# given is not found in the list, tack it back onto the root and
+	# return a null extension.  This is necessary if we are to allow
+	# dot delimited fields within image names without requiring the
+	# user to supply the image type extension.  For example, "im.c"
+	# and "im.c.imh" must refer to the same image - ".c" is part of
+	# the image name, not an image type extension.
+
+	if (strlen(extn) >= MIN_LENEXTN)
+	    if (iki_validextn (0, extn) > 0) {
+		call sfree (sp)
+		return
+	    }
+
+	# Not a legal image header extension.  Restore the extn field to the
+	# root and null the extn.
+
+	root[dot] = '.'
+	extn[1] = EOS
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikirename.x b/sys/imio/iki/ikirename.x
new file mode 100644
index 00000000..cdeff731
--- /dev/null
+++ b/sys/imio/iki/ikirename.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_RENAME -- Rename an entire image or group of images.
+
+procedure iki_rename (old, new)
+
+char	old[ARB]		#I old name of image
+char	new[ARB]		#I new name of image
+
+int	k, n, status
+pointer	new_root, new_extn
+pointer	sp, old_root, old_extn
+
+bool	streq()
+int	iki_access()
+errchk	syserrs
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (old_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (new_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the old image exists and determine its type.
+	k = iki_access (old, Memc[old_root], Memc[old_extn], 0)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, old)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, old)
+
+	# Determine if the old image exists.  New name is new root plus
+	# legal extn for old image.
+
+	n = iki_access (new, Memc[new_root], Memc[new_extn], 0)
+	if (n <= 0)
+	    call iki_parse (new, Memc[new_root], Memc[new_extn])
+
+	# If an extension was given for the new image, verify that it is a
+	# valid extension for an image of the same type as the old image.
+	# We cannot change the image type in a rename operation.
+
+	if (Memc[new_extn] != EOS) {
+	    call zcall5 (IKI_ACCESS(k), k, Memc[new_root], Memc[new_extn],
+		NEW_FILE, status)
+	    if (status == NO)
+		call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+	} else
+	    call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+
+	# Make sure we will not be clobbering an existing image.  Renaming
+	# an image onto itself is ok; what it means to do this is up to
+	# the specific image kernel.
+
+	if (n > 0) {
+	    if (streq (Memc[old_root], Memc[new_root]) &&
+		streq (Memc[old_extn], Memc[new_extn]))
+		; # rename x -> x; let kernel decide what to do
+	    else
+		call syserrs (SYS_IKICLOB, new)
+	}
+
+	# Rename the image.
+	call zcall6 (IKI_RENAME(k), k, Memc[old_root], Memc[old_extn],
+	    Memc[new_root], Memc[new_extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIRENAME, old)
+	
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiupdhdr.x b/sys/imio/iki/ikiupdhdr.x
new file mode 100644
index 00000000..f7ad22b8
--- /dev/null
+++ b/sys/imio/iki/ikiupdhdr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include	<imio.h>
+include "iki.h"
+
+# IKI_UPDHDR -- Update the image header.
+
+procedure iki_updhdr (im)
+
+pointer	im			#I image descriptor
+
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_UPDHDR(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+end
diff --git a/sys/imio/iki/mkpkg b/sys/imio/iki/mkpkg
new file mode 100644
index 00000000..cd8663e9
--- /dev/null
+++ b/sys/imio/iki/mkpkg
@@ -0,0 +1,28 @@
+# Make the Image Kernel Interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	@oif		# Original IRAF format
+	@fxf		# FITS extension format
+	@plf		# PLIO mask image mini-kernel (partial)
+	@qpf		# QPOE photon image kernel
+	@stf		# ST SDAS/GEIS format
+
+	ikiaccess.x	iki.com iki.h <imhdr.h>
+	ikiclose.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikicopy.x	iki.com iki.h
+	ikidelete.x	iki.com iki.h
+	ikiextn.x	iki.com iki.h <ctype.h> <imhdr.h>
+	ikiinit.x	iki.com iki.h
+	ikildd.x	iki.com iki.h
+	ikimkfn.x	iki.h
+	ikiopen.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikiopix.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikiparse.x	iki.h
+	ikirename.x	iki.com iki.h
+	ikiupdhdr.x	iki.com <imio.h> iki.h <imhdr.h>
+	;
diff --git a/sys/imio/iki/oif/README b/sys/imio/iki/oif/README
new file mode 100644
index 00000000..01e30678
--- /dev/null
+++ b/sys/imio/iki/oif/README
@@ -0,0 +1 @@
+IKI/OIF -- IKI kernel for the old (original) IRAF image format.
diff --git a/sys/imio/iki/oif/imhv1.h b/sys/imio/iki/oif/imhv1.h
new file mode 100644
index 00000000..a9a37874
--- /dev/null
+++ b/sys/imio/iki/oif/imhv1.h
@@ -0,0 +1,75 @@
+# IMHV1.H -- Version 1 of the OIF binary file header (April 1988).
+
+define	V1_MAGIC	"imhdr"			# file identification tag
+define	V1_PMAGIC	"impix"			# file identification tag
+define	V1_VERSION	1			# header version number
+
+define	SZ_V1IMPIXFILE	79			# name of pixel storage file
+define	SZ_V1IMHDRFILE	79			# name of header storage file
+define	SZ_V1IMTITLE	79			# image title string
+define	SZ_V1IMHIST	511			# image history record
+define	SZ_V1BUNIT	9			# brightness units string
+define	SZ_V1CTYPE	9			# coord axes units string
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V1IMHDR	513			# length of std header
+define	LEN_V1PIXHDR	183			# length of pixel file header
+define	V1U		LEN_V1IMHDR		# offset to user fields
+define	IM_V1USERAREA	(P2C($1+V1U))		# user area (database)
+
+# Disk resident header.
+define	IM_V1MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V1HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V1PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V1NDIM	Memi[$1+5]		# number of dimensions
+define	IM_V1LEN	Meml[$1+$2+6-1]		# length of the dimensions
+define	IM_V1PHYSLEN	Meml[$1+$2+13-1]	# physical length (as stored)
+define	IM_V1SSMTYPE	Meml[$1+20]		# type of subscript mapping
+define	IM_V1LUTOFF	Meml[$1+21]		# offset to subscript map luts
+define	IM_V1PIXOFF	Meml[$1+22]		# offset of the pixels
+define	IM_V1HGMOFF	Meml[$1+23]		# offset of hgm pixels
+define	IM_V1BLIST	Meml[$1+24]		# offset of bad pixel list
+define	IM_V1SZBLIST	Meml[$1+25]		# size of bad pixel list
+define	IM_V1NBPIX	Meml[$1+26]		# number of bad pixels
+define	IM_V1CTIME	Meml[$1+27]		# time of image creation
+define	IM_V1MTIME	Meml[$1+28]		# time of last modify
+define	IM_V1LIMTIME	Meml[$1+29]		# time min,max computed
+define	IM_V1MAX	Memr[P2R($1+30)]	# max pixel value
+define	IM_V1MIN	Memr[P2R($1+31)]	# min pixel value
+define	IM_V1HGM	($1+33)			# histogram descriptor
+define	IM_V1CTRAN	($1+52)			# coordinate transformations
+define	IM_V1PIXFILE	Memc[P2C($1+103)]	# name of pixel storage file
+define	IM_V1HDRFILE	Memc[P2C($1+143)]	# name of header storage file
+define	IM_V1TITLE	Memc[P2C($1+183)]	# image name string
+define	IM_V1HISTORY	Memc[P2C($1+223)]	# history comment string
+
+# The Histogram structure (field IM_HGM)
+define	LEN_HGMSTRUCT	20
+define	HGM_TIME	Meml[$1]		# time when hgm was computed
+define	HGM_LEN		Meml[$1+1]		# number of bins in hgm
+define	HGM_NPIX	Meml[$1+2]		# npix used to compute hgm
+define	HGM_MIN		Memr[P2R($1+3)]		# min hgm value
+define	HGM_MAX		Memr[P2R($1+4)]		# max hgm value
+define	HGM_INTEGRAL	Memr[P2R($1+5)]		# integral of hgm
+define	HGM_MEAN	Memr[P2R($1+6)]		# mean value
+define	HGM_VARIANCE	Memr[P2R($1+7)]		# variance about mean
+define	HGM_SKEWNESS	Memr[P2R($1+8)]		# skewness of hgm
+define	HGM_MODE	Memr[P2R($1+9)]		# modal value of hgm
+define	HGM_LCUT	Memr[P2R($1+10)]	# low cutoff value
+define	HGM_HCUT	Memr[P2R($1+11)]	# high cutoff value
+# next available field: ($1+12)
+
+# The Coordinate Transformation Structure (IM_CTRAN)
+define	LEN_CTSTRUCT	50
+define	CT_VALID	Memi[$1]		# (y/n) is structure valid?
+define	CT_BSCALE	Memr[P2R($1+1)]		# pixval scale factor
+define	CT_BZERO	Memr[P2R($1+2)]		# pixval offset
+define	CT_CRVAL	Memr[P2R($1+$2+3-1)]	# value at pixel
+define	CT_CRPIX	Memr[P2R($1+$2+10-1)]	# index of pixel
+define	CT_CDELT	Memr[P2R($1+$2+17-1)]	# increment along axis
+define	CT_CROTA	Memr[P2R($1+$2+24-1)]	# rotation angle
+define	CT_BUNIT	Memc[P2C($1+31)]	# pixval ("brightness") units
+define	CT_CTYPE	Memc[P2C($1+36)]	# coord units string
+# next available field: ($1+41)
diff --git a/sys/imio/iki/oif/imhv2.h b/sys/imio/iki/oif/imhv2.h
new file mode 100644
index 00000000..d7eaa1f7
--- /dev/null
+++ b/sys/imio/iki/oif/imhv2.h
@@ -0,0 +1,43 @@
+# IMHV2.H -- Version 2 of the OIF binary file header (March 1997).
+
+define	V2_MAGIC	"imhv2"			# file identification tag
+define	V2_PMAGIC	"impv2"			# file identification tag
+define	V2_VERSION	2			# header version
+
+define	SZ_V2IMPIXFILE	255			# name of pixel storage file
+define	SZ_V2IMHDRFILE	255			# name of header storage file
+define	SZ_V2IMTITLE	383			# image title string
+define	SZ_V2IMHIST	1023			# image history record
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V2IMHDR	1024			# length of std header
+define	LEN_V2PIXHDR	293			# length of pixel file header
+define	V2U		LEN_V2IMHDR		# offset to user fields
+define	IM_V2USERAREA	(P2C($1+V2U))		# user area (database)
+
+# Disk resident header.
+define	IM_V2MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V2HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V2PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V2SWAPPED	Memi[$1+5]		# pixels are byte swapped
+define	IM_V2NDIM	Memi[$1+6]		# number of dimensions
+define	IM_V2LEN	Meml[$1+$2+7-1]		# length of the dimensions
+define	IM_V2PHYSLEN	Meml[$1+$2+14-1]	# physical length (as stored)
+define	IM_V2SSMTYPE	Meml[$1+21]		# type of subscript mapping
+define	IM_V2LUTOFF	Meml[$1+22]		# offset to subscript map luts
+define	IM_V2PIXOFF	Meml[$1+23]		# offset of the pixels
+define  IM_V2HGMOFF	Meml[$1+24]		# offset of hgm pixels
+define  IM_V2BLIST	Meml[$1+25]		# offset of bad pixel list
+define  IM_V2SZBLIST	Meml[$1+26]		# size of bad pixel list
+define  IM_V2NBPIX	Meml[$1+27]		# number of bad pixels
+define	IM_V2CTIME	Meml[$1+28]		# time of image creation
+define	IM_V2MTIME	Meml[$1+29]		# time of last modify
+define	IM_V2LIMTIME	Meml[$1+30]		# time min,max computed
+define	IM_V2MAX	Memr[P2R($1+31)]	# max pixel value
+define	IM_V2MIN	Memr[P2R($1+32)]	# min pixel value
+define	IM_V2PIXFILE	Memc[P2C($1+37)]	# name of pixel storage file
+define	IM_V2HDRFILE	Memc[P2C($1+165)]	# name of header storage file
+define	IM_V2TITLE	Memc[P2C($1+293)]	# image name string
+define	IM_V2HISTORY	Memc[P2C($1+485)]	# history comment string
diff --git a/sys/imio/iki/oif/mkpkg b/sys/imio/iki/oif/mkpkg
new file mode 100644
index 00000000..81a4d57e
--- /dev/null
+++ b/sys/imio/iki/oif/mkpkg
@@ -0,0 +1,21 @@
+# Make the IKI/OIF interface (Old IRAF Format images)
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	oifaccess.x	oif.h
+	oifclose.x	<error.h> <imhdr.h> <imio.h> <protect.h>
+	oifcopy.x	oif.h
+	oifdelete.x	<error.h> <imhdr.h> <protect.h>
+	oifgpfn.x	oif.h <knet.h>
+	oifmkpfn.x	oif.h <imhdr.h> <imio.h> <knet.h>
+	oifopen.x	oif.h <imhdr.h> <imio.h> <fio.h> <error.h>
+	oifopix.x	oif.h <config.h> <imhdr.h> <imio.h>
+	oifrdhdr.x	imhv1.h imhv2.h oif.h <imhdr.h> <imio.h> <mach.h>
+	oifrename.x	oif.h <error.h> <imhdr.h> <imio.h>
+	oifupdhdr.x	oif.h <error.h> <imhdr.h> <imio.h>
+	oifwrhdr.x	imhv1.h imhv2.h oif.h <imhdr.h> <imio.h> <mach.h>
+	;
diff --git a/sys/imio/iki/oif/oif.h b/sys/imio/iki/oif/oif.h
new file mode 100644
index 00000000..d1161659
--- /dev/null
+++ b/sys/imio/iki/oif/oif.h
@@ -0,0 +1,15 @@
+# OIF.H -- IKI/OIF internal definitions.
+
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	OIF_HDREXTN	"imh"		# image header filename extension
+define	OIF_PIXEXTN	"pix"		# image pixfile extension
+define	LEN_PIXHDR	512		# max length of PIXHDR structure
+define	COMPRESS	NO		# disable alignment of image lines?
+define	DEF_VERSION	2		# default file version
+
+define	ENV_OIFVER	"oifversion"	# default format for new images
+define	HDR		"HDR$"		# stands for header directory
+define	STRLEN_HDR	4
+
+define	TY_IMHDR	1		# main imagefile header
+define	TY_PIXHDR	2		# pixel file header
diff --git a/sys/imio/iki/oif/oifaccess.x b/sys/imio/iki/oif/oifaccess.x
new file mode 100644
index 00000000..e5dfe28a
--- /dev/null
+++ b/sys/imio/iki/oif/oifaccess.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# OIF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.
+
+procedure oif_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O status
+
+pointer	sp, fname
+int	btoi(), access(), iki_validextn()
+string	oif_extn OIF_HDREXTN
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	# Reject image if an invalid extension is given.
+	if (extn[1] != EOS && strne (extn, oif_extn)) {
+	    status = NO
+	    call sfree (sp)
+	    return
+	}
+
+	# Check for the imagefile.
+	call iki_mkfname (root, oif_extn, Memc[fname], SZ_PATHNAME)
+	if (access (Memc[fname], acmode, 0) == YES) {
+	    if (extn[1] == EOS)
+		call strcpy (oif_extn, extn, MAX_LENEXTN)
+	    status = YES
+	} else
+	    status = NO
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifclose.x b/sys/imio/iki/oif/oifclose.x
new file mode 100644
index 00000000..8eb58b4f
--- /dev/null
+++ b/sys/imio/iki/oif/oifclose.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <protect.h>
+include <error.h>
+include <imhdr.h>
+include <imio.h>
+
+# OIF_CLOSE -- Close an OIF format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure oif_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+int	junk
+int	protect()
+
+begin
+	# Close the pixel file and header file, if open.
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	# If we are closing a new image, set delete protection on the
+	# header file to prevent the user from using DELETE to delete
+	# the image header file, which would leave a headerless pixel
+	# storage file lying about somewhere.
+
+	if (IM_ACMODE(im) == NEW_IMAGE || IM_ACMODE(im) == NEW_COPY)
+	    iferr (junk = protect (IM_HDRFILE(im), SET_PROTECTION))
+		call erract (EA_WARN)
+end
diff --git a/sys/imio/iki/oif/oifcopy.x b/sys/imio/iki/oif/oifcopy.x
new file mode 100644
index 00000000..8a7ea41d
--- /dev/null
+++ b/sys/imio/iki/oif/oifcopy.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# OIF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure oif_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		# old image root name
+char	old_extn[ARB]		# old image extn
+char	new_root[ARB]		# new image root name
+char	new_extn[ARB]		# new extn
+int	status
+
+pointer	sp
+pointer	old_fname, new_fname
+
+begin
+	call smark (sp)
+	call salloc (old_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[old_fname], SZ_PATHNAME)
+	call iki_mkfname (new_root, OIF_HDREXTN, Memc[new_fname], SZ_PATHNAME)
+
+	# For now, this is stubbed out.
+	status = ERR
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifdelete.x b/sys/imio/iki/oif/oifdelete.x
new file mode 100644
index 00000000..758309a7
--- /dev/null
+++ b/sys/imio/iki/oif/oifdelete.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<protect.h>
+include	<error.h>
+include	<imhdr.h>
+
+# OIF_DELETE -- Delete an image.  A special operator is required since the
+# image is stored as two files.
+
+procedure oif_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension
+int	status
+
+int	junk
+pointer	sp, fname, pixfile
+int	access(), protect()
+pointer	im, immapz()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filename.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	iferr (im = immapz (Memc[fname], READ_ONLY, 0)) {
+	    call erract (EA_WARN)
+
+	} else {
+	    if (IM_PIXFILE(im) != EOS) {
+		call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im),
+		    Memc[pixfile], SZ_PATHNAME)
+		if (access (Memc[pixfile],0,0) == YES)
+		    iferr (call delete (Memc[pixfile]))
+			call erract (EA_WARN)
+	    }
+
+	    call imunmap (im)
+
+	    # Do not complain if the file is not protected.
+	    iferr (junk = protect (Memc[fname], REMOVE_PROTECTION))
+		;
+	    iferr (call delete (Memc[fname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/oif/oifgpfn.x b/sys/imio/iki/oif/oifgpfn.x
new file mode 100644
index 00000000..cc9a7fef
--- /dev/null
+++ b/sys/imio/iki/oif/oifgpfn.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	"oif.h"
+
+# OIF_GPIXFNAME -- Convert a logical pixfile name into a physical pathname.
+
+procedure oif_gpixfname (pixfile, hdrfile, path, maxch)
+
+char	pixfile[ARB]		# pixfile name
+char	hdrfile[ARB]		# header file name (gives hdr directory)
+char	path[maxch]		# receives pathname
+int	maxch
+
+int	ip, nchars
+pointer	sp, fname, op
+int	strncmp(), fnldir()
+
+begin
+	# Merely return pathname if not case "HDR$".
+	if (strncmp (pixfile, HDR, STRLEN_HDR) != 0) {
+	    call fpathname (pixfile, path, maxch)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Get host pathname of pixel file directory.
+	nchars = fnldir (hdrfile, Memc[fname], SZ_PATHNAME)
+	call fpathname (Memc[fname], path, maxch)
+
+	# Fold in any subdirectories from the pixfile name.
+	# (as in HDR$pixels/).
+
+	op = fname
+	nchars = 0
+
+	for (ip=STRLEN_HDR+1;  pixfile[ip] != EOS;  ip=ip+1) {
+	    if (pixfile[ip] == '/') {
+		Memc[op] = EOS
+		call zfsubd (path, maxch, Memc[fname], nchars)
+		op = fname
+	    } else {
+		Memc[op] = pixfile[ip]
+		op = op + 1
+	    }
+	}
+
+	# Tack on the pixel file name, which was left in the fname buf.
+	if (op > fname) {
+	    Memc[op] = EOS
+	    if (nchars > 0)
+		call strcpy (Memc[fname], path[nchars+1], maxch-nchars)
+	    else
+		call strcat (Memc[fname], path, maxch)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifmkpfn.x b/sys/imio/iki/oif/oifmkpfn.x
new file mode 100644
index 00000000..234fa706
--- /dev/null
+++ b/sys/imio/iki/oif/oifmkpfn.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<knet.h>
+include	"oif.h"
+
+# OIF_MKPIXFNAME -- Generate the pixel file name.  Leave the logical pixfile
+# name in the image header, and return the pathname to the pixel file in the
+# output argument.
+
+procedure oif_mkpixfname (im, pixfile, maxch)
+
+pointer	im			# image descriptor
+char	pixfile[maxch]		# receives pathname to pixfile
+int	maxch
+
+char	suffix[2]
+int	len_osdir, len_root, len_extn, n
+pointer	sp, imdir, osdir, root, extn, subdir, fname, ip, op
+
+bool	fnullfile()
+int	fnroot(), fnldir(), access(), envgets(), strncmp()
+string	pixextn OIF_PIXEXTN
+errchk	fmkdir, imerr
+
+begin
+	# Clear junk text at the end of the filename.
+	call aclrc (IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	# Check for the null image.
+	if (fnullfile (IM_HDRFILE(im))) {
+	    call strcpy ("dev$null", IM_PIXFILE(im), SZ_IMPIXFILE)
+	    call strcpy (IM_PIXFILE(im), pixfile, maxch)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (imdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (osdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (root,   SZ_PATHNAME, TY_CHAR)
+	call salloc (subdir, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname,  SZ_PATHNAME, TY_CHAR)
+	call salloc (extn,   SZ_FNAME, TY_CHAR)
+
+	if (envgets ("imdir", Memc[imdir], SZ_PATHNAME) <= 0)
+	    call strcpy (HDR, Memc[imdir], SZ_PATHNAME)
+
+	if (strncmp (Memc[imdir], HDR, STRLEN_HDR) == 0) {
+	    # Put pixfile in same directory as the header or in a subdirectory.
+	    # In the latter case, create the directory if it does not already
+	    # exist.
+
+	    ip = imdir + STRLEN_HDR
+	    for (op=subdir;  Memc[ip] != EOS && Memc[ip] != '/';  ip=ip+1) {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	    
+	    if (Memc[subdir] != EOS) {
+		n = fnldir (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+		call fpathname (Memc[fname], Memc[fname], SZ_PATHNAME)
+		call zfsubd (Memc[fname], SZ_PATHNAME, Memc[subdir], n)
+		if (access (Memc[fname], 0, DIRECTORY_FILE) == NO)
+		    call fmkdir (Memc[fname])
+	    }
+	} else
+	    call fpathname (Memc[imdir], Memc[imdir], SZ_PATHNAME)
+
+	# Make up the root name of the new pixel file.  Take the root part of
+	# the header file and escape sequence encode it.  We have to do this
+	# because it is to be concatenated to an OS directory name, which will
+	# prevent translation of the root file name during normal filename
+	# mapping.
+
+	if (fnroot (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME) <= 0)
+	    call strcpy (pixextn, Memc[fname], SZ_PATHNAME)
+	call iki_mkfname (Memc[fname], pixextn, Memc[fname], SZ_PATHNAME)
+	call vfn_translate (Memc[fname], Memc[osdir], len_osdir,
+	    Memc[root], len_root, Memc[extn], len_extn)
+
+	suffix[1] = 'a'
+	suffix[2] = 'a'
+	suffix[3] = EOS
+
+	for (n=0;  ;  n=n+1) {
+	    call sprintf (IM_PIXFILE(im), SZ_PATHNAME, "%s%s.%s")
+		call pargstr (Memc[imdir])
+		call pargstr (Memc[root])
+		call pargstr (pixextn)
+
+	    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), pixfile, maxch)
+
+	    # Ensure that the filename is unique.
+	    if (access (pixfile, 0,0) == YES) {
+		if (n == 0) {
+		    for (op=root;  Memc[op] != EOS;  op=op+1)
+			;
+		} else {
+		    if (suffix[2] == 'z') {
+			suffix[2] = 'a'
+			if (suffix[1] == 'z')
+			    call imerr (IM_NAME(im), SYS_FMKTEMP)
+			else
+			    suffix[1] = suffix[1] + 1
+		    } else
+			suffix[2] = suffix[2] + 1
+		}
+
+		call strcpy (suffix, Memc[op], 2)
+	    } else
+		break
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifopen.x b/sys/imio/iki/oif/oifopen.x
new file mode 100644
index 00000000..a280f163
--- /dev/null
+++ b/sys/imio/iki/oif/oifopen.x
@@ -0,0 +1,137 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	"oif.h"
+
+# OIF_OPEN -- Open/create an image.
+
+procedure oif_open (kernel, im, o_im, root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I old image, if new_copy image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I NOT USED
+int	cl_index		#I NOT USED
+int	cl_size			#I NOT USED
+int	acmode			#I access mode
+int	status			#O return value
+
+pointer	sp, fname, pixfile
+int	hfd, nchars, mode, junk
+int	open(), oif_rdhdr(), access(), protect(), envgeti()
+bool	envgetb(), fnullfile()
+errchk	syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+
+	# The only valid cl_index is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1))
+	    goto err_
+
+	# This kernel does not permit a kernel section to be used.
+	if (ksection[1] != EOS)
+	    call syserrs (SYS_IKIKSECTNS, Memc[fname])
+
+	# Determine access mode for header file.
+	if (acmode == NEW_COPY || acmode == NEW_IMAGE)
+	    mode = NEW_FILE
+	else
+	    mode = acmode
+
+	# Generate full header file name; the extension may be either ".imh"
+	# or nothing, and was set earlier by oif_access().
+
+	if (mode == NEW_FILE && extn[1] == EOS)
+	    call iki_mkfname (root, OIF_HDREXTN, Memc[fname], SZ_PATHNAME)
+	else
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	# Delete any old image if one exists and imclobber is enabled.
+	if (mode == NEW_FILE && !fnullfile (Memc[fname]) &&
+	    (access (Memc[fname], 0,0) == YES)) {
+
+	    if (envgetb ("imclobber")) {
+		iferr (hfd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		    status = ERR
+		    goto err_
+		}
+		nchars = LEN_IMHDR * SZ_MII_INT
+		if (oif_rdhdr (hfd, im, nchars, TY_IMHDR) < 0) {
+		    status = ERR
+		    goto err_
+		}
+		if (IM_PIXFILE(im) != EOS) {
+		    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im),
+			Memc[pixfile], SZ_PATHNAME)
+		    if (access (Memc[pixfile],0,0) == YES)
+			iferr (call delete (Memc[pixfile]))
+			    call erract (EA_WARN)
+		}
+		call close (hfd)
+		iferr (junk = protect (Memc[fname], REMOVE_PROTECTION))
+		    ;
+		iferr (call delete (Memc[fname]))
+		    call erract (EA_WARN)
+	    } else
+		call syserrs (SYS_IKICLOB, Memc[fname])
+	}
+
+	# Open the image header file.
+	iferr (hfd = open (Memc[fname], mode, BINARY_FILE))
+	    goto err_
+
+	IM_HFD(im) = hfd
+
+	# If opening an existing image, read the OIF fixed format binary
+	# image header into the image descriptor.  If opening a new image,
+	# write out a generic image header so that the image can be accessed
+	# and deleted with imdelete should the operation be aborted before
+	# a full image is written.
+
+	if (mode == NEW_FILE) {
+	    iferr (IM_HDRVER(im) = envgeti (ENV_OIFVER))
+		IM_HDRVER(im) = DEF_VERSION
+	    call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+	    iferr (call oif_updhdr (im, status))
+		;
+	} else {
+	    iferr {
+		nchars = (IM_LENHDRMEM(im) - LEN_IMHDR) * SZ_MII_INT
+		if (oif_rdhdr (hfd, im, nchars, TY_IMHDR) < 0)
+		    status = ERR
+		else {
+		    call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+		    call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+		}
+	    } then
+		status = ERR
+	}
+
+	# It is best to close the header file at this point for two reasons:
+	# to improve error recovery (if an abort occurs with a new file still
+	# open FIO will delete it) and to free file descriptors (important for
+	# applications that open many images).  If the header needs to be
+	# updated, oif_updhdr will reopen the header file.
+
+	call close (hfd)
+	IM_HFD(im) = NULL
+
+	call sfree (sp)
+	return
+err_
+	status = ERR
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifopix.x b/sys/imio/iki/oif/oifopix.x
new file mode 100644
index 00000000..c9652374
--- /dev/null
+++ b/sys/imio/iki/oif/oifopix.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_OPIX -- Open (or create) the pixel storage file.  If the image header file
+# is `image.imh' the associated pixel storage file will be `imdir$image.pix',
+# or some variation thereon should a collision occur.  The environment variable
+# IMDIR controls where the pixfile will be placed.  The following classes of
+# values are provided:
+#
+#	path		Put pixfile in named absolute directory regardless of
+#			    where the header file is.
+#	./		Put pixfile in the current directory at image creation
+#			    time (special case of previous case).
+#	HDR$		Put pixfile in the same directory as the header file.
+#	HDR$subdir/	Put pixfiles in the subdirectory `subdir' of the
+#			    directory containing the header file.  IMIO will
+#			    create the subdirectory if necessary.
+
+procedure oif_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+long	pixoff
+pointer	sp, pixhdr, pixfile
+int	pfd, blklen
+
+int	open(), fdevblk(), oif_rdhdr()
+errchk	open, falloc, fdevblk, imerr, oif_rdhdr, oif_updhdr
+errchk	imioff, oif_wrhdr, oif_mkpixfname, oif_gpixfname, flush
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+
+	call smark (sp)
+	call salloc (pixhdr, LEN_IMDES + LEN_PIXHDR, TY_STRUCT)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    if (IM_PIXFILE(im) == EOS)
+		call imerr (IM_NAME(im), SYS_IMRDPIXFILE)
+
+	    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), Memc[pixfile],
+		SZ_PATHNAME)
+	    pfd = open (Memc[pixfile], IM_ACMODE(im), STATIC_FILE)
+
+	    call seek (pfd, BOFL)
+	    if (oif_rdhdr (pfd, pixhdr, 0, TY_PIXHDR) < 0)
+		call imerr (IM_NAME(im), SYS_IMRDPIXFILE)
+
+	case NEW_COPY, NEW_FILE, TEMP_FILE:
+	    # Generate the pixel file name.
+	    call oif_mkpixfname (im, Memc[pixfile], SZ_PATHNAME)
+
+	    # Compute the offset to the pixels in the pixfile.  Allow space
+	    # for the pixhdr pixel storage file header and start the pixels
+	    # on the next device block boundary.
+
+	    blklen = fdevblk (Memc[pixfile])
+	    pixoff = LEN_PIXHDR * SZ_MII_INT
+	    call imalign (pixoff, blklen)
+
+	    # Call IMIO to initialize the physical dimensions of the image
+	    # and the absolute file offsets of the major components of the
+	    # pixel storage file.
+
+	    call imioff (im, pixoff, COMPRESS, blklen)
+
+	    # Open the new pixel storage file (preallocate space if
+	    # enabled on local system).  Save the physical pathname of
+	    # the pixfile in the image header, in case "imdir$" changes.
+
+	    if (IM_FALLOC == YES) {
+		call falloc (Memc[pixfile], IM_HGMOFF(im) - 1)
+		pfd = open (Memc[pixfile], READ_WRITE, STATIC_FILE)
+	    } else
+		pfd = open (Memc[pixfile], NEW_FILE, BINARY_FILE)
+
+	    # Write small header into pixel storage file.  Allows detection of
+	    # headerless pixfiles, and reconstruction of header if it gets lost.
+
+	    call oif_wrhdr (pfd, im, TY_PIXHDR)
+	    call flush (pfd)
+
+	    # Update the image header so that it knows about the pixel file.
+	    call oif_updhdr (im, status)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+	IM_PFD(im) = pfd
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifrdhdr.x b/sys/imio/iki/oif/oifrdhdr.x
new file mode 100644
index 00000000..b11601cb
--- /dev/null
+++ b/sys/imio/iki/oif/oifrdhdr.x
@@ -0,0 +1,196 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <imhdr.h>
+include <imio.h>
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+
+# OIF_RDHDR -- Read the image header.  Either the main image header or the
+# pixel file header can be read.
+
+int procedure oif_rdhdr (fd, im, uchars, htype)
+
+int	fd			#I header file descriptor
+pointer	im			#I image descriptor
+int	uchars			#I maxchars of user area data to read
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1
+char	immagic[SZ_IMMAGIC]
+int	sulen_userarea, hdrlen, nchars, status
+
+bool	streq()
+int	miireadc(), miireadi(), miireadl(), miireadr()
+int	btoi(), read()
+
+errchk	read, miireadc, miireadi, miireadl, miireadr
+define	readerr_ 91
+
+begin
+	# Determine the file type.
+	call seek (fd, BOFL)
+	if (read (fd, immagic, SZ_IMMAGIC) != SZ_IMMAGIC)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V1_PMAGIC)) {
+	    # V1 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V1_MAGIC)) {
+	    # Old V1 image header.
+
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    call seek (fd, BOFL)
+	    nchars = LEN_V1IMHDR * SZ_MII_INT
+	    if (read (fd, IM_V1MAGIC(v1), nchars) != nchars) {
+		call sfree (sp)
+		return (ERR)
+	    }
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V1_VERSION
+
+	    # The following is the length of the user area in SU.
+	    sulen_userarea = IM_V1HDRLEN(v1) - LEN_V1IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    IM_SWAP(im) = NO
+	    IM_SWAPPED(im) = -1
+	    IM_PIXTYPE(im) = IM_V1PIXTYPE(v1)
+
+	    IM_NDIM(im) = IM_V1NDIM(v1)
+	    call amovl (IM_V1LEN(v1,1), IM_LEN(im,1), IM_MAXDIM)
+	    call amovl (IM_V1PHYSLEN(v1,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+
+	    IM_SSMTYPE(im) = IM_V1SSMTYPE(v1)
+	    IM_LUTOFF(im) = IM_V1LUTOFF(v1)
+	    IM_PIXOFF(im) = IM_V1PIXOFF(v1)
+	    IM_HGMOFF(im) = IM_V1HGMOFF(v1)
+	    IM_CTIME(im) = IM_V1CTIME(v1)
+	    IM_MTIME(im) = IM_V1MTIME(v1)
+	    IM_LIMTIME(im) = IM_V1LIMTIME(v1)
+	    IM_MAX(im) = IM_V1MAX(v1)
+	    IM_MIN(im) = IM_V1MIN(v1)
+
+	    call strcpy (IM_V1PIXFILE(v1), IM_PIXFILE(im), SZ_IMPIXFILE)
+	    call strcpy (IM_V1HDRFILE(v1), IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call strcpy (IM_V1TITLE(v1), IM_TITLE(im), SZ_IMTITLE)
+	    call strcpy (IM_V1HISTORY(v1), IM_HISTORY(im), SZ_IMHIST)
+
+	    # Read and output the user area.
+	    if (uchars > 0 && sulen_userarea > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (read (fd, Memc[IM_USERAREA(im)], nchars) <= 0)
+		    return (ERR)
+	    }
+
+	    call sfree (sp)
+	    return (OK)
+	}
+
+	# Check for a new format header.
+	call seek (fd, BOFL)
+	if (miireadc (fd, immagic, SZ_IMMAGIC) < 0)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V2_PMAGIC)) {
+	    # V2 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V2_MAGIC)) {
+	    # Newer V2 image header.
+	    status = ERR
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V2_VERSION
+
+	    # "sulen_userarea" is the length of the user area in SU.
+	    if (miireadi (fd, hdrlen, 1) != 1)
+		goto readerr_
+	    sulen_userarea = hdrlen - LEN_V2IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    if (miireadi (fd, IM_PIXTYPE(im), 1) != 1)
+		goto readerr_
+
+	    # Determine whether to byte swap the pixels.
+	    if (miireadi (fd, IM_SWAPPED(im), 1) != 1)
+		goto readerr_
+
+	    IM_SWAP(im) = NO
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT, TY_USHORT:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP2)
+	    case TY_INT, TY_LONG:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP4)
+	    case TY_REAL:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP4)
+	    case TY_DOUBLE:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP8)
+	    }
+
+	    # Read the fixed-format fields of the header.
+	    if (miireadi (fd, IM_NDIM(im), 1) < 0)
+		goto readerr_
+	    if (miireadi (fd, IM_LEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_PHYSLEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_SSMTYPE(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_LUTOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_PIXOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_HGMOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_BLIST(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_SZBLIST(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_NBPIX(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_CTIME(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_MTIME(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_LIMTIME(im), 1) < 0)
+		goto readerr_
+
+	    if (miireadr (fd, IM_MAX(im), 1) < 0)
+		goto readerr_
+	    if (miireadr (fd, IM_MIN(im), 1) < 0)
+		goto readerr_
+
+	    if (miireadc (fd, IM_PIXFILE(im), SZ_V2IMPIXFILE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_HDRFILE(im), SZ_V2IMHDRFILE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_TITLE(im), SZ_V2IMTITLE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_HISTORY(im), SZ_V2IMHIST) < 0)
+		goto readerr_
+
+	    # Read the variable-length user area.
+	    if (uchars > 0 && sulen_userarea > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (miireadc (fd, Memc[IM_USERAREA(im)], nchars) < 0)
+		    goto readerr_
+	    }
+
+	    status = OK
+readerr_
+	    return (status)
+	}
+
+	return (ERR)
+end
diff --git a/sys/imio/iki/oif/oifrename.x b/sys/imio/iki/oif/oifrename.x
new file mode 100644
index 00000000..edba1bcd
--- /dev/null
+++ b/sys/imio/iki/oif/oifrename.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_RENAME -- Rename an image.  A special operator is required since the image
+# is stored as two files.
+
+procedure oif_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		# old image root name
+char	old_extn[ARB]		# old image extn
+char	new_root[ARB]		# new image root name
+char	new_extn[ARB]		# old image extn
+int	status
+
+pointer	sp, im
+bool	heq, peq
+pointer	old_hfn, new_hfn
+pointer	old_pfn, new_pfn
+int	nchars, old_rootoff, new_rootoff, junk
+
+bool	streq()
+pointer	immapz()
+int	access(), strlen(), strncmp()
+errchk	immapz, rename
+
+begin
+	call smark (sp)
+	call salloc (old_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_pfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_pfn, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[old_hfn], SZ_PATHNAME)
+	call iki_mkfname (new_root, OIF_HDREXTN, Memc[new_hfn], SZ_PATHNAME)
+	heq = streq (Memc[old_hfn], Memc[new_hfn])
+
+	# Our task here is nontrivial as the pixel file must be renamed as
+	# well as the header file, e.g., since renaming the header file may
+	# move it to a different directory, and the PIXFILE field in the
+	# image header may indicate that the pixel file is in the same dir
+	# as the header.  Must open image, get pixfile name from the header,
+	# and generate the new pixfile name.  The CURRENT value of IMDIR is
+	# used to generate the new pixfile name.
+
+	im = immapz (Memc[old_hfn], READ_WRITE, 0)
+
+	if (IM_PIXFILE(im) != EOS) {
+	    # Get old pixel file filename.
+	    call oif_gpixfname (IM_PIXFILE(im), Memc[old_hfn], Memc[old_pfn],
+		SZ_PATHNAME)
+
+	    # Get new pixel file filename.
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call oif_mkpixfname (im, Memc[new_pfn], SZ_PATHNAME)
+
+	    # Do not change the pixel file name if the name does not change
+	    # other than by the addition of the "aa" style suffix added by
+	    # mkpixfname.
+
+	    peq = false
+	    call zfnbrk (old_root, old_rootoff, junk)
+	    call zfnbrk (new_root, new_rootoff, junk)
+	    peq = streq (old_root[old_rootoff], new_root[new_rootoff])
+
+	    if (peq) {
+		nchars = strlen (Memc[new_pfn]) - strlen ("aa.imh")
+		peq = (strncmp (Memc[old_pfn], Memc[new_pfn], nchars) == 0)
+	    }
+
+	    if (peq)
+		IM_UPDATE(im) = NO
+	    else {
+		# If the pixel file rename fails do not rename the header file
+		# and do not change the name of the pixel file in the header.
+
+		iferr (call rename (Memc[old_pfn], Memc[new_pfn])) {
+		    if (access (Memc[old_pfn], 0, 0) == YES) {
+			IM_UPDATE(im) = NO
+			call imunmap (im)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	} else
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	call strcpy (Memc[old_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call imunmap (im)
+
+	# Rename the header file.
+	if (!heq)
+	    call rename (Memc[old_hfn], Memc[new_hfn])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifupdhdr.x b/sys/imio/iki/oif/oifupdhdr.x
new file mode 100644
index 00000000..516d62c1
--- /dev/null
+++ b/sys/imio/iki/oif/oifupdhdr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_UPDHDR -- Update the image header.
+
+procedure oif_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+int	hfd
+errchk	imerr, open, oif_wrhdr, flush
+int	open()
+
+begin
+	status = OK
+	hfd = IM_HFD(im)
+
+	if (IM_ACMODE(im) == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+	if (hfd == NULL)
+	    hfd = open (IM_HDRFILE(im), READ_WRITE, BINARY_FILE)
+
+	call oif_wrhdr (hfd, im, TY_IMHDR)
+	call flush (hfd)
+
+	if (IM_HFD(im) == NULL)
+	    call close (hfd)
+end
diff --git a/sys/imio/iki/oif/oifwrhdr.x b/sys/imio/iki/oif/oifwrhdr.x
new file mode 100644
index 00000000..7b4e7349
--- /dev/null
+++ b/sys/imio/iki/oif/oifwrhdr.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <mach.h>
+include <imio.h>
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+# OIF_WRHDR -- Write an OIF image header.
+
+procedure oif_wrhdr (fd, im, htype)
+
+int	fd			#I header file descriptor
+pointer	im			#I image descriptor
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1, fname
+int	status, hdrlen, len_userarea
+errchk	write, miiwritec, miiwritei, miiwritel, miiwriter
+int	strlen()
+
+define	v1done_  91
+define	v2start_ 92
+define	v2done_  93
+
+begin
+	switch (IM_HDRVER(im)) {
+	case V1_VERSION:
+	    # Old V1 image header.
+	    # ----------------------
+
+	    status = ERR
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		call strcpy (V1_MAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1IMHDR
+	    case TY_PIXHDR:
+		call strcpy (V1_PMAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1PIXHDR
+	    default:
+		goto v1done_
+	    }
+
+	    # The following is the length of the user area in chars.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    IM_V1HDRLEN(v1) = LEN_V1IMHDR +
+		(len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    IM_V1PIXTYPE(v1) = IM_PIXTYPE(im)
+	    IM_V1NDIM(v1) = IM_NDIM(im)
+	    call amovl (IM_LEN(im,1), IM_V1LEN(v1,1), IM_MAXDIM)
+	    call amovl (IM_PHYSLEN(im,1), IM_V1PHYSLEN(v1,1), IM_MAXDIM)
+
+	    IM_V1SSMTYPE(v1) = IM_SSMTYPE(im)
+	    IM_V1LUTOFF(v1) = IM_LUTOFF(im)
+	    IM_V1PIXOFF(v1) = IM_PIXOFF(im)
+	    IM_V1HGMOFF(v1) = IM_HGMOFF(im)
+	    IM_V1CTIME(v1) = IM_CTIME(im)
+	    IM_V1MTIME(v1) = IM_MTIME(im)
+	    IM_V1LIMTIME(v1) = IM_LIMTIME(im)
+	    IM_V1MAX(v1) = IM_MAX(im)
+	    IM_V1MIN(v1) = IM_MIN(im)
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V1IMPIXFILE)
+		goto v1done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V1IMHDRFILE)
+		goto v1done_
+
+	    call strcpy (IM_PIXFILE(im), IM_V1PIXFILE(v1), SZ_V1IMPIXFILE)
+	    call strcpy (IM_HDRFILE(im), IM_V1HDRFILE(v1), SZ_V1IMHDRFILE)
+	    call strcpy (IM_TITLE(im), IM_V1TITLE(v1), SZ_V1IMTITLE)
+	    call strcpy (IM_HISTORY(im), IM_V1HISTORY(v1), SZ_V1IMHIST)
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR)
+		call fpathname (IM_HDRFILE(im), IM_V1PIXFILE(v1),
+		    SZ_V1IMPIXFILE)
+
+	    # Write the file header.
+	    call seek (fd, BOFL)
+	    call write (fd, IM_V1MAGIC(v1), hdrlen * SZ_MII_INT)
+
+	    # Write the user area.
+	    if (htype == TY_IMHDR)
+		call write (fd, Memc[IM_USERAREA(im)], len_userarea)
+
+	    status = OK
+v1done_
+	    call sfree (sp)
+	    if (status != OK)
+		call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+
+	case V2_VERSION:
+	    # Newer V2 image header.
+	    # ----------------------
+v2start_
+	    status = ERR
+	    call smark (sp)
+	    call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	    call seek (fd, BOFL)
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		call miiwritec (fd, V2_MAGIC, SZ_IMMAGIC)
+		hdrlen = LEN_V2IMHDR
+	    case TY_PIXHDR:
+		call miiwritec (fd, V2_PMAGIC, SZ_IMMAGIC)
+		hdrlen = LEN_V2PIXHDR
+	    default:
+		goto v2done_
+	    }
+
+	    # The following is the length of the user area in SU.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    hdrlen = LEN_V2IMHDR + (len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    call miiwritei (fd, hdrlen, 1)
+	    call miiwritei (fd, IM_PIXTYPE(im), 1)
+
+	    # Record the byte swapping used for this image.  When writing a
+	    # new image we use the native data type of the host and don't
+	    # swap bytes, so IM_SWAPPED is YES if the host architecture is
+	    # byte swapped.
+
+	    switch (IM_ACMODE(im)) {
+	    case NEW_IMAGE, NEW_COPY, TEMP_FILE:
+		IM_SWAPPED(im) = -1
+		switch (IM_PIXTYPE(im)) {
+		case TY_SHORT, TY_USHORT:
+		    IM_SWAPPED(im) = BYTE_SWAP2
+		case TY_INT, TY_LONG:
+		    IM_SWAPPED(im) = BYTE_SWAP4
+		case TY_REAL:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP4
+		case TY_DOUBLE:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP8
+		}
+	    default:
+		# IM_SWAPPED should already be set in header.
+	    }
+
+	    call miiwritei (fd, IM_SWAPPED(im), 1)
+	    call miiwritei (fd, IM_NDIM(im), 1)
+	    call miiwritel (fd, IM_LEN(im,1), IM_MAXDIM)
+	    call miiwritel (fd, IM_PHYSLEN(im,1), IM_MAXDIM)
+	    call miiwritel (fd, IM_SSMTYPE(im), 1)
+	    call miiwritel (fd, IM_LUTOFF(im), 1)
+	    call miiwritel (fd, IM_PIXOFF(im), 1)
+	    call miiwritel (fd, IM_HGMOFF(im), 1)
+	    call miiwritel (fd, IM_BLIST(im), 1)
+	    call miiwritel (fd, IM_SZBLIST(im), 1)
+	    call miiwritel (fd, IM_NBPIX(im), 1)
+	    call miiwritel (fd, IM_CTIME(im), 1)
+	    call miiwritel (fd, IM_MTIME(im), 1)
+	    call miiwritel (fd, IM_LIMTIME(im), 1)
+	    call miiwriter (fd, IM_MAX(im), 1)
+	    call miiwriter (fd, IM_MIN(im), 1)
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V2IMPIXFILE)
+		goto v2done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V2IMHDRFILE)
+		goto v2done_
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR) {
+		call aclrc (Memc[fname], SZ_PATHNAME)
+		call fpathname (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+		call miiwritec (fd, Memc[fname], SZ_V2IMPIXFILE)
+		status = OK
+		goto v2done_
+	    } else
+		call miiwritec (fd, IM_PIXFILE(im), SZ_V2IMPIXFILE)
+
+	    call oif_trim (IM_HDRFILE(im), SZ_V2IMHDRFILE)
+	    call miiwritec (fd, IM_HDRFILE(im), SZ_V2IMHDRFILE)
+
+	    call oif_trim (IM_TITLE(im), SZ_V2IMTITLE)
+	    call miiwritec (fd, IM_TITLE(im), SZ_V2IMTITLE)
+
+	    call oif_trim (IM_HISTORY(im), SZ_V2IMHIST)
+	    call miiwritec (fd, IM_HISTORY(im), SZ_V2IMHIST)
+
+	    # Write the variable-length user area.
+	    call miiwritec (fd, Memc[IM_USERAREA(im)], len_userarea)
+
+	    status = OK
+v2done_	
+	    call sfree (sp)
+	    if (status != OK)
+		call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+
+	default:
+	    IM_HDRVER(im) = V2_VERSION
+	    goto v2start_
+	}
+end
+
+
+# OIF_TRIM -- Trim trailing garbage at the end of a string.  This does not
+# affect the value of the string, but makes the contents of the output file
+# clearer when examined with file utilities.
+
+procedure oif_trim (s, nchars)
+
+char	s[ARB]
+int	nchars
+
+int	n, ntrim
+int	strlen()
+
+begin
+	n = strlen(s) + 1
+	ntrim = nchars - n
+
+	if (ntrim > 0)
+	    call aclrc (s[n], ntrim)
+end
diff --git a/sys/imio/iki/plf/README b/sys/imio/iki/plf/README
new file mode 100644
index 00000000..0a2065c7
--- /dev/null
+++ b/sys/imio/iki/plf/README
@@ -0,0 +1,5 @@
+PLF -- Partial, IKI mini-driver for the pixel list (PLIO) image format.
+
+Only part of the IKI routines are implemented here.  The open/close, header
+access, and i/o functions are handled as a special case directly in the
+IMIO code (see the impm*.x routines, and im[rd|wr]px.x).
diff --git a/sys/imio/iki/plf/mkpkg b/sys/imio/iki/plf/mkpkg
new file mode 100644
index 00000000..4253544e
--- /dev/null
+++ b/sys/imio/iki/plf/mkpkg
@@ -0,0 +1,17 @@
+# Make the PLF image kernel (PLIO mask image kernel).
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	plfaccess.x	plf.h
+	plfclose.x	<imhdr.h> <imio.h> <plset.h>
+	plfcopy.x	plf.h <error.h>
+	plfdelete.x	<error.h>
+	plfnull.x	
+	plfopen.x	<imhdr.h> <imio.h> <plio.h> <pmset.h>
+	plfrename.x	plf.h <error.h>
+	plfupdhdr.x	<imhdr.h> <imio.h> <plset.h>
+	;
diff --git a/sys/imio/iki/plf/plf.h b/sys/imio/iki/plf/plf.h
new file mode 100644
index 00000000..7fc666a9
--- /dev/null
+++ b/sys/imio/iki/plf/plf.h
@@ -0,0 +1,4 @@
+# PLF.H -- IKI/PLF internal definitions.
+
+define	PLF_EXTN	"pl"		# image header filename extension
+define	MAX_LENEXTN	3		# max length imagefile extension
diff --git a/sys/imio/iki/plf/plfaccess.x b/sys/imio/iki/plf/plfaccess.x
new file mode 100644
index 00000000..bf4ed5a9
--- /dev/null
+++ b/sys/imio/iki/plf/plfaccess.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"plf.h"
+
+# PLF_ACCESS -- Test the accessibility or existence of an existing image,
+# or the legality of the name of a new image.
+
+procedure plf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O ok or err
+
+pointer	sp, fname
+int	btoi(), access(), iki_validextn()
+string	plf_extn PLF_EXTN
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	status = NO
+	if (extn[1] != EOS)
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (extn[1] == EOS) {
+		call iki_mkfname (root, plf_extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+		if (status != NO)
+		    call strcpy (plf_extn, extn, MAX_LENEXTN)
+	    } else if (status != NO) {
+		call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfclose.x b/sys/imio/iki/plf/plfclose.x
new file mode 100644
index 00000000..2d2454e0
--- /dev/null
+++ b/sys/imio/iki/plf/plfclose.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include <plset.h>
+
+# PLF_CLOSE -- Close a mask image.
+
+procedure plf_close (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+begin
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+	if (and (IM_PLFLAGS(im), PL_CLOSEPL) != 0)
+	    call pl_close (IM_PL(im))
+
+	IM_PL(im) = NULL
+end
diff --git a/sys/imio/iki/plf/plfcopy.x b/sys/imio/iki/plf/plfcopy.x
new file mode 100644
index 00000000..4cfb2b6e
--- /dev/null
+++ b/sys/imio/iki/plf/plfcopy.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure plf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I new extn
+int	status			#O output status
+
+pointer	sp
+pointer	oldname, newname
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Copy the PLIO mask save file.
+	iferr (call fcopy (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfdelete.x b/sys/imio/iki/plf/plfdelete.x
new file mode 100644
index 00000000..4fad68aa
--- /dev/null
+++ b/sys/imio/iki/plf/plfdelete.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# PLF_DELETE -- Delete a PLIO mask savefile (mask image).
+
+procedure plf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension
+int	status			#O output status
+
+pointer	sp, fname
+errchk	delete
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (call delete (Memc[fname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfnull.x b/sys/imio/iki/plf/plfnull.x
new file mode 100644
index 00000000..83ec77cd
--- /dev/null
+++ b/sys/imio/iki/plf/plfnull.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PLF_NULL -- Null driver entry point.
+
+procedure plf_null()
+
+begin
+	call error (1, "PLF image kernel abort - null driver entry point")
+end
diff --git a/sys/imio/iki/plf/plfopen.x b/sys/imio/iki/plf/plfopen.x
new file mode 100644
index 00000000..ec65d647
--- /dev/null
+++ b/sys/imio/iki/plf/plfopen.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<pmset.h>
+include	<plio.h>
+
+
+# PLF_OPEN -- Open a PMIO mask on an image descriptor.
+
+procedure plf_open (kernel, im, o_im,
+	root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I [not used]
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I filename extension
+char	ksection[ARB]		#I QPIO filter expression
+int	cl_index		#I [not used]
+int	cl_size			#I [not used]
+int	acmode			#I [not used]
+int	status			#O ok|err
+
+pointer	sp, fname, hp, pl
+int	naxes, axlen[IM_MAXDIM], depth
+bool	envgetb(), fnullfile()
+pointer	pl_open()
+int	access()
+errchk	imerr
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (hp, IM_LENHDRMEM(im), TY_CHAR)
+
+	# The only valid cl_index for a PL image is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1)) {
+	    call sfree (sp)
+	    status = ERR
+	    return
+	}
+
+	# Get mask file name.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Open an empty mask.
+	pl = pl_open (NULL)
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    # Check that we will not be clobbering an existing mask.
+	    if (!fnullfile(Memc[fname]) && access (Memc[fname], 0, 0) == YES)
+		if (envgetb ("imclobber")) {
+		    iferr (call delete (Memc[fname]))
+			;
+		} else {
+		    call pl_close (pl)
+		    call imerr (IM_NAME(im), SYS_IKICLOB)
+		}
+	} else {
+	    # Load the named mask if opening an existing mask image.
+	    iferr (call pl_loadf (pl,Memc[fname],Memc[hp],IM_LENHDRMEM(im))) {
+		call pl_close (pl)
+		call sfree (sp)
+		status = ERR
+		return
+	    }
+
+	    # Set the image size.
+	    call pl_gsize (pl, naxes, axlen, depth)
+
+	    IM_NDIM(im) = naxes
+	    call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+	    call imioff (im, 1, YES, 1)
+
+	    # Restore the header cards.
+	    call im_pmldhdr (im, hp)
+	}
+
+	# More set up of the image descriptor.
+	IM_PL(im)	= pl
+	IM_PLFLAGS(im)	= PL_CLOSEPL
+	IM_PIXTYPE(im)  = TY_INT
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfrename.x b/sys/imio/iki/plf/plfrename.x
new file mode 100644
index 00000000..1ab47507
--- /dev/null
+++ b/sys/imio/iki/plf/plfrename.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_RENAME -- Rename a PLIO mask savefile (mask image).
+
+procedure plf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I old image extn
+int	status			#O output status
+
+pointer	sp, oldname, newname
+errchk	rename
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new datafiles.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Rename the datafile.
+	iferr (call rename (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfupdhdr.x b/sys/imio/iki/plf/plfupdhdr.x
new file mode 100644
index 00000000..e8cb8784
--- /dev/null
+++ b/sys/imio/iki/plf/plfupdhdr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<plset.h>
+
+# PLF_UPDHDR -- Update the image header.
+
+procedure plf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+pointer	bp
+int	nchars, flags, sz_buf
+int	im_pmsvhdr()
+
+begin
+	status = OK
+
+	flags = 0
+	if (IM_ACMODE(im) == READ_WRITE)
+	    flags = PL_UPDATE
+
+	bp = NULL
+	iferr {
+	    nchars = im_pmsvhdr (im, bp, sz_buf)
+	    call pl_savef (IM_PL(im), IM_HDRFILE(im), Memc[bp], flags)
+	} then
+	    status = ERR
+
+	call mfree (bp, TY_CHAR)
+end
diff --git a/sys/imio/iki/qpf/README b/sys/imio/iki/qpf/README
new file mode 100644
index 00000000..cea44538
--- /dev/null
+++ b/sys/imio/iki/qpf/README
@@ -0,0 +1,2 @@
+IKI/QPF -- IKI kernel for the QPOE (position ordered event file) image format.
+See the QPOE source directories for additional information on QPOE.
diff --git a/sys/imio/iki/qpf/mkpkg b/sys/imio/iki/qpf/mkpkg
new file mode 100644
index 00000000..eb3e8efd
--- /dev/null
+++ b/sys/imio/iki/qpf/mkpkg
@@ -0,0 +1,22 @@
+# Make the IKI/QPF interface (photon image kernel).
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	qpfaccess.x	qpf.h
+	qpfclose.x	qpf.h <imhdr.h> <imio.h>
+	qpfcopy.x	qpf.h <error.h>
+	qpfcopypar.x	qpf.h <error.h> <imhdr.h> <imio.h> <qpset.h>
+	qpfdelete.x	<error.h>
+	qpfopen.x	qpf.h <error.h> <imhdr.h> <imio.h> <mach.h>\
+			<qpioset.h> <qpset.h>
+	qpfopix.x	qpf.h <imhdr.h> <imio.h>
+	qpfrename.x	qpf.h <error.h>
+	qpfupdhdr.x	
+	qpfwattr.x	qpf.h <ctype.h> <qpioset.h>
+	qpfwfilter.x	qpf.h
+	zfioqp.x	qpf.h <fio.h> <imhdr.h> <imio.h> <mach.h> <qpioset.h>
+	;
diff --git a/sys/imio/iki/qpf/qpf.h b/sys/imio/iki/qpf/qpf.h
new file mode 100644
index 00000000..37e29cee
--- /dev/null
+++ b/sys/imio/iki/qpf/qpf.h
@@ -0,0 +1,20 @@
+# QPF.H -- IKI/QPF internal definitions.
+
+define	QPF_EXTN	"qp"		# image header filename extension
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	SZ_KWNAME	8		# size of a FITS keyword name
+define	SZ_BIGSTR	64		# max length string per FITS card
+define	SZ_MAXFILTER	4096		# max size QPIO filter (for log only)
+
+define	LEN_QPFDES	10
+define	QPF_IM		Memi[$1]	# backpointer to image descriptor
+define	QPF_QP		Memi[$1+1]	# QPOE datafile descriptor
+define	QPF_IO		Memi[$1+2]	# QPIO descriptor
+define	QPF_XBLOCK	Memr[P2R($1+3)]	# X block factor for sampling
+define	QPF_YBLOCK	Memr[P2R($1+4)]	# Y block factor for sampling
+define	QPF_VS		Memi[$1+5+$2-1]	# start vector of active rect
+define	QPF_VE		Memi[$1+7+$2-1]	# end vector of active rect
+define	QPF_IOSTAT	Memi[$1+9]	# i/o status (byte count)
+
+# QPOE parameters to be omitted from the IMIO header user parameter list.
+define	OMIT "|naxes|axlen|datamin|datamax|cretime|modtime|limtime|"
diff --git a/sys/imio/iki/qpf/qpfaccess.x b/sys/imio/iki/qpf/qpfaccess.x
new file mode 100644
index 00000000..52d0b06f
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfaccess.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpf.h"
+
+# QPF_ACCESS -- Test the accessibility or existence of an existing image,
+# or the legality of the name of a new image.
+
+procedure qpf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O ok or err
+
+pointer	sp, fname
+int	btoi(), qp_access(), iki_validextn()
+string	qpf_extn QPF_EXTN
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	status = NO
+	if (extn[1] != EOS)
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (extn[1] == EOS) {
+		call iki_mkfname (root, qpf_extn, Memc[fname], SZ_PATHNAME)
+		status = qp_access (Memc[fname], acmode)
+		if (status != NO)
+		    call strcpy (qpf_extn, extn, MAX_LENEXTN)
+	    } else if (status != NO) {
+		call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+		status = qp_access (Memc[fname], acmode)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfclose.x b/sys/imio/iki/qpf/qpfclose.x
new file mode 100644
index 00000000..b4bad7b4
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfclose.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include "qpf.h"
+
+# QPF_CLOSE -- Close a QPOE image.
+
+procedure qpf_close (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+pointer	qpf
+
+begin
+	# Close the QPF virtual file driver.
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+
+	# Close the various descriptors.
+	qpf = IM_KDES(im)
+	if (QPF_IO(qpf) != NULL)
+	    call qpio_close (QPF_IO(qpf))
+	if (QPF_QP(qpf) != NULL)
+	    call qp_close (QPF_QP(qpf))
+
+	call mfree (qpf, TY_STRUCT)
+end
diff --git a/sys/imio/iki/qpf/qpfcopy.x b/sys/imio/iki/qpf/qpfcopy.x
new file mode 100644
index 00000000..ebc2fa5b
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfcopy.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"qpf.h"
+
+# QPF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure qpf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I new extn
+int	status			#O output status
+
+pointer	sp
+pointer	oldname, newname
+errchk	qp_copy
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Copy the datafile.
+	iferr (call qp_copy (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfcopypar.x b/sys/imio/iki/qpf/qpfcopypar.x
new file mode 100644
index 00000000..cfa94c62
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfcopypar.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<qpset.h>
+include	"qpf.h"
+
+# QPF_COPYPARAMS -- Copy parameters from the QPOE datafile header into the
+# image header.  Only scalar parameters are copied.
+
+procedure qpf_copyparams (im, qp)
+
+pointer	im			#I image descriptor
+pointer	qp			#I QPOE descriptor
+
+int	nelem, dtype, maxelem, flags
+pointer	sp, param, text, comment, datatype, fl, qpf, mw, io
+
+pointer	qp_ofnlu(), qpio_loadwcs()
+int	qp_gnfn(), qp_queryf(), stridx(), strdic()
+errchk	qp_ofnlu, qp_gnfn, qp_queryf, imaddi, qp_geti, mw_saveim
+
+bool	qp_getb()
+short	qp_gets()
+int	qp_geti(), qp_gstr()
+real	qp_getr()
+double	qp_getd()
+
+begin
+	call smark (sp)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (comment, SZ_COMMENT, TY_CHAR)
+	call salloc (datatype, SZ_DATATYPE, TY_CHAR)
+
+	qpf = IM_KDES(im)
+
+	# Copy QPOE special keywords.
+	call imaddi (im, "NAXES",  qp_geti(qp,"naxes"))
+	call imaddi (im, "AXLEN1", qp_geti(qp,"axlen[1]"))
+	call imaddi (im, "AXLEN2", qp_geti(qp,"axlen[2]"))
+	call imaddr (im, "XBLOCK", QPF_XBLOCK(qpf))
+	call imaddr (im, "YBLOCK", QPF_YBLOCK(qpf))
+
+	# Output the QPOE filter.
+	iferr (call qpf_wfilter (qpf, im))
+	    call erract (EA_WARN)
+
+	# Compute and output any filter attributes.
+	iferr (call qpf_wattr (qpf, im))
+	    call erract (EA_WARN)
+
+	# Copy the WCS, if any.
+	io = QPF_IO(qpf)
+	if (io != NULL)
+	    ifnoerr (mw = qpio_loadwcs (io)) {
+		call mw_saveim (mw, im)
+		call mw_close (mw)
+	    }
+
+	# Copy general keywords.
+	fl = qp_ofnlu (qp, "*")
+
+	while (qp_gnfn (fl, Memc[param], SZ_FNAME) != EOF) {
+	    # Get the next scalar parameter which has a nonnull value.
+	    nelem = qp_queryf (qp, Memc[param], Memc[datatype], maxelem,
+		Memc[comment], flags)
+	    if (strdic (Memc[param], Memc[text], SZ_LINE, OMIT) > 0)
+		next
+
+	    dtype = stridx (Memc[datatype], "bcsilrdx")
+
+	    # Make entry for a parameter which has no value, or an unprintable
+	    # value.
+
+	    if (nelem == 0 || (nelem > 1 && dtype != TY_CHAR) ||
+		dtype < TY_BOOL || dtype > TY_COMPLEX) {
+
+		call sprintf (Memc[text], SZ_LINE, "%14s[%03d] %s")
+		    call pargstr (Memc[datatype])
+		    call pargi (nelem)
+		    call pargstr (Memc[comment])
+
+		iferr (call imastr (im, Memc[param], Memc[text]))
+		    call erract (EA_WARN)
+		next
+	    }
+
+	    # Copy parameter to image header.
+	    iferr {
+		switch (dtype) {
+		case TY_BOOL:
+		    call imaddb (im, Memc[param], qp_getb(qp,Memc[param]))
+		case TY_CHAR:
+		    if (qp_gstr (qp, Memc[param], Memc[text], SZ_LINE) > 0)
+			call imastr (im, Memc[param], Memc[text])
+		case TY_SHORT:
+		    call imadds (im, Memc[param], qp_gets(qp,Memc[param]))
+		case TY_INT, TY_LONG:
+		    call imaddi (im, Memc[param], qp_geti(qp,Memc[param]))
+		case TY_REAL:
+		    call imaddr (im, Memc[param], qp_getr(qp,Memc[param]))
+		case TY_DOUBLE:
+		    call imaddd (im, Memc[param], qp_getd(qp,Memc[param]))
+		case TY_COMPLEX:
+		    ; # not supported.
+		}
+	    } then {
+		call erract (EA_WARN)
+		break
+	    }
+	}
+
+	call qp_cfnl (fl)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfdelete.x b/sys/imio/iki/qpf/qpfdelete.x
new file mode 100644
index 00000000..c503c174
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfdelete.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# QPF_DELETE -- Delete a datafile.
+
+procedure qpf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension
+int	status			#O output status
+
+pointer	sp, fname
+errchk	qp_delete
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (call qp_delete (Memc[fname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfopen.x b/sys/imio/iki/qpf/qpfopen.x
new file mode 100644
index 00000000..99a57df1
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfopen.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<qpset.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# QPF_OPEN -- Open a QPOE image.  New QPOE images can only be written by
+# calling QPOE directly; under IMIO, only READ_ONLY access is supported.
+
+procedure qpf_open (kernel, im, o_im,
+	root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I [not used]
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I filename extension
+char	ksection[ARB]		#I QPIO filter expression
+int	cl_index		#I [not used]
+int	cl_size			#I [not used]
+int	acmode			#I [not used]
+int	status			#O ok|err
+
+int	n
+real	xblock, yblock, tol
+pointer	sp, qp, io, v, fname, qpf
+
+pointer	qp_open, qpio_open()
+real	qpio_statr(), qp_statr()
+int	qpio_getrange(), qp_geti(), qp_gstr(), qp_lenf()
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (v, SZ_FNAME, TY_CHAR)
+
+	io = NULL
+	qp = NULL
+	qpf = NULL
+	tol = EPSILONR * 100
+
+	# The only valid cl_index for a QPOE image is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1))
+	    goto err_
+
+	call malloc (qpf, LEN_QPFDES, TY_STRUCT)
+
+	# Open the QPOE file.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (qp = qp_open (Memc[fname], READ_ONLY, 0)) {
+	    qp = NULL
+	    goto err_
+	}
+
+	# Open the event list under QPIO for sampled (pixel) i/o.
+	iferr (io = qpio_open (qp, ksection, READ_ONLY))
+	    io = NULL
+
+	# Determine the data range and pixel type.
+	iferr (IM_CTIME(im) = qp_geti (qp, "cretime"))
+	    IM_CTIME(im) = 0
+	iferr (IM_MTIME(im) = qp_geti (qp, "modtime"))
+	    IM_MTIME(im) = 0
+	iferr (IM_LIMTIME(im) = qp_geti (qp, "limtime"))
+	    IM_LIMTIME(im) = 0
+
+	# The min and max pixel values for a sampled event file depend
+	# strongly on the blocking factor, which is a runtime variable.
+	# Ideally when the poefile is written the vectors 'datamin' and
+	# 'datamax' should be computed for the main event list.  These
+	# give the min and max pixel values (counts/pixel) for each blocking
+	# factor from 1 to len(data[min|max]), i.e., the blocking factor
+	# serves as the index into these vectors.
+
+	if (io != NULL) {
+	    xblock = max (1.0, qpio_statr (io, QPIO_XBLOCKFACTOR))
+	    yblock = max (1.0, qpio_statr (io, QPIO_YBLOCKFACTOR))
+	} else {
+	    xblock = max (1.0, qp_statr (qp, QPOE_XBLOCKFACTOR))
+	    yblock = max (1.0, qp_statr (qp, QPOE_YBLOCKFACTOR))
+	}
+	call strcpy ("datamax", Memc[v], SZ_FNAME)
+	n = qp_lenf (qp, Memc[v])
+
+	if (n >= max(xblock,yblock)) {
+	    call sprintf (Memc[v+7], SZ_FNAME-7, "[%d]")
+		call pargi (nint((xblock+yblock)/2))
+	    IM_MAX(im) = qp_geti (qp, Memc[v])
+	    Memc[v+5] = 'i';  Memc[v+6] = 'n'
+	    IM_MIN(im) = qp_geti (qp, Memc[v])
+	} else
+	    IM_LIMTIME(im) = 0
+
+	# Set the image pixel type.  This is arbitrary, provided we have
+	# enough dynamic range to represent the maximum pixel value.
+
+	IM_PIXTYPE(im) = TY_INT
+	if (IM_LIMTIME(im) != 0 && IM_LIMTIME(im) >= IM_MTIME(im))
+	    if (int(IM_MAX(im)) <= MAX_SHORT)
+		IM_PIXTYPE(im) = TY_SHORT
+
+	# Set the image size parameters.  If the user has specified a rect
+	# within which i/o is to occur, set the logical image size to the
+	# size of the rect rather than the full matrix.
+
+	if (io != NULL) {
+	    IM_NDIM(im)  = qpio_getrange (io, QPF_VS(qpf,1), QPF_VE(qpf,1), 2)
+	    IM_LEN(im,1) = (QPF_VE(qpf,1) - QPF_VS(qpf,1) + 1) / xblock + tol
+	    IM_LEN(im,2) = (QPF_VE(qpf,2) - QPF_VS(qpf,2) + 1) / yblock + tol
+	} else {
+	    IM_NDIM(im)  = 2
+	    IM_LEN(im,1) = qp_geti (qp, "axlen[1]") / xblock + tol
+	    IM_LEN(im,2) = qp_geti (qp, "axlen[2]") / yblock + tol
+	    QPF_VS(qpf,1) = 1;	QPF_VE(qpf,1) = IM_LEN(im,1)
+	    QPF_VS(qpf,2) = 1;	QPF_VE(qpf,2) = IM_LEN(im,2)
+	}
+	call imioff (im, 1, YES, 1)
+
+	iferr (n = qp_gstr (qp, "title", IM_TITLE(im), SZ_IMTITLE))
+	    IM_TITLE(im) = EOS
+	iferr (n = qp_gstr (qp, "history", IM_HISTORY(im), SZ_IMHIST))
+	    IM_HISTORY(im) = EOS
+
+	call strcpy (root, IM_HDRFILE(im), SZ_IMHDRFILE)
+	IM_PIXFILE(im) = EOS
+	IM_HFD(im) = NULL
+	IM_PFD(im) = NULL
+
+	# Set up the QPF descriptor.
+	QPF_IM(qpf)	= im
+	QPF_QP(qpf)	= qp
+	QPF_IO(qpf)	= io
+	QPF_XBLOCK(qpf)	= xblock
+	QPF_YBLOCK(qpf)	= yblock
+	QPF_IOSTAT(qpf)	= 0
+
+	IM_KDES(im) = qpf
+
+	# Copy any scalar QPOE file header parameters into the IMIO header.
+	iferr (call qpf_copyparams (im, qp))
+	    call erract (EA_WARN)
+
+	status = OK
+	call sfree (sp)
+	return
+
+err_
+	# Error abort.
+	if (io != NULL)
+	    call qpio_close (io)
+	if (qp != NULL)
+	    call qp_close (qp)
+
+	call mfree (qpf, TY_STRUCT)
+	IM_KDES(im) = NULL
+
+	status = ERR
+	call erract (EA_WARN)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfopix.x b/sys/imio/iki/qpf/qpfopix.x
new file mode 100644
index 00000000..9b5750ff
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfopix.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"qpf.h"
+
+# QPF_OPIX -- Open the "pixel storage file", i.e., open the special QPF/QPOE
+# virtual file driver, which samples the QPOE event list in real time to
+# produce image "pixels", where each pixel contains a count of the number of
+# photons mapping to that point in the output image matrix.
+
+procedure qpf_opix (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+pointer	sp, fname, qpf
+extern	qpfzop(), qpfzrd(), qpfzwr(), qpfzwt(), qpfzst(), qpfzcl()
+int	fopnbf()
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+	# Verify that the QPIO open succeeded at open time; if not, the file
+	# may not have an event list (which is legal, but not for pixel i/o).
+
+	qpf = IM_KDES(im)
+	if (QPF_IO(qpf) == NULL) {
+	    status = ERR
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Encode the QPF descriptor as a pseudo-filename to pass the descriptor
+	# through fopnbf to the QPF virtual binary file driver.
+
+	call sprintf (Memc[fname], SZ_FNAME, "QPF%d")
+	    call pargi (IM_KDES(im))
+
+	# Open a file descriptor for the dummy QPOE file driver, used to access
+	# the event list as a virtual pixel array (sampled at runtime).
+
+	iferr (IM_PFD(im) = fopnbf (Memc[fname], READ_ONLY,
+	    qpfzop, qpfzrd, qpfzwr, qpfzwt, qpfzst, qpfzcl)) {
+
+	    IM_PFD(im) = NULL
+	    status = ERR
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfrename.x b/sys/imio/iki/qpf/qpfrename.x
new file mode 100644
index 00000000..70f90626
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfrename.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"qpf.h"
+
+# QPF_RENAME -- Rename a datafile.
+
+procedure qpf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I old image extn
+int	status			#O output status
+
+pointer	sp, oldname, newname
+errchk	qp_rename
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new datafiles.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Rename the datafile.
+	iferr (call qp_rename (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfupdhdr.x b/sys/imio/iki/qpf/qpfupdhdr.x
new file mode 100644
index 00000000..9dd67ea6
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfupdhdr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# QPF_UPDHDR -- Update the image header.  This is a no-op for QPF since the
+# datafiles can only be accessed READ_ONLY via IMIO.
+
+procedure qpf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+begin
+	status = OK
+end
diff --git a/sys/imio/iki/qpf/qpfwattr.x b/sys/imio/iki/qpf/qpfwattr.x
new file mode 100644
index 00000000..b48a6793
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfwattr.x
@@ -0,0 +1,191 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# QPF_WATTR -- Record information about the attributes of the filter
+# expression used to generate an image.  Currently the only value which can be
+# computed and recorded is total range (integral of the in-range intervals) of
+# the range list defining an attribute, for example, the total exposure time
+# defined by the time range list used to filter the data.
+#
+# This routine is driven by a set of optional QPOE header keywords of the
+# form
+#
+#	Keyword		String Value
+#
+#	defattrN	<param-name> = "integral" <attribute-name>[:type]
+# e.g.
+#	defattr1	"exptime = integral time:d"
+#
+# where param-name is the parameter name to be written to the output image
+# header, "integral" is the value to be computed, and attribute-name is the
+# QPEX attribute (e.g., "time") to be used for the computation.  A finite
+# value is returned for the integral if a range list is given for the named
+# attribute and the range is closed.  If the range is open on either or both
+# ends, or no range expression is defined for the attribute, then INDEF is
+# returned for the value of the integral.
+
+procedure qpf_wattr (qpf, im)
+
+pointer	qpf				#I QPF descriptor
+pointer	im				#I image descriptor
+
+real	r1, r2, rsum
+double	d1, d2, dsum
+int	dtype, i, j, xlen, nranges, i1, i2, isum
+pointer	sp, io, qp, ex, kwname, kwval, pname, funame, atname, ip, xs, xe
+
+bool	strne()
+pointer	qpio_stati()
+int	qp_gstr(), ctowrd(), qp_accessf()
+int	qpex_attrli(), qpex_attrlr(), qpex_attrld()
+errchk	qpex_attrli, qpex_attrlr, qpex_attrld, imaddi, imaddr, imaddd
+
+begin
+	io = QPF_IO(qpf)
+	if (io == NULL)
+	    return
+
+	qp = QPF_QP(qpf)
+	ex = qpio_stati (io, QPIO_EX)
+
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+	call salloc (kwval, SZ_LINE, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+	call salloc (funame, SZ_FNAME, TY_CHAR)
+	call salloc (atname, SZ_FNAME, TY_CHAR)
+
+	# Process a sequence of "defattrN" header parameter definitions.
+	# Each defines a parameter to be computed and added to the output
+	# image header.
+
+	do i = 1, ARB {
+	    # Check for a parameter named "defattrN", get string value.
+	    call sprintf (Memc[kwname], SZ_FNAME, "defattr%d")
+		call pargi (i)
+
+	    if (qp_accessf (qp, Memc[kwname]) == NO)
+		break
+	    if (qp_gstr (qp, Memc[kwname], Memc[kwval], SZ_LINE) <= 0)
+		break
+
+	    # Parse string value into parameter name, function name,
+	    # expression attribute name, and datatype.
+
+	    ip = kwval
+	    if (ctowrd (Memc, ip, Memc[pname], SZ_FNAME) <= 0)
+		break
+	    while (IS_WHITE(Memc[ip]) || Memc[ip] == '=')
+		ip = ip + 1
+	    if (ctowrd (Memc, ip, Memc[funame], SZ_FNAME) <= 0)
+		break
+	    if (ctowrd (Memc, ip, Memc[atname], SZ_FNAME) <= 0)
+		break
+
+	    dtype = TY_INT
+	    for (ip=atname;  Memc[ip] != EOS;  ip=ip+1)
+		if (Memc[ip] == ':') {
+		    Memc[ip] = EOS
+		    if (Memc[ip+1] == 'd')
+			dtype = TY_DOUBLE
+		    else if (Memc[ip+1] == 'r')
+			dtype = TY_REAL
+		    else
+			call eprintf ("QPF.defattr: datatype not recognized\n")
+		}
+
+	    # Verify known function type.
+	    if (strne (Memc[funame], "integral")) {
+		call eprintf ("QPF.defattr: function `%s' not recognized\n")
+		    call pargstr (Memc[funame])
+		break
+	    }
+
+	    # Compute the integral of the range list for the named attribute.
+	    xlen = 0
+	    xs = NULL  
+	    xe = NULL
+
+	    switch (dtype) {
+	    case TY_REAL:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrlr (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    rsum = INDEFR
+		else {
+		    rsum = 0
+		    do j = 1, nranges {
+			r1 = Memr[xs+j-1]
+			r2 = Memr[xe+j-1]
+			if (IS_INDEFR(r1) || IS_INDEFR(r2)) {
+			    rsum = INDEFR
+			    break
+			} else
+			    rsum = rsum + (r2 - r1)
+		    }
+		}
+
+		call mfree (xs, TY_REAL)
+		call mfree (xe, TY_REAL)
+		call imaddr (im, Memc[pname], rsum)
+
+	    case TY_DOUBLE:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrld (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    dsum = INDEFD
+		else {
+		    dsum = 0
+		    do j = 1, nranges {
+			d1 = Memd[xs+j-1]
+			d2 = Memd[xe+j-1]
+			if (IS_INDEFD(d1) || IS_INDEFD(d2)) {
+			    dsum = INDEFD
+			    break
+			} else
+			    dsum = dsum + (d2 - d1)
+		    }
+		}
+
+		call mfree (xs, TY_DOUBLE)
+		call mfree (xe, TY_DOUBLE)
+		call imaddd (im, Memc[pname], dsum)
+
+	    default:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrli (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    isum = INDEFI
+		else {
+		    isum = 0
+		    do j = 1, nranges {
+			i1 = Memi[xs+j-1]
+			i2 = Memi[xe+j-1]
+			if (IS_INDEFI(i1) || IS_INDEFI(i2)) {
+			    isum = INDEFI
+			    break
+			} else
+			    isum = isum + (i2 - i1)
+		    }
+		}
+
+		call mfree (xs, TY_INT)
+		call mfree (xe, TY_INT)
+		call imaddi (im, Memc[pname], isum)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfwfilter.x b/sys/imio/iki/qpf/qpfwfilter.x
new file mode 100644
index 00000000..e521cbc6
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfwfilter.x
@@ -0,0 +1,53 @@
+include	"qpf.h"
+
+# QPF_WFILTER -- Record the QPIO filter used to generate an image as a series
+# of FITS cards in the image header.  Note: excessively long filters are
+# truncated to avoid overfilling the image header.
+
+procedure qpf_wfilter (qpf, im)
+
+pointer	qpf				#I QPF descriptor
+pointer	im				#I image descriptor
+
+int	nchars, nleft, index
+pointer	io, sp, bp, ip, kw, strval
+errchk	qpio_getfilter, impstr
+int	qpio_getfilter()
+
+begin
+	io = QPF_IO(qpf)
+	if (io == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (kw, SZ_KWNAME, TY_CHAR)
+	call salloc (bp, SZ_MAXFILTER, TY_CHAR)
+	call salloc (strval, SZ_BIGSTR, TY_CHAR)
+
+	# Get the filter as as string from QPIO.
+	nchars = qpio_getfilter (io, Memc[bp], SZ_MAXFILTER)
+
+	# If the filter is longer than our string buffer, write a "..." at
+	# the end of the filter to indicate that it is being truncated.
+
+	if (nchars == SZ_MAXFILTER)
+	    call strcpy ("...", Memc[bp+nchars-3], 3)
+
+	index = 1
+	ip = bp
+
+	# Output a series of QPFILTnn cards to record the full filter.
+	for (nleft = nchars;  nleft > 0;  nleft = nleft - SZ_BIGSTR) {
+	    call strcpy (Memc[ip], Memc[strval], SZ_BIGSTR)
+	    call sprintf (Memc[kw], SZ_KWNAME, "QPFILT%02d")
+		call pargi (index)
+	    iferr (call imaddf (im, Memc[kw], "c"))
+		;
+	    call impstr (im, Memc[kw], Memc[strval])
+
+	    ip = ip + SZ_BIGSTR
+	    index = index + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/zfioqp.x b/sys/imio/iki/qpf/zfioqp.x
new file mode 100644
index 00000000..0e1c38ff
--- /dev/null
+++ b/sys/imio/iki/qpf/zfioqp.x
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# ZFIOQP -- QPF virtual file driver.  This driver presents to the caller a
+# virtual file space containing a two dimensional array of type short or int
+# pixels, wherein each "pixel" is a count of the number of events from a
+# QPOE event list which map into that pixel.  An i/o request results in
+# runtime filtering and sampling of the event list, mapping each event which
+# passes the filter into the corresponding output pixel, and incrementing the
+# value of that pixel to count the event.
+
+# QPFZOP -- Open the file driver for i/o on the QPIO descriptor opened at
+# qpf_open time.
+
+procedure qpfzop (pkfn, mode, status)
+
+char	pkfn[ARB]		#I packed virtual filename from FIO
+int	mode			#I file access mode (ignored)
+int	status			#O output status - i/o channel if successful
+
+int	ip
+pointer	sp, fn, qpf
+int	ctoi()
+
+begin
+	call smark (sp)
+	call salloc (fn, SZ_FNAME, TY_CHAR)
+
+	# The QPF descriptor is passed encoded in the pseudo filename as
+	# "QPFxxxx" (decimal).  Extract this and return it as the i/o
+	# channel for the driver.
+
+	ip = 4
+	call strupk (pkfn, Memc[fn], SZ_FNAME)
+	if (ctoi (Memc[fn], ip, qpf) <= 0)
+	    status = ERR
+	else
+	    status = qpf
+
+	QPF_IOSTAT(qpf) = 0
+	call sfree (sp)
+end
+
+
+# QPFZCL -- Close the QPF binary file driver.
+
+procedure qpfzcl (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O output status
+
+begin
+	status = OK
+end
+
+
+# QPFZRD -- Read a segment of the virtual pixel array into the output buffer,
+# i.e., zero the output buffer and sample the event list, accumulating counts
+# in the output array.
+
+procedure qpfzrd (chan, obuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	obuf[ARB]		#O output buffer
+int	nbytes			#I nbytes to be read
+int	boffset			#I file offset at which read commences
+
+pointer	qpf, im, io
+int	vs[2], ve[2]
+real	xblock, yblock
+int	szb_pixel, ncols, pixel, nev, xoff, yoff
+int	qpio_readpixs(), qpio_readpixi()
+
+include	<szpixtype.inc>
+
+begin
+	qpf = chan
+	im  = QPF_IM(qpf)
+	io  = QPF_IO(qpf)
+
+	xblock = QPF_XBLOCK(qpf)
+	yblock = QPF_YBLOCK(qpf)
+	ncols = IM_PHYSLEN(im,1)
+	xoff  = QPF_VS(qpf,1)
+	yoff  = QPF_VS(qpf,2)
+	szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+
+	# Convert boffset, nbytes to vs, ve.
+	pixel = (boffset - 1) / szb_pixel
+	vs[1] = (mod (pixel, ncols)) * xblock + xoff
+	vs[2] = (pixel / ncols) * yblock + yoff
+
+	pixel = (boffset-1 + nbytes - szb_pixel) / szb_pixel
+	ve[1] = (mod (pixel, ncols)) * xblock + (xblock-1) + xoff
+	ve[2] = (pixel / ncols) * yblock + (yblock-1) + yoff
+
+	# Call readpix to sample image into the output buffer.  Zero the buffer
+	# first since the read is additive.
+
+	call aclrc (obuf, nbytes / SZB_CHAR)
+	iferr {
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT:
+		nev = qpio_readpixs (io, obuf, vs, ve, 2, xblock, yblock)
+	    case TY_INT:
+		nev = qpio_readpixi (io, obuf, vs, ve, 2, xblock, yblock)
+	    }
+	} then {
+	    QPF_IOSTAT(qpf) = ERR
+	} else
+	    QPF_IOSTAT(qpf) = nbytes
+end
+
+
+# QPFZWR -- Write to the virtual pixel array.  QPF permits only read-only
+# access, but we ignore write requests, so return OK and do nothing if this
+# routine is called.
+
+procedure qpfzwr (chan, ibuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	ibuf[ARB]		#O datg buffer
+int	nbytes			#I nbytes to be written
+int	boffset			#I file offset to write at
+
+pointer	qpf
+
+begin
+	qpf = chan
+	QPF_IOSTAT(qpf) = nbytes
+end
+
+
+# QPFZWT -- Return the number of virtual bytes transferred in the last i/o
+# request.
+
+procedure qpfzwt (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O i/o channel status
+
+pointer	qpf
+
+begin
+	qpf = chan
+	status = QPF_IOSTAT(qpf)
+end
+
+
+# QPFZST -- Query device/file parameters.
+
+procedure qpfzst (chan, param, value)
+
+int	chan			#I QPF i/o channel
+int	param			#I parameter to be returned
+int	value			#O parameter value
+
+pointer	qpf, im, io
+int	szb_pixel, npix
+int	qpio_stati()
+
+include	<szpixtype.inc>
+
+begin
+	qpf = chan
+	im = QPF_IM(qpf)
+	io = QPF_IO(qpf)
+	npix = IM_PHYSLEN(im,1) * IM_PHYSLEN(im,2)
+	szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+
+	switch (param) {
+	case FSTT_BLKSIZE:
+	    value = 1
+	case FSTT_FILSIZE:
+	    value = npix * szb_pixel
+	case FSTT_OPTBUFSIZE:
+	    value = min (npix*szb_pixel, qpio_stati(io,QPIO_OPTBUFSIZE))
+	case FSTT_MAXBUFSIZE:
+	    value = npix * szb_pixel
+	default:
+	    value = ERR
+	}
+end
diff --git a/sys/imio/iki/stf/README b/sys/imio/iki/stf/README
new file mode 100644
index 00000000..5540110b
--- /dev/null
+++ b/sys/imio/iki/stf/README
@@ -0,0 +1,300 @@
+IKI/STF -- IKI kernel for the STScI SDAS/GEIS image format.  This format stores
+images in a format which resembles FITS group format.  A GROUP FORMAT IMAGE is
+a set of one or more images, all of which are the same size, dimension, and
+datatype, and which share a common FITS header.  The individual images in a
+group each has a binary GROUP PARAMETER BLOCK (GPB).  The image and associated
+group parameter block are commonly referred to as a GROUP.  A group format
+image consists of two files, the FITS format header file for the group,
+and the pixel file containing the image data and GPBs.
+
+
+1. Typical STF group format FITS image header (imname.hhh)
+
+	SIMPLE	=		    F		/ Standard STF keywords
+	BITPIX	=		    32
+	DATATYPE= 'REAL*4	'
+	NAXIS	=		    2
+	NAXIS1	=		    512
+	NAXIS2	=		    512
+	GROUPS	=		    T
+	PSIZE	=		    512
+	GCOUNT	=		    1
+	PCOUNT	=		    12
+
+	PTYPE1	= 'DATAMIN	'		/ Define binary group params
+	PSIZE1	= 		    32
+	PDTYPE1	= 'REAL*4	'
+	    (etc, for a total of 3*PCOUNT entries)
+
+	(special keywords and HISTORY cards)
+
+
+2. Pixel file format (imname.hhd) (byte stream, no alignment, no header)
+
+	[1].pixels
+	[1].group parameter block
+	[2].pixels
+	[2].group parameter block
+		...
+	[GCOUNT].pixels
+	[GCOUNT].group parameter block
+
+
+The chief problems with this format are that the FITS format header can contain
+only parameters which pertain to the group as a whole, while the format of the
+GPBs is fixed at image creation time.  Images may be neither deleted from nor
+added to a group.  It is possible for parameters in the FITS header to have
+the same names as parameters in the GPBs.  Multiple entries for the same
+keyword may appear in the FITS header and the format does not define how
+these are to be handled.  Although the format is general enough to support
+any datatype pixels, in practice only REAL*4 can be used as the SDAS software
+maps the pixfile directly into virtual memory.
+
+CAVEAT -- This is an awkward interface and some liberties have been taken in
+the code (hidden, subtle semantics, etc.).  At least we were able to confine
+the bad code to this one directory; any problems can be fixed without any
+changes to the rest of IMIO.  All of this low level code is expected to be
+thrown out when IMIO is cut over onto DBIO (the upcoming IRAF database
+interface).
+
+
+IKI/STF Pseudocode
+----------------------------
+
+1. Data structures:
+
+	1.1 IMIO image descriptor
+	    header, pixel file descriptors
+	    pointer to additional kernel descriptor, if any
+	    index of IKI kernel in use
+	    pathnames of header, pixel files
+	    IM_NDIM, IM_LEN, etc., physical image parameters
+
+	1.2 STF image descriptor
+	    Pointed to by IM_KDES field of IMIO descriptor.
+	    Contains values of all reserved fields of STF image header,
+		some of which duplicate values in IMIO descriptor.
+	    Group, gcount, size of a group in pixfile, description of
+		the group parameter block, i.e., for each parameter,
+		the offset, datatype type, name, length if array, etc.
+
+	1.3 IMIO user area (FITS cards)
+	    While an image is open, the first few cards in the user area
+		contain the FITS encoded group parameters.
+	    The remainder of the user area contains an exact image of
+		all non-reserved keyword cards found in the STF image
+		header (or in the header of some other type of image
+		when making a new_copy of an image stored in some other
+		format).
+
+
+2. Major Procedures
+
+procedure open_image
+
+begin
+	if (mode is not new_image or new_copy) {
+	    open_existing_image
+	    return
+	}
+
+	We are opening a new_image or new_copy image.  The problem here is
+	that the new image might be a group within an existing group format
+	image.  This ambiguity is resolved by a simple test on the group
+	index, rather than by a context dependent test on the existence of
+	the group format image.  If the mode is new_whatever and the group
+	is 1, a new group format image is created, else if the group is > 1,
+	the indicated group is initialized in an existing group format image.
+
+	if (group > 1) {
+	    We are opening a new group within an existing group format image.
+
+	    Call open_existing_image to open the group without reading the
+		group parameter block, which has not yet been initialized.
+
+	    if (mode is new_image)
+		initialize GPB to pixel coords
+	    else if (mode is new_copy)
+		copy old GPB to new image; transform coords if necessary
+
+	    Note that when opening a new copy of an existing image as a new
+	    group within a group format image, it is not clear what to do
+	    with the FITS header of the old image.  Our solution is to ignore
+	    it, and retain only the GPB, the only part of the old header
+	    pertaining directly to the group being accessed.
+
+	} else if (opening group 1 of a new image) {
+	    We are creating a new group format image.
+
+	    if (mode is new_image)
+		open_new_image
+	    else
+		open_new_copy
+	}
+end
+
+
+procedure open_existing_image
+
+begin
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Open image header.
+
+	Read header:
+		process reserved cards into STF descriptor
+		spool other cards
+
+	Load group data block from pixfile, get datamin/datamax:
+		if (there is a gdb) {
+		    open pixfile
+		    read gdb into buffer
+		    for (each param in gdb) {
+			set up parameter descriptor
+			format FITS card and put in imio user area
+		    }
+		}
+
+		fetch datamin, datamax from user area
+
+	Set IM_MIN, IM_MAX, IM_LIMTIME from DATAMIN, DATAMAX.
+	Mark end of user area.
+	Copy spooled cards to user area.
+		(increase size of user area if necessary)
+
+	Call imioff to set up imio pixel offset parameters
+end
+
+
+procedure open_new_image
+
+begin
+	Upon entry, the imio iminie procedure has already been called to
+	    initialize the imio descriptor for the new image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	(At this point the IMIO header fields IM_NDIM, IM_LEN, etc., and
+	(the STF descriptor fields have not yet been set, and cannot be set
+	(until the image dimensions have been defined by the high level code.
+	(imopix() will later have to fix up the remaining header fields and
+	(set up the default group data block.
+end
+
+
+procedure open_new_copy
+
+begin
+	Upon entry, the imio immaky procedure has already been called to
+	    copy the old header to the new and initialize the data
+	    dependent fields.  This will include the FITS encoded group
+	    parameters in the user area of the old image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	Copy the STF descriptor of the old image to the new.  Preserve
+	    the parameter marking the end of the GPB area of the old
+	    user area, as we do not want to write these cards when the
+	    header is updated.
+
+	(At this point all header information is set up, except that there
+	(is no pixel file and the pixfile offsets have not been set.
+	(Provided the image dimensions do not change, one could simply
+	(set the pixfile name, call imioff, and do i/o to the image.
+end
+
+
+procedure open_pixel_file
+
+begin
+	(We are called when the first i/o is done to an image.  When writing
+	(to a new image, the user may change any of the image header attributes
+	(after the open and before we are called.
+
+	if (pixel file already open)
+	    return
+	else if (opening existing image) {
+	    open pixel file
+	    return
+	}
+
+	if (opening a new image) {
+	    Given the values of IM_NDIM and IM_LEN set by the user, set up the
+	    STF descriptor including the default group parameter block.  Add
+	    the FITS encoded cards for the GPB to the image header.  Mark the
+	    end of the GPB cards, i.e., the start of the real user parameter
+	    area.  Ignore IM_PIXTYPE; always open an image of type real since
+	    that is what the SDAS software requires.  Set up the WCS to linear
+	    pixel coordinates.
+
+	} else if (opening a new_copy image) {
+	    (The STF descriptor and GPB will already have been set up as a
+	    (copy of the data structures used by the old image.  However,
+	    (the user may have changed the values of IM_NDIM and IM_LEN
+	    (since the image was opened, and the value of GCOUNT set when
+	    (the image was opened may be different than that of the old image.
+
+	    Transform the coordinate system of the old image to produce the
+	    WCS for the new image, i.e., if an image section was used to
+	    reference the old image.
+
+	    Make a new STF descriptor using the values of IM_NDIM and IM_LEN
+	    given, as for a new_image, but using the WCS information for the
+	    new image.  The FITS encoded fields in the IMIO user area will be
+	    automatically updated by the IMADD functions, or new cards added
+	    if not present.
+
+	    Merge any additional fields from the old STF descriptor into the
+	    new one, e.g., any instrument dependent parameters stored in the
+	    GPB.
+
+	    (The STF and FITS encoded user area should now contain a full
+	    (description of the GPB for the new image.
+	}
+
+	Allocate the pixel file, using the GCOUNT parameter set in the
+	    STF descriptor at stf_open time.
+	Open the pixel file.
+
+	Set IM_MIN and IM_MAX to zero (not defined).
+	Call IMIOFF to initialize the pixel offsets.
+end
+
+
+procedure update_image_header
+
+begin
+	Update the values of DATAMIN, DATAMAX from the IMIO header fields.
+
+	Update the binary GPB in the pixel file from the FITS encoded GPB
+	    in the IMIO user area, using the GPB structure defined in the
+	    STF descriptor.
+
+	Update the STF image header file:
+	    Open a new, empty header file using FMKCOPY and OPEN.
+	    Format and output FITS cards for the reserved header fields,
+		e.g., SIMPLE, BITPIX, GCOUNT, the GPB information, etc.
+	    Copy the user area to the new header file, excluding the
+		GPB cards at the beginning of the user area.
+	    Close the new header file and replace the old header file
+		with the new one via a rename operation.
+end
+
+
+procedure close_image
+
+begin
+	(We assume that IMIO has already update the image header if such
+	(is necessary.
+
+	if (pixel file open)
+	    close pixel file
+	if (header file open)
+	    close header file
+
+	deallocate STF descriptor
+	(IMIO will deallocate the IMIO descriptor)
+end
diff --git a/sys/imio/iki/stf/mkpkg b/sys/imio/iki/stf/mkpkg
new file mode 100644
index 00000000..b28ace96
--- /dev/null
+++ b/sys/imio/iki/stf/mkpkg
@@ -0,0 +1,36 @@
+# Make the IKI/STF interface (STScI SDAS/GEIS group format images)
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	#$set XFLAGS = "$(XFLAGS) -qfx"
+	#$set XFLAGS = "$(XFLAGS) -/pg"
+
+	stfaccess.x	stf.h
+	stfaddpar.x	<imhdr.h> <imio.h> <mach.h> stf.h
+	stfclose.x	stf.h <imhdr.h> <imio.h>
+	stfcopy.x	stf.h <error.h>
+	stfcopyf.x	stf.h
+	stfctype.x	stf.h <ctype.h>
+	stfdelete.x	stf.h <error.h> <imhdr.h>
+	stfget.x	stf.h <ctype.h>
+	stfhextn.x	stf.h <imhdr.h> <imio.h>
+	stfiwcs.x	stf.h <imhdr.h>
+	stfmerge.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfmkpfn.x	stf.h
+	stfnewim.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfopen.x	stf.h <error.h> <imhdr.h> <imio.h>
+	stfopix.x	stf.h <fset.h> <imhdr.h> <imio.h> <mach.h>
+	stfordgpb.x	stf.h <mach.h>
+	stfrdhdr.x	stf.h <finfo.h> <imhdr.h> <imio.h> <mach.h>
+	stfreblk.x	stf.h <imhdr.h> <imio.h>
+	stfrename.x	stf.h <error.h>
+	stfrfits.x	stf.h <ctype.h> <finfo.h> <fset.h> <imhdr.h> <imio.h>
+	stfrgpb.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfupdhdr.x	stf.h <imhdr.h> <imio.h>
+	stfwfits.x	stf.h <error.h> <fio.h> <imhdr.h> <imio.h>
+	stfwgpb.x	stf.h <error.h> <imhdr.h> <imio.h> <mach.h>
+	;
diff --git a/sys/imio/iki/stf/stf.h b/sys/imio/iki/stf/stf.h
new file mode 100644
index 00000000..bf99a07c
--- /dev/null
+++ b/sys/imio/iki/stf/stf.h
@@ -0,0 +1,77 @@
+# STF.H -- IKI/STF internal definitions.
+
+define	HDR_TEMPLATE	"dev$pix.hhh"	# used by fmkcopy to create new header
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	STF_HDRPATTERN	"^??h"		# class of legal header extensions
+define	STF_DEFHDREXTN	"hhh"		# default header file extension
+define	STF_DEFPIXEXTN	"hhd"		# default pixel file extension
+define	ENV_DEFIMTYPE	"imtype"	# name of environment variable
+define	STF_MAXDIM	7		# max NAXIS
+define	MAX_CACHE	5		# max cached header files
+define	DEF_CACHE	3		# default size of header file cache
+define	ENV_STFCACHE	"stfcache"	# environment variable for cache size
+define	MAX_PCOUNT	99		# max param descriptors
+define	SZ_DATATYPE	16		# e.g., `REAL*4'
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_PTYPE	8		# e.g., `CRPIX1'
+define	SZ_PDTYPE	16		# e.g., `CHAR*8'
+define	SZ_COMMENT	FITS_SZCOMMENT	# comment string for GPB card
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+
+define	FITS_RECLEN	80		# length of a FITS record (card)
+define	FITS_STARTVALUE	10		# first column of value field
+define	FITS_ENDVALUE	30		# last  column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	FITS_SZCOMMENT	50		# max chars in comment, incl. /
+
+# STF image descriptor, used internally by the STF interface.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_STFDES	(LEN_STFBASE+MAX_PCOUNT*LEN_PDES)
+define	STF_CACHE	STF_BITPIX	# cache descriptor starting here
+define	STF_CACHELEN	(33+STF_PCOUNT($1)*LEN_PDES)
+define	LEN_STFBASE	43
+
+define	STF_ACMODE	Memi[$1]	# image access mode
+define	STF_NEWIMAGE	Memi[$1+1]	# creating entire new STF format image?
+define	STF_GROUP	Memi[$1+2]	# group to be accessed
+define	STF_SZGROUP	Memi[$1+3]	# size of image+hdr in pixfile, chars
+define	STF_PFD		Memi[$1+4]	# pixfile file descriptor
+define	STF_GRARG	Memi[$1+5]	# group index given in image name
+			# (extra space)
+define	STF_BITPIX	Memi[$1+10]	# bits per pixel
+define	STF_NAXIS	Memi[$1+11]	# number of axes in image
+define	STF_GROUPS	Memi[$1+12]	# group format?
+define	STF_GCOUNT	Memi[$1+13]	# number of groups in STF image
+define	STF_PSIZE	Memi[$1+14]	# size of GPB, bits
+define	STF_PCOUNT	Memi[$1+15]	# number of parameters in GPB
+define	STF_DATATYPE	Memc[P2C($1+16)]# datatype string
+define	STF_LENAXIS	Memi[$1+35+$2-1]# 35:41 = [7] max
+define	STF_PDES	(($1)+43+((($2)-1)*LEN_PDES))
+
+# GPB Parameter descriptor.
+define	LEN_PDES	81
+define	P_OFFSET	Memi[$1]	# struct offset of parameter
+define	P_SPPTYPE	Memi[$1+1]	# SPP datatype of parameter
+define	P_LEN		Memi[$1+2]	# number of elements
+define	P_PSIZE		Memi[$1+3]	# field size, bits
+define	P_PTYPEP	(P2C($1+4))	# pointer to parameter name
+define	P_PTYPE		Memc[P2C($1+4)]	# parameter name
+define	P_PDTYPE	Memc[P2C($1+13)]# datatype string
+define	P_COMMENT	Memc[P2C($1+30)]# comment string
+
+# Reserved FITS keywords known to this code.
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_GCOUNT	4
+define	KW_GROUPS	5
+define	KW_NAXIS	6
+define	KW_NAXISN	7
+define	KW_PCOUNT	8
+define	KW_PDTYPE	9
+define	KW_PSIZE	10
+define	KW_PSIZEN	11
+define	KW_PTYPE	12
+define	KW_SIMPLE	13
diff --git a/sys/imio/iki/stf/stfaccess.x b/sys/imio/iki/stf/stfaccess.x
new file mode 100644
index 00000000..40907c69
--- /dev/null
+++ b/sys/imio/iki/stf/stfaccess.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.
+
+procedure stf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O return value
+
+int	i
+pointer	sp, fname, kextn
+int	access(), iki_validextn(), iki_getextn(), btoi()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (kextn, MAX_LENEXTN, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	status = NO
+
+	# If no extension was given, look for a file with the default
+	# extension, and return the actual extension if an image with the
+	# default extension is found.
+
+	if (extn[1] == EOS) {
+	    do i = 1, ARB {
+		if (iki_getextn (kernel, i, Memc[kextn], MAX_LENEXTN) <= 0)
+		    break
+		call iki_mkfname (root, Memc[kextn], Memc[fname], SZ_PATHNAME)
+		if (access (Memc[fname], acmode, 0) == YES) {
+		    call strcpy (Memc[kextn], extn, MAX_LENEXTN)
+		    status = YES
+		    break
+		}
+	    }		
+	} else if (iki_validextn (kernel, extn) == kernel) {
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	    if (access (Memc[fname], acmode, 0) == YES)
+		status = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfaddpar.x b/sys/imio/iki/stf/stfaddpar.x
new file mode 100644
index 00000000..65a90f80
--- /dev/null
+++ b/sys/imio/iki/stf/stfaddpar.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include "stf.h"
+
+# STF_ADDPAR -- Encode a parameter in FITS format and add it to the FITS format
+# IMIO user area; initialize the entry for the parameter in the GPB descriptor
+# as well.
+
+procedure stf_addpar (im, pname, dtype, plen, pval, pno)
+
+pointer	im			#I image descriptor
+char	pname[ARB]		#I parameter name
+int	dtype			#I SPP datatype of parameter
+int	plen			#I length (> 1 if array)
+char	pval[ARB]		#I string encoded initial parameter value
+int	pno			#U parameter number
+
+bool	bval
+real	rval
+double	dval
+short	sval
+long	lval
+pointer	pp, stf
+
+bool	initparam
+int	ival, ip, junk
+int	ctoi(), ctor(), ctod(), imaccf()
+errchk	imadds, imaddl, imaddr, imaddd, imastr
+
+begin
+	stf = IM_KDES(im)
+	pp  = STF_PDES(stf,pno)
+	ip  = 1
+
+	call strcpy (pname, P_PTYPE(pp), SZ_PTYPE)
+
+	# Initialize the parameter only if not already defined in header.
+	initparam = (imaccf (im, pname) == NO)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call strcpy ("LOGICAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_BOOL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		bval = (pval[1] == 'T')
+		call imaddb (im, P_PTYPE(pp), bval)
+	    }
+	case TY_SHORT:
+	    call strcpy ("INTEGER*2", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_SHORT * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		sval = ival
+		call imadds (im, P_PTYPE(pp), sval)
+	    }
+	case TY_LONG:
+	    call strcpy ("INTEGER*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_LONG * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		lval = ival
+		call imaddl (im, P_PTYPE(pp), lval)
+	    }
+	case TY_REAL:
+	    call strcpy ("REAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_REAL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctor (pval, ip, rval)
+		call imaddr (im, P_PTYPE(pp), rval)
+	    }
+	case TY_DOUBLE:
+	    call strcpy ("REAL*8", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_DOUBLE * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctod (pval, ip, dval)
+		call imaddd (im, P_PTYPE(pp), dval)
+	    }
+	default:
+	    call sprintf (P_PDTYPE(pp), SZ_PDTYPE, "CHARACTER*%d")
+		call pargi (plen)
+	    P_PSIZE(pp) = plen * NBITS_BYTE
+	    if (initparam)
+		call imastr (im, P_PTYPE(pp), pval)
+	}
+
+	P_OFFSET(pp) = 0
+	P_SPPTYPE(pp) = dtype
+	P_LEN(pp) = plen
+
+	pno = pno + 1
+end
diff --git a/sys/imio/iki/stf/stfclose.x b/sys/imio/iki/stf/stfclose.x
new file mode 100644
index 00000000..89981578
--- /dev/null
+++ b/sys/imio/iki/stf/stfclose.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include	"stf.h"
+
+# STF_CLOSE -- Close an STF format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure stf_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+pointer	stf
+errchk	close
+
+begin
+	stf = IM_KDES(im)
+
+	# Close the pixel file and header file, if open.
+	if (STF_PFD(stf) != NULL)
+	    call close (STF_PFD(stf))
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	# Deallocate the STF descirptor.
+	call mfree (IM_KDES(im), TY_STRUCT)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopy.x b/sys/imio/iki/stf/stfcopy.x
new file mode 100644
index 00000000..e8643600
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopy.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure stf_copy (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	# If the header cannot be copied, leave the pixfile alone.
+	iferr (call fcopy (Memc[ohdr_fname], Memc[nhdr_fname]))
+	    call erract (EA_WARN)
+	else iferr (call fcopy (Memc[opix_fname], Memc[npix_fname]))
+	    call erract (EA_WARN)
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopyf.x b/sys/imio/iki/stf/stfcopyf.x
new file mode 100644
index 00000000..7402c879
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopyf.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "stf.h"
+
+define	NKW	4		# number of reserved header keywords
+
+
+# STF_COPYFITS -- Copy the spooled FITS header, separating out the GPB cards
+# and returning either or both types of cards on the two output streams.
+
+procedure stf_copyfits (stf, spool, gpb, user)
+
+pointer	stf			#I pointer to STF descriptor
+int	spool			#I spooled header to read
+int	gpb			#I stream to receive GPB cards, or NULL
+int	user			#I stream to receive user cards, or NULL
+
+bool	keyword
+int	p_ch[MAX_PCOUNT+NKW]
+pointer	p_len[MAX_PCOUNT+NKW]
+pointer	p_namep[MAX_PCOUNT+NKW]
+int	delim, ch, npars, ngpbpars, i
+pointer	sp, lbuf, sbuf, pp, op, kw[NKW]
+int	strncmp(), getline(), strlen(), gstrcpy()
+errchk	getline, putline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (sbuf, SZ_LINE, TY_CHAR)
+
+	# The following reserved keywords describing the GPB are added to
+	# the user area by stf_rdheader, and must be filtered out along with
+	# the group parameters.  Since the number of reserved or group
+	# parameters is normally small (only a dozen or so typically) a
+	# simple 1 character - 2 thread hashing scheme is probably faster,
+	# and certainly simpler, than a full hash table keyword lookup.
+
+	op = sbuf
+	npars = NKW
+	kw[1] = op;  op = op + gstrcpy ("GROUPS", Memc[op], ARB) + 1
+	kw[2] = op;  op = op + gstrcpy ("GCOUNT", Memc[op], ARB) + 1
+	kw[3] = op;  op = op + gstrcpy ("PCOUNT", Memc[op], ARB) + 1
+	kw[4] = op;  op = op + gstrcpy ("PSIZE",  Memc[op], ARB) + 1
+
+	do i = 1, npars {
+	    p_namep[i] = kw[i]
+	    p_len[i] = strlen(Memc[kw[i]])
+	    p_ch[i] = Memc[kw[i]+2]
+	}
+
+	# Add the GPB parameters to the list of group related parameters.
+	ngpbpars = min (MAX_PCOUNT, STF_PCOUNT(stf))
+	do i = 1, ngpbpars {
+	    npars = npars + 1
+	    pp = STF_PDES(stf,i)
+	    p_namep[npars] = P_PTYPEP(pp)
+	    p_len[npars] = strlen(P_PTYPE(pp))
+	    p_ch[npars] = Memc[p_namep[npars]+2]
+	}
+
+	# Determine the type of each card and copy it to the appropriate
+	# output stream.
+
+	while (getline (spool, Memc[lbuf]) != EOF) {
+	    # Does this user card redefine a reserved keyword?
+	    keyword = false
+	    ch = Memc[lbuf+2]
+	    do i = 1, npars {
+		if (ch != p_ch[i])
+		    next
+		delim = Memc[lbuf+p_len[i]]
+		if (delim != ' ' && delim != '=')
+		    next
+		if (strncmp (Memc[lbuf], Memc[p_namep[i]], p_len[i]) == 0) {
+		    keyword = true
+		    break
+		}
+	    }
+
+	    # Copy the card to the appropriate stream.
+	    if (keyword) {
+		if (gpb != NULL)
+		    call putline (gpb, Memc[lbuf])
+	    } else {
+		if (user != NULL)
+		    call putline (user, Memc[lbuf])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfctype.x b/sys/imio/iki/stf/stfctype.x
new file mode 100644
index 00000000..9c48f65a
--- /dev/null
+++ b/sys/imio/iki/stf/stfctype.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_CTYPE -- Determine the type of a FITS card.  STF recognizes only those
+# cards which define the image format and the group parameter block.
+
+int procedure stf_ctype (card, index)
+
+char	card[ARB]			#I FITS card (or keyword)
+int	index				#O index number, if any
+
+int	ch1, ch2, ip
+int	strncmp(), ctoi()
+
+begin
+	ch1 = card[1]
+	ch2 = card[2]
+
+	# The set of keywords is fixed and small, so a simple brute force
+	# recognizer is about as good as anything.
+
+	if (ch1 == 'B') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "BITPIX  ", 8) == 0)
+		    return (KW_BITPIX)				# BITPIX
+	} else if (ch1 == 'D') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "DATATYPE", 8) == 0)
+		    return (KW_DATATYPE)			# DATATYPE
+	} else if (ch1 == 'E') {
+	    if (ch2 == 'N')
+		if (card[3] == 'D' && card[4] == ' ')
+		    return (KW_END)				# END card
+	} else if (ch1 == 'G') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "GCOUNT  ", 8) == 0)
+		    return (KW_GCOUNT)				# GCOUNT
+	    } else if (ch2 == 'R') {
+		if (strncmp (card, "GROUPS  ", 8) == 0)
+		    return (KW_GROUPS)				# GROUPS
+	    }
+	} else if (ch1 == 'N') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "NAXIS", 5) == 0)
+		    if (card[6] == ' ')
+			return (KW_NAXIS)			# NAXIS
+		    else if (IS_DIGIT(card[6])) {
+			index = TO_INTEG(card[6])
+			return (KW_NAXISN)			# NAXISn
+		    }
+	} else if (ch1 == 'P') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "PCOUNT  ", 8) == 0)
+		    return (KW_PCOUNT)				# PCOUNT
+	    } else if (ch2 == 'D') {
+		if (strncmp (card, "PDTYPE", 6) == 0) {
+		    ip = 7
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PDTYPE)			# PDTYPEn
+		}
+	    } else if (ch2 == 'S') {
+		if (strncmp (card, "PSIZE", 5) == 0) {
+		    ip = 6
+		    if (card[ip] == ' ')
+			return (KW_PSIZE)
+		    else if (ctoi (card, ip, index) > 0)
+			return (KW_PSIZEN)			# PSIZEn
+		}
+	    } else if (ch2 == 'T') {
+		if (strncmp (card, "PTYPE", 5) == 0) {
+		    ip = 6
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PTYPE)			# PTYPEn
+		}
+	    }
+	} else if (ch1 == 'S') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "SIMPLE  ", 8) == 0)
+		    return (KW_SIMPLE)				# SIMPLE
+	}
+
+	return (ERR)
+end
diff --git a/sys/imio/iki/stf/stfdelete.x b/sys/imio/iki/stf/stfdelete.x
new file mode 100644
index 00000000..dd319f12
--- /dev/null
+++ b/sys/imio/iki/stf/stfdelete.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_DELETE -- Delete an image.  A special operator is required since the
+# image is stored as two files.
+
+procedure stf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U header file extension
+int	status			#O return value
+
+pointer	sp
+pointer	hdr_fname, pix_fname
+int	access()
+
+begin
+	call smark (sp)
+	call salloc (hdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filename.
+	call iki_mkfname (root, extn, Memc[hdr_fname], SZ_PATHNAME)
+	call stf_mkpixfname (root, extn, Memc[pix_fname], SZ_PATHNAME)
+
+	# If the header cannot be deleted, leave the pixfile alone.
+	iferr (call delete (Memc[hdr_fname]))
+	    call erract (EA_WARN)
+	else if (access (Memc[pix_fname],0,0) == YES) {
+	    iferr (call delete (Memc[pix_fname]))
+		call erract (EA_WARN)
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfget.x b/sys/imio/iki/stf/stfget.x
new file mode 100644
index 00000000..bacbc8d7
--- /dev/null
+++ b/sys/imio/iki/stf/stfget.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_GETI -- Return the integer value of a FITS encoded card.
+
+procedure stf_geti (card, ival)
+
+char	card[ARB]		# card to be decoded
+int	ival			# receives integer value
+
+int	ip, ctoi()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# STF_GETB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure stf_getb (card, bval)
+
+char	card[ARB]		# card to be decoded
+int	bval			# receives YES/NO
+
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# STF_GETS -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure stf_gets (card, outstr, maxch)
+
+char	card[ARB]		# FITS card to be decoded
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# STF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure stf_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
diff --git a/sys/imio/iki/stf/stfhextn.x b/sys/imio/iki/stf/stfhextn.x
new file mode 100644
index 00000000..45e89f7a
--- /dev/null
+++ b/sys/imio/iki/stf/stfhextn.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+
+# STF_GETHDREXTN -- Get the default header file extension.
+
+procedure stf_gethdrextn (im, o_im, acmode, outstr, maxch)
+
+pointer	im, o_im		#I image descriptors
+int	acmode			#I access mode
+char	outstr[maxch]		#O receives header extension
+int	maxch			#I max chars out
+
+bool	inherit
+int	kernel, old_kernel
+int	fnextn(), iki_getextn(), iki_getpar()
+
+begin
+	# Use the same extension as the input file if this is a new copy
+	# image of the same type as the input and inherit is enabled.
+	# If we have to get the extension using iki_getextn, the default
+	# extension for a new image is the first extension defined (index=1).
+
+	kernel = IM_KERNEL(im)
+
+	old_kernel = 0
+	if (acmode == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	inherit = (iki_getpar ("inherit") == YES)
+	if (inherit && acmode == NEW_COPY && kernel == old_kernel) {
+	    if (fnextn (IM_HDRFILE(im), outstr, maxch) <= 0)
+		call strcpy (STF_DEFHDREXTN, outstr, maxch)
+	} else if (iki_getextn (kernel, 1, outstr, maxch) < 0)
+	    call strcpy (STF_DEFHDREXTN, outstr, maxch)
+end
diff --git a/sys/imio/iki/stf/stfiwcs.x b/sys/imio/iki/stf/stfiwcs.x
new file mode 100644
index 00000000..415b9a76
--- /dev/null
+++ b/sys/imio/iki/stf/stfiwcs.x
@@ -0,0 +1,60 @@
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_INITWCS -- Check for an unitialized WCS and set up a unitary pixel
+# WCS in this case.
+
+procedure stf_initwcs (im)
+
+pointer	im			#I image descriptor
+
+real	v
+int	ndim, i, j
+bool	have_wcs, wcsok
+char	pname[SZ_KEYWORD]
+bool	fp_equalr()
+real	imgetr()
+
+begin
+	ndim = IM_NDIM(im)
+	have_wcs = false
+	wcsok = false
+
+	# Scan the header to determine if we have any WCS information (assume
+	# there is a WCS if any CDi_j cards are found) and if it has been
+	# initialized (at least one matrix element is nonzero).  Note that
+	# we are checking only to see if the WCS has been initialized, not
+	# if it is a valid WCS.
+
+	do j = 1, ndim {
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (j)
+		ifnoerr (v = imgetr (im, pname)) {
+		    have_wcs = true
+		    if (!fp_equalr (v, 0.0)) {
+			wcsok = true
+			break
+		    }
+		}
+	    }
+	    if (wcsok)
+		break
+	}
+
+	# If we found some WCS information and the CD matrix is zero, init
+	# the WCS.
+
+	if (have_wcs && !wcsok)
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CTYPE%d")
+		    call pargi (i)
+		call imastr (im, pname, "PIXEL")
+
+		call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (i)
+		call imaddr (im, pname, 1.0)
+	    }
+end
diff --git a/sys/imio/iki/stf/stfmerge.x b/sys/imio/iki/stf/stfmerge.x
new file mode 100644
index 00000000..a98ee877
--- /dev/null
+++ b/sys/imio/iki/stf/stfmerge.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_MERGEGPB -- Merge the non-reserved parameters from an existing GPB into
+# a new GPB; called to construct a new GPB when an image is opened in new-copy
+# mode.  Since the new copy may not be the same size and dimension as the
+# original, the reserved parameters must be set up fresh for the new copy
+# image, i.e., we cannot simply copy them from the old image.  Likewise, the
+# WCS must be transformed if the new copy image does not geometrically overlay
+# the original.
+#
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_mergegpb (n_im, o_im)
+
+pointer	n_im		# new copy image
+pointer	o_im		# image being copied
+
+bool	match
+int	n_i, o_i, n, ip, axis
+int	up_psize
+pointer	sp, cd_pat, n_stf, o_stf, n_pp, o_pp
+int	strncmp(), strlen(), patmake(), patmatch(), ctoi()
+
+begin
+	call smark (sp)
+	call salloc (cd_pat, SZ_LINE, TY_CHAR)
+
+	# Make a pattern to match the CDa_b parameter names.
+	if (patmake ("CD[0-9]_[0-9]", Memc[cd_pat], SZ_LINE) < 0)
+	    ; # cannot happen
+
+	n_stf = IM_KDES(n_im)
+	o_stf = IM_KDES(o_im)
+
+	# Examine each parameter in the old GPB and make an entry for the new
+	# ones in the new GPB.  Note that all we are doing here is defining
+	# the structure; the GPB data is not physically written until the new
+	# header is updated on disk.  The FITS encoded values for the GPB
+	# parameters will already have been copied to the user area of the
+	# new image.
+
+	up_psize = 0
+	for (o_i=1;  o_i <= STF_PCOUNT(o_stf);  o_i=o_i+1) {
+	    o_pp = STF_PDES(o_stf,o_i)
+	    n = strlen (P_PTYPE(o_pp))
+
+	    if (P_PTYPE(o_pp) == 'C')
+		if (strncmp  (P_PTYPE(o_pp), "CRPIX", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CRVAL", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CTYPE", 5) == 0 ||
+		    patmatch (P_PTYPE(o_pp), Memc[cd_pat]) > 0) {
+
+		    ip = 6
+		    if (ctoi (P_PTYPE(o_pp), ip, axis) <= 0)
+			axis = IM_MAXDIM + 1
+		    if (axis <= STF_NAXIS(n_stf))
+		    	next
+		}
+
+	    # Is there a parameter of the same name in the new descriptor?
+	    match = false
+	    for (n_i=1;  n_i <= STF_PCOUNT(n_stf);  n_i=n_i+1) {
+		n_pp = STF_PDES(n_stf,n_i)
+		if (strncmp (P_PTYPE(o_pp), P_PTYPE(n_pp), n) == 0) {
+		    match = true
+		    break
+		}
+	    }
+
+	    # If there was no match for the parameter, add a definition for
+	    # it to the GPB descriptor for the new image.
+
+	    if (!match) {
+		n = STF_PCOUNT(n_stf) + 1
+		if (n > MAX_PCOUNT)
+		    call error (4, "stf_merge: too many group parameters")
+
+		STF_PCOUNT(n_stf) = n
+		up_psize = up_psize + P_PSIZE(o_pp)
+		n_pp = STF_PDES(n_stf,n)
+	
+		P_SPPTYPE(n_pp)	= P_SPPTYPE(o_pp)
+		P_PSIZE(n_pp)	= P_PSIZE(o_pp)
+		P_LEN(n_pp)	= P_LEN(o_pp)
+
+		call strcpy (P_PTYPE(o_pp), P_PTYPE(n_pp), SZ_PTYPE)
+		call strcpy (P_PDTYPE(o_pp), P_PDTYPE(n_pp), SZ_PDTYPE)
+	    }
+	}
+
+	# Moved the PSIZE, SZGROUP calculations here to fix error in the
+	# computation of PSIZE--dlb, 11/2/87
+
+	STF_PSIZE(n_stf) = STF_PSIZE(n_stf) + up_psize
+	STF_SZGROUP(n_stf) = STF_SZGROUP(n_stf) +
+	    up_psize / (SZB_CHAR * NBITS_BYTE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfmkpfn.x b/sys/imio/iki/stf/stfmkpfn.x
new file mode 100644
index 00000000..4568efd8
--- /dev/null
+++ b/sys/imio/iki/stf/stfmkpfn.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_MKPIXFNAME -- Given the root and extn fields of the image header filename,
+# construct the pixel file name.  The pixel file has the same root name as
+# the header and the first two characters of the extension are the same as for
+# the header, if a header extension was given.
+
+procedure stf_mkpixfname (hdr_root, hdr_extn, pixfname, maxch)
+
+char	hdr_root[ARB]		# root name of header file
+char	hdr_extn[ARB]		# extension of header file
+char	pixfname[maxch]		# receives pixel filename
+int	maxch
+
+int	i
+char	pix_extn[MAX_LENEXTN]
+
+begin
+	call strcpy (STF_DEFPIXEXTN, pix_extn, MAX_LENEXTN)
+	if (hdr_extn[1] != EOS) {
+	    for (i=1;  i < MAX_LENEXTN;  i=i+1)
+		pix_extn[i] = hdr_extn[i]
+	}
+
+	call iki_mkfname (hdr_root, pix_extn, pixfname, maxch)
+end
diff --git a/sys/imio/iki/stf/stfnewim.x b/sys/imio/iki/stf/stfnewim.x
new file mode 100644
index 00000000..3e8a95ed
--- /dev/null
+++ b/sys/imio/iki/stf/stfnewim.x
@@ -0,0 +1,146 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+
+# STF_NEWIMAGE -- Set up the IMIO/STF descriptor for an image opened with mode
+# new_image or new_copy of non-STF images.  Note that the parameters GROUP 
+# and GCOUNT were set earlier by stf_open().
+
+procedure stf_newimage (im)
+
+pointer	im			# image descriptor
+
+pointer	stf
+pointer	o_im
+long	totpix
+char	pname[SZ_KEYWORD]
+int	old_kernel, pixtype, bitpix, nbytes, pno, ndim, i, j
+errchk	stf_addpar
+string	zero "0"
+string	one  "1"
+
+include <szpixtype.inc>
+
+begin
+	# Get length of axes and datatype from imio descriptor;
+	# these may be changed by the user between image mapping 
+	# and first i/o to pixfile so we set up the group parameter block
+	# and size of pixfile on first i/o operation
+
+	stf = IM_KDES(im)
+	o_im = IM_OHDR(im)
+	ndim = IM_NDIM(im)
+	STF_NAXIS(stf) = ndim
+	do i = 1, ndim
+	    STF_LENAXIS(stf,i) = IM_LEN(im,i)
+
+	# Get datatype for the pixfile; stf_open has set this to datatype 
+	# of template file if it exists, otherwise defaults to real(assuming
+	# the user hasn't changed it by now)
+
+	pixtype = IM_PIXTYPE(im)
+
+	bitpix = pix_size[pixtype] * NBITS_CHAR
+	nbytes = bitpix / NBITS_BYTE
+
+	call sprintf (STF_DATATYPE(stf), SZ_DATATYPE, "%s*%d")
+	    switch (pixtype) {
+	    case TY_USHORT:
+		call pargstr ("UNSIGNED")
+	    case TY_SHORT, TY_LONG, TY_INT:
+		call pargstr ("INTEGER")
+	    case TY_REAL, TY_DOUBLE:
+		call pargstr ("REAL")
+	    case TY_COMPLEX:
+		call pargstr ("COMPLEX")
+	    default:
+		pixtype = TY_REAL
+		bitpix = SZ_REAL * NBITS_CHAR
+		nbytes = bitpix / NBITS_BYTE
+		call pargstr ("REAL")
+	    }
+	    call pargi (nbytes)
+
+	STF_BITPIX(stf) = bitpix
+
+	# Set the IMIO min/max fields.
+
+	IM_MIN(im) = 0.
+	IM_MAX(im) = 0.
+	IM_LIMTIME(im) = 0
+
+	# For a new copy image(of an already-existing file), DO NOT add group
+	# parameters to the GPB, unless the original image is not an STF
+	# image.  The following are the "standard" set of datamin/max and the
+	# FITS coordinate parms which SDAS files are supposed to have.
+
+	if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	if ((IM_ACMODE(im) == NEW_FILE) || 
+	   ((IM_ACMODE(im) == NEW_COPY) && IM_KERNEL(im) != old_kernel)) {
+
+	    # Set up the standard STF group parameter block parameters.
+	    STF_GROUPS(stf) = YES
+	    STF_PCOUNT(stf) = 2 + (ndim * 3) + (ndim * ndim)
+	    STF_PSIZE(stf) = 2 * (SZ_REAL * NBITS_CHAR) +	# DATAMIN/MAX
+		ndim * (SZ_DOUBLE * NBITS_CHAR) +		# CRVALn
+		ndim * (SZ_REAL * NBITS_CHAR) +			# CRPIXn
+		ndim * (8 * NBITS_BYTE) +			# CTYPEn
+		(ndim * ndim) * (SZ_REAL * NBITS_CHAR)		# CD matrix
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		IM_KDES(im) = stf
+	    }
+
+	    # Set up the group data block in the STF descriptor and in 
+	    # the IMIO FITS format user area.  WARNING--the STF kernel
+	    # is implicitly assuming that the GPB related parameters
+	    # in non-STF format images are at the beginning of the user
+	    # area, if they are present at all.   If this is not true
+	    # then the following code will APPEND them to the user area.
+	    # At STScI, non-STF format images are usually made from STF
+	    # images and these parameters are at the beginning of the user
+	    # area in that case.
+
+	    pno = 1
+	    call stf_addpar (im, "DATAMIN", TY_REAL, 1, zero, pno)
+	    call stf_addpar (im, "DATAMAX", TY_REAL, 1, zero, pno)
+
+	    do i = 1, ndim {
+		call sprintf (pname,  SZ_KEYWORD, "CRPIX%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CRVAL%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_DOUBLE, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CTYPE%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_CHAR, 8, "PIXEL", pno)
+
+		do j = 1, ndim {
+		    call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+			call pargi (j)
+			call pargi (i)
+		    if (i == j)
+			call stf_addpar (im, pname, TY_REAL, 1, one,  pno)
+		    else
+			call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		}
+	    }
+	}
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, ndim
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+end
diff --git a/sys/imio/iki/stf/stfopen.x b/sys/imio/iki/stf/stfopen.x
new file mode 100644
index 00000000..016c557e
--- /dev/null
+++ b/sys/imio/iki/stf/stfopen.x
@@ -0,0 +1,225 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_OPEN -- Open/create an STF group format image.
+
+procedure stf_open (kernel, im, o_im,
+	root, extn, ksection, gr_arg, gc_arg, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I other descriptor for NEW_COPY image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I NOT USED
+int	gr_arg			#I index of group to be accessed
+int	gc_arg			#I number of groups in STF image
+int	acmode			#I access mode
+int	status			#O return value
+
+bool	subimage
+pointer	sp, fname, stf, stf_extn, ua, o_stf
+int	group, gcount, newimage, gpb, hdr, o_stflen
+
+bool	fnullfile(), envgetb()
+int	open(), stropen(), access()
+errchk	stf_initwcs, fmkcopy, calloc, realloc, syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (stf_extn, MAX_LENEXTN, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+
+	# Allocate internal STF image descriptor.
+	call calloc (stf, LEN_STFDES, TY_STRUCT)
+	IM_KDES(im) = stf
+
+	group  = max (1, gr_arg)
+	gcount = max (group, gc_arg)
+
+	STF_GRARG(stf)	= max (0, gr_arg)
+	STF_GROUP(stf)  = group
+	STF_GCOUNT(stf) = gcount
+	STF_ACMODE(stf) = acmode
+	STF_PFD(stf)    = NULL
+
+	# If a nonzero gcount is specified when a new-image or new-copy image
+	# is opened (e.g., [1/10] we assume that an entire new group format
+	# image is to be created with the given group count.  If neither the
+	# group or gcount values are specified we assume that a new image is
+	# to be created.  If the gcount field is zero (e.g., [1/0] or just [1])
+	# then we assume that the image already exists and that we are being
+	# asked to rewrite the indexed image.
+
+	newimage = NO
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	    if (gc_arg > 0 || (gr_arg <= 0 && gc_arg <= 0))
+		newimage = YES
+	STF_NEWIMAGE(stf) = newimage
+
+	# Generate full header file name.
+	if (extn[1] == EOS) {
+	    call stf_gethdrextn (im, o_im, acmode, Memc[stf_extn], MAX_LENEXTN)
+	    call iki_mkfname (root, Memc[stf_extn], Memc[fname], SZ_PATHNAME)
+	    call strcpy (Memc[stf_extn], extn, MAX_LENEXTN)
+	} else
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Generate full pixel file name.
+	call stf_mkpixfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call strcpy (Memc[fname], IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	# Create and open the image header file if create a new physical
+	# image.  If opening an existing image we do not open the header file
+	# here since the header may already be in the STF header cache.
+	# Since STF header files have a weird file type on some systems (VMS)
+	# we must create a new header file with FMKCOPY rather than OPEN.
+
+	if (STF_NEWIMAGE(stf) == YES && !fnullfile (IM_HDRFILE(im))) {
+	    if (access (IM_HDRFILE(im), 0,0) == YES) {
+		subimage = (gr_arg > 0 && gr_arg <= gc_arg)
+		if (subimage || envgetb ("imclobber")) {
+		    iferr (call delete (IM_PIXFILE(im)))
+			goto err_
+		    iferr (call delete (IM_HDRFILE(im)))
+			goto err_
+		} else {
+		    call mfree (stf, TY_STRUCT)
+		    call syserrs (SYS_IKICLOB, IM_HDRFILE(im))
+		}
+	    }
+	    iferr (call fmkcopy (HDR_TEMPLATE, IM_HDRFILE(im)))
+		goto err_
+	    iferr (IM_HFD(im) = open (IM_HDRFILE(im), READ_WRITE, TEXT_FILE))
+		goto err_
+	}
+
+	# If opening an existing image, read the image header into the STF
+	# image descriptor.
+
+	switch (acmode) {
+	case NEW_IMAGE:
+	    # For group formatted images, open NEW_IMAGE can mean either
+	    # creating a new group format image, or opening a new group
+	    # within an existing group format image.  The latter case is
+	    # indicated by a group index greater than 1.  If we are creating
+	    # a new group format image, wait until the user has set up the
+	    # dimension parameters before doing anything further (in stfopix).
+
+	    if (STF_NEWIMAGE(stf) == NO)
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+	case NEW_COPY:
+	    # Make sure the FITS encoded user area we inherited is blocked.
+
+	    ### For now, always reblock the old header as the blocked flag
+	    ### does not seem to be reliable and a header with variable length
+	    ### lines can cause the header update to fail.  This should be
+	    ### fixed as a reblock of the full header is expensive.
+
+	    ### if (IM_UABLOCKED(o_im) != YES)
+		call stf_reblock (im)
+
+	    if (STF_NEWIMAGE(stf) == NO) {
+		# Open new group within existing GF image.  The FITS header and
+		# GPB structure of the image being opened must be used, but the
+		# default data values for the GPB parameters are inherited from
+		# the image being copied.
+
+		# Filter the copied user area to retain only the GPB cards.
+		# Opening the user area on two string file descriptors is a
+		# bit tricky, but will work since fixed size cards are copied,
+		# and the EOS isn't written until close time.
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    hdr = stropen (Memc[ua], ARB, READ_ONLY)
+		    gpb = stropen (Memc[ua], ARB, NEW_FILE)
+		    call stf_copyfits (IM_KDES(o_im), hdr, gpb, NULL)
+		    call close (gpb)
+		    call close (hdr)
+		}
+
+		# Read in the FITS header of the new image after the inherited
+		# GPB data cards, and set up the STF descriptor for the new GPB
+		# as defined in the new FITS header.
+
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+		# Initialize the WCS description if this is not done by the
+		# inherited user header.
+
+		call stf_initwcs (im)
+
+	    } else {
+		# Completely new copy of an existing image, which may or may
+		# not be an STF format image.  IMIO has already copied the
+		# size parameters of the old image as well as the cards in the
+		# user area of the old image (but without leaving space for
+		# the GPB cards if not an STF image).  Copy old STF descriptor
+		# if the old image is also an STF format image, to inherit
+		# GPB structure.  Wait until opix time to init the rest of the
+		# descriptor.  
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    o_stf = IM_KDES(o_im)
+		    o_stflen = LEN_STFBASE + STF_PCOUNT(o_stf) * LEN_PDES
+		    call amovi (Memi[o_stf], Memi[stf], o_stflen)
+		    STF_ACMODE(stf)   = acmode
+		    STF_GROUP(stf)    = group
+		    STF_GCOUNT(stf)   = gcount
+		    STF_NEWIMAGE(stf) = newimage
+		    STF_PFD(stf)      = NULL
+		    if (gcount > 1)
+			STF_GROUPS(stf) = YES
+		} else
+		    STF_GROUPS(stf) = YES
+
+		# Inherit datatype of input template image if specified,
+		# otherwise default datatype to real.
+
+		if (IM_PIXTYPE(o_im) != NULL)
+		    IM_PIXTYPE(im) = IM_PIXTYPE(o_im)
+		else
+		    IM_PIXTYPE(im) = TY_REAL
+	    }
+
+	default:
+	    # Open an existing group within an existing image.
+	    iferr (call stf_rdheader (im, group, acmode))
+		goto err_
+	}
+
+	# Set group number and count for the external world if this is a group
+	# format image.
+
+	if (STF_GROUPS(stf) == YES) {
+	    IM_CLINDEX(im) = STF_GROUP(stf)
+	    IM_CLSIZE(im)  = STF_GCOUNT(stf)
+	}
+
+	# Free any unneeded space in the STF descriptor.
+	if (STF_PCOUNT(stf) > 0)
+	    call realloc (stf,
+		LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+	IM_KDES(im) = stf
+	status = OK
+
+	call sfree (sp)
+	return
+err_
+	status = ERR
+	call mfree (stf, TY_STRUCT)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfopix.x b/sys/imio/iki/stf/stfopix.x
new file mode 100644
index 00000000..da353119
--- /dev/null
+++ b/sys/imio/iki/stf/stfopix.x
@@ -0,0 +1,202 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fset.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+# STF_OPIX -- Open (or create) the pixel storage file.  If the image header file
+# is `image.hhh' the associated pixel storage file will be `image.hhd' in the
+# same directory as the header file.  STF_PFD is set if the pixel file is
+# physically open.  IM_PFD is not set until we have been called by IMIO, since
+# we must be called to once set up all the descriptors, even if the pixel file
+# was already opened to read the GPB.
+#
+# dlb, 18-may-88: added code to zero out gpb's in multi-group image for groups
+#   other than current; prevents strange numbers and when later programs try to
+#   read the gpb of an otherwise uninitialized group of the image.
+# dlb, 29-dec-1988: added code to get default set of GPB parameters and
+#   correctly initialize STF-kernel descriptor.
+
+procedure stf_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+int	compress, blklen
+bool	copy_of_stf_image
+int	pfd, sz_gpb, group, i
+pointer	stf, o_stf, o_im, ua, gpb
+long	sz_pixfile, pixoff, totpix, offset
+
+int	open()
+errchk	open, fseti, falloc, seek, syserrs, imioff, calloc
+errchk	write
+
+include <szpixtype.inc>
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+	o_im	 = IM_OHDR(im)
+	stf	 = IM_KDES(im)
+	ua	 = IM_USERAREA(im)
+
+	pfd	 = STF_PFD(stf)
+	compress = YES
+	blklen   = 1
+	pixoff   = 1
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), IM_ACMODE(im), BINARY_FILE)
+
+	case NEW_COPY, NEW_FILE:
+	    # Initialize the IMIO and STF descriptors and allocate the pixel
+	    # file.
+
+	    if (STF_NEWIMAGE(stf) == YES) {
+		# Normalize IMIO header parameters for new image.
+		call imioff (im, pixoff, compress, blklen)
+
+		# Set up the required GPB parameters for the new image.
+		# Note - this call can change the STF pointer.
+
+		call stf_newimage (im)
+		stf = IM_KDES(im)
+
+		# Save the size of the old GPB user area header if we are
+		# making a new copy of an old STF format image.
+
+		copy_of_stf_image = false
+		if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+		    if (IM_KERNEL(o_im) == IM_KERNEL(im))
+			copy_of_stf_image = true
+
+		if (copy_of_stf_image) {
+		    o_stf = IM_KDES(o_im)
+		    STF_PCOUNT(stf) = STF_PCOUNT(o_stf)
+		    STF_PSIZE(stf) = STF_PSIZE(o_stf)
+		}
+
+#		Since the stf_mergegpb code below has been deactivated,
+#		there is no need to do the complex and expensive spool/copy
+# 		operation below.  (dct 1/4/90)
+#		-------------------------------
+#		# We have to have space for the GPB data cards at the beginning
+#		# of the user area, so spool any existing user cards in a
+#		# buffer and truncate the user area at the end of the GPB.
+#
+#		ua_fd = stropen (Memc[ua+sz_gpbhdr], ARB, READ_ONLY)
+#		spool = open ("opix_spool", READ_WRITE, SPOOL_FILE)
+#		call fcopyo (ua_fd, spool)
+#		call close (ua_fd)
+#		Memc[ua+sz_gpbhdr] = EOS
+#
+#		# Merge any extra GPB parameters from the old image into the
+#		# GPB structure of the new image.  The GPB data cards for
+#		# these parameters should already be in the user area.
+#		# Order the group parameters to match the ordering in the
+#		# old image.  NOTE:  since the STF now copies all relevant
+#		# GPB parameters from an old image into the new or 
+#		# generates a default standard set (in stf_newimage),
+#		# the following is no longer necessary.  Note that if we
+#		# eventually may add parameters to the GPB, these routines
+#		# will again be useful!
+#
+#		#if (copy_of_stf_image) {
+#		#    call stf_mergegpb (im, o_im)
+#		#    call stf_ordergpb (o_stf, stf)
+#		#}
+#			
+#		# Now append the spooled user header cards to the new user
+#		# area following the GPB data cards, deleting any user cards
+#		# which redefine GPB cards in the process.
+#
+#		call seek (spool, BOFL)
+#		ua_size = (IM_LENHDRMEM(im) - LEN_IMHDR) * SZ_STRUCT
+#		ua_fd = stropen (Memc[ua], ua_size, APPEND)
+#		call stf_copyfits (stf, spool, NULL, ua_fd)
+#		call close (ua_fd)
+#		call close (spool)
+#
+#		# Compute the length of the new header
+#		IM_HDRLEN(im) = LEN_IMHDR +
+#		    (strlen(Memc[ua]) + SZ_STRUCT-1) / SZ_STRUCT
+
+		# Open the new pixel storage file (preallocate space if
+		# enabled on local system).  Save the physical pathname of
+		# the pixfile in the image header, in case "imdir$" changes.
+
+		sz_pixfile = STF_SZGROUP(stf) * STF_GCOUNT(stf)
+		call falloc (IM_PIXFILE(im), sz_pixfile)
+
+		# Zero out all remaining groups of the image
+		# Open pixel file if not already open
+
+		if (STF_PFD(stf) == NULL)
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+		# Allocate a zeroed block of memory whose length is the same
+		# as that of the group parameter block
+
+		sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+		call calloc (gpb, sz_gpb, TY_CHAR)
+	
+		# Zero out every group except the current one.
+		do group = 1, STF_GCOUNT(stf) {
+		    if (group != STF_GROUP(stf)) {
+			offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+			call seek (pfd, offset)
+			call write (pfd, Memc[gpb], sz_gpb)
+		    }
+		}
+
+		# Free the block of memory.
+		call mfree (gpb, TY_CHAR)
+
+	    } else {
+		# If we are writing to a group of an existing multigroup image,
+		# verify that the important image parameters have not been
+		# changed.
+
+		if (STF_NAXIS(stf) != IM_NDIM(im))
+		    call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+		do i = 1, IM_NDIM(im)
+		    if (STF_LENAXIS(stf,i) != IM_LEN(im,i))
+			call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+
+		# Added 5/15/87--dlb to get correct size of each data portion
+		# of a group if image opened NEW_COPY and input file was a
+		# template of a different dimensionality used to get GPB.
+		# Compute the size of each group in the pixel file, in chars.
+
+		totpix = IM_LEN(im,1)
+		do i = 2, IM_NDIM(im)
+		    totpix = totpix * IM_LEN(im,i)
+
+		STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+		    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+	    }
+
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+	    # Tell IMIO where the pixels are.
+	    pixoff = (STF_GROUP(stf) - 1) * STF_SZGROUP(stf) + 1
+	    call imioff (im, pixoff, compress, blklen)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+	STF_PFD(stf) = pfd
+	IM_PFD(im)   = pfd
+end
diff --git a/sys/imio/iki/stf/stfordgpb.x b/sys/imio/iki/stf/stfordgpb.x
new file mode 100644
index 00000000..7099e106
--- /dev/null
+++ b/sys/imio/iki/stf/stfordgpb.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"stf.h"
+
+# STF_ORDERGPB -- Order the GPB, putting the group parameters in the
+# new image in the same order as in the old image.
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_ordergpb (o_stf, n_stf)
+
+pointer	o_stf			# STF descriptor of old image
+pointer n_stf			# STF descriptor of new image
+
+pointer	sp, temp_pdes, pp, o_plist, n_plist
+int	o_pcount, n_pcount, otop, ntop, op, np, offset, sz_param, pn
+bool	streq()
+
+begin
+	o_pcount = STF_PCOUNT(o_stf)
+	n_pcount = STF_PCOUNT(n_stf)
+	if (o_pcount <= 0)
+	    return
+
+	call smark (sp)
+	call salloc (temp_pdes, LEN_PDES, TY_STRUCT)
+
+	o_plist = STF_PDES(o_stf,1)
+	n_plist = STF_PDES(n_stf,1)
+	otop = (o_pcount * LEN_PDES)
+	ntop = (n_pcount * LEN_PDES)
+
+	# Search the new parameter list for a parameter with the same name
+	# as a parameter in the old parameter list.  When a match is found,
+	# move the new parameter into the same position as it is in the
+	# old parameter list.
+
+	for (op=0; op < otop; op=op+LEN_PDES)
+	    for (np=op; np < ntop; np=np+LEN_PDES)
+		if (streq (P_PTYPE(o_plist+op), P_PTYPE(n_plist+np))) {
+		    if (op != np) {
+			# Swap parameters between old and new positions
+			call amovi (Memi[n_plist+op], Memi[temp_pdes],
+			    LEN_PDES)
+			call amovi (Memi[n_plist+np], Memi[n_plist+op],
+			    LEN_PDES)
+			call amovi (Memi[temp_pdes], Memi[n_plist+np],
+			    LEN_PDES)
+		    }
+		    break
+		}
+
+	# Update the field offsets.
+	offset = 0
+	for (pn=1;  pn <= n_pcount;  pn=pn+1) {
+	    pp = STF_PDES(n_stf,pn)
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrdhdr.x b/sys/imio/iki/stf/stfrdhdr.x
new file mode 100644
index 00000000..2c11fec9
--- /dev/null
+++ b/sys/imio/iki/stf/stfrdhdr.x
@@ -0,0 +1,186 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<finfo.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RDHEADER -- Read the STF format image header for a single group into the
+# IMIO descriptor.  The standard fields are processed into the fields of the
+# descriptor.  The GPB binary parameters are encoded as FITS cards and placed
+# in the IMIO user area, followed by all extra cards in the FITS format STF
+# group header.  Note that no distinction is made between the common FITS
+# keywords and the GPB group parameters at the IMIO level and above.
+
+procedure stf_rdheader (im, group, acmode)
+
+pointer	im		# image descriptor
+int	group		# group to be accessed
+int	acmode		# access mode
+
+long	pixoff
+long	fi[LEN_FINFO]
+real	datamin, datamax
+pointer	sp, stf, lbuf, root, extn, op
+int	compress, devblksz, ival, ch, i , junk
+int	fits, fitslen, sz_userarea, sz_gpbhdr, len_hdrmem
+long	totpix, mtime, ctime
+
+real	imgetr()
+int	fnroot(), strlen(), finfo(), imaccf()
+errchk	stf_rfitshdr, stf_rgpb, open, realloc, imaddb, imaddi, imgetr
+
+include <szpixtype.inc>
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Read the FITS header, setting the values of all reserved fields
+	# in the STF descriptor and saving all the user FITS cards in the
+	# save buffer "fits".
+
+	call stf_rfitshdr (im, fits, fitslen)
+
+	# Process the reserved keywords (set in the STF descriptor) into the
+	# corresponding fields of the IMIO descriptor.
+
+        # Set group keywords if STF_GROUPS is NO (BPS 12.06.91).
+        if (STF_GROUPS(stf) == NO) {
+            STF_GCOUNT(stf) = 1
+            STF_PCOUNT(stf) = 0
+            STF_PSIZE(stf) = 0
+        }
+
+	if (acmode != NEW_COPY) {
+	    IM_NDIM(im) = STF_NAXIS(stf)		# IM_NDIM
+	    do ival = 1, IM_MAXDIM			# IM_LEN
+		IM_LEN(im,ival) = STF_LENAXIS(stf,ival)
+	}
+
+	ch = STF_DATATYPE(stf)				# IM_PIXTYPE
+	switch (STF_BITPIX(stf)) {
+	case 16:
+	    if (ch == 'U')
+		ival = TY_USHORT
+	    else
+	        ival = TY_SHORT
+	case 32:
+	    if (ch == 'R')
+		ival = TY_REAL
+	    else
+		ival = TY_LONG
+	case 64:
+	    if (ch == 'R')
+		ival = TY_DOUBLE
+	    else
+		ival = TY_COMPLEX
+	default:
+	    ival = ERR
+	}
+	IM_PIXTYPE(im) = ival
+
+	call iki_parse (IM_HDRFILE(im), Memc[root], Memc[extn])
+	call stf_mkpixfname (Memc[root], Memc[extn], IM_PIXFILE(im),
+	    SZ_IMPIXFILE)
+
+	if (finfo (IM_PIXFILE(im), fi) != ERR) {
+	    mtime = FI_MTIME(fi)
+	    ctime = FI_CTIME(fi)
+	}
+
+	IM_NBPIX(im)   = 0			# no. bad pixels
+	IM_CTIME(im)   = ctime			# creation time
+	IM_MTIME(im)   = mtime			# modify time
+	IM_LIMTIME(im) = mtime - 1		# time max/min last updated
+	IM_UABLOCKED(im) = YES			# ua cards blocked to 80 chars
+
+	IM_HISTORY(im) = EOS
+	junk = fnroot (IM_HDRFILE(im), Memc[lbuf], SZ_LINE)
+	call strupr (Memc[lbuf])
+	call sprintf (IM_TITLE(im), SZ_IMTITLE, "%s[%d/%d]")
+	    call pargstr (Memc[lbuf])
+	    call pargi (STF_GROUP(stf))
+	    call pargi (STF_GCOUNT(stf))
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, IM_NDIM(im)
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+
+	# Write GPB related cards to the beginning of the IMIO user area.
+	call imaddb (im, "GROUPS", STF_GROUPS(stf) == YES)
+	call imaddi (im, "GCOUNT", STF_GCOUNT(stf))
+	call imaddi (im, "PCOUNT", STF_PCOUNT(stf))
+	call imaddi (im, "PSIZE", STF_PSIZE(stf))
+
+	# Extract the group parameter block from the pixfile, encoding the
+	# group parameters as FITS cards and appending to the cards above.
+	# Get the values of DATAMIN and DATAMAX from the GPB so that we can
+	# update the IMIO min/max fields.
+
+	call stf_rgpb (im, group, acmode, datamin, datamax)
+
+	# Reallocate the image descriptor to allow space for the spooled user
+	# FITS cards plus a little extra for new parameters.
+
+	sz_gpbhdr = strlen (Memc[IM_USERAREA(im)])
+	sz_userarea = sz_gpbhdr + fitslen + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Append the saved FITS cards from the STF header to the user area.
+	# Any cards which redefine GPB cards were already deleted when the
+	# fits save buffer was created (we don't want the GPB cards since
+	# we already output a FITS card for each GPB parameter above).
+
+	op = IM_USERAREA(im) + sz_gpbhdr
+	call amovc (Memc[fits], Memc[op], fitslen+1)
+
+	# Set the IMIO min/max fields.  If the GPB datamin >= datamax the
+	# values are invalidated by setting IM_LIMTIME to before the image
+	# modification time.  Although datamin/datamax were returned by
+	# stg_rgpb above, we refetch the values here to pick up the values
+	# from the spooled main header in case there were no entries for
+	# these keywords in the GPB (if there are values in the GPB they
+	# will override those in the main header).
+
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	IM_MIN(im) = datamin
+	IM_MAX(im) = datamax
+	if (datamin < datamax)
+	    IM_LIMTIME(im) = IM_MTIME(im) + 1
+	else
+	    IM_LIMTIME(im) = IM_MTIME(im) - 1
+
+	# Call up IMIO set set up the remaining image header fields used to
+	# define the physical offsets of the pixels in the pixfile.
+
+	compress = YES		# do not align image lines on blocks
+	devblksz = 1		# disable all alignment
+
+	pixoff = (group - 1) * STF_SZGROUP(stf) + 1
+	call imioff (im, pixoff, compress, devblksz)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfreblk.x b/sys/imio/iki/stf/stfreblk.x
new file mode 100644
index 00000000..9519bd08
--- /dev/null
+++ b/sys/imio/iki/stf/stfreblk.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_REBLOCK -- If the user area is not blocked to fixed length records, e.g.,
+# as is possible in a new copy image, reblock it fixed length.
+
+procedure stf_reblock (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, lbuf, op, ua
+int	fd, spool, nlines, nchars, sz_userarea, len_hdrmem
+errchk	stropen, open, getline, putline, realloc, seek, fcopyo
+int	open(), stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], ARB, READ_ONLY)
+	spool = open ("rb_spool", READ_WRITE, SPOOL_FILE)
+	
+	# Reblock into a spool file, counting the lines.
+	for (nlines=0;  ;  nlines=nlines+1) {
+	    nchars = getline (fd, Memc[lbuf])
+	    if (nchars <= 0)
+		break
+
+	    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+		Memc[lbuf+op-1] = ' '
+	    Memc[lbuf+FITS_RECLEN] = '\n'
+	    Memc[lbuf+FITS_RECLEN+1] = EOS
+
+	    call putline (spool, Memc[lbuf])
+	}
+
+	call close (fd)
+
+	# Reallocate header the right size.
+	sz_userarea = nlines * (FITS_RECLEN+1) + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Move spooled data back to user area.
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], sz_userarea, NEW_FILE)
+	call seek (spool, BOFL)
+	call fcopyo (spool, fd)
+
+	call close (fd)
+	call close (spool)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrename.x b/sys/imio/iki/stf/stfrename.x
new file mode 100644
index 00000000..0d3c43fd
--- /dev/null
+++ b/sys/imio/iki/stf/stfrename.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_RENAME -- Rename an image.  A special operator is required since the image
+# is stored as two files.
+#
+# [NOTE] - Name changed to `rname' rather than `rename' to avoid a name
+# collision with the SYMTAB procedure `stfree' (first such collision!).
+
+procedure stf_rname (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	if (!streq (Memc[ohdr_fname], Memc[nhdr_fname])) {
+	    call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	    call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	    # If the header cannot be renamed, don't leave the pixfile alone.
+	    iferr (call rename (Memc[ohdr_fname], Memc[nhdr_fname]))
+		call erract (EA_WARN)
+	    else iferr (call rename (Memc[opix_fname], Memc[npix_fname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfrfits.x b/sys/imio/iki/stf/stfrfits.x
new file mode 100644
index 00000000..8ec9e9b0
--- /dev/null
+++ b/sys/imio/iki/stf/stfrfits.x
@@ -0,0 +1,266 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<finfo.h>
+include	<fset.h>
+include	"stf.h"
+
+# STF_RFITSHDR -- Read a STF FITS image header, processing all reserved GPB
+# definition keywords into the STF descriptor in the image descriptor, and
+# saving the remaining cards (excluding cards which GPB keyword names) in
+# in a save buffer.
+# 
+# This routine implements a simple cache of FITS headers.  If a given header
+# is already in the cache and the cached entry is up to date, the cached
+# spool file containing the user FITS cards and the saved STF descriptor are
+# returned immediately without need to access the header file on disk.
+# Otherwise, the new header is read into the oldest cache slot and the cached
+# entry returned in the usual fashion.  Any modifications to the header file
+# which affect the file modify date will invalidate the cached entry.  Note
+# that multiple processes may cache the same header, so it is not permitted
+# to modify the cached entry once the header file has been read.
+# 
+# The following reserved keywords are recognized:
+# 
+# 	SIMPLE BITPIX DATATYPE NAXIS* GROUPS GCOUNT PCOUNT PSIZE 
+# 	PTYPE* PDTYPE* PSIZE* 
+# 
+# All unrecognized cards, including HISTORY and COMMENT cards, blank lines,
+# and any other garbage in the header, are preserved in the user area of the
+# IMIO descriptor (i.e., in the spoolfile).  Certain of the standard reserved
+# cards (GROUPS, GCOUNT, etc.) are saved in the IMIO user area for the sake
+# of the user, although the real values of these parameters are maintained only
+# in the STF descriptor.
+
+procedure stf_rfitshdr (im, fits, fitslen)
+
+pointer	im				#I image descriptor
+pointer	fits				#O pointer to saved FITS cards
+int	fitslen				#O length of FITS save area
+
+long	fi[LEN_FINFO]
+pointer	sp, pp, stf, o_stf, lbuf, op, hdrfile
+int	in, index, nchars, spool, slot, user, i
+
+bool	streq()
+long	clktime(), fstatl()
+int	envgeti(), stf_ctype(), finfo(), getline(), open(), stropen()
+errchk	getline, putline, syserrs, open, seek, calloc, realloc
+errchk	fpathname, malloc, stf_copyfits
+
+bool	initialized			# CACHE definitions...
+bool	reload				# reload cache
+int	rf_refcount			# reference count
+int	rf_cachesize			# number of cache slots
+pointer	rf_stf[MAX_CACHE]		# STF descriptor
+int	rf_lru[MAX_CACHE]		# lowest value is oldest slot
+long	rf_time[MAX_CACHE]		# time when entry was cached
+long	rf_mtime[MAX_CACHE]		# modify time of file in cache
+int	rf_fits[MAX_CACHE]		# FITS data
+int	rf_fitslen[MAX_CACHE]		# size of data area
+char	rf_fname[SZ_PATHNAME,MAX_CACHE]	# header file pathname
+data	initialized /false/
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the header file cache on the first call.
+	if (!initialized) {
+	    rf_refcount = 0
+	    do i = 1, MAX_CACHE
+		rf_stf[i] = 0
+
+	    iferr (rf_cachesize = envgeti (ENV_STFCACHE))
+		rf_cachesize = DEF_CACHE
+	    if (rf_cachesize > MAX_CACHE) {
+		call eprintf ("A maximum of %d STF headers may be cached\n")
+		    call pargi (MAX_CACHE)
+		rf_cachesize = MAX_CACHE
+	    } else if (rf_cachesize <= 0)
+		rf_cachesize = 0
+		
+	    initialized = true
+	}
+
+	rf_refcount = rf_refcount + 1
+	o_stf = IM_KDES(im)
+	reload = false
+	slot = 1
+
+	# Get file system info on the desired header file.
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	if (finfo (Memc[hdrfile], fi) == ERR)
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+	repeat {
+	    # Search the header file cache for the named image.
+	    do i = 1, max(1,rf_cachesize) {
+		if (rf_stf[i] == NULL) {
+		    slot = i
+		    next
+		}
+
+		if (streq (Memc[hdrfile], rf_fname[1,i])) {
+		    # File is in cache; is cached entry still valid?
+		    if (FI_MTIME(fi) != rf_mtime[i]) {
+			# File modify date has changed, reuse slot.
+			slot = i
+			break
+
+		    } else if (!reload && clktime(rf_time[i]) < 2) {
+			# The file modify date has not changed, but the cache
+			# was loaded within the last clock "tick" (second),
+			# so we cannot be sure that the file was not modified.
+			# The cache must be reloaded, but set a flag so that
+			# rf_time is not changed, so that when the cache entry
+			# ages sufficiently it will be considered valid.
+
+			reload = true
+			slot = i
+			break
+
+		    } else {
+			# Return the cached header.
+			rf_lru[i] = rf_refcount
+			call amovi (STF_CACHE(rf_stf[i]), STF_CACHE(o_stf),
+			    STF_CACHELEN(rf_stf[i]))
+			fits = rf_fits[i]
+			fitslen = rf_fitslen[i]
+
+			# Invalidate entry if cache is disabled.
+			if (rf_cachesize <= 0)
+			    rf_time[i] = 0
+
+			call sfree (sp)
+			return 				# IN CACHE
+		    }
+
+		} else {
+		    # Keep track of least recently used slot.
+		    if (rf_lru[i] < rf_lru[slot])
+			slot = i
+		}
+	    }
+
+	    # Either the image header is not in the cache, or the cached
+	    # entry is invalid.  Prepare the given cache slot and read the
+	    # header into it.
+
+	    # Free old save buffer and descriptor.
+	    if (rf_stf[slot] != NULL) {
+		call mfree (rf_stf[slot], TY_STRUCT)
+		call mfree (rf_fits[slot], TY_CHAR)
+	    }
+
+	    # Open the header file.
+	    if (IM_HFD(im) == NULL)
+		in = open (Memc[hdrfile], READ_ONLY, TEXT_FILE)
+	    else {
+		in = IM_HFD(im)
+		call seek (in, BOFL)
+	    }
+
+	    # Allocate a spool file for the FITS data.
+	    call sprintf (rf_fname[1,slot], SZ_PATHNAME, "STFHC#%d")
+		call pargi (slot)
+	    spool = open (rf_fname[1,slot], READ_WRITE, SPOOL_FILE)
+	    call fseti (spool, F_BUFSIZE, FI_SIZE(fi))
+
+	    # Allocate cache version of STF descriptor.
+	    call calloc (stf, LEN_STFDES, TY_STRUCT)
+
+	    # Initialize the cache entry.
+	    call strcpy (Memc[hdrfile], rf_fname[1,slot], SZ_PATHNAME)
+	    rf_stf[slot] = stf
+	    rf_lru[slot] = rf_refcount
+	    rf_mtime[slot] = FI_MTIME(fi)
+	    if (!reload)
+		rf_time[slot] = clktime (0)
+	    reload = true
+
+	    # Read successive lines of the FITS header.  Process reserved
+	    # keywords into the STF descriptor and spool the remaining cards
+	    # to the fits spool file.
+
+	    repeat {
+		# Get the next input line.
+		nchars = getline (in, Memc[lbuf])
+		if (nchars == EOF)
+		    break
+
+		# Block it out to 80 chars (plus newline) if it is not already.
+		if (nchars != FITS_RECLEN + 1) {
+		    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+			Memc[lbuf+op-1] = ' '
+		    Memc[lbuf+FITS_RECLEN]   = '\n'
+		    Memc[lbuf+FITS_RECLEN+1] = EOS
+		}
+		    
+		# Process the header card.
+		switch (stf_ctype (Memc[lbuf], index)) {
+		case KW_BITPIX:
+		    call stf_geti (Memc[lbuf], STF_BITPIX(stf))
+		case KW_DATATYPE:
+		    call stf_gets (Memc[lbuf], STF_DATATYPE(stf), SZ_DATATYPE)
+		case KW_END:
+		    break
+		case KW_GCOUNT:
+		    call stf_geti (Memc[lbuf], STF_GCOUNT(stf))
+		case KW_GROUPS:
+		    call stf_getb (Memc[lbuf], STF_GROUPS(stf))
+		case KW_NAXIS:
+		    call stf_geti (Memc[lbuf], STF_NAXIS(stf))
+		case KW_NAXISN:
+		    call stf_geti (Memc[lbuf], STF_LENAXIS(stf,index))
+		case KW_PCOUNT:
+		    call stf_geti (Memc[lbuf], STF_PCOUNT(stf))
+		case KW_PDTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PDTYPE(pp), SZ_PDTYPE)
+		case KW_PSIZE:
+		    call stf_geti (Memc[lbuf], STF_PSIZE(stf))
+		case KW_PSIZEN:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_geti (Memc[lbuf], P_PSIZE(pp))
+		case KW_PTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PTYPE(pp), SZ_PTYPE)
+		    call stf_getcmt (Memc[lbuf], P_COMMENT(pp), SZ_COMMENT)
+		case KW_SIMPLE:
+		    ;
+		default:
+		    call putline (spool, Memc[lbuf])
+		}
+	    }
+
+	    # Close the header file if opened locally.
+	    if (IM_HFD(im) == NULL)
+		call close (in)
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		rf_stf[slot] = stf
+	    }
+
+	    # Filter the spooled FITS cards to delete any cards which redefine
+	    # GPB keywords.  Store the filtered FITS data in the cache.
+
+	    call seek (spool, BOFL)
+	    nchars = fstatl (spool, F_FILESIZE)
+	    call malloc (fits, nchars, TY_CHAR)
+	    user = stropen (Memc[fits], nchars, NEW_FILE)
+	    call stf_copyfits (stf, spool, NULL, user)
+
+	    rf_fits[slot] = fits
+	    rf_fitslen[slot] = fstatl (user, F_FILESIZE)
+	    call close (user)
+	    call close (spool)
+	}
+end
diff --git a/sys/imio/iki/stf/stfrgpb.x b/sys/imio/iki/stf/stfrgpb.x
new file mode 100644
index 00000000..15c4da0a
--- /dev/null
+++ b/sys/imio/iki/stf/stfrgpb.x
@@ -0,0 +1,179 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RGPB -- Read the group data block into the first few cards of the user
+# area of the IMIO image header.  The GPB is stored as a binary data structure
+# in the STF pixfile.  The values of the standard GPB parameters DATAMIN and
+# DATAMAX are returned as output arguments.
+#
+# DLB--11/03/87: Made changes to allow i*2 and i*4 integer parameters in GPB.
+# DLB--11/11/87: Changed calculation of character string length in GPB to
+# avoid integer truncation error by using P_PSIZE directly.
+
+procedure stf_rgpb (im, group, acmode, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+int	acmode			# image access mode
+real	datamin, datamax	# min,max pixel values from GPB
+
+real	rval
+double	dval
+short	sval
+long	lval, offset
+bool	bval, newgroup
+pointer	sp, stf, gpb, lbuf, pp
+int	pfd, pn, sz_param, sz_gpb
+errchk	imaddb, imadds, imaddl, imaddr, imaddd, imastr
+errchk	imputd, impstr, open, read
+int	open(), read(), imaccf()
+real	imgetr()
+
+string	readerr "cannot read group data block - no such group?"
+string	badtype "illegal group data parameter datatype"
+string	nogroup "group index out of range"
+define	minmax_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Verify that the given group exists.
+	if (group < 1 || group > STF_GCOUNT(stf))
+	    call error (1, nogroup)
+
+	# Skip ahead if there is no group parameter block.
+	if (STF_PSIZE(stf) == 0)
+	    goto minmax_
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    iferr {
+		if (IM_ACMODE(im) == READ_ONLY)
+		    pfd = open (IM_PIXFILE(im), READ_ONLY, BINARY_FILE)
+		else
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+		STF_PFD(stf) = pfd
+	    } then {
+		call eprintf ("Warning: Cannot open pixfile to read GPB (%s)\n")
+		    call pargstr (IM_NAME(im))
+		pfd = NULL
+	    }
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Read the GPB into a buffer.  The GPB is located at the very end of
+	# the data storage area for the group.  If we are opening a new,
+	# uninitialized group (acmode = new_image or new_copy), do not
+	# physically read the GPB as it is will be uninitialized data.
+
+	newgroup = (acmode == NEW_IMAGE || acmode == NEW_COPY || pfd == NULL)
+	if (newgroup)
+	    call aclrc (Memc[gpb], sz_gpb)
+	else {
+	    offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	    call seek (pfd, offset)
+	    if (read (pfd, Memc[gpb], sz_gpb) != sz_gpb)
+		call error (1, readerr)
+	}
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+		
+	    # Fill in the unitialized fields of the GPB parameter descriptor.
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+
+	    switch (P_PDTYPE(pp)) {
+	    # changed case for int to short and long--dlb 11/3/87
+	    case 'I':
+		if (sz_param == SZ_SHORT)
+		    P_SPPTYPE(pp) = TY_SHORT
+		else
+		    P_SPPTYPE(pp) = TY_LONG
+		P_LEN(pp) = 1
+	    case 'R':
+		if (sz_param == SZ_REAL)
+		    P_SPPTYPE(pp) = TY_REAL
+		else
+		    P_SPPTYPE(pp) = TY_DOUBLE
+		P_LEN(pp) = 1
+	    case 'C':
+		P_SPPTYPE(pp) = TY_CHAR
+		# calculate length directly from PSIZE to avoid truncation error
+		P_LEN(pp) = min (SZ_LINE, P_PSIZE(pp) / NBITS_BYTE)
+	    case 'L':
+		P_SPPTYPE(pp) = TY_BOOL
+		P_LEN(pp) = 1
+	    default:
+		call error (1, badtype)
+	    }
+
+	    # Extract the binary parameter value and add a FITS encoded card
+	    # to the IMIO user area.  In the case of a new copy image, the
+	    # GPB values will already be in the image header, do not modify
+	    # the parameter value, but add the parameter if it was not
+	    # inherited from the old image.
+
+	    if (acmode != NEW_COPY || imaccf (im, P_PTYPE(pp)) == NO) {
+		switch (P_SPPTYPE(pp)) {
+		case TY_BOOL:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], bval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], bval, SZ_BOOL)
+		    call imaddb (im, P_PTYPE(pp), bval)
+		case TY_SHORT:
+		    call amovc (Memc[gpb+offset], sval, SZ_SHORT)
+		    call imadds (im, P_PTYPE(pp), sval)
+		case TY_LONG:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], lval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], lval, SZ_LONG)
+		    call imaddl (im, P_PTYPE(pp), lval)
+		case TY_REAL:
+		    call amovc (Memc[gpb+offset], rval, SZ_REAL)
+		    call imaddr (im, P_PTYPE(pp), rval)
+		case TY_DOUBLE:
+		    call amovc (Memc[gpb+offset], dval, SZ_DOUBLE)
+		    call imaddd (im, P_PTYPE(pp), dval)
+		case TY_CHAR:
+		    call chrupk (Memc[gpb+offset], 1, Memc[lbuf], 1, P_LEN(pp))
+		    Memc[lbuf+P_LEN(pp)] = EOS
+		    call imastr (im, P_PTYPE(pp), Memc[lbuf])
+		default:
+		    call error (1, badtype)
+		}
+	    }
+
+	    offset = offset + sz_param
+	}
+
+minmax_
+	# Return DATAMIN, DATAMAX.  This is done by searching the user area so
+	# that ordinary keywords may be used to set datamin and datamax if the
+	# GPB is not used.
+
+	datamin = 0.0; datamax = 0.0
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfupdhdr.x b/sys/imio/iki/stf/stfupdhdr.x
new file mode 100644
index 00000000..a4519c24
--- /dev/null
+++ b/sys/imio/iki/stf/stfupdhdr.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_UPDHDR -- Update the STF/GEIS format image header.
+
+procedure stf_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+pointer	stf
+int	acmode
+real	datamin, datamax
+errchk	imerr, imputr, stf_wgpb
+
+begin
+	acmode = IM_ACMODE(im)
+	status = OK
+	stf    = IM_KDES(im)
+
+	if (acmode == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	# Compute the values of DATAMIN and DATAMAX.
+	if (IM_LIMTIME(im) == 0 || IM_LIMTIME(im) < IM_MTIME(im)) {
+	    datamin = 0.
+	    datamax = 0.
+	} else {
+	    datamin = IM_MIN(im)
+	    datamax = IM_MAX(im)
+	}
+
+	# Update the group parameter block.
+	call stf_wgpb (im, STF_GROUP(stf), datamin, datamax)
+
+#	# Update the FITS header file, unless we are writing to a new group
+#	# in an existing group format image, in which case only the GPB is
+#	# updated.
+#
+#	if (acmode != NEW_IMAGE && acmode != NEW_COPY)
+#	    call stf_wfitshdr (im)
+#	else if (STF_NEWIMAGE(stf) == YES)
+#	    call stf_wfitshdr (im)
+
+	# The new strategy for FITS header updates is to always update, unless
+	# we are explicitly updating an existing group of a multigroup image.
+	# Hence, the FITS header is always updated for an STF image with only
+	# one group, or when writing the first group of a new STF imagefile.
+	# The FITS header of an existing STF multigroup image can still be
+	# updated, but only if the image is not opened to any particular group,
+	# e.g., as "pix" rather than "pix[n]", N > 0.  NEW_[IMAGE|COPY] or
+	# READ_WRITE access to "pix[n]" will update only the GPB header.
+
+	if (STF_NEWIMAGE(stf)==YES || STF_GCOUNT(stf)<=1 || STF_GRARG(stf)==0)
+	    call stf_wfitshdr (im)
+end
diff --git a/sys/imio/iki/stf/stfwfits.x b/sys/imio/iki/stf/stfwfits.x
new file mode 100644
index 00000000..c444a235
--- /dev/null
+++ b/sys/imio/iki/stf/stfwfits.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	"stf.h"
+
+# STF_WFITSHDR -- Update the FITS header file.  This is done by writing an
+# entire new header file and then replacing the old header file with the
+# new one.  This is necessary since the header file is a text file and text
+# files cannot be randomly updated.
+
+procedure stf_wfitshdr (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, fname, lbuf, stf, pp
+int	in, out, pn, junk, i, width
+
+bool	fnullfile()
+int	stropen(), open(), protect(), strlen() #ditto-dlb
+errchk	fmkcopy, open, stropen, fcopyo, fprintf
+
+begin
+	if (fnullfile (IM_HDRFILE(im)))
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Open a new header file with a unique, temporary name.  Make a copy
+	# of the template file rather than of the old header file.  Since
+	# we also block header lines out to 80 chars automatically, this
+	# means that we can read any old text file but will always generate
+	# a new header file of the standard type when the header is updated.
+
+	call mktemp (IM_HDRFILE(im), Memc[fname], SZ_FNAME)
+	call fmkcopy (HDR_TEMPLATE, Memc[fname])
+	out = open (Memc[fname], APPEND, TEXT_FILE)
+
+	# Write out the standard, reserved header parameters.
+
+	call fprintf (out, "SIMPLE  =%21s /%81t\n")
+	    call pargstr ("F")
+	call fprintf (out, "BITPIX  =%21d /%81t\n")
+	    call pargi (STF_BITPIX(stf))
+
+	# We want to get the full string length or 8 characters, 
+	# whichever is greater--6/25/87, dlb
+	
+	call fprintf (out, "DATATYPE= '%*.*s'%32t/%81t\n")
+	    width = max(8, strlen(STF_DATATYPE(STF)))
+	    call pargi (-width) # force left-justified field
+	    call pargi (width)
+	    call pargstr (STF_DATATYPE(stf))
+
+	call fprintf (out, "NAXIS   =%21d /%81t\n")
+	    call pargi (STF_NAXIS(stf))
+	do i = 1, STF_NAXIS(stf) {
+	    call fprintf (out, "NAXIS%d%9t=%21d /%81t\n")
+		call pargi (i)
+		call pargi (STF_LENAXIS(stf,i))
+	}
+
+	call fprintf (out, "GROUPS  =%21s /%81t\n")
+	    if (STF_GROUPS(stf) == YES)
+		call pargstr ("T")
+	    else
+		call pargstr ("F")
+
+	# Changed order of the following three cards to conform
+	# to SOGS expectations--dlb, 7/14/87
+	# Only write group keywords if STF_GROUPS is YES (BPS 12.06.91)
+
+	if (STF_GROUPS(stf) == YES) {
+	    call fprintf (out, "GCOUNT  =%21d /%81t\n")
+		call pargi (STF_GCOUNT(stf))
+	    call fprintf (out, "PCOUNT  =%21d /%81t\n")
+		call pargi (STF_PCOUNT(stf))
+	    call fprintf (out, "PSIZE   =%21d /%81t\n")
+		call pargi (STF_PSIZE(stf))
+	}
+
+	# Add cards defining the fields of the group parameter block.  Each
+	# field requires three cards.
+
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+
+	    # PTYPE MUST be 8 characters or less.
+	    call fprintf (out, "PTYPE%d%9t= '%-8.8s'%32t/%s%81t\n")
+		call pargi (pn)
+		call pargstr (P_PTYPE(pp))
+		call pargstr (P_COMMENT(pp))
+
+	    # Need width for string--6/26/87, dlb
+	    call fprintf (out, "PDTYPE%d%9t= '%-*.*s'%32t/%81t\n")
+		call pargi (pn)
+		width = max (8, strlen(P_PDTYPE(pp)))
+		call pargi (-width) # force left-justified field
+		call pargi (width)
+		call pargstr (P_PDTYPE(pp))
+
+	    call fprintf (out, "PSIZE%d%9t=%21d /%81t\n")
+		call pargi (pn)
+		call pargi (P_PSIZE(pp))
+	}
+
+	# Add the contents of the IMIO user area, excluding the cards used
+	# to represent GPB parameters.
+
+	in = stropen (Memc[IM_USERAREA(im)], ARB, READ_ONLY)
+	call stf_copyfits (stf, in, NULL, out)
+	call close (in)
+
+	# End of FITS header.
+	call fprintf (out, "END%81t\n")
+	call close (out)
+
+	# Replace the original header file with the new one, even if the
+	# original header is a protected file.  Transfer any file protection
+	# to the new file.
+
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	if (protect (IM_HDRFILE(im), QUERY_PROTECTION) == YES) {
+	    iferr (junk = protect (IM_HDRFILE(im), REMOVE_PROTECTION))
+		call erract (EA_ERROR)
+	    iferr (junk = protect (Memc[fname], SET_PROTECTION))
+		call erract (EA_ERROR)
+	}
+
+	iferr (call delete (IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+	iferr (call rename (Memc[fname], IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+
+	if (IM_HFD(im) != NULL)
+	    IM_HFD(im) = open (IM_HDRFILE(im), READ_ONLY, TEXT_FILE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfwgpb.x b/sys/imio/iki/stf/stfwgpb.x
new file mode 100644
index 00000000..3a9e8fe8
--- /dev/null
+++ b/sys/imio/iki/stf/stfwgpb.x
@@ -0,0 +1,174 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_WGPB -- Write the group parameter block data back into the pixel file.
+# The GPB is described by a structure member list in the STF descriptor.
+# The values of the GPB parameters are encoded as FITS cards in the user
+# area of the IMIO descriptor.
+#
+# DLB--11/3/87: Made changes to allow i*2 and i*4 integer parameters in gpb.
+
+procedure stf_wgpb (im, group, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+real	datamin, datamax	# new min, max pixel values
+
+long	offset
+pointer	sp, stf, gpb, lbuf, pp, op
+int	pfd, pn, sz_param, sz_gpb, i
+
+int	open(), strlen()
+bool	bval, imgetb()
+# changed to short and long for short integers in gpb
+short	sval, imgets()
+long	lval, imgetl()
+#
+real	rval, imgetr()
+double	dval, imgetd()
+errchk	open, seek
+int	imaccf()
+
+string	writerr "cannot update group parameter block"
+string	badtype "illegal group data parameter datatype"
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Not all images have group parameter blocks.
+	if (STF_PSIZE(stf) == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+	    STF_PFD(stf) = pfd
+	}
+
+	# Update the values of DATAMIN, DATAMAX.
+	if (imaccf (im, "DATAMIN") == YES && 
+            imaccf (im, "DATAMAX") == YES) {
+
+	    iferr {
+	        call imputr (im, "DATAMIN", datamin)
+	        call imputr (im, "DATAMAX", datamax)
+	    } then
+	        call erract (EA_WARN)
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+	    op = gpb + offset
+
+	    # Fetch the value of the parameter from IMIO and write it into
+	    # the GPB binary data structure.
+
+	    switch (P_SPPTYPE(pp)) {
+	    case TY_BOOL:
+		iferr (bval = imgetb (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    bval = false
+		}
+		# Memb[(op-1)/SZ_BOOL+1] = bval
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (bval, bval, 1)
+		    call amovc (bval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (bval, Memc[op], SZ_BOOL)
+
+	    # changed case for int to short and long 
+	    # to allow i*2 in gpb--dlb 11/3/87
+	    case TY_SHORT:
+		iferr (sval = imgets (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    sval = 0
+		}
+		call amovc (sval, Memc[op], SZ_SHORT)
+
+	    case TY_LONG:
+		iferr (lval = imgetl (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    lval = 0
+		}
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (lval, lval, 1)
+		    call amovc (lval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (lval, Memc[op], SZ_LONG)
+
+	    case TY_REAL:
+		iferr (rval = imgetr (im, P_PTYPE(pp))) {
+		    # Currently with MWCS, WCS cards such as CRVAL, CDi_j,
+		    # etc. (always type real or double) are omitted from the
+		    # header if their value is zero.  Hence if the card is
+		    # missing assume a value of zero rather than issue a
+		    # warning.
+
+		    # call erract (EA_WARN)
+		    rval = 0.0
+		}
+		# Memr[(op-1)/SZ_REAL+1] = rval
+		call amovc (rval, Memc[op], SZ_REAL)
+
+	    case TY_DOUBLE:
+		iferr (dval = imgetd (im, P_PTYPE(pp))) {
+		    # Skip warning as assume zero, as above or TY_REAL.
+		    # call erract (EA_WARN)
+		    dval = 0.0D0
+		}
+		# Memd[(op-1)/SZ_DOUBLE+1] = dval
+		call amovc (dval, Memc[op], SZ_DOUBLE)
+
+	    case TY_CHAR:
+		# Blank fill the string buffer.
+		do i = 1, P_LEN(pp)
+		    Memc[lbuf+i-1] = ' '
+
+		# Fetch the string value of the parameter.
+		iferr (call imgstr (im, P_PTYPE(pp), Memc[lbuf], SZ_LINE))
+		    call erract (EA_WARN)
+
+		# Replace the EOS delimiter by a blank.
+		i = strlen (Memc[lbuf])
+		Memc[lbuf+i] = ' '
+
+		# Pack the blank filled array into the GPB.
+		call chrpak (Memc[lbuf], 1, Memc[gpb+offset], 1, P_LEN(pp))
+
+	    default:
+		call error (1, badtype)
+	    }
+
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	# Write the GPB into the pixfile.  The GPB is located at the very end
+	# of the data storage area for the group.
+
+	offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	call seek (pfd, offset)
+	iferr (call write (pfd, Memc[gpb], sz_gpb))
+	    call error (5, writerr)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/imaccess.x b/sys/imio/imaccess.x
new file mode 100644
index 00000000..cc6d450e
--- /dev/null
+++ b/sys/imio/imaccess.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+
+# IMACCESS -- Test if an image exists and is accessible with the given access
+# mode.  If the access mode given is NEW_IMAGE, test if the image name given
+# is legal (has a legal extension, i.e., type).  YES is returned if the named
+# image exists, NO if no image exists with the given name, and ERR if the
+# image name is ambiguous (multiple images, e.g. of different types, exist
+# with the same name).
+
+int procedure imaccess (image, acmode)
+
+char	image[ARB]		# image name
+int	acmode			# access mode
+
+int	exists, cl_index, cl_size, mode, status
+pointer	sp, cluster, ksection, section, root, extn, im
+int	iki_access()
+errchk	syserrs
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (cluster, SZ_PATHNAME, TY_CHAR)
+	call salloc (ksection, SZ_FNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+	call salloc (root, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	call iki_init()
+
+	call imparse (image,
+	    Memc[cluster], SZ_PATHNAME,
+	    Memc[ksection], SZ_FNAME,
+	    Memc[section], SZ_FNAME, cl_index, cl_size)
+
+	# If an image section, kernel section, or cluster index was specified
+	# we must actually attempt to open the image to determine if the
+	# object specified by the full notation exists, otherwise we can just
+	# call the IKI access function to determine if the cluster exists.
+
+	if (Memc[section] != EOS || Memc[ksection] != EOS || cl_index >= 0) {
+	    mode = acmode
+	    if (acmode == 0)
+		mode = READ_ONLY
+	    iferr (im = immap (image, mode, 0))
+		exists = NO
+	    else {
+		exists = YES
+		call imunmap (im)
+	    }
+	} else {
+	    status = iki_access (image, Memc[root], Memc[extn], acmode)
+	    if (status > 0)
+		exists = YES
+	    else if (status == 0)
+		exists = NO
+	    else
+		call syserrs (SYS_IKIAMBIG, image)
+	}
+
+	call sfree (sp)
+	return (exists)
+end
diff --git a/sys/imio/imaflp.x b/sys/imio/imaflp.x
new file mode 100644
index 00000000..27aa64c1
--- /dev/null
+++ b/sys/imio/imaflp.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAFLP -- Flip a vector end for end.  Optimized for the usual pixel types.
+# Pretty slow for DOUBLE and COMPLEX on byte machines, but it is not worth
+# optimizing for those cases.
+
+procedure imaflp (a, npix, sz_pixel)
+
+char	a[ARB], temp
+int	npix, sz_pixel
+int	i, left, right, pixel
+
+begin
+	switch (sz_pixel) {
+	case SZ_SHORT:
+	    call imflps (a, npix)
+	case SZ_LONG:
+	    call imflpl (a, npix)
+
+	default:				# flip odd sized elements
+	    left = 1
+	    right = ((npix-1) * sz_pixel) + 1
+
+	    do pixel = 1, (npix + 1) / 2 {
+		do i = 0, sz_pixel-1 {
+		    temp = a[right+i]
+		    a[right+i] = a[left+i]
+		    a[left+i] = temp
+		}
+		left = left + sz_pixel
+		right = right - sz_pixel
+	    }
+	}
+end
+
+
+# IMFLPS -- Flip an array of SHORT sized elements.
+
+procedure imflps (a, npix)
+
+short	a[npix], temp
+int	npix, i, right
+
+begin
+	right = npix + 1
+
+	do i = 1, (npix + 1) / 2 {
+	    temp = a[right-i]
+	    a[right-i] = a[i]
+	    a[i] = temp
+	}
+end
+
+
+# IMFLPL -- Flip an array of LONG sized elements.
+
+procedure imflpl (a, npix)
+
+long	a[npix], temp
+int	npix, i, right
+
+begin
+	right = npix + 1
+
+	do i = 1, (npix + 1) / 2 {
+	    temp = a[right-i]
+	    a[right-i] = a[i]
+	    a[i] = temp
+	}
+end
diff --git a/sys/imio/imaplv.x b/sys/imio/imaplv.x
new file mode 100644
index 00000000..36a1f315
--- /dev/null
+++ b/sys/imio/imaplv.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMAPLV -- Transform the logical vector LV (which references an image section)
+# into a physical vector (which references the physical image).
+
+procedure imaplv (im, lv, pv, ndim)
+
+pointer	im
+long	lv[ndim], pv[IM_MAXDIM]
+int	ndim
+int	loff		# logical offset (subscript)
+int	nldims		# number of logical dimensions
+int	i, j		# i = logical dim index, j = physical dim index
+
+begin
+	i = 1
+	nldims = min (IM_NDIM(im), ndim)
+
+	do j = 1, IM_NPHYSDIM(im) {
+	    if (i <= nldims && IM_VMAP(im,i) == j) {
+		loff = lv[i]
+		i = i + 1
+	    } else
+		loff = 1
+	    pv[j] = IM_VOFF(im,j) + IM_VSTEP(im,j) * loff
+	}
+end
diff --git a/sys/imio/imbln1.x b/sys/imio/imbln1.x
new file mode 100644
index 00000000..60b40c0c
--- /dev/null
+++ b/sys/imio/imbln1.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMBLN1 -- Get the length of the axes of a one dimensional subraster.
+# Must be called immediately after the get or put call that created the
+# buffer.
+
+procedure imbln1 (imdes, nx)
+
+pointer	imdes
+int	nx
+pointer	bdes
+
+begin
+	# Get pointer to most recently used buffer descriptor.
+	bdes = IM_LASTBDES(imdes)
+
+	nx = abs (BD_VE(bdes,1) - BD_VS(bdes,1)) + 1
+end
diff --git a/sys/imio/imbln2.x b/sys/imio/imbln2.x
new file mode 100644
index 00000000..034a1a45
--- /dev/null
+++ b/sys/imio/imbln2.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMBLN2 -- Get the length of the axes of a two dimensional subraster.
+# Must be called immediately after the get or put call that created the
+# buffer.
+
+procedure imbln2 (imdes, nx, ny)
+
+pointer	imdes
+int	nx, ny
+int	i, v[2]
+pointer	bdes
+
+begin
+	# Get pointer to most recently used buffer descriptor.
+	bdes = IM_LASTBDES(imdes)
+
+	do i = 1, 2
+	    v[i] = abs (BD_VE(bdes,i) - BD_VS(bdes,i)) + 1
+
+	nx = v[1]
+	ny = v[2]
+end
diff --git a/sys/imio/imbln3.x b/sys/imio/imbln3.x
new file mode 100644
index 00000000..8f734ce7
--- /dev/null
+++ b/sys/imio/imbln3.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMBLN3 -- Get the length of the axes of a three dimensional subraster.
+# Must be called immediately after the get or put call that created the
+# buffer.
+
+procedure imbln3 (imdes, nx, ny, nz)
+
+pointer	imdes
+int	nx, ny, nz
+int	i, v[3]
+pointer	bdes
+
+begin
+	# Get pointer to most recently used buffer descriptor.
+	bdes = IM_LASTBDES(imdes)
+
+	do i = 1, 3
+	    v[i] = abs (BD_VE(bdes,i) - BD_VS(bdes,i)) + 1
+
+	nx = v[1]
+	ny = v[2]
+	nz = v[3]
+end
diff --git a/sys/imio/imbtran.x b/sys/imio/imbtran.x
new file mode 100644
index 00000000..bf3ec201
--- /dev/null
+++ b/sys/imio/imbtran.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMBTRAN -- Transform a point (x,y), possibly lying outside the boundary of
+# the N-dimensional image, back into the image using the current boundary
+# extension technique.
+
+procedure imbtran (im, v1, v2, ndim)
+
+pointer	im			# image descriptor
+long	v1[IM_MAXDIM]		# input, out of bounds point
+long	v2[IM_MAXDIM]		# transformed point (output)
+int	ndim			# number of dimensions to transform
+
+int	i
+long	vin, vmax
+
+begin
+	switch (IM_VTYBNDRY(im)) {
+	case BT_NEAREST:
+	    do i = 1, ndim {
+		vmax = IM_SVLEN(im,i)
+		vin  = v1[i]
+
+		if (vin < 1)
+		    v2[i] = 1
+		else if (vin > vmax)
+		    v2[i] = vmax
+		else
+		    v2[i] = vin
+	    }
+
+	case BT_REFLECT:
+	    do i = 1, ndim {
+		vmax = IM_SVLEN(im,i)
+		vin  = v1[i]
+
+		if (vin < 1)
+		    v2[i] = 1 + (1 - vin)
+		else if (vin > vmax)
+		    v2[i] = vmax - (vin - vmax)
+		else
+		    v2[i] = vin
+	    }
+
+	case BT_WRAP:
+	    do i = 1, ndim {
+		vmax = IM_SVLEN(im,i)
+		vin  = v1[i]
+
+		while (vin < 1)
+		    vin = vin + vmax
+		while (vin > vmax)
+		    vin = vin - vmax
+		v2[i] = vin
+	    }
+
+	default:
+	    do i = 1, ndim
+		v2[i] = v1[i]
+	}
+end
diff --git a/sys/imio/imcopy.x b/sys/imio/imcopy.x
new file mode 100644
index 00000000..da7c8b57
--- /dev/null
+++ b/sys/imio/imcopy.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMCOPY -- Fast copy of an entire image.  No fancy sections, type conversions,
+# etc. are permitted if this is used.
+
+procedure imcopy (old, new)
+
+char	old[ARB]	# old image
+char	new[ARB]	# new image
+
+begin
+	call iki_init()
+	call iki_copy (old, new)
+end
diff --git a/sys/imio/imcssz.x b/sys/imio/imcssz.x
new file mode 100644
index 00000000..1ba356be
--- /dev/null
+++ b/sys/imio/imcssz.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMCSSZ -- Compute size of buffer needed to hold the section defined
+# by the logical vectors VS and VE.  If type conversion is needed,
+# must allow space for whichever pixel is largest.  If subsampling is
+# in use (step size greater than one), must allow extra space for the
+# unsampled data.
+
+long procedure imcssz (im, vs, ve, ndim, dtype, npix, rwflag)
+
+pointer	im			# image descriptor
+long	vs[ARB], ve[ARB]	# endpoints of section
+int	ndim			# dimensionality of section
+int	dtype			# datatype of pixels in section
+long	npix			# number of pixels in section (output)
+int	rwflag			# section is to be read or written
+
+int	step, i, sz_pixel, npix_per_line, extra_pix
+long	buf_size
+
+int	sizeof()
+
+begin
+	sz_pixel = max (sizeof(IM_PIXTYPE(im)), sizeof(dtype))
+	
+	if (IM_VMAP(im,1) == 1)
+	    step = abs (IM_VSTEP(im,1))
+	else
+	    step = 1
+
+	# Compute the total number of pixels in the subraster.
+
+	npix_per_line = abs (ve[1] - vs[1]) + 1
+	npix = npix_per_line
+
+	for (i=2;  i <= ndim;  i=i+1)
+	    npix = npix * (abs (ve[i] - vs[i]) + 1)
+
+	# If the sample step size is greater than one, but less than
+	# IM_MAXSTEP, allow extra space for the final unsampled line.
+	# If not subsampling, and the buffer is for writing, add extra
+	# space so that writes can be an integral number of device
+	# blocks in size.
+
+	extra_pix = 0
+	if (step != 1) {
+	    if (step <= IM_MAXSTEP && rwflag == IM_READ)
+		extra_pix = (step - 1) * npix_per_line
+	} else if (rwflag == IM_WRITE)
+	    extra_pix = (IM_PHYSLEN(im,1) - IM_SVLEN(im,1))
+
+	# If accessing a mask image with range list i/o, the maximum size
+	# range list may be larger than the size of an image line in pixels.
+	# Allow some extra space to permit such range lists to be read in
+	# without buffer overflow; a runtime error is still possible if the
+	# subraster contains multiple lines, and an individual range list
+	# exceeds the length of the line in which it must be stored.
+
+	if (and (IM_PLFLAGS(im), PL_RLIO) != 0)
+	    extra_pix = max (extra_pix, RL_MAXLEN(IM_PL(im)) - npix_per_line)
+
+	buf_size = (npix + extra_pix) * sz_pixel	# size buf, chars
+
+	return (buf_size)
+end
diff --git a/sys/imio/imdelete.x b/sys/imio/imdelete.x
new file mode 100644
index 00000000..785d5c60
--- /dev/null
+++ b/sys/imio/imdelete.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMDELETE -- Delete an image.
+
+procedure imdelete (image)
+
+char	image[ARB]
+
+char	cache[SZ_FNAME], fname[SZ_FNAME], extn[SZ_FNAME]
+char	root[SZ_FNAME], src[SZ_FNAME]
+int	status, len, ip
+
+int	envgets(), strlen(), iki_access(), imaccess()
+bool	streq()
+
+begin
+	# Delete a cached version of the file.
+	if (envgets ("cache", cache, SZ_PATHNAME) > 0) {
+            status = iki_access (image, root, extn, READ_ONLY)
+	    len = strlen (root)
+	    for (ip = len; ip > 0; ip=ip-1) {
+		if (root[ip] == '/') {
+		    call strcpy (root[ip+1], root, SZ_FNAME)
+		    break
+		}
+	    }
+
+	    # Make sure the name has the image extension.
+	    len = strlen (image)
+	    if (! streq (extn, image[len-strlen(extn)+1])) {
+		call strcat (".", root, SZ_FNAME)
+		call strcat (extn, root, SZ_FNAME)
+	    }
+
+	    #  Note that if the file in the cache was added using
+	    #  a full path and/or image type extension, it will not
+	    #  be found in the cache and deleted.
+	    if (status > 0) {
+	        call fclookup (cache, image, fname, extn, SZ_FNAME)
+		if (fname[1] != EOS) {
+                    call fcdelete (cache, fname)
+
+	            call fcsrc (cache, image, src, SZ_FNAME)
+	            if (src[1] != EOS) {
+	                call fclookup (cache, src, fname, extn, SZ_FNAME)
+                        call fcdelete (cache, fname)
+                        call fcdelete (cache, src)
+	            }
+		}
+	    }
+	}
+
+	if (imaccess (image, READ_ONLY) == YES) {
+	    call iki_init()
+	    call iki_delete (image)
+	}
+end
diff --git a/sys/imio/imdmap.x b/sys/imio/imdmap.x
new file mode 100644
index 00000000..9d4e7c70
--- /dev/null
+++ b/sys/imio/imdmap.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMDMAP -- Map an image display frame as an imagefile.  Equivalent to
+# the ordinary immap, except that the pixel storage file is the image
+# frame buffer.  The special pixel storage file is pre-opened with
+# IMDOPEN.  Upon the first pixel access, IMIO normally opens the pixfile.
+# In this case, it sees that the file has already been opened (as a
+# special device as it turns out), and simply uses it.
+
+pointer procedure imdmap (device, access_mode, imdopen)
+
+char	device[ARB]		# graphcap name of display device to be opened
+int	access_mode		# display access mode
+extern	imdopen()		# device FIO open procedure
+int	imdopen()
+
+int	pfd, pixel_mode
+pointer	sp, devinfo, devname, im, tty
+
+bool	streq(), ttygetb()
+pointer	immap(), ttygdes()
+int	ttygeti(), ttygets(), envgets(), btoi()
+errchk	imdopen, immap, syserrs
+
+begin
+	call smark (sp)
+	call salloc (devinfo, SZ_LINE,  TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Determine the display access mode.  Write permission is always
+	# required, even to read from a display device.  Write only mode
+	# is however desirable for the display, to avoid unnecessary i/o
+	# when faulting the file buffer.
+
+	switch (access_mode) {
+	case READ_ONLY:
+	    pixel_mode = READ_WRITE
+	case READ_WRITE:
+	    pixel_mode = READ_WRITE
+	case WRITE_ONLY:
+	    pixel_mode = WRITE_ONLY
+	default:
+	    # Cannot create an image on a special device.
+	    call syserrs (SYS_IMDEVOPN, device)
+	}
+
+	# Open an image header for the special device.
+	im = immap ("dev$null", NEW_IMAGE, 0)
+
+	# Read the graphcap entry for the device and fetch the device
+	# parameters.
+
+	if (streq (device, "stdimage")) {
+	    if (envgets ("stdimage", Memc[devname], SZ_FNAME) <= 0) {
+		call imunmap (im)
+		call syserrs (SYS_IMDEVOPN, device)
+	    }
+	} else
+	    call strcpy (device, Memc[devname], SZ_FNAME)
+		
+	iferr (tty = ttygdes (Memc[devname])) {
+	    call imunmap (im)
+	    call erract (EA_ERROR)
+	}
+
+	if (ttygets (tty, "DD", Memc[devinfo], SZ_LINE) <= 0) {
+	    call imunmap (im)
+	    call ttycdes (tty)
+	    call syserrs (SYS_IMDEVOPN, device)
+	}
+
+	IM_PIXTYPE(im)  = TY_SHORT
+	IM_LEN(im,1)    = ttygeti (tty, "xr")
+	IM_LEN(im,2)    = ttygeti (tty, "yr")
+	IM_LEN(im,3)    = ttygeti (tty, "cn")
+	IM_LEN(im,4)    = btoi(ttygetb (tty, "LC"))
+	IM_NDIM(im)     = 2
+	IM_MIN(im)      = real (ttygeti (tty, "z0"))
+	IM_MAX(im)      = real (ttygeti (tty, "zr") - 1.) + IM_MIN(im)
+	IM_LIMTIME(im)  = IM_MTIME(im) + 1
+	IM_PIXOFF(im)   = 1	
+	IM_HGMOFF(im)   = NULL
+	IM_BLIST(im)    = NULL
+	IM_NPHYSDIM(im) = 2
+
+	call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	call amovl (IM_LEN(im,1), IM_SVLEN(im,1),   IM_MAXDIM)
+
+	# Open the display device.
+	pfd = imdopen (Memc[devinfo], pixel_mode)
+	if (pfd == ERR) {
+	    call imunmap (im)
+	    call syserrs (SYS_IMDEVOPN, device)
+	}
+
+	call imseti (im, IM_PIXFD, pfd)
+	call imseti (im, IM_WHEADER, NO)
+	call imsetbuf (pfd, im)
+
+	call ttycdes (tty)
+	call sfree (sp)
+
+	return (im)
+end
diff --git a/sys/imio/imerr.x b/sys/imio/imerr.x
new file mode 100644
index 00000000..8b2aa6b2
--- /dev/null
+++ b/sys/imio/imerr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMERR -- Format an error message for the named image and call error.
+# format of error message:  ERROR (nnn, "message ('imname')").
+
+procedure imerr (image_name, errcode)
+
+char	image_name[ARB]
+int	errcode
+
+begin
+	call syserrs (errcode, image_name)
+end
diff --git a/sys/imio/imfls.gx b/sys/imio/imfls.gx
new file mode 100644
index 00000000..49016816
--- /dev/null
+++ b/sys/imio/imfls.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imfls$t (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_PIXEL || SZ_INT != SZ_INT32) {
+		call impak$t (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/imflsh.x b/sys/imio/imflsh.x
new file mode 100644
index 00000000..c0d54d6d
--- /dev/null
+++ b/sys/imio/imflsh.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLSH -- Flush the output buffer to the pixel storage file (not
+# dependent on the datatype of the pixels).  The mapping of the subraster
+# in the output buffer to the imagefile is described by the section
+# descriptor vectors in the buffer descriptor.  Images up to IM_MAXDIM
+# dimensions are permitted, and each dimension may be accessed in either
+# the forward or reverse direction.
+
+procedure imflsh (im, bp, vs, ve, ndim)
+
+pointer	im			# image descriptor
+pointer	bp			# pointer to buffer containing the data
+long	vs[ARB], ve[ARB]	# logical coordinates of section to be written
+int	ndim			# dimensionality of the section
+
+pointer	line
+long	pvs[IM_MAXDIM], pve[IM_MAXDIM]
+long	v[IM_MAXDIM], vinc[IM_MAXDIM]
+int	sz_pixel, sz_dtype, inbounds, npix, xstep
+int	imsinb(), imloop(), sizeof()
+errchk	imwrpx, imwbpx
+include <szpixtype.inc>
+
+begin
+        sz_dtype = sizeof (IM_PIXTYPE(im))
+        sz_pixel = pix_size[IM_PIXTYPE(im)]
+
+	# Check if the section extends out of bounds.
+	inbounds = imsinb (im, vs, ve, ndim)
+	if (inbounds == ERR)
+	    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+	# Map the logical section into a physical section.  Prepare the
+	# section descriptor do-loop index and increment vectors V, VINC.
+
+	call imaplv (im, vs, pvs, ndim)
+	call imaplv (im, ve, pve, ndim)
+	call imsslv (im, pvs, pve, v, vinc, npix)
+
+	line = bp
+
+	# Write the section to the output image, line segment by line segment,
+	# advancing through the dimensions in storage order (leftmost subscript
+	# varies fastest).
+
+	repeat {
+	    # Call IMWRPX directly if section is inbounds.
+	    xstep = vinc[1]
+	    if (inbounds == YES)
+		call imwrpx (im, Memc[line], npix, v, xstep) 
+	    else
+		call imwbpx (im, Memc[line], npix, v, xstep) 
+	    line = line + npix * sz_pixel
+	} until (imloop (v, pvs, pve, vinc, IM_NPHYSDIM(im)) == LOOP_DONE)
+end
diff --git a/sys/imio/imflush.x b/sys/imio/imflush.x
new file mode 100644
index 00000000..32cd2bc7
--- /dev/null
+++ b/sys/imio/imflush.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLUSH -- Flush the output buffer.  The output buffer may contain
+# pixels of any datatype.  The entry point of the datatype specific
+# flush procedure is saved in the image descriptor by IMPGS?.
+
+procedure imflush (imdes)
+
+pointer	imdes
+
+begin
+	if (IM_PFD(imdes) != NULL && IM_FLUSH(imdes) == YES) {
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+	    call flush (IM_PFD(imdes))
+	}
+end
diff --git a/sys/imio/imgclust.x b/sys/imio/imgclust.x
new file mode 100644
index 00000000..ca075cfb
--- /dev/null
+++ b/sys/imio/imgclust.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGCLUSTER -- Get the cluster name of an image, i.e., the name of the cluster
+# to which the image belongs, minus the cluster index and image section, if any.
+
+procedure imgcluster (imspec, cluster, maxch)
+
+char	imspec[ARB]		# full image specification
+char	cluster[ARB]		# receives root image name
+int	maxch
+
+int	cl_index, cl_size
+pointer	sp, ksection, section
+
+begin
+	call smark (sp)
+	call salloc (ksection, SZ_FNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	call imparse (imspec, cluster, maxch, Memc[ksection], SZ_FNAME,
+	    Memc[section], SZ_FNAME, cl_index, cl_size)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/imggs.gx b/sys/imio/imggs.gx
new file mode 100644
index 00000000..70cc445e
--- /dev/null
+++ b/sys/imio/imggs.gx
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggs$t (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_PIXEL, totpix)
+	if (IM_PIXTYPE(imdes) != TY_PIXEL)
+	    call imupk$t (Mem$t[bp], Mem$t[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/imggsc.x b/sys/imio/imggsc.x
new file mode 100644
index 00000000..caccc6a3
--- /dev/null
+++ b/sys/imio/imggsc.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGGSC -- Get a general section, any datatype (called by one of the typed
+# procedures, which subsequently convert the datatype of the pixels returned
+# by this routine).  The mapping of the subraster in the input buffer to the
+# imagefile is described by the section descriptor vectors VS and VE.  Images
+# of up to IM_MAXDIM dimensions are permitted, and each dimension may be
+# accessed in either the forward or reverse direction.
+
+pointer procedure imggsc (im, vs, ve, ndim, dtype, totpix)
+
+pointer	im			# image descriptor
+long	vs[ARB], ve[ARB]	# logical coords of corners of section
+int	ndim			# dimensionality of section
+int	dtype			# datatype of pixels desired
+long	totpix			# total pixels in section (output)
+
+bool	rlio
+pointer	sp, px, bp, line, rl_high
+long	v[IM_MAXDIM], vinc[IM_MAXDIM]
+long	pvs[IM_MAXDIM], pve[IM_MAXDIM]
+int	sz_pixel, inbounds, npix, xstep, n
+
+pointer	imgibf()
+int	imsinb(), imloop(), pl_p2ri(), sizeof()
+errchk	imgibf, imrdpx, imrbpx
+include <szpixtype.inc>
+
+begin
+	#sz_pixel = sizeof(IM_PIXTYPE(im))
+	#sz_pixel = max ( sizeof(dtype), sizeof(IM_PIXTYPE(im)) )
+	#sz_pixel = pix_size[IM_PIXTYPE(im)]
+	sz_pixel = sizeof(IM_PIXTYPE(im))
+	rlio = (and (IM_PLFLAGS(im), PL_RLIO+PL_FAST) == PL_RLIO)
+
+	# Check that the section does not extend out of bounds.
+	inbounds = imsinb (im, vs, ve, ndim)
+	if (inbounds == ERR)
+	    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+	# Get an (input) buffer to put the pixels into.  Map the logical
+	# section into a physical section.  Prepare the section descriptor
+	# do-loop index and increment vectors V, VINC.
+
+	bp = imgibf (im, vs, ve, ndim, dtype)
+	call imaplv (im, vs, pvs, ndim)
+	call imaplv (im, ve, pve, ndim)
+	call imsslv (im, pvs, pve, v, vinc, npix)
+
+	# A temporary pixel buffer is required for RLIO conversions.
+	if (rlio) {
+	    call smark (sp)
+	    call salloc (px, npix, TY_INT)
+	}
+
+	line = bp
+	totpix = 0
+	rl_high = bp - 1
+
+	# Read the section into the input buffer, line segment by line segment,
+	# advancing through the dimensions in storage order (leftmost subscript
+	# varies fastest).
+
+	repeat {
+	    xstep = vinc[1]
+
+	    # Convert the pixel array to a range list? (image masks).  This is
+	    # done more efficiently at a lower level if no complex geometric
+	    # transformations are required (due to sections or OOB references).
+
+	    if (rlio) {
+		if (inbounds == YES)
+		    call imrdpx (im, Memi[px], npix, v, xstep) 
+		else
+		    call imrbpx (im, Memi[px], npix, v, xstep) 
+
+		if (rl_high >= line)
+		    call imerr (IM_NAME(im), SYS_IMRLOVFL)
+		else {
+		    n = pl_p2ri (Memi[px], 1, Memc[line], npix)
+		    rl_high = line + (n * RL_LENELEM * sz_pixel) - 1
+		}
+
+	    } else {
+		if (inbounds == YES)
+		    call imrdpx (im, Memc[line], npix, v, xstep) 
+		else
+		    call imrbpx (im, Memc[line], npix, v, xstep) 
+	    }
+
+	    line = line + (npix * sz_pixel)
+	    totpix = totpix + npix
+
+	} until (imloop (v, pvs, pve, vinc, IM_NPHYSDIM(im)) == LOOP_DONE)
+
+	if (rlio)
+	    call sfree (sp)
+
+	return ((bp - 1) / sizeof(dtype) + 1)
+end
diff --git a/sys/imio/imgibf.x b/sys/imio/imgibf.x
new file mode 100644
index 00000000..9155ae78
--- /dev/null
+++ b/sys/imio/imgibf.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGIBF -- Get an input buffer.
+
+pointer procedure imgibf (im, vs, ve, ndim, dtype)
+
+pointer	im
+long	vs[ARB], ve[ARB]
+int	dtype, ndim
+
+pointer	bdes
+int	i
+long	nget, nchars, totpix
+
+long	imcssz()
+errchk	imopsf, calloc, realloc, mfree, malloc
+
+begin
+	# If first input transfer, allocate and initialize array of
+	# input buffer descriptors.
+
+	if (IM_IBDES(im) == NULL) {
+	    call imopsf (im)
+	    call calloc (IM_IBDES(im), LEN_BDES * IM_VNBUFS(im), TY_STRUCT)
+	}
+
+	# Compute pointer to the next input buffer descriptor.
+	# Increment NGET, the count of the number of GETPIX calls.
+
+	nget = IM_NGET(im)
+	bdes = IM_IBDES(im) + mod (nget, IM_VNBUFS(im)) * LEN_BDES
+	IM_NGET(im) = nget + 1
+
+	# Compute the size of the buffer needed.  Check buffer
+	# descriptor to see if the old buffer is the right size.
+	# If so, use it, otherwise make a new one.
+
+	nchars = imcssz (im, vs, ve, ndim, dtype, totpix, IM_READ)
+
+	if (nchars < BD_BUFSIZE(bdes))
+	    call realloc (BD_BUFPTR(bdes), nchars, TY_CHAR)
+	else if (nchars > BD_BUFSIZE(bdes)) {
+	    call mfree (BD_BUFPTR(bdes), TY_CHAR)
+	    call malloc (BD_BUFPTR(bdes), nchars, TY_CHAR)
+	}
+
+	# Save section coordinates, datatype in buffer descriptor, and
+	# return buffer pointer to calling program.
+
+	IM_LASTBDES(im) = bdes
+	BD_BUFSIZE(bdes) = nchars
+	BD_DTYPE(bdes) = dtype
+	BD_NPIX(bdes) = totpix
+	BD_NDIM(bdes) = ndim
+
+	do i = 1, ndim {
+	    BD_VS(bdes,i) = vs[i]
+	    BD_VE(bdes,i) = ve[i]
+	}
+
+	return (BD_BUFPTR(bdes))		# return ptr to CHAR
+end
diff --git a/sys/imio/imgimage.x b/sys/imio/imgimage.x
new file mode 100644
index 00000000..9e81d409
--- /dev/null
+++ b/sys/imio/imgimage.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGIMAGE -- Get the name of an individual image within a cluster of images,
+# i.e., the image name minus any image section.
+
+procedure imgimage (imspec, image, maxch)
+
+char	imspec[ARB]		# full image specification
+char	image[ARB]		# receives image name
+int	maxch
+
+int	cl_index, cl_size
+pointer	sp, cluster, ksection, section
+
+begin
+	call smark (sp)
+	call salloc (cluster, SZ_PATHNAME, TY_CHAR)
+	call salloc (ksection, SZ_FNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	call imparse (imspec,
+	    Memc[cluster], SZ_PATHNAME,
+	    Memc[ksection], SZ_FNAME,
+	    Memc[section], SZ_FNAME, cl_index, cl_size)
+
+	if (cl_index >= 0 && cl_size == -1) {
+	    call sprintf (image, maxch, "%s[%d]")
+		call pargstr (Memc[cluster])
+		call pargi (cl_index)
+	} else if (cl_index >= 0 && cl_size > 0) {
+	    call sprintf (image, maxch, "%s[%d/%d]")
+		call pargstr (Memc[cluster])
+		call pargi (cl_index)
+		call pargi (cl_size)
+	} else
+	    call strcpy (Memc[cluster], image, maxch)
+
+	call strcat (Memc[ksection], image, maxch)
+	call sfree (sp)
+end
diff --git a/sys/imio/imgl1.gx b/sys/imio/imgl1.gx
new file mode 100644
index 00000000..5008b291
--- /dev/null
+++ b/sys/imio/imgl1.gx
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1$t (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggs$t(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+	    return (imggs$t (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/imgl2.gx b/sys/imio/imgl2.gx
new file mode 100644
index 00000000..8dfd1751
--- /dev/null
+++ b/sys/imio/imgl2.gx
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2$t (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggs$t(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_PIXEL +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggs$t (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/imgl3.gx b/sys/imio/imgl3.gx
new file mode 100644
index 00000000..eed65b92
--- /dev/null
+++ b/sys/imio/imgl3.gx
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3$t (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggs$t(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_PIXEL + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggs$t (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/imgnl.gx b/sys/imio/imgnl.gx
new file mode 100644
index 00000000..dde3d356
--- /dev/null
+++ b/sys/imio/imgnl.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnl$t (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_PIXEL)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_PIXEL)
+		call imupk$t (Mem$t[lineptr], Mem$t[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/imgnln.x b/sys/imio/imgnln.x
new file mode 100644
index 00000000..96bc7524
--- /dev/null
+++ b/sys/imio/imgnln.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGNLN -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnln (im, lineptr, v, dtype)
+
+pointer	im
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	dtype				# eventual datatype of pixels
+
+int	dim, ndim, junk, sz_pixel, fd, nchars, pixtype
+long	lineoff, line, band, offset
+long	vs[IM_MAXDIM], ve[IM_MAXDIM], unit_v[IM_MAXDIM], npix
+
+int	imloop()
+pointer	imggsc(), freadp()
+errchk	imggsc, imerr, imopsf
+define	retry_ 91
+define	oob_ 92
+define	misaligned_ 93
+include	<szpixtype.inc>
+data	unit_v /IM_MAXDIM * 1/
+
+begin
+	ndim = IM_NDIM(im)
+	if (ndim == 0)
+	    return (EOF)
+
+	npix = IM_LEN(im,1)			# read entire line
+	pixtype = IM_PIXTYPE(im)
+	sz_pixel = pix_size[pixtype]
+
+	# Perform "zero trip" check (V >= VE), before entering "loop".
+	if (v[ndim] > IM_LEN(im,ndim))
+	    return (EOF)
+retry_
+	if (IM_FAST(im) == YES && pixtype == dtype && ndim <= 3) {
+	    fd = IM_PFD(im)
+	    if (fd == NULL) {
+		call imopsf (im)
+		goto retry_
+	    }
+
+	    # Lineoff is the dimensionless line offset in the pixel storage
+	    # file (which we assume to be in line storage mode).
+
+	    lineoff = 0
+	    if (ndim > 1) {
+		line = v[2]
+		if (line < 1 || line  > IM_LEN(im,2))
+		    goto oob_
+		lineoff = line - 1
+		if (ndim > 2) {
+		    band = v[3]
+		    if (band < 1 || band > IM_LEN(im,3))
+oob_			call imerr (IM_NAME(im), SYS_IMREFOOB)
+		    lineoff = lineoff + (band - 1) * IM_PHYSLEN(im,2)
+		}
+	    }
+
+	    # Reference directly into the FIO buffer.  If the image line
+	    # straddles a FIO block boundary freadp calls error and we must
+	    # use a separate buffer.
+
+	    offset = lineoff * IM_PHYSLEN(im,1) * sz_pixel + IM_PIXOFF(im)
+	    nchars = IM_PHYSLEN(im,1) * sz_pixel
+	    iferr (lineptr = (freadp (fd, offset, nchars) - 1) / sz_pixel + 1)
+		goto misaligned_
+
+	} else {
+misaligned_
+	    # Prepare section descriptor vectors.
+	    vs[1] = 1
+	    ve[1] = npix
+	    do dim = 2, ndim {
+		vs[dim] = v[dim]
+		ve[dim] = v[dim]
+	    }
+
+	    # Get the line.
+	    lineptr = imggsc (im, vs, ve, ndim, dtype, junk)
+	}
+
+	# Increment loop vector (cannot use nested loops since the dimension
+	# of the image is variable).  Note this loop vector references
+	# logical section coordinates.
+
+	if (ndim == 1)
+	    v[1] = IM_LEN(im,1) + 1
+	else if (ndim == 2 && IM_FAST(im) == YES)
+	    v[2] = v[2] + 1
+	else
+	    junk = imloop (v, unit_v, IM_LEN(im,1), unit_v, ndim)
+
+	return (npix)
+end
diff --git a/sys/imio/imgobf.x b/sys/imio/imgobf.x
new file mode 100644
index 00000000..8dc5f3a1
--- /dev/null
+++ b/sys/imio/imgobf.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGOBF -- Get output buffer.
+
+pointer procedure imgobf (im, vs, ve, ndim, dtype)
+
+pointer	im, bdes
+int	ndim, dtype, i
+long	vs[ndim], ve[ndim]
+long	nchars, totpix, imcssz(), clktime()
+int	sizeof()
+
+errchk	imopsf, malloc, realloc, calloc
+
+include	<szpixtype.inc>
+
+begin
+	# If first write, and if new image, create pixel storage file,
+	# otherwise open pixel storage file.  Allocate and initialize
+	# output buffer descriptor.
+
+	if (IM_OBDES(im) == NULL) {
+	    call imopsf (im)
+	    call calloc (IM_OBDES(im), LEN_BDES, TY_STRUCT)
+	    IM_MTIME(im) = clktime (long(0))
+	    IM_SVMTIME(im) = IM_MTIME(im)
+	}
+
+	bdes = IM_OBDES(im)
+
+	# Compute the size of buffer needed.  A few extra chars are added
+	# to guarantee that there won't be a memory violation when
+	# writing a full physical length line.
+
+	nchars = imcssz (im, vs, ve, ndim, dtype, totpix, IM_WRITE)
+
+	if (nchars < BD_BUFSIZE(bdes))
+	    call realloc (BD_BUFPTR(bdes), nchars, TY_CHAR)
+	else if (nchars > BD_BUFSIZE(bdes)) {
+	    call mfree (BD_BUFPTR(bdes), TY_CHAR)
+	    call malloc (BD_BUFPTR(bdes), nchars, TY_CHAR)
+	}
+
+	# Save section coordinates, datatype of pixels in buffer
+	# descriptor, and return buffer pointer to calling program.
+
+	IM_LASTBDES(im) = bdes
+	BD_BUFSIZE(bdes) = nchars
+	BD_DTYPE(bdes) = dtype
+	BD_NPIX(bdes) = totpix
+	BD_NDIM(bdes) = ndim
+
+	do i = 1, ndim {
+	    BD_VS(bdes,i) = vs[i]
+	    BD_VE(bdes,i) = ve[i]
+	}
+
+	return ((BD_BUFPTR(bdes) - 1) / sizeof(dtype) + 1)
+end
diff --git a/sys/imio/imgs1.gx b/sys/imio/imgs1.gx
new file mode 100644
index 00000000..ab94d99b
--- /dev/null
+++ b/sys/imio/imgs1.gx
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1$t (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggs$t(), imgl1$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1$t (im))
+	else
+	    return (imggs$t (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/imgs2.gx b/sys/imio/imgs2.gx
new file mode 100644
index 00000000..d62c44db
--- /dev/null
+++ b/sys/imio/imgs2.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2$t (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggs$t(), imgl2$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2$t (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggs$t (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/imgs3.gx b/sys/imio/imgs3.gx
new file mode 100644
index 00000000..4179c84f
--- /dev/null
+++ b/sys/imio/imgs3.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3$t (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggs$t(), imgl3$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3$t (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggs$t (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/imgsect.x b/sys/imio/imgsect.x
new file mode 100644
index 00000000..c41fa1b9
--- /dev/null
+++ b/sys/imio/imgsect.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMGSECTION -- Get the image section field from an image specifcation.
+
+procedure imgsection (imspec, section, maxch)
+
+char	imspec[ARB]		# full image specifcation
+char	section[ARB]		# receives image section
+int	maxch
+
+int	cl_index, cl_size
+pointer	sp, cluster, ksection
+
+begin
+	call smark (sp)
+	call salloc (cluster, SZ_PATHNAME, TY_CHAR)
+	call salloc (ksection, SZ_FNAME, TY_CHAR)
+
+	call imparse (imspec, Memc[cluster], SZ_PATHNAME,
+	    Memc[ksection], SZ_FNAME, section, maxch, cl_index, cl_size)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iminie.x b/sys/imio/iminie.x
new file mode 100644
index 00000000..1d019131
--- /dev/null
+++ b/sys/imio/iminie.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_INIT_NEWIMAGE -- Initialize the header of a new image.
+
+procedure im_init_newimage (im, len_imhdr)
+
+pointer	im
+int	len_imhdr
+long	clktime()
+
+begin
+	call strcpy ("imhdr", IM_MAGIC(im), SZ_IMMAGIC)
+	IM_HDRLEN(im) = len_imhdr
+	IM_PIXTYPE(im) = DEF_PIXTYPE
+	IM_CTIME(im) = clktime (long(0))
+	IM_MTIME(im) = IM_CTIME(im)
+	IM_TITLE(im) = EOS
+	IM_HISTORY(im) = EOS
+	Memc[IM_USERAREA(im)] = EOS
+end
diff --git a/sys/imio/imioff.x b/sys/imio/imioff.x
new file mode 100644
index 00000000..bec668b3
--- /dev/null
+++ b/sys/imio/imioff.x
@@ -0,0 +1,114 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+
+# IMIOFF -- Initialize the physical dimensions of a new image.  Compute and set
+# the absolute file offsets of the major components of the pixel storage file.
+
+procedure imioff (im, pixoff, compress, devblksz)
+
+pointer	im			# image descriptor
+long	pixoff			# file offset of first pixel
+int	compress		# if set, do not align image lines
+int	devblksz		# FIO device block size
+
+real	impkden, envgetr()
+long	offset, temp1, temp2, imnote()
+int	ndim, dim, sz_pixel, lblksize, pblksize
+errchk	imerr
+
+include	<szpixtype.inc>
+
+begin
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+	pblksize = max (devblksz, SZ_VMPAGE)
+
+	if (compress == YES)
+	    lblksize = 1
+	else
+	    lblksize = devblksz
+
+	# Set the offset of the pixel storage area.  Compute the physical
+	# dimensions of the axes of the image.  If image compression is
+	# selected, the logical and physical lengths of the axes will be
+	# the same.  Otherwise, the physical length of each line of the
+	# image will be increased to fill an integral number of device blocks.
+
+	IM_PIXOFF(im) = pixoff
+	call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	call amovl (IM_LEN(im,1), IM_SVLEN(im,1), IM_MAXDIM)
+
+	ndim = IM_NDIM(im)
+
+	# If ndim was not explicitly set, compute it by counting the number
+	# of nonzero dimensions.
+
+	if (ndim == 0) {
+	    for (ndim=1;  IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM;
+	    ndim=ndim+1)
+		;
+	    ndim = ndim - 1
+	    IM_NDIM(im) = ndim
+	}
+	IM_NPHYSDIM(im) = ndim
+
+	# Make sure dimension stuff makes sense.
+	if (ndim < 0 || ndim > IM_MAXDIM)
+	    call imerr (IM_NAME(im), SYS_IMNDIM)
+
+	do dim = 1, ndim
+	    if (IM_LEN(im,dim) <= 0)
+		call imerr (IM_NAME(im), SYS_IMDIMLEN)
+
+	# Set the unused higher dimensions to 1.  This makes is possible to
+	# access the image as if it were higher dimensional, and in a way it
+	# truely is.
+
+	do dim = ndim + 1, IM_MAXDIM
+	    IM_LEN(im,dim) = 1
+
+	if (lblksize > 1) {
+	    temp1 = pixoff + IM_LEN(im,1) * sz_pixel
+	    temp2 = temp1
+	    call imalign (temp2, lblksize)
+
+	    # Only block lines if the packing density is above a certain
+	    # threshold.  Alignment is disabled if compress=YES since lblksize
+	    # will have been set to 1.
+
+	    iferr (impkden = envgetr ("impkden"))
+		impkden = IM_PACKDENSITY
+
+	    if (real(temp1-pixoff) / real(temp2-pixoff) >= impkden)
+		IM_PHYSLEN(im,1) = (temp2 - pixoff) / sz_pixel
+	}
+
+	# Set the offsets of the histogram pixels and the bad pixel list.
+	# The HGMOFF offset marks the end of the pixel segment.
+
+	offset = imnote (im, IM_LEN(im,1))
+	call imalign (offset, pblksize)
+	IM_HGMOFF(im) = offset
+
+	offset = offset + (MAX_HGMLEN * SZ_REAL)
+	call imalign (offset, lblksize)
+	IM_BLIST(im) = offset
+end
+
+
+# IMALIGN -- Advance "offset" to the next block boundary.
+
+procedure imalign (offset, blksize)
+
+long	offset
+int	blksize, diff
+
+begin
+	diff = mod (offset-1, max (1, blksize))
+	if (diff != 0)
+	    offset = offset + (blksize - diff)
+end
diff --git a/sys/imio/imisec.x b/sys/imio/imisec.x
new file mode 100644
index 00000000..9a4735fe
--- /dev/null
+++ b/sys/imio/imisec.x
@@ -0,0 +1,227 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+define	FIRST		1
+define	LAST		MAX_LONG
+
+.help imisec
+.nf ___________________________________________________________________________
+IMISEC -- Translate a section specification string (passed as a suffix
+to the imagefile filename) into a set of logical to physical transformation
+vectors.
+
+The image section notation is used to access portions of an image, to reduce
+the dimensionality of an image, to reverse the coordinates of any of the axes
+of an image, and so on.  Since this facility is built into IMIO, and is
+completely transparent to programs using IMIO, it significantly increases
+the power and flexibility of all programs which assess images, without
+complicating the applications code.
+
+Examples ("map (image_name, ...)":
+
+		   image_name			meaning
+
+		image[*,-*]		(flip columns end for end)
+		image[*,*,5]		(band 5 of image cube)
+		image[*,5,*]		(x,y --> x,z)
+		image[x1:x2,y1:y2]	(2-D subraster)
+		image[x1:x2:n,*]	(subsample by N in x)
+
+If the number of dimensions specified in the section is less than the number
+of physical dimensions in the image then the higher dimensions default to 1.
+If the number of dimensions given is greater than the number of phyiscal
+dimensions then the nonphysical excess dimensions must be set to 1.
+.endhelp ______________________________________________________________________
+
+
+procedure imisec (imdes, section)
+
+pointer	imdes
+char	section[ARB]
+int	ip, i, dim, nsubscripts, nphysdim, nlogdim
+long	x1[IM_MAXDIM], x2[IM_MAXDIM], step[IM_MAXDIM], clktime()
+
+begin
+	# Set up null mapping (default).  Check for null section string,
+	# or null section, and return if found.
+
+	nphysdim = IM_NDIM(imdes)
+
+	call aclrl (IM_VOFF(imdes,1), nphysdim)
+	call amovkl (long(1), IM_VSTEP(imdes,1), nphysdim)
+
+	do dim = 1, nphysdim
+	    IM_VMAP(imdes,dim) = dim
+
+	if (section[1] == EOS)
+	    return
+	else if (section[1] != '[')
+	    call imerr (IM_NAME(imdes), SYS_IMSYNSEC)
+
+	ip = 2
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+
+	if (section[ip] == ']')
+	    return
+
+
+	# Decode the section string, yielding the vectors X1, X2, and STEP,
+	# of length NSUBSCRIPTS.
+
+	for (i=1;  i <= IM_MAXDIM && section[ip] != ']';  i=i+1)
+	    call im_decode_subscript (section, ip, x1[i], x2[i], step[i])
+	nsubscripts = i - 1
+
+
+	# Set the transformation vectors.  If too few dimensions were given
+	# set the higher dimensions to 1.  If too many dimensions were given
+	# the higher dimensions must have been set to 1 in the section.
+
+	for (dim = nsubscripts + 1;  dim <= nphysdim;  dim = dim + 1) {
+	    x1[dim] = 1
+	    x2[dim] = 1
+	    step[dim] = 1
+	}
+	for (dim = nphysdim + 1;  dim <= nsubscripts;  dim = dim + 1)
+	    if (x1[dim] != 1 || x2[dim] != 1)
+		call imerr (IM_NAME(imdes), SYS_IMDIMSEC)
+
+	nlogdim = 0
+	for (dim=1;  dim <= nphysdim;  dim=dim+1) {
+	    # Set up transformation for a single physical dimension.
+	    call im_ctranset (imdes, dim, x1[dim], x2[dim], step[dim])
+
+	    # Map logical dimension onto physical dimension.
+	    if (x1[dim] != x2[dim]) {
+		nlogdim = nlogdim + 1
+		IM_VMAP(imdes,nlogdim) = dim
+		IM_LEN(imdes,nlogdim) = IM_LEN(imdes,dim)
+	    }
+	}
+
+	# Convert a zero-dimensional image into a one dimensional image
+	# of length one pixel (section addresses a single pixel).
+
+	if (nlogdim == 0) {
+	    nlogdim = 1
+	    IM_VMAP(imdes,1) = 1
+	    IM_LEN(imdes,1) = 1
+	}
+
+	IM_NDIM(imdes) = nlogdim
+	IM_MTIME(imdes) = clktime (long(0))
+end
+    
+
+# IM_CTRANSET -- Set the logical to physical section coordinate transformation
+# coefficients VOFF and VSTEP for the axis DIM.  Adjust the length of the
+# logical axis IM_LEN if needed.
+
+procedure im_ctranset (imdes, dim, x1_arg, x2_arg, step)
+
+pointer	imdes
+int	dim
+long	x1_arg, x2_arg, step, x1, x2, length_axis
+
+begin
+	x1 = x1_arg
+	if (x1_arg == LAST)
+	    x1 = IM_LEN(imdes,dim)
+	x2 = x2_arg
+	if (x2_arg == LAST)
+	    x2 = IM_LEN(imdes,dim)
+
+	# Compute the number of pixels in this axis of the section, allowing
+	# for non-unity step sizes.  Set the axis length seen by the calling
+	# program to this value.
+
+	length_axis = (x2 - x1) / step + 1
+	if (length_axis <= 0)
+	    call imerr (IM_NAME(imdes), SYS_IMSTEPSEC)
+	else
+	    IM_LEN(imdes,dim) = length_axis
+
+	IM_VOFF(imdes,dim) = x1 - step
+	IM_VSTEP(imdes,dim) = step
+end
+
+
+# IM_DECODE_SUBSCRIPT -- Decode a single subscript expression to produce the
+# range of values for that subscript (X1:X2), and the sampling step size, STEP.
+# Note that X1 may be less than, greater than, or equal to X2, and STEP may
+# be a positive or negative nonzero integer.  Various shorthand notations are
+# permitted, as is embedded whitespace.
+
+procedure im_decode_subscript (section, ip, x1, x2, step)
+
+char	section[ARB]
+int	ip
+long	x1, x2, step, temp
+int	ctol()
+define	synerr_ 99
+
+begin
+	x1 = FIRST
+	x2 = LAST
+	step = 1
+
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+
+	# Get X1, X2.
+	if (ctol (section, ip, temp) > 0) {			# [x1
+	    x1 = temp
+	    if (section[ip] == ':') {	
+		ip = ip + 1
+		if (ctol (section, ip, x2) == 0)		# [x1:x2
+		    goto synerr_
+	    } else
+		x2 = x1
+
+	} else if (section[ip] == '-') {
+	    x1 = LAST						# [-*
+	    x2 = FIRST
+	    ip = ip + 1
+	    if (section[ip] == '*')
+		ip = ip + 1
+
+	} else if (section[ip] == '*')				# [*
+	    ip = ip + 1
+
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+
+	# Get sample step size, if give.
+	if (section[ip] == ':') {				# ..:step
+	    ip = ip + 1
+	    if (ctol (section, ip, step) == 0)
+		goto synerr_
+	    else if (step == 0)
+		goto synerr_
+	}
+
+	# Allow notation such as "-*:5", (or even "-:5") where the step
+	# is obviously supposed to be negative.
+
+	if (x1 > x2 && step > 0)
+	    step = -step
+	
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+
+	if (section[ip] == ',') {
+	    ip = ip + 1
+	    return
+	} else if (section[ip] == ']')
+	    return
+
+synerr_
+	# Syntax error in image section specification.
+ 	call imerr (section, SYS_IMSYNSEC)
+end
diff --git a/sys/imio/imloop.x b/sys/imio/imloop.x
new file mode 100644
index 00000000..ffae877b
--- /dev/null
+++ b/sys/imio/imloop.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+
+# IMLOOP -- Increment the vector V from VS to VE (nested do loops cannot
+# be used because of the variable number of dimensions).  Return LOOP_DONE
+# when V exceeds VE.
+
+int procedure imloop (v, vs, ve, vinc, ndim)
+
+long	v[ndim], vs[ndim], ve[ndim], vinc[ndim]
+int	ndim, dim
+
+begin
+	for (dim=2;  dim <= ndim;  dim=dim+1) {
+	    v[dim] = v[dim] + vinc[dim]
+
+	    if ((vinc[dim] > 0 && v[dim] - ve[dim] > 0) ||
+	        (vinc[dim] < 0 && ve[dim] - v[dim] > 0)) {
+
+		    if (dim < ndim)
+		        v[dim] = vs[dim]		# advance to next dim
+		    else
+		        break
+	    } else
+		return (LOOP_AGAIN)
+	}
+
+	return (LOOP_DONE)
+end
diff --git a/sys/imio/immaky.x b/sys/imio/immaky.x
new file mode 100644
index 00000000..186bfe5d
--- /dev/null
+++ b/sys/imio/immaky.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+
+
+# IM_MAKE_NEWCOPY -- Copy the header of an existing, mapped image to
+# initialize the header of a new image.  Clear all fields that describe
+# the pixels (a NEW_COPY image does not inherit any pixels).
+
+procedure im_make_newcopy (im, o_im)
+
+pointer	im				# new copy image
+pointer	o_im				# image being copied
+
+pointer	mw
+int	strlen()
+long	clktime()
+pointer	mw_open()
+bool	strne(), envgetb()
+errchk	imerr, realloc, mw_open, mw_loadim, mw_saveim, mw_close
+
+begin
+	if (strne (IM_MAGIC(o_im), "imhdr"))
+	    call imerr (IM_NAME(im), SYS_IMMAGNCPY)
+
+	# Copy the old image header (all fields, including user fields).
+	# Note that the incore version of the old header may be shorter than
+	# the actual header, in which case the user fields are currently
+	# not copied (would require reopening old header file).  This is
+	# unlikely, however, since a very large in memory user area is
+	# allocated.
+
+	# Update the value of HDRLEN for the input image in case the
+	# header has grown since the image was opened.
+
+	IM_HDRLEN(o_im) = LEN_IMHDR +
+	    (strlen(Memc[IM_USERAREA(o_im)])+1 + SZ_STRUCT-1) / SZ_STRUCT
+
+	# Copy the header.
+	if (IM_LENHDRMEM(im) < IM_HDRLEN(o_im)) {
+	    IM_LENHDRMEM(im) = IM_HDRLEN(o_im) + (SZ_UAPAD / SZ_STRUCT)
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+	call amovi (IM_MAGIC(o_im), IM_MAGIC(im), IM_HDRLEN(o_im) + 1)
+
+	# If the old image was opened with an image section, modify the
+	# WCS of the new image accordingly.  The section is applied to the
+	# MWCS Lterm automatically when the WCS is loaded from an image,
+	# so all we have to do is load the WCS of the old image section,
+	# and store it in the new image.
+
+	if (IM_SECTUSED(o_im) == YES)
+	    if (!envgetb ("nomwcs")) {
+		iferr (mw = mw_open (NULL, IM_NPHYSDIM(o_im)))
+		    call erract (EA_WARN)
+		else {
+		    call mw_loadim (mw, o_im)
+		    call mw_saveim (mw, im)
+		    call mw_close (mw)
+		}
+	    }
+
+	# If the pixels of the old image were stored in byte stream mode,
+	# make the new image that way too.  Otherwise, the physical line
+	# length must be recomputed, as the new image may reside on a
+	# device with a different block size.
+
+	if (IM_LEN(im,1) == IM_PHYSLEN(im,1))
+	    IM_VCOMPRESS(im) = YES
+
+	IM_PIXOFF(im) = NULL
+	IM_HGMOFF(im) = NULL
+	IM_BLIST(im) = NULL
+	IM_SZBLIST(im) = 0
+	IM_NBPIX(im) = 0
+	IM_LIMTIME(im) = 0
+	IM_OHDR(im) = o_im
+	IM_PIXFILE(im) = EOS
+
+	IM_CTIME(im) = clktime (long(0))
+	IM_MTIME(im) = IM_CTIME(im)
+
+	# Add a line to the history file (inherited from old image).
+	call strcat ("New copy of ", IM_HISTORY(im), SZ_IMHIST)
+	call strcat (IM_NAME(o_im), IM_HISTORY(im), SZ_IMHIST)
+	call strcat ("\n", IM_HISTORY(im), SZ_IMHIST)
+end
diff --git a/sys/imio/immap.x b/sys/imio/immap.x
new file mode 100644
index 00000000..dc1a98ee
--- /dev/null
+++ b/sys/imio/immap.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMMAP -- Map an imagefile to an image structure.  This is the "open"
+# procedure for an imagefile.
+
+pointer procedure immap (imspec, acmode, hdr_arg)
+
+char	imspec[ARB]		#I image specification
+int	acmode			#I image access mode
+int	hdr_arg			#I length of user fields, or header pointer
+
+pointer	immapz()
+errchk	iki_init
+
+begin
+	call iki_init()
+	return (immapz (imspec, acmode, hdr_arg))
+end
diff --git a/sys/imio/immapz.x b/sys/imio/immapz.x
new file mode 100644
index 00000000..71e03c8c
--- /dev/null
+++ b/sys/imio/immapz.x
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMMAPZ -- Map an imagefile to an image structure.  This is the IMIO internal
+# version of the immap procedure, called once the IKI has been initialized.
+
+pointer procedure immapz (imspec, acmode, hdr_arg)
+
+char	imspec[ARB]		# image specification
+int	acmode			# image access mode
+int	hdr_arg			# length of user fields, or header pointer
+
+pointer	sp, imname, root, cluster, ksection, section, im
+char	inname[SZ_PATHNAME]
+int	min_lenuserarea, len_imhdr, cl_index, cl_size, i, val
+int	btoi(), ctoi(), envfind(), fnroot(), strlen(), envgeti(), strncmp()
+errchk	im_make_newcopy, im_init_newimage, malloc
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_PATHNAME, TY_CHAR)
+	call salloc (cluster, SZ_PATHNAME, TY_CHAR)
+	call salloc (ksection, SZ_FNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+
+	# The user or system manager can specify the minimum user area size
+	# as an environment variable, if the IRAF default is too small.
+
+	if (envfind ("min_lenuserarea", Memc[section], SZ_FNAME) > 0) {
+	    i = 1
+	    if (ctoi (Memc[section], i, min_lenuserarea) <= 0)
+		min_lenuserarea = MIN_LENUSERAREA
+	} else
+	    min_lenuserarea = MIN_LENUSERAREA
+
+
+	# If we're given a URL to an image, cache the file.
+	if (strncmp ("http://", imspec, 7) == 0)
+	    call fcadd ("cache$", imspec, "", inname, SZ_PATHNAME)
+	else if (strncmp ("file:///localhost", imspec, 17) == 0)
+	    call strcpy (imspec[18], inname, SZ_PATHNAME)
+	else if (strncmp ("file://localhost", imspec, 16) == 0)
+	    call strcpy (imspec[17], inname, SZ_PATHNAME)
+	else if (strncmp ("file://", imspec, 7) == 0)
+	    call strcpy (imspec[7], inname, SZ_PATHNAME)
+	else
+	    call strcpy (imspec, inname, SZ_PATHNAME)
+
+
+	# Parse the full image specification into its component parts.
+	call imparse (inname, Memc[cluster],SZ_PATHNAME,
+	    Memc[ksection],SZ_FNAME, Memc[section],SZ_FNAME, cl_index,cl_size)
+
+	# Allocate buffer for image descriptor/image header.  Note the dual
+	# use of the HDR_ARG argument.  In the case of a new copy image,
+	# hdr_arg is a pointer to the image to be copied; otherwise is is the
+	# length of the user area in CHARS (since the user area is a string
+	# buffer).
+
+	if (acmode == NEW_COPY) {
+	    len_imhdr = max (LEN_IMHDR + min_lenuserarea / SZ_STRUCT,
+		IM_HDRLEN(hdr_arg) + SZ_UAPAD / SZ_STRUCT)
+	} else {
+	    len_imhdr = LEN_IMHDR +
+		max (min_lenuserarea, int(hdr_arg)) / SZ_STRUCT
+	}
+
+	call malloc (im, LEN_IMDES + len_imhdr, TY_STRUCT)
+	call aclri (Memi[im], LEN_IMDES + min (len_imhdr, LEN_IMHDR + 1))
+	IM_LENHDRMEM(im) = len_imhdr
+
+	# Initialize the image descriptor structure.
+	IM_ACMODE(im) = acmode
+	IM_PFD(im)    = NULL
+	IM_HDRLEN(im) = len_imhdr
+	IM_UPDATE(im) = btoi (acmode != READ_ONLY)
+	IM_UABLOCKED(im) = -1
+
+	# Initialize options.
+	IM_VNBUFS(im) = 1
+	IM_VCOMPRESS(im) = DEF_COMPRESS
+	IM_VADVICE(im) = DEF_ADVICE
+
+	# Initialize the IMIO buffer size defaults.  The builtin defaults
+	# are used unless a value is explicitly set in the environment;
+	# an IMSET on the open descriptor will override either.
+
+	IM_VBUFSIZE(im) = DEF_FIOBUFSIZE
+	ifnoerr (val = envgeti (ENV_BUFSIZE))
+	    IM_VBUFSIZE(im) = val / SZB_CHAR
+	IM_VBUFFRAC(im) = DEF_FIOBUFFRAC
+	ifnoerr (val = envgeti (ENV_BUFFRAC))
+	    IM_VBUFFRAC(im) = val
+	IM_VBUFMAX(im) = DEF_MAXFIOBUFSIZE
+	ifnoerr (val = envgeti (ENV_BUFMAX))
+	    IM_VBUFMAX(im) = val
+
+	# Set fast i/o flag to yes initially to force IMOPSF and hence IMSETBUF
+	# to be called when the first i/o operation occurs.
+
+	IM_FAST(im) = YES
+IM_FAST(im) = NO
+
+	# Set the image name field, used by IMERR everywhere.
+	call strcpy (inname, IM_NAME(im), SZ_IMNAME)
+
+	# Initialize the mode dependent fields of the image header.
+	if (acmode == NEW_COPY)
+	    call im_make_newcopy (im, hdr_arg)
+	else if (acmode == NEW_IMAGE)
+	    call im_init_newimage (im, IM_HDRLEN(im))
+
+	# Set the following in case it isn't set by the kernel.
+	call strcpy ("imhdr", IM_MAGIC(im), SZ_IMMAGIC)
+
+	# Physically open the image and read the header.  Note that IKI_OPEN
+	# may realloc the image descriptor if additional space is required,
+	# hence the pointer IM may be modified.
+
+	iferr {
+	    call iki_open (im, Memc[cluster], Memc[ksection],
+		cl_index, cl_size, acmode, hdr_arg)
+	} then {
+	    call mfree (im, TY_STRUCT)
+	    call erract (EA_ERROR)
+	}
+
+	# Format a full image name specification if we have a cl_index format
+	# image.  IM_NAME is used mainly as an image identifier in error
+	# messages, so truncate the string by omitting some of the leading
+	# pathname information if the resultant string would be excessively
+	# long.
+
+	if (IM_CLSIZE(im) > 1) {
+	    call sprintf (Memc[imname], SZ_PATHNAME, "%s[%d/%d]%s%s")
+		call pargstr (Memc[cluster])
+		call pargi (IM_CLINDEX(im))
+		call pargi (IM_CLSIZE(im))
+		call pargstr (Memc[ksection])
+		call pargstr (Memc[section])
+
+	    if (strlen (Memc[imname]) > SZ_IMNAME) {
+		i = fnroot (Memc[cluster], Memc[root], SZ_FNAME)
+		call sprintf (Memc[imname], SZ_PATHNAME, "%s[%d/%d]%s%s")
+		    call pargstr (Memc[root])
+		    call pargi (IM_CLINDEX(im))
+		    call pargi (IM_CLSIZE(im))
+		    call pargstr (Memc[ksection])
+		    call pargstr (Memc[section])
+	    }
+
+	    call strcpy (Memc[imname], IM_NAME(im), SZ_IMNAME)
+	}
+
+	# Save those image header fields that get modified if an image section
+	# is specified.
+
+	IM_NPHYSDIM(im) = IM_NDIM(im)
+	IM_SVMTIME(im)  = IM_MTIME(im)
+	call amovl (IM_LEN(im,1), IM_SVLEN(im,1), IM_MAXDIM)
+
+	# Process the image section if one was given, i.e., parse the section
+	# string and set up a transformation to be applied to logical input
+	# vectors.
+
+	if (Memc[section] != EOS) {
+	    if (acmode == NEW_COPY || acmode == NEW_IMAGE) {
+		call iki_close (im)
+		call mfree (im, TY_STRUCT)
+		call imerr (IM_NAME(im), SYS_IMSECTNEWIM)
+	    }
+	    call imisec (im, Memc[section])
+	    IM_SECTUSED(im) = YES
+	} else {
+	    # IM_VOFF is already zero, because of the CALLOC.
+	    call amovkl (long(1), IM_VSTEP(im,1), IM_MAXDIM)
+	    do i = 1, IM_MAXDIM
+		IM_VMAP(im,i) = i
+	}
+
+	call sfree (sp)
+	return (im)
+end
diff --git a/sys/imio/imnote.x b/sys/imio/imnote.x
new file mode 100644
index 00000000..09547043
--- /dev/null
+++ b/sys/imio/imnote.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMNOTE -- Given the coordinates of a pixel, return the character offset
+# of that pixel in the pixel storage file.
+
+long procedure imnote (im, v)
+
+pointer	im			# image descriptor
+long	v[IM_MAXDIM]		# physical coords of pixel
+
+int	sz_pixel, i
+long	pixel_index, dim_offset, char_offset0
+include	<szpixtype.inc>
+
+begin
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+	pixel_index = v[1]
+	dim_offset = 1
+
+	do i = 2, IM_NPHYSDIM(im) {
+	    dim_offset = dim_offset * IM_PHYSLEN(im,i-1)
+	    pixel_index = pixel_index + dim_offset * (v[i] - 1)
+	}
+
+	char_offset0 = (pixel_index-1) * sz_pixel
+	return (IM_PIXOFF(im) + char_offset0)
+end
diff --git a/sys/imio/imopsf.x b/sys/imio/imopsf.x
new file mode 100644
index 00000000..f790481a
--- /dev/null
+++ b/sys/imio/imopsf.x
@@ -0,0 +1,140 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	<plset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fset.h>
+
+# IMOPSF -- Open (or create) the pixel storage file.  If the file has already
+# been opened do nothing but set the buffer size.  Until the pixel storage
+# file has been opened we do not know the device block size, image line length,
+# or whether IM_FAST type i/o is possible.
+
+procedure imopsf (im)
+
+pointer	im
+
+pointer	sp, imname, ref_im, pfd
+int	sv_acmode, sv_update, ndim, depth, i
+errchk	iki_opix, open
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_IMNAME, TY_CHAR)
+
+	if (IM_PL(im) != NULL) {
+	    if (IM_PFD(im) == NULL) {
+		# Complete the initialization of a mask image.
+		ref_im = IM_PLREFIM(im)
+
+		sv_acmode = IM_ACMODE(im)
+		sv_update = IM_UPDATE(im)
+		call strcpy (IM_NAME(im), Memc[imname], SZ_IMNAME)
+
+		if (ref_im != NULL) {
+		    # Create a mask the same size as the physical size of the
+		    # reference image.  Inherit any image section from the
+		    # reference image.
+
+		    IM_NDIM(im) = IM_NDIM(ref_im)
+		    IM_NPHYSDIM(im) = IM_NPHYSDIM(ref_im)
+		    IM_SECTUSED(im) = IM_SECTUSED(ref_im)
+		    call amovl (IM_LEN(ref_im,1), IM_LEN(im,1), IM_MAXDIM)
+		    call amovl (IM_PHYSLEN(ref_im,1),IM_PHYSLEN(im,1),IM_MAXDIM)
+		    call amovl (IM_SVLEN(ref_im,1), IM_SVLEN(im,1), IM_MAXDIM)
+		    call amovl (IM_VMAP(ref_im,1), IM_VMAP(im,1), IM_MAXDIM)
+		    call amovl (IM_VOFF(ref_im,1), IM_VOFF(im,1), IM_MAXDIM)
+		    call amovl (IM_VSTEP(ref_im,1), IM_VSTEP(im,1), IM_MAXDIM)
+
+		    # Tell PMIO to use this image as the reference image.
+		    call pm_seti (IM_PL(im), P_REFIM, im)
+
+		} else if (sv_acmode == NEW_IMAGE || sv_acmode == NEW_COPY) {
+		    # If ndim was not explicitly set, compute it by counting
+		    # the number of nonzero dimensions.
+
+		    ndim = IM_NDIM(im)
+		    if (ndim == 0) {
+			ndim = 1
+			while (IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM)
+			    ndim = ndim + 1
+			ndim = ndim - 1
+			IM_NDIM(im) = ndim
+		    }
+
+		    # Make sure dimension stuff makes sense.
+		    if (ndim < 0 || ndim > IM_MAXDIM)
+			call imerr (IM_NAME(im), SYS_IMNDIM)
+
+		    do i = 1, ndim
+			if (IM_LEN(im,i) <= 0)
+			    call imerr (IM_NAME(im), SYS_IMDIMLEN)
+
+		    # Set the unused higher dimensions to 1.  This makes it
+		    # possible to access the image as if it were higher
+		    # dimensional, and in a way it truely is.
+
+		    do i = ndim + 1, IM_MAXDIM
+			IM_LEN(im,i) = 1
+
+		    IM_NPHYSDIM(im) = ndim
+		    call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+		    call amovl (IM_LEN(im,1), IM_SVLEN(im,1), IM_MAXDIM)
+
+		    # Initialize the empty mask to the newly determined size.
+		    depth = PL_MAXDEPTH
+		    if (and (IM_PLFLAGS(im), PL_BOOL) != 0)
+			depth = 1
+		    call pl_ssize (IM_PL(im), IM_NDIM(im), IM_LEN(im,1), depth)
+		}
+
+		call strcpy (Memc[imname], IM_NAME(im), SZ_IMNAME)
+		IM_ACMODE(im) = sv_acmode
+		IM_UPDATE(im) = sv_update
+		IM_PIXOFF(im) = 1	
+		IM_HGMOFF(im) = NULL
+		IM_BLIST(im) = NULL
+		IM_HFD(im) = NULL
+
+		# Do the following in two statements so that IM_PFD does
+		# not get set if the OPEN fails and does an error exit.
+
+		pfd = open ("dev$null", READ_WRITE, BINARY_FILE)
+		IM_PFD(im) = pfd
+	    }
+
+	    # Execute this even if pixel file has already been opened.
+	    call imsetbuf (IM_PFD(im), im)
+
+	    # "Fast i/o" in the conventional sense no IMIO buffering)
+	    # is not permitted for mask images, since IMIO must buffer
+	    # the pixels, which are generated at run time.
+
+	    if (IM_FAST(im) == YES) {
+		IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_FAST)
+		IM_FAST(im) = NO
+	    }
+
+	} else {
+	    # Open the pixel file for a regular image.
+	    if (IM_PFD(im) == NULL)
+		call iki_opix (im)
+
+	    # Execute this even if pixel file has already been opened.
+	    call imsetbuf (IM_PFD(im), im)
+
+	    # If F_CLOSEFD is set on the pixel file, the host channel to the
+	    # file will be physically closed off except when an i/o operation
+	    # is in progress (used to conserve host file descriptors) in
+	    # applications which must open a large number of images all at
+	    # once).
+
+	    if (IM_VCLOSEFD(im) == YES)
+		call fseti (IM_PFD(im), F_CLOSEFD, YES)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/impak.gx b/sys/imio/impak.gx
new file mode 100644
index 00000000..feb37f2c
--- /dev/null
+++ b/sys/imio/impak.gx
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impak$t (a, b, npix, dtype)
+
+PIXEL	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call acht$tu (a, b, npix)
+	case TY_SHORT:
+	    call acht$ts (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call acht$ti (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call acht$ti (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call acht$tl (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call acht$tl (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call acht$tr (a, b, npix)
+	case TY_DOUBLE:
+	    call acht$td (a, b, npix)
+	case TY_COMPLEX:
+	    call acht$tx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/imparse.x b/sys/imio/imparse.x
new file mode 100644
index 00000000..cc98070d
--- /dev/null
+++ b/sys/imio/imparse.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+
+# IMPARSE -- Parse an image specification into the cluster name, cluster index,
+# cluster size, kernel section, and image section fields.
+#
+#	Syntax:		cluster[cl_index/cl_size][ksection][section]
+#
+# where all fields are optional except the cluster name.  In the limiting case
+# (cl_size = 1) the cluster name and image name are the same.  CL_INDEX and
+# CL_SIZE must be simple nonnegative decimal integer constants, if given.  The
+# [ character must be escaped to be included in the filename of the cluster.
+#
+# NOTE -- The image specification syntax is not frozen and further changes
+# are likely.  Use of this routine outside IMIO is not recommended as the
+# calling sequence may change.  Use imgname and imgsection instead.
+
+procedure imparse (imspec, cluster, sz_cluster, ksection, sz_ksection,
+	section, sz_section, cl_index, cl_size)
+
+char	imspec[ARB]		# full image specification
+char	cluster[ARB]		# receives cluster name
+int	sz_cluster		# max chars in cluster name
+char	ksection[ARB]		# receives kernel section
+int	sz_ksection		# max chars in kernel section name
+char	section[ARB]		# receives image section
+int	sz_section		# max chars in image section name
+int	cl_index		# receives cluster index (default -1)
+int	cl_size			# receives cluster size (default -1)
+
+pointer	sp, cp, secbuf
+int	ip, op, lbrack, level, ch, n
+bool	is_ksection, sect_out, ksect_out
+int	stridx()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (secbuf, SZ_LINE, TY_CHAR)
+
+	ip = 1
+	op = 1
+
+	# Extract cluster name.  The first (unescaped) [ marks the start of
+	# either the cl_index subscript or a section field.
+
+	for (ch=imspec[ip];  ch != EOS && ch != '[';  ch=imspec[ip]) {
+	    if (ch == '\\' && imspec[ip+1] == '[') {
+		cluster[op] = '\\'
+		op = op + 1
+		cluster[op] = '['
+		ip = ip + 1
+	    } else
+		cluster[op] = ch
+
+	    op = min (sz_cluster, op + 1)
+	    ip = ip + 1
+	}
+
+	cluster[op] = EOS
+	ksection[1] = EOS
+	section[1]  = EOS
+	lbrack      = ip
+	cl_index    = -1
+	cl_size     = -1
+
+	if (ch == EOS) {
+	    call sfree (sp)
+	    return
+	}
+
+	# If we have a [...] field, determine whether it is a cl_index
+	# subscript or a kernel or image section.  A cl_index subscript is
+	# anything with the syntax [ddd] or [ddd/ddd]; anything else is a
+	# kernel or image section.
+
+	ip = ip + 1
+	n = -1
+
+	for (ch=imspec[ip];  ch != EOS;  ch=imspec[ip]) {
+	    if (IS_DIGIT(ch)) {
+		if (n < 0)
+		    n = 0
+		n = (n * 10) + TO_INTEG(ch)
+	    } else if (ch == '/') {
+		cl_index = max (n, 1)
+		n = -1
+	    } else if (ch == ']') {
+		ip = ip + 1
+		break
+	    } else {
+		# Not a cl_index subscript; must be a section.
+		ip = lbrack
+		n = -1
+		break
+	    }
+	    ip = ip + 1
+	}
+
+	if (cl_index < 0)
+	    cl_index = n
+	else
+	    cl_size = n
+
+	# The rest of the input string consists of the kernel and image
+	# sections, if any.
+
+	sect_out = false
+	ksect_out = false
+
+	while (imspec[ip] == '[') {
+	    is_ksection = false
+	    cp = secbuf
+	    level = 0
+
+	    for (ch=imspec[ip];  ch != EOS;  ch=imspec[ip]) {
+		if (ch == '[')
+		    level = level + 1
+		else if (ch == ']')
+		    level = level - 1
+		else if (!is_ksection)
+		    if (stridx (imspec[ip], " 0123456789+-:*,") == 0)
+			is_ksection = true
+
+		Memc[cp] = ch
+		cp = cp + 1
+		ip = ip + 1
+
+		if (level == 0)
+		    break
+	    }
+	    Memc[cp] = EOS
+
+	    if (level != 0)
+		call syserrs (SYS_IMSYNSEC, imspec)
+	    if (is_ksection) {
+		if (ksect_out)
+		    call syserrs (SYS_IMSYNSEC, imspec)
+		call strcpy (Memc[secbuf], ksection, sz_ksection)
+		ksect_out = true
+	    } else {
+		if (sect_out)
+		    call syserrs (SYS_IMSYNSEC, imspec)
+		call strcpy (Memc[secbuf], section, sz_section)
+		sect_out = true
+	    }
+
+	    while (imspec[ip] != EOS && imspec[ip] != '[')
+		ip = ip + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/impgs.gx b/sys/imio/impgs.gx
new file mode 100644
index 00000000..1aa0f432
--- /dev/null
+++ b/sys/imio/impgs.gx
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgs$t (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imfls$t()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_PIXEL)
+	call zlocpr (imfls$t, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/impl1.gx b/sys/imio/impl1.gx
new file mode 100644
index 00000000..4fe23b4b
--- /dev/null
+++ b/sys/imio/impl1.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1$t (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgs$t(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+	    return (impgs$t (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/impl2.gx b/sys/imio/impl2.gx
new file mode 100644
index 00000000..545d2ed3
--- /dev/null
+++ b/sys/imio/impl2.gx
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2$t (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgs$t(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_PIXEL +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgs$t (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/impl3.gx b/sys/imio/impl3.gx
new file mode 100644
index 00000000..d9ed5699
--- /dev/null
+++ b/sys/imio/impl3.gx
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3$t (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgs$t(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_PIXEL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_PIXEL + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_PIXEL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_PIXEL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgs$t (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/impmhdr.x b/sys/imio/impmhdr.x
new file mode 100644
index 00000000..d8219996
--- /dev/null
+++ b/sys/imio/impmhdr.x
@@ -0,0 +1,331 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<ctype.h>
+
+.help impmhdr
+.nf --------------------------------------------------------------------------
+IMPMHDR -- Routines to encode/decode an image header in a title string
+such as is provided by pl_[save|load]f, so that general image headers can
+be saved in .pl files.
+
+	    nchars = im_pmsvhdr (im, bufp, sz_buf)
+		     im_pmldhdr (im, bufp)
+
+The information saved in the plio save file title string consist of a
+series of keyword = value assignments, one per line.
+.endhelp ---------------------------------------------------------------------
+
+define	DEF_SZBUF	32768
+define	INC_SZBUF	16384
+define	INC_HDRMEM	8100
+define	IDB_RECLEN	80
+
+define	KW_TITLE	"$TITLE = "
+define	LEN_KWTITLE	9
+define	KW_CTIME	"$CTIME = "
+define	LEN_KWCTIME	9
+define	KW_MTIME	"$MTIME = "
+define	LEN_KWMTIME	9
+define	KW_LIMTIME	"$LIMTIME = "
+define	LEN_KWLIMTIME	11
+define	KW_MINPIXVAL	"$MINPIXVAL = "
+define	LEN_KWMINPIXVAL	13
+define	KW_MAXPIXVAL	"$MAXPIXVAL = "
+define	LEN_KWMAXPIXVAL	13
+
+
+# IM_PMSVHDR -- Save an image header in a text string as a sequence of
+# keyword = value assignments, one per line.  A pointer to a text buffer
+# containing the encoded header is returned as the output parameter, and
+# the string length in chars is returned as the function value.
+# The caller should deallocate this buffer when it is no longer needed.
+
+int procedure im_pmsvhdr (im, bp, sz_buf)
+
+pointer	im				#I image descriptor
+pointer	bp				#U buffer containing encoded header
+int	sz_buf				#U allocated size of buffer, chars
+
+int	nchars, ualen, ch, i
+pointer	sp, tbuf, ip, op, idb, rp
+errchk	malloc, realloc, idb_open
+int	gstrcpy(), idb_nextcard
+pointer	idb_open()
+
+begin
+	call smark (sp)
+	call salloc (tbuf, SZ_IMTITLE, TY_CHAR)
+
+	# Allocate text buffer if the user hasn't already done so.
+	if (bp == NULL || sz_buf <= 0) {
+	    sz_buf = DEF_SZBUF
+	    call malloc (bp, sz_buf, TY_CHAR)
+	}
+
+	# Store title string in buffer.
+	call strcpy (IM_TITLE(im), Memc[tbuf], SZ_IMTITLE)
+	op = bp + gstrcpy (KW_TITLE, Memc[bp], ARB)
+	Memc[op] = '"';  op = op + 1
+	for (ip=tbuf;  Memc[ip] != EOS;  ip=ip+1) {
+	    if (Memc[ip] == '"') {
+		Memc[op] = '\\';  op = op + 1
+	    }
+	    Memc[op] = Memc[ip];  op = op + 1
+	}
+	Memc[op] = '"';  op = op + 1
+	Memc[op] = '\n';  op = op + 1
+
+	# Store the create time in buffer.
+	call sprintf (Memc[tbuf], SZ_IMTITLE, "%d")
+	    call pargl (IM_CTIME(im))
+	op = op + gstrcpy (KW_CTIME, Memc[op], ARB)
+	op = op + gstrcpy (Memc[tbuf], Memc[op], ARB)
+	Memc[op] = '\n';  op = op + 1
+
+	# Store the modify time in buffer.
+	call sprintf (Memc[tbuf], SZ_IMTITLE, "%d")
+	    call pargl (IM_MTIME(im))
+	op = op + gstrcpy (KW_MTIME, Memc[op], ARB)
+	op = op + gstrcpy (Memc[tbuf], Memc[op], ARB)
+	Memc[op] = '\n';  op = op + 1
+
+	# Store the limits time in buffer.
+	call sprintf (Memc[tbuf], SZ_IMTITLE, "%d")
+	    call pargl (IM_LIMTIME(im))
+	op = op + gstrcpy (KW_LIMTIME, Memc[op], ARB)
+	op = op + gstrcpy (Memc[tbuf], Memc[op], ARB)
+	Memc[op] = '\n';  op = op + 1
+
+	# Store the minimum good pixel value in buffer.
+	call sprintf (Memc[tbuf], SZ_IMTITLE, "%g")
+	    call pargr (IM_MIN(im))
+	op = op + gstrcpy (KW_MINPIXVAL, Memc[op], ARB)
+	op = op + gstrcpy (Memc[tbuf], Memc[op], ARB)
+	Memc[op] = '\n';  op = op + 1
+
+	# Store the maximum good pixel value in buffer.
+	call sprintf (Memc[tbuf], SZ_IMTITLE, "%g")
+	    call pargr (IM_MAX(im))
+	op = op + gstrcpy (KW_MAXPIXVAL, Memc[op], ARB)
+	op = op + gstrcpy (Memc[tbuf], Memc[op], ARB)
+	Memc[op] = '\n';  op = op + 1
+
+	# Copy the header cards.  
+	idb = idb_open (im, ualen)
+	while (idb_nextcard (idb, rp) != EOF) {
+
+	    # Increase the size of the output buffer if it fills.
+	    nchars = op - bp
+	    if (sz_buf - nchars < IDB_RECLEN) {
+		sz_buf = sz_buf + INC_SZBUF
+		call realloc (bp, sz_buf, TY_CHAR)
+		op = bp + nchars
+	    }
+
+	    # Copy the card, stripping any trailing whitespace.
+	    nchars = 0
+	    do i = 1, IDB_RECLEN {
+		ch = Memc[rp+i-1]
+		Memc[op+i-1] = ch
+		if (!IS_WHITE(ch))
+		    nchars = i
+	    }
+
+	    op = op + nchars 
+	    Memc[op] = '\n';  op = op + 1
+	}
+
+	# All done, terminate the string and return any extra space.
+	Memc[op] = EOS;  op = op + 1
+	nchars = op - bp
+	call realloc (bp, nchars, TY_CHAR)
+
+	# Clean up.
+	call idb_close (idb)
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# IM_PMLDHDR -- Load the image header from a save buffer, prepared in a
+# previous call to im_pmsvhdr.  The saved header will overwrite any
+# existing cards in the output image header.
+
+procedure im_pmldhdr (im, bp)
+
+pointer	im			#I image descriptor
+pointer	bp			#I pointer to text buffer (header save buf)
+
+int	hdrlen, sz_ua, nchars, ch, i
+pointer	sp, tbuf, ip, op, rp, ua
+int	strncmp(), ctol(), ctor()
+errchk	realloc
+
+begin
+	call smark (sp)
+	call salloc (tbuf, SZ_IMTITLE, TY_CHAR)
+
+	# Get the image title string.
+	for (ip = bp;  Memc[ip] != EOS;) {
+	    if (Memc[ip] == '$') {
+		if (strncmp (Memc[ip], KW_TITLE, LEN_KWTITLE) == 0) {
+		    # Advance to first character of quoted string.
+		    ip = ip + LEN_KWTITLE
+		    while (Memc[ip] != EOS && Memc[ip] != '"')
+			ip = ip + 1
+		    if (Memc[ip] == '"')
+			ip = ip + 1
+
+		    # Extract the string.
+		    op = tbuf
+		    while (Memc[ip] != EOS && Memc[ip] != '"') {
+			if (Memc[ip] == '\\' && Memc[ip+1] == '"')
+			    ip = ip + 1
+			Memc[op] = Memc[ip]
+			op = min (tbuf + SZ_IMTITLE, op + 1)
+			ip = ip + 1
+		    }
+
+		    # Store in image descriptor.
+		    Memc[op] = EOS
+		    call strcpy (Memc[tbuf], IM_TITLE(im), SZ_IMTITLE)
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_CTIME, LEN_KWCTIME) == 0) {
+		    # Decode the create time.
+		    ip = ip + LEN_KWCTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, IM_CTIME(im)) <= 0)
+			IM_CTIME(im) = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_MTIME, LEN_KWMTIME) == 0) {
+		    # Decode the modify time.
+		    ip = ip + LEN_KWMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, IM_MTIME(im)) <= 0)
+			IM_MTIME(im) = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_LIMTIME, LEN_KWLIMTIME) == 0) {
+		    # Decode the limits time.
+		    ip = ip + LEN_KWLIMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, IM_LIMTIME(im)) <= 0)
+			IM_LIMTIME(im) = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MINPIXVAL,LEN_KWMINPIXVAL)==0) {
+		    # Decode the minimum pixel value.
+		    ip = ip + LEN_KWMINPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, IM_MIN(im)) <= 0)
+			IM_MIN(im) = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MAXPIXVAL,LEN_KWMAXPIXVAL)==0) {
+		    # Decode the maximum pixel value.
+		    ip = ip + LEN_KWMAXPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, IM_MAX(im)) <= 0)
+			IM_MAX(im) = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else {
+	    	    # No keyword matched. Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+		}
+	    } else
+		break
+	}
+
+	# Get the header keywords.
+	hdrlen = LEN_IMDES + IM_LENHDRMEM(im)
+	sz_ua = (hdrlen - IMU) * SZ_STRUCT - 1
+	ua = IM_USERAREA(im)
+	op = ua
+
+	while (Memc[ip] != EOS) {
+	    rp = op
+
+	    # Reallocate descriptor if we need more space.  Since we are
+	    # called at image map time and the descriptor pointer has not
+	    # yet been passed out, the image descriptor can be reallocated.
+
+	    nchars = rp - ua
+	    if (nchars + IDB_RECLEN + 2 > sz_ua) {
+		hdrlen = hdrlen + INC_HDRMEM
+		IM_LENHDRMEM(im) = IM_LENHDRMEM(im) + INC_HDRMEM
+		call realloc (im, hdrlen, TY_STRUCT)
+		sz_ua = (hdrlen - IMU) * SZ_STRUCT - 1
+		ua = IM_USERAREA(im)
+		op = ua + nchars
+	    }
+
+	    # Copy the saved card, leave IP positioned to past newline.
+	    do i = 1, IDB_RECLEN + 1 {
+		ch = Memc[ip]
+		if (ch != EOS)
+		    ip = ip + 1
+		if (ch == '\n')
+		    break
+		Memc[op] = ch
+		op = op + 1
+	    }
+
+	    # Blank fill the card.
+	    while (op - rp < IDB_RECLEN) {
+		Memc[op] = ' '
+		op = op + 1
+	    }
+
+	    # Add newline termination.
+	    Memc[op] = '\n';  op = op + 1
+	}
+
+	Memc[op] = EOS
+	IM_UABLOCKED(im) = YES
+
+	call sfree (sp)
+end
diff --git a/sys/imio/impmlne1.x b/sys/imio/impmlne1.x
new file mode 100644
index 00000000..e8348349
--- /dev/null
+++ b/sys/imio/impmlne1.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMLNE1 -- Pixel mask line not empty.
+
+bool procedure im_pmlne1 (im)
+
+pointer	im			#I image descriptor
+long	v[IM_MAXDIM]
+
+bool	pm_linenotempty()
+
+begin
+	call amovkl (1, v, IM_MAXDIM)
+	return (pm_linenotempty (IM_PL(im), v))
+end
diff --git a/sys/imio/impmlne2.x b/sys/imio/impmlne2.x
new file mode 100644
index 00000000..6f15dfd1
--- /dev/null
+++ b/sys/imio/impmlne2.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMLNE2 -- Pixel mask line not empty.
+
+bool procedure im_pmlne2 (im, lineno)
+
+pointer	im			#I image descriptor
+int	lineno			#I line number
+
+long	v[IM_MAXDIM]
+bool	pm_linenotempty()
+
+begin
+	call amovkl (1, v, IM_MAXDIM)
+	v[2] = lineno
+
+	return (pm_linenotempty (IM_PL(im), v))
+end
diff --git a/sys/imio/impmlne3.x b/sys/imio/impmlne3.x
new file mode 100644
index 00000000..f41c8e11
--- /dev/null
+++ b/sys/imio/impmlne3.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMLNE3 -- Pixel mask line not empty.
+
+bool procedure im_pmlne3 (im, lineno, bandno)
+
+pointer	im			#I image descriptor
+int	lineno			#I line number
+int	bandno			#I band number
+
+long	v[IM_MAXDIM]
+bool	pm_linenotempty()
+
+begin
+	call amovkl (1, v, IM_MAXDIM)
+	v[2] = lineno
+	v[3] = bandno
+
+	return (pm_linenotempty (IM_PL(im), v))
+end
diff --git a/sys/imio/impmlnev.x b/sys/imio/impmlnev.x
new file mode 100644
index 00000000..d6d03b87
--- /dev/null
+++ b/sys/imio/impmlnev.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMLNEV -- Test if a mask image line is nonempty.
+
+bool procedure im_pmlnev (im, v)
+
+pointer	im			#I image descriptor
+long	v[IM_MAXDIM]		#I vector coordinates of image line
+
+bool	pm_linenotempty()
+
+begin
+	return (pm_linenotempty (IM_PL(im), v))
+end
diff --git a/sys/imio/impmmap.x b/sys/imio/impmmap.x
new file mode 100644
index 00000000..21ec5038
--- /dev/null
+++ b/sys/imio/impmmap.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pmset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMMAP -- Map a pixel list as a virtual mask image.  If the mask name
+# given is "BPM" (upper case) the bad pixel list for the reference image is
+# opened, if the mask name is "EMPTY" an empty mask is opened, otherwise the
+# mask name is taken to be the name of the file in which the mask is stored.
+# If there is no bad pixel list for the image an empty mask is opened.
+# If a more specialized mask is needed it should be opened or generated via
+# explicit calls to the PMIO package, and then mapped onto an image descriptor
+# with IM_PMMAPO.
+
+pointer procedure im_pmmap (mask, mode, ref_im)
+
+char	mask[ARB]		#I mask file name or "BPM"
+int	mode			#I mode and flag bits
+pointer	ref_im			#I reference image
+
+pointer	sp, cluster, section, pl, im, hp
+int	acmode, flags, sz_svhdr, ip
+pointer	im_pmmapo(), im_pmopen()
+int	btoi(), ctoi(), envfind()
+errchk	im_pmopen, im_pmopen
+
+begin
+	call smark (sp)
+	call salloc (cluster, SZ_PATHNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	acmode = PL_ACMODE(mode)
+	flags  = PL_FLAGS(mode)
+
+	# If opening an existing mask, get a buffer for the saved mask image
+	# header.
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    ip = 1
+	    if (envfind ("min_lenuserarea", Memc[section], SZ_FNAME) > 0) {
+		if (ctoi (Memc[section], ip, sz_svhdr) <= 0)
+		    sz_svhdr = MIN_LENUSERAREA
+	    } else
+		sz_svhdr = MIN_LENUSERAREA
+	    call salloc (hp, sz_svhdr, TY_CHAR)
+	}
+
+	# Parse the full image specification into a root name and an image
+	# section.
+	call imgimage (mask, Memc[cluster], SZ_PATHNAME)
+	call imgsection (mask, Memc[section], SZ_FNAME)
+
+	# Open the mask.
+	pl = im_pmopen (Memc[cluster], mode, Memc[hp], sz_svhdr, ref_im)
+
+	# Map the mask onto an image descriptor.
+	iferr (im = im_pmmapo (pl, ref_im)) {
+	    call pl_close (pl)
+	    call erract (EA_ERROR)
+	} else {
+	    call strcpy (mask, IM_NAME(im), SZ_IMNAME)
+	    if (acmode != NEW_IMAGE && acmode != NEW_COPY)
+		call im_pmldhdr (im, hp)
+	}
+
+	# Set flag to close PL descriptor at IMUNMAP time.
+	IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_CLOSEPL)
+
+	# If we are creating a new mask of type boolean, set bool flag so
+	# that imopsf will make a boolean mask.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	    if (and (flags, BOOLEAN_MASK) != 0)
+		IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_BOOL)
+
+	# Set access mode for mask, and mask update at unmap flag.
+	IM_ACMODE(im) = acmode
+	IM_UPDATE(im) = btoi (acmode != READ_ONLY)
+
+	IM_NPHYSDIM(im) = IM_NDIM(im)
+	call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	call amovl (IM_LEN(im,1), IM_SVLEN(im,1),   IM_MAXDIM)
+
+	# Set up section transformation.
+	if (ref_im == NULL && Memc[section] != EOS)
+	    call imisec (im, Memc[section])
+
+	call sfree (sp)
+	return (im)
+end
diff --git a/sys/imio/impmmapo.x b/sys/imio/impmmapo.x
new file mode 100644
index 00000000..318ce573
--- /dev/null
+++ b/sys/imio/impmmapo.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<plio.h>
+
+# IM_PMMAPO -- Map an open pixel list onto an image descriptor, so that the
+# pixel list may be accessed as a virtual "mask image".  If a reference image
+# is specified the mask image inherits any image section etc., defined for
+# the reference image.
+
+pointer procedure im_pmmapo (pl, ref_im)
+
+pointer	pl			#I mask descriptor
+pointer	ref_im			#I reference image or NULL
+
+pointer	im
+long	axlen[IM_MAXDIM]
+int	naxes, depth, i
+errchk	syserr, immapz, pl_gsize
+pointer	immapz()
+
+begin
+	# Get the mask size.
+	call pl_gsize (pl, naxes, axlen, depth)
+
+	# Verify the size if there is a reference image.
+	if (ref_im != NULL)
+	    do i = 1, max (naxes, IM_NPHYSDIM(ref_im))
+		if (IM_SVLEN(ref_im,i) != axlen[i])
+		    call syserr (SYS_IMPLSIZE)
+
+	# Open an image header for the mask.
+	call iki_init()
+	im = immapz ("dev$null", NEW_IMAGE, 0)
+
+	# Set up the image descriptor.
+	IM_NDIM(im) = naxes
+	IM_PIXTYPE(im) = TY_INT
+	call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+
+	IM_PL(im)	= pl
+	IM_PLREFIM(im)	= ref_im
+	IM_PLFLAGS(im)	= 0
+	IM_MIN(im)      = 0
+	IM_MAX(im)      = 2 ** depth - 1
+	IM_LIMTIME(im)  = IM_MTIME(im) + 1
+	IM_UPDATE(im)	= NO
+
+	PM_REFIM(pl) = im
+	if (ref_im != NULL)
+	    PM_MAPXY(pl) = IM_SECTUSED(ref_im)
+	else
+	    PM_MAPXY(pl) = NO
+
+	# Further setup of the image descriptor is carried out by IMOPSF
+	# when the first i/o access occurs, as for a regular image.
+
+	return (im)
+end
diff --git a/sys/imio/impmopen.x b/sys/imio/impmopen.x
new file mode 100644
index 00000000..bd8a564b
--- /dev/null
+++ b/sys/imio/impmopen.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<pmset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMOPEN -- Open an image mask.  If the mask name is given is "BPM" (upper
+# case) the bad pixel list for the reference image is opened, if the mask name
+# is "EMPTY" an empty mask is opened, otherwise the mask name is taken to be
+# the name of the file in which the mask is stored.  If there is no bad pixel
+# list for the image an empty mask is opened.  If a more specialized mask is
+# needed it should be opened or generated via explicit calls to the PMIO
+# package.
+
+pointer procedure im_pmopen (mask, mode, title, maxch, ref_im)
+
+char	mask[ARB]		#I mask file name or "BPM"
+int	mode			#I mode and flag bits
+char	title[maxch]		#O mask title
+int	maxch			#I max chars out
+pointer	ref_im			#I reference image
+
+pointer	sp, fname, pl, b_pl
+long	axlen[PL_MAXDIM], v[PL_MAXDIM]
+int	acmode, flags, naxes, depth
+
+bool	streq()
+pointer	pl_open(), pl_create()
+errchk	syserr, pl_open, pl_create, pl_loadf, pl_loadim
+
+string	s_empty	"EMPTY"		# the empty mask
+string	s_bpl	"BPM"		# the reference image bad pixel list
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	acmode = PL_ACMODE(mode)
+	flags  = PL_FLAGS(mode)
+
+	# Get mask name for the BPM for the given reference image.
+	if (streq (mask, s_bpl)) {
+	    if (ref_im == NULL)
+		call syserr (SYS_IMPLNORI)
+	    iferr (call imgstr (ref_im, s_bpl, Memc[fname], SZ_FNAME))
+		call strcpy (s_empty, Memc[fname], SZ_FNAME)
+	} else
+	    call strcpy (mask, Memc[fname], SZ_FNAME)
+
+	pl = pl_open (NULL)
+
+	# Open the named mask.
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (streq (Memc[fname], s_empty)) {
+		if (ref_im == NULL) {
+		    call pl_close (pl)
+		    call syserr (SYS_IMPLNORI)
+		}
+		call pl_ssize (pl, IM_NPHYSDIM(ref_im), IM_SVLEN(ref_im,1), 1)
+	    } else {
+		iferr (call pl_loadf (pl, Memc[fname], title, maxch)) {
+		    call pl_close (pl)
+		    pl = pl_open (NULL)
+		    iferr (call pl_loadim (pl, Memc[fname], title, maxch)) {
+			call pl_close (pl)
+		        call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	    # Modify the mask according to the given flags, if any.
+	    if (flags != 0) {
+		call pl_gsize (pl, naxes, axlen, depth)
+		call amovkl (1, v, PL_MAXDIM)
+
+		if (and (flags, BOOLEAN_MASK) != 0 && depth > 1) {
+		    b_pl = pl_create (naxes, axlen, 1)
+
+		    if (and (flags, INVERT_MASK) != 0) {
+		        call pl_rop (pl, v, b_pl, v, axlen, PIX_SRC)
+			call amovkl (1, v, PL_MAXDIM)
+		        call pl_rop (b_pl, v, b_pl, v, axlen, PIX_NOT(PIX_SRC))
+		    } else {
+		        call pl_rop (pl, v, b_pl, v, axlen, PIX_SRC)
+		    }
+
+		    call pl_close (pl)
+		    pl = b_pl
+
+		} else if (and (flags, INVERT_MASK) != 0)
+		    call pl_rop (pl, v, pl, v, axlen, PIX_NOT(PIX_SRC))
+	    }
+	}
+
+	call sfree (sp)
+	return (pl)
+end
diff --git a/sys/imio/impmsne1.x b/sys/imio/impmsne1.x
new file mode 100644
index 00000000..044aee81
--- /dev/null
+++ b/sys/imio/impmsne1.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+
+# IM_PMSNE1 -- Pixel mask section not empty.
+
+bool procedure im_pmsne1 (im, x1, x2)
+
+pointer	im			#I image descriptor
+int	x1, x2			#I section to be tested
+
+bool	pm_sectnotempty()
+
+begin
+	return (pm_sectnotempty (IM_PL(im), x1, x2, 1))
+end
diff --git a/sys/imio/impmsne2.x b/sys/imio/impmsne2.x
new file mode 100644
index 00000000..42cb7141
--- /dev/null
+++ b/sys/imio/impmsne2.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+
+# IM_PMSNE2 -- Pixel mask section not empty.
+
+bool procedure im_pmsne2 (im, x1, x2, y1, y2)
+
+pointer	im			#I image descriptor
+int	x1, x2			#I section to be tested
+int	y1, y2			#I section to be tested
+
+long	vs[2], ve[2]
+bool	pm_sectnotempty()
+
+begin
+	vs[1] = x1;  vs[2] = y1
+	ve[1] = x2;  ve[2] = y2
+
+	return (pm_sectnotempty (IM_PL(im), vs, ve, 2))
+end
diff --git a/sys/imio/impmsne3.x b/sys/imio/impmsne3.x
new file mode 100644
index 00000000..15a132d6
--- /dev/null
+++ b/sys/imio/impmsne3.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+
+# IM_PMSNE3 -- Pixel mask section not empty.
+
+bool procedure im_pmsne3 (im, x1,x2, y1,y2, z1,z2)
+
+pointer	im			#I image descriptor
+int	x1, x2			#I section to be tested
+int	y1, y2			#I section to be tested
+int	z1, z2			#I section to be tested
+
+long	vs[3], ve[3]
+bool	pm_sectnotempty()
+
+begin
+	vs[1] = x1;  vs[2] = y1;  vs[3] = z1
+	ve[1] = x2;  ve[2] = y2;  ve[3] = z2
+
+	return (pm_sectnotempty (IM_PL(im), vs, ve, 3))
+end
diff --git a/sys/imio/impmsnev.x b/sys/imio/impmsnev.x
new file mode 100644
index 00000000..f50fefb6
--- /dev/null
+++ b/sys/imio/impmsnev.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IM_PMSNEV -- Test if a mask image section is nonempty.
+
+bool procedure im_pmsnev (im, vs, ve, ndim)
+
+pointer	im			#I image descriptor
+long	vs[IM_MAXDIM]		#I vector coordinates of start of section
+long	ve[IM_MAXDIM]		#I vector coordinates of end of section
+int	ndim			#I dimensionality of section
+
+bool	pm_sectnotempty()
+
+begin
+	return (pm_sectnotempty (IM_PL(im), vs, ve, ndim))
+end
diff --git a/sys/imio/impnl.gx b/sys/imio/impnl.gx
new file mode 100644
index 00000000..27acdfae
--- /dev/null
+++ b/sys/imio/impnl.gx
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnl$t (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imfls$t()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_PIXEL)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imfls$t, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/impnln.x b/sys/imio/impnln.x
new file mode 100644
index 00000000..f5197768
--- /dev/null
+++ b/sys/imio/impnln.x
@@ -0,0 +1,109 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNLN -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be written before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN.  EOF is returned
+# when the last line in the image has been written.
+
+int procedure impnln (im, lineptr, v, dtype)
+
+pointer	im
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	dtype				# eventual datatype of pixels
+
+long	lineoff, line, band, offset
+int	dim, ndim, junk, sz_pixel, sz_dtype, fd, nchars, pixtype
+long	vs[IM_MAXDIM], ve[IM_MAXDIM], unit_v[IM_MAXDIM], npix
+
+int	imloop()
+pointer	imgobf(), fwritep()
+errchk	imgobf, fwritep, imerr, imopsf
+define	retry_ 91
+define	oob_ 92
+define	misaligned_ 93
+
+int	sizeof()
+include	<szpixtype.inc>
+data	unit_v /IM_MAXDIM * 1/
+
+begin
+	ndim = IM_NDIM(im)
+	if (ndim == 0)
+	    return (EOF)
+
+	npix = IM_LEN(im,1)			# write entire line
+	pixtype = IM_PIXTYPE(im)
+	sz_pixel = pix_size[pixtype]
+	sz_dtype = sizeof(pixtype)
+
+	# Perform "zero trip" check (V >= VE), before entering "loop".
+	if (v[ndim] > IM_LEN(im,ndim))
+	    return (EOF)
+retry_
+	if (IM_FAST(im) == YES && pixtype == dtype && ndim <= 3) {
+	    fd = IM_PFD(im)
+	    if (fd == NULL) {
+		call imopsf (im)
+		goto retry_
+	    }
+
+	    # Lineoff is the dimensionless line offset in the pixel storage
+	    # file (which we assume to be in line storage mode).
+
+	    lineoff = 0
+	    if (ndim > 1) {
+		line = v[2]
+		if (line < 1 || line  > IM_LEN(im,2))
+		    goto oob_
+		lineoff = line - 1
+		if (ndim > 2) {
+		    band = v[3]
+		    if (band < 1 || band > IM_LEN(im,3))
+oob_			call imerr (IM_NAME(im), SYS_IMREFOOB)
+		    lineoff = lineoff + (band - 1) * IM_PHYSLEN(im,2)
+		}
+	    }
+
+	    # Reference directly into the FIO buffer.  If the line straddles
+	    # FIO block boundaries then fwritep will return error and we must
+	    # use a separate buffer.
+
+	    offset = lineoff * IM_PHYSLEN(im,1) * sz_pixel + IM_PIXOFF(im)
+	    nchars = IM_PHYSLEN(im,1) * sz_pixel
+	    iferr (lineptr = (fwritep (fd, offset, nchars) - 1) / sz_pixel + 1)
+		goto misaligned_
+
+	} else {
+misaligned_
+	    # Prepare section descriptor vectors.
+	    vs[1] = 1
+	    ve[1] = npix
+	    do dim = 2, ndim {
+		vs[dim] = v[dim]
+		ve[dim] = v[dim]
+	    }
+	    
+	    # Get the output line buffer.
+	    lineptr = imgobf (im, vs, ve, ndim, dtype)
+	    IM_FLUSH(im) = YES
+	}
+
+	# Increment loop vector (cannot use nested loops since the dimension
+	# of the image is variable).  Note this loop vector references
+	# logical section coordinates.
+
+	if (ndim == 1)
+	    v[1] = IM_LEN(im,1) + 1
+	else if (ndim == 2 && IM_FAST(im) == YES)
+	    v[2] = v[2] + 1
+	else
+	    junk = imloop (v, unit_v, IM_LEN(im,1), unit_v, ndim)
+
+	return (npix)
+end
diff --git a/sys/imio/imps1.gx b/sys/imio/imps1.gx
new file mode 100644
index 00000000..9e225923
--- /dev/null
+++ b/sys/imio/imps1.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1$t (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgs$t(), impl1$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1$t (im))
+	else
+	    return (impgs$t (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/imps2.gx b/sys/imio/imps2.gx
new file mode 100644
index 00000000..ee5ac4a3
--- /dev/null
+++ b/sys/imio/imps2.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2$t (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgs$t(), impl2$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2$t (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgs$t (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/imps3.gx b/sys/imio/imps3.gx
new file mode 100644
index 00000000..490ee531
--- /dev/null
+++ b/sys/imio/imps3.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3$t (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgs$t(), impl3$t()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3$t (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgs$t (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/imrbpx.x b/sys/imio/imrbpx.x
new file mode 100644
index 00000000..ea54aeff
--- /dev/null
+++ b/sys/imio/imrbpx.x
@@ -0,0 +1,129 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMRBPX -- Read a line segment from an image with boundary extension.  The
+# line segment is broken up into three parts, i.e., left, center, and right.
+# The endpoints of each segment, if out of bounds, are mapped back into the
+# image using the current boundary extension technique.  The mapped line
+# segment in physical coordinates is then extracted; if an image section is
+# defined the section transformation has already been performed before we are
+# called.  After all three segments have been extracted the entire line
+# segment is flipped if the flip flag is set.
+
+procedure imrbpx (im, obuf, totpix, v, vinc)
+
+pointer	im			# image descriptor
+char	obuf[ARB]		# typeless output buffer
+int	totpix			# total number of pixels to extract
+long	v[ARB]			# vector pointer to start of line segment
+long	vinc[ARB]		# step on each axis
+
+bool	oob
+char	pixval[8]
+int	npix, ndim, sz_pixel, btype, op, off, step, xstep, imtyp, i, j, k, ncp
+long	xs[3], xe[3], x1, x2, p, v1[IM_MAXDIM], v2[IM_MAXDIM], linelen
+errchk	imrdpx
+include	<szpixtype.inc>
+
+begin
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+	ndim = IM_NPHYSDIM(im)
+
+	# Cache the left and right endpoints of the line segment and the
+	# image line length.
+
+	xstep = abs (IM_VSTEP(im,1))
+	linelen = IM_SVLEN(im,1)
+	x1 = v[1]
+	x2 = x1 + (totpix * xstep) - 1
+
+	# Compute the endpoints of the line segment in the three x-regions of 
+	# the image.
+
+	xs[1] = x1				# left oob region
+	xe[1] = min (0, x2)
+	xs[2] = max (x1, 1)			# central inbounds region
+	xe[2] = min (x2, linelen)
+	xs[3] = max (x1, linelen + 1)		# right oob region
+	xe[3] = x2
+
+	# Perform bounds mapping on the entire vector.  The mapping for all
+	# dimensions higher than the first is invariant in what follows.
+
+	call imbtran (im, v, v1, ndim)
+
+	# Copy V1 to V2 and determine if the whole thing is out of bounds.
+	oob = false
+	do i = 2, ndim {
+	    p = v1[i]
+	    v2[i] = p
+	    if (p < 1 || p > IM_SVLEN(im,i))
+		oob = true
+	}
+	
+	# Extract that portion of the line segment falling in each region
+	# into the output buffer.  There are two classes of boundary extension
+	# techniques, those that fill the out of bounds area with a constant,
+	# and those that map the oob area into a vector lying within the bounds
+	# of the image.
+
+	btype = IM_VTYBNDRY(im)
+	imtyp = IM_PIXTYPE(im)
+	op = 1
+
+	do i = 1, 3 {
+	    # Skip to next region if there are no pixels in this region.
+	    npix = (xe[i] - xs[i]) / xstep + 1
+	    if (npix <= 0)
+		next
+
+	    # Map the endpoints of the segment.
+	    call imbtran (im, xs[i], v1[1], 1)
+	    call imbtran (im, xe[i], v2[1], 1)
+
+	    # Compute the starting vector V1, step in X, and the number of
+	    # pixels in the region allowing for subsampling.
+
+	    if (v1[1] > v2[1]) {
+		step = -xstep
+		v1[1] = v2[1]
+	    } else
+		step = xstep
+
+	    # Perform the boundary extension.
+	    ncp = sz_pixel
+	    call aclrc (pixval, 8)
+	    if ((i == 2 && !oob) || btype == BT_REFLECT || btype == BT_WRAP)
+		call imrdpx (im, obuf[op], npix, v1, step)
+	    else {
+		# Use constant or value of nearest boundary pixel.
+		if (btype == BT_CONSTANT)
+		    call impakr (IM_OOBPIX(im), pixval, 1, IM_PIXTYPE(im))
+		else
+		    call imrdpx (im, pixval, 1, v1, step)
+
+	    	if ((imtyp == TY_INT || imtyp == TY_LONG) && 
+		    SZ_INT != SZ_INT32) {
+	            	call iupk32 (pixval, pixval, 2) 
+			ncp = sz_pixel * 2
+		}
+		
+		# Fill the output array.
+		off = op - 1
+		do j = 1, npix {
+		    do k = 1, ncp
+			obuf[off+k] = pixval[k]
+		    off = off + ncp
+		}
+	    }
+
+	    op = op + (npix * ncp)
+	}
+
+	# Flip the output array if the step size in X is negative.
+	if (vinc[1] < 0)
+	    call imaflp (obuf, totpix, sz_pixel)
+end
diff --git a/sys/imio/imrdpx.x b/sys/imio/imrdpx.x
new file mode 100644
index 00000000..1c7d3564
--- /dev/null
+++ b/sys/imio/imrdpx.x
@@ -0,0 +1,112 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<syserr.h>
+include	<plset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMRDPX -- Read NPIX * STEP pixels, stored contiguously in the pixel storage
+# file, starting with the pixel whose coordinates are given by the vector V,
+# into the buffer BUF.  If the step size is not unity, accumulate pixels 1,
+# 1 + STEP, and so on for a total of NPIX pixels, at the start of the buffer.
+# If VINC is negative, flip the array of NPIX pixels end for end.
+
+procedure imrdpx (im, obuf, npix, v, xstep)
+
+pointer	im			# image descriptor
+char	obuf[ARB]		# output buffer
+int	npix			# number of pixels to extract
+long	v[IM_MAXDIM]		# physical coords of first pixel
+int	xstep			# step between pixels in X (neg for a flip)
+
+pointer	pl
+long	offset
+int	sz_pixel, nbytes, fd, op, step, nchars, n
+
+char	zbuf[1024]
+
+int	read()
+long	imnote()
+errchk	imerr, seek, read, pl_glpi, pl_glri
+include	<szpixtype.inc>
+
+begin
+	step = abs (xstep)
+	if (v[1] < 1 || ((npix-1) * step) + v[1] > IM_SVLEN(im,1))
+	    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+	pl = IM_PL(im)
+	fd = IM_PFD(im)
+	offset = imnote (im, v)
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+
+	# If the step size is small, read in all the data at once and
+	# resample.  Requires a buffer STEP times larger than necessary,
+	# but is most efficient for small step sizes.  If the step size
+	# is very large, read each pixel with a separate READ call (buffer
+	# size no larger than necessary).  Most efficient technique for very
+	# large step sizes.
+
+	if (pl != NULL) {
+	    # Read from a pixel list.  Range list i/o is permitted at this
+	    # level only if no pixel conversions are required, i.e., only if
+	    # "fast" i/o is enabled.  Otherwise, we must return pixels here
+	    # and then convert back to a range list after the conversions.
+
+	    n = ((npix-1) * step + 1)
+	    if (and (IM_PLFLAGS(im), PL_FAST+PL_RLIO) == PL_FAST+PL_RLIO)
+		call pl_glri (pl, v, obuf, 0, n, PIX_SRC)
+	    else {
+		call pl_glpi (pl, v, obuf, 0, n, PIX_SRC)
+		if (step > 1)
+		    call imsamp (obuf, obuf, npix, sz_pixel, step)
+	    }
+
+	} else if (step <= IM_MAXSTEP) {
+	    # Seek to the point V in the pixel storage file.  Compute size
+	    # of transfer.  Read in the data, resample.
+
+	    call seek (fd, offset)
+	    nchars = ((npix-1) * step + 1) * sz_pixel
+
+	    if (read (fd, obuf, nchars) != nchars)
+		call imerr (IM_NAME(im), SYS_IMNOPIX)
+	    if (step > 1)
+		call imsamp (obuf, obuf, npix, sz_pixel, step)
+
+	} else {
+	    # Seek and read each pixel directly into the output buffer.
+	    nchars = npix * sz_pixel
+
+	    for (op=1;  op <= nchars;  op=op+sz_pixel) {
+		call seek (fd, offset)
+		if (read (fd, obuf[op], sz_pixel) < sz_pixel)
+		    call imerr (IM_NAME(im), SYS_IMNOPIX)
+		offset = offset + (sz_pixel * step)
+	    }
+	}
+
+	# Flip the pixel array end for end.
+	if (xstep < 0)
+	    call imaflp (obuf, npix, sz_pixel)
+
+	# Byte swap if necessary.
+	nbytes = npix * sz_pixel * SZB_CHAR
+	if (IM_SWAP(im) == YES) {
+	    switch (sz_pixel * SZB_CHAR) {
+	    case 2:
+		call bswap2 (obuf, 1, obuf, 1, nbytes)
+	    case 4:
+		call bswap4 (obuf, 1, obuf, 1, nbytes)
+	    case 8:
+		call bswap8 (obuf, 1, obuf, 1, nbytes)
+	    }
+	}
+
+	if (pl == NULL) {
+	    if ((IM_PIXTYPE(im) == TY_INT || IM_PIXTYPE(im) == TY_LONG) &&
+	        SZ_INT != SZ_INT32)
+	            call iupk32 (obuf, obuf, npix)
+	}
+end
diff --git a/sys/imio/imrename.x b/sys/imio/imrename.x
new file mode 100644
index 00000000..9e0f08bf
--- /dev/null
+++ b/sys/imio/imrename.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMRENAME -- Rename an image.
+
+procedure imrename (old, new)
+
+char	old[ARB]		# old image name
+char	new[ARB]		# new image name
+
+begin
+	call iki_init()
+	call iki_rename (old, new)
+end
diff --git a/sys/imio/imrmbufs.x b/sys/imio/imrmbufs.x
new file mode 100644
index 00000000..1e0d7c5a
--- /dev/null
+++ b/sys/imio/imrmbufs.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+
+# IMRMBUFS -- Free any pixel data buffers currently allocated to an image.
+
+procedure imrmbufs (im)
+
+pointer	im			# image descriptor
+
+int	i
+pointer	ibdes, obdes
+
+begin
+	ibdes = IM_IBDES(im)
+	obdes = IM_OBDES(im)
+
+	if (ibdes != NULL) {
+	    for (i=0;  i < IM_VNBUFS(im);  i=i+1)
+		call mfree (BD_BUFPTR(ibdes + LEN_BDES * i), TY_CHAR)
+	    call mfree (ibdes, TY_STRUCT)
+	}
+
+	if (obdes != NULL) {
+	    call mfree (BD_BUFPTR(obdes), TY_CHAR)
+	    call mfree (obdes, TY_STRUCT)
+	}
+
+	IM_IBDES(im) = NULL
+	IM_OBDES(im) = NULL
+end
diff --git a/sys/imio/imsamp.x b/sys/imio/imsamp.x
new file mode 100644
index 00000000..43e144c9
--- /dev/null
+++ b/sys/imio/imsamp.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMSAMP -- Subsample a vector.
+
+procedure imsamp (a, b, npix, sz_pixel, step)
+
+char	a[ARB], b[ARB]
+int	npix, sz_pixel, step, i, j, in, out, delta_in
+
+begin
+	switch (sz_pixel) {
+	case SZ_SHORT:
+	    call imsmps (a, b, npix, step)
+	case SZ_LONG:
+	    call imsmpl (a, b, npix, step)
+
+	default:				# flip odd sized elements
+	    in = 0
+	    out	= 0
+	    delta_in = sz_pixel * step
+
+	    do j = 1, npix {
+		do i = 1, sz_pixel
+		    b[out+i] = a[in+i]
+		in = in + delta_in
+		out = out + sz_pixel
+	    }
+	}
+end
+
+
+# IMSMPS -- Sample an array of SHORT sized elements.
+
+procedure imsmps (a, b, npix, step)
+
+short	a[ARB], b[npix]
+int	npix, step, ip, op
+
+begin
+	ip = 1
+	do op = 1, npix {
+	    b[op] = a[ip]
+	    ip = ip + step
+	}
+end
+
+
+# IMSMPL -- Sample an array of LONG sized elements.
+
+procedure imsmpl (a, b, npix, step)
+
+long	a[ARB], b[npix]
+int	npix, step, ip, op
+
+begin
+	ip = 1
+	do op = 1, npix {
+	    b[op] = a[ip]
+	    ip = ip + step
+	}
+end
diff --git a/sys/imio/imsetbuf.x b/sys/imio/imsetbuf.x
new file mode 100644
index 00000000..3938f30a
--- /dev/null
+++ b/sys/imio/imsetbuf.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<fset.h>
+include	<imio.h>
+
+# IMSETBUF -- Set the FIO file buffer size for the pixel storage file.
+# We always make the buffer size equal to an integral number of image lines
+# if possible.  The actual number of image lines chosen depends on the
+# type of access expected and the size of an image line.  If image lines are
+# very large the FIO buffer will be shorter than a line.  We also compute
+# IM_FAST, the flag determining whether or not direct access to the FIO
+# buffer is permissible.
+
+procedure imsetbuf (fd, im)
+
+int	fd			# pixel storage file
+pointer	im			# image header pointer
+
+long	imsize, bufoff, blkoff
+int	maxlines, bufsize, szline, nlines, i
+int	opt_bufsize, max_bufsize, dev_blksize
+int	fstati(), sizeof()
+
+begin
+	IM_FAST(im) = NO
+
+	max_bufsize = fstati (fd, F_MAXBUFSIZE)
+	opt_bufsize = fstati (fd, F_OPTBUFSIZE)
+	dev_blksize = max (1, fstati (fd, F_BLKSIZE))
+
+	szline = IM_PHYSLEN(im,1) * sizeof(IM_PIXTYPE(im))
+	imsize = szline
+	do i = 2, IM_NDIM(im)
+	    imsize = imsize * IM_PHYSLEN(im,i)
+
+	# Compute the suggested buffer size.  If bufsize is set externally
+	# and buffrac is disabled (zero) then we try to use the bufsize
+	# value given.  If buffrac is enabled then we compute a bufsize
+	# based on this, and use the larger of this value or the default
+	# bufsize, but not more than DEF_MAXFIOBUFSIZE.  The parameter
+	# buffrac specifies the size of an image buffer as a fraction,
+	# in percent, of the total size of the image.
+	#
+	# For example if buffrac=10, the default buffer size will be either
+	# "bufsize", or 10% of the full image size, whichever is larger, but
+	# not more than DEF_MAXFIOBUFSIZE.  The intent of buffrac is to
+	# provide an adaptive mechanism for adjusting the size of the image
+	# buffers to match the image being accessed.  For small images the
+	# buffer will be the default bufsize (or less if the image is 
+	# smaller than this).  For very large images the buffer size will 
+	# increase until the builtin default maximum value DEF_MAXFIOBUFSIZE 
+	# is reached.  If more control is needed, buffrac can be set to zero,
+	# and bufsize will specify the buffer size to be used.  Even if
+	# buffrac is enabled, bufsize can be set to a large value to force
+	# a large buffer to be used.
+
+	bufsize = IM_VBUFSIZE(im)
+	if (IM_VBUFFRAC(im) > 0)
+	    bufsize = max(bufsize, min(IM_VBUFMAX(im),
+		imsize / 100 * min(100,IM_VBUFFRAC(im)) ))
+
+	# Compute max number of image lines that will fit in default buffer.
+	if (max_bufsize > 0)
+	    nlines = min(max_bufsize,max(opt_bufsize,bufsize)) / szline
+	else
+	    nlines = bufsize / szline
+
+	# Compute final number of image lines in buffer.
+	if (nlines == 0) {
+	    # Image lines are very long.  Use a buffer smaller than a line.
+	    call fseti (fd, F_ADVICE, SEQUENTIAL)
+	    return
+	} else if (IM_VADVICE(im) == RANDOM) {
+	    # Always buffer at least one line if the lines are short.
+	    nlines = 1
+	}
+
+	# Don't make the buffer any larger than the image.
+	maxlines = 1
+	do i = 2, IM_NDIM(im)
+	    maxlines = maxlines * IM_PHYSLEN(im,i)
+	nlines = min (nlines, maxlines)
+
+	# Tell FIO to align the first file buffer to the device block
+	# containing the first image line.  Ideally the image line will
+	# start on a block boundary but this does not have to be the case.
+
+	bufoff = (IM_PIXOFF(im) - 1) / dev_blksize * dev_blksize + 1
+	blkoff = IM_PIXOFF(im) - bufoff
+	call fseti (fd, F_FIRSTBUFOFF, bufoff)
+
+	# An integral number of image lines fit inside the default size
+	# buffer.  Tell FIO the minimum size buffer to use.  FIO will actually
+	# allocate a slightly larger buffer if bufsize is not an integral
+	# number of device blocks.
+
+	bufsize = blkoff + nlines * szline
+	call fseti (fd, F_BUFSIZE, bufsize)
+
+	# If a FIO buffer will hold at least two image lines, if no image
+	# section was given, if there is only one input line buffer, if
+	# we are not going to be referencing out of bounds, and the pixel
+	# data is properly aligned in the pixel file, then FAST i/o (directly
+	# into the FIO buffer) is possible provided no datatype conversion
+	# or byte swapping is desired or required.  If all these criteria
+	# are true enable fast i/o.
+
+	if ((bufsize / szline >= 2 && IM_SECTUSED(im) == NO) &&
+	    (IM_VNBUFS(im) == 1 && IM_VNBNDRYPIX(im) == 0) &&
+	    (mod (IM_PIXOFF(im), sizeof(IM_PIXTYPE(im)))) == 1 &&
+	    IM_SWAP(im) == NO) {
+
+	    IM_FAST(im) = YES
+IM_FAST(im) = NO
+	}
+end
diff --git a/sys/imio/imseti.x b/sys/imio/imseti.x
new file mode 100644
index 00000000..9fd0bc2d
--- /dev/null
+++ b/sys/imio/imseti.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+include	<fset.h>
+
+# IMSETI -- Set an IMIO parameter of type integer (or pointer).  For
+# completeness this routine can be used to set real valued parameters, but
+# obviously since the input value is integer a fractional value cannot be
+# set.
+
+procedure imseti (im, param, value)
+
+pointer	im			#I image descriptor
+int	param			#I parameter to be set
+int	value			#I integer value of parameter
+
+int	i
+pointer	ibdes
+errchk	calloc
+
+begin
+	switch (param) {
+	case IM_ADVICE:
+	    IM_VADVICE(im) = value
+	case IM_BUFSIZE:
+	    IM_VBUFSIZE(im) = value
+	case IM_BUFFRAC:
+	    IM_VBUFFRAC(im) = value
+	case IM_BUFMAX:
+	    IM_VBUFMAX(im) = value
+	case IM_COMPRESS:
+	    IM_VCOMPRESS(im) = value
+	case IM_NBNDRYPIX:
+	    IM_VNBNDRYPIX(im) = max (0, value)
+	case IM_TYBNDRY:
+	    IM_VTYBNDRY(im) = value
+	case IM_BNDRYPIXVAL:
+	    IM_OOBPIX(im) = real(value)
+	case IM_FLAGBADPIX:
+	    IM_VFLAGBADPIX(im) = value
+	case IM_PIXFD:
+	    IM_PFD(im) = value
+	case IM_WHEADER:
+	    IM_UPDATE(im) = value
+
+	case IM_PLDES:
+	    IM_PL(im) = value
+	case IM_RLIO:
+	    # Enable/disable range list i/o (for image masks).
+	    if (value == YES)
+		IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_RLIO)
+	    else
+		IM_PLFLAGS(im) = and (IM_PLFLAGS(im), not(PL_RLIO))
+
+	case IM_NBUFS:
+	    # Free any existing input buffers.
+	    ibdes = IM_IBDES(im)
+	    if (ibdes != NULL)
+		for (i=0;  i < IM_VNBUFS(im);  i=i+1)
+		    call mfree (BD_BUFPTR(ibdes + LEN_BDES * i), TY_CHAR)
+
+	    # Change size of buffer pool.
+	    IM_VNBUFS(im) = value
+
+	    # Reinit input buffer descriptors.  The actual input buffers will
+	    # be reallocated upon demand.
+
+	    if (ibdes != NULL) {
+		call mfree (IM_IBDES(im), TY_STRUCT)
+		call calloc (IM_IBDES(im), LEN_BDES * IM_VNBUFS(im), TY_STRUCT)
+		IM_NGET(im) = 0
+	    }
+
+	case IM_CANCEL:
+	    # Free any pixel data buffers associated with an image.
+	    call imrmbufs (im)
+
+	case IM_CLOSEFD:
+	    # Set F_CLOSEFD on the pixel file.
+	    IM_VCLOSEFD(im) = value
+	    if (IM_PFD(im) != NULL)
+		call fseti (IM_PFD(im), F_CLOSEFD, value)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMSETUNKPAR)
+	}
+end
diff --git a/sys/imio/imsetr.x b/sys/imio/imsetr.x
new file mode 100644
index 00000000..b0287458
--- /dev/null
+++ b/sys/imio/imsetr.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMSETR -- Set an IMIO parameter to a real value.  For completeness this
+# routine can be used to set integer valued parameters, although if the
+# value has a fractional part or requires more than 24 bits of precision
+# the results may be unpredictable.
+
+procedure imsetr (im, param, value)
+
+pointer	im			#I image descriptor
+int	param			#I parameter to be set
+real	value			#I value of parameter
+
+begin
+	switch (param) {
+	case IM_BNDRYPIXVAL:
+	    IM_OOBPIX(im) = value
+	default:
+	    call imseti (im, param, nint(value))
+	}
+end
diff --git a/sys/imio/imsinb.x b/sys/imio/imsinb.x
new file mode 100644
index 00000000..d0c8eb60
--- /dev/null
+++ b/sys/imio/imsinb.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMSINB -- Determine whether or not a section is in bounds.  Out of bounds
+# references are permissible if boundary extension is enabled.  The actual
+# dimensionality of the image need not agree with that of the section.
+
+int procedure imsinb (im, vs, ve, ndim)
+
+pointer	im			# image descriptor
+long	vs[ARB], ve[ARB]	# logical section
+int	ndim			# dimensionality of section
+
+int	i
+int	lo, hi, bwidth
+define	oob_ 91
+
+begin
+	# First check if the section is entirely within bounds.  If this is the
+	# case no boundary extension will be required, making optimization
+	# possible.
+
+	do i = 1, ndim {
+	    hi = IM_LEN(im,i)
+	    if (vs[i] < 1 || vs[i] > hi)
+		goto oob_
+	    if (ve[i] < 1 || ve[i] > hi)
+		goto oob_
+	}
+
+	return (YES)				# section is within bounds
+
+	# There is at least one out of bounds reference.  Check that all such
+	# references are within NBNDRYPIX of the nearest boundary.  NDIM may
+	# be greater than IM_NDIM, since IMIO sets the lengths of the excess
+	# dimensions to 1.  In effect every image has up to MAXDIM dimensions.
+ oob_
+	bwidth = IM_VNBNDRYPIX(im)
+	lo = 1 - bwidth
+	hi = 1 + bwidth
+
+	do i = 1, ndim {
+	    hi = IM_LEN(im,i) + bwidth
+	    if (vs[i] < lo || vs[i] > hi)
+		return (ERR)			# section is illegal
+	    if (ve[i] < lo || ve[i] > hi)
+		return (ERR)
+	}
+
+	return (NO)				# section is oob but legal
+end
diff --git a/sys/imio/imsslv.x b/sys/imio/imsslv.x
new file mode 100644
index 00000000..2cc5e2a8
--- /dev/null
+++ b/sys/imio/imsslv.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMSSLV -- Given two vectors (VS, VE) defining the starting and ending
+# physical coordinates of the two pixels defining an image section,
+# initialize the "loop index" vector V, and the "loop increment" vector,
+# VINC.  Compute NPIX, the number of pixels in a line segment.
+
+procedure imsslv (im, vs, ve, v, vinc, npix)
+
+pointer	im
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+long	v[IM_MAXDIM], vinc[IM_MAXDIM], npix, step
+int	i
+
+begin
+	# Determine the direction in which each dimension is to be
+	# traversed.
+
+	do i = 1, IM_NPHYSDIM(im) {
+	    step = abs (IM_VSTEP(im,i))
+	    if (vs[i] <= ve[i])
+		vinc[i] = step
+	    else
+		vinc[i] = -step
+	}
+
+	# Initialize the extraction vector (passed to IMRDS? to read a
+	# contiguous array of pixels).  Compute the length of a line,
+	# allowing for decimation by the step size.
+
+	do i = 1, IM_NPHYSDIM(im)
+	    v[i] = vs[i]
+
+	if (vs[1] > ve[1])
+	    v[1] = ve[1]
+
+	npix = (ve[1] - vs[1]) / vinc[1] + 1
+end
diff --git a/sys/imio/imstati.x b/sys/imio/imstati.x
new file mode 100644
index 00000000..0697911b
--- /dev/null
+++ b/sys/imio/imstati.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMSTATI -- Get an IMIO option of type integer.
+
+int procedure imstati (im, option)
+
+pointer	im			#I image descriptor
+int	option			#I imset option being queried
+
+begin
+	switch (option) {
+	case IM_ADVICE:
+	    return (IM_VADVICE(im))
+	case IM_BUFSIZE:
+	    return (IM_VBUFSIZE(im))
+	case IM_BUFFRAC:
+	    return (IM_VBUFFRAC(im))
+	case IM_BUFMAX:
+	    return (IM_VBUFMAX(im))
+	case IM_NBUFS:
+	    return (IM_VNBUFS(im))
+	case IM_COMPRESS:
+	    return (IM_VCOMPRESS(im))
+	case IM_NBNDRYPIX:
+	    return (IM_VNBNDRYPIX(im))
+	case IM_TYBNDRY:
+	    return (IM_VTYBNDRY(im))
+	case IM_FLAGBADPIX:
+	    return (IM_VFLAGBADPIX(im))
+	case IM_PIXFD:
+	    return (IM_PFD(im))
+	case IM_CLOSEFD:
+	    return (IM_VCLOSEFD(im))
+	case IM_WHEADER:
+	    return (IM_UPDATE(im))
+	case IM_PLDES:
+	    return (IM_PL(im))
+	case IM_RLIO:
+	    if (and (IM_PLFLAGS(im), PL_RLIO) != 0)
+		return (YES)
+	    else
+		return (NO)
+	default:
+	    call imerr (IM_NAME(im), SYS_IMSTATUNKPAR)
+	}
+end
diff --git a/sys/imio/imstatr.x b/sys/imio/imstatr.x
new file mode 100644
index 00000000..871cdca1
--- /dev/null
+++ b/sys/imio/imstatr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMSTATR -- Get the real value of an IMIO parameter.
+
+real procedure imstatr (im, param)
+
+pointer	im			#I image descriptor
+int	param			#I parameter to be set
+
+int	value
+int	imstati()
+errchk	imstati
+
+begin
+	switch (param) {
+	case IM_BNDRYPIXVAL:
+	    return (IM_OOBPIX(im))
+	default:
+	    value = imstati (im, param)
+	    if (IS_INDEFI (value))
+		return (INDEFR)
+	    else
+		return (value)
+	}
+end
diff --git a/sys/imio/imstats.x b/sys/imio/imstats.x
new file mode 100644
index 00000000..4deb5096
--- /dev/null
+++ b/sys/imio/imstats.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMSTATS -- Get an IMIO option of type string.
+
+procedure imstats (im, option, outstr, maxch)
+
+pointer	im			# image descriptor
+int	option			# imset option being queried
+char	outstr[ARB]		# output string
+int	maxch
+
+begin
+	switch (option) {
+	case IM_IMAGENAME:
+	    call strcpy (IM_NAME(im), outstr, maxch)
+	default:
+	    call imerr (IM_NAME(im), SYS_IMSTATUNKPAR)
+	}
+end
diff --git a/sys/imio/imt.x b/sys/imio/imt.x
new file mode 100644
index 00000000..b508b0ae
--- /dev/null
+++ b/sys/imio/imt.x
@@ -0,0 +1,305 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+.help imt
+.nf ___________________________________________________________________________
+IMT -- Image template package.
+
+The image template package is based upon the filename template package, the
+main difference being that the IMT package knows about the use of [] in image
+names, e.g., for image sections or cluster indices.
+
+	list = imtopenp (clparam)
+
+	 list = imtopen (template)
+	       imtclose (list)
+  nchars|eof = imtgetim (list, image, maxch)
+ nchars|eof = imtrgetim (list, index, image, maxch)
+           len = imtlen (list)
+		 imtrew (list)
+
+An image template consists of a comma delimited list of one or more patterns.
+Each pattern consists of a filename template optionally followed by a cluster
+index or image section.
+
+	filename_template [image stuff] , ...
+
+In the simplest case a simple alphanumeric image or file name may be given.
+Template expansion is carried out by parsing off the [] image stuff, calling
+FNTOPNB to expand the filename template, and then appending the [] string to
+each output filename returned by FNTGFNB.  Multiple adjacent [] sequences are
+permitted and are treated as one long string.
+
+The [ must be escaped to be included in the filename template.  The escape
+will be passed on, causing the [ to be passed through into the file output
+filename.  This prevents use of the [chars] character class notation in image
+templates; the [] are either interpreted as part of the image specification,
+or as part of the filename.
+.endhelp _____________________________________________________________________
+
+define	SZ_FNT		16384
+define	CH_DELIM	20B		# used to flag image section
+
+
+# IMTOPENP -- Open an image template obtained as the string value of a CL
+# parameter.
+
+pointer	procedure imtopenp (param)
+
+char	param[ARB]		# CL parameter with string value template
+pointer	sp, template, imt
+pointer	imtopen()
+errchk	clgstr
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_FNT, TY_CHAR)
+
+	call clgstr (param, Memc[template], SZ_FNT)
+	imt = imtopen (Memc[template])
+
+	call sfree (sp)
+	return (imt)
+end
+
+
+# IMTOPEN -- Open an image template.  The filename template package is
+# sophisticated enough to do all the necessary filename editing, etc., so all
+# we need do is recast the image notation into a FNT edit operation, e.g.,
+# `*.imh[*,-*]' becomes `*.hhh%%?\[\*\,-\*]%', with the ? (CH_DELIM, actually
+# an unprintable ascii code) being included to make it easy to locate the
+# section string in the filenames returned by FNT.  We then open the resultant
+# template and perform the inverse mapping upon the filenames returned by FNT.
+
+pointer	procedure imtopen (template)
+
+char	template[ARB]		# image template
+
+int	sort, level, ip, ch
+pointer	sp, listp, fnt, op
+define	output {Memc[op]=$1;op=op+1}
+int	fntopnb(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (fnt, max(strlen(template)*2, SZ_FNT), TY_CHAR)
+
+	# Sorting is disabled as input and output templates, derived from the
+	# same database but with string editing used to modify the output list,
+	# may be sorted differently as sorting is performed upon the edited
+	# output list.
+
+	sort = NO
+
+	op = fnt
+	for (ip=1;  template[ip] != EOS;  ip=ip+1) {
+	    ch = template[ip]
+
+	    if (ch == '[') {
+		if (ip > 1 && template[ip-1] == '!') {
+		    # ![ -- Pass a [ to FNT (character class notation).
+		    Memc[op-1] = '['
+
+		} else if (ip > 1 && template[ip-1] == '\\') {
+		    # \[ -- The [ is part of the filename.  Pass it on as an
+		    # escape sequence to get by the FNT.
+
+		    output ('[')
+
+		} else {
+		    # [ -- Unescaped [.  This marks the beginning of an image
+		    # section sequence.  Output `%%[...]%' and escape all
+		    # pattern matching metacharacters until a comma template
+		    # delimiter is encountered.  Note that a comma within []
+		    # is not a template delimiter.
+
+		    output ('%')
+		    output ('%')
+		    output (CH_DELIM)
+
+		    level = 0
+		    for (;  template[ip] != EOS;  ip=ip+1) {
+			ch = template[ip]
+			if (ch == ',') {		# ,
+			    if (level <= 0)
+				break			# exit loop
+			    else {
+				output ('\\')
+				output (ch)
+			    }
+			} else if (ch == '[') {		# [
+			    output ('\\')
+			    output (ch)
+			    level = level + 1
+			} else if (ch == ']') {		# ]
+			    output (ch)
+			    level = level - 1
+			} else if (ch == '*') {		# *
+			    output ('\\')
+			    output (ch)
+			} else				# normal chars
+			    output (ch)
+		    }
+		    output ('%')
+		    ip = ip - 1
+		}
+
+	    } else if (ch == '@') {
+		# List file reference.  Output the CH_DELIM code before the @
+		# to prevent further translations on the image section names
+		# returned from the list file, e.g., "CH_DELIM // @listfile".
+
+		output (CH_DELIM)
+		output ('/')
+		output ('/')
+		output (ch)
+
+	    } else 
+		output (ch)
+	}
+
+	Memc[op] = EOS
+	listp = fntopnb (Memc[fnt], sort)
+
+	call sfree (sp)
+	return (listp)
+end
+
+
+# IMTGETIM -- Get the next image name from the image template.  FNT returns a
+# filename with optional appended image section (preceded by the CH_DELIM
+# character).  Our job is to escape any [ in the filename part of the image
+# name to avoid interpretation of these chars as image section characters by
+# IMIO.  The CH_DELIM is deleted and everything following is simply copied
+# to the output.
+
+int procedure imtgetim (imt, outstr, maxch)
+
+pointer	imt			# image template descriptor
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+
+int	nchars
+pointer	sp, buf
+int	fntgfnb(), imt_mapname()
+errchk	fntgfnb
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+	if (fntgfnb (imt, Memc[buf], SZ_PATHNAME) == EOF) {
+	    outstr[1] = EOS
+	    call sfree (sp)
+	    return (EOF)
+	}
+
+	nchars = imt_mapname (Memc[buf], outstr, maxch)
+	call sfree (sp)
+	return (nchars)
+end
+
+
+# IMTRGETIM -- Like imt_getim, but may be used to randomly access the image
+# list.
+
+int procedure imtrgetim (imt, index, outstr, maxch)
+
+pointer	imt			# image template descriptor
+int	index			# list element to be returned
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+
+int	nchars
+pointer	sp, buf
+int	fntrfnb(), imt_mapname()
+errchk	fntrfnb
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+	if (fntrfnb (imt, index, Memc[buf], SZ_PATHNAME) == EOF) {
+	    outstr[1] = EOS
+	    call sfree (sp)
+	    return (EOF)
+	}
+
+	nchars = imt_mapname (Memc[buf], outstr, maxch)
+	call sfree (sp)
+	return (nchars)
+end
+
+
+# IMTLEN -- Return the number of image names in the expanded list.
+
+int procedure imtlen (imt)
+
+pointer	imt			# image template descriptor
+int	fntlenb()
+
+begin
+	return (fntlenb (imt))
+end
+
+    
+# IMTREW -- Rewind the expanded image list.
+
+procedure imtrew (imt)
+
+pointer	imt			# image template descriptor
+
+begin
+	call fntrewb (imt)
+end
+
+    
+# IMTCLOSE -- Close an image template.
+
+procedure imtclose (imt)
+
+pointer	imt			# image template descriptor
+
+begin
+	call fntclsb (imt)
+end
+
+
+# IMT_MAPNAME -- Translate the string returned by FNT into an image
+# specification suitable for input to IMIO.
+
+int procedure imt_mapname (fnt, outstr, maxch)
+
+char	fnt[ARB]		# FNT string
+char	outstr[ARB]		# output string
+int	maxch
+
+int	ip, op
+
+begin
+	op = 1
+	for (ip=1;  fnt[ip] != EOS;  ip=ip+1)
+	    if (fnt[ip] == '[') {
+		outstr[op] = '\\'
+		op = op + 1
+		outstr[op] = '['
+		op = op + 1
+
+	    } else if (fnt[ip] == CH_DELIM) {
+		for (ip=ip+1;  fnt[ip] != EOS;  ip=ip+1) {
+		    outstr[op] = fnt[ip]
+		    op = op + 1
+		    if (op > maxch)
+			break
+		}
+		break
+
+	    } else {
+		outstr[op] = fnt[ip]
+		op = op + 1
+		if (op > maxch)
+		    break
+	    }
+	
+	outstr[op] = EOS
+	return (op - 1)
+end
diff --git a/sys/imio/imt/README b/sys/imio/imt/README
new file mode 100644
index 00000000..be232470
--- /dev/null
+++ b/sys/imio/imt/README
@@ -0,0 +1,280 @@
+
+		    Enhanced Image List Template Package
+
+			     April 15, 2011
+
+
+    The enhanced image list package provides new capabilities for handling
+image lists, but remains backwards compatible with tasks currently using
+the IMT interface.  The enhancements allow for expansion of MEF files into
+lists of extensions using the @-file operator, as well as selection of
+images within more general lists by means of modifiers (e.g. a simple
+expression such as the extname/extver or explicit extension number, or more
+complex boolean expressions to allow selection by header keyword). In
+addition, tables may now take the @-file operator to use a column
+containing image references as an input list.
+
+
+========================================================================
+TODO:  
+    - Describe syntax for use with tables and selection by row values
+    - Describe remote image specification caching mechanism
+========================================================================
+
+
+
+Template Strings
+----------------
+
+The FNT template package supports the following forms of pattern strings:
+
+    alpha, *.x, data* // .pix, [a-m]*, @list_file, nite%1%2%.1024.imh
+
+i.e. simple filenames, wildcard expansion in filenames, concatenation of
+filenames, @files, substitution in filenames, or a comma-delimited list of
+the above.  The image template package (IMT) extends these patterns to
+allow image names followed by a cluster index or image section in []
+brackets.  These patterns remain unchanged in the new version of the
+package to allow backward compatability with existing applications. Lists
+of these types represent *explicit* collections of images, i.e. a
+collection based on the image name (wildcards) or as a result of processing
+by some task (e.g. expansion of an MEF file to create an input @-file of
+expanded extension specifications).
+
+    The enhanced version of the IMT package further abstracts the concept
+of image collections to include data objects such as MEF files or tables
+containing a list of image references that *implicitly* defines the list
+(e.g. the expanded MEF extension specification or the complete column of
+image references).  Further, we allow this list (which might be quite
+broad) to be refined using modifiers or selectors on the list and thus
+dynamically create the list without requiring the use (and management) of
+intermediate files.  For example,
+
+
+  @file*			expand all files beginning w/ 'file'
+  @file//".fits"		append ".fits" to contents of 'file'
+
+  @mef.fits			expand all (image) extensions of an MEF file
+  @mef.fits[SCI]		select SCI extensions from MEF file
+  @mef.fits[SCI,2][noinherit]	select v2 SCI extns, add kernel param
+  @mef.fits[1-16x2]		select range of extensions from MEF file
+  @mef.fits[+1-8]		create a list of extensions for an MEF
+
+  *.fits[1:100,1:100]		append section to all FITS images
+  @@file[1:100,1:100]		append section to expanded MEFs in 'file'
+
+  *.fits[filter?='V']		select images w/ FILTER keyword containing 'V'
+  @*.fits[gain<3.0]		select image extns where GAIN keyword < 3.0
+  *.fits[filter?='V';gain<2.0]	select using multiple OR's expressions
+
+
+Template Syntax
+---------------
+
+    The previous syntax and behavior of image templates is unchanged in
+this version, new functionality is provided by (optional) new syntax now
+supported in the template pattern string.  Briefly,
+
+    - wildcard filename expansion may now be applied to @-files
+
+    - the use of an '@' operator is now permitted on MEF files.  By 
+      default, all image extensions in the file will be included in the 
+      list, modifiers may be used to select specific extensions or to
+      indicate a range of extensions to be used.
+
+    - the use of an '@@' operator to indicate expansion of the contents 
+      of an @-file.  For example, an @-file of MEF image names can be
+      expanded to list of all the file extensions using "@@file", whereas
+      just using "@file" would list the names of the MEF files as before.
+
+    - modifier expressions enclosed in square brackets may be appended
+      to an image template string (or @-file) to either constrain the 
+      list (e.g. only a range of MEF extensions, only images with a certain
+      keyword value, etc) or to append extra information to the image
+      specification (e.g. to add an image section to all images in the
+      list).  Multiple modifier expressions may be used 
+
+
+    The allowed syntax for a template string can be described roughly in
+the following way:
+
+
+  [@@ | @]  <file>  [extname] 	    [<expr>;...]  [<ikparams>] [<section>]
+  [@@ | @]  <file>  [extname,extver][<expr>;...]  [<ikparams>] [<section>]
+  [@@ | @]  <file>  [index_range]   [<expr>;...]  [<ikparams>] [<section>]
+ 
+		    <-------- selectors ------->  <------ modifiers ----->
+
+    The <file> specification may be the name of a file, and image, or a
+table.  The behavior of the @-file and @@-file operators will depend on
+the type of <file> but the @-file usage remains backward compatible when
+used with text files.
+
+    The use of a modifier/selection on an MEF file will automatically
+trigger expansion of the extensions in the image and so an '@' operator is
+not strictly required, however only those extensions matching the selection
+expression will be present in the final image list.  Note that the use of 
+index ranges and extname/extver selectors are mutually exclusive, selector
+expressions may be added to either.
+
+
+@-file Operations
+-----------------
+
+    The @-file operator is unchanged from previous versions when used with
+text files of image names.  Modifier/selector expressions however can now
+be applied to the contents of the @-file to select from the list only those
+images that match the selector expression, or to augment the name in the 
+list with an additional image syntax such as a section or kernel parameters.
+
+
+@@-file Operations
+------------------
+
+    The @@-file operator is new syntax meant to allow the contents of an 
+@-file to be expanded automaticaly, e.g. as if there were an @-file of
+@-file names.  Primarily this can be used to create a list of MEF image
+names in which an @-file would return the names of the MEF, while the
+@@-file syntax could be used to expand each MEF into individual extension
+specifications.
+
+
+Extension Indices
+-----------------
+
+    The [index_range] modifier may be used to specify an explicit set of
+extensions to be used.  Index ranges are specified as a comma-delimited
+list of strings specifying individual range segments as described in the
+RANGES help page.
+
+    The use of a '+' operator before an index range indicates the range
+list should be expanded without checking that the extension exists in the
+MEF itself.  Otherwise, only those extensions present in the MEF will be
+included in the list.
+
+
+Selection Expressions
+---------------------
+
+    Selection expressions may be used to restrict a template list to only
+those images that match some boolean expression, e.g. to provide for 
+selection based on a header keyword value.  Expressions follow the same
+guidelines as in the HSELECT task 'expr' parameter (see the help page
+for details).  Multiple expressions may be specified if they are separated
+by a semicolon however they are evaluated as a single expression of
+OR'd values rather than as individual expressions.  This is significant
+when considering that expressions may contain keywords not present in 
+all images being checked, for instance
+
+	*.fits[filter?='V';gain<3.0]
+
+would evaluate as if the expression had been written
+
+	(filter?='V' || gain < 3.0)
+
+If a particular image lacks either the 'filter' or 'gain' keyword the
+entire expression will evaluate to false because of an error even if one
+of the two clauses would otherwise have been true.  
+
+[NOTE:  This behavior will be changed in a future version.]
+
+
+
+Image Sections
+--------------
+    Image sections may be added to an image specification by adding a
+separate modifier string.  The section will be added once selection of
+the list by the selector expressions is complete.  An example of where
+this might be used is in automatically specifying the bias section for
+all images in a list, e.g.
+
+    @mef.fits[1:128,*]			all extensions in the image
+    @mef.fits[1-16x2][1:128,*]		only 'left' amplifiers of a mosaic
+    @mef.fits[2-16x2][1024:1128,*]	only 'right' amplifiers of a mosaic
+    m31*.fits[345:528,200:300]		same section in all registered images
+
+No check is made that the image section is valid for the given image.
+
+
+Kernel Parameters
+-----------------
+
+    A comma-delimited list of image kernel parameters may be added to any 
+image specification by adding the keywords to a separate modifier.  For 
+example,
+		@mef.fits[1-8][noinherit,padline=30]
+
+would expand the file 'mef.fits' to include extensions 1 thru 8 and add the
+kernel parameters, generating a list such as
+
+		mef.fits[1][noinherit,padline=30]
+		mef.fits[2][noinherit,padline=30]
+		    :    :      :         :
+		mef.fits[8][noinherit,padline=30]
+
+No check is made to verify that the image kernel keywords are appropriate
+for the image type.  Supplying an incorrect kernel parameter will likely
+result in the task throwing an error when opening the image.
+
+
+
+--------------------------------------------------------------------------------
+
+Appendix 1:  Examples
+
+   file
+   file*
+   @file
+   @file*
+
+   @file[2]				extension
+   @file[SCI]				extname
+   @file[SCI,2]				extname+extver
+
+   @file[2][noinherit]			extension + ikiparams
+   @file[SCI][noinherit]		extname + ikiparams
+   @file[SCI,2][noinherit]		extname+extver + ikiparams
+
+   @file[2][1:20,2:30]			extension + section
+   @file[SCI][1:20,2:30]		extname + section
+   @file[SCI,2][1:20,2:30]		extname+extver + section
+
+   @file[2][noinherit][1:20,2:30]	extension + ikiparams + section
+   @file[SCI][noinherit][1:20,2:30]	extname + ikiparams + section
+   @file[SCI,2][noinherit][1:20,2:30]	extname+extver + ikiparams + section
+
+   @file[noinherit]			ikiparams
+   @file[noinherit][1:123,2:234]	ikiparams + sections
+
+   @file[1:123,2:234]			sections
+
+   @file[1:123,2:234]			sections
+
+   mef*.fits[filter?='V']		selection expression
+   mef*.fits[filter?='V';filter?='B']	selection expressions (OR)
+   mef*.fits[filter?='V'||filter?='B']	selection expressions (OR)
+   mef*.fits[gain>0.5&&gain<2.0]	selection expressions (AND)
+
+	Expressions will evaluate to 'false' if there is an error such as
+	"keyword not found", meaning that no images will match when one or
+	more keywords may not be present.  Best to use a comma-delimited list
+	in this case.
+
+ Concatenation
+
+   @file // foo				append
+   @file* // foo			append wildcards
+   @file // [2]				append modifiers
+
+   foo // @file				prepend
+   foo // @file*			prepend wildcards
+   foo // @file[2]			prepend modifiers
+
+   Prior Behavior:
+
+	foo // bar.fits			==> foobar.fits
+	foo.fits // bar			==> foobar.fits
+
+	foo // @file1			==> foosif1.fits,foomef1.fits
+	@file1 // bar			==> sif1foo.fits,mef1foo.fits
+
diff --git a/sys/imio/imt/fxf.h b/sys/imio/imt/fxf.h
new file mode 100644
index 00000000..c4e6188b
--- /dev/null
+++ b/sys/imio/imt/fxf.h
@@ -0,0 +1,172 @@
+# FITS.H -- IKI/FITS internal definitions.
+
+define	FITS_ORIGIN	"NOAO-IRAF FITS Image Kernel July 2003"
+
+define	FITS_LENEXTN	4		# max length imagefile extension
+define	SZ_DATATYPE	16		# size of datatype string (eg "REAL*4")
+define	SZ_EXTTYPE	20		# size of exttype string (eg BINTABLE)
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+define	DEF_PHULINES	0		# initial allocation for PHU
+define	DEF_EHULINES	0		# initial allocation for EHU
+define	DEF_PADLINES	0		# initial value for extra lines in HU
+define	DEF_PLMAXLEN	32768		# default max PLIO encoded line length
+define	DEF_PLDEPTH	0		# default PLIO mask depth
+
+define	FITS_BLOCK_BYTES 2880		# FITS logical block length (bytes)
+define	FITS_BLOCK_CHARS 1440		# FITS logical block length (spp chars)
+define	FITS_STARTVALUE 10		# first column of value field
+define	FITS_ENDVALUE	30		# last	column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	LEN_CARD	80		# length of FITS card.
+define	LEN_UACARD	81		# size of a Userarea line.
+define	LEN_OBJECT	63		# maximum length of a FITS string value
+define	LEN_FORMAT	40		# maximum length of a TFORM value
+define	NO_KEYW		-1		# indicates no keyword is present.
+
+define	MAX_OFFSETS	100		# max number of offsets per cache entry.
+define	MAX_CACHE	60		# max number of cache entries.
+define	DEF_CACHE	10		# default number of cache entries.
+
+define	DEF_HDREXTN	"fits"		# default header file extension
+define	ENV_FKINIT	"fkinit"	# FITS kernel initialization
+
+define	DEF_ISOCUTOVER	0		# date when ISO format dates kick in
+define	ENV_ISOCUTOVER	"isodates"	# environment override for default
+
+define	FITS_BYTE	8	# Bits in a FITS byte
+define	FITS_SHORT	16	# Bits in a FITS short
+define	FITS_LONG	32	# Bits in a FITS long
+define	FITS_REAL	-32	# 32 Bits FITS IEEE float representation
+define	FITS_DOUBLE	-64	# 64 Bits FITS IEEE double representation
+
+define	COL_VALUE	11	# Starting column for parameter values
+define	NDEC_REAL	7	# Precision of real
+define	NDEC_DOUBLE	14	# Precision of double
+
+define	FITS_LEN_CHAR	(((($1) + 1439)/1440)* 1440)
+
+# Extension subtypes.
+define	FK_PLIO		1
+
+# Mapping of FITS Keywords to IRAF image header.  All unrecognized keywords
+# are stored here.
+
+#define	UNKNOWN	 Memc[($1+IMU-1)*SZ_MII_INT+1]
+define	UNKNOWN	 Memc[($1+IMU-1)*SZ_STRUCT+1]
+
+
+# FITS image descriptor, used internally by the FITS kernel.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_FITDES	500
+define	LEN_FITBASE	400
+
+define	FIT_ACMODE	Memi[$1]	# image access mode
+define	FIT_PFD		Memi[$1+1]	# pixel file descriptor
+define	FIT_PIXOFF	Memi[$1+2]	# pixel offset
+define	FIT_TOTPIX	Memi[$1+3]	# size of image in pixfile, chars
+define	FIT_IO		Memi[$1+4]	# FITS I/O channel
+define	FIT_ZCNV	Memi[$1+5]	# set if on-the-fly conversion needed
+define	FIT_IOSTAT	Memi[$1+6]	# i/o status for zfio routines
+define  FIT_TFORMP      Memi[$1+7]      # TFORM keyword value pointer
+define  FIT_TTYPEP      Memi[$1+8]      # TTYPE keyword value pointer
+define  FIT_TFIELDS     Memi[$1+9]      # number of fields in binary table
+define  FIT_PCOUNT      Memi[$1+10]     # PCOUNT keyword value
+			# extra space
+define	FIT_BSCALE	Memd[P2D($1+16)]
+define	FIT_BZERO	Memd[P2D($1+18)]
+define	FIT_BITPIX	Memi[$1+20]	# bits per pixel
+define	FIT_NAXIS	Memi[$1+21]	# number of axes in image
+define	FIT_LENAXIS	Memi[$1+22+$2-1]# 35:41 = [7] max
+define	FIT_ZBYTES	Memi[$1+30]	# Status value for FIT_ZCNV mode
+define	FIT_HFD		Memi[$1+31]	# Header file descriptor
+define	FIT_PIXTYPE	Memi[$1+32]
+define	FIT_CACHEHDR	Memi[$1+33]	# Cached main header unit's address.
+define	FIT_CACHEHLEN	Memi[$1+34]	# Lenght of the above.
+define	FIT_IM		Memi[$1+35]	# Has the 'im' descriptor value 
+define	FIT_GROUP	Memi[$1+36]
+define	FIT_NEWIMAGE	Memi[$1+37]	# Newimage flag
+define	FIT_HDRPTR	Memi[$1+38]	# Header data Xtension pointer
+define	FIT_PIXPTR	Memi[$1+39]	# Pixel data Xtension pointer
+define	FIT_NUMOFFS	Memi[$1+40]	# Number of offsets in cache header.
+define	FIT_EOFSIZE	Memi[$1+41]	# Size in char of file before append.
+define	FIT_XTENSION	Memi[$1+42]	# Yes, if an Xtension has been read.
+define	FIT_INHERIT	Memi[$1+43]	# INHERIT header keyword value.
+define	FIT_EXTVER	Memi[$1+44]	# EXTVER value (integer only)
+define	FIT_EXPAND	Memi[$1+45]	# Expand the header?
+define	FIT_MIN		Memr[P2R($1+46)]# Minimum pixel value
+define	FIT_MAX		Memr[P2R($1+47)]# Maximum pixel value
+define	FIT_MTIME	Meml[$1+48]	# Time of last mod. for FITS unit 
+define	FIT_SVNANR	Memr[P2R($1+49)]
+define	FIT_SVNAND	Memd[P2D($1+50)]
+define	FIT_SVMAPRIN	Memi[$1+52]
+define	FIT_SVMAPROUT	Memi[$1+53]
+define	FIT_SVMAPDIN	Memi[$1+54]
+define	FIT_SVMAPDOUT	Memi[$1+55]
+define	FIT_EXTEND	Memi[$1+56]	# FITS extend keyword
+define	FIT_PLMAXLEN	Memi[$1+57]	# PLIO maximum linelen
+			# extra space
+define	FIT_EXTTYPE	Memc[P2C($1+70)]  # extension type
+define	FIT_FILENAME	Memc[P2C($1+110)] # FILENAME value 
+define	FIT_EXTNAME	Memc[P2C($1+150)] # EXTNAME value 
+define	FIT_DATATYPE	Memc[P2C($1+190)] # datatype string
+define	FIT_TITLE	Memc[P2C($1+230)] # title string
+define	FIT_OBJECT	Memc[P2C($1+270)] # object string
+define  FIT_EXTSTYPE    Memc[P2C($1+310)] # FITS extension subtype
+			# extra space
+
+# The FKS terms carry the fkinit or kernel section arguments.
+define	FKS_APPEND	Memi[$1+400]	# YES, NO append an extension
+define	FKS_INHERIT	Memi[$1+401]	# YES, NO inherit the main header
+define	FKS_OVERWRITE	Memi[$1+402]	# YES, NO overwrite an extension
+define	FKS_DUPNAME	Memi[$1+403]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXTVER	Memi[$1+404]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXPAND	Memi[$1+405]	# YES, NO expand the header
+define	FKS_PHULINES	Memi[$1+406]	# Allocated lines in PHU
+define	FKS_EHULINES	Memi[$1+407]	# Allocated lines in EHU
+define	FKS_PADLINES	Memi[$1+408]	# Additional lines for HU
+define	FKS_NEWFILE	Memi[$1+409]	# YES, NO force newfile
+define	FKS_CACHESIZE	Memi[$1+410]	# size of header cache
+define  FKS_SUBTYPE     Memi[$1+411]	# BINTABLE subtype
+define	FKS_EXTNAME	Memc[P2C($1+412)] # EXTNAME value
+			# extra space
+
+
+# Reserved FITS keywords known to this code.
+
+define	FK_KEYWORDS "|bitpix|datatype|end|naxis|naxisn|simple|bscale|bzero\
+|origin|iraf-tlm|filename|extend|irafname|irafmax|irafmin|datamax\
+|datamin|xtension|object|pcount|extname|extver|nextend|inherit\
+|zcmptype|tform|ttype|tfields|date|"
+
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_NAXIS	4
+define	KW_NAXISN	5
+define	KW_SIMPLE	6
+define	KW_BSCALE	7
+define	KW_BZERO	8
+define	KW_ORIGIN	9
+define	KW_IRAFTLM	10
+define	KW_FILENAME	11
+define	KW_EXTEND	12
+define	KW_IRAFNAME	13
+define	KW_IRAFMAX	14
+define	KW_IRAFMIN	15
+define	KW_DATAMAX	16
+define	KW_DATAMIN	17
+define	KW_XTENSION	18
+define	KW_OBJECT	19
+define	KW_PCOUNT	20
+define	KW_EXTNAME	21
+define	KW_EXTVER	22
+define	KW_NEXTEND	23
+define	KW_INHERIT	24
+define  KW_ZCMPTYPE     25
+define  KW_TFORM        26
+define  KW_TTYPE        27
+define  KW_TFIELDS      28
+define  KW_DATE         29
diff --git a/sys/imio/imt/imt.x b/sys/imio/imt/imt.x
new file mode 100644
index 00000000..64e1441c
--- /dev/null
+++ b/sys/imio/imt/imt.x
@@ -0,0 +1,342 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+.help imt
+.nf ___________________________________________________________________________
+IMT -- Image template package.
+
+The image template package is based upon the filename template package, the
+main difference being that the IMT package knows about the use of [] in image
+names, e.g., for image sections or cluster indices.
+
+	list = imtopenp (clparam)
+
+	 list = imtopen (template)
+	       imtclose (list)
+  nchars|eof = imtgetim (list, image, maxch)
+ nchars|eof = imtrgetim (list, index, image, maxch)
+           len = imtlen (list)
+		 imtrew (list)
+
+An image template consists of a comma delimited list of one or more patterns.
+Each pattern consists of a filename template optionally followed by a cluster
+index or image section.
+
+	filename_template [image stuff] , ...
+
+In the simplest case a simple alphanumeric image or file name may be given.
+Template expansion is carried out by parsing off the [] image stuff, calling
+FNTOPNB to expand the filename template, and then appending the [] string to
+each output filename returned by FNTGFNB.  Multiple adjacent [] sequences are
+permitted and are treated as one long string.
+
+The [ must be escaped to be included in the filename template.  The escape
+will be passed on, causing the [ to be passed through into the file output
+filename.  This prevents use of the [chars] character class notation in image
+templates; the [] are either interpreted as part of the image specification,
+or as part of the filename.
+.endhelp _____________________________________________________________________
+
+define	SZ_FNT		16384
+define	CH_DELIM	20B		# used to flag image section
+
+
+# IMTOPENP -- Open an image template obtained as the string value of a CL
+# parameter.
+
+pointer	procedure imtopenp (param)
+
+char	param[ARB]		# CL parameter with string value template
+pointer	sp, template, imt
+pointer	imtopen()
+errchk	clgstr
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_FNT, TY_CHAR)
+
+	call clgstr (param, Memc[template], SZ_FNT)
+	imt = imtopen (Memc[template])
+
+	call sfree (sp)
+	return (imt)
+end
+
+
+# IMTOPEN -- Open an image template.  The filename template package is
+# sophisticated enough to do all the necessary filename editing, etc., so all
+# we need do is recast the image notation into a FNT edit operation, e.g.,
+# `*.imh[*,-*]' becomes `*.hhh%%?\[\*\,-\*]%', with the ? (CH_DELIM, actually
+# an unprintable ascii code) being included to make it easy to locate the
+# section string in the filenames returned by FNT.  We then open the resultant
+# template and perform the inverse mapping upon the filenames returned by FNT.
+
+pointer	procedure imtopen (template)
+
+char	template[ARB]		# image template
+
+int	sort, level, ip, ch
+pointer	sp, listp, fnt, op
+define	output {Memc[op]=$1;op=op+1}
+
+int	fntopnb(), strlen()
+pointer	imxopen()
+bool	envgetb()
+
+begin
+	# The interface is unchanged as far as the applications are
+	# concerned, but we'll branch here to the enhanced list processing
+	# if it is available.
+
+        if (envgetb ("use_vo") && envgetb ("use_new_imt")) 
+	    return (imxopen (template))
+
+
+	call smark (sp)
+	call salloc (fnt, max(strlen(template)*2, SZ_FNT), TY_CHAR)
+
+	# Sorting is disabled as input and output templates, derived from the
+	# same database but with string editing used to modify the output list,
+	# may be sorted differently as sorting is performed upon the edited
+	# output list.
+
+	sort = NO
+
+	op = fnt
+	for (ip=1;  template[ip] != EOS;  ip=ip+1) {
+	    ch = template[ip]
+
+	    if (ch == '[') {
+		if (ip > 1 && template[ip-1] == '!') {
+		    # ![ -- Pass a [ to FNT (character class notation).
+		    Memc[op-1] = '['
+
+		} else if (ip > 1 && template[ip-1] == '\\') {
+		    # \[ -- The [ is part of the filename.  Pass it on as an
+		    # escape sequence to get by the FNT.
+
+		    output ('[')
+
+		} else {
+		    # [ -- Unescaped [.  This marks the beginning of an image
+		    # section sequence.  Output `%%[...]%' and escape all
+		    # pattern matching metacharacters until a comma template
+		    # delimiter is encountered.  Note that a comma within []
+		    # is not a template delimiter.
+
+		    output ('%')
+		    output ('%')
+		    output (CH_DELIM)
+
+		    level = 0
+		    for (;  template[ip] != EOS;  ip=ip+1) {
+			ch = template[ip]
+			if (ch == ',') {		# ,
+			    if (level <= 0)
+				break			# exit loop
+			    else {
+				output ('\\')
+				output (ch)
+			    }
+			} else if (ch == '[') {		# [
+			    output ('\\')
+			    output (ch)
+			    level = level + 1
+			} else if (ch == ']') {		# ]
+			    output (ch)
+			    level = level - 1
+			} else if (ch == '*') {		# *
+			    output ('\\')
+			    output (ch)
+			} else				# normal chars
+			    output (ch)
+		    }
+		    output ('%')
+		    ip = ip - 1
+		}
+
+	    } else if (ch == '@') {
+		# List file reference.  Output the CH_DELIM code before the @
+		# to prevent further translations on the image section names
+		# returned from the list file, e.g., "CH_DELIM // @listfile".
+
+		output (CH_DELIM)
+		output ('/')
+		output ('/')
+		output (ch)
+
+	    } else 
+		output (ch)
+	}
+
+	Memc[op] = EOS
+
+	listp = fntopnb (Memc[fnt], sort)
+
+	call sfree (sp)
+	return (listp)
+end
+
+
+# IMTGETIM -- Get the next image name from the image template.  FNT returns a
+# filename with optional appended image section (preceded by the CH_DELIM
+# character).  Our job is to escape any [ in the filename part of the image
+# name to avoid interpretation of these chars as image section characters by
+# IMIO.  The CH_DELIM is deleted and everything following is simply copied
+# to the output.
+
+int procedure imtgetim (imt, outstr, maxch)
+
+pointer	imt			# image template descriptor
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+
+int	nchars
+pointer	sp, buf
+int	fntgfnb(), imt_mapname()
+errchk	fntgfnb
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+	if (fntgfnb (imt, Memc[buf], SZ_PATHNAME) == EOF) {
+	    outstr[1] = EOS
+	    call sfree (sp)
+	    return (EOF)
+	}
+
+	nchars = imt_mapname (Memc[buf], outstr, maxch)
+	call sfree (sp)
+	return (nchars)
+end
+
+
+# IMTRGETIM -- Like imt_getim, but may be used to randomly access the image
+# list.
+
+int procedure imtrgetim (imt, index, outstr, maxch)
+
+pointer	imt			# image template descriptor
+int	index			# list element to be returned
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+
+int	nchars
+pointer	sp, buf
+int	fntrfnb(), imt_mapname()
+errchk	fntrfnb
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+	if (fntrfnb (imt, index, Memc[buf], SZ_PATHNAME) == EOF) {
+	    outstr[1] = EOS
+	    call sfree (sp)
+	    return (EOF)
+	}
+
+	nchars = imt_mapname (Memc[buf], outstr, maxch)
+	call sfree (sp)
+	return (nchars)
+end
+
+
+# IMTLEN -- Return the number of image names in the expanded list.
+
+int procedure imtlen (imt)
+
+pointer	imt			# image template descriptor
+int	fntlenb()
+
+begin
+	return (fntlenb (imt))
+end
+
+    
+# IMTREW -- Rewind the expanded image list.
+
+procedure imtrew (imt)
+
+pointer	imt			# image template descriptor
+
+begin
+	call fntrewb (imt)
+end
+
+    
+# IMTCLOSE -- Close an image template.
+
+procedure imtclose (imt)
+
+pointer	imt			# image template descriptor
+
+begin
+	call fntclsb (imt)
+end
+
+
+# IMT_MAPNAME -- Translate the string returned by FNT into an image
+# specification suitable for input to IMIO.
+
+int procedure imt_mapname (fnt, outstr, maxch)
+
+char	fnt[ARB]		# FNT string
+char	outstr[ARB]		# output string
+int	maxch
+
+int	ip, op
+char	url[SZ_PATHNAME], cfname[SZ_PATHNAME]
+
+int	strncmp(), strlen()
+bool	envgetb()
+
+begin
+	# Check for a URL-encoded string.
+
+	if (strncmp ("http:", fnt, 5) == 0) {
+	    call aclrc (url, SZ_PATHNAME)
+	    call sprintf (url, SZ_PATHNAME, "http://%s")
+		call pargstr (fnt[6])
+
+	    call fcadd ("cache$", url, "", cfname, SZ_PATHNAME)
+	    call strcpy (cfname, outstr, SZ_PATHNAME)
+	    return (strlen (cfname))
+	}
+
+	op = 1
+	for (ip=1;  fnt[ip] != EOS;  ip=ip+1) {
+	    if (fnt[ip] == '[') {
+		outstr[op] = '\\'
+		op = op + 1
+		outstr[op] = '['
+		op = op + 1
+
+	    } else if (fnt[ip] == CH_DELIM) {
+		for (ip=ip+1;  fnt[ip] != EOS;  ip=ip+1) {
+		    outstr[op] = fnt[ip]
+		    op = op + 1
+		    if (op > maxch)
+			break
+		}
+		break
+
+	    } else {
+		outstr[op] = fnt[ip]
+		op = op + 1
+		if (op > maxch)
+		    break
+	    }
+	}
+	outstr[op] = EOS
+
+	#  FIXME
+	if (envgetb ("vo_prefetch") && strncmp (outstr, "cache", 5) == 0) {
+#	    call sprintf (cfname, SZ_LINE, "%s.fits")
+	    call sprintf (cfname, SZ_LINE, "%s")
+		call pargstr (outstr)
+	    call fcwait ("cache$", cfname)
+	}
+	
+	return (op - 1)
+end
diff --git a/sys/imio/imt/imx.h b/sys/imio/imt/imx.h
new file mode 100644
index 00000000..362e146f
--- /dev/null
+++ b/sys/imio/imt/imx.h
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+define	SZ_FNT		32768
+define	CH_DELIM	20B		    # used to flag image section
+
+define	IMT_FILE	0		    # file list
+define	IMT_IMAGE	1		    # image list
+define	IMT_TABLE	2		    # table list (ascii file)
+define	IMT_VOTABLE	3		    # table list (XML file)
+define	IMT_URL		4		    # file URL
+define	IMT_DIR		5		    # directory
+
+define  IMT_OUTPUTS     "|none|list|file|"  # expansion options
+define  IMTY_NONE       1                   # No output
+define  IMTY_LIST       2                   # List output
+define  IMTY_FILE       3                   # File output
+
+define  SZ_RANGE        100                 # Size of extension range list
+define  SZ_LISTOUT      16384               # Size of extension output list
+
+define  FIRST   	1                   # Default starting range
+define  LAST    	MAX_INT             # Default ending range
+define  STEP    	1                   # Default step
+define  EOLIST  	-1                  # End of list
+
diff --git a/sys/imio/imt/imx.x b/sys/imio/imt/imx.x
new file mode 100644
index 00000000..ba3f7bc8
--- /dev/null
+++ b/sys/imio/imt/imx.x
@@ -0,0 +1,242 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <ctype.h>
+include "imx.h"
+
+define	DEBUG		FALSE
+
+
+# IMXOPEN -- Open an image template using the enhanced expansion
+# capabilities.  This procedure is simply the entry point to the imtopen()
+# method in the standard IMT interface.
+
+pointer	procedure imxopen (template)
+
+char	template[ARB]		# image template
+
+int	i, sort, level, ip, ch, expand, nchars, nimages, index, type
+int	max_fnt, fnt_len, len, flen
+pointer	listp, intmp, fnt, op, exp
+char    lfile[SZ_LINE], lexpr[SZ_LINE], likparams[SZ_LINE], lsec[SZ_LINE]
+char    lindex[SZ_LINE], lextname[SZ_LINE], lextver[SZ_LINE], elem[SZ_LINE]
+
+pointer	imx_preproc (), imx_imexpand (), imx_fexpand ()
+pointer	imx_texpand (), imx_dexpand ()
+int	imx_filetype (), imx_parse (), imx_get_element ()
+int	fntopnb (), strlen (), strsearch()
+int	sum, fntlenb()
+bool	envgetb()
+
+define	output 	{Memc[op]=$1;op=op+1}
+define	escape 	{output('\\');output($1)}
+
+begin
+	# Pre-process the input template.
+	intmp = imx_preproc (template)
+	    
+	if (DEBUG) {
+	    call eprintf ("template: '%s'\npreproc: '%s'\n\n")
+		call pargstr (template)
+		call pargstr (Memc[intmp])
+	}
+
+
+	fnt_len = 0 						# initialize    
+	max_fnt = SZ_FNT
+	call calloc (fnt, max_fnt, TY_CHAR)
+
+	# Sorting is disabled as input and output templates, derived from the
+	# same database but with string editing used to modify the output list,
+	# may be sorted differently as sorting is performed upon the edited
+	# output list.
+
+	sort = NO
+
+	op = fnt
+	ip = intmp
+
+	for (ip=intmp;  Memc[ip] != EOS;  ip=ip+1) {
+	    ch = Memc[ip]
+
+	    if (ch == '[') {
+		if (ip > 1 && Memc[ip-1] == '!') {
+		    # ![ -- Pass a [ to FNT (character class notation).
+		    Memc[op-1] = '['
+
+		} else if (ip > 1 && Memc[ip-1] == '\\') {
+		    # \[ -- The [ is part of the filename.  Pass it on as an
+		    # escape sequence to get by the FNT.
+
+		    output ('[')
+
+		} else {
+		    # [ -- Unescaped [.  This marks the beginning of an image
+		    # section sequence.  Output `%%[...]%' and escape all
+		    # pattern matching metacharacters until a comma template
+		    # delimiter is encountered.  Note that a comma within []
+		    # is not a template delimiter.
+
+		    output ('%')
+		    output ('%')
+		    output (CH_DELIM)
+
+		    level = 0
+		    for (;  Memc[ip] != EOS;  ip=ip+1) {
+			ch = Memc[ip]
+			if (ch == ',') {		# ,
+			    if (level <= 0)
+				break			# exit loop
+			    else {
+			        escape (ch)
+			    }
+			} else if (ch == '[') {		# [
+			    escape (ch)
+			    level = level + 1
+			} else if (ch == ']') {		# ]
+			    output (ch)
+			    level = level - 1
+			} else if (ch == '*') {		# *
+			    escape (ch)
+			} else				# normal chars
+			    output (ch)
+		    }
+		    output ('%')
+		    ip = ip - 1
+		}
+
+	    } else if (ch == '@') {
+		# List file reference.  Output the CH_DELIM code before the @
+		# to prevent further translations on the image section names
+		# returned from the list file, e.g., "CH_DELIM // @listfile".
+
+		# See if we're asking to expand the contents of the file,
+		# e.g. as in "@@listfile" where 'listfile' contains MEFs
+		# or tables we later expand.
+		expand = NO
+	        if (Memc[ip+1] == '@')
+		    expand = YES
+
+		# Break out the listfile from the filtering expression.
+        
+		index = 1
+	        nchars = imx_get_element (Memc[ip], index, elem, SZ_LINE)
+		ip = ip + strlen(elem) - 1
+
+		nchars = imx_parse (elem, lfile, lindex, lextname, 
+				lextver, lexpr, lsec, likparams, SZ_LINE)
+
+		if (DEBUG) {
+		    call eprintf ("imtopen:  lfile='%s'  lexpr='%s' ip='%s'\n")
+			call pargstr (lfile)
+			call pargstr (lexpr)
+			call pargstr (Memc[ip])
+		}
+		    
+	    
+		exp = NULL
+		type = imx_filetype (lfile)
+		switch (type) {
+		case IMT_IMAGE:
+		    exp = imx_imexpand (lfile, lexpr, lindex, lextname, lextver,
+				likparams, lsec, nimages)
+
+		case IMT_TABLE:
+		case IMT_VOTABLE:
+		    exp = imx_texpand (lfile, type, lexpr, lindex, "", nimages)
+
+		case IMT_FILE:
+		    if (strsearch (lfile, "//") > 0) {
+		        call calloc (exp, SZ_FNAME, TY_CHAR)
+		        call strcpy (lfile, Memc[exp], SZ_FNAME)
+			nimages = 1
+
+		    } else if (lfile[1] == '@' && strsearch(lfile, "//") == 0) {
+		        exp = imx_fexpand (lfile[2], lexpr, lindex, lextname,
+				lextver, likparams, lsec, nimages)
+#			if (nimages > 0) {
+#		            output (CH_DELIM); output ('/'); output ('/')
+#			}
+
+		    } else {
+		        call calloc (exp, SZ_FNAME, TY_CHAR)
+		        call strcpy (lfile, Memc[exp], SZ_FNAME)
+			nimages = 1
+		    }
+
+		case IMT_DIR:
+		    exp = imx_dexpand (lfile, lexpr, lindex, lextname, lextver,
+				likparams, lsec, nimages)
+		}
+
+		if (DEBUG) {
+		    call eprintf ("expand:   exp='%s' len=%d  nim=%d\n")
+		        call pargstr (Memc[exp])
+			call pargi (strlen(Memc[exp]))
+			call pargi (nimages)
+		}
+		    
+		    
+		# Copy to the output template string.
+		len = strlen (Memc[exp])
+		if (nimages > 0) {
+		    if ((fnt_len + len) >= max_fnt) {
+			max_fnt = max_fnt + len + 1
+			if (fnt != NULL)
+			    call realloc (fnt, max_fnt, TY_CHAR)
+			else
+			    call calloc (fnt, max_fnt, TY_CHAR)
+			op = fnt
+			if (fnt_len > 0)
+			    op = fnt + strlen (Memc[fnt])
+		    }
+		    for (i=0; i < len; i=i+1)
+		        output (Memc[exp+i])
+		    Memc[op+1] = EOS
+		    fnt_len = fnt_len + strlen (Memc[exp])
+		}
+
+		if (exp != NULL)
+		    call mfree (exp, TY_CHAR)
+		nimages = 0
+
+	    } else
+		output (ch)
+	}
+	output ('\0')
+	Memc[op] = EOS
+
+
+	# Clean up the expanded template string in case there were selection
+	# filters that rejected images and we have extra commas in the string.
+	len = strlen (Memc[fnt])
+	if (Memc[fnt+len-1] == ',') {		# kill trailing commas
+	    for (ip=fnt+len-1; Memc[ip] == ',' && ip >= fnt; ip=ip-1)
+		Memc[ip] = '\0'
+	}
+	if (Memc[fnt] == ',') {
+	    for (ip=fnt; Memc[ip] == ','; )	# skip leading commas
+		ip = ip + 1
+	    for (op=fnt; Memc[ip] != EOS; ip=ip+1) {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	    Memc[op] = '\0'
+	}
+
+	if (DEBUG) {
+	    call eprintf ("imxopen:  fnt='%s'\n")
+		call pargstr (Memc[fnt])
+	}
+
+	    
+	# Open the template string using the filename list.
+	listp = fntopnb (Memc[fnt], sort)
+
+	# Clean up.
+	call mfree (fnt, TY_CHAR)
+	call mfree (intmp, TY_CHAR)
+
+	return (listp)
+end
diff --git a/sys/imio/imt/imxbreakout.x b/sys/imio/imt/imxbreakout.x
new file mode 100644
index 00000000..57a92b8a
--- /dev/null
+++ b/sys/imio/imt/imxbreakout.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+
+
+# IMX_BREAKOUT -- Break out the filename template from the filtering
+# expression in the list item.  Our input value is a single item in the
+# template list, we'll logically separate image parameters, section strings
+# and extension values from expressions that might be used in filtering.
+
+int procedure imx_breakout (item, expand, fname, expr, sec, ikparams, maxch)
+
+char    item[ARB]                       #i template string ptr
+int     expand                          #i expanding contents?
+char    fname[ARB]                      #o list filename
+char    expr[ARB]                       #o filtering expression
+char    sec[ARB]                        #o section string
+char    ikparams[ARB]                   #o image kernel params
+int     maxch                           #i max chars in fname and expr
+
+char    ch, str[SZ_LINE], sifname[SZ_LINE]
+int     nchars, ip, op
+bool	is_sif
+
+bool 	imx_issection(), imx_sifmatch()
+int	stridx()
+
+define	next_str_	99
+
+begin
+        call aclrc (fname, maxch)
+        call aclrc (expr, maxch)
+        call aclrc (sec, maxch)
+
+        # At the start the ip points to the '@' in the template string.
+        # Skip ahead to the start of the filename template string.
+        ip = 1
+        if (expand == YES)
+            ip = ip + 1
+
+        # Copy out the filename template up to the EOS, a '[' to indicate
+        # the start of a filter expression, or a comma indicating the next
+        # item in the list.
+        ch = item[ip]
+        for (op=1; ch != EOS; op=op+1) {
+            fname[op] = ch
+
+            ch = item[ip+1]
+            if (ch == ',' || ch == EOS)
+                return (ip-1)           # next list item, no filter expr
+            else if (ch == '[')
+                break                   # break to get the filter expr
+
+            ip = ip + 1
+        }
+
+
+        # Get the string up to the closing ']' char.
+next_str_
+        ip = ip + 2
+        ch = item[ip]
+        call aclrc (str, SZ_LINE)
+        for (op=1; ch != EOS; op=op+1) {
+            str[op] = ch
+
+            ip = ip + 1
+            ch = item[ip]
+            if (ch == ']')
+                break                   # break to get the filter expr
+        }
+
+	if (imx_issection (str)) {
+	    call strcpy (str, sec, SZ_LINE)
+	} else {
+	    if (expr[1] != EOS) {
+	        call strcat (",", expr, SZ_LINE)
+	        call strcat (str, expr, SZ_LINE)
+	    } else
+	        call strcpy (str, expr, SZ_LINE)
+	}
+
+	if (item[ip+1] != EOS)
+	    goto next_str_
+
+	call imx_ikparams (expr, ikparams, SZ_LINE)
+
+	# If we've found both a section and an expression, check that the
+	# section isn't being confused with an index list.
+	#if (sec[1] != EOS && expr[1] != EOS) {
+	#    if (!is_sif && stridx (':', sec) == 0) {
+	#        call strcat (",", expr, SZ_LINE)
+	#        call strcat (sec, expr, SZ_LINE)
+	#    }
+	#}
+
+	if (sec[1] != EOS) {
+	    call aclrc (sifname, SZ_LINE)
+	    call sprintf (sifname, SZ_LINE, "%s[1][%s]")
+		if (fname[1] == '@')
+		    call pargstr (fname[2])
+		else
+		    call pargstr (fname)
+		call pargstr (sec)
+	} else {
+	    call strcpy (fname, sifname, SZ_LINE)
+	}
+	is_sif = imx_sifmatch (sifname, "yes")
+
+        nchars = ip - 1
+        return (nchars)
+end
+
+
+# IMX_ISSECTION -- Determine if the string is an image section.
+#
+# Note:  There is a possible ambiguity here where using an image section
+# that represents a single pixel (e.g. foo.fits[100,100]) which might also
+# be a list of image extensions.
+
+bool procedure imx_issection (str)
+
+char	str[ARB]			# string to be checked
+
+int	ip, stridxs()
+
+begin
+	for (ip=1; str[ip] != EOS; ip=ip+1) {
+	    if (IS_ALPHA(str[ip]) || stridxs ("x()<>?", str) > 0)
+		return  (FALSE)
+	}
+
+	# Test for a range list, e.g. "[1-5]"
+	if (stridxs ("-,", str) > 0 && stridxs (":*", str) == 0) 
+	    return (FALSE);
+
+	# Test for a section that flips axes, e.g. "[-*,*]"
+	if (stridxs ("-*:,", str) > 0) 
+	    return (TRUE);
+
+	return (FALSE)
+end
+
+
+# IMX_IKPARMS -- Break out the image kernel params from the template list
+# expression string.
+
+procedure imx_ikparams (expr, ikparams, maxch)
+
+char	expr[ARB]			# expression string to modify
+char	ikparams[ARB]			# extracted image kernel params
+int	maxch				# max size of output strings
+
+int	ip, op, nexpr, niki
+char	ch, in[SZ_LINE], sub[SZ_LINE]
+
+bool	imx_isikparam()
+
+begin
+	call aclrc (in, SZ_LINE)		# initialize
+	call strcpy (expr, in, SZ_LINE)
+	nexpr = 0
+	niki  = 0
+
+	call aclrc (expr, maxch)
+	call aclrc (ikparams, maxch)
+	for (ip=1; in[ip] != EOS; ip=ip+1) {
+	    # Copy out the sub expression, i.e. up to the comma or EOS.
+	    call aclrc (sub, SZ_LINE)
+	    op = 1
+	    while (in[ip] != EOS && in[ip] != ',' && in[ip] != ';') {
+		sub[op] = in[ip]
+		ip = ip + 1
+		op = op + 1
+	    }
+	    ch = in[ip]
+
+	    if (imx_isikparam (sub)) {
+		if (niki > 0)
+		    call strcat (",", ikparams, maxch)
+		call strcat (sub, ikparams, maxch)
+		niki = niki + 1
+
+	    } else {
+		if (nexpr > 0)
+		    call strcat (",", expr, maxch)
+		call strcat (sub, expr, maxch)
+		nexpr = nexpr + 1
+	    }
+
+	    if (ch == EOS)
+		break
+	}
+end
+
+
+# IMX_ISIKPARAM -- See whether the substring refers to an image kernel param.
+
+bool procedure imx_isikparam (str)
+
+char	str[ARB]			# string to check
+
+int	strncmp()
+
+begin
+        if (strncmp (str, "extname", 7) == 0 || strncmp (str, "extver", 6) == 0)
+            return (TRUE)
+
+        # Check for the "no" versions of selected keywords.
+        else if (strncmp (str, "no", 2) == 0) {
+            if ((strncmp (str[3], "append",    4) == 0) ||
+                (strncmp (str[3], "inherit",   4) == 0) ||
+                (strncmp (str[3], "overwrite", 4) == 0) ||
+                (strncmp (str[3], "dupname",   4) == 0) ||
+                (strncmp (str[3], "expand",    4) == 0))
+                    return (TRUE)
+        }
+
+        # Other kernel keywords.
+        if (strncmp (str, "inherit",   4) == 0 ||
+            strncmp (str, "overwrite", 4) == 0 ||
+            strncmp (str, "dupname",   4) == 0 ||
+            strncmp (str, "append",    4) == 0 ||
+            strncmp (str, "noappend",  4) == 0 ||
+            strncmp (str, "type",      4) == 0 ||
+            strncmp (str, "expand",    4) == 0 ||
+            strncmp (str, "phulines",  4) == 0 ||
+            strncmp (str, "ehulines",  4) == 0 ||
+            strncmp (str, "padlines",  4) == 0 ||
+            strncmp (str, "cachesize", 4) == 0)
+                return (TRUE)
+                
+	return (FALSE)
+end
diff --git a/sys/imio/imt/imxescape.x b/sys/imio/imt/imxescape.x
new file mode 100644
index 00000000..92750ab7
--- /dev/null
+++ b/sys/imio/imt/imxescape.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imx.h"
+
+
+# IMX_ESCAPE -- Return a pointer to the composed file name, escaping parts
+# as needed.
+
+pointer procedure imx_escape (in, index, extname, extver, ikparams, 
+		section, expr, maxch)
+
+char	in[ARB]			#I File image name (without kernel or image sec)
+char	index[ARB]		#I Range list of extension indexes 
+char	extname[ARB]		#I Pattern for extension names
+char	extver[ARB]		#I Range list of extension versions
+char	ikparams[ARB]		#I Image kernel parameters
+char	section[ARB]		#I Image section
+char	expr[ARB]		#I Selection expression
+int	maxch			#I Print errors?
+
+pointer	out, op
+int	i, len, level
+char	ch, peek, prev
+bool	init_esc
+
+int	strlen()
+
+define output  {Memc[op]=$1;op=op+1}
+define escape  {output('\\');output($1)}
+
+begin
+	len = max (SZ_LINE, strlen (in))
+	call calloc (out, max (SZ_LINE, (4*len)), TY_CHAR)
+
+	op = out
+	level = 0
+
+	init_esc = false
+	for (i=1; i <= len; i=i+1) {
+	    prev = in[max(1,i)]
+	    ch   = in[i]
+	    peek = in[i+1]
+
+	    if (ch == EOS) 
+		break;
+	    if (ch == '[') {
+		if (prev != ']' && !init_esc) {
+		    output ('%')
+		    output ('%')
+		    output (CH_DELIM)
+		    init_esc = true
+		}
+		escape (ch)
+		level = level + 1
+	    } else if (ch == ']') {
+		output (ch)
+		if (peek != '[')		# closing delim
+		    output ('%')
+		level = level - 1
+	    } else if (ch == ',') {
+                if (level > 0)
+		    output('\\')
+                if (level == 0)
+		    init_esc = false
+		output (ch)
+	    } else if (ch == '*')
+		escape (ch)
+	    else
+		output (ch)
+	}
+	output (EOS)
+
+	return (out)
+end
diff --git a/sys/imio/imt/imxexpand.x b/sys/imio/imt/imxexpand.x
new file mode 100644
index 00000000..72efb17c
--- /dev/null
+++ b/sys/imio/imt/imxexpand.x
@@ -0,0 +1,1287 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include <mach.h>
+include <fio.h>
+include <finfo.h>
+include	<ctype.h>
+include	<diropen.h>
+
+include "imx.h"
+include <votParse_spp.h>
+
+
+define      SZ_BUF          8192	# name buffer string
+
+
+# IMX_IMEXPAND -- Expand a template of FITS files into a list of image
+# extensions.
+
+pointer procedure imx_imexpand (input, expr, index, extname, extver, ikparams, 
+				section, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of extension indexes
+char	extname[ARB]			# Patterns for extension names
+char 	extver[ARB]			# Range list of extension versions
+char	ikparams[ARB]			# Image kernel parameters
+char	section[ARB]			# Image section parameters
+int	nimages				# Number of output images
+
+int	lindex				# List index number?
+int	lname				# List extension name?
+int	lver				# List extension version?
+
+pointer	in, out				# Pointer to output string
+pointer	sp, sif, image, listout
+int	list, len, maxch
+
+int	imx_extns(), strlen(), fntgfnb(), fntlenb()
+pointer	imx_escape()
+bool	imx_sifmatch()
+
+begin
+	call smark (sp)
+	call salloc (in, SZ_FNAME, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+
+	lindex  = YES 			# expansion parameters
+	lname   = NO
+	lver    = NO
+	out	= NULL
+	len     = 0
+	nimages = 0
+	maxch   = SZ_LISTOUT
+
+	call aclrc (Memc[in], SZ_FNAME)
+	if (input[1] == '@')
+	    call strcpy (input[2], Memc[in], SZ_FNAME)
+	else
+	    call strcpy (input, Memc[in], SZ_FNAME)
+
+	# Get the list.
+	list = imx_extns (Memc[in], "IMAGE", index, extname, extver, 
+		    lindex, lname, lver, ikparams, section, expr, YES)
+
+	if (list == NULL || fntlenb (list) == 0) {
+	    call calloc (out, SZ_LINE, TY_CHAR)
+	    call strcpy (Memc[in], Memc[out], SZ_LINE)
+	    if (section[1] != EOS) {
+		call strcat ("\\[", Memc[out], maxch)
+		call strcat (section, Memc[out], maxch)
+		call strcat ("]", Memc[out], maxch)
+	    }
+	    if (ikparams[1] != EOS) {
+		call strcat ("\\[", Memc[out], maxch)
+		call strcat (ikparams, Memc[out], maxch)
+		call strcat ("]", Memc[out], maxch)
+	    }
+
+	    if (index[1] == EOS && imx_sifmatch (Memc[out], expr)) {
+	        nimages = 1
+	        sif = imx_escape (Memc[out], index, extname, extver, ikparams, 
+		    section, expr, maxch)
+	    } else
+	        call calloc (sif, SZ_LINE, TY_CHAR)
+	    call mfree (out, TY_CHAR)
+	    return (sif)
+	}
+
+	# Format the output and set the number of images.
+	call calloc (listout, maxch, TY_CHAR)
+	iferr {
+	    while (fntgfnb (list, Memc[image], SZ_FNAME) != EOF) {
+		nimages = nimages + 1
+		if (nimages > 1) {
+		    call strcat (",", Memc[listout], maxch)
+		    len = len + 1
+		}
+		if ((len + strlen (Memc[image])) >= maxch) {
+		    maxch = maxch + SZ_LISTOUT
+		    call realloc (listout, maxch, TY_CHAR)
+		}
+
+		call strcat (Memc[image], Memc[listout], maxch)
+		len = len + strlen (Memc[image])
+
+#		if (section[1] != EOS) {
+#		    call strcat ("[", Memc[listout], maxch)
+#		    call strcat (section, Memc[listout], maxch)
+#		    call strcat ("]", Memc[listout], maxch)
+#		    len = len + strlen (section) + 2
+#		}
+	    }
+
+	    # Escape the output image specification in a form that is correct
+	    # for the filename template interface.
+
+	    out = imx_escape (Memc[listout], index, extname, extver, ikparams, 
+		section, expr, maxch)
+
+	} then {
+	    call fntclsb (list)
+	    call sfree (sp)
+	    call error (1, "Output list format is too long")
+	}
+	call fntclsb (list)
+	call sfree (sp)
+
+	return (out)
+end
+
+
+# IMX_FEXPAND -- Expand a template of files into a list of images names.
+
+pointer procedure imx_fexpand (input, expr, index, extname, extver, ikparams, 
+				section, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of extension indexes
+char	extname[ARB]			# Patterns for extension names
+char 	extver[ARB]			# Range list of extension versions
+char	ikparams[ARB]			# Image kernel parameters
+char	section[ARB]			# Image section parameters
+int	nimages				# Number of output images
+
+pointer	sp, name, exp, lexp, nexp
+int	fd, ip, op, len, elen, nlines, nims, maxch, nchars, level
+bool	do_proc
+char	line[SZ_LINE], buf[SZ_LINE], ch
+
+define  output {buf[op]=$1;op=op+1}
+
+
+int	open(), getline(), strlen(), stridx()
+pointer	imx_imexpand()
+
+begin
+	iferr (fd = open (input, READ_ONLY, TEXT_FILE)) {
+	    call error (1, "Cannot open @file")
+	    return (NULL)
+	}
+
+	call smark (sp)
+	call salloc (name, SZ_PATHNAME, TY_CHAR)
+
+	maxch = SZ_FNT
+	call calloc (exp, maxch, TY_CHAR)
+	call aclrc (Memc[exp], maxch)
+
+#call eprintf (
+#  "fexpand: index='%s' name='%s' ver='%s' sec='%s' ik='%s' expr='%s'\n")
+#    call pargstr (index) ; call pargstr (extname) ; call pargstr (extver) ;
+#    call pargstr (section) ; call pargstr (ikparams) ; call pargstr (expr)
+
+	nlines = 0
+	nchars = 0
+	nimages = 0
+
+	while (getline (fd, line) > 0) {
+	    len = strlen (line)
+	    line[len] = EOS			# kill newline
+	    nlines = nlines + 1
+
+	    call aclrc (Memc[name], SZ_PATHNAME)
+	    call sprintf (Memc[name], SZ_PATHNAME, "@%s")
+		call pargstr (line)
+
+	    lexp = 0
+	    do_proc = (index[1]!=EOS || section[1]!=EOS || 
+		       expr[1]!=EOS || extname[1]!=EOS)
+
+	    if (input[1] == '@' || do_proc) {
+
+		# We're either being asked to expand what is presumably a
+		# image name in the form of an @@file input, or else we've
+		# added image sections, expressions, etc where the correct
+		# output specification is the expanded image name.
+
+	        lexp = imx_imexpand (Memc[name], expr, index, extname, extver,
+			ikparams, section, nims)
+
+	        elen = 0
+	        if (lexp != NULL && Memc[lexp] != EOS)
+		    elen = strlen (Memc[lexp])
+
+		# Reallocate space is the output name if needed.
+	        #if ((nchars + elen) >= (maxch - SZ_FNAME)) {
+	        if ((nchars + elen) >= maxch) {
+		    call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+		    call amovc (Memc[exp], Memc[nexp], maxch)
+		    call mfree (exp, TY_CHAR)
+		    maxch = maxch + SZ_FNT
+		    exp = nexp
+	        }
+
+		# Create a comma-delimited list.
+	        if (nlines > 1) 
+		    call strcat (",", Memc[exp], maxch)
+	        if (lexp != NULL && Memc[lexp] != EOS) {
+	            call strcat (Memc[lexp], Memc[exp], maxch)
+	            nchars = nchars + elen + 1
+	        }
+	        nimages = nimages + nims
+	    } else {
+	        if (nlines > 1) {
+		    call strcat (",", Memc[exp], maxch)
+	            nchars = nchars + 1
+		}
+		if (stridx ('[', line) != 0) {
+		    call aclrc (buf, SZ_LINE)
+		    op = 1
+		    for (ip=1; line[ip] != EOS; ip=ip+1) {
+			if (line[ip] == '[') {
+			    output ('%')
+			    output ('%')
+			    output (CH_DELIM)
+
+                    	    level = 0
+                    	    for (;  line[ip] != EOS;  ip=ip+1) {
+                        	ch = line[ip]
+                        	if (ch == ',') {                # ,
+                            	    if (level <= 0)
+                                	break                   # exit loop
+                            	    else {
+                                	output ('\\')
+                                	output (ch)
+                            	    }
+                        	} else if (ch == '[') {         # [
+                            	    output ('\\')
+                            	    output (ch)
+                            	    level = level + 1
+                        	} else if (ch == ']') {         # ]
+                            	    output (ch)
+                            	    level = level - 1
+                        	} else if (ch == '*') {         # *
+                            	    output ('\\')
+                            	    output (ch)
+                        	} else                          # normal chars
+                            	    output (ch)
+                    	    }
+                    	    output ('%')
+                    	    ip = ip - 1
+
+			    break
+			}
+			buf[op] = line[ip]
+			op = op + 1
+		    }
+	            call strcat (buf, Memc[exp], maxch)
+	            nchars = nchars + strlen (buf)
+
+		} else {
+	            call strcat (line, Memc[exp], maxch)
+	            nchars = nchars + strlen (line)
+		}
+
+	        nchars = nchars + len + 1
+	        nimages = nimages + 1
+
+		# Reallocate space is the output name if needed.
+
+	        if ((nchars + SZ_LINE) >= maxch) {
+		    call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+		    call amovc (Memc[exp], Memc[nexp], maxch)
+		    call mfree (exp, TY_CHAR)
+		    maxch = maxch + SZ_FNT
+		    exp = nexp
+	        }
+	    }
+	    call mfree (lexp, TY_CHAR)
+	}
+
+	call close (fd)			# clean up
+	call sfree (sp)
+
+	return (exp)
+end
+
+
+# IMX_TEXPAND -- Expand a template of tables into a list of images.
+
+pointer procedure imx_texpand (input, type, expr, index, fmt, nimages)
+
+char	input[ARB]			# Input table name
+int	type				# Table type
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of table rows
+char	fmt[ARB]			# Requested file format
+int	nimages				# Number of output images
+
+char	fname[SZ_PATHNAME]		# File name to open
+char	ofname[SZ_PATHNAME]
+pointer	sp, exp, nodename
+int	ip, vfd, status, delim
+
+pointer imx_votable(), imx_table()
+int	vfnopen(), vfnmapu(), strncmp(), ki_gnode()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+	exp = NULL			# initialize values
+	nimages = 0
+
+	# Get the base filename without the '@' prefix.
+	if (input[1] == '@')
+	    call strcpy (input[2], fname, SZ_PATHNAME)
+	else
+	    call strcpy (input, fname, SZ_PATHNAME)
+
+        # Map input VFN to OSFN.
+        ip = 1
+        if (strncmp (fname, "http://", 7) == 0) {
+            call strcpy (fname, ofname, SZ_PATHNAME)
+        } else {
+            vfd = vfnopen (fname, READ_ONLY)
+            status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+            call vfnclose (vfd, VFN_NOUPDATE)
+
+            # If the file resides on the local node strip the node name,
+            # returning a legal host system filename as the result.
+            if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+                ip = delim + 1
+        }
+
+
+	# Now process the file.  For a VOTable we parse the file and
+	# extract the acref columns as cached image names, for ascii
+	# tables we read the URLs directly but likewise returned the
+	# cache name.
+
+	if (type == IMT_TABLE)
+	    exp = imx_table (ofname[ip], index, nimages)
+	else if (type == IMT_VOTABLE)
+	    exp = imx_votable (ofname[ip], expr, index, fmt, nimages)
+
+	call sfree (sp)
+	return (exp)
+end
+
+
+# IMX_DEXPAND -- Expand a directory into a list of images.
+
+pointer procedure imx_dexpand (input, expr, index, extname, extver, ikparams, 
+    sec, nimages)
+
+char	input[ARB]			# List of MEF file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Index range
+char	extname[ARB]			# Extension name
+char	extver[ARB]			# Extension version
+char	ikparams[ARB]			# IKI parameters
+char	sec[ARB]			# Image section
+int	nimages				# Number of output images
+
+pointer	sp, exp, nodename, imname, listout
+int     dir, len, llen, nim, ip, delim, vfd, status, maxlen
+char    dirname[SZ_PATHNAME], ofname[SZ_PATHNAME], pdir[SZ_PATHNAME]
+char    fpath[SZ_PATHNAME], fname[SZ_PATHNAME]
+		
+pointer imx_imexpand ()
+int	vfnopen(), vfnmapu(), ki_gnode(), imx_filetype()
+int     strlen(), diropen(), isdirectory(), getline()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+	# Get the base filename without the '@' prefix.
+	if (input[1] == '@') {
+	    if (input[2] == '@')
+	        call strcpy (input[3], dirname, SZ_PATHNAME)
+	    else
+	        call strcpy (input[2], dirname, SZ_PATHNAME)
+	} else
+	    call strcpy (input, dirname, SZ_PATHNAME)
+
+	# Remove trailing '/' or '$' from dir
+	len = strlen (dirname)		
+	if (dirname[len] == '/')
+	    dirname[len] = EOS
+
+        # Map input VFN to OSFN.
+        ip = 1
+        vfd = vfnopen (dirname, READ_ONLY)
+        status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+        call vfnclose (vfd, VFN_NOUPDATE)
+
+        # If the file resides on the local node strip the node name,
+        # returning a legal host system filename as the result.
+        if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+            ip = delim + 1
+
+	call sfree (sp)
+
+        # Otherwise, read through the directory and remove the contents.
+        dir = diropen (ofname, SKIP_HIDDEN_FILES)
+
+	maxlen = SZ_LISTOUT
+	call calloc (listout, SZ_LISTOUT, TY_CHAR)
+	llen = 0
+        while (getline (dir, fname) != EOF) {
+            len = strlen (fname)
+            fname[len] = '\0'
+            
+            len = strlen (ofname)
+	    if (ofname[len] == '/' || ofname[len] == '$')
+	        call sprintf (fpath, SZ_PATHNAME, "%s%s")
+	    else
+	        call sprintf (fpath, SZ_PATHNAME, "%s/%s")
+		    call pargstr (dirname)
+		    call pargstr (fname)
+
+	    llen = llen + strlen (fpath)
+
+            # We only test plain files, skip directories.
+	    if (isdirectory (fpath, pdir, SZ_PATHNAME) > 0)
+		next
+
+	    if (imx_filetype (fpath) == IMT_IMAGE) {
+
+		if (input[2] == '@')
+		    imname = imx_imexpand (fpath, expr, index, extname, extver, 
+		        ikparams, sec, nim)
+		else {
+		    call calloc (imname, SZ_PATHNAME, TY_CHAR)
+		    call strcpy (fpath, Memc[imname], SZ_PATHNAME)
+		}
+
+		if (imname != NULL && Memc[imname] != EOS) {
+		    nimages = nimages + 1
+
+		    if (nimages > 1) {
+		        call strcat (",", Memc[listout], maxlen)
+		        llen = llen + 1
+		    }
+		    if ((llen + strlen (Memc[imname])) >= maxlen) {
+		        maxlen = maxlen + SZ_LISTOUT
+		        call realloc (listout, maxlen, TY_CHAR)
+		    }
+
+		    call strcat (Memc[imname], Memc[listout], maxlen)
+		    llen = llen + strlen (Memc[imname])
+
+		    if (sec[1] != EOS) {
+		        call strcat ("[", Memc[listout], maxlen)
+		        call strcat (sec, Memc[listout], maxlen)
+		        call strcat ("]", Memc[listout], maxlen)
+		        llen = llen + strlen (sec) + 2
+		    }
+
+		    if (imname != NULL)
+		        call mfree (imname, TY_CHAR)
+		}
+	    }
+        }
+
+	return (listout)
+end
+
+
+# IMX_FETCH -- Fetch the urls from the list.
+
+procedure imx_fetch (urls, istemp)
+
+char	urls[ARB]				#I file of URLS to download
+bool	istemp					#i is input file temporary?
+
+char	osfn[SZ_PATHNAME]
+char	url_osfn[SZ_PATHNAME]
+
+int	n, envgets()
+char	nthreads[SZ_FNAME]
+
+begin
+	# Get the host pathname of the cache directory.
+	call fmapfn ("cache$", osfn, SZ_PATHNAME)
+	call strupk (osfn, osfn, SZ_PATHNAME)
+
+	call fmapfn (urls, url_osfn, SZ_PATHNAME)
+	call strupk (url_osfn, url_osfn, SZ_PATHNAME)
+
+	n = envgets ("vo_nthreads", nthreads, SZ_FNAME)
+
+	# voget -B -C -D cache$ -b url -N <N> [-t] <infile>
+	if (istemp) {
+	    call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url", 
+	        "-N", nthreads, "-t", url_osfn)
+	} else {
+	    call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url", 
+	        "-N", nthreads, "-B", url_osfn)
+	}
+end
+
+
+# IMX_VOTABLE -- Read a VOTable, extracting the column of access references
+# as the image list.
+
+pointer procedure imx_votable (input, expr, index, fmt, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of table rows
+char	fmt[ARB]			# Requested file format
+int	nimages				# Number of output images
+
+pointer	vot, exp, ranges
+int	nranges, tfd
+char	tfile[SZ_PATHNAME]
+
+int	open()
+int	imx_decode_ranges()
+pointer	imx_votselect(), votinit()
+bool	envgetb()
+
+begin
+	# Create a temp file for the parsed access references.
+	call mktemp ("tmp$vot", tfile, SZ_PATHNAME)
+	iferr (tfd = open (tfile, NEW_FILE, TEXT_FILE)) {
+	    nimages = 0
+	    return (NULL)
+	}
+
+	# Expand the index string into a range structure.
+	if (index[1] != EOS) {
+	    call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+            if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+                 nranges, YES) == ERR) {
+		    call eprintf ("error parsing range '%s'\n")
+		        call pargstr (index)
+	    }
+	} else
+	    ranges = NULL
+ 
+	# Initialize the VOT struct and parse the table.
+	vot = votinit (input)
+
+	# Select the column from the VOTable with the access reference.
+	exp = imx_votselect (vot, tfd, fmt, ranges, nimages)
+
+	call mfree (ranges, TY_INT)
+	call votclose (vot)			# close the files
+	call close (tfd)
+
+	# Close the temp file and pre-fetch the data if needed.
+	if (envgetb ("vo_prefetch"))
+	    call imx_fetch (tfile, true)
+
+	return (exp)
+end
+
+
+# IMX_VOTSELECT -- Select the access reference column.
+
+pointer procedure imx_votselect (vot, fd, fmt, ranges, nimages)
+
+pointer	vot					#i VOTable struct pointer
+int	fd					#i filename of selected rows
+char	fmt[ARB]				#i file format
+pointer	ranges					#i ranges struct pointer
+int	nimages					#o no. selected images
+
+pointer	exp
+int	col, len, clen, maxlen
+char 	acref_ucd[SZ_FNAME], imfmt[SZ_FNAME], ucd_col[SZ_FNAME]
+char	acref[SZ_LINE], ucd[SZ_FNAME], buf[SZ_LINE], cfname[SZ_PATHNAME]
+int	i, rownum, field, acref_col, acfmt_col
+
+int	strcmp(), strsearch(), strlen(), vx_getNext()
+bool	imx_in_range()
+
+begin
+	# Figure out which table column we want.  Note that we assume there
+	# is only one <RESOURCE> element.  The caller may pass in a specific
+	# column to be used, otherwise look for for the named UCD.
+
+	col = 0						# FIXME
+	call aclrc (ucd_col, SZ_FNAME) 			# FIXME
+	call strcpy ("fits", imfmt, SZ_FNAME) 		# FIXME
+
+	call aclrc (acref_ucd, SZ_FNAME)
+	if (col > 0) {
+	    acref_col = col
+	} else {
+	    if (ucd_col[1] != EOS)
+		call strcpy (ucd_col, acref_ucd, SZ_FNAME)
+	    else
+		call strcpy (DEF_ACREF_UCD, acref_ucd, SZ_FNAME)
+
+	    # Find the access reference column number.
+            i = 0
+            for (field=VOT_FIELD(vot); field > 0; field=vx_getNext (field)) {
+		call aclrc (ucd, SZ_FNAME)
+                call vx_getAttr (field, "ucd", ucd, SZ_FNAME)
+		if (strcmp (ucd, acref_ucd) == 0) {
+		    acref_col = i
+		} else if (strcmp (ucd, DEF_FORMAT_UCD) == 0)
+		    acfmt_col = i
+	        i = i + 1
+	    }
+	}
+
+	maxlen = SZ_BUF
+	call calloc (exp, maxlen, TY_CHAR)
+
+	# Download the files.
+	for (i=0; i < VOT_NROWS(vot); i=i+1) {
+	    call vx_getTableCell (VOT_TDATA(vot), i, acfmt_col, imfmt, SZ_FNAME)
+
+	    if (fmt[1] == EOS || (fmt[1] != EOS && strsearch(imfmt, fmt) > 0)) {
+	        call vx_getTableCell (VOT_TDATA(vot), i, acref_col, 
+		    acref, SZ_LINE)
+
+	        # Do the row selection based on the index string.
+		rownum = i + 1
+	        if (ranges != NULL && ! imx_in_range (Memi[ranges], rownum))
+		    next
+
+	        # Generate a unique cache filename based on the URL.
+	        call fcname ("cache$", acref, "url", cfname, SZ_PATHNAME)
+
+	        # Append the cache name to the output string. Reallocate the
+	        # string pointer if needed.
+	        clen = strlen (cfname)
+	        if ((len + clen) >= maxlen) {
+		    maxlen = maxlen + SZ_BUF
+		    call realloc (exp, maxlen, TY_CHAR)
+	        }
+	        len = len + clen
+
+	        if (nimages == 0) {
+		    call strcpy (cfname, Memc[exp], maxlen)
+	        } else {
+		    call strcat (",", Memc[exp], maxlen)
+	            call strcat (cfname, Memc[exp], maxlen)
+	        }
+	        call aclrc (buf, SZ_LINE)
+
+		# Write the URL to the download file.
+		call fprintf (fd, "%s\n")
+		    call pargstr (acref)
+
+		nimages = nimages + 1
+	    }
+	}
+
+	return (exp)
+end
+
+
+# IMX_TABLE -- Read an ASCII text table of URLs and create the list
+# of files to process.  We apply the list index to do row selection
+# and return a list of cached filenames.
+
+pointer procedure imx_table (input, index, nimages)
+
+char	input[ARB]			# List of ME file names
+char	index[ARB]			# Range list of table rows
+int	nimages				# Number of output images
+
+pointer	exp, ranges
+int	rownum, nranges, fd, len, clen, maxlen
+char	buf[SZ_LINE], cfname[SZ_PATHNAME]
+
+int	open(), getline(), strlen()
+int	imx_decode_ranges()
+bool	imx_in_range(), envgetb()
+
+begin
+	call aclrc (buf, SZ_LINE)
+	iferr (fd = open (input, READ_ONLY, TEXT_FILE))
+	    call syserr (SYS_FOPEN)
+
+	maxlen = SZ_BUF
+	call calloc (exp, maxlen, TY_CHAR)
+
+	call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+	if (index[1] != EOS) {
+            if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+                 nranges, YES) == ERR) {
+		    call eprintf ("error parsing range '%s'\n")
+		        call pargstr (index)
+	    }
+	}
+ 
+	len = 0
+	nimages = 0
+	rownum = 0
+	while (getline (fd, buf) != EOF) {
+
+	    # Skip comments and blank lines.
+	    if (buf[1] == '\n' || buf[1] == '#')
+		next
+	    else
+		rownum = rownum + 1
+
+	    # Do the row selection based on the index string.
+	    if (index[1] != EOS && ! imx_in_range (Memi[ranges], rownum))
+		next
+
+	    # Generate a unique cache filename based on the URL.
+	    call fcname ("cache$", buf, "url", cfname, SZ_PATHNAME)
+
+	    # Append the cache name to the output string. Reallocate the
+	    # string pointer if needed.
+	    clen = strlen (cfname)
+	    if ((len + clen) >= maxlen) {
+		maxlen = maxlen + SZ_BUF
+		call realloc (exp, maxlen, TY_CHAR)
+	    }
+	    len = len + clen
+
+	    if (nimages == 0) {
+		call strcpy (cfname, Memc[exp], maxlen)
+	    } else {
+		call strcat (",", Memc[exp], maxlen)
+	        call strcat (cfname, Memc[exp], maxlen)
+	    }
+	    call aclrc (buf, SZ_LINE)
+
+	    nimages = nimages + 1
+	}
+
+	call mfree (ranges, TY_INT)
+	call close (fd)
+
+	if (envgetb ("vo_prefetch"))
+	    call imx_fetch (input, false)
+
+	return (exp)
+end
+
+
+# IMX_EXTNS -- Expand a template of ME files into a list of image extensions.
+
+int procedure imx_extns (files, exttype, index, extname, extver, 
+		lindex, lname, lver, ikparams, section, expr, err)
+
+char	files[ARB]		#I List of ME files
+char	exttype[ARB]		#I Extension type string
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	expr[ARB]		#I Selection expression
+char	ikparams[ARB]		#I Image kernel parameters
+char	section[ARB]		#I Image section parameters
+int	err			#I Print errors?
+int	list			#O Image list
+
+int	i, fd, create
+pointer	sp, temp, fname, imname, sec, rindex, rextver, ikp, str
+int	fntopnb(), fntgfnb()
+int	imx_decode_ranges(), nowhite(), open()
+errchk	open, imx_extn, delete
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (sec, SZ_FNAME, TY_CHAR)
+	call salloc (ikp, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Expand parameters.
+	list = fntopnb (files, NO)
+	call salloc (rindex, 3*SZ_RANGE, TY_INT)
+	if (imx_decode_ranges (index, Memi[rindex], SZ_RANGE, i, create) == ERR)
+	    call error (1, "Bad index range list")
+
+	rextver = NULL
+	if (nowhite (extver, Memc[str], SZ_LINE) > 0) {
+	    call salloc (rextver, 3*SZ_RANGE, TY_INT)
+	    if (imx_decode_ranges (Memc[str], Memi[rextver], SZ_RANGE, 
+		i, create) == ERR)
+		    call error (1, "Bad extension version range list")
+	}
+
+	call aclrc (Memc[ikp], SZ_LINE)
+	i = nowhite (ikparams, Memc[ikp], SZ_LINE)
+
+	# Expand ME files into list of image extensions in a temp file.
+	call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME)
+	fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE)
+	while (fntgfnb (list, Memc[fname], SZ_FNAME) != EOF) {
+	    call imgimage (Memc[fname], Memc[imname], SZ_FNAME)
+	    call imgsection (Memc[fname], Memc[sec], SZ_FNAME)
+
+	    call imx_extn (fd, Memc[imname], exttype, expr, rindex, extname, 
+		rextver, lindex, lname, lver, Memc[ikp], section, 
+		create, err)
+	}
+	call fntclsb (list)
+	call close (fd)
+
+	# Return list.
+	list = fntopnb (Memc[temp], NO)
+	call delete (Memc[temp+1])
+	call sfree (sp)
+
+	return (list)
+end
+
+
+# IMX_EXTN -- Expand a single ME file into a list of image extensions.
+# The image extensions are written to the input file descriptor.
+
+procedure imx_extn (fd, fname, exttype, expr, index, extname, extver, lindex, 
+		lname, lver, ikparams, section, create, err)
+
+int	fd			#I File descriptor for list 
+char	fname[SZ_FNAME]		#I File image name (without kernel or image sec)
+char	exttype[SZ_FNAME]	#I File extension type
+char	expr[ARB]		#I Selection expression
+pointer	index			#I Range list of extension indexes
+char	extname[ARB]		#I Pattern for extension names
+pointer	extver			#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	ikparams[ARB]		#I Image kernel parameters
+char	section[ARB]		#I Image section
+int	create			#I Create names from index range?
+int	err			#I Print errors?
+
+pointer	sp, image, name, type, str, im
+int	i, j, ver
+
+pointer	immap()
+int	imx_get_next_number(), errcode(), imgeti(), stridxs(), strcmp()
+bool	imx_in_range(), imx_extmatch(), imx_matchexpr(), imx_sifmatch()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (type, SZ_FNAME, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	i = -1
+	while (imx_get_next_number (Memi[index], i) != EOF) {
+	    j = stridxs ("[", fname)
+	    if (j > 0) {
+		if (i > 0)
+		    break
+		call strcpy (fname, Memc[image], SZ_FNAME)
+	    } else {
+		call sprintf (Memc[image], SZ_FNAME, "%s[%d]")
+		    call pargstr (fname)
+		    call pargi (i)
+	    }
+
+	    if (section[1] != EOS) {
+		call strcat ("[", Memc[image], SZ_FNAME)
+		call strcat (section, Memc[image], SZ_FNAME)
+		call strcat ("]", Memc[image], SZ_FNAME)
+	    }
+
+	    # We know the extension doesn't exist, generate the name.
+	    if (create == YES) {
+		call fprintf (fd, "%s")
+		    call pargstr (Memc[image])
+		if (section[1] != EOS) {
+		    call fprintf (fd, "[%s]")
+		        call pargstr (section)
+		}
+		call fprintf (fd, "\n")
+		next
+	    }
+
+
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		switch (errcode()) {
+		case SYS_FXFRFEOF:
+		    if (i == 1) {
+			if (extname[1] == EOS && imx_sifmatch (fname, expr)) {
+	    		    call fprintf (fd, "%s\n")
+			        call pargstr (fname)
+		 	    next
+			} else
+			    break
+		    }
+		    break
+		case SYS_IKIEXTN:
+		    next
+		case SYS_IKIOPEN:
+		    switch (i) {
+		    case 0:
+			next
+		    case 1:
+			if (err == YES)
+			    call erract (EA_WARN)
+			break
+		    default:
+			break
+		    }
+		default:
+		    call erract (EA_ERROR)
+		}
+	    }
+
+
+	    # Check the extension type.  [NOT USED]
+	    if (exttype[1] != EOS) {
+		iferr (call imgstr (im, "xtension", Memc[type], SZ_FNAME))
+		    Memc[type] = EOS
+		if (Memc[type] != EOS && strcmp (Memc[type], exttype) != 0) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+#call eprintf("imx_extn: name='%s' ver='%s' expr='%s' sec='%s' iki='%s'\n")
+#  call pargstr (extname) ; call pargstr (Memc[extver]) ;
+#  call pargstr (expr) ; call pargstr (section) ;
+#  call pargstr (ikparams) ;
+
+	    # Check the extension name.
+	    if (extname[1] != EOS) {
+		iferr (call imgstr (im, "extname", Memc[name], SZ_FNAME))
+		    Memc[name] = EOS
+		if (!imx_extmatch (Memc[name], extname)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+	    # Check the extension version.
+	    if (extver != NULL) {
+		iferr (ver = imgeti (im, "extver")) {
+		    call imunmap (im)
+		    next
+		}
+		if (!imx_in_range (Memi[extver], ver)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+	    # Check the selection expression.
+	    if (expr[1] != EOS) {
+		if (!imx_matchexpr (im, expr)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+
+	    # Set the extension name and version.
+	    if (lname == YES) {
+		iferr (call imgstr (im, "extname", Memc[name], SZ_LINE))
+		    Memc[name] = EOS
+	    } else
+		Memc[name] = EOS
+	    if (lver == YES) {
+		iferr (ver = imgeti (im, "extver"))
+		    ver = INDEFI
+	    } else
+		ver = INDEFI
+
+	    # Write the image name.
+	    call fprintf (fd, fname)
+	    if (j == 0) {
+		if (lindex == YES || (Memc[name] == EOS && IS_INDEFI(ver))) {
+		    call fprintf (fd, "[%d]")
+			call pargi (i)
+		}
+		if (Memc[name] != EOS) {
+		    call fprintf (fd, "[%s")
+			call pargstr (Memc[name])
+		    if (!IS_INDEFI(ver)) {
+			call fprintf (fd, ",%d")
+			    call pargi (ver)
+		    }
+		    if (ikparams[1] != EOS) {
+			call fprintf (fd, ",%s")
+			    call pargstr (ikparams)
+		    }
+		    call fprintf (fd, "]")
+		} else if (!IS_INDEFI(ver)) {
+		    call fprintf (fd, "[extver=%d")
+			call pargi (ver)
+		    if (ikparams[1] != EOS) {
+			call fprintf (fd, ",%s")
+			    call pargstr (ikparams)
+		    }
+		    call fprintf (fd, "]")
+		} else if (ikparams[1] != EOS) {
+		    call fprintf (fd, "[%s]%%")
+			call pargstr (ikparams)
+		}
+	    }
+	    if (section[1] != EOS) {
+	        call fprintf (fd, "[%s]")
+		    call pargstr (section)
+	    }
+	    call fprintf (fd, "\n")
+		
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+end
+
+
+# IMX_DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by EOLIST.
+
+int procedure imx_decode_ranges (range_string, ranges, max_ranges, 
+		nvalues, create)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+int	create			# generate range string?
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	create = NO
+	if (range_string[1] == '+') {
+	    ip = 2
+	    create = YES
+	} else
+	    ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all nonnegative integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = EOLIST
+	    	    nvalues = MAX_INT
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = EOLIST
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		    if (step == 0)
+			return (ERR)
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# IMX_GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure imx_get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (step == 0)
+		call error (1, "Step size of zero in range list")
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IMX_EXTMATCH -- Match extname against a comma-delimited list of patterns.
+
+bool procedure imx_extmatch (extname, patterns)
+
+char	extname[ARB]		#I Extension name to match
+char	patterns[ARB]		#I Comma-delimited list of patterns
+bool	stat			#O Match?
+
+int	i, j, k, sz_pat, strlen(), patmake(), patmatch(), nowhite()
+pointer	sp, patstr, patbuf
+
+begin
+	stat = false
+
+	sz_pat = strlen (patterns)
+	if (sz_pat == 0)
+	    return (stat)
+	sz_pat = sz_pat + SZ_LINE
+
+	call smark (sp)
+	call salloc (patstr, sz_pat, TY_CHAR)
+	call salloc (patbuf, sz_pat, TY_CHAR)
+
+	i = nowhite (patterns, Memc[patstr], sz_pat)
+	if (i == 0)
+	    stat = true
+	else if (i == 1 && Memc[patstr] == '*')
+	    stat = true
+	else {
+	    i = 1
+	    for (j=i;; j=j+1) {
+		if (patterns[j] != ',' && patterns[j] != EOS)
+		    next
+		if (j - i > 0) {
+		    if (j-i == 1 && patterns[i] == '*') {
+			stat = true
+			break
+		    }
+		    call strcpy (patterns[i], Memc[patstr+1], j-i)
+		    Memc[patstr] = '^'
+		    Memc[patstr+j-i+1] = '$'
+		    Memc[patstr+j-i+2] = EOS
+		    k = patmake (Memc[patstr], Memc[patbuf], sz_pat)
+		    if (patmatch (extname, Memc[patbuf]) > 0) {
+			stat = true
+			break
+		    }
+		}
+		if (patterns[j] == EOS)
+		    break
+		i = j + 1
+	    }
+	}
+
+	call sfree (sp)
+	return (stat)
+end
+
+
+# IMX_IN_RANGE -- Test number to see if it is in range.
+# If the number is INDEFI then it is mapped to the maximum integer.
+
+bool procedure imx_in_range (ranges, number)
+
+int     ranges[ARB]             # Range array
+int     number                  # Number to be tested against ranges
+
+int     ip, first, last, step, num
+
+begin
+        if (IS_INDEFI (number))
+            num = MAX_INT
+        else
+            num = number
+
+        for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+            first = min (ranges[ip], ranges[ip+1])
+            last = max (ranges[ip], ranges[ip+1])
+            step = ranges[ip+2]
+            if (num >= first && num <= last)
+                if (mod (num - first, step) == 0)
+                    return (true)
+        }
+
+        return (false)
+end
diff --git a/sys/imio/imt/imxexpr.x b/sys/imio/imt/imxexpr.x
new file mode 100644
index 00000000..55c185ef
--- /dev/null
+++ b/sys/imio/imt/imxexpr.x
@@ -0,0 +1,222 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<evexpr.h>
+include	<imset.h>
+include	<imhdr.h>
+include	<ctype.h>
+include	<lexnum.h>
+
+define	LEN_USERAREA	28800		# allow for the largest possible header
+define	SZ_IMAGENAME	63		# max size of an image name
+define	SZ_FIELDNAME	31		# max size of a field name
+
+define	DEBUG		FALSE
+
+
+
+# IMX_MATCHEXPR -- Match the open image descriptor against the expression.
+
+bool procedure imx_matchexpr (im, expr)
+
+pointer	im				#I image descriptor
+char    expr[ARB]           		#I expression string
+
+bool    stat
+char	val[SZ_LINE]
+pointer	o
+
+pointer	imt_im			# getop common
+char	imt_image[SZ_IMAGENAME]
+char	imt_field[SZ_FIELDNAME]
+common	/imtgop/ imt_im, imt_image, imt_field
+
+pointer	evexpr()
+extern	imx_getop()
+int	locpr()
+errchk	locpr, evexpr
+
+begin
+	call aclrc (val, SZ_LINE)
+	call aclrc (imt_image, SZ_IMAGENAME)
+	call aclrc (imt_field, SZ_FIELDNAME)
+
+	imt_im = im
+	if (expr[1] != EOS) {
+	    iferr {
+		o = evexpr (expr, locpr (imx_getop), 0)
+	    	call imx_encodeop (o, val, SZ_LINE)
+	    	stat = O_VALB(o)
+	    	call xev_freeop (o)
+	    	call mfree (o, TY_STRUCT)
+	    } then
+		stat = FALSE
+
+	    if (DEBUG) {
+		call eprintf ("expr = '%s'  %b\n")
+		    call pargstr (expr) ; call pargb (stat)
+	    }
+
+	    return (stat)
+	}
+
+	return (FALSE)
+end
+
+
+# IMX_SIFMATCH -- Check whether the file is a simple image matching the
+# expression.
+
+bool procedure imx_sifmatch (fname, expr)
+
+char    fname[ARB]           		#I image name
+char    expr[ARB]           		#I expression string
+
+pointer	im
+bool	stat
+
+pointer	immap()
+bool	imx_matchexpr (), streq()
+errchk	immap
+
+begin
+	if (expr[1] == EOS)
+	    return (TRUE)
+
+	iferr (im = immap (fname, READ_ONLY, 0)) {
+	    return (FALSE)
+	}
+
+	if (streq (expr, "yes"))
+	    stat = TRUE
+	else
+	    stat = imx_matchexpr (im, expr)
+	call imunmap (im)
+
+	return (stat)
+end
+
+
+# IMX_GETOP -- Satisfy an operand request from EVEXPR.  In this context,
+# operand names refer to the fields of the image header.  The following
+# special operand names are recognized:
+#
+#	.		a string literal, returned as the string "."
+#	$		the value of the current field
+#	$F		the name of the current field
+#	$I		the name of the current image
+#	$T		the current time, expressed as an integer
+#
+# The companion procedure HE_GETOPSETIMAGE is used to pass the image pointer
+# and image and field names.
+
+procedure imx_getop (operand, o)
+
+char	operand[ARB]		# operand name
+pointer	o			# operand (output)
+
+pointer	imt_im			# getop common
+char	imt_image[SZ_IMAGENAME]
+char	imt_field[SZ_FIELDNAME]
+common	/imtgop/ imt_im, imt_image, imt_field
+bool	streq()
+long	clktime()
+errchk	imx_getfield
+
+begin
+	if (streq (operand, ".")) {
+	    call xev_initop (o, 1, TY_CHAR)
+	    call strcpy (".", O_VALC(o), 1)
+
+	} else if (streq (operand, "$")) {
+	    call imx_getfield (imt_im, imt_field, o)
+	
+	} else if (streq (operand, "$F")) {
+	    call xev_initop (o, SZ_FIELDNAME, TY_CHAR)
+	    call strcpy (imt_field, O_VALC(o), SZ_FIELDNAME)
+
+	} else if (streq (operand, "$I")) {
+	    call xev_initop (o, SZ_IMAGENAME, TY_CHAR)
+	    call strcpy (imt_image, O_VALC(o), SZ_IMAGENAME)
+
+	} else if (streq (operand, "$T")) {
+	    # Assignment of long into int may fail on some systems.  Maybe
+	    # should use type string and let database convert to long...
+
+	    call xev_initop (o, 0, TY_INT)
+	    O_VALI(o) = clktime (long(0))
+
+	} else
+	    call imx_getfield (imt_im, operand, o)
+end
+
+
+# IMX_GETFIELD -- Return the value of the named field of the image header as
+# an EVEXPR type operand structure.
+
+procedure imx_getfield (im, field, o)
+
+pointer	im			# image descriptor
+char	field[ARB]		# name of field to be returned
+pointer	o			# pointer to output operand
+
+bool	imgetb()
+int	ftype, imgeti(), imgftype()
+real	imgetr()
+
+begin
+	iferr {
+	    ftype = imgftype (im, field)
+	} then {
+	    call xev_initop (o, SZ_LINE, TY_CHAR) 	# keyword not found
+	    call aclrc (O_VALC(o), SZ_LINE)
+	    return
+	}
+
+	switch (ftype) {
+	case TY_BOOL:
+	    call xev_initop (o, 0, TY_BOOL)
+	    O_VALB(o) = imgetb (im, field)
+
+	case TY_SHORT, TY_INT, TY_LONG:
+	    call xev_initop (o, 0, TY_INT)
+	    O_VALI(o) = imgeti (im, field)
+
+	case TY_REAL, TY_DOUBLE, TY_COMPLEX:
+	    call xev_initop (o, 0, TY_REAL)
+	    O_VALR(o) = imgetr (im, field)
+
+	default:
+	    call xev_initop (o, SZ_LINE, TY_CHAR)
+	    call imgstr (im, field, O_VALC(o), SZ_LINE)
+	}
+end
+
+
+# IMX_ENCODEOP -- Encode an operand as returned by EVEXPR as a string.  EVEXPR
+# operands are restricted to the datatypes bool, int, real, and string.
+
+procedure imx_encodeop (o, outstr, maxch)
+
+pointer	o			# operand to be encoded
+char	outstr[ARB]		# output string
+int	maxch			# max chars in outstr
+
+begin
+	switch (O_TYPE(o)) {
+	case TY_BOOL:
+	    call sprintf (outstr, maxch, "%b")
+		call pargb (O_VALB(o))
+	case TY_CHAR:
+	    call sprintf (outstr, maxch, "%s")
+		call pargstr (O_VALC(o))
+	case TY_INT:
+	    call sprintf (outstr, maxch, "%d")
+		call pargi (O_VALI(o))
+	case TY_REAL:
+	    call sprintf (outstr, maxch, "%g")
+		call pargr (O_VALR(o))
+	default:
+	    call error (1, "unknown expression datatype")
+	}
+end
diff --git a/sys/imio/imt/imxftype.x b/sys/imio/imt/imxftype.x
new file mode 100644
index 00000000..e083f032
--- /dev/null
+++ b/sys/imio/imt/imxftype.x
@@ -0,0 +1,119 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <imhdr.h>
+include "imx.h"
+
+
+# IMX_FILETYPE -- Determine the file type.
+
+int procedure imx_filetype (fname)
+
+char	fname[ARB]				#i file name
+
+char	img[SZ_FNAME], name[SZ_FNAME], buf[SZ_LINE]
+
+int	i, nchars, fd
+bool	is_http_list
+
+int	errcode(), open(), read(), access(), imaccess()
+int	strncmp(), strsearch(), isdirectory()
+pointer	im, immap()
+
+begin
+	# Check for a URL.
+	if (strncmp ("http://", fname, 7) == 0) 
+	    return (IMT_URL)
+
+	call aclrc (name, SZ_FNAME)
+	if (fname[1] == '@')
+	    call strcpy (fname[2], name, SZ_FNAME)
+	else
+	    call strcpy (fname, name, SZ_FNAME)
+
+ 	# See if it is a directory.
+	if (isdirectory (name, buf, SZ_LINE) > 0) 
+	    return (IMT_DIR)
+
+	# Check for concatenated strings.
+	if (strsearch (fname, "//") > 0) {
+	    if (isdirectory (fname, buf, SZ_LINE) > 0) 
+	        return (IMT_DIR)
+	    else
+	        return (IMT_FILE)
+	}
+
+	call aclrc (img, SZ_FNAME)				# PHU
+	call sprintf (img, SZ_FNAME, "%s[0]")
+	    call pargstr (name)
+
+	# Get a peek at the file.
+	call aclrc (buf, SZ_LINE)
+	if (imaccess (name, READ_ONLY) == YES ||
+	    imaccess (img, READ_ONLY) == YES) {
+	        return (IMT_IMAGE);
+	} else if (access (name, 0, 0) == YES) {
+	    fd = open (name, READ_ONLY, TEXT_FILE)
+	    nchars = read (fd, buf, SZ_LINE)
+	    call strupr (buf)
+	    call close (fd)
+	}
+
+	# See if it might be an image of some kind.
+	if (strncmp (buf, "SIMPLE", 6) == 0) {
+
+	    ifnoerr (im = immap (name, READ_ONLY, 0)) {	# SIF, OIF, etc
+	        call imunmap (im)
+	        return (IMT_IMAGE)
+	    }
+
+	    do i = 0, 1 {					# MEF
+	        call aclrc (img, SZ_FNAME)
+	        call sprintf (img, SZ_FNAME, "%s[%d]")
+	            call pargstr (name)
+	            call pargi (i)
+
+	        iferr (im = immap (img, READ_ONLY, 0)) {
+                    switch (errcode()) {
+                    case SYS_FXFRFEOF:
+                        break
+                    case SYS_IKIEXTN:
+                        next
+                    case SYS_IKIOPEN:
+		        if (i == 0)
+                            next
+                        break
+                    default:
+                        call erract (EA_ERROR)
+                    }
+	        } else {
+		    call imunmap (im)
+		    return (IMT_IMAGE)
+		}
+	    }
+
+	} else {
+	
+	    # If we get this far, we have a file of some kind.  See if it is a
+ 	    # list of URLs, a VOTable, or a plain file.
+	    is_http_list = FALSE
+	    fd = open (name, READ_ONLY, TEXT_FILE)
+	    do i = 1, 10 {
+	        call aclrc (buf, SZ_LINE)
+	        nchars = read (fd, buf, SZ_LINE)
+	        call strupr (buf)
+	        if (strsearch (buf, "VOTABLE") > 0) {
+	    	    call close (fd)
+		    return (IMT_VOTABLE)
+	        } else if (strncmp (buf, "http://", 7) == 0)
+	    	    is_http_list = TRUE
+	    }
+	    call close (fd)
+	}
+
+	if (is_http_list)
+	    return (IMT_TABLE)
+	else
+	    return (IMT_FILE)
+end
diff --git a/sys/imio/imt/imxparse.x b/sys/imio/imt/imxparse.x
new file mode 100644
index 00000000..f26f0918
--- /dev/null
+++ b/sys/imio/imt/imxparse.x
@@ -0,0 +1,203 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <imhdr.h>
+include "imx.h"
+
+		
+define IMT_INDEX	1
+define IMT_NAME		2
+define IMT_VER		3
+define IMT_EXPR		4
+		
+define DEBUG		FALSE
+
+
+
+# IMX_PARSE -- Parse a filename to extract index ranges, extension names,
+# versions and filtering expressions.
+
+int procedure imx_parse (input, fname, index, extname, extver, 
+			    expr, sec, ikparams, maxch)
+
+char    input[ARB]                       #i template string ptr
+char    fname[ARB]                      #o file name
+char    index[ARB]                      #o index range string
+char    extname[ARB]                    #o extension name
+char    extver[ARB]                     #o extension version
+char    expr[ARB]                       #o filtering expression string
+char    sec[ARB]                        #o image section string
+char    ikparams[ARB]                   #o image kernel section params
+int	maxch				#i max chars in string params
+
+pointer	im
+int     nchars, ip, idx
+char	comma, lexpr[SZ_LINE], subex[SZ_LINE], name[SZ_PATHNAME]
+
+int	imx_breakout(), imx_next_expr(), imx_expr_type(), stridx()
+pointer	immap()
+
+begin
+        call aclrc (expr, maxch)		# initialize
+        call aclrc (index, maxch)
+        call aclrc (fname, maxch)
+        call aclrc (extver, maxch)
+        call aclrc (extname, maxch)
+        call aclrc (ikparams, maxch)
+        call aclrc (lexpr, SZ_LINE)
+
+
+	# Separate the filename from the expression string.
+	nchars = imx_breakout (input, NO, fname, lexpr, sec, ikparams, maxch)
+
+	# Parse into sub-expression strings, breaking it up into the 
+	# appropriate form depending on the contents.
+	if (lexpr[1] != EOS) {
+	    ip = 1
+	    while (imx_next_expr (lexpr, ip, subex, maxch) != EOS) {
+
+		if (DEBUG) {
+		    call eprintf ("parse subex = '%s'\t\t'%s'\n")
+    			call pargstr (subex) ; call pargstr (lexpr)
+		}
+
+		switch (imx_expr_type (subex)) {
+		case IMT_INDEX:
+		    call strcpy (subex, index, maxch)
+		case IMT_NAME:
+		    call strcpy (subex, extname, maxch)
+		case IMT_VER:
+		    comma = ','
+		    idx = stridx (comma, subex)
+		    call strcpy (subex[idx+1], extver, maxch)
+		    subex[idx] = '\0'
+		    call strcpy (subex, extname, maxch)
+		case IMT_EXPR:
+		    if (expr[1] != EOS) {
+		        call strcat ("||", expr, maxch)
+		        call strcat (subex, expr, maxch)
+		    } else
+		        call strcpy (subex, expr, maxch)
+		default:
+		    call error (1, "unknown expression type")
+		}
+
+		ip = ip + 1
+	    }
+	}
+
+	if (DEBUG) {
+	    call eprintf ("final expr = '%s' index = '%s' sec = '%s'\n")
+		call pargstr (expr)
+		call pargstr (index)
+		call pargstr (sec)
+	}
+	    
+	call aclrc (name, SZ_PATHNAME)
+	if (fname[1] == '@')
+	    call strcpy (fname[2], name, SZ_PATHNAME)
+	else
+	    call strcpy (fname, name, SZ_PATHNAME)
+	if (index[1] != EOS) {
+	    call strcat ("[", name, SZ_PATHNAME)
+	    call strcat (index, name, SZ_PATHNAME)
+	    call strcat ("]", name, SZ_PATHNAME)
+	}
+	if (sec[1] != EOS) {
+	    call strcat ("[", name, SZ_PATHNAME)
+	    call strcat (sec, name, SZ_PATHNAME)
+	    call strcat ("]", name, SZ_PATHNAME)
+	}
+
+#	iferr {
+#	    im = immap (name, READ_ONLY, 0)
+#	    call imunmap (im)
+#	} then
+#	    ;
+
+        return (nchars)
+end
+
+
+# IMX_NEXT_EXPR -- Get the next sub expression from the string.  Expressions
+# are delimited by semicolons, the location in the expression string is
+# updated.
+
+int procedure imx_next_expr (expr, ip, subex, maxch)
+
+char    expr[ARB]                       #i input expression string
+int	ip				#u location in expr
+char    subex[ARB]                      #o sub expression string
+int	maxch				#i max size of subexpr string
+
+char	op
+
+begin
+	if (expr[ip] == EOS)
+	    return (EOS)
+
+	# Skip leading whitespace/delimiters.
+	while (IS_WHITE(expr[ip]) || expr[ip] == ';')	
+	    ip = ip + 1
+
+	op = 1				# copy until EOS or next delimiter
+	while (expr[ip] != EOS && expr[ip] != ';' && expr[ip] != ']') {
+	    subex[op] = expr[ip]
+	    ip = ip + 1
+	    op = op + 1
+	}
+	subex[op] = EOS
+
+	if (expr[ip] == ']')
+	    ip = ip + 1
+
+	return (ip)
+end
+
+
+# IMX_EXPR_TYPE -- Determine the type of expression we have.  A range list
+# is assumed to be an extension index list; a single alphabetic word is 
+# assumed to be an extension name, if followed by a numeric value it also
+# contains an extension version;  anything else is a selection expression.
+
+int procedure imx_expr_type (expr)
+
+char	expr[ARB]			#i expression
+
+int	ip, len
+char	ch
+int	strlen (), stridxs(), stridx()
+
+begin
+	len = strlen (expr)
+
+	# [<expr>]
+	ch = expr[1]
+	if ((IS_ALNUM(expr[1]) || stridx (ch, "('\"") > 0) &&
+	     stridxs ("?=:()<>&|@", expr) != 0)
+	    	return (IMT_EXPR)
+
+	# [extname,extver]
+	ch = ','
+	if (IS_ALPHA(expr[1]) && IS_DIGIT(expr[len]) && stridx (ch, expr) > 0)
+	    return (IMT_VER)
+
+	# [extname]
+	if (IS_ALPHA(expr[1]) && stridx (ch, expr) == 0)
+	    return (IMT_NAME)
+
+	# [index] or [index_range]
+	if ((IS_DIGIT(expr[1])) || 
+	    ((expr[1] == '+' || expr[1] == '-') && IS_DIGIT(expr[2]))) {
+	        for (ip=1; expr[ip] != EOS; ip = ip + 1) {
+		    ch = expr[ip]
+		    if (! IS_DIGIT(ch)) {
+		        if (stridx (ch, "-x,+") == 0)
+	    	            return (IMT_EXPR)
+		    }
+	        }
+	        return (IMT_INDEX)
+	}
+
+	return (0)
+end
diff --git a/sys/imio/imt/imxpreproc.x b/sys/imio/imt/imxpreproc.x
new file mode 100644
index 00000000..b0faccfc
--- /dev/null
+++ b/sys/imio/imt/imxpreproc.x
@@ -0,0 +1,539 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imx.h"
+
+define	DEBUG		FALSE
+define	SZ_PREFIX	2
+
+
+pointer procedure imx_preproc (template)
+
+char	template[ARB]				#i input template string
+
+pointer	exp, pre, out, op, list
+char	file[SZ_PATHNAME]
+char 	mods[SZ_LINE], fname[SZ_LINE]
+int	i, j, osize, len, llen, nmods
+
+define	output 	 {Memc[out+op]=$1;op=op+1}
+define	outstr 	 {len=strlen($1);for(j=1;j<=len;j=j+1)output($1[j])}
+define	outcomma {if(($1))output(',')}
+
+pointer	imx_fnexpand (), imx_preproc_list()
+pointer	fntopnb()
+int	fntlenb(), fntgfnb(), strlen(), strsearch(), strncmp(), imx_split()
+
+begin
+	# First Pass: Do any filename expansion in the template, maintaining 
+	# the '@' prefix and any modifiers.  The result is a comma-delimited 
+	# list we process later to expand further.
+
+	exp = imx_fnexpand (template)
+
+	# Second Pass: Process the matched list to expand the '@' files and 
+	# modifiers into a simple comma-delimited list the FNT interface 
+	# will process.
+
+	pre = imx_preproc_list (Memc[exp])
+
+	# Third Pass: Handle concatenation in the filenames.
+	if ((strncmp (Memc[pre],"http://",7) == 0) ||
+	    (strncmp (Memc[pre],"file://",7) == 0)) {
+	    osize = strlen (Memc[pre])
+	    call calloc (out, osize, TY_CHAR)
+	    call strcpy (Memc[pre], Memc[out], osize)
+
+	} else if (strsearch(Memc[pre],"//") > 0 && 
+	    strsearch(Memc[pre],".fits") > 0) {
+
+	    # FIXME -- Need to handle the case of concatenation with 
+	    # a MEF file.  Problem is, expanding the MEF requires we
+	    # recursively call ourselves to expand the image so we
+	    # need to do some restructuring.  For example,
+	    #
+	    #  foo // @mef.fits  ->  foomef.fits[1],foomef.fits[2], ....
+	    #  @mef.fits // foo  ->  meffoo.fits[1],meffoo.fits[2], ....
+
+	    call error (0, "Image expansion/concatenation not yet supported.")
+
+
+	} else if (strsearch (Memc[pre], "//") > 0) {
+
+            nmods = imx_split (Memc[pre], fname, mods, SZ_LINE)
+	    list = fntopnb (fname, YES)
+	    llen = fntlenb (list)
+
+	    osize = strlen (Memc[pre])
+	    call calloc (out, osize * 2, TY_CHAR)
+
+	    op = 0
+            for (i=0; i < llen; i=i+1) {
+                call aclrc (file, SZ_PATHNAME)
+                if (fntgfnb (list, file, SZ_PATHNAME) == EOF) 
+                    break
+
+		if ((op + strlen (file) + strlen (mods) + 3) >= osize) {
+		    osize = osize + SZ_LINE
+		    call realloc (out, osize, TY_CHAR)
+		}
+
+		# FIXME ???
+		#outcomma (i > 0); output ('@'); outstr(file) ; outstr(mods)
+		outcomma (i > 0); outstr(file) ; outstr(mods)
+            }
+	    output ('\0')
+	    call fntclsb (list)
+
+	} else {
+	    osize = strlen (Memc[pre])
+	    call calloc (out, osize, TY_CHAR)
+	    call strcpy (Memc[pre], Memc[out], osize)
+	}
+
+	if (DEBUG) {
+	    call eprintf ("pre exp = '%s'\n") ; call pargstr (Memc[exp])
+	    call eprintf ("pre pre = '%s'\n") ; call pargstr (Memc[pre])
+	    call eprintf ("pre out = '%s'\n") ; call pargstr (Memc[out])
+	}
+
+	call mfree (exp, TY_CHAR)		# clean up
+	call mfree (pre, TY_CHAR)
+
+	return (out)
+end
+
+
+# IMX_FNEXPAND -- Do any filename expansion in the template, maintaining the 
+# '@' prefix and any modifiers.  The result is a comma-delimited list we 
+# process later to expand further.
+
+pointer procedure imx_fnexpand (template)
+
+char	template[ARB]				#i input template string
+
+pointer	elem, ep, op, out, listp, sz_out, op_start, op_end
+int	i, j, ip, in, len, llen, nelem, fi, fo
+char    prefix[SZ_PREFIX], fname[SZ_PATHNAME], mods[SZ_LINE]
+char    left[SZ_PATHNAME], right[SZ_PATHNAME]
+char    file[SZ_PATHNAME], cfname[SZ_PATHNAME], osfn[SZ_PATHNAME]
+
+define	output {Memc[op]=$1;op=op+1}
+define	outstr {len=strlen($1);for(j=1;j<=len;j=j+1)output($1[j])}
+
+int	fntopnb(), fntgfnb(), fntlenb(), strlen(), stridxs(), strsearch()
+int	imx_get_element(), strncmp(), stridx()
+
+begin
+	# Allocate an intial string buffer.
+	call calloc (out, SZ_FNT, TY_CHAR)
+	call calloc (elem, SZ_FNT, TY_CHAR)
+
+	in = 1
+	nelem = 0
+	op = out
+	op_start = out
+	op_end = out + SZ_FNT - 1
+	sz_out = SZ_FNT
+
+	while (imx_get_element (template, in, Memc[elem], SZ_FNT) != EOS) {
+
+	    ep = elem
+	    nelem = nelem + 1
+	    outcomma(nelem > 1)
+
+	    call aclrc (prefix, SZ_PREFIX)
+	    call aclrc (fname,  SZ_PATHNAME)
+	    call aclrc (mods,   SZ_LINE)
+
+	    # Gather any prefix '@' symbols.
+	    if (Memc[elem] == '@') {
+	        for (i=1; Memc[ep] == '@'; i=i+1) {
+		    prefix[i] = Memc[ep]
+		    ep = ep + 1
+	        }
+	    } else {
+		ip = stridx ('@', Memc[elem])
+		if (ip > 1) {
+		  call strcpy (Memc[elem], prefix, ip-1)
+		  ep = elem + ip - 1
+		  prefix[ip] = EOS
+ 		  call strcat ("//", prefix[ip], SZ_PREFIX)
+		}
+	    }
+	
+	    # Get the filename component up to the EOS or the modifiers.
+	    for (i=1; Memc[ep] != '[' && Memc[ep] != EOS; i=i+1) {
+		fname[i] = Memc[ep]
+		ep = ep + 1
+	    }
+
+            if (strncmp ("http://", fname, 7) == 0) {
+        	call fmapfn ("cache$", osfn, SZ_PATHNAME)
+        	call strupk (osfn, osfn, SZ_PATHNAME)
+
+                #call fcadd (osfn, fname, "fits", cfname, SZ_PATHNAME)
+                call fcadd (osfn, fname, "", cfname, SZ_PATHNAME)
+
+                call strcpy (cfname, fname, SZ_PATHNAME)
+
+            } else if (strncmp ("file://", fname, 7) == 0) {
+		fi = 8
+                if (strncmp ("file:///localhost", fname, 17) == 0)
+		    fi = 18
+                else if (strncmp ("file://localhost", fname, 16) == 0)
+		    fi = 17
+
+		for (fo=1; fname[fi] != EOS; fi=fi+1) {
+		    if (fname[fi] == '/' && fname[fi+1] == '/')
+			fi = fi + 1
+		    cfname[fo] = fname[fi]
+		    fo = fo + 1
+		}
+                call strcpy (cfname, fname, SZ_PATHNAME)
+            }
+	
+	    # Get the modifier strings.
+	    for (i=1; Memc[ep] != EOS ; i=i+1) {
+		mods[i] = Memc[ep]
+		ep = ep + 1
+	    }
+	
+		
+	    if (DEBUG) {
+		call eprintf ("fnexp: '%s' --> '%s' '%s' '%s'\n")
+		    call pargstr (Memc[elem]); call pargstr (prefix);
+		    call pargstr (fname);    call pargstr (mods)
+	    }
+
+	    # Expand wildcards if needed.
+	    if (stridxs("*?", fname) > 0) {
+
+		# FIXME - Need to do concatenation here ...??
+	        if (strsearch (fname, "//") > 0) {
+		    call aclrc (left, SZ_PATHNAME)
+		    call aclrc (right, SZ_PATHNAME)
+
+		    # Gather the left and right side of a concatenation with
+		    # wildcards.  Expand the side with the wildcard but
+		    # maintain the concatenation so we keep the previous
+		    # behavior in how these processed.
+		    for (ip=1; fname[ip] != '/'; ip=ip+1)
+		 	left[ip] = fname[ip]
+		    ip = ip + 2
+		    for (i=1; fname[ip] != EOS; ip=ip+1) {
+		 	right[i] = fname[ip]
+			i = i + 1
+		    }
+
+	    	    if (stridxs("*?", left) > 0) {
+			listp = fntopnb (left, YES)
+			llen = fntlenb (listp)
+	 		for (i=0; i < llen; i=i+1) {
+		    	    call aclrc (file, SZ_PATHNAME)
+		    	    if (fntgfnb (listp, file, SZ_PATHNAME) == EOF) 
+				break
+		    	    outcomma (i > 0)
+		    	    outstr(prefix)
+		    	    outstr(file) ; outstr("//") ; outstr(right)
+			}
+			call fntclsb (listp)
+	    	    } else {
+			listp = fntopnb (right, YES)
+			llen = fntlenb (listp)
+	 		for (i=0; i < llen; i=i+1) {
+		    	    call aclrc (file, SZ_PATHNAME)
+		    	    if (fntgfnb (listp, file, SZ_PATHNAME) == EOF) 
+				break
+		    	    outcomma (i > 0)
+		    	    outstr(prefix)
+		    	    outstr(left) ; outstr("//") ; outstr(file)
+			}
+			call fntclsb (listp)
+		    }
+		    next
+
+		} else {
+		    listp = fntopnb (fname, YES)
+		    llen = fntlenb (listp)
+	 	    for (i=0; i < llen; i=i+1) {
+		        call aclrc (file, SZ_PATHNAME)
+		        if (fntgfnb (listp, file, SZ_PATHNAME) == EOF) 
+		    	    break
+		        outcomma ( i > 0)
+		        outstr(prefix) ; outstr(file) ; outstr(mods)
+
+
+	        	# Reallocate the output string if needed.
+	        	if ((op_end - op) < SZ_FNAME || op >= op_end) {
+		    	    sz_out = sz_out + SZ_FNT
+		    	    len = (op - out - 1)
+
+		    	    call calloc (op_start, sz_out, TY_CHAR)
+			    call amovc (Memc[out], Memc[op_start], len)
+			    for (op=op_start; Memc[op] != EOS; )
+				op = op + 1
+
+		    	    op_end = op_start + sz_out
+			    call mfree (out, TY_CHAR)
+		    	    out = op_start
+	        	}
+		    }
+		    call fntclsb (listp)
+		}
+
+
+	    } else {
+		outstr(prefix) ; outstr(fname) ; outstr(mods)
+	    }
+
+	    call aclrc (Memc[elem], SZ_FNT)
+	}
+	output ('\0')
+
+	call mfree (elem, TY_CHAR)
+	return (out)
+end
+
+
+# IMX_PREPROC_LIST -- Process the expanded filename string to open any
+# @files and produce final expression strings.
+
+pointer procedure imx_preproc_list (template)
+
+char	template[ARB]			#i template string
+
+pointer	tp, ip, op, itp, listp, elem
+int	i, lp, in, len, tend, tlen, plen, llen
+int	nchars, atat, nelem, in_filter
+char    ch, file[SZ_LINE], expr[SZ_LINE], fname[SZ_PATHNAME]
+char    ikparams[SZ_LINE], sec[SZ_LINE], dirname[SZ_PATHNAME]
+
+define	output {Memc[op]=$1;op=op+1}
+
+int	fntopnb(), fntgfnb(), fntlenb(), strlen(), stridxs(), strsearch()
+int	access(), imx_get_element(), imx_breakout(), isdirectory()
+
+begin
+	# Allocate an intial string buffer.
+	tlen = strlen (template)
+	plen = max(strlen(template)*2, SZ_FNT)
+	call calloc (tp, plen, TY_CHAR)
+	call calloc (itp, tlen + 1, TY_CHAR)
+	call calloc (elem, SZ_FNT, TY_CHAR)
+
+	in = 1
+	op = tp
+	nelem = 0
+	while (imx_get_element (template, in, Memc[elem], SZ_FNT) != EOS) {
+
+	    # Break out the filename and expression.
+	    nchars = imx_breakout (Memc[elem], NO, file, expr, 
+			    sec, ikparams, SZ_LINE)
+
+	    nelem = nelem + 1
+	    outcomma (nelem > 1)
+
+	    atat = NO
+	    call aclrc (Memc[itp], tlen+1)
+
+	    if (stridxs("[]", Memc[elem]) > 0 && expr[1] != EOS) {
+		if (Memc[elem] == '@' || strsearch (Memc[elem], "//") > 0)
+	            call sprintf (Memc[itp], tlen+1, "%s")
+		else
+	            call sprintf (Memc[itp], tlen+1, "@%s")
+		        call pargstr (Memc[elem])
+
+	    } else if (strsearch (Memc[elem], "][") > 0) {
+	        call sprintf (Memc[itp], tlen+1, "@%s")
+	    	    call pargstr (Memc[elem])
+
+	    } else {
+		# Simple filename or @file, just copy it out if it exists.
+		if (Memc[elem] == '@') {
+		    if (Memc[elem+1] != '@' && access (Memc[elem+1],0,0) == NO)
+			if (strsearch (Memc[elem], "//") == 0)
+		            next
+		    if (Memc[elem+1] == '@') {
+			lp = 1
+			atat = YES
+	        	call sprintf (Memc[itp], tlen+1, "%s")
+	    	    	    call pargstr (Memc[elem])
+		    } else {
+			lp = 0
+		        for (; Memc[elem+lp] != EOS; lp=lp+1)
+		            output (Memc[elem+lp])
+		        next
+		    }
+		} else {
+		    lp = 0
+		    for (; Memc[elem+lp] != EOS; lp=lp+1)
+		            output (Memc[elem+lp])
+		}
+	    }
+
+	    ip = itp
+   	    tend = itp + strlen (Memc[itp]) - 1
+	    ch = Memc[ip]
+
+	    if (ch == '@') {				# @file
+
+	        if (Memc[ip+1] == '@') {   		# @@file
+		    atat = YES
+		    ip = ip + 1
+		}
+
+		if (atat == NO) {
+		    # No metachars, copy item entirely to output string.
+		    in_filter = NO
+		    while (Memc[ip] != EOS && ip <= tend) {
+			if (Memc[ip] == '[') in_filter = YES
+			if (Memc[ip] == ']') in_filter = NO
+			if (Memc[ip] == ',' && in_filter == NO) {
+			    output (Memc[ip])
+			    ip = ip + 1
+			    break
+			}
+			output (Memc[ip])
+			ip = ip + 1
+		    }
+		    next
+		}
+
+		if (atat == YES) {
+		    if (isdirectory (file[3], dirname, SZ_PATHNAME) > 0) {
+			len = strlen (file)
+			if (file[len] != '$')
+			    call strcat ("/", file, SZ_FNAME)
+			call strcat ("*.fits", file, SZ_FNAME)
+		        listp = fntopnb (file[3], YES)
+		    } else 
+		        listp = fntopnb (file[2], YES)
+		} else 
+		    listp = fntopnb (file, YES)
+
+		llen = fntlenb (listp)
+	 	for (i=0; i < llen; i=i+1) {
+		    call aclrc (fname, SZ_PATHNAME)
+		    if (fntgfnb (listp, fname, SZ_PATHNAME) == EOF) 
+			break
+
+		    if (atat == YES)
+		        output ('@')
+		    for (lp=1; fname[lp] != EOS; lp=lp+1)
+			output (fname[lp])
+		    if (expr[1] != EOS) {	# append extension info
+		        output ('[')
+		        for (lp=1; expr[lp] != EOS; lp=lp+1)
+			    output (expr[lp])
+			if (ikparams[1] != EOS) {
+		            output (',')
+		            for (lp=1; ikparams[lp] != EOS; lp=lp+1)
+			        output (ikparams[lp])
+			}
+		        output (']')
+		    }
+		    if (sec[1] != EOS) {	# append any section notation
+		        output ('[')
+		        for (lp=1; sec[lp] != EOS; lp=lp+1)
+			    output (sec[lp])
+		        output (']')
+		    }
+
+		    outcomma (i < (llen-1))
+		}
+		call fntclsb (listp)
+		ip = ip + nchars + 1
+
+	        if (Memc[ip+1] == ',')
+		    break
+	    } # else 
+	      #	 call strcpy (Memc[elem], Memc[op], SZ_FNT)
+	}
+
+	call mfree (itp, TY_CHAR)
+	call mfree (elem, TY_CHAR)
+
+	return (tp)
+end
+
+
+# IMX_GET_ELEMENT -- Get the next element of a list template.
+
+int procedure imx_get_element (template, ip, elem, maxch)
+
+char	template[ARB]				#i input template string
+int	ip					#u template index
+char	elem[ARB]				#o output string buffer
+int	maxch					#i max size of output element
+
+int 	op, level, done
+char	ch
+
+begin
+	op = 1
+	done = 0
+	level = 0
+
+	if (template[ip] == EOS)
+	    return (EOS)
+	if (template[ip] == ',')
+	    ip = ip + 1
+
+	call aclrc (elem, maxch)
+	while (template[ip] != EOS) {
+	    ch = template[ip]
+
+	    if (ch == EOS || (ch == ',' && level == 0)) {
+		done = 1
+	    } else if (ch == '[')
+		level = level + 1
+	    else if (ch == ']')
+		level = level - 1
+
+	    if (done == 1) {
+		return (ip + 1)
+	    } else 
+	 	elem[op] = ch
+
+	    ip = ip + 1
+	    op = op + 1
+	}
+
+	return (ip)
+end
+
+
+# IMX_SPLIT -- Split a list element into the coarse filename and modifiers
+
+int procedure imx_split (in, fname, mods, maxch)
+
+char	in[ARB]					#i input template string
+char	fname[ARB]				#o filename
+char	mods[ARB]				#o modifier strings
+int	maxch					#i max size of output string
+
+int	i, j, nmods
+
+begin
+	# Allocate an intial string buffer.
+	nmods = 0
+	call aclrc (mods, maxch)
+	call aclrc (fname, maxch)
+
+
+	# Gather any prefix '@' symbols.
+	for (i=1; in[i] != '[' && in[i] != EOS && i < maxch; i=i+1)
+	    fname[i] = in[i]
+	
+	    # Get the filename component up to the EOS or the modifiers.
+	if (in[i] == '[') {
+	    for (j=1; in[i] != EOS && i < maxch && j < maxch; i=i+1) {
+		mods[j] = in[i]
+		j = j + 1
+		if (in[i] == '[')
+		    nmods = nmods + 1
+	    }
+	}
+	
+	return (nmods)
+end
diff --git a/sys/imio/imt/mkpkg b/sys/imio/imt/mkpkg
new file mode 100644
index 00000000..eca1a520
--- /dev/null
+++ b/sys/imio/imt/mkpkg
@@ -0,0 +1,24 @@
+# Update the IMIO portion of the LIBEX library.
+
+$checkout libex.a ../
+$update   libex.a
+$checkin  libex.a ../
+$exit
+
+libex.a:
+        imt.x
+        imx.x   	imx.h <error.h>
+        imxbreakout.x
+        imxparse.x      imx.h <ctype.h>
+        imxescape.x     imx.h
+        imxexpand.x     imx.h <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>
+	imxexpr.x	imx.h <ctype.h> <error.h> <evexpr.h> <lexnum.h>
+        imxftype.x      imx.h <error.h>
+        imxpreproc.x    imx.h
+	;
+
+test:
+	$call libpkg.a
+	$omake	zzdebug.x
+        $link	zzdebug.o libpkg.a
+	;
diff --git a/sys/imio/imt/t_urlget.x b/sys/imio/imt/t_urlget.x
new file mode 100644
index 00000000..e0e7bf26
--- /dev/null
+++ b/sys/imio/imt/t_urlget.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include <mach.h>
+
+task urlget	= t_urlget
+
+
+
+# URLGET -- Do an HTTP GET of a URL to the named file.
+
+procedure t_urlget ()
+
+pointer	reply
+char	url[SZ_PATHNAME], fname[SZ_PATHNAME], extn[SZ_PATHNAME]
+char	cache[SZ_PATHNAME], lfname[SZ_PATHNAME]
+int	nread
+bool	use_cache, verbose
+
+int	url_get()
+bool	fcaccess()
+
+begin
+	# Get the parameters
+	call clgstr ("url", url, SZ_PATHNAME)
+	
+	call url_to_name (url, fname, SZ_PATHNAME)
+	call strcpy ("", extn, SZ_PATHNAME)
+	call strcpy ("/tmp/cache/", cache, SZ_PATHNAME)
+	verbose = true
+	use_cache = false
+
+
+	# Tell them what we're doing.
+	if (verbose) {
+	    call printf ("%s -> %s\n")
+		call pargstr (url)
+		call pargstr (fname)
+	    call flush (STDOUT)
+	}
+
+	# Retrieve the URL.
+	if (use_cache) {
+	    call aclrc (lfname, SZ_FNAME);
+
+	    if (fcaccess (cache, url, "fits")) {
+	        call fcname (cache, url, "f", lfname, SZ_PATHNAME)
+		if (extn[1] != EOS) {
+		    # Add an extension to the cached file.
+		    call strcat (".", lfname, SZ_PATHNAME)
+		    call strcat (extn, lfname, SZ_PATHNAME)
+		}
+	    } else {
+	        # Add it to the cache, also handles the download.
+	        call fcadd (cache, url, extn, lfname, SZ_PATHNAME)
+	    }
+	    call fcopy (lfname, fname)
+
+	} else {
+	    # Not in cache, or not using the cache, so force the download.
+	    call calloc (reply, SZ_LINE, TY_CHAR)
+	    nread = url_get (url, fname, reply)
+	    call mfree (reply, TY_CHAR)
+	}
+end
+
+
+# URL_TO_NAME -- Generate a filename from a URL.
+
+procedure url_to_name (url, name, maxch)
+
+char	url[ARB]				#i URL being accessed
+char	name[ARB]				#o output name
+int	maxch					#i max size of output name
+
+int	ip, strlen()
+char	ch
+
+begin
+	ip = strlen (url)
+	while (ip > 1) {
+	    ch = url[ip]
+	    if (ch == '/' || ch == '?' || ch == '&' || ch == ';' || ch == '=') {
+		call strcpy (url[ip+1], name, maxch)
+	        return
+	    }
+	    ip = ip - 1
+	}
+
+	call strcpy (url[ip], name, maxch)
+end
diff --git a/sys/imio/imt/zzdebug.x b/sys/imio/imt/zzdebug.x
new file mode 100644
index 00000000..746fc6f1
--- /dev/null
+++ b/sys/imio/imt/zzdebug.x
@@ -0,0 +1,227 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include <mach.h>
+include "imx.h"
+
+
+task	imt		= t_imt,
+	parse		= t_parse,
+	fnexpand	= t_fnexpand,
+	prelist		= t_prelist,
+	preproc		= t_preproc,
+	breakout	= t_breakout,
+	imexpand	= t_imexpand,
+	fexpand		= t_fexpand
+
+
+
+# IMT -- Test the image template package.
+
+procedure t_imt ()
+
+char	template[SZ_LINE]
+char	image[SZ_FNAME]
+
+pointer	imt, im, imtopen(), immap()
+int	i, imtgetim()
+bool	num, clgetb()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+	num = clgetb ("number")
+
+	imt = imtopen (template)
+
+	for (i=0; imtgetim (imt, image, SZ_FNAME) != EOF; i=i+1) {
+ 
+	    if (num) {
+	        im = immap (image, READ_ONLY, 0)
+		call printf ("%3d  %s  %d x %d\n") 
+		    call pargi (i+1) 
+		    call pargstr (image)
+		    call pargi (IM_LEN(im,1))
+		    call pargi (IM_LEN(im,2))
+	        call imunmap (im)
+	    } else {
+	        if (i > 0)
+		    call printf (",")
+	        call printf ("%s")
+		    call pargstr (image)
+	    }
+	}
+	call printf ("\n")
+	call printf ("Nimages = %d\n")
+	    call pargi (i)
+
+	call imtclose (imt)
+end
+
+
+# PARSE -- Test the image template package expression parse.
+
+procedure t_parse ()
+
+char	template[SZ_LINE], name[SZ_LINE], index[SZ_LINE], ikparams[SZ_LINE]
+char	extname[SZ_LINE], extver[SZ_LINE], expr[SZ_LINE], sec[SZ_LINE]
+
+int	nch, imx_parse()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	nch = imx_parse (template, name, index, extname, extver, 
+	    expr, sec, ikparams, SZ_LINE)
+
+	call eprintf ("%s\n")			; call pargstr (template)
+	call eprintf ("\tname\t= %s\n")		; call pargstr (name)
+	call eprintf ("\tindex\t= %s\n")	; call pargstr (index)
+	call eprintf ("\textname\t= %s\n")	; call pargstr (extname)
+	call eprintf ("\textver\t= %s\n")	; call pargstr (extver)
+	call eprintf ("\texpr\t= %s\n")		; call pargstr (expr)
+	call eprintf ("\tikparams\t= %s\n")	; call pargstr (ikparams)
+	call eprintf ("\tsec\t= %s\n")		; call pargstr (sec)
+end
+
+
+# FNEXPAND -- Test the image template package pre-processor.
+
+procedure t_fnexpand ()
+
+char	template[SZ_LINE]
+
+pointer	pp, imx_fnexpand()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	pp = imx_fnexpand (template)
+
+	call eprintf ("%s\n")
+	    call pargstr (Memc[pp])
+	call mfree (pp, TY_CHAR)
+end
+
+
+# PRELIST -- Test the image template package pre-processor.
+
+procedure t_prelist ()
+
+char	template[SZ_LINE]
+
+pointer	pp, imx_preproc_list()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	pp = imx_preproc_list (template)
+
+	call eprintf ("%s\n")
+	    call pargstr (Memc[pp])
+	call mfree (pp, TY_CHAR)
+end
+
+
+# PREPROC -- Test the image template package pre-processor.
+
+procedure t_preproc ()
+
+char	template[SZ_LINE]
+
+pointer	pp, imx_preproc()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	pp = imx_preproc (template)
+
+	call eprintf ("%s\n")
+	    call pargstr (Memc[pp])
+	call mfree (pp, TY_CHAR)
+end
+
+
+# BREAKOUT -- Test the image template package expression breakout code.
+
+procedure t_breakout ()
+
+char	template[SZ_LINE]
+
+int	nchars
+char	image[SZ_LINE], expr[SZ_LINE], sec[SZ_LINE], ikparams[SZ_LINE]
+
+int	imx_breakout()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	nchars = imx_breakout(template, NO, image, expr, sec, ikparams, SZ_LINE)
+
+	call eprintf ("nchars=%d  image='%s'  expr='%s'  sec='%s'  ik='%s'\n")
+	    call pargi (nchars)
+	    call pargstr (image)
+	    call pargstr (expr)
+	    call pargstr (sec)
+	    call pargstr (ikparams)
+end
+
+
+# IMEXPAND -- Test the MEF image expansion.
+
+procedure t_imexpand ()
+
+char	template[SZ_LINE]
+int	nimages
+
+pointer	imt, imx_imexpand()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	imt = imx_imexpand (template, 
+			  "", 			# expr
+			  "", 			# index
+			  "", 			# extname
+			  "", 			# extver
+			  "", 			# ikparams
+			  "", 			# sections
+			  nimages)
+
+	call printf ("nimages = %d\n%s\n"); 
+	    call pargi (nimages)
+	    call pargstr (Memc[imt])
+
+	call mfree (imt, TY_CHAR)
+end
+
+
+# FEXPAND -- Test the filename expansion.
+
+procedure t_fexpand ()
+
+char	template[SZ_LINE]
+int	nimages
+
+pointer	imt, imx_fexpand()
+
+begin
+	call clgstr ("in", template, SZ_LINE)
+
+	imt = imx_fexpand (template, 
+			  "", 			# expr
+			  "", 			# index
+			  "", 			# extname
+			  "", 			# extver
+			  "", 			# ikparams
+			  "", 			# sections
+			  nimages)
+
+	call printf ("nimages = %d\n%s\n"); 
+	    call pargi (nimages)
+	    call pargstr (Memc[imt])
+
+	call mfree (imt, TY_CHAR)
+end
diff --git a/sys/imio/imunmap.x b/sys/imio/imunmap.x
new file mode 100644
index 00000000..dd2290b1
--- /dev/null
+++ b/sys/imio/imunmap.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMUNMAP -- Unmap a image.  Flush the output buffer, append the bad pixel
+# list, update the image header.  Close all files and return buffer space.
+
+procedure imunmap (im)
+
+pointer	im
+
+int	acmode
+errchk	imflush, close, imerr, iki_updhdr
+
+begin
+	acmode = IM_ACMODE(im)
+
+	# Note that if no pixel i/o occurred, the pixel storage file will
+	# never have been opened or created.
+
+	if (IM_PFD(im) != NULL)
+	    call imflush (im)
+
+	# Update the image header, if necessary (count of bad pixels,
+	# minimum and maximum pixel values, etc.).
+
+	if (IM_UPDATE(im) == YES) {
+	    if (acmode == READ_ONLY)
+		call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	    # Restore those fields of the image header that may have been
+	    # modified to map a section (if accessing an existing image).
+
+	    switch (acmode) {
+	    case NEW_COPY, NEW_IMAGE:
+		;			# Cannot access section of new image
+	    default:
+		IM_NDIM(im) = IM_NPHYSDIM(im)
+		IM_MTIME(im) = IM_SVMTIME(im)
+		call amovl (IM_SVLEN(im,1), IM_LEN(im,1), IM_NDIM(im))
+	    }
+
+	    # Update the image header or mask storage file.
+	    call iki_updhdr (im)
+	}
+
+	# Physically close the image.
+	call iki_close (im)
+
+	# If the image is a mask image and the PL_CLOSEPL flag is set, close
+	# the associated mask.
+
+	if (IM_PL(im) != NULL && and(IM_PLFLAGS(im),PL_CLOSEPL) != 0)
+	    call pl_close (IM_PL(im))
+
+	# Free all buffer space allocated by IMIO.
+	call imrmbufs (im)
+	call mfree (im, TY_STRUCT)
+end
diff --git a/sys/imio/imupk.gx b/sys/imio/imupk.gx
new file mode 100644
index 00000000..a637e39d
--- /dev/null
+++ b/sys/imio/imupk.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupk$t (a, b, npix, dtype)
+
+PIXEL	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtu$t (a, b, npix)
+	case TY_SHORT:
+	    call achts$t (a, b, npix)
+	case TY_INT:
+	    call achti$t (a, b, npix)
+	case TY_LONG:
+	    call achtl$t (a, b, npix)
+	case TY_REAL:
+	    call achtr$t (a, b, npix)
+	case TY_DOUBLE:
+	    call achtd$t (a, b, npix)
+	case TY_COMPLEX:
+	    call achtx$t (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/imwbpx.x b/sys/imio/imwbpx.x
new file mode 100644
index 00000000..23794c89
--- /dev/null
+++ b/sys/imio/imwbpx.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<imio.h>
+
+# IMWBPX -- Write a line segment from an image with boundary extension.  The
+# line segment is broken up into three parts, i.e., left, center, and right.
+# The left and right (out of bounds) regions are discarded, and the center
+# region, if any, is written to the image.  Inbounds data is conserved if a
+# subraster which extends out of bounds is read and then rewritten, i.e.,
+# a read followed immediately by a rewrite of the same data does not modify 
+# the image.
+
+procedure imwbpx (im, ibuf, totpix, v, vinc)
+
+pointer	im			# image descriptor
+char	ibuf[ARB]		# typeless buffer containing the data
+int	totpix			# total number of pixels to write
+long	v[ARB]			# vector pointer to start of line segment
+long	vinc[ARB]		# step on each axis
+
+bool	oob
+int	npix, ndim, sz_pixel, btype, ip, xstep, step, i
+long	xs[3], xe[3], x1, x2, p, v1[IM_MAXDIM], v2[IM_MAXDIM], linelen
+errchk	imwrpx
+include	<szpixtype.inc>
+
+begin
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+	ndim = IM_NPHYSDIM(im)
+
+	# Flip the input array if the step size in X is negative.
+	if (vinc[1] < 0)
+	    call imaflp (ibuf, totpix, sz_pixel)
+
+	# Cache the left and right endpoints of the line segment and the
+	# image line length.
+
+	xstep = abs (IM_VSTEP(im,1))
+	linelen = IM_SVLEN(im,1)
+	x1 = v[1]
+	x2 = x1 + (totpix * xstep) - 1
+
+	# Compute the endpoints of the line segment in the three x-regions of 
+	# the image.
+
+	xs[1] = x1				# left oob region
+	xe[1] = min (0, x2)
+	xs[2] = max (x1, 1)			# central inbounds region
+	xe[2] = min (x2, linelen)
+	xs[3] = max (x1, linelen + 1)		# right oob region
+	xe[3] = x2
+
+	# Perform bounds mapping on the entire vector.  The mapping for all
+	# dimensions higher than the first is invariant in what follows.
+
+	call imbtran (im, v, v1, ndim)
+
+	# Copy V1 to V2 and determine if the whole thing is out of bounds.
+	oob = false
+	do i = 2, ndim {
+	    p = v1[i]
+	    v2[i] = p
+	    if (p < 1 || p > IM_SVLEN(im,i))
+		oob = true
+	}
+	
+	btype = IM_VTYBNDRY(im)
+	ip = 1
+
+	do i = 1, 3 {
+	    # Skip to next region if there are no pixels in this region.
+	    npix = (xe[i] - xs[i]) / xstep + 1
+	    if (npix <= 0)
+		next
+
+	    # Map the endpoints of the segment.
+	    call imbtran (im, xs[i], v1[1], 1)
+	    call imbtran (im, xe[i], v2[1], 1)
+
+	    # Compute the starting vector V1, step in X, and the number of
+	    # pixels in the region allowing for subsampling.
+
+	    if (v1[1] > v2[1]) {
+		step = -xstep
+		v1[1] = v2[1]
+	    } else
+		step = xstep
+
+	    # Write the pixels if inbounds.
+	    if (i == 2 && !oob)
+		call imwrpx (im, ibuf[ip], npix, v1, step)
+
+	    ip = ip + (npix * sz_pixel)
+	}
+end
diff --git a/sys/imio/imwrite.x b/sys/imio/imwrite.x
new file mode 100644
index 00000000..724de8d7
--- /dev/null
+++ b/sys/imio/imwrite.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<imio.h>
+
+define	SZ_ZBUF		50
+
+# IMWRITE -- Write data to the pixel storage file.  Bounds checking has
+# already been performed by the time IMWRITE is called.  If writing beyond
+# EOF (new image), write zeros until the indicated offset is reached.
+
+procedure imwrite (imdes, buf, nchars, offset)
+
+pointer	imdes
+char	buf[ARB]
+int	nchars
+long	offset
+
+int	fd
+char	zbuf[SZ_ZBUF]
+long	start, i
+long	fstatl()
+errchk	write, seek, fstatl
+data	zbuf /SZ_ZBUF*0,0/
+
+begin
+	fd = IM_PFD(imdes)
+
+	# Get file size.  If writing beyond end of file (file_size+1),
+	# write out blocks of zeros until the desired offset is reached.
+	# The IM_FILESIZE parameter in the image descriptor is not always
+	# up to date, but does provide a lower bound on the size of the pixel
+	# storage file.
+
+	if (offset >= IM_FILESIZE(imdes))
+	    IM_FILESIZE(imdes) = fstatl (fd, F_FILESIZE)
+
+	if (offset-1 <= IM_FILESIZE(imdes)) {
+	    # Write within bounds of file, or at EOF.
+
+	    call seek (fd, offset)
+	    call write (fd, buf, nchars)
+
+	} else {
+	    # Write beyond EOF.
+
+	    IM_FILESIZE(imdes) = fstatl (fd, F_FILESIZE)
+	    start = IM_FILESIZE(imdes) + 1
+
+	    call seek (fd, start)
+	    do i = start, offset, SZ_ZBUF
+		call write (fd, zbuf, min (SZ_ZBUF, offset-i))
+
+	    call write (fd, buf, nchars)
+	    IM_FILESIZE(imdes) = fstatl (fd, F_FILESIZE)
+	}
+end
diff --git a/sys/imio/imwrpx.x b/sys/imio/imwrpx.x
new file mode 100644
index 00000000..3cdd2971
--- /dev/null
+++ b/sys/imio/imwrpx.x
@@ -0,0 +1,139 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<syserr.h>
+include	<plset.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMWRPX -- Write NPIX pixels, starting with the pixel at the coordinates
+# specified by the vector V, from the buffer BUF to the pixel storage file.
+
+procedure imwrpx (im, buf, npix, v, xstep)
+
+pointer	im			# image descriptor
+char	buf[ARB]		# generic buffer containing data to be written
+int	npix			# number of pixels to be written
+long	v[ARB]			# physical coords of first pixel to be written
+int	xstep			# step size between output pixels
+
+bool	rlio
+long	offset
+pointer	pl, sp, ibuf
+long	o_v[IM_MAXDIM]
+int	sz_pixel, sz_dtype, nbytes, nchars, ip, step
+
+int	sizeof()
+long	imnote()
+errchk	imerr, imwrite
+include	<szpixtype.inc>
+
+begin
+	pl = IM_PL(im)
+	sz_dtype = sizeof (IM_PIXTYPE(im))
+	sz_pixel = pix_size[IM_PIXTYPE(im)]
+	step = abs (xstep)
+	if (v[1] < 1 || ((npix-1) * step) + v[1] > IM_SVLEN(im,1))
+	    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+	# Flip the pixel array end for end.
+	if (xstep < 0)
+	    #call imaflp (buf, npix, sz_dtype)
+	    call imaflp (buf, npix, sz_pixel)
+
+	# Byte swap if necessary.
+	if (IM_SWAP(im) == YES) {
+	    nbytes = npix * sz_dtype * SZB_CHAR
+	    switch (sz_dtype * SZB_CHAR) {
+	    case 2:
+		call bswap2 (buf, 1, buf, 1, nbytes)
+	    case 4:
+		call bswap4 (buf, 1, buf, 1, nbytes)
+	    case 8:
+		call bswap8 (buf, 1, buf, 1, nbytes)
+	    }
+	}
+
+
+	if (pl != NULL) {
+
+	    # Need to unpack again on 64-bit systems.
+	    if ((IM_PIXTYPE(im) == TY_INT || IM_PIXTYPE(im) == TY_LONG) &&
+		SZ_INT != SZ_INT32) {
+		    call iupk32 (buf, buf, npix)
+	    }
+
+	    # Write to a pixel list.
+	    rlio = (and (IM_PLFLAGS(im), PL_FAST+PL_RLIO) == PL_FAST+PL_RLIO)
+	    call amovl (v, o_v, IM_MAXDIM)
+	    nchars = npix * sz_pixel
+
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT:
+		if (rlio)
+		    call pl_plrs (pl, v, buf, 0, npix, PIX_SRC)
+		else if (step == 1)
+		    call pl_plps (pl, v, buf, 0, npix, PIX_SRC)
+		else {
+		    do ip = 1, nchars, sz_pixel {
+			call pl_plpi (pl, o_v, buf[ip], 0, 1, PIX_SRC)
+			o_v[1] = o_v[1] + step
+		    }
+		}
+	    case TY_INT, TY_LONG:
+		if (rlio)
+		    call pl_plri (pl, v, buf, 0, npix, PIX_SRC)
+		else if (step == 1)
+		    call pl_plpi (pl, v, buf, 0, npix, PIX_SRC)
+		else {
+		    do ip = 1, nchars, sz_pixel {
+			call pl_plpi (pl, o_v, buf[ip], 0, 1, PIX_SRC)
+			o_v[1] = o_v[1] + step
+		    }
+		}
+	    default:
+		call smark (sp)
+		call salloc (ibuf, npix, TY_INT)
+
+		call acht (buf, Memi[ibuf], npix, IM_PIXTYPE(im), TY_INT)
+		if (rlio)
+		    call pl_plri (pl, v, Memi[ibuf], 0, npix, PIX_SRC)
+		else if (step == 1)
+		    call pl_plpi (pl, v, Memi[ibuf], 0, npix, PIX_SRC)
+		else {
+		    do ip = 1, npix {
+			call pl_plpi (pl, o_v, Memi[ibuf+ip-1], 0, 1, PIX_SRC)
+			o_v[1] = o_v[1] + step
+		    }
+		}
+		call sfree (sp)
+	    }
+
+	} else {
+	    # Write to a file.  Compute size of transfer.  If transferring
+	    # an entire line, increase size of transfer to the physical line
+	    # length, to avoid having to enblock the data.  NOTE: buffer must
+	    # be large enough to guarantee no memory violation.
+
+	    offset = imnote (im, v)
+
+	    # If not subsampling (stepsize 1), write buffer to file in a
+	    # single transfer.  Otherwise, the pixels are not contiguous,
+	    # and must be written individually.
+
+	    if (step == 1) {
+		if (v[1] == 1 && npix == IM_SVLEN(im,1))
+		    nchars = IM_PHYSLEN(im,1) * sz_pixel
+		else
+		    nchars = npix * sz_pixel
+		call imwrite (im, buf, nchars, offset)
+
+	    } else {
+		nchars = npix * sz_pixel
+		for (ip=1;  ip <= nchars;  ip=ip+sz_pixel) {
+		    call imwrite (im, buf[ip], sz_pixel, offset)
+		    offset = offset + (sz_pixel * step)
+		}
+	    }
+	}
+end
diff --git a/sys/imio/mkpkg b/sys/imio/mkpkg
new file mode 100644
index 00000000..9daec830
--- /dev/null
+++ b/sys/imio/mkpkg
@@ -0,0 +1,106 @@
+# Update the IMIO portion of the LIBEX library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+tfiles:
+	$set GFLAGS = "-k -t silrdx -p tf/"
+	$ifolder (tf/imupkr.x, imupk.gx) $generic $(GFLAGS) imupk.gx $endif
+	$ifolder (tf/imps3r.x, imps3.gx) $generic $(GFLAGS) imps3.gx $endif
+	$ifolder (tf/imps2r.x, imps2.gx) $generic $(GFLAGS) imps2.gx $endif
+	$ifolder (tf/imps1r.x, imps1.gx) $generic $(GFLAGS) imps1.gx $endif
+	$ifolder (tf/impnlr.x, impnl.gx) $generic $(GFLAGS) impnl.gx $endif
+	$ifolder (tf/impl3r.x, impl3.gx) $generic $(GFLAGS) impl3.gx $endif
+	$ifolder (tf/impl2r.x, impl2.gx) $generic $(GFLAGS) impl2.gx $endif
+	$ifolder (tf/impl1r.x, impl1.gx) $generic $(GFLAGS) impl1.gx $endif
+	$ifolder (tf/impgsr.x, impgs.gx) $generic $(GFLAGS) impgs.gx $endif
+	$ifolder (tf/impakr.x, impak.gx) $generic $(GFLAGS) impak.gx $endif
+	$ifolder (tf/imgs3r.x, imgs3.gx) $generic $(GFLAGS) imgs3.gx $endif
+	$ifolder (tf/imgs2r.x, imgs2.gx) $generic $(GFLAGS) imgs2.gx $endif
+	$ifolder (tf/imgs1r.x, imgs1.gx) $generic $(GFLAGS) imgs1.gx $endif
+	$ifolder (tf/imgnlr.x, imgnl.gx) $generic $(GFLAGS) imgnl.gx $endif
+	$ifolder (tf/imgl3r.x, imgl3.gx) $generic $(GFLAGS) imgl3.gx $endif
+	$ifolder (tf/imgl2r.x, imgl2.gx) $generic $(GFLAGS) imgl2.gx $endif
+	$ifolder (tf/imgl1r.x, imgl1.gx) $generic $(GFLAGS) imgl1.gx $endif
+	$ifolder (tf/imggsr.x, imggs.gx) $generic $(GFLAGS) imggs.gx $endif
+	$ifolder (tf/imflsr.x, imfls.gx) $generic $(GFLAGS) imfls.gx $endif
+	;
+
+libex.a:
+	# Retranslate any recently modified generic sources.
+	$ifeq (hostid, unix)
+	    $call tfiles
+	$endif
+
+	@tf		# Update datatype expanded files.
+	@db		# Update image database interface.
+	@dbc		# Update image database interface (enhanced).
+	@iki		# Update image kernel interface.
+	@imt		# Update the image template package.
+	#imt.x	
+
+	imaccess.x	
+	imaflp.x	
+	imaplv.x	<imhdr.h> <imio.h>
+	imbln1.x	<imhdr.h> <imio.h>
+	imbln2.x	<imhdr.h> <imio.h>
+	imbln3.x	<imhdr.h> <imio.h>
+	imbtran.x	<imhdr.h> <imio.h> <imset.h>
+	imcopy.x	
+	imcssz.x	<imhdr.h> <imio.h> <plset.h>
+	imdelete.x	
+	imdmap.x	<error.h> <imhdr.h> <imio.h> <imset.h>
+	imerr.x	
+	imflsh.x	<imhdr.h> <imio.h>
+	imflush.x	<imhdr.h> <imio.h>
+	imgclust.x	
+	imggsc.x	<imhdr.h> <imio.h> <plset.h>
+	imgibf.x	<imhdr.h> <imio.h>
+	imgimage.x	
+	imgnln.x	<imhdr.h> <imio.h> <szpixtype.inc>
+	imgobf.x	<imhdr.h> <imio.h>
+	imgsect.x	
+	iminie.x	<imhdr.h> <imio.h>
+	imioff.x	<config.h> <imhdr.h> <imio.h> <mach.h> <szpixtype.inc>
+	imisec.x	<ctype.h> <imhdr.h> <imio.h> <mach.h>
+	imloop.x	<imio.h>
+	immaky.x	<error.h> <imhdr.h> <imio.h>
+	immap.x	
+	immapz.x	<error.h> <imhdr.h> <imio.h> <mach.h>
+	imnote.x	<imhdr.h> <imio.h> <szpixtype.inc>
+	imopsf.x	<fset.h> <imhdr.h> <imio.h> <plset.h> <pmset.h>
+	imparse.x	<ctype.h>
+	impmhdr.x	<ctype.h> <imhdr.h> <imio.h>
+	impmlne1.x	<imhdr.h> <imio.h>
+	impmlne2.x	<imhdr.h> <imio.h>
+	impmlne3.x	<imhdr.h> <imio.h>
+	impmlnev.x	<imhdr.h> <imio.h>
+	impmmap.x	<error.h> <imhdr.h> <imio.h> <pmset.h>
+	impmmapo.x	<imhdr.h> <imio.h> <plio.h> <pmset.h>
+	impmopen.x	<error.h> <imhdr.h> <imio.h> <pmset.h>
+	impmsne1.x	<imio.h>
+	impmsne2.x	<imio.h>
+	impmsne3.x	<imio.h>
+	impmsnev.x	<imhdr.h> <imio.h>
+	impnln.x	<imhdr.h> <imio.h> <szpixtype.inc>
+	imrbpx.x	<imhdr.h> <imio.h> <imset.h> <szpixtype.inc>
+	imrdpx.x	<imhdr.h> <imio.h> <mach.h> <plset.h> <szpixtype.inc>
+	imrename.x	
+	imrmbufs.x	<imio.h>
+	imsamp.x	
+	imsetbuf.x	<fset.h> <imhdr.h> <imio.h>
+	imseti.x	<fset.h> <imhdr.h> <imio.h> <imset.h>
+	imsetr.x	<imhdr.h> <imio.h> <imset.h>
+	imsinb.x	<imhdr.h> <imio.h>
+	imsslv.x	<imhdr.h> <imio.h>
+	imstati.x	<imhdr.h> <imio.h> <imset.h>
+	imstatr.x	<imhdr.h> <imio.h> <imset.h>
+	imstats.x	<imhdr.h> <imio.h> <imset.h>
+	imunmap.x	<imhdr.h> <imio.h>
+	imwbpx.x	<imhdr.h> <imio.h> <imset.h> <szpixtype.inc>
+	imwrite.x	<fset.h> <imio.h>
+	imwrpx.x	<imhdr.h> <imio.h> <mach.h> <plset.h> <szpixtype.inc>
+	zzdebug.x	
+	;
diff --git a/sys/imio/tf/imflsd.x b/sys/imio/tf/imflsd.x
new file mode 100644
index 00000000..bc12f5b5
--- /dev/null
+++ b/sys/imio/tf/imflsd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflsd (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_DOUBLE || SZ_INT != SZ_INT32) {
+		call impakd (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imflsi.x b/sys/imio/tf/imflsi.x
new file mode 100644
index 00000000..b7a4b4fb
--- /dev/null
+++ b/sys/imio/tf/imflsi.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflsi (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_INT || SZ_INT != SZ_INT32) {
+		call impaki (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imflsl.x b/sys/imio/tf/imflsl.x
new file mode 100644
index 00000000..26934cb1
--- /dev/null
+++ b/sys/imio/tf/imflsl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflsl (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_LONG || SZ_INT != SZ_INT32) {
+		call impakl (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imflsr.x b/sys/imio/tf/imflsr.x
new file mode 100644
index 00000000..b19f1bcc
--- /dev/null
+++ b/sys/imio/tf/imflsr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflsr (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_REAL || SZ_INT != SZ_INT32) {
+		call impakr (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imflss.x b/sys/imio/tf/imflss.x
new file mode 100644
index 00000000..1034413b
--- /dev/null
+++ b/sys/imio/tf/imflss.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflss (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_SHORT || SZ_INT != SZ_INT32) {
+		call impaks (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imflsx.x b/sys/imio/tf/imflsx.x
new file mode 100644
index 00000000..7e847ffe
--- /dev/null
+++ b/sys/imio/tf/imflsx.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMFLS? -- Flush the output buffer, if necessary.  Convert the datatype
+# of the pixels upon output, if the datatype of the pixels in the imagefile
+# is different than that requested by the calling program.
+
+procedure imflsx (imdes)
+
+pointer	imdes
+pointer	bdes, bp
+errchk	imflsh
+
+begin
+	# Ignore the flush request if the output buffer has already been
+	# flushed.
+
+	if (IM_FLUSH(imdes) == YES) {
+	    bdes = IM_OBDES(imdes)
+	    bp = BD_BUFPTR(bdes)
+
+	    # Convert datatype of pixels, if necessary, and flush buffer.
+	    if (IM_PIXTYPE(imdes) != TY_COMPLEX || SZ_INT != SZ_INT32) {
+		call impakx (Memc[bp], Memc[bp], BD_NPIX(bdes),
+		    IM_PIXTYPE(imdes))
+	    }
+
+	    call imflsh (imdes, bp, BD_VS(bdes,1), BD_VE(bdes,1), BD_NDIM(bdes))
+
+	    IM_FLUSH(imdes) = NO
+	}
+end
diff --git a/sys/imio/tf/imggsd.x b/sys/imio/tf/imggsd.x
new file mode 100644
index 00000000..509da31b
--- /dev/null
+++ b/sys/imio/tf/imggsd.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggsd (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_DOUBLE, totpix)
+	if (IM_PIXTYPE(imdes) != TY_DOUBLE)
+	    call imupkd (Memd[bp], Memd[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imggsi.x b/sys/imio/tf/imggsi.x
new file mode 100644
index 00000000..9cd0e00c
--- /dev/null
+++ b/sys/imio/tf/imggsi.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggsi (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_INT, totpix)
+	if (IM_PIXTYPE(imdes) != TY_INT)
+	    call imupki (Memi[bp], Memi[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imggsl.x b/sys/imio/tf/imggsl.x
new file mode 100644
index 00000000..e4d2411d
--- /dev/null
+++ b/sys/imio/tf/imggsl.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggsl (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_LONG, totpix)
+	if (IM_PIXTYPE(imdes) != TY_LONG)
+	    call imupkl (Meml[bp], Meml[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imggsr.x b/sys/imio/tf/imggsr.x
new file mode 100644
index 00000000..37055497
--- /dev/null
+++ b/sys/imio/tf/imggsr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggsr (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_REAL, totpix)
+	if (IM_PIXTYPE(imdes) != TY_REAL)
+	    call imupkr (Memr[bp], Memr[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imggss.x b/sys/imio/tf/imggss.x
new file mode 100644
index 00000000..f6e3260e
--- /dev/null
+++ b/sys/imio/tf/imggss.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggss (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_SHORT, totpix)
+	if (IM_PIXTYPE(imdes) != TY_SHORT)
+	    call imupks (Mems[bp], Mems[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imggsx.x b/sys/imio/tf/imggsx.x
new file mode 100644
index 00000000..60c029c0
--- /dev/null
+++ b/sys/imio/tf/imggsx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGGS? -- Get a general section.
+
+pointer procedure imggsx (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+int	ndim
+long	totpix
+pointer	bp, imggsc()
+errchk	imggsc
+
+begin
+	bp = imggsc (imdes, vs, ve, ndim, TY_COMPLEX, totpix)
+	if (IM_PIXTYPE(imdes) != TY_COMPLEX)
+	    call imupkx (Memx[bp], Memx[bp], totpix, IM_PIXTYPE(imdes))
+	return (bp)
+end
diff --git a/sys/imio/tf/imgl1d.x b/sys/imio/tf/imgl1d.x
new file mode 100644
index 00000000..eeab8586
--- /dev/null
+++ b/sys/imio/tf/imgl1d.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1d (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggsd(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+	    return (imggsd (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl1i.x b/sys/imio/tf/imgl1i.x
new file mode 100644
index 00000000..0de66fa2
--- /dev/null
+++ b/sys/imio/tf/imgl1i.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1i (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggsi(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+	    return (imggsi (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl1l.x b/sys/imio/tf/imgl1l.x
new file mode 100644
index 00000000..a996ce32
--- /dev/null
+++ b/sys/imio/tf/imgl1l.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1l (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggsl(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+	    return (imggsl (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl1r.x b/sys/imio/tf/imgl1r.x
new file mode 100644
index 00000000..a3f20de8
--- /dev/null
+++ b/sys/imio/tf/imgl1r.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1r (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggsr(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+	    return (imggsr (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl1s.x b/sys/imio/tf/imgl1s.x
new file mode 100644
index 00000000..bd226f31
--- /dev/null
+++ b/sys/imio/tf/imgl1s.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1s (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggss(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+	    return (imggss (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl1x.x b/sys/imio/tf/imgl1x.x
new file mode 100644
index 00000000..a7f73ac1
--- /dev/null
+++ b/sys/imio/tf/imgl1x.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL1? -- Get a line from an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl1x (im)
+
+pointer	im
+int	fd, nchars
+long	offset
+pointer	bp, imggsx(), freadp()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+	    return (imggsx (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/imgl2d.x b/sys/imio/tf/imgl2d.x
new file mode 100644
index 00000000..dbd7858a
--- /dev/null
+++ b/sys/imio/tf/imgl2d.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2d (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggsd(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_DOUBLE +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggsd (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl2i.x b/sys/imio/tf/imgl2i.x
new file mode 100644
index 00000000..9592ebe9
--- /dev/null
+++ b/sys/imio/tf/imgl2i.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2i (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggsi(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_INT +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggsi (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl2l.x b/sys/imio/tf/imgl2l.x
new file mode 100644
index 00000000..e3f5d523
--- /dev/null
+++ b/sys/imio/tf/imgl2l.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2l (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggsl(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_LONG +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggsl (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl2r.x b/sys/imio/tf/imgl2r.x
new file mode 100644
index 00000000..d487e61b
--- /dev/null
+++ b/sys/imio/tf/imgl2r.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2r (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggsr(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_REAL +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggsr (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl2s.x b/sys/imio/tf/imgl2s.x
new file mode 100644
index 00000000..a4fd140b
--- /dev/null
+++ b/sys/imio/tf/imgl2s.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2s (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggss(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_SHORT +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggss (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl2x.x b/sys/imio/tf/imgl2x.x
new file mode 100644
index 00000000..7a97ac48
--- /dev/null
+++ b/sys/imio/tf/imgl2x.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL2? -- Get a line from an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl2x (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be read
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, imggsx(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_COMPLEX +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (imggsx (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgl3d.x b/sys/imio/tf/imgl3d.x
new file mode 100644
index 00000000..735cc4d1
--- /dev/null
+++ b/sys/imio/tf/imgl3d.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3d (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggsd(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_DOUBLE + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggsd (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgl3i.x b/sys/imio/tf/imgl3i.x
new file mode 100644
index 00000000..75a87d36
--- /dev/null
+++ b/sys/imio/tf/imgl3i.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3i (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggsi(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_INT + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggsi (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgl3l.x b/sys/imio/tf/imgl3l.x
new file mode 100644
index 00000000..e18f8d3e
--- /dev/null
+++ b/sys/imio/tf/imgl3l.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3l (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggsl(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_LONG + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggsl (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgl3r.x b/sys/imio/tf/imgl3r.x
new file mode 100644
index 00000000..428e55aa
--- /dev/null
+++ b/sys/imio/tf/imgl3r.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3r (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggsr(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_REAL + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggsr (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgl3s.x b/sys/imio/tf/imgl3s.x
new file mode 100644
index 00000000..32cd0625
--- /dev/null
+++ b/sys/imio/tf/imgl3s.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3s (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggss(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_SHORT + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggss (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgl3x.x b/sys/imio/tf/imgl3x.x
new file mode 100644
index 00000000..9ba1052d
--- /dev/null
+++ b/sys/imio/tf/imgl3x.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMGL3? -- Get a line from an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure imgl3x (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, imggsx(), freadp()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_COMPLEX + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (freadp (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (imggsx (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgnld.x b/sys/imio/tf/imgnld.x
new file mode 100644
index 00000000..55b27360
--- /dev/null
+++ b/sys/imio/tf/imgnld.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnld (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_DOUBLE)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_DOUBLE)
+		call imupkd (Memd[lineptr], Memd[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgnli.x b/sys/imio/tf/imgnli.x
new file mode 100644
index 00000000..1b9ed846
--- /dev/null
+++ b/sys/imio/tf/imgnli.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnli (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_INT)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_INT)
+		call imupki (Memi[lineptr], Memi[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgnll.x b/sys/imio/tf/imgnll.x
new file mode 100644
index 00000000..81c4fc44
--- /dev/null
+++ b/sys/imio/tf/imgnll.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnll (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_LONG)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_LONG)
+		call imupkl (Meml[lineptr], Meml[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgnlr.x b/sys/imio/tf/imgnlr.x
new file mode 100644
index 00000000..b14c96bb
--- /dev/null
+++ b/sys/imio/tf/imgnlr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnlr (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_REAL)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_REAL)
+		call imupkr (Memr[lineptr], Memr[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgnls.x b/sys/imio/tf/imgnls.x
new file mode 100644
index 00000000..ce962df6
--- /dev/null
+++ b/sys/imio/tf/imgnls.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnls (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_SHORT)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_SHORT)
+		call imupks (Mems[lineptr], Mems[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgnlx.x b/sys/imio/tf/imgnlx.x
new file mode 100644
index 00000000..76075a49
--- /dev/null
+++ b/sys/imio/tf/imgnlx.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGNL -- Get the next line from an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized
+# to the first line to be read before the first call.  Each call increments
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.
+
+int procedure imgnlx (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix, dtype, imgnln()
+errchk	imgnln
+
+begin
+	npix = imgnln (imdes, lineptr, v, TY_COMPLEX)
+
+	if (npix != EOF) {
+	    dtype = IM_PIXTYPE(imdes)
+	    if (dtype != TY_COMPLEX)
+		call imupkx (Memx[lineptr], Memx[lineptr], npix, dtype)
+	}
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imgs1d.x b/sys/imio/tf/imgs1d.x
new file mode 100644
index 00000000..5ab52b92
--- /dev/null
+++ b/sys/imio/tf/imgs1d.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1d (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggsd(), imgl1d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1d (im))
+	else
+	    return (imggsd (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs1i.x b/sys/imio/tf/imgs1i.x
new file mode 100644
index 00000000..ddb0a435
--- /dev/null
+++ b/sys/imio/tf/imgs1i.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1i (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggsi(), imgl1i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1i (im))
+	else
+	    return (imggsi (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs1l.x b/sys/imio/tf/imgs1l.x
new file mode 100644
index 00000000..5f3610c9
--- /dev/null
+++ b/sys/imio/tf/imgs1l.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1l (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggsl(), imgl1l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1l (im))
+	else
+	    return (imggsl (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs1r.x b/sys/imio/tf/imgs1r.x
new file mode 100644
index 00000000..9d5da6d4
--- /dev/null
+++ b/sys/imio/tf/imgs1r.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1r (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggsr(), imgl1r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1r (im))
+	else
+	    return (imggsr (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs1s.x b/sys/imio/tf/imgs1s.x
new file mode 100644
index 00000000..fc15aac3
--- /dev/null
+++ b/sys/imio/tf/imgs1s.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1s (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggss(), imgl1s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1s (im))
+	else
+	    return (imggss (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs1x.x b/sys/imio/tf/imgs1x.x
new file mode 100644
index 00000000..7bb64465
--- /dev/null
+++ b/sys/imio/tf/imgs1x.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS1? -- Get a section from an apparently one dimensional image.
+
+pointer procedure imgs1x (im, x1, x2)
+
+pointer	im
+int	x1, x2
+pointer	imggsx(), imgl1x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (imgl1x (im))
+	else
+	    return (imggsx (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imgs2d.x b/sys/imio/tf/imgs2d.x
new file mode 100644
index 00000000..4c8f5f71
--- /dev/null
+++ b/sys/imio/tf/imgs2d.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2d (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggsd(), imgl2d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2d (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggsd (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs2i.x b/sys/imio/tf/imgs2i.x
new file mode 100644
index 00000000..fe0c8d1e
--- /dev/null
+++ b/sys/imio/tf/imgs2i.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2i (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggsi(), imgl2i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2i (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggsi (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs2l.x b/sys/imio/tf/imgs2l.x
new file mode 100644
index 00000000..00fe004e
--- /dev/null
+++ b/sys/imio/tf/imgs2l.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2l (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggsl(), imgl2l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2l (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggsl (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs2r.x b/sys/imio/tf/imgs2r.x
new file mode 100644
index 00000000..7847908a
--- /dev/null
+++ b/sys/imio/tf/imgs2r.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2r (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggsr(), imgl2r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2r (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggsr (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs2s.x b/sys/imio/tf/imgs2s.x
new file mode 100644
index 00000000..209debe4
--- /dev/null
+++ b/sys/imio/tf/imgs2s.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2s (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggss(), imgl2s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2s (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggss (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs2x.x b/sys/imio/tf/imgs2x.x
new file mode 100644
index 00000000..3ff5bdc4
--- /dev/null
+++ b/sys/imio/tf/imgs2x.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS2? -- Get a section from an apparently two dimensional image.
+
+pointer procedure imgs2x (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	imggsx(), imgl2x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (imgl2x (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (imggsx (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imgs3d.x b/sys/imio/tf/imgs3d.x
new file mode 100644
index 00000000..32c1dab8
--- /dev/null
+++ b/sys/imio/tf/imgs3d.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3d (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggsd(), imgl3d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3d (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggsd (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgs3i.x b/sys/imio/tf/imgs3i.x
new file mode 100644
index 00000000..a231130f
--- /dev/null
+++ b/sys/imio/tf/imgs3i.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3i (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggsi(), imgl3i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3i (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggsi (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgs3l.x b/sys/imio/tf/imgs3l.x
new file mode 100644
index 00000000..5f1294b0
--- /dev/null
+++ b/sys/imio/tf/imgs3l.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3l (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggsl(), imgl3l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3l (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggsl (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgs3r.x b/sys/imio/tf/imgs3r.x
new file mode 100644
index 00000000..54bd0667
--- /dev/null
+++ b/sys/imio/tf/imgs3r.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3r (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggsr(), imgl3r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3r (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggsr (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgs3s.x b/sys/imio/tf/imgs3s.x
new file mode 100644
index 00000000..b0692edb
--- /dev/null
+++ b/sys/imio/tf/imgs3s.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3s (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggss(), imgl3s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3s (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggss (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imgs3x.x b/sys/imio/tf/imgs3x.x
new file mode 100644
index 00000000..f621fe4c
--- /dev/null
+++ b/sys/imio/tf/imgs3x.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMGS3? -- Get a section from an apparently three dimensional image.
+
+pointer procedure imgs3x (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	imggsx(), imgl3x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (imgl3x (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (imggsx (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impakd.x b/sys/imio/tf/impakd.x
new file mode 100644
index 00000000..060ef4d5
--- /dev/null
+++ b/sys/imio/tf/impakd.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impakd (a, b, npix, dtype)
+
+double	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtdu (a, b, npix)
+	case TY_SHORT:
+	    call achtds (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtdi (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtdi (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtdl (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtdl (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtdr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdd (a, b, npix)
+	case TY_COMPLEX:
+	    call achtdx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impaki.x b/sys/imio/tf/impaki.x
new file mode 100644
index 00000000..5d197add
--- /dev/null
+++ b/sys/imio/tf/impaki.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impaki (a, b, npix, dtype)
+
+int	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtiu (a, b, npix)
+	case TY_SHORT:
+	    call achtis (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtii (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtii (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtil (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtil (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtir (a, b, npix)
+	case TY_DOUBLE:
+	    call achtid (a, b, npix)
+	case TY_COMPLEX:
+	    call achtix (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impakl.x b/sys/imio/tf/impakl.x
new file mode 100644
index 00000000..884f931b
--- /dev/null
+++ b/sys/imio/tf/impakl.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impakl (a, b, npix, dtype)
+
+long	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtlu (a, b, npix)
+	case TY_SHORT:
+	    call achtls (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtli (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtli (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtll (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtll (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtlr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtld (a, b, npix)
+	case TY_COMPLEX:
+	    call achtlx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impakr.x b/sys/imio/tf/impakr.x
new file mode 100644
index 00000000..867554ce
--- /dev/null
+++ b/sys/imio/tf/impakr.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impakr (a, b, npix, dtype)
+
+real	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtru (a, b, npix)
+	case TY_SHORT:
+	    call achtrs (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtri (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtri (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtrl (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtrl (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtrr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtrd (a, b, npix)
+	case TY_COMPLEX:
+	    call achtrx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impaks.x b/sys/imio/tf/impaks.x
new file mode 100644
index 00000000..40168707
--- /dev/null
+++ b/sys/imio/tf/impaks.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impaks (a, b, npix, dtype)
+
+short	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtsu (a, b, npix)
+	case TY_SHORT:
+	    call achtss (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtsi (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtsi (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtsl (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtsl (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtsr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtsd (a, b, npix)
+	case TY_COMPLEX:
+	    call achtsx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impakx.x b/sys/imio/tf/impakx.x
new file mode 100644
index 00000000..1bfcffb9
--- /dev/null
+++ b/sys/imio/tf/impakx.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPAK? -- Convert an array of pixels of a specific datatype to the 
+# datatype given as the final argument.
+
+procedure impakx (a, b, npix, dtype)
+
+complex	a[npix]
+int	b[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtxu (a, b, npix)
+	case TY_SHORT:
+	    call achtxs (a, b, npix)
+	case TY_INT:
+	    if (SZ_INT == SZ_INT32)
+	        call achtxi (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_INT)
+	        call achtxi (a, Memi[bp], npix)
+		call ipak32 (Memi[bp], b, npix)
+		call mfree (bp, TY_INT)
+	    }
+	case TY_LONG:
+	    if (SZ_INT == SZ_INT32)
+	        call achtxl (a, b, npix)
+	    else {
+		call malloc (bp, npix, TY_LONG)
+	        call achtxl (a, Meml[bp], npix)
+		call ipak32 (Meml[bp], b, npix)
+		call mfree (bp, TY_LONG)
+	    }
+	case TY_REAL:
+	    call achtxr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtxd (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
diff --git a/sys/imio/tf/impgsd.x b/sys/imio/tf/impgsd.x
new file mode 100644
index 00000000..c298816e
--- /dev/null
+++ b/sys/imio/tf/impgsd.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgsd (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflsd()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_DOUBLE)
+	call zlocpr (imflsd, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impgsi.x b/sys/imio/tf/impgsi.x
new file mode 100644
index 00000000..62f69105
--- /dev/null
+++ b/sys/imio/tf/impgsi.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgsi (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflsi()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_INT)
+	call zlocpr (imflsi, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impgsl.x b/sys/imio/tf/impgsl.x
new file mode 100644
index 00000000..d791b4fd
--- /dev/null
+++ b/sys/imio/tf/impgsl.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgsl (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflsl()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_LONG)
+	call zlocpr (imflsl, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impgsr.x b/sys/imio/tf/impgsr.x
new file mode 100644
index 00000000..46938707
--- /dev/null
+++ b/sys/imio/tf/impgsr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgsr (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflsr()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_REAL)
+	call zlocpr (imflsr, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impgss.x b/sys/imio/tf/impgss.x
new file mode 100644
index 00000000..bcdf26e0
--- /dev/null
+++ b/sys/imio/tf/impgss.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgss (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflss()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_SHORT)
+	call zlocpr (imflss, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impgsx.x b/sys/imio/tf/impgsx.x
new file mode 100644
index 00000000..bb56c9aa
--- /dev/null
+++ b/sys/imio/tf/impgsx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPGS? -- Put a general section of a specific datatype.
+
+pointer procedure impgsx (imdes, vs, ve, ndim)
+
+pointer	imdes
+long	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	bp, imgobf()
+int	ndim
+extern	imflsx()
+errchk	imflush, imgobf
+
+begin
+	# Flush the output buffer, if appropriate.  IMFLUSH calls
+	# one of the IMFLS? routines, which write out the section.
+
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	# Get an (output) buffer to put the pixels into.  Save the
+	# section parameters in the image descriptor.  Save the epa
+	# of the typed flush procedure in the image descriptor.
+
+	bp = imgobf (imdes, vs, ve, ndim, TY_COMPLEX)
+	call zlocpr (imflsx, IM_FLUSHEPA(imdes))
+	IM_FLUSH(imdes) = YES
+
+	return (bp)
+end
diff --git a/sys/imio/tf/impl1d.x b/sys/imio/tf/impl1d.x
new file mode 100644
index 00000000..227d25dd
--- /dev/null
+++ b/sys/imio/tf/impl1d.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1d (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgsd(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+	    return (impgsd (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl1i.x b/sys/imio/tf/impl1i.x
new file mode 100644
index 00000000..a81d6b73
--- /dev/null
+++ b/sys/imio/tf/impl1i.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1i (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgsi(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+	    return (impgsi (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl1l.x b/sys/imio/tf/impl1l.x
new file mode 100644
index 00000000..8f9616ca
--- /dev/null
+++ b/sys/imio/tf/impl1l.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1l (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgsl(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+	    return (impgsl (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl1r.x b/sys/imio/tf/impl1r.x
new file mode 100644
index 00000000..dc0ed92e
--- /dev/null
+++ b/sys/imio/tf/impl1r.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1r (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgsr(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+	    return (impgsr (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl1s.x b/sys/imio/tf/impl1s.x
new file mode 100644
index 00000000..a598e92a
--- /dev/null
+++ b/sys/imio/tf/impl1s.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1s (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgss(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+	    return (impgss (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl1x.x b/sys/imio/tf/impl1x.x
new file mode 100644
index 00000000..6b141a14
--- /dev/null
+++ b/sys/imio/tf/impl1x.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL1? -- Put a line to an apparently one dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl1x (im)
+
+pointer	im			# image header pointer
+int	fd, nchars
+long	offset
+pointer	bp, impgsx(), fwritep()
+errchk	imopsf
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		offset = IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+	    return (impgsx (im, long(1), IM_LEN(im,1), 1))
+	}
+end
diff --git a/sys/imio/tf/impl2d.x b/sys/imio/tf/impl2d.x
new file mode 100644
index 00000000..cd4a1b6e
--- /dev/null
+++ b/sys/imio/tf/impl2d.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2d (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgsd(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_DOUBLE +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgsd (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl2i.x b/sys/imio/tf/impl2i.x
new file mode 100644
index 00000000..9f13e4ef
--- /dev/null
+++ b/sys/imio/tf/impl2i.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2i (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgsi(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_INT +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgsi (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl2l.x b/sys/imio/tf/impl2l.x
new file mode 100644
index 00000000..c42d57cf
--- /dev/null
+++ b/sys/imio/tf/impl2l.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2l (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgsl(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_LONG +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgsl (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl2r.x b/sys/imio/tf/impl2r.x
new file mode 100644
index 00000000..43e84370
--- /dev/null
+++ b/sys/imio/tf/impl2r.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2r (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgsr(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_REAL +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgsr (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl2s.x b/sys/imio/tf/impl2s.x
new file mode 100644
index 00000000..41bc248f
--- /dev/null
+++ b/sys/imio/tf/impl2s.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2s (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgss(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_SHORT +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgss (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl2x.x b/sys/imio/tf/impl2x.x
new file mode 100644
index 00000000..f16e9725
--- /dev/null
+++ b/sys/imio/tf/impl2x.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL2? -- Put a line to an apparently two dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl2x (im, linenum)
+
+pointer	im			# image header pointer
+int	linenum			# line to be written
+
+int	fd, nchars
+long	vs[2], ve[2], offset
+pointer	bp, impgsx(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (linenum < 1 || linenum > IM_LEN(im,2))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (linenum - 1) * IM_PHYSLEN(im,1) * SZ_COMPLEX +
+		    IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = linenum
+	    ve[2] = linenum
+
+	    return (impgsx (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/impl3d.x b/sys/imio/tf/impl3d.x
new file mode 100644
index 00000000..405ef94e
--- /dev/null
+++ b/sys/imio/tf/impl3d.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3d (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgsd(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_DOUBLE) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_DOUBLE + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_DOUBLE
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_DOUBLE + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgsd (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impl3i.x b/sys/imio/tf/impl3i.x
new file mode 100644
index 00000000..0e0d4cd1
--- /dev/null
+++ b/sys/imio/tf/impl3i.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3i (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgsi(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_INT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_INT + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_INT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_INT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgsi (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impl3l.x b/sys/imio/tf/impl3l.x
new file mode 100644
index 00000000..2471825a
--- /dev/null
+++ b/sys/imio/tf/impl3l.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3l (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgsl(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_LONG) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_LONG + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_LONG
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_LONG + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgsl (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impl3r.x b/sys/imio/tf/impl3r.x
new file mode 100644
index 00000000..675fd8d0
--- /dev/null
+++ b/sys/imio/tf/impl3r.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3r (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgsr(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_REAL) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_REAL + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_REAL
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_REAL + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgsr (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impl3s.x b/sys/imio/tf/impl3s.x
new file mode 100644
index 00000000..63da06e2
--- /dev/null
+++ b/sys/imio/tf/impl3s.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3s (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgss(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_SHORT) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_SHORT + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_SHORT
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_SHORT + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgss (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impl3x.x b/sys/imio/tf/impl3x.x
new file mode 100644
index 00000000..85b061cd
--- /dev/null
+++ b/sys/imio/tf/impl3x.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPL3? -- Put a line to an apparently three dimensional image.  If there
+# is only one input buffer, no image section, we are not referencing out of
+# bounds, and no datatype conversion needs to be performed, directly access
+# the pixels to reduce the overhead per line.
+
+pointer procedure impl3x (im, line, band)
+
+pointer	im		# image header pointer
+int	line		# line number within band
+int	band		# band number
+
+int	fd, nchars
+long	vs[3], ve[3], offset
+pointer	bp, impgsx(), fwritep()
+errchk	imopsf, imerr
+
+begin
+	repeat {
+	    if (IM_FAST(im) == YES && IM_PIXTYPE(im) == TY_COMPLEX) {
+		fd = IM_PFD(im)
+		if (fd == NULL) {
+		    call imopsf (im)
+		    next
+		}
+		if (line < 1 || line > IM_LEN(im,2) ||
+		    band < 1 || band > IM_LEN(im,3))
+		    call imerr (IM_NAME(im), SYS_IMREFOOB)
+
+		offset = (((band - 1) * IM_PHYSLEN(im,2) + line - 1) *
+		    IM_PHYSLEN(im,1)) * SZ_COMPLEX + IM_PIXOFF(im)
+		nchars = IM_PHYSLEN(im,1) * SZ_COMPLEX
+		ifnoerr (bp = (fwritep (fd, offset, nchars) - 1) / SZ_COMPLEX + 1)
+		    return (bp)
+	    }
+
+	    vs[1] = 1
+	    ve[1] = IM_LEN(im,1)
+	    vs[2] = line
+	    ve[2] = line
+	    vs[3] = band
+	    ve[3] = band
+
+	    return (impgsx (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/impnld.x b/sys/imio/tf/impnld.x
new file mode 100644
index 00000000..b0f9bfd5
--- /dev/null
+++ b/sys/imio/tf/impnld.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnld (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflsd()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_DOUBLE)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflsd, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/impnli.x b/sys/imio/tf/impnli.x
new file mode 100644
index 00000000..6155a6b6
--- /dev/null
+++ b/sys/imio/tf/impnli.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnli (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflsi()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_INT)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflsi, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/impnll.x b/sys/imio/tf/impnll.x
new file mode 100644
index 00000000..3fb29144
--- /dev/null
+++ b/sys/imio/tf/impnll.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnll (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflsl()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_LONG)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflsl, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/impnlr.x b/sys/imio/tf/impnlr.x
new file mode 100644
index 00000000..c60c8631
--- /dev/null
+++ b/sys/imio/tf/impnlr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnlr (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflsr()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_REAL)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflsr, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/impnls.x b/sys/imio/tf/impnls.x
new file mode 100644
index 00000000..af85bf8a
--- /dev/null
+++ b/sys/imio/tf/impnls.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnls (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflss()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_SHORT)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflss, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/impnlx.x b/sys/imio/tf/impnlx.x
new file mode 100644
index 00000000..e76cf1f1
--- /dev/null
+++ b/sys/imio/tf/impnlx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# IMPNL -- Put the next line to an image of any dimension or datatype.
+# This is a sequential operator.  The index vector V should be initialized 
+# before the first call to the first line to be written.  Each call increments 
+# the leftmost subscript by one, until V equals IM_LEN, at which time EOF
+# is returned.  Subsequent writes are ignored.
+
+int procedure impnlx (imdes, lineptr, v)
+
+pointer	imdes
+pointer	lineptr				# on output, points to the pixels
+long	v[IM_MAXDIM]			# loop counter
+int	npix
+int	impnln()
+extern	imflsx()
+errchk	impnln
+
+begin
+	if (IM_FLUSH(imdes) == YES)
+	    call zcall1 (IM_FLUSHEPA(imdes), imdes)
+
+	npix = impnln (imdes, lineptr, v, TY_COMPLEX)
+	if (IM_FLUSH(imdes) == YES)
+	    call zlocpr (imflsx, IM_FLUSHEPA(imdes))
+
+	return (npix)
+end
diff --git a/sys/imio/tf/imps1d.x b/sys/imio/tf/imps1d.x
new file mode 100644
index 00000000..c8dd82b1
--- /dev/null
+++ b/sys/imio/tf/imps1d.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1d (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgsd(), impl1d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1d (im))
+	else
+	    return (impgsd (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps1i.x b/sys/imio/tf/imps1i.x
new file mode 100644
index 00000000..cb97a374
--- /dev/null
+++ b/sys/imio/tf/imps1i.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1i (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgsi(), impl1i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1i (im))
+	else
+	    return (impgsi (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps1l.x b/sys/imio/tf/imps1l.x
new file mode 100644
index 00000000..c8f5aae4
--- /dev/null
+++ b/sys/imio/tf/imps1l.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1l (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgsl(), impl1l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1l (im))
+	else
+	    return (impgsl (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps1r.x b/sys/imio/tf/imps1r.x
new file mode 100644
index 00000000..1bd1434c
--- /dev/null
+++ b/sys/imio/tf/imps1r.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1r (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgsr(), impl1r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1r (im))
+	else
+	    return (impgsr (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps1s.x b/sys/imio/tf/imps1s.x
new file mode 100644
index 00000000..130e7f18
--- /dev/null
+++ b/sys/imio/tf/imps1s.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1s (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgss(), impl1s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1s (im))
+	else
+	    return (impgss (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps1x.x b/sys/imio/tf/imps1x.x
new file mode 100644
index 00000000..5a5c33a0
--- /dev/null
+++ b/sys/imio/tf/imps1x.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS1? -- Put a section to an apparently one dimensional image.
+
+pointer procedure imps1x (im, x1, x2)
+
+pointer	im		# image header pointer
+int	x1		# first column
+int	x2		# last column
+
+pointer	impgsx(), impl1x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1))
+	    return (impl1x (im))
+	else
+	    return (impgsx (im, long(x1), long(x2), 1))
+end
diff --git a/sys/imio/tf/imps2d.x b/sys/imio/tf/imps2d.x
new file mode 100644
index 00000000..e3f36fd9
--- /dev/null
+++ b/sys/imio/tf/imps2d.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2d (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgsd(), impl2d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2d (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgsd (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps2i.x b/sys/imio/tf/imps2i.x
new file mode 100644
index 00000000..57e3f36c
--- /dev/null
+++ b/sys/imio/tf/imps2i.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2i (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgsi(), impl2i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2i (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgsi (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps2l.x b/sys/imio/tf/imps2l.x
new file mode 100644
index 00000000..2d7bc8b7
--- /dev/null
+++ b/sys/imio/tf/imps2l.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2l (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgsl(), impl2l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2l (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgsl (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps2r.x b/sys/imio/tf/imps2r.x
new file mode 100644
index 00000000..ce8b2958
--- /dev/null
+++ b/sys/imio/tf/imps2r.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2r (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgsr(), impl2r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2r (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgsr (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps2s.x b/sys/imio/tf/imps2s.x
new file mode 100644
index 00000000..c5993a61
--- /dev/null
+++ b/sys/imio/tf/imps2s.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2s (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgss(), impl2s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2s (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgss (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps2x.x b/sys/imio/tf/imps2x.x
new file mode 100644
index 00000000..12db84a5
--- /dev/null
+++ b/sys/imio/tf/imps2x.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS2? -- Put a section to an apparently two dimensional image.
+
+pointer procedure imps2x (im, x1, x2, y1, y2)
+
+pointer	im
+int	x1, x2, y1, y2
+long	vs[2], ve[2]
+pointer	impgsx(), impl2x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2)
+	    return (impl2x (im, y1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    return (impgsx (im, vs, ve, 2))
+	}
+end
diff --git a/sys/imio/tf/imps3d.x b/sys/imio/tf/imps3d.x
new file mode 100644
index 00000000..0cd67b5e
--- /dev/null
+++ b/sys/imio/tf/imps3d.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3d (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgsd(), impl3d()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3d (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgsd (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imps3i.x b/sys/imio/tf/imps3i.x
new file mode 100644
index 00000000..9ec4a832
--- /dev/null
+++ b/sys/imio/tf/imps3i.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3i (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgsi(), impl3i()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3i (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgsi (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imps3l.x b/sys/imio/tf/imps3l.x
new file mode 100644
index 00000000..a68b2de5
--- /dev/null
+++ b/sys/imio/tf/imps3l.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3l (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgsl(), impl3l()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3l (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgsl (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imps3r.x b/sys/imio/tf/imps3r.x
new file mode 100644
index 00000000..4fcbecff
--- /dev/null
+++ b/sys/imio/tf/imps3r.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3r (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgsr(), impl3r()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3r (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgsr (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imps3s.x b/sys/imio/tf/imps3s.x
new file mode 100644
index 00000000..3758b3b9
--- /dev/null
+++ b/sys/imio/tf/imps3s.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3s (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgss(), impl3s()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3s (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgss (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imps3x.x b/sys/imio/tf/imps3x.x
new file mode 100644
index 00000000..7062a3c1
--- /dev/null
+++ b/sys/imio/tf/imps3x.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMPS3? -- Put a section to an apparently three dimensional image.
+
+pointer procedure imps3x (im, x1, x2, y1, y2, z1, z2)
+
+pointer	im
+int	x1, x2, y1, y2, z1, z2
+long	vs[3], ve[3]
+pointer	impgsx(), impl3x()
+
+begin
+	if (x1 == 1 && x2 == IM_LEN(im,1) && y1 == y2 && z1 == z2)
+	    return (impl3x (im, y1, z1))
+	else {
+	    vs[1] = x1
+	    ve[1] = x2
+
+	    vs[2] = y1
+	    ve[2] = y2
+
+	    vs[3] = z1
+	    ve[3] = z2
+
+	    return (impgsx (im, vs, ve, 3))
+	}
+end
diff --git a/sys/imio/tf/imupkd.x b/sys/imio/tf/imupkd.x
new file mode 100644
index 00000000..ffbbe81e
--- /dev/null
+++ b/sys/imio/tf/imupkd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupkd (a, b, npix, dtype)
+
+double	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtud (a, b, npix)
+	case TY_SHORT:
+	    call achtsd (a, b, npix)
+	case TY_INT:
+	    call achtid (a, b, npix)
+	case TY_LONG:
+	    call achtld (a, b, npix)
+	case TY_REAL:
+	    call achtrd (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdd (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxd (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/imupki.x b/sys/imio/tf/imupki.x
new file mode 100644
index 00000000..0703b22b
--- /dev/null
+++ b/sys/imio/tf/imupki.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupki (a, b, npix, dtype)
+
+int	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtui (a, b, npix)
+	case TY_SHORT:
+	    call achtsi (a, b, npix)
+	case TY_INT:
+	    call achtii (a, b, npix)
+	case TY_LONG:
+	    call achtli (a, b, npix)
+	case TY_REAL:
+	    call achtri (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdi (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxi (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/imupkl.x b/sys/imio/tf/imupkl.x
new file mode 100644
index 00000000..1b144e29
--- /dev/null
+++ b/sys/imio/tf/imupkl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupkl (a, b, npix, dtype)
+
+long	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtul (a, b, npix)
+	case TY_SHORT:
+	    call achtsl (a, b, npix)
+	case TY_INT:
+	    call achtil (a, b, npix)
+	case TY_LONG:
+	    call achtll (a, b, npix)
+	case TY_REAL:
+	    call achtrl (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdl (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxl (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/imupkr.x b/sys/imio/tf/imupkr.x
new file mode 100644
index 00000000..0cfccefc
--- /dev/null
+++ b/sys/imio/tf/imupkr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupkr (a, b, npix, dtype)
+
+real	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtur (a, b, npix)
+	case TY_SHORT:
+	    call achtsr (a, b, npix)
+	case TY_INT:
+	    call achtir (a, b, npix)
+	case TY_LONG:
+	    call achtlr (a, b, npix)
+	case TY_REAL:
+	    call achtrr (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdr (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxr (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/imupks.x b/sys/imio/tf/imupks.x
new file mode 100644
index 00000000..93d0ad3f
--- /dev/null
+++ b/sys/imio/tf/imupks.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupks (a, b, npix, dtype)
+
+short	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtus (a, b, npix)
+	case TY_SHORT:
+	    call achtss (a, b, npix)
+	case TY_INT:
+	    call achtis (a, b, npix)
+	case TY_LONG:
+	    call achtls (a, b, npix)
+	case TY_REAL:
+	    call achtrs (a, b, npix)
+	case TY_DOUBLE:
+	    call achtds (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxs (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/imupkx.x b/sys/imio/tf/imupkx.x
new file mode 100644
index 00000000..916bb73b
--- /dev/null
+++ b/sys/imio/tf/imupkx.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMUPK? -- Convert an array of pixels of datatype DTYPE into the datatype
+# specified by the IMUPK? suffix character.
+
+procedure imupkx (a, b, npix, dtype)
+
+complex	b[npix]
+int	a[npix], npix, dtype
+
+pointer	bp
+
+begin
+	switch (dtype) {
+	case TY_USHORT:
+	    call achtux (a, b, npix)
+	case TY_SHORT:
+	    call achtsx (a, b, npix)
+	case TY_INT:
+	    call achtix (a, b, npix)
+	case TY_LONG:
+	    call achtlx (a, b, npix)
+	case TY_REAL:
+	    call achtrx (a, b, npix)
+	case TY_DOUBLE:
+	    call achtdx (a, b, npix)
+	case TY_COMPLEX:
+	    call achtxx (a, b, npix)
+	default:
+	    call error (1, "Unknown datatype in imagefile")
+	}
+end
+
+
diff --git a/sys/imio/tf/mkpkg b/sys/imio/tf/mkpkg
new file mode 100644
index 00000000..a79ca832
--- /dev/null
+++ b/sys/imio/tf/mkpkg
@@ -0,0 +1,123 @@
+# Update the type specific (generically expanded) IMIO procedures.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	imflsd.x	<imhdr.h> <imio.h>
+	imflsi.x	<imhdr.h> <imio.h>
+	imflsl.x	<imhdr.h> <imio.h>
+	imflsr.x	<imhdr.h> <imio.h>
+	imflss.x	<imhdr.h> <imio.h>
+	imflsx.x	<imhdr.h> <imio.h>
+	imggsd.x	<imhdr.h>
+	imggsi.x	<imhdr.h>
+	imggsl.x	<imhdr.h>
+	imggsr.x	<imhdr.h>
+	imggss.x	<imhdr.h>
+	imggsx.x	<imhdr.h>
+	imgl1d.x	<imhdr.h> <imio.h>
+	imgl1i.x	<imhdr.h> <imio.h>
+	imgl1l.x	<imhdr.h> <imio.h>
+	imgl1r.x	<imhdr.h> <imio.h>
+	imgl1s.x	<imhdr.h> <imio.h>
+	imgl1x.x	<imhdr.h> <imio.h>
+	imgl2d.x	<imhdr.h> <imio.h>
+	imgl2i.x	<imhdr.h> <imio.h>
+	imgl2l.x	<imhdr.h> <imio.h>
+	imgl2r.x	<imhdr.h> <imio.h>
+	imgl2s.x	<imhdr.h> <imio.h>
+	imgl2x.x	<imhdr.h> <imio.h>
+	imgl3d.x	<imhdr.h> <imio.h>
+	imgl3i.x	<imhdr.h> <imio.h>
+	imgl3l.x	<imhdr.h> <imio.h>
+	imgl3r.x	<imhdr.h> <imio.h>
+	imgl3s.x	<imhdr.h> <imio.h>
+	imgl3x.x	<imhdr.h> <imio.h>
+	imgnld.x	<imhdr.h>
+	imgnli.x	<imhdr.h>
+	imgnll.x	<imhdr.h>
+	imgnlr.x	<imhdr.h>
+	imgnls.x	<imhdr.h>
+	imgnlx.x	<imhdr.h>
+	imgs1d.x	<imhdr.h>
+	imgs1i.x	<imhdr.h>
+	imgs1l.x	<imhdr.h>
+	imgs1r.x	<imhdr.h>
+	imgs1s.x	<imhdr.h>
+	imgs1x.x	<imhdr.h>
+	imgs2d.x	<imhdr.h>
+	imgs2i.x	<imhdr.h>
+	imgs2l.x	<imhdr.h>
+	imgs2r.x	<imhdr.h>
+	imgs2s.x	<imhdr.h>
+	imgs2x.x	<imhdr.h>
+	imgs3d.x	<imhdr.h>
+	imgs3i.x	<imhdr.h>
+	imgs3l.x	<imhdr.h>
+	imgs3r.x	<imhdr.h>
+	imgs3s.x	<imhdr.h>
+	imgs3x.x	<imhdr.h>
+	impakd.x	
+	impaki.x	
+	impakl.x	
+	impakr.x	
+	impaks.x	
+	impakx.x	
+	impgsd.x	<imhdr.h> <imio.h>
+	impgsi.x	<imhdr.h> <imio.h>
+	impgsl.x	<imhdr.h> <imio.h>
+	impgsr.x	<imhdr.h> <imio.h>
+	impgss.x	<imhdr.h> <imio.h>
+	impgsx.x	<imhdr.h> <imio.h>
+	impl1d.x	<imhdr.h> <imio.h>
+	impl1i.x	<imhdr.h> <imio.h>
+	impl1l.x	<imhdr.h> <imio.h>
+	impl1r.x	<imhdr.h> <imio.h>
+	impl1s.x	<imhdr.h> <imio.h>
+	impl1x.x	<imhdr.h> <imio.h>
+	impl2d.x	<imhdr.h> <imio.h>
+	impl2i.x	<imhdr.h> <imio.h>
+	impl2l.x	<imhdr.h> <imio.h>
+	impl2r.x	<imhdr.h> <imio.h>
+	impl2s.x	<imhdr.h> <imio.h>
+	impl2x.x	<imhdr.h> <imio.h>
+	impl3d.x	<imhdr.h> <imio.h>
+	impl3i.x	<imhdr.h> <imio.h>
+	impl3l.x	<imhdr.h> <imio.h>
+	impl3r.x	<imhdr.h> <imio.h>
+	impl3s.x	<imhdr.h> <imio.h>
+	impl3x.x	<imhdr.h> <imio.h>
+	impnld.x	<imhdr.h> <imio.h>
+	impnli.x	<imhdr.h> <imio.h>
+	impnll.x	<imhdr.h> <imio.h>
+	impnlr.x	<imhdr.h> <imio.h>
+	impnls.x	<imhdr.h> <imio.h>
+	impnlx.x	<imhdr.h> <imio.h>
+	imps1d.x	<imhdr.h>
+	imps1i.x	<imhdr.h>
+	imps1l.x	<imhdr.h>
+	imps1r.x	<imhdr.h>
+	imps1s.x	<imhdr.h>
+	imps1x.x	<imhdr.h>
+	imps2d.x	<imhdr.h>
+	imps2i.x	<imhdr.h>
+	imps2l.x	<imhdr.h>
+	imps2r.x	<imhdr.h>
+	imps2s.x	<imhdr.h>
+	imps2x.x	<imhdr.h>
+	imps3d.x	<imhdr.h>
+	imps3i.x	<imhdr.h>
+	imps3l.x	<imhdr.h>
+	imps3r.x	<imhdr.h>
+	imps3s.x	<imhdr.h>
+	imps3x.x	<imhdr.h>
+	imupkd.x	
+	imupki.x	
+	imupkl.x	
+	imupkr.x	
+	imupks.x	
+	imupkx.x	
+	;
diff --git a/sys/imio/zzdebug.x b/sys/imio/zzdebug.x
new file mode 100644
index 00000000..2772b27c
--- /dev/null
+++ b/sys/imio/zzdebug.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	imt	= t_imt
+
+# IMT -- Test the image template package.
+
+procedure t_imt()
+
+char	template[SZ_LINE]
+char	image[SZ_FNAME]
+pointer	imt, imtopen()
+int	imtgetim()
+
+begin
+	call clgstr ("template", template, SZ_LINE)
+	imt = imtopen (template)
+
+	while (imtgetim (imt, image, SZ_FNAME) != EOF) {
+	    call printf ("%s\n")
+		call pargstr (image)
+	}
+
+	call imtclose (imt)
+end
diff --git a/sys/ki/README b/sys/ki/README
new file mode 100644
index 00000000..147ee538
--- /dev/null
+++ b/sys/ki/README
@@ -0,0 +1,648 @@
+			   Kernel Interface Package
+				12-May-85 dct
+			         (21-Aug-85)
+
+
+1. Introduction
+
+    The kernel interface package (KI) isolates the IRAF virtual operating
+system (VOS) from the IRAF kernel, permitting access either to the local
+kernel or to an IRAF kernel resident on a remote host, via an IRAF kernel
+server (KS).  The KI provides access to files, peripherals and devices,
+and subprocesses irrespective of whether the resource is located on the
+local machine or on a remote node.  Since the KI is implemented on top of
+the IRAF kernel the different nodes may run different native operating systems.
+
+
+           +-----------+
+           |           |                  VOS = virtual operating system
+           |   V O S   |                   KI = kernel interface
+           |           |                   KS = kernel server
+           +-----------+
+                 |               :
+                 |
+           +-----------+         :        +-----------+
+           |           |                  |           |
+           |    K I    |=========:========|    K S    |==== (etc)
+           |           |                  |           |
+           +-----------+         :        +-----------+
+                 |                              |
+                 |               :              |
+           +-----------+                  +-----------+
+           |           |         :        |           |
+           |   local   |                  |  remote   |
+           |   kernel  |         :        |  kernel   |
+           |           |                  |           |
+           +-----------+         :        +-----------+
+   
+                                 :
+              (host1)                        (host2)
+
+
+	              Architecture of the Kernel Interface
+
+
+2. Conceptual Design
+
+    The purpose of the kernel interface is to permit access to logical files,
+devices, and subprocesses regardless of where such objects physically reside
+in a network.  This permits sharing of peripherals such as image displays and
+plotters, data sharing (centralized databases), load sharing (running of
+subprocesses on lightly loaded nodes), and makes such mundane operations as
+copying a file between two nodes possible without developing special purpose
+software and further complicating the user interface.
+
+By addressing these problems by implementation of an interface just above
+the IRAF kernel it becomes possible to remotely access nodes running different
+native operating systems, e.g., UNIX and VMS, with the IRAF kernel on each host
+system resolving the differences between file formats and filenames found
+on the different host systems.  Full access to text files and raw peripherals
+is inherent in the scheme regardless of the architecture of the host machine.
+Full access to binary datafiles is possible provided the binary format is
+machine independent, a desirable goal in any case.
+
+The kernel interface is conceived as an optional and invisible interface
+between the IRAF virtual operating system and the IRAF kernel.
+The specifications of the kernel are not affected by the KI, except for the
+addition of a new device driver for talking to remote kernel servers.  The VOS
+sees the same kernel interface whether or not the system is configured with a
+KI.
+
+A VOS call to a kernel procedure such as ZOPNBF, for example, is directed
+instead to the KI procedure KOPNBF which in turn calls either the local ZOPNBF
+or passes the call to a remote KS.  The VOS still calls the procedure "zopnbf",
+but the external name of this procedure is redefined in <config.h> as "kopnbf",
+permitted substitution of the KI merely by recompilation.  When the file is
+opened a channel descriptor is allocated within the KI telling whether the
+channel is local or remote, and if remote giving the KS address on the net,
+and giving the kernel channel number of the file on the node on which it
+resides.  The KI channel number instead of the kernel channel number is
+returned to the VOS.  Subsequent i/o requests on the channel are also processed
+by the KI, which uses the channel descriptor to determine whether the file
+is local or remote and then fulfils the request.
+
+
+3. Other Network Interfaces
+
+    The kernel interface is not intended to replace or compete with "real"
+network implmentations such as NFS or DECNET.  If the local net provides such
+facilities then remote access via the host network is equivalent to a local
+file reference.  Few such commercial networks, however, permit equivalent
+access when the different nodes run different operating systems.
+Often the type of access provided by the network is restricted in some way,
+e.g., NFS permits transparent access to remote files but not to remote devices.
+On VMS an IRAF kernel routine which accesses an i/o channel at the QIO level
+is bypassing DECNET hence can only be used to access a local device.
+The kernel server approach neatly sidesteps these problems without preventing
+use of the host networking facilities in cases were it is desirable to do so.
+
+
+4. Performance
+
+    The overhead of the KI for a local file access is one additional procedure
+call per i/o request, e.g., an additional 20-30 microseconds per i/o request.
+A remote file access requires encoding of the request as a KI instruction,
+transmission of the instruction to the remote host, decoding of the instruction
+by the remote host, a kernel access on the remote host, and in the case of a
+read request transmission of the data back to the requesting node where it is
+read out into the caller's buffer.  Handshaking is required to return the status
+value after reads and writes to a remote node, hence large transfers will
+significantly reduce the overhead involved in remote file access.  Large data
+transfers are automatically transferred in segments by the interface code,
+hence there is no builtin limit on the size of a transfer.
+
+A file open or process spawn requiring connection to a kernel server on a
+remote host is a relatively expensive procedure since it requires spawning of
+the kernel server process on the remote host.  Once a process has connected to
+a kernel server on a remote host that server will remain connected for the
+life of the local process, with the single connection providing simultaneous
+access to any number of files, devices, or child processes on the remote host.
+Each local process requires its own kernel server process on the remote node.
+
+
+5. Modifications to the Existing I/O System
+
+    As noted above, implementation of the KI should require minimal
+modifications to existing software.  The specific modifications or additions
+required appear to be the following:
+
+
+additions:
+
+	add package KI (kernel interface)
+	add source for the KS (kernel server) process
+	add KS device driver to the kernel (package OS)
+	add ZGHOST (get hostname) primitive to OS
+	add SPP and LIBC include files <knames.h> to map zroutine names
+
+
+modifications:
+
+	add reference to <knames.h> to VOS procedures which access kernel
+	finit.h: install kernel server device driver at process startup
+	modify filename mapping:
+	    do not map filenames which begin with a node name 
+	    prepend CWD to relative filenames if CWD is on a remote node (?)
+
+
+6. Filenames
+
+    Files and processes anywhere in the network may be accessed by prepending
+the node name to the VFN or OSFN of the file.  In essence we have extended
+the VFN filename syntax to support node names.  The syntax is as follows:
+
+	node "!" filename
+
+The field delimiter "!" is used because it is not used in filenames in AOS,
+UNIX, or VMS.  The delimiters ":" and "::", commonly used as node name
+delimiters in commercial networds, were intentionally not used so that network
+filenames may be specified without conflict on systems with host network
+support.  Typical filenames using this notation are shown below.
+
+	2!/dev/iis
+	1!lib$motd
+	3!dra0:[user.data]pic.db
+
+An important consideration in choosing the node delimiter character is that
+it not be necessary to quote filenames in common everyday usage.  It turns out
+that in the CL "command mode" the character ! is only recognized as a
+metacharacter when it occurs at the beginning of a command (as the OS escape),
+hence quoting of filenames containing ! will not be necessary.
+
+The strategy for resolving such filenames is as follows.  The full filename
+including the nodename is passed to the filename mapping code on the local
+machine.  If the filename includes a nodename the filename is not mapped.
+The KI receives the filename and strips off the nodename, using it to
+select the node which will execute the kernel primitive.  The remainder of
+the filename (minus the nodename) is passed to the KS on the addressed node,
+and the KS performs the filename mapping and passes the mapped filename on
+to the IRAF kernel.  Since the filename mapping is carried out by the KS on
+the remote node the filename will be mapped in the context of the remote
+machine, i.e., the mapping will depend upon the native operating system used
+on the remote node.  If the KS is itself configured with a kernel interface,
+multiple indirection is possible, permitting gateways onto other networks,
+e.g., "gateway!node!filename".
+
+There should be no penalty for using a self referential node name in a
+filename, i.e., the system should be smart enough to ignore node names
+when the node named is the local node.  This permits use of the same absolute
+network filenames in configuration tables on all nodes, without having to
+maintain different sources on the different nodes.
+
+Fully functional filename mapping requires that the IRAF environment variables
+used by a process on the local machine be propagated to the kernel server on
+the remote machine.  If this is not done then package directory references,
+etc., appearing in virtual filenames will not be resolved.  The kernel server
+will inherit all environment variables except iraf$, since logical directory
+names of the form "node!ldir$file" must be expanded relative to the iraf
+root directory on the remote node.  User defined logical directories should
+include an explicit node name to permit access from any node.
+
+
+6.1 External KI Procedures
+
+    The majority of the KI procedures are internal, since the KI interface
+is hidden behind the procedure redefinitions in <knet.h>.  Other subsystems
+of the VOS do however occasionally need access to the KI, and the following
+procedures are provided for this purpose.
+
+
+	ki_extnode - Extract (or delimit) the node name field
+	ki_mapchan - Map KI channel into OS channel (or pid) and node name
+
+   len_prefix =  ki_extnode (resource, nodename, maxch, nchars)
+       oschan =  ki_mapchan (kichan, nodename, maxch)
+
+
+The EXTNODE function is used to extract the node name from a resource name,
+e.g., to produce a simpler name as required by the low level code, or to
+propagate the node name prefix to a second resource name.  The MAPCHAN function
+is used to convert a KI channel descriptor into the corresponding OS channel
+number and node name, e.g., for output to the user (the KI channel code is
+meaningless to the user).
+
+
+7. KI Procedures
+
+    Only those procedures in the IRAF kernel which take a filename as an operand
+or which do i/o to a file (or to IPC) need be mapped by the kernel interface.
+This subset of the kernel includes all the file primitives, all the device
+drivers, and some exception handling procedures.
+
+	zfacss - determine file accessibility
+	zfaloc - allocate a file
+	zfchdr - change default directory 		(??)
+	zfdele - delete a file
+	zfgcwd - get default directory 			(??)
+	zfinfo - get directory info on a file
+	zfmkcp - make a null length copy of a file
+	zfprot - set, remove, or query file protection
+	zfrnam - rename a file
+	zopdir - open a directory
+	zgfdir - get next filename from a directory
+
+	zopdpr - open a detached process
+	zcldpr - close a detached process
+	zopcpr - open a connected subprocess
+	zclcpr - close a connected subprocess
+	zintpr - interrupt a subprocess
+
+	zfiobf - binary file driver
+	zfiolp - line printer driver
+	zfiomt - magtape driver
+	zfiopl - plotter driver
+	zfiopr - ipc driver
+	zfiosf - static file driver
+	zfiotx - text file driver
+	zfioty - terminal driver
+
+
+The basic function of a KI procedure is to determine which host is to execute
+the kernel primitive, call the local or remote kernel to execute the primitive,
+and return the results to the calling program.
+
+
+7.1 Pseudocode for a KI Procedure
+
+    Consider the common case of reading a file on a remote host.  The file
+open procedure must connect to the KS on the remote host, command the remote
+kernel to open the file, and read back the status of the open.  Whether the
+file is on the local or remote node, a channel descriptor must be set up
+to tell the KI i/o primitives how to access the file.
+
+
+# KOPNBF -- KI version of ZOPNBF (open binary file).
+
+procedure kopnbf (osfn, mode, status)
+
+begin
+	ks = get_kernel_server (osfn)
+	if (ks is the local node)
+	    call zopnbf (osfn, mode, status)
+	else {
+	    encode KI instruction for zopnbf
+	    write instruction to KS
+	    read reply from KS
+	    if (error on channel to KS)
+		return (status=ERR)
+	}
+
+	set up channel descriptor (set channel codes of KS and file)
+end
+
+
+# GET_KERNEL_SERVER -- Return a channel to the kernel server controlling
+# a virtual filename.
+
+int procedure get_kernel_server (vfn)
+
+begin
+	extract node name from vfn
+	if (no node name given)
+	    return (0)
+	else if (node is already connected)
+	    return (node channel)
+	else {
+	    connect to the KS on the remote node
+	    save channel of node in channel table
+	    return (node channel)
+	}
+end
+
+
+# KARDBF -- KI version of ZARDBF (read from a binary file).  The read will not
+# be asynchronous if the file is resident on a remote node.  The size of a
+# transfer is not limited by the maximum block of the channel.
+
+procedure kardbf (chan, buf, maxchars, offset)
+
+begin
+	if (ks[chan] == 0)
+	    call zardbf (chan, buf, maxchars, offset)
+	else {
+	    encode KI instruction for ZARDBF
+	    write KI instruction to remote kernel server
+	    read back the KI header of the response
+
+	    if (read status ok and KI status for read ok) { 
+		transfer data from channel directly into callers buffer,
+		    in blocks no larger than the channel block size
+		save channel status for KAWTBF
+	    }
+	}
+end
+
+
+7.2 Data Structures
+
+    The data structures required by the kernel interface are small and are
+statically allocated.
+
+
+7.2.1 Host Name Table
+
+    The host name table (HNT) lists all of the hosts in the network which the
+KI can access, giving for each node the node filename of the kernel server
+process on that node, and a list of aliases (node names) for the node.
+The host name table is the text file "dev$hosts".  The format of the file
+is illustrated by the following example:
+
+
+	1!/iraf/lib/irafks.e		: 1 a vax1 aquila
+	2!/iraf/lib/irafks.e		: 2 b vax2 lyra
+	3!usr1\:[irafx.lib]irafks.exe	: 3   vax3 vela
+	5!/iraf/lib/irafks.e		: 5 c vax5 carina
+	6!usr1\:[irafx.lib]irafks.exe	: 6   vax6 draco
+	11!/iraf/lib/irafks.e		: 11  sun1 petunia
+
+
+The format of an entry in this table is "server ':' aliases", where "server"
+is a machine dependent, colon delimited string to be passed to the ZFIOKS
+driver, and where the aliases are a sequence of null delimited logical names
+by which the high level code or the user can refer to the nodes.  The first
+field, e.g., "server", is limited to 80 characters, the aliases to 8 characters
+(longer names will be silently truncated, either limit may be increased if
+necessary).  Up to 8 aliases may be specified.  The alias "0" will be
+automatically added to the alias list of the local node by the KI; this alias
+is used by the high level code to force a file to be accessed on the local node.
+The local node should also include as an alias the name returned by ZGHOST.
+The maximum number of nodes is a <config.h> parameter.  The entries may appear
+in any order.  
+
+
+7.2.2 Node Descriptor Table
+
+    For each entry in the host name table there is a corresponding entry in
+the node descriptor table (NDT).  The fields of the NDT are initialized
+when the first filename containing a node reference is processed.  When a
+kernel server is opened on a node the N_KSCHAN field is set to the channel
+code returned by the kernel server device driver.
+
+
+	int	n_nnodes		# number of nodes in table
+
+	struct node_descriptor {
+		int	n_kschan	# KS i/o channel or NULL
+		int	n_local		# set to YES for the local node
+		int	n_nalias	# number of aliases for this node
+		char	n_server[64]	# netname!process
+		char	n_alias[8,8]	# aliases
+	} ndt[MAX_NODES]
+
+
+Runtime node references are satisfied by searching the NDT for the specified
+alias.  If the referenced node is the local node a NULL channel number is
+returned.  If the N_KSCHAN field of the referenced node is null a kernel
+server is spawned and the channel number of the server returned.  If a kernel
+server is already connected mapping an alias into a channel number is very
+fast (compared to a file open).  Once a server is spawned it remains connected
+until the local process shuts down.
+
+
+7.2.3 Channel Descriptor Table
+
+    Each open file or connected subprocess requires one channel descriptor
+for each i/o channel or process id.  The K_KSCHAN field will contain NULL if
+the channel resides on the local node.  Channel descriptors are allocated at
+file or device open time or process connect time and are freed at close or
+disconnect time.  If the channel is connected to a kernel server, the K_OSCHAN
+and K_PID fields will contain the OS channel number or process id of the
+resource as returned by the kernel server on the remote node.
+
+	
+	struct channel_descriptor {
+		int	k_kschan	# KS channel (NULL if local node)
+		int	k_oschan	# OS channel number or PID
+		int	k_status	# status for the ZAWAIT call
+	} cdt[MAX_CHANNELS]
+
+
+7.3 KII Instruction Format
+
+    The kernel interface instruction format (KII) is the binary encoding of
+the data blocks sent to and received from the remote kernel server to execute
+a call to a kernel procedure.  This format is machine independent, i.e.,
+it is defined in a way that is independent of the byte ordering, char size,
+etc. used by a node.  The KII format provides a machine independent interface
+for the execution of all kernel subroutines as well as for text file i/o.
+Binary data blocks passed via the binary file i/o procedures are not affected,
+hence if a machine independent binary format is desired it must be implemented
+at a level higher than the KI.
+
+The KII format selected is a fixed format to simplify encode/decode and
+packet transfer (if the transfer medium is stream oriented fixed size packets
+are simpler to extract from the stream).  For media such as Ethernet
+performance depends more upon the number of packets transferred than upon
+the size of a packet, so there is little penalty for wasted space in a fixed
+size packet.  The maximum amount of information necessary to encode a kernel
+procedure call is limited (the argument lists are never large) hence it is
+easy to set an upper bound on the packet size.  The KII packet structure is
+shown below.
+	
+	struct kii_packet {
+		int	p_opcode	# instruction opcode
+		int	p_subcode	# subcode (for device drivers)
+		int	p_arg[13]	# procedure arguments
+		int	p_sbuflen	# nchars in string buffer
+		char	p_sbuf[255]	# string buffer
+	}
+
+	sizeof (struct kii_packet) == ((16*4)+256) == 320 bytes
+
+
+The OPCODE and SUBCODE fields identify the kernel procedure to be executed.
+Each procedure argument is passed in the corresponding field of the ARG array;
+for string arguments this field contains the offset of the string value in
+the P_SBUF field.  Procedure argument N is passed in field N of the ARG array.
+P_SBUFLEN is the number of chars in the string buffer, including the EOS at
+the end of each string.
+
+Before transmission of the packet over the net the packet is encoded in
+a machine independent form.  The 16 integer fields are converted into MII
+32 bit signed integer format, and the 256 character string buffer is packed
+one byte per character (only the first SBUFLEN characters are packed).  The
+inverse transformation is performed by the kernel server on the remote node
+before accessing the contents of the packet.
+
+Most kernel procedures return a status value and/or data.  The KII packet
+structure is used both to remotely execute a kernel procedure and to return
+the status value and any scalar or string output arguments.  In the case of
+text file i/o the text data is passed in the SBUF field.  Procedures which
+return a data structure (e.g., ZFINFO) may pass the data structure as a
+sequence of ARG array elements, encode the structure in chararacter form
+in SBUF, or pass the structure in a separate packet.  In most cases a single
+packet will be used for greater efficiency and to avoid the need to
+explicitly encode the return value.
+
+The purpose of the SUBCODE field is to exploit the fact that the text and
+binary file drivers each have the same set of driver procedures, each with
+the same set of arguments.  The OPCODE field identifies the device driver
+and the SUBCODE field the driver function, e.g., OPN, ARD, AWR, AWT, etc.
+
+
+8. KS Driver
+
+    Connecting and disconnecting kernel servers, and all i/o to connected
+kernel servers, is provided by the KS driver.  To the KI in the calling
+process a KS behaves like a synchronous binary file opened for readwrite
+access.  The driver is patterned after a binary file driver, allowing the
+server process to be connected to FIO as a streaming binary file.  Normally,
+however, the driver procedures will be called directly by the KI.
+
+
+	zopnks (server, mode, chan)
+	zawrks (chan, buf, nbytes, offset)
+	zardks (chan, buf, maxbytes, offset)
+	zawtks (chan, status)
+	zsttks (chan, what, lvalue)
+	zclsks (chan, status)
+
+
+The entry points of the KS driver are shown above.  The argument SERVER is
+the network pathname of the kernel server process, e.g., "2!/iraf/lib/ks.e".
+There no requirement, however, that the named process be a kernel server
+process.  The driver will attempt to execute and set up readwrite streaming
+i/o to any process, hence the KS driver may be useful for network functions
+other than the kernel interface.
+
+
+9. Kernel Server Process
+
+    The kernel server process is an IRAF process with a standard IRAF Main
+but a special ONENTRY procedure and no task dictionary (like the CL).
+The server communicates with a KI via the binary streams CLIN and CLOUT,
+both of which are connected to a single channel in the calling process.
+The server process contains an interpreter capable of calling any kernel
+procedure which does i/o.  In addition, the kernel server contains enough
+of FIO to map filenames and read and write CLIN and CLOUT.  
+
+
+10. Filename Mapping Details
+
+    The system interface procedures used for filename mapping must be trapped
+by the KI to deal with node pathnames.  The relevant procedures are the
+following:
+
+	zfnbrk		break vfn into its component parts
+	zfchdr		change directory
+	zfgcwd		get default directory
+	zfxdir		extract directory prefix
+	zfpath		convert vfn to pathname
+	zfsubd		fold subdirectory into pathname
+
+The first routine, ZFNBRK, merely parses filenames into their component fields
+and it should be possible for the same routine to be used on all nodes without
+help from the KI.  The remaining routines are fundamental to the action of
+the KI.
+
+
+10.1 Default Directory
+
+    Normally, either the kernel or the host system keeps track of the default
+directory.  This remains the case when the KI is in use, provided the default
+directory is on the local node.  If the default directory is changed to some
+different node the following actions are taken by the KI:
+
+    [1]	Extract node prefix and save in a KI common for use during filename
+	mapping.
+
+    [2] Execute ZFCHDR on the remote node (minus the node prefix) to set
+	the node-relative default directory.
+
+All subsequent runtime file references are mapped as follows:
+
+    [1]	The default node prefix is prepended to all filenames which do
+	not include an explicit node name prefix.
+
+    [2] Normal filename mapping is performed, i.e., filename mapping is
+	disabled on the local node (since the filename has a node prefix),
+	deferring mapping to the kernel server on the remote node.
+
+All normal runtime filename mapping starts with a call to ZFXDIR.  If ZFXDIR
+returns anything the filename is assumed to be host dependent and is not mapped.
+Hence we want ZFXDIR to return the entire VFN as if it were an OSDIR name,
+if the VFN includes a node prefix and the node referenced is not the local
+node.  ZFPATH and ZFSUBD must behave similarly.
+
+
+10.2 Semicode
+
+
+procedure kfchdr (osdir, status)
+
+begin
+	server = ki_connect (osdir)
+
+	if (server == NULL) {
+	    # Directory is on the local node.
+
+	    default node = local node
+	    call zfchdr (osdir_minus_node_prefix, status)
+
+	} else {
+	    # Directory is on a remote node.
+
+	    pass zfchdr request to remote node
+	    if (request is successful)
+		default node = remote node
+	}
+end
+
+
+procedure kfgcwd (osdir, nchars)
+
+begin
+	if (default node is the local node)
+	    call zfgcwd to get default directory
+	else
+	    pass zfgcwd request to remote node
+
+	return (default_node // default_directory)
+end
+
+
+procedure zfxdir (vfn, osdir, maxch, nchars)
+
+begin
+	extract node name
+
+	if (no node name specified)
+	    node name = default node
+
+	if (node is the local node)
+	    pass the request to the local kernel
+	else
+	    return (node // vfn)
+end
+
+
+procedure zfpath (vfn, pathname, maxch, nchars)
+
+begin
+	extract node name
+
+	if (no node name specified)
+	    node name = default node
+
+	if (node is the local node) {
+	    call zfpath to compute local pathname
+	    return (node // pathname)
+	} else
+	    return (node // vfn)
+end
+
+
+procedure zfsubd (osfn, maxch, subdir, nchars)
+
+begin
+	extract node name
+
+	if (no node name specified)
+	    node name = default node
+
+	if (node is the local node) {
+	    call zfsubd to compute local pathname
+	    return (node // pathname)
+	} else
+	    return (node // vfn // "subdir/")
+end
diff --git a/sys/ki/irafks.x b/sys/ki/irafks.x
new file mode 100644
index 00000000..7d4598b0
--- /dev/null
+++ b/sys/ki/irafks.x
@@ -0,0 +1,1590 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<finfo.h>
+include	<fset.h>
+include	<fio.h>
+include	<clset.h>
+include	<knet.h>
+include	"ki.h"
+
+# KSERVER.X -- The IRAF kernel server, used to serve up kernel functions on
+# a remote host.
+
+define	DEBUG_FILE	"/tmp/ks.out"	# MACHDEP
+#define	DEBUG_FILE	"iraftmp:ks.out"
+define	DEBUG		NO
+#define	DEBUG		YES
+
+define	DEF_LENIOBUF	32768		# reallocated if too small
+define	SZ_TXBUF	1024		# handy text buffer
+define	LEN_BFDRIVER	8		# actually 6, but 8 is a power of 2
+define	LEN_TXDRIVER	8		# no. entry points in tx driver
+define	MAX_BFDRIVERS	10		# max binary file devices
+define	MAX_TXDRIVERS	2		# max text file devices
+
+define	LEN_BFDD	(LEN_BFDRIVER*MAX_BFDRIVERS)
+define	LEN_TXDD	(LEN_TXDRIVER*MAX_TXDRIVERS)
+
+define	ZOPNTX		txdd[($1)]		# text files
+define	ZCLSTX		txdd[($1)+1]
+define	ZGETTX		txdd[($1)+2]
+define	ZPUTTX		txdd[($1)+3]
+define	ZFLSTX		txdd[($1)+4]
+define	ZSEKTX		txdd[($1)+5]
+define	ZNOTTX		txdd[($1)+6]
+define	ZSTTTX		txdd[($1)+7]
+
+define	ZOPNBF		bfdd[($1)]		# binary files
+define	ZCLSBF		bfdd[($1)+1]
+define	ZARDBF		bfdd[($1)+2]
+define	ZAWRBF		bfdd[($1)+3]
+define	ZAWTBF		bfdd[($1)+4]
+define	ZSTTBF		bfdd[($1)+5]
+
+
+# IRAFKS -- The main entry point of the iraf kernel server task.  The kernel
+# server program is not CL callable but is instead spawned by the OS to listen
+# listen on a socket.  The ONENTRY procedure gains control from the IRAF main
+# at process startup, before the in task interpreter is entered.  The t_irafks
+# procedure is never actually called by the interpreter as the TASK statement 
+# suggests.  The purpose of the task statement is to give us an IRAF main.
+
+task	irafks = t_irafks
+procedure t_irafks()
+begin
+end
+
+
+# ONENTRY -- The real task executed by the irafks.e executable.
+
+int procedure onentry (prtype, bkgfile, cmd)
+
+int	prtype			#I process type flag (not used)
+char	bkgfile[ARB]		#I bkgfilename if detached process (not used)
+char	cmd[ARB]		#I optional command (used to flag irafks type) 
+
+bool	error_restart
+int	debuginit, chan, junk
+char	osfn[SZ_PATHNAME], debugfile[SZ_PATHNAME]
+
+int	getpid(), open()
+data	error_restart /false/
+data	debuginit /DEBUG/
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	# Debug messages can be enabled either by compiling with DEBUG=YES
+	# or by running the kernel server with "-d debugfile" on the command
+	# line (a bit of a trick using the detached process syntax).
+
+	if (prtype == PR_DETACHED) {
+	    debug = YES
+	    call strcpy (bkgfile, debugfile, SZ_PATHNAME)
+	} else {
+	    debug = debuginit
+	    call strcpy (DEBUG_FILE, debugfile, SZ_PATHNAME)
+	}
+
+	# If an error occurs and we go through error restart, deadlock will
+	# probably occur as the client may be awaiting a status packet while
+	# upon restart we will be awaiting a command packet.  Hence if restart
+	# occurs, shut the kernel server down.
+
+	if (error_restart) {
+	    call zclsks (chan, junk)
+	    return (PR_EXIT)
+	} else
+	    error_restart = true
+
+	# Open the network connection to the host process.
+	call strpak (cmd, osfn, SZ_PATHNAME)
+	call zopnks (osfn, READ_WRITE, chan)
+
+	# Open the debug file if so indicated.  The value of the debug flag
+	# should be patched before execution with a debugger if debug output
+	# is desired.
+
+	if (debug == YES) {
+	    spy = open (debugfile, APPEND, TEXT_FILE)
+	    call fseti (spy, F_FLUSHNL, YES)
+
+	    call fprintf (spy, "[%d] -------------------------\n")
+		call pargi (getpid())
+	    call fprintf (spy, "server channel = %d\n")
+		call pargi (chan)
+	}
+
+	# Redirect the standard input and output of the kernel server task
+	# to the null file to prevent deadlock if the task unexpectedly
+	# reads or writes the standard input or output.
+
+	call fredir (STDIN,  "dev$null", READ_ONLY,  TEXT_FILE)
+	call fredir (STDOUT, "dev$null", WRITE_ONLY, TEXT_FILE)
+	call fredir (STDERR, "dev$null", WRITE_ONLY, TEXT_FILE)
+
+	# Serve up the kernel until EOF is seen on the input stream.
+	if (chan != ERR)
+	    call kserver (chan, chan, DEF_LENIOBUF)
+
+	# Exit w/o running interpreter.
+	call zclsks (chan, junk)
+	return (PR_EXIT)
+end
+
+
+# KSERVER -- Kernel server interpreter.  This procedure is called from the
+# kernel server program to interpret and execute (serve up) kernel instructions
+# issued by a remote host.  Execution terminates when EOF is seen on the input
+# channel.  All i/o is all low level since the level of function implemented
+# here is that of the iraf kernel.  This code executes in a private subprocess
+# hence we need not worry about memory usage or reentrancy.
+#
+# NOTE -- Avoid passing packet data to subprocedures, since the kernel
+# procedures called directly or indirectly by this code may themselves use
+# the local KII packet data structure.
+
+procedure kserver (in, out, buflen)
+
+int	in		# input channel, a binary stream
+int	out		# output channel, a binary stream
+int	buflen		# iobuf size or 0
+
+pointer	iobuf, op, top
+long	fi[LEN_FINFO]
+char	curdir[SZ_PATHNAME]
+int	len_iobuf, status, i, nchars, opcode, subcode, arg1, arg2, arg3
+int	bfdd[LEN_BFDD], txdd[LEN_TXDD]
+
+char	txbuf[SZ_TXBUF], queue[SZ_FNAME]
+char	osfn1[SZ_PATHNAME], osfn2[SZ_PATHNAME], temp[SZ_PATHNAME]
+char	o_str[SZ_LINE], s_str[SZ_LINE]
+int	ks_receive(), ks_send(), strlen(), envscan()
+int	diropen(), gstrcpy(), getline()
+include	"kii.com"
+errchk	ks_error
+define	reply_ 91
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	if (debug == YES) {
+	    call fprintf (spy, "start kernel server, in=%d, out=%d\n")
+		call pargi (in)
+		call pargi (out)
+	}
+
+	# Allocate a buffer for read and write requests on a channel.  We always
+	# transfer data immediately, before accepting another request, hence
+	# the same buffer may be reused for all requests.
+
+	if (buflen > 0)
+	    len_iobuf = buflen / SZB_CHAR
+	else
+	    len_iobuf = DEF_LENIOBUF / SZB_CHAR
+	call malloc (iobuf, len_iobuf, TY_CHAR)
+
+	if (debug == YES) {
+	    call fprintf (spy, "kernel server, len_iobuf=%d\n")
+		call pargi (len_iobuf)
+	}
+
+	# Load the device drivers.
+	call ks_loadbf (bfdd)
+	call ks_loadtx (txdd)
+
+	# Initialize our record of the current working directory.
+	curdir[1] = EOS
+
+	# Enter the main interpreter loop of the kernel server, reading and
+	# processing kernel requests from the host until EOF is seen.  The
+	# host is completely in control.  Kernel requests are passed to the
+	# local kernel (or to yet another kernel server) unchanged except
+	# for filenames, which must be mapped in the context of the local
+	# machine.
+
+	while (ks_receive (in) > 0) {
+	    opcode  = p_opcode
+	    subcode = p_subcode
+	    arg1    = p_arg[1]
+	    arg2    = p_arg[2]
+	    arg3    = p_arg[3]
+
+	    p_sbuflen = 0
+
+	    if (debug == YES) {
+		call  ks_op2str (opcode, subcode, o_str, s_str)
+		if (opcode < KI_ZFIOBF) {
+		    call fprintf (spy, "opcode=%s, arg[] =")
+		        call pargstr (o_str)
+		} else {
+		    call fprintf (spy, "opcode=%s), subcode=%s, arg[] =")
+		        call pargstr (o_str)
+		        call pargstr (s_str)
+		}
+		do i = 1, 10 {
+		    call fprintf (spy, " %d")
+		    call pargi (p_arg[i])
+		}
+		call fprintf (spy, "\n")
+	    }
+
+	    switch (opcode) {
+	    case KI_ENVINIT:
+		# Called shortly after process startup to pass the environment
+		# list to the kernel server (req'd for filename mapping).
+		# May also be called after process startup to add entries to
+		# the environment list.  Note that the kernel server process,
+		# since it is an IRAF process, will have read the zzsetenv.def
+		# file to define the standard variables during process startup,
+		# but the client must transmit its environment list anyhow to
+		# set the values of any newly defined variables.
+
+		# Get the packed environment list string.  If this is small
+		# it is sent in the packet string buffer, otherwise the data
+		# follows in a separate record.
+
+		nchars = arg1
+		if (nchars <= SZ_SBUF)
+		    status = envscan (p_sbuf)
+		else {
+		    if (len_iobuf < nchars) {
+			call realloc (iobuf, nchars, TY_CHAR)
+			len_iobuf = nchars
+		    }
+
+		    call zardks (in, Memc[iobuf], nchars, long(0))
+		    call zawtks (in, status)
+		    if (status != nchars)
+			break
+
+		    # Unpack it and process it into the symbol table.
+		    call strupk (Memc[iobuf], Memc[iobuf], nchars)
+		    status = envscan (Memc[iobuf])
+		}
+
+		if (debug == YES) {
+		    call fprintf (spy, "%d environment entries scanned\n")
+			call pargi (status)
+		}
+
+		# Do not send a status packet back for single variable updates.
+		if (nchars < SZ_SBUF)
+		    next
+		else if (status < 0)
+		    break
+
+		# The environment variables HOST, IRAF, and TMP may differ
+		# from node to node.  The ZGTENV primitive in the local
+		# kernel will pick up the local values of these variables
+		# from the HSI global include file <iraf.h>.  This happens
+		# automatically if the variables are not defined in the
+		# environment list.  The simplest way to keep them out of
+		# the environment list is to exclude them from the list when
+		# it is composed by ki_openks() on the client node, so we
+		# do not have to do anything here.
+
+	    case KI_SETROOT:
+		# Called to set the pathname of the root iraf directory on
+		# the local node.  This need not be the same as on the client
+		# node hence we must override the definition of "iraf" in the
+		# environment list.  We are passed the OS pathname of the
+		# server process (i.e., this process) which is assumed to be
+		# resident in iraf$lib on the current node.  The pathname of
+		# iraf$ is therefore obtained by a call to ZFXDIR followed by
+		# a call to ZFSUBD with subdirectory "..".
+
+		# NOTE -- This function is obsoleted by the above code which
+		# sets the values of HOST, IRAF, and TMP from <iraf.h>.  Leave
+		# it in for a while nonetheless, just in case it is called.
+
+		call strcpy (p_sbuf[arg1], osfn1, SZ_PATHNAME)
+		call zfxdir (osfn1, osfn2, SZ_PATHNAME, nchars)
+		call zfsubd (osfn2, SZ_PATHNAME, "..", nchars)
+		call strcpy ("set iraf=", osfn1, SZ_PATHNAME)
+		call strcat (osfn2, osfn1, SZ_PATHNAME)
+
+		status = envscan (osfn1)
+
+		if (debug == YES) {
+		    call fprintf (spy, "%s\n")
+			call pargstr (osfn1)
+		}
+
+		if (status < 1)
+		    break
+
+	    case KI_FMAPFN:
+		# Map a filename in the context of the server node.
+		call strcpy (p_sbuf[arg1], osfn1, SZ_PATHNAME)
+		iferr (call ks_fmapfn (osfn1, temp, SZ_PATHNAME))
+		    status = ERR
+		else {
+		    call strupk (temp, p_sbuf, SZ_SBUF)
+		    p_sbuflen = strlen (p_sbuf)
+		    status = p_sbuflen
+		}
+
+	    case KI_ZFACSS:
+		# Test file accessibility and/or type.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfacss (osfn1, arg2, arg3, status)
+
+	    case KI_ZFALOC:
+		# Preallocate space for a file.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfaloc (osfn1, arg2, status)
+
+	    case KI_ZFCHDR:
+		# Change the default directory.
+
+		if (debug == YES) {
+		    call fprintf (spy, "change directory to `%s'\n")
+			call pargstr (p_sbuf[arg1])
+		}
+
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfchdr (osfn1, status)
+
+		# Save the logical name of the new default directory, but only
+		# if the zfchdr request is successful.
+
+		if (status != ERR)
+		    call strcpy (temp, curdir, SZ_PATHNAME)
+
+	    case KI_ZFDELE:
+		# Delete a file.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfdele (osfn1, status)
+
+	    case KI_ZFGCWD:
+		# Get the name of the current default directory.  Return the
+		# unmapped name rather than the mapped OSFN because the client
+		# deals with unmapped pathnames when the file resides on a
+		# remote node.
+
+		if (curdir[1] == EOS) {
+		    call zfgcwd (osfn1, SZ_PATHNAME, status)
+		    call strupk (osfn1, p_sbuf, SZ_SBUF)
+		} else
+		    status = gstrcpy (curdir, p_sbuf, SZ_SBUF)
+
+		p_arg[2] = 1
+		p_sbuflen = strlen (p_sbuf)
+
+	    case KI_ZFINFO:
+		# Get directory info for a file.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfinfo (osfn1, fi, status)
+
+		if (status != ERR) {
+		    # Return the integer part of the FI structure in args 2+.
+		    do i = 1, LEN_FINFO
+			p_arg[i+1] = fi[i]
+
+		    # Return the owner string in the string buffer.
+		    call strupk (FI_OWNER(fi), p_sbuf, SZ_SBUF)
+		    p_sbuflen = strlen (p_sbuf)
+		}
+
+	    case KI_ZFMKCP:
+		# Make a null length copy of a file.
+		iferr {
+		    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn1, SZ_PATHNAME)
+		    call strcpy (p_sbuf[arg2], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn2, SZ_PATHNAME)
+		} then {
+		    status = ERR
+		} else
+		    call zfmkcp (osfn1, osfn2, status)
+
+	    case KI_ZFMKDR:
+		# Make a new directory.
+		iferr {
+		    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn1, SZ_PATHNAME)
+		} then {
+		    status = ERR
+		} else
+		    call zfmkdr (osfn1, status)
+
+	    case KI_ZFPROT:
+		# Set or query file protection.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else
+		    call zfprot (osfn1, arg2, status)
+
+	    case KI_ZFRNAM:
+		# Rename a file.
+		iferr {
+		    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn1, SZ_PATHNAME)
+		    call strcpy (p_sbuf[arg2], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn2, SZ_PATHNAME)
+		} then {
+		    status = ERR
+		} else
+		    call zfrnam (osfn1, osfn2, status)
+
+	    case KI_ZFRMDR:
+		# Remove a directory.
+		iferr {
+		    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn1, SZ_PATHNAME)
+		} then {
+		    status = ERR
+		} else
+		    call zfrmdr (osfn1, status)
+
+	    case KI_ZDVALL:
+		# Allocate or deallocate a device.
+		if (debug == YES) {
+		    call fprintf (spy, "allocate `%s' flag=%d\n")
+			call pargstr (p_sbuf[arg1])
+			call pargi (arg2)
+		}
+		call strpak (p_sbuf[arg1], temp, SZ_PATHNAME)
+		call zdvall (temp, arg2, status)
+
+	    case KI_ZDVOWN:
+		# Query device allocation.
+		call strpak (p_sbuf[arg1], osfn1, SZ_PATHNAME)
+		call zdvown (osfn1, temp, SZ_PATHNAME, status)
+		call strupk (temp, p_sbuf, SZ_SBUF)
+		p_sbuflen = strlen (p_sbuf)
+
+            case KI_ZFUTIM:
+                # Update thje file modify time.
+                call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+                if (debug == YES) {
+                    call fprintf (spy, "utime `%s' atime=%d mtime=%d\n")
+                        call pargstr (temp)
+                        call pargi (arg2)
+                        call pargi (arg3)
+                }
+                iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+                    status = ERR
+                else
+                    call zfutim (osfn1, arg2, arg3, status)
+
+	    case KI_ZOPDIR:
+		# Open a directory for reading.  Since we must perform the
+		# inverse mapping we use the high level DIROPEN package
+		# rather than call the kernel directly.
+
+		if (debug == YES) {
+		    call fprintf (spy, "open directory `%s', mode %d\n")
+			call pargstr (p_sbuf[arg1])
+			call pargi (arg2)
+		}
+
+		call strcpy (p_sbuf[arg1], osfn1, SZ_PATHNAME)
+		iferr (status = diropen (osfn1, arg2))
+		    status = ERR
+
+		if (debug == YES) {
+		    call fprintf (spy, "diropen returns %d\n")
+			call pargi (status)
+		}
+
+	    case KI_ZCLDIR:
+		# Close a directory file.
+
+		iferr (call close (arg1))
+		    status = ERR
+		else
+		    status = OK
+
+	    case KI_ZGFDIR:
+		# Get the next filename from a directory.  To reduce traffic
+		# on the net we return many filenames at once.  The reverse
+		# mapping must be performed locally, returning VFN's to the
+		# client process.
+
+		top = iobuf + min (len_iobuf, arg2)
+		op  = iobuf
+
+		# Fill the output buffer.  Set argument 2 to 1 if EOF is seen
+		# on the directory.
+
+		arg2 = 1
+		iferr {
+		    while (getline (arg1, Memc[op]) != EOF) {
+			op = op + strlen (Memc[op])
+			if (op + SZ_FNAME >= top) {
+			    arg2 = 0
+			    break
+			}
+		    }
+		} then {
+		    status = ERR
+		    p_arg[2] = arg2
+		    goto reply_
+		}
+
+		# If the data is small enough return it in the string buffer,
+		# else return it as a second record.
+
+		nchars = op - iobuf
+		if (nchars <= SZ_SBUF) {
+		    call amovc (Memc[iobuf], p_sbuf, nchars)
+		    p_sbuflen = nchars
+		    status = nchars
+		    # goto reply_
+
+		} else {
+		    p_arg[1] = nchars
+		    if (ks_send (out, opcode, subcode) == ERR)
+			return
+
+		    call chrpak (Memc[iobuf], 1, Memc[iobuf], 1, nchars)
+		    call zawrks (out, Memc[iobuf], nchars, long(0))
+		    call zawtks (out, status)
+		    if (status <= 0)
+			return
+		    
+		    next
+		}
+
+	    case KI_ZOSCMD:
+		# Issue a command to the local host command interpreter.
+		# Spool the output in a file and return the name of the
+		# file to the client so that it can recover the output via
+		# the text file i/o interface.
+
+		call strpak (p_sbuf[arg1], txbuf, SZ_TXBUF)
+		call strpak ("", osfn1, SZ_PATHNAME)
+		call mktemp ("tmp$zos", temp, SZ_PATHNAME)
+		call ks_fmapfn (temp, osfn2, SZ_PATHNAME)
+
+		call zoscmd (txbuf, osfn1, osfn2, osfn2, status)
+
+		call strupk (osfn2, p_sbuf, SZ_SBUF)
+		p_sbuflen = strlen (p_sbuf)
+
+	    case KI_ZOPDPR:
+		# Open a detached process (submit bkg job).
+		iferr {
+		    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn1, SZ_PATHNAME)
+		    call strcpy (p_sbuf[arg2], temp, SZ_PATHNAME)
+		    call ks_fmapfn (temp, osfn2, SZ_PATHNAME)
+		    call strcpy (p_sbuf[arg3], queue, SZ_FNAME)
+		} then {
+		    status = ERR
+		} else
+		    call zopdpr (osfn1, osfn2, queue, status)
+
+	    case KI_ZCLDPR:
+		# Close a detached process.
+		call zcldpr (arg1, arg2, status)
+
+	    case KI_ZOPCPR:
+		# Open a connected subprocess.
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn1, SZ_PATHNAME))
+		    status = ERR
+		else {
+		    call zopcpr (osfn1, arg2, arg3, status)
+		    p_arg[2] = arg2
+		    p_arg[3] = arg3
+		}
+
+	    case KI_ZCLCPR:
+		# Close a connected subprocess.
+		call zclcpr (arg1, status)
+
+	    case KI_ZINTPR:
+		# Interrupt a connected subprocess.
+		call zintpr (arg1, arg2, status)
+
+	    case KI_ZFIOBF,KI_ZFIOLP,KI_ZFIOPL,KI_ZFIOPR,KI_ZFIOSF,KI_ZFIOGD:
+		# Binary file drivers.
+		iferr (call ks_zfiobf (in, out, iobuf, len_iobuf, bfdd))
+		    break
+		else
+		    next
+
+	    case KI_ZFIOTX, KI_ZFIOTY:
+		# Text file drivers.
+		iferr (call ks_zfiotx (in, out, iobuf, len_iobuf, txdd))
+		    break
+		else
+		    next
+
+	    case KI_ZFIOMT:
+		# Magtape driver.
+		iferr (call ks_zfiomt (in, out, iobuf, len_iobuf))
+		    break
+		else
+		    next
+
+	    default:
+		# If we receive an illegal opcode on the channel shut the
+		# server down immediately, as communications have almost
+		# certainly been irrecoverably corrupted.  We should probably
+		# go one step further and compute a checksum on the packet
+		# header.
+
+		call ks_error (opcode, "illegal opcode on channel")
+	    }
+
+	    # Transmit response packet back to host.  Shutdown if there is
+	    # an i/o error on the socket.
+reply_
+	    if (debug == YES) {
+		call fprintf (spy, "status = %d\n")
+		    call pargi (status)
+		call flush (spy)
+	    }
+
+	    p_arg[1] = status
+	    if (ks_send (out, opcode, subcode) == ERR)
+		break
+	}
+
+	call mfree (iobuf, TY_CHAR)
+
+	if (debug == YES) {
+	    call fprintf (spy, "kernel server, normal exit\n")
+	    call flush (spy)
+	}
+end
+
+
+# KS_ZFIOBF -- I/O to the class of binary file devices.  The i/o request is
+# passed in the KII common (unpacked packet from the host via the network).
+
+procedure ks_zfiobf (in, out, iobuf, len_iobuf, bfdd)
+
+int	in, out			# input and output channels to host
+pointer	iobuf			# scratch i/o buffer
+int	len_iobuf		# current length of buffer
+int	bfdd[ARB]		# loaded device drivers
+
+long	lval, ks_maxbufsize
+int	dd, status, nchars, arg1, arg2, arg3
+char	osfn[SZ_PATHNAME], temp[SZ_PATHNAME]
+errchk	realloc
+int	ks_send()
+include	"kii.com"
+define	fatal_ 91
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	# Determine the table offset of the device driver in the table of all
+	# loaded binary file device drivers.  The device driver opcodes are
+	# assigned sequentially and KI_ZFIOBF is always first.
+
+	dd = (p_opcode - KI_ZFIOBF) * LEN_BFDRIVER + 1
+
+	# Make sure the iobuffer is large enough.  If a large enough buffer
+	# cannot be allocated something is very wrong and the server shuts
+	# down.
+
+	if (p_subcode == BF_ARD || p_subcode == BF_AWR) {
+	    nchars = (p_arg[2] + SZB_CHAR-1) / SZB_CHAR
+	    if (len_iobuf < nchars) {
+		call realloc (iobuf, nchars, TY_CHAR)
+		len_iobuf = nchars
+	    }
+	}
+
+	arg1 = p_arg[1]
+	arg2 = p_arg[2]
+	arg3 = p_arg[3]
+
+	switch (p_subcode) {
+	case BF_OPN:
+	    # Open a binary file.
+
+	    if (debug == YES) {
+		call fprintf (spy, "open binary file `%s', mode %d\n")
+		    call pargstr (p_sbuf[arg1])
+		    call pargi (arg2)
+	    }
+
+	    # Do not map the filename strings of special devices, since the
+	    # syntax of such strings may bear no resemblance to that of an
+	    # ordinary filename.
+
+	    status = OK
+	    if (p_opcode == KI_ZFIOBF) {
+		call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+		iferr (call ks_fmapfn (temp, osfn, SZ_PATHNAME))
+		    status = ERR
+	    } else
+		call strpak (p_sbuf[arg1], osfn, SZ_PATHNAME)
+
+	    if (status != ERR)
+		call zcall3 (ZOPNBF(dd), osfn, arg2, status)
+
+	case BF_CLS:
+	    # Close a binary file.
+
+	    if (debug == YES) {
+		call fprintf (spy, "close %d\n")
+		    call pargi (arg1)
+	    }
+
+	    call zcall2 (ZCLSBF(dd), arg1, status)
+
+	case BF_ARD:
+	    # Read from a binary file.  The read must be performed in one
+	    # operation to preserve the record size.  Overlapped i/o is
+	    # provided by the dual process nature of the read; the actual
+	    # device read is not performed asynchronously since we must
+	    # complete each request before processing the next one.
+
+	    if (debug == YES) {
+		call fprintf (spy, "aread (%d, %d, %d)\n")
+		    call pargi (arg1)
+		    call pargi (arg2)
+		    call pargi (arg3)
+	    }
+
+	    # Read the data.
+	    call zcall4 (ZARDBF(dd), arg1, Memc[iobuf], arg2, arg3)
+	    call zcall2 (ZAWTBF(dd), arg1, status)
+
+	    # Send the ZAWT packet to the host followed by the data block.
+	    # The next operation performed by the host on the channel MUST
+	    # be completion of the i/o transfer, but the host can go off and
+	    # do other things before completing the transfer.
+
+	    p_arg[1] = status
+	    if (ks_send (out, p_opcode, BF_AWT) == ERR)
+		goto fatal_
+	    if (status > 0) {
+		call zawrks (out, Memc[iobuf], status, 0)
+		call zawtks (out, status)
+		if (status <= 0)
+		    goto fatal_
+	    }
+
+	    if (debug == YES) {
+		call fprintf (spy, "status %d\n")
+		    call pargi (status)
+	    }
+
+	    return
+
+	case BF_AWR:
+	    # Write to a binary file.  For maximum performance the write
+	    # operation is half duplex, i.e., the ZAWT operation is ignored
+	    # for writes to a binary file over the network.  If a write
+	    # error occurs when writing to the physical device we shutdown
+	    # the entire kernel process, causing a FIO write error in the
+	    # host if the next kernel server operation is another write to
+	    # the same channel.  This may cause ficticious i/o errors on
+	    # other channels as well, but the performance gain is worth it.
+
+	    if (debug == YES) {
+		call fprintf (spy, "awrite (%d, %d, %d)\n")
+		    call pargi (arg1)
+		    call pargi (arg2)
+		    call pargi (arg3)
+	    }
+
+	    # Read the data from the host.
+	    call zardks (in, Memc[iobuf], arg2, 0)
+	    call zawtks (in, status)
+	    if (debug == YES) {
+		call fprintf (spy, "read net status %d\n")
+		    call pargi (status)
+	    }
+	    if (status != arg2)
+		goto fatal_
+
+	    # Write the data to the output device.
+	    # TODO - delay the call to zawtbf to overlap i/o even further.
+
+	    call zcall4 (ZAWRBF(dd), arg1, Memc[iobuf], arg2, arg3)
+	    call zcall2 (ZAWTBF(dd), arg1, status)
+	    if (debug == YES) {
+		call fprintf (spy, "write device status %d\n")
+		    call pargi (status)
+	    }
+	    if (status != arg2)
+		goto fatal_
+
+	    return
+
+	case BF_AWT:
+	    # Wait for i/o on the device channel.  Not implemented as a
+	    # discreen kernel server operation.
+
+	    status = ERR
+
+	case BF_STT:
+	    # Get channel status.
+	    call zcall3 (ZSTTBF(dd), arg1, arg2, lval)
+
+	    # The max transfer size for a binary device is limited by the
+	    # network interface as well as the device.
+
+	    if (arg2 == FSTT_MAXBUFSIZE || arg2 == FSTT_OPTBUFSIZE) {
+		call zsttks (out, FSTT_MAXBUFSIZE, ks_maxbufsize)
+		if (lval == 0)
+		    lval = ks_maxbufsize
+		else if (ks_maxbufsize > 0)
+		    lval = min (ks_maxbufsize, lval)
+	    }
+	    status = lval
+
+	default:
+	    status = ERR
+	}
+
+	# Return a status packet to the host if the operation was not a read
+	# or a write.
+
+	if (debug == YES) {
+	    call fprintf (spy, "status %d\n")
+		call pargi (status)
+	}
+
+	p_arg[1] = status
+	if (ks_send (out, p_opcode, p_subcode) != ERR)
+	    return
+
+fatal_
+	call ks_error (1, "kernel server binary file i/o error")
+end
+
+
+# KS_ZFIOTX -- I/O to the class of text file devices.  The i/o request is
+# passed in the KII common (unpacked packet from the host via the network).
+# Text file i/o is buffered by the KI, reading and writing an integral
+# number of full lines of text in each transfer.
+
+procedure ks_zfiotx (in, out, iobuf, len_iobuf, txdd)
+
+int	in, out			# input and output channels to host
+pointer	iobuf			# scratch i/o buffer (not used)
+int	len_iobuf		# current length of buffer (not used)
+int	txdd[ARB]		# loaded device drivers
+
+long	lval, reclen
+bool	buffer_full
+pointer	rp, nextrec
+char	osfn[SZ_PATHNAME], temp[SZ_PATHNAME]
+int	dd, status, maxch, nchars, arg1, arg2, arg3
+
+int	ks_send()
+long	ki_decode()
+include	"kii.com"
+define	fatal_ 91
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	# Determine the table offset of the device driver in the table of all
+	# loaded text file device drivers.  The device driver opcodes are
+	# assigned sequentially and KI_ZFIOTX is always first.
+
+	dd = (p_opcode - KI_ZFIOTX) * LEN_TXDRIVER + 1
+
+	arg1 = p_arg[1]
+	arg2 = p_arg[2]
+	arg3 = p_arg[3]
+
+	switch (p_subcode) {
+	case TX_OPN:
+	    # Open a text file.
+
+	    if (debug == YES) {
+		call fprintf (spy, "open text file `%s', mode %d\n")
+		    call pargstr (p_sbuf[arg1])
+		    call pargi (arg2)
+	    }
+
+	    call strcpy (p_sbuf[arg1], temp, SZ_PATHNAME)
+	    iferr (call ks_fmapfn (temp, osfn, SZ_PATHNAME))
+		status = ERR
+	    else
+		call zcall3 (ZOPNTX(dd), osfn, arg2, status)
+
+	case TX_CLS:
+	    # Close a binary file.
+
+	    if (debug == YES) {
+		call fprintf (spy, "close text file %d\n")
+		    call pargi (arg1)
+	    }
+
+	    call zcall2 (ZCLSTX(dd), arg1, status)
+
+	case TX_GET:
+	    # Read from a text file.  If the device is an ordinary text file
+	    # (device TX) read as many lines of maximum size SZ_LINE as will
+	    # fit in the output buffer.  If the device is a terminal return
+	    # a single line in each call.  Each line is returned as a record
+	    # with the record length and seek offset of the line included
+	    # in the record header (buffering complicates the ZNOTTX function).
+
+	    if (debug == YES) {
+		call fprintf (spy, "gettx %d\n")
+		    call pargi (arg1)
+	    }
+
+	    rp = iobuf
+
+	    repeat {
+		maxch = min (arg2, SZ_LINE)
+		call zcall2 (ZNOTTX(dd), arg1, lval)
+		call zcall4 (ZGETTX(dd), arg1, Memc[R_DATA(rp)],
+		    maxch, status)
+
+		if (status >= 0) {
+		    reclen = R_GETRECLEN (status)
+		    call ki_encode (reclen, R_RECLEN(rp), NCHARS_INT)
+		    call ki_encode (lval,   R_SEKOFF(rp), NCHARS_LONG)
+		    
+		    rp = rp + reclen
+		}
+
+		nextrec = rp + R_GETRECLEN (SZ_LINE)
+		buffer_full = (nextrec - iobuf > arg2)
+
+	    } until (p_opcode != KI_ZFIOTX || status <= 0 || buffer_full)
+
+	    # If the data record is small enough to fit in the packet string
+	    # buffer, return it in the packet, else return it as a second
+	    # record following the packet.
+
+	    if (status == ERR)
+		nchars = ERR
+	    else if (status == EOF && rp == iobuf)
+		nchars = EOF
+	    else {
+		nchars = rp - iobuf
+		if (nchars <= SZ_SBUF) {
+		    call amovc (Memc[iobuf], p_sbuf, nchars)
+		    p_sbuflen = nchars
+		}
+	    }
+
+	    p_arg[1] = nchars
+	    if (ks_send (out, p_opcode, p_subcode) == ERR)
+		goto fatal_
+
+	    if (nchars > SZ_SBUF) {
+		call chrpak (Memc[iobuf], 1, Memc[iobuf], 1, nchars)
+		call zawrks (out, Memc[iobuf], nchars, long(0))
+		call zawtks (out, status)
+		if (status != nchars)
+		    goto fatal_
+	    }
+
+	    return
+
+	case TX_PUT:
+	    # Put a block of data to a text file.  If the block is larger than
+	    # the packet string buffer it is passed as a second record following
+	    # the packet.
+
+	    nchars = arg2
+	    if (nchars <= SZ_SBUF)
+		call zcall4 (ZPUTTX(dd), arg1, p_sbuf, nchars, status)
+	    else {
+		call zardks (in, Memc[iobuf], nchars, long(0))
+		call zawtks (in, status)
+		if (status != nchars)
+		    goto fatal_
+
+		call chrupk (Memc[iobuf], 1, Memc[iobuf], 1, nchars)
+		call zcall4 (ZPUTTX(dd), arg1, Memc[iobuf], nchars, status)
+	    }
+
+	    # If an error occurs writing to a text file close the kernel
+	    # server itself down, rather than handshaking on each packet.
+
+	    if (status == ERR)
+		goto fatal_
+
+	    return
+
+	case TX_FLS:
+	    # Flush text file output.
+	    call zcall2 (ZFLSTX(dd), arg1, status)
+
+	case TX_SEK:
+	    # Seek on a text file.
+	    lval = ki_decode (p_sbuf, NCHARS_LONG)
+	    call zcall3 (ZSEKTX(dd), arg1, lval, status)
+
+	case TX_NOT:
+	    # Note the file position of a text file.  The seek offset is
+	    # returned encoded as a char sequence in the string buffer to
+	    # avoid problems with integer precision.
+
+	    call zcall2 (ZNOTTX(dd), arg1, lval)
+	    call ki_encode (lval, p_sbuf, NCHARS_LONG)
+	    p_sbuflen = NCHARS_LONG
+	    status = lval
+
+	case TX_STT:
+	    # Get channel status.
+
+	    call zcall3 (ZSTTTX(dd), arg1, arg2, lval)
+	    call ki_encode (lval, p_sbuf, NCHARS_LONG)
+	    p_sbuflen = NCHARS_LONG
+	    status = lval
+
+	default:
+	    status = ERR
+	}
+
+	# Return a status/data packet to the host if the subcode did not
+	# specify the get or put function.
+
+	if (debug == YES) {
+	    call fprintf (spy, "status %d\n")
+	    call pargi (status)
+	}
+
+	p_arg[1] = status
+	if (ks_send (out, p_opcode, p_subcode) != ERR)
+	    return
+
+fatal_
+	call ks_error (1, "kernel server text file i/o error")
+end
+
+
+# KS_ZFIOMT -- I/O to the magtape device.  The i/o request is passed in
+# the KII common (unpacked packet from the host via the network).
+
+procedure ks_zfiomt (in, out, iobuf, len_iobuf)
+
+int	in, out			# input and output channels to host
+pointer	iobuf			# scratch i/o buffer
+int	len_iobuf		# current length of buffer
+
+long	lval
+int	status, nchars, mode, dc_off, dc_len
+int	newfile, arg[MAX_ARGS]
+char	drive[SZ_FNAME]
+errchk	realloc
+include	"kii.com"
+int	ks_send()
+define	fatal_ 91
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	call amovi (p_arg, arg, MAX_ARGS)
+
+	# Make sure the iobuffer is large enough.  If a large enough buffer
+	# cannot be allocated something is very wrong and the server shuts
+	# down.
+
+	if (p_subcode == MT_RD || p_subcode == MT_WR) {
+	    nchars = (arg[2] + SZB_CHAR-1) / SZB_CHAR
+	    if (len_iobuf < nchars) {
+		call realloc (iobuf, nchars, TY_CHAR)
+		len_iobuf = nchars
+	    }
+	}
+
+	switch (p_subcode) {
+	case MT_OP:
+	    # Open a magtape device.
+
+	    mode = arg[2]
+	    dc_off = arg[3]
+	    dc_len = arg[4]
+	    newfile = arg[5]
+
+	    # Get the device name string.
+	    call strpak (p_sbuf[arg[1]], drive, SZ_PATHNAME)
+
+	    # Get the devcap string.
+	    if (dc_len > 0 && dc_off == 0) {
+		call zardks (in, Memc[iobuf], dc_len+1, 0)
+		call zawtks (in, status)
+		if (status != dc_len + 1)
+		    goto fatal_
+	    } else
+		call strpak (p_sbuf[dc_off], Memc[iobuf], len_iobuf)
+
+	    if (debug == YES) {
+		call fprintf (spy,
+		    "open magtape device `%s', mode=%d, file=%d, devcap=`%s'\n")
+		    call pargstr (p_sbuf[arg[1]])
+		    call pargi (mode)
+		    call pargi (newfile)
+
+		    call strupk (Memc[iobuf], Memc[iobuf], len_iobuf)
+		    call pargstr (Memc[iobuf])
+		    call strpak (Memc[iobuf], Memc[iobuf], len_iobuf)
+	    }
+
+	    call zzopmt (drive, mode, Memc[iobuf], arg[6], newfile, status)
+	    p_arg[2] = newfile
+
+	case MT_CL:
+	    # Close a binary file.
+	    call zzclmt (arg[1], p_arg[2], status)
+
+	case MT_RD:
+	    # Read from a magtape file.  The read must be performed in one
+	    # operation to preserve the record size.  Overlapped i/o is
+	    # provided by the dual process nature of the read; the actual
+	    # device read is not performed asynchronously since we must
+	    # complete each request before processing the next one.
+
+	    # Read the data.
+	    call zzrdmt (arg[1], Memc[iobuf], arg[2], arg[3])
+	    call zzwtmt (arg[1], p_arg[2], status)
+
+	    # Send the ZAWT packet to the host followed by the data block.
+	    # The next operation performed by the host on the channel MUST
+	    # be completion of the i/o transfer, but the host can go off and
+	    # do other things before completing the transfer.
+
+	    p_arg[1] = status
+	    if (ks_send (out, p_opcode, MT_WT) == ERR)
+		goto fatal_
+	    if (status > 0) {
+		call zawrks (out, Memc[iobuf], status, 0)
+		call zawtks (out, status)
+		if (status <= 0)
+		    goto fatal_
+	    }
+
+	    return
+
+	case MT_WR:
+	    # Write to a magtape file.  For maximum performance the write
+	    # operation is half duplex, i.e., the ZAWT operation is ignored
+	    # for writes to a binary file over the network.  If a write
+	    # error occurs when writing to the physical device we shutdown
+	    # the entire kernel process, causing a FIO write error in the
+	    # host if the next kernel server operation is another write to
+	    # the same channel.  This may cause ficticious i/o errors on
+	    # other channels as well, but the performance gain is worth it.
+
+	    # Read the data from the host.
+	    call zardks (in, Memc[iobuf], arg[2], 0)
+	    call zawtks (in, status)
+	    if (status != arg[2])
+		goto fatal_
+
+	    # Write the data to the output device.
+	    # TODO - delay the call to zawtbf to overlap i/o even further.
+
+	    call zzwrmt (arg[1], Memc[iobuf], arg[2], arg[3])
+	    call zzwtmt (arg[1], p_arg[2], status)
+	    if (status != arg[2])
+		goto fatal_
+
+	    return
+
+	case MT_WT:
+	    # Wait for i/o on the device channel.  Not implemented as a
+	    # discreet kernel server operation; for a read the wait status
+	    # is returned with the data, and for a write we assume the normal
+	    # status and break the connection if the assumption is false.
+
+	    status = ERR
+
+	case MT_ST:
+	    # Get device status.
+	    call zzstmt (arg[1], arg[2], lval)
+	    status = lval
+
+	case MT_RW:
+	    # Rewind a drive.
+	    dc_off = p_arg[2]
+	    dc_len = p_arg[3]
+
+	    # Get the device name string.
+	    call strpak (p_sbuf[arg[1]], drive, SZ_PATHNAME)
+
+	    # Get the devcap string.
+	    if (dc_len > 0 && dc_off == 0) {
+		call zardks (in, Memc[iobuf], dc_len+1, 0)
+		call zawtks (in, status)
+		if (status != dc_len + 1)
+		    goto fatal_
+	    } else
+		call strpak (p_sbuf[dc_off], Memc[iobuf], len_iobuf)
+
+	    call zzrwmt (drive, Memc[iobuf], status)
+
+	default:
+	    status = ERR
+	}
+
+	# Return a status packet to the host if the operation was not a read
+	# or a write.
+
+	if (debug == YES) {
+	    call fprintf (spy, "status %d\n")
+	    call pargi (status)
+	}
+
+	p_arg[1] = status
+	if (ks_send (out, p_opcode, p_subcode) != ERR)
+	    return
+
+fatal_
+	call ks_error (1, "kernel server magtape i/o error")
+end
+
+
+# KS_ERROR -- Spool error message if debug is enabled, then call error
+# to kill kernel server.
+
+procedure ks_error (errcode, errmsg)
+
+int	errcode
+char	errmsg[ARB]
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	if (debug == YES) {
+	    call fprintf (spy, "ERROR (%d, `%s')\n")
+		call pargi   (errcode)
+		call pargstr (errmsg)
+	}
+
+	call error (errcode, errmsg)
+end
+
+
+# KS_LOADBF -- Load the binary file drivers.  The order in which the driver
+# entry points are loaded must agree with the defines at the head of this file.
+
+procedure ks_loadbf (bfdd)
+
+int	bfdd[ARB]			# device table
+int	off, locpr()
+extern	zopnbf(), zclsbf(), zardbf(), zawrbf(), zawtbf(), zsttbf()
+extern	zopnlp(), zclslp(), zardlp(), zawrlp(), zawtlp(), zsttlp()
+extern	zopnpl(), zclspl(), zardpl(), zawrpl(), zawtpl(), zsttpl()
+extern			    zardpr(), zawrpr(), zawtpr(), zsttpr()
+extern	zopnsf(), zclssf(), zardsf(), zawrsf(), zawtsf(), zsttsf()
+extern	zopngd(), zclsgd(), zardgd(), zawrgd(), zawtgd(), zsttgd()
+
+begin
+	off = (KI_ZFIOBF - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = locpr (zopnbf)
+	bfdd[off+2] = locpr (zclsbf)
+	bfdd[off+3] = locpr (zardbf)
+	bfdd[off+4] = locpr (zawrbf)
+	bfdd[off+5] = locpr (zawtbf)
+	bfdd[off+6] = locpr (zsttbf)
+
+	off = (KI_ZFIOLP - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = locpr (zopnlp)
+	bfdd[off+2] = locpr (zclslp)
+	bfdd[off+3] = locpr (zardlp)
+	bfdd[off+4] = locpr (zawrlp)
+	bfdd[off+5] = locpr (zawtlp)
+	bfdd[off+6] = locpr (zsttlp)
+
+	off = (KI_ZFIOPL - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = locpr (zopnpl)
+	bfdd[off+2] = locpr (zclspl)
+	bfdd[off+3] = locpr (zardpl)
+	bfdd[off+4] = locpr (zawrpl)
+	bfdd[off+5] = locpr (zawtpl)
+	bfdd[off+6] = locpr (zsttpl)
+
+	off = (KI_ZFIOPR - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = 0
+	bfdd[off+2] = 0
+	bfdd[off+3] = locpr (zardpr)
+	bfdd[off+4] = locpr (zawrpr)
+	bfdd[off+5] = locpr (zawtpr)
+	bfdd[off+6] = locpr (zsttpr)
+
+	off = (KI_ZFIOSF - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = locpr (zopnsf)
+	bfdd[off+2] = locpr (zclssf)
+	bfdd[off+3] = locpr (zardsf)
+	bfdd[off+4] = locpr (zawrsf)
+	bfdd[off+5] = locpr (zawtsf)
+	bfdd[off+6] = locpr (zsttsf)
+
+	off = (KI_ZFIOGD - KI_ZFIOBF) * LEN_BFDRIVER
+	bfdd[off+1] = locpr (zopngd)
+	bfdd[off+2] = locpr (zclsgd)
+	bfdd[off+3] = locpr (zardgd)
+	bfdd[off+4] = locpr (zawrgd)
+	bfdd[off+5] = locpr (zawtgd)
+	bfdd[off+6] = locpr (zsttgd)
+end
+
+
+# KS_LOADTX -- Load the text file drivers.  The order in which the driver
+# entry points are loaded must agree with the defines at the head of this file.
+
+procedure ks_loadtx (txdd)
+
+int	txdd[ARB]			# device table
+int	off, locpr()
+extern	zopntx(), zclstx(), zgettx(), zputtx(), zflstx(), zsektx(), znottx(),
+	zstttx()
+extern	zopnty(), zclsty(), zgetty(), zputty(), zflsty(), zsekty(), znotty(),
+	zsttty()
+
+begin
+	off = (KI_ZFIOTX - KI_ZFIOTX) * LEN_TXDRIVER
+	txdd[off+1] = locpr (zopntx)
+	txdd[off+2] = locpr (zclstx)
+	txdd[off+3] = locpr (zgettx)
+	txdd[off+4] = locpr (zputtx)
+	txdd[off+5] = locpr (zflstx)
+	txdd[off+6] = locpr (zsektx)
+	txdd[off+7] = locpr (znottx)
+	txdd[off+8] = locpr (zstttx)
+
+	off = (KI_ZFIOTY - KI_ZFIOTX) * LEN_TXDRIVER
+	txdd[off+1] = locpr (zopnty)
+	txdd[off+2] = locpr (zclsty)
+	txdd[off+3] = locpr (zgetty)
+	txdd[off+4] = locpr (zputty)
+	txdd[off+5] = locpr (zflsty)
+	txdd[off+6] = locpr (zsekty)
+	txdd[off+7] = locpr (znotty)
+	txdd[off+8] = locpr (zsttty)
+end
+
+
+# KS_SEND -- Encode the packet in the kii common in a machine independent form
+# and send it over the network.
+
+int procedure ks_send (server, opcode, subcode)
+
+int	server			# channel to host
+int	opcode			# function opcode
+int	subcode			# function subcode (for drivers)
+
+int	status
+include	"kii.com"
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	p_opcode  = opcode
+	p_subcode = subcode
+
+	# Encode the packet in machine independent form, i.e., LEN_INTFIELDS
+	# 32 bit MII integers followed by p_sbuflen chars, one char per byte.
+
+	call miipak32 (FIRSTINTFIELD, p_packet, LEN_INTFIELDS, TY_INT)
+	call chrpak (p_sbuf, 1, p_packet, LEN_INTFIELDS * 4 + 1,
+	    min (SZ_SBUF, p_sbuflen + 1))
+
+	# Transmit the packet.
+	call zawrks (server, p_packet, SZB_PACKET, long(0))
+	call zawtks (server, status)
+
+	if (debug == YES) {
+	    call fprintf (spy, "ks_send: status=%d\n");call pargi (status)
+	}
+
+	return (status)
+end
+
+
+# KS_RECEIVE -- Read a machine independent KII packet from the network
+# interface and decode it into the internal, machine dependent form in the
+# kii common.  This procedure differs from the procedure KI_RECEIVE in
+# that it does not verify the opcode and subcode of the received packet.
+
+int procedure ks_receive (server)
+
+int	server			# os channel to server process
+int	status
+include	"kii.com"
+
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	# Read the packet.
+	# [DEBUG]: call zzrdks (server, p_packet, SZB_PACKET, long(0))
+
+	call zardks (server, p_packet, SZB_PACKET, long(0))
+	call zawtks (server, status)
+
+	if (debug == YES && status <= 0) {
+	    call fprintf (spy, "ERROR: ks_receive: status=%d\n")
+		call pargi (status)
+	}
+
+	if (status <= 0)
+	    return (status)
+
+	# The encoded packet consists of LEN_INTFIELDS 32 bit MII integers
+	# followed by p_sbuflen chars, one char per byte.
+
+	call miiupk32 (p_packet, FIRSTINTFIELD, LEN_INTFIELDS, TY_INT)
+	call chrupk (p_packet, LEN_INTFIELDS * 4 + 1, p_sbuf, 1,
+	    min (SZ_SBUF, p_sbuflen + 1))
+
+	if (debug == YES) {
+	    call fprintf (spy, "ks_receive: status=%d\n") ; call pargi (status)
+	}
+
+	return (status)
+end
+
+
+# KS_FMAPFN -- Equivalent functionality of FMAPFN but with debug output.
+
+procedure ks_fmapfn (vfn, osfn, maxch)
+
+char	vfn[ARB]		# filename to be mapped
+char	osfn[maxch]		# packed output OS filename
+int	maxch			# max chars out
+
+char	upk_osfn[SZ_FNAME]
+errchk	fmapfn
+int	debug, spy
+common	/dbgcom/ debug, spy
+
+begin
+	call fmapfn (vfn, osfn, maxch)
+
+	if (debug == YES) {
+	    call strupk (osfn, upk_osfn, SZ_FNAME)
+
+	    call fprintf (spy, "`%s' -> `%s'\n")
+		call pargstr (vfn)
+		call pargstr (upk_osfn)
+	}
+end
+
+
+procedure ks_op2str (opcode, subcode, o_str, s_str)
+
+int	opcode			#i opcode
+int	subcode			#i opcode
+char	o_str[ARB]		#o string containing opcode instruction
+char	s_str[ARB]		#o string containing subcode instruction
+
+begin
+	switch (opcode) {
+	case KI_ENVINIT: call strcpy ("KI_ENVINIT", o_str, SZ_LINE) 
+	case KI_SETROOT: call strcpy ("KI_SETROOT", o_str, SZ_LINE) 
+	case KI_ZOSCMD:  call strcpy ("KI_OSCMD",   o_str, SZ_LINE) 
+	case KI_FMAPFN:  call strcpy ("KI_FMAPFN",  o_str, SZ_LINE) 
+
+	case KI_ZFACSS:  call strcpy ("KI_ZFACSS", o_str, SZ_LINE)  
+	case KI_ZFALOC:	 call strcpy ("KI_ZFALOC", o_str, SZ_LINE)  
+	case KI_ZFCHDR:  call strcpy ("KI_ZFCHDR", o_str, SZ_LINE)  
+	case KI_ZFDELE:  call strcpy ("KI_ZFDELE", o_str, SZ_LINE)  
+	case KI_ZFINFO:  call strcpy ("KI_ZFINFO", o_str, SZ_LINE)  
+	case KI_ZFGCWD:  call strcpy ("KI_ZFGCWD", o_str, SZ_LINE)  
+	case KI_ZFMKCP:  call strcpy ("KI_ZFMKCP", o_str, SZ_LINE)  
+	case KI_ZFMKDR:  call strcpy ("KI_ZFMKDR", o_str, SZ_LINE)  
+	case KI_ZFPATH:  call strcpy ("KI_ZFPATH", o_str, SZ_LINE)  
+	case KI_ZFPROT:  call strcpy ("KI_ZFPROT", o_str, SZ_LINE)  
+	case KI_ZFRNAM:  call strcpy ("KI_ZFRNAM", o_str, SZ_LINE)  
+	case KI_ZFRMDR:  call strcpy ("KI_ZFRMDR", o_str, SZ_LINE)  
+	case KI_ZFSUBD:  call strcpy ("KI_ZFSUBD", o_str, SZ_LINE)  
+	case KI_ZDVALL:  call strcpy ("KI_ZDVALL", o_str, SZ_LINE)  
+	case KI_ZDVOWN:  call strcpy ("KI_ZDVOWN", o_str, SZ_LINE)  
+	case KI_ZFUTIM:  call strcpy ("KI_ZFUTIM", o_str, SZ_LINE)  
+
+	case KI_ZOPDIR:  call strcpy ("KI_ZOPDIR", o_str, SZ_LINE)  
+	case KI_ZCLDIR:  call strcpy ("KI_ZCLDIR", o_str, SZ_LINE)  
+	case KI_ZGFDIR:  call strcpy ("KI_ZGFDIR", o_str, SZ_LINE)  
+ 
+	case KI_ZOPDPR:  call strcpy ("KI_ZOPDPR", o_str, SZ_LINE)  
+	case KI_ZCLDPR:  call strcpy ("KI_ZCLDPR", o_str, SZ_LINE)  
+	case KI_ZOPCPR:  call strcpy ("KI_ZOPCPR", o_str, SZ_LINE)  
+	case KI_ZCLCPR:  call strcpy ("KI_ZCLCPR", o_str, SZ_LINE)  
+	case KI_ZINTPR:  call strcpy ("KI_ZINTPR", o_str, SZ_LINE)  
+
+	# Device driver opcodes.
+	case KI_ZFIOBF:  call strcpy ("KI_ZFIOBF", o_str, SZ_LINE)  
+	case KI_ZFIOLP:  call strcpy ("KI_ZFIOLP", o_str, SZ_LINE)  
+	case KI_ZFIOPL:  call strcpy ("KI_ZFIOPL", o_str, SZ_LINE)  
+	case KI_ZFIOPR:  call strcpy ("KI_ZFIOPR", o_str, SZ_LINE)  
+	case KI_ZFIOSF:  call strcpy ("KI_ZFIOSF", o_str, SZ_LINE)  
+	case KI_ZFIOGD:  call strcpy ("KI_ZFIOGD", o_str, SZ_LINE)  
+
+	case KI_ZFIOTX:  call strcpy ("KI_ZFIOTX", o_str, SZ_LINE)  
+	case KI_ZFIOTY:  call strcpy ("KI_ZFIOTY", o_str, SZ_LINE)  
+
+	case KI_ZFIOMT:  call strcpy ("KI_ZFIOMT", o_str, SZ_LINE)  
+
+	default: 	 call strcpy ("", o_str, SZ_LINE)
+	}
+
+
+	# Now convert the subcode if needed.
+	call aclrc (s_str, SZ_LINE)
+	if (opcode >= KI_ZFIOBF && opcode <= KI_ZFIOGD) {
+	    switch (subcode) {
+	    case BF_OPN:  call strcpy ("BF_OPN", s_str, SZ_LINE) 
+	    case BF_CLS:  call strcpy ("BF_CLS", s_str, SZ_LINE) 
+	    case BF_ARD:  call strcpy ("BF_ARD", s_str, SZ_LINE) 
+	    case BF_AWR:  call strcpy ("BF_AWR", s_str, SZ_LINE) 
+	    case BF_AWT:  call strcpy ("BF_AWT", s_str, SZ_LINE) 
+	    case BF_STT:  call strcpy ("BF_STT", s_str, SZ_LINE) 
+	    default: 	  call strcpy ("", s_str, SZ_LINE)
+	    }
+	
+	} else if (opcode >= KI_ZFIOTX || opcode <= KI_ZFIOTY) {
+	    switch (subcode) {
+	    case TX_OPN:  call strcpy ("TX_OPN", s_str, SZ_LINE) 
+	    case TX_CLS:  call strcpy ("TX_CLS", s_str, SZ_LINE) 
+	    case TX_GET:  call strcpy ("TX_GET", s_str, SZ_LINE) 
+	    case TX_PUT:  call strcpy ("TX_PUT", s_str, SZ_LINE) 
+	    case TX_FLS:  call strcpy ("TX_FLS", s_str, SZ_LINE) 
+	    case TX_SEK:  call strcpy ("TX_SEK", s_str, SZ_LINE) 
+	    case TX_NOT:  call strcpy ("TX_NOT", s_str, SZ_LINE) 
+	    case TX_STT:  call strcpy ("TX_STT", s_str, SZ_LINE) 
+	    default: 	  call strcpy ("", s_str, SZ_LINE)
+	    }
+
+	} else if (opcode >= KI_ZFIOMT) {
+	    switch (subcode) {
+	    case MT_OP:   call strcpy ("MT_OP", s_str, SZ_LINE) 
+	    case MT_CL:   call strcpy ("MT_CL", s_str, SZ_LINE) 
+	    case MT_RD:   call strcpy ("MT_RD", s_str, SZ_LINE) 
+	    case MT_WR:   call strcpy ("MT_WR", s_str, SZ_LINE) 
+	    case MT_WT:   call strcpy ("MT_WT", s_str, SZ_LINE) 
+	    case MT_ST:   call strcpy ("MT_ST", s_str, SZ_LINE) 
+	    case MT_RW:   call strcpy ("MT_RW", s_str, SZ_LINE) 
+	    default: 	  call strcpy ("", s_str, SZ_LINE)
+	    }
+	}
+
+end
diff --git a/sys/ki/kbzard.x b/sys/ki/kbzard.x
new file mode 100644
index 00000000..7370f7f9
--- /dev/null
+++ b/sys/ki/kbzard.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KB_ZARD -- Asynchronous read from a binary device.  We are called only if
+# the device does not reside on the local node.  In this implementation
+# these reads are not actually asynchronous.  This is possible but more
+# complex to implement than I wanted to get into at this time, particularly
+# since FIO is not yet fully asynchronous.  The problem is that a node
+# channel may be used to multiplex any number of requests to the remote
+# node process.  If an asynchronous read is pending this must be detected
+# and the read completed before processing any other requests.
+
+procedure kb_zard (device, chan, obuf, max_bytes, loffset)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+char	obuf[max_bytes]		# receives data
+int	max_bytes		# max bytes to read
+long	loffset			# file offset
+
+int	server, status
+int	ki_send(), ki_receive()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = k_node[chan]
+
+	if (max_bytes <= 0) {
+	    k_status[chan] = 0
+	    return
+	}
+
+	# Send the request to initiate the read.
+
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = max_bytes
+	p_arg[3] = loffset
+
+	if (ki_send (server, device, BF_ARD) == ERR) {
+	    status = ERR
+	} else {
+	    # Wait for the ZAWT packet.
+	    if (ki_receive (server, device, BF_AWT) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+
+	    # Read the data block (if any) directly into caller's buffer.
+	    if (status > 0) {
+		call ks_aread (server, obuf, status)
+		call ks_await (server, status)
+	    }
+	}
+
+	k_status[chan] = status
+end
diff --git a/sys/ki/kbzawr.x b/sys/ki/kbzawr.x
new file mode 100644
index 00000000..406c14ba
--- /dev/null
+++ b/sys/ki/kbzawr.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KB_ZAWR -- Asynchronous write to a binary device.  We are called only if
+# the device does not reside on the local node.
+
+procedure kb_zawr (device, chan, ibuf, nbytes, loffset)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+char	ibuf[nbytes]		# receives data
+int	nbytes			# number of bytes to write
+long	loffset			# file offset
+
+int	server
+int	ki_send()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = k_node[chan]
+
+	if (nbytes <= 0) {
+	    k_status[chan] = 0
+	    return
+	}
+
+	# Send the request followed by the data block.  We must wait for the
+	# write into the network channel to complete since the channel is
+	# multiplexed.  Note that this is not the same as waiting for the
+	# data transfer to the physical device to complete; that transfer is
+	# at least partially asynchronous.
+
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = nbytes
+	p_arg[3] = loffset
+
+	if (ki_send (server, device, BF_AWR) == ERR)
+	    k_status[chan] = ERR
+	else {
+	    call ks_awrite (server, ibuf, nbytes)
+	    call ks_await  (server, k_status[chan])
+	}
+end
diff --git a/sys/ki/kbzawt.x b/sys/ki/kbzawt.x
new file mode 100644
index 00000000..e0d5a9d6
--- /dev/null
+++ b/sys/ki/kbzawt.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	"ki.h"
+
+# KB_ZAWT -- Wait for i/o to a binary file.  Called after an asynchronous read
+# or write has been issued on a channel.  We are not called unless the device
+# does not reside on the local node.  If the last i/o transfer was a read then
+# the ZAWT packet will be followed by the data which we must copy into the
+# callers buffer, using the pointer saved when the read was posted.  If the
+# last i/o operation was a write then we assume that the write was successful
+# and merely return the number of bytes written (error checking occurs
+# elsewhere).
+#
+#	 read: sendpkt,			rcvpkt, readdata
+#	write: sendpkt, senddata	[nothing]
+#
+#	       (zard|zawr)                  (zawt)
+#
+# Note that the ZAWT function is processed locally in the case of a write,
+# rather than being passed to the kernel server.  This makes file write
+# operations a pipelined operation, significantly increasing the opportunity
+# for overlapped execution and increasing the data bandwidth.  If the number
+# of bytes transferred to the remote device is not what is requested then the
+# remote kernel server will close the entire channel down (not just the
+# multiplexed channel for the device), causing a ZAWRKS error in the local
+# process.
+#
+# NOTE -- disregard the above regarding asynchronous reads.  ZARD is currently
+# implemented as a synchronous read.  The comments are retained here to show
+# how to speed up reads when the i/o system is made fully asynchronous.
+
+procedure kb_zawt (device, chan, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	status			# receives nbytes transferred or ERR
+
+include	"kichan.com"
+
+begin
+	status = k_status[chan]
+end
diff --git a/sys/ki/kbzcls.x b/sys/ki/kbzcls.x
new file mode 100644
index 00000000..afb1f348
--- /dev/null
+++ b/sys/ki/kbzcls.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KB_ZCLS -- Close a binary device.  We are called only if the device does not
+# reside on the local node.
+
+procedure kb_zcls (device, chan, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	status			# receives ok|err
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+
+	# If we receive error on the KS channel when trying to close a file,
+	# it is most likely due to a previous i/o error on the channel.  Do
+	# not return error here because we are probably being called during
+	# error recovery to free the logical channel, and if we return error
+	# the real error will be hidden.
+
+	if (ki_sendrcv (server, device, BF_CLS) == ERR)
+	    status = OK
+	else
+	    status = p_arg[1]
+
+	call ki_freechan (chan)
+end
diff --git a/sys/ki/kbzopn.x b/sys/ki/kbzopn.x
new file mode 100644
index 00000000..8a332b47
--- /dev/null
+++ b/sys/ki/kbzopn.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KB_ZOPN -- Open a binary device.  We are called only if the device does not
+# reside on the local node.
+
+procedure kb_zopn (device, osfn, mode, chan)
+
+int	device			# device driver code
+char	osfn[ARB]		# packed os filename
+int	mode			# access mode
+int	chan			# receives assigned channel
+
+int	server
+int	ki_connect(), ki_sendrcv(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+	p_arg[2] = mode
+
+	if (ki_sendrcv (server, device, BF_OPN) == ERR)
+	    chan = ERR
+	else if (p_arg[1] == ERR)
+	    chan = ERR
+	else
+	    chan = ki_getchan (server, p_arg[1])
+end
diff --git a/sys/ki/kbzstt.x b/sys/ki/kbzstt.x
new file mode 100644
index 00000000..0610dd7f
--- /dev/null
+++ b/sys/ki/kbzstt.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KB_ZSTT -- Get file status on a binary device.  We are called only if the
+# device does not reside on the local node.
+
+procedure kb_zstt (device, chan, what, lvalue)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	what			# file parameter to be returned
+long	lvalue			# receives the parameter value
+
+int	server, ks_maxbufsize
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kinode.com"
+include	"kii.com"
+data	ks_maxbufsize /-1/
+
+begin
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = what
+
+	if (ki_sendrcv (server, device, BF_STT) == ERR)
+	    lvalue = ERR
+	else {
+	    lvalue = p_arg[1]
+
+	    # The maximum buffer (transfer) size for a device is determined
+	    # by the the network interface or by the device, whichever is
+	    # smaller.
+
+	    if (what == FSTT_MAXBUFSIZE || what == FSTT_OPTBUFSIZE) {
+		if (ks_maxbufsize < 0)
+		    call zsttks (n_kschan[server], FSTT_MAXBUFSIZE, ks_maxbufsize)
+		if (lvalue == 0)
+		    lvalue = ks_maxbufsize
+		else if (ks_maxbufsize > 0)
+		    lvalue = min (lvalue, ks_maxbufsize)
+	    }
+	}
+end
diff --git a/sys/ki/kclcpr.x b/sys/ki/kclcpr.x
new file mode 100644
index 00000000..b3822c63
--- /dev/null
+++ b/sys/ki/kclcpr.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KCLCPR -- Close a connected subprocess.
+
+procedure kclcpr (pid, exit_status)
+
+int	pid			# channel descriptor
+int	exit_status		# exit status of the job
+
+int	server, inchan, outchan
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (pid <= 0) {
+	    exit_status = OK
+	    return
+	}
+
+	server = k_node[pid]
+
+	if (server == NULL) {
+	    call zclcpr (k_oschan[pid], exit_status)
+	} else {
+	    p_arg[1]  = k_oschan[pid]
+	    p_sbuflen = 0
+
+	    if (ki_sendrcv (server, KI_ZCLCPR, 0) == ERR)
+		exit_status = ERR
+	    else
+		exit_status = p_arg[1]
+	}
+
+	# The channel descriptor numbers of the two cds used for the i/o
+	# streams are encoded in the k_status field of the PID cd.
+
+	inchan  = k_status[pid] / MAX_CHANNELS
+	outchan = mod (k_status[pid], MAX_CHANNELS)
+
+	# Free the 3 channel descriptors used by the subprocess.
+	call ki_freechan (pid)
+	call ki_freechan (inchan)
+	call ki_freechan (outchan)
+end
diff --git a/sys/ki/kcldir.x b/sys/ki/kcldir.x
new file mode 100644
index 00000000..8f85f82f
--- /dev/null
+++ b/sys/ki/kcldir.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KCLDIR -- Close a directory file.
+
+procedure kcldir (chan, status)
+
+int	chan			# channel descriptor
+int	status			# answer; ok or err
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	server = k_node[chan]
+
+	if (server == NULL) {
+	    call zcldir (k_oschan[chan], status)
+
+	} else {
+	    p_arg[1]  = k_oschan[chan]
+	    p_sbuflen = 0
+
+	    if (ki_sendrcv (server, KI_ZCLDIR, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+
+	    call mfree (k_bufp[chan], TY_STRUCT)
+	}
+
+	call ki_freechan (chan)
+end
diff --git a/sys/ki/kcldpr.x b/sys/ki/kcldpr.x
new file mode 100644
index 00000000..43060701
--- /dev/null
+++ b/sys/ki/kcldpr.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KCLDPR -- Close a detached process.
+
+procedure kcldpr (jobcode, killflag, exit_status)
+
+int	jobcode			# channel descriptor
+int	killflag		# kill job or just wait for it to terminate
+int	exit_status		# exit status of the job
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (jobcode <= 0) {
+	    exit_status = OK
+	    return
+	}
+
+	server = k_node[jobcode]
+
+	if (server == NULL) {
+	    call zcldpr (k_oschan[jobcode], killflag, exit_status)
+
+	} else {
+	    p_arg[1]  = k_oschan[jobcode]
+	    p_arg[2]  = killflag
+	    p_sbuflen = 0
+
+	    if (ki_sendrcv (server, KI_ZCLDPR, 0) == ERR)
+		exit_status = ERR
+	    else
+		exit_status = p_arg[1]
+	}
+
+	call ki_freechan (jobcode)
+end
diff --git a/sys/ki/kdvall.x b/sys/ki/kdvall.x
new file mode 100644
index 00000000..a198df4f
--- /dev/null
+++ b/sys/ki/kdvall.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KDVALL -- Allocate/deallocate a device.
+
+procedure kdvall (device, allflag, status)
+
+char	device[ARB]		# device name or alias list
+int	allflag			# flag: allocate=1, deallocate=0
+int	status			# return status
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (device)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zdvall (p_sbuf, allflag, status)
+
+	} else {
+	    p_arg[2] = allflag
+	    if (ki_sendrcv (server, KI_ZDVALL, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kdvown.x b/sys/ki/kdvown.x
new file mode 100644
index 00000000..0b5180a7
--- /dev/null
+++ b/sys/ki/kdvown.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KDVOWN -- Query device allocation; return the owner name if the device is
+# allocated to someone else.
+
+procedure kdvown (device, owner, maxch, status)
+
+char	device[ARB]		# packed device name string
+char	owner[ARB]		# receives owner name string
+int	maxch			# max chars out
+int	status			# allocation status (<xalloc.h>)
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (device)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zdvown (p_sbuf, owner, maxch, status)
+
+	} else {
+	    p_arg[2] = maxch
+	    if (ki_sendrcv (server, KI_ZDVOWN, 0) == ERR) {
+		owner[1] = EOS
+		status = ERR
+	    } else {
+		status = p_arg[1]
+		call strpak (p_sbuf, owner, maxch)
+	    }
+	}
+end
diff --git a/sys/ki/kfacss.x b/sys/ki/kfacss.x
new file mode 100644
index 00000000..5634e099
--- /dev/null
+++ b/sys/ki/kfacss.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFACSS -- Determine the accessibility and type of a file.
+
+procedure kfacss (osfn, mode, type, status)
+
+char	osfn[ARB]		# packed os filename
+int	mode			# access mode or null if don't care
+int	type			# file type or null if don't care
+int	status			# answer; yes or no
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfacss (p_sbuf, mode, type, status)
+
+	} else {
+	    p_arg[2] = mode
+	    p_arg[3] = type
+
+	    if (ki_sendrcv (server, KI_ZFACSS, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfaloc.x b/sys/ki/kfaloc.x
new file mode 100644
index 00000000..4ba8d041
--- /dev/null
+++ b/sys/ki/kfaloc.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFALOC -- Create and preallocate space for a binary file.
+
+procedure kfaloc (osfn, nbytes, status)
+
+char	osfn[ARB]		# packed os filename
+int	nbytes			# nbytes of storage to allocate
+int	status			# answer; ok or err
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfaloc (p_sbuf, nbytes, status)
+
+	} else {
+	    p_arg[2] = nbytes
+
+	    if (ki_sendrcv (server, KI_ZFALOC, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfchdr.x b/sys/ki/kfchdr.x
new file mode 100644
index 00000000..2e1b6501
--- /dev/null
+++ b/sys/ki/kfchdr.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<chars.h>
+include	"ki.h"
+
+# KFCHDR -- Change the default directory.  The default node is also set if
+# the request is successful.
+
+procedure kfchdr (dirname, status)
+
+char	dirname[ARB]		# directory name
+int	status
+
+pointer	sp, fname, defnode
+int	server, junk
+int	ki_gnode(), ki_connect(), ki_findnode()
+# int	ki_sendrcv()
+include	"kinode.com"
+include	"kii.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (defnode, SZ_ALIAS, TY_CHAR)
+
+	server = ki_connect (dirname)
+
+	if (server == NULL) {
+	    # Directory is on the local node.
+
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfchdr (p_sbuf, status)
+
+	} else {
+	    # Directory is on a remote node.  Pass the node relative chdir
+	    # request on to the remote node and set the default node locally
+	    # if the request is successful.
+
+	    # Does not work yet.
+	    #if (ki_sendrcv (server, KI_ZFCHDR, 0) != ERR)
+	    #	status = p_arg[1]
+	    #else
+	    #	status = ERR
+
+	    status = ERR
+	}
+
+	# Update the default node if the change directory request
+	# is successful.
+
+	if (status != ERR) {
+	    call strupk (dirname, Memc[fname], SZ_PATHNAME)
+	    junk = ki_gnode (Memc[fname], Memc[defnode], junk)
+	    call strcpy (Memc[defnode], n_defaultnode, SZ_ALIAS)
+	    n_default = ki_findnode (n_defaultnode)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/ki/kfdele.x b/sys/ki/kfdele.x
new file mode 100644
index 00000000..53e0822a
--- /dev/null
+++ b/sys/ki/kfdele.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFDELE -- Delete a file.
+
+procedure kfdele (osfn, status)
+
+char	osfn[ARB]		# packed os filename
+int	status			# answer; ok or err
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfdele (p_sbuf, status)
+
+	} else {
+	    if (ki_sendrcv (server, KI_ZFDELE, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfgcwd.x b/sys/ki/kfgcwd.x
new file mode 100644
index 00000000..c142eaa8
--- /dev/null
+++ b/sys/ki/kfgcwd.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<chars.h>
+include	"ki.h"
+
+# KFGCWD -- Get the name of the current default directory.
+
+procedure kfgcwd (outstr, maxch, nchars)
+
+char	outstr[maxch]		# receives pathname of directory
+int	maxch			# max chars out
+int	nchars			# length of returned string
+
+int	server, op
+int	gstrcpy(), ki_sendrcv()
+include	"kinode.com"
+include	"kii.com"
+define	err_ 91
+
+begin
+	# If the current directory resides on the local node pass the zfgcwd
+	# request to the local kernel, else pass it to the kernel on the remote
+	# (default) node.  Leave the CWD in p_sbuf.
+
+	if (n_default == NULL || n_default == n_local) {
+err_	    call zfgcwd (p_sbuf, SZ_SBUF, nchars)
+	    call strupk (p_sbuf, p_sbuf, SZ_SBUF)
+	    p_arg[2] = 1
+
+	} else {
+	    # If the current directory is on a remote node then there must be
+	    # a connected kernel server attached to that node.
+
+	    server = n_default
+
+	    if (ki_sendrcv (server, KI_ZFGCWD, 0) == ERR) {
+		n_default = n_local
+		goto err_
+	    }
+	}
+
+	# Return node // directory.
+
+	op = gstrcpy (n_defaultnode, outstr, maxch) + 1
+	if (op > 1) {
+	    outstr[op] = FNNODE_CHAR
+	    op = op + 1
+	}
+
+	nchars = op + gstrcpy (p_sbuf[p_arg[2]], outstr[op], maxch-op+1)
+	call strpak (outstr, outstr, maxch)
+end
diff --git a/sys/ki/kfinfo.x b/sys/ki/kfinfo.x
new file mode 100644
index 00000000..cfc0353d
--- /dev/null
+++ b/sys/ki/kfinfo.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<finfo.h>
+include	"ki.h"
+
+# KFINFO -- Get directory info on a file.
+
+procedure kfinfo (osfn, fi, status)
+
+char	osfn[ARB]		# packed os filename
+long	fi[ARB]			# receives finfo structure
+int	status			# answer; ok or err
+
+int	server, i
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfinfo (p_sbuf, fi, status)
+
+	} else {
+	    if (ki_sendrcv (server, KI_ZFINFO, 0) == ERR)
+		status = ERR
+	    else {
+		status = p_arg[1]
+
+		# The finfo structure is returned in ARG except for the
+		# owner string, which is returned in sbuf.  Note that we
+		# are passing longs in ints hence precision could conceivably 
+		# be lost (most unlikely).
+
+		do i = 1, FI_NINTFIELDS
+		    fi[i] = p_arg[i+1]
+		call strpak (p_sbuf, FI_OWNER(fi), FI_SZOWNER)
+	    }
+	}
+end
diff --git a/sys/ki/kfiobf.x b/sys/ki/kfiobf.x
new file mode 100644
index 00000000..50d7f500
--- /dev/null
+++ b/sys/ki/kfiobf.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOBF -- Binary file driver.
+
+procedure kopnbf (osfn, mode, chan)
+
+char	osfn[ARB]
+int	mode, chan
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopnbf (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kb_zopn (KI_ZFIOBF, osfn, mode, chan)
+end
+
+
+procedure kclsbf (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclsbf (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kb_zcls (KI_ZFIOBF, chan, status)
+end
+
+
+procedure kardbf (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardbf (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOBF, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrbf (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrbf (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOBF, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtbf (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtbf (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOBF, chan, status)
+end
+
+
+procedure ksttbf (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttbf (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOBF, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiogd.x b/sys/ki/kfiogd.x
new file mode 100644
index 00000000..bde39350
--- /dev/null
+++ b/sys/ki/kfiogd.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOGD -- Binary graphics device file driver.
+
+procedure kopngd (osfn, mode, chan)
+
+char	osfn[ARB]
+int	mode, chan
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopngd (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kb_zopn (KI_ZFIOGD, osfn, mode, chan)
+end
+
+
+procedure kclsgd (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclsgd (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kb_zcls (KI_ZFIOGD, chan, status)
+end
+
+
+procedure kardgd (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardgd (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOGD, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrgd (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrgd (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOGD, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtgd (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtgd (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOGD, chan, status)
+end
+
+
+procedure ksttgd (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttgd (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOGD, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiolp.x b/sys/ki/kfiolp.x
new file mode 100644
index 00000000..7e642b00
--- /dev/null
+++ b/sys/ki/kfiolp.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOLP -- Line printer driver.
+
+procedure kopnlp (osfn, mode, chan)
+
+char	osfn[ARB]
+int	mode, chan
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopnlp (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kb_zopn (KI_ZFIOLP, osfn, mode, chan)
+end
+
+
+procedure kclslp (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclslp (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kb_zcls (KI_ZFIOLP, chan, status)
+end
+
+
+procedure kardlp (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardlp (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOLP, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrlp (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrlp (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOLP, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtlp (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtlp (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOLP, chan, status)
+end
+
+
+procedure ksttlp (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttlp (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOLP, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiopl.x b/sys/ki/kfiopl.x
new file mode 100644
index 00000000..346101cc
--- /dev/null
+++ b/sys/ki/kfiopl.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	"ki.h"
+
+# KFIOPL -- Plotter driver (NSPP metacode translator).
+
+procedure kopnpl (osfn, mode, chan)
+
+char	osfn[ARB]
+int	mode, chan
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopnpl (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kb_zopn (KI_ZFIOPL, osfn, mode, chan)
+end
+
+
+procedure kclspl (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclspl (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kb_zcls (KI_ZFIOPL, chan, status)
+end
+
+
+procedure kardpl (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardpl (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOPL, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrpl (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrpl (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOPL, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtpl (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtpl (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOPL, chan, status)
+end
+
+
+procedure ksttpl (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttpl (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOPL, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiopr.x b/sys/ki/kfiopr.x
new file mode 100644
index 00000000..2abae18e
--- /dev/null
+++ b/sys/ki/kfiopr.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOPR -- IPC driver.  This driver has no open and close entry points since
+# these functions are provided by the ZOPCPR and ZCLCPR procedures, which also
+# spawn the subprocess.
+
+#	procedure kopnpr (osfn, mode, chan)
+#	
+#	char	osfn[ARB]
+#	int	mode, chan
+#	
+#	int	server
+#	int	ki_connect(), ki_getchan()
+#	include	"kii.com"
+#	
+#	begin
+#		server = ki_connect (osfn)
+#	
+#		if (server == NULL) {
+#		    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+#		    call zopnpr (p_sbuf, mode, chan)
+#		    if (chan != ERR)
+#			chan = ki_getchan (server, chan)
+#		} else
+#		    call kb_zopn (KI_ZFIOPR, osfn, mode, chan)
+#	end
+#	
+#	
+#	procedure kclspr (chan, status)
+#	
+#	int	chan
+#	int	status
+#	include	"kichan.com"
+#	
+#	begin
+#		if (k_node[chan] == NULL) {
+#		    call zclspr (k_oschan[chan], status)
+#		    k_oschan[chan] = NULL
+#		} else
+#		    call kb_zcls (KI_ZFIOPR, chan, status)
+#	end
+
+
+procedure kardpr (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardpr (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOPR, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrpr (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrpr (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOPR, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtpr (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtpr (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOPR, chan, status)
+end
+
+
+procedure ksttpr (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttpr (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOPR, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiosf.x b/sys/ki/kfiosf.x
new file mode 100644
index 00000000..c14cc13c
--- /dev/null
+++ b/sys/ki/kfiosf.x
@@ -0,0 +1,112 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOSF -- Static file driver.  Since the static file driver may permit
+# portions of a data file to be mapped into virtual memory, use the binary
+# file driver if the file resides on a remote node.
+
+procedure kopnsf (osfn, mode, chan)
+
+char	osfn[ARB]
+int	mode, chan
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopnsf (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kb_zopn (KI_ZFIOBF, osfn, mode, chan)
+end
+
+
+procedure kclssf (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclssf (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kb_zcls (KI_ZFIOBF, chan, status)
+end
+
+
+procedure kardsf (chan, buf, max_bytes, offset)
+
+int	chan
+char	buf[ARB]
+int	max_bytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zardsf (k_oschan[chan], buf, max_bytes, offset)
+	else
+	    call kb_zard (KI_ZFIOBF, chan, buf, max_bytes, offset)
+end
+
+
+procedure kawrsf (chan, buf, nbytes, offset)
+
+int	chan
+char	buf[ARB]
+int	nbytes
+long	offset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawrsf (k_oschan[chan], buf, nbytes, offset)
+	else
+	    call kb_zawr (KI_ZFIOBF, chan, buf, nbytes, offset)
+end
+
+
+procedure kawtsf (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zawtsf (k_oschan[chan], status)
+	else
+	    call kb_zawt (KI_ZFIOBF, chan, status)
+end
+
+
+procedure ksttsf (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttsf (k_oschan[chan], what, lvalue)
+	else
+	    call kb_zstt (KI_ZFIOBF, chan, what, lvalue)
+end
diff --git a/sys/ki/kfiotx.x b/sys/ki/kfiotx.x
new file mode 100644
index 00000000..b329c674
--- /dev/null
+++ b/sys/ki/kfiotx.x
@@ -0,0 +1,157 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KFIOTX -- Text file driver.
+
+procedure kopntx (osfn, mode, chan)
+
+char	osfn[ARB]		# packed os filename
+int	mode			# access mode
+int	chan			# receives channel code
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopntx (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kt_zopn (KI_ZFIOTX, osfn, mode, chan)
+end
+
+
+procedure kclstx (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclstx (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kt_zcls (KI_ZFIOTX, chan, status)
+end
+
+
+procedure kgettx (chan, text, maxch, status)
+
+int	chan
+char	text[maxch]
+int	maxch, status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zgettx (k_oschan[chan], text, maxch, status)
+	else
+	    call kt_zget (KI_ZFIOTX, chan, text, maxch, status)
+end
+
+
+procedure kputtx (chan, text, nchars, status)
+
+int	chan
+char	text[nchars]
+int	nchars, status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zputtx (k_oschan[chan], text, nchars, status)
+	else
+	    call kt_zput (KI_ZFIOTX, chan, text, nchars, status)
+end
+
+
+procedure kflstx (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zflstx (k_oschan[chan], status)
+	else
+	    call kt_zfls (KI_ZFIOTX, chan, status)
+end
+
+
+procedure ksektx (chan, loffset, status)
+
+int	chan
+long	loffset
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsektx (k_oschan[chan], loffset, status)
+	else
+	    call kt_zsek (KI_ZFIOTX, chan, loffset, status)
+end
+
+
+procedure knottx (chan, loffset)
+
+int	chan
+long	loffset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call znottx (k_oschan[chan], loffset)
+	else
+	    call kt_znot (KI_ZFIOTX, chan, loffset)
+end
+
+
+procedure kstttx (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zstttx (k_oschan[chan], what, lvalue)
+	else {
+	    # Querying the text file status parameters is slow over the net,
+	    # and they are essentially constants anyhow, so just return the
+	    # expected values.
+	    #
+	    # call kt_zstt (KI_ZFIOTX, chan, what, lvalue)
+
+	    switch (what) {
+	    case FSTT_BLKSIZE:
+		lvalue = 1
+	    case FSTT_FILSIZE:
+		lvalue = 1
+	    case FSTT_OPTBUFSIZE:
+		lvalue = SZ_LINE
+	    case FSTT_MAXBUFSIZE:
+		lvalue = 0
+	    default:
+		lvalue = ERR
+	    }
+	}
+end
diff --git a/sys/ki/kfioty.x b/sys/ki/kfioty.x
new file mode 100644
index 00000000..4726f5c3
--- /dev/null
+++ b/sys/ki/kfioty.x
@@ -0,0 +1,138 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KFIOTY -- Terminal driver.
+
+procedure kopnty (osfn, mode, chan)
+
+char	osfn[ARB]		# packed os filename
+int	mode			# access mode
+int	chan			# receives channel code
+
+int	server
+int	ki_connect(), ki_getchan()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopnty (p_sbuf, mode, chan)
+	    if (chan != ERR)
+		chan = ki_getchan (server, chan)
+	} else
+	    call kt_zopn (KI_ZFIOTY, osfn, mode, chan)
+end
+
+
+procedure kclsty (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL) {
+	    call zclsty (k_oschan[chan], status)
+	    call ki_freechan (chan)
+	} else
+	    call kt_zcls (KI_ZFIOTY, chan, status)
+end
+
+
+procedure kgetty (chan, text, maxch, status)
+
+int	chan
+char	text[maxch]
+int	maxch, status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zgetty (k_oschan[chan], text, maxch, status)
+	else
+	    call kt_zget (KI_ZFIOTY, chan, text, maxch, status)
+end
+
+
+procedure kputty (chan, text, nchars, status)
+
+int	chan
+char	text[nchars]
+int	nchars, status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zputty (k_oschan[chan], text, nchars, status)
+	else
+	    call kt_zput (KI_ZFIOTY, chan, text, nchars, status)
+end
+
+
+procedure kflsty (chan, status)
+
+int	chan
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zflsty (k_oschan[chan], status)
+	else
+	    call kt_zfls (KI_ZFIOTY, chan, status)
+end
+
+
+procedure ksekty (chan, loffset, status)
+
+int	chan
+long	loffset
+int	status
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsekty (k_oschan[chan], loffset, status)
+	else
+	    call kt_zsek (KI_ZFIOTY, chan, loffset, status)
+end
+
+
+procedure knotty (chan, loffset)
+
+int	chan
+long	loffset
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call znotty (k_oschan[chan], loffset)
+	else
+	    call kt_znot (KI_ZFIOTY, chan, loffset)
+end
+
+
+procedure ksttty (chan, what, lvalue)
+
+int	chan
+int	what
+long	lvalue
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zsttty (k_oschan[chan], what, lvalue)
+	else
+	    call kt_zstt (KI_ZFIOTY, chan, what, lvalue)
+end
diff --git a/sys/ki/kfmkcp.x b/sys/ki/kfmkcp.x
new file mode 100644
index 00000000..675aa1b3
--- /dev/null
+++ b/sys/ki/kfmkcp.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+
+# KFMKCP -- Make a null length copy of a file.  The new file inherits the
+# attributes of the existing file.  This works provided both files are on
+# the same node; since the kernel routine is atomic and must access both
+# files, and the attributes are OS dependent, there is no way to inherit
+# the attributes if the files reside on different nodes.
+
+procedure kfmkcp (old_osfn, new_osfn, status)
+
+char	old_osfn[ARB]		# packed os filename of existing file
+char	new_osfn[ARB]		# packed os filename of new file
+int	status			# answer; ok or err
+
+pointer	sp, fname
+int	server1, server2, chan, junk, old, new
+int	ki_connect(), ki_sendrcv(), strlen()
+include	"kii.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	server2 = ki_connect (new_osfn)
+	call strcpy (p_sbuf[p_arg[1]], Memc[fname], SZ_FNAME)
+	server1 = ki_connect (old_osfn)
+	old = p_arg[1]
+
+	if (server1 == NULL && server2 == NULL) {
+	    # Both files reside on the local node.
+
+	    call strpak (p_sbuf[old], p_sbuf[old], SZ_SBUF)
+            call strpak (Memc[fname], Memc[fname], SZ_FNAME)
+	    call zfmkcp (p_sbuf[old], Memc[fname], status)
+
+	} else if (server1 == server2) {
+	    # Both files reside on the same remote node.
+
+	    new = old + strlen(p_sbuf[old])+1 + 1
+	    if (new + strlen(Memc[fname])+1 > SZ_SBUF)
+		status = ERR
+	    else {
+		call strcpy (Memc[fname], p_sbuf[new], SZ_SBUF-new+1)
+	    
+		p_arg[2]  = new
+		p_sbuflen = SZ_SBUF
+
+		if (ki_sendrcv (server1, KI_ZFMKCP, 0) == ERR)
+		    status = ERR
+		else
+		    status = p_arg[1]
+	    }
+
+	} else if (server1 != NULL && server2 != NULL) {
+	    # Both files are remote.  Cannot transfer all attributes;
+	    # the best we can do is create either a text or binary file.
+
+	    call kfacss (old_osfn, 0, TEXT_FILE, status)
+            call strpak (Memc[fname], Memc[fname], SZ_FNAME)
+
+	    if (status == YES) {
+		# Create a text file.
+		call kopntx (new_osfn, NEW_FILE, chan)
+		if (chan != ERR) {
+		    call kclstx (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    } else {
+		# Create a binary file.
+		call kopnbf (new_osfn, NEW_FILE, chan)
+		if (chan != ERR) {
+		    call kclsbf (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    }
+
+	} else if (server1 != NULL) {
+	    # The existing file is remote.  Cannot transfer all attributes;
+	    # the best we can do is create either a text or binary file.
+	    # Call ZFACSS to determine the file type of the existing file
+	    # and create a null length text or binary file.
+
+	    call kfacss (old_osfn, 0, TEXT_FILE, status)
+            call strpak (Memc[fname], Memc[fname], SZ_FNAME)
+
+	    if (status == YES) {
+		# Create a text file.
+		call zopntx (Memc[fname], NEW_FILE, chan)
+		if (chan != ERR) {
+		    call zclstx (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    } else {
+		# Create a binary file.
+		call zopnbf (Memc[fname], NEW_FILE, chan)
+		if (chan != ERR) {
+		    call zclsbf (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    }
+
+	} else {
+	    # The new file is remote.
+
+	    call strpak (p_sbuf[old], p_sbuf[old], SZ_SBUF)
+	    call zfacss (p_sbuf[old], 0, TEXT_FILE, status)
+
+	    if (status == YES) {
+		# Create a text file.
+		call kopntx (new_osfn, NEW_FILE, chan)
+		if (chan != ERR) {
+		    call kclstx (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    } else {
+		# Create a binary file.
+		call kopnbf (new_osfn, NEW_FILE, chan)
+		if (chan != ERR) {
+		    call kclsbf (chan, junk)
+		    status = chan
+		} else
+		    status = ERR
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/ki/kfmkdr.x b/sys/ki/kfmkdr.x
new file mode 100644
index 00000000..8e32ac50
--- /dev/null
+++ b/sys/ki/kfmkdr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFMKDR -- Make a new directory.
+
+procedure kfmkdr (osfn, status)
+
+char	osfn[ARB]		# packed os filename of directory
+int	status			# ok or err
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfmkdr (p_sbuf, status)
+
+	} else {
+	    if (ki_sendrcv (server, KI_ZFMKDR, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfpath.x b/sys/ki/kfpath.x
new file mode 100644
index 00000000..6522e5f2
--- /dev/null
+++ b/sys/ki/kfpath.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"ki.h"
+
+# KFPATH -- Convert a VFN into a net pathname.  The VFN may contain a node
+# pathname and the final pathname will always include the node name.	
+
+procedure kfpath (vfn, osfn, maxch, nchars)
+
+char	vfn[ARB]		# virtual filename
+char	osfn[maxch]		# receives pathname
+int	maxch			# max chars out
+int	nchars			# receives length of osfn string
+
+int	delim, op, nodeflag, junk
+int	ki_gnode(), gstrcpy(), ki_gethosts()
+include	"kinode.com"
+
+begin
+	# Read the host name table if it has not been read yet.
+	if (n_nnodes == 0)
+	    junk = ki_gethosts()
+
+	# If no VFN is given return the current working directory.
+	if (vfn[1] == EOS) {
+	    call kfgcwd (osfn, maxch, nchars)
+	    call strupk (osfn, osfn, maxch)
+	    return
+	}
+
+	# Determine what node the given VFN resides on.
+	nodeflag = ki_gnode (vfn, osfn, delim)
+
+	# Append the node delimiter to the node name if there is a node name.
+	for (op=1;  osfn[op] != EOS;  op=op+1)
+	    ;
+	if (op > 1) {
+	    osfn[op] = FNNODE_CHAR
+	    op = op + 1
+	}
+
+	if (nodeflag == LOCAL) {
+	    # File is on the local node.  Return the mapped pathname with
+	    # the node name of the local node prepended.
+
+	    call zfpath (vfn[delim+1], osfn[op], maxch-op+1, nchars)
+	    nchars = nchars + op - 1
+
+	} else {
+	    # File is on a remote node.  Do not map the filename; leave that
+	    # to the kernel when the file is referenced at runtime.
+
+	    nchars = gstrcpy (vfn[delim+1], osfn[op], maxch-op+1) + op - 1
+	}
+end
diff --git a/sys/ki/kfprot.x b/sys/ki/kfprot.x
new file mode 100644
index 00000000..d2338d8f
--- /dev/null
+++ b/sys/ki/kfprot.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFPROT -- Set or query file protection.
+
+procedure kfprot (osfn, protflag, status)
+
+char	osfn[ARB]		# packed os filename
+int	protflag		# set/query flag
+int	status			# answer; yes or no
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfprot (p_sbuf, protflag, status)
+
+	} else {
+	    p_arg[2]  = protflag
+
+	    if (ki_sendrcv (server, KI_ZFPROT, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfrmdr.x b/sys/ki/kfrmdr.x
new file mode 100644
index 00000000..e468a86f
--- /dev/null
+++ b/sys/ki/kfrmdr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFRMDR -- Remove a directory.
+
+procedure kfrmdr (osfn, status)
+
+char	osfn[ARB]		# packed os filename of directory
+int	status			# ok or err
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfrmdr (p_sbuf, status)
+
+	} else {
+	    if (ki_sendrcv (server, KI_ZFRMDR, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfrnam.x b/sys/ki/kfrnam.x
new file mode 100644
index 00000000..d2600aaa
--- /dev/null
+++ b/sys/ki/kfrnam.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+
+# KFRNAM -- Rename a file.  Both filenames must refer to the same node.
+
+procedure kfrnam (old_osfn, new_osfn, status)
+
+char	old_osfn[ARB]		#I packed old os filename
+char	new_osfn[ARB]		#I packed new os filename
+int	status			#O answer; ok or err
+
+pointer	sp, fname
+int	server1, server2, old, new
+int	ki_connect(), ki_sendrcv(), strlen()
+include	"kii.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	server2 = ki_connect (new_osfn)
+	call strcpy (p_sbuf[p_arg[1]], Memc[fname], SZ_FNAME)
+	server1 = ki_connect (old_osfn)
+	old = p_arg[1]
+
+	if (server1 == NULL && server2 == NULL) {
+	    # Both files reside on the local node.
+
+	    call strpak (p_sbuf[old], p_sbuf[old], SZ_SBUF)
+	    call strpak (Memc[fname], Memc[fname], SZ_FNAME)
+	    call zfrnam (p_sbuf[old], Memc[fname], status)
+
+	} else if (server1 == server2) {
+	    # Both files reside on the same remote node.  Pack the two
+	    # filenames into p_sbuf and send the request.
+
+	    new = old + strlen(p_sbuf[old])+1 + 1
+	    if (new + strlen(Memc[fname])+1 > SZ_SBUF)
+		status = ERR
+	    else {
+		call strcpy (Memc[fname], p_sbuf[new], SZ_SBUF-new+1)
+
+		p_arg[2]  = new
+		p_sbuflen = SZ_SBUF
+
+		if (ki_sendrcv (server1, KI_ZFRNAM, 0) == ERR)
+		    status = ERR
+		else
+		    status = p_arg[1]
+	    }
+
+	} else {
+	    # One file resides on a remote node.
+	    status = ERR
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/ki/kfsubd.x b/sys/ki/kfsubd.x
new file mode 100644
index 00000000..93f2d655
--- /dev/null
+++ b/sys/ki/kfsubd.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ki.h"
+
+# KFSUBD -- Compute the net pathname of a subdirectory given the net pathname
+# of the parent directory and the name of the subdirectory (the logical
+# subdirectory names . and .. are supported).  If the subdirectory resides on
+# the local node we call the local kernel to compute the new directory pathname.
+# If the directory resides on a remote node we merely append to the virtual
+# pathname, leaving resolution of the final pathname to the remote kernel when
+# the file is referenced at runtime.
+
+procedure kfsubd (osdir, maxch, subdir, nchars)
+
+char	osdir[maxch]		#RW net pathname of directory
+int	maxch			#RO max chars out in osdir string
+char	subdir[ARB]		#RO receives pathname
+int	nchars			#WO receives length of osfn string
+
+int	delim, op
+char	alias[SZ_ALIAS]
+int	ki_gnode(), gstrcat()
+
+begin
+	if (ki_gnode (osdir, alias, delim) == LOCAL) {
+	    # Directory is on the local node.
+
+	    if (osdir[delim+1] == EOS) {
+		call zfgcwd (osdir[delim+1], maxch - delim, nchars)
+		if (nchars == ERR)
+		    return
+		call strupk (osdir[delim+1], osdir[delim+1], maxch-delim)
+	    }
+	    call zfsubd (osdir[delim+1], maxch - delim, subdir, nchars)
+	    if (nchars != ERR)
+		nchars = nchars + delim
+
+	} else {
+	    # File is on a remote node.  Do not map the filename; leave that
+	    # to the kernel when the file is referenced at runtime.  The OSDIR
+	    # string is assumed to be a concatenatable VFN (with node prefix).
+
+	    op = gstrcat (subdir, osdir, maxch) + 1
+	    if (op > 1 && osdir[op-1] != '/') {
+		osdir[op] = '/'
+		op = op + 1
+		osdir[op] = EOS
+	    }
+
+	    nchars = op - 1
+	}
+end
diff --git a/sys/ki/kfutim.x b/sys/ki/kfutim.x
new file mode 100644
index 00000000..a4b81156
--- /dev/null
+++ b/sys/ki/kfutim.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KFUTIM -- Set the file access/modify times of a file.   Time arguments are
+# assumed to be in units of seconds from midnight on Jan 1, 1980, LST.
+#
+# NOTE:  Since the atime/mtime values are long but the p_arg[] is just int
+# this code may need to be revised if the sizes of long/int change.
+
+procedure kfutim (osfn, atime, mtime, status)
+
+char	osfn[ARB]		# packed os filename
+long	atime, mtime		# access and modify times
+int	status			# answer; ok or err
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zfutim (p_sbuf, atime, mtime, status)
+
+	} else {
+	    p_arg[2] = atime
+	    p_arg[3] = mtime
+
+	    if (ki_sendrcv (server, KI_ZFUTIM, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kfxdir.x b/sys/ki/kfxdir.x
new file mode 100644
index 00000000..3a4209ba
--- /dev/null
+++ b/sys/ki/kfxdir.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"ki.h"
+
+# KFXDIR -- Extract the OSDIR prefix (if any) from a filename.  If the VFN
+# has a node prefix and the node named is not the local node then the entire
+# filename is treated as an OSDIR name.  We are called during filename mapping
+# to determine if a VFN is an OSFN; returning nchars > 0 when there is a node
+# name prefix causes filename mapping to be deferred until the filename is
+# passed to the kernel server on the remote node.
+#
+# NOTE -- The "nchars" returned is the length of the osdir prefix portion of
+# the VFN string, NOT the length of the returned string.  ZFXDIR is used to
+# test if a VFN has an OSDIR prefix and if so, to determine the string offset
+# of the root field. 
+
+procedure kfxdir (vfn, osdir, maxch, nchars)
+
+char	vfn[ARB]		# virtual filename
+char	osdir[maxch]		# receives os directory prefix
+int	maxch			# max chars out
+int	nchars			# receives length of osdir prefix in VFN string
+
+int	delim, op
+int	ki_gnode(), gstrcpy(), ki_gethosts()
+include	"kinode.com"
+
+begin
+	repeat {
+	    if (ki_gnode (vfn, osdir, delim) == LOCAL) {
+		# File is on the local node.  Must strip the node prefix,
+		# if any, before calling zfxdir, but keep the node prefix
+		# in the output pathname else the next operator will assume
+		# the default node.
+
+		for (op=1;  osdir[op] != EOS;  op=op+1)
+		    ;
+		if (op > 1) {
+		    osdir[op] = FNNODE_CHAR
+		    op = op + 1
+		}
+
+		call zfxdir (vfn[delim+1], osdir[op], maxch-op+1, nchars)
+		if (nchars == 0)
+		    osdir[1] = EOS
+		else
+		    nchars = nchars + delim
+
+		break
+
+	    } else {
+		# Verify that the host name table has been read and if not,
+		# read it and try again.
+
+		if (n_nnodes == 0)
+		    if (ki_gethosts() != ERR)
+			next
+
+		# File is on a remote node.  Concatenate node name and filename
+		# and return the entire string as the "osdir" string, disabling
+		# filename mapping on the local node.
+
+		for (op=1;  osdir[op] != EOS;  op=op+1)
+		    ;
+
+		if (op > 1) {
+		    osdir[op] = FNNODE_CHAR
+		    op = op + 1
+		}
+
+		nchars = gstrcpy (vfn[delim+1], osdir[op], maxch-op+1) + delim
+		break
+	    }
+	}
+end
diff --git a/sys/ki/kgfdir.x b/sys/ki/kgfdir.x
new file mode 100644
index 00000000..01926195
--- /dev/null
+++ b/sys/ki/kgfdir.x
@@ -0,0 +1,124 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KGFDIR -- Get the next filename from a directory file.  Rather than make a
+# call over the net to read each filename, which would be very slow, we read
+# filenames in large batches and return filenames out of our internal buffer.
+
+procedure kgfdir (chan, osfn, maxch, status)
+
+int	chan			# channel descriptor
+char	osfn[maxch]		# receives packed OS filename
+int	maxch			# maxchars out
+int	status			# answer; ok or err
+
+pointer	dp, bp, ip, op
+pointer	sp, vfn, root, extn
+int	server, nchars, len_root, len_extn
+int	ki_sendrcv(), gstrcpy()
+include	"kichan.com"
+include	"kii.com"
+define	quit_ 91
+
+begin
+	server = k_node[chan]
+
+	if (server == NULL) {
+	    call zgfdir (k_oschan[chan], osfn, maxch, status)
+
+	} else {
+	    call smark (sp)
+	    call salloc (vfn, SZ_PATHNAME, TY_CHAR)
+	    call salloc (root, SZ_FNAME, TY_CHAR)
+	    call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	    dp = k_bufp[chan]
+	    bp = D_DATA(dp)
+
+	    if (D_IP(dp) >=  D_ITOP(dp)) {
+		# Refill buffer.
+
+		# If the last block of data was returned with the EOF flag
+		# set then the directory has been exhausted.
+
+		if (D_EOFSEEN(dp) == YES) {
+		    status = EOF
+		    goto quit_
+		}
+
+		p_arg[1]  = k_oschan[chan]
+		p_arg[2]  = SZ_DIRDATA
+		p_sbuflen = 0
+
+		if (ki_sendrcv (server, KI_ZGFDIR, 0) == ERR) {
+		    status = ERR
+		    goto quit_
+		} else if (p_arg[1] == ERR) {
+		    status = ERR
+		    goto quit_
+		} else if (p_arg[1] <= 0) {
+		    status = EOF
+		    goto quit_
+		}
+
+		nchars = p_arg[1]
+		if (nchars <= SZ_SBUF) {
+		    call amovc (p_sbuf, Memc[bp], nchars)
+		    p_sbuflen = nchars
+		} else {
+		    call ks_aread (server, Memc[bp], nchars)
+		    call ks_await (server, status)
+
+		    if (status != nchars) {
+			status = ERR
+			goto quit_
+		    } else
+			call chrupk (Memc[bp], 1, Memc[bp], 1, nchars)
+		}
+
+		D_IP(dp)      = bp
+		D_ITOP(dp)    = bp + nchars
+		D_EOFSEEN(dp) = p_arg[2]
+	    }
+
+	    # Return the next filename from the buffer.
+
+	    for (ip=D_IP(dp);  ip < D_ITOP(dp) && Memc[ip] != '\n';  ip=ip+1)
+		;
+	    Memc[ip] = EOS
+
+	    if (ip > D_IP(dp)) {
+		# A kernel server always returns unmapped (IRAF) filenames since
+		# the unmapping must be performed on the host where the files
+		# are.  We must map these into local host filenames since that
+		# is what the kernel interface is supposed to return.
+
+		call vfn_encode (Memc, D_IP(dp),
+		    Memc[root], len_root, Memc[extn], len_extn)
+		if (len_extn > 0)
+		    call vfn_map_extension (Memc[extn], Memc[extn], SZ_FNAME)
+
+		op = vfn + gstrcpy (Memc[root], Memc[vfn], SZ_PATHNAME)
+		if (len_extn > 0) {
+		    Memc[op] = '.'
+		    op = op + 1
+		    op = op + gstrcpy (Memc[extn], Memc[op], ARB)
+		}
+
+		# Return a packed (local) host filename.
+		call strpak (Memc[vfn], osfn, maxch)
+	    } else
+		op = vfn
+
+	    status = op - vfn
+	    if (status <= 0)
+		status = EOF
+
+	    D_IP(dp) = ip + 1
+quit_
+	    call sfree (sp)
+	}
+end
diff --git a/sys/ki/ki.h b/sys/ki/ki.h
new file mode 100644
index 00000000..76140c8b
--- /dev/null
+++ b/sys/ki/ki.h
@@ -0,0 +1,139 @@
+# KI.H -- IRAF Kernel Interface definitions.
+
+define	MAX_NODES	512		# max nodes known to KI
+define	MAX_CHANNELS	LAST_FD		# requires <config.h>
+define	MAX_INDIRECT	20		# max indirection in a route
+define	MAX_ALIAS	6		# maximum number of aliases per node
+define	SZ_ALIAS	16		# size of a node name alias
+define	SZ_SERVER	128		# size of a server name
+define	HNT_SUBDIR	"dev"		# parts of host name table filename
+define	HNT_FILENAME	"hosts"		# default host name table
+define	HNT_ENVNAME	"irafhnt"	# user host name table
+
+define	READ_IN_PROGRESS (-11)		# used in binary file i/o
+define	OSHIFT		128		# optype= (opcode * OSHIFT) + subcode
+define	FIRST_CHAN	4		# first available kchan.
+define	LOCAL		0		# node is a local node
+define	REMOTE		1		# node is a remote node
+
+# Node status flags.
+define	F_IOERR		01B		# fatal error on kschan
+define	F_REUSE		02B		# node descriptor may be reused
+
+# ZFIOTX buffer descriptor.
+
+define	SZ_TXBUF	16386		# size of text file buffer (should be
+					# at least (2*LEN_SEQBUF*SZ_LINE))
+define	LEN_TXBDES	(5+SZ_TXBUF/SZ_STRUCT)
+
+define	B_CI		Memi[$1]	# character index into current record
+define	B_RP		Memi[$1+1]	# pointer to current record
+define	B_ITOP		Memi[$1+2]	# end of input buffer
+define	B_OTOP		Memi[$1+3]	# end of output buffer
+define	B_BUFTOP	Memi[$1+4]	# end of buffer
+define	B_BUFPTR	P2C(($1)+5)	# first char of buffer
+
+# ZGFDIR buffer descriptor.
+
+define	SZ_DIRDATA	2048		# amount of directory data to read
+define	LEN_DIRBDES	(5+SZ_DIRDATA/SZ_STRUCT)
+
+define	D_IP		Memi[$1]	# input pointer into dirbuf
+define	D_ITOP		Memi[$1+1]	# top of dirbuf
+define	D_EOFSEEN	Memi[$1+2]	# dirbuf contains last of data
+define	D_DATA		P2C(($1)+5)	# pointer to data area
+
+# Record descriptor structure (format of a line of text record in the input
+# buffer when reading from a remote text file).
+
+define	R_RECLEN	Memc[$1]	# encoded record length (2 chars)
+define	R_SEKOFF	Memc[$1+2]	# encoded seek offset (5 chars)
+define	R_DATA		(($1)+7)	# pointer to data text
+
+define	NCHARS_INT	2		# nchars to encode an int
+define	NCHARS_LONG	5		# nchars to encode a long
+define	R_GETNCHARS	(($1)-7)	# reclen to nchars
+define	R_GETRECLEN	(($1)+7)	# nchars to reclen
+
+# KII instruction format.
+
+define	LEN_INTFIELDS	16		# number of integer fields
+define	FIRSTINTFIELD	p_opcode	# first integer field in common
+define	MAX_ARGS	13		# max procedure arguments
+define	SZ_SBUF		255		# size of string buffer
+define	SZB_PACKET	320		# packet size, bytes
+
+# KII opcodes.
+
+define	KI_ENVINIT	1
+define	KI_SETROOT	2
+define	KI_ZOSCMD	3
+define	KI_FMAPFN	4
+
+define	KI_ZFACSS	10
+define	KI_ZFALOC	11
+define	KI_ZFCHDR	12
+define	KI_ZFDELE	13
+define	KI_ZFINFO	14
+define	KI_ZFGCWD	15
+define	KI_ZFMKCP	16
+define	KI_ZFMKDR	17
+define	KI_ZFPATH	18
+define	KI_ZFPROT	19
+define	KI_ZFRNAM	20
+define	KI_ZFRMDR	21
+define	KI_ZFSUBD	22
+define	KI_ZDVALL	23
+define	KI_ZDVOWN	24
+define	KI_ZFUTIM	25
+
+define	KI_ZOPDIR	30
+define	KI_ZCLDIR	31
+define	KI_ZGFDIR	32
+
+define	KI_ZOPDPR	35
+define	KI_ZCLDPR	36
+define	KI_ZOPCPR	37
+define	KI_ZCLCPR	38
+define	KI_ZINTPR	39
+
+# Device driver opcodes.  BF must be the lowest numbered binary file driver
+# and TX must be the lowest number text file driver.
+
+define	KI_ZFIOBF	40
+define	KI_ZFIOLP	41
+define	KI_ZFIOPL	42
+define	KI_ZFIOPR	43
+define	KI_ZFIOSF	44
+define	KI_ZFIOGD	45
+
+define	KI_ZFIOTX	50
+define	KI_ZFIOTY	51
+
+define	KI_ZFIOMT	55
+
+# KII subcodes.
+
+define	BF_OPN		1		# binary files (BF, SF, PR, PL, etc.)
+define	BF_CLS		2
+define	BF_ARD		3
+define	BF_AWR		4
+define	BF_AWT		5
+define	BF_STT		6
+
+define	TX_OPN		1		# text files (TX, TY)
+define	TX_CLS		2
+define	TX_GET		3
+define	TX_PUT		4
+define	TX_FLS		5
+define	TX_SEK		6
+define	TX_NOT		7
+define	TX_STT		8
+
+define	MT_OP		1		# magtape zz-routines
+define	MT_CL		2
+define	MT_RD		3
+define	MT_WR		4
+define	MT_WT		5
+define	MT_ST		6
+define	MT_RW		7
diff --git a/sys/ki/kichan.com b/sys/ki/kichan.com
new file mode 100644
index 00000000..b810400f
--- /dev/null
+++ b/sys/ki/kichan.com
@@ -0,0 +1,8 @@
+# KICHAN.COM -- Channel descriptor common for the kernel interface.
+
+int	k_node[MAX_CHANNELS]		# kernel server node (NULL if local)
+int	k_oschan[MAX_CHANNELS]		# iraf kernel (host) channel or PID
+int	k_status[MAX_CHANNELS]		# status holding word for ZSTT
+pointer	k_bufp[MAX_CHANNELS]		# buffer pointer
+
+common	/kichan/ k_node, k_oschan, k_status, k_bufp
diff --git a/sys/ki/kiconnect.x b/sys/ki/kiconnect.x
new file mode 100644
index 00000000..ed382096
--- /dev/null
+++ b/sys/ki/kiconnect.x
@@ -0,0 +1,115 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<chars.h>
+include	"ki.h"
+
+# KI_CONNECT -- Given a resource name (e.g., a VFN, OSFN, or any string
+# which might begin with a node name prefix) extract the node name alias,
+# if any, and return the node index of the kernel server for the node.
+# NULL is returned if the resource does not reside on a remote node,
+# if the named node is not recognized, if the resource resides on the local
+# node, or if a kernel server cannot be spawned on the node.
+#
+# SIDE-EFFECTS:  In all cases the unpacked name, minus the node name prefix,
+# is left in the field P_SBUF of the kschan common, i.e., in the packet to be
+# sent to the node to service the request.  This stripped name should be used
+# even if the resource is local since the node prefix must not be passed to the
+# iraf kernel.  If the resource resides on a remote node the P_ARG[1] field is
+# set to 1 (the index of the string in the string buffer) and the P_SBUFLEN
+# field is set to the length of the unpacked string plus 1 for the EOS.
+
+int procedure ki_connect (rname)
+
+char	rname[ARB]		# packed resource name, e.g., a filename
+
+pointer	sp, sbuf, op
+char	alias[SZ_ALIAS]
+int	node, delim, junk, nlookup
+int	ki_findnode(), ki_openks(), ki_gnode(), ki_gethosts()
+int	strlen(), gstrcpy()
+
+include	"kinode.com"
+include	"kichan.com"
+include	"kii.com"
+define	again_ 91
+
+begin
+	# Read dev$hosts if it has not already been read.
+	if (n_nnodes == 0)
+	    junk = ki_gethosts()
+
+	# Unpack rname into the string buffer, search for the node character.
+	# The call to KI_GETHOSTS will fail during process startup until the
+	# environment variable "iraf" is defined.  This is harmless provided
+	# only local files are referenced during process startup.  Do not
+	# move this initialization code to ki_init() or the host name table
+	# will never be read and networking will never be turned on.  Return
+	# immediately if no nodechar found.
+	#
+	# NOTE: we are required to always leave the unpacked, node prefix
+	# stripped resource name in p_sbuf, whether or not the resource is
+	# on a remote node.
+
+	call strupk (rname, p_sbuf, SZ_SBUF)
+	nlookup = 0
+again_
+	if (ki_gnode (p_sbuf, alias, delim) == LOCAL) {
+	    p_arg[1] = delim + 1
+	    return (NULL)
+	} else
+	    p_arg[1] = delim + 1
+
+	# Find node descriptor (initialized by ki_gethosts above).  NULL is
+	# returned for ND if the node is not found or if the node is the
+	# local node.
+
+	node = ki_findnode (alias)
+	if (node == n_local)
+	    node = NULL
+	else if (n_server[1,node] == '@') {
+	    # The node entry is a route to another node.  This is an entry
+	    # such as "node : @foo!node".  We replace the "node" prefix in
+	    # rname by whatever is to the right of the @, and repeat the
+	    # host lookup.  In the example this would have the effect of
+	    # changing the "node!object" reference to "foo!node!object" and
+	    # hence routing traffic for node "node" through node "foo".  
+	    # This is often done when a node is not directly reachable on
+	    # the local network.
+
+	    call smark (sp)
+	    call salloc (sbuf, SZ_SBUF, TY_CHAR)
+
+	    op = sbuf + gstrcpy (n_server[2,node], Memc[sbuf], SZ_SBUF)
+	    Memc[op] = '!';  op = op + 1
+	    call strcpy (p_sbuf[delim+1], Memc[op], SZ_SBUF-(op-sbuf))
+	    call strcpy (Memc[sbuf], p_sbuf, SZ_SBUF)
+
+	    call sfree (sp)
+
+	    nlookup = nlookup + 1
+	    if (nlookup > MAX_INDIRECT)
+		node = NULL
+	    else
+		goto again_
+	}
+
+	# Initialize the remainder of the packet descriptor variables dealing
+	# with the resource name.  The node alias is left in the string buffer
+	# at offset 1, now terminated with an EOS.  This is followed by RNAME
+	# minus the node name prefix.  Note that RNAME may contain additional
+	# indirection; only the first node name is processed locally.
+
+	if (node != NULL) {
+	    # Resource resides on a remote node.  Connect the kernel server
+	    # if not already connected.
+
+	    p_sbuflen = strlen (p_sbuf)
+	    if (n_kschan[node] == NULL)
+		if (ki_openks (node) == ERR)
+		    node = NULL
+	}
+
+	return (node)
+end
diff --git a/sys/ki/kiencode.x b/sys/ki/kiencode.x
new file mode 100644
index 00000000..463579e4
--- /dev/null
+++ b/sys/ki/kiencode.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# KI_ENCODE -- Encode an integer into the indicated number of chars for
+# transmission between machines via a byte stream.
+
+procedure ki_encode (data, str, nchars)
+
+long	data			# data value to be encoded
+char	str[nchars]		# output chars
+int	nchars			# number of chars to be encoded
+
+int	i
+long	v, nv
+
+begin
+	v = abs (data)
+
+	do i = 1, nchars {
+	    nv = v / 128
+	    str[i] = v - (nv * 128)
+	    v = nv
+	}
+
+	if (data < 0)
+	    if (str[1] == 0)
+		str[1] = -128
+	    else
+		str[1] = -str[1]
+end
+
+
+# KI_DECODE -- Decode the long integer value encoded by ki_encode, returning
+# the long integer value as the function value.
+
+long procedure ki_decode (str, nchars)
+
+char	str[ARB]		# string to be decoded
+int	nchars			# number of chars to decode
+
+bool	neg
+int	pow, i
+long	sum
+
+begin
+	sum = str[1]
+	neg = (sum < 0)
+	if (neg)
+	    if (sum == -128)
+		sum = 0
+	    else
+		sum = -sum
+
+	pow = 1
+
+	do i = 2, nchars {
+	    pow = pow * 128
+	    sum = sum + (str[i] * pow)
+	}
+
+	if (neg)
+	    return (-sum)
+	else
+	    return (sum)
+end
diff --git a/sys/ki/kienvreset.x b/sys/ki/kienvreset.x
new file mode 100644
index 00000000..5a69c519
--- /dev/null
+++ b/sys/ki/kienvreset.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KI_ENVRESET -- Update the value of an environment variable on all currently
+# connected nodes.
+
+procedure ki_envreset (name, value)
+
+char	name[ARB]		#I name of environment variable
+char	value[ARB]		#I value of environment variable
+
+pointer	sp, buf, op
+int	node, junk, ch
+int	gstrcpy(), ki_send()
+bool	streq()
+
+include	"kii.com"
+include	"kinode.com"
+define	quit_ 91
+
+begin
+	# Do not propagate the host-specific iraf definitions "iraf", "host",
+	# and "tmp" over the network.
+
+	ch = name[1]
+	if (ch == 'i' || ch == 'h' || ch == 't')
+	    if (streq(name,"iraf") || streq(name,"host") || streq(name,"tmp"))
+		return
+
+	call smark (sp)
+	call salloc (buf, SZ_COMMAND, TY_CHAR)
+
+	# Format the SET statement to be sent to each node.
+	op = buf + gstrcpy ("set ", Memc[buf], SZ_COMMAND)
+	op = op + gstrcpy (name, Memc[op], SZ_COMMAND - 4)
+	Memc[op] = '=';  op = op + 1
+	Memc[op] = '"';  op = op + 1
+	op = op + gstrcpy (value, Memc[op], SZ_COMMAND - (op - buf))
+	Memc[op] = '"';  op = op + 1
+	Memc[op] = '\n';  op = op + 1
+	Memc[op] = EOS
+
+	# Transmit the SET statement to each node currently running a kernel
+	# server process.  This is done without reading back a status value
+	# to permit pipelining of multiple set environment packets.
+
+	for (node=1;  node <= n_nnodes;  node=node+1) {
+	    if (n_kschan[node] == NULL)
+		next
+
+	    # Set up control packet.
+	    p_sbuflen = gstrcpy (Memc[buf], p_sbuf, SZ_SBUF)
+	    p_arg[1] = p_sbuflen
+
+	    # Transmit packet.
+	    if (ki_send (node, KI_ENVINIT, 0) == ERR)
+		goto quit_
+	}
+
+	call sfree (sp)
+	return
+quit_
+	call zclsks (n_kschan[node], junk)
+	n_kschan[node] = NULL
+	call sfree (sp)
+end
diff --git a/sys/ki/kierror.x b/sys/ki/kierror.x
new file mode 100644
index 00000000..159b0707
--- /dev/null
+++ b/sys/ki/kierror.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+include "ki.h"
+
+# KI_ERROR -- Called when an i/o error occurs on the channel to a remote
+# kernel server process.  Note that this is not the same as an i/o error
+# on a channel accessed on the remote node via the KI; when we are called
+# we assume that further communications with the kernel server are impossible.
+#
+# Error recover strategy:
+#
+# We shut down the ZFIOKS channel to the server and set the error bit in the
+# status word for the node.  Note that we cannot return the node descriptor
+# until all of the remote OS channels (pids, etc.) multiplexed to the remote
+# node are closed on the local, client node.  Any further i/o requests on the
+# node will cause ERR to be returned without any attempt to do i/o.  A connect
+# request on the node will cause another kernel server to be spawned and 
+# another node descriptor to be allocated.  If and when all kichan descriptors
+# using the bad node are freed, the node descriptor will be freed.
+
+procedure ki_error (server)
+
+int	server			# kernel server node
+
+int	junk, node, i
+int	or(), and()
+include	"kinode.com"
+
+begin
+	# Close the kernel server channel and set the error bit in the
+	# node descriptor.
+
+	call zclsks (n_kschan[server], junk)
+	n_status[server] = or (n_status[server], F_IOERR)
+
+	# Allocate a new node descriptor for use by the next connection
+	# on the node.  If a node descriptor on which an error has occurred
+	# is later freed the F_REUSE bit will have been set in the status
+	# word (and the other bits cleared) so that we may reuse the
+	# descriptor.
+
+	node = 0
+	do i = 1, n_nnodes
+	    if (and (n_status[i], F_REUSE) != 0) {
+		node = i
+		break
+	    }
+	if (node == 0) {
+	    n_nnodes = n_nnodes + 1
+	    if (n_nnodes > MAX_NODES)
+		return
+	    node = n_nnodes
+	}
+
+	# Initialize the new node descriptor.  It is not necessary to transfer
+	# the n_local index since an i/o error cannot occur on the local node.
+
+	n_kschan[node] = NULL
+	n_status[node] = 0
+	n_nalias[node] = n_nalias[server]
+
+	call strcpy (n_server[1,server], n_server[1,node], SZ_SERVER)
+	do i = 1, n_nalias[node]
+	    call strcpy (n_alias[1,i,server], n_alias[1,i,node], SZ_ALIAS)
+end
diff --git a/sys/ki/kiextnode.x b/sys/ki/kiextnode.x
new file mode 100644
index 00000000..672fcbc4
--- /dev/null
+++ b/sys/ki/kiextnode.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"ki.h"
+
+# KI_EXTNODE -- Extract the node name prefix from a resource name of the form
+# "node!resource".  The entire prefix is returned, i.e., "node!".  The number
+# of chars in the prefix string is returned as the function value; zero is
+# returned if there is no node prefix.  The name of the node owning the named
+# resource is returned in the output string.  If no node is named in the
+# resource name supplied, the name of the default node (usually the local or
+# host node) is returned instead.  Note that the function value refers to the
+# prefix string, not the string length of the nodename string.
+
+int procedure ki_extnode (resource, nodename, maxch, nchars)
+
+char	resource[ARB]		# name of a resource, with opt. node prefix
+char	nodename[maxch]		# receives node name
+int	maxch			# max chars out
+int	nchars			# receives nchars in nodename string
+
+char	alias[SZ_ALIAS]
+int	delim, op, junk, node
+int	ki_gnode(), ki_findnode(), gstrcpy()
+include	"kinode.com"
+
+begin
+	# Extract node name prefix, if any, and replace by primary alias.
+	junk = ki_gnode (resource, alias, delim)
+	if (delim > 0) {
+	    node = ki_findnode (alias)
+	    if (node > 0)
+		op = gstrcpy (n_alias[1,1,node], nodename, maxch) + 1
+	    else
+		op = gstrcpy (alias, nodename, maxch) + 1
+	} else
+	    op = 1
+
+	# Append the node prefix delimiter character.
+	if (op > 1 && op <= maxch) {
+	    nodename[op] = FNNODE_CHAR
+	    op = op + 1
+	    nodename[op] = EOS
+	}
+
+	nodename[op] = EOS
+	nchars = op - 1
+
+	return (delim)
+end
diff --git a/sys/ki/kifchan.x b/sys/ki/kifchan.x
new file mode 100644
index 00000000..199212b2
--- /dev/null
+++ b/sys/ki/kifchan.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+include "ki.h"
+
+# KI_FREECHAN -- Free a channel descriptor slot.  Decrement the reference
+# count on the associated node descriptor slot; when the ref count reaches
+# zero, free the node descriptor if the error bit is set.  If the error
+# bit is not set the node descriptor is not freed because the kernel server
+# remains connected, ready for reuse.
+
+procedure ki_freechan (chan)
+
+int	chan			# kichan channel descriptor
+
+int	server, and()
+include	"kichan.com"
+include	"kinode.com"
+
+begin
+	server = k_node[chan]
+
+	# Server=0 if local node.
+	if (server > 0) {
+	    n_nrefs[server] = n_nrefs[server] - 1
+	    if (and (n_status[server], F_IOERR) != 0)
+		if (n_nrefs[server] == 0)
+		    n_status[server] = F_IOERR + F_REUSE
+	}
+	    
+	k_oschan[chan] = NULL
+end
diff --git a/sys/ki/kifmapfn.x b/sys/ki/kifmapfn.x
new file mode 100644
index 00000000..3869f7c4
--- /dev/null
+++ b/sys/ki/kifmapfn.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	"ki.h"
+
+# KI_FMAPFN -- Fully resolve a filename into its host equivalent, regardless
+# of the node on which the file resides.  This is a temporary routine.
+# The filename mapping primitives should probably perform their function when
+# called for a remote file, rather than defer the mapping until later as they
+# do now.  When this is changed, this routine will no longer be necessary and
+# can be removed.  The output filename is returned as a packed filename with
+# the node name stripped, as for FMAPFN.
+
+procedure ki_fmapfn (vfn, pkosfn, maxch)
+
+char	vfn[ARB]		# network filename
+char	pkosfn[maxch]		# receives packed, fully resolved OS filename
+int	maxch
+
+int	server
+int	ki_connect(), ki_sendrcv()
+include	"kii.com"
+
+begin
+	call strpak (vfn, pkosfn, maxch)
+	server = ki_connect (pkosfn)
+
+	if (server == NULL)
+	    call fmapfn (vfn, pkosfn, maxch)
+	else {
+	    p_arg[2] = maxch
+	    if (ki_sendrcv (server, KI_FMAPFN, 0) == ERR)
+		call syserrs (SYS_FNOSUCHFILE, vfn)
+	    else
+		call strpak (p_sbuf, pkosfn, maxch)
+	}
+end
diff --git a/sys/ki/kifndnode.x b/sys/ki/kifndnode.x
new file mode 100644
index 00000000..f41e7197
--- /dev/null
+++ b/sys/ki/kifndnode.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "ki.h"
+
+# KI_FINDNODE -- Given an alias for a node, search the node descriptor table
+# and return the table index of the named node or NULL.
+
+int procedure ki_findnode (alias)
+
+char	alias[ARB]		# alias to search for
+
+int	node, i
+char	first_char
+bool	streq()
+int	ki_gethosts(), ki_mapname(), and()
+include	"kinode.com"
+
+begin
+	# Read the host name table if it has not been read yet.
+	if (n_nnodes == 0)
+	    if (ki_gethosts() == ERR)
+		return (NULL)
+
+	# Map possible logical node name.
+	if (ki_mapname (alias, n_nodename, SZ_ALIAS) <= 0)
+	    call strcpy (alias, n_nodename, SZ_ALIAS)
+
+	# Search the node descriptor table for a node with the given alias.
+	# Do not use descriptors that have the IOERR flag set.
+
+	first_char = n_nodename[1]
+	for (node=1;  node <= n_nnodes;  node=node+1)
+	    for (i=1;  i <= n_nalias[node];  i=i+1)
+		if (first_char == n_alias[1,i,node])
+		    if (streq (n_nodename, n_alias[1,i,node]))
+			if (and (n_status[node], F_IOERR) == 0)
+			    return (node)
+
+	return (NULL)
+end
diff --git a/sys/ki/kigchan.x b/sys/ki/kigchan.x
new file mode 100644
index 00000000..aa7c4332
--- /dev/null
+++ b/sys/ki/kigchan.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <config.h>
+include "ki.h"
+
+# KI_GETCHAN -- Find the first empty slot in the channel descriptor table
+# and return its index, initializing the server and oschan fields with the
+# values given.
+
+int procedure ki_getchan (server, oschan)
+
+int	server			# kernel server node
+int	oschan			# os channel (iraf kernel channel)
+
+int	i
+include	"kichan.com"
+include	"kinode.com"
+
+begin
+	# Server=0 if local node.
+	if (server > 0)
+	    n_nrefs[server] = n_nrefs[server] + 1
+
+	do i = FIRST_CHAN, MAX_CHANNELS
+	    if (k_oschan[i] == NULL) {
+		# Initialize channel descriptor.
+
+		k_node[i]   = server
+		k_oschan[i] = oschan
+		k_status[i] = 0
+		k_bufp[i]   = NULL
+
+		return (i)
+	    }
+
+	# The following cannot happen unless something is very wrong.
+	call sys_panic (0, "ki_getchan: out of channel slots")
+end
diff --git a/sys/ki/kighost.x b/sys/ki/kighost.x
new file mode 100644
index 00000000..31bebc0f
--- /dev/null
+++ b/sys/ki/kighost.x
@@ -0,0 +1,156 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"ki.h"
+
+# KI_GETHOSTS -- Read the host name table (file) and initialize the node
+# descriptor table (common).  The default hosts table is the file "dev$hosts";
+# a different file may be specified with the environment variable
+# "irafhostnametable".
+
+int procedure ki_gethosts()
+
+pointer	sp, lbuf, osfn, ip
+int	chan, node, ch, op, junk, n, status, i, delim
+
+bool	streq()
+int	ctowrd(), envfind(), ki_gnode()
+include	"kinode.com"
+
+begin
+	call smark (sp)
+	call salloc (osfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE,  TY_CHAR)
+
+	# Null selected node descriptor fields.
+	call aclri (n_kschan, MAX_NODES)
+	call aclri (n_nrefs,  MAX_NODES)
+	call aclri (n_status, MAX_NODES)
+
+	# Process the host name table, ignoring blank lines and comment lines,
+	# until EOF is reached or the maximum number of nodes is exceeded.
+	# The format of a line is the server name followed by the aliases.
+	# Since this is a startup we require that the table file reside on
+	# the local node (not absolutely necessary, but it simplifies things).
+	# Note that since we are called by a z-routine at file open time,
+	# we cannot use high level file i/o to read the HNT file without
+	# reentrancy problems.
+
+	if (envfind (HNT_ENVNAME, Memc[osfn], SZ_PATHNAME) <= 0) {
+	    if (envfind ("iraf", Memc[osfn], SZ_PATHNAME) <= 0) {
+		call sfree (sp)
+		return (ERR)
+	    }
+
+	    # Strip any node prefix from the iraf$ pathname; it had better 
+	    # reference the local node.
+
+	    junk = ki_gnode (Memc[osfn], Memc[lbuf], delim)
+	    if (delim > 0)
+		call strcpy (Memc[osfn+delim], Memc[osfn], SZ_PATHNAME)
+
+	    # Form filename "iraf$subdir/file".
+	    call zfsubd (Memc[osfn], SZ_PATHNAME, HNT_SUBDIR, junk)
+	    call strcat (HNT_FILENAME, Memc[osfn], SZ_PATHNAME)
+	}
+
+	# Open the table file, a text file.
+	call strpak (Memc[osfn], Memc[osfn], SZ_PATHNAME)
+	call zopntx (Memc[osfn], READ_ONLY, chan)
+	if (chan == ERR) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	for (node=0;  node < MAX_NODES;  ) {
+	    call zgettx (chan, Memc[lbuf], SZ_LINE, status)
+	    if (status > 0)
+		Memc[lbuf+status] = EOS
+	    else
+		break
+
+	    # Get the next nonempty, noncomment line.
+	    for (ip=lbuf;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    ch = Memc[ip]
+	    if (ch == '\n' || ch == '#' || ch == EOS)
+		next
+
+	    node = node + 1
+
+	    # Extract the whitespace delimited alias names.  The list of
+	    # aliases is terminated by a colon.
+
+	    n_nalias[node] = 0
+	    n = 1
+
+	    while (ctowrd (Memc, ip, n_alias[1,n,node], SZ_ALIAS) > 0) {
+		while (IS_WHITE (Memc[ip]))
+		    ip = ip + 1
+
+		if (Memc[ip] == ':') {
+		    ip = ip + 1
+		    n_nalias[node] = n
+		    break
+		} else
+		    n = min (MAX_ALIAS, n + 1)
+	    }
+
+	    while (IS_WHITE (Memc[ip]))
+		ip = ip + 1
+
+	    # Extract the kernel server name for the node.  The server name
+	    # string may contain whitespace and is delimited by end of line.
+
+	    for (op=1;  op <= SZ_SERVER;  op=op+1) {
+		ch = Memc[ip]
+		if (ch == '\n' || ch == EOS)
+		    break
+
+		n_server[op,node] = ch
+		ip = ip + 1
+	    }
+
+	    # Strip any trailing whitespace.
+	    while (op > 1 && IS_WHITE(n_server[op-1,node]))
+		op = op - 1
+
+	    # Make sure the server string is null terminated.
+	    n_server[op,node] = EOS
+	}
+
+	n_nnodes = node
+	call zclstx (chan, status)
+
+	# Flag the local node.  One of the aliases must match the name returned
+	# by ZGHOST else the local node will be accessed like a remote node
+	# (you may wish to take advantage of that for debugging).  The default
+	# node name is initialized to the local node.
+
+	n_local = 0
+	n_default = 0
+
+	call strcpy (n_localnode, n_defaultnode, SZ_ALIAS)
+
+	for (node=1;  node <= n_nnodes;  node=node+1)
+	    for (i=1;  i <= n_nalias[node];  i=i+1)
+		if (streq (n_alias[1,i,node], n_localnode)) {
+		    n_local = node
+		    n_default = node
+		    break
+		}
+
+	if (n_local > 0) {
+	    # Add the alias "0" to the alias list for this node.  This is a
+	    # required alias and will overwrite the last alias for the node
+	    # if the alias list is full.
+
+	    n = n_nalias[n_local]
+	    n = min (MAX_ALIAS, n + 1)
+	    n_nalias[n_local] = n
+	    call strcpy ("0", n_alias[1,n,n_local], SZ_ALIAS)
+	}
+
+	call sfree (sp)
+	return (n_nnodes)
+end
diff --git a/sys/ki/kignode.x b/sys/ki/kignode.x
new file mode 100644
index 00000000..96424eff
--- /dev/null
+++ b/sys/ki/kignode.x
@@ -0,0 +1,111 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include "ki.h"
+
+# KI_GNODE -- Extract the node name prefix from a resource name.  The node
+# name delimiter character may be escaped to be included in the resource name.
+# If the resource name does not include an explicit node name the name of the
+# default node is returned.  The function value is LOCAL if the resource resides
+# on the local node.  NOTE: We can be called before initialization of the
+# node descriptor table.
+
+int procedure ki_gnode (rname, outstr, delim)
+
+char	rname[ARB]		# resource name
+char	outstr[SZ_ALIAS]	# receives node name
+int	delim			# receives offset of delim char
+
+int	ch, nchars
+int	ip, op, off, i
+bool	streq()
+int	ki_mapname()
+include	"kinode.com"
+define	lookup_ 91
+
+begin
+	nchars = 0
+	delim = 0
+	op = 1
+
+	# Skip leading whitespace.
+	for (off=1;  IS_WHITE (rname[off]);  off=off+1)
+	    ;
+
+	# If the first char is the node char, there can be no node prefix.
+	if (rname[off] == FNNODE_CHAR) {
+	    outstr[1] = EOS
+	    return (LOCAL)
+	}
+
+	# Extract explicit node name if given.
+	do ip = off, off + SZ_ALIAS {
+	    ch = rname[ip]
+
+	    if (!IS_LOWER(ch) || !IS_DIGIT(ch))
+		if (ch == EOS)
+		    break
+		else if (ch == FNNODE_CHAR) {
+		    if (rname[ip-1] != '\\') {
+			# Have node name.
+			delim = ip
+			nchars = (op - 1)
+			goto lookup_
+		    } else
+			op = max (1, op - 1)
+		}
+
+	    outstr[op] = ch
+	    op = op + 1
+	}
+
+	# No explicit node name given; use default node name.
+	do i = 1, SZ_ALIAS + 1 {
+	    outstr[i] = n_defaultnode[i]
+	    if (outstr[i] == EOS) {
+		nchars = (i - 1)
+		break
+	    }
+	}
+
+	
+lookup_
+	outstr[nchars+1] = EOS
+
+	# Determine if the named node is the local or a remote node.  This must
+	# work during process startup, before the network tables have been read,
+	# or when networking is enabled but the tables have not beed edited for
+	# a new host (in which case there will be no entry in the tables for
+	# the local node as identified by ZGHOST).
+
+	if (nchars <= 0) {
+	    # No output node name.
+	    outstr[1] = EOS
+	    return (LOCAL)
+
+	} else if (n_local == NULL) {
+	    # If local node is not identified in the host name table, this
+	    # effectively disables networking.  All nodes names are assumed
+	    # to be local.
+
+	    return (LOCAL)
+
+	} else {
+	    # We have a node name and the local node is identified in the
+	    # node table.  Scan the aliases of the local node to see if the
+	    # referenced node is the same.
+
+	    # Map possible logical node name.
+	    if (ki_mapname (outstr, n_nodename, SZ_ALIAS) <= 0)
+		call strcpy (outstr, n_nodename, SZ_ALIAS)
+
+	    ch = n_nodename[1]
+	    do i = 1, n_nalias[n_local]
+		if (n_alias[1,i,n_local] == ch)
+		    if (streq (n_alias[1,i,n_local], n_nodename))
+			return (LOCAL)
+	}
+
+	return (REMOTE)
+end
diff --git a/sys/ki/kii.com b/sys/ki/kii.com
new file mode 100644
index 00000000..cd542b3d
--- /dev/null
+++ b/sys/ki/kii.com
@@ -0,0 +1,15 @@
+# KI common -- Contains both the packed and unpacked packet used to transmit
+# and receive requests over the network.  Since the packed packet is first
+# in the common any overflow due to failure of the assumptions about the
+# size of the packed packet in host ints will only damage the area used by
+# the unpacked packet, causing no harm.
+
+int	p_packet[SZB_PACKET/SZB_CHAR/SZ_MII_INT]	# packed packet
+
+int	p_opcode		# instruction opcode
+int	p_subcode		# subcode, if device driver
+int	p_arg[MAX_ARGS]		# procedure arguments
+int	p_sbuflen		# nchars in use in string buffer
+char	p_sbuf[SZ_SBUF]		# string buffer
+
+common	/kiicom/ p_packet, p_opcode, p_subcode, p_arg, p_sbuflen, p_sbuf
diff --git a/sys/ki/kiinit.x b/sys/ki/kiinit.x
new file mode 100644
index 00000000..1d7488cb
--- /dev/null
+++ b/sys/ki/kiinit.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	"ki.h"
+
+# KI_INIT -- Called by the IRAF Main during process startup to initialize
+# the kernel interface to the process i/o channels.  INCHAN, OUTCHAN, and
+# ERRCHAN are the host system i/o channel codes for the process standard
+# input, output, and error channels.  DEVICE is a ZLOCPR entry point address
+# (kernel level) identifing the device driver to be used.  To use the KI we
+# must allocate channel descriptors for the host system i/o channels, and
+# the device entry point address must be mapped to the corresponding KI
+# procedure.
+
+procedure ki_init (inchan, outchan, errchan, device, devtype)
+
+int	inchan			#RW process input channel
+int	outchan			#RW process output channel
+int	errchan			#RW process error output channel
+int	device			#RW device driver epa
+int	devtype			#R  device type (not modified)
+
+int	locpr()
+extern	zgettx(), zgetty(), zardbf(), zardpr()
+extern	kgettx(), kgetty(), kardbf(), kardpr()
+include	"kichan.com"
+include	"kinode.com"
+
+begin
+	# Initialize the ki channel descriptors.
+	call amovki (NULL, k_oschan, MAX_CHANNELS)
+	call amovki (ERR,  k_status, MAX_CHANNELS)
+
+	# Assign KI channels for the 3 OS channels.
+
+	k_node[1]   = NULL
+	k_oschan[1] = inchan
+	inchan      = 1
+
+	k_node[2]   = NULL
+	k_oschan[2] = outchan
+	outchan     = 2
+
+	k_node[3]   = NULL
+	k_oschan[3] = errchan
+	errchan     = 3
+
+	# Map device codes.
+
+	if (     device == locpr (zgettx))
+	    device = locpr (kgettx)
+	else if (device == locpr (zgetty))
+	    device = locpr (kgetty)
+	else if (device == locpr (zardbf))
+	    device = locpr (kardbf)
+	else if (device == locpr (zardpr))
+	    device = locpr (kardpr)
+	
+	# Initialize node descriptor.
+
+	call zghost (n_localnode, SZ_ALIAS)
+	call strupk (n_localnode, n_localnode, SZ_ALIAS)
+
+	n_defaultnode[1] = EOS
+	n_default = NULL
+	n_local	  = NULL
+end
diff --git a/sys/ki/kilnode.x b/sys/ki/kilnode.x
new file mode 100644
index 00000000..e332e8f0
--- /dev/null
+++ b/sys/ki/kilnode.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "ki.h"
+
+# KI_LOCALNODE -- Determine if the named node is the local node.
+
+int procedure ki_localnode (node)
+
+char	node[ARB]		# node name
+
+int	ch, i
+bool	streq()
+int	ki_mapname()
+include	"kinode.com"
+
+begin
+	if (n_local == NULL) {
+	    # If local node is not identified in the host name table, this
+	    # effectively disables networking.  All nodes names are assumed
+	    # to be local.
+
+	    return (YES)
+
+	} else {
+	    # We have a node name and the local node is identified in the
+	    # node table.  Scan the aliases of the local node to see if the
+	    # referenced node is the same.
+
+	    # Map possible logical node name.
+	    if (ki_mapname (node, n_nodename, SZ_ALIAS) <= 0)
+		call strcpy (node, n_nodename, SZ_ALIAS)
+
+	    ch = n_nodename[1]
+	    do i = 1, n_nalias[n_local]
+		if (n_alias[1,i,n_local] == ch)
+		    if (streq (n_alias[1,i,n_local], n_nodename))
+			return (YES)
+	}
+
+	return (NO)
+end
diff --git a/sys/ki/kimapchan.x b/sys/ki/kimapchan.x
new file mode 100644
index 00000000..196619d2
--- /dev/null
+++ b/sys/ki/kimapchan.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<knet.h>
+include	"ki.h"
+
+# KI_MAPCHAN -- Return the OS channel number or pid and the node name of the
+# resource associated with a given KI channel.  This procedure may be called
+# whether or not networking is enabled.
+
+int procedure ki_mapchan (chan, nodename, maxch)
+
+int	chan			# KI channel (ret. by kopnbf, etc.)
+char	nodename[maxch]		# receives node name
+int	maxch
+
+int	node
+bool	netenab
+data	netenab /KNET/
+include	"kichan.com"
+include	"kinode.com"
+
+begin
+	if (netenab) {
+	    # Networking is enabled.  Every channel or pid returned to the VOS
+	    # by the kernel is actually a KI channel index.
+
+	    node = k_node[chan]
+	    if (node == NULL || n_nnodes == 0)
+		call strcpy (n_localnode, nodename, maxch)
+	    else
+		call strcpy (n_alias[1,1,node], nodename, maxch)
+
+	    return (k_oschan[chan])
+
+	} else {
+	    # Networking is disabled.  Return the name of the local node
+	    # and return the channel argument unchanged.
+
+	    call strcpy (n_localnode, nodename, maxch)
+	    return (chan)
+	}
+end
diff --git a/sys/ki/kimapname.x b/sys/ki/kimapname.x
new file mode 100644
index 00000000..53d5deb2
--- /dev/null
+++ b/sys/ki/kimapname.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# KI_MAPNAME -- Map a logical node name to a literal node name.  Logical
+# node names may be defined in the environment as aliases for "hardcoded"
+# hosts-file node names.  To distinguish logical node names from other
+# environment variables the value string must end in the node delimiter
+# character "!".   For example, "set alpha = foo.bar.edu!" defines logical
+# node alpha to be the same as foo.tar.edu.  The "!" suffix also allows
+# the logical node name to be used in file references, e.g. "alpha!pathname".
+# 
+# If the input name is a logical node name the translated value is returned
+# in newname and the number of characters output is returned as the function
+# value (as for envfind).  If the input name is not a logical node name
+# zero is returned as the function value.
+#
+# It might make sense to allow multiple indirection on name translations,
+# but this is not currently supported.
+
+int procedure ki_mapname (name, newname, maxch)
+
+char	name[ARB]		#I input logical node name
+char	newname[ARB]		#O output translated name
+int	maxch			#I max chars out
+
+int	nchars
+int	envfind()
+
+begin
+	nchars = envfind (name, newname, maxch)
+	if (nchars > 1)
+	    if (newname[nchars] == '!') {
+		newname[nchars] = EOS
+		return (nchars - 1)
+	    }
+
+	newname[1] = EOS
+	return (0)
+end
diff --git a/sys/ki/kinode.com b/sys/ki/kinode.com
new file mode 100644
index 00000000..2e0e9a16
--- /dev/null
+++ b/sys/ki/kinode.com
@@ -0,0 +1,18 @@
+# KINODE.COM -- Node descriptor table.  Contains one entry for each node listed
+# in the host name table file.
+
+int	n_nnodes				# number of nodes in table
+int	n_local					# index of the local node
+int	n_default				# index of the current defnode
+int	n_kschan[MAX_NODES]			# server channel (init to NULL)
+int	n_nrefs[MAX_NODES]			# number of k_oschan using node
+int	n_status[MAX_NODES]			# status bits for channel
+int	n_nalias[MAX_NODES]			# number of aliases
+char	n_localnode[SZ_ALIAS]			# name of the local node
+char	n_defaultnode[SZ_ALIAS]			# name of the default node
+char	n_nodename[SZ_ALIAS]			# node name working storage
+char	n_server[SZ_SERVER,MAX_NODES]		# kernel server names
+char	n_alias[SZ_ALIAS,MAX_ALIAS,MAX_NODES]	# aliases for the node
+
+common	/kinode/ n_nnodes, n_local, n_default, n_kschan, n_nrefs, n_status,
+	n_nalias, n_localnode, n_defaultnode, n_nodename, n_server, n_alias
diff --git a/sys/ki/kintpr.x b/sys/ki/kintpr.x
new file mode 100644
index 00000000..ec3b6d4f
--- /dev/null
+++ b/sys/ki/kintpr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KINTPR -- Send a signal (interrupt) to a connected subprocess.
+
+procedure kintpr (pid, vex, status)
+
+int	pid			# process id
+int	vex			# virtual exception
+int	status			# exit status of the job
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = k_node[pid]
+
+	if (server == NULL) {
+	    call zintpr (k_oschan[pid], vex, status)
+
+	} else {
+	    p_arg[1]  = k_oschan[pid]
+	    p_arg[2]  = vex
+	    p_sbuflen = 0
+
+	    if (ki_sendrcv (server, KI_ZINTPR, 0) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+	}
+end
diff --git a/sys/ki/kiopenks.x b/sys/ki/kiopenks.x
new file mode 100644
index 00000000..64bfb626
--- /dev/null
+++ b/sys/ki/kiopenks.x
@@ -0,0 +1,133 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<chars.h>
+include	"ki.h"
+
+# KI_OPENKS -- Physically open a kernel server process on a remote node.
+# Spawn the process and initialize the environment list and iraf root
+# directory on the remote node.  The KS channel or NULL is returned as the
+# function value.
+
+int procedure ki_openks (node)
+
+int	node			# node descriptor to open kernel on
+
+bool	hostdep
+pointer	sp, ksname, env, el, valp, ip, op, sv
+int	show, kschan, nchars, status, junk
+
+pointer	env_first(), env_next()
+int	strlen(), stridx(), strncmp()
+int	gstrcpy(), ki_send(), ki_receive()
+
+data	show /NO/
+include	"kii.com"
+include	"kinode.com"
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (ksname, SZ_FNAME, TY_CHAR)
+	call salloc (sv, SZB_PACKET / SZB_CHAR, TY_CHAR)
+
+	status = ERR
+
+	# Our caller may have already prepped a packet in the kii common, which
+	# we are going to clobber below.  Save packet and restore when done.
+
+	call amovc (FIRSTINTFIELD, Memc[sv], SZB_PACKET / SZB_CHAR)
+
+	# Spawn the kernel server process.
+
+	call strpak (n_server[1,node], Memc[ksname], SZ_FNAME)
+	call zopnks (Memc[ksname], READ_WRITE, kschan)
+	if (kschan == ERR) {
+	    call sfree (sp)
+	    return (ERR)
+	} else
+	    n_kschan[node] = kschan
+
+	# Read the environment list into a string buffer.  Scan the list once
+	# to determine its size, then allocate the buffer and format a series
+	# of "set name=value" lines in the buffer.
+	# Note 4 + 1 comes from len("set ") + \n.
+
+	nchars = 0
+	for (el=env_first(valp);  el != NULL;  el=env_next(el,valp,show))
+	    nchars = nchars + strlen (Memc[valp]) + 4 + 2 + 1
+
+	call salloc (env, nchars, TY_CHAR)
+
+	op = env
+	for (el=env_first(valp);  el != NULL;  el=env_next(el,valp,show)) {
+	    # Do not pass on the values of the host dependent environment
+	    # variables HOST, IRAF, and TMP.  If we do not set the values
+	    # here, the remote kernel will fetch the values automatically
+	    # from the HSI global include file <iraf.h> on the server node.
+
+	    hostdep = false
+	    if (stridx (Memc[valp], "hit") > 0)
+		hostdep = ((strncmp (Memc[valp], "host=", 5) == 0) ||
+			   (strncmp (Memc[valp], "iraf=", 5) == 0) ||
+			   (strncmp (Memc[valp], "tmp=",  4) == 0))
+
+	    if (!hostdep) {
+		call strcpy ("set ", Memc[op], ARB)
+		op = op + 4
+		for (ip=valp;  Memc[ip] != '=';  ip=ip+1) {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+		Memc[op] = '=';  op = op + 1
+		Memc[op] = '"';  op = op + 1
+		op = op + gstrcpy (Memc[ip+1], Memc[op], ARB)
+		Memc[op] = '"';  op = op + 1
+		Memc[op] = '\n'; op = op + 1
+	    }
+	}
+
+	Memc[op] = EOS
+
+	# Transmit the environment list to the server process, preceded by the
+	# KI_ENVINIT instruction packet.  The ENVINIT function does not return
+	# a status (to permit pipelining of multiple setenv packets).
+
+	p_arg[1] = nchars
+	if (nchars <= SZ_SBUF)
+	    call strcpy (Memc[env], p_sbuf, nchars)
+
+	if (ki_send (node, KI_ENVINIT, 0) == ERR)
+	    goto quit_
+
+	if (nchars > SZ_SBUF) {
+	    # Transmit the data record.
+	    call strpak (Memc[env], Memc[env], nchars)
+	    call zawrks (kschan, Memc[env], nchars, long(0)) 
+	    call zawtks (kschan, status)
+	    if (status != nchars) {
+		status = ERR
+		goto quit_
+	    }
+
+	    # We do expect a status return for large packets.
+	    if (ki_receive (node, KI_ENVINIT, 0) == ERR)
+		goto quit_
+	    if (p_arg[1] == ERR)
+		goto quit_
+	}
+
+	status = OK
+quit_
+	if (status == ERR) {
+	    call zclsks (kschan, junk)
+	    n_kschan[node] = NULL
+	}
+
+	# Restore the caller's kii packet.
+	call amovc (Memc[sv], FIRSTINTFIELD, SZB_PACKET / SZB_CHAR)
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/ki/kireceive.x b/sys/ki/kireceive.x
new file mode 100644
index 00000000..2cd1e7b6
--- /dev/null
+++ b/sys/ki/kireceive.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	"ki.h"
+
+# KI_RECEIVE -- Read a machine independent KII packet from the network
+# interface and decode it into the internal, machine dependent form in the
+# kii common.  An error status is returned if the opcode and subcode in
+# the packet do not match those expected, or if an i/o error occurs on the
+# channel.
+
+int procedure ki_receive (server, opcode, subcode)
+
+int	server			# node index of server process
+int	opcode			# function opcode
+int	subcode			# function subcode (for drivers)
+
+int	stat, ip, op, ch
+int	gstrcpy()
+include	"kii.com"
+include	"kinode.com"
+
+begin
+	# Read the packet.
+	call ks_aread (server, p_packet, SZB_PACKET)
+	call ks_await (server, stat)
+
+	# Hard error on the channel to the kernel server.
+	if (stat == ERR)
+	    return (ERR)
+
+	# The encoded packet consists of LEN_INTFIELDS 32 bit MII integers
+	# followed by p_sbuflen chars, one char per byte.
+
+	call miiupk32 (p_packet, FIRSTINTFIELD, LEN_INTFIELDS, TY_INT)
+	call chrupk (p_packet, LEN_INTFIELDS * 4 + 1, p_sbuf, 1,
+	    max(0, min(SZ_SBUF, p_sbuflen)) + 1)
+
+	# Check for out of band data, i.e., the data read was not a packet
+	# but some unsolicited message, e.g., error message, from the
+	# called program.  If this happens, print the error message and
+	# return an error status.
+
+	if (stat != SZB_PACKET || p_opcode != opcode || p_subcode != subcode) {
+
+	    # Is it a printable string?  If so, print the message in the
+	    # format "node: message".
+
+	    op = gstrcpy (n_alias[1,1,server], p_sbuf, SZ_ALIAS) + 1
+	    p_sbuf[op] = ':'
+	    op = op + 1
+	    p_sbuf[op] = ' '
+	    op = op + 1
+	    call chrupk (p_packet, 1, p_sbuf, op, SZ_LINE)
+
+	    do ip = op, SZ_LINE {
+		ch = p_sbuf[ip]
+		if (ch == EOS)
+		    break
+		else if (!IS_ASCII(ch))
+		    call strcpy ("out of band data on ki channel\n", p_sbuf,
+			SZ_LINE)
+	    }
+
+	    call xer_putline (STDERR, p_sbuf)
+	    return (ERR)
+
+	} else
+	    return (OK)
+end
diff --git a/sys/ki/kisend.x b/sys/ki/kisend.x
new file mode 100644
index 00000000..5b3f17d4
--- /dev/null
+++ b/sys/ki/kisend.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KI_SEND -- Encode the packet in the kii common in a machine independent form
+# and send it over the network.
+
+int procedure ki_send (server, opcode, subcode)
+
+int	server			# node index of server process
+int	opcode			# function opcode
+int	subcode			# function subcode (for drivers)
+
+int	status
+include	"kii.com"
+
+begin
+	p_opcode  = opcode
+	p_subcode = subcode
+
+	# Encode the packet in machine independent form, i.e., LEN_INTFIELDS
+	# 32 bit MII integers followed by p_sbuflen chars, one char per byte.
+
+	call miipak32 (FIRSTINTFIELD, p_packet, LEN_INTFIELDS, TY_INT)
+	call chrpak (p_sbuf, 1, p_packet, LEN_INTFIELDS * 4 + 1, p_sbuflen + 1)
+
+	# Transmit the packet.
+	call ks_awrite (server, p_packet, SZB_PACKET)
+	call ks_await  (server, status)
+
+	return (status)
+end
diff --git a/sys/ki/kisendrcv.x b/sys/ki/kisendrcv.x
new file mode 100644
index 00000000..8a319a35
--- /dev/null
+++ b/sys/ki/kisendrcv.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# KI_SENDRCV -- Encode and send a packet to a remote server process, then
+# read and decode the response packet.  The opcode and subcode in the
+# response packet must agree with those in the packet sent.
+
+int procedure ki_sendrcv (server, opcode, subcode)
+
+int	server			# os channel to server process
+int	opcode			# function opcode
+int	subcode			# function subcode (for drivers)
+
+int	ki_send(), ki_receive()
+
+begin
+	if (ki_send (server, opcode, subcode) == ERR)
+	    return (ERR)
+	else
+	    return (ki_receive (server, opcode, subcode))
+end
diff --git a/sys/ki/kishownet.x b/sys/ki/kishownet.x
new file mode 100644
index 00000000..63765aee
--- /dev/null
+++ b/sys/ki/kishownet.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+procedure ki_shownet (fd)
+
+int	fd			# output file
+
+int	i, j, n
+int	ki_gethosts()
+include	"kinode.com"
+
+begin
+	if (n_nnodes == 0)
+	    n = ki_gethosts()
+
+	call fprintf (fd, "Local node `%s' (%d), default node `%s', ")
+	    call pargstr (n_localnode)
+	    call pargi (n_local)
+	    call pargstr (n_defaultnode)
+	call fprintf (fd, "%d nodes in local network\n")
+	    call pargi (n_nnodes)
+
+	if (n_local == 0) {
+	    call fprintf (fd, "Network interface disabled ")
+	    call fprintf (fd, "(no entry for local node in dev$hosts)\n")
+	}
+
+	if (n_nnodes == MAX_NODES)
+	    call fprintf (fd, "HOST NAME TABLE IS FULL\n")
+	else if (n_nnodes <= 0)
+	    return
+
+	# Print node table.
+	call fprintf (fd, "\n    NODE SERVER NREFS STATUS  ALIASES\n")
+	do i = 1, n_nnodes {
+	    call fprintf (fd, "%8d %6d %5d  %05o ")
+		call pargi (i)
+		call pargi (n_kschan[i])
+		call pargi (n_nrefs[i])
+		call pargi (n_status[i])
+
+	    do j = 1, n_nalias[i] {
+		call fprintf (fd, " %s")
+		    call pargstr (n_alias[1,j,i])
+	    }
+
+	    call fprintf (fd, "\n")
+	}
+
+#	The following should no longer be needed as ki_mapname and the
+#	"node!" syntax should prevent accidential aliasing of node names
+#	and non-network related environment variables.
+#
+#	n = 0
+#	do i = 1, n_nnodes
+#	    do j = 1, n_nalias[i]
+#		if (envfind (n_alias[1,j,i], Memc[text], SZ_FNAME) > 0) {
+#		    if (n == 0)
+#			call fprintf (fd, "\n")
+#		    call fprintf (fd,
+#			"Warning: node name `%s' is an alias for `%s'\n")
+#			call pargstr (n_alias[1,j,i])
+#			call pargstr (Memc[text])
+#		    n = n + 1
+#		}
+end
diff --git a/sys/ki/kixnode.x b/sys/ki/kixnode.x
new file mode 100644
index 00000000..acf2dec2
--- /dev/null
+++ b/sys/ki/kixnode.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# KI_XNODE -- Transfer the node prefix, if any, from one resource string to
+# another.  If the output resource already has a node prefix it is replaced
+# by the new one.  The output resource string is modified in place.  If the
+# output string is the null string the node prefix from the input string
+# is returned.  If the input string is the null string the node prefix from
+# the output string is deleted, leaving only the resource name.
+
+procedure ki_xnode (r1, r2, maxch)
+
+char	r1[ARB]			#I input resource with optional node prefix
+char	r2[ARB]			#U output resource to append node! to
+int	maxch			#I max chars out
+
+pointer	sp, rt
+int	ip, nchars, buflen
+int	ki_extnode(), strlen()
+
+begin
+	call smark (sp)
+	buflen = strlen(r2) + SZ_FNAME
+	call salloc (rt, buflen, TY_CHAR)
+
+	ip = ki_extnode (r2, Memc[rt], buflen, nchars) + 1
+	call strcpy (r2[ip], Memc[rt], buflen)
+	ip = ki_extnode (r1, r2, maxch, nchars)
+	call strcpy (Memc[rt], r2[nchars+1], maxch-nchars)
+
+	call sfree (sp)
+end
diff --git a/sys/ki/kopcpr.x b/sys/ki/kopcpr.x
new file mode 100644
index 00000000..21497992
--- /dev/null
+++ b/sys/ki/kopcpr.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KOPCPR -- Open a connected subprocess.
+
+procedure kopcpr (process, inchan, outchan, pid)
+
+char	process[ARB]		# packed osfn of process executable
+int	inchan, outchan		# receives process input output channels
+int	pid			# receives process id
+
+int	server
+int	ki_connect(), ki_sendrcv(), ki_getchan()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = ki_connect (process)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopcpr (p_sbuf, inchan, outchan, pid)
+	} else {
+	    if (ki_sendrcv (server, KI_ZOPCPR, 0) == ERR)
+		pid = ERR
+	    else {
+		pid     = p_arg[1]
+		inchan  = p_arg[2]
+		outchan = p_arg[3]
+	    }
+	}
+
+	# Allocate 3 channel descriptors, one for the each of the i/o
+	# channels and another for the PID.  Save the channel descriptor
+	# numbers of the i/o channels in the status field of the PID
+	# descriptor to permit freeing the lot at disconnect time.
+
+	if (pid != ERR) {
+	    pid     = ki_getchan (server, pid)
+	    inchan  = ki_getchan (server, inchan)
+	    outchan = ki_getchan (server, outchan)
+	    k_status[pid] = inchan * MAX_CHANNELS + outchan
+	}
+end
diff --git a/sys/ki/kopdir.x b/sys/ki/kopdir.x
new file mode 100644
index 00000000..88ee950d
--- /dev/null
+++ b/sys/ki/kopdir.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<diropen.h>
+include	"ki.h"
+
+# KOPDIR -- Open a directory file for reading.
+
+procedure kopdir (osfn, chan)
+
+char	osfn[ARB]		# packed os filename or directory name
+int	chan			# channel assigned for reading filenames
+
+int	server
+pointer	dp
+int	ki_connect(), ki_sendrcv(), ki_getchan(), kmalloc()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zopdir (p_sbuf, chan)
+
+	} else {
+	    p_arg[2] = PASS_HIDDEN_FILES
+
+	    if (ki_sendrcv (server, KI_ZOPDIR, 0) == ERR)
+		chan = ERR
+	    else {
+		chan = p_arg[1]
+		if (kmalloc (dp, LEN_DIRBDES, TY_STRUCT) == ERR)
+		    chan = ERR
+		else {
+		    D_IP(dp)      = D_DATA(dp)
+		    D_ITOP(dp)    = D_DATA(dp)
+		    D_EOFSEEN(dp) = NO
+		}
+	    }
+	}
+
+	if (chan != ERR) {
+	    chan = ki_getchan (server, chan)
+	    if (server != NULL)
+		k_bufp[chan] = dp
+	}
+end
diff --git a/sys/ki/kopdpr.x b/sys/ki/kopdpr.x
new file mode 100644
index 00000000..1ea62dc9
--- /dev/null
+++ b/sys/ki/kopdpr.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ki.h"
+
+# KOPDPR -- Open a detached process.
+
+procedure kopdpr (process, bkgfile, bkgmsg, jobcode)
+
+char	process[ARB]		# packed osfn of process executable
+char	bkgfile[ARB]		# packed osfn of bkg file
+char	bkgmsg[ARB]		# control string for kernel
+int	jobcode			# receives job code of process
+
+pointer	sp, osfn, alias
+int	server, off, delim
+int	ki_connect(), ki_sendrcv(), ki_getchan(), strlen(), ki_gnode()
+include	"kii.com"
+
+begin
+	call smark (sp)
+	call salloc (osfn,  SZ_PATHNAME, TY_CHAR)
+	call salloc (alias, SZ_ALIAS,    TY_CHAR)
+
+	server = ki_connect (process)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call strupk (bkgfile, Memc[osfn], SZ_PATHNAME)
+
+	    # The bkg file must be on the same node as the process file.
+	    if (ki_gnode (Memc[osfn], Memc[alias], delim) == REMOTE)
+		jobcode = ERR
+	    else {
+		call strpak (Memc[osfn+(delim+1)-1], Memc[osfn], SZ_PATHNAME)
+		call zopdpr (p_sbuf, Memc[osfn], bkgmsg, jobcode)
+	    }
+
+	} else {
+	    # Spawning of detached processes on remote notes is not really
+	    # supported as of yet.  Add support for passing the bkgmsg; use
+	    # node name in bkgmsg to submit bkg job to remote node.
+
+	    off = p_sbuflen + 2
+	    p_arg[2] = off
+	    call strupk (bkgfile, p_sbuf[off], ARB)
+	    p_sbuflen = off + strlen(p_sbuf[off])
+
+	    if (ki_sendrcv (server, KI_ZOPDPR, 0) == ERR)
+		jobcode = ERR
+	    else
+		jobcode = p_arg[1]
+	}
+
+	if (jobcode != ERR)
+	    jobcode = ki_getchan (server, jobcode)
+
+	call sfree (sp)
+end
diff --git a/sys/ki/koscmd.x b/sys/ki/koscmd.x
new file mode 100644
index 00000000..6a358f8d
--- /dev/null
+++ b/sys/ki/koscmd.x
@@ -0,0 +1,108 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<chars.h>
+include	<ctype.h>
+include	<mach.h>
+include	"ki.h"
+
+# KOSCMD -- Send a command to the host command interpreter on the remote
+# node.  The output is captured in a file and returned to the caller on
+# the local host.
+
+procedure koscmd (oscmd, stdin_file, stdout_file, stderr_file, status)
+
+char	oscmd[ARB]		# packed host command string
+char	stdin_file[ARB]		# packed filename of stdin file
+char	stdout_file[ARB]	# packed filename of stdout file
+char	stderr_file[ARB]	# packed filename of stderr file
+int	status
+
+pointer	sp, remfn, locfn, lbuf, op
+int	server, oscmd_status, inchan, outchan, nchars
+int	ki_connect(), ki_sendrcv(), gstrcpy()
+include	"kinode.com"
+include	"kii.com"
+
+begin
+	server = ki_connect (oscmd)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zoscmd (p_sbuf, stdin_file, stdout_file, stderr_file, status)
+
+	} else {
+	    if (ki_sendrcv (server, KI_ZOSCMD, 0) == ERR)
+		status = ERR
+	    else if (p_arg[1] == ERR)
+		status = ERR
+
+	    else {
+		call smark (sp)
+		call salloc (remfn, SZ_PATHNAME, TY_CHAR)
+		call salloc (locfn, SZ_PATHNAME, TY_CHAR)
+		call salloc (lbuf,  SZ_LINE, TY_CHAR)
+
+		oscmd_status = p_arg[1]
+
+		# Construct the network pathname of the remote spool file.
+		op = remfn + gstrcpy (n_alias[1,1,server], Memc[remfn], ARB)
+		Memc[op] = FNNODE_CHAR;  op = op + 1
+		call strcpy (p_sbuf, Memc[op], ARB)
+		call strpak (Memc[remfn], Memc[remfn], SZ_PATHNAME)
+
+		# Open the spooled output file on the remote node.
+		call kopntx (Memc[remfn], READ_ONLY, inchan)
+		if (inchan == ERR) {
+		    status = ERR
+		    call sfree (sp)
+		    return
+		}
+
+		# Open the output file on the local node.  Currently, all
+		# output is sent to the designated stdout_file, and the other
+		# redirection files are ignored if specified.  If no stdout
+		# file is specified, write directly to the user terminal.
+
+		call strupk (stdout_file, Memc[locfn], SZ_PATHNAME)
+		if (Memc[locfn] != EOS) {
+		    # Copy to a textfile on the local node.
+
+		    call zopntx (stdout_file, APPEND, outchan)
+		    if (outchan == ERR) {
+			call kclstx (inchan, status)
+			status = ERR
+			call sfree (sp)
+			return
+		    }
+
+		    repeat {
+			call kgettx (inchan, Memc[lbuf], SZ_LINE, nchars)
+			if (nchars > 0)
+			    call zputtx (outchan, Memc[lbuf], nchars, status)
+		    } until (nchars <= 0)
+
+		    call zclstx (outchan, status)
+
+		} else {
+		    # Copy to the terminal on the local node, i.e., to the
+		    # standard error output of the calling process.
+
+		    repeat {
+			call kgettx (inchan, Memc[lbuf], SZ_LINE, nchars)
+			if (nchars > 0) {
+			    Memc[lbuf+nchars] = EOS
+			    call xer_putline (STDERR, Memc[lbuf])
+			}
+		    } until (nchars <= 0)
+		}
+
+		# Close and delete the remote spool file.
+		call kclstx (inchan, status)
+		call kfdele (Memc[remfn], status)
+
+		status = oscmd_status
+		call sfree (sp)
+	    }
+	}
+end
diff --git a/sys/ki/ksaread.x b/sys/ki/ksaread.x
new file mode 100644
index 00000000..824b1a67
--- /dev/null
+++ b/sys/ki/ksaread.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ki.h"
+
+# KS_AREAD -- Read from the kernel server device driver given the node
+# descriptor of a kernel server channel.  If the error bit is set on the
+# node return error w/o doing any i/o, since the channel will have been closed.
+
+procedure ks_aread (server, buf, maxbytes)
+
+int	server			# node descriptor index of server
+char	buf[ARB]		# i/o buffer
+int	maxbytes		# maxbytes to read
+
+int	and()
+include	"kinode.com"
+
+begin
+	if (and (n_status[server], F_IOERR) == 0)
+	    call zardks (n_kschan[server], buf, maxbytes, long(0))
+end
diff --git a/sys/ki/ksawait.x b/sys/ki/ksawait.x
new file mode 100644
index 00000000..069826d5
--- /dev/null
+++ b/sys/ki/ksawait.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ki.h"
+
+# KS_AWAIT -- Wait for i/o to the kernel server device driver given the node
+# descriptor of a kernel server channel.  If the error bit is set on the
+# node return immediately, since the channel will have been closed.
+
+procedure ks_await (server, status)
+
+int	server			# node descriptor index of server
+int	status			# receives i/o status
+
+int	and()
+include	"kinode.com"
+
+begin
+	if (and (n_status[server], F_IOERR) == 0) {
+	    call zawtks (n_kschan[server], status)
+	    if (status == ERR)
+		call ki_error (server)
+	} else
+	    status = ERR
+end
diff --git a/sys/ki/ksawrite.x b/sys/ki/ksawrite.x
new file mode 100644
index 00000000..20c815f5
--- /dev/null
+++ b/sys/ki/ksawrite.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ki.h"
+
+# KS_AWRITE -- Write to the kernel server device driver given the node
+# descriptor of a kernel server channel.  If the error bit is set on the
+# node return error w/o doing any i/o, since the channel will have been closed.
+
+procedure ks_awrite (server, buf, nbytes)
+
+int	server			# node descriptor index of server
+char	buf[ARB]		# i/o buffer
+int	nbytes			# nbytes to write
+
+int	and()
+include	"kinode.com"
+
+begin
+	if (and (n_status[server], F_IOERR) == 0)
+	    call zawrks (n_kschan[server], buf, nbytes, long(0))
+end
diff --git a/sys/ki/ktzcls.x b/sys/ki/ktzcls.x
new file mode 100644
index 00000000..826ad9f7
--- /dev/null
+++ b/sys/ki/ktzcls.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZCLS -- Close a text device.  We are called only if the device does not
+# reside on the local node.
+
+procedure kt_zcls (device, chan, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	status			# receives ok|err
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+
+	# If we receive error on the KS channel when trying to close a file,
+	# it is most likely due to a previous i/o error on the channel.  Do
+	# not return error here because we are probably being called during
+	# error recovery to free the logical channel, and if we return error
+	# the real error will be hidden.
+
+	if (ki_sendrcv (server, device, TX_CLS) == ERR)
+	    status = OK
+	else
+	    status = p_arg[1]
+
+	call mfree (k_bufp[chan], TY_STRUCT)
+	call ki_freechan (chan)
+end
diff --git a/sys/ki/ktzfls.x b/sys/ki/ktzfls.x
new file mode 100644
index 00000000..e22c1a98
--- /dev/null
+++ b/sys/ki/ktzfls.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZFLS -- Flush output to a text device.  We are called only if the device
+# does not reside on the local node.
+
+procedure kt_zfls (device, chan, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	status			# receives nchars written or ERR
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	call ki_flushtx (device, chan, status)
+	if (status == ERR)
+	    return
+
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+
+	if (ki_sendrcv (server, device, TX_FLS) == ERR)
+	    status = ERR
+	else
+	    status = p_arg[1]
+end
diff --git a/sys/ki/ktzget.x b/sys/ki/ktzget.x
new file mode 100644
index 00000000..f45ae755
--- /dev/null
+++ b/sys/ki/ktzget.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZGET -- Get all or part of a line of text from a text device.  We are
+# called only if the device does not reside on the local node.
+
+procedure kt_zget (device, chan, obuf, maxch, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+char	obuf[maxch]		# receives text
+int	maxch			# max chars to read
+int	status			# receives nchars read or ERR
+
+pointer	bd, bp, ip, rp
+int	server, nchars, nleft, reclen
+int	ki_sendrcv()
+long	ki_decode()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	bd = k_bufp[chan]
+
+	# Text file input is buffered; each input buffer returned by the kernel
+	# server may contain any number of lines of text.  Each line of text
+	# is preceded by a record header containing the record length and seek
+	# offset of the line.
+
+	if (maxch == 1 || B_RP(bd) >= B_ITOP(bd)) {
+	    # Refill buffer.
+
+	    server   = k_node[chan]
+	    p_arg[1] = k_oschan[chan]
+
+	    # Read only one character if this is a raw mode read.
+	    if (maxch == 1)
+		p_arg[2] = 1
+	    else
+		p_arg[2] = SZ_TXBUF
+
+	    if (ki_sendrcv (server, device, TX_GET) == ERR)
+		status = ERR
+	    else if (p_arg[1] <= 0)
+		status = p_arg[1]			# EOF or ERR
+	    else {
+		nchars = p_arg[1]
+		bp = B_BUFPTR(bd)
+
+		# If the record is small it is returned in the string buffer,
+		# else it is returned as a second record.  Each line is
+		# contained entirely in a single buffer.
+
+		if (nchars <= SZ_SBUF)
+		    call amovc (p_sbuf, Memc[bp], nchars)
+		else {
+		    call ks_aread (server, Memc[bp], nchars)
+		    call ks_await (server, status)
+
+		    if (status != nchars) {
+			call ki_error (server)
+			B_ITOP(bd) = bp
+			B_OTOP(bd) = bp
+			status = ERR
+			return
+		    }
+
+		    call chrupk (Memc[bp], 1, Memc[bp], 1, nchars)
+		}
+
+		B_RP(bd)   = bp
+		B_ITOP(bd) = bp + nchars
+		B_OTOP(bd) = bp
+		B_CI(bd)   = 0
+	    }
+	}
+
+	# Return characters from the current record until it is exhausted.
+	# When the current record is empty, leave the record pointer pointing
+	# to the start of the next record and the character index pointing
+	# to the first char of that record.
+
+	rp     = B_RP(bd)
+	ip     = R_DATA(rp) + B_CI(bd)
+	reclen = ki_decode (R_RECLEN(rp), NCHARS_INT)
+	nleft  = R_GETNCHARS (reclen) - B_CI(bd)
+
+	if (maxch >= nleft) {
+	    # Return the remainder of the buffer.
+
+	    call amovc (Memc[ip], obuf, nleft)
+	    status = nleft
+	    B_RP(bd) = B_RP(bd) + reclen
+	    B_CI(bd) = 0
+
+	} else {
+	    # Return a portion of the data remaining in the buffer.
+
+	    call amovc (Memc[ip], obuf, maxch)
+	    status = maxch
+	    B_CI(bd) = B_CI(bd) + maxch
+	}
+end
diff --git a/sys/ki/ktznot.x b/sys/ki/ktznot.x
new file mode 100644
index 00000000..8185b734
--- /dev/null
+++ b/sys/ki/ktznot.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZNOT -- Note the file position of a text device.  We are called only if
+# the device does not reside on the local node.
+
+procedure kt_znot (device, chan, loffset)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+long	loffset			# receives the file offset
+
+pointer	bd, rp
+int	server, status
+int	ki_sendrcv()
+long	ki_decode()
+include	"kichan.com"
+include	"kii.com"
+define	physnote_ 91
+
+begin
+	bd = k_bufp[chan]
+
+	# The buffering of text file input and output complicates the seek and
+	# note functions.  Our solution is [1] for an output file, flush the
+	# output and then call the kernel server to note the file position, and
+	# [2] for an input file, have the kernel server note the offset of each
+	# input line of text in the header area of each input record.
+
+	if (B_ITOP(bd) >= B_BUFPTR(bd)) {
+	    # Input file.
+
+	    rp = B_RP(bd)
+
+	    # Check for end of input buffer.
+	    if (rp >= B_ITOP(bd))
+		goto physnote_
+
+	    # If already part way into line, return offset of the next line.
+	    if (B_CI(bd) > 0) {
+		rp = rp + ki_decode (R_RECLEN(rp), NCHARS_INT)
+		if (rp >= B_ITOP(bd))
+		    goto physnote_
+	    }
+
+	    # Decode seek offset from record header of next line to be
+	    # read.  The seek offset is encoded as a char sequence.
+
+	    loffset = ki_decode (R_SEKOFF(rp), NCHARS_LONG)
+	    return
+
+	} else {
+	    # Output file.
+
+	    call ki_flushtx (device, chan, status)
+	    if (status == ERR)
+		return
+	}
+
+physnote_
+
+	# Physically call the kernel server to note the file offset.
+
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+
+	if (ki_sendrcv (server, device, TX_NOT) == ERR)
+	    loffset = ERR
+	else
+	    loffset = ki_decode (p_sbuf, NCHARS_LONG)
+end
diff --git a/sys/ki/ktzopn.x b/sys/ki/ktzopn.x
new file mode 100644
index 00000000..8a6c14b9
--- /dev/null
+++ b/sys/ki/ktzopn.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	"ki.h"
+
+# KT_ZOPN -- Open a text device.  We are called only if the device does not
+# reside on the local node.
+
+procedure kt_zopn (device, osfn, mode, chan)
+
+int	device			# device driver code
+char	osfn[ARB]		# packed os filename
+int	mode			# access mode
+int	chan			# receives assigned channel
+
+pointer	bd, bp
+int	server
+int	ki_connect(), ki_sendrcv(), ki_getchan(), kmalloc()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = ki_connect (osfn)
+	p_arg[2] = mode
+
+	if (ki_sendrcv (server, device, TX_OPN) == ERR)
+	    chan = ERR
+	else if (p_arg[1] == ERR)
+	    chan = ERR
+	else if (kmalloc (bd, LEN_TXBDES, TY_STRUCT) == ERR)
+	    chan = ERR
+	else {
+	    chan = ki_getchan (server, p_arg[1])
+	    k_bufp[chan] = NULL
+
+	    # Init the text buffer and buffer descriptor.  Text i/o over the
+	    # KI is buffered, greatly reducing the number of packets sent back
+	    # and forth between nodes and likewise increasing the bandwidth.
+	    # Buffering at the KI layer is necessary because FIO buffers only
+	    # one line of text at a time, leaving blocking and deblocking of
+	    # text lines to the kernel.
+
+	    k_bufp[chan] = bd
+	    bp = B_BUFPTR(bd)
+	    B_RP(bd)     = bp
+	    B_CI(bd)     = 0
+	    B_ITOP(bd)   = bp
+	    B_OTOP(bd)   = bp
+	    B_BUFTOP(bd) = bp + SZ_TXBUF
+	}
+end
diff --git a/sys/ki/ktzput.x b/sys/ki/ktzput.x
new file mode 100644
index 00000000..f55380a9
--- /dev/null
+++ b/sys/ki/ktzput.x
@@ -0,0 +1,125 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZPUT -- Put a line of text to a text device.  We are called only if the
+# device does not reside on the local node.  Output is buffered for greater
+# bandwidth and efficiency.
+
+procedure kt_zput (device, chan, ibuf, nchars, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+char	ibuf[nchars]		# receives text
+int	nchars			# nchars to write
+int	status			# receives nchars written or ERR
+
+pointer	bd, ep
+include	"kichan.com"
+
+begin
+	bd = k_bufp[chan]
+	ep = B_RP(bd) + nchars - 1
+
+	# If this is the first write into the buffer, OTOP will be set to
+	# the beginning of the buffer and we must reset it to the end.
+
+	if (ep >= B_OTOP(bd)) {
+	    # Check whether there is room remaining in the buffer for the data.
+	    # We do not break output lines across buffer boundaries.
+
+	    if (ep >= B_BUFTOP(bd)) {
+		call ki_flushtx (device, chan, status)
+		if (status == ERR)
+		    return
+
+		# Check for buffer too small to hold data record.  This should
+		# not be possible if SZ_TXBUF is chosen large enough, because
+		# FIO will break records larger than the FIO buffer size.
+
+		if (nchars > SZ_TXBUF) {
+		    status = ERR
+		    return
+		}
+	    }
+
+	    B_OTOP(bd) = B_BUFTOP(bd)
+	}
+
+	# Append the text data to the output buffer.
+
+	call amovc (ibuf, Memc[B_RP(bd)], nchars)
+	B_RP(bd) = B_RP(bd) + nchars
+	status = nchars
+end
+
+
+# KI_FLUSHTX -- Flush any buffered output of a text file.  Text output is
+# transmitted as a stream without reading the status back after each write.
+# If a write error occurs on the logical channel to the text file, the kernel
+# server will shut down entirely, causing a write error on the physical
+# channel to the kernel server.  It is harmless if we are called when the
+# output buffer is empty or contains input data.
+
+procedure ki_flushtx (device, chan, status)
+
+int	device			# text file device code
+int	chan			# channel assigned device
+int	status			# receives nchars written or ERR
+
+pointer	bd, bp
+int	server, nchars
+int	ki_send()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	bd = k_bufp[chan]
+	bp = B_BUFPTR(bd)
+
+	# OTOP will have been set to BUFTOP if the buffer was written into.
+	# RP may be greater than BUFPTR for input buffers, too.  If there is
+	# nothing to flush return without taking any action and without 
+	# changing any file pointers.
+
+	nchars = min (B_OTOP(bd), B_RP(bd)) - bp
+	if (nchars <= 0) {
+	    status = 0
+	    return
+	}
+
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = nchars
+
+	# If the buffer is small enough it is sent in the string buffer,
+	# otherwise it is sent as a second record.
+
+	if (nchars <= SZ_SBUF) {
+	    call amovc (Memc[bp], p_sbuf, nchars)
+	    p_sbuflen = nchars
+	} else
+	    p_sbuflen = 0
+
+	# Send packet.
+	if (ki_send (server, device, TX_PUT) == ERR)
+	    status = ERR
+	else if (nchars > SZ_SBUF) {
+	    # Send data record.
+
+	    call chrpak (Memc[bp], 1, Memc[bp], 1, nchars)
+	    call ks_awrite (server, Memc[bp], nchars)
+	    call ks_await  (server, status)
+
+	    if (status != nchars)
+		status = ERR
+	}
+
+	# Mark the buffer empty.
+
+	B_RP(bd)   = bp
+	B_ITOP(bd) = bp
+	B_OTOP(bd) = bp
+end
diff --git a/sys/ki/ktzsek.x b/sys/ki/ktzsek.x
new file mode 100644
index 00000000..f8b20829
--- /dev/null
+++ b/sys/ki/ktzsek.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZSEK -- Seek on a text device.  We are called only if the device does not
+# reside on the local node.
+
+procedure kt_zsek (device, chan, loffset, status)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+long	loffset			# znottx offset to seek to
+int	status			# receives nchars written or ERR
+
+pointer	bd
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	call ki_flushtx (device, chan, status)
+	if (status == ERR)
+	    return
+
+	# Discard any cached input text to force a buffer refill at the new
+	# offset.
+
+	bd = k_bufp[chan]
+	B_RP(bd) = B_ITOP(bd)
+
+	# Transmit the seek request to the server.
+
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+
+	# The long integer seek offset is passed as an encoded char sequence
+	# rather than as an integer p_arg value to avoid possible loss of
+	# precision.
+
+	call ki_encode (loffset, p_sbuf, NCHARS_LONG)
+	p_sbuflen = NCHARS_LONG
+
+	if (ki_sendrcv (server, device, TX_SEK) == ERR)
+	    status = ERR
+	else
+	    status = p_arg[1]
+end
diff --git a/sys/ki/ktzstt.x b/sys/ki/ktzstt.x
new file mode 100644
index 00000000..c7ca9463
--- /dev/null
+++ b/sys/ki/ktzstt.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KT_ZSTT -- Get file status on a text device.  We are called only if the
+# device does not reside on the local node.
+
+procedure kt_zstt (device, chan, what, lvalue)
+
+int	device			# device driver code
+int	chan			# channel assigned device
+int	what			# file parameter to be returned
+long	lvalue			# receives the parameter value
+
+int	server
+int	ki_sendrcv()
+long	ki_decode()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server   = k_node[chan]
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = what
+
+	if (ki_sendrcv (server, device, TX_STT) == ERR)
+	    lvalue = ERR
+	else
+	    lvalue = ki_decode (p_sbuf, NCHARS_LONG)
+end
diff --git a/sys/ki/kzclmt.x b/sys/ki/kzclmt.x
new file mode 100644
index 00000000..6d6bbb80
--- /dev/null
+++ b/sys/ki/kzclmt.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KZCLMT -- Close a magtape file.
+
+procedure kzclmt (chan, devpos, status)
+
+int	chan			#I channel to be closed
+int	devpos[ARB]		#O receives position information
+int	status			#O close status
+
+int	server
+int	ki_sendrcv()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	# Possible if an abort occurs during the open.
+	if (chan <= 0) {
+	    status = OK
+	    return
+	}
+
+	if (k_node[chan] == NULL)
+	    call zzclmt (k_oschan[chan], devpos, status)
+	else {
+	    server   = k_node[chan]
+	    p_arg[1] = k_oschan[chan]
+
+	    if (ki_sendrcv (server, KI_ZFIOMT, MT_CL) == ERR)
+		status = ERR
+	    else {
+		status = p_arg[1]
+		call amovi (p_arg[2], devpos, LEN_MTDEVPOS)
+	    }
+
+	    call mfree (k_bufp[chan], TY_INT)
+	}
+
+	call ki_freechan (chan)
+end
diff --git a/sys/ki/kzopmt.x b/sys/ki/kzopmt.x
new file mode 100644
index 00000000..859c4657
--- /dev/null
+++ b/sys/ki/kzopmt.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KZOPMT -- Open a magtape file.
+
+procedure kzopmt (device, mode, devcap, devpos, newfile, chan)
+
+char	device[ARB]		#I logical device name
+int	mode			#I access mode
+char	devcap[ARB]		#I tapecap entry for device
+int	devpos[ARB]		#I tape position information
+int	newfile			#U receives new file number
+int	chan			#O channel assigned for reading filenames
+
+pointer	sp, bp, bd
+int	server, dv_len, dc_len, dc_off
+int	ki_connect(), ki_send(), ki_receive(), ki_getchan()
+int	kmalloc(), strlen()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = ki_connect (device)
+
+	# We must preallocate a channel descriptor in order for error
+	# recovery to work, if an abort occurs during the zzopmt.
+
+	chan = ki_getchan (server, chan)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zzopmt (p_sbuf, mode, devcap, devpos, newfile, k_oschan[chan])
+
+	} else {
+	    call smark (sp)
+	    call salloc (bp, SZ_COMMAND, TY_CHAR)
+
+	    # Determine whether devcap string will fit in sbuf.
+	    call strupk (devcap, Memc[bp], SZ_COMMAND)
+	    dv_len = strlen (p_sbuf[p_arg[1]])
+	    dc_len = strlen (Memc[bp])
+	    if (p_arg[1] + dv_len+1 + dc_len > SZ_SBUF)
+		dc_off = 0
+	    else {
+		dc_off = p_arg[1] + dv_len + 1
+		call strcpy (Memc[bp], p_sbuf[dc_off], ARB)
+		p_sbuflen = dc_off + dc_len
+	    }
+
+	    # Prepare the arguments.
+	    p_arg[2] = mode
+	    p_arg[3] = dc_off
+	    p_arg[4] = dc_len
+	    p_arg[5] = newfile
+	    call amovi (devpos, p_arg[6], LEN_MTDEVPOS)
+
+	    if (ki_send (server, KI_ZFIOMT, MT_OP) == ERR)
+		k_oschan[chan] = ERR
+	    else if (dc_len > 0 && dc_off == 0) {
+		call ks_awrite (server, devcap, dc_len+1)
+		call ks_await (server, k_oschan[chan])
+	    }
+
+	    if (ki_receive (server, KI_ZFIOMT, MT_OP) == ERR)
+		k_oschan[chan] = ERR
+	    else {
+		k_oschan[chan] = p_arg[1]
+		newfile = p_arg[2]
+	    }
+
+	    call sfree (sp)
+	}
+
+	if (k_oschan[chan] == ERR) {
+	    call ki_freechan (chan)
+	    chan = ERR
+	} else {
+	    if (server != NULL) {
+		if (kmalloc (bd, LEN_MTDEVPOS, TY_INT) == ERR) {
+		    call ki_freechan (chan)
+		    chan = ERR
+		} else
+		    k_bufp[chan] = bd
+	    }
+	}
+end
diff --git a/sys/ki/kzrdmt.x b/sys/ki/kzrdmt.x
new file mode 100644
index 00000000..7fdaf517
--- /dev/null
+++ b/sys/ki/kzrdmt.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KZRDMT -- Asynchronous read from a magtape file.
+
+procedure kzrdmt (chan, obuf, max_bytes, offset)
+
+int	chan			#I magtape channel
+char	obuf[ARB]		#O buffer to receive data
+int	max_bytes		#I max bytes to read
+long	offset			#I file offset
+
+pointer	bd
+int	server, status
+int	ki_send(), ki_receive()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = k_node[chan]
+
+	if (server == NULL) {
+	    call zzrdmt (k_oschan[chan], obuf, max_bytes, offset)
+	    return
+	}
+
+	# Ignore zero reads and requests on a node closed by an error.
+	if (max_bytes <= 0) {
+	    k_status[chan] = 0
+	    return
+	}
+
+	# Send the request to initiate the read.
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = max_bytes
+	p_arg[3] = offset
+
+	if (ki_send (server, KI_ZFIOMT, MT_RD) == ERR) {
+	    status = ERR
+	} else {
+	    bd = k_bufp[chan]
+
+	    # Wait for the ZAWT packet.
+	    if (ki_receive (server, KI_ZFIOMT, MT_WT) == ERR)
+		status = ERR
+	    else {
+		status = p_arg[1]
+		call amovi (p_arg[2], Memi[bd], LEN_MTDEVPOS)
+	    }
+
+	    # Read the data block (if any) directly into caller's buffer.
+	    if (status > 0) {
+		call ks_aread (server, obuf, status)
+		call ks_await (server, status)
+	    }
+	}
+
+	k_status[chan] = status
+end
diff --git a/sys/ki/kzrwmt.x b/sys/ki/kzrwmt.x
new file mode 100644
index 00000000..38ce6634
--- /dev/null
+++ b/sys/ki/kzrwmt.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KZRWMT -- Rewind a (nonopen) magtape drive.
+
+procedure kzrwmt (drive, devcap, status)
+
+char	drive[ARB]		#I packed name of drive to be rewound
+char	devcap[ARB]		#I packed tapecap entry for device
+int	status			#O receives status, ok|err
+
+pointer	sp, bp
+int	server, dv_len, dc_len, dc_off, nbytes
+int	ki_connect(), ki_send(), ki_receive(), strlen()
+include	"kii.com"
+
+begin
+	server = ki_connect (drive)
+
+	if (server == NULL) {
+	    call strpak (p_sbuf[p_arg[1]], p_sbuf, SZ_SBUF)
+	    call zzrwmt (p_sbuf, devcap, status)
+
+	} else {
+	    call smark (sp)
+	    call salloc (bp, SZ_COMMAND, TY_CHAR)
+
+	    # Determine whether devcap string will fit in sbuf.
+	    call strupk (devcap, Memc[bp], SZ_COMMAND)
+	    dv_len = strlen (p_sbuf[p_arg[1]])
+	    dc_len = strlen (Memc[bp])
+	    if (dv_len+1 + dc_len > SZ_SBUF) {
+		dc_off = 0
+		nbytes = (dc_len + SZB_CHAR-1) / SZB_CHAR
+	    } else {
+		dc_off = dv_len + 1
+		call strcpy (Memc[bp], p_sbuf[dc_off], ARB)
+		p_sbuflen = dc_off + dc_len
+	    }
+
+	    # Prepare the arguments.
+	    p_arg[2] = dc_off
+	    p_arg[3] = dc_len
+
+	    if (ki_send (server, KI_ZFIOMT, MT_RW) == ERR)
+		status = ERR
+	    else if (dc_len > 0 && dc_off == 0) {
+		call ks_awrite (server, devcap, nbytes)
+		call ks_await (server, status)
+	    }
+
+	    if (ki_receive (server, KI_ZFIOMT, MT_RW) == ERR)
+		status = ERR
+	    else
+		status = p_arg[1]
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/ki/kzstmt.x b/sys/ki/kzstmt.x
new file mode 100644
index 00000000..2aaa0f45
--- /dev/null
+++ b/sys/ki/kzstmt.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	"ki.h"
+
+# KZSTMT -- Device status for a magtape device.
+
+procedure kzstmt (chan, what, lvalue)
+
+int	chan			#I active magtape channel
+int	what			#I device parameter
+long	lvalue			#O parameter value
+
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zzstmt (k_oschan[chan], what, lvalue)
+	else 
+	    call kb_zstt (KI_ZFIOMT, chan, what, lvalue)
+end
diff --git a/sys/ki/kzwrmt.x b/sys/ki/kzwrmt.x
new file mode 100644
index 00000000..74ae0dd9
--- /dev/null
+++ b/sys/ki/kzwrmt.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	"ki.h"
+
+# KZWRMT -- Asynchronous write to a magtape file.
+
+procedure kzwrmt (chan, buf, nbytes, offset)
+
+int	chan			#I magtape channel
+char	buf[ARB]		#I buffer containing data
+int	nbytes			#I nbytes to write
+long	offset			#I file offset
+
+int	server
+int	ki_send()
+include	"kichan.com"
+include	"kii.com"
+
+begin
+	server = k_node[chan]
+
+	if (server == NULL) {
+	    call zzwrmt (k_oschan[chan], buf, nbytes, offset)
+	    return
+	}
+
+	# Ignore zero writes and requests on a node closed by an error.
+	if (nbytes <= 0) {
+	    k_status[chan] = 0
+	    return
+	}
+
+	# Send the request followed by the data block.  We do not read anything
+	# back from the remote server until ZAWT is called.  Set k_status[chan]
+	# to WRITE_IN_PROGRESS to tell ZAWT that an await call is needed.
+
+	p_arg[1] = k_oschan[chan]
+	p_arg[2] = nbytes
+	p_arg[3] = offset
+
+	if (ki_send (server, KI_ZFIOMT, MT_WR) == ERR)
+	    k_status[chan] = ERR
+	else {
+	    call ks_awrite (server, buf, nbytes)
+	    call ks_await  (server, k_status[chan])
+	}
+end
diff --git a/sys/ki/kzwtmt.x b/sys/ki/kzwtmt.x
new file mode 100644
index 00000000..3358d83e
--- /dev/null
+++ b/sys/ki/kzwtmt.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	"ki.h"
+
+# KZWTMT -- Wait for i/o to complete on a magtape channel.
+
+procedure kzwtmt (chan, devpos, status)
+
+int	chan			#I active magtape channel
+int	devpos[ARB]		#O device position structure
+int	status			#O receives nbytes transferred or ERR
+
+pointer	bd
+include	"kichan.com"
+
+begin
+	if (k_node[chan] == NULL)
+	    call zzwtmt (k_oschan[chan], devpos, status)
+	else {
+	    bd = k_bufp[chan]
+	    status = k_status[chan]
+	    call amovi (Memi[bd], devpos, LEN_MTDEVPOS)
+	}
+end
diff --git a/sys/ki/mkpkg b/sys/ki/mkpkg
new file mode 100644
index 00000000..65a0c895
--- /dev/null
+++ b/sys/ki/mkpkg
@@ -0,0 +1,107 @@
+# Update the KI kernel interface.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$omake	irafks.x\
+		ki.h kii.com <clset.h> <finfo.h> <fset.h> <knet.h> <mach.h>
+	$link	irafks.o
+	;
+
+install:
+	$move	irafks.e bin$
+	;
+
+libsys.a:
+	# Do not put irafks.x in this list.
+	kbzard.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kbzawr.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kbzawt.x	ki.h kichan.com <config.h>
+	kbzcls.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kbzopn.x	ki.h kii.com <mach.h>
+	kbzstt.x	ki.h kichan.com kii.com kinode.com <config.h>\
+			<fio.h> <mach.h>
+	kclcpr.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kcldir.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kcldpr.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kdvall.x	ki.h kii.com <mach.h>
+	kdvown.x	ki.h kii.com <mach.h>
+	kfacss.x	ki.h kii.com <mach.h>
+	kfaloc.x	ki.h kii.com <mach.h>
+	kfchdr.x	ki.h kii.com kinode.com <chars.h> <config.h> <mach.h>
+	kfdele.x	ki.h kii.com <mach.h>
+	kfgcwd.x	ki.h kii.com kinode.com <chars.h> <config.h> <mach.h>
+	kfinfo.x	ki.h kii.com <finfo.h> <mach.h>
+	kfiobf.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfiogd.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfiolp.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfiopl.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfiopr.x	ki.h kichan.com <config.h> <mach.h>
+	kfiosf.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfiotx.x	ki.h kichan.com kii.com <config.h> <fio.h> <mach.h>
+	kfioty.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kfmkcp.x	ki.h kii.com <mach.h>
+	kfmkdr.x	ki.h kii.com <mach.h>
+	kfpath.x	ki.h kinode.com <chars.h>
+	kfprot.x	ki.h kii.com <mach.h>
+	kfrnam.x	ki.h kii.com <mach.h>
+	kfrmdr.x	ki.h kii.com <mach.h>
+	kfsubd.x	ki.h
+	kfutim.x	ki.h kii.com <mach.h>
+	kfxdir.x	ki.h kinode.com <chars.h>
+	kgfdir.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kiconnect.x	ki.h kichan.com kii.com kinode.com <chars.h>\
+			<config.h> <mach.h>
+	kiencode.x	
+	kienvreset.x	ki.h kii.com kinode.com <config.h> <mach.h>
+	kierror.x	kinode.com ki.h <config.h>
+	kiextnode.x	ki.h kinode.com <chars.h>
+	kifchan.x	kichan.com kinode.com ki.h <config.h>
+	kifmapfn.x	ki.h kii.com <mach.h>
+	kifndnode.x	kinode.com ki.h
+	kigchan.x	kichan.com kinode.com ki.h <config.h>
+	kighost.x	ki.h kinode.com <ctype.h>
+	kignode.x	kinode.com <chars.h> <ctype.h> ki.h
+	kiinit.x	ki.h kichan.com kinode.com <config.h>
+	kilnode.x	kinode.com ki.h
+	kimapchan.x	ki.h kichan.com kinode.com <config.h> <knet.h> <mach.h>
+	kimapname.x
+	kintpr.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kiopenks.x	ki.h kii.com kinode.com <chars.h> <config.h> <mach.h>
+	kireceive.x	ki.h kii.com kinode.com <ctype.h> <mach.h>
+	kisend.x	ki.h kii.com <mach.h>
+	kisendrcv.x	
+	kishownet.x	ki.h kinode.com <config.h> <mach.h>
+	kixnode.x	
+	kopcpr.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kopdir.x	ki.h kichan.com kii.com <config.h> <diropen.h> <mach.h>
+	kopdpr.x	ki.h kii.com <mach.h>
+	koscmd.x	ki.h kii.com kinode.com <chars.h> <config.h>\
+			<ctype.h> <mach.h>
+	ksaread.x	ki.h kinode.com
+	ksawait.x	ki.h kinode.com
+	ksawrite.x	ki.h kinode.com
+	ktzcls.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzfls.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzget.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktznot.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzopn.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzput.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzsek.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	ktzstt.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kzclmt.x	ki.h kichan.com kii.com <config.h> <fio.h> <mach.h>
+	kzopmt.x	ki.h kichan.com kii.com <config.h> <fio.h> <mach.h>
+	kzrdmt.x	ki.h kichan.com kii.com <config.h> <fio.h> <mach.h>
+	kzrwmt.x	ki.h kii.com <config.h> <fio.h> <mach.h>
+	kzstmt.x	ki.h kichan.com <config.h>
+	kzwrmt.x	ki.h kichan.com kii.com <config.h> <mach.h>
+	kzwtmt.x	ki.h kichan.com <config.h> <fio.h>
+	;
diff --git a/sys/ki/zzdebug.x b/sys/ki/zzdebug.x
new file mode 100644
index 00000000..550fcc3f
--- /dev/null
+++ b/sys/ki/zzdebug.x
@@ -0,0 +1,120 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	rexec	= t_rexec,
+	rtype	= t_rtype,
+	rread	= t_rread,
+	encode	= t_encode
+
+define	SZ_BUF		4096
+
+
+# REXEC -- Execute a command on a remote node and print the resultant output on
+# the standard output.  Used to test the kernel server driver.
+
+procedure t_rexec()
+
+char	server[SZ_LINE]
+char	buf[SZ_BUF]
+int	chan, nbytes, status
+
+begin
+	call clgstr ("server", server, SZ_LINE)
+	call strpak (server, server, SZ_LINE)
+
+	call zopnks (server, READ_WRITE, chan)
+	if (chan == ERR)
+	    call error (1, "cannot connect to remote server process")
+
+	repeat {
+	    call zardks (chan, buf, SZ_BUF, 0)
+	    call zawtks (chan, nbytes)
+
+	    if (nbytes > 0) {
+		call chrupk (buf, 1, buf, 1, nbytes)
+		call write (STDOUT, buf, nbytes)
+		call flush (STDOUT)
+	    }
+	} until (nbytes <= 0)
+
+	call zclsks (chan, status)
+	if (status == ERR)
+	    call error (1, "error disconnecting server process")
+end
+
+
+# RTYPE -- Type a text file possibly resident on a remote node.
+
+procedure t_rtype()
+
+char	fname[SZ_FNAME]
+char	lbuf[SZ_LINE]
+int	fd
+int	open(), getline()
+
+begin
+	call clgstr ("file", fname, SZ_FNAME)
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	while (getline (fd, lbuf) != EOF) {
+	    call putline (STDOUT, lbuf)
+	    call flush (STDOUT)
+	}
+
+	call close (fd)
+end
+
+
+# RREAD -- Read a binary file.
+
+procedure t_rread()
+
+char	fname[SZ_FNAME]
+char	dbuf[SZ_BUF]
+int	fd
+long	nchars, totchars
+int	open(), read()
+
+begin
+	call clgstr ("file", fname, SZ_FNAME)
+	fd = open (fname, READ_ONLY, BINARY_FILE)
+
+	totchars = 0
+
+	repeat {
+	    nchars = read (fd, dbuf, SZ_BUF)
+	    if (nchars > 0)
+		totchars = totchars + nchars
+	} until (nchars == EOF)
+
+	call close (fd)
+
+	call printf ("read %d chars\n")
+	    call pargi (totchars)
+end
+
+
+# ENCODE -- Test the kiencode/decode routines.
+
+procedure t_encode()
+
+int	v, ip
+char	xnum[8]
+int	ki_decode(), clgeti()
+
+begin
+	repeat {
+	    v = clgeti ("value")
+	    call ki_encode (v, xnum, 8)
+	    call chrpak (xnum, 1, xnum, 1, 8)
+	    call chrupk (xnum, 1, xnum, 1, 8)
+
+	    call printf ("\t")
+	    for (ip=1;  ip <= 8;  ip=ip+1) {
+		call printf ("%3d ")
+		    call pargc (xnum[ip])
+	    }
+
+	    call printf (" --> %d\n")
+		call pargi (ki_decode (xnum, 8))
+	}
+end
diff --git a/sys/ki/zzrdks.c b/sys/ki/zzrdks.c
new file mode 100644
index 00000000..40229d5b
--- /dev/null
+++ b/sys/ki/zzrdks.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+int	spoolit = 0;
+int	spoolfd = 0;
+
+/* Intercept KS intput and spool in a file for subsequent debugging.
+ * [MACHDEP].  This is a UNIX dependent debugging routine.  To get rid of
+ * it, delete the file, edit the Makefile, and change the reference to
+ * zzrdks in irafks.x to zardks.
+ */
+zzrdks_ (chan, buf, maxb, off)
+int	*chan;
+short	*buf;
+int	*maxb;
+int	*off;
+{
+	int	status;
+
+	zardks_ (chan, buf, maxb, off);
+
+	if (spoolit) {
+	    if (spoolfd == 0)
+		spoolfd = creat ("/tmp/ks.in", 0644);
+	    zawtks_ (chan, &status);
+	    if (status > 0)
+		write (spoolfd, buf, status);
+	}
+}
diff --git a/sys/libc/Libc.hlp b/sys/libc/Libc.hlp
new file mode 100644
index 00000000..e13faeea
--- /dev/null
+++ b/sys/libc/Libc.hlp
@@ -0,0 +1,559 @@
+.help LIBC Sep84 "C Runtime Library"
+.sp 2
+.ce
+\fBIRAF Runtime Library for the C Language\fR
+.ce
+CL Interface to IRAF
+.sp 3
+.nh
+Introduction
+
+    The IRAF runtime library for the C language was developed to port the
+IRAF command language (CL) from UNIX to IRAF.  The C runtime library (LIBC)
+consists of two parts: an emulation of the standard i/o library provided
+for the C language on an UNIX host, and a library of "system calls", i.e.,
+the C interface to the IRAF virtual operating system.
+
+.nh
+Naming Conventions
+
+    Providing familiar and predictable procedure names in C is complicated
+by the possibility of name collisions with external names in the program
+interface libraries.  To solve this problem while maintaining compatibility
+with UNIX the external names of all UNIX emulation procedures are assigned
+in C \fIdefine\fR statements.  The external name is simply the UNIX name
+preceded by the prefix "u_", e.g.,
+
+	fopen()
+
+compiles as
+
+	u_fopen()
+
+The names of the "system calls" are not compatible with those of the UNIX
+system calls.  Each system call maps directly to an IRAF program interface
+procedure.  The name of the C version is the IRAF name preceded by the
+prefix "c_", e.g.,
+
+	open()
+
+is called in C as
+
+	c_open()
+
+The "c_" names are not redefined except where necessary to produce an
+external identifier unique in the first seven characters.  When an external
+name is redefined to make it unique in the first seven characters this
+is done by application of the 4+1 rule, leaving the "c_" prefix as is.
+The calling sequences of the C system calls have been kept as compatible
+with the "crib sheet" versions as possible, even when a more convenient
+syntax could have been used for C.
+
+.nh
+Include Files
+
+    C style global include files pose a problem in a portable system since
+machine dependent filenames cannot be used.  This problem is sidestepped
+for LIBC by using the C language preprocessor to indirectly reference the
+global include files via a single master include file installed in the
+C system include file directory.  The master include file is referenced
+as <iraf.h>.  The actual include files reside in the IRAF directory system
+(as does a copy of <iraf.h>) and hence are automatically ported with the
+system.  The pathname to the LIBC global include files is arbitrary, but
+currently these files are stored in lib$libc.
+
+The technique used to access LIBC global include files in perhaps best
+explained by use of a simple example from the CL:
+
+
+.ks
+.nf
+	#define import_spp			global includes
+	#define import_libc
+	#define import_stdio
+	#include <iraf.h>
+
+	#include "config.h"			local includes
+	#include "operand.h"
+	#include "param.h"
+	#include "task.h"
+.fi
+.ke
+
+
+The include file <iraf.h> contains preprocessor control lines which load
+the include files referenced by "#define import_packagename" statements.
+In addition to being portable, this technique has the benefits of ensuring
+that the include files are loaded in the correct order and are not loaded
+more than once.
+
+The include file referenced by \fIimport_libc\fR should be included in
+every C source file which uses LIBC.  In addition to loading the referenced
+include files, <iraf.h> also includes definitions for the IRAF root
+directory IRAFDIR, the default image storage directory IMAGEDIR, and the
+name of the host operating system (e.g. "UNIX" or "VMS").
+
+.nh
+UNIX Emulation
+
+    All procedures in the UNIX standard i/o (stdio) package are emulated
+in libc.  A listing of the calling sequences of all currently implemented
+procedures is given as an appendix.  The syntax and semantics of these
+procedures have been kept as close to those of the V7 UNIX procedures as
+possible.
+
+.nh
+IRAF Program Interface Routines
+
+    All i/o in the CL is implemented ultimately by calls to procedures in
+the IRAF program interface libraries.  The UNIX emulation procedures
+discussed in the previous sections, for example, are reasonably portable
+C language packages which call C versions of the IRAF program interface
+routines.  With few exceptions the C version of each procedure maps trivially
+to the corresponding program interface procedure.  The main complication
+arises from the need to pack and unpack character strings when calling an
+SPP (Fortran) procedure from C.  Read only arguments are passed by value
+for the convenience of the C language progammer.
+
+The full program interface contains on the order of a thousand procedures
+(including generics) and it would be prohibitively difficult to make them
+all available in C.  We have therefore included only the packages actually
+used by the CL in the interface, and then only the most commonly used
+procedures in each package.  All files which directly reference program
+interface procedures should include a reference to the C language include
+file \fBirafio.h\fR.
+
+.nh 2
+File I/O (FIO)
+
+    The fundamental unit of storage in both C and SPP is the \fBchar\fR,
+but unfortunately a char is not necessarily the same size in both languages.
+In the C version of FIO data is referenced in units of C chars (bytes),
+subject to the restriction that only an \fIintegral\fR number of SPP chars
+can be read and written at a time, and seeks must be aligned on a char
+boundary.  If a nonintegral number of SPP chars are read or written,
+the interface will silently move the extra bytes necessary to fill out
+an SPP char, possibly writing beyond the end of the input buffer on a read.
+These problems are less serious than it might seem, however, since CL level
+i/o is predominantly text only (binary file i/o is not currently used in
+the CL).
+
+In keeping with the C language tradition, all FIO offsets are \fIzero\fR
+indexed, and all integer valued procedures return ERR as the function value
+in the event of an error.  Pointer valued functions return NULL in the
+event of an error.  Although only "significant" function values are shown in the
+calling sequences below, all procedures return a function value.
+
+
+.ks
+.nf
+High Level FIO:
+
+	fd =	   c_open (vfn, mode, type)
+		  c_close (fd)
+		  c_flush (fd)
+
+		  c_fseti (fd, param, value)
+	int =	 c_fstati (fd, param)
+
+	stat =    c_finfo (vfn, &fi)
+	y/n =	 c_access (vfn, mode, type)
+		 c_delete (vfn)
+		 c_rename (old_vfn, new_vfn)
+		 c_mktemp (root, &fname, maxch)
+.fi
+.ke
+
+
+The "low level" FIO procedures perform binary file i/o and fill and flush
+the internal FIO file buffer.  These procedures are called by the STDIO
+package and are not intended to be called directly by general CL code.
+Seeking is not implemented in STDIO due to the difficulty of implementing
+\fBfseek\fR in a portable system, but is not currently required anywhere
+in the CL.  STDIO directly accesses the internal FIO buffer pointers
+via a data structure defined in \fBirafio.h\fR.
+
+
+.ks
+.nf
+Low Level FIO:
+
+	  nchars = c_read (fd, &buf, maxch)
+	 	  c_write (fd, &buf, nchars)
+		   c_seek (fd, loffset)
+	 loffset = c_note (fd)
+
+	    ch = c_filbuf (fd)
+	    ch = c_flsbuf (fd, ch)
+	  FILE = c_fioptr (fd)
+.fi
+.ke
+
+
+The file access modes and types are specified as in SPP, i.e., via predefined
+integer constants defined in \fIirafio.h\fR (READ_ONLY, NEW_FILE, etc.).
+Only a few \fBfset\fR options are implemented; these are likewise defined
+in \fIirafio.h\fR.  The integer constants STDIN, STDOUT, etc. refer to
+FIO file descriptors, and should not be confused with \fBstdin\fR,
+\fBstdout\fR, etc., which reference STDIO file pointers.
+
+.nh 2
+Environment Facilities
+
+    The environment list is managed entirely by the program interface via
+the ENV package.  The CL calls ENV procedures to create, modify, and access
+the environment list.  The \fBc_propen\fR procedure in the program interface
+passes the environment list on to a connected child process at process
+creation time.
+
+
+.ks
+.nf
+       nchars = c_envgets (name, &value, maxch)
+	redef =	c_envputs (name, &value)
+		c_envmark (&sp)
+      nredefs = c_envfree (sp)
+
+	 bool = c_envgetb (name)
+	  int = c_envgeti (name)
+		c_envlist (out_fd, prefix, show_redefs)
+	nscan =	c_envscan (input_source)
+.fi
+.ke
+
+The following (non program interface) procedure is defined and used internally
+by the CL to lookup names in the environment list:
+
+	    strp = envget (name)
+
+.nh 3
+Implementation Notes
+
+    The environment list is maintained as a multi-threaded linked list.  This
+provides the searching efficiency of a hash table plus stack like semantics
+for redefinitions and for freeing blocks of variables.  There are two primary
+data structures internally, an array of pointers to the heads of the threads,
+and a buffer containing the list elements.  These data structures are
+dynamically allocated and will be automatically reallocated at runtime if
+overflow occurs.  The number of threads determines the hashing efficiency and
+is a compile time parameter.
+
+The \fBenvmark\fR and \fBenvfree\fR procedures
+mark and free storage on the environment list stack.
+All environment variables defined or redefined after a call to \fBenvmark\fR
+will be deleted and storage freed by a call to \fBenvfree\fR.  If a redef
+is freed the next most recent definition becomes current.  \fBEnvfree\fR returns
+as its function value the number of redefined variables uncovered by the free
+operation.  The calling program must mark and free in the correct order or the
+environment list may be trashed.
+
+The \fBenvlist\fR procedure prints the environment list on a file.
+Redefined values will be printed only if so indicated.
+The environment list is printed as a list of
+\fBset\fR statements in most recent first order, i.e.,
+
+
+.ks
+.nf
+	set nameN=valueN
+	set nameM=valueM
+	    ...
+	set name1=value1
+.fi
+.ke
+
+
+The \fBenvlist\fR function is used both to inspect the environment list
+and to pass the list on to a child process.
+Redefined variables are omitted when passing
+the list on to a child process, hence the order of definition does not matter.
+The output format is "prefix name=value", where the prefix string is supplied
+by the user.
+
+The \fBenvscan\fR function parses one or more \fBset\fR statements,
+calling \fBenvputs\fR to enter the SET declarations into the environment list.
+The argument is either a \fBset\fR declaration or a string of the form
+"set @filename", where "filename" is the name of a file containing \fBset\fR
+declarations.
+
+.nh 2
+Process Control
+
+    Separate facilities are provided for \fBconnected\fR and \fBdetached\fR
+processes.  Virtually all process control is concerned with connected
+subprocesses, i.e., subprocesses running synchronously with the CL and
+communicating with the CL via bidirectional IPC channels.  The only detached
+process in the system is the CL itself, when spawned as a background job
+by another (usually interactive) CL process.
+
+.nh 3
+Connected Subprocesses
+
+    A connected subprocess is connected with \fBpropen\fR and disconnected
+with \fBprclose\fR.  The \fBpropen\fR procedure spawns the named process,
+connects the IPC channels to FIO file descriptors, then sends commands to
+the child process to initialize the environment and current working directory.
+Once connected the \fIin\fR and \fIout\fR file descriptors may be reopened
+with \fBfdopen\fR for UNIX style i/o to the subprocess.  The \fBprclose\fR
+procedure sends the "bye" (shutdown) command to the child, waits for the
+child to terminate, and then returns the process termination status as the
+function value.  Normal exit status is OK, otherwise a positive integer
+error code is returned.
+
+
+.ks
+.nf
+	     pid = c_propen (process, in, out)
+	   stat = c_prclose (pid)
+		 c_prsignal (pid, signal)
+		  c_prredir (pid, stream, new_fd)
+		 c_prupdate (message)
+.fi
+.ke
+
+
+To execute a task in a connected child process the CL writes a command to
+the \fIout\fR channel with a conventional \fBfputs\fR or other STDIO call.
+After starting the task the CL redirects its command input to the \fIin\fR
+channel of the task; conventional \fBfgets\fR or \fBgetc\fR calls are made
+to read commands from the task, until "bye" is received, signaling task
+termination.
+
+New \fBset\fR or \fBchdir\fR statements may be broadcast to all connected
+subprocesses at any time (except while actually executing a task resident
+in a connected subprocess) by a call to \fBprupdate\fR.  While there is no
+way the CL can free space on the environment stack in a child process, it is
+possible to broadcast new redefinitions to all child processes if redefinitions
+should be uncovered by an \fBenvfree\fR call in the CL.
+
+The \fBprsignal\fR procedure is used to raise the interrupt exception X_INT
+in a connected child process.  When the user types interrupt (e.g. ctrl/c)
+at the CL level, the CL interrupt exception handler signals the child
+process containing the external task currently in execution (if any),
+and then resumes processing of commands from the child.  If a special exception
+handler is not posted in the child it will go through error restart,
+eventually sending the \fBerror\fR statement to the CL indicating abnormal
+termination of the task.  Note that it is permissible for a child process
+to ignore the interrupt exception, or take special recovery actions if
+interrupt occurs.
+
+.nh 4
+I/O Redirection
+
+    Pseudofile i/o (\fBxmit\fR and \fBxfer\fR directives for the task's STDIN,
+STDOUT, etc.) is handled by the program interface transparently to the CL.
+By default the standard i/o streams of the child are connected to the
+identical streams of the parent (the CL).  If redirection of a stream
+is desired the stream may be redirected in either of two ways:
+.ls
+.ls [1]
+A stdio stream may be redirected directly at the task level in the child
+process by including redirection information on the command line sent to
+the child to execute the task.  This is the most efficient technique, and
+it should be used when appropriate, e.g., for pipes or whenever an output
+stream of an external task is explicitly redirected on the CL command line.
+The syntax of the task statement recognized by the IRAF Main is documented
+in the \fISystem Interface Reference Manual\fR.  For example, to run a task
+with the standard output redirected to a pipe file:
+
+.ks
+.nf
+	fprintf (out_fp, "%s %d > %s\n",
+	    taskname, STDOUT, pipefilename);
+.fi
+.ke
+
+Pipe files, by the way, are implemented as binary files for maximum flexibility
+and efficiency.  This is acceptable since they are read and written only by
+the system.  Very high i/o bandwidths are possible using direct i/o to a binary
+file.
+.le
+
+.ls [2]
+A stdio stream may be redirected at the CL level to any previously opened
+FIO file, e.g., to one of the CL's standard streams, to a text or binary
+file opened explicitly by the CL, or to another child process (e.g. redirection
+of the standard graphics output of the child to a graphics subprocess).
+This type of redirection requires the following steps by the CL:
+.ls
+.ls o
+Open local stream to which child's stream is to be redirected.
+.le
+.ls o
+Call \fBprredir\fR to map the child's stream to the local stream.
+.le
+.ls o
+When the task is run, include an argument of the form "N >" on the task
+command line, indicating that stream N has been redirected by the parent
+process (the file name is omitted).
+.le
+.ls o
+When the task terminates, or when the next task is run in the same process,
+restore the original i/o connection with another call to \fBprredir\fR.
+The default connection is established by the system only at \fBpropen\fR time.
+.le
+.le
+.le
+.le
+
+
+The I/O redirection mechanism permits messages to be shuffled from a child
+process deep in the process tree to a device owned by the CL, or from a child
+process in one branch of the process tree to a process in another branch of
+the tree.  If raw mode is set on the STDIN stream in the child it will
+automatically be passed on to the process which physically reads the raw mode
+device.  Asynchronous execution is possible so long as messages pass only
+one way.  Synchronization occurs whenever a process waits on a read.  The most
+complex example of the IPC i/o redirection mechanism in the current system
+occurs when a science or utility task sends graphics commands via the CL to a
+separate graphics task.  Ignoring GKS inquires, this process is fully
+asynchronous and should be acceptably efficient provided the IPC buffer size
+is reasonable (1-4 Kb) and large amounts of bulk data do not have to be passed.
+
+.nh 3
+Detached Processes
+
+    The CL executes commands in the background, i.e., asynchronously, by
+dumping the entire run time context of the CL into a binary background
+file, then spawning a detached CL process to execute the already compiled
+command in the context of the parent.  The run time context consists of
+the dictionary and stack areas, the environment list, and various other
+internal state parameters which are copied into the header area of the
+bkgfile.  This is a potential problem area if dynamic memory is used,
+since it may not be possible to duplicate the virtual addresses of the
+parent's data area in the child.
+
+
+.ks
+.nf
+	    job = c_propdpr (process, bkgfile)
+	   stat = c_prcldpr (job)
+	     y/n = c_prdone (job)
+		   c_prkill (job)
+
+	   exit = c_onentry (prytpe, bkgfile)
+		   c_onexit (epa)
+.fi
+.ke
+
+
+The CL process uses the same IRAF Main as a normal IRAF process, except that
+a special \fBonentry\fR procedure is linked which serves as the CL main.
+The \fBonentry\fR procedure is called by the IRAF Main during
+process startup with the arguments shown; the function value returned by
+\fBonentry\fR determines whether or not the interpreter in the IRAF Main
+is entered.  Since we do not want IRAF Main prompts from the CL process
+the CL version of \fBonentry\fR always returns CL_EXIT, causing process
+shutdown following execution of any procedures posted with \fBonexit\fR
+during execution of \fBonentry\fR.
+
+A detached process opened with \fBpropdpr\fR should always be closed with
+\fBprcldpr\fR if it terminates while the parent is still executing.
+The \fBprdone\fR procedure may be called to determine if a background job
+has terminated.  A background job may be aborted with \fBprkill\fR.
+
+.nh 2
+Terminal Control
+
+    The TTY interface is provided at the CL level to support screen editing.
+TTY is the IRAF interface to the \fBtermcap\fR terminal capability database,
+originally developed at Berkeley for UNIX by Bill Joy.
+
+
+.ks
+.nf
+	     tty = c_ttyodes (ttyname)
+		   c_ttycdes (tty)
+		   c_ttyseti (tty, parameter, value)
+	    int = c_ttystati (tty, parameter)
+
+	    bool = c_ttygetb (tty, cap)
+	     int = c_ttygeti (tty, cap)
+	   float = c_ttygetr (tty, cap)
+	  nchars = c_ttygets (tty, cap, &outstr, maxch)
+		   c_ttyctrl (fd, tty, cap, afflncnt)
+		   c_ttyputs (fd, tty, ctrlstr, afflncnt)
+
+		  c_ttyclear (fd, tty)
+		c_ttyclearln (fd, tty)
+		   c_ttygoto (fd, tty, col, line)
+		   c_ttyinit (fd, tty)
+		c_ttyputline (fd, tty, text, map_cc)
+		     c_ttyso (fd, tty, onflag)
+.fi
+.ke
+
+
+Complete descriptions of TTY and \fBtermcap\fR are given elsewhere.
+Briefly, the device descriptor for a particular terminal is opened
+with \fBttyodes\fR, which returns a IRAF pointer (C integer) to the
+binary TTY descriptor.
+The terminal name may be given as "terminal", in which case \fBttyodes\fR
+will look up the name of the default terminal in the environment and search
+the termcap database for the entry for the named device.
+
+The \fBttyget\fR functions are used to read the capabilities.
+Capabilities are specified by two character mnemonics (character strings),
+shown as the \fIcap\fR arguments in the calling sequences above.
+Control sequences may be output with \fBttyctrl\fR or with \fBttyputs\fR,
+depending on whether you are willing to do a binary search for a
+particular capability at run time.
+The remaining high level functions make it easy to perform the more common
+control functions.
+
+Raw mode output to a terminal device is provided by the system interface
+(the newline and tab characters are exceptions).  Raw mode input is
+provided as an \fBfseti\fR option in FIO.  To set raw mode on STDIN:
+
+	c_fseti (STDIN, F_RAW, YES);
+
+While raw mode is in effect input characters are read as they are typed,
+few or no control characters are recognized, and no echoing is performed.
+
+.nh 2
+Memory Management
+
+    Both heap and stack storage facilities are available in the program
+interface, and we have made both types of facilities available in the CL.
+Note, however, that the CL does not currently use dynamic memory allocation
+directly due to the difficulties such use would cause when passing the
+context of the CL to a background CL (used to execute commands in the
+background).  The CL currently makes heavy use of pointers in the dictionary
+data structures, and since the dictionary is passed to the background CL
+as a binary array, it must be restored to the same base memory address or
+the pointers will be meaningless.  This led to the implementation of the
+dictionary and stack areas as fixed size, statically allocated arrays.
+
+The use of a fixed size dictionary is restrictive and wasteful of storage;
+a future implementation based on \fBsalloc\fR (the stack facilities) is
+desirable provided the context passing problem can be solved.  Note that
+the environment facilities do use dynamic storage and that it is nonetheless
+possible to pass the environment to a background CL, despite the internal
+use of pointers in the environment management package.
+
+
+.ks
+.nf
+Heap Storage (UNIX compatible):
+
+	    buf = malloc (nchars)		u_malloc
+	    buf = calloc (nchars)		u_calloc
+		   mfree (buf)			u_mfree
+
+
+Stack Storage:
+
+		 c_smark (&sp)
+	  buf = c_salloc (nchars)
+		 c_sfree (sp)
+.fi
+.ke
+
+
+Note that the C callable versions of \fBmalloc\fR, \fBcalloc\fR, and
+\fBmfree\fR emulate the comparable UNIX procedures.  The storage units
+are C chars, i.e., bytes.  Promotion to an integral number of SPP chars
+is automatic.  The \fIbuf\fR argument is a C pointer.  The \fIsp\fR
+argument, used to mark the position of the stack pointer, is an integer.
+The stack is implemented in segments allocated on the heap, hence there
+is no builtin limit on the size of the stack.
diff --git a/sys/libc/README b/sys/libc/README
new file mode 100644
index 00000000..4801a369
--- /dev/null
+++ b/sys/libc/README
@@ -0,0 +1,208 @@
+LIBC -- C language binding for a portion of the IRAF VOS
+	UNIX emulator
+
+This directory contains
+
+    [1]	A subset of the routines from the UNIX stdio library.  These routines
+	emulate the equivalent UNIX routines but are interfaced to the IRAF
+	program interface.
+
+    [2]	C-callable versions of a subset of the routines from the IRAF program
+	interface.  Included are portions of the following packages:
+
+		file i/o
+		formatted i/o
+		environment
+		process control
+		terminal control
+		memory management
+		exception handling
+
+The header files "irafio.h" and "names.h" should be included in all C files
+which reference the C library.  The include files "stdio.h" and "ctype.h"
+should be used wherever they would be used in a UNIX/C system.
+
+
+IMPORTANT NOTE:
+
+    Routines marked VARARGS are machine dependent in that they assume a
+certain ordering (left to right) for the argument list.  On some machines
+the ordering may be the opposite.
+
+TODO: Rewrite these procedures to use the UNIX <varargs.h> macros.
+
+
+1. LIBC Emulation of UNIX C-Library Procedures
+
+                   syntax                              err       eof
+
+       double = asin (x)
+       double = acos (x)
+       double = atan (x)
+      double = atan2 (x, y)
+       double = atof (str)                              0.
+          int = atoi (str)                              0
+         long = atol (str)                              0
+      charp = calloc (nelems, elsize)                  NULL
+            clearerr (fp)
+        double = cos (x)
+        double = exp (x)
+              fclose (fp)                              EOF
+       FILE = fdopen (fd, modestr)                     NULL
+         bool = feof (fp)
+       bool = ferror (fp)
+              fflush (fp)                              EOF
+          ch = fgetc (fp)                              EOF
+       charp = fgets (buf, maxch, fp)                  NULL
+         fd = fileno (fp)
+        FILE = fopen (fname, modestr)                  NULL
+               fputc (ch, fp)                          EOF
+               fputs (str, fp)
+       nelem = fread (bp, szelem, nelem, fp)            0         0
+                free (buf)
+      FILE = freopen (fname, modestr, fp)              NULL
+               fseek (fp, offset, origin)              EOF
+        long = ftell (fp)
+      nelem = fwrite (bp, szelem, nelem, fp)            0         0
+           ch = getc (fp)                              EOF       EOF
+        ch = getchar ()                                EOF       EOF
+      charp = getenv (envvar)                          NULL
+        charp = gets (buf)                             NULL      NULL
+         word = getw (fp)                              EOF       EOF
+       charp = index (str, ch)                         NULL
+        double = log (x)
+      double = log10 (x)
+	  int = nint (x)
+      charp = malloc (nbytes)                          NULL
+      charp = mktemp (template)                        NULL
+              perror (prefix)
+        double = pow (x, y)
+              printf (format, argp)
+             fprintf (fp, format, argp)
+             sprintf (str, format, argp)
+             eprintf (format, argp)
+           ch = putc (ch, fp)                          EOF
+        ch = putchar (ch)                              EOF
+                puts (str)
+         word = putw (word, fp)                        EOF
+	       qsort (array, len, isize, compar)
+     charp = realloc (buf, newsize)                    NULL
+              rewind (fp)                              EOF
+      charp = rindex (str, ch)
+       nscan = scanf (format, argp)                    EOF       EOF
+      nscan = fscanf (fp, format, argp)                EOF       EOF
+      nscan = sscanf (str, format, argp)               EOF       EOF
+              setbuf (fp, buf)
+           setbuffer (fp, buf, size)
+          setlinebuf (fp)
+        double = sin (x)
+       double = sqrt (x)
+      charp = strcat (s1, s2)
+      charp = strcmp (s1, s2)
+      charp = strcpy (s1, s2)
+        int = strlen (str)
+     charp = strncat (s1, s2, n)
+     charp = strncmp (s1, s2, n)
+     charp = strncpy (s1, s2, n)
+       stat = system (cmd)
+         ch = ungetc (ch, fp)                          EOF
+
+
+
+2. System Calls
+
+All output parameters are shown as "&name" regardless of whether the actual
+parameter is a pointer.  If no ERR or EOF type is shown it is inapplicable to
+the procedure.  The error type "*" denotes an error action which will lead to
+error recovery if not caught by calling the procedure inside an "iferr".  In
+general, error actions are permitted only where errors are not expected and
+where we suspect that the programmer would ignore an error return code if one
+were used.  Fatal errors cannot be caught but "cannot happen".
+
+
+                         syntax                         err        eof
+
+       bool = c_access (fname, mode, type)               *
+   longsec = c_clktime (reftime)
+               c_close (fd)                              *
+     charp = c_cnvdate (clktime, &outstr, maxch)
+     charp = c_cnvtime (clktime, &outstr, maxch)
+  longmsec = c_cputime (reftime)
+              c_delete (fname)                          ERR
+    nchars = c_envfind (var, &outstr, maxch)             0
+    nchars = c_envgets (var, &outstr, maxch)             0
+      bool = c_envgetb (var)                           no=0
+      ival = c_envgeti (var)                             *
+             c_envputs (var, value)                      *
+             c_envlist (fd, prefix, show_redefs)         *
+             c_envmark (&envp)
+   nredefs = c_envfree (envp)
+     nscan = c_envscan (input_source)                    *
+               c_error (errcode, errmsg)                 *
+              c_erract (action)                          *
+    errcode = c_errget (&outstr, maxch)
+              c_fchdir (newdir)                         ERR
+         ch = c_filbuf (fp)                             EOF        EOF
+               c_finfo (fname, fi)                      ERR
+         ch = c_flsbuf (ch, fp)                         EOF
+               c_flush (fd)                              *
+     nchars = c_fmapfn (vfn, &osfn, maxch)               0
+       stat = c_fmkdir (newdir)				ERR
+     nchars = c_fnldir (vfn, &ldir, maxch)
+     nchars = c_fnroot (vfn, &root, maxch)
+     nchars = c_fnextn (vfn, &extn, maxch)
+      nchars = c_fpath (vfn, &osfn, maxch)		 0
+         fd = c_fredir (fd, fname, mode, type)          ERR
+               c_fseti (fd, param, value)                *
+       ival = c_fstati (fd, param)                       *
+        int = c_getpid ()
+              c_getuid (&outstr, maxch)                  *
+ os_chan = c_kimapchan (ki_chan, nodename, maxch)
+      token = c_lexnum (str, &toklen)
+     nchars = c_mktemp (root, &temp_filename, maxch)     0
+         long = c_note (fd)                              *
+           fd = c_open (fname, mode, type)              ERR
+   exit_stat = c_oscmd (cmd, infile, outfile, errfile)   *
+	     c_prchdir (pid, newdir)			ERR
+ exit_stat = c_prcldpr (job)                             *
+             c_prclose (pid)                             *
+       bool = c_prdone (job)                             *
+	    c_prenvset (pid, envvar, valuestr)		ERR
+              c_prkill (job)                            ERR
+       pid = c_propdpr (process, bkgfile)               NULL
+        pid = c_propen (process, &in, &out)             NULL
+             c_prredir (pid, stream, new_fd)            ERR
+            c_prsignal (pid, signal)                    ERR
+       nbytes = c_read (fd, &buf, maxbytes)              *         EOF
+              c_rename (old_fname, new_fname)           ERR
+      charp = c_salloc (nbytes)                        fatal
+               c_smark (&sp)                           fatal
+               c_sfree (sp)                            fatal
+       bool = c_stkcmp (p1, p2)                          *
+                c_seek (fd, offset)                     ERR
+     xcharp = c_sppstr (xstr)
+       cstr = c_strpak (sppstr, &cstr, maxch)
+     xcharp = c_strupk (str, &xoutstr, maxch)
+              c_tsleep (nseconds)
+  tty(int) = c_ttyodes (ttyname)                        ERR
+             c_ttycdes (tty)                             *
+             c_ttyseti (tty, param, value)               *
+     ival = c_ttystati (tty, param)                      *
+      bool = c_ttygetb (tty, cap)                      no=0
+      ival = c_ttygeti (tty, cap)                        0
+      fval = c_ttygetr (tty, cap)                        0.
+    nchars = c_ttygets (tty, cap, &outstr, maxch)        0
+             c_ttyputs (fd, tty, cap, afflncnt)         ERR
+             c_ttyctrl (fd, tty, cap, afflncnt)         ERR
+            c_ttyclear (fd, tty)                         *
+          c_ttyclearln (fd, tty)                         *
+             c_ttygoto (fd, tty, col, line)              *
+             c_ttyinit (fd, tty)                         *
+          c_ttyputline (fd, tty, line, map_cc)           *
+               c_ttyso (fd, tty, onoff)                  *
+              c_ungetc (fd, ch)                         ERR
+           c_ungetline (fd, str)                        ERR
+              c_vfnbrk (vfn, root, extn)
+      nbytes = c_write (fd, buf, nbytes)                 *
+               c_xwhen (vex, new_handler, old_handler)   *
+               c_xgmes (oscode, oserrmsg, maxch)
diff --git a/sys/libc/atof.c b/sys/libc/atof.c
new file mode 100644
index 00000000..df0ec7d9
--- /dev/null
+++ b/sys/libc/atof.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_ctype
+#include <iraf.h>
+
+
+/* ATOF -- Ascii to double floating.  Convert any legal floating point number
+** into a binary double precision floating value.
+*/
+double
+atof (char *str)
+{
+	XINT	ip = 1;
+	XDOUBLE dval;
+
+	if (CTOD (c_sppstr(str), &ip, &dval) == 0)
+	    return ( (double) 0);
+	else
+	    return ( (double) dval);
+}
diff --git a/sys/libc/atoi.c b/sys/libc/atoi.c
new file mode 100644
index 00000000..6df13153
--- /dev/null
+++ b/sys/libc/atoi.c
@@ -0,0 +1,48 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_ctype
+#include <iraf.h>
+
+
+/* ATOI -- Ascii to integer.  Convert a simple integer in decimal radix to
+** a binary integer value.
+*/
+int
+atoi (char *str)
+{
+	register char	*ip = str;
+	register int	ch, ival;
+	int	neg;
+
+
+	if (*str == EOS)
+	    return (0);
+
+	/* Skip leading whitespace. */
+	while (isspace (*ip))
+	    ip++;
+	
+	/* Check for indefinite. */
+	if ((ch = *ip) == 'I')
+	    if (strncmp (ip, "INDEF", 5) == 0)
+		if (! (isalnum (ch = *(ip+5)) || ch == '_'))
+		    return (INDEFI);
+
+	/* Check for leading + or - sign. */
+	neg = 0;
+	if (ch == '-') {
+	    neg++;
+	    ip++;
+	} else if (ch == '+')
+	    ip++;
+
+	/* Accumulate sequence of digits. */
+	ival = 0;
+	while (isdigit (ch = *ip++))
+	    ival = ival * 10 + tointeg(ch);
+
+	return (neg ? -ival : ival);
+}
diff --git a/sys/libc/atol.c b/sys/libc/atol.c
new file mode 100644
index 00000000..f5780583
--- /dev/null
+++ b/sys/libc/atol.c
@@ -0,0 +1,49 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_ctype
+#include <iraf.h>
+
+
+/* ATOL -- Ascii to long integer.  Convert a simple integer in decimal radix to
+** a binary long integer value.
+*/
+long
+atol (char *str)
+{
+	register char	*ip = str;
+	register int	ch;
+	register long	lval;
+	int	neg;
+
+
+	if (*str == EOS)
+	    return (0);
+
+	/* Skip leading whitespace. */
+	while (isspace (*ip))
+	    ip++;
+
+	/* Check for indefinite. */
+	if ((ch = *--ip) == 'I')
+	    if (strncmp (ip, "INDEF", 5) == 0)
+		if (! (isalnum (ch = *(ip+5)) || ch == '_'))
+		    return (INDEFL);
+
+	/* Check for leading + or - sign. */
+	neg = 0;
+	if (ch == '-') {
+	    neg++;
+	    ip++;
+	} else if (ch == '+')
+	    ip++;
+
+	/* Accumulate sequence of digits. */
+	lval = 0;
+	while (isdigit (ch = *ip++))
+	    lval = lval * 10 + tointeg(ch);
+
+	return (neg ? -lval : lval);
+}
diff --git a/sys/libc/caccess.c b/sys/libc/caccess.c
new file mode 100644
index 00000000..13b6f52e
--- /dev/null
+++ b/sys/libc/caccess.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ACCESS -- FIO file access.
+*/
+int 
+c_access (
+  char	*fname,			/* name of file to be accessed	*/
+  int	mode,			/* access mode			*/
+  int	type			/* file type			*/
+)
+{
+	XINT x_mode = mode, x_type = type;
+
+	return (ACCESS (c_sppstr(fname), &x_mode, &x_type));
+}
diff --git a/sys/libc/calloc.c b/sys/libc/calloc.c
new file mode 100644
index 00000000..f9a4f044
--- /dev/null
+++ b/sys/libc/calloc.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* CALLOC -- Allocate memory for NELEM elements of size ELSIZE bytes per
+** element.  The space is initialized to all zeros.
+*/
+char *
+calloc (
+  unsigned int nelems,
+  unsigned int elsize
+)
+{
+	XINT	nchars = (nelems*elsize + sizeof(XCHAR)-1) / sizeof(XCHAR);
+	XINT	ptr, dtype = TY_CHAR;
+
+
+	iferr (CALLOC (&ptr, &nchars, &dtype))
+	    return (NULL);
+	else
+	    return ((char *)&Memc[ptr]);
+}
diff --git a/sys/libc/callocate.c b/sys/libc/callocate.c
new file mode 100644
index 00000000..303896c3
--- /dev/null
+++ b/sys/libc/callocate.c
@@ -0,0 +1,80 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ALLOCATE -- Allocate a device (and mount it, if necessary).
+*/
+int
+c_allocate (
+  char *device			/* device to be allocated	*/
+)
+{
+	int	status;
+
+	iferr (status = XALLOCATE (c_sppstr(device)))
+	    return (ERR);
+	else
+	    return (status);
+}
+
+
+/* C_DEALLOCATE -- Deallocate a device.
+*/
+int
+c_deallocate (
+  char	*device,		/* device to be allocated	*/
+  int	rewind			/* rewind flag, if magtape	*/
+)
+{
+	int	status;
+	XINT    x_rewind = rewind;
+
+	iferr (status = (int) XDEALLOCATE (c_sppstr(device), &x_rewind))
+	    return (ERR);
+	else
+	    return (status);
+}
+
+
+/* C_DEVSTATUS -- Print the current status of the named device.
+*/
+void
+c_devstatus (
+  char	*device,		/* device name		*/
+  int	out			/* output file		*/
+)
+{
+	XINT  x_out = out;
+
+	XDEVSTATUS (c_sppstr(device), &x_out);
+}
+
+
+/* C_DEVOWNER -- Determine if a device is allocated, and if so return
+** the name of the owner.
+*/
+int
+c_devowner (
+  char	*device,		/* device to be allocated	*/
+  char	*owner,			/* receives owner name string	*/
+  int	maxch 
+)
+{
+	PKCHAR	x_owner[SZ_FNAME+1];
+	XINT	x_maxch = SZ_FNAME;
+	int	status;
+
+
+	iferr (status = (int) XDEVOWNER(c_sppstr(device), x_owner, &x_maxch)) {
+	    owner[0] = EOS;
+	    return (ERR);
+	} else {
+	    c_strpak (x_owner, owner, maxch);
+	    return (status);
+	}
+}
diff --git a/sys/libc/cclktime.c b/sys/libc/cclktime.c
new file mode 100644
index 00000000..ca26e56e
--- /dev/null
+++ b/sys/libc/cclktime.c
@@ -0,0 +1,35 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_CLKTIME -- Return the clock time in long integer seconds since Jan. 1,
+** 1980, minus the reference argument (0 for absolute time).
+*/
+long
+c_clktime (
+  long reftime			/* reference time		*/
+)
+{
+	XLONG x_reftime = reftime;
+
+	return (CLKTIME (&x_reftime));
+}
+
+
+/* C_CPUTIME -- Return the cpu time consumed by the current process and all
+** subprocesses, in long integer milliseconds, minus the reference time.
+*/
+long
+c_cputime (
+  long	reftime			/* reference time		*/
+)
+{
+	XLONG x_reftime = reftime;
+
+	return (CPUTIME (&x_reftime));
+}
diff --git a/sys/libc/cclose.c b/sys/libc/cclose.c
new file mode 100644
index 00000000..630f097d
--- /dev/null
+++ b/sys/libc/cclose.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_CLOSE -- FIO file close.
+*/
+int
+c_close (
+  XINT	fd			/* FIO file descriptor		*/
+)
+{
+	XINT  x_fd = fd;
+
+	iferr (CLOSE (&x_fd))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/ccnvdate.c b/sys/libc/ccnvdate.c
new file mode 100644
index 00000000..ee97169f
--- /dev/null
+++ b/sys/libc/ccnvdate.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_CNVDATE -- Convert long integer time as returned by CLKTIME into a short
+** format date string.
+*/
+char *
+c_cnvdate (
+  long	clktime,		/* seconds since jan.1,1980	*/
+  char	*outstr,		/* encoded time string		*/
+  int	maxch 
+)
+{
+	XCHAR	buf[SZ_LINE];
+	XINT	x_maxch = SZ_LINE;
+
+	CNVDATE (&clktime, buf, &x_maxch);
+	return (c_strpak (buf, outstr, maxch));
+}
diff --git a/sys/libc/ccnvtime.c b/sys/libc/ccnvtime.c
new file mode 100644
index 00000000..4923907c
--- /dev/null
+++ b/sys/libc/ccnvtime.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_CNVTIME -- Convert long integer time as returned by CLKTIME into a long
+** format date string.
+*/
+char *
+c_cnvtime (
+  long	clktime,		/* seconds since jan.1,1980	*/
+  char	*outstr,		/* encoded time string		*/
+  int	maxch 
+)
+{
+	XCHAR	buf[SZ_LINE];
+	XINT	x_maxch = SZ_LINE;
+
+	CNVTIME (&clktime, buf, &x_maxch);
+	return (c_strpak (buf, outstr, maxch));
+}
diff --git a/sys/libc/cdelete.c b/sys/libc/cdelete.c
new file mode 100644
index 00000000..14d97926
--- /dev/null
+++ b/sys/libc/cdelete.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+/* C_DELETE -- FIO delete file.
+*/
+int
+c_delete (
+  char	*fname			/* name of file to be opened	*/
+)
+{
+	iferr (DELETE (c_sppstr(fname)))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cenvget.c b/sys/libc/cenvget.c
new file mode 100644
index 00000000..2c812226
--- /dev/null
+++ b/sys/libc/cenvget.c
@@ -0,0 +1,143 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/*
+** ENVGET[SBI] -- Assorted routines for fetching the values of environment
+**   		  variables.
+**     ENVPUTS -- Set or redefine the value of an environment variable.
+**    ENVRESET -- Reset (overwrite) the value of an environment variable.
+*/
+
+#define SZ_VALUESTR	SZ_COMMAND
+
+static	XCHAR valuestr[SZ_VALUESTR+1];
+static	XINT len_valuestr = SZ_VALUESTR;
+
+
+/* ENVGET -- (Near) emulation of the UNIX getenv procedure.  This is a handy
+** routine for looking up environment variables in C programs.  The value is
+** fetched into an internal static array and a pointer to this array is returned
+** as the function value, else NULL if the environment variable is not found.
+** The caller is responsible for using the value string before it is overwritten
+** by the next call.
+*/
+char *
+envget (
+  char	*var			/* environment variable name		*/
+)
+{
+	if (ENVFIND (c_sppstr(var), valuestr, &len_valuestr) < 0)
+	    return (NULL);
+	else
+	    return (c_strpak (valuestr, (char *)valuestr, len_valuestr+1));
+}
+
+
+/* C_ENVGETS -- Fetch the string value of an environment variable into the
+** output string.  Return the strlen length of the output string as the
+** function value.  If the variable is not found and the process is being
+** used interactively a query is generated.  If no value is given in response
+** to the query or the process is noninteractive and the variable is not
+** found, zero is returned.
+*/
+int
+c_envgets (
+  char	*var,			/* name of variable to be fetched	*/
+  char	*outstr,		/* output string			*/
+  int	maxch			/* length including EOS			*/
+)
+{
+	register int	nchars;
+
+	if ((nchars = ENVGETS (c_sppstr(var), valuestr, &len_valuestr)) < 0)
+	    return (nchars);
+	else {
+	    c_strpak (valuestr, outstr, maxch);
+	    return (nchars > maxch ? maxch : nchars);
+	}
+}
+
+
+/* C_ENVFIND -- Just like ENVGETS, except that a query will not be generated
+** even if working interactively.
+*/
+int
+c_envfind (
+  char	*var,			/* name of variable to be fetched	*/
+  char	*outstr,		/* output string			*/
+  int	maxch			/* length including EOS			*/
+)
+{
+	register int	nchars;
+
+	if ((nchars = ENVFIND (c_sppstr(var), valuestr, &len_valuestr)) < 0)
+	    return (nchars);
+	else {
+	    c_strpak (valuestr, outstr, maxch);
+	    return (nchars > maxch ? maxch : nchars);
+	}
+}
+
+
+/* C_ENVGETB -- Return the boolean value of an environment variable.  An error
+** action is taken if the variable is not found or the value string cannot
+** be interpreted as a boolean value.
+*/
+int
+c_envgetb (
+  char	*var			/* name of variable to be fetched	*/
+)
+{
+	return ((int) BTOI ((XINT) ENVGETB (c_sppstr(var))));
+}
+
+
+/* C_ENVGETI -- Return the integer value of an environment variable.  An error
+** action is taken if the variable is not found or the value string cannot
+** be interpreted as an integer value.
+*/
+int
+c_envgeti (
+  char	*var			/* name of variable to be fetched	*/
+)
+{
+	return ((int) ENVGETI (c_sppstr(var)));
+}
+
+
+/* C_ENVPUTS -- Set or redefine the value of an environment variable.  If the
+** variable is not defined a new entry is created.  If the variable is already
+** defined but has a different value it is redefined, with the new definition
+** having precedence over the former (redefinitions can be undone; see envmark
+** and envfree).  If the variable is already defined and the new definition
+** has the same value, it is ignored.
+**
+** Arguments:		set var = value
+*/
+void
+c_envputs (
+  char	*var,			/* name of variable to be set		*/
+  char	*value			/* value string				*/
+)
+{
+	ENVPUTS (c_sppstr(var), c_strupk (value, valuestr, SZ_VALUESTR));
+}
+
+
+/* C_ENVRESET -- Reset (overwrite) the value of an environment variable.
+** If the variable is not defined a new entry is created.
+*/
+void
+c_envreset (
+  char	*var,			/* name of variable to be set		*/
+  char	*value			/* value string				*/
+)
+{
+	ENVRESET (c_sppstr(var), c_strupk (value, valuestr, SZ_VALUESTR));
+}
diff --git a/sys/libc/cenvlist.c b/sys/libc/cenvlist.c
new file mode 100644
index 00000000..1616a4d5
--- /dev/null
+++ b/sys/libc/cenvlist.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ENVLIST -- List the names and values of all environment variables on the
+** output file.  Variables are listed in the reverse of the order in which
+** they were defined.  If a variable is redefined all definitions or only the
+** most recent definition may be listed.  Each definition appears on a separate
+** line in the following format:
+**
+**	prefix var="value"
+**
+** where "prefix" is the prefix string supplied as an argument, "var" is the
+** name of the variable, and "value" is the value string.
+*/
+void
+c_envlist (
+  XINT	fd,			/* output file			*/
+  char	*prefix,		/* prefix string, e.g. "set "	*/
+  int	show_redefs		/* 0=hide redefs, 1=show redefs	*/
+)
+{
+	XINT  x_fd = fd,
+	      x_show_redefs = show_redefs;
+
+	ENVLIST (&x_fd, c_sppstr(prefix), &x_show_redefs);
+}
diff --git a/sys/libc/cenvmark.c b/sys/libc/cenvmark.c
new file mode 100644
index 00000000..14963844
--- /dev/null
+++ b/sys/libc/cenvmark.c
@@ -0,0 +1,54 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* ENVMARK -- Mark the position of the "stack pointer" of the environment
+** list.  A subsequent call to ENVFREE will unset all set environment
+** operations since the corresponding mark.
+*/
+void
+c_envmark (
+  XINT	*envp			/* storage for saved stack pointer	*/
+)
+{
+	ENVMARK (envp);
+}
+
+
+/* ENVFREE -- Free or unset all environment variables set since the matching
+** call to ENVMARK.  The number of redefined variables uncovered by the free
+** operation is returned as the function value.
+*/
+int
+c_envfree (
+  int	envp,			/* marker returned by envmark		*/
+  int	userfcn			/* epa of user function for redefs	*/
+)
+{
+	XINT  x_envp = envp;
+
+	return (ENVFREE (&x_envp, (XINT *)&userfcn));
+}
+
+
+/* PRENVFREE -- Free or unset all environment variables set since the matching
+** call to ENVMARK.  The number of redefined variables uncovered by the free
+** operation is returned as the function value.  This call is equivalent to
+** envfree except that it also updates the values of any uncovered redefinitions
+** in the specified connected subprocesses.
+*/
+int
+c_prenvfree (
+  int	pid,			/* process pid, or 0 for all subprocs	*/
+  int	envp			/* marker returned by envmark		*/
+)
+{
+	XINT  x_pid = pid,  x_envp = envp;
+
+	return (PRENVFREE (&x_pid, &x_envp));
+}
diff --git a/sys/libc/cenvscan.c b/sys/libc/cenvscan.c
new file mode 100644
index 00000000..5fef48e7
--- /dev/null
+++ b/sys/libc/cenvscan.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ENVSCAN -- High level command to parse and enter a SET declaration into
+** the environment list, or to parse and enter a list of SET declarations from
+** a text file.  The single input string argument should be either a SET
+** declaration, i.e.,
+**
+**	set var="value"				(quotes optional)
+**
+** or an indirect reference to a text file containing SET declarations, e.g.,
+**
+**	@filename
+**
+** If a file is specified, only lines beginning with the keyword "set" will
+** be decoded; all other lines are ignored.  The number of SET declarations
+** processed is returned as the function value.  There is no fixed limit on
+** the number of SET declarations for a process.
+*/
+int
+c_envscan (
+  char	*input_source
+)
+{
+	return (ENVSCAN (c_sppstr(input_source)));
+}
diff --git a/sys/libc/cerract.c b/sys/libc/cerract.c
new file mode 100644
index 00000000..a9c9cb2d
--- /dev/null
+++ b/sys/libc/cerract.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ERRACT -- Take an error action.  Typically called in an IFERR error
+** handler to print a warning message or initiate error recovery after
+** application specific cleanup actions have been taken.  The actions are
+** defined in import_error
+*/
+void
+c_erract (int action)
+{
+	XINT  x_action = action;
+
+	ERRACT (&x_action);
+}
diff --git a/sys/libc/cerrcode.c b/sys/libc/cerrcode.c
new file mode 100644
index 00000000..305ab39d
--- /dev/null
+++ b/sys/libc/cerrcode.c
@@ -0,0 +1,15 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+/* C_ERRCODE -- Get the error code of the most recent error.
+*/
+int
+c_errcode ( void )
+{
+	return (ERRCODE());
+}
diff --git a/sys/libc/cerrget.c b/sys/libc/cerrget.c
new file mode 100644
index 00000000..a62a2f67
--- /dev/null
+++ b/sys/libc/cerrget.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ERRGET -- Get the error code and error message string of the most
+** recent error.
+*/
+int
+c_errget (
+  char	*outstr,		/* error message string		*/
+  int	maxch			/* max chars out, incl EOS	*/
+)
+{
+	XCHAR	buf[SZ_LINE+1];
+	XINT	szbuf = SZ_LINE;
+	int	errcode;
+
+	errcode = (int) ERRGET (buf, &szbuf);
+	c_strpak (buf, outstr, maxch);
+
+	return (errcode);
+}
diff --git a/sys/libc/cerror.c b/sys/libc/cerror.c
new file mode 100644
index 00000000..214d54a8
--- /dev/null
+++ b/sys/libc/cerror.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_ERROR -- Post an error.
+*/
+void
+c_error (
+  int	errcode,		/* error code			*/
+  char	*errmsg			/* error message		*/
+)
+{
+	XINT  x_errcode = errcode;
+	ERROR (&x_errcode, c_sppstr(errmsg));
+}
diff --git a/sys/libc/cfchdir.c b/sys/libc/cfchdir.c
new file mode 100644
index 00000000..2dc708da
--- /dev/null
+++ b/sys/libc/cfchdir.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_FCHDIR -- Change directory.
+*/
+int
+c_fchdir (char *newdir)
+{
+	iferr (FCHDIR (c_sppstr (newdir)))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cfilbuf.c b/sys/libc/cfilbuf.c
new file mode 100644
index 00000000..e37aec75
--- /dev/null
+++ b/sys/libc/cfilbuf.c
@@ -0,0 +1,36 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#include <iraf.h>
+
+
+/* C_FILBUF -- Fill the FIO file buffer.  Called by the GETC macro to fill
+** the file buffer when the end of the buffer is reached.  The function
+** value is either the first char in the refilled buffer or EOF.  If the
+** file is connected to a child process the filter PRFILBUF is called to
+** handle the XMIT and XFER requests.
+*/
+int
+c_filbuf (FILE *fp)
+{
+	register int	nchars;
+	XINT	x_fd = fileno(fp);
+	XINT	(*fillbuffer)();
+	XINT	PRFILBUF(), FILBUF();
+
+
+	fillbuffer = ((fp->_fflags & _FIPC) ? PRFILBUF : FILBUF);
+
+	iferr (nchars = (int) (*fillbuffer)(&x_fd)) {
+	    fp->_fflags |= _FERR;
+	    return (EOF);
+	} else if (nchars == XEOF) {
+	    fp->_fflags |= _FEOF;
+	    return (EOF);
+	} else
+	    return (Memc[fp->_iop++] & 0377);
+}
diff --git a/sys/libc/cfinfo.c b/sys/libc/cfinfo.c
new file mode 100644
index 00000000..7e69e5e0
--- /dev/null
+++ b/sys/libc/cfinfo.c
@@ -0,0 +1,30 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_xnames
+#define import_finfo
+#define	import_libc
+#include <iraf.h>
+
+
+/* C_FINFO -- FIO get directory info for named file.
+*/
+int
+c_finfo (
+  char	 *fname,		/* name of file to be opened	*/
+  struct _finfo *fi		/* finfo structure (output)	*/
+)
+{
+	register int	status;
+
+	iferr (status = (int) FINFO (c_sppstr(fname), (XLONG *)fi)) {
+	    status = ERR;
+	} else if (status != XERR) {
+	    c_strpak ((XCHAR *)fi->fi_owner, fi->fi_owner, SZ_OWNERSTR);
+	    status = OK;
+	} else
+	    status = ERR;
+
+	return (status);
+}
diff --git a/sys/libc/cflsbuf.c b/sys/libc/cflsbuf.c
new file mode 100644
index 00000000..9547b0c2
--- /dev/null
+++ b/sys/libc/cflsbuf.c
@@ -0,0 +1,43 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#include <iraf.h>
+
+
+/* C_FLSBUF -- Flush the FIO file buffer.  Called by the PUTC macro to flush
+** the file buffer when it fills.  The function value returned is either the
+** first char written to the buffer (passed as an argument) or EOF in the
+** event of an error.
+*/
+int
+c_flsbuf (
+  unsigned int	ch,		/* char which caused the fault	*/
+  FILE	*fp			/* output file			*/
+)
+{
+	register int	buf_not_full;
+	XINT	fd = fileno(fp);
+	XINT	nreserve = 1;
+
+
+	/* If we were called due to flush on newline and there is space in
+	 * the buffer, put the ch in the buffer before flushing.
+	 */
+	buf_not_full = (fp->_iop < fp->_otop);
+	if (buf_not_full)
+	    Memc[fp->_iop++] = (unsigned)ch;
+
+	iferr (FLSBUF (&fd, &nreserve)) {
+	    fp->_fflags |= _FERR;
+	    return (EOF);
+	}
+
+	if (!buf_not_full)
+	    Memc[fp->_iop++] = (unsigned)ch;
+
+	return (ch);
+}
diff --git a/sys/libc/cflush.c b/sys/libc/cflush.c
new file mode 100644
index 00000000..7a7a029a
--- /dev/null
+++ b/sys/libc/cflush.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FLUSH -- FIO file flush.
+*/
+void
+c_flush (
+  XINT	fd			/* FIO file descriptor		*/
+)
+{
+	XINT  x_fd = fd;
+
+	FLUSH (&x_fd);
+}
diff --git a/sys/libc/cfmapfn.c b/sys/libc/cfmapfn.c
new file mode 100644
index 00000000..0d4181a0
--- /dev/null
+++ b/sys/libc/cfmapfn.c
@@ -0,0 +1,36 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FMAPFN -- Map a VFN (virtual filename) into an OSFN (host system filename).
+*/
+int
+c_fmapfn (
+  char	*vfn,			/* virtual filename		*/
+  char	*osfn,			/* OS filename			*/
+  int	maxch
+)
+{
+	XCHAR	x_osfn[SZ_PATHNAME+1];
+	XINT	sz_path = SZ_PATHNAME;
+
+
+	/* The OSFN is returned as a packed string in the XCHAR array x_osfn.
+	 * An intermediate buffer is used to avoid char->xchar alignment
+	 * problems of upward pointer coercion on some machines.
+	 */
+	if (maxch)
+	    iferr (FMAPFN (c_sppstr(vfn), x_osfn, &sz_path))
+		osfn[0] = EOS;
+	    else {
+		(void) strncpy (osfn, (char *)x_osfn, maxch);
+		osfn[maxch-1] = EOS;
+	    }
+	
+	return (strlen (osfn));
+}
diff --git a/sys/libc/cfmkdir.c b/sys/libc/cfmkdir.c
new file mode 100644
index 00000000..9888461d
--- /dev/null
+++ b/sys/libc/cfmkdir.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FMKDIR -- FIO procedure to create a new directory.
+*/
+int
+c_fmkdir (newdir)
+char	*newdir;			/* name of the new directory	*/
+{
+	iferr (FMKDIR (c_sppstr(newdir)))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cfnextn.c b/sys/libc/cfnextn.c
new file mode 100644
index 00000000..9917b89f
--- /dev/null
+++ b/sys/libc/cfnextn.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_FNEXTN -- Extract the filename extension substring from a filename.
+*/
+int
+c_fnextn (
+  char	*vfn,			/* filename			*/
+  char	*extn,			/* filename extension (output)	*/
+  int	maxch			/* max chars out		*/
+)
+{
+	XCHAR	spp_extn[SZ_FNAME+1];
+	XINT	x_maxch = SZ_FNAME, nchars;
+
+	nchars = (int) FNEXTN (c_sppstr(vfn), spp_extn, &x_maxch);
+	c_strpak (spp_extn, extn, maxch);
+
+	return (nchars);
+}
diff --git a/sys/libc/cfnldir.c b/sys/libc/cfnldir.c
new file mode 100644
index 00000000..9b8b469c
--- /dev/null
+++ b/sys/libc/cfnldir.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_FNLDIR -- Extract the directory prefix substring from a filename.
+*/
+int
+c_fnldir (
+  char	*vfn,			/* filename			*/
+  char	*ldir,			/* directory prefix (output)	*/
+  int	maxch			/* max chars out		*/
+)
+{
+	XCHAR	spp_ldir[SZ_FNAME+1];
+	XINT	x_maxch = SZ_FNAME, nchars;
+
+	nchars = FNLDIR (c_sppstr(vfn), spp_ldir, &x_maxch);
+	c_strpak (spp_ldir, ldir, maxch);
+
+	return (nchars);
+}
diff --git a/sys/libc/cfnroot.c b/sys/libc/cfnroot.c
new file mode 100644
index 00000000..78ac72bb
--- /dev/null
+++ b/sys/libc/cfnroot.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define import_xnames
+#include <iraf.h>
+
+/* C_FNROOT -- Extract the root filename substring from a filename.
+*/
+int
+c_fnroot (
+  char	*vfn,			/* filename			*/
+  char	*root,			/* root filename (output)	*/
+  int	maxch			/* max chars out		*/
+)
+{
+	XCHAR	spp_root[SZ_FNAME+1];
+	XINT	x_maxch = SZ_FNAME, nchars;
+
+	nchars = FNROOT (c_sppstr(vfn), spp_root, &x_maxch);
+	c_strpak (spp_root, root, maxch);
+
+	return (nchars);
+}
diff --git a/sys/libc/cfpath.c b/sys/libc/cfpath.c
new file mode 100644
index 00000000..b7820012
--- /dev/null
+++ b/sys/libc/cfpath.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FPATHNAME -- Map a VFN (virtual filename) into a pathname (filename
+** specification which is independent of the current directory).
+*/
+int
+c_fpathname (
+  char	*vfn,			/* virtual filename		*/
+  char	*osfn,			/* OS filename			*/
+  int	maxch
+)
+{
+	XCHAR	x_osfn[SZ_PATHNAME+1];
+	XINT	x_maxch = SZ_PATHNAME;
+
+
+	/* The OSFN is returned as a packed string in the XCHAR array x_osfn.
+	 * An intermediate buffer is used to avoid char->xchar alignment
+	 * problems of upward pointer coercion on some machines.
+	 */
+	iferr (FPATHNAME (c_sppstr(vfn), x_osfn, &x_maxch))
+	    osfn[0] = EOS;
+	else
+	    c_strpak (x_osfn, osfn, maxch);
+	
+	return (strlen (osfn));
+}
diff --git a/sys/libc/cfredir.c b/sys/libc/cfredir.c
new file mode 100644
index 00000000..2a4ae5b1
--- /dev/null
+++ b/sys/libc/cfredir.c
@@ -0,0 +1,46 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#include <iraf.h>
+
+
+/* C_FREDIR -- FIO redirect an open i/o stream to a named file.  Most commonly
+** used to redirect one of the standard i/o streams to a file.  The named file
+** need not be of the same type as the old stream.
+*/
+int
+c_fredir (
+  XINT	fd,			/* stream to be redirected	*/
+  char	*fname,			/* name of file to be opened	*/
+  int	mode,			/* access mode			*/
+  int	type			/* file type			*/
+)
+{
+	XINT  x_fd = fd, x_type = type, x_mode = mode;
+
+	iferr (FREDIR (&x_fd, c_sppstr(fname), &x_mode, &x_type))
+	    return (ERR);
+	else
+	    return (fd);
+}
+
+
+/* C_FREDIRO -- FIO redirect an open i/o stream to another open stream.
+*/
+int
+c_frediro (
+  XINT	fd,			/* stream to be redirected	*/
+  XINT	newfd			/* where it is to be redirected	*/
+)
+{
+	XINT  x_fd = fd, x_newfd = newfd;
+
+	iferr (FREDIRO (&x_fd, &x_newfd))
+	    return (ERR);
+	else
+	    return (fd);
+}
diff --git a/sys/libc/cfseti.c b/sys/libc/cfseti.c
new file mode 100644
index 00000000..7d496c33
--- /dev/null
+++ b/sys/libc/cfseti.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FSETI -- FIO set integer file parameter.
+*/
+void
+c_fseti (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param,			/* param to be set		*/
+  int	value			/* new value			*/
+)
+{
+	XINT  x_fd = fd,  x_param = param,  x_value = value;
+
+	FSETI (&x_fd, &x_param, &x_value);
+}
diff --git a/sys/libc/cfstati.c b/sys/libc/cfstati.c
new file mode 100644
index 00000000..aacf670a
--- /dev/null
+++ b/sys/libc/cfstati.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_FSTATI -- FIO get integer file parameter.
+*/
+int
+c_fstati (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param			/* param to be queried		*/
+)
+{
+	XINT  x_fd = fd,  x_param = param;
+
+	return (FSTATI (&x_fd, &x_param));
+}
diff --git a/sys/libc/cgetpid.c b/sys/libc/cgetpid.c
new file mode 100644
index 00000000..69ad6133
--- /dev/null
+++ b/sys/libc/cgetpid.c
@@ -0,0 +1,15 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_GETPID -- Get the process id.
+*/
+int
+c_getpid ( void )
+{
+	return ((int) GETPID());
+}
diff --git a/sys/libc/cgetuid.c b/sys/libc/cgetuid.c
new file mode 100644
index 00000000..cb86f4a3
--- /dev/null
+++ b/sys/libc/cgetuid.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_GETUID -- Get the user identification string (user name).
+*/
+char *
+c_getuid (
+  char	*outstr,		/* user name, C string		*/
+  int	maxch			/* max chars out, incl EOS	*/
+)
+{
+	XCHAR	spp_uid[SZ_FNAME+1];
+	XINT	x_maxch = SZ_FNAME;
+
+
+	GETUID (spp_uid, &x_maxch);
+	return (c_strpak (spp_uid, outstr, maxch));
+}
diff --git a/sys/libc/cgflush.c b/sys/libc/cgflush.c
new file mode 100644
index 00000000..8d5fe072
--- /dev/null
+++ b/sys/libc/cgflush.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_GFLUSH -- Flush any buffered graphics output.
+*/
+void
+c_gflush (
+  int	stream			/* graphics stream		*/
+)
+{
+	XINT  x_stream = stream;
+
+	GTR_GFLUSH (&x_stream);
+}
diff --git a/sys/libc/cimaccess.c b/sys/libc/cimaccess.c
new file mode 100644
index 00000000..17d2e874
--- /dev/null
+++ b/sys/libc/cimaccess.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_IMACCESS -- IMIO test if image can be accessed (exists).  1 is returned
+** if the image exists and is unique, 0 if the image does not exist, and ERR
+** if the image name ambiguous and multiple images exist matching that name.
+*/
+int
+c_imaccess (
+  char	*imname,		/* name of image to be accessed	*/
+  int	mode			/* access mode			*/
+)
+{
+	int  status;
+	XINT  x_mode = mode;
+
+
+	iferr (status = (int) IMACCESS (c_sppstr(imname), &x_mode))
+	    return (ERR);
+	else
+	    return (status);
+}
diff --git a/sys/libc/cimdrcur.c b/sys/libc/cimdrcur.c
new file mode 100644
index 00000000..1ac9f85b
--- /dev/null
+++ b/sys/libc/cimdrcur.c
@@ -0,0 +1,39 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_IMDRCUR -- Read the logical image cursor (temporary routine, will be
+** phased out in a later release).
+*/
+int
+c_imdrcur (
+  char	*device,		/* logical device name or "stdimage" */
+  float	*x, 			/* cursor X coordinate (out) */
+  float	*y,			/* cursor Y coordinate (out) */
+  int	*wcs,			/* wcs of coords (out, = frame*100+d_wcs) */
+  int	*key,			/* keystroke which triggered read (out) */
+  char	*strval,		/* string value, if key=':' */
+  int	maxch,			/* max chars out */
+  int	d_wcs,			/* 0 for frame coords, 1 for image coords */
+  int	pause			/* true to pause for key to terminate read */
+)
+{
+	PKCHAR	x_strval[SZ_LINE+1];
+	XINT  x_maxch = maxch,  x_d_wcs = d_wcs,  x_pause = pause;
+	XINT  x_wcs, x_key;
+
+
+	if (IMDRCUR (c_sppstr(device), x, y, &x_wcs, &x_key, x_strval, &x_maxch,
+	    &x_d_wcs, &x_pause) >= 0)
+	        c_strpak (x_strval, strval, maxch);
+
+	*wcs = x_wcs;
+	*key = x_key;
+
+	return (*key = (*key == XEOF) ? EOF : *key);
+}
diff --git a/sys/libc/ckimapc.c b/sys/libc/ckimapc.c
new file mode 100644
index 00000000..6653dd29
--- /dev/null
+++ b/sys/libc/ckimapc.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_KIMAPCHAN -- Map a KI channel number into the corresponding OS channel
+** number or pid and node name.
+*/
+int
+c_kimapchan (
+  int	chan,			/* KI channel number		*/
+  char	*nodename,		/* receives server node name	*/
+  int	maxch			/* maxch chars out		*/
+)
+{
+	XCHAR	x_nodename[SZ_FNAME+1];
+	XINT	ki_chan = chan, x_maxch = SZ_FNAME;
+	int	os_chan;
+
+	os_chan = (int) KI_MAPCHAN (&ki_chan, x_nodename, &x_maxch);
+	c_strpak (x_nodename, nodename, SZ_FNAME);
+
+	return (os_chan);
+}
diff --git a/sys/libc/clexnum.c b/sys/libc/clexnum.c
new file mode 100644
index 00000000..6e5091bc
--- /dev/null
+++ b/sys/libc/clexnum.c
@@ -0,0 +1,54 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define import_libc
+#define	import_ctype
+#define	import_lexnum
+#define	import_xnames
+#include <iraf.h>
+
+
+/* LEXNUM -- Lexically analyze a string to determine if it is a legal IRAF
+** style number.  Returns one of the following tokens (lexnum.h):
+**
+**	LEX_OCTAL		octal number (e.g. B suffix)
+**	LEX_HEX			hex number (e.g. X suffix)
+**	LEX_DECIMAL		decimal number
+**	LEX_REAL		real number (incl sexagesimal)
+**	LEX_NONNUM		nonnumeric
+**
+** A numeric token is returned if any (prefix) portion of the field is
+** numeric.  The total number of numeric characters is also returned so
+** that the application may verify that the entire field was numeric,
+** if desired.
+*/
+int
+c_lexnum (
+  char	*str,			/* input string			*/
+  int	*toklen			/* nchars in token		*/
+)
+{
+	register char *ip;
+	register XCHAR *op, ch, ndigits;
+	PKCHAR	 numbuf[SZ_FNAME];
+	XINT	 ip_start = 1, x_toklen = *toklen;
+	int      status;
+
+
+	/* Convert number to XCHAR for lexnum.  In the process check to see
+	 * if we have a simple decimal integer constant to save a scan.
+	 */
+	for (ip=str, op=numbuf, ndigits=0;  (*op++ = ch = *ip++);  )
+	    if (isdigit (ch))
+		ndigits++;
+
+	if (ndigits == (ip - str - 1)) {
+	    *toklen = ndigits;
+	    return (LEX_DECIMAL);
+	} else {
+	    status = LEXNUM (numbuf, &ip_start, &x_toklen);
+	    *toklen = (int) x_toklen;
+	    return (status);
+	}
+}
diff --git a/sys/libc/cmktemp.c b/sys/libc/cmktemp.c
new file mode 100644
index 00000000..cdc9e5a7
--- /dev/null
+++ b/sys/libc/cmktemp.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_MKTEMP -- FIO make temporary (unique) filename.
+*/
+int
+c_mktemp (
+  char	*root,			/* root filename		*/
+  char	*temp_filename,		/* generated filename		*/
+  int	maxch			/* max chars in output filename	*/
+)
+{
+	XCHAR	temp[SZ_FNAME+1];
+	XINT	sz_temp = SZ_FNAME;
+
+
+	iferr (MKTEMP (c_sppstr(root), temp, &sz_temp))
+	    return (0);
+	else
+	    return (strlen (c_strpak (temp, temp_filename, maxch)));
+}
diff --git a/sys/libc/cndopen.c b/sys/libc/cndopen.c
new file mode 100644
index 00000000..1a6920be
--- /dev/null
+++ b/sys/libc/cndopen.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_NDOPEN -- Network driver FIO file open.
+*/
+int
+c_ndopen (
+  char  *fname,                 /* name of file to be opened    */
+  int   mode                    /* access mode                  */
+)
+{
+        int   fd;
+	XINT  x_mode = mode;
+
+        iferr (fd = NDOPEN (c_sppstr(fname), &x_mode))
+            return (ERR);
+        else
+            return (fd);
+}
diff --git a/sys/libc/cnote.c b/sys/libc/cnote.c
new file mode 100644
index 00000000..c62a0b02
--- /dev/null
+++ b/sys/libc/cnote.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define import_fset
+#include <iraf.h>
+
+
+/* C_NOTE -- FIO note file offset.  If the actual file is a text file the
+** seek offset is a magic number and is returned unchanged.  If the actual
+** file is a binary file the seek offset is returned as a zero-indexed byte
+** offset.
+*/
+long
+c_note (
+  XINT	fd			/* FIO file descriptor		*/
+)
+{
+	long  xchar_offset;
+	XINT  x_fd = fd;
+
+	xchar_offset = (long) NOTE (&x_fd);
+	if (c_fstati (fd, F_TYPE) == BINARY_FILE)
+	    return ((xchar_offset - 1) * sizeof(XCHAR));
+	else
+	    return (xchar_offset);
+}
diff --git a/sys/libc/copen.c b/sys/libc/copen.c
new file mode 100644
index 00000000..144dc5d4
--- /dev/null
+++ b/sys/libc/copen.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_OPEN -- FIO file open.
+*/
+int
+c_open (
+  char	*fname,			/* name of file to be opened	*/
+  int	mode,			/* access mode			*/
+  int	type			/* file type			*/
+)
+{
+	int	fd;
+	XINT  x_mode = mode, x_type = type;
+
+	iferr (fd = (int) OPEN (c_sppstr(fname), &x_mode, &x_type))
+	    return (ERR);
+	else
+	    return (fd);
+}
diff --git a/sys/libc/coscmd.c b/sys/libc/coscmd.c
new file mode 100644
index 00000000..d6185bfe
--- /dev/null
+++ b/sys/libc/coscmd.c
@@ -0,0 +1,33 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_OSCMD -- Send a command to the host system.  If the filename strings
+** are nonnull the kernel will attempt to redirect the standard i/o streams
+** to the indicated streams during execution of the command.  OK is returned
+** if execution is completes successfully, otherwise a positive integer error
+** code is returned.
+*/
+int
+c_oscmd (
+  char	*cmd,			/* command to be executed	*/
+  char	*infile,		/* stdin file			*/
+  char	*outfile,		/* stdout file			*/
+  char	*errfile		/* stderr file			*/
+)
+{
+	XCHAR	spp_infile[SZ_FNAME+1];
+	XCHAR	spp_outfile[SZ_FNAME+1];
+	XCHAR	spp_errfile[SZ_FNAME+1];
+
+	c_strupk (infile,  spp_infile,  SZ_FNAME);
+	c_strupk (outfile, spp_outfile, SZ_FNAME);
+	c_strupk (errfile, spp_errfile, SZ_FNAME);
+
+	return (OSCMD (c_sppstr(cmd), spp_infile, spp_outfile, spp_errfile));
+}
diff --git a/sys/libc/cpoll.c b/sys/libc/cpoll.c
new file mode 100644
index 00000000..65f05274
--- /dev/null
+++ b/sys/libc/cpoll.c
@@ -0,0 +1,150 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_fpoll
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_POLL --  LIBC binding to the FIO polling interface.
+**
+**       fds = c_poll_open ()                   # open a poll descriptor set
+**         npolls = c_poll (fds, nfds, timeout) # poll the set
+**            c_poll_close (fds)                # free the poll descriptor set
+**
+**             c_poll_zero (fds)                # zero the poll array
+**              c_poll_set (fds, fd, type)      # set fd to poll for type
+**            c_poll_clear (fds, fd, type)      # unset type on fd poll
+**       y/n = c_poll_test (fds, fd, type)      # test fd for type event
+**            c_poll_print (fds)                # print the poll array
+**     N = c_poll_get_nfds (fds)                # get size of descriptor set
+*/
+
+
+/* C_POLL_OPEN -- Open a poll descriptor set.
+*/
+XINT
+c_poll_open ( void )
+{
+	XINT	fds;
+
+	iferr ((fds = (XINT) POLL_OPEN ()))
+	    return (NULL);
+	else 
+	    return (fds);
+}
+
+
+/* C_POLL -- Poll the descriptor set.
+*/
+int
+c_poll (
+  XINT	fds,					/* descriptor set ptr	*/
+  int	nfds,					/* no. descriptors	*/
+  int	timeout					/* poll timeout		*/
+)
+{
+	XINT  x_fds = fds, x_nfds = nfds, x_timeout = timeout;
+
+	return ((int) POLL (&x_fds, &x_nfds, &x_timeout));
+}
+
+
+/* C_POLL_CLOSE -- Close and free a poll descriptor set.
+*/
+void
+c_poll_close (
+  XINT	fds					/* descriptor set ptr	*/
+)
+{
+	XINT  x_fds = fds;
+
+	POLL_CLOSE (&x_fds);
+}
+
+
+/* C_POLL_ZERO -- Zero the descriptor set.
+*/
+void
+c_poll_zero (
+  XINT	fds					/* descriptor set ptr	*/
+)
+{
+	XINT  x_fds = fds;
+
+	POLL_ZERO (&x_fds);
+}
+
+
+/* C_POLL_SET --  Add a descriptor to the set, and/or modify the event type.
+** The type may be a bitwise or of testable events.
+*/
+void
+c_poll_set (
+  XINT	fds,					/* descriptor set ptr	*/
+  XINT	fd,					/* no. descriptors	*/
+  int	type					/* event type		*/
+)
+{
+	XINT  x_fds = fds, x_fd = fd, x_type = type;
+
+	POLL_SET (&x_fds, &x_fd, &x_type);
+}
+
+
+/* C_POLL_CLEAR --  Remove a descriptor or event type from the set.  The type
+** may be a bitwise or of testable events.  If the event mask becomes NULL the
+** descriptor is removed entirely from the set.
+*/
+void
+c_poll_clear (
+  XINT	fds,					/* descriptor set ptr	*/
+  XINT	fd,					/* no. descriptors	*/
+  int	type					/* event type		*/
+)
+{
+	XINT  x_fds = fds, x_fd = fd, x_type = type;
+
+	POLL_CLEAR (&x_fds, &x_fd, &x_type);
+}
+
+
+/* C_POLL_TEST -- Test the descriptor for the given event type.
+*/
+int
+c_poll_test (
+  XINT	fds,					/* descriptor set ptr	*/
+  XINT	fd,					/* no. descriptors	*/
+  int	type					/* event type		*/
+)
+{
+	XINT  x_fds = fds, x_fd = fd, x_type = type;
+
+	return ((int) POLL_TEST (&x_fds, &x_fd, &x_type));
+}
+
+
+/* C_POLL_GET_NFDS -- Return the size of the descriptor set.
+*/
+int
+c_poll_get_nfds (
+  XINT	fds					/* descriptor set ptr	*/
+)
+{
+	XINT  x_fds = fds;
+
+	return (POLL_GET_NFDS (&x_fds));
+}
+
+
+/* C_POLL_PRINT --  Debug print utility.
+*/
+void
+c_poll_print (XINT fds) 
+{ 
+	XINT  x_fds = fds;
+
+	POLL_PRINT (&x_fds); 
+}
diff --git a/sys/libc/cprcon.c b/sys/libc/cprcon.c
new file mode 100644
index 00000000..c0534a60
--- /dev/null
+++ b/sys/libc/cprcon.c
@@ -0,0 +1,198 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#define	import_prstat
+#include <iraf.h>
+
+
+/* CPRCON -- Connected subprocesses.  A connected subprocess is an active filter
+** which communicates with the parent process via an input stream and an output
+** stream.  A connected subprocess is logically equivalent to the user terminal.
+** The set of useful operations thus far identified for connected subprocesses
+** are open and close, read and write, and signal (interrupt).  The read and
+** write operations are provided by interfacing the IPC channels from the
+** subprocess to FIO.  The remaining operations are peculiar to connected
+** subprocesses and are summarized below.
+**
+**		  pid =	c_propen (process, in, out)
+**		stat = c_prclose (pid)
+**		stat = c_prstati (pid, param)
+**		      c_prsignal (pid, signal)
+**		       c_prredir (pid, stream, new_fd)
+**		       c_prchdir (pid, newdir)
+**		      c_prenvset (pid, envvar, valuestr)
+**
+** A connected subprocess must be opened either with c_propen or with the low
+** level procedure PROPCPR (the latter does not require that the subprocess
+** recognize the standard IPC protocol).  An idle subprocess may be closed
+** with c_prclose, which not only closes the process but releases important
+** system resources.  The c_prsignal procedure raises the X_INT (interrupt)
+** exception in a subprocess, generally following receipt of a user interrupt
+** by the parent process.  Redirection of the child's standard i/o streams
+** is provided by c_prredir.  Finally, c_prchdir and c_prenvsets are used
+** to update the current directory and environment in child processes.
+*/
+
+
+/* C_PROPEN -- Open a connected subprocess, i.e., spawn the subprocess and
+** connect the two IPC channels connecting the child and parent to FIO.
+** The FIO streams may subsequently be opened for C style STDIO by calling
+** FDOPEN, if desired.  The C_PROPEN procedure sends the current environment
+** and working directory to the child as part of process startup.  The process
+** id (PID) of the child process is returned as the function value.  This
+** magic integer value uniquely identifies the process to the system.
+**
+** N.B.: opening a child process leaves the child in the IRAF Main interpreter
+** loop, with the child waiting for a command from the parent.  A child process
+** is capabable of performing an arbitrary number of "tasks".  To get the child
+** to run a task, the parent must write the name of the task to the OUT stream,
+** then read from the IN stream, responding to all queries from the child until
+** "bye" or "error" is received.
+*/
+unsigned int
+c_propen (
+  char	*process,		/* filename of executable process	*/
+  int	*in,			/* FD for reading from child		*/
+  int	*out			/* FD for writing to child		*/
+)
+{
+	register unsigned int pid;
+	XINT  x_in = *in, x_out = *out;
+
+	iferr (pid = (unsigned int) PROPEN (c_sppstr(process), &x_in, &x_out))
+	    return (NULL);
+	else {
+	    *in = (int) x_in;
+	    *out = (int) x_out;
+	    FDTOFP(*in)->_fflags |= _FIPC;
+	    return (pid);
+	}
+}
+
+
+/* C_PRCLOSE -- Close a connected subprocess.  The "bye" command is sent to
+** the child, commanding it to shut down, and when the task terminates the
+** exit status is returned as the function value.  The C_PRCLOSE procedure
+** must be called at process termination to free system resources.  C_PRCLOSE
+** is automatically called by the system if error recovery takes place in
+** the parent process.  Calling C_PRCLOSE is equivalent to individually
+** closing the IN and OUT streams to the subprocess (which is what happens
+** if system error recovery takes place).
+*/
+int
+c_prclose (
+  unsigned int pid		/* process id returned by C_PROPEN	*/
+)
+{
+	XINT  x_pid = pid;
+
+	return (PRCLOSE (&x_pid));
+}
+
+
+/* C_PRSTATI -- Get status on a connected subprocess.  See <libc/prstat.h>
+** for a list of parameters.
+*/
+int
+c_prstati (
+  int	pid,			/* process id of process		*/
+  int	param			/* parameter for which value is ret	*/
+)
+{
+	XINT  x_pid = pid, x_param = param;
+
+	return (PRSTATI (&x_pid, &x_param));
+}
+
+
+/* C_PRSIGNAL -- Send a signal, i.e., asynchronous interrupt, to a connected
+** child process.  Currently only the X_INT signal is implemented, and the
+** second argument is not used.  The value X_INT should nontheless be passed.
+*/
+int
+c_prsignal (
+  unsigned pid,			/* process id of process		*/
+  int	signal			/* not used at present			*/
+)
+{
+	XINT  x_pid = pid,  x_signal = signal;
+
+	iferr (PRSIGNAL (&x_pid, &x_signal))
+	    return (ERR);
+	else
+	    return (OK);
+}
+
+
+/* C_PRREDIR -- Redirect one of the standard i/o streams of the child process.
+** By default the child inherits the standard i/o streams of the parent at
+** C_PROPEN time, i.e., the STDOUT of the child is connected to the STDOUT of
+** the parent.  If the parent's STDOUT is subsequently redirected, e.g., with
+** C_FREDIR, the child's output will be redirected as well.  More commonly
+** one or more of the child's streams will be explicitly redirected with
+** C_PRREDIR.  Such redirection remains in effect for the life of the
+** process, i.e., until process termination via C_PRCLOSE or until another
+** call to C_PRREDIR.  Note that often this is not what is desired, rather,
+** one wishes to redirect a stream for the duration of a task running within
+** the process.  For this reason it is recommended that C_PRREDIR be called
+** for each standard stream (it costs almost nothing) immediately prior to
+** task execution.
+**
+** Example:
+**		fp = fopen ("tmp$spoolfile", "w");
+**		if (c_prredir (pid, STDOUT, fileno(fp)) == ERR)
+**			...
+*/
+int
+c_prredir (
+  unsigned pid,			/* process id of child			*/
+  int	stream,			/* child's stream to be redirected	*/
+  int	new_fd			/* FD of opened file in parent		*/
+)
+{
+	XINT  x_pid = pid, x_stream = stream, x_new_fd = new_fd;
+
+	iferr (PRREDIR (&x_pid, &x_stream, &x_new_fd))
+	    return (ERR);
+	else
+	    return (OK);
+}
+
+
+/* C_PRCHDIR -- Change the current working directory of a child process.
+** If pid=NULL all currently connected processes are updated.  May only
+** be called when the child process is idle.
+*/
+int
+c_prchdir (
+  int	pid,
+  char	*newdir
+)
+{
+	XINT  x_pid = pid;
+
+	return (PRCHDIR (&x_pid, c_sppstr (newdir)));
+}
+
+
+/* C_PRENVSET -- Transmit a set environment directive to the child process.
+** If pid=NULL all currently connected processes are updated.  May only
+** be called when the child process is idle.
+*/
+int
+c_prenvset (
+  int	pid,
+  char	*envvar, 
+  char  *value
+)
+{
+	XCHAR  spp_value[SZ_LINE];
+	XINT   x_pid = pid;
+
+	c_strupk (value, spp_value, SZ_LINE);
+	return (PRENVSET (&x_pid, c_sppstr (envvar), spp_value));
+}
diff --git a/sys/libc/cprdet.c b/sys/libc/cprdet.c
new file mode 100644
index 00000000..92829723
--- /dev/null
+++ b/sys/libc/cprdet.c
@@ -0,0 +1,109 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/*
+** CPRDET -- Detached processes.  A detached process is a process which runs
+** asynchronously with and independently of the parent, generally without 
+** interprocess communication during execution.  The primary example of a
+** detached process in IRAF is the CL process spawned by an interactive CL
+** to execute a command in the background.
+**
+** The parent communicates with the child by means of the "bkgfile", the name
+** of which is passed by the system to the child during process startup.
+** While the format and contents of the bkgfile are in general application
+** dependent, the system default action is to open the bkgfile as a text file
+** and read commands from it.  The CL process does not make use of this
+** default, but rather uses its own special format binary file to communicate
+** the full runtime context of the parent to the child, partially emulating
+** the UNIX fork.  The system automatically deletes the bkgfile when the
+** child process terminates.
+**
+** N.B.: The environment and cwd are not automatically passed to the child,
+** as they are for a connected subprocess.  The application must see to it
+** that this information is passed in the bkgfile if needed by the child.
+*/
+
+/* C_PROPDPR -- Open a detached process.  The named process is either spawned
+** or queued for delayed execution (depending on the system and other factors).
+** When the process eventually runs it reads the bkgfile passed by the parent
+** to determine what to do.  When the process terminates, either normally or
+** abnormally, the system deletes the bkgfile.  Deletion of the bkgfile signals
+** process termination.
+*/
+unsigned int
+c_propdpr (
+  char	*process,		/* filename of executable file	*/
+  char	*bkgfile,		/* filename of bkgfile		*/
+  char	*bkgmsg			/* control string for kernel	*/
+)
+{
+	unsigned job;
+	XCHAR	spp_bkgfile[SZ_PATHNAME];
+	XCHAR	spp_bkgmsg[SZ_LINE];
+
+
+	c_strupk (bkgfile, spp_bkgfile, SZ_PATHNAME);
+	c_strupk (bkgmsg,  spp_bkgmsg,  SZ_LINE);
+	iferr (job = PROPDPR (c_sppstr(process), spp_bkgfile, spp_bkgmsg))
+	    return (NULL);
+	else
+	    return (job);
+}
+
+
+/* C_PRCLDPR -- Close a detached process.  Wait (indefinitely) for process
+** termination, then free all system resources allocated to the process.
+** Should be called if a detached process terminated while the parent is
+** still executing.  The exit status of the child is returned as the function
+** value; the value OK (0) indicates normal termination.  A positive value
+** is the error code of the error which caused abnormal process termination.
+*/
+int
+c_prcldpr (
+  unsigned job			/* job code from C_PROPDPR	*/
+)
+{
+	XINT  x_job = job;
+
+	return (PRCLDPR (&x_job));
+}
+
+
+/* C_PRDONE -- Determine if a bkg job is still executing (function return NO)
+** or has terminated (function return YES).
+*/
+int
+c_prdone (
+  unsigned job			/* job code from C_PROPDPR	*/
+)
+{
+	XINT  x_job = job;
+
+	return (PRDONE (&x_job));
+}
+
+
+/* C_PRKILL -- Kill a bkg job.  If the bkg job has begun execution it is
+** killed without error recovery.  If the bkg job is still sitting in a queue
+** it is dequeued.  C_PRKILL returns ERR for an illegal jobcode or if sufficient
+** permission is not available to kill the job.  C_PRCLDPR should subsequently
+** be called to wait for process termination and free system resources.
+*/
+int
+c_prkill (
+  unsigned job			/* job code from C_PROPDPR	*/
+)
+{
+	XINT  x_job = job;
+
+	iferr (PRKILL (&x_job))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cprintf.c b/sys/libc/cprintf.c
new file mode 100644
index 00000000..dd317f69
--- /dev/null
+++ b/sys/libc/cprintf.c
@@ -0,0 +1,53 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_PRINTF -- Formatted print to STDOUT.
+*/
+int
+c_printf (
+  char	*format			/* format string */
+)
+{
+	iferr (PRINTF (c_sppstr(format)))
+	    return (ERR);
+	else
+	    return (OK);
+}
+
+
+/* C_FPRINTF -- Formatted print to given file.
+*/
+int
+c_fprintf (
+  XINT	fd,			/* output file */
+  char	*format			/* format string */
+)
+{
+	XINT  x_fd = fd;
+
+	iferr (FPRINTF (&x_fd, c_sppstr(format)))
+	    return (ERR);
+	else
+	    return (OK);
+}
+
+
+void c_pargb (int    ival) { XINT    x_ival = ival; PARGI (&x_ival); }
+void c_pargc (int    ival) { XINT    x_ival = ival; PARGI (&x_ival); }
+void c_pargs (short  sval) { XSHORT  x_sval = sval; PARGS (&x_sval); }
+void c_pargi (int    ival) { XINT    x_ival = ival; PARGI (&x_ival); }
+void c_pargl (long   lval) { XLONG   x_lval = lval; PARGL (&x_lval); }
+void c_pargr (float  rval) { XREAL   x_rval = rval; PARGR (&x_rval); }
+void c_pargd (double dval) { XDOUBLE x_dval = dval; PARGD (&x_dval); }
+
+
+void c_pargstr (char *strval)
+{
+    PARGSTR (c_sppstr(strval)); 
+}
diff --git a/sys/libc/crcursor.c b/sys/libc/crcursor.c
new file mode 100644
index 00000000..695c9668
--- /dev/null
+++ b/sys/libc/crcursor.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_RCURSOR -- Read a cursor.
+*/
+int
+c_rcursor (
+  int	fd,			/* FIO file descriptor		*/
+  char	*outstr,		/* output string		*/
+  int	maxch
+)
+{
+	XCHAR	buf[SZ_LINE];
+	XINT x_fd = fd, x_maxch = maxch;
+	int	key;
+
+
+	key = (int) RCURSOR (&x_fd, buf, &x_maxch);
+	c_strpak (buf, outstr, maxch);
+
+	return (key == XEOF ? EOF : key);
+}
diff --git a/sys/libc/crdukey.c b/sys/libc/crdukey.c
new file mode 100644
index 00000000..a0b7042c
--- /dev/null
+++ b/sys/libc/crdukey.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_RDUKEY -- Read a user keystroke object from the terminal in raw mode.
+*/
+int
+c_rdukey (
+  char	*obuf,			/* output buffer	*/
+  int	maxch			/* maxc chars out	*/
+)
+{
+	XCHAR	buf[SZ_LINE+1];
+	XINT	x_maxch = SZ_LINE;
+	int	status;
+
+
+	obuf[0] = EOS;
+	if ((status = (int) RDUKEY (buf, &x_maxch)) > 0)
+	    c_strpak (buf, obuf, maxch);
+
+	return (status);
+}
diff --git a/sys/libc/cread.c b/sys/libc/cread.c
new file mode 100644
index 00000000..8cc727a5
--- /dev/null
+++ b/sys/libc/cread.c
@@ -0,0 +1,70 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define import_stdio
+#define import_error
+#define import_fset
+#include <iraf.h>
+
+
+/* C_READ -- FIO read from a file.  Read up to maxbytes bytes from the stream
+** fd into the buffer buf.  If the device associated with file fd is a record
+** structured device a single record is read, and the byte count will generally
+** be less than the maximum.  If the physical record was larger than maxbytes
+** the remainder of the record is returned in successive reads.  If the actual
+** file is a text file FIO XCHARs are returned as C chars.  If the actual file
+** is a binary file no conversion is performed, and an integral number of XCHARs
+** are read.
+**
+** For reasons of consistency with SPP usage, EOF is returned when end of file
+** is reached (fread returns 0), and an error action is taken if a file read
+** error occurs.  We cannot return ERR when an error occurs since ERR and EOF
+** have the same value in STDIO land.  IFERR may be used to catch file read
+** errors.
+*/
+int
+c_read (
+  XINT	fd,			/* FIO file descriptor		*/
+  char	*buf,			/* output buffer		*/
+  int	maxbytes		/* max bytes to read		*/
+)
+{
+	XINT  x_fd = fd;
+	int   nchars_read;
+
+
+	if (c_fstati (fd, F_TYPE) == TEXT_FILE) {
+	    register char	*op = buf;
+	    register int	ch, n = maxbytes;
+	    register FILE	*fp = FDTOFP(fd);
+
+	    while (--n >= 0 && (ch = getc(fp)) >= 0) {
+		*op++ = ch;
+		if (ch == '\n')
+		    break;
+	    }
+	    if (ferror (fp))
+		c_erract (EA_ERROR);
+	    if (!(nchars_read = op - buf))
+		nchars_read = XEOF;
+
+	} else {
+	    XINT	x_maxchars = maxbytes / sizeof(XCHAR);
+	    XCHAR	*bp = (XCHAR *)buf;
+
+	    /* Verify that the pointer coercion char->XCHAR->char is legal,
+	     * i.e., that the char pointer is aligned to an XCHAR word
+	     * boundary if required on this machine.
+	     */
+	    if (buf != (char *)bp)
+		c_error (1, "c_read: buffer not xchar aligned");
+	    
+	    if ((nchars_read = READ (&x_fd, bp, &x_maxchars)) > 0)
+		nchars_read *= sizeof(XCHAR);
+	}
+
+	return (nchars_read == XEOF ? EOF : nchars_read);
+}
diff --git a/sys/libc/crename.c b/sys/libc/crename.c
new file mode 100644
index 00000000..5f5b6668
--- /dev/null
+++ b/sys/libc/crename.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_RENAME -- FIO rename file.
+*/
+int
+c_rename (
+  char	*old_fname,		/* current name of file		*/
+  char	*new_fname		/* new file name		*/
+)
+{
+	XCHAR	spp_new_fname[SZ_FNAME];
+	int	maxch = SZ_FNAME;
+
+	c_strupk (new_fname, spp_new_fname, maxch);
+	iferr (RENAME (c_sppstr(old_fname), spp_new_fname))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/creopen.c b/sys/libc/creopen.c
new file mode 100644
index 00000000..da38703e
--- /dev/null
+++ b/sys/libc/creopen.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_REOPEN -- Reopen a binary file.
+*/
+int
+c_reopen (
+  XINT  fd,                 	/* FIO file descriptor		*/
+  int   mode                    /* access mode                  */
+)
+{
+	XINT  x_fd = fd, x_mode = mode;
+	int new_fd;
+
+
+        iferr (new_fd = (int) REOPEN (&x_fd, &x_mode))
+            return (ERR);
+        else
+            return (new_fd);
+}
+
diff --git a/sys/libc/csalloc.c b/sys/libc/csalloc.c
new file mode 100644
index 00000000..823c0bca
--- /dev/null
+++ b/sys/libc/csalloc.c
@@ -0,0 +1,80 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+/*
+** CSALLOC -- Dynamic memory allocation on the SPP stack.
+**
+**			c_smark (&sp)
+**			c_sfree (sp)
+**		 ptr = c_salloc (nbytes)
+**
+** A contiguous segment of dynamic storage may be allocated with C_SALLOC,
+** much as is done with the UNIX emulation procedure MALLOC.  All buffer
+** space allocated on the stack since a call to C_SMARK to mark the position
+** of the stack pointer may be freed in a single call to C_SFREE.
+**
+** The stack is implemented as a linked list of a few large buffers allocated
+** on the heap with MALLOC, each of which normally contains many small buffers
+** allocated with individual C_SALLOC calls.  Stack allocation is very
+** efficient for buffers small enough to fit into a stack segment.  If it is
+** necessary to add a new segment to accomodate a large buffer, the expense is
+** about the same as for a buffer allocation with MALLOC.
+*/
+
+
+/* C_SALLOC -- Allocate a contiguous segment of memory on the stack.  The
+** contents of the buffer will be uninitialized.  The buffer is guaranteed to
+** have at least XDOUBLE alignment with the Mem common.  One extra XCHAR
+** of storage is automatically allocated for the EOS delimiter in the event
+** that the buffer is used to hold a character string (thus it is not necessary
+** to be forever adding +1 in calls to the memory allocator).
+**
+** N.B.: it is a fatal error if storage cannot be allocated on the stack,
+** hence error checking is not necessary.
+*/
+char *
+c_salloc (
+  unsigned nbytes		/* nbytes of storage to be allocated	*/
+)
+{
+	XINT	buf;
+	XINT	x_nchars = nbytes, x_dtype = TY_CHAR;
+
+
+	x_nchars = (nbytes + sizeof(XCHAR)-1) / sizeof(XCHAR);
+	SALLOC (&buf, &x_nchars, &x_dtype);
+	return ((char *)&Memc[buf]);
+}
+
+
+/* C_SMARK -- Mark the position of the stack pointer.
+*/
+void
+c_smark (
+  int	*sp			/* stack pointer is saved here		*/
+)
+{
+	XINT  x_sp = *sp;
+
+	SMARK (&x_sp);
+	*sp = x_sp;
+}
+
+
+/* C_SFREE -- Free all stack storage allocated since the stack pointer passed as
+** the sole argument was marked by C_SMARK.
+*/
+void
+c_sfree (
+  int	sp			/* saved stack pointer			*/
+)
+{
+	XINT  x_sp = sp;
+
+	SFREE (&x_sp);
+}
diff --git a/sys/libc/cseek.c b/sys/libc/cseek.c
new file mode 100644
index 00000000..58cedcc3
--- /dev/null
+++ b/sys/libc/cseek.c
@@ -0,0 +1,42 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define import_fset
+#include <iraf.h>
+
+
+/* C_SEEK -- FIO seek on a file.  If the actual file is a text file the
+** seek offset is assumed to have been obtained by a prior call to FTELL
+** and is passed on unchanged.  If the actual file is a binary file the
+** seek offset is a zero-indexed byte offset.  This offset is converted
+** to a one-indexed XCHAR offset; it is an error if the offset is not
+** aligned to an XCHAR word boundary.
+*/
+int
+c_seek (
+  XINT	fd,			/* FIO file descriptor		*/
+  long	offset			/* file offset			*/
+)
+{
+	XLONG	x_char_offset = offset;
+	XINT    x_fd = fd;
+	int	bypass;
+
+
+	bypass = (offset == BOFL || offset == EOFL
+		|| c_fstati (fd, F_TYPE) == TEXT_FILE);
+
+	if (!bypass) {
+	    x_char_offset /= sizeof(XCHAR);
+	    if ((x_char_offset++ * sizeof(XCHAR)) != offset)
+		return ((long) ERR);
+	}
+
+	iferr (SEEK (&x_fd, &x_char_offset))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/csppstr.c b/sys/libc/csppstr.c
new file mode 100644
index 00000000..ce7c9461
--- /dev/null
+++ b/sys/libc/csppstr.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#include <iraf.h>
+
+#define	SZ_UPKSTR	SZ_COMMAND
+static	XCHAR u_upkstr[SZ_UPKSTR+1];
+
+/* C_SPPSTR -- Unpack a C string into an SPP string.  This routine is offered
+** as a convenient alternative to C_STRUPK for cases when the length of the
+** string is known to be short and the value will be used before we are again
+** called.  The unpacked string is left in a static internal buffer and a
+** pointer to XCHAR is returned as the function value.
+*/
+XCHAR *
+c_sppstr (
+  char	*str
+)
+{
+	register char	*ip = str;
+	register XCHAR	*op = u_upkstr;
+	register int	n = SZ_UPKSTR;
+
+	while (--n >= 0 && (*op++ = *ip++) != XEOS)
+	    ;
+	u_upkstr[SZ_UPKSTR] = XEOS;
+
+	return (u_upkstr);
+}
diff --git a/sys/libc/cstropen.c b/sys/libc/cstropen.c
new file mode 100644
index 00000000..ac7d01a8
--- /dev/null
+++ b/sys/libc/cstropen.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_STROPEN -- FIO string-file open.
+*/
+int
+c_stropen (
+  XCHAR	*obuf,			/* string file-buffer	*/
+  int	maxch,			/* max chars in string	*/
+  int	mode			/* file access mode	*/
+)
+{
+	XINT  x_maxch = maxch, x_mode = mode;
+	int   fd;
+
+	iferr (fd = (int) STROPEN (obuf, &x_maxch, &x_mode))
+	    return (ERR);
+	else
+	    return (fd);
+}
diff --git a/sys/libc/cstrpak.c b/sys/libc/cstrpak.c
new file mode 100644
index 00000000..6236aa0d
--- /dev/null
+++ b/sys/libc/cstrpak.c
@@ -0,0 +1,35 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#include <iraf.h>
+
+
+/* C_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 *
+c_strpak (
+  XCHAR	*sppstr,		/* SPP string			*/
+  char	*cstr,			/* C string			*/
+  int	maxch			/* max chars out, incl EOS	*/
+)
+{
+	register XCHAR	*ip = sppstr;
+	register char	*op = cstr;
+	register int	n = maxch-1;
+
+	if (maxch) {
+	    if (sizeof(XCHAR) != sizeof(char) || (char *)sppstr != cstr) {
+		while (--n >= 0 && (*op++ = *ip++) != EOS)
+		    ;
+		cstr[maxch-1] = EOS;
+	    }
+	}
+
+	return (cstr);
+}
diff --git a/sys/libc/cstrupk.c b/sys/libc/cstrupk.c
new file mode 100644
index 00000000..c8e26e19
--- /dev/null
+++ b/sys/libc/cstrupk.c
@@ -0,0 +1,41 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#define	import_spp
+#include <iraf.h>
+
+/* C_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 *
+c_strupk (
+  char	*str,			/* C string			*/
+  XCHAR	*outstr,		/* SPP string			*/
+  int	maxch			/* max chars out, incl EOS	*/
+)
+{
+	register char	*ip = str;
+	register XCHAR	*op = outstr;
+	register int	  n = maxch-1;
+
+
+	/* 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;
+
+		for (n = n - 1;  n >= 0;  --n)
+		    op[n] = ip[n];
+	    }
+
+	return (outstr);
+}
diff --git a/sys/libc/ctsleep.c b/sys/libc/ctsleep.c
new file mode 100644
index 00000000..9b89fe08
--- /dev/null
+++ b/sys/libc/ctsleep.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+/* C_TSLEEP -- Suspend process execution for the specified number of seconds.
+*/
+void
+c_tsleep (
+  int	nseconds
+)
+{
+	XINT  x_nsec = nseconds;
+
+	TSLEEP (&x_nsec);
+}
diff --git a/sys/libc/cttset.c b/sys/libc/cttset.c
new file mode 100644
index 00000000..ab252ea2
--- /dev/null
+++ b/sys/libc/cttset.c
@@ -0,0 +1,88 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_STTYCO -- Set terminal driver options via a command string.
+*/
+void
+c_sttyco (
+  char	*args,
+  XINT	ttin, 
+  XINT  ttout,
+  XINT	outfd
+)
+{
+	XCHAR	x_args[SZ_COMMAND];
+	XINT    x_ttin = ttin, x_ttout = ttout, x_outfd = outfd;
+
+	c_strupk (args, x_args, SZ_COMMAND);
+	STTYCO (x_args, &x_ttin, &x_ttout, &x_outfd);
+}
+
+
+/* C_TTSETI -- FIO set integer terminal driver parameter.
+*/
+void
+c_ttseti (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param,			/* param to be set		*/
+  int	value			/* new value			*/
+)
+{
+	XINT  x_fd = fd, x_param = param, x_value = value;
+
+	TTSETI (&x_fd, &x_param, &x_value);
+}
+
+
+/* C_TTSTATI -- FIO stat integer terminal driver parameter.
+*/
+int
+c_ttstati (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param			/* param to be set		*/
+)
+{
+	XINT  x_fd = fd, x_param = param;
+
+	return (TTSTATI (&x_fd, &x_param));
+}
+
+/* C_TTSETS -- FIO set string terminal driver parameter.
+*/
+void
+c_ttsets (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param,			/* param to be set		*/
+  char	*value			/* new value			*/
+)
+{
+	XINT  x_fd = fd, x_param = param;
+
+	TTSETS (&x_fd, &x_param, c_sppstr (value));
+}
+
+
+/* C_TTSTATS -- FIO stat string terminal driver parameter.
+*/
+int
+c_ttstats (
+  XINT	fd,			/* FIO file descriptor		*/
+  int	param,			/* param to be set		*/
+  char	*outstr,		/* receives string value	*/
+  int	maxch
+)
+{
+	XCHAR	x_sval[SZ_LINE+1];
+	XINT	x_fd = fd, x_param = param, x_maxch = SZ_LINE;
+	int	nchars;
+
+	nchars = TTSTATS (&x_fd, &x_param, x_sval, &x_maxch);
+	c_strpak (x_sval, outstr, maxch);
+	return (maxch < nchars ? maxch : nchars);
+}
diff --git a/sys/libc/cttycdes.c b/sys/libc/cttycdes.c
new file mode 100644
index 00000000..1d7cfc84
--- /dev/null
+++ b/sys/libc/cttycdes.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+/* C_TTYCDES -- Close the TTY descriptor.
+*/
+void
+c_ttycdes (
+  XINT	tty			/* SPP pointer to descriptor	*/
+)
+{
+	XINT  x_tty = tty;
+
+	TTYCDES (&x_tty);
+}
diff --git a/sys/libc/cttyclear.c b/sys/libc/cttyclear.c
new file mode 100644
index 00000000..e10c274f
--- /dev/null
+++ b/sys/libc/cttyclear.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYCLEAR -- Clear the screen.
+*/
+void
+c_ttyclear (
+  XINT	fd,			/* output file			*/
+  XINT	tty			/* tty descriptor		*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty;
+
+	TTYCLEAR (&x_fd, &x_tty);
+}
diff --git a/sys/libc/cttyclln.c b/sys/libc/cttyclln.c
new file mode 100644
index 00000000..7a6a20ee
--- /dev/null
+++ b/sys/libc/cttyclln.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYCLEARLN -- Clear the current line.  The cursor is left positioned to
+** the left margin.
+*/
+void
+c_ttyclearln (
+  XINT	fd,			/* output file			*/
+  XINT	tty			/* tty descriptor		*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty;
+
+	TTYCLEARLN (&x_fd, &x_tty);
+}
diff --git a/sys/libc/cttyctrl.c b/sys/libc/cttyctrl.c
new file mode 100644
index 00000000..8143c8e4
--- /dev/null
+++ b/sys/libc/cttyctrl.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYCTRL -- Lookup a capability in the termcap entry for a device and
+** output the associated control string to the given output file.  The baud
+** rate (extracted from the environment at TTYODES time or set in a C_TTYSETI
+** call) determines the number of pad characters output for delays.  ERR is
+** returned if the control sequence could not be output.
+*/
+int
+c_ttyctrl (
+  XINT	fd,			/* output file			*/
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap,			/* two char capability name	*/
+  int	afflncnt		/* number of lines affected	*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty, x_afflncnt = afflncnt;
+
+	return (TTYCTRL (&x_fd, &x_tty, c_sppstr(cap), &x_afflncnt));
+}
diff --git a/sys/libc/cttygetb.c b/sys/libc/cttygetb.c
new file mode 100644
index 00000000..cc1386bc
--- /dev/null
+++ b/sys/libc/cttygetb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYGETB -- Determine if the named capability exists for a device.
+** Presence of the capability in the termcap entry for the device results
+** in a return value of YES (=1), regardless of the actual datatype of
+** the parameter.
+*/
+int
+c_ttygetb (
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap			/* two char capability name	*/
+)
+{
+	XINT  x_tty = tty;
+
+	return ((int) BTOI ((XBOOL) TTYGETB (&x_tty, c_sppstr(cap))));
+}
diff --git a/sys/libc/cttygeti.c b/sys/libc/cttygeti.c
new file mode 100644
index 00000000..1011dac5
--- /dev/null
+++ b/sys/libc/cttygeti.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYGETI -- Get the value of a termcap capability of type integer.
+** Zero is returned if the device does not have such a capability or if
+** the the value string cannot be interpreted as an integer.
+*/
+XINT
+c_ttygeti (
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap			/* two char capability name	*/
+)
+{
+	XINT  x_tty = tty;
+
+	return ((XINT) TTYGETI (&x_tty, c_sppstr(cap)));
+}
diff --git a/sys/libc/cttygetr.c b/sys/libc/cttygetr.c
new file mode 100644
index 00000000..195d0e87
--- /dev/null
+++ b/sys/libc/cttygetr.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+/* C_TTYGETR -- Get the value of a termcap capability of type real.
+** Zero is returned if the device does not have such a capability or if
+** the the value string cannot be interpreted as a real.
+*/
+float
+c_ttygetr (
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap			/* two char capability name	*/
+)
+{
+	XINT  x_tty = tty;
+
+	return ((float) TTYGETR (&x_tty, c_sppstr(cap)));
+}
diff --git a/sys/libc/cttygets.c b/sys/libc/cttygets.c
new file mode 100644
index 00000000..04aea891
--- /dev/null
+++ b/sys/libc/cttygets.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+#define	SZ_CAPSTR	128
+static	XCHAR	buf[SZ_CAPSTR];
+static	XINT	szbuf = 128;
+
+
+/* C_TTYGETS -- Get the value of a termcap capability as a character string,
+** suitable for subsequent output to the device with TTYPUTS (assuming the
+** capability is a control function).  The number of characters in the output
+** string is returned as the function value.
+*/
+int
+c_ttygets (
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap,			/* two char capability name	*/
+  char	*outstr,		/* output string		*/
+  int	maxch			/* max chars out, excl EOS	*/
+)
+{
+	XINT  x_tty = tty;
+	int	nchars;
+
+	nchars = TTYGETS (&x_tty, c_sppstr(cap), buf, &szbuf);
+	c_strpak (buf, outstr, maxch);
+
+	return (nchars);
+}
diff --git a/sys/libc/cttygoto.c b/sys/libc/cttygoto.c
new file mode 100644
index 00000000..eb6f8922
--- /dev/null
+++ b/sys/libc/cttygoto.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYGOTO -- Move the cursor to the indicated X,Y position (one-indexed).
+*/
+void
+c_ttygoto (
+  XINT	fd,			/* output file			*/
+  XINT	tty,			/* tty descriptor		*/
+  int	col,			/* x coordinate			*/
+  int	line			/* y coordinate			*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty, x_col = col, x_line = line;
+
+	TTYGOTO (&x_fd, &x_tty, &x_col, &x_line);
+}
diff --git a/sys/libc/cttyinit.c b/sys/libc/cttyinit.c
new file mode 100644
index 00000000..da7da5ab
--- /dev/null
+++ b/sys/libc/cttyinit.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYINIT -- Output the initialization sequence, if any, to the output
+** file.
+*/
+void
+c_ttyinit (
+  XINT	fd,			/* output file			*/
+  XINT	tty			/* tty descriptor		*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty;
+
+	TTYINIT (&x_fd, &x_tty);
+}
diff --git a/sys/libc/cttyodes.c b/sys/libc/cttyodes.c
new file mode 100644
index 00000000..2d7a5cc3
--- /dev/null
+++ b/sys/libc/cttyodes.c
@@ -0,0 +1,89 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/*
+** CTTY -- Terminal control.  The TTY package is an interface to the TERMCAP
+** database, originally developed for Berkeley UNIX by Bill Joy.  The termcap
+** entry for a particular terminal presents in a condensed form the
+** characteristics of the device, e.g., the number of line and columns on the
+** screen, and how to clear the screen or move the cursor.  The TTY routines
+** are used to retrieve such capabilities from the database as well as to
+** send the appropriate characters to a file (terminal) to perform such control
+** functions.
+**
+** 	     tty = c_ttyodes (ttyname)
+** 		   c_ttycdes (tty)
+** 		   c_ttyseti (tty, parameter, value)
+** 	    int = c_ttystati (tty, parameter)
+** 
+** 	    bool = c_ttygetb (tty, cap)
+** 	     int = c_ttygeti (tty, cap)
+** 	   float = c_ttygetr (tty, cap)
+** 	  nchars = c_ttygets (tty, cap, &outstr, maxch)
+** 		   c_ttyctrl (fd, tty, cap, afflncnt)
+** 		   c_ttyputs (fd, tty, ctrlstr, afflncnt)
+** 
+** 		  c_ttyclear (fd, tty)
+** 		c_ttyclearln (fd, tty)
+** 		   c_ttygoto (fd, tty, col, line)
+** 		   c_ttyinit (fd, tty)
+** 		c_ttyputline (fd, tty, text, map_cc)
+** 		     c_ttyso (fd, tty, onflag)
+** 
+** 
+** Complete descriptions of TTY and termcap are given elsewhere.  Briefly, the
+** device descriptor for a particular terminal is opened with ttyodes, which
+** returns a IRAF pointer (C integer) to the binary TTY descriptor.  The
+** terminal name may be given as "terminal", in which case ttyodes will look up
+** the name of the default terminal in the environment and search the termcap
+** database for the entry for the named device.
+** 
+** The ttyget functions are used to read the capabilities.  Capabilities are
+** specified by two character mnemonics (character strings), shown as the cap
+** arguments in the calling sequences above.  Control sequences may be output
+** with ttyctrl or with ttyputs, depending on whether you are willing to do a
+** binary search for a particular capability at run time.  The remaining high
+** level functions make it easy to perform the more common control functions.
+** 
+** Raw mode output to a terminal device is provided by the system interface
+** (the newline and tab characters are exceptions).  Raw mode input is provided
+** as an fseti option in FIO.  To set raw mode on STDIN:
+** 
+** 	c_fseti (STDIN, F_RAW, YES);
+** 
+** While raw mode is in effect input characters are read as they are typed,
+** few or no control characters are recognized, and no echoing is performed.
+** Raw mode is cleared whenever the newline character is sent to the terminal,
+** but will be reset if by the next read if F_RAW remains set.
+*/
+
+
+/* C_TTYODES -- Open the TTY descriptor for a particular terminal device.
+** An SPP pointer to the TTY descriptor is returned as the function value.
+** If the device name is given as "terminal" or "printer", the actual device
+** name is taken to be the value of the environment variable of the same name.
+** If the device name is the filename of a termcap format file, the entry
+** for the first device in the file is loaded (this gives the user a simple
+** means to supply special termcap entries).  The name of the default
+** termcap file is given by the environment variable "termcap".  TTY maintains
+** a cache of preloaded termcap device entries for frequently referenced
+** devices.
+*/
+XINT
+c_ttyodes (
+  char	*ttyname		/* termcap name of device	*/
+)
+{
+	XINT	tty;
+
+	iferr (tty = (XINT) TTYODES (c_sppstr (ttyname)))
+	    return ((XINT) ERR);
+	else
+	    return (tty);
+}
diff --git a/sys/libc/cttyputl.c b/sys/libc/cttyputl.c
new file mode 100644
index 00000000..84fdf90a
--- /dev/null
+++ b/sys/libc/cttyputl.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYPUTLINE -- Put a line of text to the output device.  Any device
+** independent control characters embedded in the text, e.g., tab, newline,
+** formfeed, backspace, or the special control codes SO (enter standout mode)
+** or SI (leave standout mode) are converted as necessary to drive the device.
+** Unknown control codes are converted to printable sequences (e.g. ^C) if
+** the map_cc flag is set.
+*/
+void
+c_ttyputline (
+  XINT	fd,			/* output file			*/
+  XINT	tty,			/* tty descriptor		*/
+  char	*line,			/* line to be output		*/
+  int	map_cc			/* map unknown ctrl chars	*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty, x_map_cc = map_cc;
+
+	TTYPUTLINE (&x_fd, &x_tty, c_sppstr(line), &x_map_cc);
+}
diff --git a/sys/libc/cttyputs.c b/sys/libc/cttyputs.c
new file mode 100644
index 00000000..4d428964
--- /dev/null
+++ b/sys/libc/cttyputs.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYPUTS -- Put a control sequence obtained in a prior call to C_TTYGETS
+** to the output file.  The baud rate (extracted from the environment at
+** TTYODES time or set in a C_TTYSETI call) determines the number of pad
+** characters output for delays.
+*/
+int
+c_ttyputs (
+  XINT	fd,			/* output file			*/
+  XINT	tty,			/* tty descriptor		*/
+  char	*cap,			/* two char capability name	*/
+  int	afflncnt		/* number of lines affected	*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty, x_afflncnt = afflncnt;
+
+	iferr (TTYPUTS (&x_fd, &x_tty, c_sppstr(cap), &x_afflncnt))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cttyseti.c b/sys/libc/cttyseti.c
new file mode 100644
index 00000000..086dd98f
--- /dev/null
+++ b/sys/libc/cttyseti.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYSETI -- Set a TTY interface parameter of type integer.
+*/
+void
+c_ttyseti (
+  XINT	tty,			/* tty descriptor		*/
+  int	param,			/* code of param to be set	*/
+  int	value			/* value to be set		*/
+)
+{
+	XINT  x_tty = tty, x_param = param, x_value = value;
+
+	TTYSETI (&x_tty, &x_param, &x_value);
+}
diff --git a/sys/libc/cttyso.c b/sys/libc/cttyso.c
new file mode 100644
index 00000000..3283f83f
--- /dev/null
+++ b/sys/libc/cttyso.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYSO -- Turn standout mode (reverse video, underline, or upper case
+** depending on the device) on or off.
+*/
+void
+c_ttyso (
+  XINT	fd,			/* output file			*/
+  XINT	tty,			/* tty descriptor		*/
+  int	onoff			/* 1=on, 0=off			*/
+)
+{
+	XINT  x_fd = fd, x_tty = tty, x_onoff = onoff;
+
+	TTYSO (&x_fd, &x_tty, &x_onoff);
+}
diff --git a/sys/libc/cttystati.c b/sys/libc/cttystati.c
new file mode 100644
index 00000000..9ba254c5
--- /dev/null
+++ b/sys/libc/cttystati.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_TTYSTATI -- Return the value of a TTY integer interface parameter.
+*/
+XINT
+c_ttystati (
+  XINT	tty,			/* tty descriptor		*/
+  int	param			/* code of param to be set	*/
+)
+{
+	XINT  x_tty = tty, x_param = param;
+
+	return (TTYSTATI (&x_tty, &x_param));
+}
diff --git a/sys/libc/ctype.c b/sys/libc/ctype.c
new file mode 100644
index 00000000..4d52648c
--- /dev/null
+++ b/sys/libc/ctype.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_ctype
+#include <iraf.h>
+
+#ifdef vms
+globaldef  vms_ctype_defs;		/* [MACHDEP]	*/
+#endif
+
+/* Character class associations for the ctype.h macros.
+*/
+char u_ctype_[] = {
+	0,
+	_C,	_C,	_C,	_C,	_C,	_C,	_C,	_C,
+	_C,	_S,	_S,	_S,	_S,	_S,	_C,	_C,
+	_C,	_C,	_C,	_C,	_C,	_C,	_C,	_C,
+	_C,	_C,	_C,	_C,	_C,	_C,	_C,	_C,
+	_S,	_P,	_P,	_P,	_P,	_P,	_P,	_P,
+	_P,	_P,	_P,	_P,	_P,	_P,	_P,	_P,
+	_N,	_N,	_N,	_N,	_N,	_N,	_N,	_N,
+	_N,	_N,	_P,	_P,	_P,	_P,	_P,	_P,
+	_P,	_U|_X,	_U|_X,	_U|_X,	_U|_X,	_U|_X,	_U|_X,	_U,
+	_U,	_U,	_U,	_U,	_U,	_U,	_U,	_U,
+	_U,	_U,	_U,	_U,	_U,	_U,	_U,	_U,
+	_U,	_U,	_U,	_P,	_P,	_P,	_P,	_P,
+	_P,	_L|_X,	_L|_X,	_L|_X,	_L|_X,	_L|_X,	_L|_X,	_L,
+	_L,	_L,	_L,	_L,	_L,	_L,	_L,	_L,
+	_L,	_L,	_L,	_L,	_L,	_L,	_L,	_L,
+	_L,	_L,	_L,	_P,	_P,	_P,	_P,	_C
+};
diff --git a/sys/libc/cungetc.c b/sys/libc/cungetc.c
new file mode 100644
index 00000000..d1f416ef
--- /dev/null
+++ b/sys/libc/cungetc.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_UNGETC -- Push a character back into the input stream.  Pushback is last
+** in first out, i.e., the last character pushed back is the first one
+** read by GETC.  Characters (and strings) may be pushed back until the
+** FIO pushback buffer overflows.
+*/
+int
+c_ungetc (
+  XINT	fd,			/* file			*/
+  int	ch			/* char to be pushed	*/
+)
+{
+	XINT    x_fd = fd;
+	XCHAR	x_ch = ch;
+
+	iferr (UNGETC (&x_fd, &x_ch))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cungetl.c b/sys/libc/cungetl.c
new file mode 100644
index 00000000..5e0fa40c
--- /dev/null
+++ b/sys/libc/cungetl.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+#define	MAX_STRLEN	SZ_COMMAND
+
+
+/* C_UNGETLINE -- Push a string back into the input stream.  Pushback is last
+** in first out, i.e., the last string pushed back is the first one read by
+** GETC.  Strings (and single characters) may be pushed back until the FIO
+** pushback buffer overflows.
+*/
+int
+c_ungetline (
+  XINT	fd,			/* file				*/
+  char	*str			/* string to be pushed back	*/
+)
+{
+	XINT    x_fd = fd;
+	XCHAR	spp_str[MAX_STRLEN];
+
+
+	iferr (UNGETLINE (&x_fd, c_strupk (str, spp_str, MAX_STRLEN)))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/cvfnbrk.c b/sys/libc/cvfnbrk.c
new file mode 100644
index 00000000..346b07fb
--- /dev/null
+++ b/sys/libc/cvfnbrk.c
@@ -0,0 +1,30 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define import_knames
+#include <iraf.h>
+
+
+/* C_VFNBRK -- Break a virtual filename (or host filename) into its component
+** parts, i.e., logical directory (ldir), root, and extension.  No characters
+** are actually moved, rather, the offsets to the root and extn fields are
+** returned as output arguments.
+*/
+void
+c_vfnbrk (
+  char	*vfn,			/* virtual filename (or osfn)	*/
+  int	*root,			/* offset of root field.	*/
+  int	*extn			/* offset of extn field.	*/
+)
+{
+	XCHAR	sppvfn[SZ_PATHNAME];
+	XINT    x_root = *root, x_extn = extn;
+
+	ZFNBRK (c_strupk(vfn,sppvfn,SZ_PATHNAME), &x_root, &x_extn);
+
+	/* Make offsets zero-indexed. */
+	*root -= 1;
+	*extn -= 1;
+}
diff --git a/sys/libc/cwmsec.c b/sys/libc/cwmsec.c
new file mode 100644
index 00000000..246285a1
--- /dev/null
+++ b/sys/libc/cwmsec.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_knames
+#include <iraf.h>
+
+
+/* C_WMSEC -- Delay for so may milliseconds.
+*/
+void
+c_wmsec (
+  int	msec			/* milliseconds to delay */
+)
+{
+	XINT  x_msec = msec;
+
+	ZWMSEC (&x_msec);
+}
diff --git a/sys/libc/cwrite.c b/sys/libc/cwrite.c
new file mode 100644
index 00000000..5ca7dab9
--- /dev/null
+++ b/sys/libc/cwrite.c
@@ -0,0 +1,51 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#define import_fset
+#define import_stdio
+#define import_error
+#include <iraf.h>
+
+
+/* C_WRITE -- FIO write to a file.  Write exactly nbytes bytes from the buffer
+** buf to the stream fd.  If the actual file is a text file C chars are output
+** as XCHARs.  If the actual file is a binary file no conversion is performed,
+** but an integral number of XCHARs are always written.
+*/
+int
+c_write (
+  XINT	fd,			/* FIO file descriptor			*/
+  char	*buf,			/* buffer containing data to be written	*/
+  int	nbytes			/* nbytes to be written			*/
+)
+{
+	XINT  x_fd = fd;
+
+	if (c_fstati (fd, F_TYPE) == TEXT_FILE) {
+	    register FILE	*fp = FDTOFP(fd);
+	    register char	*ip;
+	    register int	n = nbytes;
+
+	    for (ip=buf;  --n >= 0;  ip++)
+		putc (*ip, fp);
+	    if (ferror (fp))
+		c_erract (EA_ERROR);
+
+	} else {
+	    XINT	x_nchars = (nbytes + sizeof(XCHAR)-1) / sizeof(XCHAR);
+	    XCHAR	*bp = (XCHAR *)buf;
+
+	    /* Verify that the pointer coercion char->XCHAR->char is legal,
+	     * i.e., that the char pointer is aligned to an XCHAR word
+	     * boundary if required on this machine.
+	     */
+	    if (buf != (char *) bp)
+		return (ERR);
+	    WRITE (&x_fd, bp, &x_nchars);
+	}
+
+	return (nbytes);
+}
diff --git a/sys/libc/cxgmes.c b/sys/libc/cxgmes.c
new file mode 100644
index 00000000..f8384923
--- /dev/null
+++ b/sys/libc/cxgmes.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_knames
+#include <iraf.h>
+
+
+/* C_XGMES -- Fetch the machine dependent integer code and message string
+** for the most recent exception.  The integer code XOK is returned if
+** no exception has occurred or if C_XGMES is called more than once after
+** a single exception.
+*/
+void
+c_xgmes (
+  int	*oscode,		/* os integer code of exception		*/
+  char	*oserrmsg,		/* os error message string		*/
+  int	maxch
+)
+{
+	PKCHAR	x_oserrmsg[SZ_LINE+1];
+	XINT	x_oscode = *oscode, x_maxch = SZ_LINE;
+
+	ZXGMES (&x_oscode, x_oserrmsg, &x_maxch);
+	(void) strncpy (oserrmsg, (char *)x_oserrmsg, maxch);
+	*oscode = x_oscode;
+}
diff --git a/sys/libc/cxonerr.c b/sys/libc/cxonerr.c
new file mode 100644
index 00000000..2154851c
--- /dev/null
+++ b/sys/libc/cxonerr.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* C_XONERR -- Call any error handler procedures posted with ONERROR.
+*/
+void
+c_xonerr (
+  int	errcode
+)
+{
+	XINT  x_errcode = errcode;
+
+	XONERR (&x_errcode);
+}
diff --git a/sys/libc/cxttysize.c b/sys/libc/cxttysize.c
new file mode 100644
index 00000000..81ac4541
--- /dev/null
+++ b/sys/libc/cxttysize.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* C_XTTYSIZE -- Get the terminal screen size, dynamically querying the
+** terminal for the screen size if the terminal has this capabability (e.g.,
+** a workstation window).
+*/
+void
+c_xttysize (
+  int	*ncols,			/* ncols (output)	*/
+  int	*nlines			/* nlines (output)	*/
+)
+{
+	XINT  x_ncols, x_nlines;
+
+	XTTYSIZE (&x_ncols, &x_nlines);
+	*ncols = x_ncols;
+	*nlines = x_nlines;
+}
diff --git a/sys/libc/cxwhen.c b/sys/libc/cxwhen.c
new file mode 100644
index 00000000..b3523dfe
--- /dev/null
+++ b/sys/libc/cxwhen.c
@@ -0,0 +1,63 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_xnames
+#define	import_knames
+#define	import_libc
+#include <iraf.h>
+
+
+/* CXWHEN -- Post an exception handler.  The exception handler procedure
+** is called when an exception occurs, unless the exception has been
+** disabled.  If a user exception handler has not been posted and an
+** exception has not been disabled, a system default exception handler is
+** called when the exception occurs.
+**
+** Currently only four exceptions are recognized (import_xwhen):
+**
+**	X_INT		interrupt
+**	X_ARITH		arithmetic exception (e.g. divide by zero)
+**	X_ACV		access violation (e.g. illegal memory reference)
+**	X_IPC		write to IPC with no reader
+**
+** When an exception occurs the user supplied exception handler is called 
+** with the following argument list:
+**
+**	handler (&exception, &next_handler)
+**
+** The first argument is the code for the virtual exception calling the user
+** handler (the same handler may be posted for more than one exception).
+** The second argument is set by the user handler before exiting, and
+** must be either the ZLOCPR entry point address of the next exception
+** handler to be called or NULL, indicating that normal execution is to
+** resume.
+**
+** For portability reasons, only the virtual exceptions should be used to
+** post exception handlers.  For good diagnostic messages when an exception
+** occurs it is desirable, however, to have a more precise description of
+** the actual host system exception which occurred.  This may be obtained
+** by a call to C_XGMES.
+*/
+
+#define	SZ_ERRMSG	64
+typedef	int (*PFI)();		/* pointer to function returning int	*/
+
+
+/* C_XWHEN -- Post an exception handler for an exception, or disable the
+** exception (not all exceptions can be disabled).
+*/
+void
+c_xwhen (
+  int	exception,		/* code for virtual exception		*/
+  PFI	new_handler,		/* new exception handler		*/
+  PFI	*old_handler		/* old exception handler (output)	*/
+)
+{
+	XINT	excode = exception;
+	XINT	epa_new_handler = (XINT)new_handler;
+	XINT	epa_old_handler;
+
+	XWHEN (&excode, &epa_new_handler, &epa_old_handler);
+	*old_handler = (PFI)epa_old_handler;
+}
diff --git a/sys/libc/eprintf.c b/sys/libc/eprintf.c
new file mode 100644
index 00000000..54cb5b8f
--- /dev/null
+++ b/sys/libc/eprintf.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_stdarg
+#include <iraf.h>
+
+
+/* EPRINTF -- Formatted print to the standard error output.
+*/
+void
+eprintf (char *format, ...)
+{
+	va_list	argp;
+
+	extern void u_doprnt();
+
+
+	va_start (argp, format);
+	u_doprnt (format, &argp, stderr);
+	va_end (argp);
+	(void) fflush (stderr);
+}
diff --git a/sys/libc/fclose.c b/sys/libc/fclose.c
new file mode 100644
index 00000000..969c5d50
--- /dev/null
+++ b/sys/libc/fclose.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_xnames
+#include <iraf.h>
+
+/* FCLOSE -- Close a file opened with fopen.
+*/
+int
+fclose (
+  FILE	*fp
+)
+{
+	XINT	x_fd = fileno(fp);
+	
+	iferr (CLOSE (&x_fd))
+	    return (EOF);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/fdopen.c b/sys/libc/fdopen.c
new file mode 100644
index 00000000..c9e2bc9f
--- /dev/null
+++ b/sys/libc/fdopen.c
@@ -0,0 +1,76 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_fset
+#include <iraf.h>
+
+	
+extern int c_fstati();
+
+
+/* FDOPEN -- Reopen a file for i/o with the STDIO package, after the file
+** as already been opened by FIO.  It is an error if the access modes are
+** incompatible.
+*/
+FILE *
+fdopen (
+  XINT	fd,			/* FIO file descriptor		*/
+  char	*mode			/* STDIO access mode		*/
+)
+{
+	register int	fio_mode = c_fstati (fd, F_MODE);
+	register int	fio_type = c_fstati (fd, F_TYPE);
+
+
+	/* Verify file access mode.  No mode checking is performed for the
+	 * special file types.
+	 */
+	if (fio_type == TEXT_FILE || fio_type == BINARY_FILE)
+	    switch (mode[0]) {
+	    case 'r':
+		if (fio_mode != READ_ONLY && fio_mode != READ_WRITE)
+		    return (NULL);
+		break;
+
+	    case 'w':
+		switch (fio_mode) {
+		case NEW_FILE:
+		case READ_WRITE:
+		case WRITE_ONLY:
+		    break;
+		default:
+		    return (NULL);
+		}
+		break;
+
+	    case 'a':
+		if (fio_mode != APPEND && fio_mode != NEW_FILE)
+		    return (NULL);
+		break;
+
+	    default:
+		return (NULL);
+	    }
+
+	/* Verify file type.  No checking is performed if no type is given.
+	 */
+	switch (mode[1]) {
+	case EOS:
+	    break;
+	case 't':
+	    if (fio_type != TEXT_FILE)
+		return (NULL);
+	    break;
+	case 'b':
+	    if (fio_type != BINARY_FILE)
+		return (NULL);
+	    break;
+	default:
+	    return (NULL);
+	}
+
+	return (FDTOFP(fd));
+}
diff --git a/sys/libc/fflush.c b/sys/libc/fflush.c
new file mode 100644
index 00000000..14a2356a
--- /dev/null
+++ b/sys/libc/fflush.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_xnames
+#include <iraf.h>
+
+
+/* FFLUSH -- Flush the output file.
+*/
+int
+fflush (
+  FILE	*fp
+)
+{
+	XINT	x_fd = fileno(fp);
+
+	iferr (FLUSH (&x_fd))
+	    return (EOF);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/fgetc.c b/sys/libc/fgetc.c
new file mode 100644
index 00000000..155a1111
--- /dev/null
+++ b/sys/libc/fgetc.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FGETC -- Get a character from the input file.  Offered as a functionally
+** equivalent alternative to the macro GETC.
+*/
+int
+fgetc (
+  FILE	*fp
+)
+{
+	return (getc (fp));
+}
diff --git a/sys/libc/fgets.c b/sys/libc/fgets.c
new file mode 100644
index 00000000..45c228c6
--- /dev/null
+++ b/sys/libc/fgets.c
@@ -0,0 +1,43 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/*  FGETS -- Return a newline delimited string in the user buffer.  If the
+**  buffer fills before newline is seen the string will not be newline
+**  delimited.
+*/
+char *
+fgets (
+  char	*buf,			/* user supplied output buffer	*/
+  int	maxch,			/* max chars out (incl EOS)	*/
+  FILE	*fp			/* input file			*/
+)
+{
+	register int	ch = 0, lastch = 0, n = maxch - 1;
+	register char	*op = buf;
+
+	while (--n >= 0 && (ch = getc (fp)) >= 0) {
+	    lastch = ch;
+	    if (ch == '\r')		/* handle DOS-style CR-NL	*/
+		continue;
+	    *op++ = ch;
+	    if (ch == '\n')
+		break;
+	}
+
+	if (ch == EOF && op == buf)
+	    return ((char *) NULL);
+	else {
+#ifdef ADD_NEWLINE
+	    if (lastch != '\n')		/* handle missing NL at EOF	*/
+	        *op++ = '\n';
+#endif
+	    *op = EOS;
+	    return (buf);
+	}
+}
diff --git a/sys/libc/fopen.c b/sys/libc/fopen.c
new file mode 100644
index 00000000..f9fe16ae
--- /dev/null
+++ b/sys/libc/fopen.c
@@ -0,0 +1,61 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FOPEN -- Open a file with the given access mode and file type.  The file type
+** (text or binary) is specified with an optional, non UNIX standard character
+** "t" or "b" in the modestring.  The default is text file if no type is given.
+*/
+FILE *
+fopen (
+  char	*fname,			/* vfn of file			*/
+  char	*modestr		/* access mode [and type]	*/
+)
+{
+	XINT	x_filetype, x_filemode;
+	int 	fd;
+
+
+	/* Get file type.
+	 */
+	switch (modestr[1]) {
+	case 't':
+	case EOS:
+	    x_filetype = TEXT_FILE;
+	    break;
+	case 'b':
+	    x_filetype = BINARY_FILE;
+	    break;
+	default:
+	    return (NULL);
+	}
+
+	/* Determine file access mode.
+	 */
+	switch (modestr[0]) {
+	case 'r':
+	    x_filemode = READ_ONLY;
+	    break;
+	case 'w':
+	    x_filemode = NEW_FILE;
+	    break;
+	case 'a':
+	    x_filemode = APPEND;
+	    break;
+	default:
+	    return (NULL);
+	}
+
+	/* Open file.
+	 */
+	iferr (fd = OPEN (c_sppstr(fname), &x_filemode, &x_filetype))
+	    return (NULL);
+	else
+	    return (FDTOFP(fd));
+}
diff --git a/sys/libc/fputc.c b/sys/libc/fputc.c
new file mode 100644
index 00000000..7d815206
--- /dev/null
+++ b/sys/libc/fputc.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FPUTC -- Put a character to the output file.  Offered as a functionally
+** equivalent alternative to the macro PUTC.
+*/
+int
+fputc (
+  char	ch,
+  FILE	*fp
+)
+{
+	return (putc (ch, fp));
+}
diff --git a/sys/libc/fputs.c b/sys/libc/fputs.c
new file mode 100644
index 00000000..76dca159
--- /dev/null
+++ b/sys/libc/fputs.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FPUTS -- Put a null terminated string to the output file.
+*/
+void
+fputs (
+  char	*str,			/* input string			*/
+  FILE	*fp			/* output file			*/
+)
+{
+	register char *ip;
+
+	for (ip=str;  *ip != EOS;  ip++)
+	    putc (*ip, fp);
+}
diff --git a/sys/libc/fread.c b/sys/libc/fread.c
new file mode 100644
index 00000000..28f1376c
--- /dev/null
+++ b/sys/libc/fread.c
@@ -0,0 +1,55 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FREAD -- Read a binary block of data from the input file.  To be consistent
+** with UNIX we must read until nelem chars have been accumulated or until
+** EOF is seen.  Hence, if reading from a record structured device such as a
+** terminal, the read will not be terminated by end of record (newline).
+** If the number of bytes (C chars) requested does not fill an integral number
+** of XCHARS additional bytes will be read to fill out the last XCHAR.
+*/
+int
+fread (
+  char	*bp,			/* output buffer		*/
+  int	szelem,			/* nbytes per element		*/
+  int	nelem,			/* nelems to read		*/
+  FILE	*fp
+)
+{
+	register int nread, n;
+	int	nbytes;
+	XINT	fd = fileno (fp);
+	char	*op = bp;
+
+
+	fd     = fileno (fp);
+	nbytes = nelem * szelem;
+	nread  = 0;
+
+	if (fp == stdin)
+	    (void) fflush (stdout);
+	if (szelem <= 0)
+	    return (0);
+
+	for (op = bp;  nread < nbytes;  op += n) {
+	    iferr (n = c_read (fd, op, nbytes-nread)) {
+		fp->_fflags |= _FERR;
+		break;
+	    } else if (n == EOF) {
+		fp->_fflags |= _FEOF;
+		break;
+	    } else
+		nread += n;
+	}
+
+	if (fp->_fflags & (_FEOF|_FERR))
+	    return (nread ? nread / szelem : 0);
+	else
+	    return (nread / szelem);
+}
diff --git a/sys/libc/freadline.c b/sys/libc/freadline.c
new file mode 100644
index 00000000..b335ee20
--- /dev/null
+++ b/sys/libc/freadline.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/*  FREADLINE -- Get a line from a user with editing.  This is a libc 
+ *  interface to the host readline() interface.  The host readline()
+ *  returns a buffer allocated which we free here, what's returned to
+ *  the caller is a static buffer containing the input string.
+ */
+char *
+freadline (
+  char	*prompt				/* user supplied output buffer	*/
+)
+{
+	char  *cmd = (char *) NULL;
+	static char line[SZ_LINE];
+	char  *readline (char *prompt);
+
+
+	memset (line, 0, SZ_LINE);
+        if ((cmd = readline (prompt)) == (char *) NULL) {
+            return ((char *) NULL);
+	} else {
+	    strcpy (line, cmd);		/* save to static buffer	*/
+	    zfree_ ((void *) cmd);	/* free readline() buffer	*/
+	}
+
+	return ((char *) line);
+}
diff --git a/sys/libc/free.c b/sys/libc/free.c
new file mode 100644
index 00000000..4edd18c0
--- /dev/null
+++ b/sys/libc/free.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* FREE -- Free a block of storage previously allocated by malloc, calloc,
+** or realloc.
+*/
+void
+free (
+  char	*buf
+)
+{
+	XINT	x_ptr, x_dtype = TY_CHAR;
+
+	x_ptr = Memcptr (buf);
+	MFREE (&x_ptr, &x_dtype);
+}
diff --git a/sys/libc/freopen.c b/sys/libc/freopen.c
new file mode 100644
index 00000000..4d4ed997
--- /dev/null
+++ b/sys/libc/freopen.c
@@ -0,0 +1,56 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FREOPEN -- Close a stream and reopen it upon the named file.  This is
+** commonly used to redirect one of the standard streams stdin, stdout,
+** or stderr to a named file.
+*/
+FILE *
+freopen (
+  char	*fname,			/* vfn of file to be opened	*/
+  char	*modestr,		/* access mode [and type]	*/
+  FILE	*fp			/* stream to be reopened	*/
+)
+{
+	register XINT	fd = fileno(fp);
+	register int	status, filetype;
+
+
+	/* Determine the file type of the file to be opened.  This is given
+	 * by an optional second character in the mode string.  Default is
+	 * text file if absent.
+	 */
+	switch (modestr[1]) {
+	case 't':
+	case EOS:
+	    filetype = TEXT_FILE;
+	    break;
+	case 'b':
+	    filetype = BINARY_FILE;
+	    break;
+	default:
+	    return (NULL);
+	}
+
+	switch (modestr[0]) {
+	case 'r':
+	    status = c_fredir (fd, fname, READ_ONLY, filetype);
+	    break;
+	case 'w':
+	    status = c_fredir (fd, fname, NEW_FILE, filetype);
+	    break;
+	case 'a':
+	    status = c_fredir (fd, fname, APPEND, filetype);
+	    break;
+	default:
+	    return (NULL);
+	}
+
+	return (status == ERR ? NULL : fp);
+}
diff --git a/sys/libc/fseek.c b/sys/libc/fseek.c
new file mode 100644
index 00000000..fa32466c
--- /dev/null
+++ b/sys/libc/fseek.c
@@ -0,0 +1,93 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_fset
+#include <iraf.h>
+
+
+/* FSEEK -- Seek on a file opened under stdio.  The seek functions do not
+** completely emulate the UNIX seek functions.  The following restrictions
+** apply:
+**
+**	- It is only permissible to seek to the beginning of a line if the
+**	  actual file is a text file.  The seek offset must have been
+**	  obtained by a prior call to FTELL, which returns the seek offset
+**	  of the next line to be read or written.  Seek offsets cannot be
+**	  manufactured, e.g., as physical char offsets in the file, as is
+**	  the case for binary files.  These restrictions apply because text
+**	  files are record structured on many systems, rather than simple
+**	  byte stream files as in UNIX.
+**
+**	- It is permissible to randomly seek about on a binary file, but
+**	  seeks must be aligned on XCHAR word boundaries in the file.  This
+**	  can be guaranteed by structuring the application so that it always
+**	  reads and writes binary data records that are an integral number
+**	  of integers in size.  If this is done the program is portable to
+**	  any IRAF machine as well as to UNIX.  Seek offsets are specified
+**	  in units of bytes and are zero-indexed, as in C.
+*/
+int
+fseek (
+  FILE	*fp,			/* operand file				*/
+  long	offset,			/* offset in file			*/
+  int	mode			/* 0=absolute, 1=relative, 2=from EOF	*/
+)
+{
+	register XINT	fd = fileno(fp);
+	int	text_file, stat;
+	long	c_note();
+
+
+	text_file = (c_fstati (fd, F_TYPE) == TEXT_FILE);
+	fp->_fflags &= ~_FEOF;
+
+	if (text_file) {
+	    switch (mode) {
+	    case 0:
+		if (offset == 0L)
+		    stat = c_seek (fd, BOFL);
+		else
+		    stat = c_seek (fd, offset);
+		break;
+	    case 2:
+		if (offset == 0L) {
+		    stat = c_seek (fd, EOFL);
+		    fp->_fflags |= _FEOF;
+		} else
+		    stat = ERR;
+		break;
+	    default:
+		stat = ERR;
+		break;
+	    }
+
+	} else {
+	    /* Random seeks on (non-streaming) binary files are permitted,
+	     * but the seek must be to an XCHAR offset.  This is checked
+	     * by c_seek, which takes a zero-indexed byte offset as argument.
+	     */
+	    switch (mode) {
+	    case 0:
+		stat = c_seek (fd, offset);
+		break;
+	    case 1:
+		stat = c_seek (fd, c_note(fd) + offset);
+		break;
+	    case 2:
+		if ((stat = c_seek (fd, EOFL)) != ERR) {
+		    if (offset == 0L)
+			fp->_fflags |= _FEOF;
+		    else
+			stat = c_seek (fd, c_note(fd) - offset);
+		}
+		break;
+	    default:
+		stat = ERR;
+	    }
+	}
+
+	return (stat);
+}
diff --git a/sys/libc/ftell.c b/sys/libc/ftell.c
new file mode 100644
index 00000000..be373a6d
--- /dev/null
+++ b/sys/libc/ftell.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FTELL -- Get the FSEEK offset of the current position in a file, i.e.,
+** the file offset at which the next read or write will occur.  For a text
+** file this is a magic number, for a binary file it is the zero-indexed
+** offset in bytes from the beginning of the file.
+*/
+long
+ftell (
+  FILE	*fp			/* operand file				*/
+)
+{
+	return (c_note (fileno(fp)));
+}
diff --git a/sys/libc/fwrite.c b/sys/libc/fwrite.c
new file mode 100644
index 00000000..cb9e06e6
--- /dev/null
+++ b/sys/libc/fwrite.c
@@ -0,0 +1,36 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* FWRITE -- Write a binary block of data to the output file.  If the number
+** of bytes (C chars) specified does not fill an integral number of XCHARS
+** additional bytes will be written to fill out the last XCHAR.  The actual
+** number of elements written is returned as the function value.
+*/
+int
+fwrite (
+  char	*bp,			/* output buffer		*/
+  int szelem,			/* nbytes per element		*/
+  int	nelem,			/* nelems to read		*/
+  FILE	*fp
+)
+{
+	register int stat;
+	XINT  fd = fileno (fp);
+
+
+	if (szelem) {
+	    stat = c_write (fd, bp, nelem * szelem);
+	    if (stat == ERR) {
+		fp->_fflags |= _FERR;
+		return (0);
+	    } else
+		return (stat / szelem);
+	} else
+	    return (0);
+}
diff --git a/sys/libc/gets.c b/sys/libc/gets.c
new file mode 100644
index 00000000..309efa11
--- /dev/null
+++ b/sys/libc/gets.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* GETS -- Read a newline terminated sequence from the standard input and
+** return the resultant string minus the newline to the user.
+*/
+char *
+gets (
+  char	*buf			/* user supplied output buffer	*/
+)
+{
+	register FILE	*fp = stdin;
+	register char	*op = buf;
+	register int	ch;
+
+
+	while ((ch = getc (fp)) != EOF) {
+	    if (ch == '\n')
+		break;
+	    *op++ = ch;
+	}
+	*op = EOS;
+
+	if (ch == EOF && op == buf)
+	    return ((char *) NULL);
+	else
+	    return (buf);
+}
diff --git a/sys/libc/getw.c b/sys/libc/getw.c
new file mode 100644
index 00000000..c0dd0cf9
--- /dev/null
+++ b/sys/libc/getw.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* GETW -- Get a word (integer) from the input stream.  When used in conjunction
+** with PUTW this permits storage and retrieval of binary words in any file,
+** albeit somewhat inefficiently.
+*/
+int
+getw (
+  FILE	*fp				/* input file			*/
+)
+{
+	int	word;
+	register char	*op = (char *)&word;
+	register int	n = sizeof (int);
+
+
+	while (--n >= 0)
+	    *op++ = getc (fp);
+
+	return ((fp->_fflags & (_FEOF|_FERR)) ? EOF : word);
+}
diff --git a/sys/libc/index.c b/sys/libc/index.c
new file mode 100644
index 00000000..fa7a4917
--- /dev/null
+++ b/sys/libc/index.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#define	import_spp
+#include <iraf.h>
+
+
+/* INDEX -- Search string STR for char CH, returning a pointer to the first
+** occurrence of CH in STR or NULL.
+*/
+char *
+index (
+  char	*str,			/* string to be searched		*/
+  int	ch			/* character we are searching for	*/
+)
+{
+	register char	*ip = str;
+
+	do {
+	    if (*ip == ch)
+		return (ip);
+	} while (*ip++);
+
+	return ((char *) NULL);
+}
diff --git a/sys/libc/isatty.c b/sys/libc/isatty.c
new file mode 100644
index 00000000..b625299a
--- /dev/null
+++ b/sys/libc/isatty.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#include <iraf.h>
+
+
+/* ISATTY -- Test if the given file is a terminal.
+*/
+int
+isatty (
+  XINT	fd
+)
+{
+	XINT  x_fd = fd;
+
+	return (XISATTY (&x_fd));
+}
diff --git a/sys/libc/libc_proto.h b/sys/libc/libc_proto.h
new file mode 100644
index 00000000..52590a8e
--- /dev/null
+++ b/sys/libc/libc_proto.h
@@ -0,0 +1,326 @@
+/* atof.c */
+extern double u_atof(char *str);
+/* atoi.c */
+extern int u_atoi(char *str);
+/* atol.c */
+extern long u_atol(char *str);
+/* caccess.c */
+extern int c_access(char *fname, int mode, int type);
+/* callocate.c */
+extern int c_allocate(char *device);
+extern int c_deallocate(char *device, int u_rewind);
+extern void c_devstatus(char *device, int out);
+extern int c_devowner(char *device, char *owner, int maxch);
+/* calloc.c */
+extern char *u_calloc(unsigned int nelems, unsigned int elsize);
+/* cclktime.c */
+extern long c_clktime(long reftime);
+extern long c_cputime(long reftime);
+/* cclose.c */
+extern int c_close(int fd);
+/* ccnvdate.c */
+extern char *c_cnvdate(long clktime, char *outstr, int maxch);
+/* ccnvtime.c */
+extern char *c_cnvtime(long clktime, char *outstr, int maxch);
+/* cdelete.c */
+extern int c_delete(char *fname);
+/* cenvget.c */
+extern char *u_envget(char *var);
+extern int c_envgs(char *var, char *outstr, int maxch);
+extern int c_envfind(char *var, char *outstr, int maxch);
+extern int c_envgb(char *var);
+extern int c_envgi(char *var);
+extern void c_envputs(char *var, char *value);
+extern void c_envreset(char *var, char *value);
+/* cenvlist.c */
+extern void c_envlist(int fd, char *prefix, int show_redefs);
+/* cenvmark.c */
+extern void c_envmark(int *envp);
+extern int c_envfree(int envp, int userfcn);
+extern int c_prenvfree(int pid, int envp);
+/* cenvscan.c */
+extern int c_envscan(char *input_source);
+/* cerract.c */
+extern void c_erract(int action);
+/* cerrcode.c */
+extern int c_errcode(void);
+/* cerrget.c */
+extern int c_errget(char *outstr, int maxch);
+/* cerror.c */
+extern void c_error(int errcode, char *errmsg);
+/* cfchdir.c */
+extern int c_fchdir(char *newdir);
+/* cfilbuf.c */
+extern int c_filbuf(struct _iobuf *fp);
+/* cfinfo.c */
+extern int c_finfo(char *fname, struct _finfo *fi);
+/* cflsbuf.c */
+extern int c_flsbuf(unsigned int ch, struct _iobuf *fp);
+/* cflush.c */
+extern void c_flush(int fd);
+/* cfmapfn.c */
+extern int c_fmapfn(char *vfn, char *osfn, int maxch);
+/* cfmkdir.c */
+extern int c_fmkdir(char *newdir);
+/* cfnextn.c */
+extern int c_fnextn(char *vfn, char *extn, int maxch);
+/* cfnldir.c */
+extern int c_fnldir(char *vfn, char *ldir, int maxch);
+/* cfnroot.c */
+extern int c_fnroot(char *vfn, char *root, int maxch);
+/* cfpath.c */
+extern int c_fpathname(char *vfn, char *osfn, int maxch);
+/* cfredir.c */
+extern int c_fredir(int fd, char *fname, int mode, int type);
+/* cfseti.c */
+extern void c_fseti(int fd, int param, int value);
+/* cfstati.c */
+extern int c_fstati(int fd, int param);
+/* cgetpid.c */
+extern int c_getpid(void);
+/* cgetuid.c */
+extern char *c_getuid(char *outstr, int maxch);
+/* cgflush.c */
+extern void c_gflush(int stream);
+/* cimaccess.c */
+extern int c_imaccess(char *imname, int mode);
+/* cimdrcur.c */
+extern int c_imdrcur(char *device, float *x, float *y, int *wcs, int *key, char *strval, int maxch, int d_wcs, int pause);
+/* ckimapc.c */
+extern int c_kimapchan(int chan, char *nodename, int maxch);
+/* clexnum.c */
+extern int c_lexnum(char *str, int *toklen);
+/* cmktemp.c */
+extern int c_mktemp(char *root, char *temp_filename, int maxch);
+/* cndopen.c */
+extern int c_ndopen(char *fname, int mode);
+/* cnote.c */
+extern long c_note(int fd);
+/* copen.c */
+extern int c_open(char *fname, int mode, int type);
+/* coscmd.c */
+extern int c_oscmd(char *cmd, char *infile, char *outfile, char *errfile);
+/* cpoll.c */
+extern int c_poll_open(void);
+extern int c_poll(int fds, int nfds, int timeout);
+extern void c_poll_close(int fds);
+extern void c_poll_zero(int fds);
+extern void c_poll_set(int fds, int fd, int type);
+extern void c_poll_clear(int fds, int fd, int type);
+extern int c_poll_test(int fds, int fd, int type);
+extern int c_poll_get_nfds(int fds);
+extern void c_poll_print(int fds);
+/* cprcon.c */
+extern unsigned int c_propen(char *process, int *in, int *out);
+extern int c_prclose(unsigned int pid);
+extern int c_prstati(int pid, int param);
+extern int c_prsignal(unsigned pid, int signal);
+extern int c_prredir(unsigned pid, int stream, int new_fd);
+extern int c_prchdir(int pid, char *newdir);
+extern int c_prenvset(int pid, char *envvar, char *value);
+/* cprdet.c */
+extern unsigned int c_propdpr(char *process, char *bkgfile, char *bkgmsg);
+extern int c_prcldpr(unsigned job);
+extern int c_prdone(unsigned job);
+extern int c_prkill(unsigned job);
+/* cprintf.c */
+extern int c_printf(char *format);
+extern int c_fprintf(int fd, char *format);
+extern void c_pargb(int ival);
+extern void c_pargc(int ival);
+extern void c_pargs(short sval);
+extern void c_pargi(int ival);
+extern void c_pargl(long lval);
+extern void c_pargr(float rval);
+extern void c_pargd(double dval);
+extern void c_pargstr(char *strval);
+/* crcursor.c */
+extern int c_rcursor(int fd, char *outstr, int maxch);
+/* crdukey.c */
+extern int c_rdukey(char *obuf, int maxch);
+/* cread.c */
+extern int c_read(int fd, char *buf, int maxbytes);
+/* crename.c */
+extern int c_rename(char *old_fname, char *new_fname);
+/* creopen.c */
+extern int c_reopen(int fd, int mode);
+/* csalloc.c */
+extern char *c_salloc(unsigned nbytes);
+extern void c_smark(int *sp);
+extern void c_sfree(int sp);
+/* cseek.c */
+extern int c_seek(int fd, long offset);
+/* csppstr.c */
+extern short *c_sppstr(char *str);
+/* cstropen.c */
+extern int c_stropen(short *obuf, int maxch, int mode);
+/* cstrpak.c */
+extern char *c_strpak(short *sppstr, char *cstr, int maxch);
+/* cstrupk.c */
+extern short *c_strupk(char *str, short *outstr, int maxch);
+/* ctsleep.c */
+extern void c_tsleep(int nseconds);
+/* cttset.c */
+extern void c_sttyco(char *args, int ttin, int ttout, int outfd);
+extern void c_ttseti(int fd, int param, int value);
+extern int c_ttstati(int fd, int param);
+extern void c_ttsets(int fd, int param, char *value);
+extern int c_ttstats(int fd, int param, char *outstr, int maxch);
+/* cttycdes.c */
+extern void c_ttycdes(XINT tty);
+/* cttyclear.c */
+extern void c_ttycr(int fd, XINT tty);
+/* cttyclln.c */
+extern void c_ttycn(int fd, XINT tty);
+/* cttyctrl.c */
+extern int c_ttyctrl(int fd, XINT tty, char *cap, int afflncnt);
+/* cttygetb.c */
+extern int c_ttygb(XINT tty, char *cap);
+/* cttygeti.c */
+extern XINT c_ttygi(XINT tty, char *cap);
+/* cttygetr.c */
+extern float c_ttygr(XINT tty, char *cap);
+/* cttygets.c */
+extern int c_ttygs(XINT tty, char *cap, char *outstr, int maxch);
+/* cttygoto.c */
+extern void c_ttygoto(int fd, XINT tty, int col, int line);
+/* cttyinit.c */
+extern void c_ttyinit(int fd, XINT tty);
+/* cttyodes.c */
+extern XINT c_ttyodes(char *ttyname);
+/* cttyputl.c */
+extern void c_ttype(int fd, XINT tty, char *line, int map_cc);
+/* cttyputs.c */
+extern int c_ttyps(int fd, XINT tty, char *cap, int afflncnt);
+/* cttyseti.c */
+extern void c_ttyseti(XINT tty, int param, int value);
+/* cttyso.c */
+extern void c_ttyso(int fd, XINT tty, int onoff);
+/* cttystati.c */
+extern XINT c_ttystati(XINT tty, int param);
+/* ctype.c */
+/* cungetc.c */
+extern int c_ungec(int fd, int ch);
+/* cungetl.c */
+extern int c_ungetline(int fd, char *str);
+/* cvfnbrk.c */
+extern void c_vfnbrk(char *vfn, int *root, int *extn);
+/* cwmsec.c */
+extern void c_wmsec(int msec);
+/* cwrite.c */
+extern int c_write(int fd, char *buf, int nbytes);
+/* cxgmes.c */
+extern void c_xgmes(int *oscode, char *oserrmsg, int maxch);
+/* cxonerr.c */
+extern void c_xonerr(int errcode);
+/* cxttysize.c */
+extern void c_xttysize(int *ncols, int *nlines);
+/* cxwhen.c
+extern void c_xwhen(int exception, PFI new_handler, PFI *old_handler);
+ */
+/* eprintf.c */
+extern void u_eprintf(char *format, ...);
+/* fclose.c */
+extern int u_fclose(struct _iobuf *fp);
+/* fdopen.c */
+extern struct _iobuf *u_fdopen(int fd, char *mode);
+/* fflush.c */
+extern int u_fflush(struct _iobuf *fp);
+/* fgetc.c */
+extern int u_fgetc(struct _iobuf *fp);
+/* fgets.c */
+extern char *u_fgets(char *buf, int maxch, struct _iobuf *fp);
+/* fopen.c */
+extern struct _iobuf *u_fopen(char *fname, char *modestr);
+/* fputc.c */
+extern int u_fputc(char ch, struct _iobuf *fp);
+/* fputs.c */
+extern void u_fputs(char *str, struct _iobuf *fp);
+/* fread.c */
+extern int u_fread(char *bp, int szelem, int nelem, struct _iobuf *fp);
+/* free.c */
+extern void u_free(char *buf);
+/* freopen.c */
+extern struct _iobuf *u_freopen(char *fname, char *modestr, struct _iobuf *fp);
+/* fseek.c */
+extern int u_fseek(struct _iobuf *fp, long offset, int mode);
+/* ftell.c */
+extern long u_ftell(struct _iobuf *fp);
+/* fwrite.c */
+extern int u_fwrite(char *bp, int szelem, int nelem, struct _iobuf *fp);
+/* gets.c */
+extern char *u_gets(char *buf);
+/* getw.c */
+extern int u_getw(struct _iobuf *fp);
+/* index.c */
+extern char *u_index(char *str, int ch);
+/* isatty.c */
+extern int u_isatty(int fd);
+/* malloc.c */
+extern char *u_malloc(unsigned nbytes);
+/* mktemp.c */
+extern char *u_mktemp(char *template);
+/* perror.c */
+extern void u_perror(char *prefix);
+/* printf.c */
+extern void u_printf(char *format, ...);
+extern void u_fprintf(struct _iobuf *fp, char *format, ...);
+/*
+extern void u_doprnt(char *format, va_list *argp, struct _iobuf *fp);
+extern void u_doarg(struct _iobuf *fp, short *formspec, va_list **argp, int prec[], int varprec, int dtype);
+*/
+/* puts.c */
+extern int u_puts(char *str);
+/* putw.c */
+extern int u_putw(int word, struct _iobuf *fp);
+/* qsort.c */
+extern void u_qsort(char *base, int n, int size, int (*compar)(void));
+/* realloc.c */
+extern char *u_realloc(char *buf, unsigned newsize);
+/* rewind.c */
+extern long u_rewind(struct _iobuf *fp);
+/* rindex.c */
+extern char *u_rindex(char *str, int ch);
+/* scanf.c */
+extern int u_scanf(char *format, ...);
+extern int u_fscanf(struct _iobuf *fp, char *format, ...);
+extern int u_sscanf(char *str, char *format, ...);
+/* setbuf.c */
+extern void u_setbuf(struct _iobuf *fp, char *buf);
+extern void u_setfbf(struct _iobuf *fp, char *buf, int size);
+extern void u_setlinebuf(struct _iobuf *fp);
+/* spf.c */
+extern int spf_open(char *buf, int maxch);
+extern void spf_close(int fd);
+/* sprintf.c */
+extern char *u_sprintf(char *str, char *format, ...);
+/* stgio.c */
+extern int c_stggetline(int fd, char *buf, int maxch);
+extern int c_stgputline(int fd, char *buf);
+/* strcat.c */
+extern char *u_strcat(char *s1, char *s2);
+/* strcmp.c */
+extern int u_strcmp(char *s1, char *s2);
+/* strdup.c */
+extern char *u_strdup(char *str);
+/* strcpy.c */
+extern char *u_strcpy(char *s1, char *s2);
+/* strlen.c */
+extern int u_strlen(char *s);
+/* strncat.c */
+extern char *u_strnt(char *s1, char *s2, int n);
+/* strncmp.c */
+extern int u_strnp(char *s1, char *s2, int n);
+/* strncpy.c */
+extern char *u_strny(char *s1, char *s2, int n);
+/* system.c */
+extern int u_system(char *cmd);
+/* ungetc.c */
+extern int u_ungetc(int ch, struct _iobuf *fp);
+/* zztest.c */
+extern int thello_(void);
+extern int tprint_(void);
+extern int tcopy_(void);
+extern int tscan_(void);
+extern int onint(int *code, int *old_handler);
+extern int tgettk_(void);
diff --git a/sys/libc/malloc.c b/sys/libc/malloc.c
new file mode 100644
index 00000000..af5506cf
--- /dev/null
+++ b/sys/libc/malloc.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* MALLOC -- Allocate an uninitialized block of memory at least nbytes in size.
+*/
+char *
+malloc (
+  unsigned nbytes
+)
+{
+	XINT	x_nchars = (nbytes + sizeof(XCHAR)-1) / sizeof(XCHAR);
+	XINT	x_ptr, x_dtype = TY_CHAR;
+
+	iferr (MALLOC (&x_ptr, &x_nchars, &x_dtype))
+	    return (NULL);
+	else
+	    return ((char *)&Memc[x_ptr]);
+}
diff --git a/sys/libc/mathf.f b/sys/libc/mathf.f
new file mode 100644
index 00000000..89279451
--- /dev/null
+++ b/sys/libc/mathf.f
@@ -0,0 +1,75 @@
+c
+c	MATH -- C callable math functions.  This is the only portable way
+c	to access the Fortran intrinsic functions from C.  As a local
+c	optimization it is possible to add defines to map these external
+c	names onto the local Fortran library functions, but since C is not
+c	generally used intensively for computations and all floating point
+c	is done in double precision anyway, it is probably not worth it.
+c
+
+	integer function xnint (x)
+	double precision x
+		xnint = nint (x)
+	end
+
+	double precision function xexp (x)
+	double precision x
+		xexp = exp(x)
+	end
+
+	double precision function xlog (x)
+	double precision x
+		xlog = log(x)
+	end
+
+	double precision function xlog10 (x)
+	double precision x
+		xlog10 = log10(x)
+	end
+
+	double precision function xpow (x, y)
+	double precision x
+	double precision y
+		xpow = x ** y
+	end
+
+	double precision function xsqrt (x)
+	double precision x
+		xsqrt = sqrt(x)
+	end
+
+	double precision function xsin (x)
+	double precision x
+		xsin = sin(x)
+	end
+
+	double precision function xcos (x)
+	double precision x
+		xcos = cos(x)
+	end
+
+	double precision function xtan (x)
+	double precision x
+		xtan = tan(x)
+	end
+
+	double precision function xasin (x)
+	double precision x
+		xasin = asin(x)
+	end
+
+	double precision function xacos (x)
+	double precision x
+		xacos = acos(x)
+	end
+
+	double precision function xatan (x)
+	double precision x
+		xatan = atan(x)
+	end
+
+	double precision function xatan2 (x, y)
+	double precision x
+	double precision y
+		xatan2 = atan2(x,y)
+	end
diff --git a/sys/libc/mkpkg b/sys/libc/mkpkg
new file mode 100644
index 00000000..74349a1a
--- /dev/null
+++ b/sys/libc/mkpkg
@@ -0,0 +1,168 @@
+# Mkpkg for the IRAF runtime C library.  There is an additional dependence
+# on the global C include <iraf.h> which is not shown.  Those files which
+# reference <libc/stdio.h> have an implicit dependence on the VOS include
+# files <fio.h> and <fio.com>, since the LIBC stdio routines reference the
+# FIO internal data structures directly.
+
+$checkout libc.a lib$
+$update   libc.a
+$checkin  libc.a lib$
+$exit
+
+libc.a:
+	$set	XFLAGS	= "$(XFLAGS) -/Wall"
+
+	atof.c		<libc/ctype.h> <libc/libc.h> <libc/spp.h>\
+			<libc/xnames.h>
+	atoi.c		<libc/ctype.h> <libc/libc.h> <libc/spp.h>
+	atol.c		<libc/ctype.h> <libc/libc.h> <libc/spp.h>
+	caccess.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	calloc.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	callocate.c	<libc/spp.h> <libc/libc.h> <libc/xnames.h>
+	cclktime.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cclose.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	ccnvdate.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	ccnvtime.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cdelete.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cenvget.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cenvlist.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cenvmark.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cenvscan.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cerract.c	<libc/error.h> <libc/libc.h> <libc/spp.h>\
+			<libc/xnames.h>
+	cerrcode.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cerrget.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cerror.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cfchdir.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cfilbuf.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	cfinfo.c	<libc/libc.h> <libc/xnames.h> <libc/finfo.h>\
+			<libc/spp.h>
+	cflsbuf.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	cflush.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfmapfn.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfmkdir.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfnextn.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cfnldir.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cfnroot.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cfpath.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfredir.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfseti.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cfstati.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cgetpid.c	<libc/libc.h> <libc/xnames.h>
+	cgetuid.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cgflush.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cimaccess.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cimdrcur.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	ckimapc.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	clexnum.c	<libc/ctype.h> <libc/lexnum.h> <libc/spp.h>\
+			<libc/xnames.h> <libc/libc.h>
+	cmktemp.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cnote.c		<libc/libc.h> <libc/xnames.h> <libc/fset.h> <libc/spp.h>
+	copen.c		<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	coscmd.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cndopen.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cpoll.c		<libc/libc.h> <libc/spp.h> <libc/xnames.h>\
+			<libc/fpoll.h>
+	cprcon.c	<libc/libc.h> <libc/prstat.h> <libc/stdio.h>\
+			<libc/xnames.h> <libc/spp.h>
+	cprdet.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cprintf.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	crcursor.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	crdukey.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cread.c		<libc/libc.h> <libc/xnames.h> <libc/error.h>\
+			<libc/fset.h> <libc/spp.h> <libc/stdio.h>
+	crename.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	creopen.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	csalloc.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cseek.c		<libc/libc.h> <libc/xnames.h> <libc/fset.h> <libc/spp.h>
+	csppstr.c	<libc/libc.h> <libc/spp.h>
+	cstropen.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	cstrpak.c	<libc/libc.h> <libc/spp.h>
+	cstrupk.c	<libc/libc.h> <libc/spp.h>
+	ctsleep.c	<libc/libc.h> <libc/xnames.h>
+	cttset.c	<libc/libc.h> <libc/xnames.h>
+	cttycdes.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyclear.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyclln.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyctrl.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttygetb.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttygeti.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttygetr.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttygets.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttygoto.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyinit.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyodes.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyputl.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyputs.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyseti.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttyso.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cttystati.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	ctype.c		<libc/ctype.h>
+	cungetc.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cungetl.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	cvfnbrk.c	<libc/libc.h> <libc/spp.h> <libc/knames.h>
+	cwrite.c	<libc/libc.h> <libc/xnames.h> <libc/error.h>\
+			<libc/fset.h> <libc/spp.h> <libc/stdio.h>
+	cxgmes.c	<libc/knames.h> <libc/libc.h> <libc/spp.h>\
+			<libc/xnames.h>
+	cxonerr.c	<libc/libc.h> <libc/xnames.h>
+	cxttysize.c	<libc/libc.h> <libc/xnames.h>
+	cxwhen.c	<libc/xwhen.h> <libc/knames.h> <libc/libc.h>\
+			<libc/spp.h> <libc/xnames.h>
+	cwmsec.c	<libc/libc.h> <libc/spp.h> <libc/knames.h>
+	eprintf.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fclose.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	fdopen.c	<libc/fset.h> <libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fflush.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	fgetc.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fgets.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fopen.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	fputc.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fputs.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fread.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	freadline.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	free.c		<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	freopen.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fseek.c		<libc/fset.h> <libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	ftell.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	fwrite.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	gets.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	getw.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	index.c		<libc/libc.h> <libc/spp.h>
+	isatty.c	<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	malloc.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	mathf.f
+	mktemp.c	<libc/libc.h> <libc/spp.h>
+	perror.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	printf.c	<libc/ctype.h> <libc/libc.h> <libc/spp.h>\
+			<libc/stdio.h> <libc/xnames.h>
+	puts.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	putw.c		<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	qsort.c		<libc/libc.h>
+	realloc.c	<libc/libc.h> <libc/xnames.h> <libc/spp.h>
+	rewind.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	rindex.c	<libc/libc.h> <libc/spp.h>
+	scanf.c		<libc/ctype.h> <libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	setbuf.c	<libc/fset.h> <libc/libc.h> <libc/spp.h> <libc/stdio.h>
+	stgio.c		<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	strcat.c	<libc/libc.h>
+	strcmp.c	<libc/libc.h>
+	strdup.c	<libc/libc.h>
+	strcpy.c	<libc/libc.h>
+	strlen.c	<libc/libc.h>
+	strncat.c	<libc/libc.h>
+	strncmp.c	<libc/libc.h>
+	strncpy.c	<libc/libc.h>
+	spf.c		<libc/libc.h> <libc/spp.h> <libc/xnames.h>
+	sprintf.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	system.c	<libc/knames.h> <libc/libc.h> <libc/spp.h>
+	ungetc.c	<libc/libc.h> <libc/spp.h> <libc/stdio.h>\
+			<libc/xnames.h>
+	;
diff --git a/sys/libc/mktemp.c b/sys/libc/mktemp.c
new file mode 100644
index 00000000..433e64ae
--- /dev/null
+++ b/sys/libc/mktemp.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#include <iraf.h>
+
+/* MKTEMP -- Make a unique temporary file name.  This procedure is syntactically
+** equivalent to the UNIX procedure of the same name, but the XXXXXX are not
+** required in the input filename.
+*/
+char *
+mktemp (
+  char	*template		/* root filename, e.g., "tmp$xx"	*/
+)
+{
+	static	char unique[SZ_FNAME];
+
+	if (c_mktemp (template, unique, SZ_FNAME) > 0) {
+	    (void) strcpy (template, unique);
+	    return (unique);
+	} else
+	    return (NULL);
+}
diff --git a/sys/libc/perror.c b/sys/libc/perror.c
new file mode 100644
index 00000000..53aa923a
--- /dev/null
+++ b/sys/libc/perror.c
@@ -0,0 +1,36 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_xnames
+#define	import_stdio
+#define	import_libc
+#include <iraf.h>
+
+#define	SZ_OSERRMSG		80
+
+int	sys_nerr;			/* UNIX standard	*/
+char	*sys_errlist[1];		/* UNIX standard	*/
+int	u_oserrcode;
+char	u_oserrmsg[SZ_OSERRMSG+1];
+
+
+/* PERROR -- Print a short error message on the standard output describing
+** the last system error (e.g., exception).  The prefix string supplied
+** as the argument is first printed, followed by an ":", followed by the
+** system dependent error message describing the error.
+*/
+void
+perror (
+  char	*prefix			/* prefix string		*/
+)
+{
+	u_oserrcode = c_errget (u_oserrmsg, SZ_OSERRMSG);
+	sys_nerr = 0;
+	sys_errlist[0] = u_oserrmsg;
+
+	fputs (prefix, stderr);
+	fputs (": ", stderr);
+	fputs (u_oserrmsg, stderr);
+	fputc ('\n', stderr);
+}
diff --git a/sys/libc/printf.c b/sys/libc/printf.c
new file mode 100644
index 00000000..03b155bb
--- /dev/null
+++ b/sys/libc/printf.c
@@ -0,0 +1,245 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#define	import_ctype
+#define	import_stdarg
+#include <iraf.h>
+
+
+/* PRINTF -- Emulation of the UNIX printf facilities with the IRAF FMTIO
+** interface as the backend.  All features of the UNIX printf are supported
+** without modification.  Additional format codes are supported in conformance
+** with the IRAF printf, e.g., hms format, variable radix, tabstops, etc.,
+** but these are upward compatible with standard UNIX usage.
+*/
+
+#define	SZ_FMTSPEC	25		/* max size single format spec	*/
+#define	SZ_OBUF		SZ_COMMAND	/* sz intermediate buffer	*/
+#define	MAX_PREC	4		/* max "*" deferred args	*/
+#define	NOARG		(-1)		/* % spec with no data value	*/
+
+
+/* PRINTF -- Formatted print to the standard output.
+*/
+void
+printf (char *format, ...)
+{
+        va_list argp;
+	void u_doprnt();
+
+	va_start (argp, format);
+	u_doprnt (format, &argp, stdout);
+	va_end (argp);
+}
+
+
+/* FPRINTF -- Formatted print to a file.
+*/
+void
+fprintf (FILE *fp, char *format, ...)
+{
+        va_list argp;
+	void u_doprnt();
+
+	va_start (argp, format);
+	u_doprnt (format, &argp, fp);
+	va_end (argp);
+}
+
+
+/* U_DOPRNT -- Process the format to the output file, taking arguments from
+** the list pointed to by argp as % format specs are encountered in the input.
+** The main point of this routine is to handle the variable number of arguments.
+** The actual encoding is all handled by the IRAF FPRINF and PARG calls.
+** N.B. we assume chars are stacked as ints, and floats are stacked as doubles.
+*/
+void
+u_doprnt (
+  char *format,				/* "%w.dC" etc. format spec	*/
+  va_list *argp,			/* pointer to first value arg	*/
+  FILE	*fp				/* output file			*/
+)
+{
+	register int ch;		/* next format char reference	*/
+	XCHAR	formspec[SZ_FMTSPEC];	/* copy of single format spec	*/
+	XCHAR	*fsp;			/* pointer into formspec	*/
+	int	done, dotseen;		/* one when at end of a format	*/
+	int	varprec;		/* runtime precision is used	*/
+	int	prec[MAX_PREC];		/* values of prec args		*/
+
+	void  u_doarg ();
+
+
+	while ( (ch = *format++) ) {
+	    if (ch == '%') {
+		fsp = formspec;
+		*fsp++ = ch;
+		varprec = 0;
+		dotseen = 0;
+		done = 0;
+
+		while (!done) {
+		    ch = *fsp++ = *format++;
+
+		    switch (ch) {
+		    case EOS:
+			--format;
+			done++;
+			break;
+
+		    case 'l':
+			/* arg size modifier; ignored for now */
+			fsp--;
+			break;
+
+		    case '*':
+			prec[varprec++] = va_arg ((*argp), int);
+			break;
+
+		    case '.':
+			dotseen++;
+			break;
+
+		    case 'r':			/* nonstandard UNIX	*/
+			if ((ch = *fsp++ = *format++) == '*') {
+			    int		radix;
+			    int		radchar;
+
+			    radix = va_arg ((*argp), int);
+			    if (radix < 0)
+				radchar = 'A';
+			    else if (radix > 9)
+				radchar = radix - 10 + 'A';
+			    else
+				radchar = todigit (radix);
+			    *(fsp-1) = radchar;
+			} else if (ch == EOS) {
+			    --format;
+			    break;
+			}
+			/* fall through */
+
+		    case 'b':			/* nonstandard UNIX	*/
+		    case 'c':
+		    case 'd':
+		    case 'o':
+		    case 'x':
+		    case 'u':
+			*fsp = EOS;
+			u_doarg (fp, formspec, &argp, prec, varprec, TY_INT);
+			done++;
+			break;
+
+		    case 'E':			/* ANSI emulation	*/
+			*(fsp-1) = 'e';
+			goto rval;
+		    case 'G':			/* ANSI emulation	*/
+			*(fsp-1) = 'g';
+			goto rval;
+
+		    case 'z':			/* nonstandard UNIX	*/
+		    case 'h':			/* nonstandard UNIX	*/
+		    case 'H':			/* nonstandard UNIX	*/
+		    case 'm':			/* nonstandard UNIX	*/
+		    case 'M':			/* nonstandard UNIX	*/
+		    case 'e':
+		    case 'f':
+		    case 'g':
+			/* If no precision was specified, default to 14 digits
+			 * for %[efgz] and 3 digits for %[hm].
+			 */
+rval:			if (!dotseen) {
+			    *(fsp-1) = '.';
+			    if (ch == 'h' || ch == 'm' ||
+				ch == 'H' || ch == 'M') {
+				*fsp++ = '3';
+			    } else {
+				*fsp++ = '1';
+				*fsp++ = '4';
+			    }
+			    *fsp++ = ch;
+			}
+
+			*fsp = XEOS;
+			u_doarg (fp, formspec, &argp, prec, varprec, TY_DOUBLE);
+			done++;
+			break;
+
+		    case 's':
+			*fsp = EOS;
+			u_doarg (fp, formspec, &argp, prec, varprec, TY_CHAR);
+			done++;
+			break;
+
+		    case 't':			/* nonstandard UNIX	*/
+		    case 'w':			/* nonstandard UNIX	*/
+			*fsp = EOS;
+			u_doarg (fp, formspec, &argp, prec, varprec, NOARG);
+			done++;
+			break;
+
+		    case '%':
+			putc (ch, fp);
+			done++;
+			break;
+		    }
+		}
+
+	    } else 
+		putc (ch, fp);
+	}
+}
+
+
+/* U_DOARG -- Encode a single argument acording to the simplified format
+** specification given by formspec.  This is the interface to the IRAF
+** formatted output procedures.
+*/
+void
+u_doarg (fp, formspec, argp, prec, varprec, dtype)
+FILE	*fp;			/* output file			*/
+XCHAR	*formspec;		/* format string		*/
+va_list	**argp;			/* pointer to data value	*/
+int	prec[];			/* varprec args, if any		*/
+int	varprec;		/* number of varprec args	*/
+int	dtype;			/* datatype of data value	*/
+{
+	register int	p;
+	XCHAR	sbuf[SZ_OBUF+1];
+	XINT	fd = fileno (fp);
+	XINT	ival;
+	XDOUBLE	dval;
+	char	*cptr;
+
+
+	/* Pass format string and any variable precision arguments.
+	 */
+	FPRINTF (&fd, formspec);
+	for (p=0;  p < varprec;  p++) {
+	    ival = prec[p];
+	    PARGI (&ival);
+	}
+
+	/* Pass the data value to be encoded, bump argument pointer by the
+	 * size of the data object.  If there is no data value the case
+	 * is a no-op.
+	 */
+	switch (dtype) {
+	case TY_INT:
+	    ival = va_arg ((**argp), int);
+	    PARGI (&ival);
+	    break;
+	case TY_DOUBLE:
+	    dval = va_arg ((**argp), double);
+	    PARGD (&dval);
+	    break;
+	case TY_CHAR:
+	    cptr = va_arg ((**argp), char *);
+	    PARGSTR (c_strupk (cptr, sbuf, SZ_OBUF));
+	    break;
+	}
+}
diff --git a/sys/libc/puts.c b/sys/libc/puts.c
new file mode 100644
index 00000000..246b7bf6
--- /dev/null
+++ b/sys/libc/puts.c
@@ -0,0 +1,25 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* PUTS -- Put a null terminated string to the standard output, followed by a
+** newline.
+*/
+int
+puts (
+  char	*str			/* input string			*/
+)
+{
+	register FILE	*fp = stdout;
+	register char	*ip;
+
+
+	for (ip=str;  *ip != EOS;  ip++)
+	    putc (*ip, fp);
+	return (putc ('\n', fp));
+}
diff --git a/sys/libc/putw.c b/sys/libc/putw.c
new file mode 100644
index 00000000..d5cf6d8a
--- /dev/null
+++ b/sys/libc/putw.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+/* PUTW -- Put a word (integer) to the output stream.  When used in conjunction
+** with GETW this permits storage and retrieval of binary words to any file,
+** albeit somewhat inefficiently.
+*/
+int
+putw (
+  int	word,			/* data word to be output	*/
+  FILE	*fp			/* output file			*/
+)
+{
+	register char	*ip;
+	register int	n = sizeof (int);
+
+
+	for (ip=(char *)&word;  --n >= 0;  ip++)
+	    putc (*ip, fp);
+
+	return (ferror(fp) ? EOF : word);
+}
diff --git a/sys/libc/qsort.c b/sys/libc/qsort.c
new file mode 100644
index 00000000..345fc3bd
--- /dev/null
+++ b/sys/libc/qsort.c
@@ -0,0 +1,221 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+/*
+** Copyright (c) 1980 Regents of the University of California.
+** All rights reserved.
+**
+** Redistribution and use in source and binary forms are permitted
+** provided that the above copyright notice and this paragraph are
+** duplicated in all such forms and that any documentation,
+** advertising materials, and other materials related to such
+** distribution and use acknowledge that the software was developed
+** by the University of California, Berkeley.  The name of the
+** University may not be used to endorse or promote products derived
+** from this software without specific prior written permission.
+** THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+** IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+** WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+*/
+
+#define import_libc
+#include <iraf.h>
+
+/*
+** QSORT -- Quicker sort.  Adapted from the BSD sources.
+*/
+
+#define	THRESH		4		/* threshold for insertion */
+#define	MTHRESH		6		/* threshold for median */
+
+static  int (*qcmp)();			/* the comparison routine */
+static  int qsz;			/* size of each record */
+static  int thresh;			/* THRESHold in chars */
+static  int mthresh;			/* MTHRESHold in chars */
+static	void qst();
+
+
+/* QSORT -- First, set up some global parameters for qst to share.  Then,
+** quicksort with qst(), and then a cleanup insertion sort ourselves.
+** Sound simple? It's not...
+*/
+void
+qsort (
+  char	*base,
+  int	n,
+  int	size,
+  int	(*compar)()
+)
+{
+	register char c, *i, *j, *lo, *hi;
+	char	*minval, *maxval;
+
+
+	if (n <= 1)
+	    return;
+
+	qsz     = size;
+	qcmp    = compar;
+	thresh  = qsz * THRESH;
+	mthresh = qsz * MTHRESH;
+	maxval  = base + n * qsz;
+
+	if (n >= THRESH) {
+	    qst (base, maxval);
+	    hi = base + thresh;
+	} else
+	    hi = maxval;
+
+	/* First put smallest element, which must be in the first THRESH, in
+	 * the first position as a sentinel.  This is done just by searching
+	 * the first THRESH elements (or the first n if n < THRESH), finding
+	 * the min, and swapping it into the first position.
+	 */
+	for (j=lo=base;  (lo += qsz) < hi;  )
+	    if ((*qcmp)(j, lo) > 0)
+		j = lo;
+	if (j != base) {
+	    /* Swap j into place */
+	    for (i=base, hi=base+qsz;  i < hi;  ) {
+		c = *j;
+		*j++ = *i;
+		*i++ = c;
+	    }
+	}
+
+	/* With our sentinel in place, we now run the following hyper-fast
+	 * insertion sort.  For each remaining element, min, from [1] to [n-1],
+	 * set hi to the index of the element AFTER which this one goes.
+	 * Then, do the standard insertion sort shift on a character at a time
+	 * basis for each element in the frob.
+	 */
+	for (minval=base;  (hi = minval += qsz) < maxval;  ) {
+	    while ((*qcmp) (hi -= qsz, minval) > 0)
+		/* void */;
+	    if ((hi += qsz) != minval) {
+		for (lo = minval + qsz; --lo >= minval; ) {
+		    c = *lo;
+		    for (i=j=lo;  (j -= qsz) >= hi;  i=j)
+			*i = *j;
+		    *i = c;
+		}
+	    }
+	}
+}
+
+
+/* QST -- Do a quicksort.
+ * First, find the median element, and put that one in the first place as the
+ * discriminator.  (This "median" is just the median of the first, last and
+ * middle elements).  (Using this median instead of the first element is a big
+ * win).  Then, the usual partitioning/swapping, followed by moving the
+ * discriminator into the right place.  Then, figure out the sizes of the two
+ * partions, do the smaller one recursively and the larger one via a repeat of
+ * this code.  Stopping when there are less than THRESH elements in a partition
+ * and cleaning up with an insertion sort (in our caller) is a huge win.
+ * All data swaps are done in-line, which is space-losing but time-saving.
+ * (And there are only three places where this is done).
+ */
+static void
+qst (
+  char	*base, 
+  char  *maxval
+)
+{
+	register char c, *i, *j, *jj;
+	register int ii;
+	char *mid, *tmp;
+	int lo, hi;
+
+	/* At the top here, lo is the number of characters of elements in the
+	 * current partition.  (Which should be maxval - base).
+	 * Find the median of the first, last, and middle element and make
+	 * that the middle element.  Set j to largest of first and middle.
+	 * If maxval is larger than that guy, then it's that guy, else compare
+	 * maxval with loser of first and take larger.  Things are set up to
+	 * prefer the middle, then the first in case of ties.
+	 */
+	lo = maxval - base;		/* number of elements as chars */
+
+	do {
+	    mid = i = base + qsz * ((lo / qsz) >> 1);
+	    if (lo >= mthresh) {
+		j = ((*qcmp)((jj = base), i) > 0 ? jj : i);
+		if ((*qcmp)(j, (tmp = maxval - qsz)) > 0) {
+		    /* switch to first loser */
+		    j = (j == jj ? i : jj);
+		    if ((*qcmp)(j, tmp) < 0)
+			j = tmp;
+		}
+		if (j != i) {
+		    ii = qsz;
+		    do  {
+			c = *i;
+			*i++ = *j;
+			*j++ = c;
+		    } while (--ii);
+		}
+	    }
+
+	    /* Semi-standard quicksort partitioning/swapping
+	     */
+	    for (i = base, j = maxval - qsz; ; ) {
+		while (i < mid && (*qcmp)(i, mid) <= 0)
+		    i += qsz;
+		while (j > mid) {
+		    if ((*qcmp)(mid, j) <= 0) {
+			j -= qsz;
+			continue;
+		    }
+		    tmp = i + qsz;	/* value of i after swap */
+		    if (i == mid) {
+			/* j <-> mid, new mid is j */
+			mid = jj = j;
+		    } else {
+			/* i <-> j */
+			jj = j;
+			j -= qsz;
+		    }
+		    goto swap;
+		}
+
+		if (i == mid) {
+		    break;
+		} else {
+		    /* i <-> mid, new mid is i */
+		    jj = mid;
+		    tmp = mid = i;	/* value of i after swap */
+		    j -= qsz;
+		}
+
+	    swap:
+		ii = qsz;
+		do	{
+		    c = *i;
+		    *i++ = *jj;
+		    *jj++ = c;
+		} while (--ii);
+		i = tmp;
+	    }
+
+	    /* Look at sizes of the two partitions, do the smaller
+	     * one first by recursion, then do the larger one by
+	     * making sure lo is its size, base and maxval are update
+	     * correctly, and branching back.  But only repeat
+	     * (recursively or by branching) if the partition is
+	     * of at least size THRESH.
+	     */
+	    i = (j = mid) + qsz;
+	    if ((lo = j - base) <= (hi = maxval - i)) {
+		if (lo >= thresh)
+		    qst(base, j);
+		base = i;
+		lo = hi;
+	    } else {
+		if (hi >= thresh)
+		    qst(i, maxval);
+		maxval = j;
+	    }
+
+	} while (lo >= thresh);
+}
diff --git a/sys/libc/realloc.c b/sys/libc/realloc.c
new file mode 100644
index 00000000..21446345
--- /dev/null
+++ b/sys/libc/realloc.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* REALLOC -- Reallocate a buffer, i.e., change the size of an already
+** allocated buffer.  If necessary the buffer is moved, preserving any
+** data in the buffer.
+*/
+char *
+realloc (
+  char	*buf,
+  unsigned newsize
+)
+{
+	XINT	x_nchars = (newsize + sizeof(XCHAR)-1) / sizeof(XCHAR);
+	XINT	x_ptr, x_dtype = TY_CHAR;
+
+	x_ptr = buf ? Memcptr(buf) : NULL;
+	iferr (REALLOC (&x_ptr, &x_nchars, &x_dtype))
+	    return (NULL);
+	else
+	    return ((char *)&Memc[x_ptr]);
+}
diff --git a/sys/libc/rewind.c b/sys/libc/rewind.c
new file mode 100644
index 00000000..0185916c
--- /dev/null
+++ b/sys/libc/rewind.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+
+
+/* REWIND -- Position the named stream to beginning of file, i.e., arrange
+** for the next read or write to read or write the first byte of the file.
+*/
+long
+rewind (
+  FILE	*fp			/* operand file				*/
+)
+{
+	return ((long) fseek (fp, 0L, 0));
+}
diff --git a/sys/libc/rindex.c b/sys/libc/rindex.c
new file mode 100644
index 00000000..74169120
--- /dev/null
+++ b/sys/libc/rindex.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#define	import_spp
+#include <iraf.h>
+
+
+/* RINDEX -- Search string STR for char CH, returning a pointer to the last
+** occurrence of CH in STR or NULL.
+*/
+char *
+rindex (
+  char	*str,			/* string to be searched		*/
+  int	ch			/* character we are searching for	*/
+)
+{
+	register char	*ip = str;
+	register char	*last = NULL;
+
+	do {
+	    if (*ip == ch)
+		last = ip;
+	} while (*ip++);
+
+	return (last);
+}
diff --git a/sys/libc/scanf.c b/sys/libc/scanf.c
new file mode 100644
index 00000000..1ada2000
--- /dev/null
+++ b/sys/libc/scanf.c
@@ -0,0 +1,558 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_ctype
+#define	import_stdarg
+#include <iraf.h>
+
+
+/*
+** SCANF -- Formatted input.  The syntax of the calls and of the format strings
+** are UNIX standard, but the lexical forms of numbers recognized are IRAF
+** standard.
+*/
+
+#define	SCAN_STRING	0
+#define	SCAN_FILE	1
+#define	SZ_NUMBUF	256		/* maximum numeric field len	*/
+#define	SZ_UCC		128		/* maximum size user char class	*/
+#define	HUGE		999
+#define	ISHEX(c)	((c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'))
+
+struct _format {
+	int	f_type;			/* field type (doxscef[%)	*/
+	int	f_skipfield;		/* skip next field scanned	*/
+	int	f_width;		/* max chars in field		*/
+	int	f_longword;		/* output longword		*/
+	int	f_halfword;		/* output halfword		*/
+	int	f_delimset;		/* ucc chars are delimiters	*/
+	char	f_ucc[SZ_UCC+1];
+};
+
+/* Character input including pushback.  Character input may come either from
+** a file or from a string, depending on the value of the "intype" flag.
+** We cannot open the string as a file because file buffer characters are
+** of type XCHAR.
+*/
+struct _input {
+	int	i_type;			/* file input if !0, else str	*/
+	int	i_nchars;		/* nchars read thus far		*/
+	union {
+	FILE	*fp;			/* file pointer if file		*/
+	char	*ip;			/* char pointer if string	*/
+	} u;
+};
+
+#define	input()\
+    (in->i_nchars++, in->i_type ? (int)getc(in->u.fp) : (int)*in->u.ip++)
+#define	unput(ch)\
+    (in->i_nchars--, in->i_type ? ungetc((ch),in->u.fp) : (int)(*--(in->u.ip)))
+#define	ateof()\
+    (in->i_type ? feof(in->u.fp) : *(in->u.ip-1) == EOS)
+
+
+static int   u_doscan (struct _input *in, char *format, va_list *argp);
+static char *u_crackformat (char *format, struct _format *fmt);
+static int   u_scannum (struct _input *in, va_list **argp, 
+			struct	_format *fmt, int *eofflag);
+static char *u_setucc (char *format, struct _format *fmt);
+static int   u_scanstr (struct  _input *in, va_list **argp,
+  			struct  _format *fmt, int *eofflag);
+
+
+
+/* SCANF -- Scan the standard input.  The output arguments must be
+** pointers.  The number of fields successfully converted is returned as
+** the function value.  EOF is returned for a scan at EOF.
+*/
+int
+scanf (char *format, ...)
+{
+	va_list	argp;
+	struct _input in;
+	int status;
+
+	extern int u_doscan();
+
+
+	va_start (argp, format);
+	in.i_type = SCAN_FILE;
+	in.i_nchars = 0;
+	in.u.fp = stdin;
+
+	status = u_doscan (&in, format, &argp);
+	va_end (argp);
+	return (status);
+}
+
+
+/* FSCANF -- Formatted scan from a file.
+*/
+int
+fscanf (FILE *fp, char *format, ...)
+{
+	va_list	argp;
+	int	status;
+	struct	_input in;
+
+	extern int u_doscan();
+
+
+	va_start (argp, format);
+	in.i_type = SCAN_FILE;
+	in.i_nchars = 0;
+	in.u.fp = fp;
+
+	status = u_doscan (&in, format, &argp);
+
+	va_end (argp);
+	return (status);
+}
+
+
+/* SSCANF -- Formatted scan from a string.
+*/
+int
+sscanf (char *str, char *format, ...)
+{
+	va_list	argp;
+	struct _input in;
+	int status;
+
+	extern int u_doscan();
+
+
+	va_start (argp, format);
+	in.i_type = SCAN_STRING;
+	in.i_nchars = 0;
+	in.u.ip = str;
+
+	status = u_doscan (&in, format, &argp);
+
+	va_end (argp);
+	return (status);
+}
+
+
+/* U_DOSCAN -- Step along the format string, processing each %[*][w][lh]C
+** field specification and returning each argument using the pointer
+** supplied in the argument list.  Ordinary characters appearing in the format
+** string must match actual characters in the input stream.  Input may be
+** taken from either a string or a file.  The technique used to handle the
+** variable number of arguments is machine dependent.
+*/
+static int
+u_doscan (
+  struct _input *in,			/* input descriptor		*/
+  char	   *format,			/* format string		*/
+  va_list  *argp			/* pointer to first argument	*/
+)
+{
+	register int	ch;
+	struct	_format fmt;
+	int	nscan = 0, match;
+	int	eofflag = 0;
+	char	*u_crackformat(), *u_setucc();
+	int	u_scanstr(), u_scannum();
+
+
+	while ( (ch = *format++) ) {
+	    if (ch == '%' && *format != '%') {
+		/* Parse format specification.
+		 */
+		format = u_crackformat (format, &fmt);
+
+		/* Extract, decode, and output the next field according to
+		 * the field specification just generated.
+		 */
+		ch = *format++;
+		if (ch == 'n') {
+		    *(va_arg ((*argp), int *)) = in->i_nchars;
+		    continue;
+		} else if (ch == '[') {
+		    format = u_setucc (format, &fmt);
+		} else if (isupper (ch)) {
+		    fmt.f_longword++;
+		    ch = tolower (ch);
+		}
+		if (ch <= 0)
+		    return (EOF);
+		fmt.f_type = ch;
+
+		if (ch == 's' || ch == 'c' || ch == '[')
+		    match = u_scanstr (in, &argp, &fmt, &eofflag);
+		else
+		    match = u_scannum (in, &argp, &fmt, &eofflag);
+
+		if (match && !fmt.f_skipfield)
+		    nscan++;
+		if (eofflag)
+		    break;
+
+	    } else if (isspace (ch)) {
+		/* Skip optional whitespace. */
+		while (isspace (ch = input()))
+		    ;
+		if (ateof()) {
+		    eofflag++;
+		    break;
+		}
+		unput (ch);
+
+	    } else {
+		/* Match normal character. */
+		if (ch == '%')
+		    format++;
+		match = ch;
+		if (match != (ch = input())) {
+		    if (ateof())
+			eofflag++;
+		    else
+			unput (ch);
+		    break;
+		}
+	    }
+	}
+
+	if (eofflag)
+	    return (nscan ? nscan : EOF);
+	else
+	    return (nscan);
+}
+
+
+
+/* U_CRACKFORMAT -- Decode a %[*][w][lh]C input field format specification,
+ * returning the decoded format parameters in the output structure fmt.
+ * The number of format characters is returned as the function value.  The
+ * format string pointer is left pointing at the C character.
+ */
+static char *
+u_crackformat (
+  char	*format,		/* pointer to %+1 in format string	*/
+  struct _format *fmt		/* output format descriptor		*/
+)
+{
+	register int	ch;
+	register int	width = 0;
+
+
+	fmt->f_skipfield = 0;
+	fmt->f_longword  = 0;
+	fmt->f_halfword  = 0;
+
+	/* Skip output if "*" present. */
+	ch = *format++;
+	if (ch == '*') {
+	    fmt->f_skipfield++;
+	    ch = *format++;
+	}
+
+	/* Get max field width, if any. */
+	while (isdigit (ch)) {
+	    width = width * 10 + tointeg (ch);
+	    ch = *format++;
+	}
+	fmt->f_width = (width == 0) ? HUGE : width;
+
+	/* Datatype size modifier. */
+	if (ch == 'l') {
+	    fmt->f_longword++;
+	    ch = *format++;
+	} else if (ch == 'h') {
+	    fmt->f_halfword++;
+	    ch = *format++;
+	}
+
+	return (--format);
+}
+
+
+/* U_SCANNUM -- Extract a numeric token from the input stream.  The lexical
+** range of numbers recognized is as follows (ignoring leading +-):
+**
+**	INDEF						all types
+**	[0-7]+						o
+**	[0-9]+						d
+**	[0-9][0-9a-fA-F]*				x
+**	'.'[0-9]+([eEdD]([+-])?[0-9]+)?			f,e
+**	[0-9][0-9:]'.'[0-9]+([eEdD]([+-])?[0-9]+)?	f,e (sexagesimal)
+**
+** If the conversion fails the token is pushed back into the input, ready
+** to be rescanned.  Argp is bumped if skipfield is false whether or not
+** a legal number is matched (else one might assign a string to a pointer
+** to int in the next format, overruning memory).  If the match fails 0 is
+** output to argp and 0 is returned as the function value, indicating no
+** match.
+*/
+static int
+u_scannum (
+  struct _input *in,		/* input descriptor			*/
+  va_list	**argp,		/* where output goes			*/
+  struct	_format *fmt,	/* format descriptor			*/
+  int	*eofflag		/* set to 1 on output if end of input	*/
+)
+{
+	char	numbuf[SZ_NUMBUF+1];
+	register int	ch;
+	register long	num = 0;
+	register char	*op = numbuf;
+	int	floating = 0, radix=10, n;
+	int	neg=0, ndigits=0, match=1;
+	int	dotseen=0, expseen=0;
+
+
+	ch = fmt->f_type;
+	n  = fmt->f_width;
+
+	if (ch == 'd')
+	    radix = 10;
+	else if (ch == 'o')
+	    radix = 8;
+	else if (ch == 'x')
+	    radix = 16;
+	else if ( (floating = (ch == 'f' || ch == 'e' || ch == 'g') )) {
+	    radix = 10;
+	    dotseen = expseen = 0;
+	}
+
+	while (isspace ( (ch = input()) ))
+	    ;
+	
+	if (ch == '-' || ch == '+') {
+	    if (ch == '-') {
+		neg++;
+		*op++ = ch;
+	    }
+	    ch = input();
+	    --n;
+	}
+
+	/* Check for INDEF.  Abbreviations are not permitted; if the match
+	 * fails the input must be restored.
+	 */
+	if (ch == 'I' && op == numbuf && n >= 5) {
+	    char *ip = "INDEF";
+
+	    for (n=5;  --n >= 0 && (ch == *ip++);  ch=input())
+		*op++ = ch;
+	    *op = EOS;
+	    if (!ateof())
+		unput (ch);
+
+	    if (n < 0) {
+		/* If the 6th char is not a legal character in an identifier
+		 * then we have a match.
+		 */
+		if (! (isalnum (ch) || ch == '_')) {
+		    if (fmt->f_skipfield)
+			return (1);
+		    else if (floating)
+			goto out_;
+		    else {
+			if (fmt->f_longword)
+			    *(va_arg ((**argp), long  *)) = INDEFL;
+			else if (fmt->f_halfword)
+			    *(va_arg ((**argp), short *)) = INDEFS;
+			else
+			    *(va_arg ((**argp), int   *)) = INDEFI;
+			return (1);
+		    }
+		}
+	    }
+
+	    /* No match; neither INDEF nor a number.  Push back chars and exit.
+	     * (the FIO ungetc may be called repeatedly).
+	     */
+	    for (--op;  op >= numbuf;  --op)
+		unput (*op);
+
+	    match = 0;
+	    num = 0;
+	    numbuf[0] = '0';
+	    goto out_;
+	}
+
+	/* Extract token into numbuf.  If the token contains only digits it
+	 * will have been converted to binary and left in the variable num.
+	 */
+	for (*op++ = ch;  --n >= 0;  *op++ = ch = input()) {
+	    if (isdigit (ch)) {
+		ch = tointeg (ch);
+		if (ch >= radix)
+		    break;
+		ndigits++;
+		num = num * radix + ch;
+
+	    } else if (radix == 16 && ISHEX(ch)) {
+		if (isupper (ch))
+		    ch = tolower (ch);
+		ndigits++;
+		num = num * 16 + ch - 'a' + 10;
+
+	    } else if (ch == '.') {
+		if (!floating || dotseen)
+		    break;
+		dotseen++;
+	    } else if (ch == ':') {
+		if (!floating || ndigits == 0 || dotseen || expseen)
+		    break;
+
+	    } else if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
+		if (!floating || expseen || (ndigits == 0 && !dotseen))
+		    break;
+		expseen++;
+		*op++ = ch = input();
+		if (! (ch == '+' || ch == '-' || isdigit(ch)))
+		    break;
+
+	    } else
+		break;
+	}
+
+	*--op = EOS;
+	if (ateof())
+	    *eofflag = 1;
+	else
+	    unput (ch);
+
+	if (ndigits == 0)
+	    match = 0;				/* not a number		*/
+	if (neg)
+	    num = -num;
+out_:
+	if (fmt->f_skipfield)
+	    return (match);
+
+	/* Output value.
+	 */
+	if (floating) {
+	    float	rval;
+	    double	dval, atof();
+
+	    if (fmt->f_longword) {
+		*(va_arg ((**argp), double *)) = atof (numbuf);
+	    } else if (fmt->f_halfword) {
+		dval = atof (numbuf);
+		rval = (dval == INDEFD) ? INDEFR : dval;
+		*(va_arg ((**argp), float  *)) = rval;
+	    } else
+		*(va_arg ((**argp), double *)) = atof (numbuf);
+	} else {
+	    if (fmt->f_longword)
+		*(va_arg ((**argp), long  *)) = num;
+	    else if (fmt->f_halfword)
+		*(va_arg ((**argp), short *)) = num;
+	    else
+		*(va_arg ((**argp), int   *)) = num;
+	}
+
+	return (match);
+}
+
+
+/* U_SETUCC -- Extract a user defined character class from the format string.
+** A full 128 char table is not used since it is more expensive to prepare
+** than it is worth for small sets.
+*/
+static char *
+u_setucc (
+  char	*format,
+  struct _format *fmt
+)
+{
+	register char	*op = fmt->f_ucc;
+	register int	n = SZ_UCC;
+
+	fmt->f_delimset = (*format == '^') ? *format++ : 0;
+	while (--n && *format && (*op = *format++) != ']') {
+	    if (*op == '\\' && *format == ']')
+		*op = *format++;
+	    op++;
+	}
+	*op = EOS;
+
+	return (format);
+}
+
+
+
+/* U_SCANSTR -- Extract a whitespace delimited sequence of characters.
+*/
+static int
+u_scanstr (
+  struct  _input *in,		/* input descriptor			*/
+  va_list **argp,		/* output arglist			*/
+  struct  _format *fmt,		/* numeric format expected		*/
+  int	  *eofflag		/* set to 1 on output if end of input	*/
+)
+{
+	register int	ch, n;
+	register char	*ip, *op;
+	int	delimset;
+	char	*ucc = "";
+
+
+	op = fmt->f_skipfield ? (char *)NULL : va_arg ((**argp), char *);
+	ch = fmt->f_type;
+	n  = fmt->f_width;
+	if (ch == 'c' && n == HUGE)
+	    n = 1;
+
+	/* Set up character class to be matched.
+	 */
+	delimset = 1;
+	if (ch == 'c')
+	    ucc = "";
+	else if (ch == 's')
+	    ucc = " \t\n";
+	else if (ch == '[') {
+	    ucc = fmt->f_ucc;
+	    delimset = fmt->f_delimset;
+	}
+ 
+	/* Skip leading whitespace only for format %s.
+	 */
+	if (ch == 's') {
+	    while (isspace (ch = input()))
+		;
+	} else
+	    ch = input();
+
+	/* Extract chars matching set into output buffer.
+	 */
+	while (--n >= 0 && (ch > 0 || !ateof())) {
+	    /* Is char in set ucc. */
+	    for (ip=ucc;  *ip != EOS;  ip++)
+		if (ch == *ip) {
+		    if (delimset)
+			goto done_;
+		    if (op)
+			*op++ = ch;
+		    goto next_;
+		}
+
+	    /* Char not in set if we get here. */
+	    if (delimset) {
+		if (op)
+		    *op++ = ch;
+	    } else
+		break;
+next_:
+	    ch = input();
+	}
+done_:
+	if (ateof())
+	    *eofflag = 1;
+	else {
+	    unput (ch);
+	}
+
+	if (op && fmt->f_type != 'c')
+	    *op = EOS;
+	
+	return (1);
+}
diff --git a/sys/libc/setbuf.c b/sys/libc/setbuf.c
new file mode 100644
index 00000000..845c9f9d
--- /dev/null
+++ b/sys/libc/setbuf.c
@@ -0,0 +1,68 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_fset
+#include <iraf.h>
+
+
+/* SETBUF -- Assign a buffer to be used by the i/o system to access a file.
+** Should be called after opening the file but before doing any i/o.
+*/
+void
+setbuf (
+  FILE	*fp,
+  char	*buf
+)
+{
+	void setbuffer();
+
+	setbuffer (fp, buf, BUFSIZ);
+}
+
+
+/* SETBUFFER -- Assign a buffer of arbitrary size to be used by the i/o system
+** to access a file.  Should be called after opening the file but before doing
+** any i/o.  If the the pointer buf has the value NULL, i/o is unbuffered
+** (or as close to unbuffered as we can manage).
+*/
+void
+setbuffer (
+  FILE	*fp,
+  char	*buf,
+  int	size
+)
+{
+	register XINT	fd = fileno(fp);
+
+
+	if (buf == NULL)
+	    c_fseti (fd, F_BUFSIZE, 1);
+	else {
+	    c_fseti (fd, F_BUFPTR, Memcptr(buf));
+	    c_fseti (fd, F_BUFSIZE, size);
+	}
+}
+
+
+/* SETLINEBUF -- Set line buffered mode for a file.  A line buffered file
+ * buffers each line and flushes it to the output device when newline is
+ * seen.  We may be even after doing i/o to the file.
+ */
+void
+setlinebuf (
+  FILE	*fp
+)
+{
+	register XINT	fd = fileno(fp);
+
+	extern int  c_fstati();
+	extern void c_fseti();
+
+
+	if (c_fstati (fd, F_BUFSIZE) < SZ_LINE)
+	    c_fseti (fd, F_BUFSIZE, SZ_LINE);
+	c_fseti (fd, F_FLUSHNL, YES);
+}
diff --git a/sys/libc/spf.c b/sys/libc/spf.c
new file mode 100644
index 00000000..2953ed76
--- /dev/null
+++ b/sys/libc/spf.c
@@ -0,0 +1,65 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/*
+** SPF.C -- String spoolfile utility package.  Used to capture in a string
+** buffer the output of a routine set up to write to a file.
+**
+** Example:
+**
+**	fd = spf_open (buf, maxch)
+**	fprop (pp, fdopen(fd,"w"));
+**	spf_close (fd);
+**
+** leaves the output of the fprop() function in the user buffer "buf".
+*/
+
+static	XCHAR	*spf_buf;
+static	char	*spf_userbuf;
+static	int	spf_maxch;
+
+
+/* SPF_OPEN -- Spoolfile open.  Open a string spoolfile to be written into as
+** a file, using ordinary file i/o.  Only one such file can be open at a time.
+*/
+int
+spf_open (
+  char	*buf,			/* user string buffer		*/
+  int	maxch			/* max chars of storage		*/
+)
+{
+	XINT    x_maxch = maxch, x_mode = NEW_FILE;
+	char	*malloc();
+
+
+	spf_userbuf = buf;
+	spf_maxch = maxch;
+
+	/* Malloc always returns a buffer which aligned to at least XCHAR. */
+	spf_buf = (XCHAR *) malloc ((maxch + 1) * sizeof(XCHAR));
+
+	return (STROPEN (spf_buf, &x_maxch, &x_mode));
+}
+
+
+/* SPF_CLOSE -- Close the spoolfile string, which should have been written
+** into via file i/o while the string was open.  This leaves SPP chars in
+** the string; pack the string and return a pointer to the string.
+*/
+void
+spf_close (
+  XINT	fd			/* file descriptor of stringbuf	*/
+)
+{
+	XINT  x_fd = fd;
+
+	CLOSE (&x_fd);
+	c_strpak (spf_buf, spf_userbuf, spf_maxch);
+	free ((char *)spf_buf);
+}
diff --git a/sys/libc/sprintf.c b/sys/libc/sprintf.c
new file mode 100644
index 00000000..24d408a0
--- /dev/null
+++ b/sys/libc/sprintf.c
@@ -0,0 +1,58 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#define	import_stdarg
+#include <iraf.h>
+
+#define	SZ_OBUF		SZ_COMMAND	/* sz intermediate buffer	*/
+
+
+/* SPRINTF -- Formatted print to a string.  If char and XCHAR are the
+** same size we open the output string as a file and write directly into
+** it.  Otherwise we must write into an intermediate buffer, then pack
+** XCHAR into the char output string.  This is not as bad as it sounds
+** as the operation is negligible compared to the encoding operation.
+*/
+char *
+sprintf (char *str, char *format, ...)
+{
+	register XCHAR	*ip;
+	register char	*op;
+	XCHAR obuf[SZ_OBUF], *fiobuf;
+	XINT x_fd, x_maxch = SZ_OBUF, x_mode = NEW_FILE;
+	va_list	argp;
+
+	extern int  u_doprnt();
+
+
+	va_start (argp, format);
+
+	/* Select output buffer. */
+	if (sizeof (XCHAR) == sizeof (char))
+	    fiobuf = (XCHAR *)str;
+	else
+	    fiobuf = obuf;
+
+	/* Make it the file buffer.  Call FIO to open the string as a file.
+	 */
+	x_fd = STROPEN (fiobuf, &x_maxch, &x_mode);
+
+	/* Format the data into obuf.  */
+	u_doprnt (format, &argp, FDTOFP(x_fd));
+
+	/* FIO does not write the EOS until the string file is closed.
+	 * Move obuf to str if it is not already there.
+	 */
+	CLOSE (&x_fd);
+	if (fiobuf == obuf)
+	    for (ip=obuf, op=str;  (*op++ = *ip++) != EOS;  )
+		;
+
+	va_end (argp);
+
+	return (str);
+}
diff --git a/sys/libc/stgio.c b/sys/libc/stgio.c
new file mode 100644
index 00000000..498a020a
--- /dev/null
+++ b/sys/libc/stgio.c
@@ -0,0 +1,60 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#include <iraf.h>
+
+
+/* STGIO.C -- STDGRAPH graphics terminal i/o interface.  This is a C binding
+** for the VOS STDGRAPH graphics kernel text i/o routines.  These are used to
+** do direct i/o to the graphics terminal, whether or not the terminal is in
+** graphics mode.  When the terminal is not in graphics mode, i.e., when the
+** "workstation is deactivated", these routines are equivalent to the FIO
+** putline and getline procedures.
+**
+**	nchars|EOF = c_stggetline (STDIN, buf)
+**		     c_stgputline (STDOUT, buf)
+*/
+
+
+/* C_STGGETLINE -- Get a line of text from the graphics terminal.
+*/
+int
+c_stggetline (
+  XINT	fd,			/* input stream		*/
+  char	*buf,			/* user string buffer	*/
+  int   maxch			/* max bufer size	*/
+)
+{
+	XCHAR	xbuf[maxch+1];
+	XINT    x_fd = fd;
+	int	status;
+
+	iferr (status = STG_GETLINE (&x_fd, xbuf))
+	    return (EOF);
+	else {
+	    c_strpak (xbuf, buf, maxch);
+	    return (status);
+	}
+}
+
+
+/* C_STGPUTLINE -- Put a line of text to the graphics terminal.
+*/
+int
+c_stgputline (
+  XINT	fd,			/* input stream		*/
+  char	*buf			/* user string buffer	*/
+)
+{
+	XCHAR	xbuf[SZ_LINE+1];
+	XINT    x_fd = fd;
+
+	c_strupk (buf, xbuf, SZ_LINE);
+	iferr (STG_PUTLINE (&x_fd, xbuf))
+	    return (ERR);
+	else
+	    return (OK);
+}
diff --git a/sys/libc/strcat.c b/sys/libc/strcat.c
new file mode 100644
index 00000000..49798ba0
--- /dev/null
+++ b/sys/libc/strcat.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+
+/* STRCAT -- Concatenate S2 onto S1.
+*/
+char *
+strcat (
+  char	*s1,			/* output string		*/
+  char	*s2			/* string to be appended	*/
+)
+{
+	register char	*ip, *op;
+
+	for (op=s1;  *op++;  )
+	    ;
+	for (--op, ip=s2;  (*op++ = *ip++);  )
+	    ;
+
+	return (s1);
+}
diff --git a/sys/libc/strcmp.c b/sys/libc/strcmp.c
new file mode 100644
index 00000000..7b7dc54a
--- /dev/null
+++ b/sys/libc/strcmp.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+
+/* STRCMP -- Compare two strings.  -N is returned if S1 < S2, 0 if S1 == S2,
+** and +N if S1 > S2.
+*/
+int
+strcmp (
+  char	*s1,
+  char	*s2
+)
+{
+	while (*s1 == *s2++)
+	    if (*s1++ == '\0')
+		return (0);
+
+	return (*s1 - *--s2);
+}
diff --git a/sys/libc/strcpy.c b/sys/libc/strcpy.c
new file mode 100644
index 00000000..cbc072f0
--- /dev/null
+++ b/sys/libc/strcpy.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+/* STRCPY -- Copy string S2 to S1.
+*/
+char *
+strcpy (
+  char	*s1,			/* output string		*/
+  char	*s2			/* string to be moved		*/
+)
+{
+	register char	*ip, *op;
+
+	for (ip=s2, op=s1;  (*op++ = *ip++);  )
+	    ;
+
+	return (s1);
+}
diff --git a/sys/libc/strdup.c b/sys/libc/strdup.c
new file mode 100644
index 00000000..4568d89f
--- /dev/null
+++ b/sys/libc/strdup.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+/* STRDUP -- Save a copy of a string.
+*/
+char *
+strdup (
+  char	*str			/* string to copy		*/
+)
+{
+    register char *ip, *op, *out;
+    int  len = strlen (str);
+
+    out = calloc (1, strlen (str) + 1);
+    for (ip=str, op=out;  (*op++ = *ip++);  )
+        ;
+
+    return (out);
+}
diff --git a/sys/libc/strlen.c b/sys/libc/strlen.c
new file mode 100644
index 00000000..c6c2f813
--- /dev/null
+++ b/sys/libc/strlen.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_libc
+#include <iraf.h>
+
+
+/* STRLEN -- Length of a string.
+*/
+int
+strlen (
+  char	*s
+)
+{
+	register char	*ip=s;
+
+	while (*ip++)
+	    ;
+
+	return (ip - s - 1);
+}
diff --git a/sys/libc/strncat.c b/sys/libc/strncat.c
new file mode 100644
index 00000000..9deae4eb
--- /dev/null
+++ b/sys/libc/strncat.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+
+/* STRNCAT -- Concatenate at most N chars from S2 onto S1.
+*/
+char *
+strncat (
+  char	*s1,			/* output string		*/
+  char	*s2,			/* string to be appended	*/
+  int	n		/* max length of S1		*/
+)
+{
+	register char	*ip, *op;
+
+	for (op=s1;  *op++;  )
+	    ;
+	for (--op, ip=s2;  (*op++ = *ip++) && --n >= 0;  )
+	    ;
+	*--op = '\0';
+
+	return (s1);
+}
diff --git a/sys/libc/strncmp.c b/sys/libc/strncmp.c
new file mode 100644
index 00000000..089df283
--- /dev/null
+++ b/sys/libc/strncmp.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+/* STRNCMP -- Compare up to the first N characters of two strings.  -N is
+** returned if S1 < S2, 0 if S1 == S2, and +N if S1 > S2.
+*/
+int
+strncmp (
+  char	*s1,
+  char	*s2,
+  int	n
+)
+{
+	while (--n >= 0 && *s1 == *s2++)
+	    if (*s1++ == '\0')
+		return (0);
+
+	return (n < 0 ? 0 : *s1 - *--s2);
+}
diff --git a/sys/libc/strncpy.c b/sys/libc/strncpy.c
new file mode 100644
index 00000000..79e99495
--- /dev/null
+++ b/sys/libc/strncpy.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_libc
+#include <iraf.h>
+
+
+/* STRNCPY -- Copy exactly N characters from S2 to S1, truncating or null
+** padding S2; the output string may not be null terminated if the length
+** of S2 is N or more.
+*/
+char *
+strncpy (
+  char	*s1,			/* output string		*/
+  char	*s2,			/* string to be moved		*/
+  int   n
+)
+{
+	register char	*ip, *op;
+
+	for (ip=s2, op=s1;  --n >= 0 && (*op++ = *ip++);  )
+	    ;
+	while (--n >= 0)
+	    *op++ = '\0';
+
+	return (s1);
+}
diff --git a/sys/libc/system.c b/sys/libc/system.c
new file mode 100644
index 00000000..44265864
--- /dev/null
+++ b/sys/libc/system.c
@@ -0,0 +1,26 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_knames
+#include <iraf.h>
+
+
+/* SYSTEM -- Send a command to the host system.  OK is returned if the command
+** executes properly, else a positive integer error code identifying the error
+** which occurred.
+*/
+int
+system (
+  char	*cmd			/* command to be sent to host system	*/
+)
+{
+	PKCHAR	nullstr[1];
+	XINT	status;
+
+	nullstr[0] = EOS;
+	ZOSCMD (cmd, nullstr, nullstr, nullstr, &status);
+
+	return ((int) status);
+}
diff --git a/sys/libc/ungetc.c b/sys/libc/ungetc.c
new file mode 100644
index 00000000..2773f4e1
--- /dev/null
+++ b/sys/libc/ungetc.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+*/
+
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_stdio
+#include <iraf.h>
+
+
+/* UNGETC -- Push a character back into the input stream.  Pushback is last
+** in first out, i.e., the last character pushed back is the first one
+** read by GETC.  Characters (and strings) may be pushed back until the
+** FIO pushback buffer overflows.
+*/
+int
+ungetc (
+  int	ch,
+  FILE	*fp
+)
+{
+	XINT	x_fd = fileno(fp);
+	XCHAR	x_ch = ch;
+
+	iferr (UNGETC (&x_fd, &x_ch))
+	    return (EOF);
+	else
+	    return (ch);
+}
diff --git a/sys/libc/zzdebug.x b/sys/libc/zzdebug.x
new file mode 100644
index 00000000..88cf9551
--- /dev/null
+++ b/sys/libc/zzdebug.x
@@ -0,0 +1,7 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	hello	= t_hello,
+	print	= t_print,
+	copy	= t_copy,
+	scan	= t_scan,
+	gettok	= t_gettok
diff --git a/sys/libc/zztest.c b/sys/libc/zztest.c
new file mode 100644
index 00000000..b43fe705
--- /dev/null
+++ b/sys/libc/zztest.c
@@ -0,0 +1,98 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_libc
+#define import_stdio
+#define import_spp
+#define import_error
+#define import_xwhen
+#include <iraf.h>
+
+thello_()
+{
+	fputs ("hello, world\n", stdout);
+}
+
+
+tprint_()
+{
+	char	buf[128];
+
+	sprintf (buf, "\tabcdef %0*d[%-5.2s], %h\n", 5, 99, "wxyz", 12.5);
+	fputs (buf, stdout);
+}
+
+
+tcopy_()
+{
+	FILE	*in, *out;
+	int	ch;
+
+	if ((in = fopen ("junk", "r")) == NULL)
+	    c_erract (EA_ERROR);
+	if ((out = fopen ("junk2", "wb")) == NULL)
+	    c_erract (EA_ERROR);
+
+	while ((ch = getc (in)) != EOF)
+	    putc (ch, out);
+
+	fclose (in);
+	fclose (out);
+}
+
+
+tscan_()
+{
+	char	buf[SZ_LINE];
+	char	str[SZ_LINE];
+	char	cval;
+	int	ival, nscan, n1, n2;
+	int	onint(), oldint;
+	double	dval;
+
+	c_xwhen (X_INT, onint, &oldint);
+
+	printf (">> \n");
+	fflush (stdout);
+
+	while (fgets (buf, SZ_LINE, stdin) != NULL) {
+	    nscan = sscanf (buf,
+		"%n%c %*s %d %lg %s%n", &n1, &cval, &ival, &dval, str, &n2);
+	    printf ("nscan=%d: %d '%c' %d %g '%s' %d\n",
+		nscan, n1, cval, ival, dval, str, n2);
+	    printf (">> \n");
+	    fflush (stdout);
+	}
+
+	eprintf ("all done\n");
+}
+
+
+onint (code, old_handler)
+int	*code;			/* NOTUSED */
+int	*old_handler;
+{
+	write (2, "\7", 1);
+	*old_handler = 0;
+}
+
+
+tgettk_()
+{
+	XCHAR	fname[SZ_FNAME+1];
+	char	token[SZ_LINE+1], delim;
+	int	maxch = SZ_FNAME;
+	FILE	*fp;
+
+	clgstr_ (c_sppstr("fname"), fname, &maxch);
+	c_strpak (fname, token, maxch);
+
+	fp = fopen (token, "r");
+	if (fp == NULL)
+	    c_erract (EA_ERROR);
+
+	while (fscanf (fp, " %[^ \t\n,:()!^&+-*/;|?<>]%c", token,&delim) != EOF)
+	    eprintf ("%s\n%c\n", token, delim);
+
+	fclose (fp);
+}
diff --git a/sys/memdbg/README b/sys/memdbg/README
new file mode 100644
index 00000000..1632e355
--- /dev/null
+++ b/sys/memdbg/README
@@ -0,0 +1,107 @@
+MEMDBG -- Debug version of MEMIO.
+
+This library may be linked with an application to perform runtime checks on
+the memory allocation subsystem to check for memory leaks.  This library is
+used only for debugging and is not supported on all IRAF host systems.
+
+To use this package link the iraf process with the flags
+
+    -z -lmemdbg
+
+e.g.
+    xc -c zz.x;  xc -z -o zz.e zz.o -lmemdbg
+
+or include -lmemdbg on the $link line in the mkpkg file.
+
+It may be desirable to edit the IRAF source code to insert MEMLOG messages
+or change the logging defaults.  The following routines are provided for this
+purpose.
+
+		 memlog (message)
+		memlog1 (message, arg1)
+		memlog2 (message, arg1, arg2)
+		memlogs (message, strarg)
+		 memlev (loglevel)
+
+MEMLOG logs a simple message string.  MEMLOG[12] allow one or two integer
+arguments.  MEMLOGS allows one string argument.
+
+The debug level may be set with MEMLEV, as follows:
+
+	level = 1	log malloc/realloc/mfree calls
+	level = 2	log smark/sfree calls
+	level = 3	log both types of calls
+
+The default debug level is 3.
+
+Run one or more IRAF tasks in the process you want to debug and then type
+flpr to exit the process (debug logging is process level and ALL calls during
+the process lifetime are logged).  When the IRAF process is run a file
+
+	mem.log
+
+will be left in the current directory.  This contains a long sequence of lines
+such as the following:
+
+    215738  00000696    18d74  A 1  malloc 572 type 10
+    21929d  00000697    59e34  A 2      smark
+    21929d  00000698    5a0aa  F 2      sfree
+
+The columns are as follows.
+
+	bufadr		Buffer address for malloc, mfree, smark, etc.
+	seqno		Sequence number - order in which the calls were made
+	retadr		Return address - identifies routine which made the call
+	action		Action code - A (alloc), R (realloc), F (free)
+	class		Class of allocator (1=malloc/mfree, 2=smark/sfree)
+	comment		Describes the type of call, may give extra info
+
+This is just the raw debug output.  To check the debug output to see if there
+are any calls that don't match up, the task MEMCHK in SOFTOOLS is used, e.g.,
+
+    cl> sort mem.log | memchk | sort col=2 > mem.log2
+
+This can also be run at the host level as follows.
+
+    % sort mem.log | x_softools.e memchk fname=STDIN passall+ | sort +1 > ...
+
+This may take a while for very large (> 10K lines) mem.log files.  The
+output file will look like the input file except that any bad calls will be
+flagged with the string "####" at the end of the line.
+
+The RETADR field (printed in hex) can be used to determine what IRAF procedure
+made a particular call.  On a Sun one can run
+
+    % nm -n x_whatever.e
+
+To list the symbol table sorted by address.  The routine which made the call
+will be the .text routine with the greatest address which is less than
+retadr, i.e., retadr is an address within the text of the calling procedure.
+
+On a SysV system NM produces "pretty" output and is harder to use.  The
+following command produces the necessary sorted list on my A/UX system.
+
+    % nm -e -x imexpr.e | sort -t\| +1
+
+Another way to do this is to let a debugger look up the symbol in the
+symbol table for us.  Here is an example using adb.
+
+    % adb zz.e
+    0x25f0?i
+    _foo_+0x28:     call    _xmallc_
+
+In this example the value of retadr is 0x25f0, the executable is the file
+zz.e, and the procedure which called the MEMIO (MEMDBG) routine malloc
+was "foo" according to adb.
+
+Note that memory debug logging starts during process startup and the first
+messages logged will record the MEMIO calls made by the system code.  It is
+normal for the system code to allocate some buffers which are used for the
+lifetime of the process hence are never freed.  A simple way to determine
+where the system MEMIO calls end and your task execution begins is to put a
+call such as
+
+	call memlog ("--------- start task -----------")
+
+in the first executable line of your IRAF task.  Comments such as this will
+be preserved in the mem.log file.
diff --git a/sys/memdbg/begmem.x b/sys/memdbg/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/memdbg/begmem.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help begmem, fixmem
+.nf ___________________________________________________________________________
+BEGMEM, FIXMEM -- Try to get/release physical memory for a process.  The
+actual amount of physical memory available (in chars) is returned.  On a
+machine with virtual memory, these routines adjust the working set size.
+
+On any machine, BEGMEM may be used to determine the amount of available
+physical memory, to tune algorithms for optimum performance.  BEGMEM returns
+as its function value the actual working set size of the process after
+the adjustment (or the current working set size if "best_size" is zero).
+On some systems this represents a soft limit on the actual amount of memory
+which can be used; it is a guarantee that at least that much space is
+available.  Some systems will allow the actual working set to dynamically
+exceed this value at runtime if the process pages heavily.  The hard limit
+on the working set of a process is given by the "max_size" parameter.
+
+Note that the working set must include space not only for a task specific
+data buffers, but also for all other process data buffers and for the text
+(instruction space) of the code being executed.  There is no easy way to
+determine this, hence the application is expected to estimate it.  A typical
+value for the base text+data size required to execute a program is 150Kb.
+.endhelp ______________________________________________________________________
+
+
+# BEGMEM -- Attempt to the adjust the amount of physical memory allocated
+# to a process.  Save the old memory size in OLD_SIZE, so that memory may
+# later be restored with FIXMEM.  The new working set size is returned as
+# the function value and the hard limit on the working set size is returned
+# in MAX_SIZE.  In general, the process can be expected to page, possibly
+# heavily, or swap out if the working set size is exceeded.  All sizes are
+# returned in SPP chars.  If BEST_SIZE is zero the working set size is not
+# changed, i.e., the current working set parameters are returned.
+
+int procedure begmem (best_size, old_size, max_size)
+
+int	best_size		# desired working set size
+int	old_size		# former working set size
+int	max_size		# max physical memory available to this process
+
+int	new_size
+
+begin
+	call zawset (best_size * SZB_CHAR, new_size, old_size, max_size)
+	new_size = new_size / SZB_CHAR
+	old_size = old_size / SZB_CHAR
+	max_size = max_size / SZB_CHAR
+
+	return (new_size)
+end
+
+
+# FIXMEM -- Restore the original working set size.
+
+procedure fixmem (old_size)
+
+int	old_size
+int	j1, j2, j3
+
+begin
+	call zawset (old_size * SZB_CHAR, j1, j2, j3)
+end
diff --git a/sys/memdbg/calloc.x b/sys/memdbg/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/memdbg/calloc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CALLOC -- Allocate and zero a block of memory.
+
+procedure calloc (ubufp, buflen, dtype)
+
+pointer	ubufp			# user buffer pointer [OUTPUT]
+int	buflen			# nelements of space required,
+int	dtype		# of this data type
+
+pointer	char_ptr
+pointer	coerce()
+int	sizeof()
+errchk	malloc
+
+begin
+	call malloc (ubufp, buflen, dtype)
+	char_ptr = coerce (ubufp, dtype, TY_CHAR)
+	call aclrc (Memc[char_ptr], buflen * sizeof (dtype))
+end
diff --git a/sys/memdbg/coerce.x b/sys/memdbg/coerce.x
new file mode 100644
index 00000000..7d42f3bf
--- /dev/null
+++ b/sys/memdbg/coerce.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# COERCE -- Coerce a pointer from one datatype to another, choosing the
+# next larger element for t2 in the event that t1 is not aligned with t2.
+
+pointer procedure coerce (ptr, type1, type2)
+
+pointer	ptr				# input pointer
+int	type1, type2			# from, to data types
+int	n
+pointer	p
+include	<szdtype.inc>
+
+begin
+	p = ptr - 1
+	if (type1 == TY_CHAR)
+	    return (p / ty_size[type2] + 1)
+	else if (type2 == TY_CHAR)
+	    return (p * ty_size[type1] + 1)
+	else {
+	    p = p * ty_size[type1]				# ptr to char
+	    n = ty_size[type2]
+	    return (((p + n-1) / n) + 1)
+	}
+end
diff --git a/sys/memdbg/kmalloc.x b/sys/memdbg/kmalloc.x
new file mode 100644
index 00000000..39f21ae0
--- /dev/null
+++ b/sys/memdbg/kmalloc.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# KMALLOC -- Allocate space on the heap.  Equivalent to MALLOC, except that a
+# memory allocation failure is indicated by returning ERR as the function value.
+
+int procedure kmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	retaddr = zrtadr()
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align))
+end
diff --git a/sys/memdbg/krealloc.x b/sys/memdbg/krealloc.x
new file mode 100644
index 00000000..7d61b998
--- /dev/null
+++ b/sys/memdbg/krealloc.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<syserr.h>
+
+# KREALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.  This routine is equivalent to REALLOC except that it
+# merely returns ERR as the function value if an error occurs.
+# 
+# Buffer reallocation or resizing can always be implemented by allocating a new
+# buffer, copying the contents of the old buffer to the new buffer, and then
+# deleting the old buffer.  Nonetheless we use a OS entry point to do the actual
+# reallocation, because often it will be possible to change the size of a buffer
+# without moving it, particularly when decreasing the size of the buffer.
+# 
+# Allowing the OS to move a buffer causes problems due to the difference in
+# alignment criteria imposed by the IRAF pointer scheme, which enforces
+# stringent alignment criteria, versus OS memory allocation schemes which
+# typically only align on word or longword boundaries.  Therefore we must
+# check the offset of the data area after reallocation, possibly shifting
+# the contents of data area up or down a few chars to reestablish alignment
+# with Mem.
+
+int procedure krealloc (ptr, a_nelems, a_dtype)
+
+pointer	ptr			# buffer to be reallocated
+int	a_nelems		# new size of buffer
+int	a_dtype			# buffer datatype
+
+pointer	dataptr
+int	nelems, dtype, nchars, old_fwa, new_fwa
+int	char_shift, old_char_offset, new_char_offset
+int	status, locbuf, loc_Mem
+
+int	mgtfwa(), sizeof(), kmalloc()
+pointer	mgdptr(), msvfwa(), coerce()
+data	loc_Mem /NULL/
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	# Copy over the number of elements and the data type in case they are
+	# located in the block of memory we are reallocating.
+
+	nelems = a_nelems
+	dtype  = a_dtype
+
+	if (ptr == NULL) {
+	    return (kmalloc (ptr, nelems, dtype))
+
+	} else {
+	    if (dtype == TY_CHAR)
+		nchars = nelems + 1 + SZ_INT + SZ_MEMALIGN
+	    else
+		nchars = nelems * sizeof(dtype) + SZ_INT + SZ_MEMALIGN
+	    old_fwa = mgtfwa (ptr, dtype)
+	    new_fwa = old_fwa
+
+	    # Change the buffer size; any error is fatal.
+	    call zraloc (new_fwa, nchars * SZB_CHAR, status)
+	    if (status == ERR) {
+		ptr = NULL
+		return (ERR)
+	    }
+
+	    if (retaddr == 0)
+		retaddr = zrtadr()
+	    if (new_fwa != old_fwa) {
+		call zmemlg (old_fwa, retaddr, 'F', 1,
+		    "realloc frees old buf", 0, 0)
+		call zmemlg (new_fwa, retaddr, 'A', 1,
+		    "realloc allocs new buf", nelems * sizeof(dtype), 0)
+	    } else {
+		call zmemlg (old_fwa, retaddr, 'R', 1,
+		    "realloc %d", nelems * sizeof(dtype), 0)
+	    }
+	    retaddr = 0
+
+	    # Compute the char offset of the old data area within the original
+	    # buffer; zraloc() guarantees that the old data will have the same
+	    # offset in the new buffer.  Compute the char offset of the new
+	    # data area.  These need not be the same due to the OS allocating
+	    # the new buffer to alignment criteria less than those required
+	    # by MEMIO.
+
+	    call zlocva (Memc[coerce(ptr,dtype,TY_CHAR)], locbuf)
+	    old_char_offset = (locbuf - old_fwa)
+
+	    # We must compute a pointer to the data area within the new
+	    # buffer before we can compute the char offset of the new data
+	    # area within the new buffer.
+
+	    if (loc_Mem == NULL)
+		call zlocva (Memc, loc_Mem)
+
+	    dataptr = mgdptr (new_fwa, TY_CHAR, SZ_MEMALIGN, loc_Mem)
+	    call zlocva (Memc[dataptr], locbuf)
+	    new_char_offset = (locbuf - new_fwa)
+
+	    # Shift the old data to satisfy the new alignment criteria,
+	    # if necessary.
+
+	    char_shift = (new_char_offset - old_char_offset)
+	    if (char_shift != 0) {
+		call amovc (Memc[dataptr - char_shift], Memc[dataptr],
+		    nelems * sizeof(dtype))
+	    }
+
+	    # Save the fwa of the OS buffer in the buffer header, and return
+	    # new pointer to user.
+
+	    ptr = msvfwa (new_fwa, dtype, SZ_MEMALIGN, loc_Mem)
+	}
+
+	return (OK)
+end
diff --git a/sys/memdbg/malloc.x b/sys/memdbg/malloc.x
new file mode 100644
index 00000000..4e5affba
--- /dev/null
+++ b/sys/memdbg/malloc.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+# MALLOC -- Allocate space on the heap.  An array of at least NELEMS elements
+# of data type DTYPE is allocated, aligned to SZ_MEMALIGN (the biggest type)
+# with the global common Mem.
+
+procedure malloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+extern	kmalloc(), krealloc(), mfree(), realloc(), salloc(), vmalloc()
+int	first_time, locpr()
+
+int	sz_align, fwa_align
+int	malloc1()
+int	zrtadr()
+include	"memdbg.com"
+data	first_time /0/
+
+begin
+	# Reference the other MEMDEBUG routines to force them to be loaded.
+	if (first_time == 0) {
+	    retaddr = locpr (kmalloc)
+	    retaddr = locpr (krealloc)
+	    retaddr = locpr (mfree)
+	    retaddr = locpr (realloc)
+	    retaddr = locpr (salloc)
+	    retaddr = locpr (vmalloc)
+	    first_time = 1
+	}
+
+	retaddr = zrtadr()
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/memdbg/malloc1.x b/sys/memdbg/malloc1.x
new file mode 100644
index 00000000..02682a59
--- /dev/null
+++ b/sys/memdbg/malloc1.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help malloc1
+.nf -------------------------------------------------------------------------
+MEMIO -- Internal data structures.
+
+If "p" is the pointer returned by malloc, the first element of storage is
+referenced by the expression "Mem_[p]", where the underscore is replaced
+by the appropriate type suffix.  A pointer to an object of one data type
+is NOT equivalent to a pointer to another data type, even if both pointers
+reference the same physical address.
+
+The actual physical address of the physical buffer area allocated is stored
+in the integer cell immediately preceeding the buffer returned to the user.
+If this cell is corrupted, the condition will later be detected, and a fatal
+error ("memory corrupted") will result.
+
+For example, for a machine with a 4 byte integer, the first part of the
+buffer area might appear as follows (the first few unused cells may or
+may not be needed to satisfy the alignment criteria):
+
+      offset			allocation
+	
+	0		start of the physical buffer (from zmaloc)
+	1
+	2
+	3
+	4		byte 1 of saved fwa (address of cell 0)
+	5		byte 2	"   "    "
+	6		byte 3	"   "    "
+	7		byte 4	"   "    "
+	8		first cell available to user (maximum alignment)
+
+MALLOC, given the CHAR address of the buffer allocated by the z-routine,
+adds space for the saved fwa (an integer), and determines the address of the
+next cell which is sufficiently aligned, relative to the Mem common.  This
+cell marks the start of the user buffer area.  The buffer fwa is saved in the
+integer location immediately preceding the "first cell".
+
+MFREE, called with a pointer to the buffer to be returned, fetches the location
+of the physical buffer from the save area.  If this does not agree with the
+buffer pointer, either (1) the buffer pointer is invalid or of the wrong
+datatype, or (2), the save area has been overwritten (memory has been
+corrupted).  If everything checks out, the buffer fwa is passed to a z-routine
+to free the physical buffer space.
+
+TODO:	- Add debugging routine to summarize allocated buffer space and
+		check for buffer overruns (add sentinel at end of buffer).
+	- Keep track of buffers allocated while a program is running and
+		return at program termination, like closing open files.
+.endhelp ---------------------------------------------------------------------
+
+
+# MALLOC1 -- Low level procedure which does the actual buffer allocation.
+
+int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+int	sz_align		# number of chars of alignment required
+int	fwa_align		# address to which buffer is to be aligned
+
+int	fwa, nchars, status
+int	sizeof()
+pointer	msvfwa()
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	if (dtype == TY_CHAR)
+	    nchars = nelems + 1 + SZ_INT + sz_align	# add space for EOS
+	else
+	    nchars = nelems * sizeof (dtype) + SZ_INT + sz_align
+
+	call zmaloc (fwa, nchars * SZB_CHAR, status)
+
+	if (retaddr == 0)
+	    retaddr = zrtadr()
+	call zmemlg (fwa, retaddr, 'A', 1,
+	    "malloc %d type %d", nelems * sizeof(dtype), dtype)
+	retaddr = 0
+
+	if (status == ERR)
+	    return (ERR)
+	else {
+	    output_pointer = msvfwa (fwa, dtype, sz_align, fwa_align)
+	    return (OK)
+	}
+end
diff --git a/sys/memdbg/memdbg.com b/sys/memdbg/memdbg.com
new file mode 100644
index 00000000..f6688943
--- /dev/null
+++ b/sys/memdbg/memdbg.com
@@ -0,0 +1,4 @@
+# MEMDBG.COM -- Memory debug common.
+
+int	retaddr
+common	/memdbg/ retaddr
diff --git a/sys/memdbg/memlog.c b/sys/memdbg/memlog.c
new file mode 100644
index 00000000..c8e84281
--- /dev/null
+++ b/sys/memdbg/memlog.c
@@ -0,0 +1,175 @@
+#include <stdio.h>
+
+/* MEMLOG -- SPP callable routines for logging MEMIO debug messages and
+ * user application messages in sequence to the mem.log file.
+ *
+ *		 memlog (message)
+ *		memlog1 (message, arg1)
+ *		memlog2 (message, arg1, arg2)
+ *		memlogs (message, strarg)
+ *		 memlev (loglevel)
+ *
+ * Memlog logs a simple message string.  Memlog[12] allow one or two integer
+ * arguments.  Memlogs allows one string argument.
+ */
+
+#define	FNAME	"mem.log"
+#define	XCHAR	short
+
+static	FILE *fp = NULL;
+static	int loglevel = 3;
+static 	int number = 0;
+
+#define	LOG_MALLOC	0001
+#define	LOG_SALLOC	0002
+
+static void memput();
+
+
+/* MEMLOG -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlog_ (message)
+XCHAR	*message;
+{
+	register XCHAR *ip;
+	register char *op;
+	char	p_message[1024];
+
+	for (ip=message, op=p_message;  *op++ = *ip++;  )
+	    ;
+	memput (p_message);
+}
+
+
+/* MEMLEV -- Set the logging level.
+ */
+memlev_ (level)
+int	*level;
+{
+	loglevel = *level;
+}
+
+
+/* MEMLOG1 -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlo1_ (format, arg1)
+XCHAR	*format;
+int	*arg1;
+{
+	register XCHAR *ip;
+	register char *op;
+	char	p_format[1024];
+	char	message[1024];
+
+	/* Output user message. */
+	for (ip=format, op=p_format;  *op++ = *ip++;  )
+	    ;
+	sprintf (message, p_format, *arg1);
+	memput (message);
+}
+
+
+/* MEMLOG2 -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlo2_ (format, arg1, arg2)
+XCHAR	*format;
+int	*arg1;
+int	*arg2;
+{
+	register XCHAR *ip;
+	register char *op;
+	char	p_format[1024];
+	char	message[1024];
+
+	/* Output user message. */
+	for (ip=format, op=p_format;  *op++ = *ip++;  )
+	    ;
+	sprintf (message, p_format, *arg1, *arg2);
+	memput (message);
+}
+
+
+/* MEMLOGS -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlos_ (format, strarg)
+XCHAR	*format;
+XCHAR	*strarg;
+{
+	register XCHAR *ip;
+	register char *op;
+	char	p_format[1024];
+	char	p_strarg[1024];
+	char	message[1024];
+
+	/* Output user message. */
+	for (ip=format, op=p_format;  *op++ = *ip++;  )
+	    ;
+	for (ip=strarg, op=p_strarg;  *op++ = *ip++;  )
+	    ;
+	sprintf (message, p_format, p_strarg);
+	memput (message);
+}
+
+
+/* MEMPUT -- Log a message in sequence to the memio debug log file.
+ */
+static void
+memput (message)
+char	*message;
+{
+	/* Open logfile. */
+	if (fp == NULL) {
+	    unlink (FNAME);
+	    if ((fp = fopen (FNAME, "a")) == NULL)
+		return;
+	}
+
+	/* Output sequence number. */
+	fprintf (fp, "%10s  %08d %8s  - -  ",
+	    "------", number++, "------");
+
+	/* Output message. */
+	fprintf (fp, message);
+	fprintf (fp, "\n");
+
+	fflush (fp);
+}
+
+
+/* ZMEMLG -- Used internally by the MEMIO routines.
+ */
+zmemlg_ (addr, retaddr, action, class, format, arg1, arg2)
+int	*addr, *retaddr;
+int	*action, *class;
+XCHAR	*format;
+int	*arg1, *arg2;
+{
+	register XCHAR *ip;
+	register char *op;
+	char	p_format[1024];
+	char	s_action[2];
+
+	if (!(loglevel & *class))
+	    return;
+
+	for (ip=format, op=p_format;  *op++ = *ip++;  )
+	    ;
+	s_action[0] = *action;
+	s_action[1] = '\0';
+
+	if (fp == NULL) {
+	    unlink (FNAME);
+	    if ((fp = fopen (FNAME, "a")) == NULL)
+		return;
+	}
+
+	fprintf (fp, "%10x  %08d %8x  %s %d  ",
+	    *addr, number++, *retaddr, s_action, *class);
+	fprintf (fp, p_format, *arg1, *arg2);
+	fprintf (fp, "\n");
+	fflush (fp);
+}
diff --git a/sys/memdbg/mfree.x b/sys/memdbg/mfree.x
new file mode 100644
index 00000000..e3dbef97
--- /dev/null
+++ b/sys/memdbg/mfree.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# MFREE -- Free a previously allocated buffer.  If the buffer has already been
+# returned (NULL pointer), ignore the request.  Once the buffer has been
+# returned, the old pointer value is of not useful (and invalid), so set it
+# to NULL.
+
+procedure mfree (ptr, dtype)
+
+pointer	ptr
+int	fwa, dtype, status
+int	mgtfwa()
+errchk	mgtfwa
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	if (ptr != NULL) {
+	    fwa = mgtfwa (ptr, dtype)
+	    call zmemlg (fwa, zrtadr(), 'F', 1, "mfree", 0, 0)
+	    retaddr = 0
+
+	    call zmfree (fwa, status)
+	    if (status == ERR)
+		call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	    ptr = NULL
+	}
+end
diff --git a/sys/memdbg/mgdptr.x b/sys/memdbg/mgdptr.x
new file mode 100644
index 00000000..4c6cce22
--- /dev/null
+++ b/sys/memdbg/mgdptr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MGDPTR -- Given the fwa of a memory area, compute a pointer to the start
+# of the data area which satisfies the desired alignment criteria.  Memory
+# is allocated in units of chars, and ZLOCVA, ZMALOC, etc., return pointers
+# in units of chars.
+
+pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+long	bufadr
+pointer	bufptr
+int	modulus, loc_Mem
+int	sizeof()
+data	loc_Mem /NULL/
+
+begin
+	# Compute the address of the start of the user buffer area, which
+	# must be aligned with fwa_align (usually Mem) for all data types.
+
+	if (loc_Mem == NULL)
+	    call zlocva (Memc, loc_Mem)
+	bufadr = fwa + SZ_INT
+
+	modulus = mod (bufadr - fwa_align, sz_align)
+	if (modulus != 0)
+	    bufadr = bufadr + (sz_align - modulus)
+
+	# Compute the buffer pointer for the desired datatype.
+	bufptr = (bufadr - loc_Mem) / sizeof(dtype) + 1
+
+	return (bufptr)
+end
diff --git a/sys/memdbg/mgtfwa.x b/sys/memdbg/mgtfwa.x
new file mode 100644
index 00000000..9b39f6eb
--- /dev/null
+++ b/sys/memdbg/mgtfwa.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTFWA -- Given a user buffer pointer, retrieve physical address of buffer.
+# If physical address of buffer does not seem reasonable, memory has probably
+# been overwritten, a fatal error.
+
+int procedure mgtfwa (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	locbuf, fwa
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	fwa = Memi[bufptr-1]
+	call zlocva (Memi[bufptr-1], locbuf)
+
+	if (abs (locbuf - fwa) > SZ_VMEMALIGN)
+	    call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	return (fwa)
+end
diff --git a/sys/memdbg/mkpkg b/sys/memdbg/mkpkg
new file mode 100644
index 00000000..985d6bdf
--- /dev/null
+++ b/sys/memdbg/mkpkg
@@ -0,0 +1,27 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libmemdbg.a lib$
+$update   libmemdbg.a
+$checkin  libmemdbg.a lib$
+$exit
+
+libmemdbg.a:
+	zrtadr.c
+	memlog.c
+
+	begmem.x	<mach.h>
+	calloc.x	
+	coerce.x	<szdtype.inc>
+	kmalloc.x	memdbg.com <config.h>
+	krealloc.x	memdbg.com <config.h> <mach.h>
+	malloc.x	memdbg.com <config.h>
+	malloc1.x	memdbg.com <mach.h>
+	mfree.x		memdbg.com
+	mgdptr.x	
+	mgtfwa.x	<config.h> <mach.h>
+	msvfwa.x	
+	realloc.x	memdbg.com
+	salloc.x	memdbg.com <config.h> <szdtype.inc>
+	sizeof.x	<szdtype.inc>
+	vmalloc.x	memdbg.com <config.h> <mach.h>
+	;
diff --git a/sys/memdbg/msvfwa.x b/sys/memdbg/msvfwa.x
new file mode 100644
index 00000000..d5df074d
--- /dev/null
+++ b/sys/memdbg/msvfwa.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MSVFWA -- Determine the buffer address which satisfies the maximum alignment
+# criteria, save the buffer fwa in the integer cell immediately preceding
+# this, and return a pointer to the user area of the buffer.
+
+pointer procedure msvfwa (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+pointer	bufptr, mgdptr()
+int	coerce()
+
+begin
+	# Compute the pointer to the data area which satisfies the desired
+	# alignment criteria.  Store the fwa of the actual OS allocated buffer
+	# in the integer cell preceeding the data area.
+
+	bufptr = mgdptr (fwa, TY_INT, sz_align, fwa_align)
+	Memi[bufptr-1] = fwa
+
+	# Return pointer of type dtype to the first cell of the data area.
+	return (coerce (bufptr, TY_INT, dtype))
+end
diff --git a/sys/memdbg/realloc.x b/sys/memdbg/realloc.x
new file mode 100644
index 00000000..a3d1c866
--- /dev/null
+++ b/sys/memdbg/realloc.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# REALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.
+
+procedure realloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# buffer to be reallocated
+int	nelems			# new size of buffer
+int	dtype			# buffer datatype
+
+int	krealloc()
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	retaddr = zrtadr()
+	if (krealloc (ubufp, nelems, dtype) == ERR) {
+	    ubufp = NULL
+	    call syserr (SYS_MFULL)
+	}
+end
diff --git a/sys/memdbg/salloc.x b/sys/memdbg/salloc.x
new file mode 100644
index 00000000..7895b837
--- /dev/null
+++ b/sys/memdbg/salloc.x
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# SALLOC.X -- Stack management routines.  Stack storage is allocated in
+# segments.  Space for each segment is dynamically allocated on the heap.
+# Each segment contains a pointer to the previous segment to permit
+# reclamation of the space (see "Mem.hlp" for additional details).
+# This is a low level facility, hence any failure to allocate or deallocate
+# stack storage is fatal.
+
+
+# Segment header structure.  The header size parameter SZ_STKHDR is defined
+# in <config.h> because it is potentially machine dependent.  SZ_STKHDR
+# must be chosen such that the maximum alignment criteria is maintained.
+
+define	SH_BASE		Memi[$1]	# char pointer to base of segment
+define	SH_TOP		Memi[$1+1]	# char pointer to top of segment + 1
+define	SH_OLDSEG	Memi[$1+2]	# struct pointer to header of prev.seg.
+
+
+# SALLOC -- Allocate space on the stack.
+
+procedure salloc (output_pointer, nelem, datatype)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelem			# number of elements of storage required
+int	datatype		# datatype of the storage elements
+
+int	nchars, dtype
+include	<szdtype.inc>
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	dtype = datatype
+	if (dtype < 1 || dtype > MAX_DTYPE)
+	    call sys_panic (500, "salloc: bad datatype code")
+
+	# Align stack pointer for any data type.  Compute amount of
+	# storage to be allocated.  Always add space for at least one
+	# extra char for the EOS in case a string is stored in the buffer.
+
+	sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1
+	if (dtype == TY_CHAR)
+	    nchars = nelem + 1				# add space for EOS
+	else
+	    nchars = nelem * ty_size[dtype] + 1
+
+	# Check for stack overflow, add new segment if out of room.
+	# Since SMARK must be called before SALLOC, cur_seg cannot be
+	# null, but we check anyhow.
+
+	if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg))
+	    call stk_mkseg (cur_seg, sp, nchars)
+
+	if (dtype == TY_CHAR)
+	    output_pointer = sp
+	else
+	    output_pointer = (sp-1) / ty_size[dtype] + 1
+
+	sp = sp + nchars			# bump stack pointer
+end
+
+
+# SMARK -- Mark the position of the stack pointer, so that stack space
+# can be freed by a subsequent call to SFREE.  This routine also performs
+# initialization of the stack, since it the very first routine called
+# during task startup.
+
+procedure smark (old_sp)
+
+pointer	old_sp			# value of the stack pointer (output)
+bool	first_time
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+data	first_time /true/
+include	"memdbg.com"
+int	zrtadr()
+
+begin
+	if (first_time) {
+	    sp = NULL
+	    cur_seg = NULL
+	    call stk_mkseg (cur_seg, sp, SZ_STACK)
+	    first_time = false
+	}
+
+	call zmemlg (sp, zrtadr(), 'A', 2, "    smark", 0, 0)
+	retaddr = 0
+	old_sp = sp
+end
+
+
+# SFREE -- Free space on the stack.  Return whole segments until segment
+# containing the old stack pointer is reached.
+
+procedure sfree (old_sp)
+
+pointer	old_sp			# previous value of the stack pointer
+
+pointer	old_seg
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+include	"memdbg.com"
+int	zrtadr()
+
+begin
+	# The following is needed to avoid recursion when SFREE is called
+	# by the IRAF main during processing of SYS_MSSTKUNFL.
+
+	if (cur_seg == NULL)
+	    return
+	    
+	call zmemlg (old_sp, zrtadr(), 'F', 2, "    sfree", 0, 0)
+	retaddr = 0
+
+	# If the stack underflows (probably because of an invalid pointer)
+	# it is a fatal error.
+
+	while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) {
+	    if (SH_OLDSEG(cur_seg) == NULL)
+		call sys_panic (SYS_MSSTKUNFL, "Salloc underflow")
+
+	    old_seg = SH_OLDSEG(cur_seg)		# discard segment
+	    call mfree (cur_seg, TY_STRUCT)
+	    cur_seg = old_seg
+	}
+
+	sp = old_sp					# pop stack
+end
+
+
+# STK_MKSEG -- Create and add a new stack segment (link at head of the
+# segment list).  Called during initialization, and upon stack overflow.
+
+procedure stk_mkseg (cur_seg, sp, segment_size)
+
+pointer	cur_seg			# current segment
+pointer	sp			# salloc stack pointer
+int	segment_size		# size of new stack segment
+
+int	nchars, new_seg
+pointer	coerce() 
+int	kmalloc()
+
+begin
+	# Compute size of new segment, allocate the buffer.
+	nchars = max (SZ_STACK, segment_size) + SZ_STKHDR
+	if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR)
+	    call sys_panic (SYS_MFULL, "Out of memory")
+
+	# Output new stack pointer.
+	sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR
+
+	# Set up the segment descriptor.
+	SH_BASE(new_seg) = sp
+	SH_TOP(new_seg) = sp - SZ_STKHDR + nchars
+	SH_OLDSEG(new_seg) = cur_seg
+
+	# Make new segment the current segment.
+	cur_seg = new_seg
+end
diff --git a/sys/memdbg/sizeof.x b/sys/memdbg/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/memdbg/sizeof.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SIZEOF -- Return the size in chars of one of the fundamental datatypes.
+
+int procedure sizeof (dtype)
+
+int	dtype
+include	<szdtype.inc>
+
+begin
+	return (ty_size[dtype])
+end
diff --git a/sys/memdbg/vmalloc.x b/sys/memdbg/vmalloc.x
new file mode 100644
index 00000000..5b1dc7d0
--- /dev/null
+++ b/sys/memdbg/vmalloc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# VMALLOC -- Like malloc, but force the buffer to be aligned on a virtual
+# memory page boundary.  This feature can be used, e.g., in 4.XBSD UNIX
+# to "bypass" the system buffer cache (to avoid copying file data from the
+# system cache into the file buffer).  VMALLOC can be made equivalent to MALLOC
+# via the parameters in <config.h>, if the local machine which does not have
+# virtual memory.
+
+procedure vmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+int	zrtadr()
+include	"memdbg.com"
+
+begin
+	retaddr = zrtadr()
+	sz_align = SZ_VMEMALIGN
+	fwa_align = VMEM_BASE
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/memdbg/zrtadr.c b/sys/memdbg/zrtadr.c
new file mode 100644
index 00000000..7bf9dc2f
--- /dev/null
+++ b/sys/memdbg/zrtadr.c
@@ -0,0 +1,14 @@
+/* ZRTADR -- Return the program address from which the routine calling zrtadr
+ * was called.  If zrtadr is called in procedure B and B is called from
+ * procedure A, the address returned by zrtadr will be the address in A
+ * following the call to procedure B.  This can be used to determine which
+ * procedure called B.
+ *
+ * This is a portable stub for the actual routine, which is machine dependent
+ * and normally written in assembler.
+ */
+
+zrtadr_()
+{
+	return (0);
+}
diff --git a/sys/memdbg/zzdebug.x b/sys/memdbg/zzdebug.x
new file mode 100644
index 00000000..57fb1874
--- /dev/null
+++ b/sys/memdbg/zzdebug.x
@@ -0,0 +1,190 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# ZZDEBUG.X -- Debug MEMIO.
+
+task	memchk	= t_memchk,
+	stack	= t_stack,
+	realloc	= t_realloc
+
+
+# MEMCHK -- Scan the mem.log output produced by the debug version of MEMIO
+# (this must be sorted first) and check for memory which is allocated but
+# never freed.
+
+procedure t_memchk()
+
+int	fd, ip
+bool	passall, mark
+int	addr, retaddr, seqno, action, class
+int	old_addr, old_seqno, old_action
+char	lbuf[SZ_LINE], old_lbuf[SZ_LINE]
+char	descr[SZ_LINE], old_descr[SZ_LINE]
+char	tokbuf[SZ_FNAME], fname[SZ_FNAME]
+
+bool	clgetb()
+int	open(), getline(), nscan(), gctol()
+define	print_ 91
+
+begin
+	call clgstr ("fname", fname, SZ_FNAME)
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	passall = clgetb ("passall")
+	old_addr = 0
+	old_action = 0
+
+	while (getline (fd, lbuf) != EOF) {
+	    # Scan next line.
+	    call sscan (lbuf)
+	    call gargwrd (tokbuf, SZ_FNAME)
+		ip = 1;  ip = gctol (tokbuf, ip, addr, 16)
+	    call gargi (seqno)
+	    call gargwrd (tokbuf, SZ_FNAME)
+		ip = 1;  ip = gctol (tokbuf, ip, retaddr, 16)
+	    call gargwrd (tokbuf, SZ_FNAME)
+		action = tokbuf[1]
+	    call gargi (class)
+	    call gargstr (descr, SZ_LINE)
+
+	    if (nscan() < 4) {
+		if (passall)
+		    call putline (STDOUT, lbuf)
+		next
+	    }
+
+	    if (addr != old_addr) {
+		# Starting a log for a new buffer address.
+		if (old_lbuf[1] != EOS) {
+		    if (IS_ALPHA(old_action) && old_action != 'F') {
+			ip = 1
+			while (old_lbuf[ip] != '\n' && old_lbuf[ip] != EOS)
+			    ip = ip + 1
+			old_lbuf[ip] = EOS
+			call printf ("%s %70t####\n")
+			    call pargstr (old_lbuf)
+
+		    } else if (passall)
+			call putline (STDOUT, old_lbuf)
+		}
+
+	    } else {
+		# Verify operation on a particular buffer address.
+
+		if (old_lbuf[1] != EOS && passall)
+		    call putline (STDOUT, old_lbuf)
+
+		mark = false
+		if (IS_ALPHA(action) && class == 1) 
+		    switch (old_action) {
+		    case 'A', 'R':
+			if (action != 'R' && action != 'F')
+			    mark = true
+		    case 'F':
+			if (action != 'A')
+			    mark = true
+		    }
+
+		if (mark) {
+		    ip = 1
+		    while (lbuf[ip] != '\n' && lbuf[ip] != EOS)
+			ip = ip + 1
+		    lbuf[ip] = EOS
+		    call printf ("%s %70t####\n")
+			call pargstr (lbuf)
+		    lbuf[1] = EOS
+		}
+	    }
+
+	    old_addr = addr
+	    old_seqno = seqno
+	    old_action = action
+	    call strcpy (descr, old_descr, SZ_LINE)
+	    call strcpy (lbuf, old_lbuf, SZ_LINE)
+	}
+
+	if (old_lbuf[1] != EOS && passall)
+	    call putline (STDOUT, old_lbuf)
+end
+
+
+# STACK -- Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# REALLOC -- Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	sza, new_sza, szb, new_szb
+int	clgeti()
+
+begin
+	call malloc (a, SZ_LINE, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	sza = SZ_LINE
+	call malloc (b, SZ_LINE, TY_CHAR)
+	call strcpy ("0123456789", Memc[b], ARB)
+	szb = SZ_LINE
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	repeat {
+	    new_sza = clgeti ("a_bufsize")
+	    if (new_sza == 0)
+		return
+	    call x_realloc (a, new_sza, TY_CHAR)
+	    new_szb = clgeti ("b_bufsize")
+	    if (new_szb == 0)
+		return
+	    call x_realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("a buf %d, size %d --> %d: %s\n")
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("b buf %d, size %d --> %d: %s\n")
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
diff --git a/sys/memio/README b/sys/memio/README
new file mode 100644
index 00000000..597f1114
--- /dev/null
+++ b/sys/memio/README
@@ -0,0 +1 @@
+MEMIO -- Memory allocation and management facilities.
diff --git a/sys/memio/begmem.x b/sys/memio/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/memio/begmem.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help begmem, fixmem
+.nf ___________________________________________________________________________
+BEGMEM, FIXMEM -- Try to get/release physical memory for a process.  The
+actual amount of physical memory available (in chars) is returned.  On a
+machine with virtual memory, these routines adjust the working set size.
+
+On any machine, BEGMEM may be used to determine the amount of available
+physical memory, to tune algorithms for optimum performance.  BEGMEM returns
+as its function value the actual working set size of the process after
+the adjustment (or the current working set size if "best_size" is zero).
+On some systems this represents a soft limit on the actual amount of memory
+which can be used; it is a guarantee that at least that much space is
+available.  Some systems will allow the actual working set to dynamically
+exceed this value at runtime if the process pages heavily.  The hard limit
+on the working set of a process is given by the "max_size" parameter.
+
+Note that the working set must include space not only for a task specific
+data buffers, but also for all other process data buffers and for the text
+(instruction space) of the code being executed.  There is no easy way to
+determine this, hence the application is expected to estimate it.  A typical
+value for the base text+data size required to execute a program is 150Kb.
+.endhelp ______________________________________________________________________
+
+
+# BEGMEM -- Attempt to the adjust the amount of physical memory allocated
+# to a process.  Save the old memory size in OLD_SIZE, so that memory may
+# later be restored with FIXMEM.  The new working set size is returned as
+# the function value and the hard limit on the working set size is returned
+# in MAX_SIZE.  In general, the process can be expected to page, possibly
+# heavily, or swap out if the working set size is exceeded.  All sizes are
+# returned in SPP chars.  If BEST_SIZE is zero the working set size is not
+# changed, i.e., the current working set parameters are returned.
+
+int procedure begmem (best_size, old_size, max_size)
+
+int	best_size		# desired working set size
+int	old_size		# former working set size
+int	max_size		# max physical memory available to this process
+
+int	new_size
+
+begin
+	call zawset (best_size * SZB_CHAR, new_size, old_size, max_size)
+	new_size = new_size / SZB_CHAR
+	old_size = old_size / SZB_CHAR
+	max_size = max_size / SZB_CHAR
+
+	return (new_size)
+end
+
+
+# FIXMEM -- Restore the original working set size.
+
+procedure fixmem (old_size)
+
+int	old_size
+int	j1, j2, j3
+
+begin
+	call zawset (old_size * SZB_CHAR, j1, j2, j3)
+end
diff --git a/sys/memio/calloc.x b/sys/memio/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/memio/calloc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CALLOC -- Allocate and zero a block of memory.
+
+procedure calloc (ubufp, buflen, dtype)
+
+pointer	ubufp			# user buffer pointer [OUTPUT]
+int	buflen			# nelements of space required,
+int	dtype		# of this data type
+
+pointer	char_ptr
+pointer	coerce()
+int	sizeof()
+errchk	malloc
+
+begin
+	call malloc (ubufp, buflen, dtype)
+	char_ptr = coerce (ubufp, dtype, TY_CHAR)
+	call aclrc (Memc[char_ptr], buflen * sizeof (dtype))
+end
diff --git a/sys/memio/coerce.x b/sys/memio/coerce.x
new file mode 100644
index 00000000..7d42f3bf
--- /dev/null
+++ b/sys/memio/coerce.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# COERCE -- Coerce a pointer from one datatype to another, choosing the
+# next larger element for t2 in the event that t1 is not aligned with t2.
+
+pointer procedure coerce (ptr, type1, type2)
+
+pointer	ptr				# input pointer
+int	type1, type2			# from, to data types
+int	n
+pointer	p
+include	<szdtype.inc>
+
+begin
+	p = ptr - 1
+	if (type1 == TY_CHAR)
+	    return (p / ty_size[type2] + 1)
+	else if (type2 == TY_CHAR)
+	    return (p * ty_size[type1] + 1)
+	else {
+	    p = p * ty_size[type1]				# ptr to char
+	    n = ty_size[type2]
+	    return (((p + n-1) / n) + 1)
+	}
+end
diff --git a/sys/memio/doc/memio.hlp b/sys/memio/doc/memio.hlp
new file mode 100644
index 00000000..1bc5c0a0
--- /dev/null
+++ b/sys/memio/doc/memio.hlp
@@ -0,0 +1,308 @@
+.help memio Feb83 "Dynamic Memory Management Routines"
+.sh
+Introduction
+
+    The memory management routines manage both a stack and a heap.
+Storage for the stack may be fragmented, and chunks of stack storage are
+allocated dynamically from the heap as needed.  Programs may allocate
+heap storage directly if desired, for large or semipermanent buffers.
+Stack storage is intended for use with small buffers, where the overhead
+of allocating and deallocating space must be kept to a minimum.
+
+
+.ks
+.nf
+heap routines:
+
+	malloc  (ptr, number_of_elements, data_type)
+	calloc  (ptr, number_of_elements, data_type)
+	realloc (ptr, number_of_elements, data_type)
+	mfree   (ptr, data_type)
+
+
+stack routines:
+
+	salloc  (ptr, number_of_elements, data_type)
+	smark   (ptr)
+	sfree   (ptr)
+.fi
+.ke
+
+
+MALLOC allocates space on the heap.  CALLOC does the same, and fills the buffer
+with zeroes.  REALLOC is used to change the size of a previously allocated
+buffer, copying the contents of the buffer if necessary.  MFREE frees space
+allocated by a prior call to MALLOC, CALLOC, or REALLOC.
+
+Space is allocated on the stack with SALLOC.  SMARK should be called before
+SALLOC, to mark the position of the stack pointer.  SFREE returns all space
+allocated on the stack since the matching call to SMARK.
+
+
+.KS
+Example:
+.nf
+	pointer	buf, sp
+
+	begin
+		call smark (sp)
+		call salloc (buf, SZ_BUF, TY_CHAR)
+		while (getline (fd, Memc[buf]) != EOF) {
+		    (code to use buffer ...)
+		}
+		call sfree (sp)
+.fi
+.KE
+
+
+These routines will generate an error abort if memory cannot be allocated
+for some reason.
+
+.sh
+Heap Management
+
+    Since many operating systems provide heap management facilities,
+MALLOC and MFREE consist of little more than calls to Z routines to
+allocate and free blocks of memory.  The main function of MALLOC is
+to convert the physical buffer address returned by the Z routine into
+a pointer of the requested type.
+
+The pointer returned to the calling routine does not point at the beginning
+of the physical buffer, but at a location a few bytes into the buffer.
+The physical address of the buffer is stored in the buffer, immediately
+before the cell pointed to by the pointer returned by MALLOC.  The
+stored address must be intact when MFREE is later called to deallocate
+the buffer, or a "Memory corrupted" error diagnostic will result.
+
+The Z routines required to manage the heap are the following:
+
+.KS
+.nf
+	 zmget (bufadr, nbytes)
+	zmrget (bufadr, nbytes)
+	zmfree (buf_addr)
+.fi
+.KE
+
+The "get" routines should return NULL as the buffer address if space
+cannot be allocated for some reason.
+
+.sh
+Stack Management
+
+    The heap management routines have quite a bit of overhead associated
+with them, which precludes their use in certain applications.  In addition,
+the heap can be most efficiently managed when it contains few buffers.
+The stack provides an efficient mechanism for parceling out small amounts
+of storage, which can later all be freed with a single call.
+
+The main use of the stack is to provide automatic storage for local 
+arrays in procedures.  The preprocessor compiles code which makes calls
+to the stack management routines whenever an array is declared with the
+storage calls AUTO, or whenever the ALLOC statement is used in a procedure.
+
+
+.KS
+.nf
+	auto	char lbuf[SZ_LINE]
+	real	x[n], y[n]
+	int	n
+
+	begin
+		alloc (x[npix], y[npix])
+
+		while (getline (fd, lbuf) != EOF) {
+		    ...
+.fi
+.KE
+
+
+The AUTO storage class and the ALLOC statement are provided in the full
+preprocessor, but not in the subset preprocessor.  The following subset
+preprocessor code is functionally equivalent to the code show above:
+
+
+.KS
+.nf
+	pointer	lbuf, x, y, sp
+	int	n, getline()
+
+	begin
+		call smark (sp)
+		call salloc (lbuf, SZ_LINE, TY_CHAR)
+		n = npix
+		call salloc (x, n, TY_REAL)
+		call salloc (y, n, TY_REAL)
+
+		while (getline (fd, Memc[lbuf]) != EOF) {
+		    ...
+
+		call sfree (sp)
+.fi
+.KE
+
+.sh
+Semicode for Stack Management
+
+    At any given time, the "stack" is a contiguous buffer of a certain size.
+Stack overflow is handled by calling MALLOC to allocate another stack segment.
+A pointer to the previous stack segment is kept in each new stack segment,
+to permit reclamation of stack space.
+
+
+
+
+.KS
+.nf
+		salloc             smark              sfree
+
+
+
+	    stack_overflow 
+
+
+	
+		malloc            realloc             mfree
+
+
+
+		zmget              zmrget             zmfree
+
+
+
+		Structure of the Memory Management Routines
+.fi
+.KE
+
+
+
+
+.tp 5
+.nf
+procedure salloc (bufptr, nelements, data_type)
+
+bufptr:		upon output, contains pointer to the allocated space
+nelements:	number of elements of space to be allocated
+data_type:	data type of the elements and of the buffer pointer
+
+begin
+	# align stack pointer for the specified data type,
+	# compute amount of storage to be allocated
+
+	if (data_type == TY_CHAR)
+	    nchars = nelements
+	else {
+	    sp = sp + mod (sp-1, sizeof(data_type))
+	    nchars = nelements * sizeof(data_type)
+	}
+
+	if (sp + nchars > stack_top)		# see if room
+	    call stack_overflow (nchars)
+
+	if (data_type == TY_CHAR)		# return pointer
+	    bufptr = sp
+	else
+	    bufptr = (sp-1) / sizeof(data_type) + 1
+
+	sp = sp + nchars			# bump stack ptr
+	return
+end
+
+
+
+
+.tp 5
+procedure sfree (old_sp)			# pop the stack
+
+begin
+	# return entire segments until segment containing the old
+	# stack pointer is reached
+
+	while (old_sp < stack_base || old_sp > stack_top) {
+	    if (this is the first stack segment)
+		fatal error, invalid value for old_sp
+	    stack_base = old_segment.stack_base
+	    stack_top = old_segment.stack_top
+	    mfree (segment_pointer, TY_CHAR)
+	    segment_pointer = old_segment
+	}
+
+	sp = old_sp
+end
+
+
+
+
+.tp 5
+procedure smark (old_sp)			# save stack pointer
+
+begin
+	old_sp = sp
+end
+
+
+
+
+.tp 5
+procedure stack_overflow (nchars_needed)	# increase stk size
+
+begin
+	# allocate storage for new segment
+	segment_size = max (SZ_STACK, nchars_needed + SZ_STKHDR)
+	malloc (new_segment, segment_size, TY_CHAR)
+
+	# initialize header for the new segment
+	new_segment.old_segment = segment_pointer
+	new_segment.stack_base = new_segment + SZ_STKHDR
+	new_segment.stack_top = new_segment + segment_size
+
+	# make new segment the current segment
+	segment_pointer = new_segment
+	stack_base = new_segment.stack_base
+	stack_top = new_segment.stack_top
+	sp = stack_base
+end
+
+
+.fi
+The segment header contains fields describing the location and size of
+the segment, plus a link pointer to the previous segment in the list.
+
+
+.KS
+.nf
+	struct stack_header {
+		char	*stack_base
+		char	*stack_top
+		struct	stack_header *old_segment
+	}
+.fi
+.KE
+
+.sh
+Pointers and Addresses
+
+    Pointers are indices into (one indexed) Fortran arrays.  A pointer to
+an object of one datatype will in general have a different value than a
+pointer to an object of a different datatype, even if the objects are stored
+at the same physical address.  Pointers have strict alignment requirements,
+and it is not always possible to coerce the type of a pointer.  For this
+reason, the pointers returned by MALLOC and SALLOC are always aligned for
+all data types, regardless of the data type requested.
+
+The IRAF system code must occasionally manipulate and store true physical
+addresses, obtained with the function LOC.  The problem with physical
+addresses is that they are unsigned integers, but Fortran does not provide
+any unsigned data types.  Thus, comparisons of addresses are difficult
+in Fortran.
+
+A second LOC primitive is provided for use in routines which must compare
+addresses.  LOCC returns the address of the object passed as argument,
+right shifted to the size of a CHAR.  Thus, the difference between LOCC(a[1])
+and LOCC(a[n]) is the size of the N element array A in chars.
+
+The relationship between chars, bytes, and machine addresses is machine
+dependent.  Bytes seem to be the smallest units.  Some machines are byte
+addressable, others are word addressable.  The size of a CHAR in machine
+bytes is given by the constant SZB_CHAR.  The size of a machine word in
+machine bytes is given by the constant SZB_WORD.
diff --git a/sys/memio/kmalloc.x b/sys/memio/kmalloc.x
new file mode 100644
index 00000000..7bfc4ee0
--- /dev/null
+++ b/sys/memio/kmalloc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# KMALLOC -- Allocate space on the heap.  Equivalent to MALLOC, except that a
+# memory allocation failure is indicated by returning ERR as the function value.
+
+int procedure kmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align))
+end
diff --git a/sys/memio/krealloc.x b/sys/memio/krealloc.x
new file mode 100644
index 00000000..5c6198c8
--- /dev/null
+++ b/sys/memio/krealloc.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<syserr.h>
+
+# KREALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.  This routine is equivalent to REALLOC except that it
+# merely returns ERR as the function value if an error occurs.
+# 
+# Buffer reallocation or resizing can always be implemented by allocating a new
+# buffer, copying the contents of the old buffer to the new buffer, and then
+# deleting the old buffer.  Nonetheless we use a OS entry point to do the actual
+# reallocation, because often it will be possible to change the size of a buffer
+# without moving it, particularly when decreasing the size of the buffer.
+# 
+# Allowing the OS to move a buffer causes problems due to the difference in
+# alignment criteria imposed by the IRAF pointer scheme, which enforces
+# stringent alignment criteria, versus OS memory allocation schemes which
+# typically only align on word or longword boundaries.  Therefore we must
+# check the offset of the data area after reallocation, possibly shifting
+# the contents of data area up or down a few chars to reestablish alignment
+# with Mem.
+
+int procedure krealloc (ptr, a_nelems, a_dtype)
+
+pointer	ptr			# buffer to be reallocated
+int	a_nelems		# new size of buffer
+int	a_dtype			# buffer datatype
+
+pointer	dataptr
+int	nelems, dtype, nchars, old_fwa, new_fwa
+int	char_shift, old_char_offset, new_char_offset
+int	status, locbuf, loc_Mem
+
+int	mgtfwa(), sizeof(), kmalloc()
+pointer	mgdptr(), msvfwa(), coerce()
+data	loc_Mem /NULL/
+
+begin
+	# Copy over the number of elements and the data type in case they are
+	# located in the block of memory we are reallocating.
+
+	nelems = a_nelems
+	dtype  = a_dtype
+
+	if (ptr == NULL) {
+	    return (kmalloc (ptr, nelems, dtype))
+
+	} else {
+	    if (dtype == TY_CHAR)
+		nchars = nelems + 1 + SZ_INT + SZ_MEMALIGN
+	    else
+		nchars = nelems * sizeof(dtype) + SZ_INT + SZ_MEMALIGN
+	    old_fwa = mgtfwa (ptr, dtype)
+	    new_fwa = old_fwa
+
+	    # Change the buffer size; any error is fatal.
+	    call zraloc (new_fwa, nchars * SZB_CHAR, status)
+	    if (status == ERR) {
+		ptr = NULL
+		return (ERR)
+	    }
+
+	    # Compute the char offset of the old data area within the original
+	    # buffer; zraloc() guarantees that the old data will have the same
+	    # offset in the new buffer.  Compute the char offset of the new
+	    # data area.  These need not be the same due to the OS allocating
+	    # the new buffer to alignment criteria less than those required
+	    # by MEMIO.
+
+	    call zlocva (Memc[coerce(ptr,dtype,TY_CHAR)], locbuf)
+	    old_char_offset = (locbuf - old_fwa)
+
+	    # We must compute a pointer to the data area within the new
+	    # buffer before we can compute the char offset of the new data
+	    # area within the new buffer.
+
+	    if (loc_Mem == NULL)
+		call zlocva (Memc, loc_Mem)
+
+	    dataptr = mgdptr (new_fwa, TY_CHAR, SZ_MEMALIGN, loc_Mem)
+	    call zlocva (Memc[dataptr], locbuf)
+	    new_char_offset = (locbuf - new_fwa)
+
+	    # Shift the old data to satisfy the new alignment criteria,
+	    # if necessary.
+
+	    char_shift = (new_char_offset - old_char_offset)
+	    if (char_shift != 0) {
+		call amovc (Memc[dataptr - char_shift], Memc[dataptr],
+		    nelems * sizeof(dtype))
+	    }
+
+	    # Save the fwa of the OS buffer in the buffer header, and return
+	    # new pointer to user.
+
+	    ptr = msvfwa (new_fwa, dtype, SZ_MEMALIGN, loc_Mem)
+	}
+
+	return (OK)
+end
diff --git a/sys/memio/malloc.x b/sys/memio/malloc.x
new file mode 100644
index 00000000..d5886c36
--- /dev/null
+++ b/sys/memio/malloc.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+# MALLOC -- Allocate space on the heap.  An array of at least NELEMS elements
+# of data type DTYPE is allocated, aligned to SZ_MEMALIGN (the biggest type)
+# with the global common Mem.
+
+procedure malloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/memio/malloc1.x b/sys/memio/malloc1.x
new file mode 100644
index 00000000..33001ff1
--- /dev/null
+++ b/sys/memio/malloc1.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help malloc1
+.nf -------------------------------------------------------------------------
+MEMIO -- Internal data structures.
+
+If "p" is the pointer returned by malloc, the first element of storage is
+referenced by the expression "Mem_[p]", where the underscore is replaced
+by the appropriate type suffix.  A pointer to an object of one data type
+is NOT equivalent to a pointer to another data type, even if both pointers
+reference the same physical address.
+
+The actual physical address of the physical buffer area allocated is stored
+in the integer cell immediately preceeding the buffer returned to the user.
+If this cell is corrupted, the condition will later be detected, and a fatal
+error ("memory corrupted") will result.
+
+For example, for a machine with a 4 byte integer, the first part of the
+buffer area might appear as follows (the first few unused cells may or
+may not be needed to satisfy the alignment criteria):
+
+      offset			allocation
+	
+	0		start of the physical buffer (from zmaloc)
+	1
+	2
+	3
+	4		byte 1 of saved fwa (address of cell 0)
+	5		byte 2	"   "    "
+	6		byte 3	"   "    "
+	7		byte 4	"   "    "
+	8		first cell available to user (maximum alignment)
+
+MALLOC, given the CHAR address of the buffer allocated by the z-routine,
+adds space for the saved fwa (an integer), and determines the address of the
+next cell which is sufficiently aligned, relative to the Mem common.  This
+cell marks the start of the user buffer area.  The buffer fwa is saved in the
+integer location immediately preceding the "first cell".
+
+MFREE, called with a pointer to the buffer to be returned, fetches the location
+of the physical buffer from the save area.  If this does not agree with the
+buffer pointer, either (1) the buffer pointer is invalid or of the wrong
+datatype, or (2), the save area has been overwritten (memory has been
+corrupted).  If everything checks out, the buffer fwa is passed to a z-routine
+to free the physical buffer space.
+
+TODO:	- Add debugging routine to summarize allocated buffer space and
+		check for buffer overruns (add sentinel at end of buffer).
+	- Keep track of buffers allocated while a program is running and
+		return at program termination, like closing open files.
+.endhelp ---------------------------------------------------------------------
+
+
+# MALLOC1 -- Low level procedure which does the actual buffer allocation.
+
+int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+int	sz_align		# number of chars of alignment required
+int	fwa_align		# address to which buffer is to be aligned
+
+int	fwa, nchars, status
+int	sizeof()
+pointer	msvfwa()
+
+begin
+	if (dtype == TY_CHAR)
+	    nchars = nelems + 1 + SZ_INT + sz_align	# add space for EOS
+	else
+	    nchars = nelems * sizeof (dtype) + SZ_INT + sz_align
+
+	call zmaloc (fwa, nchars * SZB_CHAR, status)
+
+	if (status == ERR)
+	    return (ERR)
+	else {
+	    output_pointer = msvfwa (fwa, dtype, sz_align, fwa_align)
+	    return (OK)
+	}
+end
diff --git a/sys/memio/mfree.x b/sys/memio/mfree.x
new file mode 100644
index 00000000..f7c83f1d
--- /dev/null
+++ b/sys/memio/mfree.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# MFREE -- Free a previously allocated buffer.  If the buffer has already been
+# returned (NULL pointer), ignore the request.  Once the buffer has been
+# returned, the old pointer value is of not useful (and invalid), so set it
+# to NULL.
+
+procedure mfree (ptr, dtype)
+
+pointer	ptr
+int	fwa, dtype, status
+int	mgtfwa()
+errchk	mgtfwa
+
+begin
+	if (ptr != NULL) {
+	    fwa = mgtfwa (ptr, dtype)
+
+	    call zmfree (fwa, status)
+	    if (status == ERR)
+		call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	    ptr = NULL
+	}
+end
diff --git a/sys/memio/mgdptr.x b/sys/memio/mgdptr.x
new file mode 100644
index 00000000..4efc628c
--- /dev/null
+++ b/sys/memio/mgdptr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MGDPTR -- Given the fwa of a memory area, compute a pointer to the start
+# of the data area which satisfies the desired alignment criteria.  Memory
+# is allocated in units of chars, and ZLOCVA, ZMALOC, etc., return pointers
+# in units of chars.
+
+pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+#long	bufadr
+int	bufadr
+pointer	bufptr
+int	modulus, loc_Mem
+int	sizeof()
+data	loc_Mem /NULL/
+
+begin
+	# Compute the address of the start of the user buffer area, which
+	# must be aligned with fwa_align (usually Mem) for all data types.
+
+	if (loc_Mem == NULL)
+	    call zlocva (Memc, loc_Mem)
+	bufadr = fwa + SZ_INT
+
+	modulus = mod (bufadr - fwa_align, sz_align)
+	if (modulus != 0)
+	    bufadr = bufadr + (sz_align - modulus)
+
+	# Compute the buffer pointer for the desired datatype.
+	bufptr = (bufadr - loc_Mem) / sizeof(dtype) + 1
+
+	return (bufptr)
+end
diff --git a/sys/memio/mgtfwa.x b/sys/memio/mgtfwa.x
new file mode 100644
index 00000000..9b39f6eb
--- /dev/null
+++ b/sys/memio/mgtfwa.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTFWA -- Given a user buffer pointer, retrieve physical address of buffer.
+# If physical address of buffer does not seem reasonable, memory has probably
+# been overwritten, a fatal error.
+
+int procedure mgtfwa (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	locbuf, fwa
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	fwa = Memi[bufptr-1]
+	call zlocva (Memi[bufptr-1], locbuf)
+
+	if (abs (locbuf - fwa) > SZ_VMEMALIGN)
+	    call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	return (fwa)
+end
diff --git a/sys/memio/mkpkg b/sys/memio/mkpkg
new file mode 100644
index 00000000..c9c86f23
--- /dev/null
+++ b/sys/memio/mkpkg
@@ -0,0 +1,24 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	begmem.x	<mach.h>
+	calloc.x	
+	coerce.x	<szdtype.inc>
+	kmalloc.x	<config.h>
+	krealloc.x	<config.h> <mach.h>
+	malloc.x	<config.h>
+	malloc1.x	<mach.h>
+	mfree.x	
+	mgdptr.x	
+	mgtfwa.x	<config.h> <mach.h>
+	msvfwa.x	
+	realloc.x	
+	salloc.x	<config.h> <szdtype.inc>
+	sizeof.x	<szdtype.inc>
+	vmalloc.x	<config.h> <mach.h>
+	;
diff --git a/sys/memio/msvfwa.x b/sys/memio/msvfwa.x
new file mode 100644
index 00000000..d5df074d
--- /dev/null
+++ b/sys/memio/msvfwa.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MSVFWA -- Determine the buffer address which satisfies the maximum alignment
+# criteria, save the buffer fwa in the integer cell immediately preceding
+# this, and return a pointer to the user area of the buffer.
+
+pointer procedure msvfwa (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+pointer	bufptr, mgdptr()
+int	coerce()
+
+begin
+	# Compute the pointer to the data area which satisfies the desired
+	# alignment criteria.  Store the fwa of the actual OS allocated buffer
+	# in the integer cell preceeding the data area.
+
+	bufptr = mgdptr (fwa, TY_INT, sz_align, fwa_align)
+	Memi[bufptr-1] = fwa
+
+	# Return pointer of type dtype to the first cell of the data area.
+	return (coerce (bufptr, TY_INT, dtype))
+end
diff --git a/sys/memio/realloc.x b/sys/memio/realloc.x
new file mode 100644
index 00000000..40229b8f
--- /dev/null
+++ b/sys/memio/realloc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# REALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.
+
+procedure realloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# buffer to be reallocated
+int	nelems			# new size of buffer
+int	dtype			# buffer datatype
+
+int	krealloc()
+
+begin
+	if (krealloc (ubufp, nelems, dtype) == ERR) {
+	    ubufp = NULL
+	    call syserr (SYS_MFULL)
+	}
+end
diff --git a/sys/memio/salloc.x b/sys/memio/salloc.x
new file mode 100644
index 00000000..34f06217
--- /dev/null
+++ b/sys/memio/salloc.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# SALLOC.X -- Stack management routines.  Stack storage is allocated in
+# segments.  Space for each segment is dynamically allocated on the heap.
+# Each segment contains a pointer to the previous segment to permit
+# reclamation of the space (see "Mem.hlp" for additional details).
+# This is a low level facility, hence any failure to allocate or deallocate
+# stack storage is fatal.
+
+
+# Segment header structure.  The header size parameter SZ_STKHDR is defined
+# in <config.h> because it is potentially machine dependent.  SZ_STKHDR
+# must be chosen such that the maximum alignment criteria is maintained.
+
+define	SH_BASE		Memi[$1]	# char pointer to base of segment
+define	SH_TOP		Memi[$1+1]	# char pointer to top of segment + 1
+define	SH_OLDSEG	Memi[$1+2]	# struct pointer to header of prev.seg.
+
+
+# SALLOC -- Allocate space on the stack.
+
+procedure salloc (output_pointer, nelem, datatype)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelem			# number of elements of storage required
+int	datatype		# datatype of the storage elements
+
+int	nchars, dtype
+include	<szdtype.inc>
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	dtype = datatype
+	if (dtype < 1 || dtype > MAX_DTYPE)
+	    call sys_panic (500, "salloc: bad datatype code")
+
+	# Align stack pointer for any data type.  Compute amount of
+	# storage to be allocated.  Always add space for at least one
+	# extra char for the EOS in case a string is stored in the buffer.
+
+	sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1
+	if (dtype == TY_CHAR)
+	    nchars = nelem + 1				# add space for EOS
+	else
+	    nchars = nelem * ty_size[dtype] + 1
+
+	# Check for stack overflow, add new segment if out of room.
+	# Since SMARK must be called before SALLOC, cur_seg cannot be
+	# null, but we check anyhow.
+
+	if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg))
+	    call stk_mkseg (cur_seg, sp, nchars)
+
+	if (dtype == TY_CHAR)
+	    output_pointer = sp
+	else
+	    output_pointer = (sp-1) / ty_size[dtype] + 1
+
+	sp = sp + nchars			# bump stack pointer
+end
+
+
+# SMARK -- Mark the position of the stack pointer, so that stack space
+# can be freed by a subsequent call to SFREE.  This routine also performs
+# initialization of the stack, since it the very first routine called
+# during task startup.
+
+procedure smark (old_sp)
+
+pointer	old_sp			# value of the stack pointer (output)
+bool	first_time
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    sp = NULL
+	    cur_seg = NULL
+	    call stk_mkseg (cur_seg, sp, SZ_STACK)
+	    first_time = false
+	}
+
+	old_sp = sp
+end
+
+
+# SFREE -- Free space on the stack.  Return whole segments until segment
+# containing the old stack pointer is reached.
+
+procedure sfree (old_sp)
+
+pointer	old_sp			# previous value of the stack pointer
+
+pointer	old_seg
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	# The following is needed to avoid recursion when SFREE is called
+	# by the IRAF main during processing of SYS_MSSTKUNFL.
+
+	if (cur_seg == NULL)
+	    return
+	    
+	# If the stack underflows (probably because of an invalid pointer)
+	# it is a fatal error.
+
+	while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) {
+	    if (SH_OLDSEG(cur_seg) == NULL)
+		call sys_panic (SYS_MSSTKUNFL, "Salloc underflow")
+
+	    old_seg = SH_OLDSEG(cur_seg)		# discard segment
+	    call mfree (cur_seg, TY_STRUCT)
+	    cur_seg = old_seg
+	}
+
+	sp = old_sp					# pop stack
+end
+
+
+# STK_MKSEG -- Create and add a new stack segment (link at head of the
+# segment list).  Called during initialization, and upon stack overflow.
+
+procedure stk_mkseg (cur_seg, sp, segment_size)
+
+pointer	cur_seg			# current segment
+pointer	sp			# salloc stack pointer
+int	segment_size		# size of new stack segment
+
+int	nchars, new_seg
+pointer	coerce() 
+int	kmalloc()
+
+begin
+	# Compute size of new segment, allocate the buffer.
+	nchars = max (SZ_STACK, segment_size) + SZ_STKHDR
+	if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR)
+	    call sys_panic (SYS_MFULL, "Out of memory")
+
+	# Output new stack pointer.
+	sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR
+
+	# Set up the segment descriptor.
+	SH_BASE(new_seg) = sp
+	SH_TOP(new_seg) = sp - SZ_STKHDR + nchars
+	SH_OLDSEG(new_seg) = cur_seg
+
+	# Make new segment the current segment.
+	cur_seg = new_seg
+end
diff --git a/sys/memio/sizeof.x b/sys/memio/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/memio/sizeof.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SIZEOF -- Return the size in chars of one of the fundamental datatypes.
+
+int procedure sizeof (dtype)
+
+int	dtype
+include	<szdtype.inc>
+
+begin
+	return (ty_size[dtype])
+end
diff --git a/sys/memio/vmalloc.x b/sys/memio/vmalloc.x
new file mode 100644
index 00000000..25e2de0d
--- /dev/null
+++ b/sys/memio/vmalloc.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# VMALLOC -- Like malloc, but force the buffer to be aligned on a virtual
+# memory page boundary.  This feature can be used, e.g., in 4.XBSD UNIX
+# to "bypass" the system buffer cache (to avoid copying file data from the
+# system cache into the file buffer).  VMALLOC can be made equivalent to MALLOC
+# via the parameters in <config.h>, if the local machine which does not have
+# virtual memory.
+
+procedure vmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_VMEMALIGN
+	fwa_align = VMEM_BASE
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/memio/zzdebug.c b/sys/memio/zzdebug.c
new file mode 100644
index 00000000..35b0f7ad
--- /dev/null
+++ b/sys/memio/zzdebug.c
@@ -0,0 +1,366 @@
+/* zzdebug.x -- translated by f2c (version 20061008).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+
+/* Common Block Declarations */
+
+struct {
+    logical xerflg, xerpad[84];
+} xercom_;
+
+#define xercom_1 xercom_
+
+struct {
+    doublereal memd[1];
+} mem_;
+
+#define mem_1 mem_
+
+/* Table of constant values */
+
+static integer c__4 = 4;
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c__2 = 2;
+static integer c__1023 = 1023;
+static integer c_b46 = 999999999;
+
+integer sysruk_(task, cmd, rukarf, rukint)
+shortint *task, *cmd;
+integer *rukarf, *rukint;
+{
+    /* Initialized data */
+
+    static shortint dict[14] = { 115,116,97,99,107,0,114,101,97,108,108,111,
+	    99,0 };
+    static shortint st0009[29] = { 105,110,118,97,108,105,100,32,115,101,116,
+	    32,115,116,97,116,101,109,101,110,116,58,32,39,37,115,39,10,0 };
+    static shortint st0010[25] = { 105,110,118,97,108,105,100,32,83,69,84,32,
+	    105,110,32,73,82,65,70,32,77,97,105,110,0 };
+    static integer dp[3] = { 1,7,0 };
+    static integer lmarg = 5;
+    static integer maxch = 0;
+    static integer ncol = 0;
+    static integer rukean = 3;
+    static integer ntasks = 0;
+    static shortint st0001[9] = { 116,116,121,110,99,111,108,115,0 };
+    static shortint st0002[6] = { 99,104,100,105,114,0 };
+    static shortint st0003[3] = { 99,100,0 };
+    static shortint st0004[6] = { 104,111,109,101,36,0 };
+    static shortint st0005[6] = { 72,79,77,69,36,0 };
+    static shortint st0006[4] = { 115,101,116,0 };
+    static shortint st0007[6] = { 114,101,115,101,116,0 };
+    static shortint st0008[2] = { 9,0 };
+
+    /* System generated locals */
+    integer ret_val;
+
+    /* Local variables */
+    static integer i__, rmarg;
+    extern logical streq_();
+    extern /* Subroutine */ integer trealc_();
+    extern integer envgei_();
+    extern /* Subroutine */ integer xfchdr_(), erract_(), eprinf_(), tstack_()
+	    ;
+    extern integer envscn_();
+    extern /* Subroutine */ integer xffluh_(), pargsr_(), envlit_(), syspac_()
+	    , xerpsh_(), strtbl_();
+    extern logical xerpop_();
+    extern /* Subroutine */ integer zzepro_();
+
+    /* Parameter adjustments */
+    --cmd;
+    --task;
+
+    /* Function Body */
+    if (! (ntasks == 0)) {
+	goto L110;
+    }
+    i__ = 1;
+L120:
+    if (! (dp[i__ - 1] != 0)) {
+	goto L122;
+    }
+/* L121: */
+    ++i__;
+    goto L120;
+L122:
+    ntasks = i__ - 1;
+L110:
+    if (! (task[1] == 63)) {
+	goto L130;
+    }
+    xerpsh_();
+    rmarg = envgei_(st0001);
+    if (! xerpop_()) {
+	goto L140;
+    }
+    rmarg = 80;
+L140:
+    strtbl_(&c__4, dict, dp, &ntasks, &lmarg, &rmarg, &maxch, &ncol);
+    ret_val = 0;
+    goto L100;
+L130:
+    if (! (streq_(&task[1], st0002) || streq_(&task[1], st0003))) {
+	goto L150;
+    }
+    xerpsh_();
+    if (! (cmd[*rukarf] == 0)) {
+	goto L170;
+    }
+    xerpsh_();
+    xfchdr_(st0004);
+    if (! xerpop_()) {
+	goto L180;
+    }
+    xfchdr_(st0005);
+L180:
+    goto L171;
+L170:
+    xfchdr_(&cmd[*rukarf]);
+L171:
+/* L162: */
+    if (! xerpop_()) {
+	goto L160;
+    }
+    if (! (*rukint == 1)) {
+	goto L190;
+    }
+    erract_(&rukean);
+    if (xercom_1.xerflg) {
+	goto L100;
+    }
+    goto L191;
+L190:
+L191:
+L160:
+    ret_val = 0;
+    goto L100;
+L150:
+    if (! (streq_(&task[1], st0006) || streq_(&task[1], st0007))) {
+	goto L200;
+    }
+    xerpsh_();
+    if (! (cmd[*rukarf] == 0)) {
+	goto L220;
+    }
+    envlit_(&c__4, st0008, &c__1);
+    xffluh_(&c__4);
+    goto L221;
+L220:
+    if (! (envscn_(&cmd[1]) <= 0)) {
+	goto L230;
+    }
+    if (! (*rukint == 1)) {
+	goto L240;
+    }
+    eprinf_(st0009);
+    pargsr_(&cmd[1]);
+    goto L241;
+L240:
+    goto L91;
+L241:
+L230:
+L221:
+/* L212: */
+    if (! xerpop_()) {
+	goto L210;
+    }
+    if (! (*rukint == 1)) {
+	goto L250;
+    }
+    erract_(&rukean);
+    if (xercom_1.xerflg) {
+	goto L100;
+    }
+    goto L251;
+L250:
+L91:
+    syspac_(&c__0, st0010);
+L251:
+L210:
+    ret_val = 0;
+    goto L100;
+L200:
+/* L151: */
+/* L131: */
+    if (! streq_(&task[1], &dict[dp[0] - 1])) {
+	goto L260;
+    }
+    tstack_();
+    ret_val = 0;
+    goto L100;
+L260:
+    if (! streq_(&task[1], &dict[dp[1] - 1])) {
+	goto L270;
+    }
+    trealc_();
+    ret_val = 0;
+    goto L100;
+L270:
+    ret_val = -1;
+    goto L100;
+L100:
+    zzepro_();
+    return ret_val;
+} /* sysruk_ */
+
+/* Subroutine */ integer tstack_()
+{
+    /* Initialized data */
+
+    static shortint st0001[12] = { 98,117,102,102,101,114,95,115,105,122,101,
+	    0 };
+    static shortint st0002[28] = { 98,117,102,102,101,114,32,112,111,105,110,
+	    116,101,114,61,37,100,44,32,115,105,122,101,61,37,100,10,0 };
+
+    /* Local variables */
+    static integer sp;
+#define memb ((logical *)&mem_1)
+#define memc ((shortint *)&mem_1)
+#define memi ((integer *)&mem_1)
+#define meml ((integer *)&mem_1)
+#define memr ((real *)&mem_1)
+#define mems ((shortint *)&mem_1)
+#define memx ((complex *)&mem_1)
+    static integer junk;
+    extern /* Subroutine */ integer pargi_(), sfree_(), smark_();
+    extern integer clglpi_();
+    static integer bufsie;
+    extern /* Subroutine */ integer salloc_(), xffluh_(), xprinf_(), zzepro_()
+	    ;
+
+    smark_(&sp);
+L110:
+    if (! (clglpi_(st0001, &bufsie) != -2)) {
+	goto L111;
+    }
+    salloc_(&junk, &bufsie, &c__2);
+    xprinf_(st0002);
+    pargi_(&junk);
+    pargi_(&bufsie);
+    xffluh_(&c__4);
+    goto L110;
+L111:
+    sfree_(&sp);
+/* L100: */
+    zzepro_();
+    return 0;
+} /* tstack_ */
+
+#undef memx
+#undef mems
+#undef memr
+#undef meml
+#undef memi
+#undef memc
+#undef memb
+
+
+/* Subroutine */ integer trealc_()
+{
+    /* Initialized data */
+
+    static shortint st0001[12] = { 97,98,99,100,101,102,103,104,105,106,107,0 
+	    };
+    static shortint st0002[11] = { 48,49,50,51,52,53,54,55,56,57,0 };
+    static shortint st0003[25] = { 97,32,105,115,32,97,116,32,37,100,44,32,
+	    115,105,122,101,32,37,100,58,32,37,115,10,0 };
+    static shortint st0004[25] = { 98,32,105,115,32,97,116,32,37,100,44,32,
+	    115,105,122,101,32,37,100,58,32,37,115,10,0 };
+    static shortint st0005[33] = { 45,45,45,45,45,45,45,45,45,45,45,45,45,45,
+	    45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,10,0 };
+    static shortint st0006[10] = { 97,95,98,117,102,115,105,122,101,0 };
+    static shortint st0007[10] = { 98,95,98,117,102,115,105,122,101,0 };
+    static shortint st0008[30] = { 97,32,98,117,102,32,37,100,44,32,115,105,
+	    122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 };
+    static shortint st0009[30] = { 98,32,98,117,102,32,37,100,44,32,115,105,
+	    122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 };
+
+    /* Local variables */
+    static integer a, b, sza, szb;
+#define memb ((logical *)&mem_1)
+#define memc ((shortint *)&mem_1)
+#define memi ((integer *)&mem_1)
+#define meml ((integer *)&mem_1)
+#define memr ((real *)&mem_1)
+#define mems ((shortint *)&mem_1)
+#define memx ((complex *)&mem_1)
+    extern /* Subroutine */ integer pargi_();
+    extern integer clgeti_();
+    extern /* Subroutine */ integer xrealc_(), xmallc_(), eprinf_(), xmfree_()
+	    , pargsr_();
+    static integer newsza, newszb;
+    extern /* Subroutine */ integer zzepro_(), xstrcy_();
+
+    xmallc_(&a, &c__1023, &c__2);
+    xstrcy_(st0001, &memc[a - 1], &c_b46);
+    sza = 1023;
+    xmallc_(&b, &c__1023, &c__2);
+    xstrcy_(st0002, &memc[b - 1], &c_b46);
+    szb = 1023;
+    eprinf_(st0003);
+    pargi_(&a);
+    pargi_(&sza);
+    pargsr_(&memc[a - 1]);
+    eprinf_(st0004);
+    pargi_(&b);
+    pargi_(&szb);
+    pargsr_(&memc[b - 1]);
+    eprinf_(st0005);
+L110:
+    newsza = clgeti_(st0006);
+    if (! (newsza == 0)) {
+	goto L120;
+    }
+    goto L100;
+L120:
+    xrealc_(&a, &newsza, &c__2);
+    newszb = clgeti_(st0007);
+    if (! (newszb == 0)) {
+	goto L130;
+    }
+    goto L100;
+L130:
+    xrealc_(&b, &newszb, &c__2);
+    eprinf_(st0008);
+    pargi_(&a);
+    pargi_(&sza);
+    pargi_(&newsza);
+    pargsr_(&memc[a - 1]);
+    eprinf_(st0009);
+    pargi_(&b);
+    pargi_(&szb);
+    pargi_(&newszb);
+    pargsr_(&memc[b - 1]);
+    sza = newsza;
+    szb = newszb;
+/* L111: */
+    goto L110;
+/* L112: */
+    xmfree_(&a, &c__2);
+    xmfree_(&b, &c__2);
+L100:
+    zzepro_();
+    return 0;
+} /* trealc_ */
+
+#undef memx
+#undef mems
+#undef memr
+#undef meml
+#undef memi
+#undef memc
+#undef memb
+
+
diff --git a/sys/memio/zzdebug.x b/sys/memio/zzdebug.x
new file mode 100644
index 00000000..556c4fa1
--- /dev/null
+++ b/sys/memio/zzdebug.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Debug MEMIO.
+
+task	stack=t_stack, realloc=t_realloc
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	sza, new_sza, szb, new_szb
+int	clgeti()
+
+begin
+	call malloc (a, SZ_LINE, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	sza = SZ_LINE
+	call malloc (b, SZ_LINE, TY_CHAR)
+	call strcpy ("0123456789", Memc[b], ARB)
+	szb = SZ_LINE
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	repeat {
+	    new_sza = clgeti ("a_bufsize")
+	    if (new_sza == 0)
+		return
+	    call x_realloc (a, new_sza, TY_CHAR)
+	    new_szb = clgeti ("b_bufsize")
+	    if (new_szb == 0)
+		return
+	    call x_realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("a buf %d, size %d --> %d: %s\n")
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("b buf %d, size %d --> %d: %s\n")
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
diff --git a/sys/mkpkg b/sys/mkpkg
new file mode 100644
index 00000000..2a911439
--- /dev/null
+++ b/sys/mkpkg
@@ -0,0 +1,274 @@
+# Make the IRAF Virtual Operating System (VOS).  (07-May-83 Dct). 
+# Revised to use the new MKPKG facilities (12Dec85 Dct).
+
+$ifeq (hostid, unix) !(clear;date) $endif
+$call sysgen
+$echo "-------------- (done) ----------------"
+$ifeq (hostid, unix) !(date) $endif
+$exit
+
+# UPDATE -- Update the system executables in lib$
+
+update:	
+	$echo "-------------- GIO ----------------"
+	@gio
+	$echo "-------------- KI  ----------------"
+	@ki
+	$echo "-------------- TTY ----------------"
+	@tty
+	;
+
+# SUMMARY -- [UNIX] mkpkg summary: output a summary of the spooled mkpkg
+# output, omitting most of the mundane chatter.  Used to scan large spool
+# files for errors.
+
+summary:
+	$ifeq (HOSTID, unix)
+	    ! grep -v ':$$' spool | grep -v '^xc' | grep -v '^ar'\
+	    | grep -v '^check file'
+	$else
+	    $echo "mkpkg summary only available on a UNIX system"
+	$endif
+	;
+
+# SYSGEN -- Update the system libraries (VOS).  Note that the system library
+# for the iraf kernel (libos.a) is maintained in host$.
+
+sysgen:
+	$call sys
+	$call ex
+	$call vops
+	$call cur
+	$call stg
+	$ifeq (USE_LIBMAIN, yes)  $call libmain  $endif
+	$call libc
+	$call imfort
+	$call gks
+	$call ncar
+	$call sgi
+	$call imd
+
+	# Not all systems want the NCAR/NSPP and CALCOMP graphics kernels.
+	$ifeq (USE_NSPP, yes)
+	    $call nspp
+	    $call gkt
+	$endif
+	$ifeq (USE_CALCOMP, yes)
+	    $call ccp
+	$endif
+
+	# DS is required for cursor readback by the CL.
+	$call ds
+
+	# MEMIO debug library.
+	$call memdbg
+
+	$purge lib$
+	;
+
+sys:
+	$echo "-------------- LIBSYS ----------------"
+	$checkout libsys.a  lib$
+	$update   libsys.a
+	$checkin  libsys.a  lib$
+	;
+ex:
+	$echo "-------------- LIBEX -----------------"
+	$checkout libex.a   lib$
+	$update   libex.a
+	$checkin  libex.a   lib$
+	;
+vops:
+	$echo "-------------- LIBVOPS ---------------"
+	$checkout libvops.a lib$
+	$update   libvops.a
+	$checkin  libvops.a lib$
+	;
+cur:
+	$echo "-------------- LIBCUR ----------------" 
+	$checkout libcur.a  lib$
+	$update   libcur.a
+	$checkin  libcur.a  lib$
+	;
+stg:
+	$echo "-------------- LIBSTG ----------------" 
+	$checkout libstg.a  lib$
+	$update   libstg.a
+	$checkin  libstg.a  lib$
+	;
+libmain:
+	$echo "-------------- LIBMAIN.O -------------" 
+	$ifolder (bin$libmain.o, host$os/zmain.c)
+	    $call libmain.o
+	$else
+	    $echo "Libmain.o is up to date"
+	$endif
+	;
+libc:
+	$echo "-------------- LIBC ------------------" 
+	$checkout libc.a lib$
+	$update   libc.a
+	$checkin  libc.a lib$
+	;
+imfort:
+	$echo "-------------- IMFORT ----------------" 
+	$checkout libimfort.a lib$
+	$update   libimfort.a
+	$checkin  libimfort.a lib$
+	;
+gks:
+	$echo "-------------- LIBGKS ----------------" 
+	$checkout libgks.a  lib$
+	$update   libgks.a
+	$checkin  libgks.a  lib$
+	;
+sgi:
+	$echo "-------------- LIBSGI ----------------" 
+	$checkout libsgi.a  lib$
+	$update   libsgi.a
+	$checkin  libsgi.a  lib$
+	;
+imd:
+	$echo "-------------- LIBIMD ----------------" 
+	$checkout libimd.a  lib$
+	$update   libimd.a
+	$checkin  libimd.a  lib$
+	;
+ds:
+	$echo "-------------- LIBDS ----------------" 
+	$checkout libds.a  lib$
+	$update   libds.a
+	$checkin  libds.a  lib$
+	;
+ncar:
+	$echo "-------------- LIBNCAR ---------------" 
+	$checkout libncar.a lib$
+	$update   libncar.a
+	$checkin  libncar.a lib$
+	;
+nspp:
+	$echo "-------------- LIBNSPP ---------------" 
+	$checkout libnspp.a lib$
+	$update   libnspp.a
+	$checkin  libnspp.a lib$
+	;
+gkt:
+	$echo "-------------- LIBGKT ----------------" 
+	$checkout libgkt.a  lib$
+	$update   libgkt.a
+	$checkin  libgkt.a  lib$
+	;
+ccp:
+	$echo "-------------- LIBCCP ----------------" 
+	$checkout libccp.a  lib$
+	$update   libccp.a
+	$checkin  libccp.a  lib$
+	;
+ds:
+	$echo "-------------- LIBDS  ----------------" 
+	$checkout libds.a  lib$
+	$update   libds.a
+	$checkin  libds.a  lib$
+	;
+memdbg:
+	$echo "-------------- LIBMEMDBG  ------------" 
+	$checkout libmemdbg.a  lib$
+	$update   libmemdbg.a
+	$checkin  libmemdbg.a  lib$
+	;
+
+libsys.a:				# Core system
+	@fio	
+	@fmio
+	@fmtio
+	@clio
+	@etc
+	@gty
+	#@memio
+	@nmemio
+	@mtio
+	@symtab
+	@tty
+	@ki
+	@psio
+
+	@host$gdev/			# HSI graphics device drivers
+	;
+
+libex.a:				# High level system stuff
+	@gio
+	@imio
+	@plio
+	@pmio
+	@qpoe
+	@mwcs
+	;
+
+libvops.a:
+	@vops				# Vector operators
+	@osb				# Bit and byte primitives
+	;
+
+libcur.a:
+	@gio				# Cursor mode
+	;
+
+libmain.o:				# The root object module
+	$set XFLAGS = "-c $(HSI_XF)"
+	$checkout zmain.c host$os/
+	$omake	  zmain.c
+	$iffile (bin$libsys.a)		# store all binaries in BIN?
+	    $move zmain.o bin$libmain.o
+	$else
+	    $move zmain.o lib$libmain.o
+	$endif
+	$delete	  zmain.c
+	;
+
+libc.a:
+	@libc
+	;
+
+libimfort.a:
+	@imfort
+	;
+
+libgks.a:				# GKS emulator
+	@gio
+	;
+
+libncar.a:				# NCAR graphics utilities
+	@gio
+	;
+
+libnspp.a:				# Old NCAR System Plot Package (NSPP)
+	@gio
+	;
+
+libstg.a:				# The STDGRAPH graphics kernel
+	@gio
+	;
+
+libsgi.a:				# The SGI (simple graphics) kernel
+	@gio
+	;
+
+libimd.a:				# The IMD (image device) kernel
+	@gio
+	;
+
+libgkt.a:				# The NSPP graphics kernel
+	@gio
+	;
+
+libccp.a:				# The CALCOMP graphics kernel
+	@gio
+	;
+
+libds.a:				# The DS display interface library
+	@pkg$images/tv/display/mkpkg
+	;
+
+libmemdbg.a:				# The MEMIO debug library
+	@memdbg
+	;
diff --git a/sys/mtio/README b/sys/mtio/README
new file mode 100644
index 00000000..143917e6
--- /dev/null
+++ b/sys/mtio/README
@@ -0,0 +1,45 @@
+MTIO -- Magtape i/o.  This directory contains the FIO device driver for the
+magtape devices plus MTOPEN (used to open a magtape device and hook it to
+FIO) plus a few other routines.  See ./doc for additional info.
+
+
+USER ROUTINES
+
+		yes|no = mtfile (fname)		# Is fname a magtape device?
+	  yes|no = mtneedfileno (mtname)	# No file number given?
+		    gty = mtcap (mtname)
+			mtfname (mtname, file, outstr, maxch)
+
+		        mtparse (mtname, device, fileno, recno, attrl, maxch)
+		       mtencode (mtname, maxch, device, fileno, recno, attrl)
+
+		    fd = mtopen (mtname, acmode, bufsize)
+		       mtrewind (mtname, initcache)
+		     mtposition (mtname, file, record)
+
+	Use CLOSE to close a file descriptor opened with mtopen.
+	Use GTYCLOSE to close a termcap descriptor opened with mtcap.
+	MTNAME is the full magtape device specification, i.e, "mt[...]".
+
+
+
+SYSTEM ROUTINES
+
+		     mtallocate (mtname)
+		   mtdeallocate (mtname, rewind_tape)
+		       mtstatus (out, mtname)
+		        mtclean (level, stale, out)
+
+
+
+FIO DRIVER
+
+			 zopnmt (iodev, acmode, mtchan)
+			 zclsmt (mtchan, status)
+			 zardmt (mtchan, buf, maxbytes, offset)
+			 zawrmt (mtchan, buf, nbytes, offset)
+			 zawtmt (mtchan, status)
+			 zsttmt (mtchan, what, lvalue)
+
+
+All other procedures are internal to the interface.
diff --git a/sys/mtio/doc/mtio.hlp b/sys/mtio/doc/mtio.hlp
new file mode 100644
index 00000000..e00643a5
--- /dev/null
+++ b/sys/mtio/doc/mtio.hlp
@@ -0,0 +1,814 @@
+.help mtio Aug83 "Magnetic Tape I/O"
+.sh
+1. Introduction
+
+    This document describes the Magnetic Tape I/O (MTIO) package,
+i.e., the interface by which IRAF programs access magnetic tapes.
+Included are the requirements and specifications for the package,
+and a discussion of the interface between MTIO and FIO.
+
+.sh
+2. MTIO Requirements
+.ls 4
+.ls (1)
+The machine independent part of the MTIO package shall be written in
+the SPP language in compliance with the standards and conventions of IRAF.
+.le
+.ls (2)
+The MTIO package shall provide a single interface to all magtape
+devices on all IRAF target machines.
+.le
+.ls (3)
+MTIO shall interface to FIO, making it possible to read and write a magtape
+file via the FIO interface in a device independent fashion.
+.le
+.ls (4)
+All functions shall take an error action if a hardware error occurs,
+or if an illegal function is requested.
+No hardware exception or trap shall occur while accessing a magtape
+file via MTIO which is not caught by MTIO and converted into an
+IRAF error action.
+.le
+.ls (5)
+All error actions shall be defined symbolically in the system error
+code file <syserr.h>.  The MTIO error messages shall have the
+form SYS_MT<function>, i.e., SYS_MTOPEN.  The error message strings
+shall be placed in the system error message file, "syserrmsg".
+.le
+.ls (6)
+The MTIO code shall be divided into a machine independent part and
+a machine dependent part.  All machine independent function and error
+checking shall be done in the machine independent part, to minimize
+the size and complexity of the machine dependent part, and therefore
+maximize the transportability of the package.
+.le
+.ls (7)
+MTIO shall interface to FIO by implementing the standard FIO binary file
+z-routines ZOPNMT, ZCLSMT, ZARDMT, ZAWRMT, ZAWTMT, and ZSTTMT.
+The specifications for these routines are given elsewhere.
+.le
+
+.sh
+3. MTIO Specifications
+
+    A magtape file is opened with MTOPEN and then accessed as a binary
+file via the device independent FIO interface.  Upon input, FIO merges
+all tape records together into a binary byte stream.  Upon output,
+FIO writes records equal in size to the FIO buffers, unless FLUSH or
+CLOSE is called, causing a partially filled buffer to be flushed to tape.
+The data within a tape file may not be randomly accessed; only sequential
+accesses are permitted.  When i/o is complete, CLOSE should be called
+to close the file and return all buffer space.
+
+	fd = mtopen (filename, access_mode, buf_size)
+
+The format of a nonblank magnetic tape consists of beginning-of-tape (BOT),
+followed by zero or more files, followed by end-of-tape (EOT).
+Each file consists of one or more records, followed by a tape mark (EOF).
+EOT is defined as two consecutive tape marks, i.e., as a file containing
+zero records.  MTIO knows nothing about labeled tapes.
+
+Tape records need not all be the same length, but for transportability
+reasons records should be an integral number of computer words in length,
+and very short records should be avoided (short records are used by some
+operating systems for special purposes).  The term "computer word"
+is not well defined; the size of a tape record in bytes should be evenly
+divisible by 2, 4, or 8, where the transportability increases with the
+size of the divisor.  To avoid loss of data when reading a tape,
+the FIO buffer must be at least as large as the longest record on the tape.
+
+.sh
+3.1 Opening a Magtape
+
+    MTOPEN opens a file on the named magtape device.  The following
+device naming convention determines the tape drive and density:
+
+	mt[a-z][800|1600|6250]
+
+The letter in the second field determines which drive is to be used,
+and the third field, which is optional, determines the density.
+If the density is not specified, a system or drive dependent default
+density will be selected.  Thus, to access a file on drive A at 1600 bpi,
+one would open the file "mta1600".
+
+The significance of the terms "drive A", "drive B", etc., is installation
+dependent, and need not imply distinct physical drives.  A tape drive may
+have to be allocated before it can be opened by MTIO; MTIO does not attempt
+to allocate devices.
+
+The device name may optionally be followed by a subscript specifying
+the index of the file to which the tape is to be positioned.
+Thus, opening "mta[3]" causes device A to be opened with the default
+density, positioned to BOF of the third file on the tape.
+The field N, as in "mta[N]" may have the following values:
+
+.ls 4
+.ls 12 absent
+If the entire subscript is absent, or if N is absent the tape is opened
+at the current position, i.e., the tape is not physically moved.
+.le
+.ls N >= 1
+If an integer number greater than or equal to 1 (one) is given,
+the tape is opened positioned to that file.
+.le
+.ls N == EOT
+If the file number is given as "EOT" or as "eot", the tape is opened
+positioned at EOT.
+.le
+.le
+
+If called with a non "mt"-prefixed file name, MTOPEN assumes that the file
+is a regular disk resident binary file, and attempts to open the named
+file.  A program which normally reads directly from a magtape device may
+therefore be used to read from a regular binary file, or from the
+standard input (the special file "STDIN").
+
+The following access modes are recognized by MTOPEN:
+.ls 4
+.ls 12 READ_ONLY
+The device is opened for reading, positioned to the beginning of
+a file, BOT, EOT, or to the "current position".
+Any attempt to write to the device will cause an error.
+.le
+.ls WRITE_ONLY
+The device is opened for writing, positioned to the beginning of a file,
+BOT, EOT, or to the "current position".  When the file is subsequently
+closed, a new EOT mark will be written.  Existing tape files may be overwritten.
+.le
+.ls APPEND
+The device is opened for writing, positioned at the end of tape (EOT).
+Append mode must not be used with blank tapes.  Note that the significance
+of APPEND mode is different for MTOPEN than for a regular file open;
+the tape is to be extended by adding a new file, whereas in FIO it is
+the file itself which is extended.
+.le
+.ls NEW_TAPE
+The device is opened for writing, positioned at BOT.  Any existing
+data on the tape is overwritten.  Recommended mode for blank tapes.
+.le
+.le
+
+FIO can read any tape with a maximum record size less than or equal
+to the buffer size.  In buffered mode, FIO normally writes records equal
+in size to the FIO internal buffers.  Smaller records may be written if
+FLUSH or CLOSE is called; records of any size may be written in unbuffered
+mode.
+
+The third argument to MTOPEN is used to set the FIO buffer size.
+If the buffer size is given as zero, a default value is used.
+The default value chosen depends on the mode of access and upon the
+maximum record size permitted by the host system.  MTOPEN will automatically
+allocate the maximum size FIO buffer if the tape is opened for reading.
+The FIO buffer size may be changed in an FSET call anytime before
+the first buffered i/o on the file.
+
+.sh
+3.2 Ordinary I/O to a Magtape Device
+
+    Seeks are not permitted on magtape files.  A tape may be opened for
+reading or for writing, but not for both at the same time.  A magtape
+device is much like the standard input and output; STDIN is read only,
+STDOUT is write only, and seeking is not permitted on either.  STDIN
+differs from ordinary files in that data may continue to be read after
+an EOF; the same is true of magtape files.  If a read returning EOF is
+followed by another read on a magtape device, the second read will
+access the first record of the next file.  Once EOT is reached, every
+read will return EOF.  There is no way to advance beyond EOT on a read.
+An EOF mark may only be written by closing the tape (see next section).
+
+.sh
+3.3 Closing a Magtape
+
+    The CLOSE function is called either explicitly by the user task,
+or implicilty by the IRAF main upon normal or abnormal task termination.
+If the file was opened for writing, CLOSE flushes the output buffer and
+writes an EOT mark at the current position.  A file opened for writing
+is left positioned ready to write the first record of the next file on
+the tape (i.e., after the EOF of the file just written).  A file opened
+for reading, if closed immediately after reading EOF, is left positioned
+ready to read or write the first record of the next file on the tape.
+
+.sh
+3.4 Bytes and Records
+
+    Upon input, the size of a record will be rounded up to an integral
+number of "chars".  No data will be lost, but one or more extra bytes of
+data may be added.  A tape conversion program which must deal with
+odd-sized records must know the size of tape records to properly extract
+the data.  FIO cannot write odd-sized records.
+
+The binary i/o routines do not transform the data in any way,
+including byte swapping.  If byte swapping is necessary, the conversion
+program must do the byte swapping explicitly.  The predefined machine
+constants BYTE_SWAP and WORD_SWAP indicate whether byte or word swapping
+is necessary on the local machine (word swapping refers to the two 16 bit
+words in a long integer).  Floating point data should not be stored in
+binary on tape, unless the tape is to be read only by the machine which
+wrote it.
+
+Routines are available elsewhere in the PI for manipulating bytes.
+The routines BYTMOV, BYTSWP, and BYTPAK are particularly useful for cracking
+foreign tapes.
+
+.sh
+3.5 Low level I/O to a Magtape
+
+    The asynchronous, unbuffered FIO routines AREAD, AWRITE, and AWAIT
+may be used to perform record i/o on a magtape.  A single tape record
+is read or written by each call; the FIO buffer is not used.  AWAIT must
+be called after each read or write, before initiating the next i/o transfer.
+Although in general it is unwise to mix buffered and unbuffered i/o on
+the same file, it is safe to perform one or more unbuffered transfers
+immediately after opening a file, before performing any buffered i/o.
+
+If an application must do something peculiar, like write an odd-sized
+record, the MTIO z-routines may be called directly.  The z-routines transfer
+data in units of machine bytes.
+
+.sh
+3.6 CL level tape commands
+
+    The four routines ALLOCATE, DEALLOCATE, REWIND and MTSTATUS will be
+available at the CL level.  A tape drive ("mta", "mtb", etc.) must be
+explicitly allocated before it can be accessed with MTOPEN.
+A drive may be allocated to only one user at a time.  MTIO keeps track
+of the position of an allocated tape; once a drive has been allocated,
+the tape must not be manually positioned by the user.  Tapes can be
+changed without reallocating the drive provided REWIND is first used to
+rewind the tape.  DEALLOCATE automatically rewinds the tape before
+deallocating the drive.  MTSTATUS tells whether or not a particular drive
+has been allocated, and if so, gives the name of the owner, the density,
+whether not the device is physically open, and so on.
+
+.sh
+3.6 Example
+
+    The following program reads an ASCII card image file from the
+input tape and converts it to an ordinary text stream, which is written
+to the standard output.  This program is insensitive to the number of
+cards per tape record, and may be used to read card image disk files
+as well as tape files.
+
+The following CL commands might be entered to read the second card image
+file on the 800 bpi input tape into file "myfile", converting to lower case:
+
+.ks
+.nf
+	cl> allocate mta
+	cl> rcardimage "mta800[2]" | lcase > myfile
+.fi
+.ke
+
+
+The source for the program "rcardimage" follows:
+
+
+.ks
+.nf
+# RCARDIMAGE -- CL callable task which reads a card image
+# file, writing the converted cards to the standard output.
+
+procedure rcardimage()
+
+char	filename[SZ_FNAME]
+int	input, mtopen()
+
+begin
+	call clgstr ("filename", filename, SZ_FNAME)
+	input = mtopen (filename, READ_ONLY, 0)
+	call read_card_image_file (input, STDOUT)
+	call close (input)
+end
+.fi
+.ke
+
+
+
+.ks
+.nf
+define	SZ_CARD		80
+
+# READ_CARD_IMAGE_FILE -- Read the named card image file, convert
+# to a regular character stream, and write to the output file.
+
+procedure read_card_image_file (input, output)
+
+int	input, output			# input, output files
+char	cardbuf[SZ_CARD]		# raw card
+char	linebuf[SZ_CARD+1]		# add 1 char for newline
+int	last_char
+int	read()
+errchk	read, putline
+
+begin
+	# Read successive cards until EOF is reached.  Unpack the
+	# card, strip trailing whitespace, and write the processed
+	# line to the output file.
+
+	while (read (input, cardbuf, SZ_CARD) != EOF) {
+	    call chrupk (cardbuf, 1, linebuf, 1, SZ_CARD)
+
+	    # Strip trailing whitespace, add newline.
+	    last_char = 0
+	    for (ip=1;  ip <= SZ_CARD;  ip=ip+1)
+		if (! IS_WHITE (linebuf[ip]))
+		    last_char = ip
+
+	    linebuf[last_char+1] = '\n'
+	    linebuf[last_char+2] = EOS
+
+	    call putline (output, linebuf)
+	}
+end
+.fi
+.ke
+.endhelp
+
+
+.helpsys mtio Nov83 "MTIO Interface Detailed Design"
+.sh
+Strategies for Interfacing MTIO 
+
+    The specifications for MTIO have been kept as simple as possible for maximum
+machine independence.  There is only one high level call, MTOPEN, which is
+used to open the device; it does little more than call FIO.   Thereafter
+everything is done through the six FIO z-routines:
+
+.nf
+	zopnmt (filespec, access_mode; channel|ERR)
+	zclsmt (channel)
+	zardmt (channel, buffer, maxbytes, one_indexed_byte_offset)
+	zawrmt (channel, buffer,   nbytes, one_indexed_byte_offset)
+	zawtmt (channel; nbytes|ERR)
+	zsttmt (channel, parameter; long_value)
+.fi
+
+These z-routines may be written in any language so long as they are SPP (i.e.,
+Fortran) callable.  The "filespec" argument is a packed string.  The access
+modes and ERR code are system constants defined in <iraf.h>.  Channel may be
+anything you wish.  The file offsets will always be zero since the magtape
+device is a streaming (sequential) device.
+
+Be sure that the z-routines, if written partially in the SPP language, do not
+make calls to high level program interface routines, especially any which do
+i/o.  Doing so violates the reentrancy restrictions of the SPP language (and
+of Fortran).  It may also lead to problems with the way libraries are searched.
+More explicitly, any calls to error or iferr, to any of the FIO routines, or to
+any of the printf or scan routines are absolutely forbidden.  It is ok to use
+the string primitives (because they do not do any i/o or call error), but it
+is best to avoid even those if possible.  It is perfectly all right to call
+other z-routines provided they do not directly or indirectly call you back
+(none will call mtio).
+
+.sh
+Virtual Device Model
+
+    Though in general the z-routines may have to be completely rewritten for
+a new OS, in fact many systems have functionally similar primitive magtape
+interfaces.  If your system can be described by the model defined below,
+the "z?*.x" files in this directory can be used unchanged, and all you need to
+provide are the equivalents of the "zz" prefixed files.
+
+    Basically, the model requires that the zz-routine which opens the magtape
+be capable of positioning the tape to the first record of any file, given the
+file number to which the tape is positioned at open time.  The high level MTIO
+interface code is charged with keeping track of the position of the tape at
+all times, including while the tape is closed.  The high level code does not
+explicitly move the tape, though it does implicitly move it during open and when
+it commands an i/o operation.  The high level code assumes nothing about tape
+motions; all zz-primitives return status values stating how many records or
+files the tape moved in the last operation.  Thus, the details of the function
+of a zz-routine can vary depending on the system, without requiring
+modifications to the z-routines.
+
+.ls 4
+.ls (1)
+The following open/close primitives are required.  ZZOPMT opens a tape
+drive positioned ready to read or write the first record of the specified
+file.
+.ls zzopmt (drive,density,acmode, oldrec,oldfile; newfile; oschan|ERR)
+.br
+.ls 10 drive
+Logical drive number (1,2,3,...).
+.le
+.ls density
+Drive density.  A positive integer, i.e., 800, 1600 or 6250.  A value
+of zero implies that an OS default density is to be selected.
+.le
+.ls acmode
+Access mode.  Read_only or write_only.  Modes new_file and append are
+dealt with by the "newfile" file number parameter.
+.le
+.ls oldrecord
+The number of the record to which we are currently positioned in the
+oldfile.  We have to know this to know whether or not the file has to
+be rewound.  The first record is number one.
+.le
+.ls oldfile
+The number of the file to which the tape is currently positioned.
+.le
+.ls newfile
+The number of the file to be opened, where 1 specifies that the tape is
+to be rewound.  If newfile <= 0, open at EOT.  On output, contains the
+actual file number of the new file; this may differ from the requested
+value if EOT is encountered.  It is not an error (as far as the zz-routine
+is concerned) to attempt to position to a file beyond EOT.
+.le
+.ls oschan
+The channel number by which the file is to be referred in calls to the
+other zz-routines, or ERR if the file cannot be opened.  ZZOPMT should
+set oschan IMMEDIATELY AFTER PHYSICALLY OPENING THE DEVICE, so that the
+error recovery code can close the file if an interrupt occurs.
+.le
+.le
+
+.ls 4 zzclmt (oschan, access_mode; nfile)
+Close tape.  Write a new EOT at the current position if writing.
+Returns the file number increment (in the event that a file mark or two
+has to be written).
+.le
+.le
+
+.ls (2)
+The following i/o primitives are required.
+.ls zzrdmt (oschan, buf, maxbytes)
+Initiate a read of up to maxbytes bytes from the next tape
+record into buffer buf.  It is not an error if fewer than "maxbytes"
+bytes are read; in fact maxbytes will normally be larger than the largest
+record on the tape.  In general it is difficult to tell if the tape record
+was larger than maxbytes; the user code should select a large maxbytes and
+consider it an error if the full maxbytes are read.  If EOF is encountered,
+return a zero byte count in the next call to zzwtmt.
+.le
+.ls zzwrmt (oschan, buf, nbytes)
+Initiate a write of "nbytes" bytes to the tape.  It is an error
+if all data is not written.
+.le
+.ls zzwtmt (oschan; nbytes|ERR, nrecord, nfile)
+Wait for i/o to complete, and return the number of bytes read or
+written in the last transfer; return 0 if we read a tape mark.
+Keep returning the same thing in redundant calls.  If an error
+occurs the error status should be cleared when the next i/o
+transfer is initiated.  Return nrecord=1 for each tape record read,
+but not for file marks.  Return nfile=1 if a filemark is skipped.
+A read of 0 bytes signifies that EOF was seen, but does not necessarily
+imply that a tape mark has been skipped.
+.le
+.le
+.le
+
+.sh
+Program Structure
+
+    The drive must be allocated before MTOPEN is called; MTOPEN verifies
+that the drive has been allocated and then calls FIO to install the magtape
+device and open the desired file on the drive.  Allocating a file involves
+a call to the OS to allocate and/or mount the device, followed by creation
+of the device lock file in the dev$ directory.  The lock file is used to
+indicate that the drive has been allocated, and to keep track of the tape
+position when the drive is closed.
+
+
+.ks
+.nf
+	mtopen
+		mt_parse_filespec
+		mt_get_tape_position
+			various FIO routines
+		fopnbf
+			zopnmt
+				zzopmt
+			zsttmt
+		fset			[to set buffer size]
+
+	    
+	    	Structure of the MTOPEN Procedure
+.fi
+.ke
+
+
+The ZCLSMT procedure is called by CLOSE to close a file opened with MTOPEN.
+CLOSE may be called by the user, by the IRAF main if the task completes w/o
+closing the file, or during error recovery.  An error occurring during MTOPEN
+may result in a call to CLOSE.  We do not have to worry about reentrancy here
+because none of the MTIO z-routines called by ZOPNMT call error (they will
+return an ERR status to FOPNBF and therefore terminate before ZCLSMT is called).
+
+
+.ks
+.nf
+	close
+		zclsmt
+			mt_update_lockfile
+				smark,salloc,sfree
+				fvfn_to_osfn
+				mktemp
+				zopntx
+				zputtx
+				zclstx
+				zfdele
+				zfrnam
+				fatal
+			zzclmt
+
+
+	    	Structure of the ZCLSMT procedure
+.fi
+.ke
+
+
+The i/o procedures keep track of the number of records read or written and
+ensure that we do not read past EOF or EOT.  We need to keep track of the
+number of records written so that we can detect a null file write.
+
+
+.ks
+.nf
+	aread				awrite
+		zardmt				zawrmt
+			zzrdmt				zzwrmt
+
+
+	await
+		zawtmt
+			zzwtmt
+	
+
+		Structure of the I/O Procedures
+.fi
+.ke
+
+
+The final routine is the ZSTTMT status procedure.  This routine is self
+contained, except that access to the MTIO common is required to get the
+access mode (which determines the default buffer size).
+
+
+.sh
+Semicode
+
+    We do as much of the work in MTOPEN as we can, since it is the only
+high level, machine independent routine we have (we can call anything in this
+routine without reentrancy problems).  We check that the drive has been
+allocated (to us), allocate an mtio device descriptor, check that the same
+drive has not been reopened, parse the filespec and save the pieces in the
+descriptor (for later use by ZOPNMT), read in the current tape position from
+the lock file, and then call fopnbf which in turn calls ZOPNMT to open the
+drive and position to the desired file.
+
+
+.tp 8
+.nf
+int procedure mtopen (filespec, access_mode, bufsize)
+
+begin
+	if (file not mt-prefixed) {
+	    call open to open regular binary file
+	    return (file descriptor returned by open)
+	}
+
+	get mtio device descriptor slot but do not allocate it yet
+	if (slots all taken)
+	    error: magtape device multiply opened (filespec)
+	call mt_parse_filespec to break out drivename, density,
+	    filenumber and set up mtio device descriptor
+	if (drive is already open)
+	    error: magtape device multiply opened (filespec)
+	check that the named drive has been allocated to us
+	if (drive not allocated to us)
+	    error: magtape not allocated (filespec)
+	decode lock file to get old position of drive, save in
+	    device descriptor
+
+	call fopnbf to install the magtape device and open file
+	if (bufsize is nonzero)
+	    call fset to set non-default FIO buffer size
+
+	return (file descriptor)
+end
+.fi
+
+
+ZOPNMT is passed a mostly initialized magtape file descriptor in the mtio
+common by MTOPEN.  The "filespec" string is not actually used by ZOPNMT.
+We physically open the file and set up the remaining fields in the tape file
+descriptor.  NOTE: if an interrupt occurs during the call to ZZOPMT,
+ZCLSMT will be called to perform error recovery.  If this happens the
+position of the tape is undefined.
+
+
+.ks
+.nf
+procedure zopnmt (filespec, access_mode; chan|ERR)
+
+[we are passed the mtio file descriptor in the mtio common]
+
+begin
+	set flag for ZCLSMT in case we are interrupted
+	call ZZOPMT to open tape positioned to the beginning of the
+	    indicated file.
+
+	if (cannot open tape)
+	    return (chan = ERR)
+	if (actual file < requested file)
+	    if (reading)
+		set at-eof flag and at_eot flag, so that reads return EOF
+	    else {
+		call zzclmt to close device
+		return (mtchan = ERR)
+	    }
+
+	save oschan in descriptor
+	save actual file number in descriptor
+	initialize the remaining descriptor fields
+
+	return (chan = mtio descriptor index)
+end
+.fi
+.ke
+
+
+Opening a file for writing and then immediately closing it poses problems.
+There is no way to write a zero-length file on an unlabeled tape.  We cannot
+just write a tape mark because that might mean writing a spurious double
+tapemark (false EOT) in the middle of the tape.  We could just ignore the
+request and not write any file, but that is not quite right either (if a
+disk file is opened for writing and then immediately closed, a file is
+still created).  We compromise by writing a single short record containing
+the packed ASCII character string "NULLFILE".  The actual length of the
+physical nullfile record is machine dependent.
+
+We may or may not need to bump the file counter when the file is closed;
+the OS tells us which.  If we have just written a file and ZZCLMT must
+write a tape mark, for example, we might be left positioned before EOT,
+between the tape marks, or (unlikely) after the tape marks.
+
+If an error (i.e., console interrupt) occurs while the tape is being
+positioned by ZZOPMT, we will be called by the error recovery system
+with a garbage mtchan argument.  We must be able to detect this type
+of call and modify the lock file, marking the position of the tape
+as UNDEFINED.  The next open call will then automatically rewind the
+tape, ensuring accurate positioning.  In a normal close we write out
+a lockfile identifying the file and record to which the tape is positioned.
+
+
+.ks
+.nf
+procedure zclsmt (mtchan)
+
+begin
+	if (error recovery in progress for ZOPNMT)
+	    mark current position as undefined
+	else {
+	    if (file was opened for writing but nothing was written)
+		write out "null file" short record
+
+	    call zzclmt (oschan, access_mode; nfiles)
+	    file += nfiles
+	    if (nfiles > 0)
+		record = 1
+	}
+	    
+	call mt_update_lockfile to save tape status, position
+	deallocate the mtio device descriptor slot
+end
+.fi
+.ke
+
+
+Ignore all read requests once EOF or EOT has been reached.  The only operation
+possible at that point is to close the device; there is no rewind or backskip
+function for a streaming device.  We do not "know" what would happen if we
+called ZZRDMT after reaching EOF; this is OS dependent, and we do not want
+to require any particular behavior (some systems would return the first
+record of the next file, others would keep returning EOF).
+
+
+.ks
+.nf
+procedure zardmt (mtchan, buf, maxbytes, offset)
+
+begin
+	if (not at EOF or EOT)
+	    call zzrdmt (oschan, buf, maxbytes)
+end
+.fi
+.ke
+
+
+We cannot hit EOF or EOT on a write, so merely post the request and return.
+Ignore the "offset" parameter since magtape is a streaming device.
+
+
+.ks
+.nf
+procedure zawrmt (mtchan, buf, nbytes, offset)
+
+begin
+	call zzwrmt (oschan, buf, nbytes)
+end
+.fi
+.ke
+
+
+FIO insures that ZAWTMT is called once and only once after every asynchronous
+i/o read or write request.  Once we hit EOF or EOT on a read, we return
+EOF (nchars = 0) on every subsequent request until the file is closed.
+After each real data transfer we update the record,file counters as
+directed by the OS.
+
+
+.ks
+.nf
+procedure zawtmt (mtchan; status)
+
+begin
+	if (reading and at EOF or EOT)
+	    return (status = 0)
+
+	call zzwtmt (oschan, nchars, nrecords_skipped, nfiles_skipped)
+	if (nfiles_skipped > 0) {
+	    set at-EOF flag
+	    record = 1
+	}
+	
+	file += nfiles_skipped			# keep track of position
+	record += nrecords_skipped
+	nrecords += nrecords_skipped		# count records rd|wr
+
+	status = nchars
+end
+.fi
+.ke
+
+.sh
+Error Recovery
+
+    Error recovery during magtape operations is tricky since we are trying
+to keep track of the position of the drive.  If an error occurs while the
+tape is being positioned by ZZOPMT we must detect the condition and mark the
+position of the tape as indefinite (forcing a rewind on the next open).
+If an interrupt occurs while positioning to EOT for a write, we do not
+want ZZCLMT to write the new EOT mark somewhere in the middle of the tape,
+truncating the tape.
+
+    Interrupts or other errors while reading or writing are comparatively
+harmless.  Interrupting a write results in a short but otherwise normal
+file on the tape; interrupting a read leaves us positioned to some
+arbitrary record within the file (harmless).  Conceivably a read
+could be interrupted just as we were reading a tape mark, causing the
+file position to be lost.  We have not protected against this.
+
+.sh
+Data Structures
+
+    The mtio device descriptor structure describes the status of each magtape
+device in use.  The maximum number of magtape files which can be open at one
+time is the maximum number of tape drives.  Only one file can be open on each
+drive at a time.
+
+
+.ks
+.nf
+	struct mtiodes {
+		int	mt_drive	# 1,2, etc. (c.t. a,b,...)
+		int	mt_density	# 0,800,1600,6250, etc.
+		int	mt_oldfile	# file number at open time
+		int	mt_oldrecord	# record number at open time
+		int	mt_file		# file being accessed (0=EOT)
+		int	mt_record	# next record to be accessed
+		int	mt_nrecords	# nrecords read/written
+		int	mt_acmode	# access mode
+		int	mt_oschan	# OS channel number
+		int	mt_ateof	# true when at EOF
+		int	mt_ateot	# true when at EOT
+	} mtiocom[MAX_TAPES]
+.fi
+.ke
+
+
+When a device is allocated, a lock file is created in the system logical device
+directory "dev$".  For example, the lock file for magtape unit A is the
+file "dev$mta.lok".  This is a human readable text file; it is typed out on
+the terminal when the user types "devstatus mta".  The lock file is updated
+when the drive is closed and deleted when the drive is deallocated.  The drive
+is automatically deallocated when the user logs out of the CL.
+
+
+.ks
+.nf
+Sample Lock File:
+
+    # Magtape unit 'mta' allocated to 'user' Sun 20:06:13 27-Nov-83
+    current file = 4
+    current record = 1
+    72 records read, EOF seen
+.fi
+.ke
+
+
+The preliminary comments are written when the lock file is created, i.e.,
+when the device is allocated.  Any number of comment lines are permitted.
+They are merely copied when ZCLSMT updates the lock file.  The remaining
+records are written by ZCLSMT to record the current position of the tape,
+and to inform the user of the device status.
diff --git a/sys/mtio/doc/newdriver.notes b/sys/mtio/doc/newdriver.notes
new file mode 100644
index 00000000..3ef2ca7f
--- /dev/null
+++ b/sys/mtio/doc/newdriver.notes
@@ -0,0 +1,517 @@
+			    NEW IRAF MAGTAPE DRIVER
+				 October 1991
+			        (design notes)
+
+
+1. User Interface
+
+1.1 Magtape Specification
+
+	Old format:
+	    
+	    mtX.density[file.record]
+
+	New format:
+
+	    mtX['['file[.record][:(param|param@|param=value):...]']']
+
+	e.g.,
+
+	    mtexb1[4:nb:se@:ts=1200:so=/dev/ttya8]
+
+	    mtX is used only as an index into the devices file, and is not
+	    parsed.  The tape density is no longer singled out as a special
+	    parameter.  If any parameters are specified, these parameters
+	    override those given in the tapecap file entry.
+
+
+1.2 TAPECAP file
+
+	Current Format:
+
+	    irafname [%NNNN] device aliases
+	    e.g.,	 mtb.9	nrst8	rst8 nrst0 rst0
+
+	Revised Format:
+
+	    name[|alias|...]:cap=value:...:[tc=name:]
+
+	Device parameters are specified in termcap file format.
+
+	    mta|mtexb1|Exabyte drive 1:\
+		:dv=nrst0:rd=rst0:\
+		:al=rst0,rst8,rst16,rst24,nrst0,nrst8,nrst16,nrst24:\
+		:tc=exb-sunst:
+	    exb-sunst|Exabyte via SunOS ST driver:\
+		:bs#0:dt=Exabyte:fs#2200:mr#65535:
+
+	This feature will use the new GTY interface.  Modifications are
+	required to 1) allow specification of parameters at open time which
+	will override those given in the file, and 2) make the use of a #
+	for numeric parameters optional (accept either # or =).
+
+
+1.3 I/O Monitoring
+
+	Device and tape type and capacity are given in tapecap.
+	Keep track of tape usage along with file position in lock file.
+	Lock file provides simple means to track usage.  A real time
+	display may optionally be provided by the driver writing to
+	a tape monitoring window via a file or socket, with the name
+	given in tapecap or on the command line.
+
+
+2. Code Changes
+
+	OS,KI
+	    zfiomt.c - all host versions are affected as calling sequence
+	    has changed.  Network interface is affected (new tape system
+	    and old iraf kernel servers are incompatible).
+
+	    The UNIX version of the new driver needs additional code to
+	    optionally log status information to a file or special file.
+	    Support for tcp/ip status logging as well?
+
+	ETC
+	    Device allocation code is affected by the devices file syntax
+	    changes.
+
+	MTIO
+	    Must be changed to reflect magtape specfication and devices file
+	    specification changes, i.e., the density parameter is omitted,
+	    the device name is not quite the same thing, and a general
+	    device parameter mechanism is added.
+
+	    The feature to keep track of the amount of tape used is device
+	    and host independent (given adequate parameterization in the
+	    devices file) hence can be implemented in MTIO.  Output to the
+	    user, and preservation of tape usage status over device closes,
+	    will be via the .lok file and DEVSTATUS.
+
+	    The MTIO driver Z routines seem largely unaffected, except for
+	    the status routine and the i/o routines, which need support added
+	    for blocked devices.
+
+
+3. Device Driver
+
+3.1. Device Classes
+
+	generic			generic device (open/close/read/write)
+	reel			800,1600,6250 bpi 1/2inch reel tape
+	cartridge		various QIC formats - fixed size blocks
+	exabyte			variable size blocks
+	dat			variable size blocks
+
+
+3.2. Device Parameters
+
+[[NOT KEPT UP TO DATE - refer to os$zfiomt.c for latest version. ]]]]
+
+	CODE  TYPE  DEFAULT	DESCRIPTION
+
+	bs    i     0		device block size (0 if variable)
+	dn    i     none	density (bpi)
+	dt    s     generic	drive type
+	fs    i     0		filemark size (Kb)
+	mr    i     65535	maximum record size
+	or    i     63360	optimum record size
+	rs    i     0		record gap size (bytes)
+	ts    i     0		tape capacity (Mb)
+	tt    s     unknown	tape type
+
+	al    s     none	device allocation info
+	dv    s     required	no-rewind device file
+	rd    s     none	rewind device file
+	so    s     none	status output device file or socket
+
+	bo    b     no		BSF positions to BOF
+	fc    b     no		device does a FSF on CLRO
+	ir    b     no		treat all read errors as EOF
+	nb    b     no		device cannot backspace
+        nf    b     no          rewind and space forward to backspace file
+	np    b     no		disable all positioning ioctls
+	ow    b     no		backspace and overwrite EOT at append
+	re    b     no		read at EOT returns ERR
+	rf    b     no		use BSR,FSR to space over filemarks
+	se    b     no		device will position past EOT in a read
+	sk    b     no		skip record forward after a read error
+	wc    b     no		OPWR-CLWR at EOF writes null file
+
+	bf    i     builtin	BSF ioctl code
+	br    i     builtin	BSR ioctl code
+	ct    i     builtin	MTIOCTOP code
+	ff    i     builtin	FSF ioctl code
+	fr    i     builtin	FSR ioctl code
+	ri    i     builtin	REW ioctl code
+
+
+3.3. Host Level Device Operations
+
+	open				(FILE I/O OPERATIONS)
+	close
+	read
+	write
+	wait		(not used)
+
+	FSR				(POSITIONING IOCTLS)
+	BSR
+	FSF
+	BSF
+	REW
+
+	WEOF		(not used)
+	EOM		(not used) (SunOS - space to end of media)
+
+
+3.4. Device Characteristics
+
+	open		No known system/device dependencies.
+
+	close		For a tape opened read-only, close positions to after
+			the filemark of the current file on some SysV systems.
+			This makes it impossible to rewind a device opened
+			no-rewind (after the open/rewind/close the tape is
+			left at the beginning of the second file).  On such
+			systems the tape can only be rewound (left rewound
+			at close) by opening and closing the rewind device.
+
+			It is assumed that when a tape opened for writing is
+			closed an EOT mark is written, and the tape is left
+			positioned after the filemark of the last file
+			written, ready to write the next file (true on all
+			known systems, with some variations in how the EOT
+			is represented).
+
+	read		A read where the record size exceeds the size of the
+			read request is assumed to be an error.
+
+			A read at end of file should return a zero byte
+			count and leave the file positioned after the file
+			mark.  Some devices may return ERR when a tape mark
+			is read.
+
+			If the device block size is zero it is assumed that
+			records can be any size up to the max record size,
+			and that successive records can vary in size.
+
+			If the device block size is nonzero it is assumed
+			that the byte count for read and write requests (the
+			record size) should be a multiple of the device
+			block size.  Multiple physical device blocks are
+			read or written to satisfy an i/o request.  On a
+			read, all notion of the record size is lost, i.e.,
+			a read of N blocks will return N blocks regardless
+			of the blocking factor used in a write.
+
+			A read at EOT may leave the tape positioned after
+			the file mark just read or may result in a zero byte
+			count being returned with no affect on the tape
+			position.
+
+			Following a read error when reading a data record the
+			tape may be left 1) before the bad record, 2) after
+			the bad record, 3) in an undefined position, e.g.,
+			partway through the record.
+
+	write		For variable record devices each write is assumed
+			to write a tape record the size of the output buffer.
+			For fixed block devices it is assumed that the size
+			of the write request must be an integral multiple of
+			the block size, and that multiple physical device
+			blocks will be written to satisfy the request.
+
+	wait		Wait (asynchronous i/o) is not currently used and
+			is emulated in the driver.  Some systems (Ultrix
+			and SunOS 4.1) provide facilities for multi-buffered
+			asynchronous i/o which the iraf driver may make use
+			of in the future.
+
+	FSR		Forward skip record.  Some systems permit a FSR over
+			a filemark and some do not.
+
+	BSR		Backward skip record.  Some systems permit a BSR over
+			a filemark and some do not.
+
+	FSF		Forward skip file.  The tape is assumed to be left
+			positioned after the filemark and before the first
+			record of the next file.
+
+	BSF		Backward skip file.  Some systems leave the tape
+			positioned on the BOT side of the filemark, others
+			leave the tape positioned to just before the first
+			record of the file following the filemark.  A BSF with
+			a zero count may or may not rewind the current file.
+
+	REW		Rewinds the tape, leaving the tape positioned to BOT.
+			No known system/device dependencies.  See the note
+			on the "close" operation, above.
+
+	WEOF		Not currently used.
+
+
+3.5. Driver Options
+
+	overwrite filemark (reel tapes only)
+	disable all backspace operations
+	skip record forward after a read error
+	i/o logging to specified output device
+
+
+3.6. Driver Functions
+
+	ZZOPMT - open and position to desired file
+	    zmtopen
+	    zmtclose
+	    zmtposition
+		zmtrew
+		zmtfsf
+		zmtbsf
+		zmtfsr
+		zmtbsr
+
+	ZZCLMT - close
+	    zmtclose
+
+	ZZRDMT - read next record
+	    read
+	    zmtbsf
+
+	ZZWRMT - write record
+	    write
+
+	ZZWTMT - wait for i/o and return byte count
+
+	ZZRWMT - rewind tape
+	    zmtopen
+	    zmtclose
+
+	ZZSTMT - return device parameters
+
+
+3.7. Notes on Specific Devices
+
+3.7.1 Device Characteristics
+
+3.7.2 Exabyte Drivers
+
+	SunOS 4.1 ST Driver
+	    BSF positions to BOT side of filemark (conventional behavior).
+	    Driver does not allow positioning to after EOT.
+	    Bug where driver loses track of file position is fixed.
+
+	SunOS 4.0.3 ST Driver
+	    BSF positions to first record of file following file mark.
+	    BSF 0 rewinds the current file.
+	    Driver does not allow positioning to after EOT, i.e., when
+		positioning to EOT, after two successive zero reads,
+		it is NOT necessary to backspace over the filemark.
+	    Driver tries to keep track of current file position but has
+		a bug which causes it to zero its counter when appending
+		a file to a tape within open/close.
+	    This bug has two ramifications:
+		o  Will not position to a file before where it thinks
+		   BOT is.
+		o  Will rewind to get to file it thinks is at BOT.
+
+	Earlier (SunOS 3.X) Sun drivers defaulted to fixed block mode, and
+	    probably had other significant differences from the current
+	    round of drivers.
+
+	Ciprico RT Driver
+	    Both fixed and variable block device entries.
+	    rfsd_pr_errlog can get set to 1|2|8 in driver (/dev/mem) to
+		turn on status messages.  Variable is commonly set to 2
+		to get tape position readouts, but this will interfere
+		with iraf networking.
+	    BSF positions to BOT side of filemark (conventional behavior).
+	    EOT is indicated by two file marks, and a read of the second mark
+		will leave the tape positioned to after the mark, requiring
+		a backspace to position to EOT (conventional behavior).
+	    Status (NOP) ioctl implemented, but file/record count always zero.
+
+	Sparcstation (4.1) ST driver
+	    BSR over a filemark confuses the driver - looks like it thinks
+		it saw the EOF when reading in the forward direction.
+		The next read returns EOF and then the real EOF is read,
+		so 2 EOFs in a row are seen (looks like EOT).  The file
+		count in the driver gets messed up.
+	    BSF causes all subsequent reads to return immediately with ERR.
+		One (sometimes two!) REW ioctls are required to clear.
+	    FSF and FSR work.
+
+	R-Squared driver for Exabyte (Sun-3 running 4.1)
+	    Opens drive in fixed block mode.
+	    Read at EOF returns IOERR (driver bug).
+	    Status (NOP) ioctl not implemented.
+
+
+3.8. Pseudocode for Driver Functions
+
+
+# ZZOPMT -- Open the magtape device and position to the given file.
+
+procedure zzopmt (device, acmode, oldrec, oldfile, newfile, chan)
+begin
+	# Open device for positioning.
+	open no-rewind raw device read-only
+
+	# Do not move the tape if opened newfile=0.
+	if (newfile != 0) {
+	    # Rewind to get to known position if position uncertain.
+	    if (current position unknown) {
+		rewind tape
+		oldrec = 1
+		oldfile = 1
+	    }
+
+	    # Position to given file.
+	    newfile = zmtfpos (chan, oldfile, oldrec, newfile)
+	}
+
+	# Reopen if necessary for i/o.
+	if (need write access)
+	    reopen device for writing
+end
+
+
+# ZZCLMT -- Close the magtape device.
+
+procedure zzclmt (chan, acmode, nrecords, nfiles, status)
+begin
+	close device
+
+	nfiles = 0
+	nrecords = 0
+
+	if (acmode == read && device: FSF on close read-only)
+	    nfiles = 1
+	else if (acmode == write && !(at BOF && device: no EOF if no write))
+	    nfiles = 1
+end
+
+
+# ZZRDMT -- Initiate a read of the next tape record into the user buffer.
+
+procedure zzrdmt (chan, buf, maxbytes)
+begin
+	physically read tape
+	save read status for zzwtmt
+end
+
+
+# ZZWRMT -- Initiate a write of the next tape record.
+
+procedure zzwrmt (chan, buf, nbytes)
+begin
+	physically write record
+	save write status for zzwtmt
+end
+
+
+# ZZWTMT -- Wait for i/o to complete and return the byte count and the
+# change to the tape position in files and records.
+
+procedure zzwtmt (chan, nrecords, nfiles, nbytes)
+begin
+	nrecords = 0
+	nfiles = 0
+
+	if (io error) {
+	    nbytes = ERR
+	} else if (read 0 bytes) {
+	    if (at BOF) {
+		# At EOT.
+		if (device: read at EOT will go past EOT)
+		    if (device: cannot backspace) {
+			zmtrew()
+			nfiles = -ARB
+			nrecords = -ARB
+		    } else
+			zmtbsf (1)
+	    } else
+		nfiles = 1
+	} else {
+	    nrecords = 1
+	    clear at BOF flag
+	}
+end
+
+
+# ZZRWMT -- Rewind the named device.
+
+procedure zzrwmt (device, status)
+begin
+	if (device: rewind device specified)
+	    close (open (rewind-at-close device read-only))
+	else {
+	    open no rewind device
+	    zmtrew
+	    close
+	}
+end
+
+
+# ZMTFPOS -- Position to the indicated file.
+
+int procedure zmtfpos (chan, oldfile, oldrec, newfile)
+begin
+	# Already positioned to desired file; don't do anything.
+	if (newfile == oldfile && oldrec == 1)
+	    return (newfile)
+
+	# Move the tape.
+	if (newfile == 1) {
+	    # Rewind.
+	    zzrwmt()
+	} else if (newfile <= oldfile && newfile != EOT) {
+	    # Backspace to desired file.
+	    if (device: cannot backspace) {
+		zmtrew()
+		oldfile = 1
+		oldrec = 1
+		goto fwd_
+	    } else if (device: BSF positions to BOF) {
+		zmtbsf (oldfile - newfile)
+	    } else {
+		zmtbsf (oldfile - newfile + 1)
+		zmtfsf (1)
+	    }
+	} else {
+	    # Space forward to desired file or EOT.
+fwd_	    while (oldfile < newfile || newfile == EOT) {
+		n = read (next record)
+		if (n == 0 && oldrec == 1) {
+		    # At EOT.
+		    if (device: read at EOT will go past EOT) {
+			if (device: cannot backspace) {
+			    newfile = oldfile
+			    zmtrew()
+			    oldfile = 1
+			    oldrec = 1
+			    goto fwd_
+			} else
+			    zmtbsf (1)
+		    }
+		    if (writing && device: overwrite EOF) {
+			if (!device: cannot backspace) {
+			    if (device: BSF positions to BOF)
+				zmtbsf (0)
+			    else {
+				zmtbsf (1)
+				zmtfsf (1)
+			    }
+			}
+		    }
+		    break
+		} else if (n > 0)
+		    zmtfsf (1)
+
+		oldfile++
+		oldrec = 1
+	    }
+	    newfile = oldfile
+	}
+
+	return (newfile)
+end
diff --git a/sys/mtio/mkpkg b/sys/mtio/mkpkg
new file mode 100644
index 00000000..2c0ce77f
--- /dev/null
+++ b/sys/mtio/mkpkg
@@ -0,0 +1,48 @@
+# Make the MTIO routines.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+zzdebug:
+	$checkout libsys.a lib$
+	$update   libsys.a
+	$checkin  libsys.a lib$
+
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+	$omake	zzdebug.x
+	$link	-z zzdebug.o
+	;
+
+libsys.a:
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+
+	mtalloc.x	mtio.h <time.h>
+	mtcache.x	mtcache.com mtio.com mtio.h <config.h> <error.h>
+	mtcap.x	mtio.h
+	mtclean.x	mtio.h <finfo.h> <xalloc.h>
+	mtdealloc.x	<error.h>
+	mtdevall.x	<knet.h> <xalloc.h>
+	mtencode.x	
+	mtfile.x	
+	mtfname.x	mtio.h
+	mtglock.x	mtio.h
+	mtgtyopen.x	mtio.h
+	mtlocknam.x	mtio.h <chars.h> <ctype.h>
+	mtneedf.x	mtio.h
+	mtopen.x	mtio.com mtio.h <config.h> <fset.h> <knet.h> <mach.h>
+	mtparse.x	mtio.h <config.h> <ctype.h>
+	mtpos.x	mtio.h
+	mtrdlock.x	mtio.com mtio.h <config.h>
+	mtrewind.x	mtio.h <error.h>
+	mtskip.x	<fset.h>
+	mtstatus.x	
+	mtupdlock.x	mtio.com mtio.h <config.h> <knet.h> <mach.h>
+	zardmt.x	mtio.com mtio.h <config.h> <knet.h>
+	zawrmt.x	mtio.com mtio.h <config.h> <knet.h>
+	zawtmt.x	mtio.com mtio.h <config.h> <knet.h>
+	zclsmt.x	mtio.com mtio.h <config.h> <knet.h>
+	zopnmt.x	mtio.com mtio.h <config.h> <knet.h>
+	zsttmt.x	mtio.com mtio.h <config.h> <fio.h> <knet.h> <mach.h>
+	;
diff --git a/sys/mtio/mtalloc.x b/sys/mtio/mtalloc.x
new file mode 100644
index 00000000..2e21be1c
--- /dev/null
+++ b/sys/mtio/mtalloc.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<time.h>
+include	"mtio.h"
+
+# MTALLOCATE -- "Allocate" a tape drive by writing the lock file.  We do
+# not actually call the OS to physically allocate the drive; that is done
+# by our caller (e.g., xallocate, in etc$xalloc.x).  The lock file is no longer
+# used to gain exclusive access to the device; it is now used only to keep
+# track of the tape position after process termination.
+
+procedure mtallocate (mtname)
+
+char	mtname[ARB]			#I device name
+
+int	fd, junk
+pointer	sp, lockfile, mtowner, userid, timestr, device
+errchk	open, mtparse
+long	clktime()
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (lockfile, SZ_FNAME, TY_CHAR)
+	call salloc (mtowner, SZ_FNAME, TY_CHAR)
+	call salloc (userid, SZ_FNAME, TY_CHAR)
+	call salloc (timestr, SZ_TIME, TY_CHAR)
+
+	# Get name of lockfile used by the given device.
+	call mtparse (mtname, Memc[device], SZ_FNAME, junk, junk, junk, 0)
+	call mt_glock (mtname, Memc[lockfile], SZ_FNAME)
+
+	# Open lock file and write out unit, owner, time allocated, etc.
+	# Overwrite any existing lockfile.  We are called only after
+	# physically allocating the device at the host system level
+	# (and are not called if the device is already allocated), so this
+	# is safe.
+
+	iferr (call delete (Memc[lockfile]))
+	    ;
+	fd = open (Memc[lockfile], NEW_FILE, TEXT_FILE)
+
+	call cnvtime (clktime(long(0)), Memc[timestr], SZ_TIME)
+	call getuid (Memc[userid], SZ_FNAME)
+
+	call fprintf (fd, "# Magtape unit %s status %s user %s\n")
+	    call pargstr (Memc[device])
+	    call pargstr (Memc[timestr])
+	    call pargstr (Memc[userid])
+
+	# Assume initially that the tape position is undefined.  This will
+	# cause the tape to be rewound on the first open, and thereafter
+	# the position will be defined unless an i/o error occurs.
+
+	call fprintf (fd, "file = -1\n")
+	call fprintf (fd, "record = -1\n")
+	call fprintf (fd, "nfiles = 0\n")
+	call fprintf (fd, "tapeused = 0 Kb\n")
+	call fprintf (fd, "pflags = 0\n")
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtcache.com b/sys/mtio/mtcache.com
new file mode 100644
index 00000000..b3533f3f
--- /dev/null
+++ b/sys/mtio/mtcache.com
@@ -0,0 +1,9 @@
+# MTIO savepos cache.
+
+int	c_modified[SZ_CACHE]
+int	c_mtdes[LEN_DEVPOS,SZ_CACHE]
+char	c_device[SZ_DEVICE,SZ_CACHE]
+char	c_iodev[SZ_IODEV,SZ_CACHE]
+char	c_lkname[SZ_LKNAME,SZ_CACHE]
+
+common	/mtcacm/ c_modified, c_mtdes, c_device, c_iodev, c_lkname
diff --git a/sys/mtio/mtcache.x b/sys/mtio/mtcache.x
new file mode 100644
index 00000000..87b68bdb
--- /dev/null
+++ b/sys/mtio/mtcache.x
@@ -0,0 +1,199 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<error.h>
+include	"mtio.h"
+
+.help mtcache
+.nf _________________________________________________________________________
+MTCACHE -- Cache the magtape position (file and record) between file opens.
+The lock file is used for permanent storage, but is only read and written
+when necessary.  When multiple tape files are accessed by a single task the
+tape position is kept in the cache between successive MTOPEN - CLOSE file
+accesses.
+
+	 mt_getpos (mtname, mt)
+	mt_savepos (mt)
+	   mt_sync (status)
+       mt_clrcache ()
+
+SAVEPOS updates the tape descriptor in the cache; SYNC updates the cache
+on disk in the lock file.  SYNC is automatically called at task termination
+time (including during abnormal termination), but is not normally called
+when a tape file is closed.
+
+ERROR RECOVERY is a bit tricky.  If error recovery takes place the ONERROR
+procedures are called first thing, before FIO cleanup takes place.  That means
+that SYNC will be called while the magtape channel is still open, and before
+SAVEPOS has been called by ZCLSMT (which is called by fio_cleanup which is
+called by the main).  If an error occurs on a magtape channel we want to
+record an undefined file position.  We must see that SAVEPOS is called at
+file open time to mark the cache for updating, causing SYNC to write an
+undefined position lock file when the error occurs.  ZCLSMT, when called
+during error recovery, should set the position to undefined but need not
+sync the cache.
+
+The cache is invalidated at process startup time and at SYNC time in case
+the user loads a new tape or runs a different magtape process while the
+current process is idling between tasks.  In other words, the cache is only
+valid while the task using it is executing.
+.endhelp ___________________________________________________________________
+
+define	SZ_CACHE	MT_MAXTAPES
+
+
+# MT_GETPOS -- Return the device position descriptor of a drive given its
+# unit number.
+
+procedure mt_getpos (mtname, mt)
+
+char	mtname[ARB]		#I device name
+int	mt			#I MTIO descriptor
+
+int	slot
+bool	streq()
+include	"mtcache.com"
+include	"mtio.com"
+
+begin
+	# First look in the cache.
+	for (slot=1;  slot <= SZ_CACHE;  slot=slot+1)
+	    if (streq (MT_LKNAME(mt), c_lkname[1,slot])) {
+		call amovi (c_mtdes[1,slot], MT_DEVPOS(mt), LEN_DEVPOS)
+		call strcpy (c_device[1,slot], MT_DEVICE(mt), SZ_DEVICE)
+		call strcpy (c_lkname[1,slot], MT_LKNAME(mt), SZ_LKNAME)
+		call strcpy (c_iodev[1,slot], MT_IODEV(mt), SZ_IODEV)
+		return
+	    }
+
+	# Get the current position from the lock file, if there is one.
+	call mt_read_lockfile (mtname, mt)
+end
+
+
+# MT_SAVEPOS -- Save the current position in the cache.  The entire descriptor
+# is saved since most of the information therein is needed for SYNC, even
+# though only a portion of the information will be used by GETPOS.
+
+procedure mt_savepos (mt)
+
+int	mt			#I MTIO descriptor
+
+int	prev, slot
+bool	streq(), strne()
+extern	mt_sync()
+include	"mtcache.com"
+include	"mtio.com"
+data	prev /0/
+define	cache_ 91
+
+begin
+	# Post termination handler to sync the cache at task termination time.
+	call onerror (mt_sync)
+
+	# Do not update the cache if the file position is undefined.
+	if (MT_FILNO(mt) <= 0)
+	    return
+
+	# Are we updating an entry already in the cache?
+	for (slot=1;  slot <= SZ_CACHE;  slot=slot+1)
+	    if (streq (MT_LKNAME(mt), c_lkname[1,slot]))
+		goto cache_
+
+	# Add the entry to the cache.  Resync the contents of the old slot
+	# if it is for a different drive and has been modified since it was
+	# last synced.
+
+	slot = prev + 1
+	if (slot > SZ_CACHE)
+	    slot = 1
+	prev = slot
+
+	if (c_modified[slot] == YES && strne(MT_LKNAME(mt),c_lkname[1,slot])) {
+	    call amovi (c_mtdes[1,slot], MT_DEVPOS(0), LEN_DEVPOS)
+	    call strcpy (c_device[1,slot], MT_DEVICE(0), SZ_DEVICE)
+	    call strcpy (c_lkname[1,slot], MT_LKNAME(0), SZ_LKNAME)
+	    call strcpy (c_iodev[1,slot], MT_IODEV(0), SZ_IODEV)
+	    call mt_update_lockfile (0)
+	}
+
+cache_
+	call amovi (MT_DEVPOS(mt), c_mtdes[1,slot], LEN_DEVPOS)
+	call strcpy (MT_DEVICE(mt), c_device[1,slot], SZ_DEVICE)
+	call strcpy (MT_LKNAME(mt), c_lkname[1,slot], SZ_LKNAME)
+	call strcpy (MT_IODEV(mt), c_iodev[1,slot], SZ_IODEV)
+	c_modified[slot] = YES
+end
+
+
+# MT_SYNC -- Update all modified entries in the cache.  Set the position to
+# undefined (file=-1) if we are called during error recovery.  We are called
+# at task termination by the IRAF Main.
+
+procedure mt_sync (status)
+
+int	status			#I task termination status
+
+int	slot
+include	"mtcache.com"
+include	"mtio.com"
+
+begin
+	# Update the .lok files of any active devices.
+	for (slot=1;  slot <= SZ_CACHE;  slot=slot+1) {
+	    if (c_modified[slot] == YES) {
+		# If called during error recovery mark the file position undef.
+		if (status != OK) {
+		    call amovi (c_mtdes[1,slot], MT_DEVPOS(0), LEN_DEVPOS)
+		    MT_FILNO(0) = -1
+		    MT_RECNO(0) = -1
+		    call amovi (MT_DEVPOS(0), c_mtdes[1,slot], LEN_DEVPOS)
+		}
+
+		# Update the lockfile.
+		call amovi (c_mtdes[1,slot], MT_DEVPOS(0), LEN_DEVPOS)
+		call strcpy (c_device[1,slot], MT_DEVICE(0), SZ_DEVICE)
+		call strcpy (c_lkname[1,slot], MT_LKNAME(0), SZ_LKNAME)
+		call strcpy (c_iodev[1,slot], MT_IODEV(0), SZ_IODEV)
+
+		# Ignore errors if we are called during error recovery.
+		iferr (call mt_update_lockfile (0))
+		    if (status == OK)
+			call erract (EA_ERROR)
+
+		c_modified[slot] = NO
+		c_device[1,slot] = EOS
+	    }
+	}
+
+	# Invalidate the cache when a task terminates.
+	call mt_clrcache()
+
+	# If we are called during error recovery, set the file position for
+	# all open tapes to undefined to prevent mt_savepos from being called
+	# by zclsmt when the tape file is closed during error recovery.
+
+	if (status != OK)
+	    do slot = 1, MT_MAXTAPES {
+		MT_FILNO(slot) = -1
+		MT_RECNO(slot) = -1
+	    }
+end
+
+
+# MT_CLRCACHE -- Initialize the cache.
+
+procedure mt_clrcache()
+
+int	slot
+include	"mtcache.com"
+
+begin
+	for (slot=1;  slot <= SZ_CACHE;  slot=slot+1) {
+	    c_modified[slot] = NO
+	    c_device[1,slot] = EOS
+	    c_lkname[1,slot] = EOS
+	    c_iodev[1,slot] = EOS
+	    call aclri (c_mtdes[1,slot], LEN_DEVPOS)
+	}
+end
diff --git a/sys/mtio/mtcap.x b/sys/mtio/mtcap.x
new file mode 100644
index 00000000..d3f859fa
--- /dev/null
+++ b/sys/mtio/mtcap.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "mtio.h"
+
+# MTCAP -- Return the tapecap descriptor for the given magtape device.  The
+# device is specified by the full specification (as passed to mtopen), hence
+# there may be tapecap attributes in the device specification which override
+# those in the tapecap file.
+
+pointer procedure mtcap (mtname)
+
+char	mtname[ARB]			#I magtape device specification
+
+int	fileno, recno
+pointer	sp, device, devcap, cache_gty, gty
+pointer	mt_gtyopen(), gtycaps(), gtyopen()
+errchk	mtparse, mt_gtyopen
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_DEVICE, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	call mtparse (mtname, Memc[device], SZ_DEVICE, fileno, recno,
+	    Memc[devcap], SZ_DEVCAP)
+
+	# Do not return the cached MTIO device entry, as we do not want the
+	# application to close this with gtyclose.  Open a new GTY descriptor
+	# using the capabilities in the cached entry.
+
+	cache_gty = mt_gtyopen (Memc[device], Memc[devcap])
+	gty = gtyopen ("", "", Memc[gtycaps(cache_gty)])
+
+	call sfree (sp)
+	return (gty)
+end
diff --git a/sys/mtio/mtclean.x b/sys/mtio/mtclean.x
new file mode 100644
index 00000000..5de01a7e
--- /dev/null
+++ b/sys/mtio/mtclean.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<finfo.h>
+include	<xalloc.h>
+include	"mtio.h"
+
+# MTCLEAN -- Clean the lock file area.  This routine is called periodically
+# by the system (e.g. during CL startup) to scan the lock file area and
+# deleted old lock files.  This prevents old lock files which are no longer
+# valid from erroneously being used to indicate the current tape position.
+#
+# What mtclean does is similar to "delete tmp$mt*.lok" except that, since all
+# users store lok files in the same area, we don't want to delete all the
+# files indiscriminately.  The default action is to delete only files for
+# unallocated devices, or for devices allocated to the current user for which
+# the lok file is more than STALE seconds old.  It is harmless to delete a
+# lok file unnecessarily in that MTIO will recover automatically, but doing
+# so will force the tape to be rewound to regain a known position.
+
+procedure mtclean (level, stale, out)
+
+int	level			#I 0 for default; 1 to delete all .lok files
+int	stale			#I delete lok file if older than stale seconds
+int	out			#I if nonzero, print messages to this file
+
+int	fd, status
+pointer	list, ip, cp, device
+pointer	sp, fname, owner, template, lbuf
+long	fi[LEN_FINFO]
+
+pointer	fntopn()
+long	clktime()
+int	gstrmatch(), xdevowner()
+int	open(), getline(), finfo(), fntgfn()
+define	del_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (owner, SZ_FNAME, TY_CHAR)
+	call salloc (template, SZ_FNAME, TY_CHAR)
+
+	# Get file name template matching all lock files.
+	call sprintf (Memc[template], SZ_FNAME, "%s%s*%s")
+	    call pargstr (LOCKLDIR)
+	    call pargstr (LOCKFILE)
+	    call pargstr (LOCKEXTN)
+
+	# Open a file list.
+	list = fntopn (Memc[template])
+
+	# Examine each file in turn and delete if delete criteria satisfied.
+	while (fntgfn (list, Memc[fname], SZ_FNAME) != EOF) {
+
+	    # If level is nonzero (force-delete) delete unconditionally.
+	    if (level != 0)
+		goto del_
+
+	    # Open lok file and get device name.
+	    iferr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE))
+		next
+	    if (getline (fd, Memc[lbuf]) == EOF) {
+		call close (fd)
+		goto del_
+	    }
+	    if (gstrmatch (Memc[lbuf], "unit ", status, ip) <= 0) {
+		call close (fd)
+		goto del_
+	    }
+	    device = lbuf + ip
+	    for (cp=device;  Memc[cp] != EOS && Memc[cp] != ' ';  cp=cp+1)
+		;
+	    Memc[cp] = EOS
+	    call close (fd)
+
+	    # Determine if the device is currently allocated.  If the device
+	    # is not allocated delete the lok file unconditionally.  If the
+	    # device is allocated to someone else leave the lok file alone.
+	    # If the lok file is allocated to the current user delete it if
+	    # the file is older than the stale value.
+
+	    status = xdevowner (Memc[device], Memc[owner], SZ_FNAME)
+	    switch (status) {
+	    case DV_DEVFREE:
+		goto del_
+
+	    case DV_DEVINUSE:
+		# Do nothing.
+
+	    case DV_DEVALLOC:
+		# Delete the file if older than the stale value.
+		if (finfo (Memc[fname], fi) == ERR)
+		    goto del_
+
+		if (clktime(FI_MTIME(fi)) > stale) {
+		    # Delete the file.
+del_		    if (out != NULL) {
+			call fprintf (out, "delete lok file %s\n")
+			    call pargstr (Memc[fname])
+		    }
+		    iferr (call delete (Memc[fname]))
+			;
+		}
+	    }
+	}
+
+	call fntcls (list)
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtdealloc.x b/sys/mtio/mtdealloc.x
new file mode 100644
index 00000000..2f98a972
--- /dev/null
+++ b/sys/mtio/mtdealloc.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# MTDEALLOCATE -- Deallocate a previously allocated tape drive.  To deallocate
+# a drive we try to rewind (any errors, such as drive offline, will result in a
+# warning message), and then delete the lockfile.  We do not call up the OS to
+# deallocate the drive; that is done at a higher level, usually XDEALLOCATE
+# (in etc$xalloc.x).
+
+procedure mtdeallocate (mtname, rewind_tape)
+
+char	mtname[ARB]		#I magtape specification
+int	rewind_tape		#I rewind before deallocating drive
+
+pointer	sp, lockfile
+errchk	mt_glock, syserrs
+
+begin
+	call smark (sp)
+	call salloc (lockfile, SZ_FNAME, TY_CHAR)
+
+	if (rewind_tape == YES)
+	    iferr (call mtrewind (mtname, NO))
+		call erract (EA_WARN)
+
+	call mt_sync (OK)
+
+	call mt_glock (mtname, Memc[lockfile], SZ_FNAME)
+	iferr (call delete (Memc[lockfile]))
+	    ;
+
+	call mt_clrcache()
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtdevall.x b/sys/mtio/mtdevall.x
new file mode 100644
index 00000000..3f5620d8
--- /dev/null
+++ b/sys/mtio/mtdevall.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<xalloc.h>
+include	<knet.h>
+
+# MT_DEVALLOCATED -- Verify that the named host magtape device is allocated.
+# The IRAF device name must already have been translated to a host device
+# name before we are called.
+
+int procedure mt_devallocated (iodev)
+
+char	iodev[ARB]			#I host name of device
+pointer	sp, pk_iodev, pk_owner
+int	status
+
+begin
+	call smark (sp)
+	call salloc (pk_iodev, SZ_FNAME, TY_CHAR)
+	call salloc (pk_owner, SZ_FNAME, TY_CHAR)
+
+	# The following assumes that the node! prefix is in iodev.
+	call strpak (iodev, Memc[pk_iodev], SZ_FNAME)
+	call zdvown (Memc[pk_iodev], Memc[pk_owner], SZ_FNAME, status)
+
+	call sfree (sp)
+	if (status == DV_DEVALLOC)
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/mtio/mtencode.x b/sys/mtio/mtencode.x
new file mode 100644
index 00000000..b6bf6b0f
--- /dev/null
+++ b/sys/mtio/mtencode.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MTENCODE -- Construct a full magtape device specification.  This routine is
+# the opposite of MTPARSE.  If the file and record numbers are to be omitted
+# from the output mtname they should be passed as ERR.
+
+procedure mtencode (outstr, maxch, device, fileno, recno, attrl)
+
+char	outstr[ARB]			#O magtape device specification
+int	maxch				#I max chars out
+char	device[ARB]			#I device name (incl node)
+int	fileno, recno			#I file and record numbers, or ERR
+char	attrl[ARB]			#I tapecap attributes
+
+int	op
+int	gstrcpy()
+int	itoc()
+
+begin
+	if (fileno != ERR || recno != ERR || attrl[1] != EOS) {
+	    op = gstrcpy (device, outstr, maxch) + 1
+	    outstr[op] = '[';  op = op + 1 
+	    if (fileno != ERR) {
+		if (fileno == EOT)
+		    op = op + gstrcpy ("EOT", outstr[op], maxch-op+1)
+		else
+		    op = op + itoc (fileno, outstr[op], maxch-op+1)
+	    }
+	    if (recno != ERR) {
+		outstr[op] = '.';  op = op + 1
+		op = op + itoc (recno, outstr[op], maxch-op+1)
+	    }
+	    if (attrl[1] != EOS) {
+		if (attrl[1] != ':') {
+		    outstr[op] = ':'
+		    op = op + 1
+		}
+		op = op + gstrcpy (attrl, outstr[op], maxch-op+1)
+	    }
+	    outstr[op] = ']';  op = op + 1
+	    outstr[op] = EOS
+	} else
+	    call strcpy (device, outstr, maxch)
+end
diff --git a/sys/mtio/mtfile.x b/sys/mtio/mtfile.x
new file mode 100644
index 00000000..c07a550b
--- /dev/null
+++ b/sys/mtio/mtfile.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	SZ_NODENAME	9
+
+# MTFILE -- Test a filename to see if it is the name of a magtape file.
+# A magtape file is characterized by the filename prefix "mt" (ingnoring
+# the nodename prefix if any). 
+
+int procedure mtfile (fname)
+
+char	fname[ARB]			#I filename to be tested
+
+int	ip, junk
+char	nodename[SZ_NODENAME]
+int	ki_extnode()
+
+begin
+	ip = ki_extnode (fname, nodename, SZ_NODENAME, junk) + 1
+
+	if (fname[ip] == 'm' && fname[ip+1] == 't')
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/mtio/mtfname.x b/sys/mtio/mtfname.x
new file mode 100644
index 00000000..7bb92408
--- /dev/null
+++ b/sys/mtio/mtfname.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "mtio.h"
+
+# MTFNAME -- Edit the input mtname (magtape file specification) to reference
+# the numbered file.  The edited mtname is returned in the output string.
+
+procedure mtfname (mtname, fileno, outstr, maxch)
+
+char	mtname[ARB]			#I magtape device specification
+int	fileno				#I desired file number
+char	outstr[ARB]			#O output mtname string
+int	maxch				#I maxch chars out
+
+int	ofileno, orecno
+pointer	sp, device, devcap
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_DEVICE, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	call mtparse (mtname, Memc[device], SZ_DEVICE, ofileno, orecno,
+	    Memc[devcap], SZ_DEVCAP)
+	call mtencode (outstr, maxch,
+	    Memc[device], fileno, orecno, Memc[devcap])
+
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtglock.x b/sys/mtio/mtglock.x
new file mode 100644
index 00000000..a1abfef5
--- /dev/null
+++ b/sys/mtio/mtglock.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "mtio.h"
+
+# MT_GLOCK -- Return the lockfile name for the given magtape device
+# specification.  There can be many logical devices, defined in the tapecap
+# file, which refer to the same physical device.  All entries for the same
+# physical device share the same i/o device file and lock file.  If the
+# physical device is on a remote node the tapecap file on that node should
+# be accessed, and the node name must be included in the lockfile file name,
+# although the lock file is always written on the local node.
+
+procedure mt_glock (mtname, lockfile, maxch)
+
+char	mtname[ARB]			#I full magtape device spec
+char	lockfile[ARB]			#O receives lockfile name
+int	maxch				#I max chars out
+
+int	filno, recno
+pointer	sp, lkname, device, devcap, gty
+errchk	mt_gtyopen, syserrs
+int	gtygets()
+pointer	mt_gtyopen()
+
+begin
+	call smark (sp)
+	call salloc (lkname, SZ_FNAME, TY_CHAR)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	call mtparse (mtname,
+	    Memc[device], SZ_FNAME, filno, recno, Memc[devcap], SZ_DEVCAP)
+
+	# The "lk" capability specifies the lock file root name.
+	gty = mt_gtyopen (Memc[device], Memc[devcap])
+	if (gtygets (gty, "lk", Memc[lkname], SZ_FNAME) <= 0) {
+	    call eprintf ("missing `lk' parameter in tapecap entry for %s\n")
+		call pargstr (mtname)
+	    call syserrs (SYS_MTTAPECAP, mtname)
+	}
+
+	call ki_xnode (Memc[device], Memc[lkname], SZ_FNAME)
+	call mt_lockname (Memc[lkname], lockfile, maxch)
+
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtgtyopen.x b/sys/mtio/mtgtyopen.x
new file mode 100644
index 00000000..489fba2d
--- /dev/null
+++ b/sys/mtio/mtgtyopen.x
@@ -0,0 +1,129 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "mtio.h"
+
+# MT_GTYOPEN -- Given a logical device name, open the tapecap file and extract
+# the entry for the named device into an open GTY descriptor.  The descriptor
+# pointer is returned as the function value.  The last entry accessed is
+# cached indefinitely so that repeated references cause the tapecap file to
+# be scanned only once.
+#
+# The tapecap file may be defined in the user environment, otherwise it
+# defaults to the compiled in default TAPECAP (dev$tapecap).  The format
+# of the "tapecap" environment variable is "filename[:devcap]", e.g.
+#
+#	home$tapecap:so
+#
+#
+# would cause the file home$tapecap to be used as the tapecap file, adding the
+# device capabilities :so to each tapecap device access (any devcap fields
+# given on the command line will override these).  Either the filename or
+# devcap field may be omitted.  For example,  reset tapecap = ":so"  causes
+# the default tapecap file dev$tapecap to be used, but enables status output
+# logging in each magtape access.
+
+pointer procedure mt_gtyopen (device, ufields)
+
+char	device[ARB]			#I local device name (incl node)
+char	ufields[ARB]			#I optional user tapecap fields
+
+int	len_ufields, junk
+char	c_device[SZ_DEVICE]
+char	c_ufields[SZ_DEVCAP]
+bool	first_time, capseen, remote
+pointer	c_gty, gty, sp, tapecap, devcap, ip, op
+pointer	fname, dname, nname, tname
+
+bool	streq()
+pointer	gtyopen()
+int	envfind(), stridxs(), strlen(), gstrcpy(), ki_gnode()
+errchk	gtyopen, syserrs
+data	first_time /true/
+
+begin
+	# First time initialization.
+	if (first_time) {
+	    c_gty = NULL
+	    first_time = false
+	}
+
+	# Check the cache.
+	if (c_gty != NULL && streq(device,c_device) && streq(ufields,c_ufields))
+	    return (c_gty)
+
+	# Cache miss.  Free the old descriptor.
+	if (c_gty != NULL)
+	    call gtyclose (c_gty)
+
+	call smark (sp)
+	call salloc (tapecap, SZ_DEVCAP, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tname, SZ_PATHNAME, TY_CHAR)
+	call salloc (dname, SZ_FNAME, TY_CHAR)
+	call salloc (nname, SZ_FNAME, TY_CHAR)
+
+	# Get tapecap definition.
+	if (envfind ("tapecap", Memc[tapecap], SZ_DEVCAP) <= 0)
+	    call strcpy (TAPECAP, Memc[tapecap], SZ_DEVCAP)
+
+	# Parse into filename and devcap fields.
+	op = fname
+	capseen = false
+	len_ufields = gstrcpy (ufields, Memc[devcap], SZ_DEVCAP)
+	for (ip=tapecap;  Memc[ip] != EOS;  ip=ip+1) {
+	    if (Memc[ip] == ':' && !capseen) {
+		Memc[op] = EOS
+		op = devcap + len_ufields
+		capseen = true
+	    }
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+	Memc[op] = EOS
+
+	# Supply default filename if none given.
+	if (Memc[fname] == EOS)
+	    call strcpy (TAPECAP, Memc[fname], SZ_PATHNAME)
+
+	# If no node is specified for the tapecap file, access the tapecap
+	# file on the same node as the magtape device file.
+
+	if (stridxs ("!", Memc[fname]) <= 0)
+	    call ki_xnode (device, Memc[fname], SZ_PATHNAME)
+
+	# Get the node name the device is on.
+	remote = (ki_gnode (Memc[fname], Memc[nname], junk) != 0)
+
+	# Get the tapecap device name minus any node prefix.
+	call strcpy (device, Memc[dname], SZ_FNAME)
+	call ki_xnode ("", Memc[dname], SZ_FNAME)
+
+	# Open the tapecap entry.  Try "tapecap.<node>" first then "tapecap".
+	# <node> is the hostname of the host the tape device is on, i.e. the
+	# network server on which the drive is located.  The "tapecap.<node>"
+	# feature allows a shared common IRAF installation to support distinct
+	# tapecap files for different servers, falling back on the standard
+	# tapecap file if no node-specific file is found.
+
+	call strcpy (Memc[fname], Memc[tname], SZ_PATHNAME)
+	call strcat (".", Memc[tname], SZ_PATHNAME)
+	call strcat (Memc[nname], Memc[tname], SZ_PATHNAME)
+
+	iferr (gty = gtyopen (Memc[tname], Memc[dname], Memc[devcap]))
+	    iferr (gty = gtyopen (Memc[fname], Memc[dname], Memc[devcap]))
+		call syserrs (SYS_MTTAPECAP, device)
+	if (gty == NULL)
+	    call syserrs (SYS_MTTAPECAP, device)
+
+	# Update the cache.
+	if (strlen(ufields) <= SZ_DEVCAP) {
+	    call strcpy (device, c_device, SZ_DEVICE)
+	    call strcpy (Memc[devcap], c_ufields, SZ_DEVCAP)
+	    c_gty = gty
+	}
+
+	call sfree (sp)
+	return (gty)
+end
diff --git a/sys/mtio/mtio.com b/sys/mtio/mtio.com
new file mode 100644
index 00000000..8accab3b
--- /dev/null
+++ b/sys/mtio/mtio.com
@@ -0,0 +1,9 @@
+# The MTIO Common.
+
+int	new_mtchan				# flag newly opened channel
+int	mtdev[LEN_MTIODES,MT_MAXTAPES+1]	# integer fields
+char	mtnam[SZ_DEVICE,MT_MAXTAPES+1]		# array of drive names
+char	mtosn[SZ_IODEV,MT_MAXTAPES+1]		# host name for device
+char	mtlkn[SZ_LKNAME,MT_MAXTAPES+1]		# lock file name
+
+common	/mtiocom/ new_mtchan, mtdev, mtnam, mtosn, mtlkn
diff --git a/sys/mtio/mtio.h b/sys/mtio/mtio.h
new file mode 100644
index 00000000..a400a88a
--- /dev/null
+++ b/sys/mtio/mtio.h
@@ -0,0 +1,42 @@
+# MTIO.H --  Magtape i/o interface definitions.  Note that the system config
+# file contains additional definitions (i.e., MT_MAXTAPES).
+
+define	TAPECAP		"dev$tapecap"	# default tapecap file
+define	LOCKLDIR	"tmp$"		# where the lock file goes
+define	LOCKFILE	"mt"		# root lockfile name
+define	LOCKEXTN	".lok"		# lockfile extension
+define	MT_MAGIC	(-5417)		# was zopnmt called by mtopen?
+define	SZ_DEVICE	79		# max length of drive name
+define	SZ_IODEV	79		# max length host device name
+define	SZ_LKNAME	79		# max length lock file mame
+define	SZ_DEVCAP	512		# max command line tapecap chars
+
+# MTIO device descriptor structure.  The device descriptor is implemented
+# as the two dimensional integer array MTDEV, defined in the mtio common.
+# The DEVPOS substructure must agree with the driver, os$zfiomt.c.
+
+define	MT_DEVICE	mtnam[1,$1+1]	# drive name
+define	MT_IODEV	mtosn[1,$1+1]	# i/o device
+define	MT_LKNAME	mtlkn[1,$1+1]	# lock file name
+
+define	LEN_MTIODES	11
+define	MT_DEVPOS	MT_FILNO	# devpos struct (passed to driver)
+define	LEN_DEVPOS	5
+
+define	MT_OSCHAN	mtdev[1,$1+1]	# OS channel or 0
+define	MT_ACMODE	mtdev[2,$1+1]	# new access mode
+define	MT_DEVCAP	mtdev[3,$1+1]	# pointer to tapecap entry for device
+define	MT_FILE		mtdev[4,$1+1]	# new file number
+define	MT_RECORD	mtdev[5,$1+1]	# new record number
+define	MT_ATEOF	mtdev[6,$1+1]	# reached end of file on a read
+define	MT_FILNO	mtdev[7,$1+1]	# old file number at open
+define	MT_RECNO	mtdev[8,$1+1]	# old record number at open
+define	MT_NFILES	mtdev[9,$1+1]	# nfiles on tape
+define	MT_TAPEUSED	mtdev[10,$1+1]	# total tape used, bytes
+define	MT_PFLAGS	mtdev[11,$1+1]	# i/o flags returned by driver
+
+# PFLAGS bitflags.
+define	MF_ERR		001B		# i/o error in last operation
+define	MF_EOF		002B		# tape mark seen in last operation
+define	MF_EOT		004B		# end of tape seen in last op
+define	MF_EOR		010B		# last op was a record advance
diff --git a/sys/mtio/mtlocknam.x b/sys/mtio/mtlocknam.x
new file mode 100644
index 00000000..0820645a
--- /dev/null
+++ b/sys/mtio/mtlocknam.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	"mtio.h"
+
+# MT_LOCKNAME -- Generate the file name of the magtape lock file, given the
+# logical drive name.  We are called from a z-routine, so do not use any high
+# level i/o routines.  The generated lockfile name is of the form
+#
+#		[node!]dir$mta.lok
+#
+# The lock file is maintained on the same node as the drive to which it
+# refers.
+
+procedure mt_lockname (device, lockfile, maxch)
+
+char	device[ARB]		#I device name
+char	lockfile[maxch]		#O receives generated lockfile name
+int	maxch			#I max chars out
+
+int	ip, op
+int	gstrcpy(), strlen()
+
+begin
+	lockfile[1] = EOS
+
+	# Copy the node name prefix, if any.
+	call ki_xnode (device, lockfile, maxch)
+	op = strlen (lockfile) + 1
+	ip = op
+
+	# Add the directory name prefix, "mt", and device name.
+	op = op + gstrcpy (LOCKLDIR, lockfile[op], maxch-op+1)
+	op = op + gstrcpy (LOCKFILE,  lockfile[op], maxch-op+1)
+	op = op + gstrcpy (device[ip], lockfile[op], maxch-op+1)
+
+	# Add file extension.
+	op = op + gstrcpy (LOCKEXTN,  lockfile[op], maxch-op+1)
+end
diff --git a/sys/mtio/mtneedf.x b/sys/mtio/mtneedf.x
new file mode 100644
index 00000000..9c334949
--- /dev/null
+++ b/sys/mtio/mtneedf.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "mtio.h"
+
+# MTNEEDFILENO -- Returns YES if no file number is specified in mtname, or
+# NO if a file is specified.
+
+int procedure mtneedfileno (mtname)
+
+char	mtname[ARB]			#I magtape device specification
+
+int	fileno, recno
+pointer	sp, device, devcap
+int	btoi()
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_DEVICE, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	call mtparse (mtname, Memc[device], SZ_DEVICE, fileno, recno,
+	    Memc[devcap], SZ_DEVCAP)
+
+	call sfree (sp)
+	return (btoi(fileno == ERR))
+end
diff --git a/sys/mtio/mtopen.x b/sys/mtio/mtopen.x
new file mode 100644
index 00000000..fc5d6c4f
--- /dev/null
+++ b/sys/mtio/mtopen.x
@@ -0,0 +1,188 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<mach.h>
+include	"mtio.h"
+
+# MTOPEN -- Open a magtape file, or a regular binary file if the file name is
+# not "mt" prefixed.  Access modes are restricted to read_only, write_only,
+# append, and new_tape.  The buffer size argument specifies the size of the
+# FIO buffer used to access the tape; a system and device dependent default
+# is supplied if the buffer size is given as zero.  If the device is a fixed
+# block size device the buffer size will be adjusted to an integral multiple
+# of the device block size.  For variable size record devices, the buffer size
+# determines the size of the tape record on a write, or the maximum record
+# size on a read.
+# 
+# The device to be accessed is specified as follows:
+# 
+#	[node!] mtX [ '[' file[.record] [:attr-list] ']' ]
+# 
+# for example,
+# 
+#	mtexb1[4:nb:se@:ts=1200:so=/dev/ttya8]
+# 
+# The "mt" prefix is required for the object to be considered a magtape device
+# reference.  The device name returned is "mtX" as shown above; there must be
+# an entry for device mtX in the tapecap file in DEV.
+# 
+# The file and record numbers are optional.  Files and records are numbered
+# starting with 1.  A sequence such as "mtX[eot]" will cause the tape to be
+# positioned to end of tape.  "mtX[0]" causes the tape to be opened at the
+# current position, i.e., without being moved.
+# 
+# The optional attr-list field consists of a sequence of colon-delimited
+# tapecap fields.  These will override any values given in the tapecap entry
+# for the device.  The syntax for attr-list is the same as in tapecap.
+# 
+# If the filespec does not have the prefix "mt", we assume that the file is
+# a regular binary file and try to open that.  If a tape file is specified
+# then the drive must be allocated before we are called.  We allocate and
+# initialize an MTIO file descriptor and call FOPNBF to install the magtape
+# device in FIO and open the device/file.
+
+int procedure mtopen (mtname, acmode, bufsize)
+
+char	mtname[ARB]		#I device to be opened
+int	acmode			#I access mode
+int	bufsize			#I fio buffer size (record size) or 0
+
+bool	first_time
+pointer	sp, devcap, fname, gty
+int	mt, fd, nskip, new_file, new_record
+
+bool	streq()
+pointer	mt_gtyopen(), gtycaps()
+int	open(), fopnbf(), gtygets(), access()
+int	mt_skip_record(), mtfile(), mt_devallocated()
+extern	zopnmt(), zardmt(), zawrmt(), zawtmt(), zsttmt(), zclsmt()
+
+errchk	open, fopnbf, fseti, syserrs, mtparse
+errchk	mt_getpos, mt_skip_record, mt_gtyopen, gtygets, mt_glock, mtallocate
+data	first_time /true/
+include	"mtio.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	# Runtime initialization of the mtio file descriptor common.
+	# Make each file descriptor available for use.
+
+	if (first_time) {
+	    call mt_clrcache()
+	    do mt = 1, MT_MAXTAPES
+		MT_OSCHAN(mt) = NULL
+	    first_time = false
+	}
+
+	# If regular binary file, we are done.
+	if (mtfile(mtname) == NO) {
+	    call sfree (sp)
+	    return (open (mtname, acmode, BINARY_FILE))
+	}
+
+	# Get mtio file descriptor slot, but do not allocate it until
+	# we are ready to open the file.
+
+	for (mt=1;  mt <= MT_MAXTAPES && MT_OSCHAN(mt) != NULL;  mt=mt+1)
+	    ;
+	if (mt > MT_MAXTAPES)
+	    call syserrs (SYS_MTMULTOPEN, mtname)
+
+	# Break mtname into drive name, file and record number, etc.
+	call mtparse (mtname, MT_DEVICE(mt), SZ_DEVICE, 
+	    new_file, new_record, Memc[devcap], SZ_DEVCAP)
+	if (new_record == ERR)
+	    new_record = 1
+
+	# Get tapecap info.
+	gty = mt_gtyopen (MT_DEVICE(mt), Memc[devcap])
+	MT_DEVCAP(mt) = gtycaps (gty)
+	if (gtygets (gty, "dv", MT_IODEV(mt), SZ_IODEV) <= 0) {
+	    call eprintf ("missing `dv' parameter in tapecap entry for %s\n")
+		call pargstr (mtname)
+	    call syserrs (SYS_MTTAPECAP, mtname)
+	}
+	call ki_xnode (MT_DEVICE(mt), MT_IODEV(mt), SZ_IODEV)
+
+	# If the device has not been allocated, at least write out the
+	# lock file.  This will not physically allocate the device, but
+	# the lock file is required to be able to access the device.
+
+	call mt_glock (mtname, MT_LKNAME(mt), SZ_LKNAME)
+	if (mt_devallocated (MT_IODEV(mt)) == NO)
+	    if (access (MT_LKNAME(mt), 0,0) == NO)
+		call mtallocate (mtname)
+
+	# Get current tape position.
+	call mt_getpos (mtname, mt)
+
+	MT_FILE(mt) = new_file
+	MT_RECORD(mt) = new_record
+	MT_ATEOF(mt) = NO
+
+	# If tape is opened for writing but no file number is given, default
+	# to EOT.  Defaulting to current file or BOT could result in
+	# destruction of the tape.  Note that this default WILL RESULT IN TAPE
+	# RUNAWAY if used on a blank tape.  Blank tapes must be explicitly
+	# written at file [1], or opened with access mode NEW_TAPE.
+
+	if ((acmode == WRITE_ONLY && MT_FILE(mt) == -1) || (acmode == APPEND)) {
+	    MT_FILE(mt) = EOT
+	    MT_RECORD(mt) = 1
+	} else if (acmode == NEW_TAPE) {
+	    MT_FILE(mt) = 1
+	    MT_RECORD(mt) = 1
+	}
+
+	# Make sure that we are not reopening a drive which is already open.
+	for (fd=1;  fd <= MT_MAXTAPES;  fd=fd+1)
+	    if (fd != mt && MT_OSCHAN(fd) != NULL)
+		if (streq (MT_DEVICE(fd), MT_DEVICE(mt)))
+		    call syserrs (SYS_MTMULTOPEN, mtname)
+
+	# Initialize the remaining fields in the file descriptor and open the
+	# device.  ZOPNMT will position the tape.  Note that we pass the index
+	# of the new mtio descriptor slot to ZOPNMT in the common.  This is a
+	# bit ugly, but is safe enough, since we know that FOPNBF is going to
+	# call ZOPNMT.
+
+	switch (acmode) {
+	case READ_ONLY:
+	    MT_ACMODE(mt) = READ_ONLY
+	case WRITE_ONLY, APPEND, NEW_TAPE:
+	    MT_ACMODE(mt) = WRITE_ONLY
+	default:
+	    call syserrs (SYS_MTACMODE, mtname)
+	}
+
+	new_mtchan = mt
+	fd = fopnbf (MT_IODEV(mt), acmode,
+	    zopnmt, zardmt, zawrmt, zawtmt, zsttmt, zclsmt)
+
+	# Set the file buffer size (record size for variable block devices).
+	if (bufsize > 0)
+	    call fseti (fd, F_BUFSIZE, bufsize)
+	
+	# If the user specified a record offset, skip records up to there.
+	# Zero means leave positioned to old record.
+
+	if (MT_RECORD(mt) == 0)
+	    MT_RECORD(mt) = MT_RECNO(mt)
+	if (MT_RECORD(mt) > 1) {
+	    nskip = MT_RECORD(mt) - 1
+	    MT_RECORD(mt) = 1
+	    if (mt_skip_record (fd, nskip) != nskip)
+		call syserrs (SYS_MTSKIPREC, mtname)
+	}
+
+	call mt_savepos (mt)
+
+	call sfree (sp)
+	return (fd)
+end
diff --git a/sys/mtio/mtparse.x b/sys/mtio/mtparse.x
new file mode 100644
index 00000000..27622280
--- /dev/null
+++ b/sys/mtio/mtparse.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<ctype.h>
+include	"mtio.h"
+
+# MTPARSE -- Decode a virtual magtape file specification, returning the device
+# name, file and record to which the drive is to be positioned, and any special
+# device attributes (these will override the device defaults).  The file and
+# record fields are returned as ERR if missing.  Only the drive name field is
+# required.
+# 
+# Magtape device syntax:
+#
+#	[node!] mtX [ '[' file[.record] [:attr-list] ']' ]
+#
+# for example,
+#
+#	mtexb1[4:nb:se@:ts=1200:so=/dev/ttya8]
+#
+# The "mt" prefix is required for the object to be considered a magtape
+# device reference.  The device name returned is "mtX" as shown above; there
+# must be an entry for device mtX in the tapecap file in DEV.
+#
+# The file and record numbers are optional.  Files and records are numbered
+# starting with 1.  A sequence such as "mtX[eot]" will cause the tape to be
+# positioned to end of tape.  "mtX[0]" causes the tape to be opened at the
+# current position, i.e., without being moved.
+#
+# The optional attr-list field consists of a sequence of colon-delimited
+# tapecap fields.  These will override any values given in the tapecap
+# entry for the device.  The syntax for attr-list is the same as in tapecap.
+
+procedure mtparse (mtname, device, sz_device, file, record, attrl, sz_attrl)
+
+char	mtname[ARB]		#I device specification
+char	device[ARB]		#O device name as in tapecap
+int	sz_device		#I max chars in device name
+int	file			#O file number or -1
+int	record			#O record number or -1
+char	attrl[ARB]		#O attribute list
+int	sz_attrl		#I max char in attribute list
+
+char	eotstr[3]
+int	ip, op, nchars, ival
+int	ctoi(), strncmp(), ki_extnode()
+bool	streq()
+define	bad_ 91
+
+begin
+	# Extract the node name, if any, from the mtname.
+	ip = ki_extnode (mtname, device, sz_device, nchars) + 1
+	op = nchars + 1
+
+	# Verify that this is a magtape device specification.
+	if (strncmp (mtname[ip], "mt", 2) != 0)
+	    goto bad_
+
+	# Extract the device name field.
+	while (mtname[ip] != EOS && mtname[ip] != '[') {
+	    device[op] = mtname[ip]
+	    op = min (sz_device, op + 1)
+	    ip = ip + 1
+	}
+	device[op] = EOS
+
+	file = ERR
+	record = ERR
+	attrl[1] = EOS
+
+	# Process the [...] part of the device specification.
+	if (mtname[ip] == '[') {
+	    ip = ip + 1
+
+	    # Get the file number.
+	    if (ctoi (mtname, ip, ival) > 0) {
+		file = ival
+		if (file < 0)
+		    goto bad_
+	    } else if (IS_ALPHA(mtname[ip])) {
+		call strcpy (mtname[ip], eotstr, 3)
+		call strlwr (eotstr)
+		if (streq (eotstr, "eot")) {
+		    file = EOT
+		    ip = ip + 3
+		} else
+		    goto bad_
+	    }
+
+	    # Get the record number.
+	    if (mtname[ip] == '.' || mtname[ip] == ',') {
+		ip = ip + 1
+		if (mtname[ip] == ']')
+		    record = ERR
+		else if (ctoi (mtname, ip, ival) > 0) {
+		    record = ival
+		    if (record < 0)
+			goto bad_
+		}
+	    }
+
+	    # Get the device attribute list.
+	    op = 1
+	    if (mtname[ip] == ':') {
+		attrl[op] = mtname[ip]
+		op = max(1, min(sz_attrl, op + 1))
+		ip = ip + 1
+
+		while (mtname[ip] != EOS && mtname[ip] != ']') {
+		    attrl[op] = mtname[ip]
+		    op = max(1, min(sz_attrl, op + 1))
+		    ip = ip + 1
+		}
+	    }
+	    attrl[op] = EOS
+
+	    # Check for the ']' terminator.
+	    if (mtname[ip] != ']')
+		goto bad_
+	}
+
+	return
+bad_
+	call syserrs (SYS_MTFILSPEC, mtname)
+end
diff --git a/sys/mtio/mtpos.x b/sys/mtio/mtpos.x
new file mode 100644
index 00000000..f88946ae
--- /dev/null
+++ b/sys/mtio/mtpos.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mtio.h"
+
+# MTPOSITION -- Position the device to the indicated file and record.
+# We are called to position the device by device name, not to position
+# an open magtape file.
+
+procedure mtposition (mtname, file, record)
+
+char	mtname[ARB]		#I device to be positioned
+int	file			#I desired file number
+int	record			#I desired record number
+
+int	junk
+pointer	sp, mtspec, device, devcap
+errchk	mtparse, mtopen
+int	mtopen()
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (mtspec, SZ_FNAME, TY_CHAR)
+	call salloc (devcap, SZ_DEVCAP, TY_CHAR)
+
+	# Get device name (including node! prefix) from mtname.
+	call mtparse (mtname,
+	    Memc[device], SZ_FNAME, junk, junk, Memc[devcap], SZ_DEVCAP)
+
+	# Encode new mtname and open device to position to desired file.
+	# Note that we do not return until positioning is complete.  Thus,
+	# "mtposition(device,1)" is a rewind with wait.
+
+	call mtencode (Memc[mtspec], SZ_FNAME,
+	    Memc[device], file, record, Memc[devcap])
+	call close (mtopen (Memc[mtspec], READ_ONLY, 1))
+
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtrdlock.x b/sys/mtio/mtrdlock.x
new file mode 100644
index 00000000..774fab19
--- /dev/null
+++ b/sys/mtio/mtrdlock.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	"mtio.h"
+
+# MT_READ_LOCKFILE -- Read the magtape lock file to determine the current
+# position of the tape (the lock file is used to record the tape position
+# while the device is closed).  If the lock file cannot be accessed or an
+# error occurs in reading it, return an undefined tape position.
+
+procedure mt_read_lockfile (mtname, mt)
+
+char	mtname[ARB]		#I device name
+int	mt			#I MTIO descriptor
+
+int	fd, ip
+pointer	sp, lockfile, lbuf
+int	strmatch(), stridxs(), ctoi(), open(), getline()
+errchk	open, getline
+include	"mtio.com"
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (lockfile, SZ_FNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# If the lock file cannot be accessed, return an undefined tape
+	# position but do not abort.
+
+	#call mt_lockname (MT_LKNAME(mt), Memc[lockfile], SZ_FNAME)
+	call strcpy (MT_LKNAME(mt), Memc[lockfile], SZ_FNAME)
+	iferr (fd = open (Memc[lockfile], READ_ONLY, TEXT_FILE)) {
+	    fd = ERR
+	    goto err_
+	}
+
+	# Get file number.
+	repeat {
+	    if (getline (fd, Memc[lbuf]) == EOF)
+		goto err_
+	} until (strmatch (Memc[lbuf], "^file") > 0)
+	ip = stridxs ("=", Memc[lbuf]) + 1
+	if (ctoi (Memc[lbuf], ip, MT_FILNO(mt)) == 0)
+	    goto err_
+
+	# Get record number.
+	if (getline (fd, Memc[lbuf]) == EOF)
+	    goto err_
+	ip = stridxs ("=", Memc[lbuf]) + 1
+	if (ctoi (Memc[lbuf], ip, MT_RECNO(mt)) == 0)
+	    goto err_
+
+	# Get total files on tape.
+	if (getline (fd, Memc[lbuf]) == EOF)
+	    goto err_
+	ip = stridxs ("=", Memc[lbuf]) + 1
+	if (ctoi (Memc[lbuf], ip, MT_NFILES(mt)) == 0)
+	    goto err_
+
+	# Get amount of tape used.
+	if (getline (fd, Memc[lbuf]) == EOF)
+	    goto err_
+	ip = stridxs ("=", Memc[lbuf]) + 1
+	if (ctoi (Memc[lbuf], ip, MT_TAPEUSED(mt)) == 0)
+	    goto err_
+
+	# Get pflags.
+	if (getline (fd, Memc[lbuf]) == EOF)
+	    goto err_
+	ip = stridxs ("=", Memc[lbuf]) + 1
+	if (ctoi (Memc[lbuf], ip, MT_PFLAGS(mt)) == 0)
+	    goto err_
+
+	call close (fd)
+	call sfree (sp)
+
+	return
+err_
+	if (fd != ERR)
+	    call close (fd)
+
+	# Write a new lock file so that we can update the tape position
+	# later (the file must exist after the drive is opened).
+
+	call mtallocate (mtname)
+
+	# Return an undefined tape position.
+	MT_FILNO(mt) = -1
+	MT_RECNO(mt) = -1
+
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtrewind.x b/sys/mtio/mtrewind.x
new file mode 100644
index 00000000..b7efcddb
--- /dev/null
+++ b/sys/mtio/mtrewind.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"mtio.h"
+
+# MTREWIND -- Rewind the named magtape device.  This is a synchronous
+# rewind.  Rewind not only rewinds the device, it also initializes the
+# MTIO view of what is on the tape (number of files, total bytes used).
+# Hence, if the drive is left allocated but the tape is changed, or if
+# the position cache becomes inaccurate for any reason, a rewind will
+# initialize things without having to deallocate and reallocate the drive.
+
+procedure mtrewind (mtname, initcache)
+
+char	mtname[ARB]		#I device to be rewound
+int	initcache		#I discard positional information?
+
+pointer	sp, fname
+int	fd, mtopen()
+errchk	mtfname
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Init position cache.
+	if (initcache == YES) {
+	    call mt_glock (mtname, Memc[fname], SZ_FNAME)
+	    iferr (call delete (Memc[fname]))
+		;
+	}
+
+	# Rewind device.
+	call mtfname (mtname, 1, Memc[fname], SZ_FNAME)
+	iferr (fd = mtopen (Memc[fname], READ_ONLY, 0))
+	    call erract (EA_WARN)
+	else
+	    call close (fd)
+
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtskip.x b/sys/mtio/mtskip.x
new file mode 100644
index 00000000..f51948a4
--- /dev/null
+++ b/sys/mtio/mtskip.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+
+# MT_SKIP_RECORD -- Skip records on an opened file.  Return the actual number
+# of records skipped; stop if EOF is reached.
+
+int procedure mt_skip_record (fd, nrecords)
+
+int	fd				#I magtape device
+int	nrecords			#I number of records to skip
+
+pointer	sp, buf
+int	n, bufsize
+errchk	aread, await
+int	await(), fstati()
+
+begin
+	call smark (sp)
+	bufsize = fstati (fd, F_BUFSIZE)
+	call salloc (buf, bufsize, TY_CHAR)
+
+	for (n=1;  n <= nrecords;  n=n+1) {
+	    call aread (fd, Memc[buf], bufsize, 0)
+	    if (await (fd) == EOF)
+		break
+	}
+
+	call sfree (sp)
+	return (n-1)
+end
diff --git a/sys/mtio/mtstatus.x b/sys/mtio/mtstatus.x
new file mode 100644
index 00000000..967d25df
--- /dev/null
+++ b/sys/mtio/mtstatus.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MTSTATUS -- Print the status of an allocated magtape device, i.e., print the
+# lock file as a text file.  Called by the DEVSTATUS task.
+
+procedure mtstatus (out, mtname)
+
+int	out			#I output file
+char	mtname[ARB]		#I magtape specification
+
+int	in
+pointer	sp, lockfile
+errchk	open, fcopyo
+int	open(), access()
+
+begin
+	call smark (sp)
+	call salloc (lockfile, SZ_FNAME, TY_CHAR)
+
+	call mt_sync (OK)
+
+	call mt_glock (mtname, Memc[lockfile], SZ_FNAME)
+	if (access (Memc[lockfile], 0, 0) == NO) {
+	    call fprintf (out, "tape position for %s is undefined\n")
+		call pargstr (mtname)
+	} else {
+	    # Print the lockfile.
+	    in = open (Memc[lockfile], READ_ONLY, TEXT_FILE)
+	    call fcopyo (in, out)
+	    call close (in)
+	}
+	
+	call sfree (sp)
+end
diff --git a/sys/mtio/mtupdlock.x b/sys/mtio/mtupdlock.x
new file mode 100644
index 00000000..654d3cbc
--- /dev/null
+++ b/sys/mtio/mtupdlock.x
@@ -0,0 +1,188 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<config.h>
+include	"mtio.h"
+
+# MT_UPDATE_LOCKFILE -- Update the current file position in the lockfile.
+# This information is returned by the host specific driver at close time.
+# We are called from a z-routine so we must access the lockfile using only
+# low level OS interface routines to avoid recursion.  We may be called during
+# error recovery (as well as from a z-routine), so any errors are fatal.
+
+procedure mt_update_lockfile (mt)
+
+int	mt			#I device slot
+
+extern	mt_sync()
+pointer	sp, lockfile, tempfile, lbuf, ip, op, extn
+int	old_lockfile, new_lockfile, junk, status, nlines
+errchk	fmapfn
+include	"mtio.com"
+define	oline_ 91
+define	err_ 92
+
+begin
+	call smark (sp)
+	call salloc (lockfile, SZ_PATHNAME, TY_CHAR)
+	call salloc (tempfile, SZ_PATHNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# Catch any errors in the following section and convert them
+	# into fatal errors.
+
+	iferr {
+	    # Try to avoid generating any non-host legal filenames in the
+	    # following code, to avoid any need to access the VFN mapping
+	    # file.  Generate temp file in the same directory on the same
+	    # node as the lockfile so that we can easily rename the tempfile
+	    # to be the new lockfile.
+
+	    #call mt_lockname (MT_LKNAME(mt), Memc[lockfile], SZ_PATHNAME)
+	    call strcpy (MT_LKNAME(mt), Memc[lockfile], SZ_PATHNAME)
+
+	    # Make tempfile name.
+	    extn = NULL
+	    op   = tempfile
+	    for (ip=lockfile;  Memc[ip] != EOS;  ip=ip+1) {
+		if (Memc[ip] == '.')
+		    extn = op
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+
+	    if (extn == NULL)
+		extn = op
+	    call strcpy (".tlk", Memc[extn], 4)
+
+	    # Map the filenames.
+	    call fmapfn (Memc[tempfile], Memc[tempfile], SZ_PATHNAME)
+	    call fmapfn (Memc[lockfile], Memc[lockfile], SZ_PATHNAME)
+
+	} then
+	    goto err_
+
+	# Overwrite any existing tempfile.
+	call zfdele (Memc[tempfile], junk)
+	call zopntx (Memc[tempfile], NEW_FILE, new_lockfile)
+	if (new_lockfile == ERR)
+	    goto err_
+
+	# Open old lockfile, if any, and copy the comments section.
+	call zopntx (Memc[lockfile], READ_ONLY, old_lockfile)
+	if (old_lockfile == ERR) {
+oline_	    call strcpy ("# Magtape unit ", Memc[lbuf], SZ_LINE)
+	    call strcat (MT_DEVICE(mt), Memc[lbuf], SZ_LINE)
+	    call strcat (" status\n", Memc[lbuf], SZ_LINE)
+	    call mt_putline (new_lockfile, Memc[lbuf])
+	} else {
+	    nlines = 0
+	    repeat {
+		call zgettx (old_lockfile, Memc[lbuf], SZ_LINE, status)
+		if (status <= 0) {
+		    if (nlines == 0) {
+			call zclstx (old_lockfile, status)
+			goto oline_
+		    } else
+			break
+		} else
+		    nlines = nlines + 1
+		Memc[lbuf+status] = EOS
+		if (Memc[lbuf] == '#')
+		    call mt_putline (new_lockfile, Memc[lbuf])
+	    } until (Memc[lbuf] != '#')
+	    call zclstx (old_lockfile, status)
+	}
+
+	# Everything else we write from here on is new stuff.  Discard rest
+	# of old lockfile.
+
+	# Save current file and record numbers.
+	if (MT_FILNO(mt) == -1)
+	    MT_RECNO(mt) = -1
+	call mt_savekeyword (new_lockfile, "file", MT_FILNO(mt))
+	    if (MT_NFILES(mt) > 0 && (MT_FILNO(mt) == MT_NFILES(mt) + 1))
+		call mt_putline (new_lockfile, " (EOT)")
+	    call mt_putline (new_lockfile, "\n")
+	call mt_savekeyword (new_lockfile, "record", MT_RECNO(mt))
+	    call mt_putline (new_lockfile, "\n")
+	call mt_savekeyword (new_lockfile, "nfiles", MT_NFILES(mt))
+	    call mt_putline (new_lockfile, "\n")
+	call mt_savekeyword (new_lockfile, "tapeused", MT_TAPEUSED(mt))
+	    call mt_putline (new_lockfile, "\n")
+	call mt_savekeyword (new_lockfile, "pflags", MT_PFLAGS(mt))
+	    call mt_putline (new_lockfile, "\n")
+
+	# Install the new lockfile.
+	call zflstx (new_lockfile, status)
+	if (status == ERR)
+	    goto err_
+	call zclstx (new_lockfile, status)
+	if (status == ERR)
+	    goto err_
+
+	call zfdele (Memc[lockfile], status)
+	call zfrnam (Memc[tempfile], Memc[lockfile], status)
+	if (status == ERR)
+	    goto err_
+
+	call sfree (sp)
+	return
+
+err_
+	# If an error of any sort occurs, it is fatal.
+	call onerror_remove (mt_sync)
+	call zfdele (Memc[tempfile], status)
+	call zfdele (Memc[lockfile], status)
+	call fatal (0, "Fatal error writing magtape device lockfile")
+end
+
+
+# MT_SAVEKEYWORD -- Write a "keyword = value" status line into the lockfile.
+
+procedure mt_savekeyword (fd, keyword, value)
+
+int	fd			# output file
+char	keyword[ARB]		# name of keyword
+int	value			# value of keyword
+char	numbuf[MAX_DIGITS]
+int	junk, itoc()
+
+begin
+	junk = itoc (value, numbuf, MAX_DIGITS)
+
+	call mt_putline (fd, keyword)
+	call mt_putline (fd, " = ")
+	call mt_putline (fd, numbuf)
+end
+
+
+# MT_PUTLINE -- Put a text string to the lockfile.  Do not write line
+# to lockfile until a newline is seen.
+
+procedure mt_putline (fd, text)
+
+int	fd
+char	text[ARB]
+
+extern	mt_sync()
+char	lbuf[SZ_LINE]
+int	ip, op, status
+data	op /1/
+
+begin
+	for (ip=1;  text[ip] != EOS;  ip=ip+1) {
+	    lbuf[op] = text[ip]
+	    op = min (SZ_LINE, op) + 1
+	    if (text[ip] == '\n') {
+		call zputtx (fd, lbuf, op-1, status)
+		if (status == ERR) {
+		    call onerror_remove (mt_sync)
+		    call fatal (0,
+			"Fatal error writing magtape device lockfile")
+		}
+		op = 1
+	    }
+	}
+end
diff --git a/sys/mtio/zardmt.x b/sys/mtio/zardmt.x
new file mode 100644
index 00000000..ac5833be
--- /dev/null
+++ b/sys/mtio/zardmt.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	"mtio.h"
+
+# ZARDMT -- MTIO asynchronous read primitive.  Initiate a read of up to
+# maxbytes bytes into the user buffer.
+
+procedure zardmt (mtchan, buf, maxbytes, offset)
+
+int	mtchan			#I i/o channel
+char	buf[ARB]		#O output data buffer
+int	maxbytes		#I max bytes to read
+long	offset			#I file offset
+
+include	"mtio.com"
+
+begin
+	if (MT_ATEOF(mtchan) == NO)
+	    call zzrdmt (MT_OSCHAN(mtchan), buf, maxbytes, offset)
+end
diff --git a/sys/mtio/zawrmt.x b/sys/mtio/zawrmt.x
new file mode 100644
index 00000000..5caf2b70
--- /dev/null
+++ b/sys/mtio/zawrmt.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	"mtio.h"
+
+# ZAWRMT -- MTIO asynchronous write primitive.  Initiate a write of nbytes
+# bytes to the tape.
+
+procedure zawrmt (mtchan, buf, nbytes, offset)
+
+int	mtchan			#I i/o channel
+char	buf[ARB]		#I data to be written
+int	nbytes			#I number of bytes of data
+long	offset			#I file offset
+
+include	"mtio.com"
+
+begin
+	call zzwrmt (MT_OSCHAN(mtchan), buf, nbytes, offset)
+end
diff --git a/sys/mtio/zawtmt.x b/sys/mtio/zawtmt.x
new file mode 100644
index 00000000..5599a81e
--- /dev/null
+++ b/sys/mtio/zawtmt.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	"mtio.h"
+
+# ZAWTMT -- Wait for the last i/o transfer to complete, update tape position
+# counters, return nbytes|status to caller.
+
+procedure zawtmt (mtchan, status)
+
+int	mtchan			#I i/o channel
+int	status			#O status (nbytes transferred or ERR)
+
+include	"mtio.com"
+
+begin
+	# The "sticky" EOF should not be necessary but is needed due to the
+	# way FIO behaves when it hits EOF on a blocked file.  In some
+	# circumstances (depends upon the file length) two reads are made and
+	# if the second read does not return zero EOF will not be detected.
+
+	if (MT_ATEOF(mtchan) == YES)
+	    status = 0
+	else {
+	    call zzwtmt (MT_OSCHAN(mtchan), MT_DEVPOS(mtchan), status)
+	    if (status == 0)
+		MT_ATEOF(mtchan) = YES
+	}
+end
diff --git a/sys/mtio/zclsmt.x b/sys/mtio/zclsmt.x
new file mode 100644
index 00000000..7c4dcbf7
--- /dev/null
+++ b/sys/mtio/zclsmt.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<knet.h>
+include	"mtio.h"
+
+# ZCLSMT -- Close a magtape file and device.  Update lockfile so that we
+# will know where the tape is positioned next time we open the device.
+# Deallocate the mtio descriptor so that it may be reused again.
+# 
+# We are being called during error recovery if "new_mtchan" is not null.
+# If MT_OSCHAN has also been set, then ZZOPMT was interrupted, probably while
+# trying to position the tape, and the position of the tape is indefinite.
+# Close the tape with acmode=read so that no tape marks are written, and write
+# the lockfile with file = -1 to signify that the position is indefinite.
+
+procedure zclsmt (mtchan, status)
+
+int	mtchan				#I i/o channel
+int	status				#O close status
+
+int	mt
+bool	error_recovery
+include	"mtio.com"
+
+begin
+	# Called by error recovery while positioning tape? (during open)
+	if (new_mtchan != NULL) {
+	    mt = new_mtchan
+	    if (MT_OSCHAN(mt) != NULL)
+		call zzclmt (MT_OSCHAN(mt), MT_DEVPOS(mt), status)
+
+	    call mt_savepos (mt)
+	    call mt_sync (ERR)
+	    new_mtchan = NULL
+
+	} else {
+	    mt = mtchan
+
+	    # If a task aborts while a tape file is open, mt_sync will
+	    # already have been called to update the position,
+	    # and the current file will have been set to undefined (-1).
+
+	    error_recovery = (MT_FILNO(mt) == -1)
+
+	    # Close device.  This clobbers MT_FILNO (see above).
+	    call zzclmt (MT_OSCHAN(mt), MT_DEVPOS(mt), status)
+
+	    # Update the tape position if not recovering from an abort.
+	    if (!error_recovery)
+		call mt_savepos (mt)
+	}
+
+	MT_OSCHAN(mt) = NULL
+end
diff --git a/sys/mtio/zopnmt.x b/sys/mtio/zopnmt.x
new file mode 100644
index 00000000..1c55e1ae
--- /dev/null
+++ b/sys/mtio/zopnmt.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	"mtio.h"
+
+# ZOPNMT -- Open magtape device at the specifed file.  We are called indirectly
+# by MTOPEN (via fopnbf), which sets up a new mtio device decriptor pointed
+# to by NEW_MTCHAN, and passes it via the mtio common.
+
+procedure zopnmt (iodev, acmode, mtchan)
+
+char	iodev[ARB]		#I PACKED i/o device name string
+int	acmode			#I file access mode
+int	mtchan			#O return value (mt descriptor index)
+
+int	mt
+pointer	sp, pk_devcap
+include	"mtio.com"
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (pk_devcap, SZ_DEVCAP, TY_CHAR)
+
+	# Pick up index of mt descriptor slot set up by MTOPEN.  Make sure
+	# that we were called by MTOPEN and not somebody else.
+
+	mt = new_mtchan
+	if (mt < 1 || mt > MT_MAXTAPES)
+	    goto err_
+
+	# Open the device.
+	call strpak (Memc[MT_DEVCAP(mt)], Memc[pk_devcap], SZ_DEVCAP)
+	call zzopmt (iodev, MT_ACMODE(mt), Memc[pk_devcap], MT_DEVPOS(mt),
+	    MT_FILE(mt), MT_OSCHAN(mt))
+	if (MT_OSCHAN(mt) == ERR)
+	    goto err_
+
+	# If "new_mtchan" is nonzero when ZCLSMT is called, it implies that
+	# CLOSE was called during error recovery due to an interrupt of ZZOPMT
+	# and the position of the tape is undefined.  Clear the flag since the
+	# open is now complete and we were not interrupted.
+
+	new_mtchan = NULL
+	MT_FILNO(mt) = MT_FILE(mt)
+	call mt_savepos (mt)
+
+	mtchan = mt
+	call sfree (sp)
+	return
+
+err_
+	# Z-routines can only return ERR in the event of an error.
+ 	MT_OSCHAN(mt) = NULL
+	call sfree (sp)
+	mtchan = ERR
+end
diff --git a/sys/mtio/zsttmt.x b/sys/mtio/zsttmt.x
new file mode 100644
index 00000000..252c9735
--- /dev/null
+++ b/sys/mtio/zsttmt.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<config.h>
+include	<fio.h>
+include	"mtio.h"
+
+# ZSTTMT -- Get magtape device or device driver parameters and settings.
+
+procedure zsttmt (mtchan, what, lvalue)
+
+int	mtchan			#I mtio descriptor
+int	what			#I status parameter to be returned
+long	lvalue			#O returned status value
+
+include	"mtio.com"
+
+begin
+	call zzstmt (MT_OSCHAN(mtchan), what, lvalue)
+end
diff --git a/sys/mtio/zzdebug.x b/sys/mtio/zzdebug.x
new file mode 100644
index 00000000..cf02e610
--- /dev/null
+++ b/sys/mtio/zzdebug.x
@@ -0,0 +1,357 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<xalloc.h>
+include	<mach.h>
+include	<fset.h>
+
+task	alloc		= t_allocate,
+	dealloc		= t_deallocate,
+	status		= t_status,
+	mtpos		= t_mtposition,
+	wtestfile	= t_wtestfile,
+	mtexamine	= t_mtexamine,
+	mtcopy		= t_mtcopy,
+	rew		= t_rewind
+
+
+.help testmtio
+.nf __________________________________________________________________________
+MTIO test routines.  Assorted routines for verification of MTIO.
+
+	alloc		Allocate a drive.
+
+	dealloc		Deallocate a drive.
+
+	status		Print drive status
+
+	mtpos		Position to the indicated file and record.
+
+	wtestfile	Writes a test file.  The number of records and the
+			range of record sizes may be specified.  The contents
+			of a record are determined by its size.
+
+	mtexamine	Examines the structure of a tape.  Tells the number of
+			files on the tape, the number of records in each file,
+			the sizes of the records, and optionally dumps the
+			contents of an indicated range of records from each
+			file.
+
+	mtcopy		Fast binary copy.  Copies a binary disk or tape file
+			to a binary disk or tape file using all the FIO
+			defaults.
+.endhelp _____________________________________________________________________
+
+
+# ALLOCATE -- Allocate a drive.
+
+procedure t_allocate()
+
+int	junk, status
+char	drive[SZ_FNAME]
+char	owner[SZ_FNAME]
+int	xallocate(), xdevowner()
+
+begin
+	call clgstr ("drive", drive, SZ_FNAME)
+	status = xallocate (drive)
+
+	switch (status) {
+	case OK:
+	    call printf ("device allocated successfully\n")
+	case ERR:
+	    call printf ("cannot allocate device\n")
+	case DV_DEVFREE:
+	    call printf ("device is free and may be allocated\n")
+	case DV_DEVALLOC:
+	    call printf ("device is already allocated\n")
+	case DV_DEVINUSE:
+	    junk = xdevowner ("drive", owner, SZ_FNAME)
+	    call printf ("device is already allocated to `%s'\n")
+		call pargstr (owner)
+	case DV_DEVNOTFOUND:
+	    call printf ("device not found\n")
+	default:
+	    call printf ("unknown status %d\n")
+		call pargi (status)
+	}
+end
+
+
+# DEALLOCATE -- Deallocate a drive.
+
+procedure t_deallocate()
+
+int	junk, status
+char	drive[SZ_FNAME]
+char	owner[SZ_FNAME]
+
+bool	clgetb()
+int	xdeallocate(), xdevowner()
+
+begin
+	call clgstr ("drive", drive, SZ_FNAME)
+	status = xdeallocate (drive, clgetb ("rewind"))
+
+	switch (status) {
+	case OK:
+	    call printf ("device deallocated successfully\n")
+	case ERR:
+	    call printf ("cannot deallocate device\n")
+	case DV_DEVFREE:
+	    call printf ("device is free and may be allocated\n")
+	case DV_DEVALLOC:
+	    call printf ("device is already allocated\n")
+	case DV_DEVINUSE:
+	    junk = xdevowner ("drive", owner, SZ_FNAME)
+	    call printf ("device is already allocated to `%s'\n")
+		call pargstr (owner)
+	case DV_DEVNOTFOUND:
+	    call printf ("device not found\n")
+	default:
+	    call printf ("unknown status %d\n")
+		call pargi (status)
+	}
+end
+
+
+# STATUS -- Print drive status.
+
+procedure t_status()
+
+int	status
+char	drive[SZ_FNAME]
+char	owner[SZ_FNAME]
+int	xdevowner()
+
+begin
+	call clgstr ("drive", drive, SZ_FNAME)
+	status = xdevowner (drive, owner, SZ_FNAME)
+
+	switch (status) {
+	case OK:
+	    call printf ("device deallocated successfully\n")
+	case ERR:
+	    call printf ("cannot deallocate device\n")
+	case DV_DEVFREE:
+	    call printf ("device is free and may be allocated\n")
+	case DV_DEVALLOC:
+	    call printf ("device is already allocated\n")
+	case DV_DEVINUSE:
+	    call printf ("device is allocated to `%s'\n")
+		call pargstr (owner)
+	case DV_DEVNOTFOUND:
+	    call printf ("device not found\n")
+	default:
+	    call printf ("unknown status %d\n")
+		call pargi (status)
+	}
+end
+
+
+# MTPOS -- Position to the indicated file and record.
+
+procedure t_mtposition()
+
+char	drive[SZ_FNAME]
+int	clgeti()
+
+begin
+	call clgstr ("drive", drive, SZ_FNAME)
+	call mtposition (drive, clgeti("file"), clgeti("record"))
+end
+
+
+# WTESTFILE -- Write a test file to the tape.  Specify file [1] to write to
+# a new tape.  If no file number is given, the file is appended to the tape.
+# Specify the number of records to be written and the range of sizes in bytes
+# of the records.  Each byte of a record will contain the size of the record
+# modulus 256.
+
+procedure t_wtestfile()
+
+char	mtname[SZ_FNAME]
+int	nrecords
+int	min_recsize, max_recsize
+
+pointer	buf
+long	seed
+int	fd, i, recsize, oschan, status
+int	clgeti(), mtopen(), fstati()
+real	urand()
+data	seed /123/
+
+begin
+	# Get tapefile name and open file for writing.
+	call clgstr ("mtname", mtname, SZ_FNAME)
+	fd = mtopen (mtname, WRITE_ONLY, 1)
+	oschan = fstati (fd, F_CHANNEL)
+
+	nrecords = max (0, clgeti ("nrecords"))
+	min_recsize = max (1, clgeti ("min_recsize"))
+	max_recsize = max (min_recsize, clgeti ("max_recsize"))
+
+	call calloc (buf, max_recsize, TY_CHAR)
+
+	# Records are written by directly calling ZAWRMT, so that we can
+	# write odd size records.
+
+	do i = 1, nrecords {
+	    recsize = int ((max_recsize - min_recsize) * urand (seed)) +
+		min_recsize
+	    call zawrmt (oschan, Memc[buf], recsize, 0)
+	    call zawtmt (oschan, status)
+	    if (status == ERR)
+		call error (1, "write error")
+	}
+
+	call mfree (buf, TY_CHAR)
+	call close (fd)
+end
+
+
+# MTEXAMINE -- Examine the structure of a tape filesystem or a file.  If no file
+# number is given, all files are examined.
+
+procedure t_mtexamine()
+
+int	fileno, nrecords
+char	mtname[SZ_FNAME], mtfile[SZ_FNAME]
+int	strlen(), mt_examine()
+
+begin
+	call clgstr ("mtname", mtname, SZ_FNAME)
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	if (mtname[strlen(mtname)] == ']') {
+	    call strcpy (mtname, mtfile, SZ_FNAME)
+	    nrecords = mt_examine (STDOUT, mtname)
+
+	} else {
+	    fileno = 1
+	    repeat {
+		call sprintf (mtfile, SZ_FNAME, "%s[%d]")
+		    call pargstr (mtname)
+		    call pargi (fileno)
+		fileno = fileno + 1
+	    } until (mt_examine (STDOUT, mtfile) == 0)
+	}
+end
+
+
+# MT_EXAMINE -- Examine a magtape file.  Print file number, then count
+# successive records.  When the record size changes, print the number of
+# records encountered with the old size.  When all done, print the total
+# number of records and bytes.  Return the number of records in the file.
+
+int procedure mt_examine (out, mtfile)
+
+int	out				# output stream
+char	mtfile[ARB]			# magtape file to be examined
+
+pointer	buf
+int	in, nrecords, totrecords, totbytes, bufsize, recsize, last_recsize
+errchk	mtopen, read, fstati, printf, pargi
+int	mtopen(), read(), fstati()
+
+begin
+	in = mtopen (mtfile, READ_ONLY, 0)
+	bufsize = fstati (in, F_BUFSIZE)
+	call malloc (buf, bufsize, TY_CHAR)
+
+	call fprintf (out, "    File %s:\n")
+	    call pargstr (mtfile)
+
+	totrecords = 0
+	nrecords = 0
+	totbytes = 0
+	last_recsize = 0
+
+	# Describe record composition of file.
+	while (read (in, Memc[buf], bufsize) != EOF) {
+	    recsize = fstati (in, F_SZBBLK)
+	    if (nrecords == 0) {			# first record
+		nrecords = 1
+		last_recsize = recsize
+	    } else if (recsize == last_recsize) {
+		nrecords = nrecords + 1
+	    } else {
+		call fprintf (out, "\t%d %d-byte records\n")
+		    call pargi (nrecords)
+		    call pargi (last_recsize)
+		nrecords = 1
+		last_recsize = recsize
+	    }
+	    totrecords = totrecords + 1
+	    totbytes = totbytes + recsize
+	}
+
+	if (nrecords > 0) {
+	    call fprintf (out, "\t%d %d-byte records\n")
+		call pargi (nrecords)
+		call pargi (last_recsize)
+	}
+
+	# Print total count of records, bytes.
+	call fprintf (out, "\tTotal %d records, %d bytes\n")
+	    call pargi (totrecords)
+	    call pargi (totbytes)
+
+	call mfree (buf, TY_CHAR)
+	call close (in)
+
+	return (totrecords)
+end
+
+
+# MTCOPY -- Copy a binary file from magtape or disk to magtape or disk,
+# using all the default FIO and MTIO pararameters.  If the output file is
+# a magtape, all records (except possibly the last record in the file) will
+# be the same size.  If input tape records are not commensurate with the size
+# of a CHAR they will be zero-padded to an integral number of chars upon
+# input.
+
+procedure t_mtcopy()
+
+pointer	buf
+int	in, out, bufsize, acmode
+char	infile[SZ_FNAME], outfile[SZ_FNAME]
+int	mtopen(), fstati(), read(),  mtfile()
+
+begin
+	call clgstr ("infile", infile, SZ_FNAME)
+	call clgstr ("outfile", outfile, SZ_FNAME)
+
+	in = mtopen (infile, READ_ONLY, 0)
+
+	# If output file is a disk file, create a new file, but do not
+	# create a new tape if writing to tape.
+
+	acmode = NEW_FILE
+	if (mtfile(outfile) == YES)
+	    acmode = WRITE_ONLY
+	out = mtopen (outfile, acmode, 0)
+
+	bufsize = fstati (in, F_BUFSIZE)
+	call malloc (buf, bufsize, TY_CHAR)
+
+	while (read (in, Memc[buf], bufsize) != EOF)
+	    call write (out, Memc[buf], fstati (in, F_NCHARS))
+
+	call mfree (buf, TY_CHAR)
+	call close (in)
+	call close (out)
+end
+
+
+# REWIND -- Rewind the tape.
+
+procedure t_rewind()
+
+char	mtname[SZ_FNAME]
+bool	clgetb()
+int	btoi()
+
+begin
+	call clgstr ("mtname", mtname, SZ_FNAME)
+	call mtrewind (mtname, btoi(clgetb("initialize")))
+end
diff --git a/sys/mwcs/MWCS.hlp b/sys/mwcs/MWCS.hlp
new file mode 100644
index 00000000..4f77144f
--- /dev/null
+++ b/sys/mwcs/MWCS.hlp
@@ -0,0 +1,1026 @@
+.help MWCS Oct89 "Mini-WCS Interface"
+
+.ce
+\fBMini-WCS Interface\fR
+.ce
+Doug Tody
+.ce
+October 1989
+
+
+.nh
+Introduction
+
+    The mini-WCS interface represents a first cut at the general problem
+of representing a linear or nonlinear world coordinate system (WCS).
+While some of the harder problems are avoided and the general WCS problem
+remains to be solved, the current interface should be largely upwards
+compatible with future versions of the interface.  The main items omitted
+from this initial version of the interface are support for general nonlinear
+world coordinate systems, particularly support for modeling of geometric
+distortions and arbitrary application defined coordinate mapping functions.
+Limited support is provided for the projective geometries.
+
+.nh
+WCS Definition
+.nh 2
+Linear Transformations
+
+    Any linear transformation consisting of some combination of a shift,
+rotate, axis-flip, scale change, etc. can be expressed as
+
+.ks
+.nf
+	|x'|   |a b|   |x|   |u|
+	|  | = |   | * | | + | |                                   [2.1]
+	|y'|   |c d|   |y|   |v|
+.fi
+.ke
+
+where [x,y] are the input coordinates, [x',y'] are the transformed
+coordinates, [a,b,c,d] is a rotation matrix, and [u,v] is a shift vector.
+
+For example, the X term of a combination of a rotation about a point [x0,y0]
+plus a shift to an offset [x1,y1] may be expressed as
+
+.ks
+.nf
+	x' = a(x - x0) + b(y - y0) + x1
+	   = ax - ax0 + by - by0 + x1
+	   = ax + by + u
+.fi
+.ke
+whence
+.nf
+	 u = x1 - ax0 - by0
+and                                                                [2.2]
+	 v = y1 - cx0 - dy0
+.fi
+
+Another way of expressing this is to note that [U,V] is the transform
+of the origin [x,y]=[0,0] of the original coordinate system.
+There is nothing special about the rotation point; a rotation about
+any point [x,y] is equivalent to a rotation about the origin followed
+by a translation equal to the distance of the rotation point from the origin.
+
+The inverse transformation is given by
+
+.nf
+	|x|   |  -1|    / |x'|   |u| \
+	| | = | A  | * <  |  | - | |  >                            [2.3]
+	|y|   |    |    \ |y'|   |v| /
+.fi
+
+where A**(-1) is the inverse of the rotation matrix [a,b,c,d].
+
+.nh 2
+World Coordinate Systems
+
+    A world coordinate system (WCS) defines the transformation between
+a physical coordinate system (e.g., pixel coordinates in a reference image),
+and world coordinates expressed in some arbitrary units.  A two dimensional
+WCS can be expressed as
+
+.ks
+.nf
+	(x',y') = F (l,m, Wx,Wy)
+	(l,m) = [CD] * (x-Rx, y-Ry)                                [2.4]
+
+where
+
+	x,y	Are the coordinates of a point in the physical system.
+	l,m	Is a linearly transformed representation of the point.
+	x',y'	Are the coordinates of the same point in the world system.
+	F	Is the WCS function, possibly a nonlinear function.
+	Rx,Ry	Define the reference point in the physical system.
+	Wx,Wy	Are the world coordinates of the reference point.
+	[CD]	Is the coefficient determination (CD) matrix.
+.fi
+.ke
+
+The notation [CD]*(x,y) denotes a matrix multiply of the CD matrix [CD] and
+the vector (x,y), i.e., a linear transformation of the vector (x,y).
+If the WCS contains a nonlinear component, as for a sky projection,
+this is described by the function F in terms of the intermediate
+coordinates (l,m), e.g., the displacement in degrees from the reference
+point.  Separation of the WCS into linear and nonlinear components allows
+full specification of linear systems using only the basic interface,
+and simplifies the representation of the nonlinear part of the WCS.
+The nonlinear component itself (F) may be an object of arbitrary complexity.
+
+In the case of a simple 2D linear WCS with no rotation this reduces to
+
+.ks
+.nf
+	x' = (x - Rx) * CD[1,1] + Wx
+	y' = (y - Ry) * CD[2,2] + Wy
+.fi
+.ke
+
+In the general case the world system may be rotated with respect to the
+physical system (original image matrix), hence the WCS must include a
+rotation term.  Specifying this as a general linear transformation expressed
+as a matrix multiplication allows the representation of such transformations
+as conversion between skewed and cartesian coordinates as well as the
+more conventional rotation and scale transformation.
+
+The CD matrix representation (developed by STScI and now also associated
+with FITS), in addition to allowing specification of a linear transformation,
+is responsible for converting between the coordinate units used in the
+physical system and those used in the world system (more precisely,
+in the general case the units of (l,m) may differ from those of the
+world system, since F can also change the units).
+It is even possible for the world system to use different units on
+different axes, so long as a rotation is not defined between axes with
+different units.
+
+For example, if the WCS is used to describe an image cube, following
+application of the CD matrix axes 1 and 2 might have units of arc seconds,
+and axis 3 frequency.  In this case rotation would be defined only between
+axes 1 and 2, i.e., the off-diagonal CD matrix terms CD[1:2,3] and CD[3,1:2]
+must be zero, with CD[3,3] giving the scale for axis 3 independently of any
+rotation between axes 1 and 2.  This restriction on rotation between
+dissimilar axes applies only to the world system described by the CD matrix.
+As we shall see in the next section, when the WCS refers to an image,
+arbitrary rotations of the raw pixel matrix are still possible by using
+a separate pixel space transformation to describe transformations
+of the image matrix.
+
+.nh 3
+WCS Rotation Between Dissimilar Axes
+
+    To see why rotation between dissimilar axes is disallowed in some
+circumstances, note that the CD matrix, since it combines a rotation
+(or other pixel space linear transformation) and units conversion in one
+operation, can be expressed as follows in the case of a two dimensional system.
+
+The CD matrix is used as follows:
+
+.ks
+.nf
+	| l |   |    |   | x |
+	|   | = | CD | * |   |
+	| m |   |    |   | y |
+.fi
+.ke
+
+The CD matrix is constructed as follows:
+
+.ks
+.nf
+	|    |   | Dx   0 |   | a  b |
+	| CD | = |        | * |      |
+	|    |   | 0   Dy |   | c  d |
+.fi
+.ke
+
+where (Dx,Dy) is the units conversion matrix, and (a,b,c,d) is the
+rotation matrix.  This is a completely general representation, i.e.,
+any linear transformation may be specified by the matrix (a,b,c,d)
+and combined with the units conversion matrix, since the rotation
+matrix rotates the physical system to align the axes with those of
+the world coordinate system.
+
+The problem comes if we try to \fIrotate the CD matrix\fR.
+Although the CD matrix can express any
+rotation between the physical and world system, once the CD matrix
+has been formed the units conversion and rotation matrices cannot
+be recovered.  In general, further rotation of the system described by
+the CD matrix requires that we rotate the matrix (a,b,c,d), rather than
+the CD matrix itself.  The only exception occurs when Dx=Dy (similar axes),
+in which case the CD matrix and rotation matrix are equivalent except
+for a constant.  Hence, rotations between dissimilar axes of the system
+described by the (already formed) CD matrix are disallowed.  A special
+case is rotation is some multiple of 90 degrees, which can be represented
+by an axis swap or flip.
+
+.nh 2
+MWCS Coordinate System Representation
+
+    The coordinate system representation used by the MWCS interface consists of
+two components called the \fBLterm\fR and \fBWterm\fR, specifying independent
+logical and world transformations relative to a physical, cartesian coordinate
+system.  Three types of coordinate systems are defined, as outlined below.
+
+.ls
+.ls PHYSICAL
+The physical coordinate system is the raw coordinate system of the data.
+In the case of an image, the physical coordinate system refers to the pixel
+coordinates of the original data frame.  All other coordinates systems are
+defined in terms of the physical system (reference frame).
+.le
+.ls LOGICAL
+The logical coordinate system is defined by the \fILterm\fR in terms of the
+physical coordinate system.  In the case of an image, the logical coordinate
+system specifies raw pixel coordinates relative to some image section or
+derived image, i.e., the coordinates used for image i/o.  In the MWCS the
+Lterm specifies a simple linear transformation, in pixel units, between
+the original physical image matrix and the current image section.
+.le
+.ls WORLD
+The world coordinate system is defined by the \fIWterm\fR in terms of the
+physical coordinate system.  Any number of different kinds of world coordinate
+systems are conceivable.  Examples are the tangent (gnonomic) projection,
+specifying right ascension and declination relative to the original data
+image, or any linear WCS, e.g., a linear dispersion relation for spectral
+data.  Multiple world coordinate systems may be simultaneously defined in
+terms of the same physical system.
+.le
+.le
+
+The following observations apply to the behavior of MWCS as applied
+to image data.
+.ls
+.ls 4 1.
+Any linear transformation of the image matrix (shift, scale change,
+axis flip, etc.) affects only the Lterm.  The revised MWCS for the new
+image or image section may be computed merely by doing a linear
+transformation of the Lterm.
+.le
+.ls 4 2.
+If multiple world coordinate systems are associated with an image,
+all share the same Lterm.
+.le
+.ls 4 3.
+Geometric distortion of an image (not currently supported by MWCS) is
+a pixel space operation, i.e. a generalization of the Lterm, hence is
+independent of the WCS.
+.le
+.le
+
+In general, the physical and world coordinate systems are defined whenever
+a new image is created, e.g., by a task such as RFITS.  A new-copy type
+operation, such as most transformations performed by IMAGES tasks, affects
+only the Lterm.
+
+Although we normally speak in terms of images, MWCS is not
+limited to applications involving images.  For example, the physical
+coordinate system could just as well be a graphics frame buffer, and the
+logical coordinate system a pixrect.  A greyscale transformation is
+an example of a non-image WCS.  MWCS, or the successor interface,
+will eventually be used in GIO, e.g., for cursor readback.
+
+Since the Wterm includes the CD matrix, which defines a linear
+transformation, and linear transformations can be combined, in principle
+it is possible to combine the Lterm and Wterm to define a single
+transformation from logical to world coordinates.  In practice this
+can run into problems, as not all pixel space rotations may be
+representable by the CD matrix (since the latter may define different
+world space units on different axes).  Furthermore, if multiple WCS
+are defined, and the WCS are defined in terms of the logical system,
+it would be inefficient to have to transform each WCS to the new logical
+system each time a linear transformation of the data is performed
+(e.g., every time an image is opened with an image section).
+
+For images, the common coordinate transformations are image section (logical)
+coordinates to world coordinates and vice versa, and section coordinates
+to physical coordinates and vice versa.  The physical coordinate system
+can be regarded as a special case of a world coordinate system (the "pixel"
+coordinate system) defined relative to logical image section coordinates.
+
+For example, to convert IMIO image coordinates to world coordinates,
+the interface will first apply the inverse of the Lterm to determine the
+coordinates in the physical system, then apply the Wterm for the desired WCS
+to compute the world coordinates.  If the Wterm is linear and the Lterm
+does not define any rotations between dissimilar axes, the two operations
+can be combined for a more efficient coordinate transformation.
+
+An arbitrary number of world coordinate systems may be defined over the
+same domain in the physical coordinate system.  Every WCS has a name
+uniquely specifying the WCS type.  A WCS may also have attributes such as
+units, axis labels, and numeric output formats specified independently for
+each axis, as well as arbitrary user defined WCS attributes.
+
+.nh 3
+Lterm Representation
+
+    The Lterm is defined by the terms of a general linear transformation,
+as shown in equation [2.1].  For example, in the case of a 2D system the
+following quantities must be given to define the Lterm.
+
+.ks
+.nf
+	[CD] = [a,b,c,d]	rotation matrix
+	tv[] = [u,v]		translation vector
+.fi
+.ke
+
+This defines the transformation between the physical and logical coordinate
+systems, i.e., applying the transformation to a pair of physical coordinates
+[x,y] yields the corresponding logical coordinates [x',y'].  MWCS will
+automatically compute the inverse transformation when asked to convert
+between logical coordinates and physical or world coordinates.
+
+.nh 3
+Wterm Representation
+
+    The Wterm defines the transformation between the physical system and
+some arbitrary world coordinate system.  The Wterm is defined by the
+following quantities:
+
+.nf
+	R[]		reference coordinates in physical system
+	W[]		world coordinates at the reference point
+	[CD]		coordinate determination matrix
+	wtype		type of WCS (function name string)
+	wattr		WCS attributes (string, opaque outside interface)
+.fi
+
+The point R, also known as the \fIreference pixel\fR when dealing
+with image data, defines the origin of the world coordinate system in
+the physical system.  The world coordinates at the reference point are
+given by the vector W (at least for a linear WCS; in general the meaning
+of the W term depends upon the WCS type).  The CD matrix defines any
+rotation between the physical and world systems, as well as the scale
+conversion needed to convert between physical and world (or linear world)
+coordinates.
+
+Although the function name or type \fIwtype\fR is
+accessible to applications, the details of what the WCS means, and how
+it is evaluated, are intended to be internal to the interface, hence
+the use of strings to pass in the WCS information.  Functions complex
+enough to require coefficients should pass the extra information in via
+the \fIwattr\fR term.  WCS attributes such as the axis units and labels
+are also passed in via \fIwattr\fR.
+
+In the general case there may be any number of different WCS types.
+In the case of MWCS, however, only a predefined set of WCS types are
+supported, since the code for each WCS is wired into the interface.
+The predefined WCS types (as selected by \fIwtype\fR) are the following.
+
+.ks
+.nf
+	\fIWtype\fR			\fIDescription\fR
+
+	linear			simple linear WCS
+	sampled			sampled WCS function
+	(TAN etc.)		the sky projections
+.fi
+.ke
+
+A \fIlinear\fR WCS is specified by the physical and world coordinates of the
+reference point, and the row or rows of the CD matrix pertaining to the axes
+to which the WCS is assigned.  A linear WCS is completely specified by the
+linear term of the standard WCS representation.
+  
+A \fIsampled\fR WCS is specified by an array of (physical, world) coordinate
+pairs, i.e., an array of reference points, sampling the linear WCS function
+for that axis.  In the limiting case, for sampled (pixel) data, there is one
+(physical, world) point on the WCS curve for each data point.  If the WCS
+function is smooth a coarser sampling can be used to approximate the curve,
+using some form of interpolation to evaluate the function.  In the MWCS,
+a sampled function must be one-dimensional, i.e., associated with a single
+axis (higher dimensional surfaces can be represented so long as the axes
+are independent).
+
+Note that the sampled function is expressed in terms of the \fIoffset\fR
+from the reference point in both the physical and world systems.
+Any analytic function, e.g., polynomial or spline, can be sampled and
+later reconstructed from the sampled curve with no significant error,
+provided the function type and order are known and there are sufficient
+sample points to determine the system.
+The advantage of the sampled representation is that it is independent of
+the function type, and can be used to fit any analytic function when the
+time comes to evaluate the curve.
+
+The sky projections are a special case used with astronomical direct images. 
+The principal example is the gnomonic projection, the projection of the
+celestial sphere onto a plane tangent at the reference point.
+The sky projections are completely specified by the reference point and the
+standard CD matrix, plus the WCS name which specifies the type of projection,
+e.g., "gnomonic", "sine", "arc", and so on.
+
+The WCS attributes which can be set by the \fIwattr\fR string consist of
+a number of standard attributes, plus an arbitrary number of additional
+WCS specific attributes.  Examples of standard attributes include "system",
+"wtype", "units", "label", etc.  A list of the standard WCS attributes is
+given in section 3.3.1.
+
+.nh
+Interface Overview
+
+    The MWCS interface is a stand-alone interface implementing the linear
+and world coordinate transformation abstractions.  While the interface
+is designed with the typical application to image data in mind, MWCS is
+intended as a general coordinate transformation facility for use with any
+type of data, as an embedded interface in other software, including system
+interfaces such as IMIO and GIO as well as user applications.
+
+.nh 2
+Object Creation and Storage
+
+    The MWCS interface routines used to create or access MWCS objects, or
+save and restore MWCS objects in external storage, are summarized below.
+
+.nf
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+.fi
+
+A new MWCS object, initialized either to a unitary transformation of
+dimension \fIndim\fR or to the encoded MWCS in the input buffer,
+is created with \fImw_open\fR.  A MWCS object is be
+created and initialized from an image with \fImw_openim\fR; if the referenced
+image does not currently have any WCS information associated with it,
+a unitary pixel WCS will be created.  The \fImw_newcopy\fR operation
+creates a new MWCS object as a copy of an existing one, as one might wish
+to do prior to modifying a WCS.  When a descriptor is no longer needed it
+should be returned with \fImw_close\fR.
+
+A MWCS object (descriptor) is a memory object.  To encode a MWCS in an opaque
+machine independent binary array, e.g., for storage in a file or transmission
+through a datastream, \fImw_save\fR is called with the \fIchar\fR pointer of
+the buffer in which the encoded MWCS is to be placed.  If the buffer pointer is
+NULL a buffer will be created and the pointer returned, and if a valid buffer
+is passed it will be resized as necessary to store the encoded object.
+An encoded MWCS object is reloaded into a descriptor with \fImw_load\fR.
+A MWCS may be stored or updated in an image header with \fImw_saveim\fR,
+or loaded from the image header into a descriptor with \fImw_loadim\fR.
+These are the only interface routines with knowledge of the parameter names,
+etc., used to store WCS information in image headers.
+
+.nh 2
+Coordinate Transformation Procedures
+
+    The MWCS procedures used to perform coordinate transformations,
+and to modify or examine the Lterm and Wterm, are summarized below.
+
+.nf
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+.fi
+
+The procedures \fImw_[cv][12]tran[rd]\fR perform coordinate
+transformations for individual coordinates or coordinate vectors,
+for one or two dimensional systems, for coordinates of type real or double.
+The general N dimensional case is handled by the \fImw_[cv]tran[rd]\fR
+procedures, which transform \fIndim\fR-dimensional points (\fImw_ctran\fR)
+or point vectors (\fImw_vtran\fR).  A single point is specified as a
+vector of length \fIndim\fR; a point vector is expressed as an array of
+points, i.e., a 2-dimensional array V[I,J], where the index I refers to
+the axis within a point vector, and where the index J refers to the point.
+The notation V[1,j] references the 1-dimensional point vector for point J.
+
+The direction of the transformation, and the axes for which the transformation
+is to be performed, is determined by a prior call to \fImw_sctran\fR,
+which specifies the input and output coordinate systems, and performs the
+initialization necessary for efficient evaluation of a series of
+transformations.  A pointer to the optimized transformation descriptor is
+returned, to allow two or more transformations to be prepared and used
+simultaneously without having to repeat the setup, which can be considerably
+more expensive than coordinate evaluation.  The transformation descriptor
+should be freed when no longer needed, else it will be freed automatically
+when the MWCS is closed.
+
+A coordinate system is specified to \fImw_sctran\fR by its name.
+The following standard systems are predefined.
+Additional WCS names may be defined by the application.
+
+.ks
+.nf
+	"logical"		The logical system
+	"physical"		The physical system
+	"world"			The default world system
+	(user-wcs)		User defined systems
+.fi
+.ke
+
+Strings are used to specify the coordinate systems in order to allow user
+defined and named systems to be added at runtime.
+The use of a setup procedure to specify the desired transformation allows
+new types of coordinate transformations to be easily added, for example
+mixed conversions, as for a 2-dimensional system where the X and Y components
+of a coordinate pair belong to different coordinate systems, or computation
+of the derivative at a point.  In MWCS, only simple conversions between any
+two of the physical, logical, and world coordinate systems are supported.
+
+Specification of the axes for which the coordinate transformation is desired
+is necessary for the more complex systems, since there may be different,
+often quite independent coordinate systems defined on different axes.
+The axes for which the transformation is to be prepared are specified as
+a bitmask.  The default, if the mask is zero, is to use axes starting with
+1, up to the number required to satisfy the given dimension transformation.
+
+For example, to convert two dimensional image coordinates (section relative)
+to world coordinates in the default WCS:
+
+.nf
+	call mw_sctran (mw, "logical", "world", 3B)
+	call mw_c2tranr (mw, px,py, wx,wy)
+.fi
+
+Multiple independent world coordinate systems may be defined relative to
+the same physical system.  Most applications, however, are best written
+as if there were only one world system, with the coordinate system to be
+used being switched about transparently to the application.  For this
+reason there is no WCS number argument to the MWCS procedures, and
+the "world" system specifies the \fIcurrent default\fR WCS.  If a MWCS object
+defines multiple world coordinate systems, a \fImw_ssystem\fR call is used
+to select the WCS to be used.  This could be used, for example, to change
+the units appearing on plots in a graphics application, transparently
+to the application.
+
+.nh 2
+Coordinate System Specification
+
+    The MWCS procedures used to enter, modify, or inspect the MWCS
+logical and world coordinate transformations are summarized in the figure
+below.
+
+The procedures \fImw_[sg]lterm\fR are used to directly enter
+or inspect the Lterm, which consists of the linear transformation matrix
+\fIltm\fR and the translation vector \fItv\fR, both of dimension \fIndim\fR,
+defining the transformation from the physical system to the logical system.
+If the logical system undergoes successive linear transformations,
+\fImw_translate\fR may be used to translate, rather than replace,
+the current Lterm, where the given transformation matrix and translation
+vector refer to the relative transformation undergone by the logical system.
+This will always work since the Lterm is initialized to the identity matrix
+when a new MWCS object is created.  The routines \fImw_rotate\fR,
+\fImw_scale\fR, and \fImw_shift\fR provide a convenient front-end to
+\fImw_translate\fR for the more common types of translations.
+
+Specification of the Wterm is somewhat more complicated.  The Wterm for
+a new WCS should first be created and initialized for a system of the given
+dimensionality with \fImw_newsystem\fR.  The linear portion of the Wterm,
+i.e., the CD matrix and the coordinates of the reference point
+in the physical and world systems, and the WCS dimension, may then be entered
+with \fImw_swterm\fR and queried with \fImw_gwterm\fR.
+
+.nf
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+.fi
+
+The world portion of the Wterm is unusual in that the type of WCS may be
+specified independently for each axis.  The WCS function type \fIwtype\fR,
+and any attributes \fIwattr\fR, are specified for the indicated \fIaxes\fR
+with \fImw_swtype\fR.  The axes specified are those required to evaluate
+the named function.
+
+In the case of an axis of type "sampled", the sampled WCS function must
+also be entered via a call to \fImw_swsamp\fR, and may later be retrieved
+with \fImw_gwsamp\fR.  The WCS function is defined as an \fIoffset\fR from
+the reference point in both the physical and world systems, e.g.,
+the vector \fIWv\fR will be added to the world coordinates
+produced by interpolating the sampled function (this can of course be
+defeated by setting R or W to zero).
+
+A WCS always has a number of predefined \fIattributes\fR, and may also
+have any number of user defined, or WCS specific, attributes.  These are
+defined when the WCS is created, in the \fIwattr\fR argument input to
+\fImw_swtype\fR, or in a subsequent call to \fImw_swattrs\fR.  The WCS
+attributes for a specific axis may be queried with the function
+\fImw_gwattrs\fR.  Attribute values may be modified, or new attributes defined,
+with \fImw_swattrs\fR.  The issue of WCS attributes is discussed further
+in the next section.
+
+.nh 3
+WCS Types and Attributes
+
+    The WCS attributes which can be set by the \fIwattr\fR term consist of
+a number of standard attributes, plus an arbitrary number of additional
+WCS specific (application defined) attributes.  The following standard
+attributes are reserved (but not necessarily defined) for each WCS:
+
+.nf
+	"units"		axis units ("pixels", etc.)
+	"label"		axis label, for plots
+	"format"	axis numeric format, for tick labels
+	"wtype"		WCS type, e.g., "linear"
+.fi
+
+In addition, the following are defined for the entire WCS,
+regardless of the axis:
+
+.nf
+	"system"	system name (logical, physical, etc.)
+	"object"	external object with which WCS is associated
+.fi
+
+For example, to determine the WCS type for axis 1:
+
+	call mw_gwattrs (mw, 1, "wtype", wtype, SZ_WTYPE)
+
+The (world coordinate) system name \fIsystem\fR is what is used, e.g.,
+to select a WCS in a call to \fImw_ssystem\fR, or define a coordinate
+transformation in a call to \fImw_sctran\fR.  Note that the system name
+"world" is actually only an alias for the \fIdefault world system\fR.
+This may be any primary system, i.e., the logical or physical system,
+or a user defined world system.  The initial default world system may
+be specified by the user by predefining the environment variable
+\fBdefwcs\fR, otherwise the first-defined user world system is used,
+else the physical system is used.
+
+If the MWCS is associated with an image then the "object" attribute of
+the physical system will return the name of the image or image section
+defined as the physical coordinate system for the MWCS.
+This is not necessarily the full image, e.g., in the case of
+a multidimensional image, the physical system might be any 2D plane of the
+image.  In the case of an event file image, the image name may include a
+filter or blocking factor.  References back to the raw data image based on
+MWCS physical coordinates will work so long as the raw image is opened
+using the name returned by the interface.  If the image is already open
+and was accessed by descriptor via MWCS, the descriptor may be retrieved
+by a \fImw_stati\fR call to fetch MW_IMDES.
+
+All MWCS coordinate systems have the standard attributes, with default values
+being supplied by the interface if not set by the application.  In particular,
+the logical and physical coordinate systems have attributes and may be
+treated as a special case of a world coordinate system by the application.
+
+.nh 3
+Axis Mapping
+
+    The coordinate transformation procedures (section 3.2) include support
+for a feature called \fIaxis mapping\fR, used to implement \fIdimensional
+reduction\fR.  A example of dimensional reduction occurs in IMIO, when
+an image section is used to specify a subraster of an image of dimension
+less than the full physical image.  For example, the section might specify
+a 1 dimensional line or column of a 2 or higher dimensional image, or a
+2 dimensional section of a 3 dimensional image.  When this occurs the
+applications sees a logical image of dimension equal to that of the image
+section, since logically an image section \fIis\fR an image.
+
+Dimensional reduction is implemented in MWCS by a transformation on the
+input and output coordinate vectors.  The internal MWCS coordinate system
+is unaffected by either dimensional reduction or axis mapping; axis mapping
+affects only the view of the WCS as seen by the application using the
+coordinate transformation procedures.
+
+For example, if the physical image is an image cube and we access the
+logical image section "[*,5,*]", an axis mapping may be set up which
+maps \fIphysical\fR axis 1 to logical axis 1, physical axis 2 to the
+constant 5, and physical axis 3 to logical axis 2.  The internal system
+remains 3 dimensional, but the application sees a 2 dimensional system.
+Upon input, the missing axis y=5 is added to the 2 dimensional input
+coordinate vectors, producing a 3 dimensional coordinate vector for
+internal use.  During output axis 2 is dropped and replaced by axis 3.
+
+The axis map is entered with \fImw_saxmap\fR and queried with \fImw_gaxmap\fR.
+Here, \fIaxno\fR is a vector, with \fIaxno[i]\fR specifying the logical axis
+to be mapped onto physical axis I.  If zero is specified the constant
+\fIaxval[i]\fR is used instead.  Axis mapping may be enabled or disabled
+with a call to \fImw_seti\fR.
+
+Axis mapping affects all of the coordinate transformation procedures,
+plus \fImw_translate\fR (since it defines a translation in terms of the
+logical system), and all of the coordinate system specification procedures
+having an "axis" parameter, e.g., \fImw_gwattrs\fR.
+Axis mapping is not used with those procedures which directly access or
+modify the physical or world systems (e.g., \fImw_slterm\fR or
+\fImw_swterm\fR) since full knowledge of the physical system is necessary
+for such operations.
+
+.nh 3
+Binding the Physical System
+
+    Recall that all coordinate systems are defined in terms of the physical
+system, and that the Lterm defines the mapping between the physical system
+and the logical system.  Transformations of the logical system leave the
+physical and world systems unaffected.  The only exception to this is the
+procedure \fImw_bindphys\fR, which binds the physical system to the current
+logical system, i.e., makes the current logical system the new physical system.
+This involves a transformation of the linear term (CD matrix) of each world
+system, since a world system is defined in terms of the physical system,
+and initialization of the Lterm to (normally) the identity matrix and zero
+translation vector.  This operation is irreversible, i.e., once
+\fImw_bindphys\fR is executed the original physical system is lost.
+
+In the case of an MWCS which is associated with an image opened with an image
+section, the new physical system is not strictly speaking the logical system,
+but the image matrix of the image being accessed, i.e,. the current image
+ignoring the image section.  Hence, following a call to \fImw_bindphys\fR,
+the Lterm will always describe the translation between the physical image
+matrix currently being accessed, and the logical system (image section).
+
+.nh 2
+Set/Stat Procedures
+
+    The MWCS status procedures, used to query or set the MWCS parameters,
+are as follows.
+
+.nf
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
+.fi
+
+The currently defined interface parameters are the following.
+
+.nf
+	   Name       Type          Description
+
+	MW_AXMAP	b	enable or disable axis mapping
+	MW_IMDES	i	descriptor of associated image
+	MW_INTERP	i	interpolator type for sampled wcs
+	MW_NDIM		i	dimensionality of logical system
+	MW_NPHYSDIM	i	dimensionality of physical system
+	MW_NWCS		i	number of wcs defined
+	MW_WCS		i	currently active wcs
+.fi
+
+MW_NDIM may differ from MW_NPHYSDIM if dimensional reduction has been
+specified and axis mapping is enabled.  MW_NWCS returns the number of
+WCS currently defined; at least two WCS are always defined, i.e., the
+logical and physical systems (the world system will default to the
+physical system if not otherwise defined).  The index of the current
+default WCS is given by MW_WCS.  In the case of a sampled WCS, the
+interpolator type used by the coordinate transformation procedures is
+specified by MW_INTERP.
+
+.nh 2
+Utility Routines
+
+    The following routines are used internally within the interface to
+compile or evaluate transformations, and may be useful in applications
+code as well.
+
+.nf
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+.fi
+
+These routines perform matrix inversion, multiplication of a matrix by another
+matrix, multiplication of a vector by a matrix, and general linear
+transformation (matrix multiply and addition of translation vector).
+
+.nh 2
+Datatypes and Precision
+
+    All floating point data is stored internally in MWCS using double
+precision.  Most of the interface procedures have both type real and type
+double versions, e.g., for entering Lterm or Wterm data.
+The single precision versions should be normally used unless double
+precision is required to represent the data.
+
+Although all floating point data is stored internally as type double,
+coordinate transformations performed at runtime may be carried out using
+either single or double precision computations, depending upon, e.g., whether
+\fImw_ctranr\fR or \fImw_ctrand\fR is called to perform the transformation.
+What happens is that when the transformation is compiled by \fImw_sctran\fR,
+two transformation descriptors are prepared, one for type real and the other
+for type double, with the appropriate descriptor being selected at runtime
+to carry out the transformation.  Hence the precision appropriate for the
+problem at hand can be employed without requiring that the worst case
+precision be used for all applications.
+
+.nh
+IMIO Interface to MWCS
+.nh 2
+Image Header Representation
+
+    When MWCS is used with image data, the encoded MWCS object is stored
+in the image header, and loaded into an MWCS descriptor when the image is
+accessed by an applications program.  The format in which the MWCS is
+stored in the image header depends upon the type of image.  If the image
+has a "flex-header" (as for QPOE and the new image structures) the MWCS
+is encoded in a machine independent binary format and stored in the image
+header as a variable length byte array.  This provides full generality
+and is the most efficient approach.
+
+For the older image formats which use a FITS header (OIF and STF) it is
+necessary to encode the MWCS as a series of FITS cards.  The proposed FITS
+WCS format, already in use for STF format images (with minor deviations
+from the standard), is used to represent the MWCS Wterm.  Additional FITS
+cards are necessary to represent the Lterm.  The (P,W) array for sampled
+WCS can also be represented in a FITS header, although this is awkward and
+inefficient if the number of samples is large.
+
+The FITS header keywords used to represent the Wterm, Lterm, and sampled
+WCS are the following.
+
+.nf
+	WCSDIM		WCS dimension (may differ from image)
+
+	CTYPEn		coordinate type
+	CRPIXn		reference pixel
+	CRVALn		world coords of reference pixel
+	CDi_j		CD matrix
+
+	CDELTn		CDi_i if CD matrix not used (input only)
+	CROTA2		rotation angle if CD matrix not used
+
+	LTVi		Lterm translation vector
+	LTMi_j		Lterm rotation matrix
+
+	WSVi_LEN	Number of sample points for axis I
+	WSVi_jjj	Sampled WCS array for axis I
+
+	WATi_jjj	WCS attributes for axis I
+.fi
+
+Contrary to MWCS convention, the WCS stored in a FITS format header
+defines the transformation from the logical system (image matrix)
+to the world system, rather than the physical system.  The MWCS Wterm
+is computed from the FITS representation by transforming the FITS WCS
+by the stored Lterm when the stored MWCS is loaded.
+
+The name format CDi_j varies slightly from the proposed FITS standard, but is
+backwards compatible with STF (and more readable than the FITS nomenclature).
+The keywords LTVECn, LTi_j, WSVi_LEN, WSVi_jjj, and WATi_jjj are peculiar
+to MWCS.  A sampled WCS is represented as a series of WSVi_jjj cards,
+wherein the sample points are stored as character strings, storing as
+many sample points as possible on each card, ignoring the card boundaries
+(i.e., a card may end in the middle of a number).  WCS attributes are likewise
+encoded as a series of WATi_jjj cards, giving the attributes for axis I as
+string data of the form "attribute = value", ignoring card boundaries.
+Multiple world coordinate systems (other than the physical and one world
+system) cannot be used with old format image headers.
+
+.nh 2
+Handling of the WCS by IMIO
+
+    When an image is opened by IMIO the image header is read, an MWCS
+descriptor is opened, and the stored MWCS is loaded into the MWCS descriptor
+from the image header.  If an image section has been opened the Lterm
+is then updated to reflect the additional linear transformation defined
+by the section.  The correct logical to physical or world transformation
+is then seen at the IMIO level, and will be propagated to a new image
+in a NEW_COPY image operation when the MWCS is copied to the new image.
+
+In the case of an image format which uses a FITS header, application of
+the section transform during an image open \fIdoes not\fR include updating
+of the FITS representation of the WCS.  There are two problems with doing
+so: all this editing of the FITS image of the header is inefficient
+unless absolutely necessary, and more seriously, if the image is opened
+READ_WRITE with an image section and the header is later updated, the
+stored WCS will be incorrect.  So, while the WCS as represented by the
+MWCS will always be correct, the FITS header parameters will reflect
+the WCS of the raw image ignoring the image section.  If it is necessary
+for some reason to update the FITS header in memory to reflect the image
+section, \fImw_saveim\fR may be called to perform the udpate.
+
+Propagation of the correct logical system in a NEW_COPY operation works
+because once the FITS header is copied, \fImw_saveim\fR is called to
+edit the header of the new image.
+
+.nh
+Implementation
+.nh 2
+Restrictions
+
+    Since there was not time to solve the general WCS problem with the MWCS
+interface, several restrictions were accepted for this version.  These are
+the following.
+.ls
+.ls o
+All WCS functions are built in (hard coded), hence the interface is not
+extensible at runtime and the only way to support new applications is
+through modification of the interface (by adding new function drivers).
+.le
+.ls o
+There is no support for modeling geometric distortions, except possibly
+in one dimension.
+.le
+.ls o
+There is no provision for storing more than one world coordinate system
+in FITS oriented image headers, although multiple WCS are supported internally
+by the interface, and are preserved and restored across \fImw_save\fR and
+\fImw_load\fR operations.
+.le
+.ls o
+Coordinate transforms involving dependent axes must includes all such axes
+explicitly in the transform.  Dependent axes are axes which are related,
+either by a rotation, or by a WCS function.  Operations which could subset
+dependent axis groups, and which are therefore disallowed, include setting
+up a transform with an AXES bitmap which excludes dependent axes, or more
+importantly, an image section involving dimensional reduction, where the
+axis to be removed is not independent.  This could happen, for example,
+if a two-dimensional image were rotated and one tried to open a
+one-dimensional section of the rotated image.
+.le
+.le
+
+All these problems can be solved given enough time, although the last problem
+mentioned becomes very complicated (perhaps intractable) when nonlinear world
+systems of dimension greater than three are involved.
+
+.nh 2
+Function Drivers
+
+    World coordinate systems are implemented in MWCS by providing something
+called a \fIfunction driver\fR for each function type, as specified by the
+\fIwtype\fR argument to \fImw_swtype\fR.  The \fIwtype\fR is the name of
+the function, and the name of the function driver.
+
+A function driver consists of the following procedures.  A given driver
+need not implement all driver procedures; procedures which are not used
+by a driver are set to NULL in the function driver table.
+
+.nf
+        operation                       syntax
+
+        FN_INIT                 wf_FCN_init (fc, dir)
+        FN_DESTROY           wf_FCN_destroy (fc)
+        FN_FWD                   wf_FCN_fwd (fc, pv, wv)
+        FN_INV                   wf_FCN_inv (fc, wv, pv)
+.fi
+
+where FCN is replaced by a 3 letter abbreviation for the function name,
+e.g., "smp" for the sampled WCS function, "tan" for the tangent plane
+projection etc.  This is only a suggested naming convention; the actual
+driver procedure names are arbitrary so long as name conflicts are
+avoided.
+
+The argument FC to each driver procedure is a pointer to the function call
+descriptor set up by \fImw_sctran\fR.  This consists of a number of standard
+fields followed by an area which is reserved for fields which are private
+to the function driver.  During compilation of a transformation, the function
+driver initialization procedure FN_INIT will be called to perform any function
+dependent initialization, e.g., processing of the attribute list for the
+axes assigned to the function, to input any function specific parameters.
+
+During runtime evaluation of a function call, FN_FWD will be called for a
+forward transformation (physical to world), and FN_INV for an inverse
+transformation (world to physical).  Note that the linear portion of the
+WCS, i.e., the CD matrix and all other linear terms except W (the CRVAL
+vector) are handled the same for all WCS functions, outside of the driver.
+Hence when the driver is called for a forward transformation, for example,
+the CD matrix and R vector (defining the reference point) will already
+have been applied to the input vector PV.
+
+To fully understand how function drivers are implemented it is probably
+simplest to study the existing drivers.
+
+.tp 40
+.sh
+Appendix A:  Interface Summary
+
+.nf
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
+.fi
+.sp
+.endhelp
diff --git a/sys/mwcs/README b/sys/mwcs/README
new file mode 100644
index 00000000..10f44b60
--- /dev/null
+++ b/sys/mwcs/README
@@ -0,0 +1,47 @@
+MWCS Interface Summary
+
+
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
diff --git a/sys/mwcs/gen/mkpkg b/sys/mwcs/gen/mkpkg
new file mode 100644
index 00000000..bc8fe837
--- /dev/null
+++ b/sys/mwcs/gen/mkpkg
@@ -0,0 +1,29 @@
+# Make the generic portion of MWCS.
+
+$checkout libex.a lib$
+$udate    libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	mwc1trand.x	../mwcs.h
+	mwc1tranr.x	../mwcs.h
+	mwc2trand.x	../mwcs.h
+	mwc2tranr.x	../mwcs.h
+	mwctrand.x	../mwcs.h
+	mwctranr.x	../mwcs.h
+	mwgctrand.x	../mwcs.h
+	mwgctranr.x	../mwcs.h
+	mwltrand.x	
+	mwltranr.x	
+	mwmmuld.x	
+	mwmmulr.x	
+	mwv1trand.x	../mwcs.h
+	mwv1tranr.x	../mwcs.h
+	mwv2trand.x	../mwcs.h
+	mwv2tranr.x	../mwcs.h
+	mwvmuld.x	
+	mwvmulr.x	
+	mwvtrand.x	
+	mwvtranr.x	
+	;
diff --git a/sys/mwcs/gen/mwc1trand.x b/sys/mwcs/gen/mwc1trand.x
new file mode 100644
index 00000000..af46e02d
--- /dev/null
+++ b/sys/mwcs/gen/mwc1trand.x
@@ -0,0 +1,24 @@
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+double procedure mw_c1trand (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x			#I coordinates in input system
+
+double	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Memd[CT_LTM(ct)] * x + Memd[CT_LTV(ct)])
+	} else {
+	    call mw_ctrand (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/gen/mwc1tranr.x b/sys/mwcs/gen/mwc1tranr.x
new file mode 100644
index 00000000..06ad0bf7
--- /dev/null
+++ b/sys/mwcs/gen/mwc1tranr.x
@@ -0,0 +1,24 @@
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+real procedure mw_c1tranr (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x			#I coordinates in input system
+
+real	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Memr[CT_LTM(ct)] * x + Memr[CT_LTV(ct)])
+	} else {
+	    call mw_ctranr (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/gen/mwc2trand.x b/sys/mwcs/gen/mwc2trand.x
new file mode 100644
index 00000000..0cb156bd
--- /dev/null
+++ b/sys/mwcs/gen/mwc2trand.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2trand (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1,y1			#I coordinates in input system
+double	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+double	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Memd[ltm  ] * x1 + Memd[ltv  ]
+	    y2 = Memd[ltm+3] * y1 + Memd[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Memd[ltm  ] * p1[1] + Memd[ltm+1] * p1[2] + Memd[ltv  ]
+	    y2 = Memd[ltm+2] * p1[1] + Memd[ltm+3] * p1[2] + Memd[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctrand (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/gen/mwc2tranr.x b/sys/mwcs/gen/mwc2tranr.x
new file mode 100644
index 00000000..ef5b5ef7
--- /dev/null
+++ b/sys/mwcs/gen/mwc2tranr.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2tranr (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1,y1			#I coordinates in input system
+real	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+real	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Memr[ltm  ] * x1 + Memr[ltv  ]
+	    y2 = Memr[ltm+3] * y1 + Memr[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Memr[ltm  ] * p1[1] + Memr[ltm+1] * p1[2] + Memr[ltv  ]
+	    y2 = Memr[ltm+2] * p1[1] + Memr[ltm+3] * p1[2] + Memr[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctranr (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/gen/mwctrand.x b/sys/mwcs/gen/mwctrand.x
new file mode 100644
index 00000000..70e575cc
--- /dev/null
+++ b/sys/mwcs/gen/mwctrand.x
@@ -0,0 +1,97 @@
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctrand (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	p1[ndim]		#I coordinates of point in input system
+double	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Memd[ltm+(i-1)*(ndim+1)] * p1[i] + Memd[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltrand (p1, p2, Memd[ltm], Memd[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call achtdd (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtdd (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwctranr.x b/sys/mwcs/gen/mwctranr.x
new file mode 100644
index 00000000..0574a563
--- /dev/null
+++ b/sys/mwcs/gen/mwctranr.x
@@ -0,0 +1,97 @@
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctranr (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	p1[ndim]		#I coordinates of point in input system
+real	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Memr[ltm+(i-1)*(ndim+1)] * p1[i] + Memr[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltranr (p1, p2, Memr[ltm], Memr[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call achtrd (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtdr (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwgctrand.x b/sys/mwcs/gen/mwgctrand.x
new file mode 100644
index 00000000..cfdca886
--- /dev/null
+++ b/sys/mwcs/gen/mwgctrand.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctrand (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	o_ltm[ARB]		#O linear tranformation matrix
+double	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_D(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Memd[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Memd[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/gen/mwgctranr.x b/sys/mwcs/gen/mwgctranr.x
new file mode 100644
index 00000000..7825c6df
--- /dev/null
+++ b/sys/mwcs/gen/mwgctranr.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctranr (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	o_ltm[ARB]		#O linear tranformation matrix
+real	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_R(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Memr[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Memr[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/gen/mwltrand.x b/sys/mwcs/gen/mwltrand.x
new file mode 100644
index 00000000..d35670c7
--- /dev/null
+++ b/sys/mwcs/gen/mwltrand.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltrand (p1, p2, ltm, ltv, ndim)
+
+double	p1[ndim]			#I input point
+double	p2[ndim]			#O transformed output point
+double	ltm[ndim,ndim]			#I linear transformation matrix
+double	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+double	p3[MAX_DIM]
+
+begin
+	call amovd (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwltranr.x b/sys/mwcs/gen/mwltranr.x
new file mode 100644
index 00000000..9cafe4d2
--- /dev/null
+++ b/sys/mwcs/gen/mwltranr.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltranr (p1, p2, ltm, ltv, ndim)
+
+real	p1[ndim]			#I input point
+real	p2[ndim]			#O transformed output point
+real	ltm[ndim,ndim]			#I linear transformation matrix
+real	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+real	p3[MAX_DIM]
+
+begin
+	call amovr (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwmmuld.x b/sys/mwcs/gen/mwmmuld.x
new file mode 100644
index 00000000..ae35f082
--- /dev/null
+++ b/sys/mwcs/gen/mwmmuld.x
@@ -0,0 +1,21 @@
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmuld (a, b, c, ndim)
+
+double	a[ndim,ndim]		#I left input matrix
+double	b[ndim,ndim]		#I right input matrix
+double	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+double	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/gen/mwmmulr.x b/sys/mwcs/gen/mwmmulr.x
new file mode 100644
index 00000000..83e14d2c
--- /dev/null
+++ b/sys/mwcs/gen/mwmmulr.x
@@ -0,0 +1,21 @@
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmulr (a, b, c, ndim)
+
+real	a[ndim,ndim]		#I left input matrix
+real	b[ndim,ndim]		#I right input matrix
+real	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+real	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/gen/mwv1trand.x b/sys/mwcs/gen/mwv1trand.x
new file mode 100644
index 00000000..3c3ac124
--- /dev/null
+++ b/sys/mwcs/gen/mwv1trand.x
@@ -0,0 +1,32 @@
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1trand (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1[ARB]			#I coordinates in input system
+double	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+double	scale, offset
+errchk	mw_ctrand
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	scale  = Memd[CT_LTM(ct)]
+	offset = Memd[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctrand (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/gen/mwv1tranr.x b/sys/mwcs/gen/mwv1tranr.x
new file mode 100644
index 00000000..045f6a33
--- /dev/null
+++ b/sys/mwcs/gen/mwv1tranr.x
@@ -0,0 +1,32 @@
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1tranr (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1[ARB]			#I coordinates in input system
+real	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+real	scale, offset
+errchk	mw_ctranr
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	scale  = Memr[CT_LTM(ct)]
+	offset = Memr[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctranr (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/gen/mwv2trand.x b/sys/mwcs/gen/mwv2trand.x
new file mode 100644
index 00000000..3a1cf329
--- /dev/null
+++ b/sys/mwcs/gen/mwv2trand.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2trand (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1[ARB],y1[ARB]		#I coordinates in input system
+double	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+double	p1[2], p2[2]
+errchk	mw_ctrand
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Memd[ltm  ] * x1[i] + Memd[ltv  ]
+		y2[i] = Memd[ltm+3] * y1[i] + Memd[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Memd[ltm  ] * p1[1] + Memd[ltm+1] * p2[1] +
+		    Memd[ltv  ]
+		y2[i] = Memd[ltm+2] * p1[1] + Memd[ltm+3] * p2[1] +
+		    Memd[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctrand (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/gen/mwv2tranr.x b/sys/mwcs/gen/mwv2tranr.x
new file mode 100644
index 00000000..dc2fe58f
--- /dev/null
+++ b/sys/mwcs/gen/mwv2tranr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2tranr (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1[ARB],y1[ARB]		#I coordinates in input system
+real	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+real	p1[2], p2[2]
+errchk	mw_ctranr
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Memr[ltm  ] * x1[i] + Memr[ltv  ]
+		y2[i] = Memr[ltm+3] * y1[i] + Memr[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Memr[ltm  ] * p1[1] + Memr[ltm+1] * p2[1] +
+		    Memr[ltv  ]
+		y2[i] = Memr[ltm+2] * p1[1] + Memr[ltm+3] * p2[1] +
+		    Memr[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctranr (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/gen/mwvmuld.x b/sys/mwcs/gen/mwvmuld.x
new file mode 100644
index 00000000..0af8dfa7
--- /dev/null
+++ b/sys/mwcs/gen/mwvmuld.x
@@ -0,0 +1,20 @@
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmuld (a, b, c, ndim)
+
+double	a[ndim,ndim]		#I input matrix
+double	b[ndim]			#I input vector
+double	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+double	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/gen/mwvmulr.x b/sys/mwcs/gen/mwvmulr.x
new file mode 100644
index 00000000..54a0776e
--- /dev/null
+++ b/sys/mwcs/gen/mwvmulr.x
@@ -0,0 +1,20 @@
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmulr (a, b, c, ndim)
+
+real	a[ndim,ndim]		#I input matrix
+real	b[ndim]			#I input vector
+real	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+real	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/gen/mwvtrand.x b/sys/mwcs/gen/mwvtrand.x
new file mode 100644
index 00000000..1a1cb662
--- /dev/null
+++ b/sys/mwcs/gen/mwvtrand.x
@@ -0,0 +1,18 @@
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtrand (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+double	v1[ndim,npts]		#I points to be transformed
+double	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctrand
+
+begin
+	do i = 1, npts
+	    call mw_ctrand (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/gen/mwvtranr.x b/sys/mwcs/gen/mwvtranr.x
new file mode 100644
index 00000000..ca705c8b
--- /dev/null
+++ b/sys/mwcs/gen/mwvtranr.x
@@ -0,0 +1,18 @@
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtranr (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+real	v1[ndim,npts]		#I points to be transformed
+real	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctranr
+
+begin
+	do i = 1, npts
+	    call mw_ctranr (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/imwcs.h b/sys/mwcs/imwcs.h
new file mode 100644
index 00000000..6266a1d1
--- /dev/null
+++ b/sys/mwcs/imwcs.h
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMWCS.H -- Definitions used by MW_SAVEIM and MW_LOADIM to encode and
+# decode the FITS (image header) version of a MWCS.
+
+define	DEF_MAXCARDS	128		# initial number of card descriptors
+define	INC_MAXCARDS	128		# increment if overflow occurs
+define	IDB_STARTVALUE	10		# column at which data field begins
+define	MAX_FITSCOLS	68		# max chars of data per FITS card
+define	DEF_BIGBUF	680		# initial size of "big" FITS buffer
+define	INC_BIGBUF	680		# initial size of "big" FITS buffer
+define	SZ_KWNAME	8		# size of FITS keyword
+define	SZ_VALSTR	21		# size of FITS value string
+define	SZ_SBUF		163840		# string buffer size (2048 WCS cards)
+define	SZ_OBUF		680		# biggest "attribute = value" string
+define	SZ_CARD		80		# card width, chars
+define	SZ_BIGSTR	MAX_FITSCOLS	# max size FITS string (one card)
+
+# WCS FITS main descriptor.
+define	LEN_IMWCS	310
+define	IW_IM		Memi[$1]	# image descriptor
+define	IW_NDIM		Memi[$1+1]	# image dimension
+define	IW_NCARDS	Memi[$1+2]	# number of WCS cards
+define	IW_CBUF		Memi[$1+3]	# card descriptors
+define	IW_MAXCARDS	Memi[$1+4]	# CBUF allocated length, cards
+define	IW_SBUF		Memi[$1+5]	# string buffer
+define	IW_SBUFLEN	Memi[$1+6]	# SBUF allocated length, chars
+define	IW_SBUFOP	Memi[$1+7]	# current offset in sbuf
+define	IW_CARD		(IW_CBUF($1)+(($2)-1)*LEN_CDES)
+	# (avail)
+define	IW_CROTA	Memr[P2R($1+9)]				# obsolete
+define	IW_CTYPE	Memi[$1+10+($2)-1]			# axtype (strp)
+define	IW_CRPIX	Memd[P2D($1+20)+($2)-1]			# CRPIXi
+define	IW_CRVAL	Memd[P2D($1+40)+($2)-1]			# CRVALi
+define	IW_CDELT	Memd[P2D($1+60)+($2)-1]			# CDELTi
+define	IW_CD		Memd[P2D($1+80)+(($3)-1)*7+($2)-1]	# CDi_j
+define	IW_LTV		Memd[P2D($1+180)+($2)-1]		# LTVi
+define	IW_LTM		Memd[P2D($1+200)+(($3)-1)*7+($2)-1]	# LTMi_j
+define	IW_WSVLEN	Memi[$1+300+($2)-1]			# WSVi_LEN
+
+# WCS FITS card descriptor.
+define	LEN_CDES	6
+define	C_TYPE		Memi[$1]	# card type
+define	C_AXIS		Memi[$1+1]	# wcs axis
+define	C_INDEX		Memi[$1+2]	# card number on axis
+define	C_CARDNO	Memi[$1+3]	# card number in header
+define	C_UPDATED	Memi[$1+4]	# card has been updated
+define	C_RP		Memi[$1+5]	# pointer to card
+
+# Card types.
+define	TY_CTYPE	1
+define	TY_CDELT	2
+define	TY_CROTA	3
+define	TY_CRPIX	4
+define	TY_CRVAL	5
+define	TY_CD		6
+define	TY_LTV		7
+define	TY_LTM		8
+define	TY_WATDATA	9
+define	TY_WSVLEN	10
+define	TY_WSVDATA	11
+define	TY_WCSDIM	12
+define	TY_WAXMAP	13
+
+# IW_RFITS definitions.
+define	RF_REFERENCE	0		# reference directly into header
+define	RF_COPY		1		# reference copies of header cards
diff --git a/sys/mwcs/iwcfits.x b/sys/mwcs/iwcfits.x
new file mode 100644
index 00000000..61e90b93
--- /dev/null
+++ b/sys/mwcs/iwcfits.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_CFITS -- Close (free) an IMWCS descriptor allocated previously by
+# IW_RFITS.
+
+procedure iw_cfits (iw)
+
+pointer	iw			#I pointer to IMWCS descriptor
+
+begin
+	if (IW_CBUF(iw) != NULL)
+	    call mfree (IW_CBUF(iw), TY_STRUCT)
+	if (IW_SBUF(iw) != NULL)
+	    call mfree (IW_SBUF(iw), TY_CHAR)
+	call mfree (iw, TY_STRUCT)
+end
diff --git a/sys/mwcs/iwctype.x b/sys/mwcs/iwctype.x
new file mode 100644
index 00000000..b37494ba
--- /dev/null
+++ b/sys/mwcs/iwctype.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"imwcs.h"
+
+# IW_CARDTYPE -- Examine a FITS card to see if it is a WCS specification card,
+# and if so, return the card type, axis number, and index number.  ERR is
+# return if the card is not a WCS card.
+
+int procedure iw_cardtype (card, type, axis, index)
+
+char	card[ARB]		#I card to be examined
+int	type			#O card type
+int	axis			#O axis number or ERR
+int	index			#O index number or ERR
+
+int	ch1, ch2, ip
+int	strncmp(), ctoi()
+
+begin
+	ch1 = card[1]
+	ch2 = card[2]
+	type = ERR
+	ip = 6
+
+	# This is hardcoded for the sake of efficiency.
+	if (ch1 == 'C') {
+	    if (ch2 == 'D') {
+		if (IS_DIGIT (card[3])) {
+		    # CDi_j
+		    type = TY_CD
+		    axis = TO_INTEG (card[5])
+		    index = TO_INTEG (card[3])
+		    if (card[6] != ' ')
+			type = ERR
+		} else if (strncmp (card, "CDELT", 5) == 0) {
+		    # CDELTi
+		    type = TY_CDELT
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    } else if (ch2 == 'R') {
+		if (strncmp (card, "CROTA2", 6) == 0) {
+		    # CROTA2
+		    type = TY_CROTA
+		    axis = ERR
+		    index = ERR
+		} else if (strncmp (card, "CRPIX", 5) == 0) {
+		    # CRPIXi
+		    type = TY_CRPIX
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		} else if (strncmp (card, "CRVAL", 5) == 0) {
+		    # CRVALi
+		    type = TY_CRVAL
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    } else if (ch2 == 'T') {
+		if (strncmp (card, "CTYPE", 5) == 0) {
+		    # CTYPEi
+		    type = TY_CTYPE
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    }
+	} else if (ch1 == 'L' && ch2 == 'T') {
+	    if (card[3] == 'V' && IS_DIGIT (card[4])) {
+		type = TY_LTV
+		axis = TO_INTEG (card[4])
+		index = ERR
+	    } else if (card[3] == 'M' && IS_DIGIT (card[4])) {
+		type = TY_LTM
+		axis = TO_INTEG (card[4])
+		index = TO_INTEG (card[6])
+	    }
+	} else if (ch1 == 'W') {
+	    if (ch2 == 'A') {
+		if (card[3] == 'T' && IS_DIGIT (card[4])) {
+		    type = TY_WATDATA
+		    axis = TO_INTEG (card[4])
+		    if (IS_DIGIT(card[5]))
+			ip = 5
+		    if (ctoi (card, ip, index) <= 0)
+			type = ERR
+		} else if (strncmp (card, "WAXMAP", 6) == 0) {
+		    type = TY_WAXMAP
+		    axis = ERR
+		    ip = 7
+		    if (ctoi (card, ip, index) <= 0)
+			type = ERR
+		}
+	    } else if (ch2 == 'C') {
+		if (strncmp (card, "WCSDIM", 6) == 0) {
+		    type = TY_WCSDIM
+		    axis = ERR
+		    index = ERR
+		}
+	    } else if (ch2 == 'S') {
+		if (card[3] == 'V' && IS_DIGIT (card[4])) {
+		    if (strncmp (card[5], "_LEN", 4) == 0) {
+			type = TY_WSVLEN
+			axis = TO_INTEG (card[4])
+			index = ERR
+		    } else {
+			if (IS_DIGIT(card[5]))
+			    ip = 5
+			if (ctoi (card, ip, index) > 0) {
+			    type = TY_WSVDATA
+			    axis = TO_INTEG (card[4])
+			}
+		    }
+		}
+	    }
+	}
+
+	return (type)
+end
diff --git a/sys/mwcs/iwewcs.x b/sys/mwcs/iwewcs.x
new file mode 100644
index 00000000..1f5ca72a
--- /dev/null
+++ b/sys/mwcs/iwewcs.x
@@ -0,0 +1,336 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<math.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# IW_ENTERWCS -- Enter a WCS as represented in an IMWCS (FITS oriented)
+# wcs descriptor into an MWCS descriptor.  This routine is called by MW_LOADIM
+# after IW_RFITS has been called to scan a FITS image header to build the
+# IMWCS descriptor used as input here.
+
+procedure iw_enterwcs (mw, iw, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	iw			#I pointer to IMWCS descriptor
+int	ndim			#I system dimension
+
+double	theta
+char	ctype[8]
+bool	have_ltm, have_ltv, have_wattr
+int	axes[2], axis, npts, ch, ip, raax, decax, ax1, ax2, i, j, ea_type
+double	maxval
+pointer	sp, r, o_r, cd, ltm, cp, rp, bufp, pv, wv, o_cd, o_ltm, str
+
+bool	streq()
+pointer	iw_gbigfits(), iw_findcard()
+int	strncmp(), ctod(), strldxs(), envgeti()
+errchk	mw_swtermd, iw_gbigfits, malloc, mw_swtype, mw_swsampd
+define	samperr_ 91
+
+begin
+	call smark (sp)
+	call salloc (r, ndim, TY_DOUBLE)
+	call salloc (o_r, ndim, TY_DOUBLE)
+	call salloc (cd, ndim*ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+	call salloc (o_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (o_ltm, ndim*ndim, TY_DOUBLE)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	raax = 1
+	decax = 2
+
+	# Set any nonlinear functions on the axes.
+	do axis = 1, ndim {
+	    rp = IW_CTYPE(iw,axis)
+	    if (rp == NULL)
+		next
+
+	    # Get the value of CTYPEi.  Ignore case and treat '_' and '-'
+	    # as equivalent.
+
+	    do i = 1, 8 {
+		ch = Memc[rp+i-1]
+		if (ch == EOS || ch == ' ' || ch == '\'')
+		    break
+		else if (IS_UPPER(ch))
+		    ch = TO_LOWER(ch)
+		else if (ch == '_')
+		    ch = '-'
+		ctype[i] = ch
+	    }
+	    ctype[i] = EOS
+
+	    # Determine the type of function on this axis.
+	    if (streq (ctype, "linear")) {
+		;   # Linear is the default.
+
+	    } else if (streq (ctype, "sampled")) {
+		# A sampled WCS is an array of [P,W] points.
+
+		bufp = iw_gbigfits (iw, TY_WSVDATA, axis)
+		npts = IW_WSVLEN(iw,axis)
+		call malloc (pv, npts, TY_DOUBLE)
+		call malloc (wv, npts, TY_DOUBLE)
+
+		ip = 1
+		do i = 1, npts {
+		    if (ctod (Memc[bufp], ip, Memd[pv+i-1]) <= 0)
+			goto samperr_
+		    if (ctod (Memc[bufp], ip, Memd[wv+i-1]) <= 0) {
+samperr_		call eprintf (
+			    "Image %s, axis %d: Cannot read sampled WCS\n")
+			    call pargstr (IM_NAME(IW_IM(iw)))
+			    call pargi (axis)
+			break
+		    }
+		}
+
+		call mw_swtype (mw, axis, 1, "sampled", "")
+		call mw_swsampd (mw, axis, Memd[pv], Memd[wv], npts)
+
+		call mfree (wv, TY_DOUBLE)
+		call mfree (pv, TY_DOUBLE)
+		call mfree (bufp, TY_CHAR)
+
+	    } else if (strncmp (ctype, "ra--", 4) == 0) {
+		# The projections are restricted to two axes and are indicated
+		# by CTYPEi values such as, e.g., "RA---TAN" and "DEC--TAN"
+		# for the TAN projection.
+
+		raax = axis
+
+		# Locate the DEC axis.
+		decax = 0
+		do j = 1, ndim {
+		    cp = IW_CTYPE(iw,j)
+		    if (cp != NULL)
+			if (Memc[cp+3] == '-' || Memc[cp+3] == '_')
+			    if (strncmp (Memc[cp], "DEC", 3) == 0 ||
+				strncmp (Memc[cp], "dec", 3) == 0) {
+				decax = j
+				break
+			    }
+		}
+
+		# Did we find it?
+		if (decax == 0) {
+		    call eprintf (
+			"Image %s, axis %d: Cannot locate dec-%s axis\n")
+			call pargstr (IM_NAME(IW_IM(iw)))
+			call pargi (axis)
+			call pargstr (ctype[5])
+		}
+
+		# Get the function type.
+		ip = strldxs ("-", ctype) + 1
+
+		# Assign the function to the two axes.
+		axes[1] = axis
+		axes[2] = decax
+		call mw_swtype (mw, axes, 2, ctype[ip],
+		    "axis 1: axtype=ra axis 2: axtype=dec")
+
+	    } else if (strncmp (ctype, "dec-", 4) == 0) {
+		;   # This case is handled when RA-- is seen.
+
+	    } else if (strncmp (ctype[2], "lon-", 4) == 0) {
+		# The projections are restricted to two axes and are indicated
+		# by CTYPEi values such as, e.g., "xLON-TAN" and "xLAT-TAN"
+		# for the TAN projection. The letter x may be any character
+		# but must be the same for both the longitude and latitude
+		# axes. The standard values of x are G/g for galactic, E/e
+		# for ecliptic, and S/s for supergalactic coordinates.
+
+		raax = axis
+
+		# Locate the corresponding LAT axis.
+		decax = 0
+		do j = 1, ndim {
+		    cp = IW_CTYPE(iw,j)
+		    if (cp != NULL) {
+			if (Memc[cp+4] == '-' || Memc[cp+4] == '_') {
+			    if (strncmp (Memc[cp+1], "LAT", 3) == 0 ||
+			        strncmp (Memc[cp+1], "lat", 3) == 0) {
+			        decax = j
+			        break
+			    }
+			}
+		    }
+		}
+
+		# Did we find it?
+		if (decax == 0) {
+		    call eprintf (
+		        "Image %s, axis %d: Cannot locate %clat%s axis\n")
+		        call pargstr (IM_NAME(IW_IM(iw)))
+		        call pargi (axis)
+			call pargc (ctype[1])
+		        call pargstr (ctype[5])
+		}
+
+		# Get the function type.
+		ip = strldxs ("-", ctype) + 1
+
+		# Assign the function to the two axes.
+		axes[1] = axis
+		axes[2] = decax
+		call sprintf (Memc[str], SZ_LINE,
+		    "axis 1: axtype=%clon axis 2: axtype=%clat")
+		    call pargc (ctype[1])
+		    call pargc (ctype[1])
+		call mw_swtype (mw, axes, 2, ctype[ip], Memc[str])
+
+	    } else if (strncmp (ctype[2], "lat-", 4) == 0) { 
+		;   # This case is handled when xLON is seen.
+
+	    } else if (strncmp (ctype, "multispec", 8) == 0) {
+		# Multispec format image.  Axis 1,2 are coupled.
+		if (axis == 1) {
+		    axes[1] = 1;  axes[2] = 2
+		    call mw_swtype (mw, axes, 2, "multispec", "")
+		}
+
+	    } else {
+		# Since we have to be able to read any FITS header, we have
+		# no control over the value of CTYPEi.  If the value is
+		# something we don't know about, assume a LINEAR axis, using
+		# the given value of CTYPEi as the default axis label.
+
+		call mw_swattrs (mw, axis, "label", ctype)
+	    }
+	}
+
+	# Compute the CD matrix, or verify that one was read.  Either the
+	# CD matrix was input, the CROTA/CDELT representation was input,
+	# or nothing was input, in which case we have the identity matrix.
+
+	if (iw_findcard (iw, TY_CD, ERR, 0) == NULL) {
+	    # Initialize CD matrix to the identity matrix.  Can't use mw_mkidm
+	    # here as IW_CD is not dimensioned ndim.
+
+	    do j = 1, ndim {
+		do i = 1, ndim
+		    IW_CD(iw,i,j) = 0.0
+		IW_CD(iw,j,j) = 1.0
+	    }
+
+	    # Convert CDELT/CROTA to CD matrix.
+	    if (iw_findcard (iw, TY_CDELT, ERR, 0) != NULL) {
+		theta = DEGTORAD(IW_CROTA(iw))
+		ax1 = raax
+		ax2 = decax
+		IW_CD(iw,ax1,ax1) =  IW_CDELT(iw,ax1) * cos(theta)
+		IW_CD(iw,ax1,ax2) =  IW_CDELT(iw,ax1) * sin(theta)
+		IW_CD(iw,ax2,ax1) = -IW_CDELT(iw,ax2) * sin(theta)
+		IW_CD(iw,ax2,ax2) =  IW_CDELT(iw,ax2) * cos(theta)
+	    }
+
+	    do j = 1, ndim {
+		if (j == raax || j == decax)
+		    next
+		IW_CD(iw,j,j) =  IW_CDELT(iw,j)
+	    }
+	}
+
+	# Set axes with no scales to unit scales.  Issue a warning by
+	# default but use "wcs_matrix_err" to allow setting other error
+	# actions.
+
+	do i = 1, ndim {
+	    maxval = 0D0
+	    do j = 1, ndim
+		maxval = max (maxval, abs(IW_CD(iw,i,j)))
+	    if (maxval == 0D0) {
+		iferr (ea_type = envgeti ("wcs_matrix_err"))
+		    ea_type = EA_WARN
+		iferr {
+		    switch (ea_type) {
+		    case EA_FATAL, EA_ERROR:
+			call sprintf (Memc[str], SZ_FNAME, 
+			    "CD keywords for axis %d undefined")
+			    call pargi (i)
+			call error (SYS_MWMISSAX, Memc[str])
+		    case EA_WARN:
+			IW_CD(iw,i,i) = 1D0
+			call sprintf (Memc[str], SZ_LINE, 
+			    "setting CD%d_%d to %.4g")
+			    call pargi (i)
+			    call pargi (i)
+			    call pargd (IW_CD(iw,i,i))
+			call error (SYS_MWMISSAX, Memc[str])
+		    default:
+			IW_CD(iw,i,i) = 1D0
+		    }
+		} then
+		    call erract (ea_type)
+	    }
+	}
+
+	# Extract an NDIM submatrix from LTM and CD.
+	do j = 1, ndim
+	    do i = 1, ndim {
+		Memd[o_cd+(j-1)*ndim+(i-1)] = IW_CD(iw,i,j)
+		Memd[o_ltm+(j-1)*ndim+(i-1)] = IW_LTM(iw,i,j)
+	    }
+
+	# Set the linear portion of the Wterm.  First we have to transform
+	# it from the FITS logical->world representation to the MWCS
+	# physical->world form, by separating out the Lterm.  We have
+	# CD = CD' * LTM and R = inv(LTM) * (R' - LTV), where CD' and R' are
+	# the FITS versions of the MWCS CD matrix and R vector (CRPIX), and
+	# LTM and LTV are the Lterm rotation matrix and translation vector.
+
+	# First, determine if either LTM or LTV was specified in the header.
+	have_ltm = (iw_findcard (iw, TY_LTM, ERR, 0) != NULL)
+	have_ltv = (iw_findcard (iw, TY_LTV, ERR, 0) != NULL)
+
+	# Compute CD = CD' * LTM.
+	if (have_ltm)
+	    call mw_mmuld (Memd[o_cd], Memd[o_ltm], Memd[cd], ndim)
+	else
+	    call amovd (Memd[o_cd], Memd[cd], ndim*ndim)
+
+	# Compute R = inv(LTM) * (R' - LTV).
+	if (have_ltm || have_ltv) {
+	    call asubd (IW_CRPIX(iw,1), IW_LTV(iw,1), Memd[o_r], ndim)
+	    if (have_ltm) {
+		call mw_invertd (Memd[o_ltm], Memd[ltm], ndim)
+		call mw_vmuld (Memd[ltm], Memd[o_r], Memd[r], ndim)
+	    } else
+		call amovd (Memd[o_r], Memd[r], ndim)
+	} else
+	    call amovd (IW_CRPIX(iw,1), Memd[r], ndim)
+
+	# Set the Wterm.
+	call mw_swtermd (mw, Memd[r], IW_CRVAL(iw,1), Memd[cd], ndim)
+	# Process in any axis attributes.  The pseudo-axis 0 is used by
+	# any global WCS attributes.
+
+	do axis = 0, ndim {
+	    # Is there any attribute data for axis J?
+	    have_wattr = false
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_TYPE(cp) == TY_WATDATA && C_AXIS(cp) == axis) {
+		    have_wattr = true
+		    break
+		}
+	    }
+
+	    # Reconstruct the attribute list and enter into MWCS.
+	    if (have_wattr) {
+		bufp = iw_gbigfits (iw, TY_WATDATA, axis)
+		call mw_swtype (mw, axis, 1, "", Memc[bufp])
+		call mfree (bufp, TY_CHAR)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/iwfind.x b/sys/mwcs/iwfind.x
new file mode 100644
index 00000000..e400f9ee
--- /dev/null
+++ b/sys/mwcs/iwfind.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_FINDCARD -- Search the card list in the IMWCS descriptor for a card of
+# the given type, with the given axis and index numbers.  Return a pointer to
+# the card if found, else NULL.
+
+pointer procedure iw_findcard (iw, type, axis, index)
+
+pointer	iw			#I pointer to IMWCS descriptor
+int	type			#I card type code
+int	axis			#I axis number, or <0 to ignore
+int	index			#I index number, or <=0 to ignore
+
+int	i
+pointer	cp
+
+begin
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_TYPE(cp) != type)
+		next
+	    if (axis >= 0)
+		if (C_AXIS(cp) != axis)
+		    next
+	    if (index > 0)
+		if (C_INDEX(cp) != index)
+		    next
+	    return (cp)
+	}
+
+	return (NULL)
+end
diff --git a/sys/mwcs/iwgbfits.x b/sys/mwcs/iwgbfits.x
new file mode 100644
index 00000000..5fd1810d
--- /dev/null
+++ b/sys/mwcs/iwgbfits.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_GBIGFITS -- Get a FITS string valued parameter of arbitrary size.
+# Since a FITS string stored as a single parameter is limited to at most
+# 69 characters, multiple FITS cards must be used to store longer strings.
+# At the time that this routine is called, IW_RFITS has already been called
+# to scan the FITS header and build up a list of WCS oriented cards,
+# including card types and pointers to the card data.  Our job is merely
+# to take these cards in order and concatenate the string values into one
+# large string, returning a pointer to the string as the function value.
+# The caller must later make a MFREE call to free this buffer.
+
+pointer procedure iw_gbigfits (iw, ctype, axis)
+
+pointer	iw			#I pointer to IMWCS descriptor
+int	ctype			#I card type
+int	axis			#I axis to which card refers
+
+int	ncards, i, j, ch
+pointer	cp, bp, ip, op, rp
+define	put_ 10
+
+begin
+	# How much space do we need?
+	ncards = 0
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_AXIS(cp) == axis && C_TYPE(cp) == ctype)
+		ncards = ncards + 1
+	}
+
+	# Allocate the space.
+	call calloc (bp, ncards * MAX_FITSCOLS, TY_CHAR)
+
+	# For successive cards 1, 2, 3, etc...
+	op = bp
+	do j = 1, ncards {
+	    # Find the card.
+	    rp = NULL
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_AXIS(cp) != axis)
+		    next
+		if (C_INDEX(cp) != j)
+		    next
+		if (C_TYPE(cp) != ctype)
+		    next
+
+		rp = C_RP(cp)
+		break
+	    }
+
+	    # Append to the string buffer.
+	    if (rp != NULL) {
+		#call amovc (Memc[rp+IDB_STARTVALUE+1], Memc[op], MAX_FITSCOLS)
+		#op = op + MAX_FITSCOLS
+
+		do i = 1, MAX_FITSCOLS {
+		    ip = rp + IDB_STARTVALUE + i
+		    ch = Memc[ip]
+
+		    if (ch == EOS || ch == '\n') {
+			break
+		    } else if (ch == '\'') {
+			if (Memc[ip+1] == '\'') {
+			    goto put_
+			} else if (Memc[ip-1] == '\'') {
+			    ;
+			} else if (i > 1 && i <= MAX_FITSCOLS) {
+			    # If we're not at the end of the card, we have a
+			    # complete string, but add a space for appending
+			    # so we don't concatenate.
+			    Memc[op] = ' ' 
+			    op = op + 1
+			    break
+			} else
+			    break
+		    } else {
+put_			Memc[op] = ch
+			op = op + 1
+		    }
+		}
+	    }
+	}
+
+	Memc[op] = EOS
+	return (bp)
+end
diff --git a/sys/mwcs/iwparray.x b/sys/mwcs/iwparray.x
new file mode 100644
index 00000000..cb6cb0d9
--- /dev/null
+++ b/sys/mwcs/iwparray.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_PUTARRAY -- Output a double floating array as a sequence of FITS cards,
+# one value per card in the form "keyword = value", using the format string
+# given to format the name of the FITS keyword.
+
+procedure iw_putarray (iw, new, old, ndim, kw_format, kw_type, kw_index)
+
+pointer	iw			#I pointer to IMWCS descriptor
+double	new[ndim]		#I new array values
+double	old[ndim]		#I old array values from header
+int	ndim			#I image and WCS dimension
+char	kw_format[ARB]		#I format for encoding keyword name
+int	kw_type			#I IMWCS keyword type code
+int	kw_index		#I keword index or 0 if don't care
+
+int	axis
+pointer	cp, im
+char	kwname[SZ_KWNAME]
+bool	fp_equald()
+pointer	iw_findcard()
+errchk	imaddf, imputd
+
+begin
+	do axis = 1, ndim {
+	    # If new value is zero, no output, delete old card if present.
+	    if (fp_equald (new[axis], 0.0D0))
+		next
+
+	    # See if we read the card for this parameter.
+	    cp = iw_findcard (iw, kw_type, axis, kw_index)
+	    im = IW_IM(iw)
+
+	    # If value is unchanged, no need to do anything.
+	    if (fp_equald (new[axis], old[axis])) {
+		if (cp != NULL)
+		    C_UPDATED(cp) = YES
+		next
+	    }
+
+	    # Update the keyword in the image header.
+	    call sprintf (kwname, SZ_KWNAME, kw_format)
+		call pargi (axis)
+
+	    if (cp == NULL)
+		call imaddf (im, kwname, "d")
+	    call imputd (im, kwname, new[axis])
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+end
diff --git a/sys/mwcs/iwpstr.x b/sys/mwcs/iwpstr.x
new file mode 100644
index 00000000..27b7e351
--- /dev/null
+++ b/sys/mwcs/iwpstr.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_PUTSTR -- Put an arbitrarily large string valued parameter to a FITS
+# header, using multiple FITS cards if necessary.  The input string value is
+# passed in as a byte stream file.
+
+procedure iw_putstr (fd, iw, axis, ctype, fmt1, fmt2, max_index)
+
+int	fd			#I input file
+pointer	iw			#I pointer to IMWCS descriptor
+int	axis			#I axis to which parameter belongs
+int	ctype			#I card type
+char	fmt1[ARB], fmt2[ARB]	#I keyword name formats
+int	max_index		#I use fmt2 if index > max_index
+
+bool	update
+int	index, nchars
+pointer	sp, bigstr, im, cp
+char	kwname[SZ_KWNAME]
+
+pointer	iw_findcard()
+int	read(), strncmp()
+errchk	read, imaddf, impstr
+
+begin
+	call smark (sp)
+	call salloc (bigstr, SZ_BIGSTR, TY_CHAR)
+
+	index = 0
+	im = IW_IM(iw)
+
+	repeat {
+	    # Get enough data to fit on a FITS card.
+	    nchars = read (fd, Memc[bigstr], SZ_BIGSTR)
+	    if (nchars <= 0)
+		break
+
+	    # Blank fill the last card if necessary.
+	    #while (nchars < SZ_BIGSTR && mod (nchars, SZ_BIGSTR) != 0) {
+	    #	Memc[bigstr+nchars] = ' '
+	    #	nchars = nchars + 1
+	    #}
+	    Memc[bigstr+nchars] = EOS
+
+	    index = index + 1
+	    cp = iw_findcard (iw, ctype, axis, index)
+
+	    update = true
+	    if (cp != NULL)
+		if (strncmp (Memc[C_RP(cp)+IDB_STARTVALUE+1],
+		    Memc[bigstr], SZ_BIGSTR) == 0) {
+		    update = false
+		}
+
+	    # Output the card.  The format string should contain two %d
+	    # fields, unless axis=ERR, in which case only the index value
+	    # is used.  If the index value is greater than max_index then
+	    # fmt2 is used as the print format, otherwise fmt1 is used.
+
+	    if (update) {
+		if (max_index > 0 && index > max_index)
+		    call sprintf (kwname, SZ_KWNAME, fmt2)
+		else
+		    call sprintf (kwname, SZ_KWNAME, fmt1)
+		if (axis >= 0)
+		    call pargi (axis)
+		call pargi (index)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "c")
+		call impstr (im, kwname, Memc[bigstr])
+	    }
+
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/iwrfits.x b/sys/mwcs/iwrfits.x
new file mode 100644
index 00000000..b70208a5
--- /dev/null
+++ b/sys/mwcs/iwrfits.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include <ctype.h>
+include	<imio.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# IW_RFITS -- Read a FITS image header into an IMWCS (FITS oriented) world
+# coordinate system descriptor.  For reasons of efficiency (especially due
+# to the possibly of large sampled WCS arrays) this is done with a single
+# pass through the header to get all the WCS data, with interpretation of
+# the data being a separate independent step.  A pointer to an IMWCS descriptor
+# is returned as the function value.  When no longer needed, this should be
+# freed with IW_CLOSE.  The dimensionality of the WCS is determined first
+# from the image dimensionality (which may be zero) and then overridden
+# if there is a WCSDIM card.  If the final dimensionality is zero then
+# the maximum axis of the WCS cards sets the dimensionality.
+
+
+pointer procedure iw_rfits (mw, im, mode)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	im			#I pointer to image header
+int	mode			#I RF_REFERENCE or RF_COPY
+
+double	dval
+bool	omit, copy
+pointer	iw, idb, rp, cp, fp
+int	ndim, recno, ualen, type, axis, index, ip, temp, i
+
+pointer	idb_open()
+int	idb_nextcard(), iw_cardtype(), ctod(), ctoi()
+errchk	calloc, realloc, syserrs
+
+begin
+	ndim = max (IM_NDIM(im), IM_NPHYSDIM(im))
+	copy = (mode == RF_COPY)
+
+	# Allocate and initialize the FITS-WCS descriptor.
+	call calloc (iw, LEN_IMWCS, TY_STRUCT)
+	call calloc (IW_CBUF(iw), LEN_CDES * DEF_MAXCARDS, TY_STRUCT)
+
+	# Allocate string buffer if we must keep a local copy of the data.
+	if (copy) {
+	    call calloc (IW_SBUF(iw), SZ_SBUF, TY_CHAR)
+	    IW_SBUFLEN(iw) = SZ_SBUF
+	    IW_SBUFOP(iw) = 0
+	}
+
+	IW_MAXCARDS(iw) = DEF_MAXCARDS
+	IW_NDIM(iw) = ndim
+	IW_IM(iw) = im
+
+	# Scan the image header, examining successive cards to see if they
+	# are WCS specification cards, making an entry for each such card
+	# in the IMWCS descriptor.  The values of simple scalar valued cards
+	# are interpreted immediately and used to modify the default WCS
+	# data values established above.  For the array valued parameters we
+	# merely record the particulars for each card, leaving reconstruction
+	# of the array until all the cards have been located.
+
+	idb = idb_open (im, ualen)
+	recno = 0
+	while (idb_nextcard (idb, rp) != EOF) {
+	    recno = recno + 1
+	    if (iw_cardtype (Memc[rp], type, axis, index) <= 0)
+		next
+
+
+	    # Has this card already been seen?
+	    omit = false
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_TYPE(cp) != type)
+		    next
+		if (C_AXIS(cp) != axis)
+		    next
+		if (C_INDEX(cp) != index)
+		    next
+		omit = true
+		break
+	    }
+
+	    # Ignore duplicate cards.
+	    if (omit)
+		next
+
+	    # Get another card descriptor.
+	    IW_NCARDS(iw) = IW_NCARDS(iw) + 1
+	    if (IW_NCARDS(iw) > IW_MAXCARDS(iw)) {
+		IW_MAXCARDS(iw) = IW_MAXCARDS(iw) + INC_MAXCARDS
+		call realloc (IW_CBUF(iw),
+		    IW_MAXCARDS(iw) * LEN_CDES, TY_STRUCT)
+		cp = IW_CARD(iw,IW_NCARDS(iw))
+		call aclri (Memi[cp],
+		    (IW_MAXCARDS(iw) - IW_NCARDS(iw) + 1) * LEN_CDES)
+	    }
+	    cp = IW_CARD(iw,IW_NCARDS(iw))
+
+	    C_TYPE(cp) = type
+	    C_AXIS(cp) = axis
+	    C_INDEX(cp) = index
+	    C_CARDNO(cp) = recno
+
+	    ndim = max (ndim, axis)
+
+	    # The FITS data must be copied into local storage if the header
+	    # will be edited, since otherwise the cards may move, invalidating
+	    # the pointer.  Always save whole cards; don't bother with an EOS
+	    # or newline between cards.
+
+	    if (copy) {
+		if (IW_SBUFOP(iw) + SZ_CARD > IW_SBUFLEN(iw))
+		    call syserrs (SYS_MWFITSOVFL, IM_NAME(im))
+		C_RP(cp) = IW_SBUF(iw) + IW_SBUFOP(iw)
+		call strcpy (Memc[rp], Memc[C_RP(cp)], SZ_CARD)
+		IW_SBUFOP(iw) = IW_SBUFOP(iw) + SZ_CARD
+	    } else
+		C_RP(cp) = rp
+
+	    # Decode the card value. 
+	    ip = IDB_STARTVALUE
+	    switch (type) {
+	    case TY_CTYPE:
+		fp = C_RP(cp) + ip
+		while (IS_WHITE(Memc[fp]) || Memc[fp] == '\'')
+		    fp = fp + 1
+		IW_CTYPE(iw,axis) =  fp
+	    case TY_CDELT:
+		if (ctod (Memc[rp], ip, IW_CDELT(iw,axis)) <= 0)
+		    IW_CDELT(iw,axis) = 0.0
+	    case TY_CROTA:
+		if (ctod (Memc[rp], ip, dval) > 0)
+		    IW_CROTA(iw) = dval
+	    case TY_CRPIX:
+		if (ctod (Memc[rp], ip, IW_CRPIX(iw,axis)) <= 0)
+		    IW_CRPIX(iw,axis) = 0.0
+	    case TY_CRVAL:
+		if (ctod (Memc[rp], ip, IW_CRVAL(iw,axis)) <= 0)
+		    IW_CRVAL(iw,axis) = 0.0
+	    case TY_CD:
+		if (ctod (Memc[rp], ip, IW_CD(iw,axis,index)) <= 0)
+		    IW_CD(iw,axis,index) = 0.0
+	    case TY_LTV:
+		if (ctod (Memc[rp], ip, IW_LTV(iw,axis)) <= 0)
+		    IW_LTV(iw,axis) = 0.0
+	    case TY_LTM:
+		if (ctod (Memc[rp], ip, IW_LTM(iw,axis,index)) <= 0)
+		    IW_LTM(iw,axis,index) = 0.0
+	    case TY_WSVLEN:
+		if (ctoi (Memc[rp], ip, IW_WSVLEN(iw,axis)) <= 0)
+		    IW_WSVLEN(iw,axis) = 0
+	    case TY_WCSDIM:
+		if (ctoi (Memc[rp], ip, temp) > 0)
+		    IW_NDIM(iw) = temp
+	    }
+	}
+
+	# Set dimension to the maximum axis seen.
+	if (IW_NDIM(iw) == 0)
+	    IW_NDIM(iw) = ndim
+
+	call idb_close (idb)
+	return (iw)
+end
diff --git a/sys/mwcs/iwsaxmap.x b/sys/mwcs/iwsaxmap.x
new file mode 100644
index 00000000..47ad9f09
--- /dev/null
+++ b/sys/mwcs/iwsaxmap.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"mwcs.h"
+
+# IW_SETAXMAP -- If the reference image was opened with an image section,
+# modify the Lterm to reflect the section transformation, and enable the
+# axis map if any dimensional reduction was involved.
+
+procedure iw_setaxmap (mw, im)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	im			#I pointer to reference image
+
+double	v
+pointer	sp, ltv_1, ltv_2, ltm
+int	wcsdim, ndim, physax, i, j
+int	axno[MAX_DIM], axval[MAX_DIM]
+int	o_axno[MAX_DIM], o_axval[MAX_DIM]
+int	n_axno[MAX_DIM], n_axval[MAX_DIM]
+
+begin
+	# If there is no section we don't need to do anything.
+	if (IM_SECTUSED(im) == NO)
+	    return
+
+	call smark (sp)
+
+	ndim = IM_NPHYSDIM(im)
+	call salloc (ltv_1, ndim, TY_DOUBLE)
+	call salloc (ltv_2, ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+
+	# The section transformation is  px = VSTEP * lx + VOFF, specifying
+	# the transformation from logical to physical image coordinates.
+	# The IMIO axis map is given by j=VMAP[i], mapping logical axis I to
+	# physical axis J.  Hence the physical to logical transformation in
+	# terms of IMIO units is given by  lx = (1/VSTEP) * px + (-VOFF/VSTEP).
+	# Since the section transform forbids rotation the axes are independent.
+
+	call aclrd (Memd[ltv_1], ndim)
+	call aclrd (Memd[ltm], ndim * ndim)
+
+	do i = 1, ndim {
+	    if (IM_VSTEP(im,i) == 0)
+		v = 1.0D0
+	    else
+		v = 1.0D0 / IM_VSTEP(im,i)
+
+	    Memd[ltm+(i-1)*ndim+i-1] = v
+	    Memd[ltv_2+(i-1)] = -(IM_VOFF(im,i) * v)
+	}
+
+	# Enter the section transformation.  This uses the axis map, but the
+	# transformation is defined in terms of the physical image matrix,
+	# which is defined by the old axis map before modification by the new
+	# image section.  Hence we must do this step before editing the axis
+	# map below.
+
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], ndim)
+
+	# Compute the axis map for the active image section relative to the
+	# current physical image matrix.
+
+	do j = 1, ndim {
+	    for (i=1;  i <= IM_NDIM(im);  i=i+1)
+		if (IM_VMAP(im,i) == j)
+		    break
+	    if (i > IM_NDIM(im)) {
+		axno[j] = 0
+		axval[j] = IM_VOFF(im,j)
+	    } else {
+		axno[j] = i
+		axval[j] = 0
+	    }
+	}
+
+	# Get the old axis map for the WCS.  In the general case the WCS can
+	# have a dimension higher than the current image, i.e. if the current
+	# image was produced by extracting a section of an image of higher
+	# dimension.  In such a case the WCS will have an axis map relating
+	# the physical axes of the current image back to the original physical
+	# system.
+
+	wcsdim = MI_NDIM(mw)
+	call mw_gaxmap (mw, o_axno, o_axval, wcsdim)
+
+	# Combine the old axis map and the axis map for the current image
+	# section.  The old axis map physical->logical mapping maps WCS
+	# physical axes to logical axes, which are the physical axes of the
+	# current image.  The axis map for the current image section maps the
+	# physical axes of the current image to the logical axes of the
+	# section.  An axis removed in the WCS axis map is not visible in the
+	# image axno/axval computed above; the corresponding axis in the
+	# combined WCS axis map is unchanged.  The remaining axes are subject
+	# to remapping by the mage axno/axval.  This mapping may set any of
+	# the axes to a constant to further reduce the dimensionality of the
+	# logical system, however that does not concern us here, we just pass
+	# on the combined axno/axval vectors to mw_saxmap.
+
+        do i = 1, wcsdim {
+            if (o_axno[i] == 0) {
+                n_axno[i] = 0
+                n_axval[i] = o_axval[i]
+            } else {
+                physax = o_axno[i]
+                n_axno[i] = axno[physax]
+                n_axval[i] = axval[physax]
+            }
+	}
+
+	# Set the new axis map.
+	call mw_saxmap (mw, n_axno, n_axval, wcsdim)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mkpkg b/sys/mwcs/mkpkg
new file mode 100644
index 00000000..05179ce6
--- /dev/null
+++ b/sys/mwcs/mkpkg
@@ -0,0 +1,120 @@
+# Make the MWCS interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+generic:
+	$set G = "$$generic -k -p gen/ -t rd"
+	$ifolder (gen/mwc1tranr.x, mwc1tran.gx)	$(G) mwc1tran.gx	$endif
+	$ifolder (gen/mwc2tranr.x, mwc2tran.gx)	$(G) mwc2tran.gx	$endif
+	$ifolder (gen/mwctranr.x, mwctran.gx)	$(G) mwctran.gx		$endif
+	$ifolder (gen/mwgctranr.x, mwgctran.gx)	$(G) mwgctran.gx	$endif
+	$ifolder (gen/mwltranr.x, mwltran.gx)	$(G) mwltran.gx		$endif
+	$ifolder (gen/mwmmulr.x, mwmmul.gx)	$(G) mwmmul.gx		$endif
+	$ifolder (gen/mwv1tranr.x, mwv1tran.gx)	$(G) mwv1tran.gx	$endif
+	$ifolder (gen/mwv2tranr.x, mwv2tran.gx)	$(G) mwv2tran.gx	$endif
+	$ifolder (gen/mwvmulr.x, mwvmul.gx)	$(G) mwvmul.gx		$endif
+	$ifolder (gen/mwvtranr.x, mwvtran.gx)	$(G) mwvtran.gx		$endif
+	;
+
+zzdebug:
+zzdebug.e:
+	$checkout libex.a lib$
+	$update   libex.a
+	$checkin  libex.a lib$
+
+	$omake zzdebug.x <mwset.h> imwcs.h
+	$link -z zzdebug.o
+	;
+
+libex.a:
+	# $set xflags = "$(xflags) -qfx"
+	$ifeq (USE_GENERIC, yes)  $call generic  $endif
+	@gen
+
+	iwcfits.x	imwcs.h
+	iwctype.x	imwcs.h <ctype.h>
+	iwewcs.x	imwcs.h mwcs.h <ctype.h> <imhdr.h> <imio.h> <math.h>
+	iwfind.x	imwcs.h
+	iwgbfits.x	imwcs.h
+	iwparray.x	imwcs.h
+	iwpstr.x	imwcs.h
+	iwrfits.x	imwcs.h mwcs.h <imhdr.h> <imio.h> <ctype.h>
+	iwsaxmap.x	mwcs.h <imhdr.h> <imio.h>
+	mwallocd.x	mwcs.h
+	mwallocs.x	mwcs.h
+	mwclose.x	mwcs.h <error.h>
+	mwctfree.x	mwcs.com mwcs.h
+	mwfindsys.x	mwcs.h
+	mwflookup.x	mwcs.com mwcs.h
+	mwgaxlist.x	mwcs.h
+	mwgaxmap.x	mwcs.h
+	mwgltermd.x	mwcs.h
+	mwgltermr.x	mwcs.h
+	mwgsys.x	mwcs.h
+	mwgwattrs.x	mwcs.h
+	mwgwsampd.x	mwcs.h
+	mwgwsampr.x	mwcs.h
+	mwgwtermd.x	mwcs.h
+	mwgwtermr.x	mwcs.h
+	mwinvertd.x	
+	mwinvertr.x	
+	mwload.x	mwcs.h mwsv.h <error.h> <mach.h>
+	mwloadim.x	imwcs.h mwcs.h <error.h> <imhdr.h> <imio.h>
+	mwlu.x		<mach.h>
+	mwmkidmd.x	
+	mwmkidmr.x	
+	mwnewcopy.x	mwcs.h
+	mwnewsys.x	mwcs.h
+	mwopen.x	mwcs.h <error.h>
+	mwopenim.x	<imhdr.h> <imio.h>
+	mwrefstr.x	mwcs.h
+	mwrotate.x	mwcs.h
+	mwsave.x	mwcs.h mwsv.h <mach.h>
+	mwsaveim.x	imwcs.h mwcs.com mwcs.h <imhdr.h> <imio.h> <mach.h>
+	mwsaxmap.x	mwcs.h
+	mwscale.x	mwcs.h
+	mwsctran.x	mwcs.com mwcs.h <error.h> <mach.h>
+	mwsdefwcs.x	mwcs.h <mwset.h>
+	mwseti.x	mwcs.h <mwset.h>
+	mwshift.x	mwcs.h
+	mwshow.x	mwcs.h <imio.h>
+	mwsltermd.x	mwcs.h
+	mwsltermr.x	mwcs.h
+	mwssys.x	mwcs.h
+	mwstati.x	mwcs.h <mach.h> <mwset.h>
+	mwswattrs.x	mwcs.h
+	mwswsampd.x	mwcs.h
+	mwswsampr.x	mwcs.h
+	mwswtermd.x	mwcs.h
+	mwswtermr.x	mwcs.h
+	mwswtype.x	mwcs.h <ctype.h>
+	mwtransd.x	mwcs.h
+	mwtransr.x	
+	wfait.x		mwcs.h <math.h>
+	wfarc.x		mwcs.h <math.h>
+	wfcar.x		mwcs.h <math.h>
+	wfcsc.x		mwcs.h <math.h>
+	wfdecaxis.x	mwcs.h
+	wfgls.x		mwcs.h <math.h>
+	wfgsurfit.x
+	wfinit.x	mwcs.com mwcs.h
+	wfmer.x		mwcs.h <math.h>
+	wfmol.x		mwcs.h <math.h>
+	wfmspec.x	mwcs.h <imhdr.h>
+	wfpar.x		mwcs.h <math.h>
+	wfpco.x		mwcs.h <math.h>
+	wfqsc.x		mwcs.h <math.h>
+	wfsamp.x	mwcs.h
+	wfsin.x		mwcs.h <math.h>
+	wfstg.x		mwcs.h <math.h>
+	wftan.x		mwcs.h <math.h>
+	wftnx.x		mwcs.h <math.h>
+	wftpv.x		mwcs.h <math.h>
+	wftsc.x		mwcs.h <math.h>
+	wfzea.x		mwcs.h <math.h>
+	wfzpn.x		mwcs.h <math.h>
+	wfzpx.x		mwcs.h <math.h>
+	;
diff --git a/sys/mwcs/mwallocd.x b/sys/mwcs/mwallocd.x
new file mode 100644
index 00000000..96623015
--- /dev/null
+++ b/sys/mwcs/mwallocd.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_ALLOCD -- Allocate space in the data buffer.  The size of the buffer
+# is automatically increased if necessary.  Note that reallocation of the
+# buffer may cause it to move, hence all data items are referred to by their
+# offset in the buffer, rather than by an absolute pointer.
+
+int procedure mw_allocd (mw, nelem)
+
+pointer	mw		#I pointer to MWCS descriptor
+int	nelem		#I number of elements to alloc space for
+
+int	dbufused, dbuflen, offset
+errchk	realloc
+
+begin
+	dbufused = MI_DBUFUSED(mw)
+	dbuflen  = MI_DBUFLEN(mw)
+	offset   = dbufused + 1
+
+	# Increase buffer size?
+	if (dbufused + nelem > dbuflen) {
+	    dbuflen = dbuflen + INC_SZDBUF
+	    while (dbufused + nelem > dbuflen)
+		dbuflen = dbuflen + INC_SZDBUF
+
+	    call realloc (MI_DBUF(mw), dbuflen, TY_DOUBLE)
+	    call aclrd (D(mw,offset), dbuflen - offset + 1)
+	    MI_DBUFLEN(mw) = dbuflen
+	}
+
+	# Allocate the space in the buffer, and return the buffer offset
+	# of the allocated area.
+
+	MI_DBUFUSED(mw) = max (0, dbufused + nelem)
+	return (offset)
+end
diff --git a/sys/mwcs/mwallocs.x b/sys/mwcs/mwallocs.x
new file mode 100644
index 00000000..6a9caf5b
--- /dev/null
+++ b/sys/mwcs/mwallocs.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_ALLOCS -- Allocate space in the global string buffer.  The size of the
+# buffer is automatically increased if necessary.  Note that reallocation of
+# the buffer may cause it to move, hence all data items are referred to by
+# their offset in the buffer, rather than by an absolute pointer.  Since we
+# are allocating space for string data, a space for the EOS is automatically
+# allocated in addition to space for the indicated number of data chars.
+
+int procedure mw_allocs (mw, nchars)
+
+pointer	mw		#I pointer to MWCS descriptor
+int	nchars		#I number of chars to allocate space for
+
+int	sbufused, sbuflen, offset, nelem
+errchk	realloc
+
+begin
+	sbufused = MI_SBUFUSED(mw)
+	sbuflen  = MI_SBUFLEN(mw)
+	offset   = sbufused + 1
+	nelem	 = nchars + 1
+
+	# Increase buffer size?
+	if (sbufused + nelem > sbuflen) {
+	    sbuflen = sbuflen + INC_SZSBUF
+	    while (sbufused + nelem > sbuflen)
+		sbuflen = sbuflen + INC_SZSBUF
+
+	    call realloc (MI_SBUF(mw), sbuflen, TY_CHAR)
+	    call aclrc (S(mw,offset), sbuflen - offset + 1)
+	    MI_SBUFLEN(mw) = sbuflen
+	}
+
+	# Allocate the space in the buffer, and return the buffer offset
+	# of the allocated area.
+
+	MI_SBUFUSED(mw) = max (0, sbufused + nelem)
+	return (offset)
+end
diff --git a/sys/mwcs/mwc1tran.gx b/sys/mwcs/mwc1tran.gx
new file mode 100644
index 00000000..b2cbbcfc
--- /dev/null
+++ b/sys/mwcs/mwc1tran.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+PIXEL procedure mw_c1tran$t (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x			#I coordinates in input system
+
+PIXEL	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Mem$t[CT_LTM(ct)] * x + Mem$t[CT_LTV(ct)])
+	} else {
+	    call mw_ctran$t (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/mwc2tran.gx b/sys/mwcs/mwc2tran.gx
new file mode 100644
index 00000000..1c757d31
--- /dev/null
+++ b/sys/mwcs/mwc2tran.gx
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2tran$t (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1,y1			#I coordinates in input system
+PIXEL	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+PIXEL	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Mem$t[ltm  ] * x1 + Mem$t[ltv  ]
+	    y2 = Mem$t[ltm+3] * y1 + Mem$t[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Mem$t[ltm  ] * p1[1] + Mem$t[ltm+1] * p1[2] + Mem$t[ltv  ]
+	    y2 = Mem$t[ltm+2] * p1[1] + Mem$t[ltm+3] * p1[2] + Mem$t[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctran$t (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/mwclose.x b/sys/mwcs/mwclose.x
new file mode 100644
index 00000000..441a78c2
--- /dev/null
+++ b/sys/mwcs/mwclose.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <error.h>
+include "mwcs.h"
+
+# MW_CLOSE -- Close a MWCS descriptor and deallocate all resources used
+# by the descriptor.  Any CTRAN descriptors which have been opened on
+# the MWCS are automatically closed if not already manually closed by
+# the application.
+
+procedure mw_close (mw)
+
+pointer	mw		#U pointer to MWCS descriptor
+
+int	i
+pointer	ct
+
+begin
+	# Free any still allocated CTRAN descriptors.
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Free the main descriptor.
+	call mfree (mw, TY_STRUCT)
+end
diff --git a/sys/mwcs/mwcs.com b/sys/mwcs/mwcs.com
new file mode 100644
index 00000000..80c2b79d
--- /dev/null
+++ b/sys/mwcs/mwcs.com
@@ -0,0 +1,8 @@
+# MWCS common.  Used for things that are global and don't change, i.e.,
+# the WCS function drivers.
+
+int	fn_nfn				# number of defined functions
+int	fn_table[LEN_FN,MAX_FN]		# function table
+char	fn_names[SZ_FNNAME,MAX_FN]	# function names
+
+common	/mwcscom/ fn_nfn, fn_table, fn_names
diff --git a/sys/mwcs/mwcs.h b/sys/mwcs/mwcs.h
new file mode 100644
index 00000000..b202159e
--- /dev/null
+++ b/sys/mwcs/mwcs.h
@@ -0,0 +1,152 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MWCS.H -- Global (internal) definitions for the mini-WCS interface.
+
+define	MWCS_MAGIC	4D57X		# identifies MWCS descriptors
+define	DEF_SZSBUF	512		# initial string buffer size
+define	INC_SZSBUF	512		# increment string buffer size
+define	DEF_SZDBUF	64		# initial double buffer size
+define	INC_SZDBUF	64		# increment double buffer size
+define	MAX_DIM		7		# max dimension of a wcs
+define	MAX_WCS		8		# max wcs per mwcs
+define	MAX_WATTR	512		# max attributes per wcs
+define	MAX_CTRAN	20		# max runtime ctran descriptors
+define	MAX_CALL	7		# max CTRAN function calls
+define	MAX_FUNC	7		# max WCS function descriptors
+define	MAX_WCSFD	10		# max loaded WCS function drivers
+define	MAX_FN		32		# max MWCS function drivers
+define	SZ_FNNAME	20		# max size function name
+define	SZ_ATNAME	20		# max size attribute name
+
+# MWCS descriptor.  This consists of the base descriptor, global string
+# buffer, global data buffer (TY_DOUBLE), and separately allocated buffers
+# for each runtime CT (coordinate transformation) descriptor.  All character
+# data is stored in SBUF.  All floating point data is stored as type double
+# in DBUF (this does not mean that coordinate transformations are necessarily
+# carried out in double precision).  All string and floating data is
+# referenced in the base descriptor by its index in the appropriate data
+# buffer, to make the descriptor invariant with respect to relocation of DBUF.
+# To keep things simple, space is preallocated for a fixed number of WCS,
+# and for each WCS, for a fixed number of attributes.
+
+define	LEN_BASEMWCS	70
+define	LEN_WCS		1626 # (depends upon MAX_WATTR)
+define	LEN_MWCS	(LEN_BASEMWCS+LEN_WCS*MAX_WCS)
+define	MI_LEN		(LEN_BASEMWCS+LEN_WCS*MI_NWCS($1))
+
+define	MI_MAGIC	Memi[$1]		# magic marker
+define	MI_NDIM		Memi[$1+1]		# wcs physical dimension
+define	MI_WCS		Memi[$1+2]		# pointer to current wcs
+define	MI_NWCS		Memi[$1+3]		# number of wcs defined
+define	MI_REFIM	Memi[$1+4]		# reference image, if any
+define	MI_SBUF		Memi[$1+5]		# string buffer pointer
+define	MI_SBUFLEN	Memi[$1+6]		# string buffer alloclen
+define	MI_SBUFUSED	Memi[$1+7]		# string buffer chars used
+define	MI_DBUF		Memi[$1+8]		# double buffer pointer
+define	MI_DBUFLEN	Memi[$1+9]		# double buffer alloclen
+define	MI_DBUFUSED	Memi[$1+10]		# double buffer doubles used
+define	MI_USEAXMAP	Memi[$1+11]		# enable axis mapping
+define	MI_NLOGDIM	Memi[$1+12]		# dimension of logical system
+	# (available)
+define	MI_LTV		Memi[$1+18]		# dbuf index of LT vector
+define	MI_LTM		Memi[$1+19]		# dbuf index of LT matrix
+define	MI_AXNO		Memi[$1+20+($2)-1]	# axis map, log[phys]
+define	MI_AXVAL	Memi[$1+30+($2)-1]	# axis value, if axno[i]=0
+define	MI_PHYSAX	Memi[$1+40+($2)-1]	# inverted map, phys[log]
+define	MI_CTRAN	Memi[$1+50+($2)-1]	# ctran descriptor pointers
+define	MI_WCSP		($1+70+(($2)-1)*LEN_WCS)
+
+# WCS descriptor.  This consists of a base structure, used to index string
+# and double data which is stored in the global buffers SBUF and DBUF.
+# An array of WCS descriptors is preallocated in the main MWCS descriptor.
+
+define	WCS_NDIM	Memi[$1]		# dimension of world system
+define	WCS_SYSTEM	Memi[$1+1]		# sbuf index of system name
+define	WCS_AXCLASS	Memi[$1+2+($2)-1]	# axis type, 0 or FUNC index
+define	WCS_R		Memi[$1+10]		# dbuf index of R array
+define	WCS_W		Memi[$1+11]		# dbuf index of W array
+define	WCS_CD		Memi[$1+12]		# dbuf index of CD matrix
+define	WCS_NPTS	Memi[$1+20+($2)-1]	# number of points in wsampv
+define	WCS_PV		Memi[$1+30+($2)-1]	# wsamp physical vector
+define	WCS_WV		Memi[$1+40+($2)-1]	# wsamp world vector
+define	WCS_NFUNC	Memi[$1+49]		# number of functions
+define	WCS_FUNC	($1+50+(($2)-1)*5)	# function descriptors
+define	WCS_NWATTR	Memi[$1+89]		# number of wcs attributes
+define	WCS_WATTR	($1+90+(($2)-1)*3)	# pointer to wattr substruct
+
+# WCS function descriptor.
+define	LEN_WF		5
+define	WF_FN		Memi[$1]		# function code
+define	WF_NAXES	Memi[$1+1]		# number of axes 
+define	WF_AXIS		Memi[$1+2+($2)-1]	# axes function applies to
+
+# Function type flags.
+define	FORWARD		0			# forward transform (P->W)
+define	INVERSE		1			# inverse transform (W->P)
+
+# WCS attribute descriptor.
+define	LEN_AT		3
+define	AT_AXIS		Memi[$1]		# wcs axis which owns attribute
+define	AT_NAME		Memi[$1+1]		# sbuf index of name string
+define	AT_VALUE	Memi[$1+2]		# sbuf index of value string
+
+# CTRAN descriptor.  Prepared when a coordinate transformation is set up
+# with mw_sctran.  The transformation is optimized and reduced to a series
+# of matrix multiply, translate, wcs function call etc. instructions as
+# described by this descriptor.  Both single and double precision versions
+# of the transform are prepared, with the application deciding at runtime
+# which precision routine to call.
+
+define	LEN_CTBASE	(20+MAX_CALL*LEN_FC*2)
+
+define	CT_D		($1)			# pointer to type double CT
+define	CT_R		Memi[$1]		# pointer to type real CT
+define	CT_MW		Memi[$1+1]		# pointer back to MWCS
+define	CT_WCSI		Memi[$1+2]		# pointer back to system 1
+define	CT_WCSO		Memi[$1+3]		# pointer back to system 2
+define	CT_TYPE		Memi[$1+4]		# ctran type (optimized)
+define	CT_NDIM		Memi[$1+5]		# ctran physical dimension
+define	CT_LTM		Memi[$1+6]		# pointer to rot matrix
+define	CT_LTV		Memi[$1+7]		# pointer to translation vector
+define	CT_NCALLI	Memi[$1+8]		# number of function calls
+define	CT_NCALLO	Memi[$1+9]		# number of function calls
+define	CT_AXIS		Memi[$1+10+($2)-1]	# maps ctran axis to physax
+define	CT_FCI		($1+20+(($2)-1)*LEN_FC)	# pointer to CALL descriptor
+define	CT_FCO		($1+188+(($2)-1)*LEN_FC)
+
+# CT types, for optimized transforms.
+define	LNR		0			# linear, not rotated
+define	LRO		1			# linear, rotated
+define	GEN		2			# general catch all case
+
+# Base FC (WCS function call) descriptor.  This consists of a base descriptor
+# common to all WCS functions, followed by a private area reserved for use
+# by the WCS function.
+
+define	LEN_FC		64
+define	FC_CT		Memi[$1]		# CTRAN descriptor
+define	FC_WCS		Memi[$1+1]		# WCS descriptor
+define	FC_WF		Memi[$1+2]		# WF descriptor
+define	FC_FCN		Memi[$1+3]		# epa of WCS function
+define	FC_NAXES	Memi[$1+4]		# number of axes in call
+define	FC_AXIS		Memi[$1+5+($2)-1]	# CTRAN axes used by FC (max 3)
+define	FCU		8			# offset to first user field
+
+# WCS function driver (stored in common).
+define	LEN_FN		5			# length of function driver
+define	FN_FLAGS	fn_table[1,$1]		# function type flags
+define	FN_INIT		fn_table[2,$1]		# initialize call descriptor
+define	FN_DESTROY	fn_table[3,$1]		# free call descriptor
+define	FN_FWD		fn_table[4,$1]		# forward transformation
+define	FN_INV		fn_table[5,$1]		# inverse transformation
+define	FN_NAME		fn_names[1,$1]		# function name
+
+# WCS function codes.
+define	F_LINEAR	0			# linear (not a function)
+
+# WCS function type bit flags.
+define	F_RADEC		01B			# function requires RA/DEC
+
+# Handy macros.
+define	S		Memc[MI_SBUF($1)+$2-1]	# string = S(mw,i)
+define	D		Memd[MI_DBUF($1)+$2-1]	# double = D(mw,i)
diff --git a/sys/mwcs/mwctfree.x b/sys/mwcs/mwctfree.x
new file mode 100644
index 00000000..e495320b
--- /dev/null
+++ b/sys/mwcs/mwctfree.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_CTFREE -- Free a CTRAN (coordinate transformation) descriptor.  We keep
+# track of all allocated CTRAN descriptors in the parent MWCS descriptor, and
+# NULL the saved entry for a descriptor when it is freed, thus guaranteeing
+# that a descriptor will be freed only once.
+
+procedure mw_ctfree (ct)
+
+pointer	ct		#U pointer to CTRAN descriptor
+
+int	fn, i, j
+pointer mw, fc
+include	"mwcs.com"
+
+begin
+	if (ct != NULL) {
+	    mw = CT_MW(ct)
+	    if (mw != NULL)
+		do i = 1, MAX_CTRAN
+		    if (MI_CTRAN(mw,i) == ct) {
+			# Free private storage for any input WCS functions.
+			do j = 1, CT_NCALLI(ct) {
+			    fc = CT_FCI(ct,j)
+			    fn = WF_FN(FC_WF(fc))
+			    if (FN_DESTROY(fn) != NULL)
+				call zcall1 (FN_DESTROY(fn), fc)
+			}
+			# Free private storage for any output WCS functions.
+			do j = 1, CT_NCALLO(ct) {
+			    fc = CT_FCO(ct,j)
+			    fn = WF_FN(FC_WF(fc))
+			    if (FN_DESTROY(fn) != NULL)
+				call zcall1 (FN_DESTROY(fn), fc)
+			}
+			# Free the main CTRAN descriptor.
+			call mfree (ct, TY_STRUCT)
+			MI_CTRAN(mw,i) = NULL
+			break
+		    }
+	}
+end
diff --git a/sys/mwcs/mwctran.gx b/sys/mwcs/mwctran.gx
new file mode 100644
index 00000000..2d614569
--- /dev/null
+++ b/sys/mwcs/mwctran.gx
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctran$t (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	p1[ndim]		#I coordinates of point in input system
+PIXEL	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Mem$t[ltm+(i-1)*(ndim+1)] * p1[i] + Mem$t[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltran$t (p1, p2, Mem$t[ltm], Mem$t[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call acht$td (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtd$t (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/mwfindsys.x b/sys/mwcs/mwfindsys.x
new file mode 100644
index 00000000..e997fc42
--- /dev/null
+++ b/sys/mwcs/mwfindsys.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_FINDSYS -- Lookup the named world coordinate system and return a pointer
+# to the WCS descriptor, or NULL if the system is not defined.
+
+pointer procedure mw_findsys (mw, system)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system to be looked up
+
+int	i
+pointer	wp
+bool	streq()
+
+begin
+	# Search the list of defined systems.
+	do i = 1, MI_NWCS(mw) {
+	    wp = MI_WCSP(mw,i)
+	    if (WCS_SYSTEM(wp) != NULL)
+		if (streq (S(mw,WCS_SYSTEM(wp)), system))
+		    return (wp)
+	}
+
+	# Not found.
+	return (NULL)
+end
diff --git a/sys/mwcs/mwflookup.x b/sys/mwcs/mwflookup.x
new file mode 100644
index 00000000..e9f28f8d
--- /dev/null
+++ b/sys/mwcs/mwflookup.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_FLOOKUP -- Look up the named WCS function in the driver table, and
+# return the index of the associated driver.  ERR is returned if the named
+# function is not found, 0 if the function is "linear", otherwise the
+# index of the function driver is returned.
+
+int procedure mw_flookup (mw, fnname)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	fnname[ARB]		#I function to be lookup up
+
+int	fn, i
+bool	streq()
+include	"mwcs.com"
+
+begin
+	if (streq (fnname, "linear"))
+	    return (F_LINEAR)
+
+	fn = ERR
+	do i = 1, fn_nfn
+	    if (streq (fnname, FN_NAME(i))) {
+		fn = i
+		break
+	    }
+	
+	return (fn)
+end
diff --git a/sys/mwcs/mwgaxlist.x b/sys/mwcs/mwgaxlist.x
new file mode 100644
index 00000000..01b4b394
--- /dev/null
+++ b/sys/mwcs/mwgaxlist.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_GAXLIST -- Get the physical axis list.  The bitflags in AXBITS define the
+# axes in the logical system; run these through the axis map (if enabled) to
+# get the list of physical axes for which the transformation is to be prepared.
+
+procedure mw_gaxlist (mw, axbits, axis, naxes)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axbits			#I bitflag marking the desired axes
+int	axis[MAX_DIM]		#O output axis array
+int	naxes			#O number of axes in axis array
+
+int	bits, ax, i
+int	bitupk()
+
+begin
+	bits = axbits
+	if (bits == 0)
+	    bits = 177B		# default to all axes
+
+	naxes = 0
+	do i = 1, MAX_DIM
+	    if (bitupk (bits, i, 1) != 0) {
+		if (MI_USEAXMAP(mw) == YES) {
+		    if (i > MI_NLOGDIM(mw))
+			break
+		    # Map logical axis to physical axis.
+		    ax = MI_PHYSAX(mw,i)
+		} else {
+		    if (i > MI_NDIM(mw))
+			break
+		    ax = i
+		}
+
+		# Add physical axis to axis list.
+		naxes = naxes + 1
+		axis[naxes] = ax
+	    }
+end
diff --git a/sys/mwcs/mwgaxmap.x b/sys/mwcs/mwgaxmap.x
new file mode 100644
index 00000000..b888b433
--- /dev/null
+++ b/sys/mwcs/mwgaxmap.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GAXMAP -- Get the axis map.  This assigns a logical axis axno[i] to
+# each physical axis I.  If axno[i]=0, the value of the physical axis
+# coordinate is the constant axval[i], and the dimension of the logical
+# system is reduced by one.
+
+procedure mw_gaxmap (mw, axno, axval, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axno[ndim]		#O physical -> logical axis assignments
+int	axval[ndim]		#O value of physical axis if axno=0
+int	ndim			#I physical dimension of axis map
+
+int	i
+errchk	syserrs
+
+begin
+	# Verify dimension.
+	if (MI_NDIM(mw) != ndim)
+	    call syserrs (SYS_MWNDIM, "mw_gaxmap")
+
+	# Copy out the current axis map.
+	do i = 1, ndim {
+	    axno[i] = MI_AXNO(mw,i)
+	    axval[i] = MI_AXVAL(mw,i)
+	}
+end
diff --git a/sys/mwcs/mwgctran.gx b/sys/mwcs/mwgctran.gx
new file mode 100644
index 00000000..10a35179
--- /dev/null
+++ b/sys/mwcs/mwgctran.gx
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctran$t (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	o_ltm[ARB]		#O linear tranformation matrix
+PIXEL	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_$T(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Mem$t[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Mem$t[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/mwgltermd.x b/sys/mwcs/mwgltermd.x
new file mode 100644
index 00000000..e2db0c0d
--- /dev/null
+++ b/sys/mwcs/mwgltermd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GLTERMD -- Get the current Lterm, double precision version.
+
+procedure mw_gltermd (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltm[ndim,ndim]		#O linear transformation matrix
+double	ltv[ndim]		#O translation vector
+int	ndim			#I dimensionality of system
+
+int	i
+errchk	syserrs
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_gltermd")
+
+	# Copy out the data.  Default to a unitary transformation if the
+	# Lterm has not been initialized.
+
+	if (MI_LTM(mw) == NULL) {
+	    call aclrd (ltm, ndim*ndim)
+	    do i = 1, ndim
+		ltm[i,i] = 1.0D0
+	} else
+	    call amovd (D(mw,MI_LTM(mw)), ltm, ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    call aclrd (ltv, ndim)
+	else
+	    call amovd (D(mw,MI_LTV(mw)), ltv, ndim)
+end
diff --git a/sys/mwcs/mwgltermr.x b/sys/mwcs/mwgltermr.x
new file mode 100644
index 00000000..290bc6dc
--- /dev/null
+++ b/sys/mwcs/mwgltermr.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GLTERMR -- Get the current Lterm, single precision version.
+
+procedure mw_gltermr (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltm[ndim,ndim]		#O linear transformation matrix
+real	ltv[ndim]		#O translation vector
+int	ndim			#I dimensionality of system
+
+int	i
+errchk	syserrs
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_gltermr")
+
+	# Copy out the data.  Default to a unitary transformation if the
+	# Lterm has not been initialized.
+
+	if (MI_LTM(mw) == NULL) {
+	    call aclrr (ltm, ndim*ndim)
+	    do i = 1, ndim
+		ltm[i,i] = 1.0
+	} else
+	    call achtdr (D(mw,MI_LTM(mw)), ltm, ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    call aclrr (ltv, ndim)
+	else
+	    call achtdr (D(mw,MI_LTV(mw)), ltv, ndim)
+end
diff --git a/sys/mwcs/mwgsys.x b/sys/mwcs/mwgsys.x
new file mode 100644
index 00000000..a1559b8f
--- /dev/null
+++ b/sys/mwcs/mwgsys.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_GSYSTEM -- Return the name of the current default world system.
+
+procedure mw_gsystem (mw, outstr, maxch)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	outstr[ARB]		#O receives name of world system
+int	maxch			#I max chars out
+
+pointer	wp
+
+begin
+	wp = MI_WCS(mw)
+	call strcpy (S(mw,WCS_SYSTEM(wp)), outstr, maxch)
+end
diff --git a/sys/mwcs/mwgwattrs.x b/sys/mwcs/mwgwattrs.x
new file mode 100644
index 00000000..3a5fbf80
--- /dev/null
+++ b/sys/mwcs/mwgwattrs.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWATTRS -- Get the string value of the named WCS attribute for axis N.
+# If the attribute name is a number N, attribute number N is returned instead,
+# allowing the attributes to be listed without knowing their names.
+
+procedure mw_gwattrs (mw, axis, attribute, valstr, maxch)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis to which attribute belongs
+char	attribute[SZ_ATNAME]	#U attribute name
+char	valstr[ARB]		#O attribute value
+int	maxch			#I max chars to output value string
+
+pointer	wp, ap
+int	item, atno, i
+
+int	ctoi()
+bool	streq()
+errchk	syserrs
+
+begin
+	# Get current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_gwattrs")
+
+	# Get attribute number if number was given.
+	i = 1
+	if (ctoi (attribute, i, atno) == 0)
+	    atno = 0
+
+	# Lookup the named or numbered attribute and output the value
+	# string if found.
+
+	item = 0
+	do i = 1, WCS_NWATTR(wp) {
+	    ap = WCS_WATTR(wp,i)
+	    if (AT_AXIS(ap) == axis) {
+		item = item + 1
+		if (atno > 0) {
+		    if (atno == item) {
+			call strcpy (S(mw,AT_NAME(ap)), attribute, SZ_ATNAME)
+			call strcpy (S(mw,AT_VALUE(ap)), valstr, maxch)
+			return
+		    }
+		} else if (streq (S(mw,AT_NAME(ap)), attribute)) {
+		    call strcpy (S(mw,AT_VALUE(ap)), valstr, maxch)
+		    return
+		}
+	    }
+	}
+
+	call syserrs (SYS_MWWATTRNF, attribute)
+end
diff --git a/sys/mwcs/mwgwsampd.x b/sys/mwcs/mwgwsampd.x
new file mode 100644
index 00000000..8149d814
--- /dev/null
+++ b/sys/mwcs/mwgwsampd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWSAMPD -- Get the sampled WCS curve for an axis.
+
+procedure mw_gwsampd (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+double	pv[ARB]			#O physical coordinates of points
+double	wv[ARB]			#O world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwsampd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify that there is a sampled curve for this WCS.
+	if (WCS_NPTS(wp,axis) <= 0 || WCS_PV(wp,axis) == NULL
+	    || WCS_WV(wp,axis) == NULL)
+	    call syserrs (SYS_MWNOWSAMP, s_name)
+
+	# Copy out the curves.
+	call amovd (D(mw,WCS_PV(wp,axis)), pv, min(WCS_NPTS(wp,axis), npts))
+	call amovd (D(mw,WCS_WV(wp,axis)), wv, min(WCS_NPTS(wp,axis), npts))
+end
diff --git a/sys/mwcs/mwgwsampr.x b/sys/mwcs/mwgwsampr.x
new file mode 100644
index 00000000..881177e4
--- /dev/null
+++ b/sys/mwcs/mwgwsampr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWSAMPR -- Get the sampled WCS curve for an axis.
+
+procedure mw_gwsampr (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+real	pv[ARB]			#O physical coordinates of points
+real	wv[ARB]			#O world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwsampr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify that there is a sampled curve for this WCS.
+	if (WCS_NPTS(wp,axis) <= 0 || WCS_PV(wp,axis) == NULL
+	    || WCS_WV(wp,axis) == NULL)
+	    call syserrs (SYS_MWNOWSAMP, s_name)
+
+	# Copy out the curves.
+	call achtdr (D(mw,WCS_PV(wp,axis)), pv, min(WCS_NPTS(wp,axis), npts))
+	call achtdr (D(mw,WCS_WV(wp,axis)), wv, min(WCS_NPTS(wp,axis), npts))
+end
diff --git a/sys/mwcs/mwgwtermd.x b/sys/mwcs/mwgwtermd.x
new file mode 100644
index 00000000..be6b015a
--- /dev/null
+++ b/sys/mwcs/mwgwtermd.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWTERMD -- Get the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is read.
+
+procedure mw_gwtermd (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	r[ndim]			#O physical coordinates of reference point
+double	w[ndim]			#O world coordinates of reference point
+double	cd[ndim,ndim]		#O CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwtermd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy out the data.  Return the unitary transformation if the
+	# Wterm has not been set.
+
+	if (WCS_R(wp) == NULL)
+	    call aclrd (r, ndim)
+	else
+	    call amovd (D(mw,WCS_R(wp)), r, ndim)
+
+	if (WCS_W(wp) == NULL)
+	    call aclrd (w, ndim)
+	else
+	    call amovd (D(mw,WCS_W(wp)), w, ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    call mw_mkidmd (cd, ndim)
+	else
+	    call amovd (D(mw,WCS_CD(wp)), cd, ndim*ndim)
+end
diff --git a/sys/mwcs/mwgwtermr.x b/sys/mwcs/mwgwtermr.x
new file mode 100644
index 00000000..8ee44c4c
--- /dev/null
+++ b/sys/mwcs/mwgwtermr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWTERMR -- Get the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is read.
+
+procedure mw_gwtermr (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	r[ndim]			#O physical coordinates of reference point
+real	w[ndim]			#O world coordinates of reference point
+real	cd[ndim,ndim]		#O CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwtermr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy out the data.  Return the unitary transformation of the
+	# Wterm has not been set.
+
+	if (WCS_R(wp) == NULL)
+	    call aclrr (r, ndim)
+	else
+	    call achtdr (D(mw,WCS_R(wp)), r, ndim)
+
+	if (WCS_W(wp) == NULL)
+	    call aclrr (w, ndim)
+	else
+	    call achtdr (D(mw,WCS_W(wp)), w, ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    call mw_mkidmr (cd, ndim)
+	else
+	    call achtdr (D(mw,WCS_CD(wp)), cd, ndim*ndim)
+end
diff --git a/sys/mwcs/mwinvertd.x b/sys/mwcs/mwinvertd.x
new file mode 100644
index 00000000..e2744821
--- /dev/null
+++ b/sys/mwcs/mwinvertd.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_INVERTD -- Invert a square matrix, double precision version.  The matrix
+# need not be symmetric.  The input and output matrices cannot be the same.
+
+procedure mw_invertd (o_ltm, n_ltm, ndim)
+
+double	o_ltm[ndim,ndim]	#I input matrix
+double	n_ltm[ndim,ndim]	#O output (inverted) matrix
+int	ndim			#I dimensionality of system
+
+pointer	sp, ix, ltm
+int	nelem, i, j
+
+begin
+	call smark (sp)
+
+	nelem = ndim * ndim
+	call salloc (ix, ndim, TY_INT)
+	call salloc (ltm, nelem, TY_DOUBLE)
+
+	# Make scratch copy (to be modified) of input matrix.
+	call amovd (o_ltm, Memd[ltm], nelem)
+
+	# Set up identity matrix.
+	do i = 1, ndim {
+	    do j = 1, ndim
+		n_ltm[i,j] = 0.0
+	    n_ltm[i,i] = 1.0
+	}
+
+	# Perform the LU decomposition.
+	call mw_ludecompose (Memd[ltm], Memi[ix], ndim)
+
+	# Compute the inverse matrix by backsubstitution.
+	do j = 1, ndim
+	    call mw_lubacksub (Memd[ltm], Memi[ix], n_ltm[1,j], ndim)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwinvertr.x b/sys/mwcs/mwinvertr.x
new file mode 100644
index 00000000..28274754
--- /dev/null
+++ b/sys/mwcs/mwinvertr.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_INVERTR -- Invert a square matrix, single precision version.  The matrix
+# need not be symmetric.  The input and output matrices should not be the same.
+
+procedure mw_invertr (o_ltm, n_ltm, ndim)
+
+real	o_ltm[ndim,ndim]	#I input matrix
+real	n_ltm[ndim,ndim]	#O output (inverted) matrix
+int	ndim			#I dimensionality of system
+
+int	nelem, i, j
+pointer	sp, ix, ltm, inv
+
+begin
+	call smark (sp)
+
+	nelem = ndim * ndim
+	call salloc (ix, ndim, TY_INT)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (inv, nelem, TY_DOUBLE)
+
+	# Make scratch copy (to be modified) of input matrix.
+	call achtrd (o_ltm, Memd[ltm], nelem)
+
+	# Set up identity matrix.
+	call aclrd (Memd[inv], nelem)
+	do i = 1, ndim
+	    Memd[inv+(i-1)*ndim+i-1] = 1.0
+
+	# Perform the LU decomposition.
+	call mw_ludecompose (Memd[ltm], Memi[ix], ndim)
+
+	# Compute the inverse matrix by backsubstitution.
+	do j = 1, ndim
+	    call mw_lubacksub (Memd[ltm], Memi[ix], Memd[inv+(j-1)*ndim], ndim)
+
+	# Output the inverted matrix.
+	call achtdr (Memd[inv], n_ltm, nelem)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwload.x b/sys/mwcs/mwload.x
new file mode 100644
index 00000000..993ba48b
--- /dev/null
+++ b/sys/mwcs/mwload.x
@@ -0,0 +1,124 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	"mwcs.h"
+include	"mwsv.h"
+
+# MW_LOAD -- Load a saved MWCS into a descriptor.  The saved MWCS will
+# have been created in a previous call to MW_SAVE.  In its saved form,
+# the MWCS is a machine independent binary array of arbitrary length.
+
+procedure mw_load (mw, bp)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	bp			#I pointer to save buffer, type char
+
+pointer	sp, sv, ct, ip, cw, ms, wp
+int	nelem, cwlen, mslen, nwcs, lenwcs, n, i
+errchk	syserrs, malloc
+pointer	coerce()
+int	pl_l2pi()
+
+begin
+	call smark (sp)
+	call salloc (sv, LEN_SVHDR, TY_STRUCT)
+
+	# Get the save header.
+	ip = coerce (bp, TY_CHAR, TY_STRUCT)
+	call miiupk32 (Memi[ip], Memi[sv], LEN_SVHDR, TY_INT)
+	if (SV_MAGIC(sv) != MWSV_MAGIC)
+	    call syserrs (SYS_MWMAGIC, "MWCS save file")
+
+	cwlen = SV_CWCSLEN(sv)
+	mslen = SV_MWSVLEN(sv)
+
+	# Prior to MWSV version 1 lenwcs and nwcs were not recorded.
+	if (SV_VERSION(sv) < 1) {
+	    lenwcs = MWSV_LENWCS0
+	    nwcs = (mslen - MWSV_BASELEN) / lenwcs
+	} else {
+	    lenwcs = SV_LENWCS(sv)
+	    nwcs = SV_NWCS(sv)
+	}
+
+	call salloc (cw, cwlen, TY_INT)
+	call salloc (ms, mslen, TY_INT)
+
+	# Unpack the saved MWSV descriptor.  Due to a bug in MWCS prior to
+	# V2.10.4 IRAF the packed descriptor was erroneously encoded using
+	# miipak32, so if unpacking with miiupk16 doesn't work try using
+	# miiupk32.  This should allow old saved MWCS written on a similar
+	# architecture to still be read - the data is not portable however
+	# unless miipak16 is used, since pl_p2li produces a short array.
+
+	ip = coerce (bp + SV_MWSVOFF(sv), TY_CHAR, TY_STRUCT)
+	call miiupk16 (Memi[ip], Memi[cw], SV_CWCSLEN(sv), TY_SHORT)
+	n = pl_l2pi (Memi[cw], 1, Memi[ms], mslen)
+	if (MI_MAGIC(ms) != MWCS_MAGIC) {
+	    call miiupk32 (Memi[ip], Memi[cw], SV_CWCSLEN(sv), TY_INT)
+	    n = pl_l2pi (Memi[cw], 1, Memi[ms], mslen)
+	}
+
+	# Free any storage associated with the old descriptor.
+	# Start with any still allocated CTRAN descriptors.
+
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the old string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Copy the MWSV descriptor to the active MWCS descriptor.  This
+	# assumes that the base descriptor and the WCS sub-descriptor have
+	# identical structures, except for the length of each element.
+
+	call amovi (Memi[ms], Memi[mw], LEN_BASEMWCS)
+	nelem = min (lenwcs, LEN_WCS)
+	do i = 1, nwcs {
+	    wp = MI_WCSP(mw,i)
+	    call amovi (Memi[MS_WCSP(ms,i,lenwcs)], Memi[wp], nelem)
+	    if (nelem < LEN_WCS)
+		call aclri (Memi[wp+nelem], LEN_WCS-nelem)
+	}
+	do i = nwcs+1, MAX_WCS
+	    call aclri (Memi[MI_WCSP(mw,i)], LEN_WCS)
+
+	# Initialize the axis map (not preserved over a save/load).
+	do i = 1, MI_NDIM(mw) {
+	    MI_AXNO(mw,i) = i
+	    MI_PHYSAX(mw,i) = i
+	}
+
+	# Load the data buffer.
+	nelem = SV_DBUFLEN(sv)
+	if (nelem > 0) {
+	    ip = coerce (bp + SV_DBUFOFF(sv), TY_CHAR, TY_DOUBLE)
+	    call malloc (MI_DBUF(mw), nelem, TY_DOUBLE)
+	    call miiupkd (Memd[ip], D(mw,1), nelem, TY_DOUBLE)
+	    MI_DBUFUSED(mw) = nelem
+	    MI_DBUFLEN(mw) = nelem
+	}
+
+	# Load the string buffer.
+	nelem = SV_SBUFLEN(sv)
+	if (nelem > 0) {
+	    ip = coerce (bp + SV_SBUFOFF(sv), TY_CHAR, TY_CHAR)
+	    call malloc (MI_SBUF(mw), nelem, TY_CHAR)
+	    call miiupk8 (Memc[ip], S(mw,1), nelem, TY_CHAR)
+	    MI_SBUFUSED(mw) = nelem
+	    MI_SBUFLEN(mw) = nelem
+	}
+
+	# Set the default WCS.
+	call mw_sdefwcs (mw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwloadim.x b/sys/mwcs/mwloadim.x
new file mode 100644
index 00000000..231f5b9a
--- /dev/null
+++ b/sys/mwcs/mwloadim.x
@@ -0,0 +1,198 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# MW_LOADIM -- Load a MWCS object saved in an image header in FITS format
+# into an MWCS descriptor.  Note that the MWCS descriptor is allocated
+# if the input is NULL.  This is to allow the WCS cards to be read to
+# determine the WCS dimensionality.
+
+procedure mw_loadim (mw, im)
+
+pointer	mw			#U pointer to MWCS descriptor
+pointer	im			#I pointer to image header
+
+bool	have_wcs
+int	ndim, i, j, ea_type
+int	axno[MAX_DIM], axval[MAX_DIM]
+double	maxval
+pointer	sp, sysname, iw, ct, wp, cp, bufp, ip
+
+int	mw_allocd(), mw_refstr(), ctoi(), envgeti()
+pointer	iw_rfits(), iw_findcard(), iw_gbigfits(), mw_open()
+errchk	iw_rfits, mw_allocd, mw_newsystem, mw_swtype, iw_enterwcs, mw_saxmap
+errchk	mw_open
+string	s_physical "physical"
+define	axerr_ 91
+define	axinit_ 92
+
+begin
+	call smark (sp)
+	call salloc (sysname, SZ_FNAME, TY_CHAR)
+
+	# Read the FITS image header into an IMWCS descriptor.
+	iw = iw_rfits (mw, im, RF_REFERENCE)
+	if (mw == NULL) {
+	    ndim = max (IW_NDIM(iw), IM_NPHYSDIM(im))
+	    mw = mw_open (NULL, ndim)
+	}
+	ndim = IW_NDIM(iw)
+
+	# Initialize the MWCS descriptor from the IMWCS descriptor.
+	# Free any storage associated with the old descriptor.
+	# Start with any still allocated CTRAN descriptors.
+
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the old string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Initialize the new descriptor.
+	call aclri (Memi[mw], LEN_MWCS)
+
+	MI_MAGIC(mw) = MWCS_MAGIC
+	MI_REFIM(mw) = im
+	MI_NDIM(mw) = ndim
+	MI_LTV(mw) = mw_allocd (mw, ndim)
+	MI_LTM(mw) = mw_allocd (mw, ndim * ndim)
+
+	# Set the Lterm.  Set axes with no LTM scales to unit scales.
+	# Issue a warning by default but use "wcs_matrix_err" to allow
+	# setting other error actions.
+
+	call amovd (IW_LTV(iw,1), D(mw,MI_LTV(mw)), ndim)
+	if (iw_findcard (iw, TY_LTM, ERR, 0) != NULL) {
+	    do i = 1, ndim {
+		maxval = 0D0
+		do j = 1, ndim {
+		    D(mw,MI_LTM(mw)+(j-1)*ndim+(i-1)) = IW_LTM(iw,i,j)
+		    maxval = max (maxval, abs (IW_LTM(iw,i,j)))
+		}
+		if (maxval == 0D0) {
+		    iferr (ea_type = envgeti ("wcs_matrix_err"))
+			ea_type = EA_WARN
+		    iferr {
+			switch (ea_type) {
+			case EA_FATAL, EA_ERROR:
+			    call sprintf (Memc[sysname], SZ_FNAME, 
+				"LTM keywords for axis %d undefined")
+				call pargi (i)
+			    call error (SYS_MWMISSAX, Memc[sysname])
+			case EA_WARN:
+			    IW_LTM(iw,i,i) = 1D0
+			    D(mw,MI_LTM(mw)+(i-1)*ndim+(i-1)) = IW_LTM(iw,i,i)
+			    call sprintf (Memc[sysname], SZ_FNAME, 
+				"setting LTM%d_%d to %.4g")
+				call pargi (i)
+				call pargi (i)
+				call pargd (IW_LTM(iw,i,i))
+			    call error (SYS_MWMISSAX, Memc[sysname])
+			default:
+			    IW_LTM(iw,i,i) = 1D0
+			    D(mw,MI_LTM(mw)+(i-1)*ndim+(i-1)) = IW_LTM(iw,i,i)
+			}
+		    } then
+			call erract (ea_type)
+		}
+	    }
+	} else
+	    call mw_mkidmd (D(mw,MI_LTM(mw)), ndim)
+
+	# Set up the builtin world systems "physical" and "logical".
+	# Both are linear systems.  The physical system is a unitary
+	# transformation (since world systems are defined relative to
+	# the physical system), and the logical system has the Lterm
+	# for its linear term.  No wcs attributes other than wtype are
+	# defined.
+
+	# Create the physical system.
+	call mw_newsystem (mw, s_physical, ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Create the logical system.
+	call mw_newsystem (mw, "logical", ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Set W and CD for the logical system to point to the Lterm.
+	wp = MI_WCS(mw)
+	WCS_W(wp) = MI_LTV(mw)
+	WCS_CD(wp) = MI_LTM(mw)
+
+	# Did the image header specify a WCS?
+	have_wcs = false
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    switch (C_TYPE(cp)) {
+	    case TY_CTYPE, TY_CRPIX, TY_CRVAL, TY_CD, TY_CDELT:
+		have_wcs = true
+		break
+	    }
+	}
+
+	# Enter the saved WCS.  We make up a system name for now, and patch
+	# it up later once the real name has been recalled along with the
+	# attributes.
+
+	if (have_wcs) {
+	    call mw_newsystem (mw, "image", ndim)
+	    call iw_enterwcs (mw, iw, ndim)
+	    ifnoerr {
+		call mw_gwattrs (mw, 0, "system", Memc[sysname], SZ_FNAME)
+	    } then
+		WCS_SYSTEM(MI_WCS(mw)) = mw_refstr (mw, Memc[sysname])
+	}
+
+	# Restore the saved WCS axis map if any.
+	if (iw_findcard (iw, TY_WAXMAP, ERR, 0) != NULL) {
+	    bufp = iw_gbigfits (iw, TY_WAXMAP, ERR)
+
+	    ip = bufp
+	    do i = 1, ndim {
+		if (ctoi (Memc, ip, axno[i]) <= 0)
+		    goto axerr_
+		if (ctoi (Memc, ip, axval[i]) <= 0) {
+axerr_		    call eprintf ("Image %s: cannot decode WAXMAP\n")
+			call pargstr (IM_NAME(IW_IM(iw)))
+		    goto axinit_
+		}
+	    }
+
+	    call mfree (bufp, TY_CHAR)
+	    call mw_saxmap (mw, axno, axval, ndim)
+
+	} else {
+axinit_	    do i = 1, ndim {
+		MI_AXNO(mw,i) = i
+		MI_AXVAL(mw,i) = 0
+	    }
+	    MI_USEAXMAP(mw) = NO
+	    MI_NLOGDIM(mw) = ndim
+	}
+
+	# Apply the section transform, if the image was opened with an image
+	# section.  This edits the axis map restored above, if any, and must
+	# be done after restoring the original WCS axis map.
+
+	call iw_setaxmap (mw, im)
+
+	# Set the default world system.
+	call mw_sdefwcs (mw)
+
+	call iw_cfits (iw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwltran.gx b/sys/mwcs/mwltran.gx
new file mode 100644
index 00000000..d7b823b6
--- /dev/null
+++ b/sys/mwcs/mwltran.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltran$t (p1, p2, ltm, ltv, ndim)
+
+PIXEL	p1[ndim]			#I input point
+PIXEL	p2[ndim]			#O transformed output point
+PIXEL	ltm[ndim,ndim]			#I linear transformation matrix
+PIXEL	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+PIXEL	p3[MAX_DIM]
+
+begin
+	call amov$t (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/mwlu.x b/sys/mwcs/mwlu.x
new file mode 100644
index 00000000..f6a606f1
--- /dev/null
+++ b/sys/mwcs/mwlu.x
@@ -0,0 +1,143 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MULU -- Matrix utilities for MWCS.
+#
+#	mw_ludecompose		performs LU decomposition of a square matrix
+#	mw_lubacksub		performs backsubstitution to solve a system
+#
+# These routines are derived from routines in the book Numerical Recipes,
+# Press et. al. 1986.
+
+
+# MW_LUDECOMPOSE -- Replace an NxN matrix A by the LU decomposition of a
+# rowwise permutation of the matrix.  The LU decomposed matrix A and the
+# permutation index IX are output.  The decomposition is performed in place.
+
+procedure mw_ludecompose (a, ix, ndim)
+
+double	a[ndim,ndim]		#U matrix to be inverted; inverted matrix
+int	ix[ndim]		#O vector describing row permutation
+int	ndim			#I dimension of square matrix
+
+pointer	sp, vv
+int	d, i, j, k, imax
+double	aamax, sum, dum
+
+begin
+	call smark (sp)
+	call salloc (vv, ndim, TY_DOUBLE)
+
+	# Keep track of the number of row interchanges, odd or even (not used).
+	d = 1
+
+	# Loop over rows to get implicit scaling information.
+	do i = 1, ndim {
+	    aamax = 0.0
+	    do j = 1, ndim
+		if (abs(a[i,j]) > aamax)
+		    aamax = abs(a[i,j])
+	    if (aamax == 0.0)
+		call error (1, "singular matrix")
+	    Memd[vv+i-1] = 1.0 / aamax
+	}
+
+	# Loop over columns using Crout's method.
+	do j = 1, ndim {
+	    do i = 1, j-1 {
+		sum = a[i,j]
+		do k = 1, i-1
+		    sum = sum - a[i,k] * a[k,j]
+		a[i,j] = sum
+	    }
+
+	    # Search for the largest pivot element.
+	    aamax = 0.0
+	    do i = j, ndim {
+		sum = a[i,j]
+		do k = 1, j-1
+		    sum = sum - a[i,k] * a[k,j]
+		a[i,j] = sum
+
+		# Figure of merit for the pivot.
+		dum = Memd[vv+i-1] * abs(sum)
+		if (dum >= aamax) {
+		    imax = i
+		    aamax = dum
+		}
+	    }
+
+	    # Do we need to interchange rows?
+	    if (j != imax) {
+		# Yes, do so...
+		do k = 1, ndim {
+		    dum = a[imax,k]
+		    a[imax,k] = a[j,k]
+		    a[j,k] = dum
+		}
+		d = -d
+		Memd[vv+imax-1] = Memd[vv+j-1]
+	    }
+
+	    ix[j] = imax
+	    if (a[j,j] == 0.0)
+		a[j,j] = EPSILOND
+
+	    # Divide by the pivot element.
+	    if (j != ndim) {
+		dum = 1.0 / a[j,j]
+		do i = j+1, ndim
+		    a[i,j] = a[i,j] * dum
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# MW_LUBACKSUB -- Solves the set of N linear equations A*X=B.  Here A is input,
+# not as the matrix A but rather as its LU decomposition, determined by the
+# routine mw_ludecompose.  IX is input as the permutation vector as returned by
+# mw_ludecompose.  B is input as the right hand side vector B, and returns with
+# the solution vector X.
+
+procedure mw_lubacksub (a, ix, b, ndim)
+
+double	a[ndim,ndim]		#I LU decomposition of the matrix A
+int	ix[ndim]		#I permutation vector for A
+double	b[ndim]			#U rhs vector; solution vector
+int	ndim			#I dimension of system
+
+int	ii, ll, i, j
+double	sum
+
+begin
+	# Do the forward substitution, unscrambling the permutation as we
+	# go.  When II is set to a positive value, it will become the index
+	# of the first nonvanishing element of B.
+
+	ii = 0
+	do i = 1, ndim {
+	    ll = ix[i]
+	    sum = b[ll]
+	    b[ll] = b[i]
+
+	    if (ii != 0) {
+		do j = ii, i-1
+		    sum = sum - a[i,j] * b[j]
+	    } else if (sum != 0)
+		ii = i
+
+	    b[i] = sum
+	}
+
+	# Now do the backsubstitution.
+	do i = ndim, 1, -1 {
+	    sum = b[i]
+	    if (i < ndim)
+		do j = i+1, ndim
+		    sum = sum - a[i,j] * b[j]
+	    b[i] = sum / a[i,i]
+	}
+end
diff --git a/sys/mwcs/mwmkidmd.x b/sys/mwcs/mwmkidmd.x
new file mode 100644
index 00000000..acdbb077
--- /dev/null
+++ b/sys/mwcs/mwmkidmd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MKIDMD -- Make the identity matrix.
+
+procedure mw_mkidmd (ltm, ndim)
+
+double	ltm[ndim,ndim]		#O set to the identity matrix
+int	ndim			#I dimension of (square) matrix
+
+int	i, j
+
+begin
+	do j = 1, ndim {
+	    do i = 1, ndim
+		ltm[i,j] = 0.0
+	    ltm[j,j] = 1.0
+	}
+end
diff --git a/sys/mwcs/mwmkidmr.x b/sys/mwcs/mwmkidmr.x
new file mode 100644
index 00000000..f4771217
--- /dev/null
+++ b/sys/mwcs/mwmkidmr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MKIDMR -- Make the identity matrix.
+
+procedure mw_mkidmr (ltm, ndim)
+
+real	ltm[ndim,ndim]		#O set to the identity matrix
+int	ndim			#I dimension of (square) matrix
+
+int	i, j
+
+begin
+	do j = 1, ndim {
+	    do i = 1, ndim
+		ltm[i,j] = 0.0
+	    ltm[j,j] = 1.0
+	}
+end
diff --git a/sys/mwcs/mwmmul.gx b/sys/mwcs/mwmmul.gx
new file mode 100644
index 00000000..b86449c2
--- /dev/null
+++ b/sys/mwcs/mwmmul.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmul$t (a, b, c, ndim)
+
+PIXEL	a[ndim,ndim]		#I left input matrix
+PIXEL	b[ndim,ndim]		#I right input matrix
+PIXEL	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+PIXEL	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/mwnewcopy.x b/sys/mwcs/mwnewcopy.x
new file mode 100644
index 00000000..cdc7907b
--- /dev/null
+++ b/sys/mwcs/mwnewcopy.x
@@ -0,0 +1,129 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_NEWCOPY -- Copy a MWCS.  The copy is done by constructing a new MWCS
+# from the objects stored in the first one, freeing any dead storage in the
+# process.
+
+pointer procedure mw_newcopy (o_mw)
+
+pointer	o_mw			#I pointer to old MWCS descriptor
+
+int	ndim, nelem, i, j
+pointer	mw, wp, o_wp, at, o_at
+
+bool	streq()
+int	mw_copys(), mw_copyd()
+errchk	calloc, mw_copys, mw_copyd
+
+begin
+	# Make a copy of the main descriptor.
+	call malloc (mw, LEN_MWCS, TY_STRUCT)
+	call amovi (Memi[o_mw], Memi[mw], LEN_MWCS)
+
+	# We have to allocate our own string and data buffers.
+	MI_SBUF(mw) = NULL
+	MI_SBUFLEN(mw) = 0
+	MI_SBUFUSED(mw) = 0
+	MI_DBUF(mw) = NULL
+	MI_DBUFLEN(mw) = 0
+	MI_DBUFUSED(mw) = 0
+
+	# Copy the Lterm data.
+	ndim = MI_NDIM(mw)
+	nelem = ndim * ndim
+	MI_LTV(mw) = mw_copyd (mw, o_mw, MI_LTV(o_mw), ndim)
+	MI_LTM(mw) = mw_copyd (mw, o_mw, MI_LTM(o_mw), nelem)
+
+	# We don't inherit open CTRAN descriptors.
+	call aclri (MI_CTRAN(mw,1), MAX_CTRAN)
+
+	# Copy the WCS.
+	do i = 1, MI_NWCS(o_mw) {
+	    wp = MI_WCSP(mw,i)
+	    o_wp = MI_WCSP(o_mw,i)
+	    ndim = WCS_NDIM(wp)
+	    nelem = ndim * ndim
+
+	    # Copy the WCS data.
+	    WCS_R(wp) = mw_copyd (mw, o_mw, WCS_R(o_wp), ndim)
+	    WCS_W(wp) = mw_copyd (mw, o_mw, WCS_W(o_wp), ndim)
+	    WCS_CD(wp) = mw_copyd (mw, o_mw, WCS_CD(o_wp), nelem)
+
+	    # Each axis can have its own sampled WCS.
+	    do j = 1, ndim {
+		WCS_PV(wp,j) =
+		    mw_copyd (mw, o_mw, WCS_PV(o_wp,j), WCS_NPTS(o_wp,j))
+		WCS_WV(wp,j) =
+		    mw_copyd (mw, o_mw, WCS_WV(o_wp,j), WCS_NPTS(o_wp,j))
+	    }
+
+	    # Copy the WCS attributes.
+	    do j = 1, WCS_NWATTR(o_wp) {
+		at = WCS_WATTR(wp,j)
+		o_at = WCS_WATTR(o_wp,j)
+		AT_NAME(at) = mw_copys (mw, o_mw, AT_NAME(o_at))
+		AT_VALUE(at) = mw_copys (mw, o_mw, AT_VALUE(o_at))
+		if (streq (S(mw,AT_NAME(at)), "system"))
+		    WCS_SYSTEM(wp) = AT_VALUE(at)
+	    }
+
+	    # Preserve the default WCS.
+	    if (MI_WCS(o_mw) == o_wp)
+		MI_WCS(mw) = wp
+	}
+
+	return (mw)
+end
+
+
+# MW_COPYD -- Copy a block of type double data from one MWCS to another.
+# If the buffer offset in the old system is NULL, there was no data, and
+# a null offset is output.
+
+int procedure mw_copyd (mw, o_mw, o_off, nelem)
+
+pointer	mw			#I pointer to output MWCS
+pointer	o_mw			#I pointer to input (old) MWCS
+int	o_off			#I buffer offset in old MWCS
+int	nelem			#I number of type double data elements
+
+int	off
+int	mw_allocd()
+errchk	mw_allocd
+
+begin
+	if (o_off == NULL)
+	    off = NULL
+	else {
+	    off = mw_allocd (mw, nelem)
+	    call amovd (D(o_mw,o_off), D(mw,off), nelem)
+	}
+
+	return (off)
+end
+
+
+# MW_COPYS -- Copy an EOS delimited string from one MWCS to another.
+# If the buffer offset in the old system is NULL, there is no data, and
+# a null offset is output.
+
+int procedure mw_copys (mw, o_mw, o_off)
+
+pointer	mw			#I pointer to output MWCS
+pointer	o_mw			#I pointer to input (old) MWCS
+int	o_off			#I buffer offset in old MWCS
+
+int	off
+int	mw_refstr()
+errchk	mw_refstr
+
+begin
+	if (o_off == NULL)
+	    off = NULL
+	else
+	    off = mw_refstr (mw, S(o_mw,o_off))
+
+	return (off)
+end
diff --git a/sys/mwcs/mwnewsys.x b/sys/mwcs/mwnewsys.x
new file mode 100644
index 00000000..e7d1e117
--- /dev/null
+++ b/sys/mwcs/mwnewsys.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_NEWSYSTEM -- Add a new world coordinate system with the given name
+# and dimensionality to the MWCS.  Make the new system the current system,
+# since a number of WCS initialization calls will (should) surely follow.
+
+procedure mw_newsystem (mw, system, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system name
+int	ndim			#I system dimensionality
+
+pointer	wp
+int	mw_refstr()
+pointer	mw_findsys()
+errchk	syserrs, mw_refstr
+
+begin
+	# Check that the system does not already exist.
+	if (mw_findsys (mw, system) != NULL)
+	    call syserrs (SYS_MWWCSREDEF, system)
+
+	# Add the new system.
+	if (MI_NWCS(mw) + 1 > MAX_WCS)
+	    call syserrs (SYS_MWMAXWCS, system)
+	MI_NWCS(mw) = MI_NWCS(mw) + 1
+	wp = MI_WCSP(mw,MI_NWCS(mw))
+
+	# Initialize the WCS.
+	WCS_NDIM(wp) = ndim
+
+	# Make the new WCS the default WCS.
+	MI_WCS(mw) = wp
+
+	# The system name is stored as a global (axis=0) attribute of the WCS.
+	call mw_swattrs (mw, 0, "system", system)
+	WCS_SYSTEM(wp) = mw_refstr (mw, system)
+end
diff --git a/sys/mwcs/mwopen.x b/sys/mwcs/mwopen.x
new file mode 100644
index 00000000..7841f904
--- /dev/null
+++ b/sys/mwcs/mwopen.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	"mwcs.h"
+
+# MW_OPEN -- Create a new MWCS descriptor.  If the non-NULL address of a
+# buffer containing a saved MWCS is given, the saved MWCS will be loaded,
+# otherwise a unitary MWCS of the indicated dimension is created.
+
+pointer procedure mw_open (bufptr, ndim)
+
+pointer	bufptr		#I pointer to encoded MWCS, or NULL
+int	ndim		#I dimension of system to be created
+
+int	i
+pointer	mw, wp
+int	mw_allocd()
+errchk	calloc, mw_load, syserrs, mw_allocd
+string	s_physical "physical"
+
+begin
+	# Initialize the function drivers.
+	call wf_init()
+
+	# Allocate the base descriptor.
+	call calloc (mw, LEN_MWCS, TY_STRUCT)
+
+	# Load saved MWCS, if one was given.
+	if (bufptr != NULL) {
+	    call mw_load (mw, bufptr)
+	    return (mw)
+	}
+
+	# Initialize the new descriptor to a unitary transform of dimension
+	# NDIM.  Most of this is accomplished by merely creating a zeroed
+	# descriptor.
+
+	if (ndim < 1 || ndim > MAX_DIM) {
+	    call mfree (mw, TY_STRUCT)
+	    call syserrs (SYS_MWNDIM, "mw_open")
+	}
+
+	MI_MAGIC(mw) = MWCS_MAGIC
+	MI_NDIM(mw) = ndim
+	MI_NLOGDIM(mw) = ndim
+	MI_LTV(mw) = mw_allocd (mw, ndim)
+	MI_LTM(mw) = mw_allocd (mw, ndim * ndim)
+	call mw_mkidmd (D(mw,MI_LTM(mw)), ndim)
+	do i = 1, ndim {
+	    MI_AXNO(mw,i) = i
+	    MI_PHYSAX(mw,i) = i
+	}
+
+	# Set up the builtin world systems "physical" and "logical".
+	# Both are linear systems.  The physical system is a unitary
+	# transformation (since world systems are defined relative to
+	# the physical system), and the logical system has the Lterm
+	# for its linear term.  No wcs attributes other than wtype are
+	# defined.
+
+	# Create the physical system.
+	call mw_newsystem (mw, s_physical, ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Create the logical system.
+	call mw_newsystem (mw, "logical", ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Set W and CD for the logical system to point to the Lterm.
+	wp = MI_WCS(mw)
+	WCS_W(wp) = MI_LTV(mw)
+	WCS_CD(wp) = MI_LTM(mw)
+
+	# Set the default world system.
+	call mw_sdefwcs (mw)
+
+	return (mw)
+end
diff --git a/sys/mwcs/mwopenim.x b/sys/mwcs/mwopenim.x
new file mode 100644
index 00000000..f4e86180
--- /dev/null
+++ b/sys/mwcs/mwopenim.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# MW_OPENIM -- Open an MWCS descriptor on an image, loading the descriptor
+# from the image if there is one.  The MWCS descriptor is allocated after
+# the WCS cards are read in mw_loadim so that the WCS dimensionality can
+# be determined when the image header is dataless.
+
+pointer procedure mw_openim (im)
+
+pointer	im			#I pointer to image descriptor
+
+pointer	mw
+
+begin
+	mw = NULL
+	call mw_loadim (mw, im)
+	return (mw)
+end
diff --git a/sys/mwcs/mwrefstr.x b/sys/mwcs/mwrefstr.x
new file mode 100644
index 00000000..07385976
--- /dev/null
+++ b/sys/mwcs/mwrefstr.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "mwcs.h"
+
+# MW_REFSTR -- Search the string buffer for the named string and return the
+# string offset if found, otherwise enter the new string and return its
+# offset.  This is used to avoid storing the same string many times, but
+# use of this technique means that string data cannot be modified once
+# entered.
+
+int procedure mw_refstr (mw, str)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	str[ARB]		#I string to be referenced or entered
+
+bool	match
+pointer	sbuf, btop, ip
+int	nchars, off, ch, i
+int	strlen(), mw_allocs()
+errchk	mw_allocs
+
+begin
+	sbuf = MI_SBUF(mw)
+	btop = sbuf + MI_SBUFLEN(mw)
+	nchars = strlen (str)
+
+	# Search the string buffer for the given string.
+	match = false
+	if (sbuf != NULL)
+	    for (ip=sbuf;  !match && ip < btop;  ) {
+		match = true
+		do i = 1, btop-ip {
+		    ch = Memc[ip+i-1]
+		    if (i <= nchars)
+			if (ch != str[i])
+			    match = false
+		    if (ch == EOS) {
+			if (!match)
+			    ip = ip + i
+			break
+		    }
+		}
+		if (ch != EOS)
+		    break
+	    }
+
+	# Add the string if not found.
+	if (!match) {
+	    off = mw_allocs (mw, nchars)
+	    call strcpy (str, S(mw,off), nchars)
+	} else
+	    off = ip - sbuf + 1
+
+	return (off)
+end
diff --git a/sys/mwcs/mwrotate.x b/sys/mwcs/mwrotate.x
new file mode 100644
index 00000000..27972659
--- /dev/null
+++ b/sys/mwcs/mwrotate.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+define	LTM	Memd[ltm+(($2)-1)*pdim+($1)-1]
+
+# MW_ROTATE -- Front end to mw_translate, used to perform simple rotations
+# of the logical system by specifying the rotation angle in degrees, and the
+# center of rotation.  Since only one rotation angle can be specified, this
+# routine is useful only for 2-dim rotations (between any two axes).  Note
+# that the transformation is performed in double precision even though the
+# rotation angle and center are specified in single precision, preserving
+# the full internal precision of the Lterm.
+
+procedure mw_rotate (mw, theta, center, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	theta			#I rotation angle, degrees
+real	center[ARB]		#I center of rotation
+int	axbits			#I bitflags defining axes to be rotated
+
+double	d_theta
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, ax1, ax2, axmap, pdim, nelem
+errchk	syserr
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes != 2)
+	    call syserr (SYS_MWROT2AX)
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+	d_theta = theta
+	ax1 = axis[1]
+	ax2 = axis[2]
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Set up a 2-dim rotation between the specified axes.
+	LTM(ax1,ax1) =  cos(d_theta)
+	LTM(ax2,ax1) =  sin(d_theta)
+	LTM(ax1,ax2) = -sin(d_theta)
+	LTM(ax2,ax2) =  cos(d_theta)
+
+	# Set the rotation center.
+	Memd[ltv_1+ax1-1] = center[1]
+	Memd[ltv_1+ax2-1] = center[2]
+
+	# Set the back translation vector.
+	Memd[ltv_2+ax1-1] = center[1]
+	Memd[ltv_2+ax2-1] = center[2]
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsave.x b/sys/mwcs/mwsave.x
new file mode 100644
index 00000000..22b92212
--- /dev/null
+++ b/sys/mwcs/mwsave.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"mwcs.h"
+include	"mwsv.h"
+
+# MW_SAVE -- Save the contents of a MWCS descriptor, i.e., the MWCS object,
+# in a machine independent binary array.  This may be stored in a file or
+# database, passed through a network interface, etc., and later reopened
+# on a descriptor with MW_LOAD or MW_OPEN.
+
+int procedure mw_save (o_mw, bp, buflen)
+
+pointer	o_mw			#I pointer to MWCS descriptor
+pointer	bp			#U pointer to save buffer of type char
+int	buflen			#U allocated length of save buffer
+
+int	nchars, olen
+pointer	mw, sp, sv, op, oo
+errchk	coerce, realloc, mw_newcopy
+pointer	coerce(), mw_newcopy()
+int	pl_p2li()
+
+begin
+	call smark (sp)
+	call salloc (sv, LEN_SVHDR, TY_STRUCT)
+
+	# We save a new copy of the MWCS, rather than the MWCS itself,
+	# to discard any dead storage and to cause the runtime descriptor
+	# pointers to be set to NULL.
+
+	mw = mw_newcopy (o_mw)
+
+	# Clear runtime fields that cannot be meaningfully saved.
+	MI_WCS(mw) = NULL
+	MI_REFIM(mw) = NULL
+	call aclri (MI_AXNO(mw,1), MAX_DIM)
+	call aclri (MI_AXVAL(mw,1), MAX_DIM)
+	call aclri (MI_PHYSAX(mw,1), MAX_DIM)
+
+	# Compress the main header to save space.
+	call salloc (oo, MI_LEN(mw) * 3 + 32, TY_SHORT)
+	olen = pl_p2li (Memi[mw], 1, Mems[oo], MI_LEN(mw))
+
+	# Determine how much space will be needed.
+	nchars = LEN_SVHDR * SZ_STRUCT + olen * SZ_SHORT +
+	    (MI_DBUFUSED(mw) + 1) * SZ_DOUBLE +
+	    (MI_SBUFUSED(mw) + SZB_CHAR-1) / SZB_CHAR
+
+	# Get the space.
+	if (nchars > buflen) {
+	    call realloc (bp, nchars, TY_CHAR)
+	    buflen = nchars
+	}
+
+	# Prepare the save header.
+	call aclri (Memi[sv], LEN_SVHDR)
+
+	SV_MAGIC(sv)   = MWSV_MAGIC
+	SV_CWCSLEN(sv) = olen
+	SV_MWSVLEN(sv) = MI_LEN(mw)
+	SV_DBUFLEN(sv) = MI_DBUFUSED(mw)
+	SV_SBUFLEN(sv) = MI_SBUFUSED(mw)
+	SV_MWSVOFF(sv) = LEN_SVHDR * SZ_STRUCT
+	SV_DBUFOFF(sv) = (SV_MWSVOFF(sv) + olen * SZ_SHORT + SZ_DOUBLE-1) /
+			    SZ_DOUBLE * SZ_DOUBLE
+	SV_SBUFOFF(sv) = SV_DBUFOFF(sv) + MI_DBUFUSED(mw) * SZ_DOUBLE
+	SV_VERSION(sv) = MWSV_VERSION
+	SV_NWCS(sv)    = MI_NWCS(mw)
+	SV_LENWCS(sv)  = LEN_WCS
+
+	# Output the save header.
+	op = coerce (bp, TY_CHAR, TY_STRUCT)
+	call miipak32 (Memi[sv], Memi[op], LEN_SVHDR, TY_INT)
+
+	# Store the three segments of the MWCS, i.e., the main descriptor
+	# and the data and string buffers.
+
+	op = coerce (bp + SV_MWSVOFF(sv), TY_CHAR, TY_SHORT)
+	call miipak16 (Mems[oo], Mems[op], olen, TY_SHORT)
+	op = coerce (bp + SV_DBUFOFF(sv), TY_CHAR, TY_DOUBLE)
+	call miipakd (D(mw,1), Memd[op], SV_DBUFLEN(sv), TY_DOUBLE)
+	op = coerce (bp + SV_SBUFOFF(sv), TY_CHAR, TY_CHAR)
+	call miipak8 (S(mw,1), Memc[op], SV_SBUFLEN(sv), TY_CHAR)
+
+	call mw_close (mw)
+	call sfree (sp)
+
+	return (nchars)
+end
diff --git a/sys/mwcs/mwsaveim.x b/sys/mwcs/mwsaveim.x
new file mode 100644
index 00000000..a74ef99a
--- /dev/null
+++ b/sys/mwcs/mwsaveim.x
@@ -0,0 +1,394 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"imwcs.h"
+include	"mwcs.h"
+
+# MW_SAVEIM -- Save the current MWCS in an image header in FITS format.
+# This is only possible to some degree.  Although the Lterm is always saved,
+# only one world system can be saved.  FITS convention requires that the
+# FITS wcs represent the transformation from image (logical) coordinates
+# to world coordinates, whereas the MWCS Wterm represents the physical to
+# world transformation, so what we save is actually a combination of the
+# Wterm and Lterm; combining the two is only possible if there are no
+# rotations between dissimilar axes.  Sampled WCS vectors and WCS attributes
+# can be saved, although this can be inefficient for large vectors and can
+# result in header overflow, and there can be problems preserving the
+# precision of double precision data since the FITS representation is ASCII.
+# Since the WCS is represented by a variable set of cards, we must be careful
+# to delete any old WCS cards which are not updated by the save operation.
+
+procedure mw_saveim (mw, im)
+
+pointer	mw				#I pointer to MWCS descriptor
+pointer	im				#I pointer to image descriptor
+
+double	cdelt
+char	label[SZ_VALSTR]
+bool	update, output_cdelt
+char	kwname[SZ_KWNAME], ctype[SZ_KWNAME], axtype[4]
+int	ndim, axis, fn, ira, idec, i, j, pv, wv, npts, fd
+pointer	sp, iw, wp, wf, vp, cp, at, o_r, n_r, o_cd, n_cd, ltm
+int	op
+
+bool	streq(), fp_equald()
+pointer	iw_rfits(), iw_findcard()
+int	strncmp(), strlen(), open(), nowhite(), stridxs()
+errchk	iw_rfits, mw_ssystem, iw_putarray, iw_putstr, open
+include	"mwcs.com"
+define	ewcs_  91
+
+begin
+	# Scan the old image header, recording all WCS cards.
+	iw = iw_rfits (mw, im, RF_COPY)
+
+	# Save the WCS dimension (not necessarily same as that of the image).
+	ndim = MI_NDIM(mw)
+	cp = iw_findcard (iw, TY_WCSDIM, -1, 0)
+	if (cp == NULL || IW_NDIM(iw) != ndim) {
+	    call strcpy ("WCSDIM", kwname, SZ_KWNAME)
+	    if (cp == NULL)
+		call imaddf (im, kwname, "i")
+	    call imputi (im, kwname, ndim)
+	}
+	if (cp != NULL)
+	    C_UPDATED(cp) = YES
+
+	call smark (sp)
+	call salloc (o_r, ndim, TY_DOUBLE)
+	call salloc (n_r, ndim, TY_DOUBLE)
+	call salloc (o_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (n_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+
+	# Get pointer to the world system to be saved.  Currently only one
+	# such system can be saved since the image header is FITS based and
+	# FITS doesn't support multiple world coordinate systems.  The system
+	# to be saved can be set by calling MW_SSYSTEM before doing the
+	# mw_saveim.
+
+	wp = MI_WCS(mw)
+
+	# Do we need to save any WCS information at all?
+	if (MI_NWCS(mw) <= 2)
+	    goto ewcs_
+
+	# Store the current WCS in the image header.  This is optimized to
+	# use the knowledge of the current header contents obtained by
+	# iw_rfits above, to determine if each header card needs to be
+	# modified in the header, or added to the header.  If the card
+	# already exists with the correct value nothing is done.
+
+	# Output CTYPEi for each axis.
+	do axis = 1, ndim {
+
+	    # Get the new value of CTYPEi.
+	    if (WCS_AXCLASS(wp,axis) == F_LINEAR) {
+		# For the default case of a linear axis, set CTYPEi to the
+		# value of the axis label, if there is one and it is a simple
+		# keyword but not one of the CTYPE keywords reserved by MWCS.
+
+		call strcpy ("LINEAR  ", ctype, SZ_KWNAME)
+		ifnoerr {
+		    call mw_gwattrs (mw, axis, "label", label, SZ_VALSTR)
+		} then {
+		    call strupr (label)
+		    if (nowhite (label, label, SZ_VALSTR) <= SZ_KWNAME) {
+			if (strncmp (label, "SAMPLED", 8) != 0 &&
+			    strncmp (label, "RA--", 4) != 0 &&
+			    strncmp (label, "DEC-", 4) != 0 &&
+			    strncmp (label[2], "LON", 3) != 0 &&
+			    strncmp (label[2], "LAT", 3) != 0) {
+
+			    call sprintf (ctype, SZ_KWNAME, "%-8s%9t")
+				call pargstr (label)
+			}
+		    }
+		}
+
+	    } else {
+		wf = WCS_FUNC(wp,WCS_AXCLASS(wp,axis))
+		fn = WF_FN(wf)
+
+		if (and (FN_FLAGS(fn), F_RADEC) != 0) {
+		    # Determine the axis type.
+		    ira = 0
+		    idec = 0
+		    axtype[1] = EOS
+		    do i = 1, 2 {
+			ifnoerr (call mw_gwattrs (mw,
+				WF_AXIS(wf,i), "axtype", axtype, 4)) {
+			    call strlwr (axtype)
+			    if (streq (axtype, "ra") ||
+				    streq (axtype[2], "lon")) {
+				ira  = i
+				idec = 3 - i
+				break
+			    } else if (streq (axtype, "dec") ||
+				    streq (axtype[2], "lat")) {
+				ira  = 3 - i
+				idec = i
+				break
+			    } 
+			}
+		    }
+
+		    # RA and DEC had better be flagged, but if not, assume
+		    # that the first axis is RA and the second DEC.
+
+		    if (ira == 0)
+			ira = 1
+		    if (idec == 0)
+			idec = 2
+			
+		    # Make a name like "RA---TAN".
+		    if (WF_AXIS(wf,idec) == axis) {
+			if (streq (axtype, "ra") || streq (axtype, "dec")) {
+			    call strcpy ("DEC-----", ctype, SZ_KWNAME)
+			} else if (streq (axtype[2], "lon") ||
+				streq (axtype[2], "lat")) {
+			    call sprintf (ctype, SZ_KWNAME, "%cLAT----")
+				call pargc (axtype[1])
+			} else {
+			    call strcpy ("DEC-----", ctype, SZ_KWNAME)
+			}
+		    } else {
+			if (streq (axtype, "ra") || streq (axtype, "dec")) {
+			    call strcpy ("RA------", ctype, SZ_KWNAME)
+			} else if (streq (axtype[2], "lon") ||
+				streq (axtype[2], "lat")) {
+			    call sprintf (ctype, SZ_KWNAME, "%cLON----")
+				call pargc (axtype[1])
+			} else {
+			    call strcpy ("RA------", ctype, SZ_KWNAME)
+			}
+		    }
+
+		    op = max (1, SZ_KWNAME - strlen (FN_NAME(fn)) + 1)
+		    call strcpy (FN_NAME(fn), ctype[op], SZ_KWNAME-op+1)
+		    call strupr (ctype)
+
+		} else {
+		    # Just output the WCS function name as CTYPE.
+		    call strcpy ("        ", ctype, SZ_KWNAME)
+		    call strcpy (FN_NAME(fn), ctype, SZ_KWNAME)
+		    call strupr (ctype)
+		}
+	    }
+
+	    # Update the header value if there is any change.
+	    update = true
+	    vp = IW_CTYPE(iw,axis)
+	    if (vp != NULL)
+		update = (strncmp (Memc[vp], ctype, SZ_KWNAME) != 0)
+
+	    cp = iw_findcard (iw, TY_CTYPE, axis, 0)
+	    if (update) {
+		call sprintf (kwname, SZ_KWNAME, "CTYPE%d")
+		    call pargi (axis)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "c")
+		call impstr (im, kwname, ctype)
+	    }
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+
+	# FITS requires that the WCS specify the transformation from raw
+	# image (logical) coordinates to world coordinates, whereas the
+	# MWCS Wterm specifies the transformation from physical coordinates
+	# to world coordinates.  Hence, we must modify CD and CRPIX (R)
+	# to specify the transformation from logical to world coordinates.
+
+	# Get the MWCS R vector.
+	if (WCS_R(wp) != NULL)
+	    call amovd (D(mw,WCS_R(wp)), Memd[o_r], ndim)
+	else
+	    call aclrd (Memd[o_r], ndim)
+
+	# Get the MWCS CD matrix.
+	if (WCS_CD(wp) != NULL)
+	    call amovd (D(mw,WCS_CD(wp)), Memd[o_cd], ndim*ndim)
+	else
+	    call mw_mkidmd (Memd[o_cd], ndim)
+	    
+	# Output CRVAL (this is unaffected by the Lterm).
+	if (WCS_W(wp) != NULL)
+	    call iw_putarray (iw, D(mw,WCS_W(wp)), IW_CRVAL(iw,1), ndim,
+		"CRVAL%d", TY_CRVAL, 0)
+
+	# Output CRPIX = R' =  (LTM * R + LTV).
+	call mw_vmuld (D(mw,MI_LTM(mw)), Memd[o_r], Memd[n_r], ndim)
+	call aaddd (D(mw,MI_LTV(mw)), Memd[n_r], Memd[n_r], ndim)
+	call iw_putarray (iw, Memd[n_r], IW_CRPIX(iw,1), ndim,
+	    "CRPIX%d", TY_CRPIX, 0)
+
+	# Output the CD matrix = CD' =  (CD * inv(LTM)).  If the system
+	# dimensionality is 2 or less and there is no rotation, output
+	# the CDELT notation in addition to the CD matrix to enhance
+	# compatibility with older programs.
+
+	call mw_invertd (D(mw,MI_LTM(mw)), Memd[ltm], ndim)
+	call mw_mmuld (Memd[o_cd], Memd[ltm], Memd[n_cd], ndim)
+
+	# Output CDELT1/CDELT2 if the image dimension is 2 or less and the
+	# CD matrix is a diagonal matrix (no rotational or skew terms).
+
+	output_cdelt = false
+	if (ndim == 1)
+	    output_cdelt = true
+	else if (ndim == 2) {
+	    output_cdelt = (fp_equald(Memd[n_cd+1],0.0D0) &&
+			    fp_equald(Memd[n_cd+2],0.0D0))
+	}
+
+	if (output_cdelt) {
+	    do j = 1, ndim {
+		cdelt = Memd[n_cd+(j-1)*(ndim+1)]
+		cp = iw_findcard (iw, TY_CDELT, j, 0)
+		if (cp == NULL || !fp_equald(IW_CDELT(iw,j),cdelt)) {
+		    call sprintf (kwname, SZ_KWNAME, "CDELT%d")
+			call pargi (j)
+		    if (cp == NULL)
+			call imaddf (im, kwname, "d")
+		    call imputd (im, kwname, cdelt)
+		}
+		if (cp != NULL)
+		    C_UPDATED(cp) = YES
+	    }
+	}
+
+	# Update the CD matrix.
+	do j = 1, ndim {
+	    call sprintf (kwname, SZ_KWNAME, "CD%d_%%d")
+		call pargi (j)
+	    call iw_putarray (iw, Memd[n_cd+(j-1)*ndim],
+		IW_CD(iw,1,j), ndim, kwname, TY_CD, j)
+	}
+
+	# Output the Lterm.
+ewcs_
+	# Output LTV.
+	if (MI_LTV(mw) != NULL)
+	    call iw_putarray (iw, D(mw,MI_LTV(mw)), IW_LTV(iw,1), ndim,
+		"LTV%d", TY_LTV, 0)
+
+	# Output LTM.
+	if (MI_LTM(mw) != NULL) {
+	    do j = 1, ndim {
+		call sprintf (kwname, SZ_KWNAME, "LTM%%d_%d")
+		    call pargi (j)
+		call iw_putarray (iw, D(mw,MI_LTM(mw)+(j-1)*ndim),
+		    IW_LTM(iw,1,j), ndim, kwname, TY_LTM, j)
+	    }
+	}
+
+	# Output axis map if any.
+	if (MI_USEAXMAP(mw) == YES) {
+	    fd = open ("WAXMAP", READ_WRITE, SPOOL_FILE)
+	    axis = ERR
+
+	    do i = 1, ndim {
+		call fprintf (fd, "%d %d ")
+		    call pargi (MI_AXNO(mw,i))
+		    call pargi (MI_AXVAL(mw,i))
+	    }
+
+	    # Output successive WAXMAPj FITS cards.
+	    call seek (fd, BOFL)
+	    call iw_putstr (fd, iw, axis, TY_WAXMAP, "WAXMAP%02d", "", 0)
+	    call close (fd)
+	}
+
+	# Output any WCS attributes.
+	do axis = 0, ndim {
+	    fd = open ("WAT", READ_WRITE, SPOOL_FILE)
+	    npts = 0
+
+	    # Dump the attribute=value assignments for this axis into a single
+	    # large string buffer, using a spool file.
+
+	    do i = 1, WCS_NWATTR(wp) {
+		at = WCS_WATTR(wp,i)
+		if (AT_AXIS(at) != axis)
+		    next
+
+		if (npts > 0)
+		    call putline (fd, " ")
+		call putline (fd, S(mw,AT_NAME(at)))
+		if (stridxs (" \t", S(mw,(AT_VALUE(at)))) > 0) {
+		    call putline (fd, " = \"")
+		    call putline (fd, S(mw,AT_VALUE(at)))
+		    call putline (fd, "\"")
+		} else {
+		    call putline (fd, "=")
+		    call putline (fd, S(mw,AT_VALUE(at)))
+		}
+
+		npts = npts + 1
+	    }
+
+	    # Output successive WATi_jjj FITS cards.
+	    call seek (fd, BOFL)
+	    if (npts > 0)
+		call iw_putstr (fd, iw, axis, TY_WATDATA, "WAT%d_%03d",
+		    "WAT%d%04d", 999)
+	    call close (fd)
+	}
+
+	# Update any sampled WCS in the header.
+	do axis = 1, ndim {
+	    npts = WCS_NPTS(wp,axis)
+	    if (npts == 0)
+		next
+
+	    # Update the LEN card.
+	    cp = iw_findcard (iw, TY_WSVLEN, axis, 0)
+	    if (IW_WSVLEN(iw,axis) != npts) {
+		call sprintf (kwname, SZ_KWNAME, "WSV%d_LEN")
+		    call pargi (axis)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "i")
+		call imputi (im, kwname, npts)
+	    }
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+
+	    pv = WCS_PV(wp,axis)
+	    wv = WCS_WV(wp,axis)
+
+	    # Dump the entire array into an ASCII spool file as successive
+	    # points [PV,WV].
+
+	    fd = open ("WSV", READ_WRITE, SPOOL_FILE)
+	    do i = 1, npts {
+		call fprintf (fd, "%0.*g %0.*g ")
+		    call pargi (NDIGITS_DP);  call pargd (D(mw,pv+i-1))
+		    call pargi (NDIGITS_DP);  call pargd (D(mw,wv+i-1))
+	    }
+
+	    # Output successive WSVi_jjj FITS cards.
+	    call seek (fd, BOFL)
+	    call iw_putstr (fd, iw, axis, TY_WSVDATA, "WSV%d_%03d",
+		"WSV%d%04d", 999)
+	    call close (fd)
+	}
+
+	# Delete any old WCS cards which were not updated, and hence which
+	# are no longer valid, or which are not needed because the value is
+	# the default (in which case the old card is probably invalid).
+
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_UPDATED(cp) == NO) {
+		call strcpy (Memc[C_RP(cp)], kwname, SZ_KWNAME)
+		if (nowhite (kwname, kwname, SZ_KWNAME) > 0)
+		    call imdelf (im, kwname)
+	    }
+	}
+
+	call iw_cfits (iw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsaxmap.x b/sys/mwcs/mwsaxmap.x
new file mode 100644
index 00000000..3070969b
--- /dev/null
+++ b/sys/mwcs/mwsaxmap.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SAXMAP -- Set the axis map.  This assigns a logical axis axno[i] to
+# each physical axis I.  If axno[i]=0, the value of the physical axis
+# coordinate is the constant axval[i], and the dimension of the logical
+# system is reduced by one.  Setting the axis map automatically enables
+# axis mapping if a nonstandard map is entered.
+
+procedure mw_saxmap (mw, axno, axval, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axno[ndim]		#I physical -> logical axis assignments
+int	axval[ndim]		#I value of physical axis if axno=0
+int	ndim			#I physical dimension of axis map
+
+int	i, j
+errchk	syserrs, syserr
+
+begin
+	# Verify dimension.
+	if (MI_NDIM(mw) != ndim)
+	    call syserrs (SYS_MWNDIM, "mw_saxmap")
+
+	# Store the arrays, and determine the dimension of the logical system.
+	# Enable axis mapping if an interesting map has been entered.
+
+	MI_NLOGDIM(mw) = 0
+	MI_USEAXMAP(mw) = NO
+
+	do i = 1, ndim {
+	    MI_AXNO(mw,i) = axno[i]
+	    MI_AXVAL(mw,i) = axval[i]
+	    if (axno[i] > 0)
+		MI_NLOGDIM(mw) = MI_NLOGDIM(mw) + 1
+	    if (axno[i] != i)
+		MI_USEAXMAP(mw) = YES
+	}
+
+	# Invert the axis map to facilitate logical->physical mappings.
+	do j = 1, MI_NLOGDIM(mw) {
+	    for (i=1;  i <= ndim;  i=i+1)
+		if (axno[i] == j) {
+		    MI_PHYSAX(mw,j) = i
+		    break
+		}
+	    if (i > ndim)
+		call syserr (SYS_MWINVAXMAP)
+	}
+end
diff --git a/sys/mwcs/mwscale.x b/sys/mwcs/mwscale.x
new file mode 100644
index 00000000..2ae7167a
--- /dev/null
+++ b/sys/mwcs/mwscale.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_SCALE -- Front end to mw_translate, used to perform a simple rescaling
+# of the logical system.
+
+procedure mw_scale (mw, scale, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	scale[ARB]		#I scale factor for each axis in axbits
+int	axbits			#I bitflags defining axes
+
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, pdim, nelem, axmap, i, j
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes <= 0)
+	    return
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Enter the axis scale factors.
+	do i = 1, naxes {
+	    j = axis[i] - 1
+	    Memd[ltm+j*pdim+j] = scale[i]
+	}
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsctran.x b/sys/mwcs/mwsctran.x
new file mode 100644
index 00000000..c529bc80
--- /dev/null
+++ b/sys/mwcs/mwsctran.x
@@ -0,0 +1,410 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	"mwcs.h"
+
+# MW_SCTRAN -- Set up a coordinate transformation (CTRAN) descriptor.
+# The general idea is to reduce the coordinate transformation to as simple
+# a form as possible for efficient evaluation at runtime.  Most of the
+# complexities of the actual coordinate system, e.g., axis mapping, multiple
+# WCS, separate linear and world terms, forward and inverse transforms, etc.,
+# can be dealt with at CTRAN compile time.  The result is a CTRAN descriptor
+# for an N-d coordinate defining an N-d linear transformation and zero or
+# more calls to WCS functions for individual axes, where N can be anything
+# less than or equal to the dimensionality of the full system.
+#
+# A transformation may be set up between any two coordinate systems
+# SYSTEM1 and SYSTEM2.  The dimensionality of the transformation, and the
+# axes to which it applies, is determined by the axis bitflags in AXBITS.
+# A pointer to the optimized transformation descriptor is returned as the
+# function value.  An arbitrary number of transformation descriptors may be
+# simultaneously open (a limit of 16 or so is imposed by the main MWCS
+# descriptor).  A CTRAN descriptor reflects the state of the WCS *at the
+# time that the descriptor was compiled*, i.e., subsequent changes to
+# the MWCS descriptor do not affect any compiled transformation descriptors.
+# CTRAN descriptors not subsequently closed by CTFREE are automatically
+# closed when the main MWCS descriptor is closed.
+
+pointer procedure mw_sctran (mw, system1, system2, axbits)
+
+pointer mw			#I pointer to MWCS descriptor
+char	system1[ARB]		#I input coordinate system
+char	system2[ARB]		#I output coordinate system
+int	axbits			#I bitmap defining axes to be transformed
+
+bool	newfunc
+int	naxes, axis[MAX_DIM], wfno, fn, epa
+int	i, j, k , matlen, ndata, ctlen, pdim
+pointer	i_ltm, i_ltv, o_ltm, o_ltv, t_ltm, t_ltv, ltm, ltv
+pointer	sp, w1, w2, ct, wf, fc, lp, ip, op, ct_r, sv_wcs
+
+pointer	coerce()
+errchk	syserr, syserrs, calloc, zcall2, mw_invertd, mw_ssystem
+include	"mwcs.com"
+
+begin
+	call smark (sp)
+
+	# Get pointers to the input and output systems.
+	sv_wcs = MI_WCS(mw)
+	iferr {
+	    call mw_ssystem (mw, system1)
+	    w1 = MI_WCS(mw)
+	    call mw_ssystem (mw, system2)
+	    w2 = MI_WCS(mw)
+	} then {
+	    MI_WCS(mw) = sv_wcs
+	    call erract (EA_ERROR)
+	} else
+	    MI_WCS(mw) = sv_wcs
+
+	# Get the physical axis list.  The bitflags in AXBITS define the axes
+	# in the logical system; run these through the axis map (if enabled)
+	# to get the list of physical axes for which the transformation is to
+	# be prepared.
+
+	call mw_gaxlist (mw, axbits, axis, naxes)
+
+	# Allocate the CTRAN descriptor.  First we must figure out how
+	# much space is required.  The space required is for the base
+	# descriptor, plus additional space for the LTM and LTV, which vary
+	# in size depending upon the dimensionality of the transformation.
+	# The whole thing is then doubled to provide 2 versions of the
+	# descriptor, providing both single and double precision versions
+	# of the LTM and LTV.  Any additional storage utilized by the WCS
+	# functions is separately allocated by the initialization routines
+	# in the function drivers.
+
+	matlen = naxes * naxes
+	ndata = matlen + naxes
+	ctlen = LEN_CTBASE + ndata * SZ_DOUBLE / SZ_STRUCT
+	call calloc (ct, ctlen*2, TY_STRUCT)
+
+	# Save a pointer to the CTRAN descriptor in the main MWCS descriptor,
+	# to permit automatic deallocation at close time.
+
+	do i = 1, MAX_CTRAN+1 {
+	    if (i > MAX_CTRAN) {
+		call mfree (ct, TY_STRUCT)
+		call syserr (SYS_MWCTOVFL)
+	    }
+
+	    if (MI_CTRAN(mw,i) == NULL) {
+		MI_CTRAN(mw,i) = ct
+		break
+	    }
+	}
+
+	CT_MW(ct) = mw
+	CT_WCSI(ct) = w1
+	CT_WCSO(ct) = w2
+	CT_NDIM(ct) = naxes
+	CT_R(ct) = ct + ctlen
+	call amovi (axis, CT_AXIS(ct,1), naxes)
+	CT_LTM(ct) = coerce (ct + LEN_CTBASE, TY_STRUCT, TY_DOUBLE)
+	CT_LTV(ct) = CT_LTM(ct) + matlen
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# We also need some full-system matrix and vector buffers.
+	pdim = min (WCS_NDIM(w1), WCS_NDIM(w2))
+	pdim = min (MI_NDIM(mw), pdim)
+
+	i = pdim * pdim
+	call salloc (i_ltm, i, TY_DOUBLE)
+	call salloc (i_ltv, pdim, TY_DOUBLE)
+	call salloc (o_ltm, i, TY_DOUBLE)
+	call salloc (o_ltv, pdim, TY_DOUBLE)
+	call salloc (t_ltm, i, TY_DOUBLE)
+	call salloc (t_ltv, pdim, TY_DOUBLE)
+
+	# Compute the transformation.  A transformation between any two
+	# world systems W1 and W2 consists of the transformation W1->P
+	# from W1 to the physical system, followed by a transformation
+	# P->W2 to the second world system.  The linear portions of these
+	# two transformations can be combined to produce a single linear
+	# transformation, and if no WCS function calls are involved at
+	# either end, the entire transformation reduces to a single linear
+	# transformation defined by LTM and LTV.  Note that as far as we
+	# are concerned here, the special world systems "logical" and
+	# "physical" are just like other world systems, except that both are
+	# always linear systems.  The linear term for the logical system is
+	# the MWCS Lterm; for the physical system it is the identity matrix.
+
+	# Set up the transformation W1->P.  First we must determine if there
+	# are any WCS function calls.  We do this by going ahead and compiling
+	# the "in" function calls in the CTRAN descriptor.
+
+	do i = 1, naxes {
+	    wfno = WCS_AXCLASS(w1,axis[i])
+
+	    # Skip to next axis if no WCS function is assigned to this axis.
+	    if (wfno == 0)
+		next
+
+	    # Has function call for this axis already been compiled?
+	    newfunc = true
+	    do j = 1, CT_NCALLI(ct) {
+		fc = CT_FCI(ct,j)
+		do k = 1, FC_NAXES(fc)
+		    if (FC_AXIS(fc,k) == i)
+			newfunc = false
+	    }
+
+	    # Compile a function call for the inverse transformation.
+	    if (newfunc) {
+		CT_NCALLI(ct) = CT_NCALLI(ct) + 1
+		if (CT_NCALLI(ct) > MAX_CALL)
+		    call syserrs (SYS_MWFCOVFL, system1)
+
+		fc = CT_FCI(ct,CT_NCALLI(ct))
+		wf = WCS_FUNC(w1,wfno)
+		fn = WF_FN(wf)
+
+		FC_CT(fc)    = ct
+		FC_WCS(fc)   = w1
+		FC_WF(fc)    = wf
+		FC_FCN(fc)   = FN_INV(fn)
+		FC_NAXES(fc) = WF_NAXES(wf)
+
+		# Store CTRAN-relative list of axes in function call
+		# descriptor.  Verify that all the axes needed for the
+		# function call are included in the transformation.
+		# This requirement can theoretically be relaxed in
+		# some cases but this is not supported in MWCS.
+
+		do j = 1, WF_NAXES(wf) {
+		    for (k=1;  k <= naxes;  k=k+1)
+			if (axis[k] == WF_AXIS(wf,j)) {
+			    FC_AXIS(fc,j) = k
+			    break
+			}
+		    if (k > naxes)
+			call syserrs (SYS_MWMISSAX, system1)
+		}
+
+		# Call the function driver to perform any driver dependent
+		# initialization.
+
+		epa = FN_INIT(fn)
+		if (epa != NULL)
+		    call zcall2 (epa, fc, INVERSE)
+	    }
+	}
+
+	# Prepare the linear part of the input transformation W1->P.
+	# This is LTM=inv(CD), and for axis I, LTV[i]=(R[i]-inv(CD)*W)
+	# if no function call, or LTV[i]=R[i] if there is a function
+	# assigned to axis I which already deals with the W[i].  All
+	# this is done in the full dimension of the internal system for
+	# now; extraction of the portion of the full system affecting
+	# the CTRAN axes is done later to permit verification of the
+	# legality of the reduction step required.
+
+	# Invert CD matrix.
+	if (WCS_CD(w1) == NULL)
+	    call mw_mkidmd (Memd[i_ltm], pdim)
+	else
+	    call mw_invertd (D(mw,WCS_CD(w1)), Memd[i_ltm], pdim)
+
+	# If no function calls for an axis and W is set, LTV=(R-inv(CD)*W).
+	if (WCS_W(w1) != NULL) {
+	    call amovd (D(mw,WCS_W(w1)), Memd[i_ltv], pdim)
+	    do i = 1, CT_NCALLI(ct) {
+		fc = CT_FCI(ct,i)
+		do j = 1, FC_NAXES(fc) {
+		    k = axis[FC_AXIS(fc,j)]
+		    Memd[i_ltv+k-1] = 0.0d0
+		}
+	    }
+	    call mw_vmuld (Memd[i_ltm], Memd[i_ltv], Memd[t_ltv], pdim)
+
+	    # Copy R to LTV.
+	    if (WCS_R(w1) == NULL)
+	        call anegd (Memd[t_ltv], Memd[i_ltv], pdim)
+	    else
+		call asubd (D(mw,WCS_R(w1)), Memd[t_ltv], Memd[i_ltv], pdim)
+
+	} else {
+	    # Copy R to LTV.
+	    if (WCS_R(w1) == NULL)
+	        call aclrd (Memd[i_ltv], pdim)
+	    else
+	        call amovd (D(mw,WCS_R(w1)), Memd[i_ltv], pdim)
+	}
+
+	# Now prepare the output side of the transformation, from P->W2.
+	# Like the input half, this consists of a linear term and a list
+	# of zero or more function calls.
+
+	# Compile the "out" function calls in the CTRAN descriptor.
+	do i = 1, naxes {
+	    wfno = WCS_AXCLASS(w2,axis[i])
+
+	    # Skip to next axis if no WCS function is assigned to this axis.
+	    if (wfno == 0)
+		next
+
+	    # Has function call for this axis already been compiled?
+	    newfunc = true
+	    do j = 1, CT_NCALLO(ct) {
+		fc = CT_FCO(ct,j)
+		do k = 1, FC_NAXES(fc)
+		    if (FC_AXIS(fc,k) == i)
+			newfunc = false
+	    }
+
+	    # Compile a function call for the forward transformation.
+	    if (newfunc) {
+		CT_NCALLO(ct) = CT_NCALLO(ct) + 1
+		if (CT_NCALLO(ct) > MAX_CALL)
+		    call syserrs (SYS_MWFCOVFL, system2)
+
+		fc = CT_FCO(ct,CT_NCALLO(ct))
+		wf = WCS_FUNC(w2,wfno)
+		fn = WF_FN(wf)
+
+		FC_CT(fc)    = ct
+		FC_WCS(fc)   = w2
+		FC_WF(fc)    = wf
+		FC_FCN(fc)   = FN_FWD(fn)
+		FC_NAXES(fc) = WF_NAXES(wf)
+
+		# Store CTRAN-relative list of axes in function call
+		# descriptor.  Verify that all the axes needed for the
+		# function call are included in the transformation.
+
+		do j = 1, WF_NAXES(wf) {
+		    for (k=1;  k <= naxes;  k=k+1)
+			if (axis[k] == WF_AXIS(wf,j)) {
+			    FC_AXIS(fc,j) = k
+			    break
+			}
+		    if (k > naxes)
+			call syserrs (SYS_MWMISSAX, system2)
+		}
+
+		# Call the function driver to perform any driver dependent
+		# initialization.
+
+		epa = FN_INIT(fn)
+		if (epa != NULL)
+		    call zcall2 (epa, fc, FORWARD)
+	    }
+	}
+
+	# Prepare the linear part of the input transformation P->W2.
+	# This is LTM=CD, and for axis I, LTV[i]=(W-CD*R) if no function
+	# call, or LTV[i]=(-CD*R) if there is a function assigned to axis
+	# I which already deals with the W[i].
+
+	# Copy CD matrix to LTM.
+	if (WCS_CD(w2) == NULL)
+	    call mw_mkidmd (Memd[o_ltm], pdim)
+	else
+	    call amovd (D(mw,WCS_CD(w2)), Memd[o_ltm], pdim*pdim)
+
+	# Copy -R to t_ltv.
+	if (WCS_R(w2) == NULL)
+	    call aclrd (Memd[t_ltv], pdim)
+	else
+	    call amulkd (D(mw,WCS_R(w2)), -1.0D0, Memd[t_ltv], pdim)
+
+	# Compute -CD*R in LTV.
+	call mw_vmuld (Memd[o_ltm], Memd[t_ltv], Memd[o_ltv], pdim)
+
+	# If no function calls for an axis and W is set, LTV=(W-CD*R).
+	if (WCS_W(w2) != NULL) {
+	    call amovd (D(mw,WCS_W(w2)), Memd[t_ltv], pdim)
+	    call aaddd (Memd[t_ltv], Memd[o_ltv], Memd[o_ltv], pdim)
+	    do i = 1, CT_NCALLO(ct) {
+		fc = CT_FCO(ct,i)
+		do j = 1, FC_NAXES(fc) {
+		    k = axis[FC_AXIS(fc,j)]		# undo +W[k]
+		    lp = o_ltv + k - 1
+		    Memd[lp] = Memd[lp] - Memd[t_ltv+k-1]
+		}
+	    }
+	}
+
+	# Now combine the linear terms of the input and output transformations
+	# to produce the linear portion of the full transformation.
+
+	call mw_mmuld (Memd[o_ltm], Memd[i_ltm], Memd[t_ltm], pdim)
+	call mw_vmuld (Memd[o_ltm], Memd[i_ltv], Memd[t_ltv], pdim)
+	call    aaddd (Memd[o_ltv], Memd[t_ltv], Memd[t_ltv], pdim)
+
+	# Extract the rows of the full linear transformation which are used
+	# for the axes involved in the transformation we are compiling.
+	# In the process we must examine the off-diagonal elements of the
+	# matrix to verify that the system does not include any dependencies
+	# upon axes other than those included in the transformation we are
+	# compiling.  (This restriction prohibits dimensional reduction via
+	# an image section which results in loss of a rotated axis).
+
+	do i = 1, naxes {
+	    # Get matrix line pointers for axis[i].
+	    ip = t_ltm + (axis[i]-1) * pdim
+	    op = ltm + (i-1) * naxes
+
+	    do j = 1, pdim {
+		# Is column J used by transform?
+		for (k=1;  k <= naxes;  k=k+1)
+		    if (axis[k] == j)
+			break
+
+		# If column J is not used in the transform but is not zero,
+		# then transform I is dependent upon physical axis J and
+		# we cannot do the transform.  If column J is used in the
+		# transform, copy the value to the final output matrix LTM
+		# discarding unused columns as we go.
+
+		if (k > naxes) {
+		    # Check for dependency on axis outside transform.
+		    if (abs(Memd[ip+j-1]) > EPSILOND*100.0D0)
+			call syserr (SYS_MWROTDEP)
+		} else {
+		    # Add matrix element to final LTM.
+		    Memd[op+k-1] = Memd[ip+j-1]
+		}
+	    }
+
+	    # Copy the LTV vector element.
+	    Memd[ltv+i-1] = Memd[t_ltv+axis[i]-1]
+	}
+
+	# Determine the transformation type.  This is LNR for a purely
+	# linear transformation with no rotational (off-diagonal) terms,
+	# LRO for a purely linear transform with rotational terms, and
+	# GEN for everything else.
+
+	if (CT_NCALLI(ct) > 0 || CT_NCALLO(ct) > 0)
+	    CT_TYPE(ct) = GEN
+	else {
+	    CT_TYPE(ct) = LNR
+	    do j = 1, naxes
+		do i = 1, naxes
+		    if (i != j) {
+			lp = ltm + (j-1)*naxes + i-1
+			if (abs(Memd[lp]) > EPSILOND*100.0D0) {
+			    CT_TYPE(ct) = LRO
+			    break
+			}
+		    }
+	}
+
+	# Prepare the single precision part of the transform.
+	call amovi (Memi[CT_D(ct)], Memi[CT_R(ct)], ctlen)
+
+	ct_r = CT_R(ct)
+	CT_LTM(ct_r) = coerce (ct_r + LEN_CTBASE, TY_STRUCT, TY_REAL)
+	CT_LTV(ct_r) = CT_LTM(ct_r) + matlen
+	call achtdr (Memd[CT_LTM(ct)], Memr[CT_LTM(ct_r)], matlen)
+	call achtdr (Memd[CT_LTV(ct)], Memr[CT_LTV(ct_r)], naxes)
+
+	call sfree (sp)
+	return (ct)
+end
diff --git a/sys/mwcs/mwsdefwcs.x b/sys/mwcs/mwsdefwcs.x
new file mode 100644
index 00000000..2cddc6ac
--- /dev/null
+++ b/sys/mwcs/mwsdefwcs.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mwset.h>
+include	"mwcs.h"
+
+# MW_SDEFWCS -- Set the default WCS.  This is the WCS indicated by the user
+# environment variable "setwcs", if defined and the named WCS exists, else
+# the first world system is used, else the physical system is used.
+
+procedure mw_sdefwcs (mw)
+
+pointer	mw			#I pointer to MWCS descriptor
+
+pointer	sp, defwcs
+int	envfind()
+
+begin
+	call smark (sp)
+	call salloc (defwcs, SZ_FNAME, TY_CHAR)
+
+	MI_WCS(mw) = NULL
+
+	# Set the default WCS defined in the user environment, if defined
+	# and the named WCS exists in this MWCS.
+
+	if (envfind ("defwcs", Memc[defwcs], SZ_FNAME) > 0)
+	    iferr (call mw_ssystem (mw, Memc[defwcs]))
+		;
+
+	# Otherwise, the default WCS is the first world system, if any,
+	# else it is the physical system.  The first world system is WCS 3
+	# as the physical and logical systems are systems 1 and 2 and are
+	# always defined in any MWCS.
+
+	if (MI_WCS(mw) == NULL) {
+	    if (MI_NWCS(mw) >= 3)
+		MI_WCS(mw) = MI_WCSP(mw,3)
+	    else
+		call mw_ssystem (mw, "physical")
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwseti.x b/sys/mwcs/mwseti.x
new file mode 100644
index 00000000..ac1a4baa
--- /dev/null
+++ b/sys/mwcs/mwseti.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mwset.h>
+include	"mwcs.h"
+
+# MW_SETI -- Set the value of a MWCS interface parameter.
+
+procedure mw_seti (mw, param, value)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	param			#I parameter code as defined in <mwset.h>
+int	value			#I new value for parameter
+
+begin
+	switch (param) {
+	case MW_NWCS:
+	    MI_NWCS(mw) = max (2, value)
+	case MW_REFIM:
+	    MI_REFIM(mw) = value
+	case MW_USEAXMAP:
+	    MI_USEAXMAP(mw) = value
+	default:
+	    call syserr (SYS_MWSET)
+	}
+end
diff --git a/sys/mwcs/mwshift.x b/sys/mwcs/mwshift.x
new file mode 100644
index 00000000..d863f813
--- /dev/null
+++ b/sys/mwcs/mwshift.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_SHIFT -- Front end to mw_translate, used to perform a simple shift
+# of the logical system.
+
+procedure mw_shift (mw, shift, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	shift[ARB]		#I shift for each axis in axbits
+int	axbits			#I bitflags defining axes
+
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, pdim, nelem, axmap, i
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes <= 0)
+	    return
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Enter the axis shifts.
+	do i = 1, naxes
+	    Memd[ltv_2+axis[i]-1] = shift[i]
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwshow.x b/sys/mwcs/mwshow.x
new file mode 100644
index 00000000..1fbb991c
--- /dev/null
+++ b/sys/mwcs/mwshow.x
@@ -0,0 +1,152 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+include	"mwcs.h"
+
+# MW_SHOW -- Print information about a MWCS object to a file.
+
+procedure mw_show (mw, fd, what)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	fd			#I output file
+int	what			#I type of output (not used at present)
+
+pointer	wp
+int	ndim, nwcs, wcs, i, j
+bool	itob()
+
+begin
+	ndim = MI_NDIM(mw)
+	nwcs = MI_NWCS(mw)
+
+	call fprintf (fd,
+	    "MWCS=%x, ndim=%d, nwcs=%d, curwcs=%d(%s), refim=%s\n")
+	    call pargi (mw)
+	    call pargi (ndim)
+	    call pargi (nwcs)
+
+	    wcs = INDEFI
+	    do i = 1, MI_NWCS(mw)
+		if (MI_WCS(mw) == MI_WCSP(mw,i)) {
+		    wcs = i
+		    break
+		}
+	    call pargi (wcs)
+	    if (MI_WCS(mw) != NULL) {
+		wp = MI_WCS(mw)
+		if (WCS_SYSTEM(wp) != NULL)
+		    call pargstr (S(mw,WCS_SYSTEM(wp)))
+		else
+		    call pargstr ("noname")
+	    }
+
+	    if (MI_REFIM(mw) != NULL)
+		call pargstr (IM_NAME(MI_REFIM(mw)))
+	    else
+		call pargstr ("none")
+
+	call fprintf (fd, "sbuflen=%d, sbufused=%d, dbuflen=%d, dbufused=%d\n")
+	    call pargi (MI_SBUFLEN(mw))
+	    call pargi (MI_SBUFUSED(mw))
+	    call pargi (MI_DBUFLEN(mw))
+	    call pargi (MI_DBUFUSED(mw))
+
+	# Print the axis map.
+	call fprintf (fd, "useaxmap=%b, nlogdim=%d")
+	    call pargb (itob(MI_USEAXMAP(mw)))
+	    call pargi (MI_NLOGDIM(mw))
+	    call fprintf (fd, " axno=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_AXNO(mw,i))
+		}
+	    call fprintf (fd, "] axval=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_AXVAL(mw,i))
+		}
+	    call fprintf (fd, "] physax=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_PHYSAX(mw,i))
+		}
+	    call fprintf (fd, "]\n")
+
+	# Print the LTERM.
+	call fprintf (fd, "ltv = [")
+	    do i = 1, ndim {
+		if (i > 1)
+		    call fprintf (fd, " ")
+		call fprintf (fd, "%g")
+		    call pargd (D(mw,MI_LTV(mw)+i-1))
+	    }
+	    call fprintf (fd, "]\n")
+
+	call fprintf (fd, "ltm = [")
+	    do j = 1, ndim {
+		if (j > 1)
+		    call fprintf (fd, "; ")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,MI_LTM(mw)+(j-1)*ndim+i-1))
+		}
+	    }
+	    call fprintf (fd, "]\n")
+
+	# Print the world systems.
+	do wcs = 1, nwcs {
+	    wp = MI_WCSP(mw,wcs)
+	    ndim = WCS_NDIM(wp)
+
+	    call fprintf (fd,
+		"WCS %d, ndim=%d, name=%s, nwattr=%d, nfunc=%d\n")
+		call pargi (wcs)
+		call pargi (ndim)
+		if (WCS_SYSTEM(wp) != NULL)
+		    call pargstr (S(mw,WCS_SYSTEM(wp)))
+		else
+		    call pargstr ("noname")
+		call pargi (WCS_NWATTR(wp))
+		call pargi (WCS_NFUNC(wp))
+
+	    call fprintf (fd, "R = [")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,WCS_R(wp)+i-1))
+		}
+		call fprintf (fd, "]\n")
+
+	    call fprintf (fd, "W = [")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,WCS_W(wp)+i-1))
+		}
+		call fprintf (fd, "]\n")
+
+	    call fprintf (fd, "CD = [")
+		do j = 1, ndim {
+		    if (j > 1)
+			call fprintf (fd, "; ")
+		    do i = 1, ndim {
+			if (i > 1)
+			    call fprintf (fd, " ")
+			call fprintf (fd, "%g")
+			    call pargd (D(mw,WCS_CD(wp)+(j-1)*ndim+i-1))
+		    }
+		}
+		call fprintf (fd, "]\n")
+	}
+
+end
diff --git a/sys/mwcs/mwsltermd.x b/sys/mwcs/mwsltermd.x
new file mode 100644
index 00000000..f5619fd7
--- /dev/null
+++ b/sys/mwcs/mwsltermd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SLTERMD -- Set the Lterm, double precision version.  Since all floating
+# data is stored as double internally, we merely copy the data in.
+
+procedure mw_sltermd (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltm[ndim,ndim]		#I linear transformation matrix
+double	ltv[ndim]		#I translation vector
+int	ndim			#I dimensionality of system
+
+pointer	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_sltermd")
+
+	# Copy in the data.  Cobber the old data if the Lterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (MI_LTM(mw) == NULL)
+	    MI_LTM(mw) = mw_allocd (mw, ndim*ndim)
+	call amovd (ltm, D(mw,MI_LTM(mw)), ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    MI_LTV(mw) = mw_allocd (mw, ndim)
+	call amovd (ltv, D(mw,MI_LTV(mw)), ndim)
+end
diff --git a/sys/mwcs/mwsltermr.x b/sys/mwcs/mwsltermr.x
new file mode 100644
index 00000000..975221f6
--- /dev/null
+++ b/sys/mwcs/mwsltermr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SLTERMR -- Set the Lterm, single precision version.  Since all floating
+# data is stored as double internally, a real->double conversion is involved,
+# but no precision is lost provided single precision is adequate to describe
+# the input data (an example of a case where precision is lost is a rotation,
+# where there is a difference between the single and double precision version
+# of, e.g., "sin(theta)").
+
+procedure mw_sltermr (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltm[ndim,ndim]		#I linear transformation matrix
+real	ltv[ndim]		#I translation vector
+int	ndim			#I dimensionality of system
+
+int	nelem
+pointer	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_sltermr")
+
+	# Copy in the data.  Cobber the old data if the Lterm has been set,
+	# otherwise allocate space in the global data area.
+
+	nelem = ndim * ndim
+	if (MI_LTM(mw) == NULL)
+	    MI_LTM(mw) = mw_allocd (mw, nelem)
+	call achtrd (ltm, D(mw,MI_LTM(mw)), nelem)
+
+	if (MI_LTV(mw) == NULL)
+	    MI_LTV(mw) = mw_allocd (mw, ndim)
+	call achtrd (ltv, D(mw,MI_LTV(mw)), ndim)
+end
diff --git a/sys/mwcs/mwssys.x b/sys/mwcs/mwssys.x
new file mode 100644
index 00000000..ec1558eb
--- /dev/null
+++ b/sys/mwcs/mwssys.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SSYSTEM -- Make the named world coordinate system the default.
+
+procedure mw_ssystem (mw, system)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system name
+
+pointer	wp
+bool	streq()
+pointer	mw_findsys()
+errchk	mw_findsys
+
+begin
+	if (streq (system, "world"))
+	    call mw_sdefwcs (mw)		# set default world system
+	else {
+	    wp = mw_findsys (mw, system)
+	    if (wp != NULL)
+		MI_WCS(mw) = wp
+	    else
+		call syserrs (SYS_MWWCSNF, system)
+	}
+end
diff --git a/sys/mwcs/mwstati.x b/sys/mwcs/mwstati.x
new file mode 100644
index 00000000..03e80587
--- /dev/null
+++ b/sys/mwcs/mwstati.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mwset.h>
+include	<mach.h>
+include	"mwcs.h"
+
+# MW_STATI -- Get the value of a MWCS interface parameter.
+
+int procedure mw_stati (mw, param)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	param			#I parameter code as defined in <mwset.h>
+
+begin
+	switch (param) {
+	case MW_NDIM:
+	    if (MI_USEAXMAP(mw) == NO)
+		return (MI_NDIM(mw))
+	    else
+		return (MI_NLOGDIM(mw))
+	case MW_NWCS:
+	    return (MI_NWCS(mw))
+	case MW_REFIM:
+	    return (MI_REFIM(mw))
+	case MW_USEAXMAP:
+	    return (MI_USEAXMAP(mw))
+	case MW_NPHYSDIM:
+	    return (MI_NDIM(mw))
+	case MW_SAVELEN:
+	    return (MI_LEN(mw) * SZ_STRUCT + MI_DBUFUSED(mw) * SZ_DOUBLE +
+		(MI_SBUFUSED(mw) + SZB_CHAR-1) / SZB_CHAR)
+	default:
+	    call syserr (SYS_MWSTAT)
+	}
+end
diff --git a/sys/mwcs/mwsv.h b/sys/mwcs/mwsv.h
new file mode 100644
index 00000000..e08a6069
--- /dev/null
+++ b/sys/mwcs/mwsv.h
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MWSV.H -- Definitions for the MWSV external save-MWSV data format.  This
+# has been generalized slightly over the original "version 0" design, but is
+# still not very general and should be redone at some point.  There is an
+# implicit assumption that most of the elements of the MWSV structure are
+# identical to those in the MWCS runtime descriptor.
+
+define	MWSV_MAGIC	4D57X			# identifies MWSV descriptor
+define	MWSV_VERSION	1			# current MWSV version
+define	MWSV_MAXWCS	8			# max wcs per mwcs
+define	MWSV_LENWCS0	282			# LENWCS for MWSV version 0
+
+# Header for the saved MWCS object.  Object LENs are in the natural units of
+# whatever object the field refers to.  Save buffer offsets are type char
+# regardless of the object type.  The unused fields at the end of the header
+# are reserved for future use and are set to zero in the current version.
+
+define	LEN_SVHDR	16
+define	SV_MAGIC	Memi[$1]		# magic marker
+define	SV_CWCSLEN	Memi[$1+1]		# length of compressed MWSV
+define	SV_MWSVLEN	Memi[$1+2]		# full length of MWSV descr.
+define	SV_MWSVOFF	Memi[$1+3]		# char offset of saved MWSV
+define	SV_DBUFLEN	Memi[$1+4]		# length of saved DBUF
+define	SV_DBUFOFF	Memi[$1+5]		# char offset of saved DBUF
+define	SV_SBUFLEN	Memi[$1+6]		# length of saved SBUF
+define	SV_SBUFOFF	Memi[$1+7]		# char offset of saved SBUF
+define	SV_VERSION	Memi[$1+8]		# MWSV save file version number
+define	SV_NWCS		Memi[$1+9]		# number of saved WCS structs
+define	SV_LENWCS	Memi[$1+10]		# length of WCS substruct
+
+# MWSV descriptor.  This is very similar to the MWCS runtime descriptor
+# except that the size of a WCS sub-structure (LENWCS) can vary.  If the
+# MWSV version is 0 lenwcs is fixed at MS_LENWCS0, otherwise the value of
+# lenwcs is given in the save header as the value of field SV_LENWCS.
+
+define	MWSV_BASELEN	70
+define	LEN_MWSV	(MWSV_BASELEN+($1)*($2))
+
+define	MS_MAGIC	Memi[$1]		# magic marker
+define	MS_WCSP		($1+70+(($2)-1)*($3))	# $1=ms $2=wcs $3=lenwcs
diff --git a/sys/mwcs/mwswattrs.x b/sys/mwcs/mwswattrs.x
new file mode 100644
index 00000000..14fc72bd
--- /dev/null
+++ b/sys/mwcs/mwswattrs.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWATTRS -- Set the string value of the named WCS attribute for axis N.
+# The attribute is created if not already defined.  If axis N=0 is specified,
+# the attribute pertains to the entire WCS, not just one axis.
+
+procedure mw_swattrs (mw, axis, attribute, valstr)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis to which attribute belongs
+char	attribute[ARB]		#I attribute name
+char	valstr[ARB]		#I attribute value
+
+pointer	wp, ap
+int	atno, i
+bool	streq()
+int	mw_refstr()
+errchk	syserrs, mw_refstr
+
+begin
+	# Get current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swattrs")
+
+	# Lookup the named attribute and replace the pointer to the value
+	# string if found.  Otherwise, add a new attribute.
+
+	atno = 0
+	do i = 1, WCS_NWATTR(wp) {
+	    ap = WCS_WATTR(wp,i)
+	    if (AT_AXIS(ap) == axis)
+		if (streq (S(mw,AT_NAME(ap)), attribute)) {
+		    atno = i
+		    break
+		}
+	}
+
+	# Add a new attribute?
+	if (atno == 0) {
+	    atno = WCS_NWATTR(wp) + 1
+	    if (atno > MAX_WATTR)
+		call syserrs (SYS_MWATOVFL, attribute)
+	    else {
+		WCS_NWATTR(wp) = atno
+		ap = WCS_WATTR(wp,atno)
+		AT_AXIS(ap) = axis
+		AT_NAME(ap) = mw_refstr (mw, attribute)
+	    }
+	}
+
+	# Store the value string.
+	AT_VALUE(ap) = mw_refstr (mw, valstr)
+end
diff --git a/sys/mwcs/mwswsampd.x b/sys/mwcs/mwswsampd.x
new file mode 100644
index 00000000..10d02068
--- /dev/null
+++ b/sys/mwcs/mwswsampd.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWSAMPD -- Set the sampled WCS curve for an axis.
+
+procedure mw_swsampd (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+double	pv[ARB]			#I physical coordinates of points
+double	wv[ARB]			#I world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+int	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swsampd")
+
+	# Overwrite the current curve, if any, else allocate new storage.
+	if (WCS_PV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_PV(wp,axis) = mw_allocd (mw, npts)
+	call amovd (pv, D(mw,WCS_PV(wp,axis)), npts)
+
+	if (WCS_WV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_WV(wp,axis) = mw_allocd (mw, npts)
+	call amovd (wv, D(mw,WCS_WV(wp,axis)), npts)
+
+	WCS_NPTS(wp,axis) = npts
+end
diff --git a/sys/mwcs/mwswsampr.x b/sys/mwcs/mwswsampr.x
new file mode 100644
index 00000000..3fcf3f70
--- /dev/null
+++ b/sys/mwcs/mwswsampr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWSAMPR -- Set the sampled WCS curve for an axis.
+
+procedure mw_swsampr (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+real	pv[ARB]			#I physical coordinates of points
+real	wv[ARB]			#I world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+int	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swsampr")
+
+	# Overwrite the current curve, if any, else allocate new storage.
+	if (WCS_PV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_PV(wp,axis) = mw_allocd (mw, npts)
+	call achtrd (pv, D(mw,WCS_PV(wp,axis)), npts)
+
+	if (WCS_WV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_WV(wp,axis) = mw_allocd (mw, npts)
+	call achtrd (wv, D(mw,WCS_WV(wp,axis)), npts)
+
+	WCS_NPTS(wp,axis) = npts
+end
diff --git a/sys/mwcs/mwswtermd.x b/sys/mwcs/mwswtermd.x
new file mode 100644
index 00000000..0e392dc4
--- /dev/null
+++ b/sys/mwcs/mwswtermd.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWTERMD -- Set the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is affected.
+
+procedure mw_swtermd (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	r[ndim]			#I physical coordinates of reference point
+double	w[ndim]			#I world coordinates of reference point
+double	cd[ndim,ndim]		#I CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+pointer	mw_allocd()
+errchk	mw_allocd, syserrs
+string	s_name "mw_swtermd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy in the data.  Cobber the old data if the Wterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (WCS_R(wp) == NULL)
+	    WCS_R(wp) = mw_allocd (mw, ndim)
+	call amovd (r, D(mw,WCS_R(wp)), ndim)
+
+	if (WCS_W(wp) == NULL)
+	    WCS_W(wp) = mw_allocd (mw, ndim)
+	call amovd (w, D(mw,WCS_W(wp)), ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    WCS_CD(wp) = mw_allocd (mw, ndim*ndim)
+	call amovd (cd, D(mw,WCS_CD(wp)), ndim*ndim)
+end
diff --git a/sys/mwcs/mwswtermr.x b/sys/mwcs/mwswtermr.x
new file mode 100644
index 00000000..0f52419c
--- /dev/null
+++ b/sys/mwcs/mwswtermr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWTERMR -- Set the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is affected.
+
+procedure mw_swtermr (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	r[ndim]			#I physical coordinates of reference point
+real	w[ndim]			#I world coordinates of reference point
+real	cd[ndim,ndim]		#I CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+int	nelem
+pointer	mw_allocd()
+errchk	mw_allocd, syserrs
+string	s_name "mw_swtermr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy in the data.  Cobber the old data if the Wterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (WCS_R(wp) == NULL)
+	    WCS_R(wp) = mw_allocd (mw, ndim)
+	call achtrd (r, D(mw,WCS_R(wp)), ndim)
+
+	if (WCS_W(wp) == NULL)
+	    WCS_W(wp) = mw_allocd (mw, ndim)
+	call achtrd (w, D(mw,WCS_W(wp)), ndim)
+
+	nelem = ndim * ndim
+	if (WCS_CD(wp) == NULL)
+	    WCS_CD(wp) = mw_allocd (mw, nelem)
+	call achtrd (cd, D(mw,WCS_CD(wp)), nelem)
+end
diff --git a/sys/mwcs/mwswtype.x b/sys/mwcs/mwswtype.x
new file mode 100644
index 00000000..13ab5938
--- /dev/null
+++ b/sys/mwcs/mwswtype.x
@@ -0,0 +1,131 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"mwcs.h"
+
+# MW_SWTYPE -- Set the coordinate (WCS function) type and any related
+# attributes for an axis, or set of related axes, of a WCS.  Each call
+# defines a group of one or more axes which share the same WCS function
+# and which are dependent, i.e., all axes are required to evaluate the
+# coordinate of any axis in the group.  Independent axes or groups of
+# axes should be defined in separate calls.
+#
+# Although the attributes for each axis in the group are all entered in
+# a single call via the WATTR string, each attribute is still assigned
+# to a single axis.  The syntax is as follows:
+#
+#	axis 1: format="...", label="..."
+#	axis 2: ...(etc.)
+#
+# where the axis number is relative to the start of the group.
+# The WATTR string may be any length and may contain multiple lines of text.
+# A typical use of attributes is to define WCS specific parameters; these
+# may be read by the initialization routine in the WCS function driver,
+# called when a coordinate transformation is compiled.
+
+procedure mw_swtype (mw, axis, naxes, wtype, wattr)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis[naxes]		#I axis number, 1:ndim
+int	naxes			#I number of axes in function group
+char	wtype[ARB]		#I axis coordinate type
+char	wattr[ARB]		#I axis attributes, "attr=value, ..."
+
+pointer	sp, atname, valstr, wp, op, wf
+int	ip, ch, fn, wfno, ax, sz_valstr, i
+int	ctowrd(), mw_flookup(), ctoi(), strlen()
+errchk	syserrs, mw_swattrs, mw_flookup
+bool	streq()
+
+begin
+	call smark (sp)
+	sz_valstr = strlen (wattr)
+	call salloc (valstr, sz_valstr, TY_CHAR)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swtype")
+
+	# Set the function type?
+	if (wtype[1] != EOS) {
+	    # Determine the function type for this axis group.
+	    fn = mw_flookup (mw, wtype)
+	    if (fn == ERR)
+		call syserrs (SYS_MWUNKFN, wtype)
+
+	    # For anything except a simple linear relation, add a new function
+	    # descriptor to the WCS.
+
+	    if (fn != F_LINEAR) {
+		# Allocate new WCS function descriptor.
+		wfno = WCS_NFUNC(wp) + 1
+		if (wfno > MAX_FUNC)
+		    call syserrs (SYS_MWFUNCOVFL, wtype)
+		WCS_NFUNC(wp) = wfno
+
+		# Initialize the descriptor. 
+		wf = WCS_FUNC(wp,wfno)
+		WF_FN(wf) = fn
+		WF_NAXES(wf) = naxes
+		call amovi (axis, WF_AXIS(wf,1), naxes)
+	    } else
+		wfno = 0
+
+	    # Set the axis type and class.
+	    do i = 1, naxes {
+		call mw_swattrs (mw, axis[i], "wtype", wtype)
+		WCS_AXCLASS(wp,axis[i]) = wfno
+	    }
+	}
+
+	# Process the attributes into the WCS descriptor.
+	ax = axis[1]
+	for (ip=1;  wattr[ip] != EOS;  ) {
+	    # Skip to next token.
+	    ch = wattr[ip]
+	    while (IS_WHITE(ch) || ch == ',' || ch == '\n' || ch == ':') {
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+
+	    # Done?
+	    if (ch == EOS)
+		break
+
+	    # Extract attribute name string.
+	    op = atname
+	    ch = wattr[ip]
+	    while (IS_ALNUM(ch) || ch == '_' || ch == '$') {
+		Memc[op] = ch
+		op = min (atname+SZ_ATNAME, op + 1)
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+	    Memc[op] = EOS
+
+	    # Check for "axis N:" and set AX if encountered.
+	    if (streq (Memc[atname], "axis"))
+		if (ctoi (wattr, ip, i) > 0) {
+		    ax = axis[i]
+		    next
+		}
+
+	    # Skip to value string.
+	    ch = wattr[ip]
+	    while (IS_WHITE(ch) || ch == '=' || ch == '\n') {
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+
+	    # Extract value string.
+	    ch = ctowrd (wattr, ip, Memc[valstr], sz_valstr)
+
+	    # Add the attribute to the WCS.
+	    call mw_swattrs (mw, ax, Memc[atname], Memc[valstr])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwtransd.x b/sys/mwcs/mwtransd.x
new file mode 100644
index 00000000..267317ce
--- /dev/null
+++ b/sys/mwcs/mwtransd.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_TRANSLATE -- Translate the logical system, i.e., perform a linear
+# transformation of the logical system by modifying the Lterm of the MWCS.
+# The transformation is defined in terms of the CURRENT LOGICAL SYSTEM,
+# subject to axis mapping, dimensional reduction, etc.  This is unlike
+# MW_SLTERM, which defines the Lterm relative to the physical system in
+# physical terms (no axis mapping, full dimensionality, etc.).
+#
+#	p' = ltm * (p - ltv_1) + ltv_2
+#	
+# For convenience the transformation is specified using separate translation
+# vectors for the input and output systems.  If ltv_1 is set to zero a
+# "fully reduced" transformation of the form used internally may be entered.
+
+procedure mw_translated (mw, ltv_1, ltm, ltv_2, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltv_1[ndim]		#I input translation vector
+double	ltm[ndim,ndim]		#I linear transformation matrix
+double	ltv_2[ndim]		#I output translation vector
+int	ndim			#I dimensionality of transform
+
+double	v
+pointer	sp, o_ltm, o_ltv, n_ltm, n_ltv, ltv
+int	pdim, nelem, axis[MAX_DIM], i, j
+errchk	syserrs
+define	err_ 91
+
+begin
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+
+	call smark (sp)
+	call salloc (ltv, ndim, TY_DOUBLE)
+	call salloc (o_ltm, nelem, TY_DOUBLE)
+	call salloc (o_ltv, pdim, TY_DOUBLE)
+	call salloc (n_ltm, nelem, TY_DOUBLE)
+	call salloc (n_ltv, pdim, TY_DOUBLE)
+
+	# Combine the input and output translation vectors.
+	do j = 1, ndim {
+	    v = ltv_2[j]
+	    do i = 1, ndim
+		v = v + ltm[i,j] * (-ltv_1[i])
+	    Memd[ltv+j-1] = v
+	}
+
+	# Get axis map.
+	if (MI_USEAXMAP(mw) == NO) {
+	    if (ndim > MI_NDIM(mw))
+		goto err_
+	    do i = 1, ndim
+		axis[i] = i
+	} else {
+	    if (ndim > MI_NLOGDIM(mw))
+err_		call syserrs (SYS_MWNDIM, "mw_translate")
+	    do i = 1, ndim
+		axis[i] = MI_PHYSAX(mw,i)
+	}
+
+	# Perform the transformation.  Use a procedure call to dereference
+	# the pointers to simplify the notation.
+
+	call mw_axtran (D(mw,MI_LTM(mw)), D(mw,MI_LTV(mw)),
+	    Memd[n_ltm], Memd[n_ltv], pdim, ltm, Memd[ltv], axis, ndim)
+
+	# Update the Lterm.
+	call amovd (Memd[n_ltm], D(mw,MI_LTM(mw)), nelem)
+	call amovd (Memd[n_ltv], D(mw,MI_LTV(mw)), pdim)
+
+	call sfree (sp)
+end
+
+
+# MW_AXTRAN -- Axis mapped linear transformation.  Matrix or vector elements
+# not included in the axis map are propagated unchanged.
+
+procedure mw_axtran (o_ltm,o_ltv, n_ltm,n_ltv, pdim, ltm,ltv, ax, ndim)
+
+double	o_ltm[pdim,pdim]	#I matrix to be transformed
+double	o_ltv[pdim]		#I vector to be transformed
+double	n_ltm[pdim,pdim]	#O transformed matrix
+double	n_ltv[pdim]		#O transformed vector
+int	pdim			#I dimension of these guys
+double	ltm[ndim,ndim]		#I transform matrix
+double	ltv[ndim]		#I transform vector
+int	ax[ndim]		#I transform axis map: physax=axis[logax]
+int	ndim			#I dimension of these guys
+
+double	v
+int	i, j, k
+
+begin
+	# Transform the matrix.
+	call amovd (o_ltm, n_ltm, pdim * pdim)
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    # v = v + o_ltm[ax[k],ax[j]] * ltm[i,k]
+		    v = v + ltm[k,j] * o_ltm[ax[i],ax[k]]
+		n_ltm[ax[i],ax[j]] = v
+	    }
+
+	# Transform the vector.	    
+	call amovd (o_ltv, n_ltv, pdim)
+	do j = 1, ndim {
+	    v = ltv[j]
+	    do i = 1, ndim
+		v = v + ltm[i,j] * o_ltv[ax[i]]
+	    n_ltv[ax[j]] = v
+	}
+end
diff --git a/sys/mwcs/mwtransr.x b/sys/mwcs/mwtransr.x
new file mode 100644
index 00000000..3947e3d1
--- /dev/null
+++ b/sys/mwcs/mwtransr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_TRANSLATE -- Translate the logical system, i.e., perform a linear
+# transformation of the logical system by modifying the Lterm of the MWCS.
+
+procedure mw_translater (mw, ltv_1, ltm, ltv_2, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltv_1[ndim]		#I input translation vector
+real	ltm[ndim,ndim]		#I linear transformation matrix
+real	ltv_2[ndim]		#I output translation vector
+int	ndim			#I dimensionality of transform
+
+int	nelem
+pointer	sp, d_ltm, d_ltv1, d_ltv2
+
+begin
+	call smark (sp)
+	nelem = ndim * ndim
+	call salloc (d_ltm, nelem, TY_DOUBLE)
+	call salloc (d_ltv1, ndim, TY_DOUBLE)
+	call salloc (d_ltv2, ndim, TY_DOUBLE)
+
+	call achtrd (ltm, Memd[d_ltm], nelem)
+	call achtrd (ltv_1, Memd[d_ltv1], ndim)
+	call achtrd (ltv_2, Memd[d_ltv2], ndim)
+
+	call mw_translated (mw, Memd[d_ltv1], Memd[d_ltm], Memd[d_ltv2], ndim)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwv1tran.gx b/sys/mwcs/mwv1tran.gx
new file mode 100644
index 00000000..170d8239
--- /dev/null
+++ b/sys/mwcs/mwv1tran.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1tran$t (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1[ARB]			#I coordinates in input system
+PIXEL	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+PIXEL	scale, offset
+errchk	mw_ctran$t
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	scale  = Mem$t[CT_LTM(ct)]
+	offset = Mem$t[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctran$t (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/mwv2tran.gx b/sys/mwcs/mwv2tran.gx
new file mode 100644
index 00000000..6fd701f7
--- /dev/null
+++ b/sys/mwcs/mwv2tran.gx
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2tran$t (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1[ARB],y1[ARB]		#I coordinates in input system
+PIXEL	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+PIXEL	p1[2], p2[2]
+errchk	mw_ctran$t
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Mem$t[ltm  ] * x1[i] + Mem$t[ltv  ]
+		y2[i] = Mem$t[ltm+3] * y1[i] + Mem$t[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Mem$t[ltm  ] * p1[1] + Mem$t[ltm+1] * p2[1] +
+		    Mem$t[ltv  ]
+		y2[i] = Mem$t[ltm+2] * p1[1] + Mem$t[ltm+3] * p2[1] +
+		    Mem$t[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctran$t (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/mwvmul.gx b/sys/mwcs/mwvmul.gx
new file mode 100644
index 00000000..1c5f4867
--- /dev/null
+++ b/sys/mwcs/mwvmul.gx
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmul$t (a, b, c, ndim)
+
+PIXEL	a[ndim,ndim]		#I input matrix
+PIXEL	b[ndim]			#I input vector
+PIXEL	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+PIXEL	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/mwvtran.gx b/sys/mwcs/mwvtran.gx
new file mode 100644
index 00000000..ddd59cb7
--- /dev/null
+++ b/sys/mwcs/mwvtran.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtran$t (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+PIXEL	v1[ndim,npts]		#I points to be transformed
+PIXEL	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctran$t
+
+begin
+	do i = 1, npts
+	    call mw_ctran$t (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/wfait.x b/sys/mwcs/wfait.x
new file mode 100644
index 00000000..481ba7a1
--- /dev/null
+++ b/sys/mwcs/wfait.x
@@ -0,0 +1,463 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFAIT
+.nf -------------------------------------------------------------------------
+WFAIT -- WCS function driver for the Hammer-Aitoff projection.
+
+Driver routines:
+
+	FN_INIT		    wf_ait_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_ait_fwd (fc, v1, v2)
+	FN_INV		     wf_ait_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # 2 * RO * RO
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # 1 / (4 * RO * RO) (degs)
+define	FC_C3		Memd[P2D($1+FCU+20)]	     # 1 / (16 * RO * RO) (degs)
+define	FC_C4		Memd[P2D($1+FCU+22)]	     # 1 / (2 * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+24)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+26)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_AIT_INIT -- Initialize the forward or inverse Hammer-Aitoff transform.
+# Initialization for this transformation consists of, determining which axis
+# is RA / LON and which is DEC / LAT, reading in the native longitude and
+# latitude of the pole in celestial coordinates LONGPOLE and LATPOLE from the
+# attribute list, computing the celestial longitude and colatitude of the
+# native pole, precomputing the Euler angles and associated intermediary
+# functions of the reference point, reading in the projection parameter RO
+# from the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude of the reference point is less than 0, otherwise
+# 0 degrees is assumed. If LATPOLE is undefined, the more northerly of the
+# two possible solutions is assumed, otherwise the solution closest to 
+# LATPOLE is assumed. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the "axtype={ra|dec} {xlon|ylat}"
+# must have been set in the attribute list for the function. The LONGPOLE,
+# LATPOLE, and RO parameters may be set in either or both of the axes attribute
+# lists, but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_ait_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_AIT_INIT: Invalid projection parameters")
+
+	FC_C1(fc) = 2.0d0 * FC_RODEG(fc) * FC_RODEG(fc)
+	FC_C2(fc) = 1.0d0 / (2.0d0 * FC_C1(fc))
+	FC_C3(fc) = FC_C2(fc) / 4.0d0
+	FC_C4(fc) = 1.0d0 / (2.0d0 * FC_RODEG(fc))
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_AIT_FWD -- Forward transform (physical to world) for the Hammer-Aitoff
+# projection.
+
+procedure wf_ait_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, u, z, s, xp, yp, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	u = 1.0d0 - x * x * FC_C3(fc) - y * y * FC_C2(fc)
+	if (u < 0.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	z = sqrt (u)
+	s = z * y / FC_RODEG(fc)
+	if (s < -1.0d0 || s > 1.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	xp = 2.0d0 * z * z - 1.0d0
+	yp = z * x * FC_C4(fc)
+	if (xp == 0.0d0 && yp == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = 2.0d0 * atan2 (yp, xp)
+
+	# Compute THETA.
+	theta = asin (s)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+       if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG (FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_AIT_INV -- Inverse transform (world to physical) for the Hammer-Aitoff
+# projection.
+
+procedure wf_ait_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, costhe, wconst
+double	dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	wconst = sqrt (FC_C1(fc) / (1.0d0 + costhe * cos (phi / 2.0d0)))
+	p[ira] = 2.0d0 * wconst * costhe * sin (phi / 2.0d0)
+	p[idec] = wconst * sin (theta)
+end
diff --git a/sys/mwcs/wfarc.x b/sys/mwcs/wfarc.x
new file mode 100644
index 00000000..46b072b6
--- /dev/null
+++ b/sys/mwcs/wfarc.x
@@ -0,0 +1,166 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFARC
+.nf -------------------------------------------------------------------------
+WFARC -- WCS function driver for the arc projection.
+
+Driver routines:
+
+	FN_INIT		    wf_arc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_arc_fwd (fc, v1, v2)
+	FN_INV		     wf_arc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_ARC_INIT -- Initialize the arc forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+# NOTE:  This is identical to wf_tan_init.
+
+procedure wf_arc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_ARC_FWD -- Forward transform (physical to world), arc
+# projection.  Based on code from STScI, Hodge et al.
+
+procedure wf_arc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	xi, eta, x, y, z, ra, dec
+double	theta		# distance (radians) from ref pixel to object
+double	v[3]		# unit vector with v[1] pointing toward ref pixel
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	theta = sqrt (xi*xi + eta*eta)
+	if (theta == 0.d0) {
+	    v[1] = 1.d0
+	    v[2] = 0.d0
+	    v[3] = 0.d0
+	} else {
+	    v[1] = cos (theta)
+	    v[2] = sin (theta) / theta * xi
+	    v[3] = sin (theta) / theta * eta
+	}
+
+	# Rotate the rectangular coordinate system of the vector v by the
+	# declination so the X axis will pass through the equator.
+
+	x = v[1] * FC_COSDEC(fc) - v[3] * FC_SINDEC(fc)
+	y = v[2]
+	z = v[1] * FC_SINDEC(fc) + v[3] * FC_COSDEC(fc)
+
+	if (x == 0.d0 && y == 0.d0)
+	    ra = 0.d0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0.d0)
+	    ra = ra + 360.D0
+	else if (ra > 360.D0)
+	    ra = ra - 360.D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ARC_INV -- Inverse transform (world to physical) for the arc
+# projection.  Based on code from Eric Greisen, AIPS Memo No. 27.
+
+procedure wf_arc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#O output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec
+double	theta		# distance (radians) from ref pixel to object
+double	r		# theta / sin (theta)
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	theta = acos (sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra)
+	if (theta == 0.d0)
+	    r = 1.d0
+	else
+	    r = theta / sin (theta)
+
+	xi = r * cosdec * sinra
+	eta = r * (sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra)
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
+
diff --git a/sys/mwcs/wfcar.x b/sys/mwcs/wfcar.x
new file mode 100644
index 00000000..a09281ac
--- /dev/null
+++ b/sys/mwcs/wfcar.x
@@ -0,0 +1,437 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFCAR
+.nf -------------------------------------------------------------------------
+WFCAR -- WCS function driver for the cylindrical cartesian projection.
+
+Driver routines:
+
+	FN_INIT		    wf_car_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_car_fwd (fc, v1, v2)
+	FN_INV		     wf_car_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]	     # LONGPOLE (rads)
+define	FC_COSDEC	Memd[P2D($1+FCU+8)]	     # cosine (NATDEC)
+define	FC_SINDEC	Memd[P2D($1+FCU+10)]	     # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1.0 / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_CAR_INIT -- Initialize the cylindical cartesian forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions derived from the reference point, and reading in the
+# projection parameter RO from the attribute list. If LONGPOLE is undefined
+# then a value of 180.0 degrees is assumed if the celestial latitude of the
+# reference point is less than 0, otherwise 0 is assumed. If LATPOLE is 
+# undefined than the most northerly of the two possible solutions for the
+# latitude of the native pole is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE, and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_car_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data	tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Determine the native longitude and latitude of the pole of the
+	# celestial coordinate system corresponding to the FITS keywords
+	# LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+	# to 180 or 0 depending on the value of the declination of the
+	# reference point. LATPOLE has no default but will be set depending
+	# on the values of LONGPOLE and the reference declination.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = INDEFD
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = INDEFD
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = INDEFD
+	}
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+	    if (IS_INDEFD(latpole))
+		latp = 999.0d0
+	    else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+		    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+	if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+	    if (FC_NATRA(fc) < 0.0d0)
+		FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+	} else {
+	    if (FC_NATRA(fc) > 0.0d0)
+		FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+	}
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_CAR_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_CAR_FWD -- Forward transform (physical to world) for the cartesian
+# projection.
+
+procedure wf_car_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	phi = FC_RECRODEG(fc) * x
+
+	# Compute THETA.
+	theta = FC_RECRODEG(fc) * y
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  DRADTODEG( FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+	if (FC_NATRA(fc) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_CAR_INV -- Inverse transform (world to physical) for the cartesian
+# projection.
+
+procedure wf_car_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, z, dphi
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	p[ira] = FC_RODEG(fc) * phi
+	p[idec] = FC_RODEG(fc) * theta
+end
diff --git a/sys/mwcs/wfcsc.x b/sys/mwcs/wfcsc.x
new file mode 100644
index 00000000..3dedc178
--- /dev/null
+++ b/sys/mwcs/wfcsc.x
@@ -0,0 +1,624 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFCSC
+.nf -------------------------------------------------------------------------
+WFCSC -- WCS function driver for the COBE quadrilateratized cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_csc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_csc_fwd (fc, v1, v2)
+	FN_INV		     wf_csc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) * RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_CSC_INIT -- Initialize the forward or inverse Cobe quadrilateralized
+# forward or inverse transform. Initialization for this transformation consists
+# of, determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, Euler angles and various intermediary
+# functions of the reference point reading in the projection parameter RO from
+# the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude is less than 0, otherwise 0 degrees is assumed.
+# If RO is undefined a value of 180.0 / PI is assumed. In order to determine
+# the axis order, the parameter "axtype={ra|dec} {xlon|ylat}" must have been
+# set in the attribute list for the function. The LONGPOLE, LATPOLE and RO
+# parameters may be set in either or both of the axes attribute lists, but the
+# value in the RA axis attribute list takes precedence. 
+
+procedure wf_csc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_CSC_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_CSC_FWD -- Forward transform (physical to world) for the COBE
+# quarilateralized spherical projection.
+
+procedure wf_csc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	ra, dec, dlng
+real	a, b, xf, xx, yf, yy
+real	p00, p01, p02, p03, p04, p05, p06, p10, p11, p12, p13, p14, p15, p20
+real	p21, p22, p23, p24, p30, p31, p32, p33, p40, p41, p42, p50, p51, p60
+data	p00/-.27292696/, p10/-.07629969/, p20/-.22797056/, p30/.54852384/
+data	p40/-.62930065/, p50/.25795794/, p60/.02584375/, p01/-.02819452/
+data	p11/-.01471565/, p21/.48051509/, p31/-1.74114454/, p41/1.71547508/
+data	p51/-.53022337/, p02/.27058160/, p12/-.56800938/, p22/.30803317/
+data	p32/.98938102/, p42/-.83180469/, p03/-.60441560/, p13/1.50880086/
+data	p23/-.93678576/, p33/.08693841/, p04/.93412077/, p14/-1.41601920/
+data	p24/.33887446/, p05/-.63915306/, p15/.52032238/, p06/.14381585/
+
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0) {
+	    face = 4
+	    xf = xf - 6.0
+	} else if (xf > 3.0) {
+	    face = 3
+	    xf = xf - 4.0
+	} else if (xf > 1.0) {
+	    face = 2
+	    xf = xf - 2.0
+	} else if (yf > 1.0) {
+	    face = 0
+	    yf = yf - 2.0
+	} else if (yf < -1.0) {
+	    face = 5
+	    yf = yf + 2.0
+	} else {
+	    face = 1
+	}
+
+	xx = xf * xf
+	yy = yf * yf
+	a =    (p00+xx*(p10+xx*(p20+xx*(p30+xx*(p40+xx*(p50+xx*(p60)))))) + 
+	    yy*(p01+xx*(p11+xx*(p21+xx*(p31+xx*(p41+xx*(p51))))) +
+	    yy*(p02+xx*(p12+xx*(p22+xx*(p32+xx*(p42)))) +
+	    yy*(p03+xx*(p13+xx*(p23+xx*(p33))) +
+	    yy*(p04+xx*(p14+xx*(p24)) +
+	    yy*(p05+xx*(p15) +
+	    yy*(p06)))))))
+	a = xf + xf * (1.0 - xx) * a
+	b =    (p00+yy*(p10+yy*(p20+yy*(p30+yy*(p40+yy*(p50+yy*(p60)))))) + 
+	    xx*(p01+yy*(p11+yy*(p21+yy*(p31+yy*(p41+yy*(p51))))) +
+	    xx*(p02+yy*(p12+yy*(p22+yy*(p32+yy*(p42)))) +
+	    xx*(p03+yy*(p13+yy*(p23+yy*(p33))) +
+	    xx*(p04+yy*(p14+yy*(p24)) +
+	    xx*(p05+yy*(p15) +
+	    xx*(p06)))))))
+	b = yf + yf * (1.0 - yy) * b
+
+	switch (face) {
+	case 0:
+	    n = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * n
+	    m = -b * n
+	case 1:
+	    m = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * m
+	    n = b * m
+	case 2:
+	    l = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    m = -a * l
+	    n = b * l
+	case 3:
+	    m = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * m
+	    n = -b * m
+	case 4:
+	    l = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    m = -a * l
+	    n = -b * l
+	case 5:
+	    n = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = -a * n
+	    m = -b * n
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_CSC_INV -- Inverse transform (world to physical) for the COBE
+# quadilateralized spherical projection.
+
+procedure wf_csc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+double	costhe, eta, l, m, n, rho, xi
+real	tol, a, a2, a2b2, a4, b, b2, b4, ca2, cb2, x0, xf, y0, yf
+real	c00, c10, c01, c11, c20, c02, d0, d1, mm, gamma, gstar, omega1
+data	gstar/1.37484847732/, mm/.004869491981/, gamma/-.13161671474/
+data	omega1/-.159596235474/, d0/.0759196200467/, d1/-.0217762490699/
+data	c00/.141189631152/, c10/.0809701286525/, c01/-.281528535557/
+data	c11/.15384112876/, c20/-.178251207466/, c02/.106959469314/
+data	tol /1.0e-7/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+
+	switch (face) {
+	case 0:
+	    xi = l
+	    eta = -m
+	    x0 = 0.0
+	    y0 = 2.0
+	case 1:
+	    xi = l
+	    eta = n
+	    x0 = 0.0
+	    y0 = 0.0
+	case 2:
+	    xi = -m
+	    eta = n
+	    x0 = 2.0
+	    y0 = 0.0
+	case 3:
+	    xi = -l
+	    eta = n
+	    x0 = 4.0
+	    y0 = 0.0
+	case 4:
+	    xi = m
+	    eta = n
+	    x0 = 6.0
+	    y0 = 0.0
+	case 5:
+	    xi = l
+	    eta = m
+	    x0 = 0.0
+	    y0 = -2.0
+	}
+
+	a = xi / rho
+	b = eta / rho
+	a2 = a * a
+	b2 = b * b
+	a4 = a2 * a2
+	b4 = b2 * b2
+	a2b2 = a2 * b2
+	ca2 = 1.0 - a2
+	cb2 = 1.0 - b2
+
+	xf = a*(a2+ca2*(gstar+b2*(gamma*ca2+mm*a2 +
+	     cb2*(c00+c10*a2+c01*b2+c11*a2b2+c20*a4+c02*b4)) +
+	     a2*(omega1-ca2*(d0+d1*a2))))
+	yf = b*(b2+cb2*(gstar+a2*(gamma*cb2+mm*b2 +
+	     ca2*(c00+c10*b2+c01*a2+c11*a2b2+c20*b4+c02*a4)) +
+	     b2*(omega1-cb2*(d0+d1*b2))))
+
+	if (abs(xf) > 1.0) {
+	    if (abs(xf) > (1.0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0)
+		xf = 1.0
+	    else
+		xf = -1.0
+	}
+	if (abs(yf) > 1.0) {
+	    if (abs(yf) > (1.0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0)
+		yf = 1.0
+	    else
+		yf = -1.0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfdecaxis.x b/sys/mwcs/wfdecaxis.x
new file mode 100644
index 00000000..32c59bd8
--- /dev/null
+++ b/sys/mwcs/wfdecaxis.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+
+# WF_DECAXIS -- Determine which of the 2 axes for the current function is
+# the DEC axis.
+
+procedure wf_decaxis (fc, ira, idec)
+
+pointer	fc			#I pointer to function call descriptor
+int	ira, idec		#O CTRAN relative RA, DEC axis numbers
+
+pointer	ct, mw
+int	ax[2], i
+char	axtype[4]
+bool	streq()
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+
+	# This function requires exactly 2 axes.
+	if (FC_NAXES(fc) != 2)
+	    call error (1, "A projection WCS requires 2 axes")
+
+	# Map FC axis (1 or 2) to CTRAN axis to physical axis.
+	do i = 1, 2
+	    ax[i] = CT_AXIS(ct,FC_AXIS(fc,i))
+
+	# Determine which is the DEC/LAT axis, and hence the axis order.
+	ira = 0
+	idec = 0
+	do i = 1, 2
+	    ifnoerr (call mw_gwattrs (mw, ax[i], "axtype", axtype, 4)) {
+		call strlwr (axtype)
+		if (streq (axtype, "ra") || streq (axtype[2], "lon")) {
+		    ira  = i
+		    idec = 3 - i
+		    break
+		} else if (streq (axtype, "dec") || streq (axtype[2], "lat")) {
+		    ira  = 3 - i
+		    idec = i
+		    break
+		} 
+	    }
+
+	if (idec == 0)
+	    call error (2,
+	    "DEC/xLAT axis must be specified for a projection WCS")
+end
diff --git a/sys/mwcs/wfgls.x b/sys/mwcs/wfgls.x
new file mode 100644
index 00000000..942cfdd1
--- /dev/null
+++ b/sys/mwcs/wfgls.x
@@ -0,0 +1,442 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFGLS
+.nf -------------------------------------------------------------------------
+WFGLS -- WCS function driver for the Sanson-Flamsteed sinusoidal projection.
+
+Driver routines:
+
+	FN_INIT		    wf_gls_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_gls_fwd (fc, v1, v2)
+	FN_INV		     wf_gls_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_GLS_INIT -- Initialize the forward or inverse Sanson-Flamsteed global
+# sinusoidal transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the 
+# ative longitudend latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the native latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined then the
+# most northerly of the two possible solutions for the latitude of the
+# native pole is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE,  and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list
+# takes precedence. 
+
+procedure wf_gls_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+	iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+       # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_GLS_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_GLS_FWD -- Forward transform (physical to world) for the Sanson-Flamsteed
+# global sinusoidal projection.
+
+procedure wf_gls_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, wconst, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI
+	wconst = cos (y * FC_RECRODEG(fc))
+	if (wconst == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = x * FC_RECRODEG(fc) / wconst
+
+	# Compute THETA.
+	theta = y * FC_RECRODEG(fc)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+        # Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+        # Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_GLS_INV -- Inverse transform (world to physical) for the Sanson-Flamsteed
+# global sinusoidal projection.
+
+procedure wf_gls_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	p[ira] = FC_RODEG(fc) * phi * cos (theta)
+	p[idec] = FC_RODEG(fc) * theta
+
+end
diff --git a/sys/mwcs/wfgsurfit.x b/sys/mwcs/wfgsurfit.x
new file mode 100644
index 00000000..8dca0f70
--- /dev/null
+++ b/sys/mwcs/wfgsurfit.x
@@ -0,0 +1,575 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# WFGSURFIT.X -- Surface fitting package used by WCS function drivers.
+#
+# The following routines are used by the experimental function drivers tnx
+# and zpx to decode polynomial fits stored in the image header in the form
+# of a list of parameters and coefficients into surface descriptors in
+# ra / dec or longitude latitude. The polynomial surfaces so encoded consist
+# of corrections to function drivers tan and zpn. The package routines are
+# modelled after the equivalent gsurfit routines and are consistent with them.
+# The routines are:
+#
+#                 sf = wf_gsopen (wattstr)
+#                     wf_gsclose (sf)
+#
+#                  z = wf_gseval (sf, x, y)
+#                     wf_gscoeff (sf, coeff, ncoeff)
+#                zder = wf_gsder (sf, x, y, nxder, nyder)
+#
+# WF_GSOPEN is used to open a surface fit encoded in a WCS attribute, returning
+# the SF surface fitting descriptor.  wf_gsclose should be called later to free
+# the descriptor.  WF_GSEVAL is called to evaluate the surface at a point.
+
+
+define  SZ_GSCOEFFBUF     20
+
+# Define the surface descriptor.
+define  LEN_WFGSSTRUCT    20
+
+define  WF_XRANGE       Memd[P2D($1)]   # 2. / (xmax - xmin), polynomials
+define  WF_XMAXMIN      Memd[P2D($1+2)] # - (xmax + xmin) / 2., polynomials
+define  WF_YRANGE       Memd[P2D($1+4)] # 2. / (ymax - ymin), polynomials
+define  WF_YMAXMIN      Memd[P2D($1+6)] # - (ymax + ymin) / 2., polynomials
+define  WF_TYPE         Memi[$1+8]      # Type of curve to be fitted
+define  WF_XORDER       Memi[$1+9]      # Order of the fit in x
+define  WF_YORDER       Memi[$1+10]     # Order of the fit in y
+define  WF_XTERMS       Memi[$1+11]     # Cross terms for polynomials
+define  WF_NCOEFF       Memi[$1+12]     # Total number of coefficients
+define  WF_COEFF        Memi[$1+13]     # Pointer to coefficient vector
+define  WF_XBASIS       Memi[$1+14]     # Pointer to basis functions (all x)
+define  WF_YBASIS       Memi[$1+15]     # Pointer to basis functions (all y)
+
+# Define the structure elements for the wf_gsrestore task.
+define  WF_SAVETYPE     $1[1]
+define  WF_SAVEXORDER   $1[2]
+define  WF_SAVEYORDER   $1[3]
+define  WF_SAVEXTERMS   $1[4]
+define  WF_SAVEXMIN     $1[5]
+define  WF_SAVEXMAX     $1[6]
+define  WF_SAVEYMIN     $1[7]
+define  WF_SAVEYMAX     $1[8]
+
+# Define the permitted types of surfaces.
+define  WF_CHEBYSHEV    1
+define  WF_LEGENDRE     2
+define  WF_POLYNOMIAL   3
+
+# Define the cross-terms flags.
+define  WF_XNONE        0       # no x-terms (old NO)
+define  WF_XFULL        1       # full x-terms (new YES)
+define  WF_XHALF        2       # half x-terms (new)
+
+define	WF_SAVECOEFF	8
+
+
+# WF_GSOPEN -- Decode the longitude / latitude or ra / dec mwcs attribute
+# and return a gsurfit compatible surface descriptor.
+
+pointer procedure wf_gsopen (atstr)
+
+char    atstr[ARB]              #I the input mwcs attribute string
+
+double  dval
+int     ip, npar, szcoeff
+pointer gs, sp, par, coeff
+int     nscan(), ctod()
+errchk  wf_gsrestore()
+
+begin
+        if (atstr[1] == EOS)
+            return (NULL)
+
+        call smark (sp)
+        call salloc (par, SZ_LINE, TY_CHAR)
+
+        gs = NULL
+        npar = 0
+        szcoeff = SZ_GSCOEFFBUF
+        call malloc (coeff, szcoeff, TY_DOUBLE)
+
+        call sscan (atstr)
+        repeat {
+            call gargwrd (Memc[par], SZ_LINE)
+            if (nscan() == npar)
+                break
+            if (Memc[par] == EOS)
+                break
+            ip = 1
+            if (ctod (Memc[par], ip, dval) <= 0)
+                break
+            if (npar >= szcoeff) {
+                szcoeff =szcoeff + SZ_GSCOEFFBUF
+                call realloc (coeff, szcoeff, TY_DOUBLE)
+            }
+            Memd[coeff+npar] = dval
+            npar = npar + 1
+        }
+
+        iferr (call wf_gsrestore (gs, Memd[coeff]))
+            gs = NULL
+
+        call sfree (sp)
+        call mfree (coeff, TY_DOUBLE)
+
+        if (npar == 0)
+            return (NULL)
+        else
+            return (gs)
+end
+
+
+# WF_GSCLOSE -- Procedure to free the surface descriptor.
+
+procedure wf_gsclose (sf)
+
+pointer sf      	#U the surface descriptor
+errchk  mfree
+
+begin
+        if (sf == NULL)
+            return
+
+        if (WF_XBASIS(sf) != NULL)
+            call mfree (WF_XBASIS(sf), TY_DOUBLE)
+        if (WF_YBASIS(sf) != NULL)
+            call mfree (WF_YBASIS(sf), TY_DOUBLE)
+        if (WF_COEFF(sf) != NULL)
+            call mfree (WF_COEFF(sf), TY_DOUBLE)
+
+        if (sf != NULL)
+            call mfree (sf, TY_STRUCT)
+end
+
+
+# WF_GSEVAL -- Procedure to evaluate the fitted surface at a single point.
+# The WF_NCOEFF(sf) coefficients are stored in the vector pointed to by
+# WF_COEFF(sf).
+
+double procedure wf_gseval (sf, x, y)
+
+pointer sf              #I pointer to surface descriptor structure
+double  x               #I x value
+double  y               #I y value
+
+double  sum, accum
+int     i, ii, k, maxorder, xorder
+
+begin
+        # Calculate the basis functions.
+        switch (WF_TYPE(sf)) {
+        case WF_CHEBYSHEV:
+            call wf_gsb1cheb (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1cheb (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        case WF_LEGENDRE:
+            call wf_gsb1leg (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1leg (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        case WF_POLYNOMIAL:
+            call wf_gsb1pol (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1pol (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        default:
+            call error (0, "WF_GSEVAL: Unknown surface type.")
+        }
+
+        # Initialize accumulator basis functions.
+        sum = 0.
+
+        # Loop over y basis functions.
+        maxorder = max (WF_XORDER(sf) + 1, WF_YORDER(sf) + 1)
+        xorder = WF_XORDER(sf)
+        ii = 1
+
+        do i = 1, WF_YORDER(sf) {
+            # Loop over the x basis functions.
+            accum = 0.
+            do k = 1, xorder {
+                accum = accum + Memd[WF_COEFF(sf)+ii-1] *
+		    Memd[WF_XBASIS(sf)+k-1) 
+                ii = ii + 1
+            }
+            accum = accum * Memd[WF_YBASIS(sf)+i-1]
+            sum = sum + accum
+
+            # Elements of the coefficient vector where neither k = 1 or i = 1
+            # are not calculated if WF_XTERMS(sf) = NO.
+
+            switch (WF_XTERMS(sf)) {
+            case WF_XNONE:
+                xorder = 1
+            case WF_XHALF:
+                if ((i + WF_XORDER(sf) + 1) > maxorder)
+                    xorder = xorder - 1
+            default:
+                ;
+            }
+        }
+
+        return (sum)
+end
+
+
+# WF_GSCOEFF -- Procedure to fetch the number and magnitude of the coefficients.
+# If the WF_XTERMS(sf) = WF_XBI (YES) then the number of coefficients will be
+# (WF_XORDER(sf) * WF_YORDER(sf)); if WF_XTERMS is WF_XTRI then the number
+# of coefficients will be (WF_XORDER(sf) *  WF_YORDER(sf) - order *
+# (order - 1) / 2) where order is the minimum of the x and yorders;  if
+# WF_XTERMS(sf) = WF_XNONE then the number of coefficients will be
+# (WF_XORDER(sf) + WF_YORDER(sf) - 1).
+
+procedure wf_gscoeff (sf, coeff, ncoeff)
+
+pointer	sf		#I pointer to the surface fitting descriptor
+double	coeff[ARB]	#O the coefficients of the fit
+int	ncoeff		#O the number of coefficients
+
+begin
+	# Calculate the number of coefficients.
+	ncoeff = WF_NCOEFF(sf)
+	call amovd (Memd[WF_COEFF(sf)], coeff, ncoeff)
+end
+
+
+# WF_GSDER -- Procedure to calculate a new surface which is a derivative of
+# the input surface.
+
+double procedure wf_gsder (sf1, x, y, nxd, nyd)
+
+pointer	sf1		#I pointer to the previous surface
+double	x		#I x values
+double	y		#I y values
+int	nxd, nyd	#I order of the derivatives in x and y
+
+int	ncoeff, nxder, nyder, i, j, k
+int	order, maxorder1, maxorder2, nmove1, nmove2
+pointer	sf2, sp, coeff, ptr1, ptr2
+double	zfit, norm
+double	wf_gseval()
+
+begin
+	if (sf1 == NULL)
+	    return (0)
+
+	if (nxd < 0 || nyd < 0)
+	    call error (0, "GSDER: Order of derivatives cannot be < 0")
+
+	if (nxd == 0 && nyd == 0) {
+	    zfit = wf_gseval (sf1, x, y)
+	    return (zfit)
+	}
+
+	# Allocate space for new surface.
+	call calloc (sf2, LEN_WFGSSTRUCT, TY_STRUCT)
+
+	# check the order of the derivatives
+	nxder = min (nxd, WF_XORDER(sf1) - 1)
+	nyder = min (nyd, WF_YORDER(sf1) - 1)
+
+	# Set up new surface.
+	WF_TYPE(sf2) = WF_TYPE(sf1)
+
+	# Set the derivative surface parameters.
+	switch (WF_TYPE(sf2)) {
+	case WF_LEGENDRE, WF_CHEBYSHEV, WF_POLYNOMIAL:
+
+	    WF_XTERMS(sf2) = WF_XTERMS(sf1)
+
+	    # Find the order of the new surface.
+	    switch (WF_XTERMS(sf2)) {
+	    case WF_XNONE: 
+		if (nxder > 0 && nyder > 0) {
+		    WF_XORDER(sf2) = 1
+		    WF_YORDER(sf2) = 1
+		    WF_NCOEFF(sf2) = 1
+		} else if (nxder > 0) {
+		    WF_XORDER(sf2) = max (1, WF_XORDER(sf1) - nxder)
+		    WF_YORDER(sf2) = 1
+		    WF_NCOEFF(sf2) = WF_XORDER(sf2)
+		} else if (nyder > 0) {
+		    WF_XORDER(sf2) = 1
+		    WF_YORDER(sf2) = max (1, WF_YORDER(sf1) - nyder)
+		    WF_NCOEFF(sf2) = WF_YORDER(sf2)
+		}
+
+	    case WF_XHALF:
+		maxorder1 = max (WF_XORDER(sf1) + 1, WF_YORDER(sf1) + 1)
+		order = max (1, min (maxorder1 - 1 - nyder - nxder,
+		    WF_XORDER(sf1) - nxder))
+	        WF_XORDER(sf2) = order
+		order = max (1, min (maxorder1 - 1 - nyder - nxder,
+		    WF_YORDER(sf1) - nyder))
+	        WF_YORDER(sf2) = order
+		order = min (WF_XORDER(sf2), WF_YORDER(sf2))
+		WF_NCOEFF(sf2) = WF_XORDER(sf2) * WF_YORDER(sf2)  -
+			order * (order - 1) / 2
+
+	    default:
+	        WF_XORDER(sf2) = max (1, WF_XORDER(sf1) - nxder)
+	        WF_YORDER(sf2) = max (1, WF_YORDER(sf1) - nyder)
+		WF_NCOEFF(sf2) = WF_XORDER(sf2) * WF_YORDER(sf2) 
+	    }
+
+	    # Define the data limits.
+	    WF_XRANGE(sf2) = WF_XRANGE(sf1)
+	    WF_XMAXMIN(sf2) = WF_XMAXMIN(sf1)
+	    WF_YRANGE(sf2) = WF_YRANGE(sf1)
+	    WF_YMAXMIN(sf2) = WF_YMAXMIN(sf1)
+
+	default:
+	    call error (0, "WF_GSDER: Unknown surface type.")
+	}
+
+	# Allocate space for coefficients and basis functions.
+	call calloc (WF_COEFF(sf2), WF_NCOEFF(sf2), TY_DOUBLE)
+	call calloc (WF_XBASIS(sf2), WF_XORDER(sf2), TY_DOUBLE)
+	call calloc (WF_YBASIS(sf2), WF_YORDER(sf2), TY_DOUBLE)
+
+	# Get coefficients.
+	call smark (sp)
+	call salloc (coeff, WF_NCOEFF(sf1), TY_DOUBLE)
+	call wf_gscoeff (sf1, Memd[coeff], ncoeff)
+
+	# Compute the new coefficients.
+	switch (WF_XTERMS(sf2)) {
+	case WF_XFULL:
+	    ptr2 = WF_COEFF(sf2) + (WF_YORDER(sf2) - 1) * WF_XORDER(sf2)
+	    ptr1 = coeff + (WF_YORDER(sf1) - 1) * WF_XORDER(sf1)
+	    do i = WF_YORDER(sf1), nyder + 1, -1 {
+		do j = i, i - nyder + 1, -1
+		    call amulkd (Memd[ptr1+nxder], double (j - 1),
+		        Memd[ptr1+nxder], WF_XORDER(sf2))
+		do j = WF_XORDER(sf1), nxder + 1, - 1 {
+		    do k = j , j - nxder + 1, - 1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		}
+		call amovd (Memd[ptr1+nxder], Memd[ptr2], WF_XORDER(sf2))
+		ptr2 = ptr2 - WF_XORDER(sf2)
+		ptr1 = ptr1 - WF_XORDER(sf1)
+	    }
+
+	case WF_XHALF:
+	    maxorder1 = max (WF_XORDER(sf1) + 1, WF_YORDER(sf1) + 1)
+	    maxorder2 = max (WF_XORDER(sf2) + 1, WF_YORDER(sf2) + 1)
+	    ptr2 = WF_COEFF(sf2) + WF_NCOEFF(sf2)
+	    ptr1 = coeff + WF_NCOEFF(sf1)
+	    do i = WF_YORDER(sf1), nyder + 1, -1 {
+		nmove1 = max (0, min (maxorder1 - i, WF_XORDER(sf1)))
+		nmove2 = max (0, min (maxorder2 - i + nyder, WF_XORDER(sf2)))
+		ptr1 = ptr1 - nmove1
+		ptr2 = ptr2 - nmove2
+		do j = i, i - nyder + 1, -1
+		    call amulkd (Memd[ptr1+nxder], double (j - 1),
+		        Memd[ptr1+nxder], nmove2)
+		do j = nmove1, nxder + 1, - 1 {
+		    do k = j , j - nxder + 1, - 1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		}
+		call amovd (Memd[ptr1+nxder], Memd[ptr2], nmove2)
+	    }
+
+	default:
+	    if (nxder > 0 && nyder > 0) {
+		Memd[WF_COEFF(sf2)] = 0.
+
+	    } else if (nxder > 0) { 
+		ptr1 = coeff
+		ptr2 = WF_COEFF(sf2) + WF_NCOEFF(sf2) - 1
+		do j = WF_XORDER(sf1), nxder + 1, -1 {
+		    do k = j, j - nxder + 1, -1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		    Memd[ptr2] = Memd[ptr1+j-1]
+		    ptr2 = ptr2 - 1
+		}
+
+	    } else if (nyder > 0) {
+		ptr1 = coeff + WF_NCOEFF(sf1) - 1
+		ptr2 = WF_COEFF(sf2)
+		do i = WF_YORDER(sf1), nyder + 1, -1 {
+		    do j = i, i - nyder + 1, - 1
+			Memd[ptr1] = Memd[ptr1] * (j - 1)	
+		    ptr1 = ptr1 - 1
+		}
+		call amovd (Memd[ptr1+1], Memd[ptr2], WF_NCOEFF(sf2))
+	    }
+	}
+
+	# Evaluate the derivatives.
+	zfit = wf_gseval (sf2, x, y)
+
+	# Normalize.
+	if (WF_TYPE(sf2) != WF_POLYNOMIAL) { 
+	    norm = WF_XRANGE(sf2) ** nxder * WF_YRANGE(sf2) ** nyder
+	    zfit = norm * zfit
+	}
+
+	# Free the space.
+	call wf_gsclose (sf2)
+	call sfree (sp)
+
+	return (zfit)
+end
+
+
+# WF_GSRESTORE -- Procedure to restore the surface fit encoded in the
+# image header as a list of double precision parameters and coefficients
+# to the surface descriptor for use by the evaluating routines. The
+# surface parameters, surface type, xorder (or number of polynomial
+# terms in x), yorder (or number of polynomial terms in y), xterms,
+# xmin, xmax and ymin and ymax, are stored in the first eight elements
+# of the double array fit, followed by the WF_NCOEFF(sf) surface coefficients.
+
+procedure wf_gsrestore (sf, fit)
+
+pointer	sf		#O surface descriptor
+double	fit[ARB]	#I array containing the surface parameters and
+			#I coefficients
+
+int	surface_type, xorder, yorder, order
+double	xmin, xmax, ymin, ymax	
+
+begin
+	# Allocate space for the surface descriptor.
+	call calloc (sf, LEN_WFGSSTRUCT, TY_STRUCT)
+
+	xorder = nint (WF_SAVEXORDER(fit))
+	if (xorder < 1)
+	    call error (0, "WF_GSRESTORE: Illegal x order.")
+	yorder = nint (WF_SAVEYORDER(fit))
+	if (yorder < 1)
+	    call error (0, "WF_GSRESTORE: Illegal y order.")
+
+	xmin = WF_SAVEXMIN(fit)
+	xmax = WF_SAVEXMAX(fit)
+	if (xmax <= xmin)
+	    call error (0, "WF_GSRESTORE: Illegal x range.")
+	ymin = WF_SAVEYMIN(fit)
+	ymax = WF_SAVEYMAX(fit)
+	if (ymax <= ymin)
+	    call error (0, "WF_GSRESTORE: Illegal y range.")
+
+	# Set surface type dependent surface descriptor parameters.
+	surface_type = nint (WF_SAVETYPE(fit))
+
+	switch (surface_type) {
+	case WF_LEGENDRE, WF_CHEBYSHEV, WF_POLYNOMIAL:
+	    WF_XORDER(sf) = xorder
+	    WF_XRANGE(sf) = double(2.0) / (xmax - xmin)
+	    WF_XMAXMIN(sf) =  - (xmax + xmin) / double(2.0)
+	    WF_YORDER(sf) = yorder
+	    WF_YRANGE(sf) = double(2.0) / (ymax - ymin)
+	    WF_YMAXMIN(sf) =  - (ymax + ymin) / double(2.0)
+	    WF_XTERMS(sf) = WF_SAVEXTERMS(fit)
+	    switch (WF_XTERMS(sf)) {
+	    case WF_XNONE:
+		WF_NCOEFF(sf) = WF_XORDER(sf) + WF_YORDER(sf) - 1
+	    case WF_XHALF:
+		order = min (xorder, yorder)
+		WF_NCOEFF(sf) = WF_XORDER(sf) * WF_YORDER(sf) - order *
+		    (order - 1) / 2
+	    case WF_XFULL:
+		WF_NCOEFF(sf) = WF_XORDER(sf) * WF_YORDER(sf)
+	    }
+	default:
+	    call error (0, "WF_GSRESTORE: Unknown surface type.")
+	}
+
+	# Set remaining curve parameters.
+	WF_TYPE(sf) = surface_type
+
+	call malloc (WF_COEFF(sf), WF_NCOEFF(sf), TY_DOUBLE)
+	call malloc (WF_XBASIS(sf), WF_XORDER(sf), TY_DOUBLE)
+	call malloc (WF_YBASIS(sf), WF_YORDER(sf), TY_DOUBLE)
+
+	# restore coefficient array
+	call amovd (fit[WF_SAVECOEFF+1], Memd[WF_COEFF(sf)], WF_NCOEFF(sf))
+end
+
+
+# WF_GSB1POL -- Procedure to evaluate all the non-zero polynomial functions
+# for a single point and given order.
+
+procedure wf_gsb1pol (x, order, k1, k2, basis)
+
+double  x               #I data point
+int     order           #I order of polynomial, order = 1, constant
+double  k1, k2          #I nomalizing constants, dummy in this case
+double  basis[ARB]      #O basis functions
+
+int     i
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        basis[2] = x
+        if (order == 2)
+            return
+
+        do i = 3, order
+            basis[i] = x * basis[i-1]
+end
+
+
+# WF_GSB1LEG -- Procedure to evaluate all the non-zero Legendre functions for
+# a single point and given order.
+
+procedure wf_gsb1leg (x, order, k1, k2, basis)
+
+double  x               #I data point
+int     order           #I order of polynomial, order = 1, constant
+double  k1, k2          #I normalizing constants
+double  basis[ARB]      #O basis functions
+
+int     i
+double  ri, xnorm
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        xnorm = (x + k1) * k2 
+        basis[2] = xnorm
+        if (order == 2)
+            return
+
+        do i = 3, order {
+            ri = i
+            basis[i] = ((2. * ri - 3.) * xnorm * basis[i-1] -
+                       (ri - 2.) * basis[i-2]) / (ri - 1.)
+        }
+end
+
+
+# WF_GSB1CHEB -- Procedure to evaluate all the non zero Chebyshev function
+# for a given x and order.
+
+procedure wf_gsb1cheb (x, order, k1, k2, basis)
+
+double  x               #I number of data points
+int     order           #I order of polynomial, 1 is a constant
+double  k1, k2          #I normalizing constants
+double  basis[ARB]      #O array of basis functions
+
+int     i
+double  xnorm
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        xnorm = (x + k1) * k2
+        basis[2] = xnorm
+        if (order == 2)
+            return
+
+        do i = 3, order
+            basis[i] = 2. * xnorm * basis[i-1] - basis[i-2]
+end
diff --git a/sys/mwcs/wfinit.x b/sys/mwcs/wfinit.x
new file mode 100644
index 00000000..eb9c8e26
--- /dev/null
+++ b/sys/mwcs/wfinit.x
@@ -0,0 +1,140 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# WF_INIT -- Initialize the WCS function table.  Everything MWCS related
+# having to do with a world function is contained either in this file or
+# in the driver source file.  If the WCS must also be translated to/from
+# a FITS image header representation, the image header translation routine
+# iwewcs.x must also be modified.
+
+procedure wf_init()
+
+extern	wf_smp_init(), wf_smp_tran()
+extern	wf_tan_init(), wf_tan_fwd(), wf_tan_inv()
+extern	wf_arc_init(), wf_arc_fwd(), wf_arc_inv()
+extern	wf_gls_init(), wf_gls_fwd(), wf_gls_inv()
+extern	wf_sin_init(), wf_sin_fwd(), wf_sin_inv()
+extern	wf_msp_init(), wf_msp_fwd(), wf_msp_inv(), wf_msp_destroy()
+
+extern	wf_ait_init(), wf_ait_fwd(), wf_ait_inv()
+extern	wf_car_init(), wf_car_fwd(), wf_car_inv()
+extern	wf_csc_init(), wf_csc_fwd(), wf_csc_inv()
+extern	wf_mer_init(), wf_mer_fwd(), wf_mer_inv()
+extern	wf_mol_init(), wf_mol_fwd(), wf_mol_inv()
+extern	wf_par_init(), wf_par_fwd(), wf_par_inv()
+extern	wf_pco_init(), wf_pco_fwd(), wf_pco_inv()
+extern	wf_qsc_init(), wf_qsc_fwd(), wf_qsc_inv()
+extern	wf_stg_init(), wf_stg_fwd(), wf_stg_inv()
+extern	wf_tsc_init(), wf_tsc_fwd(), wf_tsc_inv()
+extern	wf_zea_init(), wf_zea_fwd(), wf_zea_inv()
+
+extern	wf_zpx_init(), wf_zpx_fwd(), wf_zpx_inv(), wf_zpx_destroy()
+extern	wf_zpn_init(), wf_zpn_fwd(), wf_zpn_inv(), wf_zpn_destroy()
+extern	wf_tnx_init(), wf_tnx_fwd(), wf_tnx_inv(), wf_tnx_destroy()
+extern	wf_tpv_init(), wf_tpv_fwd(), wf_tpv_inv(), wf_tpv_destroy()
+
+bool	first_time
+data	first_time /true/
+errchk	wf_fnload
+include	"mwcs.com"
+int	locpr()
+
+begin
+	# Only do this once.
+	if (!first_time)
+	    return
+
+	fn_nfn = 0
+	first_time = false
+
+	# Load the function drivers.
+	call wf_fnload ("sampled", 0,
+	    locpr(wf_smp_init), NULL, locpr(wf_smp_tran), locpr(wf_smp_tran))
+
+	# For compatibility reasons (FN index codes) new functions should
+	# be added at the end of the following list.
+
+	call wf_fnload ("tan", F_RADEC,
+	    locpr(wf_tan_init), NULL, locpr(wf_tan_fwd), locpr(wf_tan_inv))
+	call wf_fnload ("arc", F_RADEC,
+	    locpr(wf_arc_init), NULL, locpr(wf_arc_fwd), locpr(wf_arc_inv))
+	call wf_fnload ("gls", F_RADEC,
+	    locpr(wf_gls_init), NULL, locpr(wf_gls_fwd), locpr(wf_gls_inv))
+	call wf_fnload ("sin", F_RADEC,
+	    locpr(wf_sin_init), NULL, locpr(wf_sin_fwd), locpr(wf_sin_inv))
+
+	# Custom IRAF WCS for images containing multiple spectra.
+	call wf_fnload ("multispec", F_RADEC,
+	    locpr(wf_msp_init), locpr(wf_msp_destroy), locpr(wf_msp_fwd),
+	    locpr(wf_msp_inv))
+
+	# Most of the following are from G&C (also GLS above).
+	call wf_fnload ("ait", F_RADEC,
+	    locpr(wf_ait_init), NULL, locpr(wf_ait_fwd), locpr(wf_ait_inv))
+	call wf_fnload ("car", F_RADEC,
+	    locpr(wf_car_init), NULL, locpr(wf_car_fwd), locpr(wf_car_inv))
+	call wf_fnload ("csc", F_RADEC,
+	    locpr(wf_csc_init), NULL, locpr(wf_csc_fwd), locpr(wf_csc_inv))
+	call wf_fnload ("mer", F_RADEC,
+	    locpr(wf_mer_init), NULL, locpr(wf_mer_fwd), locpr(wf_mer_inv))
+	call wf_fnload ("mol", F_RADEC,
+	    locpr(wf_mol_init), NULL, locpr(wf_mol_fwd), locpr(wf_mol_inv))
+	call wf_fnload ("par", F_RADEC,
+	    locpr(wf_par_init), NULL, locpr(wf_par_fwd), locpr(wf_par_inv))
+	call wf_fnload ("pco", F_RADEC,
+	    locpr(wf_pco_init), NULL, locpr(wf_pco_fwd), locpr(wf_pco_inv))
+	call wf_fnload ("qsc", F_RADEC,
+	    locpr(wf_qsc_init), NULL, locpr(wf_qsc_fwd), locpr(wf_qsc_inv))
+	call wf_fnload ("stg", F_RADEC,
+	    locpr(wf_stg_init), NULL, locpr(wf_stg_fwd), locpr(wf_stg_inv))
+	call wf_fnload ("tsc", F_RADEC,
+	    locpr(wf_tsc_init), NULL, locpr(wf_tsc_fwd), locpr(wf_tsc_inv))
+	call wf_fnload ("zea", F_RADEC,
+	    locpr(wf_zea_init), NULL, locpr(wf_zea_fwd), locpr(wf_zea_inv))
+
+	# Experimental WCS for astrometric approximations.
+	call wf_fnload ("zpx", F_RADEC,
+	    locpr(wf_zpx_init), locpr(wf_zpx_destroy), locpr(wf_zpx_fwd),
+	    locpr(wf_zpx_inv))
+	call wf_fnload ("zpn", F_RADEC,
+	    locpr(wf_zpn_init), locpr(wf_zpn_destroy), locpr(wf_zpn_fwd),
+	    locpr(wf_zpn_inv))
+	call wf_fnload ("tnx", F_RADEC,
+	    locpr(wf_tnx_init), locpr(wf_tnx_destroy), locpr(wf_tnx_fwd),
+	    locpr(wf_tnx_inv))
+	call wf_fnload ("tpv", F_RADEC,
+	    locpr(wf_tpv_init), locpr(wf_tpv_destroy), locpr(wf_tpv_fwd),
+	    locpr(wf_tpv_inv))
+end
+
+
+# WF_FNLOAD -- Load a driver into the WCS function table.
+
+procedure wf_fnload (name, flags, init, destroy, fwd, inv)
+
+char	name[ARB]			#I function name
+int	init				#I initialize procedure
+int	flags				#I function type flags
+int	destroy				#I destroy procedure
+int	fwd				#I forward transform procedure
+int	inv				#I inverse transform procedure
+
+errchk	syserrs
+include	"mwcs.com"
+
+begin
+	# Get a new driver slot.
+	if (fn_nfn + 1 > MAX_FN)
+	    call syserrs (SYS_MWFNOVFL, name)
+	fn_nfn = fn_nfn + 1
+
+	# Load the driver.
+	FN_INIT(fn_nfn) = init
+	FN_FLAGS(fn_nfn) = flags
+	FN_DESTROY(fn_nfn) = destroy
+	FN_FWD(fn_nfn) = fwd
+	FN_INV(fn_nfn) = inv
+	call strcpy (name, FN_NAME(fn_nfn), SZ_FNNAME)
+end
diff --git a/sys/mwcs/wfmer.x b/sys/mwcs/wfmer.x
new file mode 100644
index 00000000..efee2be9
--- /dev/null
+++ b/sys/mwcs/wfmer.x
@@ -0,0 +1,446 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFMER
+.nf -------------------------------------------------------------------------
+WFMER -- WCS function driver for the cylindrical mercator projection.
+
+Driver routines:
+
+	FN_INIT		    wf_mer_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_mer_fwd (fc, v1, v2)
+	FN_INV		     wf_mer_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_MER_INIT -- Initialize the cylindical mercator forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined the
+# more northerly of the two possible solutions for latitude of the native
+# pole is chosen, otherwise the solution closest to LATPOLE is chosen. If
+# RO is undefined a value of 180.0 / PI is assumed. In order to determine
+# the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must have been
+# set in the attribute list for the function. The LONGPOLE, LATPOLE, and RO
+# parameters may be set in either or both of the axes attribute lists, but the
+# value in the RA axis attribute list takes precedence. 
+
+procedure wf_mer_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data	tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_MER_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	if (FC_RODEG(fc) == 0.0d0)
+	    call error (0, "WF_MER_INIT: Invalid projection parameters") 
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_MER_FWD -- Forward transform (physical to world) for the mercator
+# projection.
+
+procedure wf_mer_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	phi = FC_RECRODEG(fc) * x
+
+	# Compute THETA.
+	theta = 2.0d0 * atan (exp (y / FC_RODEG(fc))) - DHALFPI
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+        ra =  DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_MER_INV -- Inverse transform (world to physical) for the mercator
+# projection.
+
+procedure wf_mer_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, dphi, phi, theta
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+       if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	if (theta <= -DHALFPI || theta >= DHALFPI) {
+	    p[ira] = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    p[ira] = FC_RODEG(fc) * phi
+	    p[idec] = FC_RODEG(fc) * log (tan ((DHALFPI + theta) / 2.0d0))
+	}
+end
diff --git a/sys/mwcs/wfmol.x b/sys/mwcs/wfmol.x
new file mode 100644
index 00000000..b02c00f8
--- /dev/null
+++ b/sys/mwcs/wfmol.x
@@ -0,0 +1,518 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFMOL
+.nf -------------------------------------------------------------------------
+WFMOL -- WCS function driver for the Mollweide projection.
+
+Driver routines:
+
+	FN_INIT		    wf_mol_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_mol_fwd (fc, v1, v2)
+	FN_INV		     wf_mol_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # sqrt (2) * RO
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # sqrt (2) * RO / 90
+define	FC_C3		Memd[P2D($1+FCU+20)]	     # 1 / (sqrt (2) * RO)
+define	FC_C4		Memd[P2D($1+FCU+22)]	     # 90 / RO
+define	FC_C5		Memd[P2D($1+FCU+24)]	     # 2 / PI
+define	FC_BADCVAL	Memd[P2D($1+FCU+26)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+28)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_MOL_INIT -- Initialize the forward or inverse Mollweide transform.
+# Initialization for this transformation consists of, determining which axis
+# is RA / LON and which is DEC / LAT, reading in the native longitude and
+# latitude of the pole in celestial coordinates LONGPOLE and LATPOLE from the
+# attribute list, computing the Euler angles and various intermediate
+# functions of the reference point, reading in the projection parameter RO
+# from the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude of the reference point is less than 0, otherwise
+# 0 degrees is assumed.  If LATPOLE is undefined then the most northerly of
+# the two possible solutions is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a # value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE,  and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_mol_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_MOL_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = sqrt (2.0d0) * FC_RODEG(fc)
+	FC_C2(fc) = FC_C1(fc) / 90.0d0
+	FC_C3(fc) = 1.0d0 / FC_C1(fc)
+	FC_C4(fc) = 90.0d0 / FC_RODEG(fc)
+	FC_C5(fc) = 2.0d0 / DPI
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_MOL_FWD -- Forward transform (physical to world) for the Mollweide
+# projection.
+
+procedure wf_mol_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, y0, s, z, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	tol, ra, dec, dlng
+data	tol/1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	y0 = y / FC_RODEG(fc)
+	s = 2.0d0 - y0 * y0
+	if (s < tol) {
+	    if (s < -tol) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    s = 0.0d0
+	    if (abs(x) > tol) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    phi = 0.0d0
+	} else {
+	    s = sqrt (s)
+	    phi = FC_C4(fc) * DDEGTORAD(x) / s
+	}
+
+	# Compute THETA.
+	z = y * FC_C3(fc)
+	if (abs(z) > 1.0d0) {
+	    if (abs(z) > (1.0d0 + tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (z >= 0.0d0)
+		z = 1.0d0 + y0 * s / DPI
+	    else
+		z = -1.0d0 + y0 * s / DPI
+	} else
+	    z = asin (z) * FC_C5(fc) + y0 * s / DPI
+
+	if (abs(z) > 1.0d0) {
+	    if (abs(z) > (1.0d0 + tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (z >= 0.0d0)
+		z = 1.0d0
+	    else
+		z = -1.0d0
+	}
+	theta = asin (z)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_MOL_INV -- Inverse transform (world to physical) for the Mollweide
+# projection.
+
+procedure wf_mol_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	j, ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, dphi
+double	u, v0, v1, v, resid, alpha, tol, z
+data	tol /1.0d-13/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	if (abs(theta) == DHALFPI) {
+	    p[ira] = 0.0d0
+	    if (theta >= 0.0d0)
+	        p[idec] = FC_C1(fc) 
+	    else
+	        p[idec] = -FC_C1(fc) 
+	} else if (theta == 0.0d0) {
+	    p[ira] = FC_C2(fc) * DRADTODEG(phi) 
+	    p[idec] = 0.0d0
+	} else {
+	    u = DPI * sin (theta)
+	    v0 = -DPI
+	    v1 = DPI
+	    v = u
+	    do j = 1, 100 {
+		resid = (v - u) + sin (v)
+		if (resid < 0.0d0) {
+		    if (resid > -tol)
+			break
+		    v0 = v
+		} else {
+		    if (resid < tol)
+			break
+		    v1 = v
+		}
+		v = (v0 + v1) / 2.0d0
+	    }
+	    alpha = v / 2.0d0
+	    p[ira] = FC_C2(fc) * DRADTODEG(phi) * cos (alpha)
+	    p[idec] = FC_C1(fc) * sin (alpha)
+	}
+end
diff --git a/sys/mwcs/wfmspec.x b/sys/mwcs/wfmspec.x
new file mode 100644
index 00000000..2f5b5a91
--- /dev/null
+++ b/sys/mwcs/wfmspec.x
@@ -0,0 +1,578 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"mwcs.h"
+
+.help WFMSPEC
+.nf -------------------------------------------------------------------------
+WFMSPEC -- WCS function driver for MULTISPEC spectral format.
+
+The dispersion coordinate is along image lines and each line has independent
+linear or nonlinear dispersion coordinates.  The dispersion coordinates are
+defined by specn attributes where n is the physical line number.  The format
+of the attributes is:
+
+	ap beam dtype w1 dw nw z aplow aphigh coeffs...
+
+where ap is the aperture number (unique within an image), beam is a beam
+number (not used by the driver), dtype is the dispersion type with values
+
+	0 = linear dispersion
+	1 = log linear dispersion
+	2 = nonlinear dispersion
+
+w1 is the wavelength of the first physical pixel, dw is the average
+increment per pixel between the first and last pixel, nw is the number of
+pixels, z is a redshift factor to be applied to the dispersion coordinates,
+aplow and aphigh are aperture limits defining the origin of the spectra (not
+used by the driver), and coeffs are the nonlinear dispersion coefficients.
+
+The nonlinear dispersion function coefficients may describe several function
+types; chebyshev polynomial, legendre polynomial, linear spline, cubic
+spline, linear interpolation in a pixel coordinate array, and linear
+interpolation in a sampled array.
+
+The axes and dispersion parameters are in terms of the physical image.  The
+aperture number is used for the world coordinate of the line coordinate.
+Coordinates outside the valid range are mapped to nearest valid world
+coordinate.  In application this would give a correct world coordinate graph
+for a general WCS blind graphics task (especially if all invalid pixels have
+the same value as the last valid pixel).
+
+Driver routines:
+
+	FN_INIT		    wf_msp_init (fc, dir)
+	FN_DESTROY	 wf_msp_destroy (fc)
+	FN_FWD		     wf_msp_fwd (fc, v1, v2)
+	FN_INV		     wf_msp_inv (fc, v1, v2)
+
+In addition the nonlinear dispersion functions use the following routines:
+
+	wf_msp_coeff	Convert the attribute string to a coefficient array
+	wf_msp_eval	Evaluate the function (P->W)
+	wf_msp_evali	Evaluate the inverse function (W->P)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_NAPS		Memi[$1+FCU]		# number of apertures
+define	FC_APS		Memi[$1+FCU+1]		# pointer to indep coords
+define	FC_DTYPE	Memi[$1+FCU+2]		# pointer to dispersion type
+define	FC_CRVAL	Memi[$1+FCU+3]		# pointer to linear origins
+define	FC_CDELT	Memi[$1+FCU+4]		# pointer to linear intervals
+define	FC_NPTS		Memi[$1+FCU+5]		# pointer to number of points
+define	FC_Z		Memi[$1+FCU+6]		# pointer to doppler corrections
+define	FC_COEFF	Memi[$1+FCU+7]		# pointer to nonlinear coeffs
+define	FC_X		Memi[$1+FCU+8]		# pointer to last phys. coord.
+define	FC_DYDX		Memi[$1+FCU+9]		# pointer to last deriv.
+define	FC_DIR		Memi[$1+FCU+10]		# direction of transform
+
+# Function types.
+define	CHEBYSHEV	1	# CURFIT Chebyshev polynomial
+define	LEGENDRE	2	# CURFIT Legendre polynomial
+define	SPLINE3		3	# CURFIT cubic spline
+define	SPLINE1		4	# CURFIT linear spline
+define	PIXEL		5	# pixel coordinate array
+define	SAMPLE		6	# sampled coordinates
+
+# Dispersion types.
+define	LINEAR		0	# linear
+define	LOG		1	# log linear
+define	NONLINEAR	2	# nonlinear
+
+# Iterative inversion parameters.
+define	NALLOC		10	# size of allocation increments
+define  NIT		10	# max interations in determining inverse
+define  DX		0.0001  # accuracy limit in pixels for inverse
+
+# Size limiting definitions.
+define	DEF_SZATVAL	2048	# dynamically resized if overflow
+
+
+# WF_MSP_INIT -- Initialize the function call descriptor for the indicated
+# type of transform (forward or inverse).
+
+procedure wf_msp_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I type of transformation
+
+pointer	ct, mw
+int	sz_atval, naps, ip, i
+pointer	sp, atkey, atval, aps, dtype, crval, cdelt, npts, z, coeff
+int	strlen(), ctoi(), ctod()
+double	x, dval, wf_msp_eval()
+errchk	malloc, realloc
+
+begin
+	# Get pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+
+	# Check axes.
+	if (FC_NAXES(fc) != 2 || CT_AXIS(ct,1) != 1 || CT_AXIS(ct,2) != 2)
+	    call error (1, "WFMSPEC: Wrong axes")
+
+	# Get spectrum information.
+	call smark (sp)
+	sz_atval = DEF_SZATVAL
+	call malloc (atval, sz_atval, TY_CHAR)
+	call salloc (atkey, SZ_ATNAME, TY_CHAR)
+
+	for (naps=0;  ;  naps=naps+1) {
+	    call sprintf (Memc[atkey], SZ_ATNAME, "spec%d")
+		call pargi (naps+1)
+	    iferr (call mw_gwattrs (mw, 2, Memc[atkey], Memc[atval], sz_atval))
+		break
+
+	    while (strlen (Memc[atval]) == sz_atval) {
+		sz_atval = 2 * sz_atval
+		call realloc (atval, sz_atval, TY_CHAR)
+		call mw_gwattrs (mw, 2, Memc[atkey], Memc[atval], sz_atval)
+	    }
+
+	    if (naps == 0) {
+		call malloc (aps, NALLOC, TY_INT) 
+		call malloc (dtype, NALLOC, TY_INT) 
+		call malloc (crval, NALLOC, TY_DOUBLE) 
+		call malloc (cdelt, NALLOC, TY_DOUBLE) 
+		call malloc (npts, NALLOC, TY_INT) 
+		call malloc (z, NALLOC, TY_DOUBLE) 
+		call malloc (coeff, NALLOC, TY_POINTER)
+	    } else if (mod (naps, NALLOC) == 0) {
+		call realloc (aps, naps+NALLOC, TY_INT) 
+		call realloc (dtype, naps+NALLOC, TY_INT) 
+		call realloc (crval, naps+NALLOC, TY_DOUBLE)
+		call realloc (cdelt, naps+NALLOC, TY_DOUBLE) 
+		call realloc (npts, naps+NALLOC, TY_INT) 
+		call realloc (z, naps+NALLOC, TY_DOUBLE) 
+		call realloc (coeff, naps+NALLOC, TY_POINTER) 
+	    }
+
+	    # Linear dispersion function.
+	    ip = 1
+	    if (ctoi (Memc[atval], ip, Memi[aps+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[dtype+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[dtype+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[crval+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[cdelt+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[npts+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[z+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, dval) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, dval) <= 0)
+		next
+	    Memd[z+naps] = Memd[z+naps] + 1
+
+	    # Set nonlinear dispersion function.
+	    if (Memi[dtype+naps] == NONLINEAR)
+		call wf_msp_coeff (Memc[atval+ip], Memi[coeff+naps],
+		    double (0.5), double (Memi[npts+naps]+0.5))
+	}
+
+	if (naps <= 0)
+	    call error (2, "WFMSPEC: No aperture information")
+
+	call realloc (aps, naps, TY_INT) 
+	call realloc (dtype, naps, TY_INT) 
+	call realloc (crval, naps, TY_DOUBLE) 
+	call realloc (cdelt, naps, TY_DOUBLE) 
+	call realloc (npts, naps, TY_INT) 
+	call realloc (z, naps, TY_DOUBLE) 
+	call realloc (coeff, naps, TY_POINTER) 
+
+	FC_NAPS(fc) = naps
+	FC_APS(fc) = aps
+	FC_DTYPE(fc) = dtype
+	FC_CRVAL(fc) = crval
+	FC_CDELT(fc) = cdelt
+	FC_NPTS(fc) = npts
+	FC_Z(fc) = z
+	FC_COEFF(fc) = coeff
+	FC_DIR(fc) = dir
+
+	# Setup inverse parameters if needed.
+	# The parameters make the interative inversion more efficient
+	# when the inverse transformation is evaluated sequentially.
+
+	if (dir == INVERSE) {
+	   call malloc (crval, naps, TY_DOUBLE)
+	   call malloc (cdelt, naps, TY_DOUBLE)
+	   do i = 0, naps-1 {
+		if (Memi[FC_NPTS(fc)+i] == 0)
+		    next
+		if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+		    coeff = Memi[FC_COEFF(fc)+i]
+		    x = Memi[FC_NPTS(fc)+i]
+		    Memd[crval+i] = x
+		    Memd[cdelt+i] = wf_msp_eval (Memd[coeff], x) -
+			wf_msp_eval (Memd[coeff], x - 1)
+		}
+	    }
+	    FC_X(fc) = crval
+	    FC_DYDX(fc) = cdelt
+	} else {
+	    FC_X(fc) = NULL
+	    FC_DYDX(fc) = NULL
+	}
+
+	call mfree (atval, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# WF_MSP_DESTROY -- Free function driver descriptor.
+
+procedure wf_msp_destroy (fc)
+
+pointer	fc			#I pointer to FC descriptor
+int	i
+
+begin
+	do i = 1, FC_NAPS(fc)
+	    if (Memi[FC_DTYPE(fc)+i-1] == NONLINEAR)
+		call mfree (Memi[FC_COEFF(fc)+i-1], TY_DOUBLE)
+
+	call mfree (FC_APS(fc), TY_INT)
+	call mfree (FC_DTYPE(fc), TY_INT)
+	call mfree (FC_CRVAL(fc), TY_DOUBLE)
+	call mfree (FC_CDELT(fc), TY_DOUBLE)
+	call mfree (FC_NPTS(fc), TY_INT)
+	call mfree (FC_Z(fc), TY_DOUBLE)
+	call mfree (FC_COEFF(fc), TY_POINTER)
+	call mfree (FC_X(fc), TY_DOUBLE)
+	call mfree (FC_DYDX(fc), TY_DOUBLE)
+end
+
+
+# WF_MSP_FWD -- Evaluate P -> W (physical to world transformation).
+
+procedure wf_msp_fwd (fc, in, out)
+
+pointer	fc			#I pointer to FC descriptor
+double	in[2]			#I point to sample WCS at
+double	out[2]			#O value of WCS at that point
+
+int	i
+pointer	coeff
+double	din, wf_msp_eval()
+
+begin
+	i = nint (in[2]) - 1
+	if (i < 0 || i >= FC_NAPS(fc))
+	    call error (3, "WFMSPEC: Coordinate out of bounds")
+	if (Memi[FC_NPTS(fc)+i] == 0)
+	    call error (4, "WFMSPEC: No dispersion function")
+
+	if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+	    coeff = Memi[FC_COEFF(fc)+i]
+	    out[2] = Memi[FC_APS(fc)+i]
+	    out[1] = wf_msp_eval (Memd[coeff], in[1])
+	} else {
+	    din = max (0.5D0, min (double (Memi[FC_NPTS(fc)+i]+0.5), in[1]))
+	    out[2] = Memi[FC_APS(fc)+i]
+	    out[1] = Memd[FC_CRVAL(fc)+i] + Memd[FC_CDELT(fc)+i] * (din - 1)
+	    if (Memi[FC_DTYPE(fc)+i] == LOG)
+		out[1] = 10. ** out[1]
+	}
+
+	out[1] = out[1] / Memd[FC_Z(fc)+i]
+end
+
+
+# WF_MSP_INV -- Evaluate W -> P (world to physical transformation).
+
+procedure wf_msp_inv (fc, in, out)
+
+pointer	fc			#I pointer to FC descriptor
+double	in[2]			#I point to sample WCS at
+double	out[2]			#O value of WCS at that point
+
+int	i
+pointer	coeff
+double	din, dinmin
+double	wf_msp_evali()
+
+begin
+	out[2] = 1
+	dinmin = abs (in[2] - Memi[FC_APS(fc)])
+	do i = 1, FC_NAPS(fc)-1 {
+	    din = abs (in[2] - Memi[FC_APS(fc)+i])
+	    if (din < dinmin) {
+		out[2] = i + 1
+		dinmin = din
+	    }
+	}
+
+	i = nint (out[2]) - 1
+	if (i < 0 || i >= FC_NAPS(fc))
+	    call error (5, "WFMSPEC: Coordinate out of bounds")
+	if (Memi[FC_NPTS(fc)+i] == 0)
+	    call error (6, "WFMSPEC: No dispersion function")
+
+	din = in[1] * Memd[FC_Z(fc)+i]
+	if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+	    coeff = Memi[FC_COEFF(fc)+i]
+	    out[1] = wf_msp_evali (Memd[coeff], din, Memd[FC_X(fc)+i],
+		Memd[FC_DYDX(fc)+i])
+	} else {
+	    if (Memi[FC_DTYPE(fc)+i] == LOG)
+		din = log10 (din)
+	    out[1] = (din-Memd[FC_CRVAL(fc)+i]) / Memd[FC_CDELT(fc)+i] + 1
+	    out[1] = max (0.5D0, min (double(Memi[FC_NPTS(fc)+i]+0.5), out[1]))
+	}
+end
+
+
+# WF_MSP_COEFF -- Initialize nonlinear coefficient array.
+
+procedure wf_msp_coeff (atval, coeff, xmin, xmax)
+
+char	atval[ARB]		#I attribute string
+pointer	coeff			#O coefficient array
+double	xmin, xmax		#I x limits
+
+double	dval, temp
+int	ncoeff, type, order, ip, i
+errchk	malloc, realloc
+double	wf_msp_eval()
+int	ctod()
+
+begin
+	coeff = NULL
+	ncoeff = 5
+
+	ip = 1
+	while (ctod (atval, ip, dval) > 0) {
+	    if (coeff == NULL)
+		call malloc (coeff, NALLOC, TY_DOUBLE)
+	    else if (mod (ncoeff, NALLOC) == 0)
+		call realloc (coeff, ncoeff+NALLOC, TY_DOUBLE)
+	    Memd[coeff+ncoeff] = dval
+	    ncoeff = ncoeff + 1
+	}
+	if (coeff == NULL)
+	    return
+
+	# Convert range elements to a more efficient form.
+	call realloc (coeff, ncoeff, TY_DOUBLE)
+	Memd[coeff] = ncoeff
+	i = 6
+	while (i < ncoeff) {
+	    type = nint (Memd[coeff+i+1])
+	    order = nint (Memd[coeff+i+2])
+	    switch (type) {
+	    case CHEBYSHEV, LEGENDRE:
+		dval = 2 / (Memd[coeff+i+4] - Memd[coeff+i+3])
+		Memd[coeff+i+3] = (Memd[coeff+i+4] + Memd[coeff+i+3]) / 2
+		Memd[coeff+i+4] = dval
+		i = i + 6 + order
+	    case SPLINE3:
+		Memd[coeff+i+4] = nint (Memd[coeff+i+2]) /
+		    (Memd[coeff+i+4] - Memd[coeff+i+3])
+		i = i + 9 + order
+	    case SPLINE1:
+		Memd[coeff+i+4] = nint (Memd[coeff+i+2]) /
+		    (Memd[coeff+i+4] - Memd[coeff+i+3])
+		i = i + 7 + order
+	    case PIXEL:
+		i = i + 4 + order
+	    case SAMPLE:
+		Memd[coeff+i+3] = i + 5
+		i = i + 5 + order
+	    }
+	}
+
+	# Set function limits.
+	Memd[coeff+1] = xmin
+	Memd[coeff+2] = xmax
+	dval = wf_msp_eval (Memd[coeff], xmin)
+	temp = wf_msp_eval (Memd[coeff], xmax)
+	Memd[coeff+3] = min (dval, temp)
+	Memd[coeff+4] = max (dval, temp)
+end
+
+
+# WF_MSP_EVAL -- Evaluate nonlinear function.
+
+double procedure wf_msp_eval (coeff, xin)
+
+double	coeff[ARB]			#I coefficients
+double	xin				#I physical coordinate for evaluation
+
+int	i, j, k, ncoeff, type, order
+double	xval, x, y, w, ysum, wsum, a, b, c	
+
+begin
+	ncoeff = nint (coeff[1])
+	xval = max (coeff[2], min (coeff[3], xin))
+	ysum = 0.
+	wsum = 0.
+	j = 6
+	while (j < ncoeff) {
+	    type = nint (coeff[j+2])
+	    order = nint (coeff[j+3])
+	    y = coeff[j+1]
+	    w = coeff[j]
+	    switch (type) {
+	    case CHEBYSHEV:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		y = y + coeff[j+6]
+		if (order > 1)
+		    y = y + coeff[j+7] * x
+		if (order > 2) {
+		    k = j + 8
+		    a = 1
+		    b = x
+		    do i = 3, order {
+			c = 2 * x * b - a
+			y = y + coeff[k] * c
+			a = b
+			b = c
+			k = k + 1
+		    }
+		}
+		j = j + 6 + order
+	    case LEGENDRE:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		y = y + coeff[j+6]
+		if (order > 1)
+		    y = y + coeff[j+7] * x
+		if (order > 2) {
+		    k = j + 8
+		    a = 1
+		    b = x
+		    do i = 3, order {
+			c = ((2 * i - 3) * x * b - (i - 2) * a) / (i - 1)
+			y = y + coeff[k] * c
+			a = b
+			b = c
+			k = k + 1
+		    }
+		}
+		j = j + 6 + order
+	    case SPLINE3:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		i = max (0, min (int (x), order-1))
+		k = j + 6 + i
+		b = x - i
+		a = 1 - b
+		c = a * a * a
+		y = y + c * coeff[k]
+		c = 1 + 3 * a * (1 + a * b)
+		y = y + c * coeff[k+1]
+		c = 1 + 3 * b * (1 + a * b)
+		y = y + c * coeff[k+2]
+		c = b * b * b
+		y = y + c * coeff[k+3]
+		j = j + 9 + order
+	    case SPLINE1:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		i = max (0, min (int (x), order-1))
+		k = j + 6 + i
+		b = x - i
+		a = 1 - b
+		y = y + a * coeff[k] + b * coeff[k+1]
+		j = j + 7 + order
+	    case PIXEL:
+		i = max (1, min (int (xval), order-1))
+		x = xval - i
+		y = y + (1 - x) * coeff[j+3+i] + x * coeff[j+4+i]
+		j = j + 4 + order
+	    case SAMPLE:
+		i = nint (coeff[j+4])
+		for (k=j+2+order; i < k && xval > coeff[i+2]; i=i+2)
+		    ;
+		for (k=j+5; i > k && xval < coeff[i-2]; i=i-2)
+		    ;
+		coeff[j+4] = i
+		x = (xval - coeff[i]) / (coeff[i+2] - coeff[i])
+		y = y + (1 - x) * coeff[i+1] + x * coeff[i+3]
+		j = j + 5 + order
+	    }
+	    ysum = ysum + w * y
+	    wsum = wsum + w
+	}
+	ysum = ysum / wsum
+
+	return (ysum)
+end
+
+
+# WF_MSP_EVALI -- Evaluate inverse of nonlinear function.
+
+double procedure wf_msp_evali (coeff, y, x, dydx)
+
+double	coeff[ARB]		#I function coefficients
+double	y			#I world coord to invert
+double	x			#U last physical coordinate
+double	dydx			#U last coordinate derivative
+
+int     i
+double  xval, yval, y1, dx, dy
+double  wf_msp_eval()
+bool	fp_equald()
+
+begin
+	yval = max (coeff[4], min (coeff[5], y))
+
+        dx = 0.
+	dy = 0.
+        do i = 1, NIT {
+            y1 = wf_msp_eval (coeff, x)
+            if (dx > 1.) {
+		if (x + 1 < coeff[3])
+		    dy = wf_msp_eval (coeff, x+1.) - y1
+		else
+		    dy = y1 - wf_msp_eval (coeff, x-1.)
+            } else if (dx < -1.) {
+		if (x - 1 > coeff[2])
+		    dy = y1 - wf_msp_eval (coeff, x-1.)
+		else
+		    dy = wf_msp_eval (coeff, x+1.) - y1
+	    }
+	    if (!fp_equald (dy, 0.0D0))
+		dydx = dy
+            dx = (yval - y1) / dydx
+            x = x + dx
+	    x = max (coeff[2], min (coeff[3], x))
+            if (abs (dx) < DX)
+                break
+        }
+
+	if (i > NIT) {
+	    xval = (coeff[2] + coeff[3]) / 2.
+	    yval = abs (wf_msp_eval (coeff, xval) - y)
+	    dx = (coeff[3] - coeff[2]) / 18.
+	    while (dx > DX) {
+		for (x=max (coeff[2],xval-9*dx); x<=min (coeff[3],xval+9*dx);
+		    x=x+dx) {
+		    dy = abs (wf_msp_eval (coeff, x) - y)
+		    if (dy < yval) {
+			xval = x
+			yval = dy
+		    }
+		}
+		dx = dx / 10.
+	    }
+	    x = xval
+	    if (x + 1 < coeff[3])
+		dy = wf_msp_eval (coeff, x+1.) - wf_msp_eval (coeff, x)
+	    else
+		dy = wf_msp_eval (coeff, x) - wf_msp_eval (coeff, x-1.)
+	    if (!fp_equald (dy, 0.0D0))
+		dydx = dy
+	}
+		
+	yval = int (x)
+	x = yval + nint ((x-yval) / DX) * DX
+
+	return (x)
+end
diff --git a/sys/mwcs/wfpar.x b/sys/mwcs/wfpar.x
new file mode 100644
index 00000000..673aa81e
--- /dev/null
+++ b/sys/mwcs/wfpar.x
@@ -0,0 +1,458 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFPAR
+.nf -------------------------------------------------------------------------
+WFPAR -- WCS function driver for the Craster or parabolic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_par_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_par_fwd (fc, v1, v2)
+	FN_INV		     wf_par_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO (degs)
+define	FC_PIRODEG	Memd[P2D($1+FCU+18)]	     # PI * RO (degs)
+define	FC_RECPIRODEG	Memd[P2D($1+FCU+20)]	     # 1 / (PI * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+22)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+24)+($2)-1]  # CRVAL axis (1 and 2)
+
+# WF_PAR_INIT -- Initialize the forward or inverse Craster or parabolic
+# transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and associated
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined then the
+# most northerly of the two possible solutions is chosen, otherwise the
+# solution closest to LATPOLE is chosen. If RO is undefined a value of 180.0 /
+# PI is assumed. In order to determine the axis order, the  parameter
+# "axtype={ra|dec} {xlon|xlat}" must have been set in the attribute list for
+# the function. The LONGPOLE, LATPOLE,  and RO parameters may be set in either
+# or both of the axes attribute lists, but the value in the RA axis attribute
+# list takes precedence. 
+
+procedure wf_par_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_PAR_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+	FC_PIRODEG(fc) = DPI * FC_RODEG(fc)
+	FC_RECPIRODEG(fc) = 1.0d0 / FC_PIRODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_PAR_FWD -- Forward transform (physical to world) for the Craster or
+# parabolic projection.
+
+procedure wf_par_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, s, t, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	s = y * FC_RECPIRODEG(fc)
+	if (s > 1.0d0 || s < -1.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	t = 1.0d0 - 4.0d0 * s * s
+	if (t == 0.0d0) {
+	    if (x == 0.0d0) {
+		phi = 0.0d0
+	    } else {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	} else
+	    phi = FC_RECRODEG(fc) * x / t
+
+	# Compute THETA.
+	theta = 3.0d0 * asin (s)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_PAR_INV -- Inverse transform (world to physical) for the Craster
+# or parabolic projection.
+
+procedure wf_par_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = sin (theta / 3.0d0)
+	p[ira] = FC_RODEG(fc) * phi * (1.0d0 - 4.0 * s * s)
+	p[idec] = FC_PIRODEG(fc) * s
+end
diff --git a/sys/mwcs/wfpco.x b/sys/mwcs/wfpco.x
new file mode 100644
index 00000000..a9cd8e12
--- /dev/null
+++ b/sys/mwcs/wfpco.x
@@ -0,0 +1,518 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFPCO
+.nf -------------------------------------------------------------------------
+WFPCO -- WCS function driver for the polyconic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_pco_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_pco_fwd (fc, v1, v2)
+	FN_INV		     wf_pco_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RORAD	Memd[P2D($1+FCU+16)]	     # RO (rads)
+define	FC_RECRORAD	Memd[P2D($1+FCU+18)]	     # 1 / RO (rads)
+define	FC_2RODEG	Memd[P2D($1+FCU+20)]	     # 2 * RO 
+define	FC_BADCVAL	Memd[P2D($1+FCU+22)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+24)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_PCO_INIT -- Initialize the polyconic forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude  of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler anges and various
+# intermediary functions of the reference point, and reading in the
+# projection parameter RO from the attribute list. If LONGPOLE is undefined
+# then a value of 180.0 degrees is assumed if the native latitude of the
+# reference point is less than 0, otherwise 0 is assumed. If LATPOLE is
+# undefined then the most northerly of the two possible solutions for the
+# latitude of the native pole is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE and RO parameters may be set in either or both of the
+# axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_pco_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_PCO_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RORAD(fc) = DDEGTORAD(FC_RODEG(fc))
+	FC_RECRORAD(fc) = 1.0d0 / FC_RORAD(fc)
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_PCO_FWD -- Forward transform (physical to world) for the polyconic
+# projection.
+
+procedure wf_pco_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, j
+double	x, y, z, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, wconst, tol, thepos, theneg, xx, ymthe, fpos, fneg, lambda
+double	tanthe, f, dlng
+double	xp, yp
+data	tol / 1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI and THETA.
+	wconst = abs (y * FC_RECRORAD(fc))
+	if (wconst < tol) {
+	    phi = x * FC_RECRORAD(fc)
+	    theta = 0.0d0
+	} else if (abs (wconst - 90.0d0) < tol) {
+	    phi = 0.0d0
+	    if (y >= 0.0d0)
+		theta = DHALFPI
+	    else
+		theta = -DHALFPI
+	} else {
+	    if (y > 0.0d0)
+		thepos = 90.0d0
+	    else
+		thepos = -90.0d0
+	    theneg = 0.0d0
+
+	    xx = x * x
+	    ymthe = y - FC_RORAD(fc) * thepos
+	    fpos = xx + ymthe * ymthe
+	    fneg = -999.0d0
+
+	    do j = 1, 64 {
+
+		# Compute the required interval.
+		if (fneg < -100.0d0)
+		    theta = (thepos + theneg) / 2.0d0
+		else {
+		    lambda = fpos / (fpos - fneg)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    theta = thepos - lambda * (thepos - theneg)
+		}
+
+		# Compute the residue.
+		ymthe = y - FC_RORAD(fc) * theta
+		tanthe = tan (DDEGTORAD(theta))
+		f = xx + ymthe * (ymthe - FC_2RODEG(fc) / tanthe)
+
+		# Check for convergence.
+		if (abs(f) < tol)
+		    break
+		if (abs (thepos - theneg) < tol)
+		    break
+
+		# Redefine the interval
+		if (f > 0.0d0) {
+		    thepos = theta
+		    fpos = f
+		} else {
+		    theneg = theta
+		    fneg = f
+		}
+	    }
+
+	    theta = DDEGTORAD(theta)
+	    xp = FC_RODEG(fc) - ymthe * tanthe
+	    yp = x * tanthe
+	    if (xp == 0.0d0 && yp == 0.0d0)
+		phi = 0.0d0
+	    else
+		phi = atan2 (yp, xp) / sin (theta)
+	}
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+	if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_PCO_INV -- Inverse transform (world to physical) for the polyconic
+# projection.
+
+procedure wf_pco_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, costhe
+double	a, sinthe, cotthe, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x) 
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	a = phi * sinthe
+	if (sinthe == 0.0d0) {
+	    p[ira] = FC_RODEG(fc) * phi 
+	    p[idec] = 0.0d0
+	} else {
+	    cotthe = costhe / sinthe
+	    p[ira] = FC_RODEG(fc) * cotthe * sin (a)
+	    p[idec] = FC_RODEG(fc) * (cotthe * (1.0d0 - cos(a)) + theta) 
+	}
+
+end
diff --git a/sys/mwcs/wfqsc.x b/sys/mwcs/wfqsc.x
new file mode 100644
index 00000000..b75535e7
--- /dev/null
+++ b/sys/mwcs/wfqsc.x
@@ -0,0 +1,758 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFQSC
+.nf -------------------------------------------------------------------------
+WFQSC -- WCS function driver for quadrilateralized spherical cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_qsc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_qsc_fwd (fc, v1, v2)
+	FN_INV		     wf_qsc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_QSC_INIT -- Initialize the forward or inverse quarilateralized spherical
+# cube projection transform. Initialization for this transformation consists
+# of, determining which axis is RA / LON and which is DEC / LAT, reading in
+# the native longitude and latitude of the pole in celestial coordinates
+# LONGPOLE and LATPOLE from the attribute list, computing the celestial
+# longitude and colatitude of the native pole, precomputing the Euler angles
+# and various intermediary functions of the reference point, reading in the
+# projection parameter RO from the attribute list, and precomputing the various
+# required intermediate quantities. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed if the celestial latitude is less than 0, otherwise
+# 0 degrees is assumed. If LATPOLE is undefined the most northerly of the two
+# possible solutions is chosen, otherwise the solution closest to LATPOLE is
+# chosen. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE, LATPOLE,
+# and RO parameters may be set in either or both of the axes attribute lists,
+# but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_qsc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_QCS_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_QSC_FWD -- Forward transform (physical to world) for the quarilateralized
+# spherical projection.
+
+procedure wf_qsc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face, direct
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	xf, yf, rho, chi, psi, tol, wconst, ra, dec, dlng, rhu
+data	tol /1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0d0) {
+	    face = 4
+	    xf = xf - 6.0d0
+	} else if (xf > 3.0d0) {
+	    face = 3
+	    xf = xf - 4.0d0
+	} else if (xf > 1.0d0) {
+	    face = 2
+	    xf = xf - 2.0d0
+	} else if (yf > 1.0d0) {
+	    face = 0
+	    yf = yf - 2.0d0
+	} else if (yf < -1.0d0) {
+	    face = 5
+	    yf = yf + 2.0d0
+	} else {
+	    face = 1
+	}
+
+	if (abs(xf) > abs(yf))
+	    direct = YES
+	else
+	    direct = NO
+	if (direct == YES) {
+	    if (xf == 0.0d0) {
+		psi = 0.0d0
+		chi = 1.0d0
+		rho = 1.0d0
+		rhu = 0.0d0
+	    } else {
+		wconst = DDEGTORAD(15.0d0 * yf / xf)
+		psi = sin (wconst) / (cos (wconst) - 1.0d0 / DSQRTOF2)
+		chi = 1.0d0 + psi * psi
+		rhu = xf * xf * (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi))
+		rho = 1.0d0 - rhu
+	    }
+	} else {
+	    if (yf == 0.0d0) {
+		psi = 0.0d0
+		chi = 1.0d0
+		rho = 1.0d0
+		rhu = 0.0d0
+	    } else {
+		wconst = DDEGTORAD(15.0d0 * xf / yf)
+		psi = sin (wconst) / (cos (wconst) - 1.0d0 / DSQRTOF2)
+		chi = 1.0d0 + psi * psi
+		rhu = yf * yf * (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi))
+		rho = 1.0d0 - rhu
+	    }
+	}
+
+	if (rho < -1.0d0) {
+	    if (rho < (-1.0d0 - tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    rho = -1.0d0
+	    rhu = 2.0d0
+	    wconst = 0.0d0
+	} else {
+	    wconst = sqrt (rhu * (2.0d0 - rhu) / chi)
+	}
+
+	switch (face) {
+	case 0:
+	    n = rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		m = -l * psi
+	    } else {
+		m = wconst
+		if (yf > 0.0d0)
+		    m = -m
+		l = -m * psi
+	    }
+
+	case 1:
+	    m = rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		n = l * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		l = n * psi
+	    }
+
+	case 2:
+	    l = rho
+	    if (direct == YES) {
+		m = wconst
+		if (xf > 0.0d0)
+		    m = -m
+		n = -m * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		m = -n * psi
+	    }
+
+	case 3:
+	    m = -rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf > 0.0d0)
+		    l = -l
+		n = -l * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		l = -n * psi
+	    }
+
+	case 4:
+	    l = -rho
+	    if (direct == YES) {
+		m = wconst
+		if (xf < 0.0d0)
+		    m = -m
+		n = m * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		m = n * psi
+	    }
+
+	case 5:
+	    n = -rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		m = l * psi
+	    } else {
+		m = wconst
+		if (yf < 0.0d0)
+		    m = -m
+		l = m * psi
+	    }
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_QSC_INV -- Inverse transform (world to physical) for the quadilateralized
+# spherical projection.
+
+procedure wf_qsc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+double	costhe, eta, l, m, n, rho, xi, tol, x0, y0, psi, chi, xf, yf
+double	pconst, t, rhu
+data	tol /1.0d-12/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+	if (abs(theta) == DHALFPI) {
+	    p[ira] = 0.0d0
+	    if (theta >= 0.0d0)
+	        p[idec] = 2.0d0 * FC_C1(fc) 
+	    else
+	        p[idec] = -2.0d0 * FC_C1(fc) 
+	    return
+	}
+
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+	rhu = 1.0d0 - rho
+
+	switch (face) {
+	case 0:
+	    xi = l
+	    eta = -m
+	    if (rhu < 1.0d-8) {
+		t = (DHALFPI - theta)
+		rhu = t * t / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = 2.0d0
+	case 1:
+	    xi = l
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < -DPI)
+		     pconst = pconst + DTWOPI
+		if (pconst > DPI)
+		     pconst = pconst - DTWOPI
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = 0.0d0
+	case 2:
+	    xi = -m
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < -DPI)
+		     pconst = pconst + DTWOPI
+		pconst = (DHALFPI - pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 2.0d0
+	    y0 = 0.0d0
+	case 3:
+	    xi = -l
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < 0.0d0)
+		     pconst = pconst + DTWOPI
+		pconst = (DPI - pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 4.0d0
+	    y0 = 0.0d0
+	case 4:
+	    xi = m
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst > DPI)
+		     pconst = pconst - DTWOPI
+		pconst = (DHALFPI + pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 6.0d0
+	    y0 = 0.0d0
+	case 5:
+	    xi = l
+	    eta = m
+	    if (rhu < 1.0d-8) {
+		t = (DHALFPI + theta)
+		rhu = t * t / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = -2.0d0
+	}
+
+	if (xi == 0.0d0 && eta == 0.0d0) {
+	    xf = 0.0d0
+	    yf = 0.0d0
+	} else if (-xi >= abs(eta)) {
+	    psi = eta / xi
+	    chi = 1.0d0 + psi * psi
+	    xf = -sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    yf = (xf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (xi >= abs(eta)) {
+	    psi = eta / xi
+	    chi = 1.0d0 + psi * psi
+	    xf = sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    yf = (xf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (-eta > abs (xi)) {
+	    psi = xi / eta
+	    chi = 1.0d0 + psi * psi
+	    yf = -sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    xf = (yf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (eta > abs (xi)) {
+	    psi = xi / eta
+	    chi = 1.0d0 + psi * psi
+	    yf = sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    xf = (yf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	}
+
+	if (abs(xf) > 1.0d0) {
+	    if (abs(xf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0d0)
+		xf = 1.0d0
+	    else
+		xf = -1.0d0
+	}
+	if (abs(yf) > 1.0d0) {
+	    if (abs(yf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0d0)
+		yf = 1.0d0
+	    else
+		yf = -1.0d0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfsamp.x b/sys/mwcs/wfsamp.x
new file mode 100644
index 00000000..992f3211
--- /dev/null
+++ b/sys/mwcs/wfsamp.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+.help WFSAMP
+.nf -------------------------------------------------------------------------
+WFSAMP -- WCS function driver for the one dimensional sampled wcs function.
+For this driver, the function P<->W (physical to/from world) is defined by
+a sampled WCS curve.
+
+Driver routines:
+
+	FN_INIT		    wf_smp_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		   wf_smp_ctran (fc, v1, v2)
+	FN_INV				(same)
+
+In this initial implementation, only linear interpolation of the sampled
+curve is provided, but the driver is easily extended to provide additional
+interpolators.  NOTE that this entire driver assumes that the sampled function
+is monotonic.
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_NPTS		Memi[$1+FCU]		# number of points in curve
+define	FC_LOC		Memi[$1+FCU+1]		# location in IN vector
+define	FC_V1		Memi[$1+FCU+2]		# pointer to IN vector
+define	FC_V2		Memi[$1+FCU+3]		# pointer to OUT vector
+define	FC_W		Memd[P2D($1+FCU+4)]	# W value (CRVAL)
+define	FC_DIR		Memi[$1+FCU+6]		# direction of transform
+
+
+# WF_SMP_INIT -- Initialize the function call descriptor for the indicated
+# type of transform (forward or inverse).
+
+procedure wf_smp_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I type of transformation
+
+int	axis, npts
+pointer	wp, mw, sp, emsg, pv, wv
+
+begin
+	# Enforce the current restriction to 1-dim sampled functions.
+	if (FC_NAXES(fc) != 1)
+	    call error (1, "Sampled wcs functions must be 1-dimensional")
+
+	wp = FC_WCS(fc)
+	mw = CT_MW(FC_CT(fc))
+	axis = CT_AXIS(FC_CT(fc),1)
+
+	# Get pointers to the input and output sample vectors.  For our
+	# purposes there is no difference between the forward and inverse
+	# transform; we just swap the vectors for the inverse transform.
+	# The use of direct pointers here assumes that the DBUF is not
+	# reallocated while the CTRAN is being used.
+
+	npts = WCS_NPTS(wp,axis)
+	pv   = WCS_PV(wp,axis)
+	wv   = WCS_WV(wp,axis)
+
+	# Verify that we have a sampled WCS for this axis.
+	if (npts <= 0 || pv == NULL || wv == NULL) {
+	    call smark (sp)
+	    call salloc (emsg, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[emsg], SZ_LINE,
+		"No sampled wcs entered for axis %d")
+		call pargi (axis)
+	    call error (2, Memc[emsg])
+	    call sfree (sp)
+	}
+
+	if (dir == FORWARD) {
+	    FC_V1(fc) = MI_DBUF(mw) + pv - 1
+	    FC_V2(fc) = MI_DBUF(mw) + wv - 1
+	} else {
+	    FC_V1(fc) = MI_DBUF(mw) + wv - 1
+	    FC_V2(fc) = MI_DBUF(mw) + pv - 1
+	}
+
+	FC_NPTS(fc) = npts
+	if (WCS_W(wp) == NULL)
+	    FC_W(fc) = 0.0
+	else
+	    FC_W(fc) = D(mw,WCS_W(wp)+axis-1)
+
+	FC_LOC(fc) = 1
+	FC_DIR(fc) = dir
+end
+
+
+# WF_SMP_CTRAN -- Given the coordinates of a point X in the input curve,
+# locate the sample interval containing the point, and return the coordinate
+# of the same point in the output curve using simple linear interpolation
+# (currently) to evaluate the WCS function value.
+
+procedure wf_smp_ctran (fc, a_x, a_y)
+
+pointer	fc			#I pointer to FC descriptor
+double	a_x			#I point to sample WCS at
+double	a_y			#O value of WCS at that point
+
+int	index, i, step
+double	frac, x, y
+pointer	ip, op, i1, i2
+int	wf_smp_binsearch()
+define	sample_ 91
+define	oor_ 92
+
+begin
+	# Get the input X value.
+	if (FC_DIR(fc) == FORWARD)
+	    x = a_x
+	else
+	    x = a_x - FC_W(fc)
+
+	# Check for out of bounds and set step.
+	i1 = FC_V1(fc)
+	i2 = i1 + FC_NPTS(fc) - 1
+	if (Memd[i1] <= Memd[i2]) {
+	    if (x < Memd[i1] || x > Memd[i2])
+		goto oor_
+	    step = 1
+	} else {
+	    if (x < Memd[i2] || x > Memd[i1])
+		goto oor_
+	    step = -1
+	}
+
+	# Check the endpoints and the last inverval to optimize the case of
+	# repeated samplings of the same region of the curve.
+
+	if (x == Memd[i1])
+	    ip = i1 - min (0, step)
+	else if (x == Memd[i2])
+	    ip = i2 - max (0, step)
+	else
+	    ip = FC_LOC(fc) + i1 - 1
+	if (Memd[ip] <= x && x <= Memd[ip+step])
+	    goto sample_
+
+	# Next check several intervals to either side.
+	if (x < Memd[ip]) {
+	    do i = 1, 5 {
+		ip = ip - step
+		if (Memd[ip] <= x)
+		    goto sample_
+	    }
+	} else {
+	    do i = 1, 5 {
+		if (Memd[ip+step] >= x)
+		    goto sample_
+		ip = ip + step
+	    }
+	}
+
+	# Give up and do a full binary search!
+	index = wf_smp_binsearch (x, Memd[i1], FC_NPTS(fc))
+	if (index == 0)
+	    goto oor_
+	else
+	    ip = i1 + index - 1
+
+	# Having found the proper interval, compute the function value by
+	# interpolating the output vector.
+sample_
+	op = FC_V2(fc) + ip-i1
+	frac = (x - Memd[ip]) / (Memd[ip+step] - Memd[ip])
+	y = (Memd[op+step] - Memd[op]) * frac + Memd[op]
+
+	# Get the output Y value.
+	if (FC_DIR(fc) == FORWARD)
+	    a_y = y
+	else
+	    a_y = y + FC_W(fc)
+
+	# Save last location.
+	FC_LOC(fc) = ip - i1 + 1
+
+	return
+oor_
+	# Given X value is not in the region covered by the sampled curve,
+	# or at least we couldn't find it with a binary search.
+
+	call error (2, "Out of bounds reference on sampled WCS curve")
+end
+
+
+# WF_SMP_BINSEARCH -- Perform a binary search of a sorted array for the
+# interval containing the given point.
+
+int procedure wf_smp_binsearch (x, v, npts)
+
+double	x				#I point we want interval for
+double	v[ARB]				#I array to be searched
+int	npts				#I number of points in array
+
+int	low, high, pos, i
+
+begin
+	low = 1
+	high = max (1, npts)
+
+	# Cut range of search in half until interval is found, or until range
+	# vanishes (high - low <= 1).
+
+	if (v[1] < v[npts]) {
+	    do i = 1, npts {
+		pos = min ((high - low) / 2 + low, npts-1)
+		if (pos == low)
+		    return (0)				# not found
+		else if (v[pos] <= x && x <= v[pos+1])
+		    return (pos)
+		else if (x < v[pos])
+		    high = pos
+		else
+		    low = pos
+	    }
+	} else {
+	    do i = 1, npts {
+		pos = min ((high - low) / 2 + low, npts-1)
+		if (pos == low)
+		    return (0)				# not found
+		else if (v[pos+1] <= x && x <= v[pos])
+		    return (pos+1)
+		else if (x > v[pos])
+		    high = pos
+		else
+		    low = pos
+	    }
+	}
+end
diff --git a/sys/mwcs/wfsin.x b/sys/mwcs/wfsin.x
new file mode 100644
index 00000000..a1b18d82
--- /dev/null
+++ b/sys/mwcs/wfsin.x
@@ -0,0 +1,150 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFSIN
+.nf -------------------------------------------------------------------------
+WFSIN -- WCS function driver for the sine projection.
+
+Driver routines:
+
+	FN_INIT		    wf_sin_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_sin_fwd (fc, v1, v2)
+	FN_INV		     wf_sin_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_SIN_INIT -- Initialize the sine forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+# NOTE:  This is identical to wf_tan_init.
+
+procedure wf_sin_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_SIN_FWD -- Forward transform (physical to world), sine
+# projection.  Based on code from STScI, Hodge et al.
+
+procedure wf_sin_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	v1, xi, eta, x, y, z, ra, dec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	v1 = 1.d0 - xi*xi - eta*eta
+	if (v1 > 0.d0)
+	    v1 = sqrt (1.d0 - xi*xi - eta*eta)
+	else
+	    v1 = 0.d0
+
+	# Rotate the rectangular coordinate system of the vector (v1, xi, eta)
+	# by the declination so the X axis will pass through the equator.
+
+	x = v1 * FC_COSDEC(fc) - eta * FC_SINDEC(fc)
+	y = xi
+	z = v1 * FC_SINDEC(fc) + eta * FC_COSDEC(fc)
+
+	if (x == 0.d0 && y == 0.d0)
+	    ra = 0.d0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0.d0)
+	    ra = ra + 360.D0
+	else if (ra > 360.D0)
+	    ra = ra - 360.D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_SIN_INV -- Inverse transform (world to physical) for the sine
+# projection.  Based on code from Eric Greisen, AIPS Memo No. 27.
+
+procedure wf_sin_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#O output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	xi = cosdec * sinra
+	eta = sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
diff --git a/sys/mwcs/wfstg.x b/sys/mwcs/wfstg.x
new file mode 100644
index 00000000..e8ee66b4
--- /dev/null
+++ b/sys/mwcs/wfstg.x
@@ -0,0 +1,327 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFSTG
+.nf -------------------------------------------------------------------------
+WFSTG -- WCS function driver for the stereographic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_stg_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_stg_fwd (fc, v1, v2)
+	FN_INV		     wf_stg_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+2)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+4)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+6)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+8)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+10)]		# trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+12)]		# RO (degs)
+define	FC_2RODEG	Memd[P2D($1+FCU+14)]		# 2 * RO (degs)
+define	FC_REC2RODEG	Memd[P2D($1+FCU+16)]		# 1 / (2 * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_STG_INIT -- Initialize the stereographic forward or inverse transform.
+# Initialization for this transformation consists of, determining which
+# axis is RA / LON and which is DEC / LAT, computing the celestial longitude
+# and colatitude of the native pole, reading in the the native longitude of the
+# pole of the celestial coordinate system LONGPOLE from the attribute list,
+# precomputing the Euler angles and various intermediary functions of the
+# reference coordinates, reading in the projection parameter RO from the
+# attribute list, and precomputing some intermediate parameters. If LONGPOLE
+# is undefined then a value of 180.0 degrees is assumed. If RO is undefined a
+# value of 180.0 / PI is assumed. The STG projection is equivalent to the AZP
+# projection with MU set to 1.0. In order to determine the axis order, the
+# parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the attribute
+# list for the function. The LONGPOLE and RO parameters may be set in either
+# or both of the axes attribute lists, but the value in the RA axis attribute
+# list takes precedence. 
+
+procedure wf_stg_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+	FC_REC2RODEG(fc) = 1.0d0 / FC_2RODEG(fc)
+
+	# Fetch the spherical trigonometry tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Fetch the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_STG_FWD -- Forward transform (physical to world) for the stereographic
+# projection.
+
+procedure wf_stg_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - 2.0d0 * atan (r * FC_REC2RODEG(fc))
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_STG_INV -- Inverse transform (world to physical) for the stereographic
+# projection.
+
+procedure wf_stg_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = 1.0d0 + sin (theta)
+	if (s == 0.0d0) {
+	    p[ira]  = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    r = FC_2RODEG(fc) * cos (theta) / s
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+	}
+end
diff --git a/sys/mwcs/wftan.x b/sys/mwcs/wftan.x
new file mode 100644
index 00000000..2c5a0c5f
--- /dev/null
+++ b/sys/mwcs/wftan.x
@@ -0,0 +1,145 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTAN
+.nf -------------------------------------------------------------------------
+WFTAN -- WCS function driver for the tangent plane (gnonomic) projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tan_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_tan_fwd (fc, v1, v2)
+	FN_INV		     wf_tan_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_TAN_INIT -- Initialize the tangent plane forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+
+procedure wf_tan_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_TAN_FWD -- Forward transform (physical to world), tangent plane
+# projection.  Based on code from STScI, Hodge et. al.
+
+procedure wf_tan_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	xi, eta, x, y, z, ra, dec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	# Rotate the rectangular coordinate system of the vector [1,xi,eta]
+	# by the declination so that the X axis will pass through the equator.
+
+	x = FC_COSDEC(fc) - eta * FC_SINDEC(fc)
+	y = xi
+	z = FC_SINDEC(fc) + eta * FC_COSDEC(fc)
+
+	# Compute RA and DEC in radians.
+	if (x == 0.0D0 && y == 0.0D0)
+	    ra = 0.0D0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0)
+	    ra = ra + 360D0
+	else if (ra > 360D0)
+	    ra = ra - 360D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TAN_INV -- Inverse transform (world to physical) for the tangent plane
+# projection.  Based on code from STScI, Hodge et. al.
+
+procedure wf_tan_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec, cosdist
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+	cosdist = sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra
+
+	xi = cosdec * sinra / cosdist
+	eta = (sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra) /
+	    cosdist
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
diff --git a/sys/mwcs/wftnx.x b/sys/mwcs/wftnx.x
new file mode 100644
index 00000000..d8b753a6
--- /dev/null
+++ b/sys/mwcs/wftnx.x
@@ -0,0 +1,439 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTNX
+.nf -------------------------------------------------------------------------
+WFTNX -- WCS function driver for the gnomonic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tn_init (fc, dir)
+	FN_DESTROY       wf_tnx_destroy (fc)
+	FN_FWD		     wf_tnx_fwd (fc, v1, v2)
+	FN_INV		     wf_tnx_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define	MAX_NITER	20
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_LNGCOR	Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_LATCOR	Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+4)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+6)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+8)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+10)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+12)]		# trig toleracne
+define	FC_RODEG	Memd[P2D($1+FCU+14)]		# RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+16)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+18)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_TNX_INIT -- Initialize the gnomonic forward or inverse transform.
+# Initialization for this transformation consists of, determining which
+# axis is RA / LON and which is DEC / LAT, computing the celestial longitude
+# and colatitude of the native pole, reading in the the native longitude
+# of the pole of the celestial coordinate system LONGPOLE from the attribute
+# list, precomputing Euler angles and various intermediaries derived from the
+# coordinate reference values, and reading in the projection parameter RO
+# from the attribute list. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed. If RO is undefined a value of 180.0 / PI is assumed.
+# The TAN projection is equivalent to the AZP projection with MU set to 0.0.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|glat}{xlon|elat}" must have been set in the attribute list for the
+# function. The LONGPOLE and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_tnx_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, szatstr
+double	dec
+pointer	atvalue, ct, mw, wp, wv
+int	ctod(), strlen()
+pointer	wf_gsopen()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call malloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+	        if (IS_INDEFD(FC_LONGP(fc)))
+	            FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+	szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+	iferr {
+	    repeat {
+	        call mw_gwattrs (mw, FC_IRA(fc), "lngcor", Memc[atvalue],
+		    szatstr)
+		if (strlen (Memc[atvalue]) < szatstr)
+		    break
+		szatstr = szatstr + SZ_LINE 
+		call realloc (atvalue, szatstr, TY_CHAR)
+
+	    }
+	} then {
+	    FC_LNGCOR(fc) = NULL
+	} else {
+	    FC_LNGCOR(fc) = wf_gsopen (Memc[atvalue])
+	}
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+	iferr {
+	    repeat {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "latcor", Memc[atvalue],
+		    szatstr)
+		if (strlen (Memc[atvalue]) < szatstr)
+		    break
+		szatstr = szatstr + SZ_LINE 
+		call realloc (atvalue, szatstr, TY_CHAR)
+	    }
+	} then {
+	    FC_LATCOR(fc) = NULL
+	} else {
+	    FC_LATCOR(fc) = wf_gsopen (Memc[atvalue])
+	}
+
+	# Set the small angle spherical trigonometry tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call mfree (atvalue, TY_CHAR)
+end
+
+
+# WF_TNX_FWD -- Forward transform (physical to world) gnomonic projection.
+
+procedure wf_tnx_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, dlng, z
+double	ra, dec
+double	wf_gseval()
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	if (FC_LNGCOR(fc) == NULL)
+	    x = p[ira]
+	else
+	    x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+	if (FC_LATCOR(fc) == NULL)
+	    y = p[idec]
+	else
+	    y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = atan2 (FC_RODEG(fc), r)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+	if (abs (x) < FC_SPHTOL(fc))
+	    x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+		(1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI 
+	}
+	ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+	if (mod (dphi, DPI) == 0.0d0) {
+	    dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+	    if (dec > 90.0d0)
+		dec = 180.0d0 - dec
+	    if (dec < -90.0d0)
+		dec = -180.0d0 - dec
+	} else {
+	    z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+	    if (abs(z) > 0.99d0) {
+		if (z >= 0.0d0)
+		    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+		else
+		    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+	    } else
+		dec = DRADTODEG(asin (z))
+	}
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TNX_INV -- Inverse transform (world to physical) for the gnomic
+# projection.
+
+procedure wf_tnx_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy, dmax
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+	if (abs(x) < FC_SPHTOL(fc))
+	    x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+		(1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) ==0.0) {
+	    theta = dec + cosra * FC_COLATP(fc)
+	    if (theta > DHALFPI)
+		theta = DPI - theta
+	    if (theta < -DHALFPI)
+		theta = -DPI - theta
+	} else {
+	    z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+	    if (abs (z) > 0.99d0) {
+		if (z >= 0.0)
+		    theta = acos (sqrt(x * x + y * y))
+		else
+		    theta = -acos (sqrt(x * x + y * y))
+	    } else
+		theta = asin (z)
+	}
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = sin (theta)
+	if (s == 0.0d0) {
+	    p[ira] = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    r = FC_RODEG(fc) * cos (theta) / s
+	    if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	        p[ira]  = r * sin (phi)
+	        p[idec] = -r * cos (phi)
+	    } else {
+	        xm  = r * sin (phi)
+	        ym = -r * cos (phi)
+		x = xm
+		y = ym
+		niter = 0
+		dmax = 30. / 3600.
+		repeat {
+
+		    if (FC_LNGCOR(fc) != NULL) {
+		        f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+		        fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+		        fx = 1.0 + fx
+		        fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+		    } else {
+		        f = x - xm
+		        fx = 1.0 
+		        fy = 0.0
+		    }
+		    if (FC_LATCOR(fc) != NULL) {
+		        g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+		        gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+		        gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+		        gy = 1.0 + gy
+		    } else {
+		        g = y - ym
+		        gx = 0.0 
+		        gy = 1.0
+		    }
+
+		    denom = fx * gy - fy * gx
+		    if (denom == 0.0d0)
+			break
+		    dx = (-f * gy + g * fy) / denom
+		    dy = (-g * fx + f * gx) / denom
+		    x = x + max (-dmax, min (dmax, dx))
+		    y = y + max (-dmax, min (dmax, dy))
+		    if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+			break
+
+		    niter = niter + 1
+
+		} until (niter >= MAX_NITER)
+
+	        p[ira]  = x
+	        p[idec] = y
+	    }
+	}
+end
+
+
+# WF_TNX_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_tnx_destroy (fc)
+
+pointer	fc			#I pointer to the FC descriptor
+
+begin
+	if (FC_LNGCOR(fc) != NULL)
+	    call wf_gsclose (FC_LNGCOR(fc))
+	if (FC_LATCOR(fc) != NULL)
+	    call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/wftpv.x b/sys/mwcs/wftpv.x
new file mode 100644
index 00000000..812362be
--- /dev/null
+++ b/sys/mwcs/wftpv.x
@@ -0,0 +1,556 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include <ctype.h>
+include "imwcs.h"
+include	"mwcs.h"
+
+.help WFTPV
+.nf -------------------------------------------------------------------------
+# WFTPV -- WCS function driver for the TPV polynomial projection.
+
+Driver routines:
+
+	FN_INIT		 wf_tpv_init (fc, dir)
+	FN_DESTROY	 wf_tpv_destroy (fc)
+	FN_FWD		 wf_tpv_fwd (fc, v1, v2)
+	FN_INV		 wf_tpv_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+define	FC_NPRA		Memi[$1+FCU+10]		# poly order (0-39)
+define	FC_NPDEC	Memi[$1+FCU+11]		# poly order (0-39)
+define	FC_PV		Memi[$1+FCU+12]		# pointer to PV data (double)
+
+define	FC_A		Memd[FC_PV($1)+($2)]	# RA coefficient
+define	FC_B		Memd[FC_PV($1)+40+($2)]	# DEC coefficient
+
+# WF_TPV_INIT -- Initialize the tan polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The TPV projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_tpv_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, ualen, index, ip
+double	dec, dval
+pointer	ct, mw, wp, wv, im, idb, rp
+
+int	idb_nextcard(), itoc(), ctod()
+pointer	idb_open()
+errchk	wf_decaxis()
+
+begin
+	# Allocate PV storage.  This is freed in wf_tpv_destroy.
+	call calloc (FC_PV(fc), 80, TY_DOUBLE)
+
+	# Set non-zero defaults.
+	FC_NPRA(fc) = 1
+	FC_NPDEC(fc) = 1
+	FC_A(fc,1) = 1D0
+	FC_B(fc,1) = 1D0
+
+	# Get the required mwcs pointers.
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+
+        # Read through the fits header once more and pick up the PV cards.
+        # Read the values and store them, keeping track of what is
+        # the highest order coefficient.
+
+	im = MI_REFIM(mw)
+	idb = idb_open(im,ualen)
+	while (idb_nextcard(idb,rp) != EOF) {
+	    if (Memc[rp] != 'P' || Memc[rp+1] != 'V' || Memc[rp+3] != '_')
+	        next
+	    if (Memc[rp+2] != '1' && Memc[rp+2] != '2')
+	        next
+            if (! IS_DIGIT(Memc[rp+4]))
+                next
+            index = TO_INTEG(Memc[rp+4])
+            do i = 5,7 {
+                if (! IS_DIGIT(Memc[rp+i]))
+		    break
+		else
+		    index = 10*index + TO_INTEG(Memc[rp+i])
+            }
+	    if (index > 39)
+	        next
+            ip = IDB_STARTVALUE
+            if (ctod(Memc[rp],ip,dval) <= 0) 
+	        dval = 0.0d0
+	    i = TO_INTEG(Memc[rp+2])
+	    if (i == FC_IRA(fc)) {
+		FC_A(fc,index) = dval
+		if (index > FC_NPRA(fc))
+		    FC_NPRA(fc) = double(index)
+	    } else {
+		FC_B(fc,index) = dval
+		if (index > FC_NPDEC(fc))
+		    FC_NPDEC(fc) = double(index)
+	    }
+        }
+	call idb_close(idb)
+
+end
+
+
+# WF_TPV_FWD -- Forward transform (physical to world) for the tangent plane
+# with polynomial distortion.
+
+procedure wf_tpv_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+double  x, y, z, a, b, ra, dec
+
+begin
+	# Compute the standard coordinates.
+
+	x = p[1]
+	y = p[2]
+	call tpv_poly (fc, x, y, a, b)
+
+        # Rotate the rectangular coordinate system of the vector [1,xi,eta]
+        # by the declination so that the X axis will pass through the equator.
+
+        a = DEGTORAD(a)
+        b = DEGTORAD(b)
+
+        x = FC_COSDEC(fc) - b * FC_SINDEC(fc)
+        y = a
+        z = FC_SINDEC(fc) + b * FC_COSDEC(fc)
+
+        # Compute RA and DEC in radians.
+        if (x == 0.0D0 && y == 0.0D0)
+            ra = 0.0D0
+        else
+            ra = atan2 (y, x)
+        dec = atan2 (z, sqrt (x*x + y*y))
+
+        # Return RA and DEC in degrees.
+        dec = RADTODEG(dec)
+        ra  = RADTODEG(ra) + FC_W(fc,FC_IRA(fc))
+
+        if (ra < 0D0)
+            ra = ra + 360D0
+        else if (ra > 360D0)
+            ra = ra - 360D0
+
+        w[FC_IRA(fc)]  = ra
+        w[FC_IDEC(fc)] = dec
+
+end
+
+
+# WF_TPV_INV -- Inverse transform (world to physical) for the tangent plane
+# projection with polynomials.
+
+procedure wf_tpv_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, niter
+double	ra, dec
+double	cosra, cosdec, sinra, sindec, cosdist
+double	a, b, x, y, f, g, fx, gx, fy, gy, denom, dx, dy, dmax
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+	cosdist = sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra
+
+	a = RADTODEG(cosdec * sinra / cosdist)
+	b = RADTODEG((sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra) /
+	    cosdist)
+
+	x = a
+	y = b
+	dmax = 30. / 3600.
+	niter = 0
+
+	repeat {
+	    call tpv_poly (fc, x, y, f, g)
+	    call tpv_der (fc, x, y, fx, gx, fy, gy)
+	    
+	    f = f - a
+	    g = g - b
+
+	    denom = fx * gy - fy * gx
+	    if (denom == 0.0d0)
+		break
+		
+	    dx = (-f * gy + g * fy) / denom
+	    dy = (-g * fx + f * gx) / denom
+	    x = x + max (-dmax, min (dmax, dx))
+	    y = y + max (-dmax, min (dmax, dy))
+	    
+	    if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.0d-7)
+		break
+
+	    niter = niter + 1
+
+	} until (niter >= MAX_NITER)
+
+	p[ira]  = x
+	p[idec] = y
+
+end
+
+
+# WF_TPV_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_tpv_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+	call mfree (FC_PV(fc), TY_DOUBLE)
+end
+
+
+# TPV_POLY -- Evaluate TPV polynomial (x,y -> xi,eta)
+
+procedure tpv_poly (fc, x, y, a, b)
+
+pointer	fc			#I pointer to FC descriptor
+double	x, y			#I physical coordinates
+double	a, b			#O standard coordinates (xi, eta) in deg
+
+int	n
+double	r, r2, r3, r5, r7, x2, x3, x4, x5, x6, x7, y2, y3, y4, y5, y6, y7
+
+begin
+	# Compute the standard coordinates.
+	# This depends on undefined coefficients being zero.
+
+	x2 = x * x
+	y2 = y * y
+	r2 = x2 + y2
+	r = sqrt (r2)
+	n = max (FC_NPRA(fc), FC_NPDEC(fc))
+	
+	a = FC_A(fc,0) + FC_A(fc,1) * x + FC_A(fc,2) * y + FC_A(fc,3) * r
+	b = FC_B(fc,0) + FC_B(fc,1) * y + FC_B(fc,2) * x + FC_B(fc,3) * r
+	if (n <= 3)
+	    return
+	a = a + FC_A(fc,4) * x2 + FC_A(fc,5) * x*y + FC_A(fc,6) * y2
+	b = b + FC_B(fc,4) * y2 + FC_B(fc,5) * x*y + FC_B(fc,6) * x2
+	if (n <= 6)
+	    return
+	x3 = x * x2
+	y3 = y * y2
+	r3 = r * r2
+	a = a + FC_A(fc,7) * x3
+	b = b + FC_B(fc,7) * y3
+	a = a + FC_A(fc,8) * x2*y
+	b = b + FC_B(fc,8) * y2*x
+	a = a + FC_A(fc,9) * x*y2
+	b = b + FC_B(fc,9) * y*x2
+	a = a + FC_A(fc,10) * y3
+	b = b + FC_B(fc,10) * x3
+	a = a + FC_A(fc,11) * r3
+	b = b + FC_B(fc,11) * r3
+	if (n <= 11)
+	    return
+	x4 = x * x3
+	y4 = y * y3
+	a = a + FC_A(fc,12) * x4
+	b = b + FC_B(fc,12) * y4
+	a = a + FC_A(fc,13) * x3*y
+	b = b + FC_B(fc,13) * y3*x
+	a = a + FC_A(fc,14) * x2*y2
+	b = b + FC_B(fc,14) * y2*x2
+	a = a + FC_A(fc,15) * x*y3
+	b = b + FC_B(fc,15) * y*x3
+	a = a + FC_A(fc,16) * y4
+	b = b + FC_B(fc,16) * x4
+	if (n <= 16)
+	    return
+	x5 = x * x4
+	y5 = y * y4
+	r5 = r3 * r2
+	a = a + FC_A(fc,17) * x5
+	b = b + FC_B(fc,17) * y5
+	a = a + FC_A(fc,18) * x4*y
+	b = b + FC_B(fc,18) * y4*x
+	a = a + FC_A(fc,19) * x3*y2
+	b = b + FC_B(fc,19) * y3*x2
+	a = a + FC_A(fc,20) * x2*y3
+	b = b + FC_B(fc,20) * y2*x3
+	a = a + FC_A(fc,21) * x*y4
+	b = b + FC_B(fc,21) * y*x4
+	a = a + FC_A(fc,22) * y5
+	b = b + FC_B(fc,22) * x5
+	a = a + FC_A(fc,23) * r5
+	b = b + FC_B(fc,23) * r5
+	if (n <= 23)
+	    return
+	x6 = x * x5
+	y6 = y * y5
+	a = a + FC_A(fc,14) * x6
+	b = b + FC_B(fc,24) * y6
+	a = a + FC_A(fc,25) * x5*y
+	b = b + FC_B(fc,25) * y5*x
+	a = a + FC_A(fc,26) * x4*y2
+	b = b + FC_B(fc,26) * y4*x2
+	a = a + FC_A(fc,27) * x3*y3
+	b = b + FC_B(fc,27) * y3*x3
+	a = a + FC_A(fc,28) * x2*y4
+	b = b + FC_B(fc,28) * y2*x4
+	a = a + FC_A(fc,29) * x*y5
+	b = b + FC_B(fc,29) * y*x5
+	a = a + FC_A(fc,30) * y6
+	b = b + FC_B(fc,30) * x6
+	if (n <= 30)
+	    return
+	x7 = x * x6
+	y7 = y * y6
+	r7 = r5 * r2
+	a = a + FC_A(fc,31) * x7
+	b = b + FC_B(fc,31) * y7
+	a = a + FC_A(fc,32) * x6*y
+	b = b + FC_B(fc,32) * y6*x
+	a = a + FC_A(fc,33) * x5*y2
+	b = b + FC_B(fc,33) * y5*x2
+	a = a + FC_A(fc,34) * x4*y3
+	b = b + FC_B(fc,34) * y4*x3
+	a = a + FC_A(fc,35) * x3*y4
+	b = b + FC_B(fc,35) * y3*x4
+	a = a + FC_A(fc,36) * x2*y5
+	b = b + FC_B(fc,36) * y2*x5
+	a = a + FC_A(fc,37) * x*y6
+	b = b + FC_B(fc,37) * y*x6
+	a = a + FC_A(fc,38) * y7
+	b = b + FC_B(fc,38) * x7
+	a = a + FC_A(fc,39) * r7
+	b = b + FC_B(fc,39) * r7
+
+end
+
+
+# TPV_DER -- Evaluate TPV polynomial (x,y -> xi,eta)
+
+procedure tpv_der (fc, x, y, ax, bx, ay, by)
+
+pointer	fc			#I pointer to FC descriptor
+double	x, y			#I physical coordinates
+double	ax, bx			#O standard coordinates (xi, eta) in deg
+double	ay, by			#O standard coordinates (xi, eta) in deg
+
+int	n
+double	r, r2, r4, r6, x2, x3, x4, x5, x6, y2, y3, y4, y5, y6, rx, ry
+
+begin
+	x2 = x * x
+	y2 = y * y
+	r2 = x2 + y2
+	r = sqrt (r2)
+	if (r < 2.0d-7) {
+	    rx = 1D0
+	    ry = 1D0
+	} else {
+	    rx = x / r
+	    ry = y / r
+	}
+	n = max (FC_NPRA(fc), FC_NPDEC(fc))
+	
+	ax = FC_A(fc,1) + FC_A(fc,3) * rx
+	by = FC_B(fc,1) + FC_B(fc,3) * ry
+	ay = FC_A(fc,2) + FC_A(fc,3) * ry
+	bx = FC_B(fc,2) + FC_B(fc,3) * rx
+	if (n <= 3)
+	    return
+	ax = ax + 2 * FC_A(fc,4) * x + FC_A(fc,5) * y
+	by = by + 2 * FC_B(fc,4) * y + FC_B(fc,5) * x
+	ay = ay + FC_A(fc,5) * x + 2 * FC_A(fc,6) * y
+	bx = bx + FC_B(fc,5) * y + 2 * FC_B(fc,6) * x
+	if (n <= 6)
+	    return
+	ax = ax + 3 * FC_A(fc,7) * x2
+	by = by + 3 * FC_B(fc,7) * y2
+	ax = ax + 2 * FC_A(fc,8) * x*y
+	by = by + 2 * FC_B(fc,8) * y*x
+	ax = ax + FC_A(fc,9) * y2
+	by = by + FC_B(fc,9) * x2
+	ax = ax + 3 * FC_A(fc,11) * r2 * rx
+	by = by + 3 * FC_B(fc,11) * r2 * ry
+	ay = ay + FC_A(fc,8) * x2
+	bx = bx + FC_B(fc,8) * y2
+	ay = ay + 2 * FC_A(fc,9) * x*y
+	bx = bx + 2 * FC_B(fc,9) * y*x
+	ay = ay + 3 * FC_A(fc,10) * y2
+	bx = bx + 3 * FC_B(fc,10) * x2
+	ay = ay + 3 * FC_A(fc,11) * r2 * ry
+	bx = bx + 3 * FC_B(fc,11) * r2 * rx
+	if (n <= 11)
+	    return
+	x3 = x * x2
+	y3 = y * y2
+	ax = ax + 4 * FC_A(fc,12) * x3
+	by = by + 4 * FC_B(fc,12) * y3
+	ax = ax + 3 * FC_A(fc,13) * x2*y
+	by = by + 3 * FC_B(fc,13) * y2*x
+	ax = ax + 2 * FC_A(fc,14) * x*y2
+	by = by + 2 * FC_B(fc,14) * y*x2
+	ax = ax + FC_A(fc,15) * y3
+	by = by + FC_B(fc,15) * x3
+	ay = ay + FC_A(fc,13) * x3
+	bx = bx + FC_B(fc,13) * y3
+	ay = ay + 2 * FC_A(fc,14) * x2*y
+	bx = bx + 2 * FC_B(fc,14) * y2*x
+	ay = ay + 3 * FC_A(fc,15) * x*y2
+	bx = bx + 3 * FC_B(fc,15) * y*x2
+	ay = ay + 4 * FC_A(fc,16) * y3
+	bx = bx + 4 * FC_B(fc,16) * x3
+	if (n <= 16)
+	    return
+	x4 = x * x3
+	y4 = y * y3
+	r4 = r2 * r2
+	ax = ax + 5 * FC_A(fc,17) * x4
+	by = by + 5 * FC_B(fc,17) * y4
+	ax = ax + 4 * FC_A(fc,18) * x3*y
+	by = by + 4 * FC_B(fc,18) * y3*x
+	ax = ax + 3 * FC_A(fc,19) * x2*y2
+	by = by + 3 * FC_B(fc,19) * y2*x2
+	ax = ax + 2 * FC_A(fc,20) * x*y3
+	by = by + 2 * FC_B(fc,20) * y*x3
+	ax = ax + FC_A(fc,21) * y4
+	by = by + FC_B(fc,21) * x4
+	ax = ax + 5 * FC_A(fc,23) * r4 * rx
+	by = by + 5 * FC_B(fc,23) * r4 * ry
+	ay = ay + FC_A(fc,18) * x4
+	bx = bx + FC_B(fc,18) * y4
+	ay = ay + 2 * FC_A(fc,19) * x3*y
+	bx = bx + 2 * FC_B(fc,19) * y3*x
+	ay = ay + 3 * FC_A(fc,20) * x2*y2
+	bx = bx + 3 * FC_B(fc,20) * y2*x2
+	ay = ay + 4 * FC_A(fc,21) * x*y3
+	bx = bx + 4 * FC_B(fc,21) * y*x3
+	ay = ay + 5 * FC_A(fc,22) * y4
+	bx = bx + 5 * FC_B(fc,22) * x4
+	ay = ay + 5 * FC_A(fc,23) * r4 * ry
+	bx = bx + 5 * FC_B(fc,23) * r4 * rx
+	if (n <= 23)
+	    return
+	x5 = x * x4
+	y5 = y * y4
+	ax = ax + 6 * FC_A(fc,14) * x5
+	by = by + 6 * FC_B(fc,24) * y5
+	ax = ax + 5 * FC_A(fc,25) * x4*y
+	by = by + 5 * FC_B(fc,25) * y4*x
+	ax = ax + 4 * FC_A(fc,26) * x3*y2
+	by = by + 4 * FC_B(fc,26) * y3*x2
+	ax = ax + 3 * FC_A(fc,27) * x2*y3
+	by = by + 3 * FC_B(fc,27) * y2*x3
+	ax = ax + 2 * FC_A(fc,28) * x*y4
+	by = by + 2 * FC_B(fc,28) * y*x4
+	ax = ax + FC_A(fc,29) * y5
+	by = by + FC_B(fc,29) * x5
+	ay = ay + FC_A(fc,25) * x5
+	bx = bx + FC_B(fc,25) * y5
+	ay = ay + 2 * FC_A(fc,26) * x4*y
+	bx = bx + 2 * FC_B(fc,26) * y4*x
+	ay = ay + 3 * FC_A(fc,27) * x3*y2
+	bx = bx + 3 * FC_B(fc,27) * y3*x2
+	ay = ay + 4 * FC_A(fc,28) * x2*y3
+	bx = bx + 4 * FC_B(fc,28) * y2*x3
+	ay = ay + 5 * FC_A(fc,29) * x*y4
+	bx = bx + 5 * FC_B(fc,29) * y*x4
+	ay = ay + 6 * FC_A(fc,30) * y5
+	bx = bx + 6 * FC_B(fc,30) * x5
+	if (n <= 30)
+	    return
+	x6 = x * x5
+	y6 = y * y5
+	r6 = r4 * r2
+	ax = ax + 7 * FC_A(fc,31) * x6
+	by = by + 7 * FC_B(fc,31) * y6
+	ax = ax + 6 * FC_A(fc,32) * x5*y
+	by = by + 6 * FC_B(fc,32) * y5*x
+	ax = ax + 5 * FC_A(fc,33) * x4*y2
+	by = by + 5 * FC_B(fc,33) * y4*x2
+	ax = ax + 4 * FC_A(fc,34) * x3*y3
+	by = by + 4 * FC_B(fc,34) * y3*x3
+	ax = ax + 3 * FC_A(fc,35) * x2*y4
+	by = by + 3 * FC_B(fc,35) * y2*x4
+	ax = ax + 2 * FC_A(fc,36) * x*y5
+	by = by + 2 * FC_B(fc,36) * y*x5
+	ax = ax + FC_A(fc,37) * y6
+	by = by + FC_B(fc,37) * x6
+	ax = ax + 7 * FC_A(fc,39) * r6 * rx
+	by = by + 7 * FC_B(fc,39) * r6 * ry
+	ay = ay + FC_A(fc,32) * x6
+	bx = bx + FC_B(fc,32) * y6
+	ay = ay + 2 * FC_A(fc,33) * x5*y
+	bx = bx + 2 * FC_B(fc,33) * y5*x
+	ay = ay + 3 * FC_A(fc,34) * x4*y2
+	bx = bx + 3 * FC_B(fc,34) * y4*x2
+	ay = ay + 4 * FC_A(fc,35) * x3*y3
+	bx = bx + 4 * FC_B(fc,35) * y3*x3
+	ay = ay + 5 * FC_A(fc,36) * x2*y4
+	bx = bx + 5 * FC_B(fc,36) * y2*x4
+	ay = ay + 6 * FC_A(fc,37) * x*y5
+	bx = bx + 6 * FC_B(fc,37) * y*x5
+	ay = ay + 7 * FC_A(fc,38) * y6
+	bx = bx + 7 * FC_B(fc,38) * x6
+	ay = ay + 7 * FC_A(fc,39) * r6 * ry
+	bx = bx + 7 * FC_B(fc,39) * r6 * rx
+
+end
diff --git a/sys/mwcs/wftsc.x b/sys/mwcs/wftsc.x
new file mode 100644
index 00000000..65445653
--- /dev/null
+++ b/sys/mwcs/wftsc.x
@@ -0,0 +1,563 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTSC
+.nf -------------------------------------------------------------------------
+WFTSC -- WCS function driver for the tangentil spherical cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tsc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_tsc_fwd (fc, v1, v2)
+	FN_INV		     wf_tsc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_TSC_INIT -- Initialize the forward or inverse tangential spherical cube
+# projection transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude is less than 0, otherwise 0
+# is assumed. If LATPOLE is undefined then the most northerly of the two
+# possible solutions is chosen, otherwise the solution closest to LATPOLE
+# is chosen. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE, LATPOLE,
+# and RO parameters may be set in either or both of the axes attribute lists,
+# but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_tsc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_TSC_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_TSC_FWD -- Forward transform (physical to world) for the tangential
+# spherical projection.
+
+procedure wf_tsc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	xf, yf, ra, dec, dlng
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0d0) {
+	    face = 4
+	    xf = xf - 6.0d0
+	    l = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    m = -l * xf
+	    n = -l * yf
+	} else if (xf > 3.0d0) {
+	    face = 3
+	    xf = xf - 4.0d0
+	    m = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = m * xf
+	    n = -m * yf
+	} else if (xf > 1.0d0) {
+	    face = 2
+	    xf = xf - 2.0d0
+	    l = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    m = -l * xf
+	    n = l * yf
+	} else if (yf > 1.0d0) {
+	    face = 0
+	    yf = yf - 2.0d0
+	    n = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = n * xf
+	    m = -n * yf
+	} else if (yf < -1.0d0) {
+	    face = 5
+	    yf = yf + 2.0d0
+	    n = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = -n * xf
+	    m = -n * yf
+	} else {
+	    face = 1
+	    m = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = m * xf
+	    n = m * yf
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TSC_INV -- Inverse transform (world to physical) for the tangential
+# spherical projection.
+
+procedure wf_tsc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, dphi, phi, theta
+double	costhe, l, m, n, rho, tol, x0, y0, xf, yf
+data	tol /1.0d-12/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+
+	switch (face) {
+	case 0:
+	    xf = l / rho
+	    yf = -m / rho
+	    x0 = 0.0d0
+	    y0 = 2.0d0
+	case 1:
+	    xf = l / rho
+	    yf = n / rho
+	    x0 = 0.0d0
+	    y0 = 0.0d0
+	case 2:
+	    xf = -m / rho
+	    yf = n / rho
+	    x0 = 2.0d0
+	    y0 = 0.0d0
+	case 3:
+	    xf = -l / rho
+	    yf = n / rho
+	    x0 = 4.0d0
+	    y0 = 0.0d0
+	case 4:
+	    xf = m / rho
+	    yf = n / rho
+	    x0 = 6.0d0
+	    y0 = 0.0d0
+	case 5:
+	    xf = l / rho
+	    yf = m / rho
+	    x0 = 0.0d0
+	    y0 = -2.0d0
+	}
+
+	if (abs(xf) > 1.0d0) {
+	    if (abs(xf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0d0)
+		xf = 1.0d0
+	    else
+		xf = -1.0d0
+	}
+	if (abs(yf) > 1.0d0) {
+	    if (abs(yf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0d0)
+		yf = 1.0d0
+	    else
+		yf = -1.0d0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfzea.x b/sys/mwcs/wfzea.x
new file mode 100644
index 00000000..f25640aa
--- /dev/null
+++ b/sys/mwcs/wfzea.x
@@ -0,0 +1,324 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFZEA
+.nf -------------------------------------------------------------------------
+WFZEA -- WCS function driver for the zenithal equal area projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zea_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_zea_fwd (fc, v1, v2)
+	FN_INV		     wf_zea_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+2)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+4)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+6)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+8)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+10)]		# trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+12)]		# RO (degs)
+define	FC_2RODEG	Memd[P2D($1+FCU+14)]		# 2 * RO (degs)
+define	FC_REC2RODEG	Memd[P2D($1+FCU+16)]		# 1 / 2 * RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]		# bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_ZEA_INIT -- Initialize the zenithal equal area forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and intermediary functions
+# of the reference point, and reading in the projection parameter RO from the
+# attribute list. If LONGPOLE is undefined then a value of 180.0 degrees is
+# assumed. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec}{xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE and RO
+# parameters may be set in either or both of the axes attribute lists, but
+# the value in the RA axis attribute list takes precedence. 
+
+procedure wf_zea_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+		FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+	FC_REC2RODEG(fc) = 1.0d0 / FC_2RODEG(fc)
+
+	# Set the bad coordinate value.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_ZEA_FWD -- Forward transform (physical to world) for the zenithal
+# equal area projection.
+
+procedure wf_zea_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec, tol
+double	dlng, z
+data	tol /1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	if (abs (r - FC_2RODEG(fc)) < tol)
+	    theta = -DHALFPI
+	else
+	    theta = DHALFPI - 2.0d0 * asin (r * FC_REC2RODEG(fc))
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZEA_INV -- Inverse transform (world to physical) for the zenithal
+# equal area projection.
+
+procedure wf_zea_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, r, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	r = FC_2RODEG(fc) * sin ((DHALFPI - theta) / 2.0d0)
+	p[ira]  = r * sin (phi)
+	p[idec] = -r * cos (phi)
+end
diff --git a/sys/mwcs/wfzpn.x b/sys/mwcs/wfzpn.x
new file mode 100644
index 00000000..6c8db38a
--- /dev/null
+++ b/sys/mwcs/wfzpn.x
@@ -0,0 +1,600 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include <ctype.h>
+include "imwcs.h"
+include	"mwcs.h"
+
+.help WFZPN
+.nf -------------------------------------------------------------------------
+# WFZPN -- WCS function driver for the zenithal / azimuthal polynomial 
+# projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zpn_init (fc, dir)
+	FN_DESTROY	 wf_zpn_destroy (fc)
+	FN_FWD		     wf_zpn_fwd (fc, v1, v2)
+	FN_INV		     wf_zpn_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define  FC_LNGCOR       Memi[$1+FCU]                    # RA axis correction
+define  FC_LATCOR       Memi[$1+FCU+1]                  # DEC axis correction
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_NP		Memd[P2D($1+FCU+4)]		# poly order (0-9)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+8)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+10)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+12)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+14)]		# trig tolerance
+define	FC_PC		Memd[P2D($1+FCU+16)+($2)]	# poly coefficients (9)
+define	FC_RODEG	Memd[P2D($1+FCU+36)]		# RO (degs)
+define	FC_ZD		Memd[P2D($1+FCU+38)]		# colat of FIP (degs)
+define	FC_R		Memd[P2D($1+FCU+40)]		# radius of FIP (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+42)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+44)+($2)-1]	# CRVAL (axis 1 and 2)
+
+
+# WF_ZPN_INIT -- Initialize the zenithal/azimuthal polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The ZPN projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_zpn_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, j, np, szatstr, maxorder, ualen, index, ip
+double	dec, zd1, d1, zd2, d2, zd, d, r, tol, dval
+pointer	sp, atname, atvalue, ct, mw, wp, wv, im, idb, rp
+char    compare[4]
+bool    match
+int	ctod(), strlen(), idb_nextcard(), itoc()
+pointer	wf_gsopen(), idb_open()
+data	tol/1.0d-13/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+	im = MI_REFIM(mw)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	FC_LONGP(fc) = DDEGTORAD(180.0d0)
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	FC_RODEG(fc) = 180.0d0/DPI
+        szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        FC_LNGCOR(fc) = NULL
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        FC_LATCOR(fc) = NULL
+
+        # Read through the fits header once more and pick up the PV matrix
+        # cards.  Read the values and store them, keeping track of what is
+        # the highest order coefficient. With this projection only the dec
+	# axis coefficients matter. Technically we can have up to 99 
+	# coefficients. But we restrict this to 10 for the moment.
+
+        maxorder = -1
+	idb = idb_open(im,ualen)
+	compare[1] = 'P'
+        compare[2] = 'V'
+        i = itoc(FC_IDEC(fc),compare[3],1)
+	compare[4] = '_'
+	while (idb_nextcard(idb,rp) != EOF) {
+            match = true
+	    do i = 0,3 {
+	        if (Memc[rp+i] != compare[i+1]) {
+		    match = false
+		    break;
+                }
+            }
+            if (! match) 
+		next
+            if (! IS_DIGIT(Memc[rp+4]))
+                next
+            index = TO_INTEG(Memc[rp+4])
+            do i = 5,7 {
+                if (! IS_DIGIT(Memc[rp+i]))
+		    break
+		else
+		    index = 10*index + TO_INTEG(Memc[rp+i])
+            }
+	    if (index > 9)
+	        next
+            ip = IDB_STARTVALUE
+            if (ctod(Memc[rp],ip,dval) <= 0) 
+	        dval = 0.0d0
+	    if (index > maxorder)
+	        maxorder = index
+	    FC_PC(fc,index) = dval
+        }
+	call idb_close(idb)
+
+	# If all the coefficients are 0.0 the polynomial is undefined.
+	if (maxorder < 0) {
+	    call sfree (sp)
+	    call error (0, "WFT_ZPN_INIT: The polynomial is undefined")
+	}
+
+	# Determine the number of coefficients.
+	FC_NP(fc) = double(maxorder)
+	np = maxorder
+
+	if (np >= 3) {
+	    # Find the point of inflection closest to the pole.
+	    zd1 = 0.0d0
+	    d1 = FC_PC(fc,1)
+	    if (d1 <= 0.0d0) {
+		call sfree (sp)
+	        call error (0,
+		    "WFT_ZPN_INIT: The point of inflection does not exist")
+	    }
+
+	    # Find the point where the derivative first goes negative.
+	    do i = 1, 180 {
+		zd2 = DPI * double (i) / 180.0d0
+		d2 = 0.0d0
+		do j = np, 1, -1
+		    d2 = d2 * zd2 + j * FC_PC(fc,j)
+		if (d2 <= 0.0d0)
+		    break
+		zd1 = zd2
+		d1 = d2
+	    }
+
+	    # Find where the derivative is 0.
+	    if (d2 <= 0.0d0) {
+		do i = 1, 10 {
+		    zd = zd1 - d1 * (zd2 - zd1) / (d2 - d1)
+		    d = 0.0d0
+		    do j = np, 1, -1
+			d = d * zd + j * FC_PC(fc,j)
+		    if (abs(d) < tol)
+			break
+		    if (d < 0.0d0) {
+			zd2 = zd
+			d2 = d
+		    } else {
+			zd1 = zd
+			d1 = d
+		    }
+		}
+
+	    # No negative derivative.
+	    } else
+		zd = DPI
+
+	    r = 0.0d0
+	    do j = np, 0, -1
+		r = r * zd + FC_PC(fc,j)
+	    FC_ZD(fc) = zd
+	    FC_R(fc) = r
+	}
+
+	# Set the spherical trigonometric tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+
+end
+
+
+# WF_ZPN_FWD -- Forward transform (physical to world) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpn_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, i, j, k
+double	x, y, r, zd, a, b, c, d, zd1, zd2, r1, r2, lambda, rt, tol
+double	phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec, dlng, z
+double	wf_gseval()
+data	tol/1.0d-13/
+
+define	phitheta_	11
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	k = nint (FC_NP(fc))
+        if (FC_LNGCOR(fc) == NULL)
+            x = p[ira]
+        else
+            x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+        if (FC_LATCOR(fc) == NULL)
+            y = p[idec]
+        else
+            y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y) / FC_RODEG(fc)
+
+	# Solve.
+
+	# Constant no solution
+	if (k < 1) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+
+	# Linear.
+	} else if (k == 1) {
+	    zd = (r - FC_PC(fc,0)) / FC_PC(fc,1)
+
+	# Quadratic.
+	} else if (k == 2) {
+
+	    a = FC_PC(fc,2) 
+	    b = FC_PC(fc,1) 
+	    c = FC_PC(fc,0) - r 
+	    d = b * b - 4.0d0 * a * c
+	    if (d < 0.0d0) {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	    d = sqrt (d)
+
+	    # Choose solution closet to the pole.
+	    zd1 = (-b + d) / (2.0d0 * a)
+	    zd2 = (-b - d) / (2.0d0 * a)
+	    zd = min (zd1, zd2)
+	    if (zd < -tol)
+		zd = max (zd1, zd2)
+	    if (zd < 0.0d0) {
+		if (zd < -tol) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = 0.0d0
+	    } else if (zd > DPI) {
+		if (zd > (DPI + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = DPI
+	    }
+
+	# Higher order solve iteratively.
+	} else {
+
+	    zd1 = 0.0d0
+	    r1 = FC_PC(fc,0)
+	    zd2 = FC_ZD(fc)
+	    r2 = FC_R(fc)
+
+	    if (r < r1) {
+		if (r < (r1 - tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd1
+		goto phitheta_
+	    } else if (r > r2) {
+		if (r > (r2 + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd2
+		goto phitheta_
+	    } else {
+		do j = 1, 100 {
+		    lambda = (r2 - r) / (r2 - r1)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    zd = zd2 - lambda * (zd2 - zd1)
+		    rt = 0.0d0
+		    do i = k, 0, -1
+			rt = (rt * zd) + FC_PC(fc,i)
+		    if (rt < r) {
+			if ((r - rt) < tol)
+			    goto phitheta_
+			r1 = rt
+			zd1 = zd
+		    } else {
+			if ((rt - r) < tol)
+			    goto phitheta_
+			r2 = rt
+			zd2 = zd
+		    }
+		    if (abs(zd2 - zd1) < tol)
+			goto phitheta_
+		}
+	    }
+
+	}
+
+phitheta_
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - zd
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZPN_INV -- Inverse transform (world to physical) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpn_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, i, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = DHALFPI - theta
+	r = 0.0d0
+	do i = 9, 0, -1
+	    r = r * s + FC_PC(fc,i)
+	r = FC_RODEG(fc) * r
+
+        if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+
+	} else {
+            xm  = r * sin (phi)
+            ym = -r * cos (phi)
+            x = xm
+            y = ym
+            niter = 0
+
+            repeat {
+                if (FC_LNGCOR(fc) != NULL) {
+                    f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+                    fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+                    fx = 1.0 + fx
+                    fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+                } else {
+                    f = x - xm
+                    fx = 1.0
+                    fy = 0.0
+                }
+                if (FC_LATCOR(fc) != NULL) {
+                    g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+                    gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+                    gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+                    gy = 1.0 + gy
+                } else {
+                    g = y - ym
+                    gx = 0.0
+                    gy = 1.0
+                }
+                denom = fx * gy - fy * gx
+                if (denom == 0.0d0)
+                    break
+                dx = (-f * gy + g * fy) / denom
+                dy = (-g * fx + f * gx) / denom
+                x = x + max (-1.0D0, min (1.0D0, dx))
+                y = y + max (-1.0D0, min (1.0D0, dy))
+                if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+                    break
+
+                niter = niter + 1
+
+            } until (niter >= MAX_NITER)
+
+            p[ira]  = x
+            p[idec] = y
+	}
+end
+
+
+# WF_ZPN_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_zpn_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+        if (FC_LNGCOR(fc) != NULL)
+            call wf_gsclose (FC_LNGCOR(fc))
+        if (FC_LATCOR(fc) != NULL)
+            call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/wfzpx.x b/sys/mwcs/wfzpx.x
new file mode 100644
index 00000000..c5eced4a
--- /dev/null
+++ b/sys/mwcs/wfzpx.x
@@ -0,0 +1,654 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFZPX
+.nf -------------------------------------------------------------------------
+# WFZPX -- WCS function driver for the zenithal / azimuthal polynomial 
+# projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zpx_init (fc, dir)
+	FN_DESTROY	 wf_zpx_destroy (fc)
+	FN_FWD		     wf_zpx_fwd (fc, v1, v2)
+	FN_INV		     wf_zpx_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define  FC_LNGCOR       Memi[$1+FCU]                    # RA axis correction
+define  FC_LATCOR       Memi[$1+FCU+1]                  # DEC axis correction
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_NP		Memd[P2D($1+FCU+4)]		# poly order (0-9)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+8)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+10)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+12)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+14)]		# trig tolerance
+define	FC_PC		Memd[P2D($1+FCU+16)+($2)]	# poly coefficients (9)
+define	FC_RODEG	Memd[P2D($1+FCU+36)]		# RO (degs)
+define	FC_ZD		Memd[P2D($1+FCU+38)]		# colat of FIP (degs)
+define	FC_R		Memd[P2D($1+FCU+40)]		# radius of FIP (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+42)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+44)+($2)-1]	# CRVAL (axis 1 and 2)
+
+
+# WF_ZPX_INIT -- Initialize the zenithal/azimuthal polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The ZPX projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_zpx_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, j, np, szatstr
+double	dec, zd1, d1, zd2, d2, zd, d, r, tol
+pointer	sp, atname, atvalue, ct, mw, wp, wv
+int	ctod(), strlen()
+pointer	wf_gsopen()
+data	tol/1.0d-13/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+        szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        iferr {
+            repeat {
+                call mw_gwattrs (mw, FC_IRA(fc), "lngcor", Memc[atvalue],
+                    szatstr)
+                if (strlen (Memc[atvalue]) < szatstr)
+                    break
+                szatstr = szatstr + SZ_LINE
+                call realloc (atvalue, szatstr, TY_CHAR)
+
+            }
+        } then {
+            FC_LNGCOR(fc) = NULL
+        } else {
+            FC_LNGCOR(fc) = wf_gsopen (Memc[atvalue])
+        }
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        iferr {
+            repeat {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latcor", Memc[atvalue],
+                    szatstr)
+                if (strlen (Memc[atvalue]) < szatstr)
+                    break
+                szatstr = szatstr + SZ_LINE
+                call realloc (atvalue, szatstr, TY_CHAR)
+            }
+        } then {
+            FC_LATCOR(fc) = NULL
+        } else {
+            FC_LATCOR(fc) = wf_gsopen (Memc[atvalue])
+        }
+
+	# Fetch the projection coefficients
+	do j = 0, 9 {
+	    call sprintf (Memc[atname], SZ_ATNAME, "projp%d")
+		call pargi (j)
+	    iferr {
+	        call mw_gwattrs (mw, FC_IRA(fc), Memc[atname], Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+	        iferr {
+	            call mw_gwattrs (mw, FC_IDEC(fc), Memc[atname],
+		        Memc[atvalue], SZ_LINE)
+	        } then {
+		    FC_PC(fc,j) = 0.0d0
+	        } else {
+	            i = 1
+	            if (ctod (Memc[atvalue], i, FC_PC(fc,j)) <= 0)
+		        FC_PC(fc,j) = 0.0d0
+	        }
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_PC(fc,j)) <= 0)
+		    FC_PC(fc,j) = 0.0d0
+	    }
+	}
+
+	# Determine the order of the polynomial by finding the first
+	# non-zero coefficient.
+
+	do j = 9, 0, -1 {
+	    if (FC_PC(fc,j) != 0.0d0)
+		break
+	}
+
+	# If all the coefficients are 0.0 the polynomial is undefined.
+	if (j < 0) {
+	    call sfree (sp)
+	    call error (0, "WFT_ZPX_INIT: The polynomial is undefined")
+	}
+
+	# Determine the number of coefficients.
+	FC_NP(fc) = double (j)
+	np = j
+
+	if (np >= 3) {
+	    # Find the point of inflection closest to the pole.
+	    zd1 = 0.0d0
+	    d1 = FC_PC(fc,1)
+	    if (d1 <= 0.0d0) {
+		call sfree (sp)
+	        call error (0,
+		    "WFT_ZPX_INIT: The point of inflection does not exist")
+	    }
+
+	    # Find the point where the derivative first goes negative.
+	    do i = 1, 180 {
+		zd2 = DPI * double (i) / 180.0d0
+		d2 = 0.0d0
+		do j = np, 1, -1
+		    d2 = d2 * zd2 + j * FC_PC(fc,j)
+		if (d2 <= 0.0d0)
+		    break
+		zd1 = zd2
+		d1 = d2
+	    }
+
+	    # Find where the derivative is 0.
+	    if (d2 <= 0.0d0) {
+		do i = 1, 10 {
+		    zd = zd1 - d1 * (zd2 - zd1) / (d2 - d1)
+		    d = 0.0d0
+		    do j = np, 1, -1
+			d = d * zd + j * FC_PC(fc,j)
+		    if (abs(d) < tol)
+			break
+		    if (d < 0.0d0) {
+			zd2 = zd
+			d2 = d
+		    } else {
+			zd1 = zd
+			d1 = d
+		    }
+		}
+
+	    # No negative derivative.
+	    } else
+		zd = DPI
+
+	    r = 0.0d0
+	    do j = np, 0, -1
+		r = r * zd + FC_PC(fc,j)
+	    FC_ZD(fc) = zd
+	    FC_R(fc) = r
+	}
+
+	# Set the spherical trigonometric tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+
+end
+
+
+# WF_ZPX_FWD -- Forward transform (physical to world) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpx_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, i, j, k
+double	x, y, r, zd, a, b, c, d, zd1, zd2, r1, r2, lambda, rt, tol
+double	phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec, dlng, z
+double	wf_gseval()
+data	tol/1.0d-13/
+
+define	phitheta_	11
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	k = nint (FC_NP(fc))
+        if (FC_LNGCOR(fc) == NULL)
+            x = p[ira]
+        else
+            x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+        if (FC_LATCOR(fc) == NULL)
+            y = p[idec]
+        else
+            y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y) / FC_RODEG(fc)
+
+	# Solve.
+
+	# Constant no solution
+	if (k < 1) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+
+	# Linear.
+	} else if (k == 1) {
+	    zd = (r - FC_PC(fc,0)) / FC_PC(fc,1)
+
+	# Quadratic.
+	} else if (k == 2) {
+
+	    a = FC_PC(fc,2) 
+	    b = FC_PC(fc,1) 
+	    c = FC_PC(fc,0) - r 
+	    d = b * b - 4.0d0 * a * c
+	    if (d < 0.0d0) {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	    d = sqrt (d)
+
+	    # Choose solution closet to the pole.
+	    zd1 = (-b + d) / (2.0d0 * a)
+	    zd2 = (-b - d) / (2.0d0 * a)
+	    zd = min (zd1, zd2)
+	    if (zd < -tol)
+		zd = max (zd1, zd2)
+	    if (zd < 0.0d0) {
+		if (zd < -tol) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = 0.0d0
+	    } else if (zd > DPI) {
+		if (zd > (DPI + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = DPI
+	    }
+
+	# Higher order solve iteratively.
+	} else {
+
+	    zd1 = 0.0d0
+	    r1 = FC_PC(fc,0)
+	    zd2 = FC_ZD(fc)
+	    r2 = FC_R(fc)
+
+	    if (r < r1) {
+		if (r < (r1 - tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd1
+		goto phitheta_
+	    } else if (r > r2) {
+		if (r > (r2 + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd2
+		goto phitheta_
+	    } else {
+		do j = 1, 100 {
+		    lambda = (r2 - r) / (r2 - r1)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    zd = zd2 - lambda * (zd2 - zd1)
+		    rt = 0.0d0
+		    do i = k, 0, -1
+			rt = (rt * zd) + FC_PC(fc,i)
+		    if (rt < r) {
+			if ((r - rt) < tol)
+			    goto phitheta_
+			r1 = rt
+			zd1 = zd
+		    } else {
+			if ((rt - r) < tol)
+			    goto phitheta_
+			r2 = rt
+			zd2 = zd
+		    }
+		    if (abs(zd2 - zd1) < tol)
+			goto phitheta_
+		}
+	    }
+
+	}
+
+phitheta_
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - zd
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZPX_INV -- Inverse transform (world to physical) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpx_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, i, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy, dmax
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = DHALFPI - theta
+	r = 0.0d0
+	do i = 9, 0, -1
+	    r = r * s + FC_PC(fc,i)
+	r = FC_RODEG(fc) * r
+
+        if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+
+	} else {
+            xm  = r * sin (phi)
+            ym = -r * cos (phi)
+            x = xm
+            y = ym
+            niter = 0
+	    dmax = 30. / 3600.
+
+            repeat {
+                if (FC_LNGCOR(fc) != NULL) {
+                    f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+                    fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+                    fx = 1.0 + fx
+                    fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+                } else {
+                    f = x - xm
+                    fx = 1.0
+                    fy = 0.0
+                }
+                if (FC_LATCOR(fc) != NULL) {
+                    g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+                    gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+                    gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+                    gy = 1.0 + gy
+                } else {
+                    g = y - ym
+                    gx = 0.0
+                    gy = 1.0
+                }
+                denom = fx * gy - fy * gx
+                if (denom == 0.0d0)
+                    break
+                dx = (-f * gy + g * fy) / denom
+                dy = (-g * fx + f * gx) / denom
+                x = x + max (-dmax, min (dmax, dx))
+                y = y + max (-dmax, min (dmax, dy))
+                if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+                    break
+
+                niter = niter + 1
+
+            } until (niter >= MAX_NITER)
+
+            p[ira]  = x
+            p[idec] = y
+	}
+end
+
+
+# WF_ZPX_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_zpx_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+        if (FC_LNGCOR(fc) != NULL)
+            call wf_gsclose (FC_LNGCOR(fc))
+        if (FC_LATCOR(fc) != NULL)
+            call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/zzdebug.x b/sys/mwcs/zzdebug.x
new file mode 100644
index 00000000..d098f68b
--- /dev/null
+++ b/sys/mwcs/zzdebug.x
@@ -0,0 +1,507 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<math.h>
+include	<mwset.h>
+include	"imwcs.h"
+
+task	simple	= t_simple,
+	wcs	= t_wcs,
+	float	= t_float,
+	imtest	= t_imtest,
+	inv	= t_inv,
+	save	= t_save,
+	load	= t_load
+
+define	SAVELEN		10240
+
+
+# SIMPLE -- Simple test of the most common interface routines.
+
+procedure t_simple()
+
+pointer	mw, ct, bp
+int	buflen, nchars
+real	ltm[2,2], ltv[2], x1,y1, x2,y2
+pointer	mw_open(), mw_sctran()
+int	mw_save()
+
+begin
+	call memchk()
+	mw = mw_open (NULL, 2)
+
+	ltm[1,1] = 1.0;  ltm[1,2] = 0.0
+	ltm[2,1] = 0.0;  ltm[2,2] = 1.0
+	ltv[1]   = 0.0;  ltv[2]   = 0.0
+	call mw_sltermr (mw, ltm, ltv, 2)
+
+	ct = mw_sctran (mw, "logical", "physical", 0)
+	x1 = 0.5;  y1 = 0.5
+	call mw_c2tranr (ct, x1, y1, x2, y2)
+
+	call eprintf ("[%g,%g] -> [%g,%g]\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	bp = NULL
+	nchars = mw_save (mw, bp, buflen)
+	call mw_load (mw, bp)
+
+	call eprintf ("save/load, save buflen = %d chars, nchars=%d\n")
+	    call pargi (buflen)
+	    call pargi (nchars)
+
+	ct = mw_sctran (mw, "logical", "physical", 0)
+	x1 = 0.5;  y1 = 0.5
+	call mw_c2tranr (ct, x1, y1, x2, y2)
+
+	call eprintf ("[%g,%g] -> [%g,%g]\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	call mw_close (mw)
+end
+
+
+# WCS -- Test the creation and use of a world coordinate system.
+
+procedure t_wcs()
+
+pointer	mw, ct1, ct2, ct3
+real	pv[100], wv[100]
+real	theta, center[2], scale[2], shift[2]
+real	ltm[3,3], ltv[3], x1,y1, x2,y2
+double	r[3], w[3], cd[3,3]
+double	l2m[2,2], l2v_1[2], l2v_2[2], d_theta
+int	ndim, axes[3], naxes, npts, i
+pointer	mw_open(), mw_sctran()
+real	mw_c1tranr()
+
+begin
+	call memchk()
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Apply a transform to the first 2 axes.
+	d_theta = DEGTORAD(30.0D0)
+	l2m[1,1] =  cos(d_theta);  l2m[2,1] = sin(d_theta)
+	l2m[1,2] = -sin(d_theta);  l2m[2,2] = cos(d_theta)
+	l2v_1[1] = 0.0;   l2v_1[2] = 0.0
+	l2v_2[1] = 10.0;  l2v_2[2] = 20.0
+	#l2v_2[1] = 0.0;  l2v_2[2] = 0.0
+
+	#call mw_translated (mw, l2v_1, l2m, l2v_2, 2)
+	theta = d_theta;  call aclrr (center, 2)
+	call mw_rotate (mw, theta, center, 3B)
+	shift[1] = 10.0;  shift[2] = 20.0
+	call mw_shift (mw, shift, 3B)
+	scale[1] = 4.0;  scale[2] = 0.2
+	call mw_scale (mw, scale, 3B)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Apply the inverse transform.
+	d_theta = -d_theta
+	l2m[1,1] =  cos(d_theta);  l2m[2,1] = sin(d_theta)
+	l2m[1,2] = -sin(d_theta);  l2m[2,2] = cos(d_theta)
+	call amovd (l2v_2, l2v_1, 2);  call aclrd (l2v_2, 2)
+
+	#call mw_translated (mw, l2v_1, l2m, l2v_2, 2)
+	scale[1] = 1.0/scale[1];  scale[2] = 1.0/scale[2]
+	call mw_scale (mw, scale, 3B)
+	shift[1] = -shift[1];  shift[2] = -shift[2]
+	call mw_shift (mw, shift, 3B)
+	call mw_rotate (mw, -theta, center, 3B)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	call mw_close (mw)
+end
+
+
+# PLTERM -- Print the Lterm.
+
+procedure plterm (mw, ltm, ltv, ndim)
+
+pointer	mw
+real	ltm[ndim,ndim]
+real	ltv[ndim]
+int	ndim
+
+int	i, j
+
+begin
+	# Examine the Lterm.
+	call mw_gltermr (mw, ltm, ltv, ndim)
+	call eprintf ("----- lterm -----\n")
+
+	do j = 1, ndim {
+	    do i = 1, ndim {
+		call eprintf (" %8.3f")
+		    call pargr (ltm[i,j])
+	    }
+	    call eprintf (" : %8.3f\n")
+		call pargr (ltv[j])
+	}
+end
+
+
+# IMTEST -- Test the image header WCS save and load facilities.
+
+procedure t_imtest()
+
+double	cd[3,3], r[3], w[3]
+int	ndim, naxes, axes[2], npts, i
+pointer	mw, ct1, ct2, ct3, im, iw, cp
+real	theta, center[3], shift[3], scale[3], x1,y1, x2,y2, pv[10], wv[10]
+pointer	mw_open(), mw_sctran(), immap(), iw_rfits()
+real	mw_c1tranr()
+
+begin
+	call memchk()
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Apply a transform to the first 2 axes.
+	call aclrr (center, 2)
+	theta = DEGTORAD(30.0D0)
+	shift[1] = 10.0;  shift[2] = 20.0
+	scale[1] = 4.0;   scale[2] = 0.2
+
+	call mw_rotate (mw, theta, center, 3B)
+	call mw_shift (mw, shift, 3B)
+	call mw_scale (mw, scale, 3B)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Evaluate tests 1.
+	# -----------------
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	# Test image header save/load.
+	call eprintf ("save WCS in image header...\n")
+	#iferr (call imdelete ("pix"))
+	#    ;
+	im = immap ("pix", READ_WRITE, 0)
+	call mw_saveim (mw, im)
+
+	# See what we saved.
+	call printf ("-------- IMAGE HEADER --------\n")
+	iw = iw_rfits (mw, im, RF_REFERENCE)
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    call write (STDOUT, Memc[C_RP(cp)], 80)
+	    call putci (STDOUT, '\n')
+	}
+	call iw_cfits (iw)
+	call printf ("------------------------------\n")
+	call flush (STDOUT)
+
+	# Reload saved header.
+	call mw_loadim (mw, im)
+
+	# Evaluate tests 2.
+	# -----------------
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	call mw_close (mw)
+end
+
+
+# INV -- Test matrix inversion.
+
+procedure t_inv()
+
+int	i, j
+double	a[3,3], b[3,3], c[3,3]
+long	seed, clktime()
+real	urand()
+
+begin
+	# Construct the identity matrix.
+	do i = 1, 3 {
+	    do j = 1, 3
+		a[i,j] = 0.0
+	    a[i,i] = 1.0
+	}
+
+	# Invert the matrix.
+	call mw_invertd (a, b, 3)
+
+	# Print the inverse.
+	call printf ("inverse of identity matrix:\n")
+	do i = 1, 3 {
+	    do j = 1, 3 {
+		call printf ("  %20.*f")
+		    call pargi (NDIGITS_DP)
+		    call pargd (b[i,j])
+	    }
+	    call printf ("\n")
+	}
+
+	# Compute a random matrix.
+	seed = clktime(0)
+	do i = 1, 3
+	    do j = 1, 3
+		a[i,j] = urand (seed)
+
+	# Invert the matrix.
+	call mw_invertd (a, b, 3)
+	call mw_invertd (b, c, 3)
+
+	# Print the difference of the original and the inverted inverse.
+	call printf ("difference of inverse of random matrix:\n")
+	do i = 1, 3 {
+	    do j = 1, 3 {
+		call printf ("  %20.*f")
+		    call pargi (NDIGITS_DP)
+		    call pargd (a[i,j] - c[i,j])
+	    }
+	    call printf ("\n")
+	}
+end
+
+
+# SAVE -- Save a test WCS to a file.
+
+procedure t_save()
+
+pointer	mw, bp
+double	cd[3,3], r[3], w[3]
+int	ndim, naxes, axes[2], npts, buflen, nchars, fd, i
+real	theta, center[3], shift[3], scale[3], pv[10], wv[10]
+int	open(), mw_save
+pointer	mw_open()
+
+begin
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Apply a transform to the first 2 axes.
+	call aclrr (center, 2)
+	theta = DEGTORAD(30.0D0)
+	shift[1] = 10.0;  shift[2] = 20.0
+	scale[1] = 4.0;   scale[2] = 0.2
+
+	call mw_rotate (mw, theta, center, 3B)
+	call mw_shift (mw, shift, 3B)
+	call mw_scale (mw, scale, 3B)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Display the new WCS.
+	call mw_show (mw, STDOUT, 0)
+
+	# Save to a file.
+	bp = NULL;  buflen = 0
+	nchars = mw_save (mw, bp, buflen)
+
+	fd = open ("mwcs.sav", NEW_FILE, BINARY_FILE)
+	call write (fd, Memc[bp], nchars)
+	call close (fd)
+
+	call mfree (bp, TY_CHAR)
+	call mw_close (mw)
+end
+
+
+# LOAD -- Load a test WCS from a file.
+
+procedure t_load()
+
+pointer	mw, bp
+int	fd, nchars
+char	fname[SZ_FNAME]
+int	open(), read()
+pointer	mw_open()
+
+begin
+	call clgstr ("savefile", fname, SZ_FNAME)
+	call malloc (bp, SAVELEN, TY_CHAR)
+
+	# Open and read save file.
+	fd = open (fname, READ_ONLY, BINARY_FILE)
+	nchars = read (fd, Memc[bp], SAVELEN)
+	call printf ("read %d chars from %s\n")
+	    call pargi (nchars)
+	    call pargstr (fname)
+
+	mw = mw_open (NULL, 3)
+	call mw_load (mw, bp)
+
+	# Display the new WCS.
+	call mw_show (mw, STDOUT, 0)
+
+	call mw_close (mw)
+	call mfree (bp, TY_CHAR)
+end
+
+
+# FLOAT -- Test single to double conversions.
+
+procedure t_float()
+
+real	r
+double	x
+
+begin
+	x = sin(0.34567D0)
+	r = 1.0
+	call achtrd (r, x, 1)
+	call printf ("x = %g\n")
+	    call pargd (x)
+end
+
+
+# MEMCHK -- Enable runtime dynamic memory verification.  System dependent,
+# should be commented out unless a Fortran callable MEMVER is available for
+# linking.
+
+procedure memchk()
+
+begin
+	# call memver (2)
+end
diff --git a/sys/nmemio/README b/sys/nmemio/README
new file mode 100644
index 00000000..597f1114
--- /dev/null
+++ b/sys/nmemio/README
@@ -0,0 +1 @@
+MEMIO -- Memory allocation and management facilities.
diff --git a/sys/nmemio/begmem.x b/sys/nmemio/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/nmemio/begmem.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help begmem, fixmem
+.nf ___________________________________________________________________________
+BEGMEM, FIXMEM -- Try to get/release physical memory for a process.  The
+actual amount of physical memory available (in chars) is returned.  On a
+machine with virtual memory, these routines adjust the working set size.
+
+On any machine, BEGMEM may be used to determine the amount of available
+physical memory, to tune algorithms for optimum performance.  BEGMEM returns
+as its function value the actual working set size of the process after
+the adjustment (or the current working set size if "best_size" is zero).
+On some systems this represents a soft limit on the actual amount of memory
+which can be used; it is a guarantee that at least that much space is
+available.  Some systems will allow the actual working set to dynamically
+exceed this value at runtime if the process pages heavily.  The hard limit
+on the working set of a process is given by the "max_size" parameter.
+
+Note that the working set must include space not only for a task specific
+data buffers, but also for all other process data buffers and for the text
+(instruction space) of the code being executed.  There is no easy way to
+determine this, hence the application is expected to estimate it.  A typical
+value for the base text+data size required to execute a program is 150Kb.
+.endhelp ______________________________________________________________________
+
+
+# BEGMEM -- Attempt to the adjust the amount of physical memory allocated
+# to a process.  Save the old memory size in OLD_SIZE, so that memory may
+# later be restored with FIXMEM.  The new working set size is returned as
+# the function value and the hard limit on the working set size is returned
+# in MAX_SIZE.  In general, the process can be expected to page, possibly
+# heavily, or swap out if the working set size is exceeded.  All sizes are
+# returned in SPP chars.  If BEST_SIZE is zero the working set size is not
+# changed, i.e., the current working set parameters are returned.
+
+int procedure begmem (best_size, old_size, max_size)
+
+int	best_size		# desired working set size
+int	old_size		# former working set size
+int	max_size		# max physical memory available to this process
+
+int	new_size
+
+begin
+	call zawset (best_size * SZB_CHAR, new_size, old_size, max_size)
+	new_size = new_size / SZB_CHAR
+	old_size = old_size / SZB_CHAR
+	max_size = max_size / SZB_CHAR
+
+	return (new_size)
+end
+
+
+# FIXMEM -- Restore the original working set size.
+
+procedure fixmem (old_size)
+
+int	old_size
+int	j1, j2, j3
+
+begin
+	call zawset (old_size * SZB_CHAR, j1, j2, j3)
+end
diff --git a/sys/nmemio/calloc.x b/sys/nmemio/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/nmemio/calloc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CALLOC -- Allocate and zero a block of memory.
+
+procedure calloc (ubufp, buflen, dtype)
+
+pointer	ubufp			# user buffer pointer [OUTPUT]
+int	buflen			# nelements of space required,
+int	dtype		# of this data type
+
+pointer	char_ptr
+pointer	coerce()
+int	sizeof()
+errchk	malloc
+
+begin
+	call malloc (ubufp, buflen, dtype)
+	char_ptr = coerce (ubufp, dtype, TY_CHAR)
+	call aclrc (Memc[char_ptr], buflen * sizeof (dtype))
+end
diff --git a/sys/nmemio/coerce.x b/sys/nmemio/coerce.x
new file mode 100644
index 00000000..36f762b2
--- /dev/null
+++ b/sys/nmemio/coerce.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# COERCE -- Coerce a pointer from one datatype to another, choosing the
+# next larger element for t2 in the event that t1 is not aligned with t2.
+
+pointer procedure coerce (ptr, type1, type2)
+
+pointer	ptr				# input pointer
+int	type1, type2			# from, to data types
+int	n
+pointer	p
+include	<szdtype.inc>
+
+begin
+	p = ptr - 1
+	if (type1 == TY_CHAR) {
+	    return (p / ty_size[type2] + 1)
+	} else if (type2 == TY_CHAR) {
+	    return (p * ty_size[type1] + 1)
+	} else {
+	    p = p * ty_size[type1]				# ptr to char
+	    n = ty_size[type2]
+	    return (((p + n-1) / n) + 1)
+	}
+end
diff --git a/sys/nmemio/doc/memio.hlp b/sys/nmemio/doc/memio.hlp
new file mode 100644
index 00000000..1bc5c0a0
--- /dev/null
+++ b/sys/nmemio/doc/memio.hlp
@@ -0,0 +1,308 @@
+.help memio Feb83 "Dynamic Memory Management Routines"
+.sh
+Introduction
+
+    The memory management routines manage both a stack and a heap.
+Storage for the stack may be fragmented, and chunks of stack storage are
+allocated dynamically from the heap as needed.  Programs may allocate
+heap storage directly if desired, for large or semipermanent buffers.
+Stack storage is intended for use with small buffers, where the overhead
+of allocating and deallocating space must be kept to a minimum.
+
+
+.ks
+.nf
+heap routines:
+
+	malloc  (ptr, number_of_elements, data_type)
+	calloc  (ptr, number_of_elements, data_type)
+	realloc (ptr, number_of_elements, data_type)
+	mfree   (ptr, data_type)
+
+
+stack routines:
+
+	salloc  (ptr, number_of_elements, data_type)
+	smark   (ptr)
+	sfree   (ptr)
+.fi
+.ke
+
+
+MALLOC allocates space on the heap.  CALLOC does the same, and fills the buffer
+with zeroes.  REALLOC is used to change the size of a previously allocated
+buffer, copying the contents of the buffer if necessary.  MFREE frees space
+allocated by a prior call to MALLOC, CALLOC, or REALLOC.
+
+Space is allocated on the stack with SALLOC.  SMARK should be called before
+SALLOC, to mark the position of the stack pointer.  SFREE returns all space
+allocated on the stack since the matching call to SMARK.
+
+
+.KS
+Example:
+.nf
+	pointer	buf, sp
+
+	begin
+		call smark (sp)
+		call salloc (buf, SZ_BUF, TY_CHAR)
+		while (getline (fd, Memc[buf]) != EOF) {
+		    (code to use buffer ...)
+		}
+		call sfree (sp)
+.fi
+.KE
+
+
+These routines will generate an error abort if memory cannot be allocated
+for some reason.
+
+.sh
+Heap Management
+
+    Since many operating systems provide heap management facilities,
+MALLOC and MFREE consist of little more than calls to Z routines to
+allocate and free blocks of memory.  The main function of MALLOC is
+to convert the physical buffer address returned by the Z routine into
+a pointer of the requested type.
+
+The pointer returned to the calling routine does not point at the beginning
+of the physical buffer, but at a location a few bytes into the buffer.
+The physical address of the buffer is stored in the buffer, immediately
+before the cell pointed to by the pointer returned by MALLOC.  The
+stored address must be intact when MFREE is later called to deallocate
+the buffer, or a "Memory corrupted" error diagnostic will result.
+
+The Z routines required to manage the heap are the following:
+
+.KS
+.nf
+	 zmget (bufadr, nbytes)
+	zmrget (bufadr, nbytes)
+	zmfree (buf_addr)
+.fi
+.KE
+
+The "get" routines should return NULL as the buffer address if space
+cannot be allocated for some reason.
+
+.sh
+Stack Management
+
+    The heap management routines have quite a bit of overhead associated
+with them, which precludes their use in certain applications.  In addition,
+the heap can be most efficiently managed when it contains few buffers.
+The stack provides an efficient mechanism for parceling out small amounts
+of storage, which can later all be freed with a single call.
+
+The main use of the stack is to provide automatic storage for local 
+arrays in procedures.  The preprocessor compiles code which makes calls
+to the stack management routines whenever an array is declared with the
+storage calls AUTO, or whenever the ALLOC statement is used in a procedure.
+
+
+.KS
+.nf
+	auto	char lbuf[SZ_LINE]
+	real	x[n], y[n]
+	int	n
+
+	begin
+		alloc (x[npix], y[npix])
+
+		while (getline (fd, lbuf) != EOF) {
+		    ...
+.fi
+.KE
+
+
+The AUTO storage class and the ALLOC statement are provided in the full
+preprocessor, but not in the subset preprocessor.  The following subset
+preprocessor code is functionally equivalent to the code show above:
+
+
+.KS
+.nf
+	pointer	lbuf, x, y, sp
+	int	n, getline()
+
+	begin
+		call smark (sp)
+		call salloc (lbuf, SZ_LINE, TY_CHAR)
+		n = npix
+		call salloc (x, n, TY_REAL)
+		call salloc (y, n, TY_REAL)
+
+		while (getline (fd, Memc[lbuf]) != EOF) {
+		    ...
+
+		call sfree (sp)
+.fi
+.KE
+
+.sh
+Semicode for Stack Management
+
+    At any given time, the "stack" is a contiguous buffer of a certain size.
+Stack overflow is handled by calling MALLOC to allocate another stack segment.
+A pointer to the previous stack segment is kept in each new stack segment,
+to permit reclamation of stack space.
+
+
+
+
+.KS
+.nf
+		salloc             smark              sfree
+
+
+
+	    stack_overflow 
+
+
+	
+		malloc            realloc             mfree
+
+
+
+		zmget              zmrget             zmfree
+
+
+
+		Structure of the Memory Management Routines
+.fi
+.KE
+
+
+
+
+.tp 5
+.nf
+procedure salloc (bufptr, nelements, data_type)
+
+bufptr:		upon output, contains pointer to the allocated space
+nelements:	number of elements of space to be allocated
+data_type:	data type of the elements and of the buffer pointer
+
+begin
+	# align stack pointer for the specified data type,
+	# compute amount of storage to be allocated
+
+	if (data_type == TY_CHAR)
+	    nchars = nelements
+	else {
+	    sp = sp + mod (sp-1, sizeof(data_type))
+	    nchars = nelements * sizeof(data_type)
+	}
+
+	if (sp + nchars > stack_top)		# see if room
+	    call stack_overflow (nchars)
+
+	if (data_type == TY_CHAR)		# return pointer
+	    bufptr = sp
+	else
+	    bufptr = (sp-1) / sizeof(data_type) + 1
+
+	sp = sp + nchars			# bump stack ptr
+	return
+end
+
+
+
+
+.tp 5
+procedure sfree (old_sp)			# pop the stack
+
+begin
+	# return entire segments until segment containing the old
+	# stack pointer is reached
+
+	while (old_sp < stack_base || old_sp > stack_top) {
+	    if (this is the first stack segment)
+		fatal error, invalid value for old_sp
+	    stack_base = old_segment.stack_base
+	    stack_top = old_segment.stack_top
+	    mfree (segment_pointer, TY_CHAR)
+	    segment_pointer = old_segment
+	}
+
+	sp = old_sp
+end
+
+
+
+
+.tp 5
+procedure smark (old_sp)			# save stack pointer
+
+begin
+	old_sp = sp
+end
+
+
+
+
+.tp 5
+procedure stack_overflow (nchars_needed)	# increase stk size
+
+begin
+	# allocate storage for new segment
+	segment_size = max (SZ_STACK, nchars_needed + SZ_STKHDR)
+	malloc (new_segment, segment_size, TY_CHAR)
+
+	# initialize header for the new segment
+	new_segment.old_segment = segment_pointer
+	new_segment.stack_base = new_segment + SZ_STKHDR
+	new_segment.stack_top = new_segment + segment_size
+
+	# make new segment the current segment
+	segment_pointer = new_segment
+	stack_base = new_segment.stack_base
+	stack_top = new_segment.stack_top
+	sp = stack_base
+end
+
+
+.fi
+The segment header contains fields describing the location and size of
+the segment, plus a link pointer to the previous segment in the list.
+
+
+.KS
+.nf
+	struct stack_header {
+		char	*stack_base
+		char	*stack_top
+		struct	stack_header *old_segment
+	}
+.fi
+.KE
+
+.sh
+Pointers and Addresses
+
+    Pointers are indices into (one indexed) Fortran arrays.  A pointer to
+an object of one datatype will in general have a different value than a
+pointer to an object of a different datatype, even if the objects are stored
+at the same physical address.  Pointers have strict alignment requirements,
+and it is not always possible to coerce the type of a pointer.  For this
+reason, the pointers returned by MALLOC and SALLOC are always aligned for
+all data types, regardless of the data type requested.
+
+The IRAF system code must occasionally manipulate and store true physical
+addresses, obtained with the function LOC.  The problem with physical
+addresses is that they are unsigned integers, but Fortran does not provide
+any unsigned data types.  Thus, comparisons of addresses are difficult
+in Fortran.
+
+A second LOC primitive is provided for use in routines which must compare
+addresses.  LOCC returns the address of the object passed as argument,
+right shifted to the size of a CHAR.  Thus, the difference between LOCC(a[1])
+and LOCC(a[n]) is the size of the N element array A in chars.
+
+The relationship between chars, bytes, and machine addresses is machine
+dependent.  Bytes seem to be the smallest units.  Some machines are byte
+addressable, others are word addressable.  The size of a CHAR in machine
+bytes is given by the constant SZB_CHAR.  The size of a machine word in
+machine bytes is given by the constant SZB_WORD.
diff --git a/sys/nmemio/kmalloc.x b/sys/nmemio/kmalloc.x
new file mode 100644
index 00000000..7bfc4ee0
--- /dev/null
+++ b/sys/nmemio/kmalloc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# KMALLOC -- Allocate space on the heap.  Equivalent to MALLOC, except that a
+# memory allocation failure is indicated by returning ERR as the function value.
+
+int procedure kmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align))
+end
diff --git a/sys/nmemio/krealloc.x b/sys/nmemio/krealloc.x
new file mode 100644
index 00000000..be080547
--- /dev/null
+++ b/sys/nmemio/krealloc.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<syserr.h>
+
+# KREALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.  This routine is equivalent to REALLOC except that it
+# merely returns ERR as the function value if an error occurs.
+# 
+# Buffer reallocation or resizing can always be implemented by allocating a new
+# buffer, copying the contents of the old buffer to the new buffer, and then
+# deleting the old buffer.  Nonetheless we use a OS entry point to do the actual
+# reallocation, because often it will be possible to change the size of a buffer
+# without moving it, particularly when decreasing the size of the buffer.
+# 
+# Allowing the OS to move a buffer causes problems due to the difference in
+# alignment criteria imposed by the IRAF pointer scheme, which enforces
+# stringent alignment criteria, versus OS memory allocation schemes which
+# typically only align on word or longword boundaries.  Therefore we must
+# check the offset of the data area after reallocation, possibly shifting
+# the contents of data area up or down a few chars to reestablish alignment
+# with Mem.
+
+int procedure krealloc (ptr, a_nelems, a_dtype)
+
+pointer	ptr			# buffer to be reallocated
+int	a_nelems		# new size of buffer
+int	a_dtype			# buffer datatype
+
+pointer	dataptr
+int	nelems, dtype, nchars, nuser, old_fwa, new_fwa
+int	char_shift, old_char_offset, new_char_offset
+int	status, locbuf, loc_Mem
+
+int	mgtfwa(), sizeof(), kmalloc()
+pointer	mgdptr(), msvfwa(), coerce()
+data	loc_Mem /NULL/
+
+begin
+	# Copy over the number of elements and the data type in case they are
+	# located in the block of memory we are reallocating.
+
+	nelems = a_nelems
+	dtype  = a_dtype
+
+	if (ptr == NULL) {
+	    return (kmalloc (ptr, nelems, dtype))
+
+	} else {
+	    if (dtype == TY_CHAR)
+		nuser = nelems + 1
+	    else
+		nuser = nelems * sizeof(dtype) + 1
+
+	    nchars = nuser + (8 * SZ_INT) + SZ_MEMALIGN
+	    old_fwa = mgtfwa (ptr, dtype)
+	    new_fwa = old_fwa
+
+	    # Change the buffer size; any error is fatal.
+	    call zraloc (new_fwa, nchars * SZB_CHAR,  status)
+	    if (status == ERR) {
+		call merror ("Realloc failed\n")
+		ptr = NULL
+		return (ERR)
+	    }
+
+	    # Compute the char offset of the old data area within the original
+	    # buffer; zraloc() guarantees that the old data will have the same
+	    # offset in the new buffer.  Compute the char offset of the new
+	    # data area.  These need not be the same due to the OS allocating
+	    # the new buffer to alignment criteria less than those required
+	    # by MEMIO.
+
+	    call zlocva (Memc[coerce(ptr,dtype,TY_CHAR)], locbuf)
+	    old_char_offset = (locbuf - old_fwa)
+
+	    # We must compute a pointer to the data area within the new
+	    # buffer before we can compute the char offset of the new data
+	    # area within the new buffer.
+
+	    if (loc_Mem == NULL)
+		call zlocva (Memc, loc_Mem)
+
+	    dataptr = mgdptr (new_fwa, TY_CHAR, SZ_MEMALIGN, loc_Mem)
+	    call zlocva (Memc[dataptr], locbuf)
+	    new_char_offset = (locbuf - new_fwa)
+
+	    # Shift the old data to satisfy the new alignment criteria,
+	    # if necessary.  
+	    # 
+	    # FIXME -- If the new alloation is smaller than the old pointer,
+	    # 	       we should only copy as much data as will fit in the
+	    #	       new space as per normal unix handling.
+
+	    char_shift = (new_char_offset - old_char_offset)
+	    if (char_shift != 0) {
+		call amovc (Memc[dataptr - char_shift], Memc[dataptr],
+		    nelems * sizeof(dtype))
+	    }
+
+	    # Save the fwa of the OS buffer in the buffer header, and return
+	    # new pointer to user.
+
+	    ptr = msvfwa (new_fwa, dtype, nelems, SZ_MEMALIGN, loc_Mem)
+	}
+
+	return (OK)
+end
diff --git a/sys/nmemio/main.x b/sys/nmemio/main.x
new file mode 100644
index 00000000..653023ed
--- /dev/null
+++ b/sys/nmemio/main.x
@@ -0,0 +1,893 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<error.h>
+include	<syserr.h>
+include	<clset.h>
+include	<fset.h>
+include	<ctype.h>
+include	<printf.h>
+include	<xwhen.h>
+include	<knet.h>
+
+.help iraf_main
+.nf __________________________________________________________________________
+The IRAF MAIN
+
+    Task resident interpreter for interface to CL.  Supervises process startup
+and shutdown, error restart, and task execution.  A process may contain any
+number of tasks, which need not be related.  The iraf main allows a process to
+be run either directly (interactively or in batch) or from the CL.  A brief
+description of the operation of the Main is given here; additional documentation
+is given in the System Interface Reference Manual.
+
+
+EXECUTION
+
+[1] The process containing the IRAF Main is run.  The PROCESS MAIN, a machine
+    dependent code segment, gains control initially.  The process main
+    determines whether the task is being run from as a connected subprocess,
+    as a detached process, or as a host process, and opens the process
+    standard i/o channels.  The process main then calls the IRAF Main, i.e., us.
+
+[2] The IRAF Main performs the initialization associated with process startup
+    and then enters the interpreter loop waiting for a command.  A number of
+    special commands are implemented, e.g.:
+
+	?		print menu
+	bye		shutdown process
+	chdir		change directory
+	set		set environment variable or variables
+
+    Any other command is assumed to be the name of a task.  The syntax of a
+    task invocation statement is as follows:
+
+	[$]task [<[fname]], ([[stream[(T|B)]]>[fname]])|([[stream]>>[fname]])
+
+    Everything but the task name is optional.  A leading $ enables printing of
+    the cpu time and clock time consumed by the process at termination.  Any
+    combination of the standard i/o streams may be redirected on the command
+    line into a file.  If the stream is redirected at the CL level redirection
+    is shown on the command line but the filename is omitted.
+
+[3] The communications protocol during task execution varies depending on
+    whether or not we are talking to the CL.  If talking directly to the user,
+    the interpreter generates a prompt, and the standard input and output is
+    not blocked into XMIT and XFER commands.  Interactive parameter requests
+    have the form "paramname: response" while CL/IPC requests have the form
+    "paramname=\nresponse", where "response" is the value entered by the user.
+
+[4] Task termination is indicated in interactive mode by generation of a prompt
+    for the next command and in CL/IPC mode by transmission of the command
+    "bye" to the parent process.  If a task terminates abnormally the command
+    "error" is sent to the parent process or the terminal, and the Main reenters
+    the interpreter loop.
+
+A unique SYS_RUNTASK procedure is generated for each process at compile time by
+performing string substitution on a TASK statement appearing in the source code.
+The SYS_RUNTASK procedure contains the task dictionary, CALL statements for
+each task, plus the special task "?".  The main itself, i.e. this file, is a
+precompiled library procedure which has no direct knowledge of the commands
+to be run.
+
+
+ERROR RECOVERY
+
+    If a task terminates abnormally two things can happen: [1] a panic abort
+occurs, causing immediate shutdown of the process (rare), or [2] the IRAF Main
+is reentered at the ZSVJMP statement by a corresponding call to ZDOJMP from
+elsewhere in the system, e.g., ERRACT in the error handling code.
+
+Error restart consists of the following steps:
+
+    (1) The IRAF main is reentered at the point just after the ZDOJMP statement,
+	with a nonzero error code identifying the error in STATUS.
+    (2) The main performs error recovery, cleaning up the files system (deleting
+	NEW_FILES and TEMP_FILES), clearing the stack, and calling any
+	procedures posted with ONERROR.  At present the error recovery code does
+	not free heap buffers or clear posted exception handlers.
+    (3) The ERROR statement is sent to the CL.  An example of the
+	error statment is "ERROR (501, "Access Violation")".
+    (4) The main reenters the interpreter loop awaiting the next command from
+	the CL.
+
+Any error occuring during error restart is fatal and results in immediate
+process termination, usually with a panic error message.  This is necessary
+to prevent infinite error recursion.
+
+
+SHUTDOWN
+
+    The process does not shutdown when interrupted by the CL or during error
+recovery, unless a panic occurs.  In normal operation shutdown only occurs when
+the command BYE is received from the parennt process, or when EOF is read from
+the process standard input.  Procedures posted during execution with ONEXIT 
+will be called during process shutdown.  Any error occuring while executing
+an ONEXIT procedure is fatal and will result in a panic abort of the process.
+.endhelp _____________________________________________________________________
+
+define	SZ_VALSTR		SZ_COMMAND
+define	SZ_CMDBUF		(SZ_COMMAND+1024)
+define	SZ_TASKNAME		32
+define	TIMEIT_CHAR		'$'
+define	MAXFD			5		# max redirectable fd's
+define	STARTUP			0		# stages of execution
+define	SHUTDOWN		1
+define	IDLE			2
+define	EXECUTING		3
+define	DUMMY			finit		# any procedure will do
+
+
+# IRAF_MAIN -- Execute commands read from the standard input until the special
+# command "bye" is received, initiating process shutdown.  The arguments tell
+# the process type (connected, detached, or host) and identify the process
+# standard i/o channels and device driver to be used.
+
+int procedure iraf_main (a_cmd, a_inchan, a_outchan, a_errchan,
+	a_driver, a_devtype, prtype, bkgfile, jobcode, sys_runtask, onentry)
+
+char	a_cmd[ARB]		# command to be executed or null string
+int	a_inchan		# process standard input
+int	a_outchan		# process standard output
+int	a_errchan		# process standard error output
+int	a_driver		# ZLOCPR address of device driver
+int	a_devtype		# device type (text or binary)
+int	prtype			# process type (connected, detached, host)
+char	bkgfile[ARB]		# packed filename of bkg file if detached
+int	jobcode			# jobcode if detached process
+extern	sys_runtask()		# client task execution procedure
+extern	onentry()		# client onentry procedure
+
+bool	networking
+int	inchan, outchan, errchan, driver, devtype
+char	cmd[SZ_CMDBUF], taskname[SZ_TASKNAME], bkgfname[SZ_FNAME]
+int	arglist_offset, timeit, junk, interactive, builtin_task, cmdin
+int	jumpbuf[LEN_JUMPBUF], status, errstat, state, interpret, i
+long	save_time[2]
+pointer	sp
+
+bool	streq()
+extern	DUMMY()
+int	sys_getcommand(), sys_runtask(), oscmd()
+int	access(), envscan(), onentry(), stropen()
+errchk	xonerror, fio_cleanup
+common	/JUMPCOM/ jumpbuf
+string	nullfile "dev$null"
+data	networking /KNET/
+define	shutdown_ 91
+
+# The following common is required on VMS systems to defeat the Fortran
+# optimizer, which would otherwise produce optimizations that would cause
+# a future return from ZSVJMP to fail.  Beware that this trick may fail on
+# other systems with clever optimizers.
+
+common	/zzfakecom/ state
+
+begin
+	# The following initialization code is executed upon process
+	# startup only.
+
+	errstat = OK
+	state = STARTUP
+	call mio_init()
+	call zsvjmp (jumpbuf, status)
+	if (status != OK)
+	    call sys_panic (EA_FATAL, "fatal error during process startup")
+
+	# Install the standard exception handlers, but if we are a connected
+	# subprocess do not enable interrupts until process startup has
+	# completed.
+
+	call ma_ideh()
+	if (prtype == PR_CONNECTED)
+	    call intr_disable()
+
+	inchan  = a_inchan
+	outchan = a_outchan
+	errchan = a_errchan
+	driver  = a_driver
+	devtype = a_devtype
+
+	# If the system is configured with networking initialize the network
+	# interface and convert the input channel codes and device driver
+	# code to their network equivalents.
+
+	if (networking)
+	    call ki_init (inchan, outchan, errchan, driver, devtype)
+
+	# Other initializations.
+	call env_init()
+	call fmt_init (FMT_INITIALIZE)			# init printf
+	call xer_reset()				# init error checking
+	call erract (OK)				# init error handling
+	call onerror (DUMMY)				# init onerror
+	call onexit  (DUMMY)				# init onexit 
+	call finit()					# initialize FIO
+	call clopen (inchan, outchan, errchan, driver, devtype)
+	call clseti (CL_PRTYPE, prtype)
+	call clc_init()					# init param cache
+	call strupk (bkgfile, bkgfname, SZ_FNAME)
+
+	# If we are running as a host process (no IRAF parent process) look
+	# for the file "zzsetenv.def" in the current directory and then in
+	# the system library, and initialize the environment from this file
+	# if found.  This works because the variable "iraf$" is defined at
+	# the ZGTENV level.
+
+	interactive = NO
+	if (prtype == PR_HOST) {
+	    interactive = YES
+	    if (access ("zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @zzsetenv.def"))
+		    ;
+	    } else if (access ("host$hlib/zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @host$hlib/zzsetenv.def"))
+		    ;
+	    }
+	}
+
+	# Save context for error restart.  If an error occurs execution
+	# resumes just past the ZSVJMP statement with a nonzero status.
+
+	call smark (sp)
+	call zsvjmp (jumpbuf, status)
+
+	if (status != OK) {
+	    errstat = status
+
+	    # Give up if error occurs during shutdown.
+	    if (state == SHUTDOWN)
+		call sys_panic (errstat, "fatal error during process shutdown")
+
+	    # Tell error handling package that an error restart is in
+	    # progress (necessary to avoid recursion).
+
+	    call erract (EA_RESTART)
+
+	    iferr {
+		# Call user cleanup routines and then clean up files system.
+		# Make sure that user cleanup routines are called FIRST.
+
+		call xonerror (status)
+		call ma_ideh()
+		call flush (STDERR)
+		do i = CLIN, STDPLOT
+		    call fseti (i, F_CANCEL, OK)
+		call fio_cleanup (status)
+		call fmt_init (FMT_INITIALIZE)
+		call sfree (sp)
+	    } then
+		call erract (EA_FATAL)			# panic abort
+
+	    # Send ERROR statement to the CL, telling the CL that the task
+	    # has terminated abnormally.  The CL will either kill us, resulting
+	    # in error restart with status=SYS_XINT, or send us another command
+	    # to execute.  If we are connected but idle, do not send the ERROR
+	    # statement because the CL will not read it until it executes the
+	    # next task (which it will then mistakenly think has aborted).
+
+	    if (!(prtype == PR_CONNECTED && state == IDLE))
+		call xer_send_error_statement_to_cl (status)
+
+	    # Inform error handling code that error restart has completed,
+	    # or next error call will result in a panic shutdown.
+
+	    call erract (OK)
+	    call xer_reset ()
+	    status = OK
+	}
+
+	# During process startup and shutdown the parent is not listening to
+	# us, hence we dump STDOUT and STDERR into the null file.  If this is
+	# not done and we write to CLOUT, deadlock may occur.  During startup
+	# we also call the ONENTRY procedure.  This is a no-op for connected
+	# and host subprocesses unless a special procedure is linked by the
+	# user (for detached processes the standard ONENTRY procedure opens
+	# the bkgfile as CLIN).  The return value of ONENTRY determines whether
+	# the interpreter loop is entered.  Note that ONENTRY permits complete
+	# bypass of the standard interpreter loop by an application (e.g. the
+	# IRAF CL).
+
+	if (state == STARTUP) {
+	    # Redirect stderr and stdout to the null file.
+	    if (prtype == PR_CONNECTED) {
+		call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+		call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	    }
+
+	    # Call the custom or default ONENTRY procedure.  The lowest bit
+	    # of the return value contains the PR_EXIT/PR_NOEXIT flag, higher
+	    # bits may contain a more meaningful 7-bit status code which will
+	    # be returned to the shell.
+
+	    i = onentry (prtype, bkgfname, a_cmd)
+	    if (mod(i, 2) == PR_EXIT) {
+		interpret = NO
+		errstat = i / 2
+		goto shutdown_
+	    } else
+		interpret = YES
+
+	    # Open the command input stream.  If a command string was given on
+	    # the command line then we read commands from that, otherwise we
+	    # take commands from CLIN.
+
+	    for (i=1;  IS_WHITE(a_cmd[i]) || a_cmd[i] == '\n';  i=i+1)
+		;
+	    if (a_cmd[i] != EOS) {
+		cmdin = stropen (a_cmd, ARB, READ_ONLY)
+		call fseti (cmdin, F_KEEP, YES)
+		interpret = NO
+		interactive = NO
+	    } else
+		cmdin = CLIN
+	}
+
+	# Interpreter loop of the IRAF Main.  Execute named tasks until the
+	# command "bye" is received, or EOF is read on the process standard
+	# input (CLIN).  Prompts and other perturbations in the CL/IPC protocol
+	# are generated if we are being run directly as a host process.
+
+	while (sys_getcommand (cmdin, cmd, taskname, arglist_offset,
+	    timeit, prtype) != EOF) {
+
+	    builtin_task = NO
+	    if (streq (taskname, "bye")) {
+		# Initiate process shutdown.
+		break
+	    } else if (streq (taskname, "set") || streq (taskname, "reset")) {
+		builtin_task = YES
+	    } else if (streq (taskname, "cd")  || streq (taskname, "chdir")) {
+		builtin_task = YES
+	    } else if (prtype == PR_CONNECTED && streq (taskname, "_go_")) {
+		# Restore the normal standard output streams, following
+		# completion of process startup.  Reenable interrupts.
+		call close (STDOUT)
+		call close (STDERR)
+		call intr_enable()
+		state = IDLE
+		next
+	    } else if (taskname[1] == '!') {
+		# Send a command to the host system.
+		junk = oscmd (cmd[arglist_offset], "", "", "")
+		next
+	    } else
+		state = EXECUTING
+
+	    if (builtin_task == NO) {
+		if (timeit == YES)
+		    call sys_mtime (save_time)
+
+		# Clear the parameter cache.
+		call clc_init()
+
+		# Set the name of the root pset.
+		call clc_newtask (taskname)
+
+		# Process the argument list, consisting of any mixture of
+		# parameter=value directives and i/o redirection directives.
+
+		call sys_scanarglist (cmdin, cmd[arglist_offset])
+	    }
+
+	    # Call sys_runtask (the code for which was generated automatically
+	    # by the preprocessor in place of the TASK statement) to search
+	    # the dictionary and run the named task.
+
+	    errstat = OK
+            call mem_init (taskname)
+	    if (sys_runtask (taskname,cmd,arglist_offset,interactive) == ERR) {
+		call flush (STDOUT)
+		call sprintf (cmd, SZ_CMDBUF,
+		    "ERROR (0, \"Iraf Main: Unknown task name (%s)\")\n")
+		    call pargstr (taskname)
+		call putline (CLOUT, cmd)
+		call flush (CLOUT)
+		state = IDLE
+		next
+	    }
+            call mem_fini (taskname)
+
+	    # Cleanup after successful termination of command.  Flush the
+	    # standard output, cancel any unread standard input so the next
+	    # task won't try to read it, print elapsed time if enabled,
+	    # check for an incorrect error handler, call any user posted
+	    # termination procedures, close open files, close any redirected
+	    # i/o and restore the normal standard i/o streams.
+
+	    if (builtin_task == NO) {
+
+		call flush (STDOUT)
+		call fseti (STDIN, F_CANCEL, OK)
+
+		if (timeit == YES)
+		    call sys_ptime (STDERR, taskname, save_time)
+
+		call xer_verify()
+		call xonerror (OK)
+		call fio_cleanup (OK)
+
+		if (prtype == PR_CONNECTED) {
+		    call putline (CLOUT, "bye\n")
+		    call flush (CLOUT)
+		}
+		if (state != STARTUP)
+		    state = IDLE
+	    }
+	}
+
+	# The interpreter has exited after receipt of "bye" or EOF.  Redirect
+	# stdout and stderr to the null file (since the parent is no longer
+	# listening to us), call the user exit procedures if any, and exit.
+
+shutdown_
+	state = SHUTDOWN
+	if (prtype == PR_CONNECTED) {
+	    call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+	    call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	} else if (prtype == PR_HOST && cmd[1] == EOS && interpret == YES) {
+	    call putci (CLOUT, '\n')
+	    call flush (CLOUT)
+	}
+
+	call xonexit (OK)
+	call fio_cleanup (OK)
+	call clclose()
+
+	return (errstat)
+end
+
+
+# SYS_GETCOMMAND -- Get the next command from the input file.  Ignore blank
+# lines and comment lines.  Parse the command and return the components as
+# output arguments.  EOF is returned as the function value when eof file is
+# reached on the input file.
+
+int procedure sys_getcommand (fd, cmd, taskname, arglist_offset, timeit, prtype)
+
+int	fd			#I command input file
+char	cmd[SZ_CMDBUF]		#O command line
+char	taskname[SZ_TASKNAME]	#O extracted taskname, lower case
+int	arglist_offset		#O offset into CMD of first argument
+int	timeit			#O if YES, time the command
+int	prtype			#I process type code
+
+int	ip, op
+int	getlline(), stridx()
+
+begin
+	repeat {
+	    # Get command line.  Issue prompt first if process is being run
+	    # interactively.
+
+	    if (prtype == PR_HOST && fd == CLIN) {
+		call putline (CLOUT, "> ")
+		call flush (CLOUT)
+	    }					
+	    if (getlline (fd, cmd, SZ_CMDBUF) == EOF)
+		return (EOF)
+
+	    # Check for timeit character and advance to first character of
+	    # the task name.
+
+	    timeit = NO
+	    for (ip=1;  cmd[ip] != EOS;  ip=ip+1) {
+		if (cmd[ip] == TIMEIT_CHAR && timeit == NO)
+		    timeit = YES
+		else if (!IS_WHITE (cmd[ip]))
+		    break
+	    }
+
+	    # Skip blank lines and comment lines.
+	    switch (cmd[ip]) {
+	    case '#', '\n', EOS:
+		next
+	    case '?', '!':
+		taskname[1] = cmd[ip]
+		taskname[2] = EOS
+		arglist_offset = ip + 1
+		return (OK)
+	    }
+
+	    # Extract task name.
+	    op = 1
+	    while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) {
+		taskname[op] = cmd[ip]
+		ip = ip + 1
+		op = min (SZ_TASKNAME + 1, op + 1)
+	    }
+	    taskname[op] = EOS
+
+	    # Determine index of argument list.
+	    while (IS_WHITE (cmd[ip]))
+		ip = ip + 1
+	    arglist_offset = ip
+
+	    # Get rid of the newline.
+	    for (;  cmd[ip] != EOS;  ip=ip+1)
+		if (cmd[ip] == '\n') {
+		    cmd[ip] = EOS
+		    break
+		}
+
+	    return (OK)
+	}
+end
+
+
+# SYS_SCANARGLIST -- Parse the argument list of a task.  At the level of the
+# iraf main the command syntax is very simple.  There are two types of
+# arguments, parameter assignments (including switches) and i/o redirection
+# directives.  All param assignments are of the form  "param=value",  where
+# PARAM must start with a lower case alpha and where VALUE is either quoted or
+# is delimited by one of the metacharacters [ \t\n<>\\].  A redirection argument
+# is anything which is not a parameter set argument, i.e., any argument which
+# does not start with a lower case alpha.
+
+procedure sys_scanarglist (cmdin, i_args)
+
+int	cmdin			# command input stream
+char	i_args[ARB]		# (first part of) argument list
+
+int	fd
+char	ch
+bool	skip
+pointer	sp, fname, args, ip, op
+int	getlline()
+
+begin
+	call smark (sp)
+	call salloc (args, SZ_CMDBUF, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call strcpy (i_args, Memc[args], SZ_CMDBUF)
+
+	# Do not skip whitespace for param=value args on the command line.
+	skip = false
+
+	# Inform FIO that all standard i/o streams are unredirected (overridden
+	# below if redirected by an argument).
+
+	for (fd=1;  fd < FIRST_FD;  fd=fd+1)
+	    call fseti (fd, F_REDIR, NO)
+
+	# Process each argument in the argument list.  If the command line ends
+	# with an escaped newline then continuation is assumed.  Arguments are
+	# delimited by whitespace.
+
+	for (ip=args;  Memc[ip] != '\n' && Memc[ip] != EOS;  ) {
+	    # Advance to the next argument.
+	    while (IS_WHITE (Memc[ip]))
+		ip = ip + 1
+
+	    # Check for continuation.
+	    ch = Memc[ip]
+	    if (ch == '\\' && (Memc[ip+1] == '\n' || Memc[ip+1] == EOS)) {
+		if (getlline (cmdin, Memc[args], SZ_CMDBUF) == EOF) {
+		    call sfree (sp)
+		    return
+		}
+		ip = args
+		next
+	    } else if (ch == '\n' || ch == EOS)
+		break
+
+	    # If the argument begins with an alpha, _, or $ (e.g., $nargs)
+	    # then it is a param=value argument, otherwise it must be a redir.
+	    # The form @filename causes param=value pairs to be read from
+	    # the named file.
+
+	    if (ch == '@') {
+		op = fname
+		for (ip=ip+1;  Memc[ip] != EOS;  ip=ip+1)
+		    if (IS_WHITE (Memc[ip]) || Memc[ip] == '\n')
+			break
+		    else if (Memc[ip] == '\\' && Memc[ip+1] == '\n')
+			break
+		    else {
+			Memc[op] = Memc[ip]
+			op = op + 1
+		    }
+		Memc[op] = EOS
+		call sys_getpars (Memc[fname])
+
+	    } else if (IS_ALPHA(ch) || ch == '_' || ch == '$') {
+		call sys_paramset (Memc, ip, skip)
+	    } else
+		call sys_redirect (Memc, ip)
+	}
+
+	call sfree (sp)
+end
+
+
+# SYS_GETPARS -- Read a sequence of param=value parameter assignments from
+# the named file and enter them into the CLIO cache for the task.
+
+procedure sys_getpars (fname)
+
+char	fname			# pset file
+
+bool	skip
+int	lineno, fd
+pointer	sp, lbuf, ip
+int	open(), getlline()
+errchk	open, getlline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_CMDBUF, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	# Skip whitespace for param = value args in a par file.
+	skip = true
+
+	lineno = 0
+	while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) {
+	    lineno = lineno + 1
+	    for (ip=lbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#' || Memc[ip] == '\n')
+		next
+	    iferr (call sys_paramset (Memc, ip, skip)) {
+		for (;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+		    ;
+		Memc[ip] = EOS
+		call eprintf ("Bad param assignment, line %d: `%s'\n")
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# SYS_PARAMSET -- Extract the param and value substrings from a param=value
+# or switch argument and enter them into the CL parameter cache.  (see also
+# clio.clcache).
+
+procedure sys_paramset (args, ip, skip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of argument
+bool	skip			# skip whitespace within "param=value" args
+
+pointer	sp, param, value, op
+int	stridx()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_VALSTR, TY_CHAR)
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) {
+	    Memc[op] = args[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance to the switch character or assignment operator.
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '+':
+	    # Boolean switch "yes".
+	    ip = ip + 1
+	    call strcpy ("yes", Memc[value], SZ_VALSTR)
+	
+	case '-':
+	    # Boolean switch "no".
+	    ip = ip + 1
+	    call strcpy ("no", Memc[value], SZ_VALSTR)
+
+	case '=':
+	    # Extract the value field.  This is either a quoted string or a
+	    # string delimited by any of the metacharacters listed below.
+
+	    ip = ip + 1
+	    if (skip) {
+		while (IS_WHITE (args[ip]))
+		    ip = ip + 1
+	    }
+	    call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR)
+
+	default:
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Enter the param=value pair into the CL parameter cache.
+	call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end
+
+
+# SYS_REDIRECT -- Process a single redirection argument.  The syntax of an
+# argument to redirect the standard input is
+#
+#	< [fname]
+#
+# If the filename is omitted it is understood that STDIN has been redirected
+# in the CL.  The syntax to redirect a standard output stream is
+#
+#	[45678][TB](>|>>)[fname]
+#
+# where [4567] is the FD number of a standard output stream (STDOUT, STDERR,
+# STDGRAPH, STDIMAGE, or STDPLOT), and [TB] indicates if the file is text or
+# binary.  If the stream is redirected at the CL level the output filename
+# will be given as `$', serving only to indicate that the stream is redirected.
+
+procedure sys_redirect (args, ip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of redir arg
+
+pointer	sp, fname
+int	fd, mode, type
+int	ctoi()
+define	badredir_ 91
+errchk	fredir, fseti
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Get number of stream (0 if not given).
+	if (ctoi (args, ip, fd) <= 0)
+	    fd = 0
+
+	# Get file type (optional).
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case 'T', 't':
+	    type = TEXT_FILE
+	    ip = ip + 1
+	case 'B', 'b':
+	    type = BINARY_FILE
+	    ip = ip + 1
+	default:
+	    type = 0
+	}
+
+	# Check for "<", ">", or ">>".
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '<':
+	    ip = ip + 1
+	    mode = READ_ONLY
+	    if (fd == 0)
+		fd = STDIN
+	    else if (fd != STDIN || fd != CLIN)
+		goto badredir_
+
+	case '>':
+	    ip = ip + 1
+	    if (args[ip] == '>') {
+		ip = ip + 1
+		mode = APPEND
+	    } else
+		mode = NEW_FILE
+
+	    if (fd == 0)
+		fd = STDOUT
+	    else {
+		switch (fd) {
+		case CLOUT, STDOUT, STDERR, STDGRAPH, STDIMAGE, STDPLOT:
+		    ;
+		default:
+		    goto badredir_
+		}
+	    }
+
+	default:
+	    # Not a redirection argument.
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Set default file type for given stream if no type specified.
+	if (type == 0)
+	    switch (fd) {
+	    case CLIN, CLOUT, STDIN, STDOUT, STDERR:
+		type = TEXT_FILE
+	    default:
+		type = BINARY_FILE
+	    }
+
+	# Extract the filename, if any.  If the CL has redirected the output
+	# and is merely using the redirection syntax to inform us of this,
+	# the metafilename "$" is given.
+
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+	
+	if (args[ip] == '$') {
+	    Memc[fname] = EOS
+	    ip = ip + 1
+	} else
+	    call sys_gstrarg (args, ip, Memc[fname], SZ_FNAME)
+
+	# At this point we have FD, FNAME, MODE and TYPE.  If no file is
+	# named the stream has already been redirected by the parent and
+	# all we need to is inform FIO that the stream has been redirected.
+	# Otherwise we redirect the stream in the local process.  A locally
+	# redirected stream will be closed and the normal direction restored
+	# during FIO cleanup, at program termination or during error
+	# recovery.
+
+	if (Memc[fname] != EOS)
+	    call fredir (fd, Memc[fname], mode, type)
+	else
+	    call fseti (fd, F_REDIR, YES)
+
+	call sfree (sp)
+	return
+
+badredir_
+	call error (2, "IRAF Main: illegal redirection")
+end
+
+
+# SYS_GSTRARG -- Extract a string field.  This is either a quoted string or a
+# string delimited by any of the metacharacters " \t\n<>\\".
+
+procedure sys_gstrarg (args, ip, outstr, maxch)
+
+char	args[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[maxch]		# receives string field
+int	maxch
+
+char	delim, ch
+int	op
+int	stridx()
+
+begin
+	op = 1
+	if (args[ip] == '"' || args[ip] == '\'') {
+	    # Quoted value string.
+
+	    delim = args[ip]
+	    for (ip=ip+1;  args[ip] != delim && args[ip] != EOS;  ip=ip+1) {
+		if (args[ip] == '\n') {
+		    break
+		} else if (args[ip] == '\\' && args[ip+1] == delim) {
+		    outstr[op] = delim
+		    op = op + 1
+		    ip = ip + 1
+		} else {
+		    outstr[op] = args[ip]
+		    op = op + 1
+		}
+	    }
+
+	} else {
+	    # Nonquoted value string.
+
+	    for (delim=-1;  args[ip] != EOS;  ip=ip+1) {
+		ch = args[ip]
+		if (ch == '\\' && (args[ip+1] == '\n' || args[ip+1] == EOS))
+		    break
+		else if (stridx (ch, " \t\n<>\\") > 0)
+		    break
+		else {
+		    outstr[op] = ch
+		    op = op + 1
+		}
+	    }
+	}
+
+	outstr[op] = EOS
+	if (args[ip] == delim)
+	    ip = ip + 1
+end
diff --git a/sys/nmemio/malloc.x b/sys/nmemio/malloc.x
new file mode 100644
index 00000000..d5886c36
--- /dev/null
+++ b/sys/nmemio/malloc.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+# MALLOC -- Allocate space on the heap.  An array of at least NELEMS elements
+# of data type DTYPE is allocated, aligned to SZ_MEMALIGN (the biggest type)
+# with the global common Mem.
+
+procedure malloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/nmemio/malloc1.x b/sys/nmemio/malloc1.x
new file mode 100644
index 00000000..e5cfd0d3
--- /dev/null
+++ b/sys/nmemio/malloc1.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help malloc1
+.nf -------------------------------------------------------------------------
+MEMIO -- Internal data structures.
+
+If "p" is the pointer returned by malloc, the first element of storage is
+referenced by the expression "Mem_[p]", where the underscore is replaced
+by the appropriate type suffix.  A pointer to an object of one data type
+is NOT equivalent to a pointer to another data type, even if both pointers
+reference the same physical address.
+
+The actual physical address of the physical buffer area allocated is stored
+in the integer cell immediately preceeding the buffer returned to the user.
+If this cell is corrupted, the condition will later be detected, and a fatal
+error ("memory corrupted") will result.
+
+For example, for a machine with a 4 byte integer, the first part of the
+buffer area might appear as follows (the first few unused cells may or
+may not be needed to satisfy the alignment criteria):
+
+      offset			allocation
+	
+	0		start of the physical buffer (from zmaloc)
+	1
+	2
+	3
+	4		byte 1 of saved fwa (address of cell 0)
+	5		byte 2	"   "    "
+	6		byte 3	"   "    "
+	7		byte 4	"   "    "
+	8		first cell available to user (maximum alignment)
+
+
+New Scheme allowing for 64-bit architectures(10/15/2009):
+
+      offset			allocation
+	
+	 0		start of the physical buffer (from zmaloc)
+	 0-7		alignment space
+	 8-15		bytes 1-8 of saved fwa (address of cell 0)
+	16-23		Bytes 1-8 of upper sentinal location
+	24-31		Bytes 1-8 of pointer type
+	32-39		Bytes 1-8 of nbytes of storage
+	40-47		Bytes 1-8 of lower sentinal value
+	48		first cell available to user (maximum alignment)
+	N+1		Bytes 1-8 of upper sentinal value
+
+   Total storage required is
+
+      [ ((nelems + 1) * sizeof(dtype)) + sz-align + (5 * SZ_INT) ] * SZB_CHAR
+	
+
+MALLOC, given the CHAR address of the buffer allocated by the z-routine,
+adds space for the saved fwa (an integer), and determines the address of the
+next cell which is sufficiently aligned, relative to the Mem common.  This
+cell marks the start of the user buffer area.  The buffer fwa is saved in an
+integer location preceding the "first cell".
+
+MFREE, called with a pointer to the buffer to be returned, fetches the location
+of the physical buffer from the save area.  If this does not agree with the
+buffer pointer, either (1) the buffer pointer is invalid or of the wrong
+datatype, or (2), the save area has been overwritten (memory has been
+corrupted).  If everything checks out, the buffer fwa is passed to a z-routine
+to free the physical buffer space.
+
+TODO:	- Add debugging routine to summarize allocated buffer space and
+		check for buffer overruns (add sentinel at end of buffer).
+	- Keep track of buffers allocated while a program is running and
+		return at program termination, like closing open files.
+.endhelp ---------------------------------------------------------------------
+
+
+
+# MALLOC1 -- Low level procedure which does the actual buffer allocation.
+
+int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+int	sz_align		# number of chars of alignment required
+int	fwa_align		# address to which buffer is to be aligned
+
+int	fwa, nchars, nuser, status
+pointer	cp
+
+int	sizeof()
+pointer	msvfwa(), coerce()
+
+include "nmemio.com"
+
+begin
+	if (dtype == TY_CHAR)
+	    nuser = nelems + 1  			# add space for EOS
+	else
+	    nuser = nelems * sizeof (dtype) + 1
+	nchars = nuser + (8 * SZ_INT) + sz_align
+
+	call zmaloc (fwa, (nchars * SZB_CHAR), status)
+
+	if (status == ERR)
+	    return (ERR)
+
+	else {
+	    output_pointer = msvfwa (fwa, dtype, nelems, sz_align, fwa_align)
+
+	    if (mclear > 0) {
+		# Clear the user area only.
+	        cp = coerce (output_pointer, dtype, TY_CHAR)
+                call aclrc (Memc[cp], (nuser * SZB_CHAR))
+	    }
+
+	    # Update usage stats.
+	    if (mreport > 0) {
+	        nalloc = nalloc + 1
+	        mem_used = mem_used + (nchars * SZB_CHAR)
+	        if ((nchars * SZB_CHAR) > max_alloc)
+		    max_alloc = (nchars * SZB_CHAR)
+	    }
+
+	    # Save the ptr in the GC buffer.
+	    if (mcollect > 0)
+		call mgc_save (output_pointer, dtype)
+
+	    return (OK)
+	}
+end
diff --git a/sys/nmemio/merror.x b/sys/nmemio/merror.x
new file mode 100644
index 00000000..d69eb6cd
--- /dev/null
+++ b/sys/nmemio/merror.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+
+
+# MERROR -- Provide a convenient trap for a memory error.
+
+procedure merror (msg)
+
+char	msg[ARB]
+
+include "nmemio.com"
+
+begin
+	if (in_task > 0)
+	    call error (EA_ERROR, msg)
+end
diff --git a/sys/nmemio/mfini.x b/sys/nmemio/mfini.x
new file mode 100644
index 00000000..f3933fa1
--- /dev/null
+++ b/sys/nmemio/mfini.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+
+define	MDEBUG		false
+
+# MEM_FINI --  Close out the MEMIO use in this task.  We perform the memory
+# garbage collection and report usage statistics if requested.
+
+procedure mem_fini (task)
+
+char 	task[ARB]			# task name
+
+int	sv_report
+
+include	"nmemio.com"
+
+begin
+	# Do garbage collection.
+	call mgc_collect()
+            
+	# Turn off reporting so the print statements below don't add
+	# to the reported values.
+	sv_report = mreport
+	mreport   = 0
+	mdebug    = 0
+	in_task   = 0
+
+	if (MDEBUG) {
+	    call eprintf ("\nTask '%s':\n")
+                call pargstr (task)
+	    call eprintf ("     mwatch:\t%d\n") ; call pargi (mwatch)
+	    call eprintf ("     mclear:\t%d\n") ; call pargi (mclear)
+	    call eprintf ("   mcollect:\t%d\n") ; call pargi (mcollect)
+	    call eprintf ("    mreport:\t%d\n") ; call pargi (mreport)
+	}
+
+	# Report memory usage.
+	if (sv_report > 0) {
+            call eprintf ("\nTask '%s':\n")
+                call pargstr (task)
+	    call eprintf ("       Memory:\t%9d used   (%9d max )\n")
+		call pargl (mem_used)
+		call pargi (max_alloc)
+	    call eprintf ("     Pointers:\t%9d alloc  (%9d free)\n")
+		call pargi (nalloc)
+		call pargi (nfree)
+	    call eprintf ("       Leaked:\t%9d bytes  (%9d ptrs)\n\n")
+		call pargl (leaked)
+		call pargl (nleaked)
+	}
+
+	# Free the GC buffer.
+	call mgc_close ()
+end
diff --git a/sys/nmemio/mfree.x b/sys/nmemio/mfree.x
new file mode 100644
index 00000000..d83149c3
--- /dev/null
+++ b/sys/nmemio/mfree.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+
+
+# MFREE -- Free a previously allocated buffer.  If the buffer has already been
+# returned (NULL pointer), ignore the request.  Once the buffer has been
+# returned, the old pointer value is of not useful (and invalid), so set it
+# to NULL.
+
+procedure mfree (ptr, dtype)
+
+pointer	ptr
+int	dtype
+
+pointer	bp
+int	fwa, gc_type, status, lwl
+char	emsg[SZ_LINE]
+
+int	mgtfwa(), coerce(), mgc_gettype()
+errchk	mgtfwa
+
+include "nmemio.com"
+
+begin
+	# Check for NULL or already-freed pointers.  We only invoke an error 
+	# rather than sys_panic to allow for recovery.
+	if (ptr < 0) {
+	    call merror ("Attempt to free already freed pointer")
+	    return 
+	}
+	if (mdebug > 0 && ptr == NULL) {
+	    call merror ("Attempt to free NULL pointer")
+	    return 
+	}
+	if (mcollect > 0) {
+	    gc_type = mgc_gettype (ptr)
+	    if ((gc_type != NULL && gc_type != dtype) && in_task > 0) {
+	        call merror ("Attempt to free pointer of wrong type")
+		dtype = gc_type
+	    }
+	}
+
+	if (ptr != NULL) {
+	    fwa = mgtfwa (ptr, dtype)
+
+	    bp = coerce (ptr, dtype, TY_INT)
+	    if (mwatch  > 0) {
+
+	        # Check the lower sentinal value.  Any serious underflow 
+		# would have corrupted the fwa and been detected above in
+		# mgtfwa(), we really only use this to check for 0/1 indexing
+		# problems that write before the start od the data.
+	        if (Memi[bp-1] != lsentinal) {
+	    	    call aclrc (emsg, SZ_LINE)
+		    call sprintf (emsg, SZ_LINE, 
+			"Pointer underflow: addr=0x%x  nelem=%d  type=%s\n")
+			    call pargi (ptr)
+			    call pargi (Memi[bp-2])
+			    call ptype (dtype)
+		    if (mreport > 0)
+			call eprintf (emsg)
+		    call merror (emsg)
+		}
+
+	        # Check the upper sentinal value.  Note that the setinal is
+		# aligned to the INT boundary so depending on the type we
+		# might still allow a slight overrun.
+	        lwl = Memi[bp-4]
+	        if (Memi[lwl] != usentinal) {
+	    	    call aclrc (emsg, SZ_LINE)
+		    call sprintf (emsg, SZ_LINE, 
+			"Pointer overflow: addr=0x%x  nelem=%d  type=%s\n")
+			    call pargi (ptr)
+			    call pargi (Memi[bp-2])
+			    call ptype (dtype)
+		    if (mreport > 0)
+			call eprintf (emsg)
+		    call merror (emsg)
+		}
+	    }
+
+	    call zmfree (fwa, status)
+	    if (status == ERR)
+		call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	    # Negate the pointer so we can detect another attempt to free it.
+	    if (mcollect > 0 && in_task > 0)
+	        call mgc_update (ptr)
+	    if (mcollect >= 0)
+	        nfree = nfree + 1
+	    ptr   = - ptr
+	    ptr   = NULL
+	}
+end
+
+
+# PTYPE -- Convert a pointer type code t its string equivalent.
+
+procedure ptype (dtype)
+
+int     dtype
+
+begin
+	switch (dtype) {
+	case TY_BOOL:       call pargstr ("TY_BOOL")
+	case TY_CHAR:       call pargstr ("TY_CHAR")
+	case TY_SHORT:      call pargstr ("TY_SHORT")
+	case TY_INT:        call pargstr ("TY_INT")
+	case TY_LONG:       call pargstr ("TY_LONG")
+	case TY_REAL:       call pargstr ("TY_REAL")
+	case TY_DOUBLE:     call pargstr ("TY_DOUBLE")
+	case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+	case TY_STRUCT:     call pargstr ("TY_STRUCT")
+	case TY_POINTER:    call pargstr ("TY_POINTER")
+	}
+end
diff --git a/sys/nmemio/mgc.x b/sys/nmemio/mgc.x
new file mode 100644
index 00000000..8ef2b58c
--- /dev/null
+++ b/sys/nmemio/mgc.x
@@ -0,0 +1,222 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+#  MGC Interface - Simple memory garbage collector interface.  Our strategy
+#  here is simply to store the pointer and its type (so we can dereference to
+#  a host pointer).  As pointers are allocated they are saved here, and when
+#  freed the pointer value is made negative to indicate it is invalid and
+#  that slot is available for later reuse.
+#	When a task completes, we run through the buffer looking for un-freed
+#  pointers and manually reclaim the space.  This is not especially clever but
+#  we are only used (presumably by developers) when requested so normal use
+#  of MEMIO should see no added overhead.
+#
+#               mgc_init  ()
+#              mgc_close  ()
+#               mgc_save  (ptr, dtype)
+#             mgc_update  (ptr)
+#   index = mgc_getindex  (ptr)
+#     type = mgc_gettype  (ptr)
+#            mgc_collect  ()
+
+
+define	SZ_GC_BUFFER		10240
+
+# A zero-indexed structure saving the (ptr,type) pairs.
+define	GC_PTR			Memi[$1+($2 * 2)]
+define	GC_TYPE			Memi[$1+($2 * 2 + 1)]
+
+
+# MGC_INIT -- Initialize the MGC interface.
+
+procedure mgc_init ()
+
+include "nmemio.com"
+
+begin
+       	if (mcollect > 0)
+            call calloc (mgc, SZ_GC_BUFFER, TY_STRUCT)
+	else
+	    mgc = NULL
+end
+
+
+# MGC_CLOSE -- Close the MGC buffer.
+
+procedure mgc_close ()
+
+include "nmemio.com"
+
+begin
+        if (mcollect > 0 && mgc != NULL) {
+            call mfree (mgc, TY_STRUCT)
+	    mgc = NULL
+	}
+end
+
+
+# MGC_SAVE -- Save a pointer in the GC buffer.
+
+procedure mgc_save (ptr, dtype)
+
+pointer	ptr					#i pointer to save
+int	dtype					#i pointer type
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	for (i=0; i < bmax; i=i+1) {
+	    if (GC_PTR(mgc,i) <= 0) {
+		# Space is re-used if negative, otherwise first free slot.
+		GC_PTR(mgc,i) = ptr
+		GC_TYPE(mgc,i) = dtype
+
+		if (mdebug > 0) {
+		    call eprintf ("save %d: ptr 0x%x\n")
+		        call pargi (i); call pargi (GC_PTR(mgc,i))
+		}
+		return
+	    }
+	}
+
+	# If we get this far we've exhausted the GC buffer.  Print a warning
+	# if reporting and just ignore it since the chances this would be 
+	# a leaked pointer are rather small.
+	if (mreport > 0)
+	    call eprintf ("Warning:  GC buffer overflow\n")
+end
+
+
+# MGC_UPDATE -- Update the status of the pointer in the GC buffer.
+
+procedure mgc_update (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mgc == NULL || in_task == 0)
+	    return
+
+	if (in_task > 0 && mdebug > 0) {
+	  call eprintf ("update  0x%x  collect = %d\n")
+	    call pargi (ptr)
+	    call pargi (mcollect)
+	}
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (GC_PTR(mgc,i) == ptr) {
+		if (in_task > 0 && mdebug > 0) {
+	  	    call eprintf ("update  %d:  0x%x  %d\n")
+	    	    call pargi (i); call pargi (GC_PTR(mgc,i)); call pargi (ptr)
+		}
+	        GC_PTR(mgc,i) = (- ptr)
+		return
+	    }
+	    if (GC_PTR(mgc,i) == NULL)
+		return
+	}
+end
+
+
+# MGC_GETINDEX -- Given a pointer, return its GC index.
+
+int procedure mgc_getindex (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (abs (GC_PTR(mgc,i)) == ptr)
+		return (i)
+	    if (GC_PTR(mgc,i) == NULL)
+		return (NULL)
+	}
+
+	return (NULL)
+end
+
+
+# MGC_GETTYPE -- Given a pointer, return its type.
+
+int procedure mgc_gettype (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (abs (GC_PTR(mgc,i)) == ptr)
+		return (GC_TYPE(mgc,i))
+	    if (GC_PTR(mgc,i) == NULL)
+		return (NULL)
+	}
+
+	return (NULL)
+end
+
+
+# MGC_COLLECT -- Do the final garbage collection.
+
+procedure mgc_collect ()
+
+int	i, bmax, nchars
+pointer	bp
+
+int	sizeof ()
+pointer	coerce ()
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+	mcollect = -1
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (GC_PTR(mgc,i) > 0) {
+		if (mdebug > 0) {
+		    call eprintf ("collect %d: recovering ptr 0x%x\n")
+		        call pargi (i); call pargi (GC_PTR(mgc,i))
+		}
+
+                bp = coerce (GC_PTR(mgc,i), GC_TYPE(mgc,i), TY_INT)
+
+		nleaked = nleaked + 1
+		nchars = Memi[bp - 2] * sizeof (GC_TYPE(mgc,i))
+		leaked = leaked + (nchars * SZB_CHAR)
+
+		call mfree (GC_PTR(mgc,i), GC_TYPE(mgc,i))
+
+	    } else if (GC_PTR(mgc,i) == NULL)
+		return
+	}
+end
diff --git a/sys/nmemio/mgdptr.x b/sys/nmemio/mgdptr.x
new file mode 100644
index 00000000..81328132
--- /dev/null
+++ b/sys/nmemio/mgdptr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MGDPTR -- Given the fwa of a memory area, compute a pointer to the start
+# of the data area which satisfies the desired alignment criteria.  Memory
+# is allocated in units of chars, and ZLOCVA, ZMALOC, etc., return pointers
+# in units of chars.
+
+pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+long	bufadr
+pointer	bufptr
+int	modulus, loc_Mem
+int	sizeof()
+data	loc_Mem /NULL/
+
+begin
+	# Compute the address of the start of the user buffer area, which
+	# must be aligned with fwa_align (usually Mem) for all data types.
+
+	if (loc_Mem == NULL)
+	    call zlocva (Memc, loc_Mem)
+	bufadr = fwa + (5 * SZ_INT)
+
+	modulus = mod (bufadr - fwa_align, sz_align)
+	if (modulus != 0)
+	    bufadr = bufadr + (sz_align - modulus)
+
+	# Compute the buffer pointer for the desired datatype.
+	bufptr = (bufadr - loc_Mem) / sizeof(dtype) + 1
+
+	return (bufptr)
+end
diff --git a/sys/nmemio/mgtfwa.x b/sys/nmemio/mgtfwa.x
new file mode 100644
index 00000000..8d3452fd
--- /dev/null
+++ b/sys/nmemio/mgtfwa.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTFWA -- Given a user buffer pointer, retrieve physical address of buffer.
+# If physical address of buffer does not seem reasonable, memory has probably
+# been overwritten, a fatal error.
+
+int procedure mgtfwa (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	locbuf, fwa
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	fwa = Memi[bufptr-5]
+	call zlocva (Memi[bufptr-5], locbuf)
+
+	if (abs (locbuf - fwa) > (6 * SZ_VMEMALIGN))
+	    call sys_panic (SYS_MCORRUPTED, "Memory fwa has been corrupted")
+
+	return (fwa)
+end
diff --git a/sys/nmemio/mgtlwl.x b/sys/nmemio/mgtlwl.x
new file mode 100644
index 00000000..3a7d3ac1
--- /dev/null
+++ b/sys/nmemio/mgtlwl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTLWL -- Given a user buffer pointer, retrieve location of the last word.
+
+int procedure mgtlwl (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	return (Memi[bufptr-4])
+end
diff --git a/sys/nmemio/minit.x b/sys/nmemio/minit.x
new file mode 100644
index 00000000..06214137
--- /dev/null
+++ b/sys/nmemio/minit.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+
+define  L_SENTINAL      20030125
+define  U_SENTINAL      20040922
+
+
+# MEM_INIT -- Initialize the MEMIO interface for the task.
+
+procedure mem_init (task)
+
+char	task[ARB]			# task name
+
+int	mgtenv()
+
+include "nmemio.com"
+
+begin
+	# Initialize I/O buffers for stdout/stderr.  We do this here to
+	# create the file buffers without counting these in the memory 
+	# usage stats.
+#	call fmkbfs (STDOUT)
+#	call fmkbfs (STDERR)
+
+	# Allocate the garbage collection buffer.
+	mcollect  = mgtenv ("MEMIO_COLLECT")
+	call mgc_init()
+
+	# Initialize the sentinal values.
+	lsentinal   = L_SENTINAL
+	usentinal   = U_SENTINAL
+
+	mwatch    = mgtenv ("MEMIO_WATCH")
+	mreport   = mgtenv ("MEMIO_REPORT")
+	mclear    = mgtenv ("MEMIO_CLEAR")
+	mdebug    = mgtenv ("MEMIO_DEBUG")
+
+	max_alloc = 0
+	mem_used  = 0
+	leaked	  = 0
+	nleaked	  = 0
+	nalloc	  = 0
+	nfree	  = 0
+
+	in_task	  = 1
+end
+
+
+# MGTENV -- Get an environment variable for MEMIO control.
+
+int procedure mgtenv (varname)
+
+char	varname[ARB]			# env variable to find
+
+int	ival, ip, status, junk
+char	key[SZ_LINE], value[SZ_LINE]
+
+int	ctoi()
+
+begin
+	ip = 1				# init
+        ival = 0
+	call aclrc (key, SZ_LINE)
+	call aclrc (value, SZ_LINE)
+
+        call strpak (varname, key, SZ_LINE)
+        call zgtenv (key, value, SZ_LINE, status)
+        call strupk (value, value, SZ_LINE)
+
+	if (status == 0)		# variable defined w/out value
+	    ival = 1
+	else if (status > 0)		# get environment variable value
+	    junk = ctoi (value, ip, ival)
+
+	return (ival)
+end
+
+
+# MEM_PTYPE -- Print a pointer type.  Used in error messages.
+
+procedure mem_ptype (dtype)
+
+int     dtype
+
+begin
+	switch (dtype) {
+	case TY_BOOL:       call pargstr ("TY_BOOL")
+	case TY_CHAR:       call pargstr ("TY_CHAR")
+	case TY_SHORT:      call pargstr ("TY_SHORT")
+	case TY_INT:        call pargstr ("TY_INT")
+	case TY_LONG:       call pargstr ("TY_LONG")
+	case TY_REAL:       call pargstr ("TY_REAL")
+	case TY_DOUBLE:     call pargstr ("TY_DOUBLE")
+	case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+	case TY_STRUCT:     call pargstr ("TY_STRUCT")
+	case TY_POINTER:    call pargstr ("TY_POINTER")
+	default:    	    call pargstr ("unknown")
+	}
+end
+
+
+# MIO_INIT -- Initialize the MEMIO interface for the task.
+
+procedure mio_init ()
+
+include "nmemio.com"
+
+begin
+	mgc       = NULL
+	mcollect  = 0
+	mwatch    = 0
+	mreport   = 0
+	mclear    = 0
+	mdebug    = 0
+
+	max_alloc = 0
+	mem_used  = 0
+	leaked	  = 0
+	nleaked	  = 0
+	nalloc	  = 0
+	nfree	  = 0
+
+	in_task	  = 0
+end
diff --git a/sys/nmemio/mkpkg b/sys/nmemio/mkpkg
new file mode 100644
index 00000000..94cfaed9
--- /dev/null
+++ b/sys/nmemio/mkpkg
@@ -0,0 +1,31 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	#$set XFLAGS	= "$(XFLAGS) -g"
+
+	begmem.x	<mach.h>
+	calloc.x	
+	coerce.x	<szdtype.inc>
+	kmalloc.x	<config.h>
+	krealloc.x	<config.h> <mach.h>
+	malloc1.x	<mach.h> nmemio.com
+	malloc.x	<config.h>
+	merror.x	<error.h> nmemio.com
+	mfini.x		<config.h> nmemio.com
+	mfree.x		<error.h> nmemio.com
+	mgc.x		<mach.h> nmemio.com
+	mgdptr.x	
+	mgtfwa.x	<config.h> <mach.h>
+	mgtlwl.x	<config.h> <mach.h>
+	minit.x		<config.h> nmemio.com
+	msvfwa.x	<mach.h> nmemio.com
+	realloc.x	
+	salloc.x	<config.h> <szdtype.inc>
+	sizeof.x	<szdtype.inc>
+	vmalloc.x	<config.h> <mach.h>
+	;
diff --git a/sys/nmemio/msvfwa.x b/sys/nmemio/msvfwa.x
new file mode 100644
index 00000000..cd3313c5
--- /dev/null
+++ b/sys/nmemio/msvfwa.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+# MSVFWA -- Determine the buffer address which satisfies the maximum alignment
+# criteria, save the buffer fwa in the integer cell immediately preceding
+# this, and return a pointer to the user area of the buffer.
+
+pointer procedure msvfwa (fwa, dtype, nelem, sz_align, fwa_align)
+
+int	fwa, dtype, nelem, sz_align, fwa_align, nbits
+pointer	bufptr, lwl, offset
+
+pointer	mgdptr()
+int	coerce(), sizeof()
+
+include "nmemio.com"
+
+begin
+	# Compute the pointer to the data area which satisfies the desired
+	# alignment criteria.  Store the fwa of the actual OS allocated buffer
+	# in the integer cell preceeding the data area.
+
+	bufptr = mgdptr (fwa, TY_INT, sz_align, fwa_align)
+
+	nbits = sizeof(TY_INT) * 8 * SZB_CHAR
+	if (nbits == 64) {
+	    if (sizeof (dtype) == sizeof (TY_CHAR))
+	        offset = (nelem / SZ_INT + 1)
+	    else if (sizeof (dtype) == sizeof (TY_REAL))
+	        offset = (nelem / SZ_REAL + 1)
+	    else
+	        offset = nelem
+
+	} else if (nbits == 32) { 
+
+	    if (sizeof(dtype) < sz_align)
+	        offset = (nelem / (SZ_INT / sizeof(dtype))) + 1
+	    else
+	        offset = (nelem * sizeof (dtype)) / SZB_CHAR
+	}
+
+	lwl = bufptr + offset
+
+	Memi[bufptr-5] = fwa				# first word address
+	Memi[bufptr-4] = lwl				# last word location
+	Memi[bufptr-3] = dtype				# data type
+	Memi[bufptr-2] = nelem				# no. of elements
+	Memi[bufptr-1] = lsentinal			# lower sentinal
+	Memi[lwl]      = usentinal 			# upper sentinal
+
+	# Return pointer of type dtype to the first cell of the data area.
+	return (coerce (bufptr, TY_INT, dtype))
+end
diff --git a/sys/nmemio/nmemio.com b/sys/nmemio/nmemio.com
new file mode 100644
index 00000000..126475c0
--- /dev/null
+++ b/sys/nmemio/nmemio.com
@@ -0,0 +1,26 @@
+
+int	mclear				# clear newly allocated memory?
+int	mwatch				# check buffer sentinals on FREE?
+int	mcollect			# garbage collect on exit?
+int	mreport				# report memio usage stats?
+
+int	lsentinal			# lower sentinal value
+int	usentinal			# upper sentinal value
+
+long	mem_used			# total mem usage
+long	max_alloc			# largest allocated pointer size
+long	leaked				# total leaked bytes
+int 	nleaked				# number leaked pointers
+int 	nalloc				# total number of allocations
+int 	nfree				# total number of frees
+
+int	mdebug				# debugging memory use in tasks?
+int	in_task				# in task or iraf main?
+
+pointer	mgc				# garbage collection buffer
+
+#  Debug common
+common	/nmemio/ mclear, mwatch, mcollect, mreport, lsentinal, usentinal,
+		 mem_used, max_alloc, nleaked, leaked, nalloc, nfree, 
+		 mdebug, in_task, mgc
+
diff --git a/sys/nmemio/realloc.x b/sys/nmemio/realloc.x
new file mode 100644
index 00000000..40229b8f
--- /dev/null
+++ b/sys/nmemio/realloc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# REALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.
+
+procedure realloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# buffer to be reallocated
+int	nelems			# new size of buffer
+int	dtype			# buffer datatype
+
+int	krealloc()
+
+begin
+	if (krealloc (ubufp, nelems, dtype) == ERR) {
+	    ubufp = NULL
+	    call syserr (SYS_MFULL)
+	}
+end
diff --git a/sys/nmemio/salloc.x b/sys/nmemio/salloc.x
new file mode 100644
index 00000000..34f06217
--- /dev/null
+++ b/sys/nmemio/salloc.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# SALLOC.X -- Stack management routines.  Stack storage is allocated in
+# segments.  Space for each segment is dynamically allocated on the heap.
+# Each segment contains a pointer to the previous segment to permit
+# reclamation of the space (see "Mem.hlp" for additional details).
+# This is a low level facility, hence any failure to allocate or deallocate
+# stack storage is fatal.
+
+
+# Segment header structure.  The header size parameter SZ_STKHDR is defined
+# in <config.h> because it is potentially machine dependent.  SZ_STKHDR
+# must be chosen such that the maximum alignment criteria is maintained.
+
+define	SH_BASE		Memi[$1]	# char pointer to base of segment
+define	SH_TOP		Memi[$1+1]	# char pointer to top of segment + 1
+define	SH_OLDSEG	Memi[$1+2]	# struct pointer to header of prev.seg.
+
+
+# SALLOC -- Allocate space on the stack.
+
+procedure salloc (output_pointer, nelem, datatype)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelem			# number of elements of storage required
+int	datatype		# datatype of the storage elements
+
+int	nchars, dtype
+include	<szdtype.inc>
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	dtype = datatype
+	if (dtype < 1 || dtype > MAX_DTYPE)
+	    call sys_panic (500, "salloc: bad datatype code")
+
+	# Align stack pointer for any data type.  Compute amount of
+	# storage to be allocated.  Always add space for at least one
+	# extra char for the EOS in case a string is stored in the buffer.
+
+	sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1
+	if (dtype == TY_CHAR)
+	    nchars = nelem + 1				# add space for EOS
+	else
+	    nchars = nelem * ty_size[dtype] + 1
+
+	# Check for stack overflow, add new segment if out of room.
+	# Since SMARK must be called before SALLOC, cur_seg cannot be
+	# null, but we check anyhow.
+
+	if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg))
+	    call stk_mkseg (cur_seg, sp, nchars)
+
+	if (dtype == TY_CHAR)
+	    output_pointer = sp
+	else
+	    output_pointer = (sp-1) / ty_size[dtype] + 1
+
+	sp = sp + nchars			# bump stack pointer
+end
+
+
+# SMARK -- Mark the position of the stack pointer, so that stack space
+# can be freed by a subsequent call to SFREE.  This routine also performs
+# initialization of the stack, since it the very first routine called
+# during task startup.
+
+procedure smark (old_sp)
+
+pointer	old_sp			# value of the stack pointer (output)
+bool	first_time
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    sp = NULL
+	    cur_seg = NULL
+	    call stk_mkseg (cur_seg, sp, SZ_STACK)
+	    first_time = false
+	}
+
+	old_sp = sp
+end
+
+
+# SFREE -- Free space on the stack.  Return whole segments until segment
+# containing the old stack pointer is reached.
+
+procedure sfree (old_sp)
+
+pointer	old_sp			# previous value of the stack pointer
+
+pointer	old_seg
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	# The following is needed to avoid recursion when SFREE is called
+	# by the IRAF main during processing of SYS_MSSTKUNFL.
+
+	if (cur_seg == NULL)
+	    return
+	    
+	# If the stack underflows (probably because of an invalid pointer)
+	# it is a fatal error.
+
+	while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) {
+	    if (SH_OLDSEG(cur_seg) == NULL)
+		call sys_panic (SYS_MSSTKUNFL, "Salloc underflow")
+
+	    old_seg = SH_OLDSEG(cur_seg)		# discard segment
+	    call mfree (cur_seg, TY_STRUCT)
+	    cur_seg = old_seg
+	}
+
+	sp = old_sp					# pop stack
+end
+
+
+# STK_MKSEG -- Create and add a new stack segment (link at head of the
+# segment list).  Called during initialization, and upon stack overflow.
+
+procedure stk_mkseg (cur_seg, sp, segment_size)
+
+pointer	cur_seg			# current segment
+pointer	sp			# salloc stack pointer
+int	segment_size		# size of new stack segment
+
+int	nchars, new_seg
+pointer	coerce() 
+int	kmalloc()
+
+begin
+	# Compute size of new segment, allocate the buffer.
+	nchars = max (SZ_STACK, segment_size) + SZ_STKHDR
+	if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR)
+	    call sys_panic (SYS_MFULL, "Out of memory")
+
+	# Output new stack pointer.
+	sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR
+
+	# Set up the segment descriptor.
+	SH_BASE(new_seg) = sp
+	SH_TOP(new_seg) = sp - SZ_STKHDR + nchars
+	SH_OLDSEG(new_seg) = cur_seg
+
+	# Make new segment the current segment.
+	cur_seg = new_seg
+end
diff --git a/sys/nmemio/sizeof.x b/sys/nmemio/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/nmemio/sizeof.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SIZEOF -- Return the size in chars of one of the fundamental datatypes.
+
+int procedure sizeof (dtype)
+
+int	dtype
+include	<szdtype.inc>
+
+begin
+	return (ty_size[dtype])
+end
diff --git a/sys/nmemio/vmalloc.x b/sys/nmemio/vmalloc.x
new file mode 100644
index 00000000..25e2de0d
--- /dev/null
+++ b/sys/nmemio/vmalloc.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# VMALLOC -- Like malloc, but force the buffer to be aligned on a virtual
+# memory page boundary.  This feature can be used, e.g., in 4.XBSD UNIX
+# to "bypass" the system buffer cache (to avoid copying file data from the
+# system cache into the file buffer).  VMALLOC can be made equivalent to MALLOC
+# via the parameters in <config.h>, if the local machine which does not have
+# virtual memory.
+
+procedure vmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_VMEMALIGN
+	fwa_align = VMEM_BASE
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/nmemio/zz.x b/sys/nmemio/zz.x
new file mode 100644
index 00000000..c81f1506
--- /dev/null
+++ b/sys/nmemio/zz.x
@@ -0,0 +1,11 @@
+task hello = t_hello
+
+procedure t_hello()
+pointer	t1, t2
+begin
+	call malloc (t1, SZ_LINE, TY_CHAR)
+	call mfree (t1, TY_CHAR)
+
+	call malloc (t2, SZ_LINE, TY_INT)
+	call mfree (t2, TY_INT)
+end
diff --git a/sys/nmemio/zzdebug.x b/sys/nmemio/zzdebug.x
new file mode 100644
index 00000000..556c4fa1
--- /dev/null
+++ b/sys/nmemio/zzdebug.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Debug MEMIO.
+
+task	stack=t_stack, realloc=t_realloc
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	sza, new_sza, szb, new_szb
+int	clgeti()
+
+begin
+	call malloc (a, SZ_LINE, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	sza = SZ_LINE
+	call malloc (b, SZ_LINE, TY_CHAR)
+	call strcpy ("0123456789", Memc[b], ARB)
+	szb = SZ_LINE
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	repeat {
+	    new_sza = clgeti ("a_bufsize")
+	    if (new_sza == 0)
+		return
+	    call x_realloc (a, new_sza, TY_CHAR)
+	    new_szb = clgeti ("b_bufsize")
+	    if (new_szb == 0)
+		return
+	    call x_realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("a buf %d, size %d --> %d: %s\n")
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("b buf %d, size %d --> %d: %s\n")
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
diff --git a/sys/nmemio/zzfoo.gx b/sys/nmemio/zzfoo.gx
new file mode 100644
index 00000000..5de60c5b
--- /dev/null
+++ b/sys/nmemio/zzfoo.gx
@@ -0,0 +1,587 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Test procedures for the NMEMIO interface.
+#
+
+include <mach.h>
+
+
+define	MT_HEAP		0			# test heap memory
+define	MT_STACK	1			# test stack memory
+
+
+task memtest 	= t_memtest,
+     stack   	= t_stack, 
+     realloc	= t_realloc
+
+
+#  MEMTEST -- Task to test new memio interface.
+
+procedure t_memtest ()
+
+int	model, nerr
+pointer str, ptr
+
+bool	clgetb()
+
+begin
+	if (clgetb ("stack"))
+	    model = MT_STACK
+	else
+	    model = MT_HEAP
+
+	# Check we can allocate a large array.
+	if (model == MT_HEAP) {
+	    call eprintf ("\nBegin large heap malloc tests ....\n\n")
+	    call malloc (str, 256000, TY_STRUCT)
+	    call mfree (str, TY_STRUCT)
+	    call eprintf ("Done\n\n")
+	
+	    # Print the memory layout.
+	    $for (csiblrdx)
+	        call mt_print (TY_PIXEL)
+	    $endfor
+	    call mt_print (TY_STRUCT)
+	    call mt_print (TY_POINTER)
+	}
+
+	# Test Mem common assignments
+	call eprintf ("\nBegin assignment tests ....\n\n");
+	call mt_auto_b ("bool   ", model)
+	call mt_auto_c ("char   ", model)
+	call mt_auto_s ("short  ", model)
+	call mt_auto_i ("int    ", model)
+	call mt_auto_l ("long   ", model)
+	call mt_auto_r ("real   ", model)
+	call mt_auto_d ("double ", model)
+	call mt_auto_x ("complex", model)
+	call eprintf ("\nEnd assignment tests ....\n\n");
+
+
+	# Test string memory
+	call eprintf ("Begin Memc test\t\t");
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[str], SZ_LINE)
+	call strcpy ("test string", Memc[str], SZ_LINE)
+	call eprintf ("str = '%s'  ch[2] = '%c' (should be 's')\n")
+	    call pargstr (Memc[str])
+	    call pargc (Memc[str+2])
+	call mfree (str, TY_CHAR)
+
+
+	# Test the struct memory
+	call eprintf ("\n\n")
+	call eprintf ("Begin struct test\n")
+	call mt_struct (model)
+	call eprintf ("Done\n")
+
+
+	# Test memory overflow and then underflow detection.
+	call eprintf ("\n\n")
+	call eprintf ("Testing overflow:\t")
+	nerr = 0
+	$for (csiblrdx)
+	    iferr ( call mt_overflow (TY_PIXEL) ) 
+		nerr = nerr + 1;
+	$endfor
+	iferr ( call mt_overflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_overflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+	
+
+	call eprintf ("Testing underflow:\t")
+	nerr = 0
+	$for (csiblrdx)
+	    iferr ( call mt_underflow (TY_PIXEL) ) 
+		nerr = nerr + 1;
+	$endfor
+	iferr ( call mt_underflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_underflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+
+
+	# Note this test will leak 1024 bytes because of the error recovery.
+	call eprintf ("Testing invalid free:\t")
+	call calloc (ptr, 256, TY_REAL)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing double free:\t")
+	call calloc (ptr, 256, TY_INT)
+	call mfree (ptr, TY_INT)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing NULL free:\t")
+	iferr ( call mfree (NULL, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing recovered free:\n")
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call eprintf ("Done\n")
+
+	call eprintf ("\n\nEnd of NMEMIO tests\n")
+end
+
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack ()
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	i, sza, new_sza, szb, new_szb
+
+begin
+	sza = SZ_FNAME
+	szb = SZ_LINE
+
+	call malloc (a, sza, TY_CHAR)
+	call malloc (b, szb, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	call strcpy ("0123456789", Memc[b], ARB)
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	for (i=1; i <= 10; i=i+1) {
+	    if (i < 5) {
+	        new_sza = sza + 512 ; new_szb = szb + 256
+	    } else {
+	        new_sza = sza + 256 ; new_szb = szb + 512
+	    }
+	    call realloc (a, new_sza, TY_CHAR)
+	    call realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("%2d: a buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("%2d: b buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
+
+
+
+define	SZ_TEST		640
+define  F_I1		Memi[$1]
+define  F_I2		Memi[$1+1]
+define  F_L1		Meml[$1+2]
+define  F_L2		Meml[$1+3]
+define  F_R1		Memr[$1+4]
+define  F_R2		Memr[$1+5]
+define  F_D1		Memd[P2D($1+8)]
+define  F_D2		Memd[P2D($1+10)]
+define  F_I3		Memi[$1+12]
+define  F_I4		Memi[$1+13]
+define  F_S1		Mems[P2S($1+14)]
+define  F_S2		Mems[P2S($1+15)]
+
+
+procedure mt_struct (model)
+
+int	model
+
+pointer	sp, str
+real	x, y, z
+double  d1, d2, d3
+
+int	locva()
+
+begin
+	if (model == MT_HEAP) {
+	    call malloc (str, SZ_TEST, TY_STRUCT)
+	} else {
+	    call smark (sp)
+	    call salloc (str, SZ_TEST, TY_STRUCT)
+	}
+
+
+	F_I1(str) = 1
+	F_I2(str) = 2
+	F_L1(str) = 3
+	F_L2(str) = 4
+	F_R1(str) = 5.0
+	F_R2(str) = 6.0
+	F_D1(str) = 7.0
+	F_D2(str) = 8.0
+	F_I3(str) = 9
+	F_I4(str) = 10
+	F_S1(str) = 11
+	F_S2(str) = 12
+
+	x 	   = 2.717	;   d1 	   = F_R1(str)
+	y 	   = 2.717	;   d2 	   = 3.14159d0	;
+	z 	   = double(x)  ;   d3 	   = double(3.14159)
+
+	call eprintf ("\nd1=%.6g d2=%.6g d3=%.6g    x=%.6g y=%.6g z=%.6g)\n\n")
+	    call pargd (d1)  ; call pargd (d2) ; call pargd (d3)
+	    call pargr (x)   ; call pargr (y)  ; call pargr (z)
+
+	call eprintf ("Done Setting values ....\n\ntest = %d  %d  %d\n\n")
+	    call pargi (str) 
+	    call pargi (locva(str))
+	    call pargi (locva(F_I1(str)))
+
+	# call mdump (str, 64)
+
+	call eprintf ("I1 = %4d  I2 = %4d   \t%d %d\n")
+	    call pargi (F_I1(str))        ; call pargi (F_I2(str))
+	    call pargi (locva(F_I1(str))) ; call pargi (locva(F_I2(str)))
+
+	call eprintf ("L1 = %4d  L2 = %4d   \t%d %d\n")
+	    call pargl (F_L1(str))        ; call pargl (F_L2(str))
+	    call pargi (locva(F_L1(str))) ; call pargi (locva(F_L2(str)))
+
+	call eprintf ("R1 = %4.1f  R2 = %4.1f   \t%d %d\n")
+	    call pargr (F_R1(str))	  ; call pargr (F_R2(str))
+	    call pargi (locva(F_R1(str))) ; call pargi (locva(F_R2(str)))
+
+	call eprintf ("D1 = %4.1f  D2 = %4.1f   \t%d %d\n")
+	    call pargd (F_D1(str))	  ; call pargd (F_D2(str))
+	    call pargi (locva(F_D1(str))) ; call pargi (locva(F_D2(str)))
+
+	call eprintf ("I3 = %4d  I4 = %4d   \t%d %d\n")
+	    call pargi (F_I3(str))        ; call pargi (F_I4(str))
+	    call pargi (locva(F_I3(str))) ; call pargi (locva(F_I4(str)))
+
+	call eprintf ("S1 = %4d  S2 = %4d   \t%d %d\n")
+	    call pargs (F_S1(str))        ; call pargs (F_S2(str))
+	    call pargi (locva(F_S1(str))) ; call pargi (locva(F_S2(str)))
+
+
+        if (model == MT_HEAP)
+    	    call mfree (str, TY_STRUCT)
+        else
+    	    call sfree (sp)
+end
+
+
+define	NVALS		3
+
+procedure mt_print (dtype)
+
+int	dtype
+
+int	i, locva(), coerce()
+real	x
+double	xx
+pointer	p, bp, lwl
+
+begin
+    call calloc (p, NVALS, dtype)
+    bp = coerce (p, dtype, TY_INT)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    # Print the ptr header.
+    call eprintf ("\n")
+    call eprintf ("         p = 0x%-15x  %-16d\t%d\n")
+	call pargi (p)  ;  call pargi (p)  ;   call pargi (locva(Memi[bp]))
+    call eprintf ("       fwa = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-5)	; call pargi (Memi[bp-5])
+	call pargi (locva (Memi[bp-5]))
+    call eprintf ("       lwl = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-4)	; call pargi (Memi[bp-4])
+	call pargi (locva (Memi[bp-4]))
+    call eprintf ("     dtype = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-3)	; call mptype (dtype)
+	call pargi (locva (Memi[bp-3]))
+    call eprintf ("     nelem = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-2)	; call pargi (Memi[bp-2])
+	call pargi (locva (Memi[bp-2]))
+    call eprintf ("L sentinal = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-1)	; call pargi (Memi[bp-1])
+	call pargi (locva (Memi[bp-1]))
+
+
+    # Print the values.
+    call eprintf ("      data =    ")
+    for (i=0; i < NVALS; i=i+1) {
+	switch (dtype) {
+	case TY_BOOL:
+	    call eprintf (" %3b\t\t\t\t\t%-15d")
+		call pargb (Memb[p+i])
+		call pargi (locva(Memb[p+i]))
+	case TY_CHAR:
+	    call eprintf (" %3c\t\t\t\t\t%-15d")
+		call pargc (Memc[p+i])
+		call pargi (locva(Memc[p+i]))
+	case TY_SHORT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargs (Mems[p+i])
+		call pargi (locva(Mems[p+i]))
+	case TY_INT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_LONG:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargl (Meml[p+i])
+		call pargi (locva(Meml[p+i]))
+	case TY_REAL:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargr (Memr[p+i])
+		call pargi (locva(Memr[p+i]))
+	case TY_DOUBLE:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargd (Memd[p+i])
+		call pargi (locva(Memd[p+i]))
+	case TY_COMPLEX:
+	    call eprintf (" %3x\t\t\t\t\t%-15d")
+		call pargx (Memx[p+i])
+		call pargi (locva(Memx[p+i]))
+	case TY_STRUCT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_POINTER:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	}
+	call eprintf ("\n")
+	if (i < (NVALS-1))
+	    call eprintf ("\t\t")
+    }
+
+    lwl = Memi[bp-4]
+    call eprintf ("U sentinal = 0x%-15x  %-15d\t\t%d\n\n")
+	call pargi (lwl)	; call pargi (Memi[lwl])
+	call pargi (locva (Memi[lwl]))
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_overflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS + 4; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_underflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE		; Memb[p-1] = FALSE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i		; Memc[p-1] = '0'
+	case TY_SHORT:	  Mems[p+i] = i			; Mems[p-1] = 999
+	case TY_INT:	  Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_LONG:	  Meml[p+i] = i			; Meml[p-1] = 999
+	case TY_REAL:	  Memr[p+i] = x			; Memr[p-1] = 999
+	case TY_DOUBLE:	  Memd[p+i] = xx		; Memd[p-1] = 999
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)	; Memx[p-1] = 999
+	case TY_STRUCT:   Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_POINTER:  Memi[p+i] = i			; Memi[p-1] = 999
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mptype (dtype)
+int	dtype
+begin
+    switch (dtype) {
+    case TY_BOOL:	call pargstr ("TY_BOOL   ")
+    case TY_CHAR:	call pargstr ("TY_CHAR   ")
+    case TY_SHORT:	call pargstr ("TY_SHORT  ")
+    case TY_INT:	call pargstr ("TY_INT    ")
+    case TY_LONG:	call pargstr ("TY_LONG   ")
+    case TY_REAL:	call pargstr ("TY_REAL   ")
+    case TY_DOUBLE:	call pargstr ("TY_DOUBLE ")
+    case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+    case TY_STRUCT:     call pargstr ("TY_STRUCT ")
+    case TY_POINTER:    call pargstr ("TY_POINTER")
+    }
+end
+
+
+
+# Generic Mem_ test assignment.
+
+define	NAVALS		4
+
+$for (bcsilrdx)
+
+procedure mt_auto_$t (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_PIXEL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_PIXEL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+    $if (datatype == b)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = TRUE
+	call eprintf ("[ %b %b %b %b ]\n")
+    $endif
+    $if (datatype == c)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = 'a' + i
+	call eprintf ("[ %-3c %-3c %-3c %-3c ]\n")
+    $endif
+    $if (datatype == x)
+        for (i=0; i < NAVALS; i=i+1) {
+	    x = i
+	    Mem$t[ip+i] = cmplx(x,0.1)
+	}
+	call eprintf ("[ %x  %x  %x  %x  ]\n")
+    $endif
+    $if (datatype == sil)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+    $endif
+    $if (datatype == rd)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+    $endif
+        for (i=0; i < NAVALS; i=i+1)
+	    call parg$t (Mem$t[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_PIXEL)
+    else
+    	call sfree (sp)
+end
+
+$endfor
diff --git a/sys/nmemio/zzfoo.x b/sys/nmemio/zzfoo.x
new file mode 100644
index 00000000..a9e51dcf
--- /dev/null
+++ b/sys/nmemio/zzfoo.x
@@ -0,0 +1,908 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Test procedures for the NMEMIO interface.
+#
+
+include <mach.h>
+
+
+define	MT_HEAP		0			# test heap memory
+define	MT_STACK	1			# test stack memory
+
+
+task memtest 	= t_memtest,
+     stack   	= t_stack, 
+     realloc	= t_realloc
+
+
+#  MEMTEST -- Task to test new memio interface.
+
+procedure t_memtest ()
+
+int	model, nerr
+pointer str, ptr
+
+bool	clgetb()
+
+begin
+	if (clgetb ("stack"))
+	    model = MT_STACK
+	else
+	    model = MT_HEAP
+
+	# Check we can allocate a large array.
+	if (model == MT_HEAP) {
+	    call eprintf ("\nBegin large heap malloc tests ....\n\n")
+	    call malloc (str, 256000, TY_STRUCT)
+	    call mfree (str, TY_STRUCT)
+	    call eprintf ("Done\n\n")
+	
+	    # Print the memory layout.
+
+	        call mt_print (TY_CHAR)
+
+	        call mt_print (TY_SHORT)
+
+	        call mt_print (TY_INT)
+
+	        call mt_print (TY_BOOL)
+
+	        call mt_print (TY_LONG)
+
+	        call mt_print (TY_REAL)
+
+	        call mt_print (TY_DOUBLE)
+
+	        call mt_print (TY_COMPLEX)
+
+	    call mt_print (TY_STRUCT)
+	    call mt_print (TY_POINTER)
+	}
+
+	# Test Mem common assignments
+	call eprintf ("\nBegin assignment tests ....\n\n");
+	call mt_auto_b ("bool   ", model)
+	call mt_auto_c ("char   ", model)
+	call mt_auto_s ("short  ", model)
+	call mt_auto_i ("int    ", model)
+	call mt_auto_l ("long   ", model)
+	call mt_auto_r ("real   ", model)
+	call mt_auto_d ("double ", model)
+	call mt_auto_x ("complex", model)
+	call eprintf ("\nEnd assignment tests ....\n\n");
+
+
+	# Test string memory
+	call eprintf ("Begin Memc test\t\t");
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[str], SZ_LINE)
+	call strcpy ("test string", Memc[str], SZ_LINE)
+	call eprintf ("str = '%s'  ch[2] = '%c' (should be 's')\n")
+	    call pargstr (Memc[str])
+	    call pargc (Memc[str+2])
+	call mfree (str, TY_CHAR)
+
+
+	# Test the struct memory
+	call eprintf ("\n\n")
+	call eprintf ("Begin struct test\n")
+	call mt_struct (model)
+	call eprintf ("Done\n")
+
+
+	# Test memory overflow and then underflow detection.
+	call eprintf ("\n\n")
+	call eprintf ("Testing overflow:\t")
+	nerr = 0
+
+	    iferr ( call mt_overflow (TY_CHAR) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_SHORT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_INT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_BOOL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_LONG) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_REAL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_DOUBLE) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_COMPLEX) ) 
+		nerr = nerr + 1;
+
+	iferr ( call mt_overflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_overflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+	
+
+	call eprintf ("Testing underflow:\t")
+	nerr = 0
+
+	    iferr ( call mt_underflow (TY_CHAR) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_SHORT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_INT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_BOOL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_LONG) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_REAL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_DOUBLE) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_COMPLEX) ) 
+		nerr = nerr + 1;
+
+	iferr ( call mt_underflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_underflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+
+
+	# Note this test will leak 1024 bytes because of the error recovery.
+	call eprintf ("Testing invalid free:\t")
+	call calloc (ptr, 256, TY_REAL)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing double free:\t")
+	call calloc (ptr, 256, TY_INT)
+	call mfree (ptr, TY_INT)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing NULL free:\t")
+	iferr ( call mfree (NULL, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing recovered free:\n")
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call eprintf ("Done\n")
+
+	call eprintf ("\n\nEnd of NMEMIO tests\n")
+end
+
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack ()
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	i, sza, new_sza, szb, new_szb
+
+begin
+	sza = SZ_FNAME
+	szb = SZ_LINE
+
+	call malloc (a, sza, TY_CHAR)
+	call malloc (b, szb, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	call strcpy ("0123456789", Memc[b], ARB)
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	for (i=1; i <= 10; i=i+1) {
+	    if (i < 5) {
+	        new_sza = sza + 512 ; new_szb = szb + 256
+	    } else {
+	        new_sza = sza + 256 ; new_szb = szb + 512
+	    }
+	    call realloc (a, new_sza, TY_CHAR)
+	    call realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("%2d: a buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("%2d: b buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
+
+
+
+define	SZ_TEST		640
+define  F_I1		Memi[$1]
+define  F_I2		Memi[$1+1]
+define  F_L1		Meml[$1+2]
+define  F_L2		Meml[$1+3]
+define  F_R1		Memr[$1+4]
+define  F_R2		Memr[$1+5]
+define  F_D1		Memd[P2D($1+8)]
+define  F_D2		Memd[P2D($1+10)]
+define  F_I3		Memi[$1+12]
+define  F_I4		Memi[$1+13]
+define  F_S1		Mems[P2S($1+14)]
+define  F_S2		Mems[P2S($1+15)]
+
+
+procedure mt_struct (model)
+
+int	model
+
+pointer	sp, str
+real	x, y, z
+double  d1, d2, d3
+
+int	locva()
+
+begin
+	if (model == MT_HEAP) {
+	    call malloc (str, SZ_TEST, TY_STRUCT)
+	} else {
+	    call smark (sp)
+	    call salloc (str, SZ_TEST, TY_STRUCT)
+	}
+
+
+	F_I1(str) = 1
+	F_I2(str) = 2
+	F_L1(str) = 3
+	F_L2(str) = 4
+	F_R1(str) = 5.0
+	F_R2(str) = 6.0
+	F_D1(str) = 7.0
+	F_D2(str) = 8.0
+	F_I3(str) = 9
+	F_I4(str) = 10
+	F_S1(str) = 11
+	F_S2(str) = 12
+
+	x 	   = 2.717	;   d1 	   = F_R1(str)
+	y 	   = 2.717	;   d2 	   = 3.14159d0	;
+	z 	   = double(x)  ;   d3 	   = double(3.14159)
+
+	call eprintf ("\nd1=%.6g d2=%.6g d3=%.6g    x=%.6g y=%.6g z=%.6g)\n\n")
+	    call pargd (d1)  ; call pargd (d2) ; call pargd (d3)
+	    call pargr (x)   ; call pargr (y)  ; call pargr (z)
+
+	call eprintf ("Done Setting values ....\n\ntest = %d  %d  %d\n\n")
+	    call pargi (str) 
+	    call pargi (locva(str))
+	    call pargi (locva(F_I1(str)))
+
+	# call mdump (str, 64)
+
+	call eprintf ("I1 = %4d  I2 = %4d   \t%d %d\n")
+	    call pargi (F_I1(str))        ; call pargi (F_I2(str))
+	    call pargi (locva(F_I1(str))) ; call pargi (locva(F_I2(str)))
+
+	call eprintf ("L1 = %4d  L2 = %4d   \t%d %d\n")
+	    call pargl (F_L1(str))        ; call pargl (F_L2(str))
+	    call pargi (locva(F_L1(str))) ; call pargi (locva(F_L2(str)))
+
+	call eprintf ("R1 = %4.1f  R2 = %4.1f   \t%d %d\n")
+	    call pargr (F_R1(str))	  ; call pargr (F_R2(str))
+	    call pargi (locva(F_R1(str))) ; call pargi (locva(F_R2(str)))
+
+	call eprintf ("D1 = %4.1f  D2 = %4.1f   \t%d %d\n")
+	    call pargd (F_D1(str))	  ; call pargd (F_D2(str))
+	    call pargi (locva(F_D1(str))) ; call pargi (locva(F_D2(str)))
+
+	call eprintf ("I3 = %4d  I4 = %4d   \t%d %d\n")
+	    call pargi (F_I3(str))        ; call pargi (F_I4(str))
+	    call pargi (locva(F_I3(str))) ; call pargi (locva(F_I4(str)))
+
+	call eprintf ("S1 = %4d  S2 = %4d   \t%d %d\n")
+	    call pargs (F_S1(str))        ; call pargs (F_S2(str))
+	    call pargi (locva(F_S1(str))) ; call pargi (locva(F_S2(str)))
+
+
+        if (model == MT_HEAP)
+    	    call mfree (str, TY_STRUCT)
+        else
+    	    call sfree (sp)
+end
+
+
+define	NVALS		3
+
+procedure mt_print (dtype)
+
+int	dtype
+
+int	i, locva(), coerce()
+real	x
+double	xx
+pointer	p, bp, lwl
+
+begin
+    call calloc (p, NVALS, dtype)
+    bp = coerce (p, dtype, TY_INT)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    # Print the ptr header.
+    call eprintf ("\n")
+    call eprintf ("         p = 0x%-15x  %-16d\t%d\n")
+	call pargi (p)  ;  call pargi (p)  ;   call pargi (locva(Memi[bp]))
+    call eprintf ("       fwa = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-5)	; call pargi (Memi[bp-5])
+	call pargi (locva (Memi[bp-5]))
+    call eprintf ("       lwl = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-4)	; call pargi (Memi[bp-4])
+	call pargi (locva (Memi[bp-4]))
+    call eprintf ("     dtype = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-3)	; call mptype (dtype)
+	call pargi (locva (Memi[bp-3]))
+    call eprintf ("     nelem = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-2)	; call pargi (Memi[bp-2])
+	call pargi (locva (Memi[bp-2]))
+    call eprintf ("L sentinal = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-1)	; call pargi (Memi[bp-1])
+	call pargi (locva (Memi[bp-1]))
+
+
+    # Print the values.
+    call eprintf ("      data =    ")
+    for (i=0; i < NVALS; i=i+1) {
+	switch (dtype) {
+	case TY_BOOL:
+	    call eprintf (" %3b\t\t\t\t\t%-15d")
+		call pargb (Memb[p+i])
+		call pargi (locva(Memb[p+i]))
+	case TY_CHAR:
+	    call eprintf (" %3c\t\t\t\t\t%-15d")
+		call pargc (Memc[p+i])
+		call pargi (locva(Memc[p+i]))
+	case TY_SHORT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargs (Mems[p+i])
+		call pargi (locva(Mems[p+i]))
+	case TY_INT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_LONG:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargl (Meml[p+i])
+		call pargi (locva(Meml[p+i]))
+	case TY_REAL:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargr (Memr[p+i])
+		call pargi (locva(Memr[p+i]))
+	case TY_DOUBLE:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargd (Memd[p+i])
+		call pargi (locva(Memd[p+i]))
+	case TY_COMPLEX:
+	    call eprintf (" %3x\t\t\t\t\t%-15d")
+		call pargx (Memx[p+i])
+		call pargi (locva(Memx[p+i]))
+	case TY_STRUCT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_POINTER:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	}
+	call eprintf ("\n")
+	if (i < (NVALS-1))
+	    call eprintf ("\t\t")
+    }
+
+    lwl = Memi[bp-4]
+    call eprintf ("U sentinal = 0x%-15x  %-15d\t\t%d\n\n")
+	call pargi (lwl)	; call pargi (Memi[lwl])
+	call pargi (locva (Memi[lwl]))
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_overflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS + 4; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_underflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE		; Memb[p-1] = FALSE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i		; Memc[p-1] = '0'
+	case TY_SHORT:	  Mems[p+i] = i			; Mems[p-1] = 999
+	case TY_INT:	  Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_LONG:	  Meml[p+i] = i			; Meml[p-1] = 999
+	case TY_REAL:	  Memr[p+i] = x			; Memr[p-1] = 999
+	case TY_DOUBLE:	  Memd[p+i] = xx		; Memd[p-1] = 999
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)	; Memx[p-1] = 999
+	case TY_STRUCT:   Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_POINTER:  Memi[p+i] = i			; Memi[p-1] = 999
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mptype (dtype)
+int	dtype
+begin
+    switch (dtype) {
+    case TY_BOOL:	call pargstr ("TY_BOOL   ")
+    case TY_CHAR:	call pargstr ("TY_CHAR   ")
+    case TY_SHORT:	call pargstr ("TY_SHORT  ")
+    case TY_INT:	call pargstr ("TY_INT    ")
+    case TY_LONG:	call pargstr ("TY_LONG   ")
+    case TY_REAL:	call pargstr ("TY_REAL   ")
+    case TY_DOUBLE:	call pargstr ("TY_DOUBLE ")
+    case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+    case TY_STRUCT:     call pargstr ("TY_STRUCT ")
+    case TY_POINTER:    call pargstr ("TY_POINTER")
+    }
+end
+
+
+
+# Generic Mem_ test assignment.
+
+define	NAVALS		4
+
+
+
+procedure mt_auto_b (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_BOOL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_BOOL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memb[ip+i] = TRUE
+	call eprintf ("[ %b %b %b %b ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargb (Memb[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_BOOL)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_c (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_CHAR)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_CHAR)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memc[ip+i] = 'a' + i
+	call eprintf ("[ %-3c %-3c %-3c %-3c ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargc (Memc[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_CHAR)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_s (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_SHORT)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_SHORT)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Mems[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargs (Mems[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_SHORT)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_i (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_INT)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_INT)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memi[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargi (Memi[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_INT)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_l (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_LONG)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_LONG)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Meml[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargl (Meml[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_LONG)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_r (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_REAL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_REAL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memr[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargr (Memr[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_REAL)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_d (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_DOUBLE)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_DOUBLE)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memd[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargd (Memd[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_DOUBLE)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_x (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_COMPLEX)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_COMPLEX)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1) {
+	    x = i
+	    Memx[ip+i] = cmplx(x,0.1)
+	}
+	call eprintf ("[ %x  %x  %x  %x  ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargx (Memx[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_COMPLEX)
+    else
+    	call sfree (sp)
+end
+
+
diff --git a/sys/osb/README b/sys/osb/README
new file mode 100644
index 00000000..c3fda892
--- /dev/null
+++ b/sys/osb/README
@@ -0,0 +1,4 @@
+OSB -- Bit and byte primitives.
+
+	zzeps.f - a program to compute the machine epsilon.
+		  (not part of the library)
diff --git a/sys/osb/_proto b/sys/osb/_proto
new file mode 100644
index 00000000..c247bb87
--- /dev/null
+++ b/sys/osb/_proto
@@ -0,0 +1,77 @@
+extern int bitmov_(integer *a, integer *aoff, integer *b, integer *boff, integer *nbits);
+extern int bswap2_(char *a, integer *aoff, char *b, integer *boff, integer *nbytes, ftnlen a_len, ftnlen b_len);
+extern int bswap4_(char *a, integer *aoff, char *b, integer *boff, integer *nbytes, ftnlen a_len, ftnlen b_len);
+extern int bytmov_(char *a, integer *aoff, char *b, integer *boff, integer *nbytes, ftnlen a_len, ftnlen b_len);
+extern int chrpak_(shortint *a, integer *aoff, char *b, integer *boff, integer *nchars, ftnlen b_len);
+extern int chrupk_(char *a, integer *aoff, shortint *b, integer *boff, integer *nchars, ftnlen a_len);
+extern int f77pak_(shortint *sppstr, char *f77str, integer *maxch, ftnlen f77str_len);
+extern int f77upk_(char *f77str, shortint *sppstr, integer *maxch, ftnlen f77str_len);
+extern int ieevpd_(doublereal *native, doublereal *ieee, integer *nelem);
+extern int ieevud_(doublereal *ieee, doublereal *native, integer *nelem);
+extern int ieepad_(doublereal *x);
+extern int ieeupd_(doublereal *x);
+extern int ieesnd_(doublereal *x);
+extern int ieegnd_(doublereal *x);
+extern int ieestd_(integer *onin, integer *onout);
+extern int ieezsd_(void);
+extern int ieemad_(integer *inval, integer *outval);
+extern int ieegmd_(integer *inval, integer *outval);
+extern int ieesmd_(integer *inval, integer *outval);
+extern int ieevpr_(real *native, real *ieee, integer *nelem);
+extern int ieevur_(real *ieee, real *native, integer *nelem);
+extern int ieepar_(real *x);
+extern int ieeupr_(real *x);
+extern int ieesnr_(real *x);
+extern int ieegnr_(real *x);
+extern int ieestr_(integer *onin, integer *onout);
+extern int ieezsr_(void);
+extern int ieemar_(integer *inval, integer *outval);
+extern int ieegmr_(integer *inval, integer *outval);
+extern int ieesmr_(integer *inval, integer *outval);
+extern integer miilen_(integer *nelems, integer *miidae);
+extern integer miinem_(integer *nchars, integer *miitye);
+extern int miipak_(integer *spp, integer *mii, integer *nelems, integer *sppdae, integer *miidae);
+extern int miipa6_(integer *spp, integer *mii, integer *nelems, integer *sppdae);
+extern int miipa2_(integer *spp, integer *mii, integer *nelems, integer *sppdae);
+extern int miipa8_(integer *spp, integer *mii, integer *nelems, integer *sppdae);
+extern int miipad_(integer *spp, doublereal *mii, integer *nelems, integer *sppdae);
+extern int miipar_(integer *spp, real *mii, integer *nelems, integer *sppdae);
+extern integer miipke_(integer *nelems, integer *miitye);
+extern int miiupk_(integer *mii, integer *spp, integer *nelems, integer *miidae, integer *sppdae);
+extern int miiup6_(integer *mii, integer *spp, integer *nelems, integer *sppdae);
+extern int miiup2_(integer *mii, integer *spp, integer *nelems, integer *sppdae);
+extern int miiup8_(integer *mii, integer *spp, integer *nelems, integer *sppdae);
+extern int miiupd_(doublereal *mii, integer *spp, integer *nelems, integer *sppdae);
+extern int miiupr_(real *mii, integer *spp, integer *nelems, integer *sppdae);
+extern integer nmilen_(integer *nelems, integer *nmidae);
+extern integer nminem_(integer *nchars, integer *nmitye);
+extern int nmipak_(integer *spp, integer *nmi, integer *nelems, integer *sppdae, integer *nmidae);
+extern int nmipa6_(integer *spp, integer *nmi, integer *nelems, integer *sppdae);
+extern int nmipa2_(integer *spp, integer *nmi, integer *nelems, integer *sppdae);
+extern int nmipa8_(integer *spp, integer *nmi, integer *nelems, integer *sppdae);
+extern int nmipad_(integer *spp, doublereal *nmi, integer *nelems, integer *sppdae);
+extern int nmipar_(integer *spp, real *nmi, integer *nelems, integer *sppdae);
+extern integer nmipke_(integer *nelems, integer *nmitye);
+extern int nmiupk_(integer *nmi, integer *spp, integer *nelems, integer *nmidae, integer *sppdae);
+extern int nmiup6_(integer *nmi, integer *spp, integer *nelems, integer *sppdae);
+extern int nmiup2_(integer *nmi, integer *spp, integer *nelems, integer *sppdae);
+extern int nmiup8_(integer *nmi, integer *spp, integer *nelems, integer *sppdae);
+extern int nmiupd_(doublereal *nmi, integer *spp, integer *nelems, integer *sppdae);
+extern int nmiupr_(real *nmi, integer *spp, integer *nelems, integer *sppdae);
+extern int strpak_(shortint *instr, char *outstr, integer *maxch, ftnlen outstr_len);
+extern int strupk_(char *instr, shortint *outstr, integer *maxch, ftnlen instr_len);
+extern real urand_(integer *lseed);
+extern integer xori_(integer *a, integer *b);
+extern shortint xors_(shortint *a, shortint *b);
+extern integer xorl_(integer *a, integer *b);
+extern integer sysruk_(shortint *task, shortint *cmd, integer *rukarf, integer *rukint);
+extern int sbit_(void);
+extern int tbit_(void);
+extern int cseps_(real *seps);
+extern logical sgt_(real *value);
+extern int cdeps_(doublereal *deps);
+extern logical dgt_(doublereal *value);
+extern int cseps_(real *seps);
+extern logical sgt_(real *value, real *ref);
+extern int cdeps_(doublereal *deps);
+extern logical dgt_(doublereal *value, doublereal *ref);
diff --git a/sys/osb/abs.c b/sys/osb/abs.c
new file mode 100644
index 00000000..90bd3ad6
--- /dev/null
+++ b/sys/osb/abs.c
@@ -0,0 +1,13 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#include <iraf.h>
+
+/* ABS -- Integer absolute value.
+ */
+XINT
+abs_ (XINT *a)
+{
+	return (abs(a));
+}
diff --git a/sys/osb/achtb.gc b/sys/osb/achtb.gc
new file mode 100644
index 00000000..dd5f97d2
--- /dev/null
+++ b/sys/osb/achtb.gc
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTB$T (
+  XCHAR		*a,
+  $if (datatype == B)
+  XCHAR		*b,
+  $else
+  XPIXEL	*b,
+  $endif
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XPIXEL	*op;
+
+	for (ip = &first[*npix], op = &((XPIXEL *)b)[*npix];  ip > first;  )
+	    $if (datatype == x)
+		(--op)->r = (float) *--ip;
+	    $else
+		*--op = *--ip;
+	    $endif
+}
diff --git a/sys/osb/achtbb.c b/sys/osb/achtbb.c
new file mode 100644
index 00000000..26a48e99
--- /dev/null
+++ b/sys/osb/achtbb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBB (
+  XCHAR		*a,
+  XCHAR		*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XUBYTE	*op;
+
+	for (ip = &first[*npix], op = &((XUBYTE *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbc.c b/sys/osb/achtbc.c
new file mode 100644
index 00000000..a1a778c2
--- /dev/null
+++ b/sys/osb/achtbc.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBC (
+  XCHAR		*a,
+  XCHAR	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XCHAR	*op;
+
+	for (ip = &first[*npix], op = &((XCHAR *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbd.c b/sys/osb/achtbd.c
new file mode 100644
index 00000000..deb2f23a
--- /dev/null
+++ b/sys/osb/achtbd.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBD (
+  XCHAR		*a,
+  XDOUBLE	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XDOUBLE	*op;
+
+	for (ip = &first[*npix], op = &((XDOUBLE *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbi.c b/sys/osb/achtbi.c
new file mode 100644
index 00000000..41733ce8
--- /dev/null
+++ b/sys/osb/achtbi.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBI (
+  XCHAR		*a,
+  XINT	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XINT	*op;
+
+	for (ip = &first[*npix], op = &((XINT *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbl.c b/sys/osb/achtbl.c
new file mode 100644
index 00000000..a1090d62
--- /dev/null
+++ b/sys/osb/achtbl.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBL (
+  XCHAR		*a,
+  XLONG	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XLONG	*op;
+
+	for (ip = &first[*npix], op = &((XLONG *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbr.c b/sys/osb/achtbr.c
new file mode 100644
index 00000000..72839ce9
--- /dev/null
+++ b/sys/osb/achtbr.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBR (
+  XCHAR		*a,
+  XREAL	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XREAL	*op;
+
+	for (ip = &first[*npix], op = &((XREAL *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbs.c b/sys/osb/achtbs.c
new file mode 100644
index 00000000..da68e65d
--- /dev/null
+++ b/sys/osb/achtbs.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBS (
+  XCHAR		*a,
+  XSHORT	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XSHORT	*op;
+
+	for (ip = &first[*npix], op = &((XSHORT *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbu.c b/sys/osb/achtbu.c
new file mode 100644
index 00000000..45b523ca
--- /dev/null
+++ b/sys/osb/achtbu.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBU (
+  XCHAR		*a,
+  XUSHORT	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XUSHORT	*op;
+
+	for (ip = &first[*npix], op = &((XUSHORT *)b)[*npix];  ip > first;  )
+		*--op = *--ip;
+}
diff --git a/sys/osb/achtbx.c b/sys/osb/achtbx.c
new file mode 100644
index 00000000..a62a48c1
--- /dev/null
+++ b/sys/osb/achtbx.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTB_ -- Unpack an unsigned byte array into an SPP array.
+ * The loop runs in the reverse direction so that the unpack can be
+ * performed in place (a and b can be the same array).
+ */
+void
+ACHTBX (
+  XCHAR		*a,
+  XCOMPLEX	*b,
+  XINT		*npix
+)
+{
+	register XUBYTE	*ip, *first = (XUBYTE *)a;
+	register XCOMPLEX	*op;
+
+	for (ip = &first[*npix], op = &((XCOMPLEX *)b)[*npix];  ip > first;  )
+		(--op)->r = (float) *--ip;
+}
diff --git a/sys/osb/achtcb.c b/sys/osb/achtcb.c
new file mode 100644
index 00000000..d9749e62
--- /dev/null
+++ b/sys/osb/achtcb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTCB (
+  XCHAR  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XCHAR	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XCHAR *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtcu.c b/sys/osb/achtcu.c
new file mode 100644
index 00000000..1a0b3d1c
--- /dev/null
+++ b/sys/osb/achtcu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTCU (
+  XCHAR   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XCHAR		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtdb.c b/sys/osb/achtdb.c
new file mode 100644
index 00000000..e7cd0663
--- /dev/null
+++ b/sys/osb/achtdb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTDB (
+  XDOUBLE  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XDOUBLE	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XDOUBLE *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtdu.c b/sys/osb/achtdu.c
new file mode 100644
index 00000000..bcea4762
--- /dev/null
+++ b/sys/osb/achtdu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTDU (
+  XDOUBLE   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XDOUBLE		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtib.c b/sys/osb/achtib.c
new file mode 100644
index 00000000..74977f40
--- /dev/null
+++ b/sys/osb/achtib.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTIB (
+  XINT  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XINT	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XINT *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtiu.c b/sys/osb/achtiu.c
new file mode 100644
index 00000000..5b14bd43
--- /dev/null
+++ b/sys/osb/achtiu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTIU (
+  XINT   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XINT		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtlb.c b/sys/osb/achtlb.c
new file mode 100644
index 00000000..fcf63a87
--- /dev/null
+++ b/sys/osb/achtlb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTLB (
+  XLONG  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XLONG	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XLONG *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtlu.c b/sys/osb/achtlu.c
new file mode 100644
index 00000000..a669577e
--- /dev/null
+++ b/sys/osb/achtlu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTLU (
+  XLONG   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XLONG		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtrb.c b/sys/osb/achtrb.c
new file mode 100644
index 00000000..47d27e87
--- /dev/null
+++ b/sys/osb/achtrb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTRB (
+  XREAL  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XREAL	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XREAL *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtru.c b/sys/osb/achtru.c
new file mode 100644
index 00000000..70a99f7f
--- /dev/null
+++ b/sys/osb/achtru.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTRU (
+  XREAL   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XREAL		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtsb.c b/sys/osb/achtsb.c
new file mode 100644
index 00000000..f8453873
--- /dev/null
+++ b/sys/osb/achtsb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTSB (
+  XSHORT  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XSHORT	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XSHORT *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = *ip++;
+}
diff --git a/sys/osb/achtsu.c b/sys/osb/achtsu.c
new file mode 100644
index 00000000..269a5122
--- /dev/null
+++ b/sys/osb/achtsu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTSU (
+  XSHORT   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XSHORT		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtu.gc b/sys/osb/achtu.gc
new file mode 100644
index 00000000..35e8f226
--- /dev/null
+++ b/sys/osb/achtu.gc
@@ -0,0 +1,37 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTU$T (
+  XUSHORT  	*a,
+  XPIXEL   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XPIXEL	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		$if (datatype == x)
+		    (--op)->r = (float) *--ip;
+		$else
+		    *--op = *--ip;
+		$endif
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		$if (datatype == x)
+		    (op++)->r = (float) *ip++;
+		$else
+		    *op++ = *ip++;
+		$endif
+	}
+}
diff --git a/sys/osb/achtub.c b/sys/osb/achtub.c
new file mode 100644
index 00000000..a772f3f0
--- /dev/null
+++ b/sys/osb/achtub.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUB (
+  XUSHORT  	*a,
+  XUBYTE   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XUBYTE	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtuc.c b/sys/osb/achtuc.c
new file mode 100644
index 00000000..7779e036
--- /dev/null
+++ b/sys/osb/achtuc.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUC (
+  XUSHORT  	*a,
+  XCHAR   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XCHAR	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtud.c b/sys/osb/achtud.c
new file mode 100644
index 00000000..0d825c3b
--- /dev/null
+++ b/sys/osb/achtud.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUD (
+  XUSHORT  	*a,
+  XDOUBLE   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XDOUBLE	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtui.c b/sys/osb/achtui.c
new file mode 100644
index 00000000..dea6c326
--- /dev/null
+++ b/sys/osb/achtui.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUI (
+  XUSHORT  	*a,
+  XINT   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XINT	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtul.c b/sys/osb/achtul.c
new file mode 100644
index 00000000..f6b0b94e
--- /dev/null
+++ b/sys/osb/achtul.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUL (
+  XUSHORT  	*a,
+  XLONG   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XLONG	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtur.c b/sys/osb/achtur.c
new file mode 100644
index 00000000..eebaba1c
--- /dev/null
+++ b/sys/osb/achtur.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUR (
+  XUSHORT  	*a,
+  XREAL   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XREAL	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtus.c b/sys/osb/achtus.c
new file mode 100644
index 00000000..dc940362
--- /dev/null
+++ b/sys/osb/achtus.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUS (
+  XUSHORT  	*a,
+  XSHORT   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XSHORT	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtuu.c b/sys/osb/achtuu.c
new file mode 100644
index 00000000..55168dea
--- /dev/null
+++ b/sys/osb/achtuu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUU (
+  XUSHORT  	*a,
+  XUSHORT   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XUSHORT	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = *ip++;
+	}
+}
diff --git a/sys/osb/achtux.c b/sys/osb/achtux.c
new file mode 100644
index 00000000..bf44a0ce
--- /dev/null
+++ b/sys/osb/achtux.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHTU_ -- Unpack an unsigned short integer array into an SPP datatype.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTUX (
+  XUSHORT  	*a,
+  XCOMPLEX   	*b,
+  XINT	   	*npix
+)
+{
+	register XUSHORT *ip;
+	register XCOMPLEX	 *op;
+	register int	 n = *npix;
+
+	if (sizeof(*op) >= sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    (--op)->r = (float) *--ip;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    (op++)->r = (float) *ip++;
+	}
+}
diff --git a/sys/osb/achtxb.c b/sys/osb/achtxb.c
new file mode 100644
index 00000000..62dd0274
--- /dev/null
+++ b/sys/osb/achtxb.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTXB (
+  XCOMPLEX  	*a,
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XCOMPLEX	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XCOMPLEX *)a, op=(XUBYTE *)b;  --n >= 0;  )
+		*op++ = (int) (ip++)->r;
+}
diff --git a/sys/osb/achtxu.c b/sys/osb/achtxu.c
new file mode 100644
index 00000000..a5bd8a71
--- /dev/null
+++ b/sys/osb/achtxu.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHTXU (
+  XCOMPLEX   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XCOMPLEX		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		    *--op = (int) (--ip)->r;
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		    *op++ = (int) (ip++)->r;
+	}
+}
diff --git a/sys/osb/achtzb.gc b/sys/osb/achtzb.gc
new file mode 100644
index 00000000..27ef9a48
--- /dev/null
+++ b/sys/osb/achtzb.gc
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_B -- Pack SPP array into an unsigned byte array.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHT$TB (
+  $if (datatype == B)
+  XCHAR  	*a,
+  $else
+  XPIXEL  	*a,
+  $endif
+  XCHAR	    	*b,
+  XINT	    	*npix
+)
+{
+	register XPIXEL	*ip;
+	register XUBYTE	*op;
+	register int n = *npix;
+
+	for (ip=(XPIXEL *)a, op=(XUBYTE *)b;  --n >= 0;  )
+	    $if (datatype == x)
+		*op++ = (int) (ip++)->r;
+	    $else
+		*op++ = *ip++;
+	    $endif
+}
diff --git a/sys/osb/achtzu.gc b/sys/osb/achtzu.gc
new file mode 100644
index 00000000..4e5faacd
--- /dev/null
+++ b/sys/osb/achtzu.gc
@@ -0,0 +1,37 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACHT_U -- Pack an SPP datatype array into an unsigned short integer.
+ * [MACHDEP]: The underscore appended to the procedure name is OS dependent.
+ */
+void
+ACHT$TU (
+  XPIXEL   	*a,
+  XUSHORT  	*b,
+  XINT	   	*npix
+)
+{
+	register XPIXEL		*ip;
+	register XUSHORT	*op;
+	register int		n = *npix;
+
+	if (sizeof(*op) > sizeof(*ip)) {
+	    for (ip = &a[n], op = &b[n];  ip > a;  )
+		$if (datatype == x)
+		    *--op = (int) (--ip)->r;
+		$else
+		    *--op = *--ip;
+		$endif
+	} else {
+	    for (ip=a, op=b;  --n >= 0;  )
+		$if (datatype == x)
+		    *op++ = (int) (ip++)->r;
+		$else
+		    *op++ = *ip++;
+		$endif
+	}
+}
diff --git a/sys/osb/aclrb.c b/sys/osb/aclrb.c
new file mode 100644
index 00000000..15d63e39
--- /dev/null
+++ b/sys/osb/aclrb.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRB -- Clear a block of memory.
+ */
+void
+ACLRB (XCHAR *a, XINT *nbytes)
+{
+	register char	*p;
+	register int	n;
+
+	for (p=(char *)a, n = *nbytes;  --n >= 0;  )
+	    *p++ = 0;
+}
diff --git a/sys/osb/and.c b/sys/osb/and.c
new file mode 100644
index 00000000..98dcbb07
--- /dev/null
+++ b/sys/osb/and.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ANDI -- Bitwise boolean AND of two integer variables.
+ */
+XINT
+ANDI (XINT *a, XINT *b)
+{
+	return (*a & *b);
+}
+
+
+/* ANDS -- Bitwise boolean AND of two short integer variables.
+ */
+XSHORT
+ANDS (XSHORT *a, XSHORT *b)
+{
+	return (*a & *b);
+}
+
+
+/* ANDL -- Bitwise boolean AND of two long integer variables.
+ */
+XLONG
+ANDL (XLONG *a, XLONG *b)
+{
+	return (*a & *b);
+}
diff --git a/sys/osb/bitfields.c b/sys/osb/bitfields.c
new file mode 100644
index 00000000..3275c542
--- /dev/null
+++ b/sys/osb/bitfields.c
@@ -0,0 +1,70 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/*
+ * BITFIELDS.C -- Portable C routines for extracting and inserting small
+ * integers into an integer value.
+ */
+
+unsigned XINT bitmask[] = {	0,		/* MACHDEP		*/
+  01,			    03,			     07,
+  017,			    037,		     077,
+  0177,			    0377,		     0777,
+  01777,		    03777,		     07777,
+  017777,		    037777,		     077777,
+  0177777,		    0377777,		     0777777,
+  01777777,		    03777777,		     07777777,
+  017777777,		    037777777,		     077777777,
+  0177777777,		    0377777777,		     0777777777,
+  01777777777,		    03777777777,	     07777777777,
+  017777777777,		    037777777777,   	     077777777777,
+  0177777777777,	    0377777777777,   	     0777777777777,
+  01777777777777,	    03777777777777,   	     07777777777777,
+  017777777777777,	    037777777777777,   	     077777777777777,
+  0177777777777777,	    0377777777777777,        0777777777777777,
+  01777777777777777,	    03777777777777777,       07777777777777777,
+  017777777777777777,	    037777777777777777,      077777777777777777,
+  0177777777777777777,	    0377777777777777777,     0777777777777777777,
+  01777777777777777777,	    03777777777777777777,    07777777777777777777,
+  017777777777777777777,    037777777777777777777,   077777777777777777777,
+  0177777777777777777777,   0377777777777777777777,  0777777777777777777777,
+  01777777777777777777777,  03777777777777777777777, 07777777777777777777777
+};
+
+
+
+/* BITPAK -- Pack an unsigned integer value into a bitfield in a longword.
+ * The size of the bitfield may not exceed the number of bits in an integer.
+ */
+void
+BITPAK (
+  unsigned XINT	*ival,		/* value to be placed in bitfield	*/
+  unsigned XINT	*wordp,		/* longword to be written into		*/
+  XINT	*offset,		/* one-indexed offset of first bit	*/
+  XINT	*nbits 			/* number of bits to be set		*/
+)
+{
+	register unsigned XINT	shift;
+	register unsigned XINT	mask;
+
+	shift = *offset - 1;
+	mask = bitmask[*nbits] << shift;
+	*wordp = (*wordp & ~mask) | ((*ival << shift) & mask);
+}
+
+
+/* BITUPK -- Unpack an unsigned integer bit field from a longword.
+ */
+XINT
+BITUPK (
+  unsigned XINT	*wordp,		/* longword to be examined		*/
+  XINT	*offset,		/* one-indexed offset of first bit	*/
+  XINT	*nbits 			/* number of bits to be set		*/
+)
+{
+	return ((*wordp >> (*offset-1)) & bitmask[*nbits]);
+}
diff --git a/sys/osb/bitmov.x b/sys/osb/bitmov.x
new file mode 100644
index 00000000..f6784b2a
--- /dev/null
+++ b/sys/osb/bitmov.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# BITMOV -- Move a sequence of bits in a bit array of arbitrary length.
+
+procedure bitmov (a, a_off, b, b_off, nbits)
+
+int	a[ARB]		# input bit array
+int	a_off		# first bit to be moved
+int	b[ARB]		# output bit array
+int	b_off		# first bit to be written
+int	nbits		# number of bits to be moved
+
+int	ip, op, ip_top, nbits_left
+int	bitupk()
+
+begin
+	ip_top = a_off + nbits - NBITS_INT
+	op = b_off
+
+	for (ip = a_off;  ip <= ip_top;  ip = ip + NBITS_INT) {
+	    call bitpak (bitupk(a,ip,NBITS_INT), b, op, NBITS_INT)
+	    op = op + NBITS_INT
+	}
+
+	nbits_left = (a_off + nbits) - ip
+	if (nbits_left > 0)
+	    call bitpak (bitupk(a,ip,nbits_left), b, op, nbits_left)
+end
diff --git a/sys/osb/bswap2.c b/sys/osb/bswap2.c
new file mode 100644
index 00000000..a2c08030
--- /dev/null
+++ b/sys/osb/bswap2.c
@@ -0,0 +1,38 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* BSWAP2 - Move bytes from array "a" to array "b", swapping successive
+ * pairs of bytes.  The two arrays may be the same but may not be offset
+ * and overlapping.
+ */
+BSWAP2 (a, aoff, b, boff, nbytes)
+XCHAR	*a;			/* input array			*/
+XINT	*aoff;			/* first byte in input array	*/
+XCHAR	*b;			/* output array			*/
+XINT	*boff;			/* first byte in output array	*/
+XINT	*nbytes;		/* number of bytes to swap	*/
+{
+	register char *ip, *op, *otop;
+	register unsigned temp;
+
+	ip = (char *)a + *aoff - 1;
+	op = (char *)b + *boff - 1;
+	otop = op + (*nbytes & ~1);
+
+	/* Swap successive pairs of bytes.
+	 */
+	while (op < otop) {
+	    temp  = *ip++;
+	    *op++ = *ip++;
+	    *op++ = temp;
+	}
+
+	/* If there is an odd byte left, move it to the output array.
+	 */
+	if (*nbytes & 1)
+	    *op = *ip;
+}
diff --git a/sys/osb/bswap2.f b/sys/osb/bswap2.f
new file mode 100644
index 00000000..700c8498
--- /dev/null
+++ b/sys/osb/bswap2.f
@@ -0,0 +1,20 @@
+c BSWAP2 - Move bytes from array "a" to array "b", swapping successive
+c pairs of bytes.
+
+	subroutine bswap2 (a, aoff, b, boff, nbytes)
+
+	character*1 a(*), b(*), temp
+	integer	aoff, boff, nbytes, i
+	integer aoff1, boff1
+
+		aoff1 = aoff + 1
+		boff1 = boff + 1
+
+ 		do 10 i = 0, nbytes-1, 2
+		    temp = a(aoff1+i)
+		    if (i .ne. nbytes) then
+			b(boff1+i) = a(aoff+i)
+		    endif
+		    b(boff+i) = temp
+ 10		continue
+	end
diff --git a/sys/osb/bswap4.c b/sys/osb/bswap4.c
new file mode 100644
index 00000000..763633a5
--- /dev/null
+++ b/sys/osb/bswap4.c
@@ -0,0 +1,46 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* BSWAP4 - Move bytes from array "a" to array "b", swapping the four bytes
+ * in each successive 4 byte group, i.e., 12345678 becomes 43218765.
+ * The input and output arrays may be the same but may not partially overlap.
+ */
+BSWAP4 (a, aoff, b, boff, nbytes)
+XCHAR	*a;			/* input array			*/
+XINT	*aoff;			/* first byte in input array	*/
+XCHAR	*b;			/* output array			*/
+XINT	*boff;			/* first byte in output array	*/
+XINT	*nbytes;		/* number of bytes to swap	*/
+{
+	register char	*ip, *op, *tp;
+	register int	n;
+	static	char temp[4];
+
+	tp = temp;
+	ip = (char *)a + *aoff - 1;
+	op = (char *)b + *boff - 1;
+
+	/* Swap successive four byte groups.
+	 */
+	for (n = *nbytes >> 2;  --n >= 0;  ) {
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	}
+
+	/* If there are any odd bytes left, move them to the output array.
+	 * Do not bother to swap as it is unclear how to swap a partial
+	 * group, and really incorrect if the data is not modulus 4.
+	 */
+	for (n = *nbytes & 03;  --n >= 0;  )
+	    *op++ = *ip++;
+}
diff --git a/sys/osb/bswap4.f b/sys/osb/bswap4.f
new file mode 100644
index 00000000..1cfa107c
--- /dev/null
+++ b/sys/osb/bswap4.f
@@ -0,0 +1,29 @@
+c BSWAP4 - Move bytes from array "a" to array "b", swapping the four bytes
+c in each successive 4 byte group, i.e., 12345678 becomes 43218765.
+
+	subroutine bswap4 (a, aoff, b, boff, nbytes)
+
+	character*1 a(*), b(*), temp
+	integer	aoff, boff, nbytes, i
+	integer aoff1, boff1, aoff2, boff2, aoff3, boff3
+
+		if (nbytes .le. 4) then
+		    return
+		endif
+
+		aoff1 = aoff + 1
+		boff1 = boff + 1
+		aoff2 = aoff + 2
+		boff2 = boff + 2
+		aoff3 = aoff + 3
+		boff3 = boff + 3
+
+ 		do 10 i = 0, nbytes-3, 4
+		    temp = a(aoff1+i)
+		    b(boff1+i) = a(aoff2+i)
+		    b(boff2+i) = temp
+		    temp = a(aoff3+i)
+		    b(boff3+i) = a(aoff+i)
+		    b(boff+i) = temp
+ 10		continue
+	end
diff --git a/sys/osb/bswap8.c b/sys/osb/bswap8.c
new file mode 100644
index 00000000..ff544b7d
--- /dev/null
+++ b/sys/osb/bswap8.c
@@ -0,0 +1,54 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* BSWAP8 - Move bytes from array "a" to array "b", swapping the eight bytes
+ * in each successive 8 byte group, i.e., 12345678 becomes 87654321.
+ * The input and output arrays may be the same but may not partially overlap.
+ */
+BSWAP8 (a, aoff, b, boff, nbytes)
+XCHAR	*a;			/* input array			*/
+XINT	*aoff;			/* first byte in input array	*/
+XCHAR	*b;			/* output array			*/
+XINT	*boff;			/* first byte in output array	*/
+XINT	*nbytes;		/* number of bytes to swap	*/
+{
+	register char	*ip, *op, *tp;
+	register int	n;
+	static	char temp[8];
+
+	tp = temp;
+	ip = (char *)a + *aoff - 1;
+	op = (char *)b + *boff - 1;
+
+	/* Swap successive eight byte groups.
+	 */
+	for (n = *nbytes >> 3;  --n >= 0;  ) {
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *tp++ = *ip++;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	    *op++ = *--tp;
+	}
+
+	/* If there are any odd bytes left, move them to the output array.
+	 * Do not bother to swap as it is unclear how to swap a partial
+	 * group, and really incorrect if the data is not modulus 8.
+	 */
+	for (n = *nbytes & 03;  --n >= 0;  )
+	    *op++ = *ip++;
+}
diff --git a/sys/osb/bytmov.c b/sys/osb/bytmov.c
new file mode 120000
index 00000000..90b667eb
--- /dev/null
+++ b/sys/osb/bytmov.c
@@ -0,0 +1 @@
+/iraf/iraf/unix/as/bytmov.c
\ No newline at end of file
diff --git a/sys/osb/bytmov.f b/sys/osb/bytmov.f
new file mode 100644
index 00000000..b866e852
--- /dev/null
+++ b/sys/osb/bytmov.f
@@ -0,0 +1,27 @@
+c BYTMOV -- Byte move from array "a" to array "b".  The move must be
+c nondestructive, allowing a byte array to be shifted left or right a
+c few bytes, hence calls to zlocva() are required to get the addresses of 
+c the arrays.
+
+	subroutine bytmov (a, aoff, b, boff, nbytes)
+
+	character*1 a(*), b(*)
+	integer	aoff, boff, nbytes
+	integer	fwaa, lwaa, fwab, i
+
+		call zlocva (a(aoff), fwaa)
+		call zlocva (a(aoff+nbytes-1), lwaa)
+		call zlocva (b(boff), fwab)
+
+		if (fwaa .eq. fwab) then
+		    return
+		else if (fwab .ge. fwaa .and. fwab .le. lwaa) then
+		    do 10 i = nbytes-1, 0, -1
+			b(boff+i) = a(aoff+i)
+ 10		    continue
+		else
+		    do 20 i = 0, nbytes-1
+			b(boff+i) = a(aoff+i)
+ 20		    continue
+		endif
+	end
diff --git a/sys/osb/chrpak.c b/sys/osb/chrpak.c
new file mode 100644
index 00000000..3a1356a8
--- /dev/null
+++ b/sys/osb/chrpak.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* CHRPAK -- Pack a counted string of XCHAR into bytes.  This routine does not
+ * know about EOS terminators.  The input and output arrays may be the same.
+ * Note that while XCHAR is signed, the signedness of the C char is unspecified,
+ * hence we pack the chars in unsigned bytes, dealing explicitly with any
+ * negative values.
+ */
+CHRPAK (a, a_off, b, b_off, nchars)
+XCHAR	*a, *b;
+XINT	*a_off, *b_off, *nchars;
+{
+	register XCHAR	*ip;
+	register unsigned char *op;
+	register int	n, ch;
+
+	ip = &a[*a_off-1];
+	op = &((unsigned char *)b)[*b_off-1];
+	n  = *nchars;
+
+	while (--n >= 0)
+	    *op++ = ((ch = *ip++) >= 0) ? ch : ch + 256;
+}
diff --git a/sys/osb/chrpak.f b/sys/osb/chrpak.f
new file mode 100644
index 00000000..e34812fc
--- /dev/null
+++ b/sys/osb/chrpak.f
@@ -0,0 +1,13 @@
+c CHRPAK -- Pack XCHAR (integer*2) into bytes.  Should work on most byte
+c addressable machines.  The input and output arrays may be the same.
+
+	subroutine chrpak (a, aoff, b, boff, nchars)
+
+	integer*2 a(*)
+	character*1 b(*)
+	integer	aoff, boff, nchars, i
+
+ 		do 10 i = 0, nchars-1
+		    b(boff+i) = char (a(aoff+i))
+ 10		continue
+	end
diff --git a/sys/osb/chrupk.c b/sys/osb/chrupk.c
new file mode 100644
index 00000000..f909c8d9
--- /dev/null
+++ b/sys/osb/chrupk.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* CHRUPK -- Unpack a byte string into XCHAR.  This routine does not
+ * know about EOS terminators.  The input and output arrays may be the same.
+ * Note that while XCHAR is signed, the signedness of the C char is unspecified,
+ * hence we pack the chars into unsigned bytes and restore the sign explicitly.
+ */
+CHRUPK (a, a_off, b, b_off, nchars)
+XCHAR	*a, *b;
+XINT	*a_off, *b_off, *nchars;
+{
+	register unsigned char *ip;
+	register XCHAR	*op;
+	register int	n, ch;
+
+	/* Set pointers to last char plus one so that we can unpack the array
+	 * in the reverse direction.
+	 */
+	n = *nchars;
+	ip = &((unsigned char *)a)[*a_off-1+n];
+	op = &b[*b_off-1+n];
+
+	/* Unpack string from right to left.
+	 */
+	while (--n >= 0)
+	    *--op = ((ch = *--ip) <= 127) ? ch : ch - 256;
+}
diff --git a/sys/osb/chrupk.f b/sys/osb/chrupk.f
new file mode 100644
index 00000000..3a1d7f44
--- /dev/null
+++ b/sys/osb/chrupk.f
@@ -0,0 +1,13 @@
+c CHRUPK -- Unpack bytes into XCHAR (integer*2).  Should work on most byte
+c addressable machines.  The input and output arrays may be the same.
+
+	subroutine chrupk (a, aoff, b, boff, nchars)
+
+	character*1 a(*)
+	integer*2 b(*)
+	integer	aoff, boff, nchars, i
+
+ 		do 10 i = 0, nchars-1
+		    b(boff+i) = ichar (a(aoff+i))
+ 10		continue
+	end
diff --git a/sys/osb/d1mach.f b/sys/osb/d1mach.f
new file mode 120000
index 00000000..12ea8148
--- /dev/null
+++ b/sys/osb/d1mach.f
@@ -0,0 +1 @@
+/iraf/iraf/unix/hlib/d1mach.f
\ No newline at end of file
diff --git a/sys/osb/f77pak.f b/sys/osb/f77pak.f
new file mode 100644
index 00000000..db7df6f0
--- /dev/null
+++ b/sys/osb/f77pak.f
@@ -0,0 +1,32 @@
+c F77PAK -- Convert an SPP string into a Fortran 77 string.
+c
+        subroutine f77pak (sppstr, f77str, maxch)
+c
+        integer*2 sppstr(*)
+        character*(*) f77str
+        integer maxch
+        integer i, ch, last, maxout, EOS
+        parameter (EOS=0)
+c
+        maxout = min (maxch, len(f77str))
+c
+c       # Unpack the EOS delimited SPP string.
+	last = maxout
+        do 10 i = 1, maxout
+            ch = sppstr(i)
+            if (ch .eq. EOS) then
+		last = i - 1
+		goto 20
+	    endif
+            f77str(i:i) = char (ch)
+ 10     continue
+ 20     continue
+c
+c       # Pad on the right with blanks.
+	if (last .gt. maxch) last = maxch
+	if (last .le. 0) then
+	    f77str = ' '
+	else
+	    f77str = f77str(1:last)
+	endif
+        end
diff --git a/sys/osb/f77upk.f b/sys/osb/f77upk.f
new file mode 100644
index 00000000..fc875008
--- /dev/null
+++ b/sys/osb/f77upk.f
@@ -0,0 +1,26 @@
+c F77UPK -- Convert a Fortran 77 string into an SPP string.  Unpack
+c each Fortran character into an SPP char and trim the blank padding
+c at the right.
+c
+        subroutine f77upk (f77str, sppstr, maxch)
+c
+        character*(*)	f77str
+        integer*2	sppstr(*)
+        integer		maxch
+        integer		lastch, nchars, i
+        integer		EOS, BLANK
+        parameter	(EOS=0, BLANK=32)
+c
+c -- Unpack string.
+ 	nchars = min (maxch, len(f77str))
+	lastch = 0
+        do 10 i = 1, nchars
+            sppstr(i) = ichar (f77str(i:i))
+	    if (sppstr(i) .gt. BLANK) lastch = i
+ 10     continue
+c
+c -- Add EOS delimiter to SPP string, trimming blank padding at right.
+	if (lastch .gt. maxch) lastch = maxch
+	sppstr(lastch+1) = EOS
+c
+        end
diff --git a/sys/osb/i1mach.f b/sys/osb/i1mach.f
new file mode 120000
index 00000000..3cfa7dae
--- /dev/null
+++ b/sys/osb/i1mach.f
@@ -0,0 +1 @@
+/iraf/iraf/unix/hlib/i1mach.f
\ No newline at end of file
diff --git a/sys/osb/i32to64.c b/sys/osb/i32to64.c
new file mode 100644
index 00000000..4b4b00d1
--- /dev/null
+++ b/sys/osb/i32to64.c
@@ -0,0 +1,42 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* I32TO64 - Convert big endian 32bit integer array into 64bit.
+ */
+int
+I32TO64 (void *a, void *b, XINT *nelems)
+{
+	XINT  i, j, k;
+	char  *ip = (char *) a, 
+	      *op = (char *) b;
+
+
+	j = *nelems * 8;
+	k = *nelems * 4;
+
+	if ( ip < op ) {
+	    for ( i = k ; 0 < i ; i-- )
+		op[i-1] = ip[i-1];
+	}
+	else if ( op < ip ) {
+	    for ( i = 0 ; i < k ; i++ )
+		op[i] = ip[i];
+	}
+
+	for ( i=0 ; i < *nelems ; i++ ) {
+	    char pad;
+	    op[--j] = op[--k];
+	    op[--j] = op[--k];
+	    op[--j] = op[--k];
+	    op[--j] = op[--k];
+	    if ( (op[k] & 0x080) != 0 ) pad = 0x0ff;
+	    else pad = 0;
+	    op[--j] = pad;
+	    op[--j] = pad;
+	    op[--j] = pad;
+	    op[--j] = pad;
+	}
+
+	return 0;
+}
diff --git a/sys/osb/i64to32.c b/sys/osb/i64to32.c
new file mode 100644
index 00000000..2b6a619c
--- /dev/null
+++ b/sys/osb/i64to32.c
@@ -0,0 +1,98 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* I64TO32 - Convert big endian 64bit integer array into 32bit.
+ */
+int
+I64TO32 (void *a, void *b, XINT *nelems)
+{
+	char *ip = (char *)a,
+	     *op = (char *)b;
+	XINT i;
+
+
+	/*
+	 *  in      |--------|
+	 *  out   |----|
+	 */
+	if ( op <= ip ) {
+	    for ( i=0 ; i < *nelems ; i++ ) {
+		ip += 4;
+		*op = *ip;
+		op++; ip++;
+		*op = *ip;
+		op++; ip++;
+		*op = *ip;
+		op++; ip++;
+		*op = *ip;
+		op++; ip++;
+	    }
+	}
+	else {
+
+	    char *ipe = (char *)a + *nelems * 8 - 1;
+	    char *ope = (char *)b + *nelems * 4 - 1;
+	    
+	    /*
+	     *  in      |--------|
+	     *  out           |----|
+	     */
+	    if ( ipe <= ope ) {
+		for ( i=0 ; i < *nelems ; i++ ) {
+		    *ope = *ipe;
+		    ope--; ipe--;
+		    *ope = *ipe;
+		    ope--; ipe--;
+		    *ope = *ipe;
+		    ope--; ipe--;
+		    *ope = *ipe;
+		    ope--; ipe--;
+		    ipe -= 4;
+		}
+	    }
+	    /*
+	     *  in      |--------|
+	     *  out       |----|
+	     */
+	    else {
+		
+		for ( i=0 ; i < *nelems ; i++ ) {
+		    /* --------> */
+		    ip += 4;
+		    if ( op < ip ) {
+			*op = *ip;
+			op++; ip++;
+			*op = *ip;
+			op++; ip++;
+			*op = *ip;
+			op++; ip++;
+			*op = *ip;
+			op++; ip++;
+		    }
+		    else {
+			op += 4;
+			ip += 4;
+		    }
+		    /* <-------- */
+		    if ( ipe < ope ) {
+			*ope = *ipe;
+			ope--; ipe--;
+			*ope = *ipe;
+			ope--; ipe--;
+			*ope = *ipe;
+			ope--; ipe--;
+			*ope = *ipe;
+			ope--; ipe--;
+		    }
+		    else {
+			ope -= 4;
+			ipe -= 4;
+		    }
+		    ipe -= 4;
+		}
+	    }
+	}
+
+	return 0;
+}
diff --git a/sys/osb/iand32.c b/sys/osb/iand32.c
new file mode 100644
index 00000000..b812cad5
--- /dev/null
+++ b/sys/osb/iand32.c
@@ -0,0 +1,12 @@
+
+#define	iand32		iand32_
+
+long
+iand32 (long *a, long *b)
+{
+    long  val = 0;
+    int   ia = (int) (*a >> 32), ib = (int) *b;
+
+    val = (ia & ib);
+    return ((long) val);
+}
diff --git a/sys/osb/ieee.gx b/sys/osb/ieee.gx
new file mode 100644
index 00000000..64659cd3
--- /dev/null
+++ b/sys/osb/ieee.gx
@@ -0,0 +1,391 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+	         ieepak[rd] (datum)			# scalar conversions
+	         ieeupk[rd] (datum)
+		ieevpak[rd] (native, ieee, nelem)	# vector conversions
+		ieevupk[rd] (ieee, native, nelem)
+	     iee[sg]nan[rd] (NaN)			# NaN handling
+	     iee[sg]map[rd] (mapin, mapout)
+		ieestat[rd] (nin, nout)
+	       ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions.  The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system.  The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEF).  If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions.  The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format.  NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+$if (datatype == r)
+define	IEEE_SWAP	IEEE_SWAP4
+define	BSWAP		bswap4
+define	NSWAP		4
+define	IOFF		1
+$else
+define	IEEE_SWAP	IEEE_SWAP8
+define	BSWAP		bswap8
+define	NSWAP		8
+define	IOFF		2	# MACHDEP (normally 1, 2 on e.g. Intel)
+$endif
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format.  The input and output arrays can be the same.
+
+procedure ieevpak$t (native, ieee, nelem)
+
+PIXEL	native[ARB]		#I input native floating format array
+PIXEL	ieee[ARB]		#O output IEEE floating format array
+int	nelem			#I number of floating point numbers
+
+int	i
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout == NO) {
+	    if (IEEE_SWAP == YES)
+		call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+	    else
+		call amov$t (native, ieee, nelem)
+	} else {
+	    do i = 1, nelem
+		if (native[i] == native_NaN) {
+		    ieee(i) = ieee_NaN
+		    nout = nout + 1
+		} else
+		    ieee[i] = native[i]
+
+	    # Byteswap if necessary.
+	    if (IEEE_SWAP == YES)
+		call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+	}
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format.  The input and output arrays can be the same.
+
+procedure ieevupk$t (ieee, native, nelem)
+
+PIXEL	ieee[ARB]		#I input IEEE floating format array
+PIXEL	native[ARB]		#O output native floating format array
+int	nelem			#I number of floating point numbers
+
+int	expon, i, val
+$if (datatype == r)
+real	fval
+int	ival[1]
+%	equivalence (fval, ival)
+$else
+double	fval
+int	ival[2]
+%	equivalence (fval, ival)
+int	iand32()
+$endif
+%	equivalence (ival, val)
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES) {
+	    call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+	    if (mapin != NO) {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = native[i]
+$if (datatype == r)
+		    expon = and (ival[IOFF], NaNmask)
+$else
+		    if (SZ_INT == SZ_INT32)
+		        expon = and (ival[IOFF], NaNmask)
+		    else
+		        expon = iand32 (val, NaNmask)
+$endif
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    }
+		}
+	    }
+	} else {
+	    if (mapin == NO)
+		call amov$t (ieee, native, nelem)
+	    else {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = ieee[i]
+$if (datatype == r)
+		    expon = and (ival[IOFF], NaNmask)
+$else
+		    if (SZ_INT == SZ_INT32)
+		        expon = and (ival[IOFF], NaNmask)
+		    else
+		        expon = iand32 (val, NaNmask)
+$endif
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    } else
+			native[i] = ieee[i]
+		}
+	    }
+	}
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepak$t (x)
+
+PIXEL	x			#U datum to be converted
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout != NO)
+	    if (x == native_NaN) {
+		x = ieee_NaN
+		nout = nout + 1
+	    }
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupk$t (x)
+
+PIXEL	x			#U datum to be converted
+
+int	expon, val
+$if (datatype == r)
+real	fval
+int	ival[1]
+%	equivalence (fval, ival)
+$else
+double	fval
+int	ival[2]
+%	equivalence (fval, ival)
+int	iand32()
+$endif
+%	equivalence (val, ival)
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+
+	# Check for IEEE exceptional values and map NaN to the native NaN
+	# value, and denormalized numbers (zero exponent) to zero.
+
+	if (mapin != NO) {
+	    fval = x
+$if (datatype == r)
+	    expon = and (ival[IOFF], NaNmask)
+$else
+	    if (SZ_INT == SZ_INT32)
+	        expon = and (ival[IOFF], NaNmask)
+	    else
+	        expon = iand32 (val, NaNmask)
+$endif
+	    if (expon == 0)
+		x = 0
+	    else if (expon == NaNmask) {
+	        x = native_NaN
+		nin = nin + 1
+	    }
+	}
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native.  This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnan$t (x)
+
+PIXEL	x			#I native value which will replace NaN
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	native_NaN = x
+	nin = 0
+	nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnan$t (x)
+
+PIXEL	x			#O native value which will replace NaN
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestat$t (o_nin, o_nout)
+
+int	o_nin				#O number of NaN seen on input
+int	o_nout				#O number of NaN values output
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	o_nin = nin
+	o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstat$t ()
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	nin = 0
+	nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP.  Retained for backwards compatibility.
+
+procedure ieemap$t (inval, outval)
+
+int	inval				#I enable mapping on input
+int	outval				#I enable mapping on output
+
+begin
+	call ieesmap$t (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmap$t (inval, outval)
+
+int	inval				#O get input mapping enable flag
+int	outval				#O get output mapping enable flag
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	inval = mapin
+	outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+#  3           2            1           0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+#    7    f    8    0    0    0    0    0
+
+procedure ieesmap$t (inval, outval)
+
+int	inval				#I enable NaN mapping for input?
+int	outval				#I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#%	real r_quiet_nan
+#$else
+#%	double precision d_quiet_nan
+#$endif
+
+PIXEL	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	mapin = inval
+	mapout = outval
+
+	# MACHDEP.
+#	if (mapout == YES)
+#	$if (datatype == r)
+#%	    ieeenn = r_quiet_NaN()
+#	$else
+#%	    ieeenn = d_quiet_NaN()
+#	$endif
+
+	if (mapin == YES)
+	$if (datatype == r)
+	    NaNmask = 7F800000X
+	$else
+	    NaNmask = 7FF00000X
+	$endif
+end
diff --git a/sys/osb/ieeed.x b/sys/osb/ieeed.x
new file mode 100644
index 00000000..f29c1aa3
--- /dev/null
+++ b/sys/osb/ieeed.x
@@ -0,0 +1,356 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+	         ieepak[rd] (datum)			# scalar conversions
+	         ieeupk[rd] (datum)
+		ieevpak[rd] (native, ieee, nelem)	# vector conversions
+		ieevupk[rd] (ieee, native, nelem)
+	     iee[sg]nan[rd] (NaN)			# NaN handling
+	     iee[sg]map[rd] (mapin, mapout)
+		ieestat[rd] (nin, nout)
+	       ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions.  The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system.  The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEFD).  If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions.  The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format.  NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+define	IEEE_SWAP	IEEE_SWAP8
+define	BSWAP		bswap8
+define	NSWAP		8
+define	IOFF		2	# MACHDEP (normally 1, 2 on e.g. Intel)
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format.  The input and output arrays can be the same.
+
+procedure ieevpakd (native, ieee, nelem)
+
+double	native[ARB]		#I input native floating format array
+double	ieee[ARB]		#O output IEEE floating format array
+int	nelem			#I number of floating point numbers
+
+int	i
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout == NO) {
+	    if (IEEE_SWAP == YES)
+		call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+	    else
+		call amovd (native, ieee, nelem)
+	} else {
+	    do i = 1, nelem
+		if (native[i] == native_NaN) {
+		    ieee(i) = ieee_NaN
+		    nout = nout + 1
+		} else
+		    ieee[i] = native[i]
+
+	    # Byteswap if necessary.
+	    if (IEEE_SWAP == YES)
+		call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+	}
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format.  The input and output arrays can be the same.
+
+procedure ieevupkd (ieee, native, nelem)
+
+double	ieee[ARB]		#I input IEEE floating format array
+double	native[ARB]		#O output native floating format array
+int	nelem			#I number of floating point numbers
+
+int	expon, i, val
+double	fval
+int	ival[2]
+%	equivalence (fval, ival)
+int	iand32()
+%	equivalence (ival, val)
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES) {
+	    call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+	    if (mapin != NO) {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = native[i]
+		    if (SZ_INT == SZ_INT32)
+		        expon = and (ival[IOFF], NaNmask)
+		    else
+		        expon = iand32 (val, NaNmask)
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    }
+		}
+	    }
+	} else {
+	    if (mapin == NO)
+		call amovd (ieee, native, nelem)
+	    else {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = ieee[i]
+		    if (SZ_INT == SZ_INT32)
+		        expon = and (ival[IOFF], NaNmask)
+		    else
+		        expon = iand32 (val, NaNmask)
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    } else
+			native[i] = ieee[i]
+		}
+	    }
+	}
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepakd (x)
+
+double	x			#U datum to be converted
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout != NO)
+	    if (x == native_NaN) {
+		x = ieee_NaN
+		nout = nout + 1
+	    }
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupkd (x)
+
+double	x			#U datum to be converted
+
+int	expon, val
+double	fval
+int	ival[2]
+%	equivalence (fval, ival)
+int	iand32()
+%	equivalence (val, ival)
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+
+	# Check for IEEE exceptional values and map NaN to the native NaN
+	# value, and denormalized numbers (zero exponent) to zero.
+
+	if (mapin != NO) {
+	    fval = x
+	    if (SZ_INT == SZ_INT32)
+	        expon = and (ival[IOFF], NaNmask)
+	    else
+	        expon = iand32 (val, NaNmask)
+	    if (expon == 0)
+		x = 0
+	    else if (expon == NaNmask) {
+	        x = native_NaN
+		nin = nin + 1
+	    }
+	}
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native.  This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnand (x)
+
+double	x			#I native value which will replace NaN
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	native_NaN = x
+	nin = 0
+	nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnand (x)
+
+double	x			#O native value which will replace NaN
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestatd (o_nin, o_nout)
+
+int	o_nin				#O number of NaN seen on input
+int	o_nout				#O number of NaN values output
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	o_nin = nin
+	o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstatd ()
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	nin = 0
+	nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP.  Retained for backwards compatibility.
+
+procedure ieemapd (inval, outval)
+
+int	inval				#I enable mapping on input
+int	outval				#I enable mapping on output
+
+begin
+	call ieesmapd (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmapd (inval, outval)
+
+int	inval				#O get input mapping enable flag
+int	outval				#O get output mapping enable flag
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	inval = mapin
+	outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+#  3           2            1           0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+#    7    f    8    0    0    0    0    0
+
+procedure ieesmapd (inval, outval)
+
+int	inval				#I enable NaN mapping for input?
+int	outval				#I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#%	real r_quiet_nan
+#$else
+#%	double precision d_quiet_nan
+#$endif
+
+double	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	mapin = inval
+	mapout = outval
+
+	# MACHDEP.
+#	if (mapout == YES)
+#	$if (datatype == r)
+#%	    ieeenn = r_quiet_NaN()
+#	$else
+#%	    ieeenn = d_quiet_NaN()
+#	$endif
+
+	if (mapin == YES)
+	    NaNmask = 7FF00000X
+end
diff --git a/sys/osb/ieeer.x b/sys/osb/ieeer.x
new file mode 100644
index 00000000..59ce8566
--- /dev/null
+++ b/sys/osb/ieeer.x
@@ -0,0 +1,345 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+	         ieepak[rd] (datum)			# scalar conversions
+	         ieeupk[rd] (datum)
+		ieevpak[rd] (native, ieee, nelem)	# vector conversions
+		ieevupk[rd] (ieee, native, nelem)
+	     iee[sg]nan[rd] (NaN)			# NaN handling
+	     iee[sg]map[rd] (mapin, mapout)
+		ieestat[rd] (nin, nout)
+	       ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions.  The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system.  The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEFR).  If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions.  The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format.  NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+define	IEEE_SWAP	IEEE_SWAP4
+define	BSWAP		bswap4
+define	NSWAP		4
+define	IOFF		1
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format.  The input and output arrays can be the same.
+
+procedure ieevpakr (native, ieee, nelem)
+
+real	native[ARB]		#I input native floating format array
+real	ieee[ARB]		#O output IEEE floating format array
+int	nelem			#I number of floating point numbers
+
+int	i
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout == NO) {
+	    if (IEEE_SWAP == YES)
+		call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+	    else
+		call amovr (native, ieee, nelem)
+	} else {
+	    do i = 1, nelem
+		if (native[i] == native_NaN) {
+		    ieee(i) = ieee_NaN
+		    nout = nout + 1
+		} else
+		    ieee[i] = native[i]
+
+	    # Byteswap if necessary.
+	    if (IEEE_SWAP == YES)
+		call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+	}
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format.  The input and output arrays can be the same.
+
+procedure ieevupkr (ieee, native, nelem)
+
+real	ieee[ARB]		#I input IEEE floating format array
+real	native[ARB]		#O output native floating format array
+int	nelem			#I number of floating point numbers
+
+int	expon, i, val
+real	fval
+int	ival[1]
+%	equivalence (fval, ival)
+%	equivalence (ival, val)
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES) {
+	    call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+	    if (mapin != NO) {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = native[i]
+		    expon = and (ival[IOFF], NaNmask)
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    }
+		}
+	    }
+	} else {
+	    if (mapin == NO)
+		call amovr (ieee, native, nelem)
+	    else {
+		# Check for IEEE exceptional values and map NaN to the native
+		# NaN value, and denormalized numbers (zero exponent) to zero.
+
+		do i = 1, nelem {
+		    fval = ieee[i]
+		    expon = and (ival[IOFF], NaNmask)
+		    if (expon == 0) {
+			native[i] = 0
+		    } else if (expon == NaNmask) {
+			native[i] = native_NaN
+			nin = nin + 1
+		    } else
+			native[i] = ieee[i]
+		}
+	    }
+	}
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepakr (x)
+
+real	x			#U datum to be converted
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (mapout != NO)
+	    if (x == native_NaN) {
+		x = ieee_NaN
+		nout = nout + 1
+	    }
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupkr (x)
+
+real	x			#U datum to be converted
+
+int	expon, val
+real	fval
+int	ival[1]
+%	equivalence (fval, ival)
+%	equivalence (val, ival)
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	if (IEEE_SWAP == YES)
+	    call BSWAP (x, 1, x, 1, NSWAP)
+
+	# Check for IEEE exceptional values and map NaN to the native NaN
+	# value, and denormalized numbers (zero exponent) to zero.
+
+	if (mapin != NO) {
+	    fval = x
+	    expon = and (ival[IOFF], NaNmask)
+	    if (expon == 0)
+		x = 0
+	    else if (expon == NaNmask) {
+	        x = native_NaN
+		nin = nin + 1
+	    }
+	}
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native.  This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnanr (x)
+
+real	x			#I native value which will replace NaN
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	native_NaN = x
+	nin = 0
+	nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnanr (x)
+
+real	x			#O native value which will replace NaN
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestatr (o_nin, o_nout)
+
+int	o_nin				#O number of NaN seen on input
+int	o_nout				#O number of NaN values output
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	o_nin = nin
+	o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstatr ()
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	nin = 0
+	nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP.  Retained for backwards compatibility.
+
+procedure ieemapr (inval, outval)
+
+int	inval				#I enable mapping on input
+int	outval				#I enable mapping on output
+
+begin
+	call ieesmapr (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmapr (inval, outval)
+
+int	inval				#O get input mapping enable flag
+int	outval				#O get output mapping enable flag
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	inval = mapin
+	outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+#  3           2            1           0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+#    7    f    8    0    0    0    0    0
+
+procedure ieesmapr (inval, outval)
+
+int	inval				#I enable NaN mapping for input?
+int	outval				#I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#%	real r_quiet_nan
+#$else
+#%	double precision d_quiet_nan
+#$endif
+
+real	native_NaN, ieee_NaN
+int	mapin, mapout, nin, nout, NaNmask
+common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+	mapin = inval
+	mapout = outval
+
+	# MACHDEP.
+#	if (mapout == YES)
+#	$if (datatype == r)
+#%	    ieeenn = r_quiet_NaN()
+#	$else
+#%	    ieeenn = d_quiet_NaN()
+#	$endif
+
+	if (mapin == YES)
+	    NaNmask = 7F800000X
+end
diff --git a/sys/osb/imul32.c b/sys/osb/imul32.c
new file mode 100644
index 00000000..237bd5fa
--- /dev/null
+++ b/sys/osb/imul32.c
@@ -0,0 +1,24 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+
+/* IMUL32 - Multiply two integer values and return the result.  This is 
+ * needed to allow e.g. the normal overflow condition to occur for algorithms
+ * such as random number generators.
+ */
+int
+IMUL32 (long *a, long *b)
+{
+    int val = 0;
+    int  ia = (int) *a;
+    int  ib = (int) *b;
+
+
+    /*  MACHDEP - Depends on integer overflow behavior for a specific
+     *  platform.
+     */
+    val = ia * ib;
+
+    return ((int) val);
+}
diff --git a/sys/osb/ipak16.c b/sys/osb/ipak16.c
new file mode 100644
index 00000000..94670857
--- /dev/null
+++ b/sys/osb/ipak16.c
@@ -0,0 +1,20 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* IPAK16 - Pack an array of native ints into and array of 16-bit short.
+ */
+void
+IPAK16 (void *a, void *b, XINT *nelems)
+{
+	/* MACHDEP - Works only for little-endian systems (e.g. x86)
+	*/
+	int    i  = 0;
+	int   *ip = (int *) a;
+	short *op = (short  *) b;
+
+	for (i=0; i < *nelems; i++) {
+	    *op = (int) *ip;
+	    op++, ip++;
+	}
+}
diff --git a/sys/osb/ipak32.c b/sys/osb/ipak32.c
new file mode 100644
index 00000000..a4f5061b
--- /dev/null
+++ b/sys/osb/ipak32.c
@@ -0,0 +1,23 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* IPAK32 - Pack 64-bit int into and array of 32-bit int.
+ */
+void
+IPAK32 (void *a, void *b, XINT *nelems)
+{
+	/* MACHDEP - Works only for little-endian systems (e.g. x86)
+	*/
+	XINT *ip = (XINT *) a;
+	int  *op = (int  *) calloc (*nelems, sizeof (int));
+	int  *tmp, i;
+
+	tmp = op;
+	for (i=0; i < *nelems; i++, ip++) {
+	    *tmp++ = (int) (*ip);
+	}
+	memmove (b, op, *nelems * sizeof (int));
+
+	free (op);
+}
diff --git a/sys/osb/iscl32.c b/sys/osb/iscl32.c
new file mode 100644
index 00000000..75e51082
--- /dev/null
+++ b/sys/osb/iscl32.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <stdlib.h>
+#include <iraf.h>
+
+
+/* ISCL32 - Scale a pixel array stored as SPP chars to the desired type.
+ */
+ISCL32 (a, b, npix, bscale, bzero)
+XCHAR	*a;			/* input array			*/
+XCHAR	*b;			/* output array			*/
+XINT	*npix;			/* number of bytes to swap	*/
+XDOUBLE *bscale, *bzero;	/* scaling factors		*/
+{
+    int   i, pix;
+    int   *ip = (int *) a;
+    float *rp = (float *) calloc (*npix, sizeof (float));
+    float *tmp;
+
+    tmp = rp;
+    for (i=0; i < *npix; i++) {
+	pix = *ip;
+	*tmp = (float) (pix * (*bscale) + (*bzero));
+	tmp++, ip++;
+    }
+
+    memmove (b, rp, (*npix * sizeof (float)));
+}
diff --git a/sys/osb/iscl64.c b/sys/osb/iscl64.c
new file mode 100644
index 00000000..6a8b624c
--- /dev/null
+++ b/sys/osb/iscl64.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <stdlib.h>
+#include <iraf.h>
+
+
+/* ISCL64 - Scale a pixel array stored as SPP chars to the desired type.
+ */
+ISCL64 (a, b, npix, bscale, bzero)
+XCHAR	*a;			/* input array			*/
+XCHAR	*b;			/* output array			*/
+XINT	*npix;			/* number of bytes to swap	*/
+XDOUBLE *bscale, *bzero;	/* scaling factors		*/
+{
+    int   i, pix;
+    int   *ip = (int *) a;
+    double *dp = (double *) calloc (*npix, sizeof (double));
+    double *tmp;
+
+    tmp = dp;
+    for (i=0; i < *npix; i++) {
+	pix = *ip;
+	*tmp = (double) (pix * (*bscale) + (*bzero));
+	tmp++, ip++;
+    }
+
+    memmove (b, dp, (*npix * sizeof (double)));
+}
diff --git a/sys/osb/iupk16.c b/sys/osb/iupk16.c
new file mode 100644
index 00000000..10b5c064
--- /dev/null
+++ b/sys/osb/iupk16.c
@@ -0,0 +1,21 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+
+/* IUPK16 - Unpack 16-bit int into and array of native integers.
+ */
+void
+IUPK16 (void *a, void *b, XINT *nelems)
+{
+	int    i;
+	int   *op = (int *) calloc (*nelems, sizeof (int)), *tmp;
+	short *ip = (short *) a;
+
+	tmp = op;
+	for (i=0; i < *nelems; i++)
+	    *tmp++ = *ip++;
+
+	memmove (b, op, *nelems * sizeof (int));
+	free (op);
+}
diff --git a/sys/osb/iupk32.c b/sys/osb/iupk32.c
new file mode 100644
index 00000000..a280b805
--- /dev/null
+++ b/sys/osb/iupk32.c
@@ -0,0 +1,23 @@
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+
+/* IUPK32 - Unpack 32-bit int into and array of 64-bit int.
+ */
+void
+IUPK32 (void *a, void *b, XINT *nelems)
+{
+	XINT i, *tmp;
+	XINT *op = (XINT *) calloc (*nelems, sizeof (XINT));
+	int  *ip = (int *) a;
+
+
+	tmp = op;
+	for (i=0; i < *nelems; i++) {
+	    *tmp++ = *ip++;
+	}
+	memmove (b, op, *nelems * sizeof (XINT));
+
+	free (op);
+}
diff --git a/sys/osb/miilen.x b/sys/osb/miilen.x
new file mode 100644
index 00000000..1eb16d1a
--- /dev/null
+++ b/sys/osb/miilen.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIILEN -- Determine the number of SPP integers to store nelems of type
+# mii_type.  The mii_type are defined in mii.h.
+#
+# THIS PROCEDURE HAS BEEN OBSOLETED BY MIIPAKLEN.
+
+int procedure miilen (nelems, mii_datatype)
+
+int	nelems			#I number of MII data elements
+int	mii_datatype		#I datatype of MII data
+
+begin
+	return (((nelems * abs(mii_datatype) / NBITS_BYTE + SZB_CHAR - 1) /
+	    SZB_CHAR + SZ_INT32 - 1) / SZ_INT32)
+end
diff --git a/sys/osb/miinelem.x b/sys/osb/miinelem.x
new file mode 100644
index 00000000..2ae53882
--- /dev/null
+++ b/sys/osb/miinelem.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIINELEM -- Determine the number of MII elements of the given datatype
+# which can be stored in an SPP char array of the indicated length.
+# The mii_type codes are defined in mii.h; we assume here that the codes
+# used are the number of bits in each MII type.
+
+int procedure miinelem (nchars, mii_type)
+
+int	nchars			#I size in chars of packed array
+int	mii_type		#I MII type of packed data
+
+int	nbits
+
+begin
+	nbits = abs (mii_type)
+	return ((nchars * SZB_CHAR * NBITS_BYTE) / nbits)
+end
diff --git a/sys/osb/miipak.x b/sys/osb/miipak.x
new file mode 100644
index 00000000..b86bc054
--- /dev/null
+++ b/sys/osb/miipak.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mii.h>
+
+.help mii
+.nf ___________________________________________________________________________
+MII -- Machine independent integer format conversion routines.  The MII integer
+format provides for three machine independent integer datatypes:
+
+    MII_BYTE	8 bit unsigned byte
+    MII_SHORT	16 bit twos complement signed integer
+    MII_LONG	32 bit twos complement signed integer
+
+plus, more recently, two IEEE floating point formats:
+
+    MII_REAL	32 bit IEEE floating point
+    MII_DOUBLE	64 bit IEEE floating point
+
+The MII datatypes are the same as are used in the FITS transportable image
+format.  In the case of the short and long integers, the most significant
+bytes of an integer are given first.
+
+The routines in this package are provided for converting to and from the
+MII format and the SPP format.  The latter format, of course, is potentially
+quite machine dependent.  The implementation given here assumes that the
+SPP datatypes include 16 bit and 32 bit twos complement integers; the ordering
+of the bytes within these integer formats is described by the machine
+constants BYTE_SWAP2 and BYTE_SWAP4.  Byte swapping for the IEEE floating
+formats is defined by the machine constants IEEE_SWAP4 and IEEE_SWAP8.
+.endhelp ______________________________________________________________________
+
+
+# MIIPAK -- Pack a SPP array of type spp_type into a MII array of type
+# mii_type.  The mii_types are defined in mii.h.
+
+procedure miipak (spp, mii, nelems, spp_datatype, mii_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+int	mii_datatype		#I MII datatype code
+
+begin
+	switch (mii_datatype) {
+	case MII_BYTE:
+	    call miipak8  (spp, mii, nelems, spp_datatype)
+	case MII_SHORT:
+	    call miipak16 (spp, mii, nelems, spp_datatype)
+	case MII_LONG:
+	    call miipak32 (spp, mii, nelems, spp_datatype)
+	case MII_REAL:
+	    call miipakr (spp, mii, nelems, spp_datatype)
+	case MII_DOUBLE:
+	    call miipakd (spp, mii, nelems, spp_datatype)
+	}
+end
diff --git a/sys/osb/miipak16.x b/sys/osb/miipak16.x
new file mode 100644
index 00000000..d972c0fa
--- /dev/null
+++ b/sys/osb/miipak16.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIPAK16 -- Pack an SPP array of the indicated datatype into an 16 bit
+# signed MII array.
+
+procedure miipak16 (spp, mii, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbs (spp, mii, nelems)
+	case TY_USHORT:
+	    call achtus (spp, mii, nelems)
+	case TY_CHAR:
+	    call achtcs (spp, mii, nelems)
+	case TY_SHORT:
+	    call achtss (spp, mii, nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtis (spp, mii, nelems)
+	case TY_LONG:
+	    call achtls (spp, mii, nelems)
+	case TY_REAL:
+	    call achtrs (spp, mii, nelems)
+	case TY_DOUBLE:
+	    call achtds (spp, mii, nelems)
+	case TY_COMPLEX:
+	    call achtxs (spp, mii, nelems)
+	}
+
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (mii, 1, mii, 1, nelems * (16 / NBITS_BYTE))
+end
diff --git a/sys/osb/miipak32.x b/sys/osb/miipak32.x
new file mode 100644
index 00000000..1586f4ea
--- /dev/null
+++ b/sys/osb/miipak32.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIPAK32 -- Pack an SPP array of the indicated datatype into an 32 bit
+# signed MII array.
+
+procedure miipak32 (spp, mii, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+int	mii_bytes
+int	spp_bytes
+int	sizeof()
+pointer	tmpp
+
+begin
+	call malloc (tmpp, nelems, TY_LONG)
+
+	mii_bytes = 32 / NBITS_BYTE
+	spp_bytes = sizeof(spp_datatype) * SZB_CHAR
+
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbl (spp, Meml[tmpp], nelems)
+	case TY_USHORT:
+	    call achtul (spp, Meml[tmpp], nelems)
+	case TY_CHAR:
+	    call achtcl (spp, Meml[tmpp], nelems)
+	case TY_SHORT:
+	    call achtsl (spp, Meml[tmpp], nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtil (spp, Meml[tmpp], nelems)
+	case TY_LONG:
+	    call achtll (spp, Meml[tmpp], nelems)
+	case TY_REAL:
+	    call achtrl (spp, Meml[tmpp], nelems)
+	case TY_DOUBLE:
+	    call achtdl (spp, Meml[tmpp], nelems)
+	case TY_COMPLEX:
+	    call achtxl (spp, Meml[tmpp], nelems)
+	}
+
+        if ( mii_bytes == spp_bytes ) {
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (Meml[tmpp], 1, mii, 1, nelems * (mii_bytes))
+	    else if (BYTE_SWAP2 == YES)
+		call bswap2 (Meml[tmpp], 1, mii, 1, nelems * (mii_bytes))
+	}
+	else if ( 2 * mii_bytes == spp_bytes ) {
+	    if (BYTE_SWAP8 == YES)
+		call bswap8 (Meml[tmpp], 1, Meml[tmpp], 1, nelems * (spp_bytes))
+	    else if (BYTE_SWAP4 == YES)
+		call bswap4 (Meml[tmpp], 1, Meml[tmpp], 1, nelems * (spp_bytes))
+	    else if (BYTE_SWAP2 == YES)
+		call bswap2 (Meml[tmpp], 1, Meml[tmpp], 1, nelems * (spp_bytes))
+	    call i64to32 ( Meml[tmpp], mii, nelems )
+	}
+	else {
+	    call eprintf("[ERROR] miipak32.x: unexpected integer size\n")
+	}
+
+        call mfree (tmpp, TY_LONG)
+end
diff --git a/sys/osb/miipak8.x b/sys/osb/miipak8.x
new file mode 100644
index 00000000..ea4e16ea
--- /dev/null
+++ b/sys/osb/miipak8.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MIIPAK8 -- Pack an SPP array of the indicated datatype into an 8 bit
+# unsigned MII array.
+
+procedure miipak8 (spp, mii, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbb (spp, mii, nelems)
+	case TY_USHORT:
+	    call achtub (spp, mii, nelems)
+	case TY_CHAR:
+	    call achtcb (spp, mii, nelems)
+	case TY_SHORT:
+	    call achtsb (spp, mii, nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtib (spp, mii, nelems)
+	case TY_LONG:
+	    call achtlb (spp, mii, nelems)
+	case TY_REAL:
+	    call achtrb (spp, mii, nelems)
+	case TY_DOUBLE:
+	    call achtdb (spp, mii, nelems)
+	case TY_COMPLEX:
+	    call achtxb (spp, mii, nelems)
+	}
+end
diff --git a/sys/osb/miipakd.x b/sys/osb/miipakd.x
new file mode 100644
index 00000000..b0766221
--- /dev/null
+++ b/sys/osb/miipakd.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIPAKD -- Pack an SPP array of the indicated datatype into an 64 bit
+# IEEE floating format.
+
+procedure miipakd (spp, mii, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+double	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	if (spp_datatype == TY_DOUBLE)
+	    call ieevpakd (spp, mii, nelems)
+	else {
+	    switch (spp_datatype) {
+	    case TY_UBYTE:
+		call achtbd (spp, mii, nelems)
+	    case TY_USHORT:
+		call achtud (spp, mii, nelems)
+	    case TY_CHAR:
+		call achtcd (spp, mii, nelems)
+	    case TY_SHORT:
+		call achtsd (spp, mii, nelems)
+	    case TY_INT, TY_POINTER, TY_STRUCT:
+		call achtid (spp, mii, nelems)
+	    case TY_LONG:
+		call achtld (spp, mii, nelems)
+	    case TY_REAL:
+		call achtrd (spp, mii, nelems)
+	    case TY_COMPLEX:
+		call achtxd (spp, mii, nelems)
+	    default:
+		call amovd (spp, mii, nelems)
+	    }
+
+	    call ieevpakd (mii, mii, nelems)
+	}
+end
diff --git a/sys/osb/miipakr.x b/sys/osb/miipakr.x
new file mode 100644
index 00000000..e6d0a5be
--- /dev/null
+++ b/sys/osb/miipakr.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIPAKR -- Pack an SPP array of the indicated datatype into an 32 bit
+# IEEE floating format.
+
+procedure miipakr (spp, mii, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+real	mii[ARB]		#O output MII format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	if (spp_datatype == TY_REAL)
+	    call ieevpakr (spp, mii, nelems)
+	else {
+	    switch (spp_datatype) {
+	    case TY_UBYTE:
+		call achtbr (spp, mii, nelems)
+	    case TY_USHORT:
+		call achtur (spp, mii, nelems)
+	    case TY_CHAR:
+		call achtcr (spp, mii, nelems)
+	    case TY_SHORT:
+		call achtsr (spp, mii, nelems)
+	    case TY_INT, TY_POINTER, TY_STRUCT:
+		call achtir (spp, mii, nelems)
+	    case TY_LONG:
+		call achtlr (spp, mii, nelems)
+	    case TY_DOUBLE:
+		call achtdr (spp, mii, nelems)
+	    case TY_COMPLEX:
+		call achtxr (spp, mii, nelems)
+	    default:
+		call amovr (spp, mii, nelems)
+	    }
+
+	    call ieevpakr (mii, mii, nelems)
+	}
+end
diff --git a/sys/osb/miipksize.x b/sys/osb/miipksize.x
new file mode 100644
index 00000000..16791e95
--- /dev/null
+++ b/sys/osb/miipksize.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIPKSIZE -- Determine the size in SPP chars of the array required to store
+# nelems of type mii_type in MII packed form.  The mii_type codes are defined
+# in mii.h; we assume here that the integer codes are the sizes of the MII
+# types in bits.
+
+int procedure miipksize (nelems, mii_type)
+
+int	nelems			#I number of MII elements of type mii_type
+int	mii_type		#I <mii.h> type code (=8,16,32,-32,-64)
+
+begin
+	return ((nelems * abs(mii_type) / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR)
+end
diff --git a/sys/osb/miiupk.x b/sys/osb/miiupk.x
new file mode 100644
index 00000000..bb536987
--- /dev/null
+++ b/sys/osb/miiupk.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mii.h>
+
+# MIIUPK -- Unpack a MII array of type mii_type into a SPP array of type
+# spp_type.  The mii_types are defined in mii.h.
+
+procedure miiupk (mii, spp, nelems, mii_datatype, spp_datatype)
+
+int	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	mii_datatype		#I MII datatype code
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (mii_datatype) {
+	case MII_BYTE:
+	    call miiupk8  (mii, spp, nelems, spp_datatype)
+	case MII_SHORT:
+	    call miiupk16 (mii, spp, nelems, spp_datatype)
+	case MII_LONG:
+	    call miiupk32 (mii, spp, nelems, spp_datatype)
+	case MII_REAL:
+	    call miiupkr (mii, spp, nelems, spp_datatype)
+	case MII_DOUBLE:
+	    call miiupkd (mii, spp, nelems, spp_datatype)
+	}
+end
diff --git a/sys/osb/miiupk16.x b/sys/osb/miiupk16.x
new file mode 100644
index 00000000..2e24b3dd
--- /dev/null
+++ b/sys/osb/miiupk16.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIUPK16 -- Unpack a 16 bit signed MII array into an SPP array of the
+# indicated datatype.
+
+procedure miiupk16 (mii, spp, nelems, spp_datatype)
+
+int	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	if (BYTE_SWAP2 == YES) {
+	    call bswap2 (mii, 1, spp, 1, nelems * (16 / NBITS_BYTE))    
+	    call achts (spp, spp, nelems, spp_datatype)
+	} else
+	    call achts (mii, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/miiupk32.x b/sys/osb/miiupk32.x
new file mode 100644
index 00000000..183805f7
--- /dev/null
+++ b/sys/osb/miiupk32.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIUPK32 -- Unpack a 32 bit signed MII array into an SPP array of the
+# indicated datatype.
+
+procedure miiupk32 (mii, spp, nelems, spp_datatype)
+
+int	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+int	mii_bytes
+int	spp_bytes
+int	sizeof()
+
+begin
+	mii_bytes = 32 / NBITS_BYTE
+	spp_bytes = sizeof(spp_datatype) * SZB_CHAR
+
+        if ( mii_bytes == spp_bytes ) {
+	    if (BYTE_SWAP4 == YES) {
+		call bswap4 (mii, 1, spp, 1, nelems * (mii_bytes))
+		call achtl (spp, spp, nelems, spp_datatype)
+	    } else if (BYTE_SWAP2 == YES) {
+		call bswap2 (mii, 1, spp, 1, nelems * (mii_bytes))
+		call achtl (spp, spp, nelems, spp_datatype)
+	    } else
+		call achtl (mii, spp, nelems, spp_datatype)
+
+	} else if ( 2 * mii_bytes == spp_bytes ) {
+	    call i32to64 (mii, spp, nelems) 		# for 64bit integer
+	    if (BYTE_SWAP8 == YES) {
+		call bswap8 (spp, 1, spp, 1, nelems * (spp_bytes))
+		call achtl (spp, spp, nelems, spp_datatype)
+	    } else if (BYTE_SWAP4 == YES) {
+		call bswap4 (spp, 1, spp, 1, nelems * (spp_bytes))
+		call achtl (spp, spp, nelems, spp_datatype)
+	    } else if (BYTE_SWAP2 == YES) {
+		call bswap2 (spp, 1, spp, 1, nelems * (spp_bytes))
+		call achtl (spp, spp, nelems, spp_datatype)
+	    } else
+		call achtl (spp, spp, nelems, spp_datatype)
+
+	} else {
+	    call eprintf("[ERROR] miiupk32.x: unexpected integer size\n")
+	}
+end
diff --git a/sys/osb/miiupk8.x b/sys/osb/miiupk8.x
new file mode 100644
index 00000000..34a3a378
--- /dev/null
+++ b/sys/osb/miiupk8.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MIIUPK8 -- Unpack an 8 bit unsigned MII array into an SPP array of the
+# indicated datatype.
+
+procedure miiupk8 (mii, spp, nelems, spp_datatype)
+
+int	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call achtb (mii, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/miiupkd.x b/sys/osb/miiupkd.x
new file mode 100644
index 00000000..b509ef3a
--- /dev/null
+++ b/sys/osb/miiupkd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIUPKD -- Unpack a 64 bit IEEE floating array into an SPP array of the
+# indicated datatype.
+
+procedure miiupkd (mii, spp, nelems, spp_datatype)
+
+double	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call ieevupkd (mii, spp, nelems)
+	if (spp_datatype != TY_DOUBLE)
+	    call achtd (spp, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/miiupkr.x b/sys/osb/miiupkr.x
new file mode 100644
index 00000000..2ff27ff8
--- /dev/null
+++ b/sys/osb/miiupkr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MIIUPKR -- Unpack a 32 bit IEEE floating array into an SPP array of the
+# indicated datatype.
+
+procedure miiupkr (mii, spp, nelems, spp_datatype)
+
+real	mii[ARB]		#I input MII format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call ieevupkr (mii, spp, nelems)
+	if (spp_datatype != TY_REAL)
+	    call achtr (spp, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/mkpkg b/sys/osb/mkpkg
new file mode 100644
index 00000000..267b5ba6
--- /dev/null
+++ b/sys/osb/mkpkg
@@ -0,0 +1,167 @@
+# Make the OSB (bit and byte primitives) portion of the VOPS library.
+
+$checkout libvops.a lib$
+$update   libvops.a
+$checkin  libvops.a lib$
+$exit
+
+generic:
+	# Convert the generic files into typed files.
+	$set GFLAGS = "-k -t UBcsilrdx"
+	$ifolder (achtiu.c, achtzu.gc)
+	    $generic $(GFLAGS) achtzu.gc -o acht\$$tu.c		$endif
+	$ifolder (achtib.c, achtzb.gc)
+	    $generic $(GFLAGS) achtzb.gc -o acht\$$tb.c		$endif
+	$ifolder (achtui.c, achtu.gc)
+	    $generic $(GFLAGS) achtu.gc				$endif
+	$ifolder (achtbi.c, achtb.gc)
+	    $generic $(GFLAGS) achtb.gc				$endif
+	$ifolder (ieeer.x, ieee.gx)
+	    $generic -k -t rd ieee.gx				$endif
+	;
+
+libvops.a:
+	# Generic preprocessing is normally done only on the development system,
+	# and need not be available on all systems.
+
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	# The following contain machine dependent constants.
+	hlib$i1mach.f
+	hlib$d1mach.f
+	hlib$r1mach.f
+
+	# The following should normally be optimized in assembler (see the
+	# special file list in "hlib$mkpkg.sf").
+
+	$ifeq (USE_CCOMPILER, yes)
+	    bytmov.c
+	$else
+	    bytmov.f
+	$end
+
+	bitfields.c
+	aclrb.c			# see also vops/ak/aclr*.x
+
+	# The operation of the following depends upon integer overflow, which
+	# may result in an exception on some hosts.
+
+	urand.x		<mach.h>
+	imul32.c			# added to support 64-bit
+	iscl32.c			# added to support 64-bit
+	iscl64.c			# added to support 64-bit
+	iand32.c			# added to support 64-bit
+	strsum.c			# added for VO integration support
+
+	# If a C compiler is not available for the following they will have
+	# to be written in assembler or some other low level language, and
+	# added to the special file list.
+
+	achtbb.c
+	achtbc.c
+	achtbd.c
+	achtbi.c
+	achtbl.c
+	achtbr.c
+	achtbs.c
+	achtbu.c
+	achtbx.c
+	achtcb.c
+	achtcu.c
+	achtdb.c
+	achtdu.c
+	achtib.c
+	achtiu.c
+	achtlb.c
+	achtlu.c
+	achtrb.c
+	achtru.c
+	achtsb.c
+	achtsu.c
+	achtub.c
+	achtuc.c
+	achtud.c
+	achtui.c
+	achtul.c
+	achtur.c
+	achtus.c
+	achtuu.c
+	achtux.c
+	achtxb.c
+	achtxu.c
+	and.c
+	not.c
+	or.c
+	shift.c
+	abs.c
+	i32to64.c
+	i64to32.c
+	ipak32.c
+	iupk32.c
+	ipak16.c
+	iupk16.c
+
+
+	# Both C and Fortran versions of the following are provided.
+	# The C versions are normally preferred and are the most portable.
+
+	$ifeq (USE_CCOMPILER, yes)
+	    bswap2.c
+	    bswap4.c
+	    bswap8.c
+	    chrpak.c
+	    chrupk.c
+	    strpak.c
+	    strupk.c
+	$else
+	    bswap2.f
+	    bswap4.f
+	    bswap8.f		# not written; wait until we need it
+	    chrpak.f
+	    chrupk.f
+	    strpak.f
+	    strupk.f
+	$endif
+
+	# The following are fairly portable, but potentially machine dependent.
+
+	ieeer.x		<mach.h>
+	ieeed.x		<mach.h>
+
+	miilen.x	<mach.h>
+	miinelem.x	<mach.h>
+	miipak.x	<mii.h>
+	miipak16.x	<mach.h>
+	miipak32.x	<mach.h>
+	miipak8.x	
+	miipakd.x	<mach.h>
+	miipakr.x	<mach.h>
+	miipksize.x	<mach.h>
+	miiupk.x	<mii.h>
+	miiupk16.x	<mach.h>
+	miiupk32.x	<mach.h>
+	miiupk8.x	
+	miiupkd.x	<mach.h>
+	miiupkr.x	<mach.h>
+
+	nmilen.x	<mach.h>
+	nminelem.x	<mach.h>
+	nmipak.x	<nmi.h>
+	nmipak16.x	<mach.h>
+	nmipak32.x	<mach.h>
+	nmipak8.x	
+	nmipakd.x	<mach.h>
+	nmipakr.x	<mach.h>
+	nmipksize.x	<mach.h>
+	nmiupk.x	<nmi.h>
+	nmiupk16.x	<mach.h>
+	nmiupk32.x	<mach.h>
+	nmiupk8.x	
+	nmiupkd.x	<mach.h>
+	nmiupkr.x	<mach.h>
+
+	f77pak.f
+	f77upk.f
+	bitmov.x	<mach.h>
+	xor.x
+	;
diff --git a/sys/osb/nmilen.x b/sys/osb/nmilen.x
new file mode 100644
index 00000000..32cc2055
--- /dev/null
+++ b/sys/osb/nmilen.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMILEN -- Determine the number of SPP integers to store nelems of type
+# nmi_type.  The nmi_type are defined in nmi.h.
+#
+# THIS PROCEDURE HAS BEEN OBSOLETED BY NMIPAKLEN.
+
+int procedure nmilen (nelems, nmi_datatype)
+
+int	nelems			#I number of NMI data elements
+int	nmi_datatype		#I datatype of NMI data
+
+begin
+	return (((nelems * abs(nmi_datatype) / NBITS_BYTE + SZB_CHAR - 1) /
+	    SZB_CHAR + SZ_INT - 1) / SZ_INT)
+end
diff --git a/sys/osb/nminelem.x b/sys/osb/nminelem.x
new file mode 100644
index 00000000..4a21c3e6
--- /dev/null
+++ b/sys/osb/nminelem.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMINELEM -- Determine the number of NMI elements of the given datatype
+# which can be stored in an SPP char array of the indicated length.
+# The nmi_type codes are defined in nmi.h; we assume here that the codes
+# used are the number of bits in each NMI type.
+
+int procedure nminelem (nchars, nmi_type)
+
+int	nchars			#I size in chars of packed array
+int	nmi_type		#I NMI type of packed data
+
+int	nbits
+
+begin
+	nbits = abs (nmi_type)
+	return ((nchars * SZB_CHAR * NBITS_BYTE) / nbits)
+end
diff --git a/sys/osb/nmipak.x b/sys/osb/nmipak.x
new file mode 100644
index 00000000..3c6a5e15
--- /dev/null
+++ b/sys/osb/nmipak.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<nmi.h>
+
+.help nmi
+.nf ___________________________________________________________________________
+NMI -- Machine independent integer format conversion routines.  The NMI integer
+format provides for three machine independent integer datatypes:
+
+    NMI_BYTE	8 bit unsigned byte
+    NMI_SHORT	16 bit twos complement signed integer
+    NMI_LONG	32 bit twos complement signed integer
+
+plus, more recently, two IEEE floating point formats:
+
+    NMI_REAL	32 bit IEEE floating point
+    NMI_DOUBLE	64 bit IEEE floating point
+
+The NMI datatypes are the same as are used in the FITS transportable image
+format.  In the case of the short and long integers, the most significant
+bytes of an integer are given first.
+
+The routines in this package are provided for converting to and from the
+NMI format and the SPP format.  The latter format, of course, is potentially
+quite machine dependent.  The implementation given here assumes that the
+SPP datatypes include 16 bit and 32 bit twos complement integers; the ordering
+of the bytes within these integer formats is described by the machine
+constants BYTE_SWAP2 and BYTE_SWAP4.  Byte swapping for the IEEE floating
+formats is defined by the machine constants IEEE_SWAP4 and IEEE_SWAP8.
+.endhelp ______________________________________________________________________
+
+
+# NMIPAK -- Pack a SPP array of type spp_type into a NMI array of type
+# nmi_type.  The nmi_types are defined in nmi.h.
+
+procedure nmipak (spp, nmi, nelems, spp_datatype, nmi_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+int	nmi_datatype		#I NMI datatype code
+
+begin
+	switch (nmi_datatype) {
+	case NMI_BYTE:
+	    call nmipak8  (spp, nmi, nelems, spp_datatype)
+	case NMI_SHORT:
+	    call nmipak16 (spp, nmi, nelems, spp_datatype)
+	case NMI_LONG:
+	    call nmipak32 (spp, nmi, nelems, spp_datatype)
+	case NMI_REAL:
+	    call nmipakr (spp, nmi, nelems, spp_datatype)
+	case NMI_DOUBLE:
+	    call nmipakd (spp, nmi, nelems, spp_datatype)
+	}
+end
diff --git a/sys/osb/nmipak16.x b/sys/osb/nmipak16.x
new file mode 100644
index 00000000..eeae2a3d
--- /dev/null
+++ b/sys/osb/nmipak16.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIPAK16 -- Pack an SPP array of the indicated datatype into an 16 bit
+# signed NMI array.
+
+procedure nmipak16 (spp, nmi, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbs (spp, nmi, nelems)
+	case TY_USHORT:
+	    call achtus (spp, nmi, nelems)
+	case TY_CHAR:
+	    call achtcs (spp, nmi, nelems)
+	case TY_SHORT:
+	    call achtss (spp, nmi, nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtis (spp, nmi, nelems)
+	case TY_LONG:
+	    call achtls (spp, nmi, nelems)
+	case TY_REAL:
+	    call achtrs (spp, nmi, nelems)
+	case TY_DOUBLE:
+	    call achtds (spp, nmi, nelems)
+	case TY_COMPLEX:
+	    call achtxs (spp, nmi, nelems)
+	}
+end
diff --git a/sys/osb/nmipak32.x b/sys/osb/nmipak32.x
new file mode 100644
index 00000000..73abfd25
--- /dev/null
+++ b/sys/osb/nmipak32.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIPAK32 -- Pack an SPP array of the indicated datatype into an 32 bit
+# signed NMI array.
+
+procedure nmipak32 (spp, nmi, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+int	nmi_bytes
+int	spp_bytes
+int	sizeof()
+pointer	tmpp
+
+begin
+	call malloc (tmpp, nelems, TY_INT)
+
+	nmi_bytes = 32 / NBITS_BYTE
+	spp_bytes = sizeof(spp_datatype) * SZB_CHAR
+
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbi (spp, Memi[tmpp], nelems)
+	case TY_USHORT:
+	    call achtui (spp, Memi[tmpp], nelems)
+	case TY_CHAR:
+	    call achtci (spp, Memi[tmpp], nelems)
+	case TY_SHORT:
+	    call achtsi (spp, Memi[tmpp], nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtii (spp, Memi[tmpp], nelems)
+	case TY_LONG:
+	    call achtli (spp, Memi[tmpp], nelems)
+	case TY_REAL:
+	    call achtri (spp, Memi[tmpp], nelems)
+	case TY_DOUBLE:
+	    call achtdi (spp, Memi[tmpp], nelems)
+	case TY_COMPLEX:
+	    call achtxi (spp, Memi[tmpp], nelems)
+	}
+
+	if ( 2 * nmi_bytes == spp_bytes )
+	    call ipak32 (Memi[tmpp], nmi, nelems)
+
+        call mfree (tmpp, TY_INT)
+end
diff --git a/sys/osb/nmipak8.x b/sys/osb/nmipak8.x
new file mode 100644
index 00000000..6cf2720d
--- /dev/null
+++ b/sys/osb/nmipak8.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NMIPAK8 -- Pack an SPP array of the indicated datatype into an 8 bit
+# unsigned NMI array.
+
+procedure nmipak8 (spp, nmi, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+int	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (spp_datatype) {
+	case TY_UBYTE:
+	    call achtbb (spp, nmi, nelems)
+	case TY_USHORT:
+	    call achtub (spp, nmi, nelems)
+	case TY_CHAR:
+	    call achtcb (spp, nmi, nelems)
+	case TY_SHORT:
+	    call achtsb (spp, nmi, nelems)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtib (spp, nmi, nelems)
+	case TY_LONG:
+	    call achtlb (spp, nmi, nelems)
+	case TY_REAL:
+	    call achtrb (spp, nmi, nelems)
+	case TY_DOUBLE:
+	    call achtdb (spp, nmi, nelems)
+	case TY_COMPLEX:
+	    call achtxb (spp, nmi, nelems)
+	}
+end
diff --git a/sys/osb/nmipakd.x b/sys/osb/nmipakd.x
new file mode 100644
index 00000000..b1cb8ad3
--- /dev/null
+++ b/sys/osb/nmipakd.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIPAKD -- Pack an SPP array of the indicated datatype into an 64 bit
+# IEEE floating format.
+
+procedure nmipakd (spp, nmi, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+double	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	if (spp_datatype == TY_DOUBLE)
+	    call ieevpakd (spp, nmi, nelems)
+	else {
+	    switch (spp_datatype) {
+	    case TY_UBYTE:
+		call achtbd (spp, nmi, nelems)
+	    case TY_USHORT:
+		call achtud (spp, nmi, nelems)
+	    case TY_CHAR:
+		call achtcd (spp, nmi, nelems)
+	    case TY_SHORT:
+		call achtsd (spp, nmi, nelems)
+	    case TY_INT, TY_POINTER, TY_STRUCT:
+		call achtid (spp, nmi, nelems)
+	    case TY_LONG:
+		call achtld (spp, nmi, nelems)
+	    case TY_REAL:
+		call achtrd (spp, nmi, nelems)
+	    case TY_COMPLEX:
+		call achtxd (spp, nmi, nelems)
+	    default:
+		call amovd (spp, nmi, nelems)
+	    }
+
+	    call ieevpakd (nmi, nmi, nelems)
+	}
+end
diff --git a/sys/osb/nmipakr.x b/sys/osb/nmipakr.x
new file mode 100644
index 00000000..ac710a2b
--- /dev/null
+++ b/sys/osb/nmipakr.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIPAKR -- Pack an SPP array of the indicated datatype into an 32 bit
+# IEEE floating format.
+
+procedure nmipakr (spp, nmi, nelems, spp_datatype)
+
+int	spp[ARB]		#I input array of SPP integers
+real	nmi[ARB]		#O output NMI format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	if (spp_datatype == TY_REAL)
+	    call ieevpakr (spp, nmi, nelems)
+	else {
+	    switch (spp_datatype) {
+	    case TY_UBYTE:
+		call achtbr (spp, nmi, nelems)
+	    case TY_USHORT:
+		call achtur (spp, nmi, nelems)
+	    case TY_CHAR:
+		call achtcr (spp, nmi, nelems)
+	    case TY_SHORT:
+		call achtsr (spp, nmi, nelems)
+	    case TY_INT, TY_POINTER, TY_STRUCT:
+		call achtir (spp, nmi, nelems)
+	    case TY_LONG:
+		call achtlr (spp, nmi, nelems)
+	    case TY_DOUBLE:
+		call achtdr (spp, nmi, nelems)
+	    case TY_COMPLEX:
+		call achtxr (spp, nmi, nelems)
+	    default:
+		call amovr (spp, nmi, nelems)
+	    }
+
+	    call ieevpakr (nmi, nmi, nelems)
+	}
+end
diff --git a/sys/osb/nmipksize.x b/sys/osb/nmipksize.x
new file mode 100644
index 00000000..8ccd8297
--- /dev/null
+++ b/sys/osb/nmipksize.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIPKSIZE -- Determine the size in SPP chars of the array required to store
+# nelems of type nmi_type in NMI packed form.  The nmi_type codes are defined
+# in nmi.h; we assume here that the integer codes are the sizes of the NMI
+# types in bits.
+
+int procedure nmipksize (nelems, nmi_type)
+
+int	nelems			#I number of NMI elements of type nmi_type
+int	nmi_type		#I <nmi.h> type code (=8,16,32,-32,-64)
+
+begin
+	return ((nelems * abs(nmi_type) / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR)
+end
diff --git a/sys/osb/nmiupk.x b/sys/osb/nmiupk.x
new file mode 100644
index 00000000..074f74bb
--- /dev/null
+++ b/sys/osb/nmiupk.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<nmi.h>
+
+# NMIUPK -- Unpack a NMI array of type nmi_type into a SPP array of type
+# spp_type.  The nmi_types are defined in nmi.h.
+
+procedure nmiupk (nmi, spp, nelems, nmi_datatype, spp_datatype)
+
+int	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	nmi_datatype		#I NMI datatype code
+int	spp_datatype		#I SPP datatype code
+
+begin
+	switch (nmi_datatype) {
+	case NMI_BYTE:
+	    call nmiupk8  (nmi, spp, nelems, spp_datatype)
+	case NMI_SHORT:
+	    call nmiupk16 (nmi, spp, nelems, spp_datatype)
+	case NMI_LONG:
+	    call nmiupk32 (nmi, spp, nelems, spp_datatype)
+	case NMI_REAL:
+	    call nmiupkr (nmi, spp, nelems, spp_datatype)
+	case NMI_DOUBLE:
+	    call nmiupkd (nmi, spp, nelems, spp_datatype)
+	}
+end
diff --git a/sys/osb/nmiupk16.x b/sys/osb/nmiupk16.x
new file mode 100644
index 00000000..abe20bee
--- /dev/null
+++ b/sys/osb/nmiupk16.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIUPK16 -- Unpack a 16 bit signed NMI array into an SPP array of the
+# indicated datatype.
+
+procedure nmiupk16 (nmi, spp, nelems, spp_datatype)
+
+int	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call achts (nmi, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/nmiupk32.x b/sys/osb/nmiupk32.x
new file mode 100644
index 00000000..f42907fa
--- /dev/null
+++ b/sys/osb/nmiupk32.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIUPK32 -- Unpack a 32 bit signed NMI array into an SPP array of the
+# indicated datatype.
+
+procedure nmiupk32 (nmi, spp, nelems, spp_datatype)
+
+int	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+int	nmi_bytes
+int	spp_bytes
+int	sizeof()
+
+begin
+	nmi_bytes = 32 / NBITS_BYTE
+	spp_bytes = sizeof(spp_datatype) * SZB_CHAR
+
+	# for 64bit integer
+	if ( 2 * nmi_bytes == spp_bytes )
+	    call iupk32 (nmi, spp, nelems)
+
+	call achti (nmi, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/nmiupk8.x b/sys/osb/nmiupk8.x
new file mode 100644
index 00000000..4c7f0e8e
--- /dev/null
+++ b/sys/osb/nmiupk8.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NMIUPK8 -- Unpack an 8 bit unsigned NMI array into an SPP array of the
+# indicated datatype.
+
+procedure nmiupk8 (nmi, spp, nelems, spp_datatype)
+
+int	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call achtb (nmi, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/nmiupkd.x b/sys/osb/nmiupkd.x
new file mode 100644
index 00000000..35d16631
--- /dev/null
+++ b/sys/osb/nmiupkd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIUPKD -- Unpack a 64 bit IEEE floating array into an SPP array of the
+# indicated datatype.
+
+procedure nmiupkd (nmi, spp, nelems, spp_datatype)
+
+double	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call ieevupkd (nmi, spp, nelems)
+	if (spp_datatype != TY_DOUBLE)
+	    call achtd (spp, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/nmiupkr.x b/sys/osb/nmiupkr.x
new file mode 100644
index 00000000..474662f5
--- /dev/null
+++ b/sys/osb/nmiupkr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# NMIUPKR -- Unpack a 32 bit IEEE floating array into an SPP array of the
+# indicated datatype.
+
+procedure nmiupkr (nmi, spp, nelems, spp_datatype)
+
+real	nmi[ARB]		#I input NMI format array
+int	spp[ARB]		#O output SPP format array
+int	nelems			#I number of integers to be converted
+int	spp_datatype		#I SPP datatype code
+
+begin
+	call ieevupkr (nmi, spp, nelems)
+	if (spp_datatype != TY_REAL)
+	    call achtr (spp, spp, nelems, spp_datatype)
+end
diff --git a/sys/osb/not.c b/sys/osb/not.c
new file mode 100644
index 00000000..bbb2ed9e
--- /dev/null
+++ b/sys/osb/not.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* NOTI -- Bitwise boolean NOT of an integer variable.
+ */
+XINT
+NOTI (XINT *a)
+{
+	return (~(*a));
+}
+
+
+/* NOTS -- Bitwise boolean NOT of a short integer variable.
+ */
+XSHORT
+NOTS (XSHORT *a)
+{
+	return (~(*a));
+}
+
+
+/* NOTL -- Bitwise boolean NOT of a long integer variable.
+ */
+XLONG
+NOTL (XLONG *a)
+{
+	return (~(*a));
+}
diff --git a/sys/osb/or.c b/sys/osb/or.c
new file mode 100644
index 00000000..88c8711c
--- /dev/null
+++ b/sys/osb/or.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ORI -- Bitwise boolean OR of two integer variables.
+ */
+XINT
+ORI (XINT *a, XINT *b)
+{
+	return (*a | *b);
+}
+
+
+/* ORS -- Bitwise boolean OR of two short integer variables.
+ */
+XSHORT
+ORS (XSHORT *a, XSHORT *b)
+{
+	return (*a | *b);
+}
+
+
+/* ORL -- Bitwise boolean OR of two long integer variables.
+ */
+XLONG
+ORL (XLONG *a, XLONG *b)
+{
+	return (*a | *b);
+}
diff --git a/sys/osb/r1mach.f b/sys/osb/r1mach.f
new file mode 120000
index 00000000..c64a1953
--- /dev/null
+++ b/sys/osb/r1mach.f
@@ -0,0 +1 @@
+/iraf/iraf/unix/hlib/r1mach.f
\ No newline at end of file
diff --git a/sys/osb/shift.c b/sys/osb/shift.c
new file mode 100644
index 00000000..86eacfb3
--- /dev/null
+++ b/sys/osb/shift.c
@@ -0,0 +1,49 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/*
+ * SHIFT.C -- Bitwise shift operators.  A positive bitshift shifts to the left,
+ * zero-filling at the right, i.e., a left shift by 1 is equivalent to a
+ * multiplication by 2 (but does not cause integer overflow).  A negative shift
+ * shifts to the right and is equivalent to a division.
+ */
+
+/* SHIFTI -- Bitwise boolean SHIFT of two integer variables.
+ */
+XINT
+SHIFTI (
+  XINT	*a_a,			/* operand to be shifted	*/
+  XINT	*a_bits 		/* number of bits to shift	*/
+)
+{
+	register XINT	a = *a_a, bits = *a_bits;
+	return (bits > 0 ? (a << bits) : (a >> -bits));
+}
+
+/* SHIFTS -- Bitwise boolean SHIFT of two short-integer variables.
+ */
+XSHORT
+SHIFTS (
+  XSHORT *a_a,			/* operand to be shifted	*/
+  XSHORT *a_bits 		/* number of bits to shift	*/
+)
+{
+	register XSHORT	a = *a_a, bits = *a_bits;
+	return (bits > 0 ? (a << bits) : (a >> -bits));
+}
+
+/* SHIFTL -- Bitwise boolean SHIFT of two long-integer variables.
+ */
+XLONG
+SHIFTL (
+  XLONG	*a_a,			/* operand to be shifted	*/
+  XLONG	*a_bits 		/* number of bits to shift	*/
+)
+{
+	register XLONG	a = *a_a, bits = *a_bits;
+	return (bits > 0 ? (a << bits) : (a >> -bits));
+}
diff --git a/sys/osb/strpak.c b/sys/osb/strpak.c
new file mode 100644
index 00000000..4f88123d
--- /dev/null
+++ b/sys/osb/strpak.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* STRPAK -- Pack an SPP character string into a C string, i.e., a sequence
+ * of characters stored one per byte, delimited by EOS='\0'.  The operation
+ * may be performed in place.  This version assumes that the host character
+ * set is ASCII and hence no lookup table reference to map character sets is
+ * needed.  If this is not the case, code must be added to convert to the host
+ * character set.
+ *
+ * N.B.: If sizeof(XCHAR)=1, XEOS=EOS, and the host character set is ASCII,
+ * and the operation is being performed in place, then this procedure should
+ * do nothing.
+ */
+STRPAK (instr, outstr, maxch)
+XCHAR	*instr;
+PKCHAR	*outstr;
+XINT	*maxch;
+{
+	register XCHAR	*ip = instr;
+	register char	*op = (char *)outstr;
+	register int	  n = *maxch;
+
+	while ((*op++ = *ip++) != XEOS && --n >= 0)
+	    ;
+	*--op = EOS;
+}
diff --git a/sys/osb/strpak.f b/sys/osb/strpak.f
new file mode 100644
index 00000000..8c66f6f0
--- /dev/null
+++ b/sys/osb/strpak.f
@@ -0,0 +1,29 @@
+c STRPAK -- Pack an SPP character string into a C string, i.e., a sequence
+c of characters stored one per byte, delimited by EOS='\0'.  The operation
+c may be performed in place.  This version assumes that the host character
+c set is ASCII and hence no lookup table reference to map character sets is
+c needed.  If this is not the case, code must be added to convert to the host
+c character set.
+c
+c N.B.: If sizeof(XCHAR)=1, XEOS=EOS, and the host character set is ASCII,
+c and the operation is being performed in place, then this procedure should
+c do nothing.
+c 
+c N.B.: This code ASSUMES that XCHAR is implemented as INTEGER*2 and that
+c both XEOS and EOS are 0.
+
+	subroutine strpak (instr, outstr, maxch)
+
+	integer*2 instr(*), ch, EOS
+	character*1 outstr(*)
+	integer maxch
+	parameter (EOS=0)
+	integer i
+
+		do 10 i = 1, maxch
+		    ch = instr(i)
+		    outstr(i) = char (ch)
+		    if (ch .eq. EOS) return
+ 10		continue
+		outstr(maxch+1) = char (EOS)
+	end
diff --git a/sys/osb/strsum.c b/sys/osb/strsum.c
new file mode 100644
index 00000000..71655b3f
--- /dev/null
+++ b/sys/osb/strsum.c
@@ -0,0 +1,100 @@
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+
+#ifdef INT32_SUM
+
+/**
+ *  STRSUM -- Compute the 32-bit checksum of an SPP string.
+ */
+
+int
+STRSUM (XCHAR *array, XINT *length, XINT *maxch)
+{
+    int      i, len, carry=0, newcarry=0;
+    unsigned int *iarray, sum = 0;
+    char     pkstr[*maxch];
+
+    register int     n = *maxch;
+    register XCHAR  *ip = array;
+    register char   *op = (char *) pkstr;
+
+
+    /*  Convert the input string to a packed char array.
+     */
+    while ((*op++ = *ip++) != XEOS && --n >= 0)
+	;
+    *--op = EOS;
+
+    /*  Compute the checksum.
+     */
+    iarray = (unsigned int *) pkstr;
+    len = *length / 4;
+
+    for (i=0; i<len; i++) {
+        if (iarray[i] > ~ sum)
+            carry++;
+
+        sum += iarray[i];
+    }
+
+    while (carry) {
+        if (carry > ~ sum)
+            newcarry++;
+        sum += carry;
+        carry = newcarry;
+        newcarry = 0;
+    }
+
+    return (sum);
+}
+
+#else
+
+/**
+ *  STRSUM -- Compute the 32-bit checksum of an SPP string.
+ */
+
+int
+STRSUM (XCHAR *array, XINT *length, XINT *maxch)
+{
+    int      i, len, carry=0, newcarry=0;
+    unsigned int *iarray, sum = 0;
+    unsigned long lsum = 0;
+    char     pkstr[*maxch];
+
+    register int     n = *maxch;
+    register XCHAR  *ip = array;
+    register char   *op = (char *) pkstr;
+
+
+    /*  Convert the input string to a packed char array.
+     */
+    while ((*op++ = *ip++) != XEOS && --n >= 0)
+	;
+    *--op = EOS;
+
+    /*  Compute the checksum.
+     */
+    iarray = (unsigned int *) pkstr;
+    len = *length / 4;
+
+    for (i=0; i<len; i++) {
+        if (iarray[i] > ~ lsum)
+            carry++;
+        lsum += iarray[i];
+    }
+
+    while (carry) {
+        if (carry > ~ lsum)
+            newcarry++;
+        lsum += carry;
+        carry = newcarry;
+        newcarry = 0;
+    }
+
+    return (abs(sum = lsum));
+}
+
+#endif
diff --git a/sys/osb/strupk.c b/sys/osb/strupk.c
new file mode 100644
index 00000000..97bd1bc1
--- /dev/null
+++ b/sys/osb/strupk.c
@@ -0,0 +1,39 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* STRUPK -- Unpack a kernel (C style) string into an SPP string.  The unpacking
+ * operation can be performed in place.  A kernel string consists of a sequence
+ * of host characters stored one character per byte, delimited by EOS='\0'.
+ * We assume here that the host character set is ASCII.  If this is not the
+ * case code must be added to convert from the host character set to ASCII in
+ * the unpacked string.
+ *
+ * N.B.: If sizeof(XCHAR)=1, XEOS=EOS, and the host character set is ASCII,
+ * and the operation is being performed in place, then this procedure should
+ * do nothing.
+ */
+STRUPK (instr, outstr, maxch)
+PKCHAR	*instr;
+XCHAR	*outstr;
+XINT	*maxch;
+{
+	register char	*ip = (char *)instr;
+	register XCHAR	*op = outstr;
+	register int	  n;
+
+	/* 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.
+	 */
+	for (n=0;  *ip++;  n++)
+	    ;
+	n = (n < *maxch) ? n : *maxch;
+	op[n] = XEOS;
+
+	for (ip = (char *)instr;  --n >= 0;  )
+	    op[n] = ip[n];
+	op[*maxch] = XEOS;
+}
diff --git a/sys/osb/strupk.f b/sys/osb/strupk.f
new file mode 100644
index 00000000..1123e2ac
--- /dev/null
+++ b/sys/osb/strupk.f
@@ -0,0 +1,39 @@
+c STRUPK -- Unpack a kernel (C style) string into an SPP string.  The unpacking
+c operation can be performed in place.  A kernel string consists of a sequence
+c of host characters stored one character per byte, delimited by EOS='\0'.
+c We assume here that the host character set is ASCII.  If this is not the
+c case code must be added to convert from the host character set to ASCII in
+c the unpacked string.
+c
+c N.B.: If sizeof(XCHAR)=1, XEOS=EOS, and the host character set is ASCII,
+c and the operation is being performed in place, then this procedure should
+c do nothing.
+c 
+c N.B.: This code ASSUMES that XCHAR is implemented as INTEGER*2 and that
+c both XEOS and EOS are 0.
+
+	subroutine strupk (instr, outstr, maxch)
+
+	character*1 instr(*)
+	integer*2 outstr(*)
+	integer maxch, EOS
+	parameter (EOS=0)
+	integer i
+
+		    
+c Determine length of string so that we can unpack it in the reverse
+c direction.
+		i = 1
+ 10		continue
+		if (ichar (instr(i)) .eq. EOS .or. i .gt. maxch) goto 20
+		    i = i + 1
+		    goto 10
+ 20		continue
+
+c Unpack the string from right to left.
+c
+		outstr(i) = EOS
+		do 30 i=i, 1, -1
+		    outstr(i) = ichar (instr(i))
+ 30		continue
+	end
diff --git a/sys/osb/urand.x b/sys/osb/urand.x
new file mode 100644
index 00000000..84e1fc67
--- /dev/null
+++ b/sys/osb/urand.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# URAND -- Universal Random Number Generator.  From "Computer Methods for
+# Mathematical Computations", by Forsythe, Malcolm, and Moler, 1977.
+# Urand is a uniform random number generator based on theory and suggestions
+# given in D.E. Knuth (1969), Vol 2.  Values of URAND will be returned in the
+# interval (0,1).  Random numbers are generated by the recursion relation
+# (r' = r * a + c) where the art lies in choosing the values for A and C.
+#
+# [MACHDEP] - NOTE - This routine will not work on machines that do not permit
+# integer overflow during multiplication.  In such a case a machine dependent
+# routine should be provided in host$as.
+
+real procedure urand (lseed)
+
+long	lseed				# seed value on first call
+long	n, a, c, m, mic
+
+real	scale
+data	m /0/
+
+int	imul32()
+
+begin
+	# When first called, compute multiplier, increment, and miscellaneous
+	# constants.
+
+	if (m == 0) {
+	    m = MAX_LONG / 2 + 1
+	    a = 8 * int (m * atan (1.d0 / 8.d0)) + 5
+	    c = 2 * int (m * (0.5d0 - sqrt (3.d0) / 6.d0)) + 1
+	    mic = (m - c) + m
+	    scale = 0.5 / m
+	    lseed = max (1, lseed)
+	}
+
+	# Compute next random number, taking care not to cause an arithmetic
+	# exception.
+
+	n = imul32 (lseed, a)			# [MACHDEP] - integer overflow
+	if (n > mic)
+	    n = (n - m) - m
+	n = n + c
+
+	if (n / 2 > m)
+	    n = (n - m) - m
+
+	if (n < 0)
+	    n = (n + m) + m
+
+	lseed = n
+	return (n * scale)
+end
diff --git a/sys/osb/xor.x b/sys/osb/xor.x
new file mode 100644
index 00000000..3ba0dd85
--- /dev/null
+++ b/sys/osb/xor.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XORI -- Boolean exclusive or of two integer operands.
+
+int procedure xori (a, b)
+
+int	a, b
+int	not(), and(), or()
+
+begin
+	return (or (and(a,not(b)), and(not(a),b)))
+end
+
+
+# XORS -- Boolean exclusive or of two short integer operands.
+
+short procedure xors (a, b)
+
+short	a, b
+short	nots(), ands(), ors()
+
+begin
+	return (ors (ands(a,nots(b)), ands(nots(a),b)))
+end
+
+
+# XORL -- Boolean exclusive or of two long integer operands.
+
+long procedure xorl (a, b)
+
+long	a, b
+long	notl(), andl(), orl()
+
+begin
+	return (orl (andl(a,notl(b)), andl(notl(a),b)))
+end
diff --git a/sys/osb/zzdebug.x b/sys/osb/zzdebug.x
new file mode 100644
index 00000000..f15f3fd4
--- /dev/null
+++ b/sys/osb/zzdebug.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+task	sbit, tbit
+
+define	NWORDS		1	# limited to 1 longword at present
+
+
+# SBIT, TBIT -- Test the bitpak and bitupk primitives.
+
+procedure sbit()
+
+int	b[NWORDS]
+int	offset, nbits, value, i
+int	bitupk(), clgeti()
+
+begin
+	offset = clgeti ("offset")
+	nbits  = clgeti ("nbits")
+	value  = clgeti ("value")
+
+	if (offset < 1 || offset > NWORDS * NBITS_INT)
+	    call error (1, "bit offset out of range")
+
+	call bitpak (value, b, offset, nbits)
+
+	call printf ("\n")
+	call printf ("\t21098765432109876543210987654321\n")
+	call printf ("\t  3         2         1        0\n")
+	do i = 1, NWORDS {
+	    call printf ("%4d\t%032r2  (%011oB)\n")
+		call pargi ((i-1) * 32 + 1)
+		call pargi (b[i])
+		call pargi (b[i])
+	}
+	return
+
+entry	tbit()
+	offset = clgeti ("offset")
+	nbits  = clgeti ("nbits")
+
+	call printf ("bitfield=%d\n")
+	    call pargi (bitupk (b, offset, nbits))
+end
diff --git a/sys/osb/zzeps.f b/sys/osb/zzeps.f
new file mode 100644
index 00000000..680af1b0
--- /dev/null
+++ b/sys/osb/zzeps.f
@@ -0,0 +1,114 @@
+
+c-------------------------------------------------------------------------
+c Compute machine epsilon, i.e, the smallest real or double precision
+c number EPS such that (1.0 + EPS > 1.0).  This calculation is tricky
+c because of the optimizations performed by some compilers, and because
+c a comparison performed in registers may be done to a higher precision
+c than one involving variables.  This program contains some minor
+c violations of the F78 standard.
+c-------------------------------------------------------------------------
+
+
+	program epsilo
+
+	real seps
+	double precision deps
+
+		write (*,*) 'Calculate Machine Epsilon ------'
+		call cseps (seps)
+		call cdeps (deps)
+		write (*,*) '   single precision epsilon: ', seps
+		write (*,*) '   double precision epsilon: ', deps
+
+		write (*,*) ' '
+		write (*,*) 'Verify Values -----'
+
+		write (*, '(''     enter s.p. epsilon: '',$)')
+		read (*,*) seps
+		if (1.0 + seps .gt. 1.0) then
+		    write (*,*) '     ok'
+		else
+		    write (*,*) '     not ok'
+		endif
+
+		write (*, '(''     enter d.p. epsilon: '',$)')
+		read (*,*) deps
+		if (1.0 + deps .gt. 1.0) then
+		    write (*,*) '     ok'
+		else
+		    write (*,*) '     not ok'
+		endif
+
+		stop
+	end
+
+
+c -- Compute the single precision epsilon.
+
+	subroutine cseps (seps)
+
+	real	seps
+	real	sval
+	double	precision dval
+	logical	sgt
+	common	/eps/ sval, dval
+	save	/eps/
+
+		sval = 1.0
+ 10		seps = sval
+		sval = sval / 2.0
+		if (sgt (1.0)) then
+		    goto 10
+		endif
+	end
+
+
+
+c -- Is SVAL + 1.0 greater than 1.0?
+
+	logical function sgt (value)
+
+	real	value, sval, stemp
+	double precision dval
+	common	/eps/ sval, dval
+	save	/eps/
+
+		stemp = sval + 1.0
+		sgt = (stemp .gt. value)
+	end
+
+
+
+c -- Compute the double precision epsilon.
+
+	subroutine cdeps (deps)
+
+	double	precision deps
+	double	precision dval
+	real	sval
+	logical	dgt
+	common	/eps/ sval, dval
+	save	/eps/
+
+		dval = 1.0d0
+ 10		deps = dval
+		dval = dval / 2.0d0
+		if (dgt (1.0d0)) then
+		    goto 10
+		endif
+	end
+
+
+c -- Is DVAL + 1.0 greater than 1.0?
+
+	logical function dgt (value)
+
+	double	precision value
+	double	precision dval, dtemp
+	real	sval
+	common	/eps/ sval, dval
+	save	/eps/
+
+		dtemp = dval + 1.0d0
+		dgt = (dtemp .gt. value)
+	end
diff --git a/sys/osb/zzeps2.f b/sys/osb/zzeps2.f
new file mode 100644
index 00000000..d52ffe20
--- /dev/null
+++ b/sys/osb/zzeps2.f
@@ -0,0 +1,110 @@
+c-------------------------------------------------------------------------
+c ZZEPS2.F -- Alternate version of ZZEPS.  This version may avoid problems
+c seen on some systems of excess precision causing an artificially large
+c value of the single precision epsilon to be computed, due to the epsilon
+c value being computed in registers.  Use whichever version produces the
+c smaller epsilon.
+c
+c Compute machine epsilon, i.e, the smallest real or double precision
+c number EPS such that (1.0 + EPS > 1.0).  This calculation is tricky
+c because of the optimizations performed by some compilers, and because
+c a comparison performed in registers may be done to a higher precision
+c than one involving variables.  This program contains some minor
+c violations of the F78 standard.
+c-------------------------------------------------------------------------
+
+
+	program epsilo
+
+	real seps
+	double precision deps
+
+		write (*,*) 'Calculate Machine Epsilon ------'
+		call cseps (seps)
+		call cdeps (deps)
+		write (*,*) '   single precision epsilon: ', seps
+		write (*,*) '   double precision epsilon: ', deps
+
+		write (*,*) ' '
+		write (*,*) 'Verify Values -----'
+
+		write (*, '(''     enter s.p. epsilon: '',$)')
+		read (*,*) seps
+		if (1.0 + seps .gt. 1.0) then
+		    write (*,*) '     ok'
+		else
+		    write (*,*) '     not ok'
+		endif
+
+		write (*, '(''     enter d.p. epsilon: '',$)')
+		read (*,*) deps
+		if (1.0 + deps .gt. 1.0) then
+		    write (*,*) '     ok'
+		else
+		    write (*,*) '     not ok'
+		endif
+
+		stop
+	end
+
+
+c -- Compute the single precision epsilon.
+
+	subroutine cseps (seps)
+
+	real	seps
+	real	sval
+	double	precision dval
+	logical	sgt
+	common	/eps/ sval, dval
+	save	/eps/
+
+		sval = 1.0
+ 10		seps = sval
+		sval = sval / 2.0
+		if (sgt (sval + 1.0, 1.0)) then
+		    goto 10
+		endif
+	end
+
+
+
+c -- Is SVAL + 1.0 greater than 1.0?
+
+	logical function sgt (value, ref)
+
+	real	value, ref
+
+		sgt = (value .gt. ref)
+	end
+
+
+
+c -- Compute the double precision epsilon.
+
+	subroutine cdeps (deps)
+
+	double	precision deps
+	double	precision dval
+	real	sval
+	logical	dgt
+	common	/eps/ sval, dval
+	save	/eps/
+
+		dval = 1.0d0
+ 10		deps = dval
+		dval = dval / 2.0d0
+		if (dgt (dval + 1.0d0, 1.0d0)) then
+		    goto 10
+		endif
+	end
+
+
+c -- Is DVAL + 1.0 greater than 1.0?
+
+	logical function dgt (value, ref)
+
+	double	precision value, ref
+
+		dgt = (value .gt. ref)
+	end
diff --git a/sys/plio/PLIO.hlp b/sys/plio/PLIO.hlp
new file mode 100644
index 00000000..16e23dfc
--- /dev/null
+++ b/sys/plio/PLIO.hlp
@@ -0,0 +1,1341 @@
+.help PLIO Feb88 "Pixel List Package Design"
+.ce
+\fBThe IRAF Pixel List Package\fR
+.ce
+and
+.ce
+\fBIMIO Extensions to Support Image Masks\fR
+.ce
+Doug Tody
+.ce
+February, 1988
+.ce
+(Revised June 1988)
+
+
+.NH
+Introduction
+
+    The pixel list package is a general package for flagging individual pixels
+or regions of an image, to mark some subset of the pixels in an image.
+This may be done to flag bad pixels, or to identify those regions of an image
+to be processed by some applications program.  When the pixel list package is
+used to flag the bad pixels in an image we call this a \fBbad pixel mask\fR,
+or BPM.  When used to identify the regions of an image to be processed (or
+ignored), we call the list a \fBregion mask\fR.
+
+A pixel list may be viewed conceptually as either a list or an image; the list
+is merely the compressed form of a virtual \fBmask image\fR.  Storing a mask
+image as a list has two major advantages.
+.ls
+.ls [1]
+Storage efficiency.  Simple masks may be stored very compactly, e.g., as small
+arrays stored directly in an image header, or in a separate mask file or
+database.
+.le
+.ls [2]
+Runtime efficiency.  Storing a mask in list form has the advantage that one
+can determine very quickly whether or not a given region of the image (e.g.,
+an image line) contains any pixels in the mask.  The alternative, given a
+fully populated mask image (or flagging the pixels directly in the data image),
+requires that one examine every pixel in the mask image, which is very
+inefficient for simple masks.
+.le
+.le
+
+The pixel list technique for implementing image masks is the most efficient
+choice only for simple or moderately complex masks.  As a mask image increases
+in complexity there eventually comes a point where it would be simpler and
+more efficient to use a conventional raster image to store the mask.
+For example, if one wishes to associate a flag value (such as a weight) with
+every pixel in an image, and the flag values vary rapidly in value across the
+image, a separate image should probably be used (except that other forms of
+data compression may be possible; the IRAF \fInoise function package\fR
+addresses one aspect of this problem).
+
+The pixel list related software is subdivided into two parts, the pixel list
+package itself, and the extensions to IMIO to make use of the pixel list
+package.  The pixel list package in itself is independent of IMIO and may be
+used separately.
+
+.NH
+IMIO Support for Pixel Lists
+
+    Most image applications tend to fall into two classes, the simple pointwise
+transformation operators, and the more cpu intensive image analysis operations.
+The simple operators usually operate upon the whole image (no mask required)
+and may ignore the presence of bad pixels in the image, provided reasonable
+artificial values have been provided for the bad pixels so that arithmetic
+problems do not occur, and provided we keep track of the locations of the
+bad pixels (by propagating the bad pixel lists), so that the bad pixel
+information is available to subsequent image analysis programs.
+
+The image analysis operators, on the other hand, must know the locations of
+the bad pixels in order to exclude them from the fit.  The analysis is also
+often performed only upon specified regions of the image, as indicated by some
+sort of image mask.  Most image analysis algorithms are fairly cpu intensive,
+hence as long as we can access the bad pixel list and region mask reasonably
+efficiently, we would prefer a simple interface, e.g., for every buffer of
+input image data read, an associated buffer the same size and dimensionality
+as the input image data buffer, containing the bad pixel or region mask flag
+values.
+
+In general, if pixel lists are to be used with images, either IMIO must
+provide direct support for pixel lists or the pixel list package must duplicate
+much of the functionality of IMIO.  This is because the pixel list must
+be defined in terms of the physical image, whereas an applications
+program accessing an image via IMIO may be operating upon some user specified
+section of the image.  To support applications transparent sectioning, boundary
+extension, multiple input buffers, and so on, support for pixel lists must
+be integrated into IMIO.
+
+.NH 2
+Mask Images
+
+    These considerations lead us to make it possible for a pixel list to appear
+to an application as a special type of image called a \fImask image\fR, even
+though the mask may be stored as a pixel list internally, and accessed or
+queried directly as a list if desired.  If whenever we read a block of data
+from the data image, we read an equivalent block of data from the mask image,
+it is evident that whatever we come up with for reading from the mask image is
+going to have to look an awful lot like IMIO.  Given the complexities of image
+section transformations, automatic buffer allocation strategies, and so on,
+the simplest solution is to just go ahead and use IMIO to access the virtual
+mask image.  This leads us to the interface shown in the figure below.
+These routines represent an extension to IMIO to support pixel lists.  The
+conventional IMIO routines, used to access the mask "pixels", are not shown.
+
+The mask image may be opened by name with \fIim_pmmap\fR, or an already opened
+pixel mask, perhaps the result of some computation done by the applications
+program, may be opened with \fIim_pmmapo\fR.  Alternatively, if the mask is
+stored (or will be stored in the case of a new mask) in a pixel list file
+(".pl" extension), the mask may be opened with a conventional \fIimmap\fR call.
+This last option is especially powerful, since it allows all image tasks to
+access masks as if they were conventional images, e.g., one can DISPLAY or
+IMCOPY a stored mask.
+
+.ks
+.nf
+		  im = im_pmmap (maskname, mode, ref_im|NULL)
+		 im = im_pmmapo (pm, ref_im)
+
+		         imseti (im, IM_RLIO, YES|NO)
+		         imseti (im, IM_PMDES, pm)
+		   pm = imstati (im, IM_PMDES)
+
+	   bool = im_pmlne[123] (im[, lineno[, bandno]])
+	   bool = im_pmsne[123] (im, x1, x2[, y1, y2[, z1, z2]])
+	       bool = im_pmlnev (im, v)
+	       bool = im_pmsnev (im, vs, ve, ndim)
+.fi
+.ke
+
+The \fImode\fR argument to \fIim_pmmap\fR  specifies both the access mode for
+the mask, and any standard transformations to be performed upon the mask before
+i/o takes place (if an existing mask is to be read).  NEW_FILE mode is used to
+create a new mask; READ_ONLY to read an existing mask, and READ_WRITE to modify
+an existing mask.  The mode-transformation flags currently supported are
+INVERT_MASK, which performs a PIX_NOT operation on the input mask, and
+BOOLEAN_MASK, which converts an integer input mask to boolean.  Any more
+complex mask transformations or combinations must be performed explicitly
+by the calling program via calls to the PMIO or PLIO routines, mapping the
+resultant mask onto an image descriptor with \fIim_pmmapo\fR.
+
+If a reference image \fIref_im\fR is specified at open time,
+then the mask image will inherit any image section, boundary extension, etc.
+in effect for the reference image.  Inheritance occurs when the first i/o
+to the mask image takes place.  The reserved names "BPM" and "EMPTY",
+respectively (must be upper case), denote the bad pixel mask
+for the reference image, or an empty mask the size of the reference image.
+If the reference image does not have a bad pixel mask, BPM and EMPTY are
+equivalent.  Note that separate image descriptors are used for the data
+(reference) image and any mask images.  Multiple mask images may be associated
+with the same reference image.
+
+Normal IMIO calls, e.g., \fIimgs2i\fR, are used to access the mask "pixels".
+Since it is common for a mask to be empty over large regions of an image,
+a set of boolean functions are provided for testing whether regions of the
+mask are nonempty, allowing a program to avoid the expense of image mask i/o
+and subseqent testing of the mask pixel values if not needed.
+The boolean functions \fIim_pmlne\fR (line not empty) and \fIim_pmsne\fR
+(section not empty) and their more general variants \fIim_pmlnev\fR and
+\fIim_pmsnev\fR test whether the specified region of the mask image contains
+any nonzero mask pixels.  The calling sequences of these routines are patterned
+after the corresponding IMIO pixel i/o routines, e.g., \fIim_pmlne2\fR is
+intended for use with the \fIimgl2\fR routines, and \fIim_pmlnev\fR is
+intended for use with the \fIimgnl\fR routines.
+
+By default, mask image i/o operates on data buffers containing arrays of
+pixels, as for a conventional data image.  When i/o takes place, the interface
+automatically converts between pixel format and the compressed line list format
+in which the mask is stored internally.  An alternative format for the mask
+data is \fBrange list\fR format, enabled by setting the \fIIM_RLIO\fR parameter
+to YES in an \fIimseti\fR call.  Range list i/o works identically to pixel i/o,
+except that the "pixel arrays" returned by IMIO (or input to IMIO) are range
+list structures, as defined in \fB<plset.h>\fR and discussed in section 3.3.4.
+
+Range list i/o at the IMIO level is fully general, i.e., the section
+transformation, if any, is applied transparently to the calling program,
+and the full range of IMIO i/o routines may be used.
+If the data buffer is a multidimensional subraster, each line of the subraster
+will be a separate range list, and the physical length in pixels of each line
+of the subraster will be as for a pixel subraster.
+On a read, if the length of the encoded range list exceeds the subraster
+line length in pixels, and i/o error will occur.  Such an i/o error cannot
+occur when i/o is restricted to lines or line segments (1D buffers),
+since IMIO will automatically allocate a data buffer large enough to hold
+the worst case (longest) range list.  Range list overflow errors are
+unlikely even for subrasters, however, since the range list format is
+normally much more compact than the equivalent pixel array (except for
+very small subrasters or very complex masks).
+
+.NH 2
+Masked Image I/O (MIO)
+
+    The mask image i/o routines discussed in the previous section provide a
+fully generalized means for directly accessing a mask as an separate entity,
+independent of the associated reference data image.  Two separate image
+descriptors are required, and two parallel but separate sets of calls to the
+IMIO routines.  In many applications, however, a mask is used only to specify
+those regions of the data image to be analyzed or processed.  We want to
+access those regions of the image visible through the mask, but are not
+otherwise interested in the mask itself.  The \fBmasked image i/o\fR (MIO)
+interface is designed for such applications.
+
+The MIO interface is summarized in the figure below.  A named mask may be
+opened on a previously opened image with the \fImio_open\fR procedure.
+As for \fIim_pmopen\fR, the reserved names "BPM" and "EMPTY", respectively,
+denote the bad pixel mask for the image, or an empty mask the size of the
+image.  If the image does not have a bad pixel mask, an empty mask will be
+opened.
+
+The \fIflags\fR argument, if nonzero, specifies an operation be performed
+upon the input mask to generate the mask to be used to access the data image.
+The currently supported flags are INVERT_MASK and BOOLEAN_MASK.  For example,
+when the mask is a bad pixel mask, INVERT_MASK would cause MIO to access only
+that portion of the image which is \fInot\fR covered by the bad pixel mask,
+i.e., the "good" region of the image.  BOOLEAN_MASK is used to convert an
+integer mask into a boolean mask.  Note that in the case of inversion of an
+integer mask, the PIX_NOT operation merely complements the mask pixel values,
+hence will not affect the \fIregion\fR covered by the mask.  To invert an
+integer mask in the region sense, use INVERT_MASK+BOOLEAN_MASK.
+
+.ks
+.nf
+		  mp = mio_open (maskname, flags, im)
+		 mp = mio_openo (pm, im)
+	      value = mio_stati (mp, param)
+		       mio_seti (mp, param, value)
+		   mio_setrange (mp, vs, ve, ndim)
+   n|EOF = mio_[gp]lseg[silrdx] (mp, ptr, mval, v, npix)
+		      mio_close (mp)
+.fi
+.ke
+
+More general mask transformations must be carried out by the user using the
+PMIO package to directly compute the desired mask, the mapping the mask onto
+an image descriptor with \fImio_openo\fR.  For example, given as input a bad
+pixel mask and a region mask, one could compute the mask specifying all pixels
+in the region mask but not in the bad pixel mask.  Any general mask may be
+computed in this way.
+
+An MIO application will not normally need to access the mask directly, but
+if such access is required the mask descriptor may be obtained with a call
+to \fImio_stati\fR to fetch the value of the parameter \fIP_PMDES\fR.
+Similarly, the image descriptor may be queried as parameter \fIP_IMDES\fR,
+and either parameter may be set with the corresponding call to \fImio_seti\fR.
+
+Successive calls to a get or put line segment procedure, e.g.,
+\fImio_glsegr\fR (get line segment real), return line segments from the data
+image until all the data present in the area outlined by the mask has been
+accessed, at which time EOF is returned as the function value.
+Each line segment is returned along with a vector \fIv\fR specifying the
+line of the image from which the segment is taken and the index of the first
+pixel of the current line segment within the line, a count \fInpix\fR of the
+number of pixels in the line segment, and the mask value \fImval\fR for the
+current line segment (e.g., 1 for a boolean mask).  Each line segment
+corresponds to a region of constant nonzero value (\fImval\fR) in the mask.
+Line segments are returned sequentially in storage order.
+
+By default, the entire region of the image visible through the mask will be
+accessed.  To access only a portion of the image, the \fIimio_setrange\fR
+procedure may be called before performing any i/o to specify the starting and
+ending vector coordinates \fIvs\fR and \fIve\fR of the region to be accessed.
+Multiple calls may be made on the same MIO descriptor to access multiple
+regions of the data image, or to "rewind" a given region of the image.
+
+.NH 2
+Mask Image Storage
+
+    As we shall see in the discussion of the pixel list package, the pixel
+list package is designed to permit a list to be stored anywhere, e.g.,
+in a binary file, in a database, as an array in an image header,
+or merely as a temporary array in memory.  When the new image structures
+become available storing the masks in the image header or in a global database
+will probably be the best approach, but in the meantime the simplest solution
+is to store each pixel list or mask in a small binary file.  This approach has
+the advantage of being independent of the particular image format used (none
+of which are currently capable of storing the pixel list directly in any case).
+
+If desired, the name of the mask file may be stored in the image header
+as a simple string valued parameter.  Alternatively, the mask name may be
+input as a parameter when a task is run.  A single mask may be associated
+with several images, or several masks may be used with the same image.
+The approach to be followed for a particular program is up to the programmer
+or package designer.
+
+The bad pixel mask is a special case, since it has a well defined logical
+meaning for an image, unlike the region masks which are application specific.
+The most straightforward approach is to use a single boolean mask for the
+bad pixel list, using the optional header keyword \fIBPM\fR to store the
+mask name, which should normally be the image name plus the pixel list file
+extension "\fI.pl\fR".  An integer BPM could also be used, but most applications
+would treat it as a boolean mask, treating any pixel with a nonzero value as
+a bad pixel.
+
+Any additional information required to describe the bad pixels is application
+specific, and may be stored in any of several ways, e.g., as a set of boolean
+masks, in an integer mask, using flag bits or reserved values to describe each
+pixel or region, in a separate fully populated weight image, or using the noise
+function package.  Most IRAF applications will probably use the BPM plus a
+noise function, with the noise function being stored either as
+a one-dimensional noise model or as a separate uncertainty image, transparently
+to the application.  The combination of a one-dimensional noise model plus a
+compressed bad pixel list should provide an efficient and flexible solution
+to the pixel variance problem for most applications.
+
+.NH 2
+Example
+
+    Open a data image and the associated mask image, and sum the pixels within
+the area indicated by the mask.
+
+.nf
+    include <pmset.h>
+
+    task    sum = t_sum
+.fi
+
+.tp 6
+.nf
+    # SUM -- Sum the image pixels lying within the given mask.
+
+    procedure t_sum()
+
+    char    image[SZ_FNAME]              # input data image
+    char    mask[SZ_FNAME]               # image mask
+
+    int     npix, mval, totpix, m_flags
+    long    v[PM_MAXDIM]
+    pointer im, mp, pp
+    real    sum
+
+    bool    clgetb()
+    real    asumr()
+    int     mio_glsegr()
+    pointer immap(), mio_open()
+
+    begin
+	    call clgstr ("image", image, SZ_FNAME)
+	    call clgstr ("mask", mask, SZ_FNAME)
+	    m_flags = 0
+	    if (clgetb ("invert"))
+		m_flags = INVERT_MASK
+
+	    im = immap (image, READ_ONLY, 0)
+	    mp = mio_open (mask, m_flags, im)
+
+	    sum = 0;  totpix = 0
+	    while (mio_glsegr (mp, pp, mval, v, npix) != EOF) {
+		sum = sum + asumr (Memr[pp], npix)
+		totpix = totpix + npix
+	    }
+
+	    call mio_close (mp)
+	    call imunmap (im)
+
+	    call printf ("%d pixels, sum=%g, mean=%g\n")
+		call pargi (totpix)
+		call pargr (sum)
+		if (totpix > 0)
+		    call pargr (sum / totpix)
+		else
+		    call pargr (INDEF)
+    end
+.fi
+
+A more complex application might use the spatial information provided by
+\fIv\fR and \fInpix\fR, or the flag values provided by \fImval\fR (for an
+integer mask).  For example, a surface fitting routine would accumulate each
+line segment into a least squares matrix, using the coordinate information
+provided as well as the pixel values.
+
+.NH 2
+The Pixel Mask Package (PMIO)
+
+    We have thus far discussed two quite different interfaces, i.e., the use
+of IMIO to do pixel i/o to a mask mapped as a virtual mask image, and the MIO
+interface, used to access the portion of a data image visible through a mask.
+The next step is to define the interface used to access the mask object
+directly as a \fImask\fR, independently of the use of masks for image i/o.
+
+.nf
+	    pm = pm_newmask (ref_im, depth)
+
+	       pm = pm_open (bufptr|NULL)
+	     pm = pm_create (naxes, axlen, depth)
+	    pm = pm_newcopy (pm)
+		   pm_close (pm)
+
+		pm_[sg]size (pm, naxes, alxen, depth)
+		    pm_seti (pm, param, value)
+	   value = pm_stati (pm, param)
+		   pm_debug (pm, outfd, maxcol, flags)
+	    bool = pm_empty (pm)
+		pm_compress (pm)
+		   pm_clear (pm)
+
+		    pm_load (pm, bufptr)
+	   nwords = pm_save (pm, bufptr, buflen)
+		   pm_loadf (pm, fname, title, maxch)
+		   pm_savef (pm, fname, title, save_flags)
+	   pm_[load|save]im (pm, imname[, save_flags])
+
+	    ptr = pm_access (pm, v)
+     bool = pm_linenotempty (pm, v)
+     bool = pm_sectnotempty (pm, vs, ve, ndim)
+	  pm[gp]l[lrp][sil] (pm, v, buf, b_depth, npix, rop)
+
+	  pm_[set|get]plane (pm, v)
+		   pm_point (pm, x, y, rop)
+		  pm_circle (pm, x, y, r, rop)
+		     pm_box (pm, x1,y1, x2,y2, rop)
+		    pm_line (pm, x1,y1, x2,y2, width, rop)
+		 pm_polygon (pm, x, y, npts, rop)
+
+		     pm_rop (pm_src, vs, pm_dst, vs, vn, rop)
+		 pm_stencil (pm_src, vs, pm_dst, vs, pm_stl, vs, vn, rop)
+.fi
+
+There are two variants on this lowest level interface, known as PMIO (pixel
+mask i/o) and PLIO (pixel list i/o).  These two interfaces are equivalent
+with one difference: PMIO can accept a reference image and inherit the section
+transformation of the reference image, allowing the mask to be accessed in
+the coordinate system of the reference image, while PLIO is a stand alone
+interface, implemented independently of IMIO without any ties to IMIO.
+PMIO is implemented as a thin layer upon PLIO, with ties to IMIO to access
+the section transformation for the reference image.
+
+The PMIO interface is shown in the figure above.
+With the exception of the additional routine \fIpm_newmask\fR, used to create
+a new, empty mask the same size as a reference image, the PMIO routines are
+identical to the corresponding PLIO routines except for the \fIpm\fR package
+prefix, and the implied section transformation.  Indeed, if no reference image
+is specified or if the section transformation is unitary (the reference image
+was opened without an image section), the two interfaces are identical.
+Hence the discussion of PLIO in the next section will serve to document PMIO
+as well.
+
+To use PMIO, merely include \fB<pmset.h>\fR rather than \fI<plset.h>\fR,
+and set the reference image with a call to \fIpm_seti\fR, e.g.,
+
+	call pm_seti (pm, P_REFIM, ref_im)
+
+This step can be skipped if \fIpm_newmask\fR or \fIpm_newcopy\fR is used to
+create a new mask, as the reference image will be inherited by the new mask.
+
+Programs which use PMIO to access a mask may also use the low level line,
+range, and pixel list routines discussed in section 3.1 (\fBpl_rangerop\fR etc.)
+on lists returned by PMIO, since PMIO will have already transformed the data
+into the coordinate system of the reference image.
+
+In general, the PMIO interface should be used in preference to PLIO whenever
+the mask to be accessed is logically associated with some data image or images.
+The region description and logical region processing capabilities of PLIO are
+very powerful in their own right, however, and PLIO should be used directly by
+applications which do not consider the mask to be merely an overlay for a data
+image.  An example would be any application which operates upon a 2-dimensional
+data structure other than an image (e.g., region filtering in the POE image
+kernel).
+
+.NH
+The Pixel List Package (PLIO)
+
+    A pixel list is a way of representing an N-dimensional image matrix which
+is well suited for applications where the represented image is sparse, or
+consists of a moderate number of arbitrarily shaped regions.  Routines are
+provided for creating new lists, for writing to or reading from lists,
+for storing or retrieving lists, and for performing various types of
+operations upon entire lists to make new lists.  The full set of routines
+in the package are summarized in the figure below.
+
+A pixel list, like an image, has a fixed dimensionality and size which is
+determined at list creation time for the lifetime of the list.  New lists
+are created with \fIpl_create\fR, which returns a pointer to an empty list.
+The \fIdepth\fR parameter specifies the depth of the list in bits, i.e.,
+the number of bits per pixel, in the range 1-27.  A boolean list has a depth
+of 1 bit.  In the current implementation the boolean mask is handled as a
+degenerate case of an integer mask, i.e., an integer mask which happens to
+have mask values in the range 0-1.
+
+An existing list is accessed by opening a descriptor with \fIpl_open\fR and
+loading the list into the runtime descriptor structure, either by specifying
+a non-NULL buffer pointer \fIbufptr\fR, or by calling one of the \fIpl_load\fR
+functions after opening a null descriptor.
+
+.ks
+.nf
+	       pl = pl_open (bufptr|NULL)
+	     pl = pl_create (naxes, axlen, depth)
+	    pl = pl_newcopy (pl)
+		   pl_close (pl)
+
+		pl_[sg]size (pl, naxes, axlen, depth)
+		    pl_seti (pl, param, value)
+	   value = pl_stati (pl, param)
+		   pl_debug (pl, outfd, maxcol, flags)
+	    bool = pl_empty (pl)
+		pl_compress (pl)
+		   pl_clear (pl)
+
+		    pl_load (pl, bufptr)
+	   nwords = pl_save (pl, bufptr, buflen)
+		   pl_loadf (pl, fname, title, maxch)
+		   pl_savef (pl, fname, title, save_flags)
+	   pl_[load|save]im (pl, imname[, save_flags])
+
+	    ptr = pl_access (pl, v)
+     bool = pl_linenotempty (pl, v)
+     bool = pl_sectnotempty (pl, vs, ve, ndim)
+	  pl[gp]l[lrp][sil] (pl, v, buf, b_depth, npix, rop)
+
+	  pl_[set|get]plane (pl, v)
+		   pl_point (pl, x, y, rop)
+		  pl_circle (pl, x, y, r, rop)
+		     pl_box (pl, x1,y1, x2,y2, rop)
+		    pl_line (pl, x1,y1, x2,y2, width, rop)
+		 pl_polygon (pl, x, y, npts, rop)
+
+		     pl_rop (pl_src, vs, pl_dst, vs, vn, rop)
+		 pl_stencil (pl_src, vs, pl_dst, vs, pl_stl, vs, vn, rop)
+.fi
+.ke
+
+Pixel lists are stored externally as opaque binary byte arrays.
+The function \fIpl_save\fR will encode a pixel list as a byte array and store
+it in the indicated buffer, resizing the buffer if necessary.
+If \fIbufptr\fR is NULL a new buffer will be allocated, overwriting the NULL.
+The \fIpl_load\fR function performs the inverse function.
+The \fIf\fR suffixed functions are provided for convenience when storing
+lists in small binary files.  The \fIim\fR suffixed functions create masks
+out of actual data images, and vice versa.  In the most general case, a list
+is encoded into an array in memory and then stored away by the applications
+wherever they wish, e.g., as an array parameter in an image header when the
+new image structures become available.
+
+Pixel list i/o is provided via the \fIpl[gp]l[lrp][sil]\fR family of functions,
+which read, write, or edit (via the \fIrop\fR) lines or line segments of masks.
+The naming convention is as follows:
+
+.ks
+.nf
+	 pl		package prefix
+	[gp]		get or put
+	 l		line segment
+	[lrp]		as a line list, range list, or pixel array
+	[sil]		in an array of type short, int, or long
+.fi
+.ke
+
+For example, \fIplglps\fR would get a line from a mask image as a fully
+populated array of type short.  For maximum efficiency, since this is a low
+level interface, the data is read from or copied into a user allocated buffer,
+rather than having the pixel list package control the buffer.
+
+The functions \fIplgll[sil]\fR return the packed line list for the indicated
+line or line segment.  This is the copy-out form of access with the least
+overhead, but requires that the application have knowledge of the internal
+line list format.
+
+Alternatively, if it is only desired to read from a list, accessing the list
+in the internal format, the internal list for an image line may be directly
+accessed by pointer with the \fIpl_access\fR function.  This is the most
+efficient form of access.  The variant \fIpl_linenotempty\fR is similar except
+that the NULL pointer is returned if the indicated line of the list is empty,
+providing an efficient and convenient way to perform the empty test on mask
+image lines.
+
+The functions \fIplglr[sil]\fR are similar to the get line list form of access,
+but instead of returning the encoded list-list in the internal format,
+it returns a simple array of ranges of absolute pixel indices and associated
+mask values.  This is the recommended way of accessing the mask as a list
+structured object, since it does not require knowledge of the internal packed
+line list format.  For example, to print line \fIv\fR of the mask on descriptor
+\fIpl\fR as a series of range lists:
+
+.ks
+.nf
+	int	buf[3,1024], n, i, plglri()
+
+	n = plglri (pl, v, buf, 0, axlen[1], 0)
+	do i = 1, n {
+	    call printf ("range at %d, %d pixels, mask value = %o\n")
+		call pargi (buf[1,i]);  call pargi (buf[2,i])
+		call pargi (buf[3,i])
+	}
+.fi
+.ke
+
+These routines require that the depth in bits of the output line or range
+list or pixel array be specified.  This is necessary to avoid generating
+numbers the size of the machine integer when inverting a mask (PIX_NOT),
+e.g., if the mask depth is 8 bits, the complement of a 0 pixel should be 377,
+not 37777777777.  The depth argument may also be used to convert an integer
+mask to a boolean mask, or vice versa (using the PIX_VALUE field of the
+rasterop discussed in the next section).  If \fIb_value\fR is zero, clipping
+of the output values is disabled.  This would be appropriate, for example,
+when simply reading from a mask without modifying the pixel values.
+
+New pixel lists may be created by having the application prepare the packed
+line lists externally, inserting them directly into the pixel list structure
+with a \fIput\fR routine.  This is generally inadvisable, however, because
+the packed line list format is considered internal to the PLIO package.
+A better alternative is to input the mask data as a populated array or
+as a range list, letting the PL package manage the internal line list.
+
+A more convenient approach to creating or modifying masks for most applications
+is to define the mask by specifying a series of include and exclude standard
+region types (circles, boxes, lines, points, or polygons),
+using the block of routines beginning with \fIpl_setplane\fR in the figure.
+Note that these are two dimensional
+operators; they are provided for convenience even though the pixel list
+package can support images of any dimension (if the image has three or more
+dimensions \fIpl_setplane\fR may be used to specify the plane to be operated
+upon).  The most general routine is \fIpl_polygon\fR, which may be used to
+operate upon the pixels in the interior of any general polygon.  All of the
+region drawing operators will permit regions to extend beyond the boundary
+of the mask, clipping as necessary at the boundary.
+
+.NH 2
+Pixel, Line, and Range List Routines
+
+    Most of the N dimensional region or mask oriented PMIO and PLIO routines
+eventually result in calls to the low level pixel, line, and range rasterop
+routines and format conversion routines shown in the figure below.  These
+routines form the functional core of the PLIO package and will often be
+responsible for most of the execution time of routines which use PLIO.
+
+There are two main classes of routines.  The \fIpl_pixrop\fR, \fIpl_linerop\fR,
+and \fIpl_rangerop\fR routines perform the general raster operation on pixel
+arrays, line lists, and range lists.  The \fIpl_linestencil\fR routine performs
+the stencil rasterop operation upon line lists; currently only a list list
+version is available since this is a rarely used routine.  Lastly, a set of
+six routines are provided for converting between any two of the three formats,
+e.g., line list to range list or pixel array and vice versa, omitting the
+like-to-like conversions.  For example, \fIpl_p2ri\fR would convert a pixel
+array to a range list, both of type integer.
+
+.ks
+.nf
+		 pl_linerop (ll_src, xs, src_maxval,
+			     ll_dst, ds, dst_maxval, ll_out, npix, rop)
+	     pl_linestencil (ll_src, xs, src_maxval, ll_dst, ds, dst_maxval,
+			     ll_stn, xs, ll_out, npix, rop)
+
+	     pl_pixrop[sil] (px_src, xs, src_maxval,
+			     px_dst, ds, dst_maxval, npix, rop)
+	   pl_rangerop[sil] (rl_src, xs, src_maxval,
+			     rl_dst, ds, dst_maxval, rl_out, npix, rop)
+
+    n = pl_[lrp]2[lrp][sil] (op_src, xs, op_dst, npix)
+.fi
+.ke
+
+Note that these low level routines
+specify the mask depth as a maximum pixel value, rather than taking the depth
+in bits as the high level PMIO and PLIO routines do, and that there are no
+\fI"pm_"\fR versions of these routines - the one set of routines may be used
+with both PLIO and PMIO.
+
+.NH 2
+Rasterops
+
+    The argument \fIrop\fR in the circle, box, and other routines discussed
+in the previous sections is called a \fBrasterop\fR, and specifies the bitwise
+operation to be performed to generate the destination operand.  Much of the
+generality and conciseness of the pixel list package is due to the rasterop
+abstraction, which is patterned after a similar construct used by the Sun
+Microsystems \fISunview\fR interface to specify operations upon \fIpixrects\fR,
+which are logically similar to PLIO masks.
+
+The rasterop defines the operation to be performed to generate the destination
+mask, in terms of bitwise boolean operations performed upon the input source
+and destination masks.  Rasterops are constructed via a series of bitwise
+\fIand\fR and \fIor\fR operations, using the following macro defines:
+
+.ks
+.nf
+	PIX_SRC			  specifies the source mask
+	PIX_DST			  specifies the destination mask
+	PIX_NOT(op)		  inverts the operand mask
+	PIX_VALUE(value)	  specifies the bitplanes to be set
+.fi
+.ke
+
+Examples of some of the possible operations (out of a total of 16 possible
+operations) are shown below.  This table is reproduced from the SunView
+Pixrect Reference Manual.
+
+.ks
+.nf
+	     \fIRasterop\fR			     \fIDescription\fR
+
+	PIX_SRC			  copy source to destination
+	PIX_DST			  no-op
+	PIX_SRC | PIX_DST	  paint (OR source to destination)
+	PIX_SRC & PIX_DST	  mask (AND of source and destination)
+	PIX_NOT(PIX_SRC)&PIX_DST  erase (AND destination with negation
+				    of source)
+	PIX_NOT(PIX_DST)	  invert area (negate the existing
+				    values)
+	PIX_SRC ^ PIX_DST	  inverting paint (XOR of source and
+				    destination)
+.fi
+.ke
+
+Here, the |&^ denote the SPP \fIor\fR, \fIand\fR, and \fIxor\fR intrinsic
+functions, which must be used to construct actual rasterop expressions in SPP,
+e.g.:
+
+	PIX_NOT(PIX_SRC) | PIX_DST | PIX_VALUE(v)
+
+would actually be written as
+
+	or (PIX_NOT(PIX_SRC), PIX_DST) + PIX_VALUE(v)
+
+The following additional macros are defined to deal with the more common
+cases of setting or clearing a region.
+
+.ks
+.nf
+	PIX_SET			  (PIX_SRC | PIX_NOT(PIX_SRC))
+	PIX_CLR			  (PIX_SRC & PIX_NOT(PIX_SRC))
+.fi
+.ke
+
+As a simple example, consider the case of specifying a region mask as a series
+of include and exclude circles and boxes.  This is trivial for a boolean mask:
+an include circle or box is specified by the rasterop PIX_SET, and an exclude
+by PIX_CLR.  In the equivalent operation upon an integer mask this would cause
+any mask values which had already been set to be replaced, hence it might be
+desirable to use a PIX_SRC|PIX_DST rasterop instead, to OR the bits of the new
+flag values into those of any flag values already set.  Similarly, when using
+\fIpl_ltop\fR to unpack a line list into a pixel array, the PIX_SRC|PIX_DST
+rasterop might be specified to OR the mask segment into an existing pixel
+array.
+
+General bitwise boolean operations upon masks are provided by the \fIpl_rop\fR
+and \fIpl_stencil\fR operators, which operate upon entire masks or rectangular
+subregions of masks.  The \fIpl_rop\fR operator combines the source and
+destination masks to produce a new mask; \fIpl_stencil\fR performs the same
+operation, but only in the regions specified by the stencil mask,
+which must be a boolean mask.  The input mask may be NULL (depending upon
+the rasterop specified), or the source and destination masks may be the same.
+
+The equivalent operators for line lists, range lists, and pixel arrays are
+the \fIpl_S2D\fR family of routines, where \fIS=D=[lrp]\fR for a line list,
+range list, or pixel array rop.  The routine \fIpl_linestencil\fR implements
+the stencil operation for a line list.
+
+As noted above, when operating upon integer masks (\fIdepth\fR > 1), the
+PIX_VALUE macro is used to specify the flag value for the indicated region.
+For example, the following rasterop would set all the pixels in a region to
+the same value:
+
+	PIX_VALUE(value)
+
+to OR in the new value instead of replacing any existing flag values:
+
+	PIX_VALUE(value) | PIX_DST
+
+If a boolean mask is to be written to an integer mask, PIX_VALUE specifies
+the flag value to be used for the regions set to 1 in the input boolean mask.
+For example, one might wish to combine a set of 8 boolean masks to form a
+single 8 bit deep integer mask, with each bit in the integer mask corresponding
+to one of the input boolean masks (001 = mask 1, 002 = mask 2, 040 = mask 3,
+etc.).  This could be done using the rasterop shown above, incrementing
+PIX_VALUE in each operation to specify the bitplane to be set.
+
+.NH 3
+Rasterop Expression Evaluation
+
+    As mentioned above, there are sixteen possible ways to combine the source
+and destination masks subject to the four possible boolean operations
+(\fIand\fR, \fIor\fR, \fIxor\fR, and \fInot\fR).
+More precisely, although numerous bitwise expressions can be constructed, many
+of these are equivalent, and there are only sixteen fundamental operations.
+These are summarized in the following table.
+
+.nf
+		Operation			      Opcode
+
+	PIX_CLR 		      			00
+	PIX_SET						17
+
+	PIX_SRC						14
+	PIX_DST						12
+
+	PIX_NOT(PIX_SRC)				03
+	PIX_NOT(PIX_DST)				05
+
+	PIX_SRC & PIX_DST				10
+	PIX_SRC | PIX_DST				16
+	PIX_SRC ^ PIX_DST				06
+
+	PIX_SRC & PIX_NOT(PIX_DST)			04
+	PIX_SRC | PIX_NOT(PIX_DST)			15
+	PIX_NOT(PIX_SRC) & PIX_DST			02
+	PIX_NOT(PIX_SRC) | PIX_DST			13
+
+	PIX_NOT (PIX_SRC & PIX_DST)			07
+	PIX_NOT (PIX_SRC | PIX_DST)			01
+	PIX_NOT (PIX_SRC ^ PIX_DST)			11
+.fi
+
+As an example of the redundancy of arbitrary rasterop expressions,
+compare the following with the equivalent expressions (same opcode)
+in the table above.
+
+.ks
+.nf
+	PIX_NOT(PIX_SRC) & PIX_NOT(PIX_DST)		01
+	PIX_NOT(PIX_SRC) ^ PIX_NOT(PIX_DST)		06
+	PIX_NOT(PIX_SRC) | PIX_NOT(PIX_DST)		07
+	PIX_NOT(PIX_SRC) ^ PIX_DST			11
+	PIX_SRC ^ PIX_NOT(PIX_DST)			11
+.fi
+.ke
+
+Any number of additional logically redundant expressions may be constructed.
+The programmer should not worry about simplifying logical expressions,
+but should choose instead whatever expression is clearest for their particular
+application, letting the interface handle expression optimization internally.
+
+Of the sixteen possible fundamental operations, there are four trivial
+operations (\fIclr\fR, \fIset\fR, \fIsrc\fR, \fIdst\fR),
+seven composite operations, and four primary operations, namely,
+\fIand\fR, \fIor\fR, \fIxor\fR, and \fInot\fR (two cases of the latter).
+The composite operations are all implementable as two primary
+operations in sequence.  PIX_NOT is implemented by actual inversion of the
+list rather than as a mode flag, to avoid complications when the list is read.
+
+.NH 3
+Rasterop Encoding
+
+    The rasterop argument specifies the bitwise boolean operation to be
+performed, and optionally the pixel value to be used (in the case of an
+integer mask).  Both are specified as a single integer value, packed as
+shown in the figure below.
+
+.ks
+.nf
+	+--+-------------+--------+
+	|32|31          5|4      1|
+	+--+-------------+--------+
+	|  | pixel value | opcode |
+	+--+----------------------+
+.fi
+.ke
+
+The following is an example of a typical rasterop (note that since the pixel
+value field has a reserved range of bits which is zero prior to expression
+evaluation, the "+" operator is equivalent to the \fIor\fR intrinsic function).
+
+	or(PIX_SRC, PIX_NOT(PIX_DST)) + PIX_VALUE(pix_value)
+
+Note that the width of the pixel value field in the rasterop constrains the
+effective mask depth to be 27 bits or less, if full generality is desired in
+rasterop operations.  Masks of up to 31 bits (the minimum unsigned precision
+of a \fIlong\fR) can be stored and accessed, but rasterops using PIX_VALUE
+are limited to 27 bits.
+
+.NH 2
+Pixel List Data Structures
+
+    A pixel list consists of an array of pointers to the \fIline lists\fR
+forming the mask.  There is one pointer for each image line; if the pointer
+is NULL, no mask values are set on the associated image line.  N-dimensional
+images are easily handled by an N-1 dimensional array of line pointers.
+
+Each line list consists of a series of offsets and mask pixel values
+(the pixel values are normally omitted for a boolean mask).
+The offsets specify the number of pixels for which the mask has the same value.
+This line list format has the following two significant advantages over the
+alternative technique of specifying a list of ranges using absolute pixel
+coordinates:
+.ls
+.ls [1]
+A higher degree of data compression is possible.  If absolute pixel
+coordinates are used in the list, the list must be an array of 32 bit
+integer values in order to avoid a builtin limit on the size of the image
+which can be represented.  By using offsets, list elements as small as
+one byte are possible.
+.le
+.ls [2]
+A list composed of offsets is invariant with respect to translation.
+For example, when extracting a subraster of an image, one can extract the
+corresponding segment of each line list and perhaps edit the first element,
+and the remainder of the list may be used without change.
+.le
+.le
+
+When describing regular regions such as boxes it will often be the case that
+successive lines of the mask are equivalent, in which case multiple line list
+pointers may point to the same line list.  Hence, the line lists will provide
+good compression of regular objects in any two dimensional plane of the mask.
+This technique can be extended to higher dimensions if desirable, without
+affecting the line list data structures visible to an application.
+
+.NH 3
+Line List Encoding
+
+    A good compromise between storage efficiency and efficiency of runtime
+access, while keeping things simple, is achieved if we maintain the compressed
+line lists as variable length arrays of type short integer (16 bits per list
+element), regardless of the mask depth.  A line list consists of a series of
+simple \fIinstructions\fR which are executed in sequence to reconstruct a line
+of the mask.  Each 16 bit instruction consists of the sign bit (not used at
+present), a three bit \fIopcode\fR, and twelve bits of data, i.e.:
+
+.ks
+.nf
+	+--+-----------+-----------------------------+
+	|16|15       13|12                          1|
+	+--+-----------+-----------------------------+
+	|  |   opcode  |            data             |
+	+--+-----------------------------------------+
+.fi
+.ke
+
+The significance of the data depends upon the instruction.  The instructions
+currently implemented are summarized in the table below.
+
+.ks
+.nf
+     Instruction     Opcode           Description
+
+        ZN            00 	Output N zeros
+        HN            04 	Output N high values
+        PN            05 	Output N-1 zeros plus one high value
+	SH	      01	Set high value, absolute
+        IH,DH         02,03	Increment or decrement high value
+        IS,DS         06,07	Like IH-DH, plus output one high value
+.fi
+.ke
+
+In order to reconstruct a mask line, the application executing these
+instructions is required to keep track of two values,
+the \fIcurrent high value\fR and the \fIcurrent position\fR in the output line.
+The detailed operation of each instruction is as follows:
+.ls 4
+.ls 8 ZN
+Zero the next N (=\fIdata\fR) output pixels.
+.le
+.ls HN
+Set the next N output pixels to the current high value.
+.le
+.ls PN
+Zero the next N-1 output pixels, and set pixel N to the current high value.
+.le
+.ls SH
+Set the high value (absolute rather than incremental), taking the high 15 bits
+from the next word in the instruction stream, and the low 12 bits from the
+current data value.
+.le
+.ls IH,DH
+Increment (IH) or decrement (DH) the current high value by the \fIdata\fR
+value.  The current position is not affected.
+.le
+.ls IS,DS
+Increment (IS) or decrement (DS) the current high value by the \fIdata\fR
+value, and \fIstep\fR, i.e., output one high value.
+.le
+.le
+
+The high value is assumed to be set to 1 at the beginning of a line, hence
+the IH,DH and IS,DS instructions are not normally needed for boolean masks.
+If the length of a line segment of constant value or the difference between
+two successive high values exceeds 4096 (12 bits), then multiple instructions
+are required to describe the segment or intensity change.
+
+The performance of this encoding is very good for typical masks consisting
+of isolated high or low values or extended regions at the same level.
+The worst case performance occurs when successive pixels have different values.
+Even in this case the encoding will only require one word (16 bits) per mask
+pixel, provided either the delta intensity change between pixels is usually
+less than 12 bits, or the mask represents a zero floored step function of
+constant height.  The worst case cannot exceed npix*2 words provided the mask
+depth is 24 bits or less.
+
+.NH 3
+Example: Line List Encoding
+
+    As a simple example, consider the following line of a boolean mask.
+The set pixels are 1, 4, 8 through 11, and so on, shown as \fIindex list\fR
+in the figure.  The corresponding \fIoffset list\fR (line list encoding)
+is also shown.  Note that both encodings require the same amount of space,
+assuming 16 bits per list element in both cases; the index list would require
+twice as much space if 32 bit list elements were used.
+
+.ks
+.nf
+	Index list:	1, 4, 8-11, 15, 23-39		7 words
+	Offset list:	P1 P3 Z3 H4 P4 Z7 H17		7 words
+
+	Inverted I-L:	2-3, 5-7, 12-14, 16-22		8 words
+	Inverted O-L:	Z1 H2 Z1 H3 Z4 H3 Z1 H7		8 words
+.fi
+.ke
+
+The bottom half of the figure shows the encodings for the inverted lists,
+i.e., the lists which would be produced by a PIX_NOT rasterop operation.
+Since both encodings reflect only the points in a line where level changes
+occur, the information content and list size of the normal and inverted
+lists are comparable.  The encoding for an integer mask would be equivalent
+except for the addition of occasional SH or SL instructions to set the high
+value.
+
+.NH 3
+Line List Structure
+
+    The full line list structure consists of a header describing the line
+list entry in the PLIO descriptor, plus the LL encoding of the line, as
+illustrated below.  This information is internal to the PLIO package and
+should not be used in applications code.  [The LL header was generalized
+in Aug2000 to permit larger masks; see plio.h]
+
+.ks
+.nf
+	define	LL_START	4
+	struct linelist {
+		short	nref		# number of lines pointing here
+		short	blen		# length of buffer containing list
+		short	len		# encoded linelist length, words
+		short	ll[]		# encoded pixel data
+	}
+.fi
+.ke
+
+The linelist encoding includes any trailing zeros, i.e., executing of the
+encoded instructions will regenerate the entire mask line.
+
+.NH 3
+Range List Structure
+
+    The range list structure provides applications programs with a list
+representation of a mask, for cases where it would be inefficient or
+inconvenient to access the mask as a pixel array.  Range lists are not
+used to store masks in external storage, hence data compression is not an
+issue, nor is machine independence.
+
+.ks
+.nf
+	rtype = short|int|long
+	struct rangelist {
+		rtype	x		# x coordinate of first pixel
+		rtype	n		# number of pixels in range
+		rtype	v		# pixel value
+	}
+
+	int	rl[3,ARB]		# typical range list array decl
+.fi
+.ke
+
+The range list structure is defined in <plset.h>, e.g. (refer to the actual
+file for more reliable documentation for these definitions):
+
+.ks
+.nf
+	RL_FIRST	# first data range entry in list
+	RL_LENELEM	# size of each element of list (i.e., 3)
+	RL_MAXLEN	# maximum range list length (arg=pl)
+
+	RL_LEN		# physical length of range list	(RL_LEN(rl))
+	RL_AXLEN	# length of mask image line (RL_AXLEN(rl))
+	RLI_LEN		# RL_LEN for rl = ptr to int
+	RLI_AXLEN	# RL_AXLEN  "     "     "
+	RLS_LEN		# RL_LEN for rl = ptr to int
+	RLS_AXLEN	# RL_AXLEN  "     "     "
+
+	RL_X		# use as RL_X(rl,i), rl = range list array
+	RL_N		# Npix field of range list array element
+	RL_V		# Value field of range list array element
+
+	RL_XOFF		# offset of xstart field 
+	RL_NOFF		# offset of npix field
+	RL_VOFF		# offset of value field
+.fi
+.ke
+
+The range list is represented as a simple two dimensional integer or
+short integer array.  The first line of the two dimensional array is
+used as the \fBrange list header\fR, and is used to store the \fIlen\fR
+and \fIaxlen\fR parameters describing the encoded mask line.  Each
+subsequent entry defines a range \fInpix\fR of mask image pixels,
+starting at pixel \fIx\fR (absolute pixel coordinates), all of which
+have the value \fIvalue\fR.  Only nonzero ranges are stored.
+Note that the \fIlen\fR field defines the entire length of the structure,
+including the header range and data ranges.
+
+.NH 3
+Example: A Small Mask
+
+    A complete example of a small mask (75 columns by 40 lines) is shown below.
+This mask and the sample output were prepared by the PLIO debug interpreter,
+file \fIzzdebug.x\fR in the PLIO source directory.
+
+.nf
+40 .1111111..............................................................22222
+39 .1111111..............................................................22222
+38 .1111111...............................................................2222
+37 .1111111...............................................................2222
+36 .1111111............................................................4......
+35 .1111111.....................11111111111111111111111111...........4444.....
+34 .1111111.....................11111111111111111111111111........44444444....
+33 .1111111......................1111111111111111111111111......44444444......
+32 .1111111......................1111111111111111111111111...44444444.........
+31 .1111111......................1111111111111111111111111.44444444...........
+30 .1111111...........4..........1111111111111111111111115444444..............
+29 .1111111...........4..........11111111111111111111155554444................
+28 .1111111...........4..........111111111111111111155555544..................
+27 .1111111...........4..........1111111111111111555555551....................
+26 .1111111.....................11111111111111155555555111....................
+25 .1111111.....................11111111111115555555111111....................
+24 ............................1111111111155444444.1111111....................
+23 ...........................111111111155544444....111111....................
+22 ..............1...........1111111155555444........11111....................
+21 ........................1111111155555554..........11111....................
+20 ........................111111555555511...........11111....................
+19 ........................111555555551111...........11111....................
+18 ........................155555555111111...........11111....................
+17 ......................445555551111111111.........111111....................
+16 ....................444455551111111111111.......1111111....................
+15 ..................4444445111111111111111111111111111111....................
+14 ...............44444444.1111111111111111111111111111111....................
+13 .............44444444......................................................
+12 ..........44444444.........................................................
+11 ........44444444...........................................................
+10 .........4444........................22222.................................
+ 9 ..........4.........................2222222..............22222.............
+ 8 ....................................2222222.............2222222............
+ 7 ....................................2222222.............2222222............
+ 6 .....................................22222..............2222222............
+ 5 11111111111111111111.....................................22222.............
+ 4 11111111111111111111.......................................................
+ 3 11111111111111111111.......................................................
+ 2 11111111111111111111.......................................................
+ 1 11111111111111111111.......................................................
+   123456789012345678901234567890123456789012345678901234567890123456789012345
+            1         2         3         4         5         6         7     
+.fi
+
+This first figure shows the mask itself, output graphically as a character
+matrix.  This is an integer mask wherein the integer value of each pixel is
+the ASCII value of the character shown.  The mask was created by \fIor\fR-in
+a number of regions together, using a different mask value for each region.
+The result in areas where the regions intersect is a new mask pixel value.
+
+The figure below shows the internal data structures used to represent the
+previous mask.  Both the line list and range list representations of the
+mask are shown.  The size of the packed line list is 582 words, 189 of which
+are free (no longer used due to updates), hence the packed line list size
+would be 393 words following a call to \fIpl_compress\fR to compress the mask.
+
+.nf
+    Mask 1EECD naxes=2 [75,40] maxval=177 plane=[75,40]
+    max buffered line size 1024, max actual line size 16
+    40 lines total, 40 are nonempty, mask is nonempty
+    llbp=42AF5, len=1190, op=583, free=189, nupdates=35
+
+    Index at 1EFF1 containing 40 lines:
+	 4     4     4     4    17    26    35    35   166   177   187
+       194   201   208   218   228   241   254   266   554   292   568
+       319   333   347   360   492   507   523   539   423   435   447
+       459   471   483   148   148   157   157
+
+    Line list containing 40 lines:
+    [1:4]      IH48(49) H20 Z55 (75,49)
+    [5]        IH48(49) H20 IH1(50) Z37 H5 Z13 (75,50)
+    [6]        IH49(50) Z37 H5 Z14 H7 Z12 (75,50)
+    [7:8]      IH49(50) Z36 H7 Z13 H7 Z12 (75,50)
+    [9]        IH51(52) P11 DH2(50) Z25 H7 Z14 H5 Z13 (75,50)
+    [10]       IH51(52) Z9 H4 DH2(50) Z24 H5 Z33 (75,50)
+    [11]       IH51(52) Z8 H8 Z59 (75,52)
+    [12]       IH51(52) Z10 H8 Z57 (75,52)
+    [13]       IH51(52) Z13 H8 Z54 (75,52)
+    [14]       IH51(52) Z15 H8 DH3(49) Z1 H31 Z20 (75,49)
+    [15]       IH51(52) Z18 H6 IS1(53) DH4(49) H30 Z20 (75,49)
+    [16]       IH51(52) Z20 H4 IH1(53) H4 DH4(49) H13 Z7 H7 Z20 (75,49)
+    [17]       IH51(52) Z22 H2 IH1(53) H6 DH4(49) H10 Z9 H6 Z20 (75,49)
+    [18]       IH48(49) P25 IH4(53) H8 DH4(49) H6 Z11 H5 Z20 (75,49)
+    [19]       IH48(49) Z24 H3 IH4(53) H8 DH4(49) H4 Z11 H5 Z20 (75,49)
+    [20]       IH48(49) Z24 H6 IH4(53) H7 DH4(49) H2 Z11 H5 Z20 (75,49)
+    [21]       IH48(49) Z24 H8 IH4(53) H7 DS1(52) DH3(49) Z10 H5 Z20
+	       (75,49)
+    [22]       IH48(49) P15 Z11 H8 IH4(53) H5 DH1(52) H3 DH3(49) Z8 H5
+	       Z20 (75,49)
+    [23]       IH48(49) Z27 H10 IH4(53) H3 DH1(52) H5 DH3(49) Z4 H6 Z20
+	       (75,49)
+    [24]       IH48(49) Z28 H11 IH4(53) H2 DH1(52) H6 DH3(49) Z1 H7 Z20
+	       (75,49)
+    [25]       IH48(49) Z1 H7 Z21 H13 IH4(53) H7 DH4(49) H6 Z20 (75,49)
+    [26]       IH48(49) Z1 H7 Z21 H15 IH4(53) H8 DH4(49) H3 Z20 (75,49)
+    [27]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H16 IH4(53) H8
+	       DS4(49) Z20 (75,49)
+    [28]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H19 IH4(53) H6
+	       DH1(52) H2 Z18 (75,52)
+    [29]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H21 IH4(53) H4
+	       DH1(52) H4 Z16 (75,52)
+    [30]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H24 IS4(53)
+	       DH1(52) H6 Z14 (75,52)
+    [31]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z1 H8 Z11 (75,52)
+    [32]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z3 H8 Z9 (75,52)
+    [33]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z6 H8 Z6 (75,52)
+    [34]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z8 H8 Z4 (75,52)
+    [35]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z11 H4 Z5 (75,52)
+    [36]       IH48(49) Z1 H7 IH3(52) P61 Z6 (75,52)
+    [37:38]    IH48(49) Z1 H7 IH1(50) Z63 H4 (75,50)
+    [39:40]    IH48(49) Z1 H7 IH1(50) Z62 H5 (75,50)
+
+    Line list containing 40 lines:
+    [1:4]      1-20(49)
+    [5]        1-20(49) 58-62(50)
+    [6]        38-42(50) 57-63(50)
+    [7:8]      37-43(50) 57-63(50)
+    [9]        11(52) 37-43(50) 58-62(50)
+    [10]       10-13(52) 38-42(50)
+    [11]       9-16(52)
+    [12]       11-18(52)
+    [13]       14-21(52)
+    [14]       16-23(52) 25-55(49)
+    [15]       19-24(52) 25(53) 26-55(49)
+    [16]       21-24(52) 25-28(53) 29-41(49) 49-55(49)
+    [17]       23-24(52) 25-30(53) 31-40(49) 50-55(49)
+    [18]       25(49) 26-33(53) 34-39(49) 51-55(49)
+    [19]       25-27(49) 28-35(53) 36-39(49) 51-55(49)
+    [20]       25-30(49) 31-37(53) 38-39(49) 51-55(49)
+    [21]       25-32(49) 33-39(53) 40(52) 51-55(49)
+    [22]       15(49) 27-34(49) 35-39(53) 40-42(52) 51-55(49)
+    [23]       28-37(49) 38-40(53) 41-45(52) 50-55(49)
+    [24]       29-39(49) 40-41(53) 42-47(52) 49-55(49)
+    [25]       2-8(49) 30-42(49) 43-49(53) 50-55(49)
+    [26]       2-8(49) 30-44(49) 45-52(53) 53-55(49)
+    [27]       2-8(49) 20(52) 31-46(49) 47-54(53) 55(49)
+    [28]       2-8(49) 20(52) 31-49(49) 50-55(53) 56-57(52)
+    [29]       2-8(49) 20(52) 31-51(49) 52-55(53) 56-59(52)
+    [30]       2-8(49) 20(52) 31-54(49) 55(53) 56-61(52)
+    [31]       2-8(49) 31-55(49) 57-64(52)
+    [32]       2-8(49) 31-55(49) 59-66(52)
+    [33]       2-8(49) 31-55(49) 62-69(52)
+    [34]       2-8(49) 30-55(49) 64-71(52)
+    [35]       2-8(49) 30-55(49) 67-70(52)
+    [36]       2-8(49) 69(52)
+    [37:38]    2-8(49) 72-75(50)
+    [39:40]    2-8(49) 71-75(50)
+.fi
+
+The line list and range list tables shown consist of two columns, the first
+listing the range of mask lines pointing to the line or range list shown to
+the right (a sequence of identical mask lines will point to the same encoded
+line list).  Each instruction which changes the mask pixel value is followed
+by the new current mask value in parenthesis.  Zero ranges are omitted in
+the range list format.  The "pl_circle" regions appear as ellipses since
+a printed character does not have a unit aspect ratio.
+
+.NH 3
+Pixel List Descriptor
+
+    For runtime access to a mask we require, for an N dimensional mask, an
+N-1 dimensional array of line list pointers, plus the line lists themselves.
+Multiple line list pointers may point to the same encoded line list.
+All line pointers are valid at all times, i.e., NULL pointers are not
+permitted, even for empty mask lines.  Initially, all line pointers will
+point to the same entry, the encoded line list representation of an empty
+line, i.e., a line of zeros (i.e., the single instruction ZN where N=axlen[1]).
+
+.ks
+.nf
+	struct pldes {
+		int	pl_magic	# magic / version no.
+		int	pl_private1	# used by PMIO (ref_im)
+		int	pl_private2	# used by PMIO (mapxy flag)
+		int	pl_maxline	# max encoded line lentgh
+		int	pl_maxval	# mask depth as max pixel value
+		int	pl_naxes	# number of axes
+		int	pl_axlen[7]	# axis lengths
+		int	pl_plane[7]	# current plane for pl_setplane
+		int	pl_llbp		# line list bufptr
+		int	pl_llop		# next location in llbuf
+		int	pl_lllen	# current llbuf length
+		int	pl_llfree	# amount of free space in list
+		int	pl_llnupdates	# line list has been modified
+		int	pl_llinc	# llbuf increment on overflow
+		int	pl_nlp		# number of line pointers
+		int	pl_lp[]		# array of line pointers
+	}
+.fi
+.ke
+
+The main descriptor, which is a dynamically allocated data structure, is a
+fixed size descriptor, the size of which depends upon the dimensionality and
+size of the mask.  A single additional dynamically allocated buffer of type
+\fIshort\fR is used to store the encoded line lists.  The size of this buffer
+may vary at runtime as the mask is edited.  New line lists, or edited line
+lists which increase in size, are inserted at the end of the buffer.
+As existing line lists are freed a count of the amount of free space is
+kept in \fIpl_llfree\fR.  If the percent of free space reaches a predetermined
+level garbage collection is possible by copying the list, otherwise the line
+list buffer is reallocated to increase its size.  The line pointers \fIpl_lp\fR
+are actually offsets into \fIllbuf\fR, rather than true pointers.
+
+.NH 3
+External Storage Format
+
+    A mask is stored externally as a variable length array of 32 bit MII
+integers (the stored mask header) followed by two variable length arrays of
+16 bit MII integers, packed in the following format:
+
+.ks
+.nf
+	struct pl_extern {
+		int	ple_magic	# magic / version no.
+		int	ple_naxes	# mask dimensionality
+		int	ple_axlen[7]	# length of each axis
+		int	ple_llop	# output pointer into llbuf
+		int	ple_lllen	# llbuf length, words
+		int	ple_nlp		# number of line pointers (lines)
+		int	ple_nlpx	# length of compressed index
+		int	ple_exlen	# length of full pl_extern struct
+		int	ple_flags	# flag bits
+		int	ple_maxline	# saved pl_maxline
+		int	ple_maxval	# saved pl_maxval
+		short	ple_pkindex[]	# packed line list index array
+		short	ple_llbuf[]	# line list buffer
+	}
+.fi
+.ke
+
+The \fIpl_compress\fR function is applied before a mask is encoded
+into the external storage format, to eliminate the unused space in the line
+list buffer which occurs during dynamic updates to the runtime list structure.
+The line list index, containing one integer entry for each line in the mask
+in the runtime format, is compressed using \fIpl_p2li\fR, storing in the
+external representation the compressed array encoded as a line list in
+\fIple_pkindex\fR.  This is especially important for large masks, as otherwise
+the index array could be by far the biggest contributor to the size of the
+mask when encoded into its external format.
+
+No format conversions are required other than decoding the compressed line list
+index and possibly byte swapping, hence accessing a stored list is very fast.
+Further data compression is possible when packing the list for storage, but it
+is not clear if this is justified.
diff --git a/sys/plio/README b/sys/plio/README
new file mode 100644
index 00000000..440bf528
--- /dev/null
+++ b/sys/plio/README
@@ -0,0 +1,288 @@
+PMIO -- The Pixel Mask I/O package (PLIO for image masks).
+PLIO -- The Pixel List I/O package (no ties to IMIO)
+
+    A PIXEL LIST is a compressed, region oriented data structure used to store
+an image matrix.  The pixel list package is used to create, manage, and access
+this data structure.  Although the PLIO package can stand alone and is useful
+in its own right, one of the main uses of the pixel list package is in the IMIO
+interface, which can access a pixel list as if it were a MASK IMAGE.
+See PLIO.hlp for further information on the PLIO package and image masks.
+
+The pixel list package itself does not support any fancy image coordinate
+transformations.  If an image has an associated pixel mask, the pixel mask
+refers to the physical image matrix.  An application written at the IMIO level
+where an image section transformation may be defined for an image should
+normally use the PMIO (pixel mask) package in preference to PLIO.  PMIO is
+equivalent to PLIO, except that coordinates are input in image section
+coordinates, and a reference image is used to map such coordinates onto the
+physical image matrix.
+
+
+1. IMIO Mask Image Interface
+
+		  im = im_pmmap (maskname, mode, ref_im|NULL)
+		 im = im_pmmapo (pm, ref_im)
+
+		         imseti (im, IM_RLIO, YES|NO)	# enable range list i/o
+		         imseti (im, IM_PMDES, pm)	# inquire PM descriptor
+		   pm = imstati (im, IM_PMDES)
+
+	   bool = im_pmlne[123] (im[, lineno[, bandno]])
+	   bool = im_pmsne[123] (im, x1, x2[, y1, y2[, z1, z2]])
+	       bool = im_pmlnev (im, v)
+	       bool = im_pmsnev (im, vs, ve, ndim)
+
+		  mp = mio_open (maskname, flags, im)	# Masked Image I/O
+		 mp = mio_openo (pm, im)
+	      value = mio_stati (mp, param)
+		       mio_seti (mp, param, value)
+		   mio_setrange (mp, vs, ve, ndim)
+   n|EOF = mio_[gp]lseg[silrdx] (mp, ptr, mval, v, npix)
+		      mio_close (mp)
+
+
+2. Pixel Mask Interface (uses reference image for section transformation)
+
+		pm = pm_newmask (ref_im, depth)
+
+		   pm = pm_open (bufptr|NULL)
+		 pm = pm_create (naxes, axlen, depth)
+		pm = pm_newcopy (pm)
+		       pm_close (pm)
+
+		    pm_[sg]size (pm, naxes, alxen, depth)
+		        pm_seti (pm, param, value)
+	       value = pm_stati (pm, param)
+		       pm_debug (pm, outfd, maxcol, flags)
+		bool = pm_empty (pm)
+		    pm_compress (pm)
+		       pm_clear (pm)
+
+			pm_load (pm, bufptr)
+	       nwords = pm_save (pm, bufptr, buflen, save_flags)
+		       pm_loadf (pm, fname, title, maxch)
+		       pm_savef (pm, fname, title, save_flags)
+	       pm_[load|save]im (pm, imname[, save_flags])
+
+	     ptr = pm_emptyline (pm)
+		ptr = pm_access (pm, v)
+         bool = pm_linenotempty (pm, v)
+         bool = pm_sectnotempty (pm, vs, ve, ndim)
+	      pm[gp]l[lrp][sil] (pm, v, buf, b_depth, npix, rop)
+
+	      pm_[set|get]plane (pm, v)
+		       pm_point (pm, x, y, rop)
+		      pm_circle (pm, x, y, r, rop)
+			 pm_box (pm, x1,y1, x2,y2, rop)
+			pm_line (pm, x1,y1, x2,y2, width, rop)
+		     pm_polygon (pm, x, y, npts, rop)
+
+			 pm_rop (pm_src, vs, pm_dst, vs, vn, rop)
+		     pm_stencil (pm_src, vs, pm_dst, vs, pm_stl, vs, vn, rop)
+
+
+2.1 Random Access to a Pixel Mask
+
+		 pmr = pmr_open (pm, plane, buflimit)
+		    pmr_setrect (pmr, x1,y1, x2,y2)
+	      mval = pmr_getpix (pmr, i, j)
+		      pmr_close (pmr)
+
+
+3. Pixel List Interface (stands alone; independent of IMIO; no coord xforms)
+
+		   pl = pl_open (bufptr|NULL)
+		 pl = pl_create (naxes, axlen, depth)
+		pl = pl_newcopy (pl)
+		       pl_close (pl)
+
+		    pl_[sg]size (pl, naxes, axlen, depth)
+		        pl_seti (pl, param, value)
+	       value = pl_stati (pl, param)
+		       pl_debug (pl, outfd, maxcol, flags)
+		bool = pl_empty (pl)
+		    pl_compress (pl)
+		       pl_clear (pl)
+
+			pl_load (pl, bufptr)
+	       nwords = pl_save (pl, bufptr, buflen, save_flags)
+		       pl_loadf (pl, fname, title, maxch)
+		       pl_savef (pl, fname, title, save_flags)
+	       pl_[load|save]im (pl, imname[, save_flags])
+
+	     ptr = pl_emptyline (pl)
+		ptr = pl_access (pl, v)
+         bool = pl_linenotempty (pl, v)
+         bool = pl_sectnotempty (pl, vs, ve, ndim)
+	      pl[gp]l[lrp][sil] (pl, v, buf, b_depth, npix, rop)
+
+	      pl_[set|get]plane (pl, v)
+		       pl_point (pl, x, y, rop)
+		      pl_circle (pl, x, y, r, rop)
+			 pl_box (pl, x1,y1, x2,y2, rop)
+			pl_line (pl, x1,y1, x2,y2, width, rop)
+		     pl_polygon (pl, x, y, npts, rop)
+
+			 pl_rop (pl_src, vs, pl_dst, vs, vn, rop)
+		     pl_stencil (pl_src, vs, pl_dst, vs, pl_stl, vs, vn, rop)
+
+
+3.1 Random Access to a Pixel List
+
+		 plr = plr_open (pl, plane, buflimit)
+		    plr_setrect (plr, x1,y1, x2,y2)
+	      mval = plr_getpix (plr, i, j)
+		     plr_getlut (plr, bufp, xsize,ysize, xblock,yblock)
+		      plr_close (plr)
+
+
+3.2 Pixel, Line, and Range List Routines
+
+		      pl_pixrop (px_src, xs, src_maxval,
+				 px_dst, ds, dst_maxval, npix, rop)
+		     pl_linerop (ll_src, xs, src_maxval,
+				 ll_dst, ds, dst_maxval, ll_out, npix, rop)
+		    pl_rangerop (rl_src, xs, src_maxval,
+				 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+		 pl_linestencil (ll_src, xs, src_maxval, ll_dst, ds, dst_maxval,
+				 ll_stn, xs, ll_out, npix, rop)
+
+	n = pl_[lrp]2[lrp][sil] (op_src, xs, op_dst, npix)
+
+		  len = pl_llen (ll)
+
+
+4. EXAMPLE
+
+4.1 Sample Mask (pl_draw output)
+
+ 40 .1111111..............................................................22222
+ 39 .1111111..............................................................22222
+ 38 .1111111...............................................................2222
+ 37 .1111111...............................................................2222
+ 36 .1111111............................................................4......
+ 35 .1111111.....................11111111111111111111111111...........4444.....
+ 34 .1111111.....................11111111111111111111111111........44444444....
+ 33 .1111111......................1111111111111111111111111......44444444......
+ 32 .1111111......................1111111111111111111111111...44444444.........
+ 31 .1111111......................1111111111111111111111111.44444444...........
+ 30 .1111111...........4..........1111111111111111111111115444444..............
+ 29 .1111111...........4..........11111111111111111111155554444................
+ 28 .1111111...........4..........111111111111111111155555544..................
+ 27 .1111111...........4..........1111111111111111555555551....................
+ 26 .1111111.....................11111111111111155555555111....................
+ 25 .1111111.....................11111111111115555555111111....................
+ 24 ............................1111111111155444444.1111111....................
+ 23 ...........................111111111155544444....111111....................
+ 22 ..............1...........1111111155555444........11111....................
+ 21 ........................1111111155555554..........11111....................
+ 20 ........................111111555555511...........11111....................
+ 19 ........................111555555551111...........11111....................
+ 18 ........................155555555111111...........11111....................
+ 17 ......................445555551111111111.........111111....................
+ 16 ....................444455551111111111111.......1111111....................
+ 15 ..................4444445111111111111111111111111111111....................
+ 14 ...............44444444.1111111111111111111111111111111....................
+ 13 .............44444444......................................................
+ 12 ..........44444444.........................................................
+ 11 ........44444444...........................................................
+ 10 .........4444........................22222.................................
+  9 ..........4.........................2222222..............22222.............
+  8 ....................................2222222.............2222222............
+  7 ....................................2222222.............2222222............
+  6 .....................................22222..............2222222............
+  5 11111111111111111111.....................................22222.............
+  4 11111111111111111111.......................................................
+  3 11111111111111111111.......................................................
+  2 11111111111111111111.......................................................
+  1 11111111111111111111.......................................................
+    123456789012345678901234567890123456789012345678901234567890123456789012345
+             1         2         3         4         5         6         7     
+
+
+4.2 Sample Debug Output (for above mask)
+
+Mask 1EECD naxes=2 [75,40] maxval=177 plane=[75,40]
+max buffered line size 1024, max actual line size 16
+40 lines total, 40 are nonempty, mask is nonempty
+llbp=42AF5, len=1190, op=583, free=189, nupdates=35
+Index at 1EFF1 containing 40 lines:
+     4      4      4      4     17     26     35     35    166    177    187
+   194    201    208    218    228    241    254    266    554    292    568
+   319    333    347    360    492    507    523    539    423    435    447
+   459    471    483    148    148    157    157
+Line list containing 40 lines:
+[1:4]      IH48(49) H20 Z55 (75,49)
+[5]        IH48(49) H20 IH1(50) Z37 H5 Z13 (75,50)
+[6]        IH49(50) Z37 H5 Z14 H7 Z12 (75,50)
+[7:8]      IH49(50) Z36 H7 Z13 H7 Z12 (75,50)
+[9]        IH51(52) P11 DH2(50) Z25 H7 Z14 H5 Z13 (75,50)
+[10]       IH51(52) Z9 H4 DH2(50) Z24 H5 Z33 (75,50)
+[11]       IH51(52) Z8 H8 Z59 (75,52)
+[12]       IH51(52) Z10 H8 Z57 (75,52)
+[13]       IH51(52) Z13 H8 Z54 (75,52)
+[14]       IH51(52) Z15 H8 DH3(49) Z1 H31 Z20 (75,49)
+[15]       IH51(52) Z18 H6 IS1(53) DH4(49) H30 Z20 (75,49)
+[16]       IH51(52) Z20 H4 IH1(53) H4 DH4(49) H13 Z7 H7 Z20 (75,49)
+[17]       IH51(52) Z22 H2 IH1(53) H6 DH4(49) H10 Z9 H6 Z20 (75,49)
+[18]       IH48(49) P25 IH4(53) H8 DH4(49) H6 Z11 H5 Z20 (75,49)
+[19]       IH48(49) Z24 H3 IH4(53) H8 DH4(49) H4 Z11 H5 Z20 (75,49)
+[20]       IH48(49) Z24 H6 IH4(53) H7 DH4(49) H2 Z11 H5 Z20 (75,49)
+[21]       IH48(49) Z24 H8 IH4(53) H7 DS1(52) DH3(49) Z10 H5 Z20 (75,49)
+[22]       IH48(49) P15 Z11 H8 IH4(53) H5 DH1(52) H3 DH3(49) Z8 H5 Z20 (75,49)
+[23]       IH48(49) Z27 H10 IH4(53) H3 DH1(52) H5 DH3(49) Z4 H6 Z20 (75,49)
+[24]       IH48(49) Z28 H11 IH4(53) H2 DH1(52) H6 DH3(49) Z1 H7 Z20 (75,49)
+[25]       IH48(49) Z1 H7 Z21 H13 IH4(53) H7 DH4(49) H6 Z20 (75,49)
+[26]       IH48(49) Z1 H7 Z21 H15 IH4(53) H8 DH4(49) H3 Z20 (75,49)
+[27]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H16 IH4(53) H8 DS4(49) Z20
+           (75,49)
+[28]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H19 IH4(53) H6 DH1(52) H2 Z18
+           (75,52)
+[29]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H21 IH4(53) H4 DH1(52) H4 Z16
+           (75,52)
+[30]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H24 IS4(53) DH1(52) H6 Z14
+           (75,52)
+[31]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z1 H8 Z11 (75,52)
+[32]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z3 H8 Z9 (75,52)
+[33]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z6 H8 Z6 (75,52)
+[34]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z8 H8 Z4 (75,52)
+[35]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z11 H4 Z5 (75,52)
+[36]       IH48(49) Z1 H7 IH3(52) P61 Z6 (75,52)
+[37:38]    IH48(49) Z1 H7 IH1(50) Z63 H4 (75,50)
+[39:40]    IH48(49) Z1 H7 IH1(50) Z62 H5 (75,50)
+
+Line list containing 40 lines:
+[1:4]      1-20(49)
+[5]        1-20(49) 58-62(50)
+[6]        38-42(50) 57-63(50)
+[7:8]      37-43(50) 57-63(50)
+[9]        11(52) 37-43(50) 58-62(50)
+[10]       10-13(52) 38-42(50)
+[11]       9-16(52)
+[12]       11-18(52)
+[13]       14-21(52)
+[14]       16-23(52) 25-55(49)
+[15]       19-24(52) 25(53) 26-55(49)
+[16]       21-24(52) 25-28(53) 29-41(49) 49-55(49)
+[17]       23-24(52) 25-30(53) 31-40(49) 50-55(49)
+[18]       25(49) 26-33(53) 34-39(49) 51-55(49)
+[19]       25-27(49) 28-35(53) 36-39(49) 51-55(49)
+[20]       25-30(49) 31-37(53) 38-39(49) 51-55(49)
+[21]       25-32(49) 33-39(53) 40(52) 51-55(49)
+[22]       15(49) 27-34(49) 35-39(53) 40-42(52) 51-55(49)
+[23]       28-37(49) 38-40(53) 41-45(52) 50-55(49)
+[24]       29-39(49) 40-41(53) 42-47(52) 49-55(49)
+[25]       2-8(49) 30-42(49) 43-49(53) 50-55(49)
+[26]       2-8(49) 30-44(49) 45-52(53) 53-55(49)
+[27]       2-8(49) 20(52) 31-46(49) 47-54(53) 55(49)
+[28]       2-8(49) 20(52) 31-49(49) 50-55(53) 56-57(52)
+[29]       2-8(49) 20(52) 31-51(49) 52-55(53) 56-59(52)
+[30]       2-8(49) 20(52) 31-54(49) 55(53) 56-61(52)
+[31]       2-8(49) 31-55(49) 57-64(52)
+[32]       2-8(49) 31-55(49) 59-66(52)
+[33]       2-8(49) 31-55(49) 62-69(52)
+[34]       2-8(49) 30-55(49) 64-71(52)
+[35]       2-8(49) 30-55(49) 67-70(52)
+[36]       2-8(49) 69(52)
+[37:38]    2-8(49) 72-75(50)
+[39:40]    2-8(49) 71-75(50)
diff --git a/sys/plio/mkpkg b/sys/plio/mkpkg
new file mode 100644
index 00000000..deb49757
--- /dev/null
+++ b/sys/plio/mkpkg
@@ -0,0 +1,94 @@
+# Make the PLIO package library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+tfiles:
+	$set GFLAGS = "-k -t sil -p tf/"
+	$ifolder (tf/plglpi.x,  plglp.gx)  $generic $(GFLAGS) plglp.gx  $endif
+	$ifolder (tf/plglri.x,  plglr.gx)  $generic $(GFLAGS) plglr.gx  $endif
+	$ifolder (tf/pll2pi.x,  pll2p.gx)  $generic $(GFLAGS) pll2p.gx  $endif
+	$ifolder (tf/pll2ri.x,  pll2r.gx)  $generic $(GFLAGS) pll2r.gx  $endif
+	$ifolder (tf/plp2li.x,  plp2l.gx)  $generic $(GFLAGS) plp2l.gx  $endif
+	$ifolder (tf/plp2ri.x,  plp2r.gx)  $generic $(GFLAGS) plp2r.gx  $endif
+	$ifolder (tf/plplpi.x,  plplp.gx)  $generic $(GFLAGS) plplp.gx  $endif
+	$ifolder (tf/plplri.x,  plplr.gx)  $generic $(GFLAGS) plplr.gx  $endif
+	$ifolder (tf/plpropi.x, plprop.gx) $generic $(GFLAGS) plprop.gx $endif
+	$ifolder (tf/plr2li.x,  plr2l.gx)  $generic $(GFLAGS) plr2l.gx  $endif
+	$ifolder (tf/plr2pi.x,  plr2p.gx)  $generic $(GFLAGS) plr2p.gx  $endif
+	$ifolder (tf/plrropi.x, plrrop.gx) $generic $(GFLAGS) plrrop.gx $endif
+	$ifolder (tf/plrpri.x,  plrpr.gx)  $generic $(GFLAGS) plrpr.gx  $endif
+	$ifolder (tf/plreqi.x,  plreq.gx)  $generic $(GFLAGS) plreq.gx  $endif
+	;
+
+zzdebug:
+zzdebug.e:
+	$set	XFLAGS = "$(XFLAGS) -q"
+	$omake	zzdebug.x <error.h> <ctype.h> <fset.h> <plset.h> <plio.h>
+	$link	-z zzdebug.o -o zzdebug.e
+	;
+
+libex.a:
+	# Retranslate any recently modified generic sources.
+	$ifeq (hostid, unix)
+	    $call tfiles
+	$endif
+
+	@tf		# Update datatype expanded files.
+
+	placcess.x	<plio.h> <plset.h>
+	plalloc.x	<plio.h>
+	plascii.x	<ctype.h> <plset.h>
+	plbox.x		<plio.h> <plset.h> plbox.h
+	plubox.x	<plio.h> <plset.h> plbox.h
+	plcircle.x	<plio.h> <plset.h> plcircle.h
+	plucircle.x	<plio.h> <plset.h> plcircle.h
+	plclear.x	<plio.h>
+	plclose.x	<plio.h>
+	plcmpress.x	<plio.h>
+	plcompare.x	<plio.h> <plset.h>
+	plcreate.x	
+	pldbgout.x	
+	pldebug.x	<plio.h> <plset.h>
+	plempty.x	<plio.h>
+	plemptyline.x	<plio.h>
+	plglls.x	<plio.h>
+	plgplane.x	<plio.h>
+	plgsize.x	<plio.h> <plset.h>
+	pllen.x		<plio.h>
+	plleq.x		<plio.h>
+	plline.x	<math.h> <plio.h> <plset.h>
+	pllinene.x	<plio.h> <plset.h>
+	pllnext.x	pllseg.h <plio.h>
+	plload.x	<plio.h> <plset.h>
+	plloadf.x	<plio.h> <plset.h>
+	plloadim.x	<imhdr.h> <imset.h> <plio.h> <plset.h>
+	plloop.x	<plio.h>
+	pllpr.x		<plio.h>
+	pllrop.x	<plio.h> <plset.h> pllseg.h
+	pllsten.x	<plio.h> <plset.h> pllseg.h
+	plnewcopy.x	<plio.h> <plset.h>
+	plopen.x	<plio.h> <plset.h>
+	plplls.x	<plio.h>
+	plpoint.x	<plio.h> <plset.h>
+	plpolygon.x	<plio.h> <plset.h> plpolygon.h
+	plupolygon.x	<plio.h> <plset.h> plpolygon.h
+	plregrop.x	<plio.h> <plset.h>
+	plrio.x		<plio.h>
+	plrop.x		<plio.h> <plset.h>
+	plsave.x	<plio.h> <plset.h>
+	plsavef.x	<plio.h> <plset.h>
+	plsaveim.x	<imhdr.h> <imset.h> <mach.h> <plio.h> <plset.h>
+	plsectnc.x	<plio.h> pllseg.h <plset.h>
+	plsectne.x	<plio.h> pllseg.h <plset.h>
+	plseti.x	<plio.h> <plset.h>
+	plsplane.x	<plio.h>
+	plssize.x	<plio.h> <plset.h>
+	plsslv.x	<plio.h> <plset.h>
+	plstati.x	<plio.h> <plset.h>
+	plsten.x	<plio.h> <plset.h>
+	plupdate.x	<mach.h> <plio.h> <plset.h>
+	plvalid.x	<plio.h>
+	;
diff --git a/sys/plio/placcess.x b/sys/plio/placcess.x
new file mode 100644
index 00000000..92cb036d
--- /dev/null
+++ b/sys/plio/placcess.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include <plset.h>
+include	<plio.h>
+
+# PL_ACCESS -- Return a pointer (type short) to the encoded line list data
+# for the indicated mask image line.  A valid pointer is always returned;
+# if the mask line is empty, the pointer will point to "empty line" linelist.
+
+pointer procedure pl_access (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I coordinates of desired line
+
+int	pl_reference()
+
+begin
+	return (Ref (pl, pl_reference(pl,v)))
+end
+
+
+# PL_REFERENCE -- Return a reference (llbuf offset) to the indicated mask
+# image line.  A valid offset is always returned; if the mask line is empty,
+# the offset will be that of the "empty line" linelist.
+
+int procedure pl_reference (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I coordinates of desired line
+
+int	index, i
+int	totlen, axlen
+define	oob_ 91
+
+begin
+	# Compute the index of the line in the line pointer array.
+	if (PL_NAXES(pl) == 2) {
+	    # Optimized for case naxes=2.
+	    index = v[2]
+	    if (index < 1 || index > PL_AXLEN(pl,2))
+		goto oob_
+	} else {
+	    # General case.
+	    index = 1
+	    totlen = 1
+	    do i = 2, PL_NAXES(pl) {
+		axlen = PL_AXLEN(pl,i)
+		if (v[i] < 1 || v[i] > axlen)
+		    goto oob_
+		index = index + totlen * (v[i] - 1)
+		totlen = totlen * axlen
+	    }
+	}
+
+	return (PL_LP(pl,index))
+oob_
+	call syserr (SYS_PLREFOOB)
+end
diff --git a/sys/plio/plalloc.x b/sys/plio/plalloc.x
new file mode 100644
index 00000000..1fecf486
--- /dev/null
+++ b/sys/plio/plalloc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_ALLOC -- Allocate space in the line list buffer, returning the llbuf
+# offset of the allocated area as the function value.  If overflow occurs
+# the buffer is resized.
+
+int procedure pl_alloc (pl, nwords)
+
+pointer	pl			#I mask descriptor
+int	nwords			#I number of words of storage to allocate
+
+int	newbuf
+int	len, o_len, inc, op
+errchk	realloc
+
+begin
+	len = PL_LLLEN(pl)		# current buffer length
+	inc = PL_LLINC(pl)		# length increment
+	op  = PL_LLOP(pl)		# next available location
+
+	newbuf = op
+	op = newbuf + nwords
+
+	for (o_len = len;  op >= len;  ) {
+	    inc = min (PL_MAXINC, inc * 2)
+	    len = len + inc
+	}
+
+	if (len != o_len)
+	    call realloc (PL_LLBP(pl), len, TY_SHORT)
+
+	PL_LLLEN(pl) = len
+	PL_LLINC(pl) = inc
+	PL_LLOP(pl)  = op
+
+	return (newbuf)
+end
diff --git a/sys/plio/plascii.x b/sys/plio/plascii.x
new file mode 100644
index 00000000..8106b10e
--- /dev/null
+++ b/sys/plio/plascii.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<plset.h>
+
+# PL_ASCIIDUMP -- Dump a two dimensional region of a mask as a printable ASCII
+# character array on the output stream.  Intended as a simple debugging tool;
+# see also PL_SAVEIM.
+
+procedure pl_asciidump (pl, vs, ve, outfd)
+
+pointer	pl			#I mask descriptor
+long	vs[ARB]			#I ll vector (only first two elements used)
+long	ve[ARB]			#I ur vector (only first two elements used)
+int	outfd			#I output file
+
+pointer	sp, pv, cv
+int	npix, ch, i
+long	v[PL_MAXDIM]
+errchk	pl_valid
+
+begin
+	call pl_valid (pl)
+	npix = ve[1] - vs[1] + 1
+
+	call smark (sp)
+	call salloc (pv, npix, TY_INT)
+	call salloc (cv, npix, TY_CHAR)
+
+	# Output mask.
+	call amovl (vs, v, PL_MAXDIM)
+	v[2] = ve[2]
+
+	while (v[2] >= vs[2]) {
+	    call pl_glpi (pl, v, Memi[pv], 0, npix, PIX_SRC)
+	    do i = 1, npix {
+		ch = mod (Memi[pv+i-1], 128)
+		if (ch < 32)
+		    ch = ch + 32
+		if (ch <= 32 || ch == 127)
+		    ch = '.'
+		Memc[cv+i-1] = ch
+	    }
+	    call fprintf (outfd, "%3d ")
+		call pargi (v[2])
+	    call write (outfd, Memc[cv], npix)
+	    call putci (outfd, '\n')
+	    v[2] = v[2] - 1
+	}
+
+	# Label the columns.
+	call fprintf (outfd, "%5t")
+	do i = 1, npix
+	    call putci (outfd, TO_DIGIT(mod (i,10)))
+	call fprintf (outfd, "\n")
+
+	call fprintf (outfd, "%5t")
+	do i = 1, npix
+	    if (mod (i, 10) == 0)
+		call putci (outfd, TO_DIGIT(i / 10))
+	    else
+		call putci (outfd, ' ')
+	call fprintf (outfd, "\n")
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plbox.h b/sys/plio/plbox.h
new file mode 100644
index 00000000..f988b9d6
--- /dev/null
+++ b/sys/plio/plbox.h
@@ -0,0 +1,10 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LEN_BOXDES	6
+define	B_PL		Memi[$1]	# reference mask
+define	B_X1		Memi[$1+1]	# X1 coord of box
+define	B_Y1		Memi[$1+2]	# Y1 coord of box
+define	B_X2		Memi[$1+3]	# X2 coord of box
+define	B_Y2		Memi[$1+4]	# Y2 coord of box
+define	B_PV		Memi[$1+5]	# pixel value
+
diff --git a/sys/plio/plbox.x b/sys/plio/plbox.x
new file mode 100644
index 00000000..35dbda4c
--- /dev/null
+++ b/sys/plio/plbox.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plbox.h"
+
+
+# PL_BOX -- Rasterop between a box as source, and an existing mask as dest.
+# This is a 2-dim operator.  The pl_setplane procedure is used to specify
+# the plane to be modified.
+
+procedure pl_box (pl, x1,y1, x2,y2, rop)
+
+pointer	pl			#I mask descriptor
+int	x1,y1			#I lower left corner of box
+int	x2,y2			#I upper right corner of box
+int	rop			#I rasterop
+
+pointer	sp, ufd
+extern	pl_ubox()
+
+begin
+	call plvalid (pl)
+	call smark (sp)
+	call salloc (ufd, LEN_BOXDES, TY_STRUCT)
+
+	B_PL(ufd) = pl
+	B_X1(ufd) = max(1, min(PL_AXLEN(pl,1), x1))
+	B_Y1(ufd) = max(1, min(PL_AXLEN(pl,2), y1))
+	B_X2(ufd) = max(1, min(PL_AXLEN(pl,1), x2))
+	B_Y2(ufd) = max(1, min(PL_AXLEN(pl,2), y2))
+	B_PV(ufd) = 1
+
+	call pl_regionrop (pl, pl_ubox, ufd, y1, y2, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plcircle.h b/sys/plio/plcircle.h
new file mode 100644
index 00000000..f77492f9
--- /dev/null
+++ b/sys/plio/plcircle.h
@@ -0,0 +1,10 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+define	LEN_CIRCLEDES	5
+define	C_PL		Memi[$1]	# reference mask
+define	C_XCEN		Memr[P2R($1+1)]	# X1 coord of circle
+define	C_YCEN		Memr[P2R($1+2)]	# Y1 coord of circle
+define	C_RADIUS	Memr[P2R($1+3)]	# X2 coord of circle
+define	C_PV		Memi[$1+4]	# pixel value
+
diff --git a/sys/plio/plcircle.x b/sys/plio/plcircle.x
new file mode 100644
index 00000000..504c1ce5
--- /dev/null
+++ b/sys/plio/plcircle.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plcircle.h"
+
+
+# PL_CIRCLE -- Rasterop between a circular region as source, and an existing
+# mask as destination.  It is not necessary for the center of the circle to
+# be inside the mask; if it is outside, the boundary of the circle will be
+# clipped to the boundary of the mask.  This is a 2-dim operator.  If the
+# image dimensionality is greater than two the pl_setplane procedure should
+# be called first to specify the plane to be modified.
+
+procedure pl_circle (pl, x, y, radius, rop)
+
+pointer	pl			#I mask descriptor
+int	x,y			#I center coords of circle
+int	radius			#I radius of circle
+int	rop			#I rasterop
+
+int	y1, y2
+pointer	sp, ufd
+extern	pl_ucircle()
+
+begin
+	call plvalid (pl)
+	call smark (sp)
+	call salloc (ufd, LEN_CIRCLEDES, TY_STRUCT)
+
+	y1 = max ( 1, min (PL_AXLEN(pl,2), y - radius))
+	y2 = max (y1, min (PL_AXLEN(pl,2), y + radius))
+
+	C_PL(ufd) = pl
+	C_XCEN(ufd) = x
+	C_YCEN(ufd) = y
+	C_RADIUS(ufd) = radius
+	C_PV(ufd) = 1
+
+	call pl_regionrop (pl, pl_ucircle, ufd, y1, y2, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plclear.x b/sys/plio/plclear.x
new file mode 100644
index 00000000..5ece1b5d
--- /dev/null
+++ b/sys/plio/plclear.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_CLEAR -- Clear a mask.  The entire surface is cleared.  This is equivalent
+# to a full surface pl_rop with rop=PIX_CLR, but is more convenient and can be
+# implemented more efficiently since the entire surface is cleared.
+
+procedure pl_clear (pl)
+
+pointer	pl			#I mask descriptor
+
+pointer	lp
+int	n_len, i
+errchk	realloc
+
+begin
+	# Clear the line list buffer.
+	lp = Ref (pl, PL_EMPTYLINE)
+	PL_LLOP(pl) = LP_BLEN(lp)
+	LP_NREFS(lp) = PL_NLP(pl)
+
+	do i = 1, PL_NLP(pl)
+	    PL_LP(pl,i) = PL_EMPTYLINE
+	    
+	n_len = PL_LLBUFLEN
+	call realloc (PL_LLBP(pl), n_len, TY_SHORT)
+
+	PL_LLLEN(pl) = n_len
+	PL_LLFREE(pl) = 0
+	PL_LLNUPDATES(pl) = 0
+end
diff --git a/sys/plio/plclose.x b/sys/plio/plclose.x
new file mode 100644
index 00000000..e5e53e2b
--- /dev/null
+++ b/sys/plio/plclose.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plio.h>
+
+# PL_CLOSE -- Close a mask descriptor.  The memory resident mask is destroyed;
+# an explicit call to one of the save procedures is required to save the mask
+# in external storage.
+
+procedure pl_close (pl)
+
+pointer	pl			#I mask descriptor
+errchk	syserr
+
+begin
+	if (pl != NULL) {
+	    if (PL_MAGIC(pl) != PL_MAGICVAL)
+		call syserr (SYS_PLINVDES)
+
+	    if (PL_LPP(pl) != NULL)
+		call mfree (PL_LPP(pl), TY_INT)
+	    if (PL_LLBP(pl) != NULL)
+		call mfree (PL_LLBP(pl), TY_SHORT)
+	    call mfree (pl, TY_STRUCT)
+	}
+end
diff --git a/sys/plio/plcmpress.x b/sys/plio/plcmpress.x
new file mode 100644
index 00000000..54850a7a
--- /dev/null
+++ b/sys/plio/plcmpress.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plio.h>
+
+# PL_COMPRESS -- Compress the line list buffer to eliminate any unusable
+# space, as is generated when mask lines are modified and the old line lists
+# are freed.  The compress operation may move the line lists about, possibly
+# changing the line offsets.
+
+procedure pl_compress (pl)
+
+pointer	pl			#I mask descriptor
+
+pointer	n_bp, o_lp, n_lp, op
+int	nwords, r_len, b_len, i
+errchk	malloc, mfree, syserr
+
+begin
+	# Redundant calls are ignored.
+	if (PL_LLNUPDATES(pl) <= 0)
+	    return
+
+        # Return if there was a prior error with plalloc.
+	if (PL_LLBP(pl) == NULL)
+	    call syserr (SYS_PLBADMASK)
+
+	# Count the total space in the active line lists.
+	nwords = 0
+	for (i=0;  i < PL_LLOP(pl);  i=i+b_len) {
+	    o_lp = Ref (pl, i)
+	    b_len = LP_BLEN(o_lp)
+	    if (b_len <= 0 || b_len > PL_LLOP(pl))
+		call syserr (SYS_PLBADMASK)
+	    if (i == PL_EMPTYLINE || LP_NREF(o_lp) > 0)
+		nwords = nwords + LP_LEN(o_lp)
+	}
+
+	# Verify that the free space accounting is correct.
+	if (nwords != (PL_LLOP(pl) - PL_LLFREE(pl)))
+	    call eprintf ("Warning: PL_LLFREE inconsistent (recoverable)\n")
+
+	# Allocate a new buffer large enough to hold the compressed line list.
+	call malloc (n_bp, nwords, TY_SHORT)
+
+	# Copy the active line lists to the new buffer; as each line is
+	# copied, overwrite a couple words of the old line list with the
+	# new offset of the line.
+
+	op = 0
+	for (i=0;  i < PL_LLOP(pl);  i=i+b_len) {
+	    o_lp = Ref (pl, i)
+	    b_len = LP_BLEN(o_lp)
+	    if (b_len <= 0 || b_len > PL_LLOP(pl))
+		call syserr (SYS_PLBADMASK)
+
+	    if (i == PL_EMPTYLINE || LP_NREF(o_lp) > 0) {
+		n_lp = n_bp + op
+		r_len = LP_LEN(o_lp)
+
+		# The following should not be possible, barring a bug.
+		if (op + r_len > nwords)
+		    call fatal (pl, "pl_compress: llbuf overflow")
+
+		call amovs (Mems[o_lp], Mems[n_lp], r_len)
+
+		LP_NREFS(o_lp) = op / I_SHIFT
+		LP_SETBLEN(o_lp, mod (op, I_SHIFT))
+		LP_SETBLEN(n_lp, r_len)
+		op = op + r_len
+	    }
+	}
+		
+	# Fix up the line index by accessing the tag word in the old line list
+	# in the old buffer to get the line list offset in the new buffer.
+
+	do i = 1, PL_NLP(pl) {
+	    o_lp = Ref (pl, PL_LP(pl,i))
+	    PL_LP(pl,i) = LP_NREF(o_lp) * I_SHIFT + LP_BLEN(o_lp)
+	}
+	    
+	# Deallocate the old buffer and install the new one.
+	call mfree (PL_LLBP(pl), TY_SHORT)
+
+	PL_LLBP(pl) = n_bp
+	PL_LLOP(pl) = op
+	PL_LLLEN(pl) = nwords
+	PL_LLFREE(pl) = 0
+	PL_LLNUPDATES(pl) = 0
+end
diff --git a/sys/plio/plcompare.x b/sys/plio/plcompare.x
new file mode 100644
index 00000000..59ba9d1f
--- /dev/null
+++ b/sys/plio/plcompare.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_COMPARE -- Compare two masks for equality, optionally noting any
+# differences on the output file.  PL_EQUAL is returned if the two masks
+# are equivalent.
+
+int procedure pl_compare (pl_1, pl_2, outfd)
+
+pointer	pl_1, pl_2		#I masks to be compared
+int	outfd			#I file for diagnostic output, or NULL
+
+int	i
+bool	pll_equal()
+
+begin
+	if (PL_NAXES(pl_1) != PL_NAXES(pl_2) || PL_NLP(pl_1) != PL_NLP(pl_2)) {
+	    if (outfd != NULL)
+		call fprintf (outfd, "the masks are not the same size\n")
+	    return (PL_NOTEQUAL)
+	}
+
+	do i = 1, PL_NLP(pl_1)
+	    if (!pll_equal (LL(pl_1,PL_LP(pl_1,i)), LL(pl_2,PL_LP(pl_2,i)))) {
+		if (outfd != NULL) {
+		    call fprintf (outfd, "masks differ at line %d\n")
+			call pargi (i)
+		}
+		return (PL_NOTEQUAL)
+	    }
+
+	return (PL_EQUAL)
+end
diff --git a/sys/plio/plcreate.x b/sys/plio/plcreate.x
new file mode 100644
index 00000000..fe972bcb
--- /dev/null
+++ b/sys/plio/plcreate.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PL_CREATE -- Create an empty mask with the given dimensionality and size.
+# A newly created mask has all line pointers pointing to the empty line,
+# which is stored as the first entry in the line list buffer.
+
+pointer procedure pl_create (naxes, axlen, depth)
+
+int	naxes			#I number of axes (dimensionality of mask)
+long	axlen[ARB]		#I length of each axis
+int	depth			#I mask depth, bits
+
+pointer	pl
+pointer	pl_open()
+errchk	pl_open
+
+begin
+	pl = pl_open (NULL)
+	call pl_ssize (pl, naxes, axlen, depth)
+
+	return (pl)
+end
diff --git a/sys/plio/pldbgout.x b/sys/plio/pldbgout.x
new file mode 100644
index 00000000..26885f3e
--- /dev/null
+++ b/sys/plio/pldbgout.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PL_DEBUGOUT -- Output formatter for PL package debug output.  Output as
+# many text items as will fit on a line, inserting one space between each
+# text item.  A call with BUF=EOS terminates the sequence with a newline.
+
+procedure pl_debugout (fd, buf, col, firstcol, maxcol)
+
+int	fd			#I output stream
+char	buf[ARB]		#I text to be output
+int	col			#I next column of output
+int	firstcol		#I first column to write to
+int	maxcol			#I last column to write to
+
+int	nchars
+int	strlen()
+
+begin
+	nchars = min (maxcol-firstcol+1, strlen(buf))
+
+	if (nchars == 0) {
+	    # Terminate the sequence with a newline.
+	    call fprintf (fd, "\n")
+	    col = 1
+	    return
+
+	} else if (col + nchars > maxcol) {
+	    # Break line and output token.
+	    call fprintf (fd, "\n")
+
+	    for (col=1;  col < firstcol;  col=col+1)
+		call putci (fd, ' ')
+
+	} else {
+	    # Append to the current line.
+	    if (col <= firstcol) {
+		for (;  col < firstcol;  col=col+1)
+		    call putci (fd, ' ')
+	    } else {
+		call putci (fd, ' ')
+		col = col + 1
+	    }
+	}
+
+	call putline (fd, buf)
+	col = col + nchars
+end
diff --git a/sys/plio/pldebug.x b/sys/plio/pldebug.x
new file mode 100644
index 00000000..67a719dc
--- /dev/null
+++ b/sys/plio/pldebug.x
@@ -0,0 +1,218 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_DEBUG -- Print debug information for a mask.  The information to be
+# printed is selected by summing the following bitflags:
+#
+#	PD_SUMMARY		mask level summary information
+#	PD_INDEX		print the line list index
+#	PD_LLOUT		print the line lists, line list format
+#	PD_RLOUT		print the line lists, range list format
+#
+# The mask is not modified in any way.  All output is on the given stream,
+# formatted to the page width given by the 'width' argument.
+
+procedure pl_debug (pl, fd, width, what)
+
+pointer	pl			#I mask descriptor
+int	fd			#I output file
+int	width			#I max width of formatted output, columns
+int	what			#I flags defining what to print
+
+pointer	sp, buf, rng, rl, pp
+int	line_1, line_2, nne, nv, v, lp, i
+int	naxes, axlen, nlp, firstcol, maxcol, col, rlen
+errchk	pl_valid, fprintf, pl_debugout, pll_prints, plr_printi
+bool	pl_empty()
+int	pl_l2ri()
+
+define	index_ 91
+define	lines_ 92
+define	done_  93
+define	llout_ 94
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (rng, SZ_FNAME, TY_CHAR)
+	call salloc (rl, RL_MAXLEN(pl), TY_INT)
+
+	call pl_valid (pl)
+	naxes = PL_NAXES(pl)
+	axlen = PL_AXLEN(pl,1)
+	nlp   = PL_NLP(pl)
+	maxcol = width - 1
+
+	# Output the summary information.
+	# ---------------------------------
+
+	if (and (what, PD_SUMMARY) == 0)
+	    goto index_
+
+	# Line 1 of summary.
+	call fprintf (fd, "Mask %x naxes=%d [")
+	    call pargi (pl)
+	    call pargi (naxes)
+	do i = 1, naxes {
+	    call fprintf (fd, "%d%c")
+		call pargi (PL_AXLEN(pl,i))
+		if (i == naxes)
+		    call pargi (']')
+		else
+		    call pargi (',')
+	}
+	call fprintf (fd, " maxval=%o")
+	    call pargi (PL_MAXVAL(pl))
+	call fprintf (fd, " plane=[")
+	do i = 1, naxes {
+	    call fprintf (fd, "%d%c")
+		call pargi (PL_AXLEN(pl,i))
+		if (i == naxes)
+		    call pargi (']')
+		else
+		    call pargi (',')
+	}
+	call fprintf (fd, "\n")
+
+	# Line 2 of summary.
+	call fprintf (fd,
+	    "max buffered line size %d, max actual line size %d\n")
+	    call pargi (PL_MAXLINE(pl))
+	    v = 0
+	    nne = 0
+	    do i = 1, nlp {
+		lp = PL_LP(pl,i)
+		nv = LP_LEN (Ref (pl, lp))
+		if (nv > v)
+		    v = nv
+		if (lp != PL_EMPTYLINE)
+		    nne = nne + 1
+	    }
+	    call pargi (v)
+
+	# Line 3 of summary.
+	call fprintf (fd, "%d lines total, %d are nonempty, mask is %s\n")
+	    call pargi (nlp)
+	    call pargi (nne)
+	if (pl_empty (pl))
+	    call pargstr ("empty")
+	else
+	    call pargstr ("nonempty")
+
+	# Line 4 of summary.
+	call fprintf (fd, "llbp=%x, len=%d, op=%d, free=%d, nupdates=%d\n")
+	    call pargi (PL_LLBP(pl))
+	    call pargi (PL_LLLEN(pl))
+	    call pargi (PL_LLOP(pl))
+	    call pargi (PL_LLFREE(pl))
+	    call pargi (PL_LLNUPDATES(pl))
+
+index_
+	# Print index.
+	# ---------------------------------
+
+	if (and (what, PD_INDEX) == 0)
+	    goto lines_
+
+	call fprintf (fd, "Index at %x containing %d lines:\n")
+	    call pargi (PL_LPP(pl))
+	    call pargi (nlp)
+	col = 1
+	firstcol = 1
+	do i = 1, nlp {
+	    lp = PL_LP(pl,i)
+	    call sprintf (Memc[buf], SZ_LINE, "%6d")
+		call pargi (lp)
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+	}
+	call pl_debugout (fd, "", col, firstcol, maxcol)
+
+lines_
+	# Print the line list.
+	# ---------------------------------
+
+	if (and (what, PD_LLOUT+PD_RLOUT+PD_LHDR) == 0)
+	    goto done_
+
+	call fprintf (fd, "Line list containing %d lines:\n")
+	    call pargi (nlp)
+
+	line_1 = 0
+	do i = 1, nlp + 1 {
+	    if (i > nlp && line_1 != 0)
+		goto llout_
+	    lp = PL_LP(pl,i)
+
+	    if (lp == PL_EMPTYLINE && line_1 == 0) {
+		# Skip over an empty line.
+		next
+	    } else if (line_1 == 0) {
+		# Begin a new region.
+		line_1 = i
+		line_2 = i
+		if (i == nlp)
+		    goto llout_
+	    } else if (lp == PL_LP(pl,line_1)) {
+		# Add line to current region.
+		line_2 = i
+		if (i == nlp)
+		    goto llout_
+
+	    } else {
+		# Output a region.
+llout_
+		lp = PL_LP(pl,line_1)
+		pp = Ref (pl, lp)
+
+		if (line_1 == line_2) {
+		    call sprintf (Memc[rng], SZ_FNAME, "[%d]")
+			call pargi (line_1)
+		} else {
+		    call sprintf (Memc[rng], SZ_FNAME, "[%d:%d]")
+			call pargi (line_1)
+			call pargi (line_2)
+		}
+
+		if (and (what, PD_LHDR) != 0) {
+		    call sprintf (Memc[buf], SZ_LINE,
+			"%s%12tlp=%5d, nref=%d, blen=%d, len=%d")
+			call pargstr (Memc[rng])
+			call pargi (lp)
+			call pargi (LP_NREF(pp))
+			call pargi (LP_BLEN(pp))
+			call pargi (LP_LEN(pp))
+		} else
+		    call strcpy (Memc[rng], Memc[buf], SZ_LINE)
+
+		# Output the line list as a line list.
+		firstcol = 12
+		if (and (what, PD_LLOUT) != 0)
+		    call pll_prints (LL(pl,lp), fd, Memc[buf], firstcol, maxcol)
+
+		# Output as a range list.
+		if (and (what, PD_RLOUT) != 0) {
+		    rlen = pl_l2ri (LL(pl,lp), 1, Memi[rl], axlen)
+		    call plr_printi (Memi[rl], fd, Memc[buf], firstcol, maxcol)
+		}
+
+		if (and (what, PD_RLOUT+PD_LLOUT) == 0) {
+		    col = 1;  firstcol = 1
+		    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+		    call pl_debugout (fd, "", col, firstcol, maxcol)
+		}
+
+		if (PL_LP(pl,i) == PL_EMPTYLINE || line_2 == i)
+		    line_1 = 0
+		else {
+		    line_1 = i
+		    line_2 = i
+		}
+	    }
+	}
+
+done_
+	call flush (fd)
+	call sfree (sp)
+end
diff --git a/sys/plio/plempty.x b/sys/plio/plempty.x
new file mode 100644
index 00000000..2dab29ed
--- /dev/null
+++ b/sys/plio/plempty.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_EMPTY -- Test whether a mask is empty, i.e., contains no nonzero pixels.
+
+bool procedure pl_empty (pl)
+
+pointer	pl			#I mask descriptor
+int	i
+
+begin
+	# Mask is empty if all lines are empty.
+	do i = 1, PL_NLP(pl)
+	    if (PL_LP(pl,i) != PL_EMPTYLINE)
+		return (false)
+
+	return (true)
+
+	# The following also works, but the call to pl_compress is an
+	# unintended side effect which it is best to avoid.
+
+	# call pl_compress (pl)
+	# return (PL_LLOP(pl) == LP_BLEN(Ref(pl,0)))
+end
diff --git a/sys/plio/plemptyline.x b/sys/plio/plemptyline.x
new file mode 100644
index 00000000..4d4612cd
--- /dev/null
+++ b/sys/plio/plemptyline.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+
+# PL_EMPTYLINE -- Return a pointer to the empty line for a mask.
+
+pointer procedure pl_emptyline (pl)
+
+pointer	pl			#I mask descriptor
+
+begin
+	return (Ref (pl, PL_EMPTYLINE))
+end
diff --git a/sys/plio/plglls.x b/sys/plio/plglls.x
new file mode 100644
index 00000000..aaae0e42
--- /dev/null
+++ b/sys/plio/plglls.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GLLS -- Get a line segment as a list list, applying the given ROP to
+# combine the pixels with those of the output line list.
+
+procedure pl_glls (pl, v, ll_dst, ll_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	ll_dst[ARB]		#O output line list
+int	ll_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_out, ll_src
+pointer	pl_access()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1)) {
+	    ll_len = LP_LEN(ll_src)
+	    call amovs (Mems[ll_src], ll_dst, ll_len)
+
+	} else {
+	    call smark (sp)
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+
+	    call pl_linerop (Mems[ll_src], v[1], PL_MAXVAL(pl), ll_dst, 1,
+		MV(ll_depth), Mems[ll_out], npix, rop)
+	    ll_len = LP_LEN(ll_out)
+	    call amovs (Mems[ll_out], ll_dst, ll_len)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/plglp.gx b/sys/plio/plglp.gx
new file mode 100644
index 00000000..d5803033
--- /dev/null
+++ b/sys/plio/plglp.gx
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pl_glp$t (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	np
+pointer	sp, px_out, ll_src
+pointer	pl_access()
+int	pl_l2p$t()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop)) {
+	    np = pl_l2p$t (Mems[ll_src], v[1], px_dst, npix)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (px_out, npix, TY_PIXEL)
+
+	np = pl_l2p$t (Mems[ll_src], v[1], Mem$t[px_out], npix)
+	call pl_pixrop$t (Mem$t[px_out], 1, PL_MAXVAL(pl),
+	    px_dst, 1, MV(px_depth), npix, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plglr.gx b/sys/plio/plglr.gx
new file mode 100644
index 00000000..3a63346d
--- /dev/null
+++ b/sys/plio/plglr.gx
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+include	<plset.h>
+
+# PL_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output list.
+
+procedure pl_glr$t (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	rl_dst[ARB]		#O output range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	mr, nr
+pointer	sp, rl_out, rl_src, ll_src
+pointer	pl_access()
+int	pl_l2r$t()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop))
+	    nr = pl_l2r$t (Mems[ll_src], v[1], rl_dst, npix)
+	else {
+	    call smark (sp)
+	    mr = min (RL_MAXLEN(pl), npix * 3)
+	    call salloc (rl_src, mr, TY_PIXEL)
+	    call salloc (rl_out, mr, TY_PIXEL)
+
+	    nr = pl_l2r$t (Mems[ll_src], v[1], Mem$t[rl_src], npix)
+	    call pl_rangerop$t (Mem$t[rl_src], 1, PL_MAXVAL(pl),
+			              rl_dst,  1, MV(rl_depth),
+				      Mem$t[rl_out], npix, rop)
+
+	     # Copy out the edited range list.
+	     call amov$t (Mem$t[rl_out], rl_dst, RL$T_LEN(rl_out))
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/plgplane.x b/sys/plio/plgplane.x
new file mode 100644
index 00000000..3f338178
--- /dev/null
+++ b/sys/plio/plgplane.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GETPLANE -- Get the 2-Dim plane to be referenced in calls to the pl_box,
+# pl_circle, etc. geometric region masking operators.
+
+procedure pl_getplane (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[ARB]			#O vector defining plane
+
+begin
+	call amovl (PL_PLANE(pl,1), v, PL_MAXDIM)
+end
diff --git a/sys/plio/plgsize.x b/sys/plio/plgsize.x
new file mode 100644
index 00000000..40e73ac3
--- /dev/null
+++ b/sys/plio/plgsize.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PL_GSIZE -- Get the dimensionality and size of a mask.
+
+procedure pl_gsize (pl, naxes, axlen, depth)
+
+pointer	pl			#I mask descriptor
+int	naxes			#O number of axes (dimensionality of mask)
+long	axlen[ARB]		#O length of each axis
+int	depth			#O mask depth, bits
+
+int	i
+
+begin
+	naxes = PL_NAXES(pl)
+	call amovl (PL_AXLEN(pl,1), axlen, PL_MAXDIM)
+
+	do i = 0, ARB
+	    if (2**i > min (I_PVMAX, PL_MAXVAL(pl))) {
+		depth = i
+		break
+	    }
+end
diff --git a/sys/plio/pll2p.gx b/sys/plio/pll2p.gx
new file mode 100644
index 00000000..007af7a0
--- /dev/null
+++ b/sys/plio/pll2p.gx
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_L2P -- Convert a line list to a pixel array.  The number of pixels output
+# (always npix) is returned as the function value.
+
+int procedure pl_l2p$t (ll_src, xs, px_dst, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+PIXEL	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+PIXEL	pv
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, ip, op, otop, i
+define	putpix_ 91
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	xe = xs + npix - 1
+	skipword = false
+	op = 1
+	x1 = 1
+	pv = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN, I_HN, I_PN:
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+
+		# Process segment if any region is inbounds.
+		np = i2 - i1 + 1
+		if (np > 0) {
+		    otop = op + np - 1
+		    if (opcode == I_HN) {
+			do i = op, otop
+			    px_dst[i] = pv
+		    } else {
+			do i = op, otop
+			    px_dst[i] = 0
+			if (opcode == I_PN && i2 == x2)
+			    px_dst[otop] = pv
+		    }
+		    op = otop + 1
+		}
+
+		# Advance the line index.
+		x1 = x2 + 1
+
+	    case I_SH:
+		pv = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+	    case I_IH:
+		pv = pv + data
+	    case I_DH:
+		pv = pv - data
+	    case I_IS:
+		pv = pv + data
+		goto putpix_
+	    case I_DS:
+		pv = pv - data
+putpix_
+		if (x1 >= xs && x1 <= xe) {
+		    px_dst[op] = pv
+		    op = op + 1
+		}
+		x1 = x1 + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/pll2r.gx b/sys/plio/pll2r.gx
new file mode 100644
index 00000000..ae6a6fcf
--- /dev/null
+++ b/sys/plio/pll2r.gx
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_L2R -- Convert a line list to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_l2r$t (ll_src, xs, rl, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+PIXEL	rl[3,ARB] 		#O output range list
+int	npix			#I number of pixels to convert
+
+int	pv, hi
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, rn, ip
+define	range_ 91
+define	putrange_ 92
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	rn = RL_FIRST
+	xe = xs + npix - 1
+	skipword = false
+	x1 = 1
+	hi = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		pv = 0
+		goto range_
+	    case I_HN:
+		pv = hi
+range_
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+		np = i2 - i1 + 1
+		x1 = x2 + 1
+
+	    case I_PN:
+		pv = hi
+		x2 = x1 + data - 1
+		if (x2 < xs || x2 > xe)
+		    np = 0
+		else {
+		    i1 = x2
+		    np = 1
+		}
+		x1 = x2 + 1
+
+	    case I_SH:
+		hi = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+		next
+	    case I_IH:
+		hi = hi + data
+		next
+	    case I_DH:
+		hi = hi - data
+		next
+
+	    case I_IS, I_DS:
+		if (opcode == I_IS)
+		    hi = hi + data
+		else
+		    hi = hi - data
+
+		i1 = max (x1, xs)
+		i2 = min (x1, xe)
+		np = i2 - i1 + 1
+		x1 = x1 + 1
+		pv = hi
+	    }
+
+	    # Output a range entry?
+	    if (np > 0 && pv > 0) {
+		rl[1,rn] = i1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/pllen.x b/sys/plio/pllen.x
new file mode 100644
index 00000000..a09b3770
--- /dev/null
+++ b/sys/plio/pllen.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+
+# PL_LLEN -- Return the length of an encoded line list.
+
+int procedure pl_llen (ll)
+
+short	ll[ARB]			#I encoded line list
+
+begin
+	return (LL_LEN(ll))
+end
diff --git a/sys/plio/plleq.x b/sys/plio/plleq.x
new file mode 100644
index 00000000..d74ae370
--- /dev/null
+++ b/sys/plio/plleq.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PLL_EQUAL -- Compare two line lists for equality.
+
+bool procedure pll_equal (l1, l2)
+
+short	l1[ARB]			#I line list 1
+short	l2[ARB]			#I line list 2
+
+int	i, off
+int	l1_len, l1_first
+int	l2_len, l2_first
+
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(l1)) {
+	    l1_len = OLL_LEN(l1)
+	    l1_first = OLL_FIRST
+	} else {
+	    l1_len = LL_LEN(l1)
+	    l1_first = LL_FIRST(l1)
+	}
+
+	# Support old format line lists.
+	if (LL_OLDFORMAT(l2)) {
+	    l2_len = OLL_LEN(l2)
+	    l2_first = OLL_FIRST
+	} else {
+	    l2_len = LL_LEN(l2)
+	    l2_first = LL_FIRST(l2)
+	}
+
+	if (l1_len != l2_len)
+	    return (false)
+
+	off = l2_first - l1_first
+	do i = l1_first, l1_len
+	    if (l1[i] != l2[i+off])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/plio/plline.x b/sys/plio/plline.x
new file mode 100644
index 00000000..54caf253
--- /dev/null
+++ b/sys/plio/plline.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+include <plset.h>
+include <plio.h>
+
+# PL_LINE -- Perform a rasterop operation upon a line of arbitrary width drawn
+# at an arbitrary orientation in a 2-dimensional plane of a mask.  If the
+# dimensionality of the mask exceeds 2, the pl_setplane() procedure should be
+# called first to define the plane of the mask to be modified.
+
+procedure pl_line (pl, x1, y1, x2, y2, width, rop)
+
+pointer	pl			#I mask descriptor
+int	x1,y1			#I start point of line
+int	x2,y2			#I end point of line
+int	width			#I width of line to be drawn, pixels
+int	rop			#I rasterop defining operation
+
+int	npts
+int	x[4], y[4]
+real	theta, hwidth, dx, dy
+
+begin
+	dx = x2 - x1
+	dy = y2 - y1
+
+	# Compute the line direction and halfwidth.
+	hwidth = max (1.0, real(width)) / 2.0 - 0.001
+	if (abs(dx) < 0.0001) {
+	    if (dy > 0)
+		theta = HALFPI
+	    else
+		theta = -HALFPI
+	} else if (abs(dy) < 0.0001) {
+	    if (dx > 0)
+		theta = 0.0
+	    else
+		theta = PI
+	} else
+	    theta = atan2 (dy, dx)
+
+	# Construct a polyline to be filled to draw the line.
+	if (width < 1.0001) {
+	    x[1] = x1;  y[1] = y1
+	    x[2] = x2;  y[2] = y2
+	    npts = 2
+
+	} else {
+	    x[1] = x1 + nint (hwidth * cos(theta+HALFPI))
+	    y[1] = y1 + nint (hwidth * sin(theta+HALFPI))
+
+	    x[2] = x1 + nint (hwidth * cos(theta-HALFPI))
+	    y[2] = y1 + nint (hwidth * sin(theta-HALFPI))
+
+	    x[3] = x2 + nint (hwidth * cos(theta-HALFPI))
+	    y[3] = y2 + nint (hwidth * sin(theta-HALFPI))
+
+	    x[4] = x2 + nint (hwidth * cos(theta+HALFPI))
+	    y[4] = y2 + nint (hwidth * sin(theta+HALFPI))
+	    npts = 4
+	}
+
+	# Draw the line.
+	call pl_polygon (pl, x, y, npts, rop)
+end
diff --git a/sys/plio/pllinene.x b/sys/plio/pllinene.x
new file mode 100644
index 00000000..3babc889
--- /dev/null
+++ b/sys/plio/pllinene.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PL_LINENOTEMPTY -- Test whether the indicated mask image line is empty.
+
+bool procedure pl_linenotempty (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I coordinates of desired line
+
+int	pl_reference()
+
+begin
+	return (pl_reference(pl,v) != PL_EMPTYLINE)
+end
diff --git a/sys/plio/pllnext.x b/sys/plio/pllnext.x
new file mode 100644
index 00000000..43d87c01
--- /dev/null
+++ b/sys/plio/pllnext.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+include	"pllseg.h"
+
+# PLL_NEXTSEG -- Internal routine called by the PLLSEG.H routines to get the
+# next segment of a line list.
+
+procedure pll_nextseg (ll, ld)
+
+short	ll[ARB]			#I input line list
+int	ld[LEN_PLLDES]		#I list list i/o descriptor
+
+int	ip
+int	opcode, data
+
+begin
+	for (ip = ld_ip(ld);  ip <= LL_LEN(ll);  ip = ld_ip(ld)) {
+	    ld_ip(ld) = ip + 1
+	    opcode = I_OPCODE(ll[ip])
+	    data   = I_DATA(ll[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		ld_nleft(ld) = data
+		ld_value(ld) = 0
+		return
+	    case I_HN:
+		ld_nleft(ld) = data
+		ld_value(ld) = ld_hi(ld)
+		return
+	    case I_PN:
+		ld_nleft(ld) = data - 1
+		ld_value(ld) = 0
+		ld_next_nleft(ld) = 1
+		ld_next_value(ld) = ld_hi(ld)
+		return
+
+	    case I_SH:
+		ip = ip + 1
+		ld_ip(ld) = ip + 1
+		ld_hi(ld) = (int(ll[ip]) * I_SHIFT) + data
+	    case I_IH:
+		ld_hi(ld) = ld_hi(ld) + data
+	    case I_DH:
+		ld_hi(ld) = ld_hi(ld) - data
+
+	    case I_IS, I_DS:
+		if (opcode == I_IS)
+		    ld_hi(ld) = ld_hi(ld) + data
+		else
+		    ld_hi(ld) = ld_hi(ld) - data
+
+		ld_nleft(ld) = 1
+		ld_value(ld) = ld_hi(ld)
+		return
+	    }
+	}
+
+	ld_value(ld) = 0
+end
diff --git a/sys/plio/plload.x b/sys/plio/plload.x
new file mode 100644
index 00000000..d67fc595
--- /dev/null
+++ b/sys/plio/plload.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <plset.h>
+include	<plio.h>
+
+# PL_LOAD -- Load a mask from a buffer encoded in a machine independent format
+# in a previous call to PL_SAVE.  The given mask descriptor may be either
+# inactive or active.  In the case of a load into an active mask, the existing
+# mask is clobbered, and the mask may change size.
+
+procedure pl_load (pl, bp)
+
+pointer	pl			#I mask descriptor
+pointer	bp			#I buffer pointer (to short)
+
+pointer	sp, index, ex, ip
+int	o_lllen, o_nlp, sz_index, flags, nlp, i
+errchk	malloc, realloc, syserr
+int	pl_l2pi()
+pointer	coerce()
+
+begin
+	call smark (sp)
+	call salloc (ex, LEN_PLEXTERN, TY_STRUCT)
+
+	o_lllen = PL_LLLEN(pl)
+	o_nlp = PL_NLP(pl)
+
+	# Decode the external format header structure, a fixed size structure
+	# stored in 32 bit MII integer format.
+
+	call miiupk32 (Memi[coerce(bp,TY_SHORT,TY_INT)], Memi[ex],
+	    LEN_PLEXTERN, TY_STRUCT)
+	if (PLE_MAGIC(ex) != PL_MAGICVAL)
+	    call syserr (SYS_PLBADSAVEF)
+
+	call amovi (PLE_AXLEN(ex,1), PL_AXLEN(pl,1), PL_MAXDIM)
+	PL_MAGIC(pl)    = PLE_MAGIC(ex)
+	PL_NAXES(pl)	= PLE_NAXES(ex)
+	PL_LLOP(pl)	= PLE_LLOP(ex)
+	PL_LLLEN(pl)	= PLE_LLLEN(ex)
+	PL_MAXLINE(pl)	= PLE_MAXLINE(ex)
+	PL_MAXVAL(pl)	= PLE_MAXVAL(ex)
+	PL_NLP(pl)	= PLE_NLP(ex)
+	sz_index	= PLE_NLPX(ex)
+	flags		= PLE_FLAGS(ex)
+
+	# Get the (compressed) line index.  If the descriptor is already active
+	# the new mask may be a different size than the old one.
+
+	nlp = 1
+	do i = 2, PL_NAXES(pl)
+	    nlp = nlp * PL_AXLEN(pl,i)
+	if (PL_LPP(pl) == NULL)
+	    call malloc (PL_LPP(pl), nlp, TY_INT)
+	else if (nlp != o_nlp)
+	    call realloc (PL_LPP(pl), nlp, TY_INT)
+
+	call salloc (index, sz_index, TY_SHORT)
+	#ip = bp + (LEN_PLEXTERN * SZ_STRUCT) / SZ_SHORT
+	ip = bp + (LEN_PLEXTERN * SZ_MII_INT) / SZ_SHORT
+	call miiupk16 (Mems[ip], Mems[index], sz_index, TY_SHORT)
+	PL_NLP(pl) = pl_l2pi (Mems[index], 1, PL_LP(pl,1), nlp)
+
+	# Allocate or resize the line list buffer.
+	if (PL_LLBP(pl) == NULL)
+	    call malloc (PL_LLBP(pl), PL_LLLEN(pl), TY_SHORT)
+	else if (PL_LLLEN(pl) != o_lllen)
+	    call realloc (PL_LLBP(pl), PL_LLLEN(pl), TY_SHORT)
+
+	# Read the stored line list.
+	ip = ip + sz_index
+	call miiupk16 (Mems[ip], LL(pl,0), PL_LLLEN(pl), TY_SHORT)
+
+	# Update the remaining fields of the mask descriptor.
+	PL_LLFREE(pl) = 0
+	PL_LLNUPDATES(pl) = 0
+	PL_LLINC(pl) = PL_STARTINC
+	call amovki (1, PL_PLANE(pl,1), PL_MAXDIM)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plloadf.x b/sys/plio/plloadf.x
new file mode 100644
index 00000000..978086b8
--- /dev/null
+++ b/sys/plio/plloadf.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plset.h>
+include	<plio.h>
+
+# PL_LOADF -- Load a mask stored in external format in a binary file.  This
+# simple code permits only one mask per file; more sophisticated storage
+# facilities are planned; these will probably obsolete this routine.
+
+procedure pl_loadf (pl, mask, title, maxch)
+
+pointer	pl			#I mask descriptor
+char	mask[ARB]		#I mask file
+char	title[maxch]		#O mask title
+int	maxch			#I max chars out
+
+int	fd, nchars
+pointer	sp, bp, sv, text, fname, extn
+int	open(), read(), miireadc(), miireadi(), fnextn()
+errchk	open, read, syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	# Get mask file name.
+	call strcpy (mask, Memc[fname], SZ_PATHNAME)
+	if (fnextn (mask, Memc[extn], SZ_FNAME) <= 0)
+	    call strcat (".pl", Memc[fname], SZ_PATHNAME)
+
+	# Open the mask save file.
+	fd = open (Memc[fname], READ_ONLY, BINARY_FILE)
+
+	# Get savefile header.
+	call salloc (sv, LEN_SVDES, TY_STRUCT)
+	if (miireadi (fd, Memi[sv], LEN_SVDES) != LEN_SVDES)
+	    goto err_
+
+	# Verify file type.
+	if (SV_MAGIC(sv) != PLIO_SVMAGIC)
+	    goto err_
+
+	# Get descriptive text.
+	call salloc (text, SV_TITLELEN(sv), TY_CHAR)
+	if (miireadc (fd, Memc[text], SV_TITLELEN(sv)) != SV_TITLELEN(sv))
+	    goto err_
+	else
+	    call strcpy (Memc[text], title, maxch)
+
+	# Get encoded mask.
+	call salloc (bp, SV_MASKLEN(sv), TY_SHORT)
+	iferr (nchars = read (fd, Mems[bp], SV_MASKLEN(sv) * SZ_SHORT))
+	    goto err_
+	call close (fd)
+
+	iferr (call pl_load (pl, bp))
+	    goto err_
+
+	call sfree (sp)
+	return
+err_
+	call close (fd)
+	call syserrs (SYS_PLBADSAVEF, Memc[fname])
+end
diff --git a/sys/plio/plloadim.x b/sys/plio/plloadim.x
new file mode 100644
index 00000000..6fc45adc
--- /dev/null
+++ b/sys/plio/plloadim.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<plset.h>
+include	<plio.h>
+
+# PL_LOADIM -- Load a mask stored as a conventional image, i.e., convert an
+# image to a mask.
+
+procedure pl_loadim (pl, imname, title, maxch)
+
+pointer	pl			#I mask descriptor
+char	imname[ARB]		#I image name or section
+char	title[ARB]		#O mask title
+int	maxch			#I max chars out
+
+bool	sampling
+pointer	im, px, im_pl, bp
+long	vs_l[PL_MAXDIM], vs_p[PL_MAXDIM]
+long	ve_l[PL_MAXDIM], ve_p[PL_MAXDIM]
+int	npix, naxes, maxdim, maxval, depth, sz_buf, i
+long	v_in[PL_MAXDIM], v_out[PL_MAXDIM], vn[PL_MAXDIM]
+
+pointer	immap()
+int	imgnli(), imstati(), im_pmsvhdr()
+errchk	immap, imgnli
+
+begin
+	# Open the input image.
+	im = immap (imname, READ_ONLY, 0)
+
+	# Encode and output the image header.
+	bp = NULL;  i = im_pmsvhdr (im, bp, sz_buf)
+	call strcpy (Memc[bp], title, maxch)
+	call mfree (bp, TY_CHAR)
+
+	# Determine the mask depth in bits.
+	maxval = IM_MAX(im)
+	if (maxval <= 0)
+	    maxval = I_PVMAX
+	do i = 0, ARB
+	    if (2**i > min (I_PVMAX, maxval)) {
+		depth = i
+		break
+	    }
+
+	# Initialize the mask to the size of the image section.
+	npix = IM_LEN(im,1)
+	naxes = IM_NDIM(im)
+	maxdim = min (IM_MAXDIM, PL_MAXDIM)
+	call amovl (IM_LEN(im,1), vn, maxdim)
+	call pl_ssize (pl, naxes, vn, depth)
+
+	# If the image is already a mask internally, check whether any
+	# subsampling, axis flipping, or axis mapping is in effect.
+	# If so we can't use PLIO to copy the mask section.
+
+	im_pl = imstati (im, IM_PLDES)
+	sampling = false
+
+	if (im_pl != NULL) {
+	    call amovkl (long(1), vs_l, maxdim)
+	    call amovl (IM_LEN(im,1), ve_l, maxdim)
+	    call imaplv (im, vs_l, vs_p, maxdim)
+	    call imaplv (im, ve_l, ve_p, maxdim)
+
+	    do i = 1, maxdim {
+		vn[i] = ve_l[i] - vs_l[i] + 1
+		if (vn[i] != ve_p[i] - vs_p[i] + 1) {
+		    sampling = true
+		    break
+		}
+	    }
+	}
+
+	# If the source image is already a mask internally and no axis
+	# geometry is in effect in the image section (if any), then we can
+	# use a PLIO rasterop to efficiently copy the mask subsection.
+
+	if (im_pl != NULL && !sampling) {
+	    # Copy a mask subsection (or entire image if no section).
+	    call pl_rop (im_pl, vs_p, pl, vs_l, vn, PIX_SRC)
+
+	} else {
+	    # Copy image pixels.  Initialize the vector loop indices.
+	    call amovkl (long(1), v_in, maxdim)
+	    call amovkl (long(1), v_out, maxdim)
+
+	    # Copy the image.
+	    while (imgnli (im, px, v_in) != EOF) {
+		call pl_plpi (pl, v_out, Memi[px], 0, npix, PIX_SRC)
+		call amovl (v_in, v_out, maxdim)
+	    }
+	}
+
+	call pl_compress (pl)
+	call imunmap (im)
+end
diff --git a/sys/plio/plloop.x b/sys/plio/plloop.x
new file mode 100644
index 00000000..500dc8bb
--- /dev/null
+++ b/sys/plio/plloop.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PLLOOP -- Increment the vector V from VS to VE (nested do loops cannot
+# be used because of the variable number of dimensions).  Return LOOP_DONE
+# when V exceeds VE.
+
+int procedure plloop (v, vs, ve, ndim)
+
+long	v[ndim]			#U vector giving current position in image
+long	vs[ndim]		#I start vector
+long	ve[ndim]		#I end vector
+int	ndim			#I vector length
+
+int	i
+
+begin
+	do i = 2, ndim {
+	    v[i] = v[i] + 1
+	    if (v[i] > ve[i]) {
+		if (i < ndim)
+		    v[i] = vs[i]
+		else
+		    break
+	    } else
+		return (LOOP_AGAIN)
+	}
+
+	return (LOOP_DONE)
+end
diff --git a/sys/plio/pllpr.x b/sys/plio/pllpr.x
new file mode 100644
index 00000000..9a8d1684
--- /dev/null
+++ b/sys/plio/pllpr.x
@@ -0,0 +1,111 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PLL_PRINTS -- Print a line list on the given output stream.
+
+procedure pll_prints (ll, fd, label, firstcol, maxcols)
+
+short	ll[ARB]			#I line list
+int	fd			#I output file
+char	label[ARB]		#I line label
+int	firstcol		#I first column for output
+int	maxcols			#I width of formatted output
+
+pointer	sp, buf
+bool	skipword
+int	opcode, data
+int	ll_len, ll_first, col, ip, pv, x
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll)) {
+	    ll_len = OLL_LEN(ll)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll)
+	    ll_first = LL_FIRST(ll)
+	}
+
+	# Output the line label and advance to the first column.  If the label
+	# extends beyond the first column, start a new line.
+
+	call putline (fd, label)
+	col = strlen (label) + 1
+	if (col > firstcol)
+	    call pl_debugout (fd, "", col, firstcol, maxcols)
+
+	skipword = false
+	pv = 1
+	x = 1
+
+	# Decode the line list proper.
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll[ip])
+	    data   = I_DATA(ll[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		x = x + data
+		call sprintf (Memc[buf], SZ_FNAME, "Z%d")
+		    call pargi (data)
+	    case I_HN:
+		x = x + data
+		call sprintf (Memc[buf], SZ_FNAME, "H%d")
+		    call pargi (data)
+	    case I_PN:
+		x = x + data
+		call sprintf (Memc[buf], SZ_FNAME, "P%d")
+		    call pargi (data)
+
+	    case I_SH:
+		pv = (int(ll[ip+1]) * I_SHIFT) + data
+		skipword = true
+		call sprintf (Memc[buf], SZ_FNAME, "SH(%d)")
+		    call pargi (pv)
+	    case I_IH:
+		pv = pv + data
+		call sprintf (Memc[buf], SZ_FNAME, "IH%d(%d)")
+		    call pargi (data)
+		    call pargi (pv)
+	    case I_DH:
+		pv = pv - data
+		call sprintf (Memc[buf], SZ_FNAME, "DH%d(%d)")
+		    call pargi (data)
+		    call pargi (pv)
+
+	    case I_IS, I_DS:
+		x = x + 1
+		if (opcode == I_IS) {
+		    pv = pv + data
+		    call sprintf (Memc[buf], SZ_FNAME, "IS%d(%d)")
+			call pargi (data)
+			call pargi (pv)
+		} else {
+		    pv = pv - data
+		    call sprintf (Memc[buf], SZ_FNAME, "DS%d(%d)")
+			call pargi (data)
+			call pargi (pv)
+		}
+	    }
+
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcols)
+	}
+
+	call sprintf (Memc[buf], SZ_FNAME, "(%d,%d)")
+	    call pargi (x - 1)
+	    call pargi (pv)
+	call pl_debugout (fd, Memc[buf], col, firstcol, maxcols)
+
+	call pl_debugout (fd, "", col, firstcol, maxcols)
+	call sfree (sp)
+end
diff --git a/sys/plio/pllrop.x b/sys/plio/pllrop.x
new file mode 100644
index 00000000..2f5f1358
--- /dev/null
+++ b/sys/plio/pllrop.x
@@ -0,0 +1,271 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include "pllseg.h"
+include	<plio.h>
+
+# PL_LINEROP -- Rasterop operation between source and destination line lists.
+# The indicated rasterop operation is performed upon the source and destination
+# line lists, writing the result to LL_OUT, which is a copy of LL_DST except
+# for the region affected by the rasterop operation (note that the destination
+# line list cannot be edited in place since it may change size).
+
+procedure pl_linerop (ll_src, xs, src_maxval,
+		      ll_dst, ds, dst_maxval, ll_out, npix, rop)
+
+short	ll_src[ARB]		#I source line list
+int	xs			#I starting pixel index in src line list
+int	src_maxval		#I maximum pixel value, source mask
+short	ll_dst[ARB]		#I destination line list
+int	ds			#I starting pixel index in dst line list
+int	dst_maxval		#I maximum pixel value, dst mask
+short	ll_out[ARB]		#O output list (edited version of ll_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+int	segsize, v_src, v_dst, pv
+bool	need_src, need_dst, rop_enable
+int	o_op, o_iz, o_pv, o_np, o_hi, src_value
+int	opcode, data, nz, iz, x1, hi, dv, v, np, op, n, i
+int	d_src[LEN_PLLDES], d_dst[LEN_PLLDES]
+define	done_ 91
+
+begin
+	need_src = R_NEED_SRC(rop)
+	need_dst = R_NEED_DST(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Advance to the desired position in the source list, discarding
+	# the instructions once read.  The point XS may lie within the range
+	# of an instruction.
+
+	if (need_src) {
+	    x1 = 1
+	    pll_init (ll_src, d_src)
+	    do i = 1, ARB {
+		np = min (pll_nleft(d_src), xs - x1)
+		pll_getseg (ll_src, d_src, np, v_src)
+		x1 = x1 + np
+		if (x1 >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Copy DST to OUT, applying the rasterop in the region of NPIX pixels
+	# beginning at DS.  To simplify things (avoid pathological complexity
+	# in this case) we suffer some unnecessary unpacking and repacking
+	# of encoded line list instructions in the regions of the DST list
+	# which are simply copied.  This avoids the need for special treatment
+	# at the edges of the region to which the ROP applies.  ROP_ENABLE is
+	# false initially, true in the ROP region, and false again to the
+	# right.  The number of pixels in each region is given by SEGSIZE.
+
+	o_pv = -1
+	op = LL_CURHDRLEN + 1
+	segsize = ds - 1
+	rop_enable = false
+	x1 = 1;  iz = 1;  hi = 1
+	pll_init (ll_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been properly performed
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, pll_nleft(d_dst))
+	    if (need_src && rop_enable && pll_nleft(d_src) > 0)
+		np = min (np, pll_nleft(d_src))
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We always
+	    # have to read the DST list in order to copy the unmodified regions
+	    # to the output.  We read the SRC list and apply the rasterop only
+	    # in the region to which the ROP applies.
+
+	    pll_getseg (ll_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		# Get v_src.
+		if (need_src) {
+		    v_src = 0
+		    if (pll_nleft (d_src) > 0)
+			pll_getseg (ll_src, d_src, np, v_src)
+
+		    if (R_NOTSRC(rop)) {
+			v_src = not (v_src)
+			if (src_maxval != 0)
+			    v_src = and (v_src, src_maxval)
+		    }
+
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		}
+
+		# Get v_dst.
+		if (need_dst) {
+		    if (R_NOTDST(rop)) {
+			v_dst = not (v_dst)
+			if (dst_maxval != 0)
+			    v_dst = and (v_dst, dst_maxval)
+		    }
+		}
+
+		# Apply the rasterop.
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC, PIX_NOTSRC:
+		    pv = v_src
+		case PIX_DST, PIX_NOTDST:
+		    pv = v_dst
+		case PIX_SRC_AND_DST, PIX_SRC_AND_NOTDST, PIX_NOTSRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST, PIX_SRC_OR_NOTDST, PIX_NOTSRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, or map int
+		# to bool for the case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (dst_maxval, pv)
+
+	    } else
+		pv = v_dst
+
+
+	    if (pv == 0) {
+		if (pll_nleft (d_dst) <= 0) {
+		    # Output zeros at end of list.
+		    x1 = x1 + np
+		} else {
+		    # Keep going until we get a nonzero range.
+		    o_pv = 0
+		    x1 = x1 + np
+		    segsize = segsize - np
+		    next
+		}
+	    } else if (pv == o_pv) {
+		# Combine with previous range.
+		iz = o_iz
+		hi = o_hi
+		op = o_op
+		x1 = x1 - o_np
+		segsize = segsize + o_np
+		np = np + o_np
+		o_np = np
+	    } else {
+		# Save current range parameters.
+		o_op = op
+		o_np = np
+		o_iz = iz
+		o_hi = hi
+		o_pv = pv
+	    }
+
+	    # Encode an instruction to regenerate the current range of NP data
+	    # values of nonzero level PV, starting at X1.  In the most complex
+	    # case we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_out[op] = M_SH + and (pv, I_DATAMAX)
+			op = op + 1
+			ll_out[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_out[op] = M_DH + (-dv)
+			else
+			    ll_out[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_out[op-1]
+			    ll_out[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (n=nz;  n > 0;  n = n - I_DATAMAX) {
+		    ll_out[op] = M_ZN + min(I_DATAMAX,n)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_out[op-1] = ll_out[op-1] + M_PN + 1
+		    goto done_
+		}
+		# At end of list.
+		if (pv == 0)
+		    goto done_
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (n=np;  n > 0;  n = n - I_DATAMAX) {
+		ll_out[op] = M_HN + min(I_DATAMAX,n)
+		op = op + 1
+	    }
+done_
+	    segsize = segsize - np
+	    x1 = x1 + np
+	    iz = x1
+	}
+
+	# Update the line list header.
+	call amovs (ll_dst, ll_out, LL_CURHDRLEN)
+	LL_SETLEN(ll_out, op - 1)
+end
diff --git a/sys/plio/pllseg.h b/sys/plio/pllseg.h
new file mode 100644
index 00000000..2f358944
--- /dev/null
+++ b/sys/plio/pllseg.h
@@ -0,0 +1,56 @@
+# PLLSEG.H -- Macros for sequentially reading segments of a line list.
+#
+#	       pll_init (ll, descriptor)
+#      npix = pll_nleft (descriptor)
+#      val = pll_getseg (ll, descriptor, npix, value)
+#
+# pll_init	Initialize descriptor for sequential i/o from the linelist LL.
+# pll_nleft	Number of pixels left in the current line segment of constant
+#		  value.  Zero is returned at the EOL.
+# pll_getseg	Read NPIX pixels from the current segment, advancing to the
+#		  next segment automatically when the the current segment is
+#		  exhausted.
+#
+# The descriptor is an integer array, the contents of which are hidden from
+# the application using these macros.  This package uses the internal
+# procedure PLL_NEXTSEG, which is included in PL package library.
+
+# Range list i/o descriptor.
+define	LEN_PLLDES	7
+define	ld_nleft	$1[1]
+define	ld_value	$1[2]
+define	ld_x		$1[3]
+define	ld_ip		$1[4]
+define	ld_hi		$1[5]
+define	ld_next_nleft	$1[6]
+define	ld_next_value	$1[7]
+
+# PLL_INIT -- Initialize the linelist descriptor.
+define	(pll_init, {			# $1=ll $2=des
+	# ld_x($2) = 1
+	ld_hi($2) = 1
+	if (LL_OLDFORMAT($1))
+	    ld_ip($2) = OLL_FIRST
+	else
+	    ld_ip($2) = LL_FIRST($1)
+	ld_next_nleft($2) = 0
+	ld_nleft($2) = 0
+	call pll_nextseg ($1, $2)
+})
+
+# PLL_NLEFT -- Number of pixels left in the current segment.
+define	pll_nleft	ld_nleft($1)
+
+# PLL_GETSEG -- Read pixels from the current segment.
+define	(pll_getseg, {			# $1=ll $2=des $3=npix $4=value
+	$4 = ld_value($2)
+	# ld_x($2) = ld_x($2) + $3
+	ld_nleft($2) = ld_nleft($2) - $3
+	if (ld_nleft($2) <= 0)
+	    if (ld_next_nleft($2) > 0) {
+		ld_nleft($2) = ld_next_nleft($2)
+		ld_value($2) = ld_next_value($2)
+		ld_next_nleft($2) = 0
+	    } else
+		call pll_nextseg ($1, $2)
+})
diff --git a/sys/plio/pllsten.x b/sys/plio/pllsten.x
new file mode 100644
index 00000000..cfd125f3
--- /dev/null
+++ b/sys/plio/pllsten.x
@@ -0,0 +1,289 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include "pllseg.h"
+include	<plio.h>
+
+# PL_LINESTENCIL -- Rasterop operation between source and destination line
+# lists, reading the source and applying the rasterop only in the regions
+# specified by the stencil line list.  The stencil list is aligned with the
+# source list.
+
+procedure pl_linestencil (ll_src,xs,src_maxval, ll_dst,ds,dst_maxval,
+			  ll_stn,ss, ll_out, npix, rop)
+
+short	ll_src[ARB]		#I source line list
+int	xs			#I starting pixel index in src line list
+int	src_maxval		#I maximum pixel value, source mask
+short	ll_dst[ARB]		#I destination line list
+int	ds			#I starting pixel index in dst line list
+int	dst_maxval		#I maximum pixel value, destination mask
+short	ll_stn[ARB]		#I stencil line list
+int	ss			#I starting pixel index in stn line list
+short	ll_out[ARB]		#O output list (edited version of ll_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+bool	need_src, rop_enable
+int	o_op, o_iz, o_pv, o_np, o_hi
+int	segsize, v_src, v_dst, v_stn, pv, src_value
+int	opcode, data, x1, hi, dv, v, iz, nz, np, op, n, i
+int	d_src[LEN_PLLDES], d_dst[LEN_PLLDES], d_stn[LEN_PLLDES]
+define	copyout_ 91
+define	done_ 92
+
+begin
+	need_src = R_NEED_SRC(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1)
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = src_maxval
+
+	# Advance to the indicated position in the source list, discarding
+	# the instructions once read.  The point XS may lie within the range
+	# of an instruction.
+
+	if (need_src) {
+	    x1 = 1
+	    pll_init (ll_src, d_src)
+	    do i = 1, ARB {
+		np = min (pll_nleft(d_src), xs - x1)
+		pll_getseg (ll_src, d_src, np, v_src)
+		x1 = x1 + np
+		if (x1 >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Advance to the indicated position in the stencil list.  This causes
+	# the point SS in the stencil to be aligned with the point XS in the
+	# source.
+
+	if (need_src) {
+	    x1 = 1
+	    pll_init (ll_stn, d_stn)
+	    do i = 1, ARB {
+		np = min (pll_nleft(d_stn), xs - x1)
+		pll_getseg (ll_stn, d_stn, np, v_stn)
+		x1 = x1 + np
+		if (x1 >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Copy DST to OUT, applying the rasterop in the region of NPIX pixels
+	# beginning at DS.  To simplify things (avoid pathological complexity
+	# in this case) we suffer some unnecessary unpacking and repacking
+	# of encoded line list instructions in the regions of the DST list
+	# which are simply copied.  This avoids the need for special treatment
+	# at the edges of the region to which the ROP applies.  ROP_ENABLE is
+	# false initially, true in the ROP region, and false again to the
+	# right.  The number of pixels in each region is given by SEGSIZE.
+
+	o_pv = -1
+	op = LL_CURHDRLEN + 1
+	segsize = ds - 1
+	rop_enable = false
+	x1 = 1;  iz = 1;  hi = 1
+	pll_init (ll_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been performed properly
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, pll_nleft(d_dst))
+	    if (need_src && rop_enable && pll_nleft(d_src) > 0) {
+		np = min (np, pll_nleft(d_src))
+		if (pll_nleft (d_stn) > 0)
+		    np = min (np, pll_nleft(d_stn))
+	    }
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We always
+	    # have to read the DST list to copy it to the output.  We read the
+	    # SRC list and apply the rasterop only in the region to which the
+	    # ROP applies.
+
+	    pll_getseg (ll_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		if (need_src) {
+		    v_src = 0
+		    if (pll_nleft (d_src) > 0)
+			pll_getseg (ll_src, d_src, np, v_src)
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		    pll_getseg (ll_stn, d_stn, np, v_stn)
+		    if (v_stn == 0)
+			goto copyout_
+		}
+
+		# Compute the pixel value for the new output segment, given the
+		# source and destination pixel values and the rasterop supplied.
+
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC:
+		    pv = v_src
+		case PIX_DST:
+		    pv = v_dst
+		case PIX_NOTSRC:
+		    pv = not (v_src)
+		case PIX_NOTDST:
+		    pv = not (v_dst)
+		case PIX_SRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_SRC_AND_NOTDST:
+		    pv = and (v_src, not(v_dst))
+		case PIX_SRC_OR_NOTDST:
+		    pv = or (v_src, not(v_dst))
+		case PIX_NOTSRC_AND_DST:
+		    pv = and (not(v_src), v_dst)
+		case PIX_NOTSRC_OR_DST:
+		    pv = or (not(v_src), v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, handle the
+		# case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (dst_maxval, pv)
+
+	    } else
+copyout_	pv = v_dst
+
+	    if (pv == 0) {
+		if (pll_nleft (d_dst) <= 0) {
+		    # Output zeros at end of list.
+		    x1 = x1 + np
+		} else {
+		    # Keep going until we get a nonzero range.
+		    o_pv = 0
+		    x1 = x1 + np
+		    segsize = segsize - np
+		    next
+		}
+	    } else if (pv == o_pv) {
+		# Combine with previous range.
+		iz = o_iz
+		hi = o_hi
+		op = o_op
+		x1 = x1 - o_np
+		segsize = segsize + o_np
+		np = np + o_np
+		o_np = np
+	    } else {
+		# Save current range parameters.
+		o_op = op
+		o_np = np
+		o_iz = iz
+		o_hi = hi
+		o_pv = pv
+	    }
+
+	    # Encode an instruction to regenerate the current range of NP data
+	    # values of nonzero level PV, starting at X1.  In the most complex
+	    # case we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_out[op] = M_SH + and (pv, I_DATAMAX)
+			op = op + 1
+			ll_out[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_out[op] = M_DH + (-dv)
+			else
+			    ll_out[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_out[op-1]
+			    ll_out[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (n=nz;  n > 0;  n = n - I_DATAMAX) {
+		    ll_out[op] = M_ZN + min(I_DATAMAX,n)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_out[op-1] = ll_out[op-1] + M_PN + 1
+		    goto done_
+		}
+		# At end of list.
+		if (pv == 0)
+		    goto done_
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (n=np;  n > 0;  n = n - I_DATAMAX) {
+		ll_out[op] = M_HN + min(I_DATAMAX,n)
+		op = op + 1
+	    }
+done_
+	    segsize = segsize - np
+	    x1 = x1 + np
+	    iz = x1
+	}
+
+	# Update the line list header.
+	call amovs (ll_dst, ll_out, LL_CURHDRLEN)
+	LL_SETLEN(ll_out, op - 1)
+end
diff --git a/sys/plio/plnewcopy.x b/sys/plio/plnewcopy.x
new file mode 100644
index 00000000..a429bc6e
--- /dev/null
+++ b/sys/plio/plnewcopy.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_NEWCOPY -- Create a new, empty mask with the same size and depth
+# attributes as the reference mask.
+
+pointer procedure pl_newcopy (old_pl)
+
+pointer	old_pl			#I mask descriptor
+
+pointer	new_pl
+int	naxes, depth
+long	axlen[PL_MAXDIM]
+pointer	pl_open()
+errchk	pl_open
+
+begin
+	new_pl = pl_open (NULL)
+
+	call pl_gsize (old_pl, naxes, axlen, depth)
+	call pl_ssize (new_pl, naxes, axlen, depth)
+
+	PL_PRIVATE1(new_pl) = PL_PRIVATE1(old_pl)
+	PL_PRIVATE2(new_pl) = PL_PRIVATE2(old_pl)
+	PL_MAXLINE(new_pl)  = PL_MAXLINE(old_pl)
+
+	return (new_pl)
+end
diff --git a/sys/plio/plopen.x b/sys/plio/plopen.x
new file mode 100644
index 00000000..6510ebe5
--- /dev/null
+++ b/sys/plio/plopen.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PL_OPEN -- Open a mask.  If the input buffer pointer is NULL an inactive
+# mask descriptor is allocated, otherwise the pointer is taken to point to
+# an encoded mask, which is decoded and loaded to create an active descriptor.
+
+pointer procedure pl_open (smp)
+
+pointer	smp			#I stored mask pointer or NULL
+
+pointer	pl
+errchk	calloc, pl_load
+
+begin
+	# Allocate and initialize an inactive descriptor.
+	call calloc (pl, LEN_PLDES, TY_STRUCT)
+
+	call amovki (1, PL_PLANE(pl,1), PL_MAXDIM)
+	PL_MAGIC(pl) = PL_MAGICVAL
+	PL_LLINC(pl) = PL_STARTINC
+
+	# Load the saved mask, if any.
+	if (smp != NULL)
+	    call pl_load (pl, smp)
+
+	return (pl)
+end
diff --git a/sys/plio/plp2l.gx b/sys/plio/plp2l.gx
new file mode 100644
index 00000000..85a59507
--- /dev/null
+++ b/sys/plio/plp2l.gx
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_P2L -- Convert a pixel array to a line list.  The length of the list is
+# returned as the function value.
+
+int procedure pl_p2l$t (px_src, xs, ll_dst, npix)
+
+PIXEL	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+PIXEL	hi, pv, nv, zero
+int	xe, x1, iz, ip, op, np, nz, dv, v
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+
+	# Pack the pixel array into a line list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	iz = xs			# start index of range of zeros
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    } else if (pv == 0)
+		x1 = xe + 1
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    np = ip - x1 + 1
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    # The I_DATAMAX-1 limit is to allow adding M_PN+1 without
+	    # overflowing the range of the data segment.
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    x1 = ip + 1
+	    iz = x1
+	    pv = nv
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/plp2r.gx b/sys/plio/plp2r.gx
new file mode 100644
index 00000000..2e1d1984
--- /dev/null
+++ b/sys/plio/plp2r.gx
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_P2R -- Convert a pixel array to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_p2r$t (px_src, xs, rl, npix)
+
+PIXEL	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+PIXEL	rl[3,ARB]		#O destination range list
+int	npix			#I number of pixels to convert
+
+PIXEL	hi, pv, zero
+int	xe, x1, np, rn, nv, ip
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	rn = RL_FIRST
+
+	# Pack the pixel array into a range list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    }
+
+	    np = ip - x1 + 1
+
+	    # Output the new range.
+	    if (pv > 0) {
+		rl[1,rn] = x1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    x1 = ip + 1
+	    pv = nv
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/plplls.x b/sys/plio/plplls.x
new file mode 100644
index 00000000..8f8ca491
--- /dev/null
+++ b/sys/plio/plplls.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLLS -- Put a line segment input as a line list to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plls (pl, v, ll_src, ll_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	ll_src[ARB]		#I input line list
+int	ll_depth		#I line list depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+pointer	sp, ll_out, ll_dst
+pointer	pl_access()
+errchk	pl_access
+
+begin
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, ll_src)
+	else {
+	    call smark (sp)
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (ll_src, 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(ll_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/plplp.gx b/sys/plio/plplp.gx
new file mode 100644
index 00000000..01a3596c
--- /dev/null
+++ b/sys/plio/plplp.gx
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLP -- Put a line segment input as a pixel array to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plp$t (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_p2l$t()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the pixel array to a line list.
+	ll_len = pl_p2l$t (px_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(px_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plplr.gx b/sys/plio/plplr.gx
new file mode 100644
index 00000000..d33ba40c
--- /dev/null
+++ b/sys/plio/plplr.gx
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plr$t (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	rl_src[ARB]		#I input range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_r2l$t()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the range list to a line list.
+	ll_len = pl_r2l$t (rl_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(rl_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plpoint.x b/sys/plio/plpoint.x
new file mode 100644
index 00000000..de9b7ede
--- /dev/null
+++ b/sys/plio/plpoint.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+
+# PL_POINT -- Perform a rasterop operation on a single point in a line of a
+# 2-dimensional plane of a mask.  If the dimensionality of the mask exceeds 2,
+# the pl_setplane() procedure should be called first to define the plane of
+# the mask to be modified.
+
+procedure pl_point (pl, x, y, rop)
+
+pointer	pl			#I mask descriptor
+int	x			#I pixel to be modified
+int	y			#I line to be modified
+int	rop			#I rasterop defining operation
+
+long	v[PL_MAXDIM]
+int	npix, ll_len
+pointer	sp, ll_out, ll_reg, rl_out, ll_dst, op
+errchk	plvalid, pl_access, pl_linerop, pl_update
+pointer	pl_access()
+int	pl_r2li()
+
+begin
+	call plvalid (pl)
+	call amovl (PL_PLANE(pl,1), v, PL_MAXDIM)
+	v[2] = y
+
+	call smark (sp)
+	call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	call salloc (ll_reg, LL_CURHDRLEN + 6, TY_SHORT)
+	call salloc (rl_out, RL_FIRST * 3, TY_INT)
+
+	# Access the destination line in the mask.
+	ll_dst = pl_access (pl, v)
+
+	# Construct the edit-region list.
+	npix = 1
+	RLI_AXLEN(rl_out) = npix
+	RLI_LEN(rl_out) = RL_FIRST
+
+	op = rl_out + (RL_FIRST - 1) * 3
+	Memi[op+RL_XOFF] = 1
+	Memi[op+RL_NOFF] = npix
+	Memi[op+RL_VOFF] = 1
+
+	ll_len = pl_r2li (Memi[rl_out], 1, Mems[ll_reg], npix)
+
+	# Edit the affected line.
+	call pl_linerop (Mems[ll_reg], 1, 1, Mems[ll_dst], x, PL_MAXVAL(pl),
+	    Mems[ll_out], npix, rop)
+
+	# Update the edited line in the mask.
+	call pl_update (pl, v, Mems[ll_out])
+
+	# Compress the mask if excessive free space has accumulated.
+	if (PL_NEEDCOMPRESS(pl))
+	    call pl_compress (pl)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plpolygon.h b/sys/plio/plpolygon.h
new file mode 100644
index 00000000..764b32ae
--- /dev/null
+++ b/sys/plio/plpolygon.h
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+define	TOL		0.0001		# pixel units
+define	swapi		{tempi=$2;$2=$1;$1=tempi}
+define	swapr		{tempr=$2;$2=$1;$1=tempr}
+define	equal		(abs($1-$2)<TOL)
+
+define	LEN_PGONDES	7
+define	P_PL		Memi[$1]	# pointer to X vector
+define	P_XP		Memi[$1+1]	# pointer to X vector
+define	P_YP		Memi[$1+2]	# pointer to Y vector
+define	P_OO		Memi[$1+3]	# pointer to previous range list
+define	P_OY		Memi[$1+4]	# y value of previous range list
+define	P_NS		Memi[$1+5]	# number of line segments
+define	P_PV		Memi[$1+6]	# pixel value
diff --git a/sys/plio/plpolygon.x b/sys/plio/plpolygon.x
new file mode 100644
index 00000000..dc249b88
--- /dev/null
+++ b/sys/plio/plpolygon.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plpolygon.h"
+
+
+# PL_POLYGON -- Perform a rasterop operation on the area enclosed by a polygon
+# drawn in a 2-dimensional plane of a mask.  If the dimensionality of the mask
+# exceeds 2, the pl_setplane() procedure should be called first to define the
+# plane of the mask to be modified.
+
+procedure pl_polygon (pl, x, y, npts, rop)
+
+pointer	pl			#I mask descriptor
+int	x[npts]			#I polygon x-vertices
+int	y[npts]			#I polygon y-vertices
+int	npts			#I number of points in polygon
+int	rop			#I rasterop defining operation
+
+int	line_1, line_2, i
+pointer	sp, ufd, xp, yp, oo
+extern	pl_upolygon()
+errchk	plvalid
+
+begin
+	call plvalid (pl)
+	if (npts <= 0)
+	    return
+	else if (npts == 1) {
+	    call pl_point (pl, x[1], y[1], rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (ufd, LEN_PGONDES, TY_STRUCT)
+	call salloc (oo, RL_FIRST + (npts+1)*3, TY_INT)
+	call salloc (xp, npts + 1, TY_REAL)
+	call salloc (yp, npts + 1, TY_REAL)
+
+	# Initialize the region descriptor.
+	P_PL(ufd) = pl
+	P_XP(ufd) = xp
+	P_YP(ufd) = yp
+	P_PV(ufd) = 1
+	P_OO(ufd) = oo
+	P_OY(ufd) = -1
+	P_NS(ufd) = npts - 1
+	RLI_LEN(oo) = 0
+
+	# Copy the user supplied polygon vertices into the descriptor,
+	# normalizing the polygon in the process.
+
+	do i = 1, npts {
+	    Memr[xp+i-1] = x[i]
+	    Memr[yp+i-1] = y[i]
+	}
+
+	if (npts > 2)
+	    if (abs(x[1]-x[npts]) > TOL || abs(y[1]-y[npts]) > TOL) {
+		Memr[xp+npts] = x[1]
+		Memr[yp+npts] = y[1]
+		P_NS(ufd) = npts
+	    }
+
+	# Compute the range in Y in which the polygon should be drawn.
+	call alimi (y, npts, line_1, line_2)
+
+	call pl_regionrop (pl, pl_upolygon, ufd, line_1, line_2, rop)
+	call sfree (sp)
+end
diff --git a/sys/plio/plprop.gx b/sys/plio/plprop.gx
new file mode 100644
index 00000000..60d1c603
--- /dev/null
+++ b/sys/plio/plprop.gx
@@ -0,0 +1,177 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_PIXROP -- Rasterop between source and destination pixel arrays.
+
+procedure pl_pixrop$t (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+
+PIXEL	px_src[ARB]		#I source pixel array
+int	xs			#I starting pixel index in src
+int	src_maxval		#I max pixel value in src mask
+PIXEL	px_dst[ARB]		#O destination pixel array
+int	ds			#I starting pixel index in dst
+int	dst_maxval		#I max pixel value in dst mask
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+pointer	sp, src
+int	opcode, i
+PIXEL	data, ceil, src_value
+int	and(), or(), xor(), not()
+define	out_ 91
+
+begin
+	opcode = R_OPCODE(rop)
+	data   = R_DATA(rop)
+	ceil   = 0
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Handle the easy cases first.
+	switch (opcode) {
+	case PIX_CLR:
+	    call aclr$t (px_dst[ds], npix)
+	    return
+	case PIX_SET:
+	    call amovk$t (data, px_dst[ds], npix)
+	    goto out_
+	case PIX_SRC:
+	    if (src_maxval != 1)
+		call amov$t (px_src[xs], px_dst[ds], npix)
+	    else {
+		do i = 1, npix
+		    if (px_src[xs+i-1] > 0)
+			px_dst[ds+i-1] = src_value
+		    else
+			px_dst[ds+i-1] = 0
+	    }
+
+	    goto out_
+	case PIX_DST:
+	    return	# no-op
+	}
+
+	# Integer or boolean source mask?
+	if (src_maxval != 1) {
+	    # Integer source mask; operate directly on source mask.
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_src[xs+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (px_src[xs+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(px_src[xs+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(px_src[xs+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (px_src[xs+i-1], px_dst[ds+i-1]))
+	    }
+
+	} else {
+	    # Boolean source mask; use integer DATA value from ROP if source
+	    # mask pixel is set.
+
+	    call smark (sp)
+	    call salloc (src, npix, TY_PIXEL)
+
+	    do i = 1, npix
+		if (px_src[xs+i-1] > 0)
+		    Mem$t[src+i-1] = src_value
+		else
+		    Mem$t[src+i-1] = 0
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (Mem$t[src+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mem$t[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mem$t[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (Mem$t[src+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mem$t[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mem$t[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(Mem$t[src+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(Mem$t[src+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    }
+
+	    call sfree (sp)
+	}
+out_
+	# If writing to an integer mask, mask the data to the indicated max
+	# value (necessary to avoid very large values if any NOT operations
+	# occurred).  If writing to a boolean mask, map positive integer mask
+	# values to 1.
+
+	if (dst_maxval == 1) {
+	    data = 1
+	    call argt$t (px_dst[ds], npix, ceil, data)
+	} else if (dst_maxval > 1) {
+	    data = dst_maxval
+	    call aandk$t (px_dst[ds], data, px_dst[ds], npix)
+	}
+end
diff --git a/sys/plio/plr2l.gx b/sys/plio/plr2l.gx
new file mode 100644
index 00000000..d0a98e92
--- /dev/null
+++ b/sys/plio/plr2l.gx
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2L -- Convert a range list to a line list.  The length of the output
+# line list is returned as the function value.
+
+int procedure pl_r2l$t (rl_src, xs, ll_dst, npix)
+
+PIXEL	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+PIXEL	hi, pv
+int	last, xe, x1, x2, iz, op, np, nz, nr, dv, v, i
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+	iz = xs
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr + 1 {
+	    if (i <= nr) {
+		# Load next range.
+		x1 = rl_src[1,i]
+		np = rl_src[2,i]
+		pv = rl_src[3,i]
+		x2 = x1 + np - 1
+		last = x2
+
+		# Get an inbounds range.
+		if (x1 > xe)
+		    break
+		else if (xs > x2)
+		    next
+		else if (x1 < xs)
+		    x1 = xs
+		else if (x2 > xe)
+		    x2 = xe
+
+		# Go again if nothing inbounds.
+		nz = x1 - iz
+		np = x2 - x1 + 1
+		if (np <= 0)
+		    next
+
+	    } else if (iz < xe) {
+		# At end of input range list, but need to output a ZN.
+		nz = xe - iz + 1
+		np = 0
+		pv = 0
+	    } else
+		break
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0 && x2 == last) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    iz = x2 + 1
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/plr2p.gx b/sys/plio/plr2p.gx
new file mode 100644
index 00000000..fa0eecda
--- /dev/null
+++ b/sys/plio/plr2p.gx
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2P -- Convert a range list to a pixel array.  The number of pixels
+# output (always npix) is returned as the function value.
+
+int procedure pl_r2p$t (rl_src, xs, px_dst, npix)
+
+PIXEL	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+PIXEL	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+PIXEL	hi, pv
+int	xe, x1, x2, iz, op, np, nz, nr, i, j
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	iz = xs
+	op = 1
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr {
+	    x1 = rl_src[1,i]
+	    np = rl_src[2,i]
+	    pv = rl_src[3,i]
+	    x2 = x1 + np - 1
+
+	    # Get an inbounds range.
+	    if (x1 > xe)
+		break
+	    else if (xs > x2)
+		next
+	    else if (x1 < xs)
+		x1 = xs
+	    else if (x2 > xe)
+		x2 = xe
+		
+	    nz = x1 - iz
+	    np = x2 - x1 + 1
+	    if (np <= 0)
+		next
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		do j = 1, nz
+		    px_dst[op+j-1] = 0
+		op = op + nz
+	    }
+
+	    # Output the pixels.
+	    do j = 1, np
+		px_dst[op+j-1] = pv
+	    op = op + np
+done_
+	    x1 = x2 + 1
+	    iz = x1
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/plregrop.x b/sys/plio/plregrop.x
new file mode 100644
index 00000000..6e37183a
--- /dev/null
+++ b/sys/plio/plregrop.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+
+# PL_REGIONROP -- Perform a rasterop operation on an irregular region in a
+# 2-dimensional plane of a mask.  The boundary of the region is defined by
+# a user supplied function which, given the line number (Y) returns a range
+# list defining the region for that line.
+#
+#	rl_new = ufcn (ufd, y, rl_out, xs, npix)
+#
+# where
+#	rl_new	= true if range list for line Y is different than for Y-1
+#	ufd	= user region descriptor (parameters defining region)
+#	y	= input y value
+#	rl_out 	= output range list
+#	xs	= first pixel to be edited in dst mask
+#	npix	= number of pixels in edit region
+#
+# If the dimensionality of the mask exceeds 2, the pl_setplane() procedure
+# should be called first to define the plane of the mask to be modified.
+
+procedure pl_regionrop (pl, ufcn, ufd, y1, y2, rop)
+
+pointer	pl			#I mask descriptor
+extern	ufcn()			#I user supplied region tracing procedure
+pointer	ufd			#I user region descriptor
+int	y1			#I first mask line to be modified
+int	y2			#I last mask line to be modified
+int	rop			#I rasterop defining operation
+
+bool	rl_new
+long	v[PL_MAXDIM]
+int	ll_len, xs, npix
+pointer	sp, ll_out, ll_reg, ll_dst, ol_dst, rl_out
+pointer	pl_access()
+int	pl_r2li()
+bool	ufcn()
+errchk	plvalid
+
+begin
+	call plvalid (pl)
+
+	call smark (sp)
+	call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	call salloc (ll_reg, LL_MAXLEN(pl), TY_SHORT)
+	call salloc (rl_out, RL_MAXLEN(pl), TY_INT)
+
+	call amovl (PL_PLANE(pl,1), v, PL_MAXDIM)
+	ol_dst = 1
+
+	for (v[2]=y1;  v[2] <= y2;  v[2]=v[2]+1) {
+	    ll_dst = pl_access (pl, v)
+	    rl_new = ufcn (ufd, v[2], Memi[rl_out], xs, npix)
+	    if (rl_new)
+		ll_len = pl_r2li (Memi[rl_out], 1, Mems[ll_reg], npix)
+
+	    if (ll_dst != ol_dst || rl_new) {
+	    call pl_linestencil (Mems[ll_reg],  1, 1,
+				 Mems[ll_dst], xs, PL_MAXVAL(pl),
+				 Mems[ll_reg],  1,
+				 Mems[ll_out], npix, rop)
+		ol_dst = ll_dst
+	    }
+
+	    # Update the affected line of the destination mask.
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	# Compress the mask if excessive free space has accumulated.
+	if (PL_NEEDCOMPRESS(pl))
+	    call pl_compress (pl)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plreq.gx b/sys/plio/plreq.gx
new file mode 100644
index 00000000..470b4484
--- /dev/null
+++ b/sys/plio/plreq.gx
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+
+# PLR_EQUAL -- Compare two range lists for equality.
+
+bool procedure plr_equal$t (r1, r2)
+
+PIXEL	r1[3,ARB]			#I range list 1
+PIXEL	r2[3,ARB]			#I range list 2
+
+int	i
+int	len1, len2
+
+begin
+	len1 = RL_LEN(r1)
+	len2 = RL_LEN(r2)
+
+	if (len1 != len2)
+	    return (false)
+
+	do i = RL_FIRST, len1
+	    if (r1[1,i] != r2[1,i] || r1[2,i] != r2[2,i] || r1[3,i] != r2[3,i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/plio/plrio.x b/sys/plio/plrio.x
new file mode 100644
index 00000000..0cf2b8d9
--- /dev/null
+++ b/sys/plio/plrio.x
@@ -0,0 +1,350 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plio.h>
+
+.help PLRIO
+.nf ---------------------------------------------------------------------------
+PLRIO -- A small package used to provide a means for efficient random
+sampling (at the pixel level) of large PLIO masks.  In other words, if we have
+a large mask and want to determine the values of successive mask pixels at
+random locations in the mask, this package provides a more efficient means
+for doing so than calling a routine such as PL_GLPI.  The mask must already
+exist; means are not provided within this package for creating or editing
+masks, only for reading them.
+
+		 plr = plr_open (pl, plane, buflimit)
+		    plr_setrect (plr, x1,y1, x2,y2)
+	      mval = plr_getpix (plr, x, y)
+		     plr_getlut (plr, bufp, xsize,ysize, xblock,yblock)
+		      plr_close (plr)
+
+PLR_OPEN opens the indicated 2 dimensional plane of the N dimensional mask PL.
+Buffer space used to provide an efficient means of randomly sampling the mask
+will be kept to within approximately BUFLIMIT integer units of storage (the
+internal table used to sample the mask is type integer, so BUFLIMIT is the
+approximate number of entries in the table).  Random sampling of the mask is
+provided by the integer function PLR_GETPIX, which returns the mask value at
+the point [i,j] within the specified plane.  PLR_SETRECT may be called before
+calling PLR_GETPIX to set the clipping rectangle, which defaults to the
+boundaries of the mask.  If a PLR_GETPIX call references outside the clipping
+region, ERR will be returned as the mask value (normal mask values are >= 0).
+Use of a clipping region other than the boundaries of the full mask can avoid
+the need for redundant clipping operations in the client.  For cases when
+even the function call overhead of PLR_GETPIX is too much, the lookup table
+may be directly accessed via a call to PLR_GETLUT.  Table references which
+resolve to a negative valued table entry should call PLR_GETPIX to get the
+mask value, otherwise the table value is the mask value.  PLR_CLOSE should
+be called to free the PLRIO table space (which can be extensive) when no longer
+needed.
+.endhelp ----------------------------------------------------------------------
+
+define	DEF_BUFLIMIT	(128*128)		# internal buffer size
+define	LEN_STACK	(4*32)			# max mask size = 2**LEN_STACK
+
+# If any of the following are changed check that pmio$pmrio.x is consistent.
+define	LEN_PLRDES	20
+define	PLR_PL		Memi[$1]		# main PLIO descriptor
+define	PLR_NCOLS	Memi[$1+1]		# table width
+define	PLR_NLINES	Memi[$1+2]		# table height
+define	PLR_XBLOCK	Memi[$1+3]		# table blocking factor, X
+define	PLR_YBLOCK	Memi[$1+4]		# table blocking factor, Y
+define	PLR_BUFP	Memi[$1+5]		# buffer pointer
+define	PLR_X1		Memi[$1+6]		# clipping rectangle
+define	PLR_Y1		Memi[$1+7]		# clipping rectangle
+define	PLR_X2		Memi[$1+8]		# clipping rectangle
+define	PLR_Y2		Memi[$1+9]		# clipping rectangle
+define	PLR_PLANE	Memi[$1+10+($2)-1]	# plane to be accessed
+
+define	COMPLEX		-1			# table bin -> compex region
+define	LEN_REGDES	4			# region descriptor
+define	V1		Memi[$1+($2)-1]
+define	V2		Memi[$1+2+($2)-1]
+
+
+# PLR_OPEN -- Open a PLIO mask for random pixel access.  Provides efficient
+# random pixel level access to any size mask.  This is a 2-dimensional
+# operator, but can be used to sample any 2-dim plane of an N-dim mask.
+
+pointer procedure plr_open (pl, plane, buflimit)
+
+pointer	pl			#I PLIO descriptor
+int	plane[ARB]		#I 2-dim plane to be accessed
+int	buflimit		#I approximate table size, or 0 if don't care
+
+int	v1[PL_MAXDIM], v2[PL_MAXDIM]
+int	maxpix, ndim, npix, mval, i, j
+int	msize[2], tsize[2], block[2], vm[2]
+pointer	sp, stack, plr, bufp, el, rp
+errchk	calloc, malloc, plvalid
+bool	pl_sectnotconst()
+
+begin
+	call plvalid (pl)
+	call smark (sp)
+	call salloc (stack, LEN_STACK * LEN_REGDES, TY_STRUCT)
+
+	# Allocate the PLRIO descriptor.
+	call calloc (plr, LEN_PLRDES, TY_STRUCT)
+
+	# Set the plane to be accessed.
+	ndim = PL_NAXES(pl)
+	do i = 1, 2
+	    msize[i] = PL_AXLEN(pl,i)
+
+	do i = 1, PL_MAXDIM
+	    if (i > ndim) {
+		PLR_PLANE(pl,i) = 1
+		v1[i] = 1
+		v2[i] = 1
+	    } else if (i > 2) {
+		PLR_PLANE(pl,i) = plane[i]
+		v1[i] = plane[i]
+		v2[i] = plane[i]
+	    }
+
+	# Get the maximum table size in pixels.
+	if (buflimit <= 0)
+	    maxpix = DEF_BUFLIMIT
+	else
+	    maxpix = buflimit
+
+	# Determine the blocking factors required to keep the lookup table
+	# within the given size limit.
+
+	block[1] = 1;  block[2] = 1
+	while ((msize[1] / block[1]) * (msize[2] / block[2]) > maxpix)
+	    do i = 1, 2
+		block[i] = min (msize[i], block[i]*2)
+
+	# Compute the lookup table size.
+	do i = 1, 2
+	    tsize[i]  = (msize[i] + block[i]-1) / block[i]
+
+	# Allocate the table space.
+	call malloc (bufp, tsize[1] * tsize[2], TY_INT)
+
+	# Compute the lookup table.  Since the lookup table can be large,
+	# e.g., a quarter million elements for a 512sq table, we don't want
+	# to directly compute the value of each bufp[i,j].  Instead, we examine
+	# a region of the table, starting with the entire table, and if the
+	# corresponding region of the mask is not filled with the same mask
+	# value, we divide the region into 4 quadrants and examine each in
+	# turn, and so on until the nonconstant regions are the size of one
+	# table bin (pixel), which we conclude maps to a COMPLEX (nonconstant)
+	# region of the mask.  By this technique, only table bins which map
+	# to complex mask regions need be evaluated, and entire large regions
+	# of the mask are quickly dealt with.
+
+	# Push the entire mask area on the stack as the first region.
+	el = stack
+	do i = 1, 2 {
+	    V1(el,i) = 1
+	    V2(el,i) = tsize[i]
+	}
+
+	repeat {
+	    # Get the mask coordinates of the next region on the stack.
+	    do i = 1, 2 {
+		v1[i] = (V1(el,i) - 1) * block[i] + 1
+		v2[i] = min (msize[i], V2(el,i) * block[i])
+	    }
+
+	    # Examine the region to see if the associated region of the mask
+	    # consists entirely of a single mask value.
+
+	    if (pl_sectnotconst (pl, v1, v2, ndim, mval)) {
+		if (V1(el,1) == V2(el,1) && V1(el,2) == V2(el,2)) {
+		    # This single table pixel maps to a complex mask region.
+		    Memi[bufp+(V1(el,2)-1)*tsize[1]+V1(el,1)-1] = COMPLEX
+
+		} else {
+		    # Divide the nonzero mask region into four quadrants
+		    # and recursively examine each in turn.
+
+		    # Compute the coordinates of the central pixel in vm.
+		    do i = 1, 2
+			vm[i] = (V1(el,i) + V2(el,i) + 1) / 2
+
+		    # Save the currently stacked region in v1/v2.
+		    v1[1] = V1(el,1);  v1[2] = V1(el,2)
+		    v2[1] = V2(el,1);  v2[2] = V2(el,2)
+
+		    if ((el-stack)/LEN_REGDES+4 >= LEN_STACK)
+			call syserrs (SYS_PLSTKOVFL, "plr_open")
+
+		    # Push the four quadrants of this region on the stack.
+		    # If the region we are subdividing is only one pixel
+		    # wide in either axis then only two of the regions will
+		    # be valid.  The invalid regions will have zero pixels
+		    # in one axis or the other, i.e. (v2[i] < v1[i]).  If
+		    # a region is invalid discard it by not advancing the
+		    # stack pointer.
+
+		    V1(el,1) = v1[1];    V1(el,2) = vm[2]
+		    V2(el,1) = vm[1]-1;  V2(el,2) = v2[2]
+		    if (V1(el,1) <= V2(el,1) && V1(el,2) <= V2(el,2))
+			el = el + LEN_REGDES
+
+		    V1(el,1) = vm[1];    V1(el,2) = vm[2]
+		    V2(el,1) = v2[1];    V2(el,2) = v2[2]
+		    if (V1(el,1) <= V2(el,1) && V1(el,2) <= V2(el,2))
+			el = el + LEN_REGDES
+		    
+		    V1(el,1) = v1[1];    V1(el,2) = v1[2]
+		    V2(el,1) = vm[1]-1;  V2(el,2) = vm[2]-1
+		    if (V1(el,1) <= V2(el,1) && V1(el,2) <= V2(el,2))
+			el = el + LEN_REGDES
+
+		    V1(el,1) = vm[1];    V1(el,2) = v1[2]
+		    V2(el,1) = v2[1];    V2(el,2) = vm[2]-1
+		    if (V1(el,1) <= V2(el,1) && V1(el,2) <= V2(el,2))
+			el = el + LEN_REGDES
+		}
+	    } else {
+		# Set entire region to a constant mask value.
+		npix = V2(el,1) - V1(el,1) + 1
+		do j = V1(el,2), V2(el,2) {
+		    rp = bufp + (j-1) * tsize[1] + V1(el,1) - 1
+		    if (npix == 1) {
+			Memi[rp] = mval
+		    } else if (npix < 8) {
+			do i = 1, npix
+			    Memi[rp+i-1] = mval
+		    } else {
+			if (mval == 0)
+			    call aclri (Memi[rp], npix)
+			else
+			    call amovki (mval, Memi[rp], npix)
+		    }
+		}
+	    }
+
+	    # Pop stack.
+	    el = el - LEN_REGDES
+
+	} until (el < stack)
+
+	# Initialize the PLRIO descriptor.
+	PLR_PL(plr) = pl
+	PLR_NCOLS(plr) = tsize[1]
+	PLR_NLINES(plr) = tsize[2]
+	PLR_XBLOCK(plr) = block[1]
+	PLR_YBLOCK(plr) = block[2]
+	PLR_BUFP(plr) = bufp
+	PLR_X1(plr) = 1
+	PLR_Y1(plr) = 1
+	PLR_X2(plr) = msize[1]
+	PLR_Y2(plr) = msize[2]
+
+	call sfree (sp)
+	return (plr)
+end
+
+
+# PLR_GETPIX -- Return the value of the given mask pixel, identified by the
+# 2-dim coordinates of the pixel relative to the plane of the N-dim mask
+# specified at open time.
+
+int procedure plr_getpix (plr, i, j)
+
+pointer	plr			#I PLR descriptor
+int	i, j			#I plane-relative coordinates of pixel
+
+pointer	pl, ll_src
+int	ii, jj, mval, np
+pointer	pl_access()
+int	pl_l2pi()
+errchk	pl_access
+
+begin
+	# Clip to the specified region of the mask.
+	if (i < PLR_X1(plr) || i > PLR_X2(plr))
+	    return (ERR)
+	if (j < PLR_Y1(plr) || j > PLR_Y2(plr))
+	    return (ERR)
+
+	# Map mask pixel coordinates to lookup table bin.
+	ii = (i - 1) / PLR_XBLOCK(plr)
+	jj = (j - 1) / PLR_YBLOCK(plr)
+
+	# Get the lookup table value of the given bin.
+	mval = Memi[PLR_BUFP(plr)+jj*PLR_NCOLS(plr)+ii]
+
+	# Access the original mask to get value if complex region.
+	if (mval == COMPLEX) {
+	    pl = PLR_PL(plr)
+	    PLR_PLANE(plr,2) = j
+	    ll_src = pl_access (pl, PLR_PLANE(plr,1))
+	    np = pl_l2pi (Mems[ll_src], i, mval, 1)
+	}
+
+	return (mval)
+end
+
+
+# PLR_GETLUT -- Obtain the buffer pointer and scaling information of the
+# internal lookup table, so that direct table references may be made to
+# minimize overhead in particularly demanding applications.  This is not
+# recommended unless absolutely necessary, as PLR_GETPIX is easier and
+# safer to use and nearly as efficient.  The strategy for using the table
+# is to use the blocking factors and XSIZE to map a 2dim mask coordinate
+# into a table offset, and access the table to get the table value.
+# If this is negative PLR_GETPIX should be called to compute the mask
+# value, else the table value is the mask value.
+
+procedure plr_getlut (plr, bufp, xsize,ysize, xblock,yblock)
+
+pointer	plr			#I PLR descriptor
+pointer	bufp			#O lookup table buffer pointer (int *)
+int	xsize,ysize		#O table size
+int	xblock,yblock		#O blocking factors
+
+begin
+	bufp = PLR_BUFP(plr)
+	xsize = PLR_NCOLS(plr)
+	ysize = PLR_NLINES(plr)
+	xblock = PLR_XBLOCK(plr)
+	yblock = PLR_YBLOCK(plr)
+end
+
+
+# PLR_SETRECT -- Set the clipping region for PLR_GETPIX.
+
+procedure plr_setrect (plr, x1,y1, x2,y2)
+
+pointer	plr			#I PLR descriptor
+int	x1,y1			#I lower left corner of region
+int	x2,y2			#I upper right corner of region
+
+pointer	pl
+define	oob_ 91
+errchk	syserrs
+
+begin
+	pl = PLR_PL(plr)
+
+	if (x1 < 1 || x1 > PL_AXLEN(pl,1))
+	    goto oob_
+	if (x2 < 1 || x2 > PL_AXLEN(pl,1))
+	    goto oob_
+	if (y1 < 1 || y1 > PL_AXLEN(pl,2))
+	    goto oob_
+	if (y2 < 1 || y2 > PL_AXLEN(pl,2))
+oob_	    call syserrs (SYS_PLREFOOB, "plr_setrect")
+
+	PLR_X1(plr) = x1;  PLR_Y1(plr) = y1
+	PLR_X2(plr) = x2;  PLR_Y2(plr) = y2
+end
+
+
+# PLR_CLOSE -- Free a PLRIO descriptor.
+
+procedure plr_close (plr)
+
+pointer	plr			#I PLR descriptor
+
+begin
+	call mfree (PLR_BUFP(plr), TY_INT)
+	call mfree (plr, TY_STRUCT)
+end
diff --git a/sys/plio/plrop.x b/sys/plio/plrop.x
new file mode 100644
index 00000000..b111a359
--- /dev/null
+++ b/sys/plio/plrop.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include <plset.h>
+include	<plio.h>
+
+# PL_ROP -- Perform a rasterop operation from the source mask to the
+# destination mask at the given offsets.  The source and destination need
+# not be the same size or dimensionality, but out of bounds references are
+# not permitted.  If the source is of lesser dimensionality than the
+# indicated section of the destination, then the source will be rewound
+# and reread as necessary to operate upon the entire destination subregion,
+# e.g., a line source mask may be applied to successive lines of a plane,
+# or a plane mask may be applied to successive planes of a 3D mask.
+# The source and destination masks may be the same if desired, but if the 
+# source and destination regions overlap feedback may occur (this could be
+# fixed).  With some rasterops, e.g, PIX_SET or PIX_CLR, no source mask is
+# required, and pl_src=NULL is permitted.
+
+procedure pl_rop (pl_src, vs_src, pl_dst, vs_dst, vn, rop)
+
+pointer	pl_src			#I source mask or NULL
+long	vs_src[PL_MAXDIM]	#I start vector in source mask
+pointer	pl_dst			#I destination mask (required)
+long	vs_dst[PL_MAXDIM]	#I start vector in destination mask
+long	vn[PL_MAXDIM]		#I vector giving subregion size
+long	rop			#I rasterop
+
+bool	need_src
+pointer	sp, ll_out, ll_src, ll_dst, ol_src, ol_dst
+long	v_src[PL_MAXDIM], v_dst[PL_MAXDIM]
+long	ve_src[PL_MAXDIM], ve_dst[PL_MAXDIM]
+
+int	plloop()
+pointer	pl_access()
+errchk	syserr, plvalid, plsslv, pl_access
+
+begin
+	call plvalid (pl_dst)
+	need_src = R_NEED_SRC(rop)
+	if (need_src && pl_src == NULL)
+	    call syserr (SYS_PLNULLSRC)
+
+	call smark (sp)
+	call salloc (ll_out, LL_MAXLEN(pl_dst), TY_SHORT)
+
+	# Initialize the N-dimensional loop counters.
+	call plsslv (pl_dst, vs_dst, vn, v_dst, ve_dst)
+	if (need_src)
+	    call plsslv (pl_src, vs_src, vn, v_src, ve_src)
+	else
+	    ll_src = ll_out	# any valid pointer will do
+
+	# Perform the operation.
+	ol_dst = -1
+	repeat {
+	    # Get a line from each mask.  The DST linelist is required,
+	    # even if R_NEED_DST(rop) is false, because the DST size
+	    # parameters determine the size of the output list, and the
+	    # rop may only apply to a portion of the DST list.
+
+	    ll_dst = pl_access (pl_dst, v_dst)
+	    if (need_src)
+		ll_src = pl_access (pl_src, v_src)
+
+	    # Perform the rasterop operation upon one line of the mask.
+	    # Note that if successive mask lines point to the same encoded
+	    # line list, we only have to compute the result once.
+
+	    if (ll_src != ol_src || ll_dst != ol_dst) {
+		call pl_linerop (Mems[ll_src], vs_src[1], PL_MAXVAL(pl_src),
+				 Mems[ll_dst], vs_dst[1], PL_MAXVAL(pl_dst),
+				 Mems[ll_out], vn[1], rop)
+		ol_src = ll_src
+		ol_dst = ll_dst
+	    }
+
+	    # Update the affected line of the destination mask.
+	    call pl_update (pl_dst, v_dst, Mems[ll_out])
+
+	    # If the end of the input mask is reached, rewind it and go again.
+	    if (need_src)
+		if (plloop (v_src,vs_src,ve_src,PL_NAXES(pl_src)) == LOOP_DONE)
+		    call amovi (vs_src, v_src, PL_NAXES(pl_src))
+
+	} until (plloop (v_dst, vs_dst, ve_dst, PL_NAXES(pl_dst)) == LOOP_DONE)
+
+	# Compress the mask if excessive free space has accumulated.
+	if (PL_NEEDCOMPRESS(pl_dst))
+	    call pl_compress (pl_dst)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plrpr.gx b/sys/plio/plrpr.gx
new file mode 100644
index 00000000..f0004515
--- /dev/null
+++ b/sys/plio/plrpr.gx
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PLR_PRINT -- Print a range list on the given output stream.
+
+procedure plr_print$t (rl, fd, label, firstcol, maxcol)
+
+PIXEL	rl[3,ARB]		#I range list
+int	fd			#I output file
+char	label[ARB]		#I line label
+int	firstcol		#I first column for output
+int	maxcol			#I width of formatted output
+
+pointer	sp, buf
+int	col, rn, r_len, x, n, pv
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Output the line label and advance to the first column.  If the label
+	# extends beyond the first column, start a new line.
+
+	call putline (fd, label)
+	col = strlen (label) + 1
+	if (col > firstcol)
+	    call pl_debugout (fd, "", col, firstcol, maxcol)
+
+	r_len = RL_LEN(rl)
+
+	# Decode the range list proper.
+	do rn = RL_FIRST, r_len {
+	    x  = RL_X(rl,rn)
+	    n  = RL_N(rl,rn)
+	    pv = RL_V(rl,rn)
+
+	    if (n == 1) {
+		call sprintf (Memc[buf], SZ_LINE, "%d(%d)")
+		    call pargi (x)
+		    call pargi (pv)
+	    } else {
+		call sprintf (Memc[buf], SZ_LINE, "%d-%d(%d)")
+		    call pargi (x)
+		    call pargi (x+n-1)
+		    call pargi (pv)
+	    }
+
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+	}
+
+	call pl_debugout (fd, "", col, firstcol, maxcol)
+	call sfree (sp)
+end
diff --git a/sys/plio/plrrop.gx b/sys/plio/plrrop.gx
new file mode 100644
index 00000000..dcc961b2
--- /dev/null
+++ b/sys/plio/plrrop.gx
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+include "../plrseg.h"
+
+# PL_RANGEROP -- Rasterop operation between source and destination range lists.
+# The indicated rasterop operation is performed upon the source and destination
+# range lists, writing the result to RL_OUT, which is a copy of RL_DST except
+# for the region affected by the rasterop operation (note that the destination
+# range list cannot be edited in place since it may change size).
+
+procedure pl_rangerop$t (rl_src, xs, src_maxval,
+			 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+
+PIXEL	rl_src[3,ARB]		#I source range list
+int	xs			#I starting pixel index in src range list
+int	src_maxval		#I max pixel value in src mask
+PIXEL	rl_dst[3,ARB]		#I destination range list
+int	ds			#I starting pixel index in dst range list
+int	dst_maxval		#I max pixel value in dst mask
+PIXEL	rl_out[3,ARB]		#O output list (edited version of rl_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+bool	need_src, need_dst, rop_enable
+PIXEL	data, src_value, v_src, v_dst, pv
+int	segsize, opcode, x, i, np, rn_o, p
+int	d_src[LEN_PLRDES], d_dst[LEN_PLRDES]
+
+begin
+	need_src = R_NEED_SRC(rop)
+	need_dst = R_NEED_DST(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Advance to the desired position in the source list, discarding
+	# the unused ranges.  The point XS may lie within a range or in a
+	# zero area of the input line.
+
+	if (need_src) {
+	    x = 1
+	    plr_init (rl_src, d_src)
+	    do i = 1, ARB {
+		np = min (plr_nleft(d_src), xs - x)
+		plr_getseg (rl_src, d_src, np, v_src)
+		x = x + np
+		if (x >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Advance through both the source and destination lists, extracting
+	# line segments which have a constant value in each input list; the
+	# values for the two lists may differ.  Apply the given rasterop to
+	# the source and destination pixel values and write each line segment
+	# as a range to the output list.  If the ranges in the two input lists
+	# differ (randomly overlap) then the output list will generally be
+	# more fragmented, i.e., have more ranges of constant value.  As each
+	# output range is generated compare it with the previous range to see
+	# if they can be joined, as applying a rasterop may cause two different
+	# ranges to have the same value.
+
+	x = 1
+	rn_o = RL_FIRST
+	segsize = ds - 1
+	rop_enable = false
+	plr_init (rl_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been properly performed
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, plr_nleft(d_dst))
+	    if (need_src && rop_enable && plr_nleft(d_src) > 0)
+		np = min (np, plr_nleft(d_src))
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We must
+	    # read the DST list whether or not we will use the data, since
+	    # the list pointer must be advanced NPIX pixels so that we may
+	    # copy the remainder of the list after the loop.
+
+	    plr_getseg (rl_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		# Get v_src.
+		if (need_src) {
+		    v_src = 0
+		    if (plr_nleft (d_src) > 0)
+			plr_getseg (rl_src, d_src, np, v_src)
+
+		    if (R_NOTSRC(rop)) {
+			v_src = not (v_src)
+			if (src_maxval != 0)
+			    v_src = and (int(v_src), src_maxval)
+		    }
+
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		}
+
+		# Get v_dst.
+		if (need_dst) {
+		    if (R_NOTDST(rop)) {
+			v_dst = not (v_dst)
+			if (dst_maxval != 0)
+			    v_dst = and (int(v_dst), dst_maxval)
+		    }
+		}
+
+		# Apply the rasterop.
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC, PIX_NOTSRC:
+		    pv = v_src
+		case PIX_DST, PIX_NOTDST:
+		    pv = v_dst
+		case PIX_SRC_AND_DST, PIX_SRC_AND_NOTDST, PIX_NOTSRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST, PIX_SRC_OR_NOTDST, PIX_NOTSRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, or map int
+		# to bool for the case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (int(pv), dst_maxval)
+
+	    } else
+		pv = v_dst
+
+	    # Output a nonzero range.
+	    if (pv > 0) {
+		p = rn_o - 1
+		if (p >= RL_FIRST &&
+		    pv == rl_out[3,p] && x == rl_out[1,p] + rl_out[2,p]) {
+		    # Merge new range with previous one.
+		    rl_out[2,p] = rl_out[2,p] + np
+		} else {
+		    rl_out[1,rn_o] = x
+		    rl_out[2,rn_o] = np
+		    rl_out[3,rn_o] = pv
+		    rn_o = rn_o + 1
+		}
+	    }
+
+	    x = x + np
+	    segsize = segsize - np
+	}
+
+	# Update the range list header.
+	call amov$t (rl_dst, rl_out, (RL_FIRST - 1) * 3)
+	RL_LEN(rl_out) = rn_o - 1
+end
diff --git a/sys/plio/plrseg.h b/sys/plio/plrseg.h
new file mode 100644
index 00000000..f37372c3
--- /dev/null
+++ b/sys/plio/plrseg.h
@@ -0,0 +1,58 @@
+# PLRSEG.H -- Macros for sequentially reading segments of a range list.
+#
+#	       plr_init (rl, descriptor)
+#      npix = plr_nleft (descriptor)
+#      val = plr_getseg (rl, descriptor, npix, value)
+#
+# plr_init	Initialize descriptor for sequential i/o from the rangelist RL.
+# plr_nleft	Number of pixels left in the current line segment of constant
+#		  value.  Zero is returned at the EOL.
+# plr_getseg	Read NPIX pixels from the current segment, advancing to the
+#		  next segment automatically when the the current segment is
+#		  exhausted.
+#
+# The descriptor is an integer array, the contents of which are hidden from
+# the application using these macros.
+
+# Range list i/o descriptor.
+define	LEN_PLRDES	4
+define	rd_nleft	$1[1]
+define	rd_value	$1[2]
+define	rd_x		$1[3]
+define	rd_rn		$1[4]
+
+# PLR_INIT -- Initialize the rangelist descriptor.
+define	(plr_init, {			# $1=rl $2=des
+	rd_x($2) = 1
+	rd_rn($2) = RL_FIRST
+	plr_nextseg ($1, $2)
+})
+
+# PLR_NLEFT -- Number of pixels left in the current segment.
+define	plr_nleft	rd_nleft($1)
+
+# PLR_GETSEG -- Read pixels from the current segment.
+define	(plr_getseg, {			# $1=rl $2=des $3=npix $4=value
+	$4 = rd_value($2)
+	rd_x($2) = rd_x($2) + $3
+	rd_nleft($2) = rd_nleft($2) - $3
+	if (rd_nleft($2) <= 0)
+	    plr_nextseg ($1, $2)
+})
+	
+# PLR_NEXTSEG -- Set up the next segment (internal routine).
+define	(plr_nextseg, {			# $1=rl $2=des
+	if (rd_rn($2) <= RL_LEN($1)) {
+	    if ($1[1,rd_rn($2)] > rd_x($2)) {
+		rd_value($2) = 0
+		rd_nleft($2) = $1[1,rd_x($2)] - rd_x($2)
+	    } else {
+		rd_value($2) = $1[3,rd_rn($2)]
+		rd_nleft($2) = $1[2,rd_rn($2)]
+		rd_rn($2) = rd_rn($2) + 1
+	    }
+	} else if (rd_x($2) <= RL_AXLEN($1)) {
+	    rd_value($2) = 0
+	    rd_nleft($2) = RL_AXLEN($1) - rd_x($2) + 1
+	}
+})
diff --git a/sys/plio/plsave.x b/sys/plio/plsave.x
new file mode 100644
index 00000000..1b0101d3
--- /dev/null
+++ b/sys/plio/plsave.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PL_SAVE -- Save a mask in a buffer in a machine independent format.  The user
+# supplied buffer will be resized if necessary to hold the full encoded mask.
+# If a NULL buffer pointer is given, a new buffer will be allocated with the
+# pointer value overwriting the NULL (hence NULL must not be passed as a
+# constant in the argument list).  The length of the encoded mask in words is
+# returned as the function value; this value will be less than BUFLEN is the
+# user supplied buffer is larger than it needs to be to store the mask, i.e.,
+# the user buffer is not resized or reallocated if it is large enough to store
+# the mask.  The existing contents of the buffer will be overwritten.  Multiple
+# calls may be made to checkpoint the mask, allowing rollback to an earlier
+# state.
+
+int procedure pl_save (pl, bp, buflen, flags)
+
+pointer	pl			#I mask descriptor
+pointer	bp			#U buffer pointer (to short), or NULL
+int	buflen			#U buffer length, shorts
+int	flags			#I not used at present
+
+pointer	sp, index, ex, op
+int	sz_index, n_buflen
+int	pl_p2li()
+pointer	coerce()
+errchk	malloc, realloc, pl_compress
+
+begin
+	call smark (sp)
+	call salloc (ex, LEN_PLEXTERN, TY_STRUCT)
+	call salloc (index, PL_NLP(pl) * 3 + LL_CURHDRLEN, TY_SHORT)
+
+	# Eliminate any wasted space in the mask, and compute the amount
+	# of space needed to store the compressed mask.  Compress the index
+	# first to eliminate wasted space; this can make a big difference
+	# for a sparse or empty mask.
+
+	call pl_compress (pl)
+	sz_index = pl_p2li (PL_LP(pl,1), 1, Mems[index], PL_NLP(pl))
+	#n_buflen = (LEN_PLEXTERN * SZ_STRUCT + PL_LLLEN(pl) * SZ_SHORT +
+	n_buflen = (LEN_PLEXTERN * SZ_MII_INT + PL_LLLEN(pl) * SZ_SHORT +
+	    sz_index * SZ_SHORT) / SZ_SHORT
+
+	# Allocate or resize the output buffer.
+	if (bp == NULL) {
+	    call malloc (bp, n_buflen, TY_SHORT)
+	    buflen = n_buflen
+	} else if (n_buflen > buflen) {
+	    call realloc (bp, n_buflen, TY_SHORT)
+	    buflen = n_buflen
+	}
+
+	# Encode and output the external format header structure.
+	call aclri (Memi[ex], LEN_PLEXTERN)
+
+	PLE_MAGIC(ex)	= PL_MAGIC(pl)
+	PLE_NAXES(ex)	= PL_NAXES(pl)
+	PLE_LLOP(ex)	= PL_LLOP(pl)
+	PLE_LLLEN(ex)	= PL_LLLEN(pl)
+	PLE_MAXLINE(ex) = PL_MAXLINE(pl)
+	PLE_MAXVAL(ex)  = PL_MAXVAL(pl)
+	PLE_NLP(ex)	= PL_NLP(pl)
+	PLE_NLPX(ex)	= sz_index
+	PLE_EXLEN(ex)	= n_buflen
+
+	op = bp
+	call amovl (PL_AXLEN(pl,1), PLE_AXLEN(ex,1), PL_MAXDIM)
+	call miipak32 (Memi[ex], Memi[coerce(op,TY_SHORT,TY_INT)],
+	    LEN_PLEXTERN, TY_STRUCT)
+	#op = op + (LEN_PLEXTERN * SZ_STRUCT) / SZ_SHORT
+	op = op + (LEN_PLEXTERN * SZ_MII_INT) / SZ_SHORT
+
+	# Append the compressed index...
+	call miipak16 (Mems[index], Mems[op], sz_index, TY_SHORT)
+	op = op + sz_index
+
+	# and the line list buffer.
+	call miipak16 (LL(pl,0), Mems[op], PL_LLLEN(pl), TY_SHORT)
+	op = op + PL_LLLEN(pl)
+
+	call sfree (sp)
+	return (op - bp)
+end
diff --git a/sys/plio/plsavef.x b/sys/plio/plsavef.x
new file mode 100644
index 00000000..25575e5f
--- /dev/null
+++ b/sys/plio/plsavef.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_SAVEF -- Store a mask in external format in a binary file.  This simple
+# code permits only one mask per file; more sophisticated mask storage
+# facilities are planned.  These will likely obsolete this routine.
+
+procedure pl_savef (pl, fname, title, flags)
+ 
+pointer	pl			#I mask descriptor
+char	fname[ARB]		#I file name
+char	title[ARB]		#I mask title
+int	flags			#I save flags
+
+int	fd, masklen, buflen, junk
+pointer	sp, fullname, extn, bp, sv
+errchk	open, pl_save, write, mfree
+int	open(), fnextn(), strlen(), pl_save()
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (sv, LEN_SVDES, TY_STRUCT)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+	call salloc (fullname, SZ_PATHNAME, TY_CHAR)
+
+	# Add the ".pl" filename extension if not already present.
+	call strcpy (fname, Memc[fullname], SZ_PATHNAME)
+	junk = fnextn (fname, Memc[extn], SZ_FNAME)
+	if (strne (Memc[extn], "pl"))
+	    call strcat (".pl", Memc[fullname], SZ_PATHNAME)
+
+	# The update flag is required to allow overwriting an existing mask.
+	if (and (flags, PL_UPDATE) != 0)
+	    iferr (call delete (Memc[fullname]))
+		;
+
+	# Encode the mask.
+	bp = NULL
+	masklen = pl_save (pl, bp, buflen, flags)
+
+	# Set up the savefile descriptor.
+	SV_MAGIC(sv) = PLIO_SVMAGIC
+	SV_TITLELEN(sv) = strlen (title) + 1
+	SV_MASKLEN(sv) = masklen
+
+	# Write the savefile.
+	fd = open (Memc[fullname], NEW_FILE, BINARY_FILE)
+
+	call miiwritei (fd, Memi[sv], LEN_SVDES)
+	call miiwritec (fd, title, SV_TITLELEN(sv))
+	call write (fd, Mems[bp], masklen * SZ_SHORT)
+	call mfree (bp, TY_SHORT)
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/plio/plsaveim.x b/sys/plio/plsaveim.x
new file mode 100644
index 00000000..8e1b4b54
--- /dev/null
+++ b/sys/plio/plsaveim.x
@@ -0,0 +1,122 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<mach.h>
+include	<plset.h>
+include	<plio.h>
+
+# PL_SAVEIM -- Save a mask in a conventional image, i.e., convert a mask to
+# an image.
+
+procedure pl_saveim (pl, imname, title, flags)
+
+pointer	pl			#I mask descriptor
+char	imname[ARB]		#I image name or section
+char	title[ARB]		#I mask "title" string
+int	flags			#I bitflags
+
+bool	sampling
+pointer	im, px, im_pl, bp
+int	npix, naxes, depth, maxdim, mode, i, locstr, locmem
+long	v_in[PL_MAXDIM], v_out[PL_MAXDIM], vn[PL_MAXDIM]
+long	vs_l[PL_MAXDIM], vs_p[PL_MAXDIM]
+long	ve_l[PL_MAXDIM], ve_p[PL_MAXDIM]
+
+pointer	immap()
+long	clktime()
+int	impnli(), imaccess(), imstati(), strlen()
+errchk	immap, syserrs, impnli
+
+begin
+	# Open the new output image.
+	mode = NEW_IMAGE
+	if (and (flags, PL_UPDATE) != 0)
+	    if (imaccess (imname, 0) == YES)
+		mode = READ_WRITE
+
+	im = immap (imname, mode, 0)
+
+	# Reload the image header from the "title" string, if any.
+	if (strlen(title) > 0) {
+	    call zlocva (title, locstr)
+	    call zlocva (Memc, locmem)
+	    bp = locstr - locmem + 1
+	    call im_pmldhdr (im, bp)
+	}
+
+	# Initialize a new image to the size of the mask.  If updating an
+	# existing image the sizes must match.
+
+	call pl_gsize (pl, naxes, vn, depth)
+	maxdim = min (IM_MAXDIM, PL_MAXDIM)
+	npix = vn[1]
+
+	if (mode == NEW_IMAGE) {
+	    IM_NDIM(im) = naxes
+	    IM_PIXTYPE(im) = TY_SHORT
+	    if (PL_MAXVAL(pl) > MAX_SHORT)
+		IM_PIXTYPE(im) = TY_INT
+	    call amovl (vn, IM_LEN(im,1), maxdim)
+	} else {
+	    if (naxes != IM_NDIM(im)) {
+		call imunmap (im)
+		call syserrs (SYS_IMPLSIZE, imname)
+	    }
+	    do i = 1, naxes
+		if (vn[i] != IM_LEN(im,i)) {
+		    call imunmap (im)
+		    call syserrs (SYS_IMPLSIZE, imname)
+		}
+	}
+
+	# If the image is already a mask internally, check whether any
+	# subsampling, axis flipping, or axis mapping is in effect.
+	# If so we can't use PLIO to copy the mask section.
+
+	im_pl = imstati (im, IM_PLDES)
+	sampling = false
+
+	if (im_pl != NULL) {
+	    call amovkl (long(1), vs_l, maxdim)
+	    call amovl (IM_LEN(im,1), ve_l, maxdim)
+	    call imaplv (im, vs_l, vs_p, maxdim)
+	    call imaplv (im, ve_l, ve_p, maxdim)
+
+	    do i = 1, maxdim {
+		vn[i] = ve_l[i] - vs_l[i] + 1
+		if (vn[i] != ve_p[i] - vs_p[i] + 1) {
+		    sampling = true
+		    break
+		}
+	    }
+	}
+
+	# If the source image is already a mask internally and no axis
+	# geometry is in effect in the image section (if any), then we can
+	# use a PLIO rasterop to efficiently copy the mask subsection.
+
+	if (im_pl != NULL && !sampling) {
+	    # Copy a mask subsection (or entire image if no section).
+	    call pl_rop (pl, vs_l, im_pl, vs_p, vn, PIX_SRC)
+	    call pl_compress (im_pl)
+
+	} else {
+	    # Copy image pixels.  Initialize the vector loop indices.
+	    call amovkl (long(1), v_in, maxdim)
+	    call amovkl (long(1), v_out, maxdim)
+
+	    # Copy the image.
+	    while (impnli (im, px, v_out) != EOF) {
+		call pl_glpi (pl, v_in, Memi[px], 0, npix, PIX_SRC)
+		call amovl (v_out, v_in, maxdim)
+	    }
+	}
+
+	IM_MIN(im) = 0
+	IM_MAX(im) = PL_MAXVAL(pl)
+	IM_LIMTIME(im) = clktime(0)
+
+	call imunmap (im)
+end
diff --git a/sys/plio/plsectnc.x b/sys/plio/plsectnc.x
new file mode 100644
index 00000000..7aba7fe6
--- /dev/null
+++ b/sys/plio/plsectnc.x
@@ -0,0 +1,113 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include "pllseg.h"
+include	<plio.h>
+
+# PL_SECTNOTCONST -- Test whether the indicated mask image section is constant,
+# i.e., all the pixels in the section have the same value.  Return this value
+# if the region is constant.
+
+bool procedure pl_sectnotconst (pl_src, v1, v2, ndim, mval)
+
+pointer	pl_src			#I mask descriptor
+long	v1[PL_MAXDIM]		#I starting coordinates of section
+long	v2[PL_MAXDIM]		#I ending coordinates of section
+int	ndim			#I section dimension
+int	mval			#O mask value, if constant region
+
+pointer	lp
+int	ll_src, lval, i
+long	v[PL_MAXDIM], vs[PL_MAXDIM], ve[PL_MAXDIM], vn[PL_MAXDIM]
+
+bool	pll_const()
+int	pl_reference(), plloop()
+errchk	plvalid, plsslv, pl_reference
+
+begin
+	call plvalid (pl_src)
+
+	# Initialize the N-dimensional loop counters.
+	do i = 1, PL_MAXDIM
+	    if (i <= ndim) {
+		if (v1[i] <= v2[i]) {
+		    vs[i] = v1[i]
+		    vn[i] = v2[i] - v1[i] + 1
+		} else {
+		    vs[i] = v2[i]
+		    vn[i] = v1[i] - v2[i] + 1
+		}
+	    } else {
+		vs[i] = 1
+		vn[i] = 1
+	    }
+
+	call plsslv (pl_src, vs, vn, v, ve)
+	mval = ERR
+
+	# Test each line segment in the section.
+	repeat {
+	    # Determine if line segment is complex, or is all set to lval.
+	    ll_src = pl_reference (pl_src, v)
+	    if (ll_src == PL_EMPTYLINE)
+		lval = 0
+	    else {
+		lp = Ref (pl_src, ll_src)
+		if (!pll_const (Mems[lp], vs[1], vn[1], lval))
+		    return (true)
+	    }
+
+	    # Exit if the mask value changes, indicating a complex region.
+	    if (mval == ERR)
+		mval = lval
+	    else if (mval != lval)
+		return (true)
+
+	} until (plloop (v, vs, ve, PL_NAXES(pl_src)) == LOOP_DONE)
+
+	return (false)
+end
+
+
+# PLL_CONST -- Test whether a section of a line list is set to a constant
+# value.  If yes, return the value in mval.
+
+bool procedure pll_const (ll_src, xs, npix, mval)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I first pixel to test
+int	npix			#I length of region to be tested
+int	mval			#O mask value, if constant valued segment
+
+int	nleft, x1, np, v_src, i
+int	d_src[LEN_PLLDES]
+
+begin
+	# Advance to the indicated position in the source list.
+	x1 = 1
+	pll_init (ll_src, d_src)
+	do i = 1, ARB {
+	    np = min (pll_nleft(d_src), xs - x1)
+	    pll_getseg (ll_src, d_src, np, v_src)
+	    x1 = x1 + np
+	    if (x1 >= xs || np == 0)
+		break
+	}
+
+	# Test if the next npix pixels are all set to the same value.
+	# Note the line list is segmented and we have to read segments until
+	# we have examined NPIX pixels, or until the mask value changes.
+
+	mval = -1
+	for (nleft=npix;  nleft > 0;  nleft = nleft - np) {
+	    np = min (pll_nleft(d_src), nleft)
+	    pll_getseg (ll_src, d_src, np, v_src)
+	    if (v_src != mval)
+		if (mval < 0)
+		    mval = v_src
+		else
+		    return (false)
+	}
+
+	return (true)
+end
diff --git a/sys/plio/plsectne.x b/sys/plio/plsectne.x
new file mode 100644
index 00000000..c8ca8f6d
--- /dev/null
+++ b/sys/plio/plsectne.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include "pllseg.h"
+include	<plio.h>
+
+# PL_SECTNOTEMPTY -- Test whether the indicated mask image section is empty.
+
+bool procedure pl_sectnotempty (pl_src, v1, v2, ndim)
+
+pointer	pl_src			#I mask descriptor
+long	v1[PL_MAXDIM]		#I starting coordinates of section
+long	v2[PL_MAXDIM]		#I ending coordinates of section
+int	ndim
+
+pointer	lp
+int	ll_src, i
+long	v[PL_MAXDIM], vs[PL_MAXDIM], ve[PL_MAXDIM], vn[PL_MAXDIM]
+
+bool	pll_empty()
+int	pl_reference(), plloop()
+errchk	plvalid, plsslv, pl_reference
+
+begin
+	call plvalid (pl_src)
+
+	# Initialize the N-dimensional loop counters.
+	do i = 1, PL_MAXDIM
+	    if (i <= ndim) {
+		if (v1[i] <= v2[i]) {
+		    vs[i] = v1[i]
+		    vn[i] = v2[i] - v1[i] + 1
+		} else {
+		    vs[i] = v2[i]
+		    vn[i] = v1[i] - v2[i] + 1
+		}
+	    } else {
+		vs[i] = 1
+		vn[i] = 1
+	    }
+
+	call plsslv (pl_src, vs, vn, v, ve)
+
+	# Test each line segment in the section.
+	repeat {
+	    ll_src = pl_reference (pl_src, v)
+	    if (ll_src != PL_EMPTYLINE) {
+		lp = Ref (pl_src, ll_src)
+		if (!pll_empty (Mems[lp], vs[1], vn[1]))
+		    return (true)
+	    }
+	} until (plloop (v, vs, ve, PL_NAXES(pl_src)) == LOOP_DONE)
+
+	return (false)
+end
+
+
+# PLL_EMPTY -- Test whether a section of a line list is empty.
+
+bool procedure pll_empty (ll_src, xs, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I first pixel to test
+int	npix			#I length of region to be tested
+
+int	nleft, x1, np, v_src, i
+int	d_src[LEN_PLLDES]
+
+begin
+	# Advance to the indicated position in the source list.
+	x1 = 1
+	pll_init (ll_src, d_src)
+	do i = 1, ARB {
+	    np = min (pll_nleft(d_src), xs - x1)
+	    pll_getseg (ll_src, d_src, np, v_src)
+	    x1 = x1 + np
+	    if (x1 >= xs || np == 0)
+		break
+	}
+
+	# Test if the next npix pixels are zero.
+	if (pll_nleft(d_src) < npix)
+	    return (false)
+	else {
+	    pll_getseg (ll_src, d_src, npix, v_src)
+	    return (v_src == 0)
+	}
+
+	# Test if the next npix pixels are zero.  Note the line list is
+	# segmented and we have to read segments until we have examined NPIX
+	# pixels, or until a nonzero mask pixel is encountered.
+
+	for (nleft=npix;  nleft > 0;  nleft = nleft - np) {
+	    np = min (pll_nleft(d_src), nleft)
+	    pll_getseg (ll_src, d_src, np, v_src)
+	    if (v_src != 0)
+		return (false)
+	}
+
+	return (true)
+end
diff --git a/sys/plio/plseti.x b/sys/plio/plseti.x
new file mode 100644
index 00000000..c6e9d2b4
--- /dev/null
+++ b/sys/plio/plseti.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plset.h>
+include	<plio.h>
+
+# PL_SETI -- Set a PLIO parameter.
+
+procedure pl_seti (pl, param, value)
+
+pointer	pl			#I mask descriptor
+int	param			#I parameter code
+int	value			#I parameter value
+
+begin
+	switch (param) {
+	case P_PRIVATE1:
+	    PL_PRIVATE1(pl) = value
+	case P_PRIVATE2:
+	    PL_PRIVATE2(pl) = value
+	case P_MAXLINE:
+	    PL_MAXLINE(pl) = value
+	case P_DEPTH:
+	    PL_MAXVAL(pl) = MV(value)
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/plio/plsplane.x b/sys/plio/plsplane.x
new file mode 100644
index 00000000..e4a1f3c1
--- /dev/null
+++ b/sys/plio/plsplane.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_SETPLANE -- Set the 2-Dim plane to be referenced in calls to the pl_box,
+# pl_circle, etc. geometric region masking operators.
+
+procedure pl_setplane (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[ARB]			#I vector defining plane
+
+begin
+	call amovl (v, PL_PLANE(pl,1), PL_MAXDIM)
+end
diff --git a/sys/plio/plssize.x b/sys/plio/plssize.x
new file mode 100644
index 00000000..c14e893d
--- /dev/null
+++ b/sys/plio/plssize.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PL_SSIZE -- Set the size of a mask, i.e., given an existing open mask
+# descriptor, create an empty mask with the given dimensionality and size.
+
+procedure pl_ssize (pl, naxes, axlen, depth)
+
+pointer	pl			#I mask descriptor
+int	naxes			#I number of axes (dimensionality of mask)
+long	axlen[ARB]		#I length of each axis
+int	depth			#I mask depth, bits
+
+int	npix, i
+pointer	sp, px, lp
+int	pl_p2ls()
+errchk	malloc, calloc, mfree
+
+begin
+	npix = axlen[1]
+	call smark (sp)
+	call salloc (px, npix, TY_SHORT)
+
+	# Initialize the old descriptor.
+	if (PL_LPP(pl) != NULL)
+	    call mfree (PL_LPP(pl), TY_INT)
+	if (PL_LLBP(pl) != NULL)
+	    call mfree (PL_LLBP(pl), TY_SHORT)
+	call amovki (1, PL_PLANE(pl,1), PL_MAXDIM)
+
+	# Set up the empty descriptor.
+	PL_NAXES(pl) = naxes
+	if (depth > 0)
+	    PL_MAXVAL(pl) = MV(depth)
+	else
+	    PL_MAXVAL(pl) = MV(PL_MAXDEPTH)
+	call amovl (axlen, PL_AXLEN(pl,1), naxes)
+	do i = naxes + 1, PL_MAXDIM
+	    PL_AXLEN(pl,i) = 1
+
+	# Allocate the line list buffer.
+	PL_MAXLINE(pl) = (axlen[1] * 3) + LL_CURHDRLEN
+	PL_LLLEN(pl) = PL_LLBUFLEN
+	call malloc (PL_LLBP(pl), PL_LLBUFLEN, TY_SHORT)
+	lp = PL_LLBP(pl)
+
+	# Encode the empty line line-list.
+	call aclrs (Mems[px], npix)
+	PL_LLOP(pl) = pl_p2ls (Mems[px], 1, Mems[lp], npix)
+
+	# Set up the initial line list index (all lines empty).
+	PL_NLP(pl) = 1
+	do i = 2, naxes
+	    PL_NLP(pl) = PL_NLP(pl) * axlen[i]
+	call calloc (PL_LPP(pl), PL_NLP(pl), TY_INT)
+
+	# Set up the LL header for the empty line.
+	LP_NREFS(lp) = PL_NLP(pl)
+	LP_SETBLEN(lp, PL_LLOP(pl))
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plsslv.x b/sys/plio/plsslv.x
new file mode 100644
index 00000000..bb7b21cb
--- /dev/null
+++ b/sys/plio/plsslv.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include	<plio.h>
+
+# PLSSLV -- Given two vectors (VS, VN) defining the starting coordinates and
+# size of an image section, initialize the "loop index" vector V, and the
+# loop-end vector VE.
+
+procedure plsslv (pl, vs, vn, v, ve)
+
+pointer	pl			#I mask descriptor
+long	vs[PL_MAXDIM]		#I vector coordinates of start of section
+long	vn[PL_MAXDIM]		#I vector size of section
+long	v[PL_MAXDIM]		#O vector for i/o (vector loop index)
+long	ve[PL_MAXDIM]		#O vector coordinates of end of section
+
+int	i
+
+begin
+	do i = 1, PL_NAXES(pl) {
+	     v[i] = vs[i]
+	    ve[i] = vs[i] + vn[i] - 1
+	}
+end
diff --git a/sys/plio/plstati.x b/sys/plio/plstati.x
new file mode 100644
index 00000000..c6659afa
--- /dev/null
+++ b/sys/plio/plstati.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plset.h>
+include	<plio.h>
+
+# PL_STATI -- Stat a PLIO parameter.
+
+int procedure pl_stati (pl, param)
+
+pointer	pl			#I mask descriptor
+int	param			#I parameter code
+
+int	i
+
+begin
+	switch (param) {
+	case P_PRIVATE1:
+	    return (PL_PRIVATE1(pl))
+	case P_PRIVATE2:
+	    return (PL_PRIVATE2(pl))
+	case P_MAXLINE:
+	    return (PL_MAXLINE(pl))
+	case P_DEPTH:
+	    do i = 0, ARB
+		if (2**i > min (I_PVMAX, PL_MAXVAL(pl)))
+		    return (i)
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/plio/plsten.x b/sys/plio/plsten.x
new file mode 100644
index 00000000..6397af3d
--- /dev/null
+++ b/sys/plio/plsten.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include <plset.h>
+include	<plio.h>
+
+# PL_STENCIL -- Perform a rasterop operation from the source mask to the
+# destination mask at the given offsets, but only within the regions set to
+# one in the stencil mask.
+
+procedure pl_stencil (pl_src, vs_src, pl_dst, vs_dst, pl_stn, vs_stn, vn, rop)
+
+pointer	pl_src			#I source mask or NULL
+long	vs_src[PL_MAXDIM]	#I start vector in source mask
+pointer	pl_dst			#I destination mask (required)
+long	vs_dst[PL_MAXDIM]	#I start vector in destination mask
+pointer	pl_stn			#I stencil mask (required)
+long	vs_stn[PL_MAXDIM]	#I start vector in stencil mask
+long	vn[PL_MAXDIM]		#I vector giving subregion size
+long	rop			#I rasterop
+
+bool	need_src
+pointer	sp, ll_out, ll_src, ll_dst, ll_stn, ol_src, ol_dst, ol_stn
+long	v_src[PL_MAXDIM], v_dst[PL_MAXDIM], v_stn[PL_MAXDIM]
+long	ve_src[PL_MAXDIM], ve_dst[PL_MAXDIM], ve_stn[PL_MAXDIM]
+
+int	plloop()
+pointer	pl_access()
+errchk	syserr, plvalid, plsslv, pl_access
+
+begin
+	call plvalid (pl_dst)
+	call plvalid (pl_stn)
+	need_src = R_NEED_SRC(rop)
+	if (need_src && pl_src == NULL)
+	    call syserr (SYS_PLNULLSRC)
+
+	call smark (sp)
+	call salloc (ll_out, LL_MAXLEN(pl_dst), TY_SHORT)
+
+	# Initialize the N-dimensional loop counters.
+	call plsslv (pl_dst, vs_dst, vn, v_dst, ve_dst)
+	call plsslv (pl_stn, vs_stn, vn, v_stn, ve_stn)
+	if (need_src)
+	    call plsslv (pl_src, vs_src, vn, v_src, ve_src)
+	else
+	    ll_src = ll_out		# any valid pointer will do
+
+	# Perform the operation.
+	ol_dst = -1
+	repeat {
+	    # Get a line from each mask.
+	    ll_dst = pl_access (pl_dst, v_dst)
+	    ll_stn = pl_access (pl_stn, v_stn)
+	    if (need_src)
+		ll_src = pl_access (pl_src, v_src)
+
+	    # Perform the rasterop operation upon one line of the mask.
+	    # Note that if successive mask lines point to the same encoded
+	    # line list, we only have to compute the result once.
+
+	    if (ll_src != ol_src || ll_dst != ol_dst || ll_stn != ol_stn) {
+		call pl_linestencil (Mems[ll_src], vs_src[1], PL_MAXVAL(pl_src),
+				     Mems[ll_dst], vs_dst[1], PL_MAXVAL(pl_dst),
+				     Mems[ll_stn], vs_stn[1],
+				     Mems[ll_out], vn[1], rop)
+
+		ol_src = ll_src
+		ol_dst = ll_dst
+		ol_stn = ll_stn
+	    }
+
+	    # Update the affected line of the destination mask.
+	    call pl_update (pl_dst, v_dst, Mems[ll_out])
+
+	    # If the end of the input mask or stencil is reached,
+	    # rewind it and go again.
+
+	    if (plloop (v_stn,vs_stn,ve_stn,PL_NAXES(pl_stn)) == LOOP_DONE)
+		call amovi (vs_stn, v_stn, PL_NAXES(pl_stn))
+	    if (need_src)
+		if (plloop (v_src,vs_src,ve_src,PL_NAXES(pl_src)) == LOOP_DONE)
+		    call amovi (vs_src, v_src, PL_NAXES(pl_src))
+
+	} until (plloop (v_dst, vs_dst, ve_dst, PL_NAXES(pl_dst)) == LOOP_DONE)
+
+	# Compress the mask if excessive free space has accumulated.
+	if (PL_NEEDCOMPRESS(pl_dst))
+	    call pl_compress (pl_dst)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/plubox.x b/sys/plio/plubox.x
new file mode 100644
index 00000000..ec3e1f47
--- /dev/null
+++ b/sys/plio/plubox.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plbox.h"
+
+
+# PL_UBOX -- Regionrop ufcn for a box (rectangular) region.
+
+bool procedure pl_ubox (ufd, y, rl_reg, xs, npix)
+
+pointer	ufd			#I user function descriptor
+int	y			#I mask line number
+int	rl_reg[3,ARB]		#O output range list for line Y
+int	xs			#O start of edit region in dst mask
+int	npix			#O number of pixels affected
+
+int	rn
+bool	rl_new
+
+begin
+	rl_new = true
+	rn = RL_FIRST
+
+	if (y >= B_Y1(ufd) && y <= B_Y2(ufd)) {
+	    xs = B_X1(ufd)
+	    npix = B_X2(ufd) - B_X1(ufd) + 1
+
+	    RL_X(rl_reg,rn) = 1
+	    RL_N(rl_reg,rn) = npix
+	    RL_V(rl_reg,rn) = B_PV(ufd)
+
+	    rl_new = (y == B_Y1(ufd))
+	    rn = rn + 1
+
+	} else {
+	    npix = 0
+	    xs = 1
+	}
+
+	RL_LEN(rl_reg) = rn - 1
+	RL_AXLEN(rl_reg) = npix
+
+	return (rl_new)
+end
diff --git a/sys/plio/plucircle.x b/sys/plio/plucircle.x
new file mode 100644
index 00000000..5a23d20a
--- /dev/null
+++ b/sys/plio/plucircle.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plcircle.h"
+
+
+# PL_UCIRCLE -- Regionrop ufcn for a circle (circular region), clipped at
+# the borders of the mask.
+
+bool procedure pl_ucircle (ufd, y, rl_reg, xs, npix)
+
+pointer	ufd			#I user function descriptor
+int	y			#I mask line number
+int	rl_reg[3,ARB]		#O output range list for line Y
+int	xs			#O first pixel to be edited
+int	npix			#O number of pixels affected
+
+pointer	pl
+real	radius, dx, dy
+int	rn, axlen, x1, x1_clipped, x2, x2_clipped
+
+begin
+	pl = C_PL(ufd)
+	rn = RL_FIRST
+	axlen = PL_AXLEN(pl,1)
+	radius = C_RADIUS(ufd)
+
+	dy = abs (C_YCEN(ufd) - y)
+	if (dy <= radius) {
+	    dx = sqrt (radius**2 - dy**2)
+	    x1 = C_XCEN(ufd) - int(dx)
+	    x2 = C_XCEN(ufd) + int(dx)
+	    x1_clipped = max(1, min(axlen, x1))
+	    x2_clipped = max(1, min(axlen, x2))
+
+	    xs = x1_clipped
+	    npix = x2_clipped - x1_clipped + 1
+
+	    RL_X(rl_reg,rn) = 1
+	    RL_N(rl_reg,rn) = npix
+	    RL_V(rl_reg,rn) = C_PV(ufd)
+	    rn = rn + 1
+
+	} else {
+	    npix = 0
+	    xs = 1
+	}
+
+	RL_LEN(rl_reg) = rn - 1
+	RL_AXLEN(rl_reg) = npix
+
+	return (true)
+end
diff --git a/sys/plio/plupdate.x b/sys/plio/plupdate.x
new file mode 100644
index 00000000..bb90cc34
--- /dev/null
+++ b/sys/plio/plupdate.x
@@ -0,0 +1,158 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include <plset.h>
+include	<plio.h>
+
+# PL_UPDATE -- Update the indicated line of a mask, i.e., insert a possibly
+# modified line (encoded line list) into an image mask.  This is where image
+# compression in the Y direction occurs: if the line to be inserted is the
+# "empty line", or a copy of the adjacent line earlier in the image, then we
+# merely set the new line pointer to point to the line already stored, and
+# increment the reference count for that line.  When a new mask is created,
+# all lines point to the "empty line" line list (PL_EMPTYLINE), which has a
+# reference count equal to the number of lines in the mask.
+#
+# A new line may replace an existing line in storage if space permits and the
+# reference count of the existing line is one or less, i.e., the stored line
+# list is used only by the image line being updated.  Otherwise the new line
+# list will be appended to the line list buffer, which is resized to a larger
+# size if it overflows.  Note that the resize may move the buffer, which is
+# why all line "pointers" are actually offsets into the line list buffer.
+#
+# We do not perform garbage collection on freed lines, rather we keep a count
+# of the total amount of freed space (which cannot be reused), allowing the
+# entire line list to be rebuilt periodically to reclaim the space, when the
+# percentage of wasted space rises to a certain level.  Since this can be a
+# relatively expensive operation it is only performed by high level, more
+# macroscopic operators, e.g., following a full mask rasterop, or before
+# writing the mask to external storage.  Note also that rebulding the mask
+# may shift the stored line lists about, invalidating any line list pointers
+# that may be cached in the calling procedure.  This is another reason why
+# we do not perform mask compression automatically if buffer overflow occurs
+# during a line update.
+
+procedure pl_update (pl, v, ll)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I coordinates of line in the mask
+short	ll[ARB]			#I encoded line list
+
+pointer	o_pp, n_pp
+int	totlen, axlen, index, i
+int	o_lp, n_lp, o_len, n_len, b_len
+
+bool	pll_equal()
+int	pl_alloc()
+errchk	pl_alloc
+define	update_ 91
+define	oob_ 92
+
+begin
+	# Compute the index of the line in the line pointer array.
+	if (PL_NAXES(pl) == 2) {
+	    # Optimized for case naxes=2.
+	    index = v[2]
+	    if (index < 1 || index > PL_AXLEN(pl,2))
+		goto oob_
+	} else {
+	    # Generalized code.
+	    index = 1
+	    totlen = 1
+	    do i = 2, PL_NAXES(pl) {
+		axlen = PL_AXLEN(pl,i)
+		if (v[i] < 1 || v[i] > axlen)
+		    goto oob_
+		index = index + totlen * (v[i] - 1)
+		totlen = totlen * axlen
+	    }
+	}
+
+	# Now the pointer to the current stored line list.
+	o_lp = PL_LP(pl,index)
+	o_pp = Ref (pl, o_lp)
+	if (o_pp == NULL)
+	    return
+
+	# Has the line been modified?
+	n_len = LL_LEN(ll)
+	if (n_len == LP_LEN(o_pp))
+	    if (pll_equal (ll, LL(pl,o_lp)))
+		return
+
+	# Keep track of the number of edits.
+	PL_LLNUPDATES(pl) = PL_LLNUPDATES(pl) + 1
+
+	# Is the new line empty?
+	n_lp = PL_EMPTYLINE
+	n_pp = Ref (pl, n_lp)
+	if (n_len == LP_LEN(n_pp))
+	    if (pll_equal (ll, LL(pl,n_lp)))
+		goto update_
+
+	# Is the new line a copy of the adjacent line (Y=Y-1) in the image?
+	# Due to the short integer encoding a maximum of MAX_SHORT references
+	# are allowed per line.
+
+	if (index > 1) {
+	    n_lp = PL_LP(pl,index-1)
+	    n_pp = Ref (pl, n_lp)
+	    if (LP_NREF(n_pp) < MAX_SHORT)
+		if (n_len == LP_LEN(n_pp))
+		    if (pll_equal (ll, LL(pl,n_lp)))
+			goto update_
+	}
+
+	# The new line isn't a copy of the empty line or of an adjacent line,
+	# so copy it into the line list buffer.
+
+	b_len = LP_BLEN(o_pp)
+	if (LP_NREF(o_pp) <= 1 && n_len <= b_len && o_lp != PL_EMPTYLINE) {
+	    # Overwrite existing line.
+
+	    o_len = LP_LEN(o_pp)
+	    call amovs (ll, LL(pl,o_lp), n_len)
+	    LP_NREFS(o_pp) = 1
+	    LP_SETBLEN(o_pp, b_len)
+	    PL_LLFREE(pl) = PL_LLFREE(pl) + (o_len - LP_LEN(o_pp))
+	    return
+
+	} else {
+	    # Add a new line.
+
+	    n_lp = pl_alloc (pl, n_len)
+	    o_pp = Ref (pl, o_lp)
+	    n_pp = Ref (pl, n_lp)
+	    call amovs (ll, LL(pl,n_lp), n_len)
+
+	    LP_NREFS(n_pp) = 0
+	    LP_SETBLEN(n_pp, n_len)
+	    PL_LLFREE(pl) = PL_LLFREE(pl) + n_len
+	}
+
+	# We get here only if the new line has already been stored in the
+	# linelist buffer, with a pointer to such in N_LP, and a pointer to
+	# the old line in O_LP.  Dereference the old line, which the new line
+	# is no longer associated with, and increase the reference count of
+	# the new line.
+update_
+
+	# Dereference the old line and free the space if it is no longer used.
+	# If the old line buffer is freed we reclaim only LP_LEN words, since
+	# we already reclaimed LP_BLEN-LP_LEN in an earlier edit operation.
+
+	LP_NREFS(o_pp) = LP_NREFS(o_pp) - 1
+	if (LP_NREF(o_pp) == 0 && o_lp != PL_EMPTYLINE)
+	    PL_LLFREE(pl) = PL_LLFREE(pl) + LP_LEN(o_pp)
+
+	# Add another reference to the new line.
+	LP_NREFS(n_pp) = LP_NREFS(n_pp) + 1
+	if (LP_NREF(n_pp) == 1 && n_lp != PL_EMPTYLINE)
+	    PL_LLFREE(pl) = PL_LLFREE(pl) - LP_BLEN(n_pp)
+
+	PL_LP(pl,index) = n_lp
+	return
+oob_
+	call syserr (SYS_PLREFOOB)
+end
diff --git a/sys/plio/plupolygon.x b/sys/plio/plupolygon.x
new file mode 100644
index 00000000..b60e9bc5
--- /dev/null
+++ b/sys/plio/plupolygon.x
@@ -0,0 +1,223 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <plset.h>
+include <plio.h>
+include "plpolygon.h"
+
+
+# PL_UPOLYGON -- Regionrop ufcn for a general closed polygonal region.
+# (surely there must be a simpler way to code this...)
+
+bool procedure pl_upolygon (ufd, line, rl_reg, xs, npix)
+
+pointer	ufd			#I user function descriptor
+int	line			#I mask line number
+int	rl_reg[3,ARB]		#O output range list for line Y
+int	xs			#O start of edit region in dst mask
+int	npix			#O number of pixels affected
+
+pointer	xp, yp, pl
+bool	rl_new, cross
+int	nseg, np, low, rn, i1, i2, ii, i, j
+int	tempi, axlen, rl_len, p_prev, p_next
+real	tempr, y, y1, y2, x1, x2, p1, p2, p_y, n_y
+
+int	btoi()
+bool	plr_equali()
+define	done_ 91
+
+begin
+	pl = P_PL(ufd)
+	axlen = PL_AXLEN(pl,1)
+	rn = RL_FIRST
+	npix = 0
+	xs = 1
+
+	nseg = P_NS(ufd)
+	xp = P_XP(ufd)
+	yp = P_YP(ufd)
+	y  = real(line)
+
+	# Find the point(s) of intersection of the current mask line with
+	# the line segments forming the polygon.  Note that the line must
+	# cross a segment to go from inside to outside or vice versa; if a
+	# segment (or vertex) is merely touched it should be drawn, but it
+	# is not a point of crossing.
+
+	do i = 1, nseg {
+	    # Locate next and previous line segments.
+	    if (i == 1)
+		p_prev = nseg
+	    else
+		p_prev = i - 1
+	    if (i == nseg)
+		p_next = 1
+	    else
+		p_next = i + 2
+
+	    # Get endpoints of current segment.
+	    x1 = Memr[xp+i-1];  x2 = Memr[xp+i]
+	    y1 = Memr[yp+i-1];  y2 = Memr[yp+i]
+	    if (y1 > y2) {
+		swapr (x1, x2)
+		swapr (y1, y2)
+		swapi (p_next, p_prev)
+	    }
+
+	    # Does current line intersect the polygon line segment?
+	    if (y > y1-TOL && y < y2+TOL) {
+		p_y = Memr[yp+p_prev-1]
+		n_y = Memr[yp+p_next-1]
+
+		if (y2 - y1 > TOL) {
+		    # Single point of intersection.
+		    p1 = x1 + ((x2 - x1) / (y2 - y1)) * (y - y1)
+		    p2 = p1
+
+		    if (equal (p1, x1) && equal (y, y1))
+			cross = ((p_y - y1) < 0)
+		    else if (equal (p1, x2) && equal (y, y2))
+			cross = ((n_y - y2) > 0)
+		    else
+			cross = true
+
+		} else {
+		    # Intersection is entire line segment.
+		    p1 = x1;  p2 = x2
+		    cross = (((p_y - y) * (n_y - y)) < 0)
+		}
+
+		i1 = max(1, min(axlen, nint(p1)))
+		i2 = max(1, min(axlen, nint(p2)))
+		if (i1 > i2)
+		    swapi (i1, i2)
+
+		np = i2 - i1 + 1
+		if (np > 0) {
+		    RL_X(rl_reg,rn) = i1
+		    RL_N(rl_reg,rn) = np
+		    RL_V(rl_reg,rn) = btoi(cross)
+		    rn = rn + 1
+		}
+	    }
+	}
+
+	rl_len = rn - 1
+	if (rl_len <= RL_FIRST)
+	    goto done_
+
+	# Sort the line intersection-segments in order of increasing X.
+	do j = RL_FIRST, rl_len {
+	    # Get low X value of initial segment.
+	    i1 = RL_X(rl_reg,j)
+	    np = RL_N(rl_reg,j)
+	    i1 = min (i1, i1 + np - 1)
+	    low = j
+
+	    # Find lowest valued segment in remainder of array.
+	    do i = j+1, rl_len {
+		i2 = RL_X(rl_reg,i)
+		np = RL_N(rl_reg,i)
+		i2 = min (i2, i2 + np - 1)
+		if (i2 < i1) {
+		    i1 = i2
+		    low = i
+		}
+	    }
+	    
+	    # Interchange the initial segment and the low segment.
+	    if (low != j) {
+		swapi (RL_X(rl_reg,j), RL_X(rl_reg,low))
+		swapi (RL_N(rl_reg,j), RL_N(rl_reg,low))
+		swapi (RL_V(rl_reg,j), RL_V(rl_reg,low))
+	    }
+	}
+
+	# Combine any segments which overlap.
+	rn = RL_FIRST
+	do i = RL_FIRST + 1, rl_len {
+	    i1 = RL_X(rl_reg,rn)
+	    i2 = RL_N(rl_reg,rn) + i1 - 1
+	    ii = RL_X(rl_reg,i)
+	    if (ii >= i1 && ii <= i2) {
+		i2 = ii + RL_N(rl_reg,i) - 1
+		RL_N(rl_reg,rn) = max (RL_N(rl_reg,rn), i2 - i1 + 1)
+		RL_V(rl_reg,rn) = max (RL_V(rl_reg,rn), RL_V(rl_reg,i))
+	    } else {
+		rn = rn + 1
+		RL_X(rl_reg,rn) = RL_X(rl_reg,i)
+		RL_N(rl_reg,rn) = RL_N(rl_reg,i)
+		RL_V(rl_reg,rn) = RL_V(rl_reg,i)
+	    }
+	}
+	rl_len = rn
+
+	# Now combine successive pairs of intersections to produce the line
+	# segments to be drawn.  If all points are crossing points (where the
+	# image line crosses the polygon boundary) then we draw a line between
+	# the first two points, then the second two points, and so on.  Points
+	# where the image line touches the polygon boundary but does not cross
+	# it are plotted, but are not joined with other points to make line
+	# segments.
+
+	rn = RL_FIRST
+	ii = RL_FIRST
+
+	do j = RL_FIRST, rl_len {
+	    if (j <= ii && j < rl_len) {
+		next
+
+	    } else if (RL_V(rl_reg,ii) == YES) {
+		# Skip a vertext that touches but does not cross.
+		if (RL_V(rl_reg,j) == NO && j < rl_len)
+		    next
+
+		# Draw a line between the two crossing points.
+		RL_X(rl_reg,rn) = RL_X(rl_reg,ii)
+		RL_N(rl_reg,rn) = max (RL_N(rl_reg,ii),
+		    RL_X(rl_reg,j) + RL_N(rl_reg,j) - RL_X(rl_reg,ii))
+		RL_V(rl_reg,rn) = P_PV(ufd)
+		rn = rn + 1
+		ii = j + 1
+
+	    } else {
+		# Plot only the first point.
+		RL_X(rl_reg,rn) = RL_X(rl_reg,ii)
+		RL_N(rl_reg,rn) = RL_N(rl_reg,ii)
+		RL_V(rl_reg,rn) = P_PV(ufd)
+		rn = rn + 1
+
+		if (j >= rl_len && j != ii) {
+		    # Plot the second point, if and end of list.
+		    RL_X(rl_reg,rn) = RL_X(rl_reg,j)
+		    RL_N(rl_reg,rn) = RL_N(rl_reg,j)
+		    RL_V(rl_reg,rn) = P_PV(ufd)
+		    rn = rn + 1
+		} else
+		    ii = j
+	    }
+	}
+
+done_
+	# Convert the X values in the range list to be relative to the start
+	# of the list.  Compute NPIX, the range in pixels spanned by the range
+	# list.
+
+	rl_len = rn - 1
+	xs = RL_X(rl_reg,RL_FIRST)
+	npix = RL_X(rl_reg,rl_len) + RL_N(rl_reg,rl_len) - xs
+
+	do i = RL_FIRST, rl_len
+	    RL_X(rl_reg,i) = RL_X(rl_reg,i) - xs + 1
+
+	RL_LEN(rl_reg) = rl_len
+	RL_AXLEN(rl_reg) = npix
+
+	rl_new = true
+	if (P_OY(ufd) == line - 1)
+	    rl_new = !plr_equali (rl_reg, Memi[P_OO(ufd)])
+	call amovi (rl_reg, Memi[P_OO(ufd)], rn - 1)
+	P_OY(ufd) = line
+
+	return (rl_new)
+end
diff --git a/sys/plio/plvalid.x b/sys/plio/plvalid.x
new file mode 100644
index 00000000..1d6482d9
--- /dev/null
+++ b/sys/plio/plvalid.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plio.h>
+
+# PLVALID -- Verify the validity of a mask descriptor.
+
+procedure plvalid (pl)
+
+pointer	pl		#I open mask descriptor
+errchk	syserr
+
+begin
+	if (pl != NULL)
+	    if (PL_MAGIC(pl) == PL_MAGICVAL)
+		if (PL_LLBP(pl) == NULL)
+		    call syserr (SYS_PLINACTDES)
+		else
+		    return
+
+	call syserr (SYS_PLINVDES)
+end
diff --git a/sys/plio/tf/mkpkg b/sys/plio/tf/mkpkg
new file mode 100644
index 00000000..00a4d40e
--- /dev/null
+++ b/sys/plio/tf/mkpkg
@@ -0,0 +1,51 @@
+# Update the type expanded generic files in the PLIO package library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	plglpi.x	<plio.h>
+	plglpl.x	<plio.h>
+	plglps.x	<plio.h>
+	plglri.x	<plio.h> <plset.h>
+	plglrl.x	<plio.h> <plset.h>
+	plglrs.x	<plio.h> <plset.h>
+	pll2pi.x	<plio.h>
+	pll2pl.x	<plio.h>
+	pll2ps.x	<plio.h>
+	pll2ri.x	<plio.h> <plset.h>
+	pll2rl.x	<plio.h> <plset.h>
+	pll2rs.x	<plio.h> <plset.h>
+	plp2li.x	<plio.h>
+	plp2ll.x	<plio.h>
+	plp2ls.x	<plio.h>
+	plp2ri.x	<plio.h> <plset.h>
+	plp2rl.x	<plio.h> <plset.h>
+	plp2rs.x	<plio.h> <plset.h>
+	plplpi.x	<plio.h>
+	plplpl.x	<plio.h>
+	plplps.x	<plio.h>
+	plplri.x	<plio.h>
+	plplrl.x	<plio.h>
+	plplrs.x	<plio.h>
+	plpropi.x	<plio.h> <plset.h>
+	plpropl.x	<plio.h> <plset.h>
+	plprops.x	<plio.h> <plset.h>
+	plr2li.x	<plio.h> <plset.h>
+	plr2ll.x	<plio.h> <plset.h>
+	plr2ls.x	<plio.h> <plset.h>
+	plr2pi.x	<plio.h> <plset.h>
+	plr2pl.x	<plio.h> <plset.h>
+	plr2ps.x	<plio.h> <plset.h>
+	plreqi.x	<plset.h>
+	plreql.x	<plset.h>
+	plreqs.x	<plset.h>
+	plrpri.x	<plio.h> <plset.h>
+	plrprl.x	<plio.h> <plset.h>
+	plrprs.x	<plio.h> <plset.h>
+	plrropi.x	<plio.h> <plset.h> ../plrseg.h
+	plrropl.x	<plio.h> <plset.h> ../plrseg.h
+	plrrops.x	<plio.h> <plset.h> ../plrseg.h
+	;
diff --git a/sys/plio/tf/plglpi.x b/sys/plio/tf/plglpi.x
new file mode 100644
index 00000000..3724ed6d
--- /dev/null
+++ b/sys/plio/tf/plglpi.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pl_glpi (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	np
+pointer	sp, px_out, ll_src
+pointer	pl_access()
+int	pl_l2pi()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop)) {
+	    np = pl_l2pi (Mems[ll_src], v[1], px_dst, npix)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (px_out, npix, TY_INT)
+
+	np = pl_l2pi (Mems[ll_src], v[1], Memi[px_out], npix)
+	call pl_pixropi (Memi[px_out], 1, PL_MAXVAL(pl),
+	    px_dst, 1, MV(px_depth), npix, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plglpl.x b/sys/plio/tf/plglpl.x
new file mode 100644
index 00000000..6e1632c0
--- /dev/null
+++ b/sys/plio/tf/plglpl.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pl_glpl (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	np
+pointer	sp, px_out, ll_src
+pointer	pl_access()
+int	pl_l2pl()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop)) {
+	    np = pl_l2pl (Mems[ll_src], v[1], px_dst, npix)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (px_out, npix, TY_LONG)
+
+	np = pl_l2pl (Mems[ll_src], v[1], Meml[px_out], npix)
+	call pl_pixropl (Meml[px_out], 1, PL_MAXVAL(pl),
+	    px_dst, 1, MV(px_depth), npix, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plglps.x b/sys/plio/tf/plglps.x
new file mode 100644
index 00000000..728beb0a
--- /dev/null
+++ b/sys/plio/tf/plglps.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pl_glps (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	np
+pointer	sp, px_out, ll_src
+pointer	pl_access()
+int	pl_l2ps()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop)) {
+	    np = pl_l2ps (Mems[ll_src], v[1], px_dst, npix)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (px_out, npix, TY_SHORT)
+
+	np = pl_l2ps (Mems[ll_src], v[1], Mems[px_out], npix)
+	call pl_pixrops (Mems[px_out], 1, PL_MAXVAL(pl),
+	    px_dst, 1, MV(px_depth), npix, rop)
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plglri.x b/sys/plio/tf/plglri.x
new file mode 100644
index 00000000..3f031ee5
--- /dev/null
+++ b/sys/plio/tf/plglri.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+include	<plset.h>
+
+# PL_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output list.
+
+procedure pl_glri (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	rl_dst[ARB]		#O output range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	mr, nr
+pointer	sp, rl_out, rl_src, ll_src
+pointer	pl_access()
+int	pl_l2ri()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop))
+	    nr = pl_l2ri (Mems[ll_src], v[1], rl_dst, npix)
+	else {
+	    call smark (sp)
+	    mr = min (RL_MAXLEN(pl), npix * 3)
+	    call salloc (rl_src, mr, TY_INT)
+	    call salloc (rl_out, mr, TY_INT)
+
+	    nr = pl_l2ri (Mems[ll_src], v[1], Memi[rl_src], npix)
+	    call pl_rangeropi (Memi[rl_src], 1, PL_MAXVAL(pl),
+			              rl_dst,  1, MV(rl_depth),
+				      Memi[rl_out], npix, rop)
+
+	     # Copy out the edited range list.
+	     call amovi (Memi[rl_out], rl_dst, RLI_LEN(rl_out))
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/tf/plglrl.x b/sys/plio/tf/plglrl.x
new file mode 100644
index 00000000..cf30dc62
--- /dev/null
+++ b/sys/plio/tf/plglrl.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+include	<plset.h>
+
+# PL_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output list.
+
+procedure pl_glrl (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	rl_dst[ARB]		#O output range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	mr, nr
+pointer	sp, rl_out, rl_src, ll_src
+pointer	pl_access()
+int	pl_l2rl()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop))
+	    nr = pl_l2rl (Mems[ll_src], v[1], rl_dst, npix)
+	else {
+	    call smark (sp)
+	    mr = min (RL_MAXLEN(pl), npix * 3)
+	    call salloc (rl_src, mr, TY_LONG)
+	    call salloc (rl_out, mr, TY_LONG)
+
+	    nr = pl_l2rl (Mems[ll_src], v[1], Meml[rl_src], npix)
+	    call pl_rangeropl (Meml[rl_src], 1, PL_MAXVAL(pl),
+			              rl_dst,  1, MV(rl_depth),
+				      Meml[rl_out], npix, rop)
+
+	     # Copy out the edited range list.
+	     call amovl (Meml[rl_out], rl_dst, RLL_LEN(rl_out))
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/tf/plglrs.x b/sys/plio/tf/plglrs.x
new file mode 100644
index 00000000..4c9c90a4
--- /dev/null
+++ b/sys/plio/tf/plglrs.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+include	<plset.h>
+
+# PL_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output list.
+
+procedure pl_glrs (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	rl_dst[ARB]		#O output range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	mr, nr
+pointer	sp, rl_out, rl_src, ll_src
+pointer	pl_access()
+int	pl_l2rs()
+errchk	pl_access
+
+begin
+	ll_src = pl_access (pl,v)
+	if (!R_NEED_DST(rop))
+	    nr = pl_l2rs (Mems[ll_src], v[1], rl_dst, npix)
+	else {
+	    call smark (sp)
+	    mr = min (RL_MAXLEN(pl), npix * 3)
+	    call salloc (rl_src, mr, TY_SHORT)
+	    call salloc (rl_out, mr, TY_SHORT)
+
+	    nr = pl_l2rs (Mems[ll_src], v[1], Mems[rl_src], npix)
+	    call pl_rangerops (Mems[rl_src], 1, PL_MAXVAL(pl),
+			              rl_dst,  1, MV(rl_depth),
+				      Mems[rl_out], npix, rop)
+
+	     # Copy out the edited range list.
+	     call amovs (Mems[rl_out], rl_dst, RLS_LEN(rl_out))
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/plio/tf/pll2pi.x b/sys/plio/tf/pll2pi.x
new file mode 100644
index 00000000..cadea930
--- /dev/null
+++ b/sys/plio/tf/pll2pi.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_L2P -- Convert a line list to a pixel array.  The number of pixels output
+# (always npix) is returned as the function value.
+
+int procedure pl_l2pi (ll_src, xs, px_dst, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+int	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+int	pv
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, ip, op, otop, i
+define	putpix_ 91
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	xe = xs + npix - 1
+	skipword = false
+	op = 1
+	x1 = 1
+	pv = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN, I_HN, I_PN:
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+
+		# Process segment if any region is inbounds.
+		np = i2 - i1 + 1
+		if (np > 0) {
+		    otop = op + np - 1
+		    if (opcode == I_HN) {
+			do i = op, otop
+			    px_dst[i] = pv
+		    } else {
+			do i = op, otop
+			    px_dst[i] = 0
+			if (opcode == I_PN && i2 == x2)
+			    px_dst[otop] = pv
+		    }
+		    op = otop + 1
+		}
+
+		# Advance the line index.
+		x1 = x2 + 1
+
+	    case I_SH:
+		pv = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+	    case I_IH:
+		pv = pv + data
+	    case I_DH:
+		pv = pv - data
+	    case I_IS:
+		pv = pv + data
+		goto putpix_
+	    case I_DS:
+		pv = pv - data
+putpix_
+		if (x1 >= xs && x1 <= xe) {
+		    px_dst[op] = pv
+		    op = op + 1
+		}
+		x1 = x1 + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/pll2pl.x b/sys/plio/tf/pll2pl.x
new file mode 100644
index 00000000..9863019b
--- /dev/null
+++ b/sys/plio/tf/pll2pl.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_L2P -- Convert a line list to a pixel array.  The number of pixels output
+# (always npix) is returned as the function value.
+
+int procedure pl_l2pl (ll_src, xs, px_dst, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+long	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+long	pv
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, ip, op, otop, i
+define	putpix_ 91
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	xe = xs + npix - 1
+	skipword = false
+	op = 1
+	x1 = 1
+	pv = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN, I_HN, I_PN:
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+
+		# Process segment if any region is inbounds.
+		np = i2 - i1 + 1
+		if (np > 0) {
+		    otop = op + np - 1
+		    if (opcode == I_HN) {
+			do i = op, otop
+			    px_dst[i] = pv
+		    } else {
+			do i = op, otop
+			    px_dst[i] = 0
+			if (opcode == I_PN && i2 == x2)
+			    px_dst[otop] = pv
+		    }
+		    op = otop + 1
+		}
+
+		# Advance the line index.
+		x1 = x2 + 1
+
+	    case I_SH:
+		pv = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+	    case I_IH:
+		pv = pv + data
+	    case I_DH:
+		pv = pv - data
+	    case I_IS:
+		pv = pv + data
+		goto putpix_
+	    case I_DS:
+		pv = pv - data
+putpix_
+		if (x1 >= xs && x1 <= xe) {
+		    px_dst[op] = pv
+		    op = op + 1
+		}
+		x1 = x1 + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/pll2ps.x b/sys/plio/tf/pll2ps.x
new file mode 100644
index 00000000..a853e5ba
--- /dev/null
+++ b/sys/plio/tf/pll2ps.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_L2P -- Convert a line list to a pixel array.  The number of pixels output
+# (always npix) is returned as the function value.
+
+int procedure pl_l2ps (ll_src, xs, px_dst, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+short	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+short	pv
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, ip, op, otop, i
+define	putpix_ 91
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	xe = xs + npix - 1
+	skipword = false
+	op = 1
+	x1 = 1
+	pv = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN, I_HN, I_PN:
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+
+		# Process segment if any region is inbounds.
+		np = i2 - i1 + 1
+		if (np > 0) {
+		    otop = op + np - 1
+		    if (opcode == I_HN) {
+			do i = op, otop
+			    px_dst[i] = pv
+		    } else {
+			do i = op, otop
+			    px_dst[i] = 0
+			if (opcode == I_PN && i2 == x2)
+			    px_dst[otop] = pv
+		    }
+		    op = otop + 1
+		}
+
+		# Advance the line index.
+		x1 = x2 + 1
+
+	    case I_SH:
+		pv = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+	    case I_IH:
+		pv = pv + data
+	    case I_DH:
+		pv = pv - data
+	    case I_IS:
+		pv = pv + data
+		goto putpix_
+	    case I_DS:
+		pv = pv - data
+putpix_
+		if (x1 >= xs && x1 <= xe) {
+		    px_dst[op] = pv
+		    op = op + 1
+		}
+		x1 = x1 + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/pll2ri.x b/sys/plio/tf/pll2ri.x
new file mode 100644
index 00000000..431b97e2
--- /dev/null
+++ b/sys/plio/tf/pll2ri.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_L2R -- Convert a line list to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_l2ri (ll_src, xs, rl, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+int	rl[3,ARB] 		#O output range list
+int	npix			#I number of pixels to convert
+
+int	pv, hi
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, rn, ip
+define	range_ 91
+define	putrange_ 92
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	rn = RL_FIRST
+	xe = xs + npix - 1
+	skipword = false
+	x1 = 1
+	hi = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		pv = 0
+		goto range_
+	    case I_HN:
+		pv = hi
+range_
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+		np = i2 - i1 + 1
+		x1 = x2 + 1
+
+	    case I_PN:
+		pv = hi
+		x2 = x1 + data - 1
+		if (x2 < xs || x2 > xe)
+		    np = 0
+		else {
+		    i1 = x2
+		    np = 1
+		}
+		x1 = x2 + 1
+
+	    case I_SH:
+		hi = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+		next
+	    case I_IH:
+		hi = hi + data
+		next
+	    case I_DH:
+		hi = hi - data
+		next
+
+	    case I_IS, I_DS:
+		if (opcode == I_IS)
+		    hi = hi + data
+		else
+		    hi = hi - data
+
+		i1 = max (x1, xs)
+		i2 = min (x1, xe)
+		np = i2 - i1 + 1
+		x1 = x1 + 1
+		pv = hi
+	    }
+
+	    # Output a range entry?
+	    if (np > 0 && pv > 0) {
+		rl[1,rn] = i1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/pll2rl.x b/sys/plio/tf/pll2rl.x
new file mode 100644
index 00000000..0ff4ce4b
--- /dev/null
+++ b/sys/plio/tf/pll2rl.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_L2R -- Convert a line list to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_l2rl (ll_src, xs, rl, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+long	rl[3,ARB] 		#O output range list
+int	npix			#I number of pixels to convert
+
+int	pv, hi
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, rn, ip
+define	range_ 91
+define	putrange_ 92
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	rn = RL_FIRST
+	xe = xs + npix - 1
+	skipword = false
+	x1 = 1
+	hi = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		pv = 0
+		goto range_
+	    case I_HN:
+		pv = hi
+range_
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+		np = i2 - i1 + 1
+		x1 = x2 + 1
+
+	    case I_PN:
+		pv = hi
+		x2 = x1 + data - 1
+		if (x2 < xs || x2 > xe)
+		    np = 0
+		else {
+		    i1 = x2
+		    np = 1
+		}
+		x1 = x2 + 1
+
+	    case I_SH:
+		hi = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+		next
+	    case I_IH:
+		hi = hi + data
+		next
+	    case I_DH:
+		hi = hi - data
+		next
+
+	    case I_IS, I_DS:
+		if (opcode == I_IS)
+		    hi = hi + data
+		else
+		    hi = hi - data
+
+		i1 = max (x1, xs)
+		i2 = min (x1, xe)
+		np = i2 - i1 + 1
+		x1 = x1 + 1
+		pv = hi
+	    }
+
+	    # Output a range entry?
+	    if (np > 0 && pv > 0) {
+		rl[1,rn] = i1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/pll2rs.x b/sys/plio/tf/pll2rs.x
new file mode 100644
index 00000000..a0852774
--- /dev/null
+++ b/sys/plio/tf/pll2rs.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_L2R -- Convert a line list to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_l2rs (ll_src, xs, rl, npix)
+
+short	ll_src[ARB]		#I input line list
+int	xs			#I starting index in ll_src
+short	rl[3,ARB] 		#O output range list
+int	npix			#I number of pixels to convert
+
+int	pv, hi
+bool	skipword
+int	opcode, data, ll_len, ll_first
+int	x1, x2, i1, i2, xe, np, rn, ip
+define	range_ 91
+define	putrange_ 92
+ 
+begin
+	# Support old format line lists.
+	if (LL_OLDFORMAT(ll_src)) {
+	    ll_len = OLL_LEN(ll_src)
+	    ll_first = OLL_FIRST
+	} else {
+	    ll_len = LL_LEN(ll_src)
+	    ll_first = LL_FIRST(ll_src)
+	}
+
+	# No pixels?
+	if (npix <= 0 || ll_len <= 0)
+	    return (0)
+ 
+	rn = RL_FIRST
+	xe = xs + npix - 1
+	skipword = false
+	x1 = 1
+	hi = 1
+
+	do ip = ll_first, ll_len {
+	    if (skipword) {
+		skipword = false
+		next
+	    }
+
+	    opcode = I_OPCODE(ll_src[ip])
+	    data   = I_DATA(ll_src[ip])
+
+	    switch (opcode) {
+	    case I_ZN:
+		pv = 0
+		goto range_
+	    case I_HN:
+		pv = hi
+range_
+		# Determine inbounds region of segment.
+		x2 = x1 + data - 1
+		i1 = max (x1, xs)
+		i2 = min (x2, xe)
+		np = i2 - i1 + 1
+		x1 = x2 + 1
+
+	    case I_PN:
+		pv = hi
+		x2 = x1 + data - 1
+		if (x2 < xs || x2 > xe)
+		    np = 0
+		else {
+		    i1 = x2
+		    np = 1
+		}
+		x1 = x2 + 1
+
+	    case I_SH:
+		hi = (int(ll_src[ip+1]) * I_SHIFT) + data
+		skipword = true
+		next
+	    case I_IH:
+		hi = hi + data
+		next
+	    case I_DH:
+		hi = hi - data
+		next
+
+	    case I_IS, I_DS:
+		if (opcode == I_IS)
+		    hi = hi + data
+		else
+		    hi = hi - data
+
+		i1 = max (x1, xs)
+		i2 = min (x1, xe)
+		np = i2 - i1 + 1
+		x1 = x1 + 1
+		pv = hi
+	    }
+
+	    # Output a range entry?
+	    if (np > 0 && pv > 0) {
+		rl[1,rn] = i1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    if (x1 > xe)
+		break
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/plp2li.x b/sys/plio/tf/plp2li.x
new file mode 100644
index 00000000..58b3a8b5
--- /dev/null
+++ b/sys/plio/tf/plp2li.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_P2L -- Convert a pixel array to a line list.  The length of the list is
+# returned as the function value.
+
+int procedure pl_p2li (px_src, xs, ll_dst, npix)
+
+int	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+int	hi, pv, nv, zero
+int	xe, x1, iz, ip, op, np, nz, dv, v
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+
+	# Pack the pixel array into a line list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	iz = xs			# start index of range of zeros
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    } else if (pv == 0)
+		x1 = xe + 1
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    np = ip - x1 + 1
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    # The I_DATAMAX-1 limit is to allow adding M_PN+1 without
+	    # overflowing the range of the data segment.
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    x1 = ip + 1
+	    iz = x1
+	    pv = nv
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plp2ll.x b/sys/plio/tf/plp2ll.x
new file mode 100644
index 00000000..fa4a7d13
--- /dev/null
+++ b/sys/plio/tf/plp2ll.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_P2L -- Convert a pixel array to a line list.  The length of the list is
+# returned as the function value.
+
+int procedure pl_p2ll (px_src, xs, ll_dst, npix)
+
+long	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+long	hi, pv, nv, zero
+int	xe, x1, iz, ip, op, np, nz, dv, v
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+
+	# Pack the pixel array into a line list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	iz = xs			# start index of range of zeros
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    } else if (pv == 0)
+		x1 = xe + 1
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    np = ip - x1 + 1
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    # The I_DATAMAX-1 limit is to allow adding M_PN+1 without
+	    # overflowing the range of the data segment.
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    x1 = ip + 1
+	    iz = x1
+	    pv = nv
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plp2ls.x b/sys/plio/tf/plp2ls.x
new file mode 100644
index 00000000..327778dc
--- /dev/null
+++ b/sys/plio/tf/plp2ls.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_P2L -- Convert a pixel array to a line list.  The length of the list is
+# returned as the function value.
+
+int procedure pl_p2ls (px_src, xs, ll_dst, npix)
+
+short	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+short	hi, pv, nv, zero
+int	xe, x1, iz, ip, op, np, nz, dv, v
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+
+	# Pack the pixel array into a line list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	iz = xs			# start index of range of zeros
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    } else if (pv == 0)
+		x1 = xe + 1
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    np = ip - x1 + 1
+	    nz = x1 - iz
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    # The I_DATAMAX-1 limit is to allow adding M_PN+1 without
+	    # overflowing the range of the data segment.
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    x1 = ip + 1
+	    iz = x1
+	    pv = nv
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plp2ri.x b/sys/plio/tf/plp2ri.x
new file mode 100644
index 00000000..64f4f1eb
--- /dev/null
+++ b/sys/plio/tf/plp2ri.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_P2R -- Convert a pixel array to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_p2ri (px_src, xs, rl, npix)
+
+int	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+int	rl[3,ARB]		#O destination range list
+int	npix			#I number of pixels to convert
+
+int	hi, pv, zero
+int	xe, x1, np, rn, nv, ip
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	rn = RL_FIRST
+
+	# Pack the pixel array into a range list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    }
+
+	    np = ip - x1 + 1
+
+	    # Output the new range.
+	    if (pv > 0) {
+		rl[1,rn] = x1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    x1 = ip + 1
+	    pv = nv
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/plp2rl.x b/sys/plio/tf/plp2rl.x
new file mode 100644
index 00000000..574faad9
--- /dev/null
+++ b/sys/plio/tf/plp2rl.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_P2R -- Convert a pixel array to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_p2rl (px_src, xs, rl, npix)
+
+long	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+long	rl[3,ARB]		#O destination range list
+int	npix			#I number of pixels to convert
+
+long	hi, pv, zero
+int	xe, x1, np, rn, nv, ip
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	rn = RL_FIRST
+
+	# Pack the pixel array into a range list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    }
+
+	    np = ip - x1 + 1
+
+	    # Output the new range.
+	    if (pv > 0) {
+		rl[1,rn] = x1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    x1 = ip + 1
+	    pv = nv
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/plp2rs.x b/sys/plio/tf/plp2rs.x
new file mode 100644
index 00000000..da082f47
--- /dev/null
+++ b/sys/plio/tf/plp2rs.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_P2R -- Convert a pixel array to a range list.  The length of the output
+# range list is returned as the function value.
+
+int procedure pl_p2rs (px_src, xs, rl, npix)
+
+short	px_src[ARB]		#I input pixel array
+int	xs			#I starting index in pixbuf
+short	rl[3,ARB]		#O destination range list
+int	npix			#I number of pixels to convert
+
+short	hi, pv, zero
+int	xe, x1, np, rn, nv, ip
+define	done_ 91
+
+begin
+	# No input pixels?
+	if (npix <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	rn = RL_FIRST
+
+	# Pack the pixel array into a range list.  This is done by scanning
+	# the pixel list for successive ranges of pixels of constant nonzero
+	# value, where each range is described as follows:
+
+	zero = 0
+	pv = max (zero, px_src[xs])	# pixel value of current range
+	x1 = xs			# start index of current range
+	hi = 1			# current high value
+
+	# Process the data array.
+	do ip = xs, xe {
+	    if (ip < xe) {
+		# Get the next pixel value, loop again if same as previous one.
+		nv = max (zero, px_src[ip+1])
+		if (nv == pv)
+		    next
+
+		# If current range is zero, loop again to get nonzero range.
+		if (pv == 0) {
+		    pv = nv
+		    x1 = ip + 1
+		    next
+		}
+	    }
+
+	    np = ip - x1 + 1
+
+	    # Output the new range.
+	    if (pv > 0) {
+		rl[1,rn] = x1
+		rl[2,rn] = np
+		rl[3,rn] = pv
+		rn = rn + 1
+	    }
+
+	    x1 = ip + 1
+	    pv = nv
+	}
+
+	RL_LEN(rl) = rn - 1
+	RL_AXLEN(rl) = npix
+
+	return (rn - 1)
+end
diff --git a/sys/plio/tf/plplpi.x b/sys/plio/tf/plplpi.x
new file mode 100644
index 00000000..26c094d4
--- /dev/null
+++ b/sys/plio/tf/plplpi.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLP -- Put a line segment input as a pixel array to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plpi (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_p2li()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the pixel array to a line list.
+	ll_len = pl_p2li (px_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(px_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plplpl.x b/sys/plio/tf/plplpl.x
new file mode 100644
index 00000000..85a11304
--- /dev/null
+++ b/sys/plio/tf/plplpl.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLP -- Put a line segment input as a pixel array to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plpl (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_p2ll()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the pixel array to a line list.
+	ll_len = pl_p2ll (px_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(px_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plplps.x b/sys/plio/tf/plplps.x
new file mode 100644
index 00000000..b693c90e
--- /dev/null
+++ b/sys/plio/tf/plplps.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLP -- Put a line segment input as a pixel array to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plps (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_p2ls()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the pixel array to a line list.
+	ll_len = pl_p2ls (px_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(px_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plplri.x b/sys/plio/tf/plplri.x
new file mode 100644
index 00000000..433f9a88
--- /dev/null
+++ b/sys/plio/tf/plplri.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plri (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	rl_src[ARB]		#I input range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_r2li()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the range list to a line list.
+	ll_len = pl_r2li (rl_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(rl_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plplrl.x b/sys/plio/tf/plplrl.x
new file mode 100644
index 00000000..bf40b9ef
--- /dev/null
+++ b/sys/plio/tf/plplrl.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plrl (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	rl_src[ARB]		#I input range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_r2ll()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the range list to a line list.
+	ll_len = pl_r2ll (rl_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(rl_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plplrs.x b/sys/plio/tf/plplrs.x
new file mode 100644
index 00000000..13318070
--- /dev/null
+++ b/sys/plio/tf/plplrs.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the line segment with the existing line of the mask.
+
+procedure pl_plrs (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	rl_src[ARB]		#I input range list
+int	rl_depth		#I range list depth, bits
+int	npix			#I number of pixels to be set
+int	rop			#I rasterop
+
+int	ll_len
+pointer	sp, ll_src, ll_out, ll_dst
+pointer	pl_access()
+int	pl_r2ls()
+errchk	pl_access
+
+begin
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Convert the range list to a line list.
+	ll_len = pl_r2ls (rl_src, 1, Mems[ll_src], npix)
+
+	if (!R_NEED_DST(rop) && v[1] == 1 && npix == PL_AXLEN(pl,1))
+	    call pl_update (pl, v, Mems[ll_src])
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl,v)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), Mems[ll_dst], v[1],
+		MV(rl_depth), Mems[ll_out], npix, rop)
+	    call pl_update (pl, v, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plpropi.x b/sys/plio/tf/plpropi.x
new file mode 100644
index 00000000..ecfe7227
--- /dev/null
+++ b/sys/plio/tf/plpropi.x
@@ -0,0 +1,177 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_PIXROP -- Rasterop between source and destination pixel arrays.
+
+procedure pl_pixropi (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+
+int	px_src[ARB]		#I source pixel array
+int	xs			#I starting pixel index in src
+int	src_maxval		#I max pixel value in src mask
+int	px_dst[ARB]		#O destination pixel array
+int	ds			#I starting pixel index in dst
+int	dst_maxval		#I max pixel value in dst mask
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+pointer	sp, src
+int	opcode, i
+int	data, ceil, src_value
+int	and(), or(), xor(), not()
+define	out_ 91
+
+begin
+	opcode = R_OPCODE(rop)
+	data   = R_DATA(rop)
+	ceil   = 0
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Handle the easy cases first.
+	switch (opcode) {
+	case PIX_CLR:
+	    call aclri (px_dst[ds], npix)
+	    return
+	case PIX_SET:
+	    call amovki (data, px_dst[ds], npix)
+	    goto out_
+	case PIX_SRC:
+	    if (src_maxval != 1)
+		call amovi (px_src[xs], px_dst[ds], npix)
+	    else {
+		do i = 1, npix
+		    if (px_src[xs+i-1] > 0)
+			px_dst[ds+i-1] = src_value
+		    else
+			px_dst[ds+i-1] = 0
+	    }
+
+	    goto out_
+	case PIX_DST:
+	    return	# no-op
+	}
+
+	# Integer or boolean source mask?
+	if (src_maxval != 1) {
+	    # Integer source mask; operate directly on source mask.
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_src[xs+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (px_src[xs+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(px_src[xs+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(px_src[xs+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (px_src[xs+i-1], px_dst[ds+i-1]))
+	    }
+
+	} else {
+	    # Boolean source mask; use integer DATA value from ROP if source
+	    # mask pixel is set.
+
+	    call smark (sp)
+	    call salloc (src, npix, TY_INT)
+
+	    do i = 1, npix
+		if (px_src[xs+i-1] > 0)
+		    Memi[src+i-1] = src_value
+		else
+		    Memi[src+i-1] = 0
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (Memi[src+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Memi[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Memi[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (Memi[src+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Memi[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Memi[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(Memi[src+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(Memi[src+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (Memi[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (Memi[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (Memi[src+i-1], px_dst[ds+i-1]))
+	    }
+
+	    call sfree (sp)
+	}
+out_
+	# If writing to an integer mask, mask the data to the indicated max
+	# value (necessary to avoid very large values if any NOT operations
+	# occurred).  If writing to a boolean mask, map positive integer mask
+	# values to 1.
+
+	if (dst_maxval == 1) {
+	    data = 1
+	    call argti (px_dst[ds], npix, ceil, data)
+	} else if (dst_maxval > 1) {
+	    data = dst_maxval
+	    call aandki (px_dst[ds], data, px_dst[ds], npix)
+	}
+end
diff --git a/sys/plio/tf/plpropl.x b/sys/plio/tf/plpropl.x
new file mode 100644
index 00000000..1aa3b21c
--- /dev/null
+++ b/sys/plio/tf/plpropl.x
@@ -0,0 +1,177 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_PIXROP -- Rasterop between source and destination pixel arrays.
+
+procedure pl_pixropl (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+
+long	px_src[ARB]		#I source pixel array
+int	xs			#I starting pixel index in src
+int	src_maxval		#I max pixel value in src mask
+long	px_dst[ARB]		#O destination pixel array
+int	ds			#I starting pixel index in dst
+int	dst_maxval		#I max pixel value in dst mask
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+pointer	sp, src
+int	opcode, i
+long	data, ceil, src_value
+int	and(), or(), xor(), not()
+define	out_ 91
+
+begin
+	opcode = R_OPCODE(rop)
+	data   = R_DATA(rop)
+	ceil   = 0
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Handle the easy cases first.
+	switch (opcode) {
+	case PIX_CLR:
+	    call aclrl (px_dst[ds], npix)
+	    return
+	case PIX_SET:
+	    call amovkl (data, px_dst[ds], npix)
+	    goto out_
+	case PIX_SRC:
+	    if (src_maxval != 1)
+		call amovl (px_src[xs], px_dst[ds], npix)
+	    else {
+		do i = 1, npix
+		    if (px_src[xs+i-1] > 0)
+			px_dst[ds+i-1] = src_value
+		    else
+			px_dst[ds+i-1] = 0
+	    }
+
+	    goto out_
+	case PIX_DST:
+	    return	# no-op
+	}
+
+	# Integer or boolean source mask?
+	if (src_maxval != 1) {
+	    # Integer source mask; operate directly on source mask.
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_src[xs+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (px_src[xs+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(px_src[xs+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(px_src[xs+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (px_src[xs+i-1], px_dst[ds+i-1]))
+	    }
+
+	} else {
+	    # Boolean source mask; use integer DATA value from ROP if source
+	    # mask pixel is set.
+
+	    call smark (sp)
+	    call salloc (src, npix, TY_LONG)
+
+	    do i = 1, npix
+		if (px_src[xs+i-1] > 0)
+		    Meml[src+i-1] = src_value
+		else
+		    Meml[src+i-1] = 0
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (Meml[src+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Meml[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Meml[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (Meml[src+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Meml[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Meml[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(Meml[src+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(Meml[src+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (Meml[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (Meml[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (Meml[src+i-1], px_dst[ds+i-1]))
+	    }
+
+	    call sfree (sp)
+	}
+out_
+	# If writing to an integer mask, mask the data to the indicated max
+	# value (necessary to avoid very large values if any NOT operations
+	# occurred).  If writing to a boolean mask, map positive integer mask
+	# values to 1.
+
+	if (dst_maxval == 1) {
+	    data = 1
+	    call argtl (px_dst[ds], npix, ceil, data)
+	} else if (dst_maxval > 1) {
+	    data = dst_maxval
+	    call aandkl (px_dst[ds], data, px_dst[ds], npix)
+	}
+end
diff --git a/sys/plio/tf/plprops.x b/sys/plio/tf/plprops.x
new file mode 100644
index 00000000..f06baadb
--- /dev/null
+++ b/sys/plio/tf/plprops.x
@@ -0,0 +1,177 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_PIXROP -- Rasterop between source and destination pixel arrays.
+
+procedure pl_pixrops (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+
+short	px_src[ARB]		#I source pixel array
+int	xs			#I starting pixel index in src
+int	src_maxval		#I max pixel value in src mask
+short	px_dst[ARB]		#O destination pixel array
+int	ds			#I starting pixel index in dst
+int	dst_maxval		#I max pixel value in dst mask
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+pointer	sp, src
+int	opcode, i
+short	data, ceil, src_value
+int	and(), or(), xor(), not()
+define	out_ 91
+
+begin
+	opcode = R_OPCODE(rop)
+	data   = R_DATA(rop)
+	ceil   = 0
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Handle the easy cases first.
+	switch (opcode) {
+	case PIX_CLR:
+	    call aclrs (px_dst[ds], npix)
+	    return
+	case PIX_SET:
+	    call amovks (data, px_dst[ds], npix)
+	    goto out_
+	case PIX_SRC:
+	    if (src_maxval != 1)
+		call amovs (px_src[xs], px_dst[ds], npix)
+	    else {
+		do i = 1, npix
+		    if (px_src[xs+i-1] > 0)
+			px_dst[ds+i-1] = src_value
+		    else
+			px_dst[ds+i-1] = 0
+	    }
+
+	    goto out_
+	case PIX_DST:
+	    return	# no-op
+	}
+
+	# Integer or boolean source mask?
+	if (src_maxval != 1) {
+	    # Integer source mask; operate directly on source mask.
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_src[xs+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (px_src[xs+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(px_src[xs+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(px_src[xs+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (px_src[xs+i-1], px_dst[ds+i-1]))
+	    }
+
+	} else {
+	    # Boolean source mask; use integer DATA value from ROP if source
+	    # mask pixel is set.
+
+	    call smark (sp)
+	    call salloc (src, npix, TY_SHORT)
+
+	    do i = 1, npix
+		if (px_src[xs+i-1] > 0)
+		    Mems[src+i-1] = src_value
+		else
+		    Mems[src+i-1] = 0
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (Mems[src+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mems[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mems[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (Mems[src+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mems[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mems[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(Mems[src+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(Mems[src+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (Mems[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (Mems[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (Mems[src+i-1], px_dst[ds+i-1]))
+	    }
+
+	    call sfree (sp)
+	}
+out_
+	# If writing to an integer mask, mask the data to the indicated max
+	# value (necessary to avoid very large values if any NOT operations
+	# occurred).  If writing to a boolean mask, map positive integer mask
+	# values to 1.
+
+	if (dst_maxval == 1) {
+	    data = 1
+	    call argts (px_dst[ds], npix, ceil, data)
+	} else if (dst_maxval > 1) {
+	    data = dst_maxval
+	    call aandks (px_dst[ds], data, px_dst[ds], npix)
+	}
+end
diff --git a/sys/plio/tf/plr2li.x b/sys/plio/tf/plr2li.x
new file mode 100644
index 00000000..f6fb6c79
--- /dev/null
+++ b/sys/plio/tf/plr2li.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2L -- Convert a range list to a line list.  The length of the output
+# line list is returned as the function value.
+
+int procedure pl_r2li (rl_src, xs, ll_dst, npix)
+
+int	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+int	hi, pv
+int	last, xe, x1, x2, iz, op, np, nz, nr, dv, v, i
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+	iz = xs
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr + 1 {
+	    if (i <= nr) {
+		# Load next range.
+		x1 = rl_src[1,i]
+		np = rl_src[2,i]
+		pv = rl_src[3,i]
+		x2 = x1 + np - 1
+		last = x2
+
+		# Get an inbounds range.
+		if (x1 > xe)
+		    break
+		else if (xs > x2)
+		    next
+		else if (x1 < xs)
+		    x1 = xs
+		else if (x2 > xe)
+		    x2 = xe
+
+		# Go again if nothing inbounds.
+		nz = x1 - iz
+		np = x2 - x1 + 1
+		if (np <= 0)
+		    next
+
+	    } else if (iz < xe) {
+		# At end of input range list, but need to output a ZN.
+		nz = xe - iz + 1
+		np = 0
+		pv = 0
+	    } else
+		break
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0 && x2 == last) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    iz = x2 + 1
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plr2ll.x b/sys/plio/tf/plr2ll.x
new file mode 100644
index 00000000..b21d6678
--- /dev/null
+++ b/sys/plio/tf/plr2ll.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2L -- Convert a range list to a line list.  The length of the output
+# line list is returned as the function value.
+
+int procedure pl_r2ll (rl_src, xs, ll_dst, npix)
+
+long	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+long	hi, pv
+int	last, xe, x1, x2, iz, op, np, nz, nr, dv, v, i
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+	iz = xs
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr + 1 {
+	    if (i <= nr) {
+		# Load next range.
+		x1 = rl_src[1,i]
+		np = rl_src[2,i]
+		pv = rl_src[3,i]
+		x2 = x1 + np - 1
+		last = x2
+
+		# Get an inbounds range.
+		if (x1 > xe)
+		    break
+		else if (xs > x2)
+		    next
+		else if (x1 < xs)
+		    x1 = xs
+		else if (x2 > xe)
+		    x2 = xe
+
+		# Go again if nothing inbounds.
+		nz = x1 - iz
+		np = x2 - x1 + 1
+		if (np <= 0)
+		    next
+
+	    } else if (iz < xe) {
+		# At end of input range list, but need to output a ZN.
+		nz = xe - iz + 1
+		np = 0
+		pv = 0
+	    } else
+		break
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0 && x2 == last) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    iz = x2 + 1
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plr2ls.x b/sys/plio/tf/plr2ls.x
new file mode 100644
index 00000000..6aceca17
--- /dev/null
+++ b/sys/plio/tf/plr2ls.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2L -- Convert a range list to a line list.  The length of the output
+# line list is returned as the function value.
+
+int procedure pl_r2ls (rl_src, xs, ll_dst, npix)
+
+short	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+short	ll_dst[ARB]		#O destination line list
+int	npix			#I number of pixels to convert
+
+short	hi, pv
+int	last, xe, x1, x2, iz, op, np, nz, nr, dv, v, i
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	# Initialize the linelist header.
+	LL_VERSION(ll_dst) = LL_CURVERSION
+	LL_HDRLEN(ll_dst) = LL_CURHDRLEN
+	LL_NREFS(ll_dst) = 0
+	LL_SETBLEN(ll_dst,0)
+
+	xe = xs + npix - 1
+	op = LL_CURHDRLEN + 1
+	iz = xs
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr + 1 {
+	    if (i <= nr) {
+		# Load next range.
+		x1 = rl_src[1,i]
+		np = rl_src[2,i]
+		pv = rl_src[3,i]
+		x2 = x1 + np - 1
+		last = x2
+
+		# Get an inbounds range.
+		if (x1 > xe)
+		    break
+		else if (xs > x2)
+		    next
+		else if (x1 < xs)
+		    x1 = xs
+		else if (x2 > xe)
+		    x2 = xe
+
+		# Go again if nothing inbounds.
+		nz = x1 - iz
+		np = x2 - x1 + 1
+		if (np <= 0)
+		    next
+
+	    } else if (iz < xe) {
+		# At end of input range list, but need to output a ZN.
+		nz = xe - iz + 1
+		np = 0
+		pv = 0
+	    } else
+		break
+
+	    # Encode an instruction to regenerate the current range I0-IP
+	    # of N data values of nonzero level PV.  In the most complex case
+	    # we must update the high value and output a range of zeros,
+	    # followed by a range of NP high values.  If NP is 1, we can
+	    # probably use a PN or [ID]S instruction to save space.
+
+	    # Change the high value?
+	    if (pv > 0) {
+		dv = pv - hi
+		if (dv != 0) {
+		    # Output IH or DH instruction?
+		    hi = pv
+		    if (abs(dv) > I_DATAMAX) {
+			ll_dst[op] = M_SH + and (int(pv), I_DATAMAX)
+			op = op + 1
+			ll_dst[op] = pv / I_SHIFT
+			op = op + 1
+		    } else {
+			if (dv < 0)
+			    ll_dst[op] = M_DH + (-dv)
+			else
+			    ll_dst[op] = M_IH + dv
+			op = op + 1
+
+			# Convert to IS or DS if range is a single pixel.
+			if (np == 1 && nz == 0) {
+			    v = ll_dst[op-1]
+			    ll_dst[op-1] = or (v, M_MOVE)
+			    goto done_
+			}
+		    }
+		}
+	    }
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		# Output the ZN instruction.
+		for (;  nz > 0;  nz = nz - (I_DATAMAX-1)) {
+		    ll_dst[op] = M_ZN + min(I_DATAMAX-1,nz)
+		    op = op + 1
+		}
+		# Convert to PN if range is a single pixel.
+		if (np == 1 && pv > 0 && x2 == last) {
+		    ll_dst[op-1] = ll_dst[op-1] + M_PN + 1
+		    goto done_
+		}
+	    }
+
+	    # The only thing left is the HN instruction if we get here.
+	    for (;  np > 0;  np = np - I_DATAMAX) {
+		ll_dst[op] = M_HN + min(I_DATAMAX,np)
+		op = op + 1
+	    }
+done_
+	    iz = x2 + 1
+	}
+
+	LL_SETLEN(ll_dst, op - 1)
+	return (op - 1)
+end
diff --git a/sys/plio/tf/plr2pi.x b/sys/plio/tf/plr2pi.x
new file mode 100644
index 00000000..57db5b63
--- /dev/null
+++ b/sys/plio/tf/plr2pi.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2P -- Convert a range list to a pixel array.  The number of pixels
+# output (always npix) is returned as the function value.
+
+int procedure pl_r2pi (rl_src, xs, px_dst, npix)
+
+int	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+int	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+int	hi, pv
+int	xe, x1, x2, iz, op, np, nz, nr, i, j
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	iz = xs
+	op = 1
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr {
+	    x1 = rl_src[1,i]
+	    np = rl_src[2,i]
+	    pv = rl_src[3,i]
+	    x2 = x1 + np - 1
+
+	    # Get an inbounds range.
+	    if (x1 > xe)
+		break
+	    else if (xs > x2)
+		next
+	    else if (x1 < xs)
+		x1 = xs
+	    else if (x2 > xe)
+		x2 = xe
+		
+	    nz = x1 - iz
+	    np = x2 - x1 + 1
+	    if (np <= 0)
+		next
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		do j = 1, nz
+		    px_dst[op+j-1] = 0
+		op = op + nz
+	    }
+
+	    # Output the pixels.
+	    do j = 1, np
+		px_dst[op+j-1] = pv
+	    op = op + np
+done_
+	    x1 = x2 + 1
+	    iz = x1
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/plr2pl.x b/sys/plio/tf/plr2pl.x
new file mode 100644
index 00000000..763bb8d2
--- /dev/null
+++ b/sys/plio/tf/plr2pl.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2P -- Convert a range list to a pixel array.  The number of pixels
+# output (always npix) is returned as the function value.
+
+int procedure pl_r2pl (rl_src, xs, px_dst, npix)
+
+long	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+long	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+long	hi, pv
+int	xe, x1, x2, iz, op, np, nz, nr, i, j
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	iz = xs
+	op = 1
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr {
+	    x1 = rl_src[1,i]
+	    np = rl_src[2,i]
+	    pv = rl_src[3,i]
+	    x2 = x1 + np - 1
+
+	    # Get an inbounds range.
+	    if (x1 > xe)
+		break
+	    else if (xs > x2)
+		next
+	    else if (x1 < xs)
+		x1 = xs
+	    else if (x2 > xe)
+		x2 = xe
+		
+	    nz = x1 - iz
+	    np = x2 - x1 + 1
+	    if (np <= 0)
+		next
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		do j = 1, nz
+		    px_dst[op+j-1] = 0
+		op = op + nz
+	    }
+
+	    # Output the pixels.
+	    do j = 1, np
+		px_dst[op+j-1] = pv
+	    op = op + np
+done_
+	    x1 = x2 + 1
+	    iz = x1
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/plr2ps.x b/sys/plio/tf/plr2ps.x
new file mode 100644
index 00000000..ecba387d
--- /dev/null
+++ b/sys/plio/tf/plr2ps.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_R2P -- Convert a range list to a pixel array.  The number of pixels
+# output (always npix) is returned as the function value.
+
+int procedure pl_r2ps (rl_src, xs, px_dst, npix)
+
+short	rl_src[3,ARB]		#I input range list
+int	xs			#I starting pixel index in range list
+short	px_dst[ARB]		#O output pixel array
+int	npix			#I number of pixels to convert
+
+short	hi, pv
+int	xe, x1, x2, iz, op, np, nz, nr, i, j
+define	done_ 91
+
+begin
+	# No input pixels?
+	nr = RL_LEN(rl_src)
+	if (npix <= 0 || nr <= 0)
+	    return (0)
+
+	xe = xs + npix - 1
+	iz = xs
+	op = 1
+	hi = 1
+
+	# Process the array of range lists.
+	do i = RL_FIRST, nr {
+	    x1 = rl_src[1,i]
+	    np = rl_src[2,i]
+	    pv = rl_src[3,i]
+	    x2 = x1 + np - 1
+
+	    # Get an inbounds range.
+	    if (x1 > xe)
+		break
+	    else if (xs > x2)
+		next
+	    else if (x1 < xs)
+		x1 = xs
+	    else if (x2 > xe)
+		x2 = xe
+		
+	    nz = x1 - iz
+	    np = x2 - x1 + 1
+	    if (np <= 0)
+		next
+
+	    # Output range of zeros to catch up to current range?
+	    if (nz > 0) {
+		do j = 1, nz
+		    px_dst[op+j-1] = 0
+		op = op + nz
+	    }
+
+	    # Output the pixels.
+	    do j = 1, np
+		px_dst[op+j-1] = pv
+	    op = op + np
+done_
+	    x1 = x2 + 1
+	    iz = x1
+	}
+
+	# Zero any remaining output range.
+	do i = op, npix
+	    px_dst[i] = 0
+
+	return (npix)
+end
diff --git a/sys/plio/tf/plreqi.x b/sys/plio/tf/plreqi.x
new file mode 100644
index 00000000..0307efea
--- /dev/null
+++ b/sys/plio/tf/plreqi.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+
+# PLR_EQUAL -- Compare two range lists for equality.
+
+bool procedure plr_equali (r1, r2)
+
+int	r1[3,ARB]			#I range list 1
+int	r2[3,ARB]			#I range list 2
+
+int	i
+int	len1, len2
+
+begin
+	len1 = RL_LEN(r1)
+	len2 = RL_LEN(r2)
+
+	if (len1 != len2)
+	    return (false)
+
+	do i = RL_FIRST, len1
+	    if (r1[1,i] != r2[1,i] || r1[2,i] != r2[2,i] || r1[3,i] != r2[3,i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/plio/tf/plreql.x b/sys/plio/tf/plreql.x
new file mode 100644
index 00000000..1fb76d6a
--- /dev/null
+++ b/sys/plio/tf/plreql.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+
+# PLR_EQUAL -- Compare two range lists for equality.
+
+bool procedure plr_equall (r1, r2)
+
+long	r1[3,ARB]			#I range list 1
+long	r2[3,ARB]			#I range list 2
+
+int	i
+int	len1, len2
+
+begin
+	len1 = RL_LEN(r1)
+	len2 = RL_LEN(r2)
+
+	if (len1 != len2)
+	    return (false)
+
+	do i = RL_FIRST, len1
+	    if (r1[1,i] != r2[1,i] || r1[2,i] != r2[2,i] || r1[3,i] != r2[3,i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/plio/tf/plreqs.x b/sys/plio/tf/plreqs.x
new file mode 100644
index 00000000..b44bf4da
--- /dev/null
+++ b/sys/plio/tf/plreqs.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+
+# PLR_EQUAL -- Compare two range lists for equality.
+
+bool procedure plr_equals (r1, r2)
+
+short	r1[3,ARB]			#I range list 1
+short	r2[3,ARB]			#I range list 2
+
+int	i
+int	len1, len2
+
+begin
+	len1 = RL_LEN(r1)
+	len2 = RL_LEN(r2)
+
+	if (len1 != len2)
+	    return (false)
+
+	do i = RL_FIRST, len1
+	    if (r1[1,i] != r2[1,i] || r1[2,i] != r2[2,i] || r1[3,i] != r2[3,i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/plio/tf/plrpri.x b/sys/plio/tf/plrpri.x
new file mode 100644
index 00000000..a74e7791
--- /dev/null
+++ b/sys/plio/tf/plrpri.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PLR_PRINT -- Print a range list on the given output stream.
+
+procedure plr_printi (rl, fd, label, firstcol, maxcol)
+
+int	rl[3,ARB]		#I range list
+int	fd			#I output file
+char	label[ARB]		#I line label
+int	firstcol		#I first column for output
+int	maxcol			#I width of formatted output
+
+pointer	sp, buf
+int	col, rn, r_len, x, n, pv
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Output the line label and advance to the first column.  If the label
+	# extends beyond the first column, start a new line.
+
+	call putline (fd, label)
+	col = strlen (label) + 1
+	if (col > firstcol)
+	    call pl_debugout (fd, "", col, firstcol, maxcol)
+
+	r_len = RL_LEN(rl)
+
+	# Decode the range list proper.
+	do rn = RL_FIRST, r_len {
+	    x  = RL_X(rl,rn)
+	    n  = RL_N(rl,rn)
+	    pv = RL_V(rl,rn)
+
+	    if (n == 1) {
+		call sprintf (Memc[buf], SZ_LINE, "%d(%d)")
+		    call pargi (x)
+		    call pargi (pv)
+	    } else {
+		call sprintf (Memc[buf], SZ_LINE, "%d-%d(%d)")
+		    call pargi (x)
+		    call pargi (x+n-1)
+		    call pargi (pv)
+	    }
+
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+	}
+
+	call pl_debugout (fd, "", col, firstcol, maxcol)
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plrprl.x b/sys/plio/tf/plrprl.x
new file mode 100644
index 00000000..6357cd71
--- /dev/null
+++ b/sys/plio/tf/plrprl.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PLR_PRINT -- Print a range list on the given output stream.
+
+procedure plr_printl (rl, fd, label, firstcol, maxcol)
+
+long	rl[3,ARB]		#I range list
+int	fd			#I output file
+char	label[ARB]		#I line label
+int	firstcol		#I first column for output
+int	maxcol			#I width of formatted output
+
+pointer	sp, buf
+int	col, rn, r_len, x, n, pv
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Output the line label and advance to the first column.  If the label
+	# extends beyond the first column, start a new line.
+
+	call putline (fd, label)
+	col = strlen (label) + 1
+	if (col > firstcol)
+	    call pl_debugout (fd, "", col, firstcol, maxcol)
+
+	r_len = RL_LEN(rl)
+
+	# Decode the range list proper.
+	do rn = RL_FIRST, r_len {
+	    x  = RL_X(rl,rn)
+	    n  = RL_N(rl,rn)
+	    pv = RL_V(rl,rn)
+
+	    if (n == 1) {
+		call sprintf (Memc[buf], SZ_LINE, "%d(%d)")
+		    call pargi (x)
+		    call pargi (pv)
+	    } else {
+		call sprintf (Memc[buf], SZ_LINE, "%d-%d(%d)")
+		    call pargi (x)
+		    call pargi (x+n-1)
+		    call pargi (pv)
+	    }
+
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+	}
+
+	call pl_debugout (fd, "", col, firstcol, maxcol)
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plrprs.x b/sys/plio/tf/plrprs.x
new file mode 100644
index 00000000..e055f851
--- /dev/null
+++ b/sys/plio/tf/plrprs.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PLR_PRINT -- Print a range list on the given output stream.
+
+procedure plr_prints (rl, fd, label, firstcol, maxcol)
+
+short	rl[3,ARB]		#I range list
+int	fd			#I output file
+char	label[ARB]		#I line label
+int	firstcol		#I first column for output
+int	maxcol			#I width of formatted output
+
+pointer	sp, buf
+int	col, rn, r_len, x, n, pv
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Output the line label and advance to the first column.  If the label
+	# extends beyond the first column, start a new line.
+
+	call putline (fd, label)
+	col = strlen (label) + 1
+	if (col > firstcol)
+	    call pl_debugout (fd, "", col, firstcol, maxcol)
+
+	r_len = RL_LEN(rl)
+
+	# Decode the range list proper.
+	do rn = RL_FIRST, r_len {
+	    x  = RL_X(rl,rn)
+	    n  = RL_N(rl,rn)
+	    pv = RL_V(rl,rn)
+
+	    if (n == 1) {
+		call sprintf (Memc[buf], SZ_LINE, "%d(%d)")
+		    call pargi (x)
+		    call pargi (pv)
+	    } else {
+		call sprintf (Memc[buf], SZ_LINE, "%d-%d(%d)")
+		    call pargi (x)
+		    call pargi (x+n-1)
+		    call pargi (pv)
+	    }
+
+	    call pl_debugout (fd, Memc[buf], col, firstcol, maxcol)
+	}
+
+	call pl_debugout (fd, "", col, firstcol, maxcol)
+	call sfree (sp)
+end
diff --git a/sys/plio/tf/plrropi.x b/sys/plio/tf/plrropi.x
new file mode 100644
index 00000000..72292323
--- /dev/null
+++ b/sys/plio/tf/plrropi.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+include "../plrseg.h"
+
+# PL_RANGEROP -- Rasterop operation between source and destination range lists.
+# The indicated rasterop operation is performed upon the source and destination
+# range lists, writing the result to RL_OUT, which is a copy of RL_DST except
+# for the region affected by the rasterop operation (note that the destination
+# range list cannot be edited in place since it may change size).
+
+procedure pl_rangeropi (rl_src, xs, src_maxval,
+			 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+
+int	rl_src[3,ARB]		#I source range list
+int	xs			#I starting pixel index in src range list
+int	src_maxval		#I max pixel value in src mask
+int	rl_dst[3,ARB]		#I destination range list
+int	ds			#I starting pixel index in dst range list
+int	dst_maxval		#I max pixel value in dst mask
+int	rl_out[3,ARB]		#O output list (edited version of rl_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+bool	need_src, need_dst, rop_enable
+int	data, src_value, v_src, v_dst, pv
+int	segsize, opcode, x, i, np, rn_o, p
+int	d_src[LEN_PLRDES], d_dst[LEN_PLRDES]
+
+begin
+	need_src = R_NEED_SRC(rop)
+	need_dst = R_NEED_DST(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Advance to the desired position in the source list, discarding
+	# the unused ranges.  The point XS may lie within a range or in a
+	# zero area of the input line.
+
+	if (need_src) {
+	    x = 1
+	    plr_init (rl_src, d_src)
+	    do i = 1, ARB {
+		np = min (plr_nleft(d_src), xs - x)
+		plr_getseg (rl_src, d_src, np, v_src)
+		x = x + np
+		if (x >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Advance through both the source and destination lists, extracting
+	# line segments which have a constant value in each input list; the
+	# values for the two lists may differ.  Apply the given rasterop to
+	# the source and destination pixel values and write each line segment
+	# as a range to the output list.  If the ranges in the two input lists
+	# differ (randomly overlap) then the output list will generally be
+	# more fragmented, i.e., have more ranges of constant value.  As each
+	# output range is generated compare it with the previous range to see
+	# if they can be joined, as applying a rasterop may cause two different
+	# ranges to have the same value.
+
+	x = 1
+	rn_o = RL_FIRST
+	segsize = ds - 1
+	rop_enable = false
+	plr_init (rl_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been properly performed
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, plr_nleft(d_dst))
+	    if (need_src && rop_enable && plr_nleft(d_src) > 0)
+		np = min (np, plr_nleft(d_src))
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We must
+	    # read the DST list whether or not we will use the data, since
+	    # the list pointer must be advanced NPIX pixels so that we may
+	    # copy the remainder of the list after the loop.
+
+	    plr_getseg (rl_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		# Get v_src.
+		if (need_src) {
+		    v_src = 0
+		    if (plr_nleft (d_src) > 0)
+			plr_getseg (rl_src, d_src, np, v_src)
+
+		    if (R_NOTSRC(rop)) {
+			v_src = not (v_src)
+			if (src_maxval != 0)
+			    v_src = and (int(v_src), src_maxval)
+		    }
+
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		}
+
+		# Get v_dst.
+		if (need_dst) {
+		    if (R_NOTDST(rop)) {
+			v_dst = not (v_dst)
+			if (dst_maxval != 0)
+			    v_dst = and (int(v_dst), dst_maxval)
+		    }
+		}
+
+		# Apply the rasterop.
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC, PIX_NOTSRC:
+		    pv = v_src
+		case PIX_DST, PIX_NOTDST:
+		    pv = v_dst
+		case PIX_SRC_AND_DST, PIX_SRC_AND_NOTDST, PIX_NOTSRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST, PIX_SRC_OR_NOTDST, PIX_NOTSRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, or map int
+		# to bool for the case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (int(pv), dst_maxval)
+
+	    } else
+		pv = v_dst
+
+	    # Output a nonzero range.
+	    if (pv > 0) {
+		p = rn_o - 1
+		if (p >= RL_FIRST &&
+		    pv == rl_out[3,p] && x == rl_out[1,p] + rl_out[2,p]) {
+		    # Merge new range with previous one.
+		    rl_out[2,p] = rl_out[2,p] + np
+		} else {
+		    rl_out[1,rn_o] = x
+		    rl_out[2,rn_o] = np
+		    rl_out[3,rn_o] = pv
+		    rn_o = rn_o + 1
+		}
+	    }
+
+	    x = x + np
+	    segsize = segsize - np
+	}
+
+	# Update the range list header.
+	call amovi (rl_dst, rl_out, (RL_FIRST - 1) * 3)
+	RL_LEN(rl_out) = rn_o - 1
+end
diff --git a/sys/plio/tf/plrropl.x b/sys/plio/tf/plrropl.x
new file mode 100644
index 00000000..ec936e09
--- /dev/null
+++ b/sys/plio/tf/plrropl.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+include "../plrseg.h"
+
+# PL_RANGEROP -- Rasterop operation between source and destination range lists.
+# The indicated rasterop operation is performed upon the source and destination
+# range lists, writing the result to RL_OUT, which is a copy of RL_DST except
+# for the region affected by the rasterop operation (note that the destination
+# range list cannot be edited in place since it may change size).
+
+procedure pl_rangeropl (rl_src, xs, src_maxval,
+			 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+
+long	rl_src[3,ARB]		#I source range list
+int	xs			#I starting pixel index in src range list
+int	src_maxval		#I max pixel value in src mask
+long	rl_dst[3,ARB]		#I destination range list
+int	ds			#I starting pixel index in dst range list
+int	dst_maxval		#I max pixel value in dst mask
+long	rl_out[3,ARB]		#O output list (edited version of rl_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+bool	need_src, need_dst, rop_enable
+long	data, src_value, v_src, v_dst, pv
+int	segsize, opcode, x, i, np, rn_o, p
+int	d_src[LEN_PLRDES], d_dst[LEN_PLRDES]
+
+begin
+	need_src = R_NEED_SRC(rop)
+	need_dst = R_NEED_DST(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Advance to the desired position in the source list, discarding
+	# the unused ranges.  The point XS may lie within a range or in a
+	# zero area of the input line.
+
+	if (need_src) {
+	    x = 1
+	    plr_init (rl_src, d_src)
+	    do i = 1, ARB {
+		np = min (plr_nleft(d_src), xs - x)
+		plr_getseg (rl_src, d_src, np, v_src)
+		x = x + np
+		if (x >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Advance through both the source and destination lists, extracting
+	# line segments which have a constant value in each input list; the
+	# values for the two lists may differ.  Apply the given rasterop to
+	# the source and destination pixel values and write each line segment
+	# as a range to the output list.  If the ranges in the two input lists
+	# differ (randomly overlap) then the output list will generally be
+	# more fragmented, i.e., have more ranges of constant value.  As each
+	# output range is generated compare it with the previous range to see
+	# if they can be joined, as applying a rasterop may cause two different
+	# ranges to have the same value.
+
+	x = 1
+	rn_o = RL_FIRST
+	segsize = ds - 1
+	rop_enable = false
+	plr_init (rl_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been properly performed
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, plr_nleft(d_dst))
+	    if (need_src && rop_enable && plr_nleft(d_src) > 0)
+		np = min (np, plr_nleft(d_src))
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We must
+	    # read the DST list whether or not we will use the data, since
+	    # the list pointer must be advanced NPIX pixels so that we may
+	    # copy the remainder of the list after the loop.
+
+	    plr_getseg (rl_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		# Get v_src.
+		if (need_src) {
+		    v_src = 0
+		    if (plr_nleft (d_src) > 0)
+			plr_getseg (rl_src, d_src, np, v_src)
+
+		    if (R_NOTSRC(rop)) {
+			v_src = not (v_src)
+			if (src_maxval != 0)
+			    v_src = and (int(v_src), src_maxval)
+		    }
+
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		}
+
+		# Get v_dst.
+		if (need_dst) {
+		    if (R_NOTDST(rop)) {
+			v_dst = not (v_dst)
+			if (dst_maxval != 0)
+			    v_dst = and (int(v_dst), dst_maxval)
+		    }
+		}
+
+		# Apply the rasterop.
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC, PIX_NOTSRC:
+		    pv = v_src
+		case PIX_DST, PIX_NOTDST:
+		    pv = v_dst
+		case PIX_SRC_AND_DST, PIX_SRC_AND_NOTDST, PIX_NOTSRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST, PIX_SRC_OR_NOTDST, PIX_NOTSRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, or map int
+		# to bool for the case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (int(pv), dst_maxval)
+
+	    } else
+		pv = v_dst
+
+	    # Output a nonzero range.
+	    if (pv > 0) {
+		p = rn_o - 1
+		if (p >= RL_FIRST &&
+		    pv == rl_out[3,p] && x == rl_out[1,p] + rl_out[2,p]) {
+		    # Merge new range with previous one.
+		    rl_out[2,p] = rl_out[2,p] + np
+		} else {
+		    rl_out[1,rn_o] = x
+		    rl_out[2,rn_o] = np
+		    rl_out[3,rn_o] = pv
+		    rn_o = rn_o + 1
+		}
+	    }
+
+	    x = x + np
+	    segsize = segsize - np
+	}
+
+	# Update the range list header.
+	call amovl (rl_dst, rl_out, (RL_FIRST - 1) * 3)
+	RL_LEN(rl_out) = rn_o - 1
+end
diff --git a/sys/plio/tf/plrrops.x b/sys/plio/tf/plrrops.x
new file mode 100644
index 00000000..b2d9781c
--- /dev/null
+++ b/sys/plio/tf/plrrops.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+include "../plrseg.h"
+
+# PL_RANGEROP -- Rasterop operation between source and destination range lists.
+# The indicated rasterop operation is performed upon the source and destination
+# range lists, writing the result to RL_OUT, which is a copy of RL_DST except
+# for the region affected by the rasterop operation (note that the destination
+# range list cannot be edited in place since it may change size).
+
+procedure pl_rangerops (rl_src, xs, src_maxval,
+			 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+
+short	rl_src[3,ARB]		#I source range list
+int	xs			#I starting pixel index in src range list
+int	src_maxval		#I max pixel value in src mask
+short	rl_dst[3,ARB]		#I destination range list
+int	ds			#I starting pixel index in dst range list
+int	dst_maxval		#I max pixel value in dst mask
+short	rl_out[3,ARB]		#O output list (edited version of rl_dst)
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+bool	need_src, need_dst, rop_enable
+short	data, src_value, v_src, v_dst, pv
+int	segsize, opcode, x, i, np, rn_o, p
+int	d_src[LEN_PLRDES], d_dst[LEN_PLRDES]
+
+begin
+	need_src = R_NEED_SRC(rop)
+	need_dst = R_NEED_DST(rop)
+	opcode   = R_OPCODE(rop)
+	data     = R_DATA(rop)
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Advance to the desired position in the source list, discarding
+	# the unused ranges.  The point XS may lie within a range or in a
+	# zero area of the input line.
+
+	if (need_src) {
+	    x = 1
+	    plr_init (rl_src, d_src)
+	    do i = 1, ARB {
+		np = min (plr_nleft(d_src), xs - x)
+		plr_getseg (rl_src, d_src, np, v_src)
+		x = x + np
+		if (x >= xs || np == 0)
+		    break
+	    }
+	}
+
+	# Advance through both the source and destination lists, extracting
+	# line segments which have a constant value in each input list; the
+	# values for the two lists may differ.  Apply the given rasterop to
+	# the source and destination pixel values and write each line segment
+	# as a range to the output list.  If the ranges in the two input lists
+	# differ (randomly overlap) then the output list will generally be
+	# more fragmented, i.e., have more ranges of constant value.  As each
+	# output range is generated compare it with the previous range to see
+	# if they can be joined, as applying a rasterop may cause two different
+	# ranges to have the same value.
+
+	x = 1
+	rn_o = RL_FIRST
+	segsize = ds - 1
+	rop_enable = false
+	plr_init (rl_dst, d_dst)
+
+	do i = 1, ARB {
+	    # Set up for the next segment (before, in, and after the region to
+	    # which the ROP applies), when the current segment is exhausted.
+
+	    if (segsize <= 0)
+		if (!rop_enable) {
+		    # Begin processing central region.
+		    segsize = npix
+		    rop_enable = true
+		    if (segsize <= 0)
+			next
+		} else {
+		    # Begin processing final region.
+		    segsize = ARB
+		    rop_enable = false
+		}
+
+	    # Determine the length of the next output segment.  This is the
+	    # largest segment of constant value formed by the intersection of
+	    # the two lists.  If bounds checking has been properly performed
+	    # then it should not be possible to see nleft=zero on either input
+	    # list.  Note that zeroed regions are valid data here.
+
+	    np = min (segsize, plr_nleft(d_dst))
+	    if (need_src && rop_enable && plr_nleft(d_src) > 0)
+		np = min (np, plr_nleft(d_src))
+	    if (np <= 0)
+		break
+
+	    # Get the segment value and advance the line pointers.  We must
+	    # read the DST list whether or not we will use the data, since
+	    # the list pointer must be advanced NPIX pixels so that we may
+	    # copy the remainder of the list after the loop.
+
+	    plr_getseg (rl_dst, d_dst, np, v_dst)
+	    if (rop_enable) {
+		# Get v_src.
+		if (need_src) {
+		    v_src = 0
+		    if (plr_nleft (d_src) > 0)
+			plr_getseg (rl_src, d_src, np, v_src)
+
+		    if (R_NOTSRC(rop)) {
+			v_src = not (v_src)
+			if (src_maxval != 0)
+			    v_src = and (int(v_src), src_maxval)
+		    }
+
+		    if (v_src != 0 && src_maxval == 1)
+			v_src = src_value
+		}
+
+		# Get v_dst.
+		if (need_dst) {
+		    if (R_NOTDST(rop)) {
+			v_dst = not (v_dst)
+			if (dst_maxval != 0)
+			    v_dst = and (int(v_dst), dst_maxval)
+		    }
+		}
+
+		# Apply the rasterop.
+		switch (opcode) {
+		case PIX_CLR:
+		    pv = 0
+		case PIX_SET:
+		    pv = data
+		case PIX_SRC, PIX_NOTSRC:
+		    pv = v_src
+		case PIX_DST, PIX_NOTDST:
+		    pv = v_dst
+		case PIX_SRC_AND_DST, PIX_SRC_AND_NOTDST, PIX_NOTSRC_AND_DST:
+		    pv = and (v_src, v_dst)
+		case PIX_SRC_OR_DST, PIX_SRC_OR_NOTDST, PIX_NOTSRC_OR_DST:
+		    pv = or (v_src, v_dst)
+		case PIX_SRC_XOR_DST:
+		    pv = xor (v_src, v_dst)
+		case PIX_NOT_SRC_AND_DST:
+		    pv = not (and (v_src, v_dst))
+		case PIX_NOT_SRC_OR_DST:
+		    pv = not (or (v_src, v_dst))
+		case PIX_NOT_SRC_XOR_DST:
+		    pv = not (xor (v_src, v_dst))
+		}
+
+		# Mask the high bits to prevent negative values, or map int
+		# to bool for the case of a boolean output mask.
+
+		if (dst_maxval == 1 && pv != 0)
+		    pv = 1
+		else if (dst_maxval > 1)
+		    pv = and (int(pv), dst_maxval)
+
+	    } else
+		pv = v_dst
+
+	    # Output a nonzero range.
+	    if (pv > 0) {
+		p = rn_o - 1
+		if (p >= RL_FIRST &&
+		    pv == rl_out[3,p] && x == rl_out[1,p] + rl_out[2,p]) {
+		    # Merge new range with previous one.
+		    rl_out[2,p] = rl_out[2,p] + np
+		} else {
+		    rl_out[1,rn_o] = x
+		    rl_out[2,rn_o] = np
+		    rl_out[3,rn_o] = pv
+		    rn_o = rn_o + 1
+		}
+	    }
+
+	    x = x + np
+	    segsize = segsize - np
+	}
+
+	# Update the range list header.
+	call amovs (rl_dst, rl_out, (RL_FIRST - 1) * 3)
+	RL_LEN(rl_out) = rn_o - 1
+end
diff --git a/sys/plio/zzdebug.x b/sys/plio/zzdebug.x
new file mode 100644
index 00000000..0ff3cc47
--- /dev/null
+++ b/sys/plio/zzdebug.x
@@ -0,0 +1,1442 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<xwhen.h>
+include	<error.h>
+include	<ctype.h>
+include	<fset.h>
+include	<plset.h>
+include	<plio.h>
+
+task	pltest	= t_pltest,
+	script	= t_script
+
+.help pltest
+.nf -------------------------------------------------------------------------
+PLTEST -- PL package debug and test facility.
+
+    Due to the complexity of the PL package, testing is performed using an
+interactive interpreter which reads commands from the standard input.
+All commands operate internally upon a set of four mask registers A-D,
+and a set of ten vector registers V[0-9].
+
+	a,b,c,d		- mask registers
+	v0,...,v9	- vector registers
+
+The following commands are defined:
+
+	help					# print command summary
+	timer					# toggle timing of commands
+	run fname				# read commands from a file
+	log [fname]				# log commands in a file
+	clear					# clear the screen
+	bye					# all done (also EOF)
+
+	create [mask] naxes axlen depth		# create a new mask
+	load [mask] fname			# load mask from file
+	save [mask] fname [title]		# save mask in file
+	loadim [mask] image			# load mask from image
+	saveim [mask] image [title]		# save mask in image
+	erase [mask] [vs ve]			# erase a mask or region
+	draw [mask] [vs ve] [>ofile]		# draw mask or region of mask
+
+	set [mask]				# set reference mask
+	set [vector] i j k...			# load vector register
+	show [vector]				# print vector register
+	show [mask] [index] [ll] [rl] [>ofile]	# print debug info for a mask
+
+	box [mask] P1 P2 rop			# draw a box
+	circle [mask] P1 r rop			# draw a circle
+	line [mask] P1 P2 width rop		# draw a line segment
+	point [mask] P1 rop			# draw a point
+	polygon [mask] P1 ... PN rop		# draw a polygon
+
+	rop src [vs] dst [vs] [vn] rop			# rasterop
+	stencil src [vs] dst [vs] stn [vs] [vn] rop	# stencil
+	invert [mask] [vs [vn]]			# invert a mask
+
+	compare mask1 mask2			# compare two masks
+	rtest mask1 mask2			# range list conversion test
+	ptest mask1 mask2			# pixel array conversion test
+	secne [mask] vs ve			# test if section not empty
+	secnc [mask] vs ve			# test if section not constant
+	rio [mask] vs				# test mask using random i/o
+
+Rasterops may be specified either as integer constants (any radix) or via
+a simple symbolic notation, e.g.:  "opcode+[value]".
+
+A mask may be examined in detail with SHOW, which calls pl_debug to decode
+the contents of a mask.  A graphic image of a mask may be drawn with DRAW,
+which renders each pixel in the mask as a printable character.
+.endhelp --------------------------------------------------------------------
+
+define	SZ_SBUF		512			# size limiting parameters
+define	DEF_MASKSIZE_X	75
+define	DEF_MASKSIZE_Y	40
+define	MAXKWLEN	20
+define	MAXARGS		50
+define	MAXMREG		4
+define	MAXVREG		10
+define	MAXINCL		10
+define	WIDTH		80
+
+define	INT_ARG		1			# argument types
+define	STRING_ARG	2
+define	VECTOR_ARG	3
+define	MASK_ARG	4
+
+define	v_i	argval[$1]			# integer argument
+define	v_s	sbuf[argval[$1]]		# string argument
+define	v_si	sbuf[argval[$1]+$2-1]		# indexed string argument
+define	v_v	v_reg[1,argval[$1]+1]		# vector argument
+define	v_vi	v_reg[$2,argval[$1]+1]		# indexed vector argument
+define	v_m	v_mask[argval[$1]]		# mask argument
+
+define	KW_BOX		1			# interpreter commands
+define	KW_BYE		2
+define	KW_CIRCLE	3
+define	KW_CLEAR	4
+define	KW_COMPARE	5
+define	KW_CREATE	6
+define	KW_DRAW		7
+define	KW_ERASE	8
+define	KW_HELP		9
+# eol			10
+define	KW_LINE		11
+define	KW_POINT	12
+define	KW_POLYGON	13
+define	KW_LOAD		14
+define	KW_LOADIM	15
+define	KW_PTEST	16
+define	KW_ROP		17
+define	KW_RTEST	18
+define	KW_RUN		19
+define	KW_SAVE		20
+define	KW_SAVEIM	21
+# eol			22
+define	KW_SET		23
+define	KW_SHOW		24
+define	KW_SECNE	25
+define	KW_SECNC	26
+define	KW_RIO		27
+define	KW_STENCIL	28
+define	KW_INVERT	29
+define	KW_TIMER	30
+define	KW_LOG		31
+
+
+# PLTEST -- Test the PL package.  Read and execute commands from the standard
+# input until EOF or BYE is seen.
+
+procedure t_pltest()
+
+long	time[2]
+int	x, y, r
+bool	timer, bval
+int	px[MAXARGS], py[MAXARGS], old_onint, width, mval
+pointer	pl, pl_1, pl_2, def_pl, pl_src, pl_dst, pl_stn, tty, plr
+char	cmd[SZ_LINE], kwname[SZ_FNAME], title[SZ_LINE], fname[SZ_FNAME]
+int	what, rop, v_arg, x1, x2, y1, y2, ip, op, ch, i, j, cmdlog, status
+int	opcode, save_fd[MAXINCL], in, fd, o_fd, maskno, depth, naxes, npts
+int	v1[PL_MAXDIM], v2[PL_MAXDIM], v3[PL_MAXDIM], v4[PL_MAXDIM], v[PL_MAXDIM]
+
+int	plr_getpix(), pl_compare()
+int	fstati(), strdic(), open(), getline(), strncmp(), locpr()
+pointer	pl_create(), ttyodes(), plr_open()
+bool	pl_sectnotempty(), pl_sectnotconst()
+extern	onint()
+
+char	sbuf[SZ_SBUF]
+int	nargs, argno, argtype[MAXARGS], argval[MAXARGS], s_op
+int	v_mask[MAXMREG], v_reg[PL_MAXDIM,MAXVREG], jmpbuf[LEN_JUMPBUF]
+common	/plzcom/ v_mask, v_reg, nargs, argno, argtype, argval, s_op,
+	jmpbuf, sbuf
+define	argerr_ 91
+define	eof_ 92
+
+string	keywords "|box|bye|circle|clear|compare|create|draw|erase|help|\
+	|line|point|polygon|load|loadim|ptest|rop|rtest|run|save|saveim|\
+	|set|show|secne|secnc|rio|stencil|invert|timer|log|"
+
+begin
+	in = 0
+	ip = 1
+	fd = STDIN
+	cmdlog = 0
+	cmd[ip] = EOS
+	timer = false
+
+	# Initialize the mask registers.
+	v[1] = DEF_MASKSIZE_X
+	v[2] = DEF_MASKSIZE_Y
+	do i = 1, MAXMREG
+	    v_mask[i] = pl_create (2, v, 7)
+	def_pl = v_mask[1]
+
+	# Initialize the vector registers.
+	do i = 1, MAXVREG
+	    call amovki (1, v_reg[1,i], PL_MAXDIM)
+
+	# Main interpreter loop.
+	# ---------------------------
+
+	call xwhen (X_INT, locpr(onint), old_onint)
+	call zsvjmp (jmpbuf, status)
+
+	if (status != OK) {
+	    # Clean up after an interrupt.
+	    call xer_reset()
+	    ip = 1;  cmd[ip] = EOS
+	    while (in > 0) {
+		call close (fd)
+		fd = save_fd[in]
+		in = in - 1
+	    }
+	}
+
+	repeat {
+	    # Get next command.
+	    if (cmd[ip] == '\n' || cmd[ip] == '#' || cmd[ip] == EOS) {
+		# Prompt if reading from the standard input.
+		if (in == 0 && fstati (STDIN, F_REDIR) == NO) {
+		    call putline (STDOUT, "* ")
+		    call flush (STDOUT)
+		}
+
+		# Handle EOF on the current command stream.
+		if (getline (fd, cmd) == EOF) {
+eof_		    if (in > 0) {
+			call close (fd)
+			fd = save_fd[in]
+			in = in - 1
+		    } else
+			break
+		}
+
+		ip = 1
+	    }
+
+	    # Skip blank lines and comment lines.
+	    for (ip=1;  IS_WHITE(cmd[ip]) || cmd[ip] == ';';  ip=ip+1)
+		;
+	    if (cmd[ip] == '\n' || cmd[ip] == '#' || cmd[ip] == EOS)
+		next
+
+	    if (cmdlog != 0)
+		call putline (cmdlog, cmd)
+
+	    # Extract the keyword into the KWNAME buffer.  Leave the input
+	    # pointer positioned to the first char following the keyword.
+
+	    for (op=1;  cmd[ip] != EOS && cmd[ip] != '\n';  ip=ip+1) {
+		ch = cmd[ip]
+		if (IS_ALNUM(ch) || ch == '?' || ch == '_') {
+		    kwname[op] = ch
+		    op = op + 1
+		} else
+		    break
+	    }
+	    kwname[op] = EOS
+
+	    # Look up the keyword in the dictionary.  If not found ring the
+	    # bell, but do not quit.
+
+	    if (kwname[1] == '?')
+		opcode = KW_HELP
+	    else
+		opcode = strdic (kwname, kwname, MAXKWLEN, keywords)
+	    if (opcode <= 0) {
+		call eprintf ("unknown command\007\n")
+		call flush (STDERR)
+		ip=1;  cmd[ip] = EOS
+		next
+	    }
+
+	    # Parse the argument list.
+	    call parse_args (cmd, ip)
+
+	    # Process the command.
+	    # -------------------------
+
+	    switch (opcode) {
+	    case KW_BYE:
+		goto eof_
+
+	    case KW_LOG:
+		# Enable/Disable command logging.
+
+		if (cmdlog == 0) {
+		    if (nargs >= 1 && argtype[argno] == STRING_ARG)
+			cmdlog = open (v_s(argno), APPEND, TEXT_FILE)
+		    else
+			cmdlog = open ("zzdebug.log", APPEND, TEXT_FILE)
+		    call eprintf ("command spooling enabled\n")
+		    call fprintf (cmdlog, "# --- begin ---\n")
+		} else {
+		    call close (cmdlog)
+		    cmdlog = 0
+		    call eprintf ("command spooling disabled\n")
+		}
+
+	    case KW_POINT:
+		# Draw a point.
+
+		# Get mask.
+		pl = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get coords of point.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 2
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('1')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_point (pl, x1, y1, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_BOX:
+		# Draw a box.
+
+		# Get mask.
+		pl = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get corner coords of box.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		    if (argtype[argno] != VECTOR_ARG)
+			goto argerr_
+		    x2 = v_vi(argno,1)
+		    y2 = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 4
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		    x2 = v_i(argno);  argno = argno + 1
+		    y2 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('2')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_box (pl, x1, y1, x2, y2, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_LINE:
+		# Draw a line of arbitrary orientation and width.
+
+		# Get mask.
+		pl = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get endpoints of line.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		    if (argtype[argno] != VECTOR_ARG)
+			goto argerr_
+		    x2 = v_vi(argno,1)
+		    y2 = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 4
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		    x2 = v_i(argno);  argno = argno + 1
+		    y2 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get line width.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    width = v_i(argno);  argno = argno + 1
+		} else
+		    width = 1
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('4')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_line (pl, x1, y1, x2, y2, width, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CIRCLE:
+		# Draw a circle.
+
+		# Get mask.
+		pl = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get center coords and radius of circle.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Center coords given as a vector.
+		    x = v_vi(argno,1)
+		    y = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Center coords given explicitly.
+		    do i = 1, 2
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x = v_i(argno);  argno = argno + 1
+		    y = v_i(argno);  argno = argno + 1
+		}
+
+		if (argtype[argno] != INT_ARG)
+		    goto argerr_
+		r = v_i(argno);  argno = argno + 1
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('Q')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_circle (pl, x, y, r, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_POLYGON:
+		# Draw a polygon.
+
+		# Get mask.
+		pl = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get the coordinates of the polygon.
+		for (npts=0;  argno <= nargs;  ) {
+		    npts = npts + 1
+
+		    if (argtype[argno] == VECTOR_ARG) {
+			# Coords of point given as a vector.
+			px[npts] = v_vi(argno,1)
+			py[npts] = v_vi(argno,2)
+			argno = argno + 1
+
+		    } else if (argtype[argno] == INT_ARG &&
+			argtype[argno+1] == INT_ARG) {
+
+			# Center coords given explicitly.
+			px[npts] = v_i(argno);  argno = argno + 1
+			py[npts] = v_i(argno);  argno = argno + 1
+		    }
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('R')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_polygon (pl, px, py, npts, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CLEAR:
+		# Clear the screen.
+		tty = ttyodes ("terminal")
+		call ttyclear (STDOUT, tty)
+		call ttycdes (tty)
+
+	    case KW_COMPARE:
+		# Compare two masks.
+		if (nargs < 2)
+		    goto argerr_
+
+		# Get mask 1.
+		if (argtype[argno] == MASK_ARG) {
+		    pl_1 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Get mask 2.
+		if (argtype[argno] == MASK_ARG) {
+		    pl_2 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		status = pl_compare (pl_1, pl_2, STDOUT)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CREATE:
+		# Create a new, emtpy mask of the given size and depth.
+
+		# Get mask.
+		maskno = 1
+		if (argtype[argno] == MASK_ARG) {
+		    maskno = v_i(argno)
+		    argno = argno + 1
+		}
+
+		# Get naxes.
+		if (argtype[argno] != INT_ARG)
+		    goto argerr_
+		naxes = v_i(argno);  argno = argno + 1
+
+		# Get mask size.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Mask size given as vector.
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else {
+		    # Mask size given explicitly.
+		    do i = 1, naxes {
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+			v1[i] = v_i(argno)
+			argno = argno + 1
+		    }
+		}
+
+		# Get mask depth.
+		if (argtype[argno] != INT_ARG)
+		    depth = 1
+		else {
+		    depth = v_i(argno)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_close (v_mask[maskno])
+		v_mask[maskno] = pl_create (naxes, v1, depth)
+		def_pl = v_mask[maskno]
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+		
+	    case KW_DRAW:
+		# Draw a mask or region of a mask on the screen.
+
+		# Get mask.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be drawn.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl,1), v2, PL_MAXDIM)
+
+		# Get output stream.
+		o_fd = STDOUT
+		if (argtype[argno] == STRING_ARG) {
+		    if (v_si(argno,1) == '>') {
+			# Write output to a file.
+			if (v_si(argno,2) == '>') {
+			    iferr (o_fd = open (v_si(argno,3),
+				APPEND, TEXT_FILE)) {
+				call erract (EA_WARN)
+				o_fd = STDOUT
+			    }
+			} else {
+			    iferr (o_fd = open (v_si(argno,2),
+				NEW_FILE, TEXT_FILE)) {
+				call erract (EA_WARN)
+				o_fd = STDOUT
+			    }
+			}
+		    } else {
+			call eprintf ("unknown option `%s'\n")
+			    call pargstr (v_s(argno))
+		    }
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		call pl_asciidump (pl, v1, v2, o_fd)
+
+		if (o_fd != STDOUT)
+		    call close (o_fd)
+
+	    case KW_ERASE:
+		# Erase a mask, or a region of a mask.
+
+		# Get mask.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be erased.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		if (nargs <= 1)
+		    call pl_clear (pl)
+		else
+		    call pl_rop (NULL, 0, pl, v1, v2, PIX_CLR)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_HELP:
+		# Print a command summary.
+		call print_help (STDOUT)
+
+	    case KW_RUN:
+		# Read commands from a file.
+		if (nargs < 1 || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		in = in + 1
+		if (in > MAXINCL)
+		    call error (1, "too many nested run files\n")
+		save_fd[in] = fd
+		iferr (fd = open (v_s(argno), READ_ONLY, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    fd = save_fd[in]
+		    in = in - 1
+		}
+
+	    case KW_SET:
+		# Set the value of a mask or vector register.
+		if (nargs < 1) {
+		    goto argerr_
+
+		} else if (argtype[argno] == MASK_ARG) {
+		    # Set the default mask.
+		    def_pl = v_m(argno)
+		    maskno = v_i(argno)
+
+		} else if (argtype[argno] == VECTOR_ARG) {
+		    # Set a vector register.
+		    v_arg = argno
+		    argno = argno + 1
+
+		    do i = 1, PL_MAXDIM
+			if (argno <= nargs && argtype[argno] == INT_ARG) {
+			    v[i] = v_i(argno)
+			    argno = argno + 1
+			} else
+			    v[i] = 1
+
+		    call amovi (v, v_v(v_arg), PL_MAXDIM)
+		}
+
+	    case KW_SHOW:
+		# Print information about a mask or vector register.
+
+		if (nargs < 1 || argtype[argno] == MASK_ARG) {
+		    # Print information about a mask.
+
+		    if (nargs < 1)
+			pl = def_pl
+		    else {
+			pl = v_m(argno)
+			argno = argno + 1
+		    }
+
+		    o_fd = STDOUT
+
+		    # Process option selects.
+		    what = PD_SUMMARY
+		    while (argno <= nargs && argtype[argno] == STRING_ARG) {
+			if (strncmp (v_s(argno), "i", 1) == 0) {
+			    what = or (what, PD_INDEX)
+			} else if (strncmp (v_s(argno), "ll", 2) == 0) {
+			    what = or (what, PD_LLOUT)
+			} else if (strncmp (v_s(argno), "rl", 2) == 0) {
+			    what = or (what, PD_RLOUT)
+			} else if (strncmp (v_s(argno), "lh", 2) == 0) {
+			    what = or (what, PD_LHDR)
+
+			} else if (v_si(argno,1) == '>') {
+			    # Write output to a file.
+			    if (v_si(argno,2) == '>') {
+				iferr (o_fd = open (v_si(argno,3),
+				    APPEND, TEXT_FILE)) {
+				    call erract (EA_WARN)
+				    o_fd = STDOUT
+				}
+			    } else {
+				iferr (o_fd = open (v_si(argno,2),
+				    NEW_FILE, TEXT_FILE)) {
+				    call erract (EA_WARN)
+				    o_fd = STDOUT
+				}
+			    }
+			} else {
+			    call eprintf ("unknown option `%s'\n")
+				call pargstr (v_s(argno))
+			}
+			argno = argno + 1
+		    }
+
+		    # Perform the operation.
+		    call pl_debug (pl, o_fd, WIDTH, what)
+		    if (o_fd != STDOUT)
+			call close (o_fd)
+
+		} else if (argtype[argno] == VECTOR_ARG) {
+		    # Print the value of a vector register.
+		    call printf ("v%d: ")
+			call pargi (v_i(argno))
+		    do i = 1, PL_MAXDIM {
+			call printf (" %d")
+			    call pargi (v_vi(argno,i))
+		    }
+		    call printf ("\n")
+
+		} else {
+		    # Print the value of all vector registers.
+		    do j = 1, MAXVREG {
+			call printf ("v%d: ")
+			    call pargi (j-1)
+			do i = 1, PL_MAXDIM {
+			    call printf (" %d")
+				call pargi (v_reg(i,j))
+			}
+			call printf ("\n")
+		    }
+		}
+
+	    case KW_LOAD:
+		# Load a mask from a file.
+
+		# Get mask to be loaded.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get mask filename.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pl_loadf (pl, v_s(argno), title, SZ_LINE))
+		    call erract (EA_WARN)
+		else if (title[1] != EOS) {
+		    call printf ("mask: %s\n")
+			call pargstr (title)
+		    call flush (STDOUT)
+		}
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SAVE:
+		# Save a mask in a file.
+
+		# Get mask to be saved.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get mask filename.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+		else {
+		    call strcpy (v_s(argno), fname, SZ_FNAME)
+		    argno = argno + 1
+		}
+
+		# Get title string.
+		if (argno <= nargs && argtype[argno] == STRING_ARG) {
+		    call strcpy (v_s(argno), title, SZ_LINE)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pl_savef (pl, fname, title, 0))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_LOADIM:
+		# Load a mask from an image.
+
+		# Get mask to be loaded.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get image section.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pl_loadim (pl, v_s(argno), title, SZ_LINE))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SAVEIM:
+		# Save a mask in an image.
+
+		# Get mask to be saved.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get output image name.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+		else {
+		    call strcpy (v_s(argno), fname, SZ_FNAME)
+		    argno = argno + 1
+		}
+
+		# Get title string.
+		if (argno <= nargs && argtype[argno] == STRING_ARG) {
+		    call strcpy (v_s(argno), title, SZ_LINE)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pl_saveim (pl, fname, title, 0))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_ROP:
+		# General rasterop operation.
+
+		# Get source mask.
+		pl_src = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl_src = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in source mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Get destination mask.
+		pl_dst = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl_dst = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in destination mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v2, PL_MAXDIM)
+
+		# Get vector defining size of region to be modified.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v3, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl_dst,1), v3, PL_MAXDIM)
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = PIX_SRC
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_rop (pl_src, v1, pl_dst, v2, v3, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_STENCIL:
+		# Rasterop operation though a stencil mask.
+
+		# Get source mask.
+		pl_src = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl_src = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in source mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Get destination mask.
+		pl_dst = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl_dst = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in destination mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v2, PL_MAXDIM)
+
+		# Get stencil mask.
+		pl_stn = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl_stn = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in stencil mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v3, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v3, PL_MAXDIM)
+
+		# Get vector defining size of region to be modified.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v4, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl_dst,1), v4, PL_MAXDIM)
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else {
+		    call eprintf ("no rop specified - copying src to dst\n")
+		    rop = PIX_SRC
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pl_stencil (pl_src, v1, pl_dst, v2, pl_stn, v3, v4, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_INVERT:
+		# Invert a mask.
+
+		# Get mask.
+		pl_src = def_pl
+		if (argtype[argno] == MASK_ARG) {
+		    pl_src = v_m(argno)
+		    argno = argno + 1
+		}
+		pl_dst = pl_src
+
+		# Get start vector in mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Get vector defining size of region to be modified.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl_dst,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		rop = PIX_NOT(PIX_SRC)
+		call pl_rop (pl_src, v1, pl_dst, v1, v2, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_PTEST, KW_RTEST:
+		# Line list to pixel array or range list conversion test.
+		if (nargs < 2)
+		    goto argerr_
+
+		# Get mask 1.
+		if (argtype[argno] == MASK_ARG) {
+		    pl_1 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Get mask 2.
+		if (argtype[argno] == MASK_ARG) {
+		    pl_2 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call conv_test (pl_1, pl_2, STDOUT, opcode)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SECNE:
+		# Test if a section of a mask is not empty.
+
+		# Get mask.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be erased.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+
+		bval = pl_sectnotempty (pl, v1, v2, 2)
+		call printf ("pl_sectnotempty -> %b (mask is %s)\n")
+		    call pargb (bval)
+		    if (bval)
+			call pargstr ("not empty")
+		    else
+			call pargstr ("empty")
+
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SECNC:
+		# Test if a section of a mask is not constant.
+
+		# Get mask.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be erased.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pl,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		
+		call printf ("pl_sectnotconst -> ")
+		if (pl_sectnotconst (pl, v1, v2, 2, mval))
+		    call printf ("true (mask is not constant)\n")
+		else {
+		    call printf ("false (mask is constant, value=%d)\n")
+			call pargi (mval)
+		}
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_RIO:
+		# Test access to a mask using random io (plr_getpix).
+
+		# Get mask.
+		pl = def_pl
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pl = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be tested.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+
+		call amovki (1, v, PL_MAXDIM)
+		plr = plr_open (pl, v, 0)
+		call printf ("mask pixel [%d,%d] has value %d\n")
+		    call pargi (v1[1])
+		    call pargi (v1[2])
+		    call pargi (plr_getpix (plr, v1[1], v1[2]))
+		call plr_close (plr)
+
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_TIMER:
+		if (timer) {
+		    call printf ("timer off\n")
+		    timer = false
+		} else {
+		    call printf ("timer on\n")
+		    timer = true
+		}
+
+	    default:
+		# Unrecognized command.
+		call eprintf ("unknown switch\007\n")
+		call flush (STDERR)
+	    }
+
+	    call flush (STDOUT)
+	    if (cmdlog != 0)
+		call flush (cmdlog)
+	    next
+argerr_
+	    call eprintf ("invalid argument list\n")
+	}
+
+	call zxwhen (X_INT, old_onint, status)
+	if (cmdlog != 0)
+	    call close (cmdlog)
+
+	do i = 1, MAXMREG
+	    call pl_close (v_mask[i])
+end
+
+
+# ONINT -- Interrupt handler.
+
+procedure onint (signal, next_handler)
+
+int	signal			#I signal code
+int	next_handler		#O epa of next handler
+
+char	sbuf[SZ_SBUF]
+int	nargs, argno, argtype[MAXARGS], argval[MAXARGS], s_op
+int	v_mask[MAXMREG], v_reg[PL_MAXDIM,MAXVREG], jmpbuf[LEN_JUMPBUF]
+common	/plzcom/ v_mask, v_reg, nargs, argno, argtype, argval, s_op,
+	jmpbuf, sbuf
+
+begin
+	call fseti (STDOUT, F_CANCEL, OK)
+	call eprintf ("interrupt!\007\n")
+	call zdojmp (jmpbuf, signal)
+end
+
+
+# PARSE_ARGS -- Parse the argument list to an interpreter command, leaving
+# the decoded arguments in the interpreter common, and returning the number
+# of arguments as the function value.
+
+procedure parse_args (args, ip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer into argument list
+
+double	dval
+int	nchars, junk, i
+int	ctowrd(), stridx(), gctod(), strlen()
+
+char	sbuf[SZ_SBUF]
+int	nargs, argno, argtype[MAXARGS], argval[MAXARGS], s_op
+int	v_mask[MAXMREG], v_reg[PL_MAXDIM,MAXVREG], jmpbuf[LEN_JUMPBUF]
+common	/plzcom/ v_mask, v_reg, nargs, argno, argtype, argval, s_op,
+	jmpbuf, sbuf
+
+begin
+	s_op = 1
+	argno = 1
+	nargs = 0
+
+	do i = 1, MAXARGS
+	    argtype[i] = 0
+
+	# Get next token.
+	junk = ctowrd (args, ip, sbuf[s_op], SZ_SBUF-s_op)
+	nchars = strlen (sbuf[s_op])
+
+	while (nchars > 0) {
+	    nargs = nargs + 1
+	    if (nargs > MAXARGS)
+		call error (1, "too many arguments")
+
+	    if (nchars == 1 && sbuf[s_op] == '=') {
+		# Discard assignment operator.
+		nargs = nargs - 1
+
+	    } else if (nchars == 1 && stridx (sbuf[s_op], "abcd") > 0) {
+		# Mask register.
+		argval[nargs] = stridx (sbuf[s_op], "abcd")
+		argtype[nargs] = MASK_ARG
+
+	    } else if (nchars == 2 && sbuf[s_op] == 'v' &&
+		# Vector register.
+		IS_DIGIT(sbuf[s_op+1])) {
+		argval[nargs] = TO_INTEG(sbuf[s_op+1])
+		argtype[nargs] = VECTOR_ARG
+
+	    } else if (IS_DIGIT (sbuf[s_op])) {
+		# Get an integer constant.
+		i=1;  nchars = gctod (sbuf[s_op], i, dval)
+		argval[nargs] = nint(dval)
+		argtype[nargs] = INT_ARG
+
+		# Handle the notation "opcode+value", for rasterops.
+		if (sbuf[s_op+i-1] == '+') {
+		    i=i+1;  nchars = gctod (sbuf[s_op], i, dval)
+		    argval[nargs] = argval[nargs] + PIX_VALUE(nint(dval))
+		}
+
+	    } else {
+		# String constant.
+		argval[nargs] = s_op
+		argtype[nargs] = STRING_ARG
+		s_op = s_op + nchars + 1
+	    }
+
+	    while (IS_WHITE(args[ip]))
+		ip = ip + 1
+	    if (args[ip] == ';' || args[ip] == '\n') {
+		ip = ip + 1
+		break
+	    }
+
+	    # Get next token.
+	    junk = ctowrd (args, ip, sbuf[s_op], SZ_SBUF-s_op)
+	    nchars = strlen (sbuf[s_op])
+	}
+end
+
+
+# CONV_TEST -- Test the line list to pixel array or range list conversion
+# routines.
+
+procedure conv_test (pl_1, pl_2, fd, opcode)
+
+pointer	pl_1			#I input mask
+pointer	pl_2			#I output mask
+int	fd			#I output file, for reporting errors
+int	opcode			#I KW_[PR]TEST
+
+begin
+	call fprintf (fd, "conv_test called\n")
+end
+
+
+# PRINT_HELP -- Print the PL test interpreter commands help summary.
+
+procedure print_help (fd)
+
+int	fd			#I output file
+
+begin
+	call fprintf (fd, "help%48t# print command summary\n")
+	call fprintf (fd, "timer%48t# toggle timing of commands\n")
+	call fprintf (fd, "run fname%48t# read commands from a file\n")
+	call fprintf (fd, "log [fname]%48t# log commands in a file\n")
+	call fprintf (fd, "clear%48t# clear the screen\n")
+	call fprintf (fd, "bye%48t# all done (also EOF)\n\n")
+	call fprintf (fd,
+	"create [mask] naxes axlen [depth]%48t# create a new mask\n")
+	call fprintf (fd, "load [mask] fname%48t# load mask from file\n")
+	call fprintf (fd, "save [mask] fname%48t# save mask in file\n")
+	call fprintf (fd, "loadim [mask] image%48t# load mask from image\n")
+	call fprintf (fd, "saveim [mask] image%48t# save mask in image\n")
+	call fprintf (fd, "erase [mask] [vs ve]%48t# erase a mask or region\n")
+	call fprintf (fd,
+	"draw [mask] [vs ve] [>ofile]%48t# draw mask or region of mask\n\n")
+	call fprintf (fd, "set [mask]%48t# set reference mask\n")
+	call fprintf (fd, "set [vector] i j k...%48t# load vector register\n")
+	call fprintf (fd, "show [vector]%48t# print vector register\n")
+	call fprintf (fd,
+"show [mask] [index] [ll] [rl] [>ofile]%48t# print debug info for a mask\n\n")
+	call fprintf (fd, "box P1 P2 rop%48t# draw a box\n")
+	call fprintf (fd, "circle P1 r rop%48t# draw a circle\n \n")
+	call fprintf (fd,
+	"line [mask] P1 P2 width rop%48t# draw a line segment\n")
+	call fprintf (fd, "point [mask] P1 rop%48t# draw a point\n")
+	call fprintf (fd, "polygon [mask] P1 ... PN rop%48t# draw a polygon\n")
+	call fprintf (fd, "rop src [vs] dst [vs] [vn] rop%48t# rasterop\n")
+	call fprintf (fd,
+	"stencil src [vs] dst [vs] stn [vs] [vn] rop%48t# stencil\n \n")
+	call fprintf (fd, "compare mask1 mask2%48t# compare two masks\n")
+	call fprintf (fd, "rtest mask1 mask2%48t# range list conversion test\n")
+	call fprintf (fd,
+	"ptest mask1 mask2%48t# pixel array conversion test\n")
+	call fprintf (fd, "secne [mask] [vs ve]%48t# test section not empty\n")
+	call fprintf (fd, "rio [mask] [vs]%48t# test mask using random i/o\n")
+end
+
+
+# SCRIPT -- Make a PLIO drawing script suitable to input to PLTEST above.
+
+procedure t_script()
+
+int	ncmds, seed, i
+int	xo, yo, xs, ys, x, y, r
+int	clgeti()
+real	urand()
+
+begin
+	ncmds = clgeti ("ncmds")
+
+	xo = 50;  xs = 1024 - 100
+	yo = 50;  ys = 1024 - 100
+
+	seed = 5
+
+	do i = 1, ncmds {
+	    x = urand(seed) * xs + xo
+	    y = urand(seed) * ys + yo
+	    r = urand(seed) * 40
+
+	    call printf ("circle %d %d %d %d\n")
+		call pargi (x)
+		call pargi (y)
+		call pargi (r)
+		call pargi (PIX_SET + PIX_VALUE(mod(i,256)))
+
+	    call printf ("box %d %d %d %d %d\n")
+		call pargi (x - r)
+		call pargi (y - r)
+		call pargi (x + r)
+		call pargi (y + r)
+		call pargi (or(PIX_SRC,PIX_DST) + PIX_VALUE(mod(i*2,256)))
+
+	    call printf ("point %d %d %d\n")
+		call pargi (x)
+		call pargi (y)
+		call pargi (PIX_CLR + PIX_VALUE(mod(i*4,256)))
+	}
+end
diff --git a/sys/plio/zzlib.x b/sys/plio/zzlib.x
new file mode 100644
index 00000000..fe21d849
--- /dev/null
+++ b/sys/plio/zzlib.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plio.h>
+
+# PL_CHKFREE -- Verify that the count of free space in the linelist is
+# correct. (DEBUG TOOL).
+
+procedure pl_chkfree (pl, msg)
+
+pointer	pl			#I mask descriptor
+char	msg[ARB]		#I message to be printed if error occurs
+
+pointer	o_lp
+short	nref[8192], nl
+int	used, free, nused, nfree, b_len, i
+
+begin
+	used = 0;  nused = 0
+	free = 0;  nfree = 0
+
+	# Count the space in the active line lists.
+	nl = 0
+	for (i=0;  i < PL_LLOP(pl);  i=i+b_len) {
+	    o_lp = Ref (pl, i)
+	    b_len = LP_BLEN(o_lp)
+
+	    nl = nl + 1
+	    nref[nl] = LP_NREF(o_lp)
+
+	    if (LP_NREF(o_lp) < 0) {
+		call eprintf ("lineoff %d, nref = %d\n")
+		    call pargi (i)
+		    call pargi (LP_NREF(o_lp))
+		free = free + b_len
+		nfree = nfree + 1
+	    } else if (i == PL_EMPTYLINE || LP_NREF(o_lp) > 0) {
+		used = used + b_len
+		nused = nused + 1
+	    } else {
+		free = free + b_len
+		nfree = nfree + 1
+	    }
+	}
+
+	if (free != PL_LLFREE(pl)) {
+	    call eprintf ("CHKFREE (%s): used=%d,%d, free=%d,%d, ")
+		call pargstr (msg)
+		call pargi (used)
+		call pargi (nused)
+		call pargi (free)
+		call pargi (nfree)
+	    call eprintf ("PL_LLFREE=%d, OP-FREE=%d\n")
+		call pargi (PL_LLFREE(pl))
+		call pargi (PL_LLOP(pl) - PL_LLFREE(pl))
+
+	    do i = 1, nl {
+		call eprintf ("%4d")
+		    call pargs (nref[i])
+		if (mod (i,19) == 0)
+		    call eprintf ("\n")
+	    }
+	    call eprintf ("\n")
+	}
+end
diff --git a/sys/plio/zzsum.x b/sys/plio/zzsum.x
new file mode 100644
index 00000000..2e6097f9
--- /dev/null
+++ b/sys/plio/zzsum.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+
+task    sum = t_sum
+
+# SUM -- Sum the image pixels lying within the given mask.
+
+procedure t_sum()
+
+char    image[SZ_FNAME]              # input data image
+char    mask[SZ_FNAME]               # image mask
+
+int     npix, mval, totpix, m_flags
+long    v[PM_MAXDIM]
+pointer im, mp, pp
+real    sum
+
+bool	clgetb()
+real    asumr()
+int     mio_glsegr()
+pointer immap(), mio_open()
+
+begin
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("mask", mask, SZ_FNAME)
+	m_flags = 0
+	if (clgetb ("invert"))
+	    m_flags = INVERT_MASK
+
+	im = immap (image, READ_ONLY, 0)
+	mp = mio_open (mask, m_flags, im)
+
+	sum = 0;  totpix = 0
+	while (mio_glsegr (mp, pp, mval, v, npix) != EOF) {
+	    sum = sum + asumr (Memr[pp], npix)
+	    totpix = totpix + npix
+	}
+
+	call mio_close (mp)
+	call imunmap (im)
+
+	call printf ("%d pixels, sum=%g, mean=%g\n")
+	    call pargi (totpix)
+	    call pargr (sum)
+	    if (totpix > 0)
+		call pargr (sum / totpix)
+	    else
+		call pargr (INDEF)
+end
diff --git a/sys/pmio/README b/sys/pmio/README
new file mode 100644
index 00000000..303c464b
--- /dev/null
+++ b/sys/pmio/README
@@ -0,0 +1,284 @@
+PMIO -- The Pixel Mask I/O package (PLIO for image masks).
+PLIO -- The Pixel List I/O package (no ties to IMIO)
+
+    A PIXEL LIST is a compressed, region oriented data structure used to store
+an image matrix.  The pixel list package is used to create, manage, and access
+this data structure.  Although the PLIO package can stand alone and is useful
+in its own right, one of the main uses of the pixel list package is in the IMIO
+interface, which can access a pixel list as if it were a MASK IMAGE.
+See PLIO.hlp for further information on the PLIO package and image masks.
+
+The pixel list package itself does not support any fancy image coordinate
+transformations.  If an image has an associated pixel mask, the pixel mask
+refers to the physical image matrix.  An application written at the IMIO level
+where an image section transformation may be defined for an image should
+normally use the PMIO (pixel mask) package in preference to PLIO.  PMIO is
+equivalent to PLIO, except that coordinates are input in image section
+coordinates, and a reference image is used to map such coordinates onto the
+physical image matrix.
+
+
+1. IMIO Mask Image Interface
+
+		  im = im_pmmap (maskname, mode, ref_im|NULL)
+		 im = im_pmmapo (pm, ref_im)
+
+		         imseti (im, IM_RLIO, YES|NO)	# enable range list i/o
+		         imseti (im, IM_PMDES, pm)	# inquire PM descriptor
+		   pm = imstati (im, IM_PMDES)
+
+	   bool = im_pmlne[123] (im[, lineno[, bandno]])
+	   bool = im_pmsne[123] (im, x1, x2[, y1, y2[, z1, z2]])
+	       bool = im_pmlnev (im, v)
+	       bool = im_pmsnev (im, vs, ve, ndim)
+
+		  mp = mio_open (maskname, flags, im)	# Masked Image I/O
+		 mp = mio_openo (pm, im)
+	      value = mio_stati (mp, param)
+		       mio_seti (mp, param, value)
+		   mio_setrange (mp, vs, ve, ndim)
+   n|EOF = mio_[gp]lseg[silrdx] (mp, ptr, mval, v, npix)
+		      mio_close (mp)
+
+
+2. Pixel Mask Interface (uses reference image for section transformation)
+
+		pm = pm_newmask (ref_im, depth)
+
+		   pm = pm_open (bufptr|NULL)
+		 pm = pm_create (naxes, axlen, depth)
+		pm = pm_newcopy (pm)
+		       pm_close (pm)
+
+		    pm_[sg]size (pm, naxes, alxen, depth)
+		        pm_seti (pm, param, value)
+	       value = pm_stati (pm, param)
+		       pm_debug (pm, outfd, maxcol, flags)
+		bool = pm_empty (pm)
+		    pm_compress (pm)
+		       pm_clear (pm)
+
+			pm_load (pm, bufptr)
+	       nwords = pm_save (pm, bufptr, buflen, save_flags)
+		       pm_loadf (pm, fname, title, maxch)
+		       pm_savef (pm, fname, title, save_flags)
+	       pm_[load|save]im (pm, imname[, save_flags])
+
+		ptr = pm_access (pm, v)
+         bool = pm_linenotempty (pm, v)
+         bool = pm_sectnotempty (pm, vs, ve, ndim)
+	      pm[gp]l[lrp][sil] (pm, v, buf, b_depth, npix, rop)
+
+	      pm_[set|get]plane (pm, v)
+		       pm_point (pm, x, y, rop)
+		      pm_circle (pm, x, y, r, rop)
+			 pm_box (pm, x1,y1, x2,y2, rop)
+			pm_line (pm, x1,y1, x2,y2, width, rop)
+		     pm_polygon (pm, x, y, npts, rop)
+
+			 pm_rop (pm_src, vs, pm_dst, vs, vn, rop)
+		     pm_stencil (pm_src, vs, pm_dst, vs, pm_stl, vs, vn, rop)
+
+
+2.1 Random Access to a Pixel Mask
+
+		 pmr = pmr_open (pm, plane, buflimit)
+		    pmr_setrect (pmr, x1,y1, x2,y2)
+	      mval = pmr_getpix (pmr, i, j)
+		      pmr_close (pmr)
+
+
+3. Pixel List Interface (stands alone; independent of IMIO; no coord xforms)
+
+		   pl = pl_open (bufptr|NULL)
+		 pl = pl_create (naxes, axlen, depth)
+		pl = pl_newcopy (pl)
+		       pl_close (pl)
+
+		    pl_[sg]size (pl, naxes, axlen, depth)
+		        pl_seti (pl, param, value)
+	       value = pl_stati (pl, param)
+		       pl_debug (pl, outfd, maxcol, flags)
+		bool = pl_empty (pl)
+		    pl_compress (pl)
+		       pl_clear (pl)
+
+			pl_load (pl, bufptr)
+	       nwords = pl_save (pl, bufptr, buflen, save_flags)
+		       pl_loadf (pl, fname, title, maxch)
+		       pl_savef (pl, fname, title, save_flags)
+	       pl_[load|save]im (pl, imname[, save_flags])
+
+		ptr = pl_access (pl, v)
+         bool = pl_linenotempty (pl, v)
+         bool = pl_sectnotempty (pl, vs, ve, ndim)
+	      pl[gp]l[lrp][sil] (pl, v, buf, b_depth, npix, rop)
+
+	      pl_[set|get]plane (pl, v)
+		       pl_point (pl, x, y, rop)
+		      pl_circle (pl, x, y, r, rop)
+			 pl_box (pl, x1,y1, x2,y2, rop)
+			pl_line (pl, x1,y1, x2,y2, width, rop)
+		     pl_polygon (pl, x, y, npts, rop)
+
+			 pl_rop (pl_src, vs, pl_dst, vs, vn, rop)
+		     pl_stencil (pl_src, vs, pl_dst, vs, pl_stl, vs, vn, rop)
+
+
+3.1 Random Access to a Pixel List
+
+		 plr = plr_open (pl, plane, buflimit)
+		    plr_setrect (plr, x1,y1, x2,y2)
+	      mval = plr_getpix (plr, i, j)
+		     plr_getlut (plr, bufp, xsize,ysize, xblock,yblock)
+		      plr_close (plr)
+
+
+3.2 Pixel, Line, and Range List Routines
+
+		      pl_pixrop (px_src, xs, src_maxval,
+				 px_dst, ds, dst_maxval, npix, rop)
+		     pl_linerop (ll_src, xs, src_maxval,
+				 ll_dst, ds, dst_maxval, ll_out, npix, rop)
+		    pl_rangerop (rl_src, xs, src_maxval,
+				 rl_dst, ds, dst_maxval, rl_out, npix, rop)
+		 pl_linestencil (ll_src, xs, src_maxval, ll_dst, ds, dst_maxval,
+				 ll_stn, xs, ll_out, npix, rop)
+
+	n = pl_[lrp]2[lrp][sil] (op_src, xs, op_dst, npix)
+
+
+4. EXAMPLE
+
+4.1 Sample Mask (pl_draw output)
+
+ 40 .1111111..............................................................22222
+ 39 .1111111..............................................................22222
+ 38 .1111111...............................................................2222
+ 37 .1111111...............................................................2222
+ 36 .1111111............................................................4......
+ 35 .1111111.....................11111111111111111111111111...........4444.....
+ 34 .1111111.....................11111111111111111111111111........44444444....
+ 33 .1111111......................1111111111111111111111111......44444444......
+ 32 .1111111......................1111111111111111111111111...44444444.........
+ 31 .1111111......................1111111111111111111111111.44444444...........
+ 30 .1111111...........4..........1111111111111111111111115444444..............
+ 29 .1111111...........4..........11111111111111111111155554444................
+ 28 .1111111...........4..........111111111111111111155555544..................
+ 27 .1111111...........4..........1111111111111111555555551....................
+ 26 .1111111.....................11111111111111155555555111....................
+ 25 .1111111.....................11111111111115555555111111....................
+ 24 ............................1111111111155444444.1111111....................
+ 23 ...........................111111111155544444....111111....................
+ 22 ..............1...........1111111155555444........11111....................
+ 21 ........................1111111155555554..........11111....................
+ 20 ........................111111555555511...........11111....................
+ 19 ........................111555555551111...........11111....................
+ 18 ........................155555555111111...........11111....................
+ 17 ......................445555551111111111.........111111....................
+ 16 ....................444455551111111111111.......1111111....................
+ 15 ..................4444445111111111111111111111111111111....................
+ 14 ...............44444444.1111111111111111111111111111111....................
+ 13 .............44444444......................................................
+ 12 ..........44444444.........................................................
+ 11 ........44444444...........................................................
+ 10 .........4444........................22222.................................
+  9 ..........4.........................2222222..............22222.............
+  8 ....................................2222222.............2222222............
+  7 ....................................2222222.............2222222............
+  6 .....................................22222..............2222222............
+  5 11111111111111111111.....................................22222.............
+  4 11111111111111111111.......................................................
+  3 11111111111111111111.......................................................
+  2 11111111111111111111.......................................................
+  1 11111111111111111111.......................................................
+    123456789012345678901234567890123456789012345678901234567890123456789012345
+             1         2         3         4         5         6         7     
+
+
+4.2 Sample Debug Output (for above mask)
+
+Mask 1EECD naxes=2 [75,40] maxval=177 plane=[75,40]
+max buffered line size 1024, max actual line size 16
+40 lines total, 40 are nonempty, mask is nonempty
+llbp=42AF5, len=1190, op=583, free=189, nupdates=35
+Index at 1EFF1 containing 40 lines:
+     4      4      4      4     17     26     35     35    166    177    187
+   194    201    208    218    228    241    254    266    554    292    568
+   319    333    347    360    492    507    523    539    423    435    447
+   459    471    483    148    148    157    157
+Line list containing 40 lines:
+[1:4]      IH48(49) H20 Z55 (75,49)
+[5]        IH48(49) H20 IH1(50) Z37 H5 Z13 (75,50)
+[6]        IH49(50) Z37 H5 Z14 H7 Z12 (75,50)
+[7:8]      IH49(50) Z36 H7 Z13 H7 Z12 (75,50)
+[9]        IH51(52) P11 DH2(50) Z25 H7 Z14 H5 Z13 (75,50)
+[10]       IH51(52) Z9 H4 DH2(50) Z24 H5 Z33 (75,50)
+[11]       IH51(52) Z8 H8 Z59 (75,52)
+[12]       IH51(52) Z10 H8 Z57 (75,52)
+[13]       IH51(52) Z13 H8 Z54 (75,52)
+[14]       IH51(52) Z15 H8 DH3(49) Z1 H31 Z20 (75,49)
+[15]       IH51(52) Z18 H6 IS1(53) DH4(49) H30 Z20 (75,49)
+[16]       IH51(52) Z20 H4 IH1(53) H4 DH4(49) H13 Z7 H7 Z20 (75,49)
+[17]       IH51(52) Z22 H2 IH1(53) H6 DH4(49) H10 Z9 H6 Z20 (75,49)
+[18]       IH48(49) P25 IH4(53) H8 DH4(49) H6 Z11 H5 Z20 (75,49)
+[19]       IH48(49) Z24 H3 IH4(53) H8 DH4(49) H4 Z11 H5 Z20 (75,49)
+[20]       IH48(49) Z24 H6 IH4(53) H7 DH4(49) H2 Z11 H5 Z20 (75,49)
+[21]       IH48(49) Z24 H8 IH4(53) H7 DS1(52) DH3(49) Z10 H5 Z20 (75,49)
+[22]       IH48(49) P15 Z11 H8 IH4(53) H5 DH1(52) H3 DH3(49) Z8 H5 Z20 (75,49)
+[23]       IH48(49) Z27 H10 IH4(53) H3 DH1(52) H5 DH3(49) Z4 H6 Z20 (75,49)
+[24]       IH48(49) Z28 H11 IH4(53) H2 DH1(52) H6 DH3(49) Z1 H7 Z20 (75,49)
+[25]       IH48(49) Z1 H7 Z21 H13 IH4(53) H7 DH4(49) H6 Z20 (75,49)
+[26]       IH48(49) Z1 H7 Z21 H15 IH4(53) H8 DH4(49) H3 Z20 (75,49)
+[27]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H16 IH4(53) H8 DS4(49) Z20
+           (75,49)
+[28]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H19 IH4(53) H6 DH1(52) H2 Z18
+           (75,52)
+[29]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H21 IH4(53) H4 DH1(52) H4 Z16
+           (75,52)
+[30]       IH48(49) Z1 H7 IH3(52) P12 DH3(49) Z10 H24 IS4(53) DH1(52) H6 Z14
+           (75,52)
+[31]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z1 H8 Z11 (75,52)
+[32]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z3 H8 Z9 (75,52)
+[33]       IH48(49) Z1 H7 Z22 H25 IH3(52) Z6 H8 Z6 (75,52)
+[34]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z8 H8 Z4 (75,52)
+[35]       IH48(49) Z1 H7 Z21 H26 IH3(52) Z11 H4 Z5 (75,52)
+[36]       IH48(49) Z1 H7 IH3(52) P61 Z6 (75,52)
+[37:38]    IH48(49) Z1 H7 IH1(50) Z63 H4 (75,50)
+[39:40]    IH48(49) Z1 H7 IH1(50) Z62 H5 (75,50)
+
+Line list containing 40 lines:
+[1:4]      1-20(49)
+[5]        1-20(49) 58-62(50)
+[6]        38-42(50) 57-63(50)
+[7:8]      37-43(50) 57-63(50)
+[9]        11(52) 37-43(50) 58-62(50)
+[10]       10-13(52) 38-42(50)
+[11]       9-16(52)
+[12]       11-18(52)
+[13]       14-21(52)
+[14]       16-23(52) 25-55(49)
+[15]       19-24(52) 25(53) 26-55(49)
+[16]       21-24(52) 25-28(53) 29-41(49) 49-55(49)
+[17]       23-24(52) 25-30(53) 31-40(49) 50-55(49)
+[18]       25(49) 26-33(53) 34-39(49) 51-55(49)
+[19]       25-27(49) 28-35(53) 36-39(49) 51-55(49)
+[20]       25-30(49) 31-37(53) 38-39(49) 51-55(49)
+[21]       25-32(49) 33-39(53) 40(52) 51-55(49)
+[22]       15(49) 27-34(49) 35-39(53) 40-42(52) 51-55(49)
+[23]       28-37(49) 38-40(53) 41-45(52) 50-55(49)
+[24]       29-39(49) 40-41(53) 42-47(52) 49-55(49)
+[25]       2-8(49) 30-42(49) 43-49(53) 50-55(49)
+[26]       2-8(49) 30-44(49) 45-52(53) 53-55(49)
+[27]       2-8(49) 20(52) 31-46(49) 47-54(53) 55(49)
+[28]       2-8(49) 20(52) 31-49(49) 50-55(53) 56-57(52)
+[29]       2-8(49) 20(52) 31-51(49) 52-55(53) 56-59(52)
+[30]       2-8(49) 20(52) 31-54(49) 55(53) 56-61(52)
+[31]       2-8(49) 31-55(49) 57-64(52)
+[32]       2-8(49) 31-55(49) 59-66(52)
+[33]       2-8(49) 31-55(49) 62-69(52)
+[34]       2-8(49) 30-55(49) 64-71(52)
+[35]       2-8(49) 30-55(49) 67-70(52)
+[36]       2-8(49) 69(52)
+[37:38]    2-8(49) 72-75(50)
+[39:40]    2-8(49) 71-75(50)
diff --git a/sys/pmio/mio.h b/sys/pmio/mio.h
new file mode 100644
index 00000000..11e4c9d0
--- /dev/null
+++ b/sys/pmio/mio.h
@@ -0,0 +1,56 @@
+# MIO -- Image i/o through a mask.
+# 
+#     The MIO routines are used to sequentially read or write the portion of
+# the image IM which is "visible" through the mask denoted by the mask name
+# PLNAME or the open mask descriptor PM.  An image pixel is said to be visible
+# if the associated mask pixel is nonzero.  The PMIO routines may be used prior
+# to performing any i/o to prepare the desired mask, e.g., a mask might be
+# inverted to access only the "masked" pixels, or a mask might be ANDed with a
+# region to limit i/o to only the portions of the image visible through both
+# the mask and the region.  Certain commonly performed mask conversions may be
+# performed at MIO_OPEN time via the FLAGS argument, e.g., inversion, or
+# conversion of an integer mask to a boolean mask.
+# 
+# 		  mp = mio_open (mask, flags, im)
+# 		 mp = mio_openo (pm, im)
+# 	      value = mio_stati (mp, param)
+# 		       mio_seti (mp, param, value)
+# 		   mio_setrange (mp, vs, ve, ndim)
+#  n|EOF = mio_[gp]lseg[silrdx] (mp, ptr, mval, v, npix)
+# 		      mio_close (mp)
+# 
+# mio_open flags (defined in <pmset.h>):
+# 
+# 	INVERT_MASK		invert mask (PIX_NOT(PIX_SRC))
+# 	BOOLEAN_MASK		convert mask to boolean if not already
+# 
+# set/stat params (defined in <pmset.h>):
+# 	
+# 	P_PMDES			pixel mask descriptor
+# 	P_IMDES			image descriptor
+#	P_REGCOORDS		mio_setrange region relative coords
+# 
+# The get/put line segment i/o routines return successive line segments of
+# constant value from the data image IM, advancing through the image in storage
+# order starting at the position vector [1,1,1...,N].  A pointer to each line
+# segment is returned in PTR, with the associated integer mask value in MVAL,
+# and the vector coordinates and length of the line segment in V and NPIX.
+# EOF is returned when there are no more visible pixels to be read through the
+# masked region.
+
+define	LEN_MIODES	50
+define	M_IM		Memi[$1]		# image descriptor
+define	M_PM		Memi[$1+1]		# mask descriptor
+define	M_PMCLOSE	Memi[$1+2]		# have mio_close close mask
+define	M_DEPTH		Memi[$1+3]		# have mio_close close mask
+define	M_ACTIVE	Memi[$1+4]		# set once i/o begins
+define	M_LBP		Memi[$1+5]		# line buffer pointer
+define	M_RLP		Memi[$1+6]		# range list pointer
+define	M_RLI		Memi[$1+7]		# range list index
+define	M_NDIM		Memi[$1+8]		# dimensionality of section
+define	M_LINEIO	Memi[$1+9]		# section is entire line
+define	M_REGCOORDS	Memi[$1+10]		# region relative coords
+define	M_V		Meml[$1+11+$2-1]	# current vector
+define	M_VS		Meml[$1+20+$2-1]	# start vector
+define	M_VE		Meml[$1+30+$2-1]	# end vector
+define	M_VN		Meml[$1+40+$2-1]	# size of section
diff --git a/sys/pmio/mioclose.x b/sys/pmio/mioclose.x
new file mode 100644
index 00000000..7b321512
--- /dev/null
+++ b/sys/pmio/mioclose.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	"mio.h"
+
+# MIO_CLOSE -- Close an MIO descriptor.
+
+procedure mio_close (mp)
+
+pointer	mp			#I MIO descriptor
+
+begin
+	if (M_PMCLOSE(mp) == YES)
+	    call pm_close (M_PM(mp))
+	if (M_RLP(mp) != NULL)
+	    call mfree (M_RLP(mp), TY_INT)
+	call mfree (mp, TY_STRUCT)
+end
diff --git a/sys/pmio/miogl.gx b/sys/pmio/miogl.gx
new file mode 100644
index 00000000..3b02710e
--- /dev/null
+++ b/sys/pmio/miogl.gx
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glseg$t (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2$t(), imgl3$t(), imggs$t()
+errchk	imgl2$t, imgl3$t, imggs$t, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2$t (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3$t (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggs$t (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/mioopen.x b/sys/pmio/mioopen.x
new file mode 100644
index 00000000..b22c2022
--- /dev/null
+++ b/sys/pmio/mioopen.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	"mio.h"
+
+# MIO_OPEN -- Open a pixel mask for masked i/o on the given data image.
+# The data image also serves as the reference image for coordinate (section)
+# transformations.
+
+pointer procedure mio_open (mask, flags, im)
+
+char	mask[ARB]		#I mask name
+int	flags			#I flag bits
+pointer	im			#I data (and reference) image
+
+pointer	pm, mp
+char	title[1]
+pointer	im_pmopen(), mio_openo()
+errchk	im_pmopen
+
+begin
+	pm = im_pmopen (mask, flags, title, 0, im)
+	mp = mio_openo (pm, im)
+
+	M_PMCLOSE(mp) = YES
+	M_DEPTH(mp) = PM_MAXDEPTH
+	if (and (flags, BOOLEAN_MASK) != 0)
+	    M_DEPTH(mp) = 1
+
+	return (mp)
+end
diff --git a/sys/pmio/mioopeno.x b/sys/pmio/mioopeno.x
new file mode 100644
index 00000000..bd3a6a96
--- /dev/null
+++ b/sys/pmio/mioopeno.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	"mio.h"
+
+# MIO_OPENO -- Open an MIO descriptor for the given mask and data image.
+
+pointer procedure mio_openo (pm, im)
+
+pointer	pm			#I mask descriptor
+pointer	im			#I image descriptor
+
+pointer	mp
+
+begin
+	call calloc (mp, LEN_MIODES, TY_STRUCT)
+	call malloc (M_RLP(mp), RL_MAXLEN(pm), TY_INT)
+	RLI_LEN(M_RLP(mp)) = 0
+
+	call amovkl (1, M_VS(mp,1), IM_MAXDIM)
+	call amovl (IM_LEN(im,1), M_VN(mp,1), IM_MAXDIM)
+
+	M_IM(mp) = im
+	M_PM(mp) = pm
+	call pm_seti (pm, P_REFIM, im)
+	call mio_setrange (mp, M_VS(mp,1), M_VN(mp,1), IM_NDIM(im))
+
+	return (mp)
+end
diff --git a/sys/pmio/miopl.gx b/sys/pmio/miopl.gx
new file mode 100644
index 00000000..be7b7b95
--- /dev/null
+++ b/sys/pmio/miopl.gx
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plseg$t (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2$t(), impl3$t(), impgs$t()
+errchk	impl2$t, impl3$t, impgs$t, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2$t (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3$t (im, v[2], v[3])
+	    else
+		bp = impgs$t (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/mioseti.x b/sys/pmio/mioseti.x
new file mode 100644
index 00000000..ef4fe116
--- /dev/null
+++ b/sys/pmio/mioseti.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	"mio.h"
+
+# MIO_SETI -- Set an MIO parameter.
+
+procedure mio_seti (mp, param, value)
+
+pointer	mp			#I MIO descriptor
+int	param			#I parameter to be set
+int	value			#I new value
+
+begin
+	switch (param) {
+	case P_PMDES:
+	    M_PM(mp) = value
+	    M_ACTIVE(mp) = NO
+	case P_IMDES:
+	    M_IM(mp) = value
+	    M_ACTIVE(mp) = NO
+	case P_REGCOORDS:
+	    M_REGCOORDS(mp) = value
+	case P_PMCLOSE:
+	    M_PMCLOSE(mp) = value
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/pmio/miosrange.x b/sys/pmio/miosrange.x
new file mode 100644
index 00000000..26b42727
--- /dev/null
+++ b/sys/pmio/miosrange.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"mio.h"
+
+# MIO_SETRANGE -- Set the region of the image to be accessed, and rewind the
+# i/o pointer to the beginning of the specified region.
+
+procedure mio_setrange (mp, vs, ve, ndim)
+
+pointer	mp			#I MIO descriptor
+long	vs[IM_MAXDIM]		#I vector coords of start of region
+long	ve[IM_MAXDIM]		#I vector coords of end of region
+int	ndim			#I dimensionality of region
+
+int	i
+int	btoi()
+
+begin
+	do i = 1, IM_MAXDIM
+	    if (i <= ndim) {
+		M_VS(mp,i) = min (vs[i], ve[i])
+		M_VN(mp,i) = abs (ve[i] - vs[i]) + 1
+	    } else {
+		M_VS(mp,i) = 1
+		M_VN(mp,i) = 1
+	    }
+
+	M_LINEIO(mp) = btoi (vs[1] == 1 && ve[1] == IM_LEN(M_IM(mp),1))
+	M_REGCOORDS(mp) = YES
+	M_ACTIVE(mp) = NO
+	M_NDIM(mp) = ndim
+end
diff --git a/sys/pmio/miostati.x b/sys/pmio/miostati.x
new file mode 100644
index 00000000..3f492daa
--- /dev/null
+++ b/sys/pmio/miostati.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	"mio.h"
+
+# MIO_STATI -- Stat an MIO parameter.
+
+int procedure mio_stati (mp, param)
+
+pointer	mp			#I MIO descriptor
+int	param			#I parameter to be set
+
+begin
+	switch (param) {
+	case P_PMDES:
+	    return (M_PM(mp))
+	case P_IMDES:
+	    return (M_IM(mp))
+	case P_REGCOORDS:
+	    return (M_REGCOORDS(mp))
+	case P_PMCLOSE:
+	    return (M_PMCLOSE(mp))
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/pmio/mkpkg b/sys/pmio/mkpkg
new file mode 100644
index 00000000..0c03f90d
--- /dev/null
+++ b/sys/pmio/mkpkg
@@ -0,0 +1,68 @@
+# Make the PM package library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+tfiles:
+	$set PFLAGS = "-k -t silrdx -p tf/"
+	$set GFLAGS = "-k -t sil -p tf/"
+	$ifolder (tf/miogli.x,  miogl.gx)  $generic $(PFLAGS) miogl.gx  $endif
+	$ifolder (tf/miopli.x,  miopl.gx)  $generic $(PFLAGS) miopl.gx  $endif
+	$ifolder (tf/pmglpi.x,  pmglp.gx)  $generic $(GFLAGS) pmglp.gx  $endif
+	$ifolder (tf/pmglri.x,  pmglr.gx)  $generic $(GFLAGS) pmglr.gx  $endif
+	$ifolder (tf/pmplpi.x,  pmplp.gx)  $generic $(GFLAGS) pmplp.gx  $endif
+	$ifolder (tf/pmplri.x,  pmplr.gx)  $generic $(GFLAGS) pmplr.gx  $endif
+	;
+
+zzdebug:
+zzdebug.e:
+	$set	XFLAGS = "$(XFLAGS) -q"
+	$omake	zzinterp.x <error.h> <ctype.h> <fset.h> <pmset.h>
+	$omake	zzdebug.x <error.h> <imhdr.h> <ctype.h> <fset.h> <pmset.h>
+	$link	zzdebug.o zzinterp.o -o zzdebug.e
+	;
+
+libex.a:
+	# Retranslate any recently modified generic sources.
+	$ifeq (hostid, unix)
+	    $call tfiles
+	$endif
+
+	# Transfer <plset.h> dependency to <pmset.h>.
+	$ifnewer (<plset.h>, <pmset.h>)
+	    $copy <pmset.h> temp.pm
+	    $move temp.pm <pmset.h>
+	$endif
+
+	@tf		# Update datatype expanded files.
+
+	mioclose.x	mio.h <pmset.h>
+	mioopen.x	mio.h <pmset.h>
+	mioopeno.x	mio.h <imhdr.h> <pmset.h>
+	mioseti.x	mio.h <pmset.h>
+	miosrange.x	mio.h <imhdr.h>
+	miostati.x	mio.h <pmset.h>
+	pmaccess.x	pmio.com <plio.h> <pmset.h>
+	pmascii.x	pmio.com <plio.h> <pmset.h>
+	pmbox.x		pmio.com <plio.h> <pmset.h>
+	pmcircle.x	pmio.com <plio.h> <pmset.h>
+	pmclear.x	pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmempty.x	pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmglls.x	pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmline.x	pmio.com <plio.h> <pmset.h>
+	pmlinene.x	pmio.com <plio.h> <imhdr.h> <pmset.h>
+	pmnewmask.x	<imhdr.h> <imio.h> <plio.h> <pmset.h>
+	pmplls.x	pmio.com <plio.h> <pmset.h>
+	pmpoint.x	pmio.com <plio.h> <pmset.h>
+	pmpolygon.x	pmio.com <plio.h> <pmset.h>
+	pmrio.x		pmio.com <plio.h> <pmset.h>
+	pmrop.x		pmio.com <plio.h> <imhdr.h> <pmset.h>
+	pmsectnc.x	pmio.com <plio.h> <pmset.h>
+	pmsectne.x	pmio.com <plio.h> <pmset.h>
+	pmseti.x	<imio.h> <plio.h> <pmset.h>
+	pmstati.x	<imio.h> <plio.h> <pmset.h>
+	pmsplane.x	pmio.com <plio.h> <pmset.h>
+	pmsten.x	pmio.com <plio.h> <imhdr.h> <pmset.h>
+	;
diff --git a/sys/pmio/plprop.gx b/sys/pmio/plprop.gx
new file mode 100644
index 00000000..60d1c603
--- /dev/null
+++ b/sys/pmio/plprop.gx
@@ -0,0 +1,177 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<plset.h>
+include	<plio.h>
+
+# PL_PIXROP -- Rasterop between source and destination pixel arrays.
+
+procedure pl_pixrop$t (px_src,xs,src_maxval, px_dst,ds,dst_maxval, npix, rop)
+
+PIXEL	px_src[ARB]		#I source pixel array
+int	xs			#I starting pixel index in src
+int	src_maxval		#I max pixel value in src mask
+PIXEL	px_dst[ARB]		#O destination pixel array
+int	ds			#I starting pixel index in dst
+int	dst_maxval		#I max pixel value in dst mask
+int	npix			#I number of pixels to convert
+int	rop			#I rasterop
+
+pointer	sp, src
+int	opcode, i
+PIXEL	data, ceil, src_value
+int	and(), or(), xor(), not()
+define	out_ 91
+
+begin
+	opcode = R_OPCODE(rop)
+	data   = R_DATA(rop)
+	ceil   = 0
+
+	# Pixel value to be used if input mask is boolean.
+	if (src_maxval == 1) {
+	    src_value = data
+	    if (src_value <= 0)
+		src_value = dst_maxval
+	}
+
+	# Handle the easy cases first.
+	switch (opcode) {
+	case PIX_CLR:
+	    call aclr$t (px_dst[ds], npix)
+	    return
+	case PIX_SET:
+	    call amovk$t (data, px_dst[ds], npix)
+	    goto out_
+	case PIX_SRC:
+	    if (src_maxval != 1)
+		call amov$t (px_src[xs], px_dst[ds], npix)
+	    else {
+		do i = 1, npix
+		    if (px_src[xs+i-1] > 0)
+			px_dst[ds+i-1] = src_value
+		    else
+			px_dst[ds+i-1] = 0
+	    }
+
+	    goto out_
+	case PIX_DST:
+	    return	# no-op
+	}
+
+	# Integer or boolean source mask?
+	if (src_maxval != 1) {
+	    # Integer source mask; operate directly on source mask.
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_src[xs+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (px_src[xs+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (px_src[xs+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(px_src[xs+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(px_src[xs+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (px_src[xs+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (px_src[xs+i-1], px_dst[ds+i-1]))
+	    }
+
+	} else {
+	    # Boolean source mask; use integer DATA value from ROP if source
+	    # mask pixel is set.
+
+	    call smark (sp)
+	    call salloc (src, npix, TY_PIXEL)
+
+	    do i = 1, npix
+		if (px_src[xs+i-1] > 0)
+		    Mem$t[src+i-1] = src_value
+		else
+		    Mem$t[src+i-1] = 0
+
+	    switch (opcode) {
+	    case PIX_NOTSRC:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (Mem$t[src+i-1])
+	    case PIX_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (px_dst[xs+i-1])
+
+	    case PIX_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mem$t[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mem$t[src+i-1], px_dst[ds+i-1])
+	    case PIX_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = xor (Mem$t[src+i-1], px_dst[ds+i-1])
+
+	    case PIX_SRC_AND_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (Mem$t[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_SRC_OR_NOTDST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (Mem$t[src+i-1], not(px_dst[ds+i-1]))
+	    case PIX_NOTSRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = and (not(Mem$t[src+i-1]), px_dst[ds+i-1])
+	    case PIX_NOTSRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] =  or (not(Mem$t[src+i-1]), px_dst[ds+i-1])
+
+	    case PIX_NOT_SRC_AND_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (and (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_OR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not ( or (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    case PIX_NOT_SRC_XOR_DST:
+		do i = 1, npix
+		    px_dst[ds+i-1] = not (xor (Mem$t[src+i-1], px_dst[ds+i-1]))
+	    }
+
+	    call sfree (sp)
+	}
+out_
+	# If writing to an integer mask, mask the data to the indicated max
+	# value (necessary to avoid very large values if any NOT operations
+	# occurred).  If writing to a boolean mask, map positive integer mask
+	# values to 1.
+
+	if (dst_maxval == 1) {
+	    data = 1
+	    call argt$t (px_dst[ds], npix, ceil, data)
+	} else if (dst_maxval > 1) {
+	    data = dst_maxval
+	    call aandk$t (px_dst[ds], data, px_dst[ds], npix)
+	}
+end
diff --git a/sys/pmio/pmaccess.x b/sys/pmio/pmaccess.x
new file mode 100644
index 00000000..74f73e72
--- /dev/null
+++ b/sys/pmio/pmaccess.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include <plio.h>
+
+# PM_ACCESS -- Return a pointer (type short) to the indicated mask image
+# line.  A valid pointer is always returned; if the mask line is empty, the
+# pointer will reference the "empty line" linelist.
+
+pointer procedure pm_access (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[PM_MAXDIM]		#I coordinates of desired line
+
+pointer	pl_access()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call imaplv (PM_REFIM(pl), v, v1, PM_MAXDIM)
+	    return (pl_access (pl, v1))
+	} else
+	    return (pl_access (pl, v))
+end
diff --git a/sys/pmio/pmascii.x b/sys/pmio/pmascii.x
new file mode 100644
index 00000000..3e85d0af
--- /dev/null
+++ b/sys/pmio/pmascii.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_ASCIIDUMP -- Dump a two dimensional region of a mask as a printable ASCII
+# character array on the output stream.  Intended as a simple debugging tool;
+# see also PM_SAVEIM.
+
+procedure pm_asciidump (pl, vs, ve, outfd)
+
+pointer	pl			#I mask descriptor
+long	vs[ARB]			#I ll vector (only first two elements used)
+long	ve[ARB]			#I ur vector (only first two elements used)
+int	outfd			#I output file
+
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_asciidump (pl, vs, ve, outfd)
+	else {
+	    call imaplv (PM_REFIM(pl), vs, v1, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pl), ve, v2, PM_MAXDIM)
+	    call pl_asciidump (pl, v1, v2, outfd)
+	}
+end
diff --git a/sys/pmio/pmbox.x b/sys/pmio/pmbox.x
new file mode 100644
index 00000000..d54eb8fa
--- /dev/null
+++ b/sys/pmio/pmbox.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_BOX -- Rasterop between a box as source, and an existing mask as dest.
+# This is a 2-dim operator.  The pm_setplane procedure is used to specify
+# the plane to be modified.
+
+procedure pm_box (pl, x1,y1, x2,y2, rop)
+
+pointer	pl			#I mask descriptor
+int	x1,y1			#I lower left corner of box
+int	x2,y2			#I upper right corner of box
+int	rop			#I rasterop
+
+errchk	pl_getplane
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call pl_getplane (pl, v1)
+	    v1[1] = x1;  v1[2] = y1
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call pl_getplane (pl, v3)
+	    v3[1] = x2;  v3[2] = y2
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    call pl_box (pl, v2[1],v2[2], v4[1],v4[2], rop)
+
+	} else
+	    call pl_box (pl, x1,y1, x2,y2, rop)
+end
diff --git a/sys/pmio/pmcircle.x b/sys/pmio/pmcircle.x
new file mode 100644
index 00000000..086da99a
--- /dev/null
+++ b/sys/pmio/pmcircle.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_CIRCLE -- Rasterop between a circular region as source, and an existing
+# mask as destination.  It is not necessary for the center of the circle to
+# be inside the mask; if it is outside, the boundary of the circle will be
+# clipped to the boundary of the mask.  This is a 2-dim operator.  If the
+# image dimensionality is greater than two the pm_setplane procedure should
+# be called first to specify the plane to be modified.
+
+procedure pm_circle (pl, x, y, radius, rop)
+
+pointer	pl			#I mask descriptor
+int	x,y			#I center coords of circle
+int	radius			#I radius of circle
+int	rop			#I rasterop
+
+errchk	pl_getplane
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call pl_getplane (pl, v1)
+	    v1[1] = x;  v1[2] = y
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call pl_getplane (pl, v3)
+	    v3[1] = x + radius;  v3[2] = y
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    call pl_circle (pl, v2[1], v2[2], abs(v4[1]-v2[1]), rop)
+
+	} else
+	    call pl_circle (pl, x, y, radius, rop)
+end
diff --git a/sys/pmio/pmclear.x b/sys/pmio/pmclear.x
new file mode 100644
index 00000000..1aed4013
--- /dev/null
+++ b/sys/pmio/pmclear.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_CLEAR -- Clear a mask.  The entire surface is cleared.  This is equivalent
+# to a full surface pm_rop with rop=PIX_CLR, but is more convenient and can be
+# implemented more efficiently since the entire surface is cleared.
+
+procedure pm_clear (pl)
+
+pointer	pl			#I mask descriptor
+
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call amovkl (1, v1, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+	    call amovl (IM_LEN(PM_REFIM(pl),1), v3, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    call pl_rop (NULL, NULL, pl, v2, v4, PIX_CLR)
+
+	} else
+	    call pl_clear (pl)
+end
diff --git a/sys/pmio/pmempty.x b/sys/pmio/pmempty.x
new file mode 100644
index 00000000..c8797663
--- /dev/null
+++ b/sys/pmio/pmempty.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_EMPTY -- Test whether a mask is empty, i.e., contains no nonzero pixels.
+
+bool procedure pm_empty (pl)
+
+pointer	pl			#I mask descriptor
+
+bool	pl_empty(), pl_sectnotempty()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call amovkl (1, v1, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+	    call amovl (IM_LEN(PM_REFIM(pl),1), v3, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    return (!pl_sectnotempty (pl, v2, v4, PM_MAXDIM))
+
+	} else
+	    return (pl_empty (pl))
+end
diff --git a/sys/pmio/pmglls.x b/sys/pmio/pmglls.x
new file mode 100644
index 00000000..6604c999
--- /dev/null
+++ b/sys/pmio/pmglls.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLLS -- Get a line segment as a list list, applying the given ROP to
+# combine the pixels with those of the output line list.
+
+procedure pm_glls (pl, v, ll_dst, ll_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	ll_dst[ARB]		#O output line list
+int	ll_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	ll_len, temp, np, step, xstep
+pointer	sp, px_src, ll_src, ll_out, im
+int	pl_p2li()
+include	"pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glls (pl, v, ll_dst, ll_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_INT)
+	call pl_glpi (pl, v1, Memi[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Memi[px_src], Memi[px_src], npix, SZ_INT, step)
+	if (xstep < 0)
+	    call imaflp (Memi[px_src], npix, SZ_INT)
+
+	# Convert to a line list.
+	ll_len = pl_p2li (Memi[px_src], 1, Mems[ll_src], npix)
+
+	# Copy to or combine with destination.
+	if (!R_NEED_DST(rop)) {
+	    ll_len = LP_LEN(ll_src)
+	    call amovs (Mems[ll_src], ll_dst, ll_len)
+	} else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    call pl_linerop (Mems[ll_src], 1, PL_MAXVAL(pl), ll_dst, 1,
+		MV(ll_depth), Mems[ll_out], npix, rop)
+	    ll_len = LP_LEN(ll_out)
+	    call amovs (Mems[ll_out], ll_dst, ll_len)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/pmglp.gx b/sys/pmio/pmglp.gx
new file mode 100644
index 00000000..26c6b2e0
--- /dev/null
+++ b/sys/pmio/pmglp.gx
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pm_glp$t (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	temp, np, step, xstep
+pointer	sp, px_src, px_out, im
+include	"../pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glp$t (pl, v, px_dst, px_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_PIXEL)
+	call pl_glp$t (pl, v1, Mem$t[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Mem$t[px_src], Mem$t[px_src], npix, SZ_PIXEL, step)
+	if (xstep < 0)
+	    call imaflp (Mem$t[px_src], npix, SZ_PIXEL)
+
+	if (!R_NEED_DST(rop))
+	    call amov$t (Mem$t[px_src], px_dst, npix)
+	else {
+	    call salloc (px_out, npix, TY_PIXEL)
+	    call pl_pixrop$t (Mem$t[px_src], 1, PL_MAXVAL(pl), px_dst, 1,
+		MV(px_depth), npix, rop)
+	    call amov$t (Mem$t[px_out], px_dst, npix)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/pmglr.gx b/sys/pmio/pmglr.gx
new file mode 100644
index 00000000..9c2e2606
--- /dev/null
+++ b/sys/pmio/pmglr.gx
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output line list.  Note that this
+# operator uses IMIO if a section transformation is needed, hence if the 
+# application also uses IMIO to directly access the mask image, care must
+# be taken to avoid confusion over the use of IMIO allocated pixel buffers.
+
+procedure pm_glr$t (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	rl_dst[3,ARB]		#O output line list
+int	rl_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	rl_len, temp, step, xstep, np
+pointer	sp, px_src, rl_src, rl_out, im
+include	"../pmio.com"
+int	pl_p2r$t()
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glr$t (pl, v, rl_dst, rl_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (rl_src, RL_MAXLEN(pl), TY_PIXEL)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_PIXEL)
+	call pl_glp$t (pl, v1, Mem$t[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Mem$t[px_src], Mem$t[px_src], npix, SZ_PIXEL, step)
+	if (xstep < 0)
+	    call imaflp (Mem$t[px_src], npix, SZ_PIXEL)
+
+	# Convert to a range list.
+	rl_len = pl_p2r$t (Mem$t[px_src], 1, Mem$t[rl_src], npix)
+
+	# Copy to or combine with destination.
+	if (!R_NEED_DST(rop)) {
+	    rl_len = RLI_LEN(rl_src) * RL_LENELEM
+	    call amov$t (Mem$t[rl_src], rl_dst, rl_len)
+	} else {
+	    call salloc (rl_out, RL_MAXLEN(pl), TY_PIXEL)
+	    call pl_rangerop$t (Mem$t[rl_src], 1, PL_MAXVAL(pl), rl_dst, 1,
+		MV(rl_depth), Mem$t[rl_out], npix, rop)
+	    $if (datatype == s)
+		rl_len = RLS_LEN(rl_out) * RL_LENELEM
+	    $else
+		rl_len = RLI_LEN(rl_out) * RL_LENELEM
+	    $endif
+	    call amov$t (Mem$t[rl_out], rl_dst, rl_len)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/pmio.com b/sys/pmio/pmio.com
new file mode 100644
index 00000000..76616e6a
--- /dev/null
+++ b/sys/pmio/pmio.com
@@ -0,0 +1,5 @@
+# PMIO.COM -- A few scratch vectors used in many of the PMIO routines,
+# defined in common to save some space.
+
+long	v1[PM_MAXDIM], v2[PM_MAXDIM], v3[PM_MAXDIM], v4[PM_MAXDIM]
+common	/pmiocom/ v1, v2, v3, v4
diff --git a/sys/pmio/pmline.x b/sys/pmio/pmline.x
new file mode 100644
index 00000000..36be1cb4
--- /dev/null
+++ b/sys/pmio/pmline.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_LINE -- Perform a rasterop operation upon a line of arbitrary width drawn
+# at an arbitrary orientation in a 2-dimensional plane of a mask.  If the
+# dimensionality of the mask exceeds 2, the pm_setplane() procedure should be
+# called first to define the plane of the mask to be modified.
+
+procedure pm_line (pl, x1, y1, x2, y2, width, rop)
+
+pointer	pl			#I mask descriptor
+int	x1,y1			#I start point of line
+int	x2,y2			#I end point of line
+int	width			#I width of line to be drawn, pixels
+int	rop			#I rasterop defining operation
+
+errchk	pl_getplane
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call pl_getplane (pl, v1)
+	    v1[1] = x1;  v1[2] = y1
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call pl_getplane (pl, v3)
+	    v3[1] = x2;  v3[2] = y2
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    call pl_line (pl, v2[1],v2[2], v4[1],v4[2], width, rop)
+
+	} else
+	    call pl_line (pl, x1, y1, x2, y2, width, rop)
+end
diff --git a/sys/pmio/pmlinene.x b/sys/pmio/pmlinene.x
new file mode 100644
index 00000000..0e49de54
--- /dev/null
+++ b/sys/pmio/pmlinene.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <pmset.h>
+include	<plio.h>
+
+# PM_LINENOTEMPTY -- Test whether the indicated mask image line is empty.
+
+bool procedure pm_linenotempty (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[PM_MAXDIM]		#I coordinates of desired line
+
+bool	pl_sectnotempty(), pl_linenotempty()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call imaplv (PM_REFIM(pl), v, v1, PM_MAXDIM)
+	    call amovl (v, v2, PM_MAXDIM)
+	    v2[1] = IM_LEN(PM_REFIM(pl),1)
+	    call imaplv (PM_REFIM(pl), v2, v3, PM_MAXDIM)
+
+	    return (pl_sectnotempty (pl, v1, v3, PM_MAXDIM))
+
+	} else
+	    return (pl_linenotempty (pl, v))
+end
diff --git a/sys/pmio/pmnewmask.x b/sys/pmio/pmnewmask.x
new file mode 100644
index 00000000..200e4841
--- /dev/null
+++ b/sys/pmio/pmnewmask.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<plio.h>
+
+# PM_NEWMASK -- Create an empty mask with the same dimensionality and size as
+# the given reference image.
+
+pointer procedure pm_newmask (ref_im, depth)
+
+pointer	ref_im			#I reference image
+int	depth			#I mask depth, bits
+
+pointer	pl
+pointer	pl_open()
+errchk	pl_open
+
+begin
+	pl = pl_open (NULL)
+	call pl_ssize (pl, IM_NDIM(ref_im), IM_SVLEN(ref_im,1), depth)
+
+	PM_REFIM(pl) = ref_im
+	PM_MAPXY(pl) = IM_SECTUSED(ref_im)
+
+	return (pl)
+end
diff --git a/sys/pmio/pmplls.x b/sys/pmio/pmplls.x
new file mode 100644
index 00000000..b7f0e826
--- /dev/null
+++ b/sys/pmio/pmplls.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLLS -- Put a line segment input as a list list to a mask, applying the
+# given ROP to combine the pixels with those of the output mask.
+
+procedure pm_plls (pl, v, ll_raw, ll_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	ll_raw[ARB]		#I input line list
+int	ll_depth		#I line list depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src, ll_dst, ll_stn, ll_out, px_src, im
+int	ll_len, step, xstep, temp, np, ip, i
+int	pl_l2pi(), pl_p2li()
+pointer	pl_access()
+include	"pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_plls (pl, v, ll_raw, ll_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	np = (npix - 1) * step + 1
+	ll_stn = NULL
+
+	# Resample and flip the line list if necessary.  Construct a stencil
+	# list if the step size is greater than 1.
+
+	if (xstep < 0 || step > 1) {
+	    call salloc (px_src, np, TY_INT)
+	    i = pl_l2pi (ll_raw, 1, Memi[px_src], npix)
+	    call aclri (Memi[px_src+i], np - i)
+
+	    # Flip data array.
+	    if (xstep < 0)
+		call imaflp (Memi[px_src], npix, SZ_INT)
+
+	    if (step > 1) {
+		# Resample data array.
+		ip = px_src + npix - 1
+		do i = np, 1, -step {
+		    Memi[px_src+i-1] = Memi[ip]
+		    ip = ip - 1
+		}
+
+		# Construct stencil.
+		call salloc (ll_stn, LL_MAXLEN(pl), TY_SHORT)
+		call aclri (Memi[px_src], np)
+		do i = 1, np, step
+		    Memi[px_src+i-1] = 1
+		ll_len = pl_p2li (Memi[px_src], 1, Mems[ll_stn], np)
+	    }
+
+	    # Convert flipped and resampled data back to line list.
+	    ll_len = pl_p2li (Memi[px_src], 1, Mems[ll_src], np)
+
+	} else {
+	    ll_len = LL_LEN(ll_raw)
+	    call amovs (ll_raw, Mems[ll_src], ll_len)
+	}
+
+	# Copy to or combine with destination.
+	if (ll_stn == NULL)
+	    call pl_plls (pl, v1, Mems[ll_src], ll_depth, np, rop)
+	else {
+	    call salloc (ll_out, LL_MAXLEN(pl), TY_SHORT)
+	    ll_dst = pl_access (pl, v1)
+	    call pl_linestencil (Mems[ll_src],  1, MV(ll_depth),
+		Mems[ll_dst], v1, PL_MAXVAL(pl), Mems[ll_stn], 1,
+		Mems[ll_out], np, rop)
+	    call pl_update (pl, v1, Mems[ll_out])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/pmplp.gx b/sys/pmio/pmplp.gx
new file mode 100644
index 00000000..90246ddc
--- /dev/null
+++ b/sys/pmio/pmplp.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLP -- Put a line segment input as a pixel array a mask, applying the
+# given ROP to combine the pixels with those of the mask.
+
+procedure pm_plp$t (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_p2l$t()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plp$t (pl, v, px_src, px_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_p2l$t (px_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], px_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/pmplr.gx b/sys/pmio/pmplr.gx
new file mode 100644
index 00000000..6f87601b
--- /dev/null
+++ b/sys/pmio/pmplr.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the pixels with those of the output mask.
+
+procedure pm_plr$t (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+PIXEL	rl_src[3,ARB]		#I input range list
+int	rl_depth		#I range list pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_r2l$t()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plr$t (pl, v, rl_src, rl_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_r2l$t (rl_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], rl_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/pmpoint.x b/sys/pmio/pmpoint.x
new file mode 100644
index 00000000..c464c47e
--- /dev/null
+++ b/sys/pmio/pmpoint.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_POINT -- Perform a rasterop operation on a single point in a line of a
+# 2-dimensional plane of a mask.  If the dimensionality of the mask exceeds 2,
+# the pm_setplane() procedure should be called first to define the plane of
+# the mask to be modified.
+
+procedure pm_point (pl, x, y, rop)
+
+pointer	pl			#I mask descriptor
+int	x			#I pixel to be modified
+int	y			#I line to be modified
+int	rop			#I rasterop defining operation
+
+errchk	pl_getplane
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call pl_getplane (pl, v1)
+	    v1[1] = x;  v1[2] = y
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call pl_point (pl, v2[1], v2[2], rop)
+
+	} else
+	    call pl_point (pl, x, y, rop)
+end
diff --git a/sys/pmio/pmpolygon.x b/sys/pmio/pmpolygon.x
new file mode 100644
index 00000000..5e09e5b7
--- /dev/null
+++ b/sys/pmio/pmpolygon.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_POLYGON -- Perform a rasterop operation on the area enclosed by a polygon
+# drawn in a 2-dimensional plane of a mask.  If the dimensionality of the mask
+# exceeds 2, the pm_setplane() procedure should be called first to define the
+# plane of the mask to be modified.
+
+procedure pm_polygon (pl, x, y, npts, rop)
+
+pointer	pl			#I mask descriptor
+int	x[npts]			#I polygon x-vertices
+int	y[npts]			#I polygon y-vertices
+int	npts			#I number of points in polygon
+int	rop			#I rasterop defining operation
+
+int	i
+pointer	sp, xp, yp
+errchk	pl_getplane
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call smark (sp)
+	    call salloc (xp, npts, TY_INT)
+	    call salloc (yp, npts, TY_INT)
+
+	    call pl_getplane (pl, v1)
+	    do i = 1, npts {
+		v1[1] = x[i];  v1[2] = y[i]
+		call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+		Memi[xp+i-1] = v2[1];  Memi[yp+i-1] = v2[2]
+	    }
+
+	    call pl_polygon (pl, Memi[xp], Memi[yp], npts, rop)
+	    call sfree (sp)
+
+	} else
+	    call pl_polygon (pl, x, y, npts, rop)
+end
diff --git a/sys/pmio/pmrio.x b/sys/pmio/pmrio.x
new file mode 100644
index 00000000..278c7f30
--- /dev/null
+++ b/sys/pmio/pmrio.x
@@ -0,0 +1,128 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+.help PMRIO
+.nf ---------------------------------------------------------------------------
+PMRIO -- A small package used to provide a means for efficient random
+sampling (at the pixel level) of large PMIO masks.  In other words, if we have
+a large mask and want to determine the values of successive mask pixels at
+random locations in the mask, this package provides a more efficient means
+for doing so than calling a routine such as PM_GLPI.  The mask must already
+exist; means are not provided within this package for creating or editing
+masks, only for reading them.
+
+		 pmr = pmr_open (pm, plane, buflimit)
+		    pmr_setrect (pmr, x1,y1, x2,y2)
+	      mval = pmr_getpix (pmr, x, y)
+		      pmr_close (pmr)
+
+PMR_OPEN opens the indicated 2 dimensional plane of the N dimensional mask PM.
+Buffer space used to provide an efficient means of randomly sampling the mask
+will be kept to within approximately BUFLIMIT integer units of storage (the
+internal table used to sample the mask is type integer, so BUFLIMIT is the
+approximate number of entries in the table).  Random sampling of the mask is
+provided by the integer function PMR_GETPIX, which returns the mask value at
+the point [i,j] within the specified plane.  PMR_SETRECT may be called before
+calling PMR_GETPIX to set the clipping rectangle, which defaults to the
+boundaries of the mask.  If a PMR_GETPIX call references outside the clipping
+region, ERR will be returned as the mask value (normal mask values are >= 0).
+Use of a clipping region other than the boundaries of the full mask can avoid
+the need for redundant clipping operations in the client.  PMR_CLOSE should
+be called to free the PMRIO table space (which can be extensive) when no longer
+needed.
+
+This package is a front end to the PLRIO package in PLIO, which does all the
+real work.
+.endhelp ----------------------------------------------------------------------
+
+# The following definitions must agree with those in plio$plrio.x.
+define	PMR_PL		Memi[$1]		# backpointer to PLIO descriptor
+define	PMR_PLANE	Memi[$1+10+($2)-1]	# defines 2D plane in ND mask
+
+
+# PMR_OPEN -- Open a PMIO mask for random pixel access.  Provides efficient
+# random pixel level access to any size mask.  This is a 2-dimensional
+# operator, but can be used to sample any 2-dim plane of an N-dim mask.
+
+pointer procedure pmr_open (pl, plane, buflimit)
+
+pointer	pl			#I PMIO/PLIO descriptor
+int	plane[ARB]		#I 2-dim plane to be accessed
+int	buflimit		#I approximate table size, or 0 if don't care
+
+pointer	plr_open()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call imaplv (PM_REFIM(pl), plane, v1, PM_MAXDIM)
+	    return (plr_open (pl, v1, buflimit))
+	} else
+	    return (plr_open (pl, plane, buflimit))
+end
+
+
+# PMR_GETPIX -- Return the value of the given mask pixel, identified by the
+# 2-dim coordinates of the pixel relative to the plane of the N-dim mask
+# specified at open time.
+
+int procedure pmr_getpix (pmr, i, j)
+
+pointer	pmr			#I PMR descriptor
+int	i, j			#I plane-relative coordinates of pixel
+
+pointer	pl
+int	plr_getpix()
+include	"pmio.com"
+
+begin
+	pl = PMR_PL(pmr)
+	if (PM_MAPXY(pl) == YES) {
+	    PMR_PLANE(pmr,1) = i
+	    PMR_PLANE(pmr,2) = j
+	    call imaplv (PM_REFIM(pl), PMR_PLANE(pmr,1), v1, PM_MAXDIM)
+	    return (plr_getpix (pmr, v1[1], v1[2]))
+	} else
+	    return (plr_getpix (pmr, i, j))
+end
+
+
+# PMR_SETRECT -- Set the clipping region for PMR_GETPIX.
+
+procedure pmr_setrect (pmr, x1,y1, x2,y2)
+
+pointer	pmr			#I PMR descriptor
+int	x1,y1			#I lower left corner of region
+int	x2,y2			#I upper right corner of region
+
+pointer	pl
+include	"pmio.com"
+
+begin
+	pl = PMR_PL(pmr)
+        if (PM_MAPXY(pl) == YES) {
+	    call amovi (PMR_PLANE(pmr,1), v1, PM_MAXDIM)
+            v1[1] = x1;  v1[2] = y1
+            call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call amovi (PMR_PLANE(pmr,1), v3, PM_MAXDIM)
+            v3[1] = x2;  v3[2] = y2
+            call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    call plr_setrect (pmr, v2[1],v2[2], v4[1],v4[2])
+	} else
+	    call plr_setrect (pmr, x1,y1, x2,y2)
+end
+
+
+# PMR_CLOSE -- Free a PMRIO descriptor.
+
+procedure pmr_close (pmr)
+
+pointer	pmr			#I PMR descriptor
+
+begin
+	call plr_close (pmr)
+end
diff --git a/sys/pmio/pmrop.x b/sys/pmio/pmrop.x
new file mode 100644
index 00000000..ddd77d37
--- /dev/null
+++ b/sys/pmio/pmrop.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <pmset.h>
+include	<plio.h>
+
+# PM_ROP -- Perform a rasterop operation from the source mask to the
+# destination mask at the given offsets.  The source and destination need
+# not be the same size or dimensionality, but out of bounds references are
+# not permitted.  If the source is of lesser dimensionality than the
+# indicated section of the destination, then the source will be rewound
+# and reread as necessary to operate upon the entire destination subregion,
+# e.g., a line source mask may be applied to successive lines of a plane,
+# or a plane mask may be applied to successive planes of a 3D mask.
+# The source and destination masks may be the same if desired, but if the 
+# source and destination regions overlap feedback may occur (this could be
+# fixed).  With some rasterops, e.g, PIX_SET or PIX_CLR, no source mask is
+# required, and pm_src=NULL is permitted.
+
+procedure pm_rop (pm_src, vs_src, pm_dst, vs_dst, vn, rop)
+
+pointer	pm_src			#I source mask or NULL
+long	vs_src[PM_MAXDIM]	#I start vector in source mask
+pointer	pm_dst			#I destination mask (required)
+long	vs_dst[PM_MAXDIM]	#I start vector in destination mask
+long	vn[PM_MAXDIM]		#I vector giving subregion size
+long	rop			#I rasterop
+
+int	i
+include	"pmio.com"
+
+begin
+	# If an image section is used on either the source or destination
+	# mask, map the input vectors into the physical image space and
+	# perform the rasterop operation there.
+
+	if (PM_MAPXY(pm_src) == YES || PM_MAPXY(pm_dst) == YES) {
+	    # Compute V1, the start vector in the source mask.
+	    call imaplv (PM_REFIM(pm_src), vs_src, v1, PM_MAXDIM)
+
+	    # Compute V3, the end vector in the source mask.
+	    call aaddl (vs_src, vn, v2, PM_MAXDIM)
+	    call asubkl (v2, 1, v2, PL_MAXDIM)
+	    call aminl (v2, IM_LEN(PM_REFIM(pm_src),1), v2, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pm_src), v2, v3, PM_MAXDIM)
+
+	    # Swap V1 and V3 if necessary.
+	    call aminl (v1, v3, v1, PM_MAXDIM)
+
+	    # Compute V2, the start vector in the destination mask.
+	    call imaplv (PM_REFIM(pm_dst), vs_dst, v2, PM_MAXDIM)
+
+	    # Compute V4, the end vector in the destination mask.
+	    call aaddl (vs_dst, vn, v3, PM_MAXDIM)
+	    call asubkl (v3, 1, v3, PL_MAXDIM)
+	    call aminl (v3, IM_LEN(PM_REFIM(pm_dst),1), v3, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pm_dst), v3, v4, PM_MAXDIM)
+
+	    # Compute v3 = vn for rasterop.  Input: SRC=v1:v3, DST=v2:v4
+	    # This also swaps v2 and v4 if necessary.
+
+	    do i = 1, PM_MAXDIM
+		if (v2[i] > v4[i]) {
+		    v3[i] = v2[i] - v4[i] + 1
+		    v2[i] = v4[i]
+		} else
+		    v3[i] = v4[i] - v2[i] + 1
+
+	    # Perform the rasterop.
+	    call pl_rop (pm_src, v1, pm_dst, v2, v3, rop)
+
+	} else
+	    call pl_rop (pm_src, vs_src, pm_dst, vs_dst, vn, rop)
+end
diff --git a/sys/pmio/pmsectnc.x b/sys/pmio/pmsectnc.x
new file mode 100644
index 00000000..ce424c3e
--- /dev/null
+++ b/sys/pmio/pmsectnc.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_SECTNOTCONST -- Test whether the indicated mask image section is constant,
+# i.e., all the mask pixels therein are set to the same value.  If so, return
+# the mask value as an output argument.
+
+bool procedure pm_sectnotconst (pl, vs, ve, ndim, mval)
+
+pointer	pl			#I mask descriptor
+long	vs[PM_MAXDIM]		#I starting coordinates of section
+long	ve[PM_MAXDIM]		#I ending coordinates of section
+int	ndim			#I dimension of section
+int	mval			#O mask value
+
+bool	pl_sectnotconst()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call amovkl ( 1, v1, PM_MAXDIM)
+	    call amovl (vs, v1, ndim)
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call amovkl ( 1, v3, PM_MAXDIM)
+	    call amovl (ve, v3, ndim)
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    return (pl_sectnotconst (pl, v2, v4, PM_MAXDIM, mval))
+
+	} else
+	    return (pl_sectnotconst (pl, vs, ve, ndim, mval))
+end
diff --git a/sys/pmio/pmsectne.x b/sys/pmio/pmsectne.x
new file mode 100644
index 00000000..654c53b1
--- /dev/null
+++ b/sys/pmio/pmsectne.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pmset.h>
+include	<plio.h>
+
+# PM_SECTNOTEMPTY -- Test whether the indicated mask image section is empty.
+
+bool procedure pm_sectnotempty (pl, vs, ve, ndim)
+
+pointer	pl			#I mask descriptor
+long	vs[PM_MAXDIM]		#I starting coordinates of section
+long	ve[PM_MAXDIM]		#I ending coordinates of section
+int	ndim
+
+bool	pl_sectnotempty()
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call amovkl ( 1, v1, PM_MAXDIM)
+	    call amovl (vs, v1, ndim)
+	    call imaplv (PM_REFIM(pl), v1, v2, PM_MAXDIM)
+
+	    call amovkl ( 1, v3, PM_MAXDIM)
+	    call amovl (ve, v3, ndim)
+	    call imaplv (PM_REFIM(pl), v3, v4, PM_MAXDIM)
+
+	    return (pl_sectnotempty (pl, v2, v4, PM_MAXDIM))
+
+	} else
+	    return (pl_sectnotempty (pl, vs, ve, ndim))
+end
diff --git a/sys/pmio/pmseti.x b/sys/pmio/pmseti.x
new file mode 100644
index 00000000..ef1fd99e
--- /dev/null
+++ b/sys/pmio/pmseti.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	<plio.h>
+include	<imio.h>
+
+# PM_SETI -- Set a PMIO or PLIO parameter.
+
+procedure pm_seti (pl, param, value)
+
+pointer	pl			#I mask descriptor
+int	param			#I parameter code
+int	value			#I parameter value
+
+begin
+	switch (param) {
+	case P_REFIM:
+	    PM_REFIM(pl) = value
+	    PM_MAPXY(pl) = IM_SECTUSED(value)
+	case P_MAPXY:
+	    PM_MAPXY(pl) = value
+	case P_MAXLINE:
+	    PL_MAXLINE(pl) = value
+	case P_DEPTH:
+	    PL_MAXVAL(pl) = MV(value)
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/pmio/pmsplane.x b/sys/pmio/pmsplane.x
new file mode 100644
index 00000000..4fcad1fd
--- /dev/null
+++ b/sys/pmio/pmsplane.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_SETPLANE -- Set the 2-Dim plane to be referenced in calls to the pm_box,
+# pm_circle, etc. geometric region masking operators.
+
+procedure pm_setplane (pl, v)
+
+pointer	pl			#I mask descriptor
+long	v[ARB]			#I vector defining plane
+
+include	"pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == YES) {
+	    call imaplv (PM_REFIM(pl), v, v1, PM_MAXDIM)
+	    call pl_setplane (pl, v1)
+	} else
+	    call pl_setplane (pl, v)
+end
diff --git a/sys/pmio/pmstati.x b/sys/pmio/pmstati.x
new file mode 100644
index 00000000..4e8566d2
--- /dev/null
+++ b/sys/pmio/pmstati.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	<plio.h>
+include	<imio.h>
+
+# PM_STATI -- Stat a PMIO or PLIO parameter.
+
+int procedure pm_stati (pl, param)
+
+pointer	pl			#I mask descriptor
+int	param			#I parameter code
+
+int	i
+
+begin
+	switch (param) {
+	case P_REFIM:
+	    return (PM_REFIM(pl))
+	case P_MAPXY:
+	    return (PM_MAPXY(pl))
+	case P_MAXLINE:
+	    return (PL_MAXLINE(pl))
+	case P_DEPTH:
+	    do i = 0, ARB
+		if (2**i > min (I_PVMAX, PL_MAXVAL(pl)))
+		    return (i)
+	default:
+	    call syserr (SYS_PLINVPAR)
+	}
+end
diff --git a/sys/pmio/pmsten.x b/sys/pmio/pmsten.x
new file mode 100644
index 00000000..09a34a52
--- /dev/null
+++ b/sys/pmio/pmsten.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <pmset.h>
+include	<plio.h>
+
+# PM_STENCIL -- Perform a rasterop operation from the source mask to the
+# destination mask at the given offsets, but only within the regions set to
+# one in the stencil mask.
+
+procedure pm_stencil (pm_src, vs_src, pm_dst, vs_dst, pm_stn, vs_stn, vn, rop)
+
+pointer	pm_src			#I source mask or NULL
+long	vs_src[PM_MAXDIM]	#I start vector in source mask
+pointer	pm_dst			#I destination mask (required)
+long	vs_dst[PM_MAXDIM]	#I start vector in destination mask
+pointer	pm_stn			#I stencil mask (required)
+long	vs_stn[PM_MAXDIM]	#I start vector in stencil mask
+long	vn[PM_MAXDIM]		#I vector giving subregion size
+long	rop			#I rasterop
+
+int	i
+long	v5[PM_MAXDIM], v6[PM_MAXDIM]
+include	"pmio.com"
+
+begin
+	# If an image section is in use on any of the input mask operands,
+	# perform a coordination transformation into physical mask space
+	# before performing the stencil operation.
+
+	if (PM_MAPXY(pm_src) == YES || PM_MAPXY(pm_dst) == YES ||
+	    PM_MAPXY(pm_stn) == YES) {
+
+	    # Compute the geometry V1:V3 of the source mask.
+	    call imaplv (PM_REFIM(pm_src), vs_src, v1, PM_MAXDIM)
+
+	    call aaddl (vs_src, vn, v2, PM_MAXDIM)
+	    call asubkl (v2, 1, v2, PM_MAXDIM)
+	    call aminl (v2, IM_LEN(PM_REFIM(pm_src),1), v2, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pm_src), v2, v3, PM_MAXDIM)
+
+	    # Swap V1 and V3 if necessary.
+	    call aminl (v1, v3, v1, PM_MAXDIM)
+
+	    # Compute the geometry V2:V4 of the destination mask.
+	    call imaplv (PM_REFIM(pm_dst), vs_dst, v2, PM_MAXDIM)
+
+	    call aaddl (vs_dst, vn, v3, PM_MAXDIM)
+	    call asubkl (v3, 1, v3, PM_MAXDIM)
+	    call aminl (v3, IM_LEN(PM_REFIM(pm_dst),1), v3, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pm_dst), v3, v4, PM_MAXDIM)
+
+	    # Compute v3 = vn for rasterop.  Input: SRC=v1:v3, DST=v2:v4
+	    # This also swaps v2 and v4 if necessary.
+
+	    do i = 1, PM_MAXDIM
+		if (v2[i] > v4[i]) {
+		    v3[i] = v2[i] - v4[i] + 1
+		    v2[i] = v4[i]
+		} else
+		    v3[i] = v4[i] - v2[i] + 1
+
+	    # Compute the start vector V4 of the stencil mask.
+	    call imaplv (PM_REFIM(pm_stn), vs_stn, v4, PM_MAXDIM)
+	    call aaddl (vs_stn, vn, v5, PM_MAXDIM)
+	    call asubkl (v5, 1, v5, PM_MAXDIM)
+	    call aminl (v5, IM_LEN(PM_REFIM(pm_stn),1), v5, PM_MAXDIM)
+	    call imaplv (PM_REFIM(pm_stn), v5, v6, PM_MAXDIM)
+	    call aminl (v4, v6, v4, PM_MAXDIM)
+
+	    # Perform the rasterop operation.
+	    call pl_stencil (pm_src, v1, pm_dst, v2, pm_stn, v4, v3, rop)
+
+	} else
+	    call pl_stencil (pm_src, vs_src, pm_dst, vs_dst,
+		pm_stn, vs_stn, vn, rop)
+end
diff --git a/sys/pmio/tf/miogld.x b/sys/pmio/tf/miogld.x
new file mode 100644
index 00000000..7c3dc743
--- /dev/null
+++ b/sys/pmio/tf/miogld.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegd (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2d(), imgl3d(), imggsd()
+errchk	imgl2d, imgl3d, imggsd, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2d (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3d (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggsd (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miogli.x b/sys/pmio/tf/miogli.x
new file mode 100644
index 00000000..726f46f1
--- /dev/null
+++ b/sys/pmio/tf/miogli.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegi (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2i(), imgl3i(), imggsi()
+errchk	imgl2i, imgl3i, imggsi, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2i (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3i (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggsi (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miogll.x b/sys/pmio/tf/miogll.x
new file mode 100644
index 00000000..6566ae01
--- /dev/null
+++ b/sys/pmio/tf/miogll.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegl (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2l(), imgl3l(), imggsl()
+errchk	imgl2l, imgl3l, imggsl, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2l (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3l (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggsl (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/mioglr.x b/sys/pmio/tf/mioglr.x
new file mode 100644
index 00000000..d0fa8de0
--- /dev/null
+++ b/sys/pmio/tf/mioglr.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegr (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2r(), imgl3r(), imggsr()
+errchk	imgl2r, imgl3r, imggsr, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2r (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3r (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggsr (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miogls.x b/sys/pmio/tf/miogls.x
new file mode 100644
index 00000000..4973da4f
--- /dev/null
+++ b/sys/pmio/tf/miogls.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegs (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2s(), imgl3s(), imggss()
+errchk	imgl2s, imgl3s, imggss, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2s (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3s (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggss (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/mioglx.x b/sys/pmio/tf/mioglx.x
new file mode 100644
index 00000000..44f866a2
--- /dev/null
+++ b/sys/pmio/tf/mioglx.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_GLSEG -- Get a line segment from a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_glsegx (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U coords of first pixel in output ine segment
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	imgl2x(), imgl3x(), imggsx()
+errchk	imgl2x, imgl3x, imggsx, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, M_NDIM(mp))
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = imgl2x (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = imgl3x (im, v[2], v[3])
+	    else {
+		call amovl (v, ve, M_NDIM(mp));  ve[1] = M_VE(mp,1)
+		bp = imggsx (im, v, ve, M_NDIM(mp))
+	    }
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miopld.x b/sys/pmio/tf/miopld.x
new file mode 100644
index 00000000..33515220
--- /dev/null
+++ b/sys/pmio/tf/miopld.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegd (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2d(), impl3d(), impgsd()
+errchk	impl2d, impl3d, impgsd, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2d (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3d (im, v[2], v[3])
+	    else
+		bp = impgsd (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miopli.x b/sys/pmio/tf/miopli.x
new file mode 100644
index 00000000..80ab9ab2
--- /dev/null
+++ b/sys/pmio/tf/miopli.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegi (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2i(), impl3i(), impgsi()
+errchk	impl2i, impl3i, impgsi, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2i (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3i (im, v[2], v[3])
+	    else
+		bp = impgsi (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miopll.x b/sys/pmio/tf/miopll.x
new file mode 100644
index 00000000..c59564b4
--- /dev/null
+++ b/sys/pmio/tf/miopll.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegl (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2l(), impl3l(), impgsl()
+errchk	impl2l, impl3l, impgsl, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2l (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3l (im, v[2], v[3])
+	    else
+		bp = impgsl (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/mioplr.x b/sys/pmio/tf/mioplr.x
new file mode 100644
index 00000000..05471efd
--- /dev/null
+++ b/sys/pmio/tf/mioplr.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegr (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2r(), impl3r(), impgsr()
+errchk	impl2r, impl3r, impgsr, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2r (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3r (im, v[2], v[3])
+	    else
+		bp = impgsr (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/miopls.x b/sys/pmio/tf/miopls.x
new file mode 100644
index 00000000..85288e28
--- /dev/null
+++ b/sys/pmio/tf/miopls.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegs (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2s(), impl3s(), impgss()
+errchk	impl2s, impl3s, impgss, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2s (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3s (im, v[2], v[3])
+	    else
+		bp = impgss (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/mioplx.x b/sys/pmio/tf/mioplx.x
new file mode 100644
index 00000000..238cb7eb
--- /dev/null
+++ b/sys/pmio/tf/mioplx.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+include	"../mio.h"
+
+# MIO_PLSEG -- Put a line segment to a masked image.  A line segment is a
+# region of the data image for which the corresponding region of the mask has
+# the constant nonzero value MVAL.  Line segments are returned for each line in
+# the region VS to VE, returning the number of pixels in each line segment as
+# the function value, or EOF when the region is exhausted.  Once EOF is
+# reached, repeated calls will continue to return EOF until the next call to
+# MIO_SETRANGE.  Repeated calls to MIO_SETRANGE may be used to access a series
+# of distinct regions in the image.  If a subregion of the image is being
+# accessed with MIO_SETRANGE, the vector coordinates V returned below will
+# be relative to the defined subregion (if this is not what is desired,
+# the range should be set to the full image and a region mask used to mask
+# off the subregion to be accessed).
+
+int procedure mio_plsegx (mp, ptr, mval, v, npix)
+
+pointer	mp			#I MIO descriptor
+pointer	ptr			#O pointer to a buffer containing the data
+int	mval			#O mask value for the output line segment
+long	v[IM_MAXDIM]		#U vector coordinates of first pixel
+int	npix			#O number of pixels in output line segment
+
+int	x1, i
+long	ve[IM_MAXDIM]
+pointer	pm, im, rl, rp, bp
+pointer	impl2x(), impl3x(), impgsx()
+errchk	impl2x, impl3x, impgsx, pm_glri
+bool	pm_sectnotempty()
+int	plloop()
+
+begin
+	pm = M_PM(mp)
+	rl = M_RLP(mp)
+
+	# Initialization performed for the first i/o on a new region.
+	if (M_ACTIVE(mp) == NO) {
+	    call plsslv (pm, M_VS(mp,1), M_VN(mp,1), M_V(mp,1), M_VE(mp,1))
+	    call pm_glri (pm,
+		M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+	    M_RLI(mp) = RL_FIRST
+	    M_ACTIVE(mp) = YES
+	}
+
+	# Get a new mask line?
+	while (M_RLI(mp) > RLI_LEN(rl))
+	    if (plloop (M_V(mp,1), M_VS(mp,1), M_VE(mp,1),
+		M_NDIM(mp)) == LOOP_DONE) {
+		return (EOF)
+	    } else {
+		call amovl (M_V(mp,1), ve, M_NDIM(mp))
+		ve[1] = M_VE(mp,1)
+		if (pm_sectnotempty (pm, M_V(mp,1), ve, M_NDIM(mp))) {
+		    call pm_glri (pm,
+			M_V(mp,1), Memi[rl], M_DEPTH(mp), M_VN(mp,1), PIX_SRC)
+		    M_RLI(mp) = RL_FIRST
+		}
+	    }
+
+
+	# Get a new image line?
+	if (M_RLI(mp) == RL_FIRST) {
+	    call amovl (M_V(mp,1), v, IM_MAXDIM)
+	    im = M_IM(mp)
+	
+	    if (M_LINEIO(mp) == YES && M_NDIM(mp) == 2)
+		bp = impl2x (im, v[2])
+	    else if (M_LINEIO(mp) == YES && M_NDIM(mp) == 3)
+		bp = impl3x (im, v[2], v[3])
+	    else
+		bp = impgsx (im, v, ve, M_NDIM(mp))
+
+	    M_LBP(mp) = bp
+	} else
+	    bp = M_LBP(mp)
+
+	# Return the next line segment.
+	rp = rl + (M_RLI(mp) - 1) * RL_LENELEM
+	M_RLI(mp) = M_RLI(mp) + 1
+
+	x1   = Memi[rp+RL_XOFF]
+	npix = Memi[rp+RL_NOFF]
+	mval = Memi[rp+RL_VOFF]
+	ptr  = bp + x1 - M_VS(mp,1)
+
+	if (M_REGCOORDS(mp) == NO) {
+	    v[1] = x1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i)
+	} else {
+	    v[1] = x1 - M_VS(mp,1) + 1
+	    do i = 2, M_NDIM(mp)
+		v[i] = M_V(mp,i) - M_VS(mp,i) + 1
+	}
+
+	return (npix)
+end
diff --git a/sys/pmio/tf/mkpkg b/sys/pmio/tf/mkpkg
new file mode 100644
index 00000000..2d51c91e
--- /dev/null
+++ b/sys/pmio/tf/mkpkg
@@ -0,0 +1,33 @@
+# Update the type expanded generic files in the PMIO package library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	miogld.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miogli.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miogll.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	mioglr.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miogls.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	mioglx.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miopld.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miopli.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miopll.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	mioplr.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	miopls.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	mioplx.x	../mio.h <imhdr.h> <plio.h> <pmset.h>
+	pmglpi.x	../pmio.com <plio.h> <pmset.h>
+	pmglpl.x	../pmio.com <plio.h> <pmset.h>
+	pmglps.x	../pmio.com <plio.h> <pmset.h>
+	pmglri.x	../pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmglrl.x	../pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmglrs.x	../pmio.com <imhdr.h> <plio.h> <pmset.h>
+	pmplpi.x	../pmio.com <plio.h> <pmset.h>
+	pmplpl.x	../pmio.com <plio.h> <pmset.h>
+	pmplps.x	../pmio.com <plio.h> <pmset.h>
+	pmplri.x	../pmio.com <plio.h> <pmset.h>
+	pmplrl.x	../pmio.com <plio.h> <pmset.h>
+	pmplrs.x	../pmio.com <plio.h> <pmset.h>
+	;
diff --git a/sys/pmio/tf/pmglpi.x b/sys/pmio/tf/pmglpi.x
new file mode 100644
index 00000000..2de53760
--- /dev/null
+++ b/sys/pmio/tf/pmglpi.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pm_glpi (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	temp, np, step, xstep
+pointer	sp, px_src, px_out, im
+include	"../pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glpi (pl, v, px_dst, px_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_INT)
+	call pl_glpi (pl, v1, Memi[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Memi[px_src], Memi[px_src], npix, SZ_INT, step)
+	if (xstep < 0)
+	    call imaflp (Memi[px_src], npix, SZ_INT)
+
+	if (!R_NEED_DST(rop))
+	    call amovi (Memi[px_src], px_dst, npix)
+	else {
+	    call salloc (px_out, npix, TY_INT)
+	    call pl_pixropi (Memi[px_src], 1, PL_MAXVAL(pl), px_dst, 1,
+		MV(px_depth), npix, rop)
+	    call amovi (Memi[px_out], px_dst, npix)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmglpl.x b/sys/pmio/tf/pmglpl.x
new file mode 100644
index 00000000..24e4b6ff
--- /dev/null
+++ b/sys/pmio/tf/pmglpl.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pm_glpl (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	temp, np, step, xstep
+pointer	sp, px_src, px_out, im
+include	"../pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glpl (pl, v, px_dst, px_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_LONG)
+	call pl_glpl (pl, v1, Meml[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Meml[px_src], Meml[px_src], npix, SZ_LONG, step)
+	if (xstep < 0)
+	    call imaflp (Meml[px_src], npix, SZ_LONG)
+
+	if (!R_NEED_DST(rop))
+	    call amovl (Meml[px_src], px_dst, npix)
+	else {
+	    call salloc (px_out, npix, TY_LONG)
+	    call pl_pixropl (Meml[px_src], 1, PL_MAXVAL(pl), px_dst, 1,
+		MV(px_depth), npix, rop)
+	    call amovl (Meml[px_out], px_dst, npix)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmglps.x b/sys/pmio/tf/pmglps.x
new file mode 100644
index 00000000..bcc50de4
--- /dev/null
+++ b/sys/pmio/tf/pmglps.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLP -- Get a line segment as a pixel array, applying the given ROP to
+# combine the pixels with those of the output array.
+
+procedure pm_glps (pl, v, px_dst, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	px_dst[ARB]		#O output pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	temp, np, step, xstep
+pointer	sp, px_src, px_out, im
+include	"../pmio.com"
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glps (pl, v, px_dst, px_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_SHORT)
+	call pl_glps (pl, v1, Mems[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Mems[px_src], Mems[px_src], npix, SZ_SHORT, step)
+	if (xstep < 0)
+	    call imaflp (Mems[px_src], npix, SZ_SHORT)
+
+	if (!R_NEED_DST(rop))
+	    call amovs (Mems[px_src], px_dst, npix)
+	else {
+	    call salloc (px_out, npix, TY_SHORT)
+	    call pl_pixrops (Mems[px_src], 1, PL_MAXVAL(pl), px_dst, 1,
+		MV(px_depth), npix, rop)
+	    call amovs (Mems[px_out], px_dst, npix)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmglri.x b/sys/pmio/tf/pmglri.x
new file mode 100644
index 00000000..3b3881f8
--- /dev/null
+++ b/sys/pmio/tf/pmglri.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output line list.  Note that this
+# operator uses IMIO if a section transformation is needed, hence if the 
+# application also uses IMIO to directly access the mask image, care must
+# be taken to avoid confusion over the use of IMIO allocated pixel buffers.
+
+procedure pm_glri (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	rl_dst[3,ARB]		#O output line list
+int	rl_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	rl_len, temp, step, xstep, np
+pointer	sp, px_src, rl_src, rl_out, im
+include	"../pmio.com"
+int	pl_p2ri()
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glri (pl, v, rl_dst, rl_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (rl_src, RL_MAXLEN(pl), TY_INT)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_INT)
+	call pl_glpi (pl, v1, Memi[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Memi[px_src], Memi[px_src], npix, SZ_INT, step)
+	if (xstep < 0)
+	    call imaflp (Memi[px_src], npix, SZ_INT)
+
+	# Convert to a range list.
+	rl_len = pl_p2ri (Memi[px_src], 1, Memi[rl_src], npix)
+
+	# Copy to or combine with destination.
+	if (!R_NEED_DST(rop)) {
+	    rl_len = RLI_LEN(rl_src) * RL_LENELEM
+	    call amovi (Memi[rl_src], rl_dst, rl_len)
+	} else {
+	    call salloc (rl_out, RL_MAXLEN(pl), TY_INT)
+	    call pl_rangeropi (Memi[rl_src], 1, PL_MAXVAL(pl), rl_dst, 1,
+		MV(rl_depth), Memi[rl_out], npix, rop)
+		rl_len = RLI_LEN(rl_out) * RL_LENELEM
+	    call amovi (Memi[rl_out], rl_dst, rl_len)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmglrl.x b/sys/pmio/tf/pmglrl.x
new file mode 100644
index 00000000..d78b891e
--- /dev/null
+++ b/sys/pmio/tf/pmglrl.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output line list.  Note that this
+# operator uses IMIO if a section transformation is needed, hence if the 
+# application also uses IMIO to directly access the mask image, care must
+# be taken to avoid confusion over the use of IMIO allocated pixel buffers.
+
+procedure pm_glrl (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	rl_dst[3,ARB]		#O output line list
+int	rl_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	rl_len, temp, step, xstep, np
+pointer	sp, px_src, rl_src, rl_out, im
+include	"../pmio.com"
+int	pl_p2rl()
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glrl (pl, v, rl_dst, rl_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (rl_src, RL_MAXLEN(pl), TY_LONG)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_LONG)
+	call pl_glpl (pl, v1, Meml[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Meml[px_src], Meml[px_src], npix, SZ_LONG, step)
+	if (xstep < 0)
+	    call imaflp (Meml[px_src], npix, SZ_LONG)
+
+	# Convert to a range list.
+	rl_len = pl_p2rl (Meml[px_src], 1, Meml[rl_src], npix)
+
+	# Copy to or combine with destination.
+	if (!R_NEED_DST(rop)) {
+	    rl_len = RLI_LEN(rl_src) * RL_LENELEM
+	    call amovl (Meml[rl_src], rl_dst, rl_len)
+	} else {
+	    call salloc (rl_out, RL_MAXLEN(pl), TY_LONG)
+	    call pl_rangeropl (Meml[rl_src], 1, PL_MAXVAL(pl), rl_dst, 1,
+		MV(rl_depth), Meml[rl_out], npix, rop)
+		rl_len = RLI_LEN(rl_out) * RL_LENELEM
+	    call amovl (Meml[rl_out], rl_dst, rl_len)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmglrs.x b/sys/pmio/tf/pmglrs.x
new file mode 100644
index 00000000..79fea4f6
--- /dev/null
+++ b/sys/pmio/tf/pmglrs.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<pmset.h>
+include	<plio.h>
+
+# PM_GLR -- Get a line segment as a range list, applying the given ROP to
+# combine the pixels with those of the output line list.  Note that this
+# operator uses IMIO if a section transformation is needed, hence if the 
+# application also uses IMIO to directly access the mask image, care must
+# be taken to avoid confusion over the use of IMIO allocated pixel buffers.
+
+procedure pm_glrs (pl, v, rl_dst, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	rl_dst[3,ARB]		#O output line list
+int	rl_depth		#I line list depth, bits
+int	npix			#I number of pixels desired
+int	rop			#I rasterop
+
+int	rl_len, temp, step, xstep, np
+pointer	sp, px_src, rl_src, rl_out, im
+include	"../pmio.com"
+int	pl_p2rs()
+
+begin
+	im = PM_REFIM(pl)
+	if (PM_MAPXY(pl) == NO) {
+	    call pl_glrs (pl, v, rl_dst, rl_depth, npix, rop)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (rl_src, RL_MAXLEN(pl), TY_SHORT)
+
+	# Determine physical coords of line segment.
+	call amovl (v, v3, PM_MAXDIM)
+	call imaplv (im, v3, v1, PM_MAXDIM)
+	v3[1] = v3[1] + npix - 1
+	call imaplv (im, v3, v2, PM_MAXDIM)
+
+	# Get line scaling parameters.
+	if (npix <= 1)
+	    xstep = 1
+	else
+	    xstep = (v2[1] - v1[1]) / (npix - 1)
+	step = xstep
+	if (xstep < 0) {
+	    temp = v1[1];  v1[1] = v2[1];  v2[1] = temp
+	    step = -step
+	}
+
+	# Extract the pixels.
+	np = (npix - 1) * step + 1
+	call salloc (px_src, np, TY_SHORT)
+	call pl_glps (pl, v1, Mems[px_src], 0, np, PIX_SRC)
+
+	# Subsample and flip if necessary.
+	if (step > 1)
+	    call imsamp (Mems[px_src], Mems[px_src], npix, SZ_SHORT, step)
+	if (xstep < 0)
+	    call imaflp (Mems[px_src], npix, SZ_SHORT)
+
+	# Convert to a range list.
+	rl_len = pl_p2rs (Mems[px_src], 1, Mems[rl_src], npix)
+
+	# Copy to or combine with destination.
+	if (!R_NEED_DST(rop)) {
+	    rl_len = RLI_LEN(rl_src) * RL_LENELEM
+	    call amovs (Mems[rl_src], rl_dst, rl_len)
+	} else {
+	    call salloc (rl_out, RL_MAXLEN(pl), TY_SHORT)
+	    call pl_rangerops (Mems[rl_src], 1, PL_MAXVAL(pl), rl_dst, 1,
+		MV(rl_depth), Mems[rl_out], npix, rop)
+		rl_len = RLS_LEN(rl_out) * RL_LENELEM
+	    call amovs (Mems[rl_out], rl_dst, rl_len)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/pmio/tf/pmplpi.x b/sys/pmio/tf/pmplpi.x
new file mode 100644
index 00000000..b62b333a
--- /dev/null
+++ b/sys/pmio/tf/pmplpi.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLP -- Put a line segment input as a pixel array a mask, applying the
+# given ROP to combine the pixels with those of the mask.
+
+procedure pm_plpi (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_p2li()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plpi (pl, v, px_src, px_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_p2li (px_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], px_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/tf/pmplpl.x b/sys/pmio/tf/pmplpl.x
new file mode 100644
index 00000000..2194d9f9
--- /dev/null
+++ b/sys/pmio/tf/pmplpl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLP -- Put a line segment input as a pixel array a mask, applying the
+# given ROP to combine the pixels with those of the mask.
+
+procedure pm_plpl (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_p2ll()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plpl (pl, v, px_src, px_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_p2ll (px_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], px_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/tf/pmplps.x b/sys/pmio/tf/pmplps.x
new file mode 100644
index 00000000..68e26f7d
--- /dev/null
+++ b/sys/pmio/tf/pmplps.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLP -- Put a line segment input as a pixel array a mask, applying the
+# given ROP to combine the pixels with those of the mask.
+
+procedure pm_plps (pl, v, px_src, px_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	px_src[ARB]		#I input pixel array
+int	px_depth		#I pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_p2ls()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plps (pl, v, px_src, px_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_p2ls (px_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], px_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/tf/pmplri.x b/sys/pmio/tf/pmplri.x
new file mode 100644
index 00000000..4a2f1435
--- /dev/null
+++ b/sys/pmio/tf/pmplri.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the pixels with those of the output mask.
+
+procedure pm_plri (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+int	rl_src[3,ARB]		#I input range list
+int	rl_depth		#I range list pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_r2li()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plri (pl, v, rl_src, rl_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_r2li (rl_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], rl_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/tf/pmplrl.x b/sys/pmio/tf/pmplrl.x
new file mode 100644
index 00000000..260daa21
--- /dev/null
+++ b/sys/pmio/tf/pmplrl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the pixels with those of the output mask.
+
+procedure pm_plrl (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+long	rl_src[3,ARB]		#I input range list
+int	rl_depth		#I range list pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_r2ll()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plrl (pl, v, rl_src, rl_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_r2ll (rl_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], rl_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/tf/pmplrs.x b/sys/pmio/tf/pmplrs.x
new file mode 100644
index 00000000..43b99b98
--- /dev/null
+++ b/sys/pmio/tf/pmplrs.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pmset.h>
+include	<plio.h>
+
+# PM_PLR -- Put a line segment input as a range list to a mask, applying the
+# given ROP to combine the pixels with those of the output mask.
+
+procedure pm_plrs (pl, v, rl_src, rl_depth, npix, rop)
+
+pointer	pl			#I mask descriptor
+long	v[PL_MAXDIM]		#I vector coords of line segment
+short	rl_src[3,ARB]		#I input range list
+int	rl_depth		#I range list pixel depth, bits
+int	npix			#I number of pixels affected
+int	rop			#I rasterop
+
+pointer	sp, ll_src
+int	ll_len, pl_r2ls()
+include	"../pmio.com"
+
+begin
+	if (PM_MAPXY(pl) == NO)
+	    call pl_plrs (pl, v, rl_src, rl_depth, npix, rop)
+	else {
+	    call smark (sp)
+	    call salloc (ll_src, LL_MAXLEN(pl), TY_SHORT)
+
+	    ll_len = pl_r2ls (rl_src, 1, Mems[ll_src], npix)
+	    call pm_plls (pl, v, Mems[ll_src], rl_depth, npix, rop)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/pmio/zzdebug.x b/sys/pmio/zzdebug.x
new file mode 100644
index 00000000..e21e500d
--- /dev/null
+++ b/sys/pmio/zzdebug.x
@@ -0,0 +1,217 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<ctype.h>
+include	<fset.h>
+include	<pmset.h>
+include	<plio.h>
+
+task	pmtest	= t_pmtest,
+	mkmask	= t_mkmask,
+	pmcopy	= t_pmcopy,
+	mio	= t_mio
+
+
+# MKMASK -- Make a mask for the given image.
+
+procedure t_mkmask()
+
+char	image[SZ_FNAME]
+char	mask[SZ_FNAME]
+char	cmdfile[SZ_FNAME]
+char	cmd[SZ_FNAME]
+
+pointer	im, pm
+int	x, y, r, x1, y1, x2, y2, fd
+pointer	immap(), pm_newmask()
+int	open(), nscan(), fscan()
+bool	streq()
+
+begin
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("mask", mask, SZ_FNAME)
+
+	# Open the image and an empty mask.
+	im = immap (image, READ_ONLY, 0)
+	pm = pm_newmask (im, 1)
+
+	# Get the list of commands to be processed.
+	call clgstr ("cmdfile", cmdfile, SZ_FNAME)
+	fd = open (cmdfile, READ_ONLY, TEXT_FILE)
+
+	# Process the commands and draw the mask.
+	while (fscan (fd) != EOF) {
+	    call gargwrd (cmd, SZ_FNAME)
+	    if (nscan() < 1)
+		break
+
+	    if (streq (cmd, "point")) {
+		# Command: point x y
+		call gargi (x)
+		call gargi (y)
+		if (nscan() < 3) {
+		    call eprintf ("point: bad arg list\n")
+		    next
+		}
+		
+		call eprintf ("point %d %d\n")
+		    call pargi (x);  call pargi (y)
+		call pm_point (pm, x, y, PIX_SET + PIX_VALUE(1))
+
+	    } else if (streq (cmd, "circle")) {
+		# Command: circle x y r
+		call gargi (x)
+		call gargi (y)
+		call gargi (r)
+		if (nscan() < 4) {
+		    call eprintf ("circle: bad arg list\n")
+		    next
+		}
+
+		call eprintf ("circle %d %d %d\n")
+		    call pargi (x);  call pargi (y);  call pargi (r)
+		call pm_circle (pm, x, y, r, PIX_SET + PIX_VALUE(1))
+
+	    } else if (streq (cmd, "box")) {
+		# Command: box x1 y1 x2 y2
+		call gargi (x1);  call gargi (y1)
+		call gargi (x2);  call gargi (y2)
+		if (nscan() < 5) {
+		    call eprintf ("box: bad arg list\n")
+		    next
+		}
+
+		call eprintf ("box %d %d %d %d\n")
+		    call pargi (x1);  call pargi (y1)
+		    call pargi (x2);  call pargi (y2)
+		call pm_box (pm, x1,y1, x2,y2, PIX_SET + PIX_VALUE(1))
+
+	    } else {
+		call eprintf ("bad command %s\n")
+		    call pargstr (cmd)
+	    }
+
+	    # call pm_debug (pm, STDERR, 80, PD_INDEX)
+	}
+
+	# Save the mask in a file.
+	call pm_savef (pm, mask, "mkmask", 0)
+
+	call pm_close (pm)
+	call imunmap (im)
+end
+
+
+# PMCOPY -- Copy an image mask.
+
+procedure t_pmcopy
+
+char	refim[SZ_FNAME]
+char	mask[SZ_FNAME], newmask[SZ_FNAME], title[SZ_LINE]
+
+pointer	im, old_pm, new_pm
+long	vs[PM_MAXDIM], vn[PM_MAXDIM]
+pointer	immap(), pm_open(), pm_newmask()
+int	pm_stati()
+
+begin
+	call clgstr ("mask", mask, SZ_FNAME)
+	call clgstr ("refim", refim, SZ_FNAME)
+	call clgstr ("newmask", newmask, SZ_FNAME)
+
+	# Open reference image.
+	im = immap (refim, READ_ONLY, 0)
+
+	# Open old mask.
+	old_pm = pm_open (NULL)
+	call pm_loadf (old_pm, mask, title, SZ_LINE)
+	call pm_seti (old_pm, P_REFIM, im)
+
+	# Create a new mask.
+	new_pm = pm_newmask (im, pm_stati(old_pm,P_DEPTH))
+
+	# Copy the mask.
+	call amovkl (1, vs, PM_MAXDIM)
+	call amovkl (IM_LEN(im,1), vn, PM_MAXDIM)
+	call pm_rop (old_pm, vs, new_pm, vs, vn, PIX_SRC)
+
+	# Save in a file.
+	call pm_savef (new_pm, newmask, title, 0)
+
+	call pm_close (new_pm)
+	call pm_close (old_pm)
+	call imunmap (im)
+end
+
+
+# MIO -- Test MIO.
+
+procedure t_mio()
+
+char	image[SZ_FNAME]
+char	mask[SZ_FNAME]
+
+real	rsum
+pointer	im, mp, pm, bp
+bool	debug, usefullimage
+long	v[IM_MAXDIM], vs[2], ve[2]
+int	mval, npix, totpix
+
+real	asums()
+bool	clgetb()
+pointer	immap(), mio_open()
+int	clgeti(), mio_glsegs(), mio_stati(), clscan(), nscan()
+
+begin
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("mask", mask, SZ_FNAME)
+	debug = clgetb ("debug")
+
+	im = immap (image, READ_ONLY, 0)
+	mp = mio_open (mask, clgeti("flags"), im)
+
+	# The following assumes a 2D image.
+	usefullimage = true
+	if (clscan ("region") != EOF) {
+	    call gargi(vs[1]);  call gargi (vs[2])
+	    call gargi(ve[1]);  call gargi (ve[2])
+	    usefullimage = (nscan() != 4)
+	}
+	if (usefullimage) {
+	    call amovkl (1, vs, 2)
+	    call amovl (IM_LEN(im,1), ve, 2)
+	}
+	call mio_setrange (mp, vs, ve, 2)
+
+	if (debug) {
+	    pm = mio_stati (mp, P_PMDES)
+	    call pm_debug (pm, STDERR, 80, PD_LLOUT)
+	}
+
+	totpix = 0
+	rsum = 0.0
+
+	while (mio_glsegs (mp, bp, mval, v, npix) != EOF) {
+	    if (debug) {
+		call eprintf ("x=%3d, y=%3d, n=%3d, mval=%o\n")
+		    call pargl (v[1])
+		    call pargl (v[2])
+		    call pargi (npix)
+		    call pargi (mval)
+	    }
+	    totpix = totpix + npix
+	    rsum = rsum + asums (Mems[bp], npix)
+	}
+
+	call eprintf ("totpix=%d, sum=%g, mean=%g\n")
+	    call pargi (totpix)
+	    call pargr (rsum)
+	    if (totpix == 0)
+		call pargr (INDEFR)
+	    else
+		call pargr (rsum / totpix)
+
+	call mio_close (mp)
+	call imunmap (im)
+end
diff --git a/sys/pmio/zzinterp.x b/sys/pmio/zzinterp.x
new file mode 100644
index 00000000..cd23aaf2
--- /dev/null
+++ b/sys/pmio/zzinterp.x
@@ -0,0 +1,1142 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<fset.h>
+include	<pmset.h>
+include	<plio.h>
+
+.help pmtest
+.nf -------------------------------------------------------------------------
+PMTEST -- PMIO package debug and test facility.
+
+    Due to the complexity of the PMIO package, testing is performed using an
+interactive interpreter which reads commands from the standard input.
+All commands operate internally upon a set of four mask registers A-D,
+and a set of ten vector registers V[0-9].
+
+	a,b,c,d		- mask registers
+	v0,...,v9	- vector registers
+
+The following commands are defined:
+
+	help					# print command summary
+	timer					# toggle timing of commands
+	run fname				# read commands from a file
+	clear					# clear the screen
+	bye					# all done (also EOF)
+
+	create [mask] naxes axlen depth		# create a new mask
+	load [mask] fname			# load mask from file
+	save [mask] fname [title]		# save mask in file
+	loadim [mask] image			# load mask from image
+	saveim [mask] image [title]		# save mask in image
+	erase [mask] [vs ve]			# erase a mask or region
+	draw [mask] [vs ve] [>ofile]		# draw mask or region of mask
+
+	set [mask]				# set reference mask
+	set [vector] i j k...			# load vector register
+	show [vector]				# print vector register
+	show [mask] [index] [ll] [rl] [>ofile]	# print debug info for a mask
+
+	box [mask] P1 P2 rop			# draw a box
+	circle [mask] P1 r rop			# draw a circle
+	line [mask] P1 P2 width rop		# draw a line segment
+	point [mask] P1 rop			# draw a point
+	polygon [mask] P1 ... PN rop		# draw a polygon
+
+	rop src [vs] dst [vs] [vn] rop			# rasterop
+	stencil src [vs] dst [vs] stn [vs] [vn] rop	# stencil
+
+	compare mask1 mask2			# compare two masks
+	rtest mask1 mask2			# range list conversion test
+	ptest mask1 mask2			# pixel array conversion test
+
+Rasterops may be specified either as integer constants (any radix) or via
+a simple symbolic notation, e.g.:  "opcode+[value]".
+
+A mask may be examined in detail with SHOW, which calls pm_debug to decode
+the contents of a mask.  A graphic image of a mask may be drawn with DRAW,
+which renders each pixel in the mask as a printable character.
+.endhelp --------------------------------------------------------------------
+
+define	SZ_SBUF		512			# size limiting parameters
+define	DEF_MASKSIZE_X	75
+define	DEF_MASKSIZE_Y	40
+define	MAXKWLEN	20
+define	MAXARGS		50
+define	MAXMREG		4
+define	MAXVREG		10
+define	MAXINCL		10
+define	WIDTH		80
+
+define	INT_ARG		1			# argument types
+define	STRING_ARG	2
+define	VECTOR_ARG	3
+define	MASK_ARG	4
+
+define	v_i	argval[$1]			# integer argument
+define	v_s	sbuf[argval[$1]]		# string argument
+define	v_si	sbuf[argval[$1]+$2-1]		# indexed string argument
+define	v_v	v_reg[1,argval[$1]+1]		# vector argument
+define	v_vi	v_reg[$2,argval[$1]+1]		# indexed vector argument
+define	v_m	v_mask[argval[$1]]		# mask argument
+
+define	KW_BOX		1			# interpreter commands
+define	KW_BYE		2
+define	KW_CIRCLE	3
+define	KW_CLEAR	4
+define	KW_COMPARE	5
+define	KW_CREATE	6
+define	KW_DRAW		7
+define	KW_ERASE	8
+define	KW_HELP		9
+# eol			10
+define	KW_LINE		11
+define	KW_POINT	12
+define	KW_POLYGON	13
+define	KW_LOAD		14
+define	KW_LOADIM	15
+define	KW_PTEST	16
+define	KW_ROP		17
+define	KW_RTEST	18
+define	KW_RUN		19
+define	KW_SAVE		20
+define	KW_SAVEIM	21
+# eol			22
+define	KW_SET		23
+define	KW_SHOW		24
+define	KW_STENCIL	25
+define	KW_TIMER	26
+
+
+# PMTEST -- Test the PMIO package.  Read and execute commands from the standard
+# input until EOF or BYE is seen.
+
+procedure t_pmtest()
+
+bool	timer
+long	time[2]
+int	x, y, r
+int	px[MAXARGS], py[MAXARGS]
+int	what, rop, v_arg, x1, x2, y1, y2, ip, op, ch, i, j
+pointer	pm, pm_1, pm_2, def_pm, pm_src, pm_dst, pm_stn, tty
+char	cmd[SZ_LINE], kwname[SZ_FNAME], fname[SZ_FNAME], title[SZ_LINE]
+int	opcode, save_fd[MAXINCL], in, fd, o_fd, maskno, depth, naxes, npts
+int	v1[PL_MAXDIM], v2[PL_MAXDIM], v3[PL_MAXDIM], v4[PL_MAXDIM], v[PL_MAXDIM]
+int	fstati(), strdic(), open(), getline(), strncmp()
+pointer	pm_create(), ttyodes()
+
+char	sbuf[SZ_SBUF]
+int	v_mask[MAXMREG], v_reg[PL_MAXDIM,MAXVREG]
+int	nargs, argno, argtype[MAXARGS], argval[MAXARGS], s_op, width
+common	/pmzcom/ v_mask, v_reg, nargs, argno, argtype, argval, s_op, sbuf
+define	argerr_ 91
+define	eof_ 92
+
+string	keywords "|box|bye|circle|clear|compare|create|draw|erase|help|\
+	|line|point|polygon|load|loadim|ptest|rop|rtest|run|save|saveim|\
+	|set|show|stencil|timer|"
+
+begin
+	in = 0
+	ip = 1
+	fd = STDIN
+	cmd[ip] = EOS
+	timer = false
+
+	# Initialize the mask registers.
+	v[1] = DEF_MASKSIZE_X
+	v[2] = DEF_MASKSIZE_Y
+	do i = 1, MAXMREG
+	    v_mask[i] = pm_create (2, v, 7)
+	def_pm = v_mask[1]
+
+	# Initialize the vector registers.
+	do i = 1, MAXVREG
+	    call amovki (1, v_reg[1,i], PL_MAXDIM)
+
+	# Main interpreter loop.
+	# ---------------------------
+
+	repeat {
+	    # Get next command.
+	    if (cmd[ip] == '\n' || cmd[ip] == '#' || cmd[ip] == EOS) {
+		# Prompt if reading from the standard input.
+		if (in == 0 && fstati (STDIN, F_REDIR) == NO) {
+		    call putline (STDOUT, "* ")
+		    call flush (STDOUT)
+		}
+
+		# Handle EOF on the current command stream.
+		if (getline (fd, cmd) == EOF) {
+eof_		    if (in > 0) {
+			call close (fd)
+			fd = save_fd[in]
+			in = in - 1
+		    } else
+			break
+		}
+
+		ip = 1
+	    }
+
+	    # Skip blank lines and comment lines.
+	    for (ip=1;  IS_WHITE(cmd[ip]) || cmd[ip] == ';';  ip=ip+1)
+		;
+	    if (cmd[ip] == '\n' || cmd[ip] == '#' || cmd[ip] == EOS)
+		next
+
+	    # Extract the keyword into the KWNAME buffer.  Leave the input
+	    # pointer positioned to the first char following the keyword.
+
+	    for (op=1;  cmd[ip] != EOS && cmd[ip] != '\n';  ip=ip+1) {
+		ch = cmd[ip]
+		if (IS_ALNUM(ch)) {
+		    kwname[op] = ch
+		    op = op + 1
+		} else
+		    break
+	    }
+	    kwname[op] = EOS
+
+	    # Look up the keyword in the dictionary.  If not found ring the
+	    # bell, but do not quit.
+
+	    opcode = strdic (kwname, kwname, MAXKWLEN, keywords)
+	    if (opcode <= 0) {
+		call eprintf ("unknown command\007\n")
+		call flush (STDERR)
+		ip=1;  cmd[ip] = EOS
+		next
+	    }
+
+	    # Parse the argument list.
+	    call parse_args (cmd, ip)
+
+	    # Process the command.
+	    # -------------------------
+
+	    switch (opcode) {
+	    case KW_BYE:
+		goto eof_
+
+	    case KW_POINT:
+		# Draw a point.
+
+		# Get mask.
+		pm = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get coords of point.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 2
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('1')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_point (pm, x1, y1, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_BOX:
+		# Draw a box.
+
+		# Get mask.
+		pm = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get corner coords of box.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		    if (argtype[argno] != VECTOR_ARG)
+			goto argerr_
+		    x2 = v_vi(argno,1)
+		    y2 = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 4
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		    x2 = v_i(argno);  argno = argno + 1
+		    y2 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('2')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_box (pm, x1, y1, x2, y2, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_LINE:
+		# Draw a line of arbitrary orientation and width.
+
+		# Get mask.
+		pm = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get endpoints of line.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Coords given as vectors.
+		    x1 = v_vi(argno,1)
+		    y1 = v_vi(argno,2)
+		    argno = argno + 1
+		    if (argtype[argno] != VECTOR_ARG)
+			goto argerr_
+		    x2 = v_vi(argno,1)
+		    y2 = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Coords given explicitly.
+		    do i = 1, 4
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x1 = v_i(argno);  argno = argno + 1
+		    y1 = v_i(argno);  argno = argno + 1
+		    x2 = v_i(argno);  argno = argno + 1
+		    y2 = v_i(argno);  argno = argno + 1
+		}
+
+		# Get line width.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    width = v_i(argno);  argno = argno + 1
+		} else
+		    width = 1
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('4')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_line (pm, x1, y1, x2, y2, width, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CIRCLE:
+		# Draw a circle.
+
+		# Get mask.
+		pm = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get center coords and radius of circle.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Center coords given as a vector.
+		    x = v_vi(argno,1)
+		    y = v_vi(argno,2)
+		    argno = argno + 1
+
+		} else {
+		    # Center coords given explicitly.
+		    do i = 1, 2
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+
+		    x = v_i(argno);  argno = argno + 1
+		    y = v_i(argno);  argno = argno + 1
+		}
+
+		if (argtype[argno] != INT_ARG)
+		    goto argerr_
+		r = v_i(argno);  argno = argno + 1
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('Q')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_circle (pm, x, y, r, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_POLYGON:
+		# Draw a polygon.
+
+		# Get mask.
+		pm = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get the coordinates of the polygon.
+		for (npts=0;  argno <= nargs;  ) {
+		    npts = npts + 1
+
+		    if (argtype[argno] == VECTOR_ARG) {
+			# Coords of point given as a vector.
+			px[npts] = v_vi(argno,1)
+			py[npts] = v_vi(argno,2)
+			argno = argno + 1
+
+		    } else if (argtype[argno] == INT_ARG &&
+			argtype[argno+1] == INT_ARG) {
+
+			# Center coords given explicitly.
+			px[npts] = v_i(argno);  argno = argno + 1
+			py[npts] = v_i(argno);  argno = argno + 1
+		    }
+		}
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = or (PIX_SRC, PIX_DST) + PIX_VALUE('R')
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_polygon (pm, px, py, npts, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CLEAR:
+		# Clear the screen.
+		tty = ttyodes ("terminal")
+		call ttyclear (STDOUT, tty)
+		call ttycdes (tty)
+
+	    case KW_COMPARE:
+		# Compare two masks.
+		if (nargs < 2)
+		    goto argerr_
+
+		# Get mask 1.
+		if (argtype[argno] == MASK_ARG) {
+		    pm_1 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Get mask 2.
+		if (argtype[argno] == MASK_ARG) {
+		    pm_2 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_compare (pm_1, pm_2, STDOUT)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_CREATE:
+		# Create a new, emtpy mask of the given size and depth.
+
+		# Get mask.
+		if (argtype[argno] == MASK_ARG) {
+		    maskno = v_i(argno)
+		    argno = argno + 1
+		}
+
+		# Get naxes.
+		if (argtype[argno] != INT_ARG)
+		    goto argerr_
+		naxes = v_i(argno);  argno = argno + 1
+
+		# Get mask size.
+		if (argtype[argno] == VECTOR_ARG) {
+		    # Mask size given as vector.
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else {
+		    # Mask size given explicitly.
+		    do i = 1, naxes {
+			if (argtype[argno+i-1] != INT_ARG)
+			    goto argerr_
+			v1[i] = v_i(argno)
+			argno = argno + 1
+		    }
+		}
+
+		# Get mask depth.
+		if (argtype[argno] != INT_ARG)
+		    depth = 1
+		else {
+		    depth = v_i(argno)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		v_mask[maskno] = pm_create (naxes, v1, depth)
+		def_pm = v_mask[maskno]
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+		
+	    case KW_DRAW:
+		# Draw a mask or region of a mask on the screen.
+
+		# Get mask.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be drawn.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pm,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		call pm_asciidump (pm, v1, v2, STDOUT)
+
+	    case KW_ERASE:
+		# Erase a mask, or a region of a mask.
+
+		# Get mask.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get vector coords of region to be erased.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pm,1), v2, PL_MAXDIM)
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		if (nargs <= 1)
+		    call pm_clear (pm)
+		else
+		    call pm_rop (NULL, 0, pm, v1, v2, PIX_CLR)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_HELP:
+		# Print a command summary.
+		call print_help (STDOUT)
+
+	    case KW_RUN:
+		# Read commands from a file.
+		if (nargs < 1 || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		in = in + 1
+		if (in > MAXINCL)
+		    call error (1, "too many nested run files\n")
+		save_fd[in] = fd
+		iferr (fd = open (v_s(argno), READ_ONLY, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    fd = save_fd[in]
+		    in = in - 1
+		}
+
+	    case KW_SET:
+		# Set the value of a mask or vector register.
+		if (nargs < 1) {
+		    goto argerr_
+
+		} else if (argtype[argno] == MASK_ARG) {
+		    # Set the default mask.
+		    def_pm = v_m(argno)
+		    maskno = v_i(argno)
+
+		} else if (argtype[argno] == VECTOR_ARG) {
+		    # Set a vector register.
+		    v_arg = argno
+		    argno = argno + 1
+
+		    do i = 1, PL_MAXDIM
+			if (argno <= nargs && argtype[argno] == INT_ARG) {
+			    v[i] = v_i(argno)
+			    argno = argno + 1
+			} else
+			    v[i] = 1
+
+		    call amovi (v, v_v(v_arg), PL_MAXDIM)
+		}
+
+	    case KW_SHOW:
+		# Print information about a mask or vector register.
+
+		if (nargs < 1 || argtype[argno] == MASK_ARG) {
+		    # Print information about a mask.
+
+		    if (nargs < 1)
+			pm = def_pm
+		    else {
+			pm = v_m(argno)
+			argno = argno + 1
+		    }
+
+		    o_fd = STDOUT
+
+		    # Process option selects.
+		    what = PD_SUMMARY
+		    while (argno <= nargs && argtype[argno] == STRING_ARG) {
+			if (strncmp (v_s(argno), "i", 1) == 0) {
+			    what = or (what, PD_INDEX)
+			} else if (strncmp (v_s(argno), "ll", 2) == 0) {
+			    what = or (what, PD_LLOUT)
+			} else if (strncmp (v_s(argno), "rl", 2) == 0) {
+			    what = or (what, PD_RLOUT)
+			} else if (strncmp (v_s(argno), "lh", 2) == 0) {
+			    what = or (what, PD_LHDR)
+
+			} else if (v_s(argno) == '>') {
+			    # Write output to a file.
+			    if (v_si(argno,2) == '>') {
+				iferr (o_fd = open (v_si(argno,3),
+				    APPEND, TEXT_FILE)) {
+				    call erract (EA_WARN)
+				    o_fd = STDOUT
+				}
+			    } else {
+				iferr (o_fd = open (v_si(argno,2),
+				    NEW_FILE, TEXT_FILE)) {
+				    call erract (EA_WARN)
+				    o_fd = STDOUT
+				}
+			    }
+			} else {
+			    call eprintf ("unknown option `%s'\n")
+				call pargstr (v_s(argno))
+			}
+			argno = argno + 1
+		    }
+
+		    # Perform the operation.
+		    call pm_debug (pm, o_fd, WIDTH, what)
+		    if (o_fd != STDOUT)
+			call close (o_fd)
+
+		} else if (argtype[argno] == VECTOR_ARG) {
+		    # Print the value of a vector register.
+		    call printf ("v%d: ")
+			call pargi (v_i(argno))
+		    do i = 1, PL_MAXDIM {
+			call printf (" %d")
+			    call pargi (v_vi(argno,i))
+		    }
+		    call printf ("\n")
+
+		} else {
+		    # Print the value of all vector registers.
+		    do j = 1, MAXVREG {
+			call printf ("v%d: ")
+			    call pargi (j-1)
+			do i = 1, PL_MAXDIM {
+			    call printf (" %d")
+				call pargi (v_reg(i,j))
+			}
+			call printf ("\n")
+		    }
+		}
+
+	    case KW_LOAD:
+		# Load a mask from a file.
+
+		# Get mask to be loaded.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get mask filename.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pm_loadf (pm, v_s(argno), title, SZ_LINE))
+		    call erract (EA_WARN)
+		else if (title[1] != EOS) {
+		    call printf ("mask: %s\n")
+			call pargstr (title)
+		    call flush (STDOUT)
+		}
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SAVE:
+		# Save a mask in a file.
+
+		# Get mask to be saved.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get mask filename.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+		else {
+		    call strcpy (v_s(argno), fname, SZ_FNAME)
+		    argno = argno + 1
+		}
+
+		# Get title string.
+		if (argno <= nargs && argtype[argno] == STRING_ARG) {
+		    call strcpy (v_s(argno), title, SZ_LINE)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pm_savef (pm, fname, title, 0))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_LOADIM:
+		# Load a mask from an image.
+
+		# Get mask to be loaded.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get image section.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pm_loadim (pm, v_s(argno), title, 0))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_SAVEIM:
+		# Save a mask in an image.
+
+		# Get mask to be saved.
+		pm = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get output image name.
+		if (argno > nargs || argtype[argno] != STRING_ARG)
+		    goto argerr_
+		else {
+		    call strcpy (v_s(argno), fname, SZ_FNAME)
+		    argno = argno + 1
+		}
+
+		# Get title string.
+		if (argno <= nargs && argtype[argno] == STRING_ARG) {
+		    call strcpy (v_s(argno), title, SZ_LINE)
+		    argno = argno + 1
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		iferr (call pm_saveim (pm, fname, title, 0))
+		    call erract (EA_WARN)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_ROP:
+		# General rasterop operation.
+
+		# Get source mask.
+		pm_src = def_pm
+		if (argtype[argno] == MASK_ARG) {
+		    pm_src = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in source mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Get destination mask.
+		pm_dst = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm_dst = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in destination mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v2, PL_MAXDIM)
+
+		# Get vector defining size of region to be modified.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v3, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pm_dst,1), v3, PL_MAXDIM)
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else
+		    rop = PIX_SRC
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_rop (pm_src, v1, pm_dst, v2, v3, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_STENCIL:
+		# Rasterop operation though a stencil mask.
+
+		# Get source mask.
+		pm_src = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm_src = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in source mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v1, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v1, PL_MAXDIM)
+
+		# Get destination mask.
+		pm_dst = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm_dst = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in destination mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v2, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v2, PL_MAXDIM)
+
+		# Get stencil mask.
+		pm_stn = def_pm
+		if (nargs >= 1 && argtype[argno] == MASK_ARG) {
+		    pm_stn = v_m(argno)
+		    argno = argno + 1
+		}
+
+		# Get start vector in stencil mask.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v3, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovki (1, v3, PL_MAXDIM)
+
+		# Get vector defining size of region to be modified.
+		if (argtype[argno] == VECTOR_ARG) {
+		    call amovi (v_v(argno), v4, PL_MAXDIM)
+		    argno = argno + 1
+		} else
+		    call amovi (PL_AXLEN(pm_dst,1), v4, PL_MAXDIM)
+
+		# Get rop.
+		if (argno <= nargs) {
+		    if (argtype[argno] != INT_ARG)
+			goto argerr_
+		    rop = v_i(argno);  argno = argno + 1
+		} else {
+		    call eprintf ("no rop specified - copying src to dst\n")
+		    rop = PIX_SRC
+		}
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call pm_stencil (pm_src, v1, pm_dst, v2, pm_stn, v3, v4, rop)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_PTEST, KW_RTEST:
+		# Line list to pixel array or range list conversion test.
+		if (nargs < 2)
+		    goto argerr_
+
+		# Get mask 1.
+		if (argtype[argno] == MASK_ARG) {
+		    pm_1 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Get mask 2.
+		if (argtype[argno] == MASK_ARG) {
+		    pm_2 = v_m(argno)
+		    argno = argno + 1
+		} else
+		    goto argerr_
+
+		# Perform the operation.
+		if (timer)
+		    call sys_mtime (time)
+		call conv_test (pm_1, pm_2, STDOUT, opcode)
+		if (timer)
+		    call sys_ptime (STDOUT, "", time)
+
+	    case KW_TIMER:
+		if (timer) {
+		    call printf ("timer off\n")
+		    timer = false
+		} else {
+		    call printf ("timer on\n")
+		    timer = true
+		}
+
+	    default:
+		# Unrecognized command.
+		call eprintf ("unknown switch\007\n")
+		call flush (STDERR)
+	    }
+
+	    call flush (STDOUT)
+	    next
+argerr_
+	    call eprintf ("invalid argument list\n")
+	}
+
+	do i = 1, MAXMREG
+	    call pm_close (v_mask[i])
+end
+
+
+# PARSE_ARGS -- Parse the argument list to an interpreter command, leaving
+# the decoded arguments in the interpreter common, and returning the number
+# of arguments as the function value.
+
+procedure parse_args (args, ip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer into argument list
+
+double	dval
+int	nchars, junk, i
+int	ctowrd(), stridx(), gctod(), strlen()
+
+char	sbuf[SZ_SBUF]
+int	v_mask[MAXMREG], v_reg[PL_MAXDIM,MAXVREG]
+int	nargs, argno, argtype[MAXARGS], argval[MAXARGS], s_op
+common	/pmzcom/ v_mask, v_reg, nargs, argno, argtype, argval, s_op, sbuf
+
+begin
+	s_op = 1
+	argno = 1
+	nargs = 0
+
+	do i = 1, MAXARGS
+	    argtype[i] = 0
+
+	# Get next token.
+	junk = ctowrd (args, ip, sbuf[s_op], SZ_SBUF-s_op)
+	nchars = strlen (sbuf[s_op])
+
+	while (nchars > 0) {
+	    nargs = nargs + 1
+	    if (nargs > MAXARGS)
+		call error (1, "too many arguments")
+
+	    if (nchars == 1 && sbuf[s_op] == '=') {
+		# Discard assignment operator.
+		nargs = nargs - 1
+
+	    } else if (nchars == 1 && stridx (sbuf[s_op], "abcd") > 0) {
+		# Mask register.
+		argval[nargs] = stridx (sbuf[s_op], "abcd")
+		argtype[nargs] = MASK_ARG
+
+	    } else if (nchars == 2 && sbuf[s_op] == 'v' &&
+		# Vector register.
+		IS_DIGIT(sbuf[s_op+1])) {
+		argval[nargs] = TO_INTEG(sbuf[s_op+1])
+		argtype[nargs] = VECTOR_ARG
+
+	    } else if (IS_DIGIT (sbuf[s_op])) {
+		# Get an integer constant.
+		i=1;  nchars = gctod (sbuf[s_op], i, dval)
+		argval[nargs] = nint(dval)
+		argtype[nargs] = INT_ARG
+
+		# Handle the notation "opcode+value", for rasterops.
+		if (sbuf[s_op+i-1] == '+') {
+		    i=i+1;  nchars = gctod (sbuf[s_op], i, dval)
+		    argval[nargs] = argval[nargs] + PIX_VALUE(nint(dval))
+		}
+
+	    } else {
+		# String constant.
+		argval[nargs] = s_op
+		argtype[nargs] = STRING_ARG
+		s_op = s_op + nchars + 1
+	    }
+
+	    while (IS_WHITE(args[ip]))
+		ip = ip + 1
+	    if (args[ip] == ';' || args[ip] == '\n') {
+		ip = ip + 1
+		break
+	    }
+
+	    # Get next token.
+	    junk = ctowrd (args, ip, sbuf[s_op], SZ_SBUF-s_op)
+	    nchars = strlen (sbuf[s_op])
+	}
+end
+
+
+# CONV_TEST -- Test the line list to pixel array or range list conversion
+# routines.
+
+procedure conv_test (pm_1, pm_2, fd, opcode)
+
+pointer	pm_1			#I input mask
+pointer	pm_2			#I output mask
+int	fd			#I output file, for reporting errors
+int	opcode			#I KW_[PR]TEST
+
+begin
+	call fprintf (fd, "conv_test called\n")
+end
+
+
+# PRINT_HELP -- Print the PMIO test interpreter commands help summary.
+
+procedure print_help (fd)
+
+int	fd			#I output file
+
+begin
+	call fprintf (fd, "help%48t# print command summary\n")
+	call fprintf (fd, "timer%48t# toggle timing of commands\n")
+	call fprintf (fd, "run fname%48t# read commands from a file\n")
+	call fprintf (fd, "clear%48t# clear the screen\n")
+	call fprintf (fd, "bye%48t# all done (also EOF)\n\n")
+	call fprintf (fd,
+	"create [mask] naxes axlen [depth]%48t# create a new mask\n")
+	call fprintf (fd, "load [mask] fname%48t# load mask from file\n")
+	call fprintf (fd, "save [mask] fname%48t# save mask in file\n")
+	call fprintf (fd, "loadim [mask] image%48t# load mask from image\n")
+	call fprintf (fd, "saveim [mask] image%48t# save mask in image\n")
+	call fprintf (fd, "erase [mask] [vs ve]%48t# erase a mask or region\n")
+	call fprintf (fd,
+	"draw [mask] [vs ve] [>ofile]%48t# draw mask or region of mask\n\n")
+	call fprintf (fd, "set [mask]%48t# set reference mask\n")
+	call fprintf (fd, "set [vector] i j k...%48t# load vector register\n")
+	call fprintf (fd, "show [vector]%48t# print vector register\n")
+	call fprintf (fd,
+"show [mask] [index] [ll] [rl] [>ofile]%48t# print debug info for a mask\n\n")
+	call fprintf (fd, "box P1 P2 rop%48t# draw a box\n")
+	call fprintf (fd, "circle P1 r rop%48t# draw a circle\n \n")
+	call fprintf (fd,
+	"line [mask] P1 P2 width rop%48t# draw a line segment\n")
+	call fprintf (fd, "point [mask] P1 rop%48t# draw a point\n")
+	call fprintf (fd, "polygon [mask] P1 ... PN rop%48t# draw a polygon\n")
+	call fprintf (fd, "rop src [vs] dst [vs] [vn] rop%48t# rasterop\n")
+	call fprintf (fd,
+	"stencil src [vs] dst [vs] stn [vs] [vn] rop%48t# stencil\n \n")
+	call fprintf (fd, "compare mask1 mask2%48t# compare two masks\n")
+	call fprintf (fd, "rtest mask1 mask2%48t# range list conversion test\n")
+	call fprintf (fd,
+	"ptest mask1 mask2%48t# pixel array conversion test\n")
+end
diff --git a/sys/psio/README b/sys/psio/README
new file mode 100644
index 00000000..a1786fd7
--- /dev/null
+++ b/sys/psio/README
@@ -0,0 +1,339 @@
+PSIO -- The Postscript I/O package.
+
+	The PSIO interface is used to format a block of text as Postscript
+output on a page of a given size (Letter, Legal, A4 or B5).  Once initialized
+by a ps_open() call, programs can set various options related to the page
+size or properties, preferred fonts, etc.  Output is begun with a call to
+the ps_write_prolog() routine to initialize the PS prolog.  Afterwards,
+text may be fed to a buffer using ps_deposit() to fill the output page to
+a right justified margin, inserting linebreaks where needed.  Other routines
+permit specific linebreaks or text positioning as required.
+
+
+1) PSIO Interface Summary
+-------------------------
+
+		     include  <psset.h>
+
+		ps = ps_open  (fd, default_footer)
+	          ps_setfont  (ps, font)
+	        ps_page_size  (ps, page)
+	        ps_font_size  (ps, font_size)
+		   ps_header  (ps, ledge, center, redge)
+		   ps_footer  (ps, ledge, center, redge)
+	       ps_setmargins  (ps, left, right, top, bottom)
+	     ps_write_prolog  (ps)
+		    ps_close  (ps)
+
+	             ps_xpos  (ps, xpos)
+	             ps_ypos  (ps, ypos)
+	           ps_indent  (ps, nchars)
+	         ps_testpage  (ps, nlines)
+	          ps_deposit  (ps, line)
+	        ps_linebreak  (ps, fill_flag)
+	        ps_pagebreak  (ps, fill_flag)
+	          ps_newline  (ps)
+	           ps_output  (ps, line)
+	           ps_center  (ps, line)
+	     ps_rightjustify  (ps, text)
+
+	width = ps_textwidth  (ps, string)
+	  pos = ps_centerpos  (ps, text)
+	      pos = ps_rjpos  (ps, text)
+
+
+
+2) PSIO Interface Description
+-----------------------------
+
+    ps = ps_open (fd, default_footer)
+	Initialize the PS structure with default page size and margins,
+	set output file descriptor. Returns the PS struct pointer initialized
+	with defaults.  If the 'default_footer' int flag is enabled a default
+	footer containing the string "NOAO/IRAF" in the bottom left corner,
+	the IRAF version string in the center, and the page number in the 
+	bottom right will be created for each page.  Otherwise only a page
+	number will appear unless a different footer is defined with the
+	ps_footer() command.
+
+
+    ps_setfont (ps, font)
+	Set the current font to be used.  Allowable values for 'font' are set
+	in the <psset.h> include file as
+
+	    define F_ROMAN         1           	# times-roman font
+	    define F_ITALIC        2           	# times-roman italic font
+	    define F_BOLD          3           	# times-roman bold font
+	    define F_TELETYPE      4           	# fixed-width font
+	    define F_PREVIOUS      5           	# previous font
+
+	The default font will be a 10-point Times-Roman.
+
+    ps_font_size (ps, font_size)
+	Set the font size in points to be used.  Font sizes are not changeable
+	once the interface has been opened so this routine must be called
+	before the Postscript prolog is written.
+
+    ps_page_size (ps, page)
+
+	Set the default page size to be used.  Allowable values for 'page'
+	are set in the <psset.h> include file as
+
+	    define PAGE_LETTER     1        # US Letter (612x792  @ 300 dpi)
+	    define PAGE_LEGAL      2	    # US Legal  (612x1008 @ 300 dpi)
+	    define PAGE_A4         3	    # A4 size   (595x850  @ 300 dpi)
+	    define PAGE_B5         4	    # B5 size   (524x765  @ 300 dpi)
+
+	The default page size will be US Letter but can be overridden in the
+	environment by defining a 'pspage' variable as e.g.
+
+	    cl> reset pspage = "legal"
+
+    ps_header (ps, ledge, center, redge)
+	Set header text tags.  The header will appear on each page, empty
+	strings are allowed to indicate no text is to be written in that
+	part of the header.
+
+    ps_footer (ps, ledge, center, redge)
+	Set footer text tags.  The footer will appear on each page, empty
+	strings are allowed to indicate no text is to be written in that
+	part of the header.  A running page number will always be written
+	to the 'redge' field unless a non-empty value is defined, a white-
+	space character can be used to indicate no text should be written
+	to that part of the footer.
+
+    ps_setmargins (ps, left, right, top, bottom)
+	Set/Change page margins from defaults set by ps_open().  Values are
+	defined in units of inches given as a floating point number.
+
+    ps_write_prolog (ps)
+	Write the PS prolog given the current postscript struct.  This
+	initializes a flag preventing subsequent changes from taking effect
+	once called.
+
+    ps_close (ps)
+	Close the struct, flush the page, and free memory
+
+
+    ps_xpos (ps, xpos)
+    ps_ypos (ps, ypos)
+	Set current X or Y position on page
+
+    ps_indent  (ps, nchars)
+	Set a temporary indenture of the page from the permanent left margin.
+	Value is given as a number of fixed-width characters, negative values
+	are not permitted, a value of zero may be used to reset to the left
+	margin.
+	         
+    ps_testpage  (ps, nlines)
+	Test whether the output is within the specified number of line of
+	the end of the page, if so do a page break.  This routine can be used
+	to force a page break when a certain number of lines is to be reserved
+	to e.g. keep a group of text together on a page.
+
+    ps_deposit (ps, line)
+	Deposit a line of text to the output buffer.  When the output width
+	exceeds the permanent right margin the line is flushed to the output
+	file and the x-position reset to the current left margin, the y-pos
+	is moved to the next line determined by the font size.   Remaining
+	words in the line buffer to added to the next line buffer. 
+	    Width of the line is computed from the width of each word plus
+	a space char, including font changes.  The line buffer outputs each
+	word plus spacing individually,  font changes are handled in the
+	output routine.
+
+    ps_linebreak (ps, fill_flag)
+	Break the current line regardless of whether it has been filled.  
+	The int 'fill_flag' says whether to fill the current line to be right 
+	justified.  May be called to simply flush the current line buffer.
+
+    ps_output (ps, line, fill_flag)
+	Output the given line and break, fill to be right justified if the
+	int 'fill_flag' is set.
+	
+    ps_center (ps, line)
+	Center the line on the page and break.
+
+    ps_rightjustify (ps, text)
+	Right justfify text on the current line.
+
+
+    width = ps_textwidth (ps, string)
+	Get the width of the given string.  Width is returned in terms of
+	Postscript pixels assuming a 72 point, 300 dpi page.
+
+    pos = ps_centerpos (ps, text)
+    pos = ps_rjpos (ps, text)
+	Get the X position of the centered and right-justified strings.
+
+
+3) Postscript Prolog
+--------------------
+
+	Example prolog for the postscript output.  The actual prolog is
+created based on parameters specified such as the page size, header/footer
+text, etc.  Lines with '***' indicate those which are set dependent upon 
+PS structure values.
+
+
+%!PS-Adobe-1.0
+%%Creator: IRAF postscript translator
+%%CreationDate: Wed May 19 14:34:47 1999
+%%Pages: (atend)
+%%DocumentFonts: (atend)
+%%EndComments
+%%BeginProlog
+
+/inch	{ 72 mul    } def		% 72 points per inch
+/PL 	{ 792  	    } def		% set page height	     	   ***
+/FtrY	{ 20	    } def		% footer Y position
+/HdrY	{ PL 40 sub } def		% header Y position
+/xOrg	72 	   def			% 1 inch left margin         	   ***
+/yOrg	720    	   def			% 1 inch top margin          	   ***
+/yDelta 12 	   def			% line spacing		     	   ***
+/Line	1 	   def			% line number
+/Page	0 	   def			% page number
+/pnum   4 string   def			% sizeof page number cvs buffer
+/res	10.00	   def			% pixel resolution factor    	   ***
+
+/TA { 	newpath 			% Draw a box around our text
+    xOrg yOrg moveto 			% area as a debugging procedure.
+       0 -664 rlineto                   %                                  ***
+     467    0 rlineto                   %                                  ***
+       0  664 rlineto                   %                                  ***
+    closepath 
+    stroke
+} bind def
+
+/FS 	{ findfont exch scalefont } bind def 	% find and scale a font
+/Fonts [					% create an array of fonts
+    10 /Times-Roman FS 				%		     	   ***
+    10 /Times-Bold FS 				%		     	   ***
+    10 /Times-Italic FS 			%			   ***
+    10 /Courier FS 				%			   ***
+    12 /Times-Bold FS 				%		     	   ***
+] def
+/R  {	Fonts 0 get setfont } bind def 		% set roman font
+/B  {	Fonts 1 get setfont } bind def 		% set bold font
+/I  {	Fonts 2 get setfont } bind def 		% set italic font
+/T  {	Fonts 3 get setfont } bind def 		% set teletype font
+/H  {	Fonts 4 get setfont } bind def 		% set header font
+
+/NL {	Line 1 add SL 	} bind def 		% newline
+/H  {	res div 
+	currentpoint exch pop 
+	moveto 		} def			% horizontal position
+/S  {	exch H show 	} bind def 		% show
+/SL {	/Line exch def 				% set line position
+	xOrg yOrg Line yDelta mul sub moveto
+} bind def
+
+
+/BP {	 					% Begin page (header).
+    xOrg HdrY moveto R (TEE \(Nov97\)) show	% write the header         ***
+     280 HdrY moveto R (system) show            %                          ***
+     485 HdrY moveto R (TEE \(Nov97\)) show     %                          ***
+    1 SL R
+} bind def
+
+/EP {	     					% End page (footer).
+    /Page Page 1 add def			% increment page number
+    xOrg FtrY moveto R (NOAO/IRAF) show	% write the footer                 ***
+    250  FtrY moveto R (IRAF V2.11 May 1997) show                          ***
+    530  FtrY moveto R Page pnum cvs show                                  ***
+    showpage					% show the page
+} bind def
+
+%%EndProlog
+%%Page: 1 1
+%-----------------------------------------------------------------------------
+
+initgraphics
+TA
+BP
+	...<postscript generated by translator>...
+EP
+	...<repeat above as needed>...
+
+% end of listing
+%%Trailer
+%%DocumentFonts: Times-Roman Times-Bold Times-Italic Courier
+%%Pages: <N>								   ***
+
+
+
+4) Example Program
+------------------
+
+include <time.h>
+include <psset.h>
+
+task   pstest        = t_pstest
+
+# PSTEST -- Test the PSIO package.  This test program pretty-prints a file
+# with a header message and page number suitable for output to a printer.
+
+procedure t_pstest()
+
+pointer	ps
+int     fd, ip, op
+char    fname[SZ_FNAME], date[SZ_TIME], line[SZ_LINE], outline[SZ_LINE]
+
+pointer ps_open()
+int     open(), getline()
+long    clktime()
+
+begin
+        # Get the file to format and date string.
+        call clgstr ("filename", fname, SZ_FNAME)
+        call cnvtime (clktime(0), date, SZ_TIME)
+
+        # Open the file.
+        fd = open (fname, READ_ONLY, TEXT_FILE)
+
+        # Initialize the PSIO interface.
+        ps = ps_open (STDOUT, NO)
+        call ps_header (ps, fname, "NOAO/IRAF", date)
+        call ps_footer (ps, "PSIO Test Page", "", "")
+        call ps_write_prolog (ps)
+
+        # Output the text in a fixed-width font.
+        call ps_setfont (ps, F_TELETYPE)
+
+        call ps_linebreak (ps, NO)
+        while (getline (fd, line) != EOF) {
+	
+            if (line[1] == EOS) {
+		# Simple break on a newline.
+                call ps_linebreak (ps, NO)
+
+            } else {
+	        # Detab the line.
+	        ip = 1
+	        op = 1
+                while (line[ip] != EOS && op <= SZ_LINE) {
+                    if (line[ip] == '\t') {
+                        repeat {
+                            outline[op] = ' '
+                            op = op + 1
+                        } until (mod(op,8) == 1)
+                        ip = ip + 1
+                    } else {
+                        outline[op] = line [ip]
+                        ip = ip + 1
+                        op = op + 1
+                    }
+                }
+                outline[op] = EOS
+
+                # Output the line and a newline.
+                call ps_output (ps, outline, NO)            
+                call ps_newline (ps)
+            }
+        }
+
+        # Close the file and PSIO interface.
+        call close (fd)
+        call ps_close (ps)
+end
+
diff --git a/sys/psio/font.com b/sys/psio/font.com
new file mode 100644
index 00000000..30ae823e
--- /dev/null
+++ b/sys/psio/font.com
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FONT.COM -- Character width font tables.  Each array contains the width
+# of ASCII chars 32 (space) thru 126 (~) expressed as 10 times the width 
+# in pixels as drawn on a 300dpi page.  This allows us to compute fractional
+# pixels when placing strings.
+#
+# The default font chosen is a 10-point Times-Roman in normal, bold and italic.
+# Other font sizes chosen will be scaled from these values.  Fixed width fonts
+# don't need width tables and are defined in the PSTOOLS.H file.
+
+# Set an alias for the width of a space char so we can change it easily
+# in the package include and not forget about it here.
+define	SW	SPACE_WIDTH
+
+# Declare the width tables.
+int	i
+short	roman[96], bold[96], italic[96]	
+
+
+# Times-Roman 10-point normal.
+data	(roman(i), i= 1, 7)  /  SW,  33,  41,  50,  50,  83,  78/
+data	(roman(i), i= 8,14)  /  33,  33,  33,  50,  56,  25,  33/
+data	(roman(i), i=15,21)  /  25,  28,  50,  50,  50,  50,  50/
+data	(roman(i), i=22,28)  /  50,  50,  50,  50,  50,  28,  28/
+data	(roman(i), i=29,35)  /  56,  56,  56,  44,  92,  72,  67/
+data	(roman(i), i=36,42)  /  67,  72,  61,  56,  72,  72,  33/
+data	(roman(i), i=43,49)  /  39,  72,  61,  89,  72,  72,  56/
+data	(roman(i), i=50,56)  /  72,  67,  56,  61,  72,  72,  94/
+data	(roman(i), i=57,63)  /  72,  72,  61,  33,  28,  33,  47/
+data	(roman(i), i=64,70)  /  50,  33,  44,  50,  44,  50,  44/
+data	(roman(i), i=71,77)  /  33,  50,  50,  28,  28,  50,  28/
+data	(roman(i), i=78,84)  /  78,  50,  50,  50,  50,  33,  39/
+data	(roman(i), i=85,91)  /  28,  50,  50,  72,  50,  50,  44/
+data	(roman(i), i=92,96)  /  48,  20,  48,  54, 0/
+
+# Times-Roman 10-point bold.
+data	(bold(i), i= 1, 7)   /  SW,  33,  56,  50,  50, 100,  83/
+data	(bold(i), i= 8,14)   /  33,  33,  33,  50,  57,  25,  33/
+data	(bold(i), i=15,21)   /  25,  28,  50,  50,  50,  50,  50/
+data	(bold(i), i=22,28)   /  50,  50,  50,  50,  50,  33,  33/
+data	(bold(i), i=29,35)   /  57,  57,  57,  50,  93,  72,  67/
+data	(bold(i), i=36,42)   /  72,  72,  67,  61,  78,  78,  39/
+data	(bold(i), i=43,49)   /  50,  78,  67,  94,  72,  78,  61/
+data	(bold(i), i=50,56)   /  78,  72,  56,  67,  72,  72, 100/
+data	(bold(i), i=57,63)   /  72,  72,  67,  33,  28,  33,  58/
+data	(bold(i), i=64,70)   /  50,  33,  50,  56,  44,  56,  44/
+data	(bold(i), i=71,77)   /  33,  50,  56,  28,  33,  56,  28/
+data	(bold(i), i=78,84)   /  83,  56,  50,  56,  56,  44,  39/
+data	(bold(i), i=85,91)   /  33,  56,  50,  72,  50,  50,  44/
+data	(bold(i), i=92,96)   /  39,  22,  39,  52, 0/
+
+# Times-Roman 10-point italic.
+data	(italic(i), i= 1, 7) /  SW,  33,  42,  50,  50,  83,  78/
+data	(italic(i), i= 8,14) /  33,  33,  33,  50,  68,  25,  33/
+data	(italic(i), i=15,21) /  25,  28,  50,  50,  50,  50,  50/
+data	(italic(i), i=22,28) /  50,  50,  50,  50,  50,  33,  33/
+data	(italic(i), i=29,35) /  68,  68,  68,  50,  92,  61,  61/
+data	(italic(i), i=36,42) /  67,  72,  61,  61,  72,  72,  33/
+data	(italic(i), i=43,49) /  44,  67,  56,  83,  67,  72,  61/
+data	(italic(i), i=50,56) /  72,  61,  50,  56,  72,  61,  83/
+data	(italic(i), i=57,63) /  61,  56,  56,  39,  28,  39,  42/
+data	(italic(i), i=64,70) /  50,  33,  50,  50,  44,  50,  44/
+data	(italic(i), i=71,77) /  28,  50,  50,  28,  28,  44,  28/
+data	(italic(i), i=78,84) /  72,  50,  50,  50,  50,  39,  39/
+data	(italic(i), i=85,91) /  28,  50,  44,  67,  44,  44,  39/
+data	(italic(i), i=92,96) /  40,  27,  40,  54, 0/
+
diff --git a/sys/psio/mkpkg b/sys/psio/mkpkg
new file mode 100644
index 00000000..8c5fa1e8
--- /dev/null
+++ b/sys/psio/mkpkg
@@ -0,0 +1,29 @@
+# Make the PSIO interface library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+
+zzdebug:
+zzdebug.e:
+        $set    XFLAGS = "$(XFLAGS) -q"
+        $omake  zzdebug.x psio.h <psset.h> <time.h>
+        $link   zzdebug.o -o zzdebug.e
+        ;
+
+libsys.a:
+        psbreak.x       psio.h <psset.h>
+        pscenter.x      psio.h
+        psclose.x       psio.h
+        psdeposit.x     psio.h <ctype.h>
+        psfont.x        psio.h <psset.h>
+        psjustify.x     psio.h
+        psopen.x        psio.h <psset.h>
+        psoutput.x      psio.h <ctype.h> <psset.h>
+        pspos.x 	psio.h
+        psprolog.x      psio.h
+        pssetup.x       psio.h <psset.h>
+        pswidth.x       psio.h font.com <ctype.h> <psset.h>
+	;
diff --git a/sys/psio/psbreak.x b/sys/psio/psbreak.x
new file mode 100644
index 00000000..eb82b541
--- /dev/null
+++ b/sys/psio/psbreak.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <psset.h>
+include "psio.h"
+
+
+# PS_LINEBREAK -- Break the current line regardless of whether it has been
+# filled.  The fill_flag says whether to fill the current line to be right 
+# justified.  May be called to simply output the current line buffer.
+
+procedure ps_linebreak (ps, fill_flag)
+
+pointer	ps					#I PSIO descriptor
+int	fill_flag				#I fill line flag
+
+begin
+	iferr (call ps_output (ps, Memc[PS_WBPTR(ps)], fill_flag))
+	    return
+
+	# Do a variable spacing depending on whether we're within unformatted
+	# text where the font is smaller, or outputting a regular line.
+
+	if (PS_CFONT(ps) == F_TELETYPE)
+            PS_YPOS(ps) = PS_YPOS(ps) - ((LINE_HEIGHT-2) * RESOLUTION)
+	else 
+            PS_YPOS(ps) = PS_YPOS(ps) - (LINE_HEIGHT * RESOLUTION)
+
+	# Check for a page break.
+        if (PS_YPOS(ps) <= PS_PBMARGIN(ps))
+            call ps_pagebreak (ps)
+	else {
+	    call fprintf (PS_FD(ps), "%d V\n")
+	        call pargi (PS_YPOS(ps))
+	}
+
+        # Reset the X position to current left margin.
+        PS_XPOS(ps) = PS_CLMARGIN(ps)
+
+	# Clear the word buffer.
+	call aclrc (Memc[PS_WBPTR(ps)], SZ_LINE)
+end
+
+
+# PS_NEWLINE -- Output a newline (vertical space actually).
+
+procedure ps_newline (ps)
+
+pointer	ps					#I PSIO descriptor
+
+begin
+	# Check for a page break.
+        PS_YPOS(ps) = PS_YPOS(ps) - ((LINE_HEIGHT-4) * RESOLUTION)
+        if (PS_YPOS(ps) <= PS_PBMARGIN(ps))
+            call ps_pagebreak (ps)
+	else {
+	    call fprintf (PS_FD(ps), "%d V\n")
+	        call pargi (PS_YPOS(ps))
+	}
+
+        # Reset the X position to current left margin.
+        PS_XPOS(ps) = PS_CLMARGIN(ps)
+end
+
+
+# PS_PAGEBREAK -- Break the current page regardless of whether it has been
+# filled.
+
+procedure ps_pagebreak (ps)
+
+pointer	ps					#I PSIO descriptor
+
+begin
+	PS_PNUM(ps) = PS_PNUM(ps) + 1
+	call fprintf (PS_FD(ps), "EP\n%%%%Page: %d %d\nBP\n")
+	    call pargi (PS_PNUM(ps))
+	    call pargi (PS_PNUM(ps))
+
+	PS_YPOS(ps) = (PS_PHEIGHT(ps) * RESOLUTION) - PS_PTMARGIN(ps)
+	call ps_ypos (ps, PS_YPOS(ps))
+end
diff --git a/sys/psio/pscenter.x b/sys/psio/pscenter.x
new file mode 100644
index 00000000..818c33cb
--- /dev/null
+++ b/sys/psio/pscenter.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_CENTER -- Center the string on the page and break.
+
+procedure ps_center (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text string
+
+int	mtemp, ps_centerPos()
+errchk	ps_centerpos, ps_output
+
+begin
+	mtemp = PS_CLMARGIN(ps)
+	PS_CLMARGIN(ps) = ps_centerpos (ps, str)
+	call ps_output (ps, str, NO)
+	PS_CLMARGIN(ps) = mtemp
+end
+
+
+# PS_CENTERPOS -- Get the X position of the centered string.
+
+int procedure ps_centerpos (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char    str[ARB]                             	#I string to center
+
+int	ps_textwidth()
+errchk	ps_textwidth
+
+begin
+	return (((PS_PWIDTH(ps) * RESOLUTION)/2) - ps_textwidth (ps, str) / 2)
+end
diff --git a/sys/psio/psclose.x b/sys/psio/psclose.x
new file mode 100644
index 00000000..ba0d694e
--- /dev/null
+++ b/sys/psio/psclose.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_CLOSE -- Close the struct and free memory.
+
+procedure ps_close (ps)
+
+pointer	ps					#I PSIO descriptor
+
+errchk	mfree
+
+begin
+	# Write the page trailer.
+	call ps_trailer(ps)
+
+	call mfree (PS_HLE(ps), TY_CHAR)
+	call mfree (PS_HCE(ps), TY_CHAR)
+	call mfree (PS_HRE(ps), TY_CHAR)
+	call mfree (PS_FLE(ps), TY_CHAR)
+	call mfree (PS_FCE(ps), TY_CHAR)
+	call mfree (PS_FRE(ps), TY_CHAR)
+	call mfree (PS_WBPTR(ps), TY_CHAR)
+
+	call mfree (ps, TY_STRUCT)
+end
diff --git a/sys/psio/psdeposit.x b/sys/psio/psdeposit.x
new file mode 100644
index 00000000..a3df3ea9
--- /dev/null
+++ b/sys/psio/psdeposit.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include "psio.h"
+
+
+# PS_DEPOSIT -- Deposit a line of text to the output buffer.  When the output
+# width exceeds the permanent right margin the line us flushed to the output
+# file and the x-position reset to the current left margin, the y-pos is 
+# moved to the next line dependent on the font size.   Remaining words in the
+# line buffer to added to the next line buffer. 
+
+procedure ps_deposit (ps, line)
+
+pointer	ps					#I PSIO descriptor
+char	line[ARB]				#I text line
+
+char	word[SZ_FNAME]
+pointer	wbuf, wp
+int	i, ip, start_ip
+int	len, width, curpos, rmargin
+
+int	strlen(), ps_textwidth(), ps_chwidth()
+errchk	ps_chwidth, ps_textwidth, ps_linebreak
+
+begin
+	# Process the line, collect all the words that will fit on the
+	# line and add to the word buffer.  When the line fills output
+	# it, otherwise fill the buffer.
+
+	wbuf = PS_WBPTR(ps)
+	wp = PS_WBPTR(ps) + strlen (Memc[wbuf])
+	curpos = PS_CLMARGIN(ps) + ps_textwidth (ps, Memc[wbuf])
+	rmargin = PS_CRMPOS(ps)
+	len = strlen (line)
+
+	# Trim trailing whitespace or newlines.
+	for ( ; IS_WHITE(line[len]) || line[len] == '\n'; len=len-1)
+	    line[len] = EOS
+
+	# Take care of any leading whitespace.  Tabs are treated as
+	# spaces, we assume the caller has 'detabbed' the line before
+	# we are called.
+	for (ip=1; IS_WHITE(line[ip]); ip=ip+1)
+	    width = width + ps_chwidth (line[ip], PS_CFONT(ps))
+	if (PS_JUSTIFY(ps) == NO)
+	    curpos = curpos + width
+
+	# Process the rest of the line.
+	for (; ip <= len; ip=ip+1) {
+
+	    # Get the next word on the line and it's length.
+	    start_ip = ip
+	    for (i=1; !IS_WHITE(line[ip]) && line[ip] != EOS; i=i+1) {
+		word[i] = line[ip]
+		ip = ip + 1
+	    }
+	    word[i] = EOS
+	    len = ps_textwidth (ps, word)
+
+	    if (curpos + len > rmargin) {
+		# We would overflow the line so break it here.
+		len = strlen (Memc[wbuf])
+		Memc[wbuf+len-1] = EOS
+		call ps_linebreak (ps, PS_JUSTIFY(ps))
+
+		call aclrc (Memc[wbuf], SZ_FNAME)
+		call strcpy (line[start_ip], Memc[wbuf], SZ_LINE)
+		call strcat (" ", Memc[wbuf], SZ_LINE)
+		return
+
+	    } else {
+		# Copy the word to the buffer and update the position.
+		call strcat (word, Memc[wbuf], SZ_LINE)
+		curpos = curpos + len
+	 	wp = wp + strlen (word)
+	    }
+
+	    # Get the spaces between words.
+	    for (; IS_WHITE(line[ip]) && line[ip] != EOS; ip=ip+1) {
+		curpos = curpos + ps_chwidth (line[ip], PS_CFONT(ps))
+		Memc[wp] = line[ip]
+		wp = wp + 1
+	    }
+
+	    if (line[ip] == EOS)
+		break
+	    else
+	        ip = ip - 1
+	}
+
+	call strcat (" ", Memc[wbuf], SZ_LINE)
+	PS_XPOS(ps) = curpos
+end
diff --git a/sys/psio/psfont.x b/sys/psio/psfont.x
new file mode 100644
index 00000000..ca91b719
--- /dev/null
+++ b/sys/psio/psfont.x
@@ -0,0 +1,145 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_SETFONT -- Set the font to be used.
+
+procedure ps_setfont (ps, font)
+
+pointer	ps					#I PSIO descriptor
+int	font					#I font type
+
+int	old_font
+char	old_font_ch, ps_fontchar()
+errchk	syserr
+
+begin
+	old_font = PS_CFONT(ps)
+	old_font_ch = PS_CFONT_CH(ps)
+
+	switch (font) {
+	case F_ROMAN:
+	    PS_CFONT(ps) = F_ROMAN
+	    PS_CFONT_CH(ps) = 'R'
+	    call fprintf (PS_FD(ps), "R ")
+	case F_ITALIC:
+	    PS_CFONT(ps) = F_ITALIC
+	    PS_CFONT_CH(ps) = 'I'
+	    call fprintf (PS_FD(ps), "I ")
+	case F_BOLD:
+	    PS_CFONT(ps) = F_BOLD
+	    PS_CFONT_CH(ps) = 'B'
+	    call fprintf (PS_FD(ps), "B ")
+	case F_TELETYPE:
+	    PS_CFONT(ps) = F_TELETYPE
+	    PS_CFONT_CH(ps) = 'T'
+	    call fprintf (PS_FD(ps), "T ")
+	case F_PREVIOUS:
+	    if (PS_SFONT(ps) != NULL) {
+	        call fprintf (PS_FD(ps), "%c ")
+		    call pargc (ps_fontchar (ps, PS_SFONT(ps)))
+	    } else {
+	        call fprintf (PS_FD(ps), "%c ")
+		    call pargc (ps_fontchar (ps, PS_PFONT(ps)))
+	    }
+	default:
+	    call syserr (SYS_PSFONT)
+	}
+
+	PS_PFONT(ps) = old_font
+	PS_PFONT_CH(ps) = old_font_ch
+end
+
+
+# PS_SPFONT -- Set the special font to be used.
+
+procedure ps_spfont (ps, font)
+
+pointer	ps					#I PSIO descriptor
+int	font					#I font type
+
+errchk	syserr
+
+begin
+	if (font == NULL) {
+	    PS_SFONT(ps) = NULL
+	    PS_SFONT_CH(ps) = EOS
+	    call fprintf (PS_FD(ps), "R ")
+	    return
+	}
+
+	switch (font) {
+	case F_ROMAN:
+	    PS_SFONT(ps) = F_ROMAN
+	    PS_SFONT_CH(ps) = 'R'
+	    call fprintf (PS_FD(ps), "R ")
+	case F_ITALIC:
+	    PS_SFONT(ps) = F_ITALIC
+	    PS_SFONT_CH(ps) = 'I'
+	    call fprintf (PS_FD(ps), "I ")
+	case F_BOLD:
+	    PS_SFONT(ps) = F_BOLD
+	    PS_SFONT_CH(ps) = 'B'
+	    call fprintf (PS_FD(ps), "B ")
+	case F_TELETYPE:
+	    PS_SFONT(ps) = F_TELETYPE
+	    PS_SFONT_CH(ps) = 'T'
+	    call fprintf (PS_FD(ps), "T ")
+	default:
+	    call syserr (SYS_PSSPFONT)
+	}
+end
+
+
+# PS_GETFONT -- Given the font character in a "\fN" string return the font
+# type code. 
+
+int procedure ps_getfont (ps, font_char)
+
+pointer	ps					#I PSIO descriptor
+char	font_char				#I font type character
+
+begin
+	switch (font_char) {
+	case 'R':
+	    return (F_ROMAN)
+	case 'B':
+	    return (F_BOLD)
+	case 'I':
+	    return (F_ITALIC)
+	case 'T':
+	    return (F_TELETYPE)
+	case 'P':
+	    return (F_PREVIOUS)
+	default:
+	    return (PS_CFONT(ps))
+	}
+end
+
+
+# PS_FONTCHAR -- Given the font code return the character for it.
+
+char procedure ps_fontchar (ps, font)
+
+pointer	ps					#I PSTIO descriptor
+int	font					#I font type character
+
+begin
+	switch (font) {
+	case F_ROMAN:
+	    return ('R')
+	case F_BOLD:
+	    return ('B')
+	case F_ITALIC:
+	    return ('I')
+	case F_TELETYPE:
+	    return ('T')
+	case F_PREVIOUS:
+	    return ('P')
+	default:
+	    return (PS_CFONT_CH(ps))
+	}
+end
diff --git a/sys/psio/psio.h b/sys/psio/psio.h
new file mode 100644
index 00000000..418b05bc
--- /dev/null
+++ b/sys/psio/psio.h
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PSIO.H -- Private definitions for the PSIO interface.
+
+# Page size definitions.
+define  LETTER_WIDTH    612             # resolutions at 72 points (300 dpi)
+define  LETTER_HEIGHT   792
+define  LEGAL_WIDTH     612
+define  LEGAL_HEIGHT    1008
+define  A4_WIDTH        595
+define  A4_HEIGHT       850
+define  B5_WIDTH        524
+define  B5_HEIGHT       765
+
+# Font definitions.
+define  FIXED_WIDTH     54              # width of a courier 9-pt font
+define  SPACE_WIDTH     30              # width of a 10-point space character
+define  FONT_SIZE	10              # default font size (points)
+define  START_CH	32              # width table start character
+define  END_CH		128             # width table end character
+define  LINE_HEIGHT	12              # height of a line (points)
+
+define  RESOLUTION      10              # pixel resolution scale factor
+define  PPI             72              # points-per-inch
+
+# Default margins.
+define  TMARGIN         1.25             # default margins (inches)
+define  BMARGIN         1.0
+define  LMARGIN         1.0
+define  RMARGIN         1.0
+
+
+# The main PSIO data structure.
+define	LEN_PSSTRUCT	45
+define	SZ_WORD		128
+
+define	PS_FD		Memi[$1+00]	# output file descriptor
+define	PS_INITIALIZED	Memi[$1+01]	# prolog written flag
+define	PS_NUMBER	Memi[$1+02]	# number pages?
+define	PS_PNUM		Memi[$1+03]	# current page number
+define	PS_JUSTIFY	Memi[$1+04]	# text justification flag
+
+define	PS_PAGE		Memi[$1+06]	# page size 	    (letter|legal|a4|b5)
+define	PS_PWIDTH	Memi[$1+07]	# page width	    (points)
+define	PS_PHEIGHT	Memi[$1+08]	# page height	    (points)
+define	PS_FONTSZ	Memi[$1+09]	# default font size (points)
+
+define	PS_PLMARGIN	Memi[$1+10]	# perm. L margin    (pixres)
+define	PS_PRMARGIN	Memi[$1+11]	# perm. R margin    (pixres)
+define	PS_PTMARGIN	Memi[$1+12]	# perm. L margin    (pixres)
+define	PS_PBMARGIN	Memi[$1+13]	# perm. R margin    (pixres)
+define	PS_CLMARGIN	Memi[$1+14]	# current L margin  (pixres)
+define	PS_CRMARGIN	Memi[$1+15]	# current R margin  (pixres)
+define	PS_PRMPOS	Memi[$1+16]	# perm R margin pos (pixres)
+define	PS_CRMPOS	Memi[$1+17]	# cur. R margin pos (pixres)
+define	PS_CURPOS	Memi[$1+18]	# current page pos  (pixres)
+
+define	PS_LMARGIN	Memr[P2R($1+20)]# left margin	    (inches)
+define	PS_RMARGIN	Memr[P2R($1+21)]# right margin	    (inches)
+define	PS_TMARGIN	Memr[P2R($1+22)]# top margin	    (inches)
+define	PS_BMARGIN	Memr[P2R($1+23)]# bottom margin	    (inches)
+
+define	PS_HLE		Memi[$1+25]	# header left edge tag str
+define	PS_HCE		Memi[$1+26]	# header center tag str
+define	PS_HRE		Memi[$1+27]	# header right edge tag str
+define	PS_FLE		Memi[$1+28]	# footer left edge tag str
+define	PS_FCE		Memi[$1+29]	# footer center tag str
+define	PS_FRE		Memi[$1+30]	# footer right edge tag str
+
+define	PS_WBPTR	Memi[$1+31]	# word buffer ptr
+
+# Runtime descriptor.
+define  PS_XPOS         Memi[$1+35]     # current page X position
+define  PS_YPOS         Memi[$1+36]     # current page Y position
+define  PS_CFONT        Memi[$1+37]     # current font type
+define  PS_PFONT        Memi[$1+38]     # previous font
+define  PS_SFONT        Memi[$1+39]     # special font (forced)
+define  PS_CFONT_CH     Memi[$1+40]     # current font code char
+define  PS_PFONT_CH     Memi[$1+41]     # special font code char
+define  PS_SFONT_CH     Memi[$1+42]     # special font code char
+define  PS_LINE_WIDTH   Memi[$1+43]     # current allowable line (points)
+
+
+# Utility shorthand macros.
+define	HLEDGE	     Memc[PS_HLE($1)]	# Header tag strings
+define	HCENTER	     Memc[PS_HCE($1)]
+define	HREDGE	     Memc[PS_HRE($1)]
+define	FLEDGE	     Memc[PS_FLE($1)]	# Footer tag strings
+define	FCENTER	     Memc[PS_FCE($1)]
+define	FREDGE	     Memc[PS_FRE($1)]
diff --git a/sys/psio/psjustify.x b/sys/psio/psjustify.x
new file mode 100644
index 00000000..367cc6fe
--- /dev/null
+++ b/sys/psio/psjustify.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_RIGHTJUSTIFY -- Right justfify text on the given string and break.
+
+procedure ps_rightjustify (ps, str)
+
+pointer ps                                      #I PSIO descriptor
+char    str[ARB]                                #I text line
+
+int     mtemp, ps_rjPos()
+errchk	ps_output
+
+begin
+	mtemp = PS_CLMARGIN(ps)
+        PS_CLMARGIN(ps) = ps_rjpos (ps, str)
+	call ps_output (ps, str, NO)
+	PS_CLMARGIN(ps) = mtemp
+end
+
+
+# PS_RJPOS -- Get the X position of the right-justified string.
+
+int procedure ps_rjpos (ps, str)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text to justify
+
+int	ps_textwidth()
+errchk	ps_textwidth
+
+begin
+	return (PS_CRMPOS(ps) - ps_textwidth (ps, str))
+end
+
+
+# PS_SET_JUSTIFY -- Set the justification flag.
+
+procedure ps_setjustify (ps, justify)
+
+pointer	ps					#I PSIO descriptor
+int	justify					#I justificaton flag
+
+begin
+	PS_JUSTIFY(ps) = justify
+end
diff --git a/sys/psio/psopen.x b/sys/psio/psopen.x
new file mode 100644
index 00000000..289fafcc
--- /dev/null
+++ b/sys/psio/psopen.x
@@ -0,0 +1,107 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <psset.h>
+include "psio.h"
+
+define	PSPAGE_ENV	"pspage"
+
+
+# PS_OPEN -- Initialize the PSTOOLS structure.
+
+pointer procedure ps_open (fd, default_footer)
+
+int	fd					#I output file descriptor
+int	default_footer				#I option flags
+
+pointer	ps
+int	scale
+char	page[SZ_FNAME], version[SZ_FNAME]
+int	envgets()
+bool	streq()
+errchk	calloc, syserr
+
+begin
+	# Allocate the structure.
+	iferr {
+	    call calloc (ps, LEN_PSSTRUCT, TY_STRUCT)
+
+	    call calloc (PS_HLE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_HCE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_HRE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FLE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FCE(ps), SZ_WORD, TY_CHAR)
+	    call calloc (PS_FRE(ps), SZ_WORD, TY_CHAR)
+	
+	    call calloc (PS_WBPTR(ps), SZ_LINE, TY_CHAR)
+	} then
+	    call syserr (SYS_PSOPEN)
+
+	# Set the output file descriptor
+	PS_FD(ps) = fd
+
+	# Initialize default values of the struct.
+	call aclrc (page, SZ_FNAME)
+	if (envgets (PSPAGE_ENV, page, SZ_FNAME) != 0) {
+	    call strlwr (page)
+	    if (streq (page, "letter"))
+	        call ps_page_size (ps, PAGE_LETTER)
+	    else if (streq (page, "legal"))
+	        call ps_page_size (ps, PAGE_LEGAL)
+	    else if (streq (page, "a4"))
+	        call ps_page_size (ps, PAGE_A4)
+	    else if (streq (page, "b5"))
+	        call ps_page_size (ps, PAGE_B5)
+	} else
+	    call ps_page_size (ps, PAGE_LETTER)
+
+	PS_FONTSZ(ps)	= FONT_SIZE		# default font size
+	PS_JUSTIFY(ps)	= YES			# justify text?
+
+	# Set the margin values.
+	scale = PPI * RESOLUTION
+	PS_PLMARGIN(ps)	= LMARGIN * scale	# perm. L margin     (points)
+	PS_PRMARGIN(ps)	= RMARGIN * scale	# perm. R margin     (points)
+	PS_PTMARGIN(ps)	= TMARGIN * scale	# perm. T margin     (points)
+	PS_PBMARGIN(ps)	= BMARGIN * scale	# perm. B margin     (points)
+
+	PS_CLMARGIN(ps)	= PS_PLMARGIN(ps)	# current L margin   (points)
+	PS_CRMARGIN(ps)	= PS_PRMARGIN(ps)	# current R margin   (points)
+
+	# Set the right margin in pixel coords.
+	PS_CRMPOS(ps)   = (PS_PWIDTH(ps) * RESOLUTION) - PS_CRMARGIN(ps)
+	PS_PRMPOS(ps)   = PS_CRMPOS(ps)
+	PS_CURPOS(ps)   = PS_PLMARGIN(ps)
+
+	PS_LMARGIN(ps)	= LMARGIN		# page left margin   (inches)
+	PS_RMARGIN(ps)	= RMARGIN		# page right margin  (inches)
+	PS_TMARGIN(ps)	= TMARGIN		# page top margin    (inches)
+	PS_BMARGIN(ps)	= BMARGIN		# page bottom margin (inches)
+
+	PS_XPOS(ps)	= PS_PLMARGIN(ps)
+	PS_YPOS(ps)	= (RESOLUTION * PS_PHEIGHT(ps)) - PS_PTMARGIN(ps)
+
+	PS_CFONT(ps)	= F_ROMAN		# font initializations
+	PS_PFONT(ps)	= F_ROMAN
+	PS_SFONT(ps)	= NULL
+	PS_CFONT_CH(ps)	= 'R'
+	PS_SFONT_CH(ps)	= EOS
+
+	# Compute the width of the line.
+	PS_LINE_WIDTH(ps) = (PS_PWIDTH(ps) * RESOLUTION) - 
+	    PS_PLMARGIN(ps) - PS_PRMARGIN(ps) 
+
+	# Set the footer flags.
+	PS_PNUM(ps) = 1
+	PS_NUMBER(ps) = YES
+	if (default_footer == YES) {
+	    call aclrc (version, SZ_FNAME)
+	    if (envgets ("version", version, SZ_FNAME) != 0)
+		call strcpy (version, FLEDGE(ps), SZ_FNAME)
+	    else
+	        call strcpy ("NOAO/IRAF", FLEDGE(ps), SZ_WORD)
+	    call strcpy (" ", FCENTER(ps), SZ_FNAME)
+	} 
+
+	return (ps)
+end
diff --git a/sys/psio/psoutput.x b/sys/psio/psoutput.x
new file mode 100644
index 00000000..e94cd8c9
--- /dev/null
+++ b/sys/psio/psoutput.x
@@ -0,0 +1,199 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_OUTPUT -- Output the given line and break, fill if requested.
+
+procedure ps_output (ps, str, fill_flag)
+
+pointer	ps					#I PSIO descriptor
+char	str[ARB]				#I text string to write
+int	fill_flag				#I fill line flag
+
+char	ch, word[SZ_FNAME]
+int	fd, last_nscan, ip, op, curpos
+int	i, spacing, nspaces, nwords, ngaps, twidth, len
+int	ps_textwidth(), strmatch(), strlen()
+errchk	ps_wrtblock, ps_textwidth
+
+define	break_	99
+
+begin
+	# Idiot check.
+	if (str[1] == EOS)
+	    return
+
+	if (PS_INITIALIZED(ps) == NO)
+	    call ps_write_prolog (ps)
+
+	# Initialize.
+	fd = PS_FD(ps)
+	curpos = PS_CLMARGIN(ps)
+	last_nscan = 0
+
+        # Trim trailing whitespace or newlines.
+        len = strlen (str)
+        for ( ; IS_WHITE(str[len]) || str[len] == '\n'; len=len-1)
+            str[len] = EOS
+
+	if (fill_flag == NO && strmatch(str, "\\\\f?") != 0) {
+	    # No font changes or filling, just dump it as one string.
+	    call ps_wrtblock (ps, curpos, str)
+	    return
+	}
+
+	# Get the number of words in the line.
+	nspaces = 0
+	for (ip=1; str[ip] != EOS; ip=ip+1) {
+	    if (IS_WHITE(str[ip]) && !IS_WHITE(str[ip+1]))
+	        nspaces = nspaces + 1
+	}
+	nwords = nspaces + 1
+	ngaps = max (1, nspaces)
+	twidth = ps_textwidth (ps, str)
+
+	# Calculate the inter-word spacing.
+	if (PS_CFONT(ps) == F_TELETYPE)
+	    spacing = FIXED_WIDTH
+	else
+	    spacing = SPACE_WIDTH
+
+	if (fill_flag == YES)
+	    spacing = spacing + (PS_LINE_WIDTH(ps) - twidth) / ngaps
+
+	# Set the base font for the line
+	if (PS_SFONT(ps) != NULL)
+	    ch = PS_SFONT_CH(ps)
+	else
+	    ch = PS_CFONT_CH(ps)
+	call fprintf (fd, "%c\n")
+	    call pargc (ch)
+
+	# Process the words on the line.
+	ip = 1
+	do i = 1, nwords {
+
+	    if (str[ip] == EOS)
+		break
+
+	    # Collect chars up to the end of the word.
+	    for (op=1; str[ip] != EOS && str[ip] != ' '; op=op+1) {
+		word[op] = str[ip]
+		ip = ip + 1
+	    }
+	    word[op] = EOS
+	    twidth = ps_textwidth (ps, word)
+
+	    # if we're filling, force the right-justification of the last
+	    # word to cover for any roundoff in the spacing computation.
+	    if (fill_flag == YES && i == nwords)
+	    	curpos = PS_CRMPOS(ps) - twidth
+
+	    # Write it out, handling font changes.
+	    if (op > 1)
+	        call ps_wrtblock (ps, curpos, word)
+
+	    # Increment the position for the next word.
+	    curpos = curpos + twidth
+
+	    # Increment for the spaces between words.
+	    for ( ; IS_WHITE(str[ip]) && str[ip] != EOS; ip=ip+1)
+	        curpos = curpos + spacing
+	}
+end
+
+
+# PS_WRTBLOCK -- Write a block of text at the given position.  We escape the
+# parenthesis here since they were needed in computing the width.
+
+procedure ps_wrtblock (ps, curpos, str)
+
+pointer	ps					#I PSIO descriptor
+int	curpos					#I X position of text
+char	str[ARB]				#I string to write
+
+char	word[SZ_WORD], line[SZ_LINE]
+int	i, fd, ip, pos, st, en, gstrmatch()
+int	ps_textwidth(), ps_getfont()
+errchk	ps_setfont, ps_textwidth
+
+begin
+	fd = PS_FD(ps)
+
+	call aclrc (word, SZ_WORD)
+	call aclrc (line, SZ_LINE)
+
+	if (gstrmatch (str, "\\\\f?", st, en) == 0) {
+	    # No font changes so just output the word.
+	    call ps_escText (str, line, SZ_LINE)
+	    call fprintf (fd, "%d (%s) S\n")
+		call pargi (curpos)
+		call pargstr (line)
+
+	} else {
+	    # We have a font change.  Collect all chars up to the font change
+	    # and output as an atom.  Change the font, and repeat until we
+	    # use up the string.
+
+	    pos = curpos
+	    i = 1
+	    for (ip=1; str[ip] != EOS; ip=ip+1) {
+		if (str[ip] == '\\' && str[ip+1] == 'f') {
+		    if (word[1] != EOS) {
+			word[i] = EOS
+	    		call ps_esctext (word, line, SZ_LINE)
+	    		call fprintf (fd, "%d (%s) S\n")
+			    call pargi (pos)
+			    call pargstr (line)
+			pos = pos + ps_textwidth (ps, word)
+		    }
+		    iferr (call ps_setfont (ps, ps_getfont(ps, str[ip+2])))
+		        break;
+		    ip = ip + 2
+		    i = 1
+		    word[1] = EOS
+	 	} else {
+		    word[i] = str[ip]
+		    i = i + 1
+		}
+	    }
+ 	    word[i] = EOS
+
+	    if (word[1] != EOS) {
+    		call ps_esctext (word, line, SZ_LINE)
+    		call fprintf (fd, "%d (%s) S\n")
+		    call pargi (pos)
+		    call pargstr (line)
+		pos = pos + ps_textwidth (ps, word)
+	    }
+	}
+end
+
+
+# PS_ESCTEXT -- Escape the parenthesis in a text string.
+
+procedure ps_esctext (in, out, maxch)
+
+char	in[ARB]					#I input text
+char	out[ARB]				#O output text
+int	maxch					#I max characters
+
+int	ip, op
+
+begin
+	ip = 1
+	op = 1
+	while (in[ip] != EOS) {
+	    if (in[ip] == '(' || in[ip] == ')' || in[ip] == '\\') {
+		out[op] = '\\'
+		op = op + 1
+	    }
+	    out[op] = in[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	out[op] = EOS
+end
diff --git a/sys/psio/pspos.x b/sys/psio/pspos.x
new file mode 100644
index 00000000..55a918c1
--- /dev/null
+++ b/sys/psio/pspos.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_XPOS -- Set current X position on page.
+
+procedure ps_xpos (ps, xpos)
+
+pointer	ps					#I PSIO descriptor
+int	xpos					#I position
+
+begin
+	PS_XPOS(ps) = xpos
+	call fprintf (PS_FD(ps), "%d H\n")
+	    call pargi (PS_XPOS(ps))
+end
+
+
+# PS_YPOS -- Set current Y position on page.
+
+procedure ps_ypos (ps, ypos)
+
+pointer	ps					#I PSIO descriptor
+int	ypos					#I position
+
+begin
+	PS_YPOS(ps) = ypos
+	call fprintf (PS_FD(ps), "%d V\n")
+	    call pargi (PS_YPOS(ps))
+end
+
+
+# PS_INDENT -- Set current left margin defined as a number of fixed width
+# characters from the permanent left margin.
+
+procedure ps_indent (ps, nchars)
+
+pointer	ps					#I PSIO descriptor
+int	nchars					#I position
+
+begin
+	PS_CLMARGIN(ps) = PS_PLMARGIN(ps) + max(0,nchars) * FIXED_WIDTH
+	PS_LINE_WIDTH(ps) = (PS_PWIDTH(ps) * RESOLUTION) - 
+                                PS_CLMARGIN(ps) - PS_PRMARGIN(ps) 
+end
+
+
+# PS_TESTPAGE -- Test whether we are within the given number of lines from
+# the bottom of the page, if so break.
+
+procedure ps_testpage (ps, nlines)
+
+pointer	ps					#I PSIO descriptor
+int	nlines					#I position
+
+int	nleft
+
+begin
+	nleft = nlines * LINE_HEIGHT * RESOLUTION
+	if ((PS_YPOS(ps) - PS_PBMARGIN(ps)) < nleft)
+	    call ps_pagebreak (ps)
+end
diff --git a/sys/psio/psprolog.x b/sys/psio/psprolog.x
new file mode 100644
index 00000000..79ed63c1
--- /dev/null
+++ b/sys/psio/psprolog.x
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "psio.h"
+
+
+# PS_WRITE_PROLOG -- Write the PS prolog given the current postscript struct.
+# This initializes a flag keeping other changes from taking effect once
+# this is called.
+
+procedure ps_write_prolog (ps)
+
+pointer	ps					#I PSIO descriptor
+
+int	fd, sz_font
+char	buf[SZ_LINE]
+
+int	itoc(), ps_centerPos(), ps_rjPos()
+long	clktime()
+
+begin
+	fd = PS_FD(ps)
+	call cnvtime (clktime(long(0)), buf, SZ_LINE)
+
+	# Write the header stuff.
+	call fprintf (fd, "%%!PS-Adobe-1.0\n")
+	call fprintf (fd, "%%%%Creator: IRAF PostScript Translator\n")
+	call fprintf (fd, "%%%%CreationDate: %s\n") 	; call pargstr (buf)
+	call fprintf (fd, "%%%%Pages: (atend)\n")
+	call fprintf (fd, "%%%%DocumentFonts: (atend)\n")
+	call fprintf (fd, "%%%%EndComments\n")
+	call fprintf (fd, "%%%%BeginProlog\n")
+
+
+	# Initialize page values.
+	call fprintf (fd,
+	    "/inch\t{ 72 mul \t} def\t\t\t%% 72 points per inch\n")
+	call fprintf (fd,
+	    "/PL \t{ %d  \t\t} def\t\t\t%% set page height\n")
+	    call pargi (PS_PHEIGHT(ps))
+	call fprintf (fd,
+	    "/FtrY\t{ 20  \t\t} def\t\t\t%% footer Y position\n")
+	call fprintf (fd,
+	    "/HdrY\t{ PL 40 sub  \t} def\t\t\t%% header Y position\n")
+	call fprintf (fd,
+	    "/xOrg\t%d \t   def\t\t\t\t%% left margin (inches)\n")
+	    call pargi (PS_PLMARGIN(ps))
+	call fprintf (fd,
+	    "/yOrg\t%d \t   def\t\t\t\t%% top margin (inches)\n")
+	    call pargi (PS_PTMARGIN(ps))
+	call fprintf (fd,
+	    "/Page\t0 \t   def\t\t\t\t%% page number\n")
+	call fprintf (fd,
+	    "/pnum\t4 string def\t\t\t\t%% sizeof pnum cvs buffer\n")
+	call fprintf (fd,
+	    "/res\t%4.2f\tdef\t\t\t\t%% pixel resolution factor\n")
+	    call pargi (RESOLUTION)
+	call fprintf (fd, "\n")
+
+
+	# Create the font array to be used.
+	sz_font = PS_FONTSZ(ps)
+	call fprintf (fd, "/FS \t{ findfont exch scalefont } bind def ")
+	call fprintf (fd, "\t%% find and scale a font\n")
+	call fprintf (fd, "/Fonts [\t\t\t\t\t%% create an array of fonts\n")
+	call fprintf (fd, "\t%d /Times-Roman FS\n")  ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Times-Bold FS\n")   ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Times-Italic FS\n") ; call pargi (sz_font)
+	call fprintf (fd, "\t%d /Courier FS\n")      ; call pargi (sz_font-1)
+	call fprintf (fd, "\t11 /Times-Bold FS\n")   
+	    if (sz_font >= 6 && sz_font <= 10)
+		call pargi (sz_font+2)
+	    else
+		call pargi (sz_font)
+	call fprintf (fd, "] def\n")
+
+	# Set the fonts.
+	call fprintf (fd,
+	    "/SF { setfont       \t} bind def\n")
+	call fprintf (fd,
+	    "/R  { Fonts 0 get SF\t} bind def\t\t%% roman font\n")
+	call fprintf (fd,
+	    "/B  { Fonts 1 get SF\t} bind def\t\t%% bold font\n")
+	call fprintf (fd,
+	    "/I  { Fonts 2 get SF\t} bind def\t\t%% italic font\n")
+	call fprintf (fd,
+	    "/T  { Fonts 3 get SF\t} bind def\t\t%% teletype font\n")
+	call fprintf (fd,
+	    "/HD { Fonts 4 get SF\t} bind def\t\t%% header font\n")
+
+	# Define line motion bindings.
+	call fprintf (fd, "/H  { res div\n")
+	call fprintf (fd, "\tcurrentpoint exch pop\n")
+	call fprintf (fd, "\tmoveto \t\t} def\t\t\t%% horizontal position\n")
+	call fprintf (fd, "/V  { res div\n")
+	call fprintf (fd, "\tcurrentpoint pop exch\n")
+	call fprintf (fd, "\tmoveto \t\t} def\t\t\t%% vertical position\n")
+	call fprintf (fd, "/S  { exch H show\t} bind def\t\t%% show\n")
+
+
+	# Write the page header routine.
+	call fprintf (fd, "/BP {\t\t\t\t\t\t%% Begin page (header).\n")
+	if (HLEDGE(ps) != EOS) {
+	    call fprintf (fd, "\txOrg %d div HdrY moveto B (%s) show\n")
+		call pargi (RESOLUTION)
+		call pargstr (HLEDGE(ps))
+	}
+	if (HCENTER(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div HdrY moveto B (%s) show\n")
+		call pargi (ps_centerPos(ps, HCENTER(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (HCENTER(ps))
+	}
+	if (HREDGE(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div HdrY moveto B (%s) show\n")
+		call pargi (ps_rjPos(ps, HREDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (HREDGE(ps))
+	}
+	call fprintf (fd, "\txOrg yOrg moveto\n")
+	call fprintf (fd, "} bind def\n")
+
+
+	# Write the page footer routine.
+	call fprintf (fd, "/EP {\t\t\t\t\t\t%% End page (footer).\n")
+	call fprintf (fd,
+	    "\t/Page Page 1 add def\t\t\t%% increment page number\n")
+	if (FLEDGE(ps) != EOS) {
+	    call fprintf (fd, "\txOrg %d div FtrY moveto R (%s) show\n")
+		call pargi (RESOLUTION)
+		call pargstr (FLEDGE(ps))
+	}
+	if (FCENTER(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div FtrY moveto R (%s) show\n")
+		call pargi (ps_centerPos(ps, FLEDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (FCENTER(ps))
+	}
+	if (PS_NUMBER(ps) == YES) {
+	    if (itoc (PS_PNUM(ps), buf, SZ_LINE) != 0) {
+		call fprintf (fd,
+		    "\t%d %d div FtrY moveto R Page pnum cvs show\n")
+		    call pargi (ps_rjPos(ps, buf))
+		    call pargi (RESOLUTION)
+	    }
+	} else if (FREDGE(ps) != EOS) {
+	    call fprintf (fd, "\t%d %d div FtrY moveto R (%s) show\n")
+		call pargi (ps_rjPos(ps, FREDGE(ps)))
+		call pargi (RESOLUTION)
+		call pargstr (FREDGE(ps))
+	}
+	call fprintf (fd, "\tshowpage\t\t\t\t%% show the page\n")
+	call fprintf (fd, "} bind def\n")
+
+
+	# Finish the prolog header and flush the output.
+	call fprintf (fd, "%%%%EndProlog\n")
+	call fprintf (fd, "%%%%Page: 1 1\n")
+	call fprintf (fd, "%%----------\n")
+	call fprintf (fd, "initgraphics\n")
+	call fprintf (fd, "R\n")
+	call fprintf (fd, "BP\n")
+	call flush (fd)
+
+	# Set the flag indicating we've written the prolog
+	PS_INITIALIZED(ps) = YES
+end
+
+
+# PS_TRAILER - Write the postscript trailer.
+
+procedure ps_trailer (ps)
+
+pointer	ps					#I PSIO descriptor
+
+int	fd
+
+begin
+	fd = PS_FD(ps)
+
+	call fprintf (fd, "EP\n")
+	call fprintf (fd, "%% end of document\n")
+	call fprintf (fd, "%%%%Trailer\n")
+	call fprintf (fd, "%%%%DocumentFonts: ")
+	call fprintf (fd, "Times-Roman Times-Bold Times-Italic Courier\n")
+	call fprintf (fd, "%%%%Pages: %d\n")
+	    call pargi(PS_PNUM(ps))
+
+	call flush (fd)
+end
diff --git a/sys/psio/pssetup.x b/sys/psio/pssetup.x
new file mode 100644
index 00000000..3afe6644
--- /dev/null
+++ b/sys/psio/pssetup.x
@@ -0,0 +1,132 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <psset.h>
+include "psio.h"
+
+
+# PS_PAGE_SIZE -- Set the page size (letter|legal|a4|b5).
+
+procedure ps_page_size (ps, page)
+
+pointer	ps					#I PSIO descriptor
+int	page					#I page type
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (page >= PAGE_LETTER && page <= PAGE_B5) {
+	    switch (page) {
+	    case PAGE_LETTER:
+	        PS_PAGE(ps)    = PAGE_LETTER
+	        PS_PWIDTH(ps)  = LETTER_WIDTH
+	        PS_PHEIGHT(ps) = LETTER_HEIGHT
+	    case PAGE_LEGAL:
+	        PS_PAGE(ps)    = PAGE_LEGAL
+	        PS_PWIDTH(ps)  = LEGAL_WIDTH
+	        PS_PHEIGHT(ps) = LEGAL_HEIGHT
+	    case PAGE_A4:
+	        PS_PAGE(ps)    = PAGE_A4
+	        PS_PWIDTH(ps)  = A4_WIDTH
+	        PS_PHEIGHT(ps) = A4_HEIGHT
+	    case PAGE_B5:
+	        PS_PAGE(ps)    = PAGE_B5
+	        PS_PWIDTH(ps)  = B5_WIDTH
+	        PS_PHEIGHT(ps) = B5_HEIGHT
+	    default:
+	        call eprintf (
+		    "Warning (PSIO): attempt to set illegal page size.")
+	    }
+	}
+end
+
+
+# PS_FONT_SIZE -- Set the default font size to use (default = 10 points).
+
+procedure ps_font_size (ps, font_size)
+
+pointer	ps					#I PSIO descriptor
+int	font_size				#I default font size
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	PS_FONTSZ(ps) = font_size
+end
+
+
+# PS_HEADER -- Set the header tag strings.
+
+procedure ps_header (ps, ledge, center, redge)
+
+pointer	ps					#I PSIO descriptor
+char	ledge[ARB]				#I left edge text
+char	center[ARB]				#I center text
+char	redge[ARB]				#I right edge text
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (ledge[1] != EOS)
+	    call strcpy (ledge, HLEDGE(ps), SZ_WORD)
+	if (center[1] != EOS)
+	    call strcpy (center, HCENTER(ps), SZ_WORD)
+	if (redge[1] != EOS)
+	    call strcpy (redge, HREDGE(ps), SZ_WORD)
+end
+
+
+# PS_FOOTER -- Set the footer tag strings.
+
+procedure ps_footer (ps, ledge, center, redge)
+
+pointer	ps					#I PSIO descriptor
+char	ledge[ARB]				#I left edge text
+char	center[ARB]				#I center text
+char	redge[ARB]				#I right edge text
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	if (ledge[1] != EOS)
+	    call strcpy (ledge, FLEDGE(ps), SZ_WORD)
+	if (center[1] != EOS)
+	    call strcpy (center, FCENTER(ps), SZ_WORD)
+	if (redge[1] != EOS) {
+	    call strcpy (redge, FREDGE(ps), SZ_WORD)
+	    PS_NUMBER(ps) = NO
+	}
+end
+
+
+# PS_SETMARGINS -- Set the permanent page margins (in inches).
+
+procedure ps_setmargins (ps, left, right, top, bottom)
+
+pointer	ps					#I PSIO descriptor
+real	left, right, top, bottom		#I margins
+
+int	scale
+
+begin
+	if (PS_INITIALIZED(ps) == YES)
+	    return
+
+	PS_LMARGIN(ps)	= left
+	PS_RMARGIN(ps)	= right
+	PS_TMARGIN(ps)	= top
+	PS_BMARGIN(ps)	= bottom
+
+        # Set the margin values.
+        scale = PPI * RESOLUTION
+        PS_PLMARGIN(ps) = left * scale       	# perm. L margin     (points)
+        PS_PRMARGIN(ps) = right * scale       	# perm. R margin     (points)
+        PS_PTMARGIN(ps) = top * scale       	# perm. T margin     (points)
+        PS_PBMARGIN(ps) = bottom * scale       	# perm. B margin     (points)
+
+        PS_CLMARGIN(ps) = PS_PLMARGIN(ps)       # current L margin   (points)
+        PS_CRMARGIN(ps) = PS_PRMARGIN(ps)       # current R margin   (points)
+end
diff --git a/sys/psio/pswidth.x b/sys/psio/pswidth.x
new file mode 100644
index 00000000..e102f37c
--- /dev/null
+++ b/sys/psio/pswidth.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <psset.h>
+include "psio.h"
+
+
+# PS_TEXTWIDTH -- Return the length in PS pixels of the given string.  We 
+# handle font changes here and keep track of the current and previous font.
+
+int procedure ps_textwidth (ps, str)
+
+pointer	ps					#I package pointer
+char	str[ARB]				#I string to check
+
+int	ip, width, f_current
+int	ps_getfont(), ps_chwidth()
+errchk	ps_chwidth
+
+begin
+	# Initialize.
+	width = 0
+	f_current = PS_CFONT(ps)
+
+	# Now process the word, computing the width of each character and
+	# returning the total width.  Handle inline font changes.
+
+	for (ip=1; str[ip] != EOS; ip=ip+1) {
+
+	    # Handle any font changes.
+	    if (str[ip] == '\\' && str[ip+1] == 'f') {
+	        f_current = ps_getfont (ps, str[ip+2])
+	        ip = ip + 2
+	    } else if ((str[ip] == '\\' && str[ip+1] == '(') ||
+	    	       (str[ip] == '\\' && str[ip+1] == ')')) {
+		# Skip over escaped parens in width computation.
+	        ip = ip + 1
+	        width = width + ps_chwidth (str[ip], f_current)
+	    } else
+	        width = width + ps_chwidth (str[ip], f_current)
+	}
+
+	return (width)
+end
+
+
+# PS_CHWIDTH -- Given the font type and a character return the width.
+
+int procedure ps_chwidth (ch, font)
+
+char	ch					#I character
+int	font					#I font type character
+
+errchk	syserr
+include	"font.com"
+
+begin
+	if (ch < START_CH || ch > END_CH)
+	    return (0)
+
+	switch (font) {
+	case F_ROMAN: 	
+	    return (roman[(ch-START_CH+1)])
+	case F_BOLD: 	
+	    return (bold[(ch-START_CH+1)])
+	case F_ITALIC: 	
+	    return (italic[(ch-START_CH+1)])
+	case F_TELETYPE: 	
+	    return (FIXED_WIDTH)
+	case F_PREVIOUS: 	
+	    return (FIXED_WIDTH)
+	default:
+	    call syserr (SYS_PSFONT)
+	}
+end
diff --git a/sys/psio/zzdebug.x b/sys/psio/zzdebug.x
new file mode 100644
index 00000000..97e78aa7
--- /dev/null
+++ b/sys/psio/zzdebug.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <time.h>
+include <psset.h>
+
+
+task   pstest        = t_pstest
+
+# PSTEST -- Test the PSIO package.  This test program pretty-prints a file
+# with a header message and page number suitable for output to a printer.
+
+procedure t_pstest()
+
+pointer	ps
+int     fd, ip, op
+char    fname[SZ_FNAME], date[SZ_TIME], line[SZ_LINE], outline[SZ_LINE]
+
+pointer ps_open()
+int     open(), getline()
+long    clktime()
+errchk	open, close, getline, ps_setfont, ps_open
+
+begin
+        # Get the file to format and date string.
+        call clgstr ("filename", fname, SZ_FNAME)
+        call cnvtime (clktime(0), date, SZ_TIME)
+
+        # Open the file.
+        iferr (fd = open (fname, READ_ONLY, TEXT_FILE))
+	    call error (1, "Error opening file.")
+
+        # Initialize the PSIO interface.
+        iferr (ps = ps_open (STDOUT, NO))
+	    call error (1, "Error opening PSIO interface.")
+        call ps_header (ps, fname, "NOAO/IRAF", date)
+        call ps_footer (ps, "PSIO Test Page", "", "")
+        call ps_write_prolog (ps)
+
+        # Output the text in a fixed-width font.
+        call ps_setfont (ps, F_TELETYPE)
+
+        call ps_linebreak (ps, NO)
+        while (getline (fd, line) != EOF) {
+	
+            if (line[1] == EOS) {
+		# Simply break on a newline.
+                call ps_linebreak (ps, NO)
+
+            } else {
+	        # Detab the line to preserve the spacing.
+	        ip = 1
+	        op = 1
+                while (line[ip] != EOS && op <= SZ_LINE) {
+                    if (line[ip] == '\t') {
+                        repeat {
+                            outline[op] = ' '
+                            op = op + 1
+                        } until (mod(op,8) == 1)
+                        ip = ip + 1
+                    } else {
+                        outline[op] = line [ip]
+                        ip = ip + 1
+                        op = op + 1
+                    }
+                }
+                outline[op] = EOS
+
+                # Output the line and a newline break.
+                call ps_output (ps, outline, NO)            
+                call ps_newline (ps)
+            }
+        }
+        call close (fd) 			# close the file
+
+        # Close the PSIO interface, this writes the PS trailer.
+        call ps_close (ps)
+end
diff --git a/sys/qpoe/QPDEFS b/sys/qpoe/QPDEFS
new file mode 100644
index 00000000..863337fd
--- /dev/null
+++ b/sys/qpoe/QPDEFS
@@ -0,0 +1,60 @@
+# QPDEFS -- SAMPLE global macro definition file for QPOE.  This should be
+# modified (and a copy placed somewhere outside the QPOE sources) to establish
+# the defaults for a given site.  Each user may also have their own private
+# copy of this file.  The environment variable `qmfiles' defines the list of
+# QPDEFS files to be read to define the runtime environment for QPOE.
+
+# Interface parameters (defaults shown).
+#set	bucketlen	1024
+#set	cachesize	8
+#set	indexlen	100
+#set	maxlfiles	128
+#set	pagesize	512
+#set	sbufsize	2048
+#set	stablen		2048
+#set	progbuflen	1024
+#set	databuflen	4096
+#set	maxfrlutlen	8192
+#set	maxrrlutlen	1024
+#set	lutminranges	5
+#set	lutscale	15
+#set	maxpushback	8192
+#set	blockfactor	8
+#set	optbufsize	524288
+#set	debuglevel	0
+
+set	lutscale	32
+set	blockfactor	4
+
+# The event structure used in qpoe$zzdebug.x for s/w testing.
+define	evfields	{s:x,s:y,s,s,d,s,s}
+define	x		s0
+define	y		s2
+define	pha		s4
+define	pi		s6
+define	time		d8
+define	dx		s16
+define	dy		s18
+
+# An alias.
+define	t		time
+
+# Some test filters.
+define	box		x=(400:800),y=(200:400)
+define	dbox		dx=(400:800),dy=(200:400)
+define	eventimes	(30:31,32:33,34:35,36:37,38:39,40:41,42:43)
+define	oddtimes	(31:32,33:34,35:36,37:38,39:40,41:42,43:44)
+define	alltimes	(eventimes,oddtimes)
+
+# The following is for integer LUT tests; a bitwise test would be more
+# suitable for testing for an even integer.
+
+define	even		(2,4,6,8,10,12,14,16,18,20,22,24,26,28,30)
+
+# Test argument substitution in macros.
+define	eq		$1=($2)
+define	ne		$1=!($2)
+define	le		$1=(:$2)
+define	lt		$1=(!($2:))
+define	ge		$1=($2:)
+define	gt		$1=(!(:$2))
diff --git a/sys/qpoe/QPOE.hlp b/sys/qpoe/QPOE.hlp
new file mode 100644
index 00000000..cbb0ee5b
--- /dev/null
+++ b/sys/qpoe/QPOE.hlp
@@ -0,0 +1,1201 @@
+.help QPOE Jun90 "Quick POE Design"
+.ce
+\fBQuick-POE (Position Ordered Event File) Interface Design\fR
+.ce
+Doug Tody
+.ce
+July, 1988
+
+.NH
+Introduction
+
+    The POE (Position Ordered Event file) facility is an interface and file
+structure used to store and access the event (photon) lists generated
+by event counting detectors.  Each event is described by a unique position,
+time, energy, and possibly other parameters (e.g., polarization, position in
+other coordinate systems, or instrument related parameters).  In the case of
+an imaging event counting detector, the "image" generated consists of this list
+of discrete events, rather than the regular matrix produced by a conventional
+sampling detector.  Both types of detectors are fundamental to astronomy.
+
+The POE interface is a stand alone interface built upon the standard VOS
+interfaces DFIO (in a future release), PLIO, SYMTAB, FIO, and other lower
+level interfaces.  The POE interface may be called directly by applications
+code to create and access POE datafiles, for event file specific processing.
+In addition, an IMIO image kernel is provided so that POE files may be
+accessed as (read only) images, allowing existing IRAF image tasks to be
+used to access POE files.  The main function of the POE image kernel is to
+filter and sample the event list in real time, returning a conventional
+sampled grid (image matrix) to the high level applications code.
+The parameters controlling the filtering and sampling operations may be
+specified by the user when the image (POE file) is accessed, making runtime
+filtering of events possible in connection with any general image processing
+task.
+
+.NH 2
+Important Concepts
+    
+    The primary object dealt with by this interface is the \fIevent file\fR,
+consisting of a free format \fIfile header\fR and the main \fIevent list\fR.
+The event list is a collection of \fIevent structures\fR, e.g., photons
+hitting an imaging detector during the period of observation recorded by the
+event file.  Each event is characterized by a standard set of attributes such
+as the position of the event in detector, sky, or other coordinates, the time
+at which the event was recorded, the energy of the event, and so on, plus
+optionally additional instrument dependent attributes (in general the event
+structure cannot be fixed, and the nomenclature may vary depending upon the
+science being performed).
+
+The events may appear in the event list in any order, but since most access
+to image data tends to be spatial in nature, access will be most efficient if
+the event list is position ordered.  This is the convention chosen by QPOE
+and hence the name \fIpoe\fRfile, or \fIp\fRosition \fIo\fRrdered \fIe\fRvent
+file.  An important alternative ordering is time ordering, which preserves
+the order in which the events were originally recorded, but which requires
+a complete scan of the event list to accumulate the events in a region of
+interest during analysis.  There are cases where time ordering might be
+preferable to position ordering, e.g., for time series analysis of a long
+observation.
+
+Of fundamental importance to the analysis of data from event counting
+detectors is the concept of \fIfiltering\fR.  It is in the nature of event
+counting detectors that they are often used to observe very faint objects
+for very long periods of integration.  The total amount of data (number of
+events) may be limited, so one wants to preserve all events, but since the
+quality of the data may vary both with time and with position, it is common
+to want to reject a portion of the data.  Conversely, the analysis being
+performed may require one to examine only a portion of the data, e.g., only
+events with a certain range of energies or arrival times, occurring within a
+given region of the image.  Often the analysis will be repeated many times
+wtih different filters.
+
+Hence, most analysis of event counting data typically involves both
+\fIrejection\fR and \fIregion of interest\fR filtering.  Rejection filtering
+depends mostly upon the data itself, hence the rejection filter for an image
+is a part of the image and should be in effect by default whenever the image
+is accessed, although we would like to physically record all data and be able
+to change the rejection filter either temporarily or indefinitely if desired.
+Region of interest filtering, on the other hand, depends upon the scientific
+analysis being performed rather than upon the data, hence is highly variable
+and should be controlled by the user, independently of the data.
+
+.NH 2
+Interface Requirements
+
+    Given the description of the problem to be solved presented in the previous
+section, we can make the following observations regarding the POE interface:
+.ls 4 o
+A flexible binary file header supporting both scalar and variable length vector
+fields is essential.  Examples of vector fields include the aspect and temporal
+records (actually arrays of records, or subtables), the processing history
+(probably stored as a single variable length text buffer), and the rejection
+and region of interest filters (PLIO external format byte sequences stored as
+opaque binary arrays).
+.le
+.ls o
+In the general case the details of the event structure depend upon the
+instrument for which data is being stored.  The minimum requirement is that
+the event structure consist of a set of standard fields (x, y, time, energy)
+followed by a variable length, instrument dependent area (hence the size of
+the event structure, while fixed for a given datafile, should be allowed to
+vary depending upon the data).  Ideally all fields should be named and
+accessible for filtering, the names chosen should be variables rather than
+constants, and the set of fields used to describe an event should be allowed
+to vary depending upon the data.
+.le
+.ls o
+Runtime access to the event list, including event-attribute and spatial
+filtering, should be as efficient as possible since this is likely to be
+by far the most time consuming part of the interface.  Header access
+efficiency is much less important and is not expected to be a problem.
+.le
+.ls o
+For most efficient access the event list should be stored sorted upon some
+primary key, with an index maintained by the interface for that key,
+and used for efficient retrieval.  The minimum requirement is that the primary
+or sort key be the Y coordinate (corresponding to image lines).  Ideally it
+should be possible for the sort key to be any field of the event structure,
+or any combination of fields (e.g., Y+X, or T).  Ideally the interface itself
+should be responsible for maintaining the event list in sort order; this is
+not a requirement since writing to event files is much less common than
+reading.  Ideally it should be possible for the event list to be unordered,
+and it should be possible to transparently access the event list regardless
+of the ordering.
+.le
+.ls o
+Rejection filtering is typically required by the data, yet we wish to retain
+all the data and be able to override or replace the default rejection mask.
+The rejection filter is logically associated with the data and should be
+stored with the data.  The minimum requirement is for the interface to be able
+to store all the data plus the rejection mask, and be able to return only
+the "good" data at runtime.  The interface is not required to perform rejection
+filtering at runtime, although it would be desirable to be able to do so if
+the efficiency penalty were not too great.  Alternatively, the event list
+could be prefiltered, and the "good" and "bad" events stored in different
+places in the datafile, requiring that the entire file be rebuilt to change
+the rejection filter.
+.le
+.ls o
+Region of interest filtering is a common operation for event data, and can be
+difficult to implement efficiently, hence should be supported directly by the
+interface.  At a minimum it should be possible to filter events by defining a
+range of acceptable or unacceptable values for each of some subset of the event
+attributes (e.g., energy or time).  Ideally it should also be possible to
+specify an arbitrarily long list of ranges of acceptable values.  Ideally
+spatial filtering should be supported as well; this is required for rejection
+filtering, but is at most a desirable option for spatial region of interest
+filtering (there is nothing about spatial filtering which is unique to event
+data, hence it might be more appropriate to implement it at a higher level,
+but on the other hand it might be more efficient to implement it at the event
+i/o level since the event list is position ordered and can be very large).
+.le
+.ls o
+It should be possible to specify the various filtering options both
+transparently to applications programs (via a symbolic expression passed
+into the interface by the user as part of the file specification),
+or procedurally, via \fIset\fR-parameter calls issued by the client program.
+.le
+
+The above issues need to be adequately addressed in order to have a useful
+interface.  In the longer term there are many other considerations, e.g.,
+it is also desirable for the data format to be machine independent, and the
+data format should be flexible, to accommodate the inevitable evolutionary
+revisions as well as to accommodate data from a variety of instruments or
+projects.  The event files can be very large, hence efficiency is a major
+consideration for event i/o and filtering.
+
+.NH 
+The QPOE Interface
+.NH 2
+Implementation Strategy
+
+    A two step operation is planned for implementing the POE interface within
+IRAF.  The first step is the so called quick-POE interface.  The objective of
+quick-POE is to provide the necessary functionality so that applications
+development can proceed immediately, without waiting for the general interface
+to be developed.  Once quick-POE is in place development of the fully general
+POE interface can proceed at a more leisurely pace consistent with the plan to
+provide most of the functionality of the generalized POE interface with other
+standard IRAF facilities currently under development, most notably the datafile
+i/o interface (DFIO), a general purpose binary file record manager to be used
+in the new images structures project and elsewhere in IRAF.
+
+The main facilities provided by POE are for access to general header fields,
+access to the variable length aspect and temporal records, event list i/o,
+and event filtering.  The POE header is a type of record, and the aspect and
+temporal "records" are arrays of records (tables), as is the event list itself.
+Any record access problem involving large records commonly involves the
+related problems of indexing and selection based on a user supplied predicate
+(boolean expression or filter in our case).
+
+In the general case, we would like the POE interface to be able to support
+data from a variety of detectors or instruments, not only those used in high
+energy astrophysics but those used in optical and radio observatories as well,
+hence the details of the data structures must be allowed to vary without
+affecting the interface itself.  Ideally the POE files should be maintained
+in a machine independent format, and the applications programs using POE
+should not be affected by changes to the data format, and indeed should be
+usable directly with any of several similar data formats, or with data formats
+that evolve over time.
+
+All these observations lead us to conclude that a general implementation of
+the POE interface has much in common with the general record access problem,
+hence the association of POE with DFIO.  Quick-POE will provide much the same
+functionality at the applications level but will be less general, i.e., the
+binary record structures as seen by applications will be mapped directly onto
+external storage (the main contribution of DFIO is data independence and
+flexibility).  This means that initially the applications will be tied to
+a specific format datafile, changes to applications structures will require
+reformatting the data, and the datafiles will probably be machine dependent.
+
+This approach would be unacceptable in the long run, as the need arises to
+support a variety of instruments, but is viable for initial applications
+development provided a DFIO based implementation eventually replaces the
+initial interface.  There should be little difference in terms of functionality
+and efficiency between QPOE and POE; in fact QPOE may have the edge over POE
+in terms of efficiency, since it will be less general.  It is likely that
+applications developed for QPOE will be usable with POE with few if any
+changes, e.g., by reimplementing QPOE as a layer on top of the more general
+POE interface.  The main motivation for implementing a DFIO based POE will be
+to provide increased data independence, a machine independent binary data
+format, and the ability to support a variety of instruments with a single
+interface.
+
+Although some throw away code will have to be written to implement the QPOE
+interface, most of the complexity of the interface lies in the event filtering
+code, which should be reusable in the final interface.  Low level, custom
+(non-DFIO) selection code is required for POE due to the unusual requirements
+for region and temporal filtering, and the potentially extremely high data
+volume (>10**6 event records).  This implies that DFIO itself will have to be
+a layered interface, supporting low level access to the packed data records
+for applications with unusual efficiency requirements (it will be).  Finally,
+it is already evident that the low level file manager required by QPOE has
+much in common with the access method code planned for DFIO, hence can serve
+as a prototype for the DFIO file manager.
+
+The remainder of this document will deal only with the details of the
+QPOE interface.  The DFIO interface has already been specified,
+including a sketch of a data definition for a POE file.  See \fIThe IRAF
+Datafile I/O Interface\fR, February 1988.  The region filtering
+code in POE will make use of the Pixel List I/O (PLIO) interface, described
+in \fIThe IRAF Pixel List Package\fR, February 1988.  The latter interface
+has already been implemented, as have all other interfaces (e.g., SYMTAB)
+required by QPOE.
+
+.NH 2
+Architecture
+
+    The architecture of IRAF as it pertains to the QPOE (and POE) interface
+is summarized in the figure below.
+
+.ks
+.nf
+        IMIO
+                IKI
+                        IK-POE
+                                POE
+                                        PLIO
+                                        [DFIO]
+                                        SYMTAB
+                                        FIO
+.fi
+.ke
+
+As indicated in the figure, QPOE depends most heavily on the VOS interfaces
+PLIO (pixel list i/o), used for spatial filtering, SYMTAB (the general symbol
+table package), used to manage the file header and aspect and temporal records,
+and FIO (file i/o), used to access the binary file in
+which the QPOE data is stored (low level, unbuffered asynchronous i/o is
+used by the QPOE file manager).  The QPOE interface is accessed both directly
+by applications code, and by the IMIO interface via an image kernel, shown
+as IK-POE in the figure.  IK-POE and QPOE comprise the code to be written to
+implement the QPOE interface.
+
+The QPOE interface consists of the POE file itself, a binary data structure
+[largely] private to the QPOE interface, and a set of procedures for creating,
+writing into, and reading from POE files.  The procedures fall into several
+categories, i.e.,
+.ls 4
+.ls o
+General QPOE file management procedures.  These include routines for creating,
+deleting, renaming, opening, and closing POE files, plus set/stat routines
+for setting and querying the file parameters and interface options.
+.le
+.ls o
+General header access procedures.  These include a conventional set of keyword
+driven typed scalar get/put routines, plus get/put routines for accessing
+variable length typed and opaque binary arrays (e.g., history records and the
+aspect and temporal records).
+.le
+.ls o
+Event i/o procedures.  These are routines for initially preparing and
+subsequently reading (sequentially with seek) the main event list, e.g.,
+the raw "get next photon" routine.
+.le
+.ls o
+The selection subpackage.  Included are routines for opening and incrementally
+compiling a user supplied selection predicate (filter) input as a formatted
+text string, and for testing individual event records to see whether they
+satisfy the given expression.
+.le
+.le
+
+All binary data structures other than simple scalar variables, e.g., the
+aspect and temporal records and the event structure, are described in QPOE
+by compile time bound SPP binary data structure definitions, provided in a
+standard interface include file (\fI<qpset.h>\fR) referenced by both QPOE and
+selected applications.  When the interface is layered upon DFIO these
+structures could continue to be used, since DFIO will have the ability to
+define runtime mappings of conventional application defined structures onto
+the physical data datafile (POE file) structures.
+
+.NH 2
+Interface Specification
+
+    The quick-POE interface (QPOE, package prefix `qp') is a set of procedures
+for accessing \fIpoefiles\fR, or position ordered event files.  Each poefile
+consists of a \fBheader\fR of arbitrary size and content containing zero or
+more named scalar or variable length (opaque, typeless) fields, plus an
+\fBevent list\fR consisting of zero or more event structures.
+The event structure is fixed at compile time via a conventional SPP structure
+declaration in the include file \fB<qpset.h>\fR.
+
+.NH 3
+Interface Procedures
+
+    The QPOE procedures fall into three main categories, the primary user
+interface procedures (general datafile management, header access, and filtered
+event i/o), the low level or raw event i/o procedures, and the low level
+selection expression compile and evaluate procedures.
+
+.NH 4
+Header Access Procedures
+
+    The routines described in this section are used to create, open, or
+otherwise manipulate poefiles, to define new header parameters or query the
+existing parameter set, and to read and write the values of both scalar and
+vector parameters of various standard and poefile-specific datatypes.
+These operators are summarized in the figure below.
+
+The function of most of these procedures should be obvious.
+The \fIqp_access\fR, \fIqp_delete\fR, \fIqp_rename\fR, and \fIqp_copy\fR
+operators perform the implied operation on the named poefile.
+The poefile may be rebuilt with \fIqp_rebuild\fR, recovering any unused
+space and rendering storage for the internal data structures (logically)
+contiguous in the process (a rebuild is just a copy/rename/delete).
+
+The \fIqp_open\fR procedure must be called to open or create a poefile,
+before it can be accessed.  The NEW_FILE and NEW_COPY modes are supported
+for creating new files.  If NEW_COPY mode is specified, a reference file
+may be specified (via the descriptor \fIo_qp\fR) from which the new file
+is to inherit the header but no data (no event list).
+The \fIqp_seti\fR and \fIqp_stati\fR procedures are used to set and stat
+any parameters affecting QPOE i/o, and \fIqp_sync\fR updates an opened
+poefile on disk.
+
+The \fIqp_get\fR and \fIqp_put\fR scalar functions behave as for the other
+VOS interfaces, e.g., they will abort if the named parameter does not exist,
+or if the implied datatype conversion is illegal.  The \fIqp_add\fR 
+procedures are equivalent to the \fIqp_put\fR procedures except that they
+will create the named parameter if it does not already exist (see also
+\fIqp_addf\fR, discussed below).
+
+.nf
+         yes|no = qp_access (poefile, mode)
+                    qp_copy (poefile, newfile)
+                  qp_rename (poefile, newfile)
+                 qp_rebuild (poefile)
+                  qp_delete (poefile)
+
+               qp = qp_open (poefile, mode, o_qp)
+                    qp_seti (qp, param, ival)
+            ival = qp_stati (qp, param)
+                    qp_sync (qp)
+                   qp_close (qp)
+           
+     val = qp_get[bcsilrdx] (qp, param)
+                    qp_gstr (qp, param, outstr, maxch)
+           qp_put[bcsilrdx] (qp, param, val)
+                    qp_pstr (qp, param, strval)
+           qp_add[bcsilrdx] (qp, param, defval, comment)
+                    qp_astr (qp, param, strval, comment)
+
+              fd = qp_popen (qp, param, mode, type)
+            nelem = qp_read (qp, param, buf, nelem, first, dtype)
+                   qp_write (qp, param, buf, nelem, first, dtype)
+
+        yes|no = qp_accessf (qp, param)
+                 qp_deletef (qp, param)
+                 qp_renamef (qp, param, newname)
+                    qp_addf (qp, param, dtype, maxelem, comment, flags)
+	  nelem = qp_queryf (qp, param, dtype, maxelem, comment, flags)
+
+         list = qp_ofnl[su] (qp, template)
+          nch|EOF = qp_gnfn (list, outstr, maxch)
+                    qp_cfnl (list)
+.fi
+
+Array valued parameters may be randomly read with \fIqp_read\fR and
+written with \fIqp_write\fR; arrays may be any length, and will be
+automatically extended in a write.  The only way to shorten an array
+parameter is to copy it and delete the old parameter.  The typed read and
+write functions allow automatic type conversions, and external storage of
+the data in a machine independent form (should the interface choose to do so).
+In addition to the standard SPP types, QPOE supports the special types
+TY_EVENT, TY_ASPECT, and TY_TEMPORAL.  Finally, the type TY_OPAQUE denotes
+an array of element size SZ_CHAR, which will be copied to and from external
+storage without the data being modified in any way (note that opaque data
+is machine independent only if the application encodes it that way).
+
+Alternatively, an array valued parameter may be opened as a random access
+\fIfile\fR with \fIqp_popen\fR, and then read or written with conventional
+FIO calls.  The value of the \fItype\fR parameter must be TEXT_FILE or
+BINARY_FILE, as for a conventional file.  If the type is TEXT_FILE then
+only text data may be stored in the file, and text data will be byte packed
+on disk.  The BINARY_FILE type is equivalent to the QPOE type TY_OPAQUE.
+File i/o to a QPOE parameter is equivalent to file i/o to a conventional
+binary file in terms of both efficiency and semantics, i.e., the data is not
+modified in any way, and the "files" may be any size (the main semantic
+difference is that deleting the parameter does not immediately free the space).
+A parameter opened as a file with \fIqp_popen\fR is closed with the FIO
+\fIclose\fR routine.
+
+Although new parameters may be defined when first written to by calling one of
+the typed \fIqp_add\fR functions, the most general procedure for adding new
+parameters is \fIqp_addf\fR, which allows the datatype and vector length of
+the parameter to be explicitly specified, along with a comment describing the
+new parameter.  The procedure \fIqp_accessf\fR tests if the named parameter
+exists, and \fIqp_deletef\fR and \fIqp_renamef\fR make it possible to delete
+and rename parameters, e.g., for implementing array copy procedures.
+The \fIqp_queryf\fR procedure returns the datatype, allocated vector length,
+current vector length, and comment field of the named parameter.
+
+The field name list procedures (\fIqp_ofnl[su]\fR etc.) are used to obtain
+the names of all header parameters matching the given template; a null or "*"
+template returns the names of all header parameters.  This is the only way by
+which an application without apriori knowledge of the field names can determine
+what is in the header, e.g., to list or copy the header.
+
+.NH 4
+Filtered Event I/O Procedures
+
+    The \fBevent i/o\fR subpacke provides sequential i/o facilities for the
+main event list of the poefile.  These procedures, known as the QPIO (QPOE
+event i/o) package, provide read or write (append) access to the event list,
+optionally filtered when reading to select events spatially or by event
+attribute.
+
+Under QPOE, an event list is stored as a variable length array (i.e., as a
+named header parameter) of type \fIevent\fR.  The QPIO package takes this
+basic object and adds additional structure for more efficient i/o, e.g., events
+are blocked into large, fixed size \fIbuckets\fR of N events, the first two
+events of each bucket containing the minimum and maximum event values for that
+bucket.  If the event list is sorted an \fIindex\fR may be maintained for the
+list; this index, plus the min/max event values maintained for a bucket, are
+used to optimize basic event i/o and filtering.  During event i/o the raw
+event list may be filtered spatially or by event attribute.  All this is
+transparent to the application, which merely opens the event list parameter
+and begins reading (or writing) blocks of events.
+
+Before i/o can take place the named event list parameter is opened with
+\fIqpio_open\fR.  The selection filter to be used by QPIO may be specified
+via a selection expression passed in by the user at poefile open time (as
+part of the poefile name), at QPIO open time (as part of the parameter name),
+or in subsequent calls to \fIqp_addfilter\fR (each call incrementally modifies
+the current filter) or to \fIqp_setfilter\fR (each call replaces the affected
+portion of the current filter).  A region mask may also be specified with
+\fIqp_setmask\fR; if no mask is specified, the default rejection mask is used
+(or more precisely, its inverse).
+
+.nf
+           qpio = qpio_open (qp, param, mode)
+               qpio_mkindex (qpio, key, nelem)
+              qpio_setrange (qpio, vs, ve, ndim)
+       qpio_[add|set]filter (qpio, selexpr)
+    nchars = qpio_getfilter (qpio, outstr, maxch)
+               qpio_setmask (qpio, pl)
+          pl = qpio_getmask (qpio)
+   nev|EOF = qpio_getevents (qpio, ev, maskval, maxevents)
+             qpio_putevents (qpio, ev, nevents)
+               qpio_readpix (qpio, obuf, vs, ve, dxim, xblock, yblock)
+                 qpio_close (qpio)
+.fi
+
+Events are read sequentially with \fIqp_getevents\fR, which fills in the
+pointer array \fIev[maxevents]\fR with one or more pointers to event structs,
+returning the number of events read as the function value, or EOF when the
+event list is exhausted.  Events are returned in the order in which they are
+stored in the main event list.  If a region mask is used for spatial
+filtering, the mask value associated with the output events is returned in 
+\fImaskval\fR.  Filtering and subranges are supported only for reading;
+\fIqp_putevents\fR may only be used to append to the output poefile.
+At present, poefiles are not randomly updatable, as this would require
+runtime editing of the compressed event lists and it is not clear how useful
+such a feature would be.
+
+If less then the entire image is to be accessed then \fIqp_setrange\fR
+may be called to specify the region of the poe image from which events are
+to be read (the vector coordinates \fIvs\fR and \fIve\fR are specified
+relative to the predefined primary event coordinate system, i.e., the PO
+coordinates).  Repeated calls to \fIqp_setrange\fR may be made to access
+multiple regions of the image, or to rewind the i/o pointer for a region.
+
+An alternative to event i/o is provided by \fIqp_readpix\fR, which samples
+the event list using the current filters and blocking factor,
+generating \fInpix\fR pixels beginning with the pixel at the image coordinates
+specified by the vector \fIv\fR.  This is the routine used by the POE IMIO
+image kernel to read from a poefile.  Only integer pixels are supported.
+On output, each pixel value is a count of the number of filtered events
+mapping into that pixel.  A region mask may be used to filter the event list,
+but the ability to discriminate between different regions by the mask value
+is lost.
+
+A poefile may contain any number of event list parameters, although most
+files are expected to store only the main event list.
+As an alternative to QPIO, event-array parameters may be accessed directly
+via the normal header access parameters, e.g., \fIqp_read\fR, but i/o may be
+somewhat less efficient (due to the copyout), the bucket structure will be
+visible, and no filtering is possible.  In short, the raw event list will
+be accessed as an array, returning the min/max events in each bucket along
+with the data events.
+
+In the current implementation, the event structure is a fixed, predefined
+binary structure, and all event i/o is expressed in terms of pointers to event
+structures.  The event structure is defined in the include file
+\fB<qpset.h>\fR, discussed in the appendix.
+
+.NH 4
+Selection Subsystem Procedures
+
+    The \fBselection subsystem\fR is a facility used to perform runtime
+filtering of the event list, returning to the calling program only those
+events satisfying some user defined selection criteria.  The selection
+subsystem is driven by a selection expression provided by the user as a
+formatted string, normally at image (poefile) open time.  The selection
+expression syntax itself is independent of the procedural interface and is
+described separately in section 2.3.2.  The selection procedures are
+summarized in the figure below.
+
+.nf
+	     ex = qpex_open (qp, expr)
+    ok|err = qpex_modfilter (ex, exprlist)
+    nchars = qpex_getfilter (ex, outstr, maxch)
+	nev = qpex_evaluate (ex, i_ev, o_ev, nev)
+		 qpex_close (ex)
+.fi
+
+A selection expression, input as the string \fIexpr\fR, is compiled with
+\fIqpex_open\fR, which returns a pointer to the runtime descriptor (filter)
+for the given compiled selection expression.  If \fIexpr\fR is the null
+string the filter returned will pass all events.
+
+An active filter may be modified with \fIqpex_modfilter\fR, which combines
+the expression \fIexpr\fR into the current filter, allowing complex
+filters to be built up in several calls, or allowing an application to modify
+a base filter without knowledge of the base filter.  The expression consists
+of a list of comma delimited "attribute = exprlist" terms.  If the assignment
+is specified as "=" the term for the given attribute is replaced; if the
+assignment is "+=" the term for the given attribute is further qualified.
+A text representation for the current filter may be obtained at any time with
+\fIqpex_getfilter\fR.  The boolean function \fIqpex_evaluate\fR is called to
+test whether a specific event meets the selection criteria, i.e., to test
+whether or not \fIexpr\fR is true for the given event.
+
+Selection is normally performed transparently to the application by the QPIO
+interface, which calls the routines described in this section to create and
+apply event-attribute filters.
+
+.NH 3
+Spatial and Event Attribute Filtering
+.NH 4
+Selection Syntax
+
+    Selection expressions are used to construct \fIfilters\fR to specify the
+rejection mask and region of interest filters before reading the event list
+via QPIO.  Due to the complexity of event attribute selection, selection
+predicates are specified syntactically, i.e., as an expression input as a
+text string.  These filters may be input by the user as part of the image
+or poefile specification (object name), transparently to applications code,
+or they may be constructed by the application via calls to the QPIO or
+selection routines.  Complex or frequently referenced filters may be stored
+in text files and referenced by filename if desired.  It does not matter
+whether a filter is input all at once, or compiled incrementally.
+
+An event attribute filter consists of a set of filters for each event
+attribute.  By default, i.e., if no filter is specified, all attribute values
+are passed.  If a filter is specified for an attribute, the filter specifies
+either a bitwise mask value, or a list of acceptable values or ranges of values
+for the attribute.  An event is passed if and only if all event attribute
+filters pass the event.  If a list of acceptable values are specified, the
+list may be any length, with little impact on filtering efficiency.
+
+The basic event attribute filter syntax consists of a list of attribute
+filters, e.g.:
+
+        attribute = values [, attribute = values ...]
+
+where \fIattribute\fR is the attribute name, e.g., a position attribute,
+time, energy, and so on, and \fIvalues\fR is a mask or list of values.
+Mask values are integers prefixed by `%', e.g.,
+
+        attribute = %1003B
+
+Note that the mask may be specified in decimal (the default), octal (`b' or
+`B' suffix), or hex (`x' or `X' suffix), in accord with the usual IRAF
+conventions.  The meta-characters used in selection expressions have been
+selected to avoid or at least minimize the need to quote such expressions
+in CL commands.
+
+A specific value or list of values may be specified as a
+simple integer constant, or comma delimited list of constants, e.g.:
+
+.nf
+        attribute = 3
+or
+        attribute = 3, 5, 20X
+.fi
+
+Ranges are specified using the `:' notation, e.g.,
+
+        attribute = 3, 5, 8:11
+
+A `!' may be prepended to indicate the opposite, i.e., "everything but":
+
+.nf
+        attribute = !%14B
+or
+        attribute = 3, !1:10
+.fi
+
+Open ended ranges may be used to indicate that the range includes all values
+less than or equal to or greater than or equal to the given value, e.g.,
+
+        attribute = :100
+
+denotes all values less than or equal to 100.
+
+File inclusion or \fImacro expansion\fR is denoted by a C-like function call
+notation, e.g.,
+
+.nf
+        macro()
+or
+        macro(a,b)
+.fi
+
+Any arguments are expanded via string substitution when the text of the macro
+or include file is expanded.  Include files should have the extension ".qpm".
+Macros are permitted only if the variable \fBqpinit\fR is defined in the user's
+environment, the string value consisting if the filename of the user's QPOE
+macro file.  In a reference to a macro \fImacro\fR, QPOE will look first in
+the macro definitions file pointed to by \fIqpinit\fR for the named macro,
+then it will look for the file "\fImacro\fR.qpm" in the current directory.
+
+Parenthesis are optional and may be included to, for example, make attribute
+value lists more easily identifiable.  If a line ends in a comma or backslash
+continuation is assumed; blank lines and comment lines are ignored.
+The syntax for attributes with floating point values is identical to that
+for integers except that mask values are not allowed.
+
+.NH 4
+Region Specification
+
+    QPOE does not itself contain any syntax-level support for specifying
+region masks, e.g., via a list of include and exclude circles and other
+shapes.  The reason for this is that it is too difficult to come up with
+a sufficiently general scheme at the level of an interface like QPOE;
+there are too many ways to specify regions, hence in general such region
+specification must be done at the applications level.  QPOE does however
+include very general and efficient support for region analysis provided the
+region mask is input already encoded into a PLIO binary mask.  Since PLIO
+includes high level primitives for defining masks in terms of include and
+exclude circles, boxes, lines, polygons, etc., it is easy to extend QPOE at
+the applications level to include support for a region specification language
+tailored to the specific application.
+
+While QPOE cannot itself process a user defined region description to create
+new region masks, it is possible to \fIselect\fR from any number of region
+masks if these are prepared in advance using other systems facilities or
+applications programs.  PLIO region masks may be stored in the QPOE header
+as named parameters of type opaque binary array, or they may be stored in
+external binary files.  The region mask to be used may be specified by
+including an assignment of the form
+
+        mask=[\fIparam\fR|\fIfile\fR.pl]
+
+in the selection expression.  Unless otherwise specified, this region mask 
+will be combined with the default rejection mask for the poefile (the final
+mask will be the region mask \fIand\fR-ed with the \fInot\fR of the rejection
+mask).
+
+.NH 4
+Predefined Selection Keywords
+
+    While the syntax of a selection expression is an inherent part of the
+QPOE interface, the names of the event attributes used in selection
+expressions are logically part of the event structure, and ideally should
+be stored with the data and used by the interface only to determine the
+attribute datatypes and offsets into the event structure when the selection
+expression is compiled at runtime.  We should not really be documenting the
+specifics of the POE external data structures here, but in QPOE these data
+structures are wired into the interface, so it is appropriate to do so.
+
+The following \fIstandard event attributes\fR are defined.  Minimum match
+abbreviations are of course permitted.  The keyword \fIpi\fR is an acceptable
+alias for \fIenergy\fR (\fIpi\fR and \fIpha\fR are examples of discipline
+dependent terminology which should be associated with the data and not the
+interface).
+
+.nf
+        X               short           range in X (PO coords)
+        Y               short           range in Y (PO coords)
+        TIME            real            time event was recorded
+        ENERGY,PI       int             energy of event
+        PHA             int             pulse height
+.fi
+
+The event attributes may also be referred to using the generic notation
+[\fIsir\fR]\fIN\fR, which refers to each attribute by its datatype and
+struct offset (byte units, zero indexed) rather than by name.  For example,
+if the event attributes shown above are assumed to be shown in the order
+in which the fields are stored in the event struct, the \fItime\fR field
+could also be referred to as \fIR4\fR, and \fIpha\fR as \fII10\fR.  This
+crude but effective technique may be used to reference any private
+(nonstandard) fields of the event struct in selection expressions.
+
+The following additional, non-event keywords are defined:
+
+.nf
+        BLOCK           int             \fIqp_readpix\fR blocking factor
+        MASK            string          region mask to be used
+        FILTER          string          region filter to be used
+        REJMASK         string          rejection mask to be used
+        REJFILTER       string          rejection filter to be used
+.fi
+
+The default values for these parameters are taken from datafile header
+parameters of the same name, if such are found.  Masks are specified either
+by the name of a header parameter of type opaque binary array (containing
+an encoded PLIO mask), or by the name of a PLIO mask file, extension ".pl".
+Named filters are specified by the name of a header parameter of type char
+array, or by the name of a text file (extension ".qpf"), where in either
+case the named object contains the selection expression text.
+
+.NH 3
+Interface Set/Stat Parameters
+
+    The internal parameters for the QPOE interface, and all user accessible
+data structures, e.g., the event and other structures, are defined in the
+global system include file \fB<qpset.h>\fR.  This file should be referred to
+for up to date documentation on these definitions and structures; the
+discussion which follows may not be kept up to date.
+
+The following interface parameters may be accessed via the \fIqp_seti\fR and
+\fIqp_stati\fR procedures:
+
+.nf
+        QP_XRESOLUTION          resolution of an event x-coordinate
+        QP_YRESOLUTION          resolution of an event y-coordinate
+        QP_LENEVENT             length of an event structure
+        QP_LENINDEX             resolution of the event list index
+        QP_BUCKETSIZE           event list bucket size, nevents
+        QP_PAGESIZE             datafile page size, bytes
+        QP_CACHESIZE            number of buffers in data buffer cache
+        QP_MAXFILES             max lfiles in datafile (fixed)
+        QP_NFILES               query number of lfiles in datafile
+        QP_NPAGES               query number of pages in datafile
+        QP_FREEPAGES            query number of free pages in datafile
+.fi
+
+The parameters shown above may be set only at datafile creation time.
+The X and Y resolution parameters define the range of event x,y coordinates.
+The resolution of the event list index is set by QP_LENINDEX, and may be less
+than the full resolution of the event pixel Y-coordinate.
+The remaining parameters control how storage is physically allocated in the
+datafile and in any event lists.
+
+.NH 2
+Detailed Design
+.NH 3
+Event Attribute Filtering
+
+    The point of event-attribute filtering is to test an event to see if it
+satisfies a user defined event selection expression.  A selection expression
+may be decomposed into a list of simple, independent expressions for the
+individual event attributes; the event satisfies the full expression only
+if the value of each event attribute satisfies the associated attribute
+expression.  Currently, attribute expressions are limited to bitmasks, lists
+of acceptable values, or lists of ranges (inclusive) of acceptable values.
+
+        attr1=expr, attr2=expr, ...
+
+The highly constrained nature of event-attribute expressions makes expression
+evaluation straightforward and fast.  Expression evaluation is implemented
+by logically negating each attribute expression and testing each in turn;
+expression evaluation ends either when an attribute test fails, in which case
+the event is rejected, or when the end of the attribute expression list is
+reached, in which case the event is passed.
+
+The obvious way to implement such an expression evaluator is with a simple
+interpreter.  The expression is parsed and compiled to produce a simple
+interpreter program, using the instructions shown in the figure below.
+
+.ks
+.nf
+        \fIinstruction     arguments\fR
+
+        MSK[sir]        offset  maskval         bitwise mask test
+        EQL[sir]        offset  value           equality test
+        LEQ[sir]        offset  value           less than or equal
+        GEQ[sir]        offset  value           greater than or equal
+        RNG[sir]        offset  lowval highval  range test (inclusive)
+        LUT[sir]        offset  lut             lookup table
+        NOT                                     invert test
+        RET                                     return, pass event
+.fi
+.ke
+
+An interpreter program consists of a series of these instructions.  The
+\fIoffset\fR argument gives the offset of the event attribute (field) to
+be tested; the datatype of this field must match that of the instruction
+and of the data argument or arguments, if any.  Only event attributes for
+which restricted values were specified are tested, hence the cost of the
+evaluator depends only upon the complexity of the expression to be evaluated.
+An interpreter of this type can be coded very efficiently as a switch-case
+statement (jump table) within an optimized DO-loop.
+
+Simple attribute value tests are most efficiently coded as several \fIMSK\fR,
+\fIEQL\fR, etc., instructions.  The only case of any complexity is where the
+attribute has a long list of acceptable values or ranges of values.  This is
+most efficiently coded using a lookup table, using the \fILUT\fR instruction
+shown in the figure.  A lookup table test may be preceded by a range test to
+limit the size of the lookup table required.  For an integer or short integer
+attribute, the lookup table will be a \fIboolean\fR table containing one entry
+for each possible value of the attribute in the range spanned by the table.
+
+Use of a lookup table for floating point attributes is more difficult since
+an enormous lookup table might be required to preserve the resolution of
+the floating point numbers used to define ranges.  The solution is to employ
+an \fIinteger\fR (rather than boolean) lookup table of \fIreduced resolution\fR.
+The floating point value of the attribute to be tested is mapped into a bin of
+the lookup table.  The integer value of the table entry has one of the
+following values:
+
+.ks
+.nf
+        0               Reject all FP numbers mapping to this bin.
+        1               Accept all FP numbers mapping to this bin.
+
+        N               Some of the FP numbers mapping to this bin are
+                        legal, and some are not.  The value N is the
+                        address of a segment of interpreter code to be
+                        executed to test a FP value mapped to this bin.
+.fi
+.ke
+
+The performance of this algorithm for floating point table lookup depends
+upon the frequency with which 0 or 1 is encountered as the table value during
+lookup; if 0 or 1 is encountered most of the time, then a floating point LUT
+test is comparable in expense to an integer LUT test.  But since we already
+have to map a floating point number into an integer space of reduced
+resolution, we can easily vary the resolution of the lookup table,
+increasing the resolution of the table until the desired level of efficiency
+is reached (the interpreter execution time for case N is pretty fast in any
+case, so this is not critical).
+
+In summary, the expense of event-attribute filtering is directly proportional
+to the number of attribute tests to be performed.  An arbitrary number of
+values or ranges of values may be specified for an attribute with little if
+any affect on performance, even for floating point attributes (e.g., for
+time-tagged quality filtering).
+
+.NH 3
+Region Filtering
+
+    Region filtering is implemented in QPOE by the PLIO interface, which is
+documented elsewhere.  PLIO permits regions of arbitrary complexity to be
+described and used for event filtering, with little overhead beyond that
+already present for i/o on a large event list with no region filtering.
+This assumes only that the event list is position ordered, and that the
+region mask is specified in the PO (position ordered) coordinate system.
+This makes it possible for QPIO to use the mask to reduce the number of
+events to be examined; event attribute filtering is performed only on those
+events read through the region mask (this is similar to masked image i/o,
+i.e., the MIO package).
+
+If the event structure supports multiple coordinate systems and the region
+mask refers to a non-PO coordinate system, then the only approach is to first
+perform event-attribute filtering on the non-positional event attributes,
+then for each event passing the event-attribute filter, fetch the mask value
+corresponding to the x,y coordinates of the event.  This is still an efficient
+technique since only mask pixel lookup is required (no complicated region
+list traversal is involved), but it will be significantly less efficient than
+PO region filtering since we cannot take advantage of position ordering to
+reduce the number of events to be examined, and the overhead of accessing
+the region mask will be greater.
+
+.NH 3
+Datafile Layout and Access
+.NH 4
+File Structure
+
+    The QPOE file structure is private to the QPOE interface and is discussed
+here only for the purpose of detailing (and documenting) the design of the
+interface.  The QPOE file is a random access, dynamically extendable, binary
+file.  Under QPOE these files will be partially, but not completely, machine
+independent, hence file sharing by machines of different architectures will
+not be provided initially.  This will be rectified when management of the
+datafile is later turned over to DFIO.
+
+To provide a reasonable degree of flexibility, QPOE contains many
+variable length data structures, e.g., there may be any number of header
+parameters, including array valued parameters of arbitrary size.  New header
+parameters may be added at any time, and new data may be appended to array
+parameters at any time.  This flexibility places certain demands upon the
+low level file manager used to maintain these data structures in the datafile.
+
+All access to the physical datafile is via a low level binary
+\fIfile manager\fR.  The purpose of the file manager is to implement a
+restricted implementation of the binary file abstraction upon a single host
+level binary file.  This provides the "lightweight" binary file mechanism we
+need for QPOE.  Since the file manager is a low level facility, it is
+implemented using only the low level asynchronous i/o facilities provided
+by FIO to read and write file pages, once the file has been opened.
+
+The file manager provides routines for creating new datafiles, and for
+creating, deleting, etc., \fIlightweight files\fR (lfiles) within a datafile.
+Storage for lfiles is allocated in units of datafile \fIpages\fR.  For each
+data page in the datafile there is an entry in the datafile \fIpage table\fR.
+The page table itself is stored as an lfile (\fIlfile zero\fR) in the data
+pages.  Files at the file manager level are known only by their file number;
+association of these file numbers with file names is left up to the higher
+level code, and in the case of QPOE is done with the symbol table (which is
+also stored as an lfile).
+
+.ks
+.nf
+         +-----------------+
+           datafile header              fixed size
+         +-----------------+
+              file table                fixed size
+         +-----------------+
+                  |
+              data pages                data and page table pages
+                  |                        (arbitrarily large)
+                  v
+.fi
+.ke
+
+The page table is a vector mapping datafile pages by file offset onto lfile
+file numbers; the value of each page table entry is the file number of the
+lfile to which the page is assigned.  When the file manager opens an lfile
+it scans the page table, extracting the page numbers of the pages assigned
+to the lfile, to form a vector mapping lfile page offsets directly onto
+datafile page offsets.  New pages are always allocated at the end of the
+datafile, and new lfiles are always allocated at the end of the file table,
+hence lfile deletion will leave "holes" (unused storage) in both the datafile
+pages and file table.  A \fIrebuild\fR operation is required to reclaim the
+space occupied by these holes.  Deleted files are recoverable by merely
+revalidating their file table entries.
+
+Every variable size object managed by QPOE is stored in the datafile as a
+distinct lfile.  Since storage for lfiles is allocated in units of file pages,
+the minimum amount of storage used by a variable length object is 0 or 1 page.
+Examples of variable size objects are the SYMTAB symbol table
+used to describe the contents of the datafile header (and any other symbols
+used by QPOE), the static data storage area (used to store the values of
+scalar and static array valued header parameters), and individual variable
+length arrays.  Note that each variable length array is stored in the datafile
+as a separate lfile; if the maximum size of an array is less then the page
+size, it will be more efficient to store it as a static array.
+
+The most important example of a variable length array is the main event list
+of the poefile.  To improve i/o efficiency and speed selection, the event
+structs stored in an event list are grouped together into \fIbuckets\fR,
+as discussed earlier in section 2.3.1.2.  Each bucket will always occupy an
+integral number of file pages.  Storage for buckets is allocated contiguously
+in the datafile, and buckets are always read and written to disk in a single
+i/o transfer.
+
+The most important physical datafile parameters are hence the page size and
+the bucket size.  A larger page size can improve i/o efficiency and reduce the
+size of the page table, but can lead to significant wasted space if there are
+many variable length arrays.  Since the i/o system will move entire large
+blocks of pages to and from disk whenever possible, use of a small page is
+normally preferred.  A large bucket size improves i/o efficiency for event
+lists, but if the bucket size is too large then bucket searching takes longer,
+and selection efficiency may decrease.
+
+.NH 4
+File Manager
+
+    The function of the file manager is to map a set of lfiles onto a single
+random access host binary file.  The file manager must keep track of the size
+and type of each file, and whether or not it has been deleted.
+In addition, the file manager must maintain a page table for the entire
+datafile, noting the lfile to which each page is assigned.  While an lfile
+is open the file manager must maintain the page vector for that lfile so that
+lfile offsets may be mapped directly onto datafile offsets.
+
+The number of lfiles is fixed at datafile creation time, and lfiles are
+referred to by file number.  File number zero is the datafile page table;
+the first user lfile is number one.  A datafile with a max file count of one
+would actually contain two lfiles, counting the page table.
+
+The file manager interface is summarized in the figure below.  A new datafile
+may be created or an existing datafile opened with \fIfm_open\fR.
+If a new datafile is being created the page size and max file count may be
+changed from their default values with calls to \fIfm_seti\fR, and the values
+of these and other parameters may be queried at any time with \fIfm_stati\fR.  
+An opened datafile may be copied with \fIfm_copyo\fR, omitting deleted lfiles
+and rendering file segments contiguous.  The page size and max file count
+may be changed in a copy operation if desired.
+
+The \fIfm_access\fR, \fIfm_rename\fR, and \fIfm_delete\fR routines perform
+the indicated operation upon the named datafile.  The \fIfm_rebuild\fR
+routine rebuilds a datafile, discarding deleted structures and coalescing
+storage for objects.  This routine, as well as \fIfm_copy\fR, are built upon
+on the lower level routine \fIfm_copyo\fR,  which does the real work, and
+which allows the structural attributes of the new datafile to be specified
+in \fIfm_seti\fR cals.
+
+All i/o to lfiles is via the six routines beginning with \fIfm_lfopen\fR in
+the figure below.  These routines constitute a FIO binary file driver for
+lfiles, and may be called directly, or passed to the FIO routine \fIfopnbf\fR
+to open an lfile as a binary file (\fIfm_lfname\fR should be called first
+to construct a pseudo-filename for the lfile so that \fIfm_lfopen\fR can
+reconstruct the file manager descriptor, lfile number, and lfile type).
+Note that the lfile driver routines are unbuffered and (potentially)
+asynchronous, and that i/o must be in units of datafile pages.
+(See the buffer cache routines described in the next section for a higher
+level facility for i/o to lfiles).
+
+.nf
+        yes|no = fm_access (datafile, mode)
+                  fm_rename (datafile, newname)
+                    fm_copy (datafile, newname)
+                  fm_delete (datafile)
+                 fm_rebuild (datafile)
+
+               fm = fm_open (datafile, mode)
+                    fm_seti (fm, param, ival)
+            ival = fm_stati (fm, param)
+		   fm_debug (fm, out, what)
+                   fm_copyo (fm, fm_to)
+                    fm_sync (fm)
+                   fm_close (fm)
+
+       lfile = fm_nextlfile (fm)
+                  fm_lfname (fm, lfile, type, lfname, maxch)
+
+                  fm_lfopen (lfname, mode, lf)
+                 fm_lfstati (lf, param, ival)
+                 fm_lfaread (lf, buf, nbytes, offset, status)
+                fm_lfawrite (lf, buf, nbytes, offset, status)
+                 fm_lfawait (lf, status)
+                 fm_lfclose (lf, status)
+
+                  fm_lfstat (fm, lfile, statbuf)
+                fm_lfdelete (fm, lfile)
+              fm_lfundelete (fm, lfile)
+.fi
+
+In a sense, all lfiles exist as zero length files when the datafile is
+created, since the lfile descriptors are preallocated and the files are
+known only by number.  Lfiles become interesting when they are opened as
+files with \fIfm_lfopen\fR, and data is written into the file.  An lfile
+may be deleted with \fIfm_lfstat\fR.  All this does is set the delete bit
+in the lfile descriptor, hence a deleted lfile may later be undeleted with
+\fIfm_lfundelete\fR.  The data in a deleted lfile is not lost until the lfile
+is again opened and written into, or the datafile is rebuilt.  Information
+on a specific lfile (size, type, etc.) may be obtained with \fIfm_lfstat\fR.
+
+There is nothing about the file manager which is specific to QPOE, so it is
+implemented as a separate, standalone facility, and may be used in applications
+other than QPOE.
+
+.NH 4
+Buffer Cache
+
+    For reasons of efficiency, QPOE maintains portions of the datafile in
+memory buffers while a datafile is open.  The main QPOE descriptor, symbol
+table, and file manager descriptor and page table are maintained in special
+runtime data structures internal to the respective interfaces.  All other
+data is stored in lfiles and accessed only upon demand.  In particular,
+storage for all static (non variable length) QPOE header parameters is
+maintained in a single lfile, and storage for each variable length parameter
+is allocated in a separate lfile.
+
+Since most access to QPOE header parameters is via simple gets and puts to
+named parameters, lfile access is handled by QPOE transparently to the client
+applications program.  To avoid excessive disk i/o when randomly accessing
+the datafile, it is desirable for QPOE to maintain a cache of several lfile
+data buffers, e.g., so that accesses to a series of static parameters or
+repeated accesses to read or write different parts of an array parameter
+should incur minimal disk accesses.  This buffer cache is implemented in
+QPOE by simply opening each lfile as a file under FIO, leaving it up to FIO to
+manage the file buffer, and maintaining a LRU cache of open lfiles in QPOE.
+The number of buffers (open lfiles) is controlled by the QP_CACHESIZE
+parameter.  Since the lfile buffer cache is a general datafile related
+facility, it is implemented by the file manager.
+
+.ks
+.nf
+              fd = fm_getfd (fm, lfile, mode, type)
+                   fm_retfd (fm, lfile)
+                 fm_lockout (fm, lfile)
+                 fm_debugfd (fm, out)
+.fi
+.ke
+
+The \fIfm_getfd\fR routine maps an lfile onto a file descriptor.  A file
+descriptor is opened on the lfile only when necessary.  Once opened, an lfile
+remains in the cache until forced out by the LRU replacement algorithm,
+or the datafile is closed.  Removal of an lfile from the cache (closing the
+associated file descriptor) is permitted only after a call to \fIfm_retfd\fR;
+calling this routine does not immediately close the file, it only permits it
+to be closed.  Most calls to \fIfm_getfd\fR should return a file descriptor
+immediately, with very little overhead, with an already active file buffer,
+hence repeated calls to the cache manager and FIO may be made without
+incurring any disk accesses.
+
+Note that lfiles may be opened on file descriptors via direct calls to the
+file manager, regardless of whether these lfiles are already open in the
+buffer cache.  This allows two or more independent file buffers to be
+simultaneously active on the same lfile, but opens the possibility of loss
+of data if the buffers overlap.  If this is a problem, the routine
+\fIfm_lockoutfd\fR may be called to prevent inadvertent use of an lfile by
+the cache.  This should be followed by a call to \fIfm_retfd\fR to clear the
+lockout bit once the reason for the lockout (usually a noncached lfile open)
+is gone.  The routine \fIfm_debugfd\fR will print information on \fIout\fR
+describing the contents of the buffer cache.
+
+.tp 24
+.NH 3
+Interface Structure
+.NH 4 1
+Header Access Package (QP Routines)
+
+    The structure of the general QPOE routines (mostly header access) is
+illustrated in the figure below.
+
+.ks
+.nf
+                                +--------+
+                                |   QP   |
+                                +--------+
+                                 /      \
+                                /        \
+                        +--------+      +--------+
+                        | SYMTAB |      | BCACHE |
+                        +--------+      +--------+
+                                             |
+                                      +--------------+
+                                      | FILE MANAGER |  
+                                      +--------------+
+
+              Figure 1.  Structure of the Header Access Routines
+.fi
+.ke
+
+To fulfill a get or put header access, QPOE will access the symbol table
+(SYMTAB) to lookup the symbol name and determine the symbol datatype, nelem,
+lfile number, and lfile file offset where the value is stored.  The buffer
+cache (BCACHE) and FIO are then called to access the value of the parameter
+in the datafile.
+
+.NH 4
+Filtered Event I/O Package (QPIO)
+
+    The structure of the filtered event i/o package (QPIO) is illustrated in
+the figure below.
+
+.ks
+.nf
+                                +--------+
+                                |  QPIO  |
+                                +--------+
+                                 /   |  \       
+                      __________/    |   \__________
+                     /               |              \
+                +--------+      +--------+      +--------+
+                |  PLIO  |      |  QPEX  |      | BCACHE |
+                +--------+      +--------+      +--------+
+                                     |               |
+                                +--------+    +--------------+
+                                | SYMTAB |    | FILE MANAGER |  
+                                +--------+    +--------------+
+
+                     Figure 2.  Structure of QPIO Routines
+.fi
+.ke
+
+In the typical \fIgetevents\fR call, QPIO will call PLIO to determine the
+next region of the stored image (event list) to access, then if the event
+data is not already in a data buffer, FIO is called to read the data (bucket),
+using the event list index, an integer array valued parameter, to determine
+what bucket to read.  The events in the bucket are then examined and optionally
+filtered via calls to QPEX, returning pointers to the passed events in an
+output argument.  This process terminates when either the mask value changes
+or at least one event has been returned and a new bucket is required to 
+continue reading.
diff --git a/sys/qpoe/README b/sys/qpoe/README
new file mode 100644
index 00000000..dd48198b
--- /dev/null
+++ b/sys/qpoe/README
@@ -0,0 +1,323 @@
+QPOE -- Prototype POE (Position Ordered Event file) Interface.
+See QPOE.hlp for detailed information.
+-----------------------------------------------------------------
+
+
+1. QPOE (General QPOE file access)
+
+		    [ --- external routines --- ]
+
+	       qp_parse (expr, poefile, sz_poefile, paramex, sz_paramex)
+     yes|no = qp_access (poefile, mode)
+	        qp_copy (o_poefile, n_poefile)
+	      qp_rename (o_poefile, n_poefile)
+	     qp_rebuild (poefile)
+	      qp_delete (poefile)
+
+	  ptr = qp_open (poefile, mode, o_qp)
+	     qp_set[ir] (qp, param, value)
+      val = qp_stat[ir] (qp, param)
+	       qp_debug (qp, out, what)
+		qp_sync (qp)
+	       qp_close (qp)
+
+       qp_add[bcsilrdx] (qp, param, value, comment)
+		qp_astr (qp, param, value, comment)
+ val = qp_get[bcsilrdx] (qp, param)
+       nchars = qp_gstr (qp, param, outstr, maxch)
+       qp_put[bcsilrdx] (qp, param, value)
+	        qp_pstr (qp, param, strval)
+
+	    n = qp_read (qp, param, buf, maxelem, first, datatype)
+	       qp_write (qp, param, buf, nelem, first, datatype)
+          fd = qp_popen (qp, param, mode, type)
+	mw = qp_loadwcs (qp)
+	     qp_savewcs (qp, mw)
+
+    yes|no = qp_accessf (qp, param)
+	     qp_deletef (qp, param)
+	     qp_renamef (qp, param, newname)
+	       qp_copyf (o_qp, o_param, n_qp, n_param)
+	        qp_addf (qp, param, datatype, maxelem, comment, flags)
+      nelem = qp_queryf (qp, param, datatype, maxelem, comment, flags)
+        nelem = qp_lenf (qp, param)
+ nchars = qp_expandtext (qp, s1, s2, maxch)
+
+      ptr = qp_ofnl[su] (qp, template)
+	  ptr = qp_ofnl (qp, template, sort)
+	n|EOF = qp_gnfn (fl, outstr, maxch)
+	len = qp_lenfnl (fl)
+	     qp_seekfnl (fl, pos)
+		qp_cfnl (fl)
+
+		    [ --- internal routines --- ]
+
+		qp_bind (qp)
+       dtype = qp_dtype (qp, datatype, dsym)
+nchars = qp_elementsize (qp, datatype)
+     nchars = qp_sizeof (qp, dtype, dsym)
+	     qp_mkfname (poefile, extn, fname, maxch)
+	 ival = qp_ctoi (str, ip, ival)
+	 dval = qp_ctod (str, ip, dval)
+
+	 ptr = qp_gmsym (qp, macro, textp)
+	 ptr = qp_gpsym (qp, param)
+   nfields = qp_parsefl (qp, fieldlist, dd)
+	     qp_inherit (n_qp, o_qp, out)
+    dtype = qp_getparam (qp, param, o_pp)
+    dtype = qp_putparam (qp, param, o_pp)
+	    qp_flushpar (qp)
+
+       gt = qp_opentext (qp, text)			# token i/o
+     token = qp_nexttok (gt)
+      token = qp_gettok (gt, tokbuf, maxch)
+      token = qp_rawtok (gt, outstr, maxch)
+     nargs = qp_arglist (gt, argbuf, maxch)
+	   qp_closetext (gt)
+
+	ptr = qm_access ()				# macros
+	   ch = qm_getc (fd, ch)
+		qm_scan (qm, fname, flags)
+	       qm_scano (qm, fd, flags)
+   qm_[set|upd]defaults (qm, qp)
+	    qm_setparam (qm, param, valstr)
+	ptr = qm_symtab (qm)
+
+
+2. QPIO (Event I/O)
+
+		    [ --- external routines --- ]
+
+         io = qpio_open (qp, paramex, mode)
+	     qpio_close (io)
+
+	  qpio_setrange (io, vs, ve, ndim)
+   ndim = qpio_getrange (io, vs, ve, maxdim)
+	 qpio_setfilter (io, expr)
+nchars = qpio_getfilter (io, outstr, maxch)
+	   qpio_set[ir] (io, param, value)
+    val = qpio_stat[ir] (io, param)
+      mw = qpio_loadwcs (io)
+	   qpio_mkindex (io, key)
+
+	 qpio_putevents (io, i_ev, nevents)
+ n|EOF = qpio_getevents (io, o_ev, maskval, maxev, nev)
+ nev = qpio_readpix[si] (io, obuf, vs, ve, ndim, xblock, yblock)
+
+		    [ --- internal routines --- ]
+
+    ok|err = qpio_parse (io, expr, filter, sz_filter, mask, sz_mask)
+	  qpio_loadmask (io, mask, mergeflg)
+bkno|EOF = qpio_rbucket (io, bkno)
+	   qpio_wbucket (io, n_bkno)
+	      qpio_sync (io)
+
+
+3. QPEX (Event Attribute Filtering)
+
+		    [ --- external routines --- ]
+
+	 ex = qpex_open (qp, expr)
+ok|err = qpex_modfilter (ex, exprlist)
+nchars = qpex_getfilter (ex, outstr, maxch)
+ nc = qpex_getattribute (ex, attribute, outstr, maxch)
+   nr = qpex_attrl[ird] (ex, attribute, xs, xe, xlen)
+    nev = qpex_evaluate (ex, i_ev, o_ev, nev)
+	     qpex_close (ex)
+
+		    [ --- internal routines --- ]
+
+    v = qpex_parse[dir] (expr, xs, xe, xlen)
+  v = qpex_sublist[dir] (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+  v = qpex_codegen[dir] (ex, atname, assignop, expr, offset, dtype)
+	    qpex_delete (ex, offset, dtype)
+
+       ptr = qpex_pbpos (ex)
+     offset = qpex_refd (ex, value)
+     ptr = qpex_dballoc (ex, nelem, dtype)
+      ptr = qpex_dbpstr (ex, strval)
+	     qpex_pbpin (ex, opcode, arg1, arg2, arg3)
+	      qpex_mark (ex, pb_save, db_save)
+	      qpex_free (ex, pb_save, db_save)
+
+   nr = qp_rlmerge[dir] (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+
+4. INTERFACE SYNTAX
+
+Default parameter and domain names:
+
+	"deffilt"	# default event filter (all event lists)
+	"defmask"	# default region mask (all event lists)
+	"deffilt.<evl>"	# default event filter for event list <evl>
+	"defmask.<evl>"	# default region mask for event list <evl>
+	"event"		# default name of user event datatype
+	"events"	# default event-list parameter
+
+QPIO expression syntax:
+
+	[ evl-param ][ `[' [`!'] keyword [(`:='|`='|`+=') expr], ...`]' ]
+
+where <evl-param> defaults to "events" if not given, and where <keyword> may
+be any of the following, or a term of an event attribute expression.
+
+	block		# blocking factor for image matrix
+	debug		# debug level (integer, 0=nodebug)
+	filter		# event attribute filter (expression)
+	key		# event key (Y,X) fields (e.g.(s10,s8))
+	noindex		# don't use index even if present
+	param		# name of event list header parameter
+	mask		# region mask
+	rect		# subregion of image, e.g, rect=[*,100:400]
+
+Any unrecognized keyword=expr terms are passed on to the event attribute
+filter, hence the "filter=(expr)" syntax is optional.
+
+QPEX expression syntax (the <expr> in "filter=<expr>" above):
+
+	'(' attribute=expr [, attribute=expr...] ')'
+
+where <attribute> is the "physical" name (type code plus byte offset) of
+a field of the event structure, and expr is
+
+	%N		bitwise mask test
+	!%N		negated bitwise mask test
+
+or some combination of
+
+	N		equality test
+	:N		open range (less than or equal to N)
+	N:		open range (greater than or equal to N)
+	M:N		range (M to N inclusive)
+	expr,expr,...	list of values or ranges
+	'(' expr ')'	parenthesized expr
+	'!' expr	
+
+MACRO syntax:
+
+	macro		replace <macro> by defined value
+	macro(arg,...)	replace <macro> with argument substitution
+	@file		replace <@file> by contents of file
+	`cmd`		replace <`cmd`> by output of the CL command "cmd",
+			  replacing all newlines by spaces
+	@file(arg,...)	file pushback with argument substitution
+	`cmd`(arg,...)	command output pushback with argument substitution
+
+Macro define syntax:
+
+	define macro replacement-text
+	set parameter value
+
+where <macro> is any identifier, and <replacement-text> is literal text to
+be pushed back into the input and rescanned when <macro> is encountered in
+the input stream.  <replacement-text> may contain symbols of the form '$N'
+denoting places where argument substitution is to be performed during pushback.
+The special builtin macro $DFN will be replaced by the datafile name, returned
+as a string token.
+
+<parameter> denotes a QPOE interface parameter the value of which is to be
+set, e.g., to set the size of a buffer to be created at run time.  The
+following interface parameters are defined:
+
+	"bucketlen"	QPIO bucket length, nevents
+	"cachesize"	number of file descriptors in lfile cache
+	"indexlen"	number of hash entries in symbol table index
+	"maxlfiles"	maximum number of lfiles in datafile
+	"pagesize"	page size, bytes, of datafile
+	"sbufsize"	initial symbol table size, su
+	"stablen"	initial symbol table string buffer size, chars
+	"progbuflen"	QPEX program buffer size (compiled instructions)
+	"databuflen"	QPEX data buffer size (initialized data space)
+	"nodeffilt"	disable the use of any default event filters
+	"nodefmask"	disable the use of any default region masks
+	"maxpushback"	max characters pushback (for macro expansion)
+	"maxfrlutlen"	max full resolution lookup table length
+	"maxrrlutlen"	max reduced resolution lookup table length
+	"lutminranges"	min ranges required before a lookup table is used
+	"lutscale"	scale factor to convert nranges to n LUT bins
+	"blockfactor"	QPIO blocking factor for output pixel arrays
+	"optbufsize"	FIO i/o buffer size for IMIO access to QPOE file, chars
+	"debuglevel"	debug level, 0 for no runtime debug messages
+
+Environment:
+
+	'qmfiles'	an environment variable listing a set of macro
+			define files defining the global macros to be
+			used by QPOE
+
+	'qmsave'	an environment variable defining the name of a
+			file to be used to store the compiled macros
+			(defaults to uparm$qpoe.msv).
+
+
+5. INTERFACE PARAMETERS
+
+# QPSET.H -- User accessible definitions for the QPOE package.
+
+define	SZ_COMMENT		79	# max size comment string
+define	SZ_DATATYPE		79	# max size datatype name string
+
+# QPOE Read-Write Parameters.
+define	QPOE_BLOCKFACTOR	1	# blocking factor for pixel arrays
+define	QPOE_BUCKETLEN		2	# event list bucket length, nevents
+define	QPOE_CACHESIZE		3	# lfile (buffer) cache size, nlfiles
+define	QPOE_DATABUFLEN		4	# QPEX data buffer length, chars
+define	QPOE_DEBUGLEVEL		5	# debug level (0 = no messages)
+define	QPOE_DEFLUTLEN		6	# default lookup table length (bins)
+define	QPOE_INDEXLEN		7	# symbol table hash index length
+define	QPOE_LUTMINRANGES	8	# min ranges before using LUT
+define	QPOE_LUTSCALE		9	# scale nranges to LUT bins
+define	QPOE_MAXFRLUTLEN	10	# max full-res LUT length
+define	QPOE_MAXLFILES		11	# max lfiles in datafile
+define	QPOE_MAXPUSHBACK	12	# max amount of pushed back macro data
+define	QPOE_MAXRRLUTLEN	13	# max reduced-res LUT length
+define	QPOE_OPTBUFSIZE		14	# optimum buffer size for IMIO/QPF/FIO
+define	QPOE_PAGESIZE		15	# page size of datafile, bytes
+define	QPOE_PROGBUFLEN		16	# QPEX program buffer length, ints
+define	QPOE_SBUFSIZE		17	# symtab string buf size, chars (init)
+define	QPOE_STABLEN		18	# symtab data area size, su (init)
+define	QPOE_NODEFFILT		19	# disable use of default filter
+define	QPOE_NODEFMASK		20	# disable use of default mask
+
+# QPOE Read-Only Parameters.
+define	QPOE_FM			21	# FMIO descriptor
+define	QPOE_MODE		22	# poefile access mode
+define	QPOE_ST			23	# SYMTAB symbol table descriptor
+define	QPOE_VERSION		24	# QPOE version number
+
+# Parameter flags (for qp_addf).
+define	QPF_NONE		(-1)	# no flags (0 gives default flags)
+define	QPF_INHERIT		0002B	# copy parameter in a NEW_COPY open
+
+
+# QPIOSET.H -- QPIO User accessible interface parameters.
+
+define	qpio_stati	qpiost		# (name collision with qpio_seti)
+
+# Read-Write Parameters.
+define	QPIO_BLOCKFACTOR	1	# blocking factor for image matrices
+define	QPIO_BUCKETLEN		2	# event list bucket size, nevents
+define	QPIO_DEBUG		3	# debug level, debug=0 for no messages
+define	QPIO_EVXOFF		4	# short offset of X field of event
+define	QPIO_EVYOFF		5	# short offset of Y field of event
+define	QPIO_EX			6	# QPEX descriptor (event attr. filter)
+define	QPIO_NODEFFILT		7	# disable use of default filter
+define	QPIO_NODEFMASK		8	# disable use of default mask
+define	QPIO_NOINDEX		9	# flag to disable use of index
+define	QPIO_OPTBUFSIZE		10	# optimum buffer size for IMIO/QPF/FIO
+define	QPIO_PL			11	# PLIO descriptor (pixel mask)
+
+# Read-Only Parameters.
+define	QPIO_EVENTLEN		12	# length of event struct, shorts
+define	QPIO_FD			13	# file descriptor of event list lfile
+define	QPIO_INDEXLEN		14	# event list index length (0=noindex)
+define	QPIO_IXXOFF		15	# short offset of X field used in index
+define	QPIO_IXYOFF		16	# short offset of Y field used in index
+define	QPIO_LF			17	# lfile in which event list is stored
+define	QPIO_MASKP		18	# char pointer to mask-name buffer
+define	QPIO_MAXEVP		19	# pointer to MAX-event fields struct
+define	QPIO_MINEVP		20	# pointer to MIN-event fields struct
+define	QPIO_NCOLS		21	# number of columns in image
+define	QPIO_NLINES		22	# number of lines in image
+define	QPIO_PARAMP		23	# char pointer to param-name buffer
+define	QPIO_QP			24	# backpointer to QPOE descriptor
diff --git a/sys/qpoe/gen/mkpkg b/sys/qpoe/gen/mkpkg
new file mode 100644
index 00000000..8c08a1f7
--- /dev/null
+++ b/sys/qpoe/gen/mkpkg
@@ -0,0 +1,47 @@
+# Update the generically expanded files in libex.a.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	qpaddb.x	../qpoe.h
+	qpaddc.x	../qpoe.h
+	qpaddd.x	../qpoe.h
+	qpaddi.x	../qpoe.h
+	qpaddl.x	../qpoe.h
+	qpaddr.x	../qpoe.h
+	qpadds.x	../qpoe.h
+	qpaddx.x	../qpoe.h
+	qpexattrld.x	../qpex.h <ctype.h> <mach.h>
+	qpexattrli.x	../qpex.h <ctype.h> <mach.h>
+	qpexattrlr.x	../qpex.h <ctype.h> <mach.h>
+	qpexcoded.x	../qpex.h <mach.h>
+	qpexcodei.x	../qpex.h <mach.h>
+	qpexcoder.x	../qpex.h <mach.h>
+	qpexparsed.x	../qpex.h <ctype.h> <mach.h>
+	qpexparsei.x	../qpex.h <ctype.h> <mach.h>
+	qpexparser.x	../qpex.h <ctype.h> <mach.h>
+	qpexsubd.x	../qpex.h <mach.h>
+	qpexsubi.x	../qpex.h <mach.h>
+	qpexsubr.x	../qpex.h <mach.h>
+	qpgetc.x	../qpoe.h
+	qpgetd.x	../qpoe.h
+	qpgeti.x	../qpoe.h
+	qpgetl.x	../qpoe.h
+	qpgetr.x	../qpoe.h
+	qpgets.x	../qpoe.h
+	qpiogetev.x	../qpio.h <pmset.h>
+	qpiorpixi.x	../qpio.h <mach.h>
+	qpiorpixs.x	../qpio.h <mach.h>
+	qpputc.x	../qpoe.h
+	qpputd.x	../qpoe.h
+	qpputi.x	../qpoe.h
+	qpputl.x	../qpoe.h
+	qpputr.x	../qpoe.h
+	qpputs.x	../qpoe.h
+	qprlmerged.x	../qpex.h <mach.h>
+	qprlmergei.x	../qpex.h <mach.h>
+	qprlmerger.x	../qpex.h <mach.h>
+	;
diff --git a/sys/qpoe/gen/qpaddb.x b/sys/qpoe/gen/qpaddb.x
new file mode 100644
index 00000000..1291824a
--- /dev/null
+++ b/sys/qpoe/gen/qpaddb.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addb (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+bool	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_BOOL]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putb (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddc.x b/sys/qpoe/gen/qpaddc.x
new file mode 100644
index 00000000..64264e20
--- /dev/null
+++ b/sys/qpoe/gen/qpaddc.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addc (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_CHAR]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putc (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddd.x b/sys/qpoe/gen/qpaddd.x
new file mode 100644
index 00000000..61db744e
--- /dev/null
+++ b/sys/qpoe/gen/qpaddd.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addd (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+double	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_DOUBLE]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putd (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddi.x b/sys/qpoe/gen/qpaddi.x
new file mode 100644
index 00000000..47d746c6
--- /dev/null
+++ b/sys/qpoe/gen/qpaddi.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addi (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+int	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_INT]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_puti (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddl.x b/sys/qpoe/gen/qpaddl.x
new file mode 100644
index 00000000..f5e0cac2
--- /dev/null
+++ b/sys/qpoe/gen/qpaddl.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addl (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+long	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_LONG]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putl (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddr.x b/sys/qpoe/gen/qpaddr.x
new file mode 100644
index 00000000..ec367ab7
--- /dev/null
+++ b/sys/qpoe/gen/qpaddr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addr (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+real	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_REAL]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putr (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpadds.x b/sys/qpoe/gen/qpadds.x
new file mode 100644
index 00000000..67036fda
--- /dev/null
+++ b/sys/qpoe/gen/qpadds.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_adds (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+short	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_SHORT]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_puts (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpaddx.x b/sys/qpoe/gen/qpaddx.x
new file mode 100644
index 00000000..d147748e
--- /dev/null
+++ b/sys/qpoe/gen/qpaddx.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_addx (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+complex	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_COMPLEX]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_putx (qp, param, value)
+end
diff --git a/sys/qpoe/gen/qpexattrld.x b/sys/qpoe/gen/qpexattrld.x
new file mode 100644
index 00000000..5954cbe4
--- /dev/null
+++ b/sys/qpoe/gen/qpexattrld.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	"../qpex.h"
+
+# QPEX_ATTRL -- Get the good-value range list for the named attribute, as a
+# binary range list of the indicated type.  This range list is a simplified
+# version of the original filter expression, which may have contained
+# multiple fields, some negated or overlapping, in any order, subsequently
+# modified or deleted with qpex_modfilter, etc.  The final resultant range
+# list is ordered and consists of discreet nonoverlapping ranges.
+#
+# Upon input the variables XS and XE should either point to a pair of
+# preallocated buffers of length XLEN, or they should be set to NULL.
+# The routine will reallocate the buffers as necessary to allow for long
+# range lists, updating XLEN so that it always contains the actual length
+# of the arrays (which may not be completely full).  Each list element
+# consists of a pair of values (xs[i],xe[i]) defining the start and end
+# points of the range.  If xs[1] is INDEF the range is open to the left,
+# if xe[nranges] is INDEF the range is open to the right.  The number of
+# ranges output is returned as the function value.
+
+int procedure qpex_attrld (ex, attribute, xs, xe, xlen)
+
+pointer	ex			#I QPEX descriptor
+char	attribute[ARB]		#I attribute name
+pointer	xs			#U pointer to array of start values
+pointer	xe			#U pointer to array of end values
+int	xlen			#U length of xs/xe arrays
+
+pointer	ps, pe, qs, qe
+pointer	sp, expr, ip, ep
+int	plen, qlen, np, nq, nx
+int	neterms, nchars, maxch
+int	qpex_getattribute(), qpex_parsed(), qp_rlmerged()
+
+begin
+	call smark (sp)
+
+	# Get attribute filter expression.  In the unlikely event that the
+	# expression is too large to fit in our buffer, repeat with a buffer
+	# twice as large until it fits.
+
+	maxch = DEF_SZEXPRBUF
+	nchars = 0
+
+	repeat {
+	    maxch = maxch * 2
+	    call salloc (expr, maxch, TY_CHAR)
+	    nchars = qpex_getattribute (ex, attribute, Memc[expr], maxch)
+	    if (nchars <= 0)
+		break
+	} until (nchars < maxch)
+
+	# Parse expression to produce a range list.  If the expression
+	# contains multiple eterms each is parsed separately and merged
+	# into the final output range list.
+
+	nx = 0
+	neterms = 0
+
+	if (nchars > 0) {
+	    # Get range list storage.
+	    plen = DEF_XLEN
+	    call malloc (ps, plen, TY_DOUBLE)
+	    call malloc (pe, plen, TY_DOUBLE)
+	    qlen = DEF_XLEN
+	    call malloc (qs, qlen, TY_DOUBLE)
+	    call malloc (qe, qlen, TY_DOUBLE)
+
+	    # Parse each subexpression and merge into output range list.
+	    for (ip=expr;  Memc[ip] != EOS;  ) {
+		# Get next subexpression.
+		while (IS_WHITE (Memc[ip]))
+		    ip = ip + 1
+		for (ep=ip;  Memc[ip] != EOS;  ip=ip+1)
+		    if (Memc[ip] == ';') {
+			Memc[ip] = EOS
+			ip = ip + 1
+			break
+		    }
+		if (Memc[ep] == EOS)
+		    break
+
+		# Copy output range list to X list temporary.
+		if (max(nx,1) > plen) {
+		    plen = max(xlen,1)
+		    call realloc (ps, plen, TY_DOUBLE)
+		    call realloc (pe, plen, TY_DOUBLE)
+		}
+		if (neterms <= 0) {
+		    Memd[ps] = LEFTD
+		    Memd[pe] = RIGHTD
+		    np = 1
+		} else {
+		    call amovd (Memd[xs], Memd[ps], nx)
+		    call amovd (Memd[xe], Memd[pe], nx)
+		    np = nx
+		}
+
+		# Parse next eterm into Y list temporary.
+		nq = qpex_parsed (Memc[ep], qs, qe, qlen)
+
+		# Merge the X and Y lists, leaving result in output list.
+		nx = qp_rlmerged (xs,xe,xlen,
+		    Memd[ps], Memd[pe], np, Memd[qs], Memd[qe], nq)
+
+		neterms = neterms + 1
+	    }
+
+	    # Free temporary range list storage.
+	    call mfree (ps, TY_DOUBLE);  call mfree (pe, TY_DOUBLE)
+	    call mfree (qs, TY_DOUBLE);  call mfree (qe, TY_DOUBLE)
+
+	    # Convert LEFT/RIGHT magic values to INDEF.
+	    if (nx > 0) {
+		if (IS_LEFTD (Memd[xs]))
+		    Memd[xs] = INDEFD
+		if (IS_RIGHTD (Memd[xe+nx-1]))
+		    Memd[xe+nx-1] = INDEFD
+	    }
+	}
+
+	call sfree (sp)
+	return (nx)
+end
diff --git a/sys/qpoe/gen/qpexattrli.x b/sys/qpoe/gen/qpexattrli.x
new file mode 100644
index 00000000..706aecc8
--- /dev/null
+++ b/sys/qpoe/gen/qpexattrli.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	"../qpex.h"
+
+# QPEX_ATTRL -- Get the good-value range list for the named attribute, as a
+# binary range list of the indicated type.  This range list is a simplified
+# version of the original filter expression, which may have contained
+# multiple fields, some negated or overlapping, in any order, subsequently
+# modified or deleted with qpex_modfilter, etc.  The final resultant range
+# list is ordered and consists of discreet nonoverlapping ranges.
+#
+# Upon input the variables XS and XE should either point to a pair of
+# preallocated buffers of length XLEN, or they should be set to NULL.
+# The routine will reallocate the buffers as necessary to allow for long
+# range lists, updating XLEN so that it always contains the actual length
+# of the arrays (which may not be completely full).  Each list element
+# consists of a pair of values (xs[i],xe[i]) defining the start and end
+# points of the range.  If xs[1] is INDEF the range is open to the left,
+# if xe[nranges] is INDEF the range is open to the right.  The number of
+# ranges output is returned as the function value.
+
+int procedure qpex_attrli (ex, attribute, xs, xe, xlen)
+
+pointer	ex			#I QPEX descriptor
+char	attribute[ARB]		#I attribute name
+pointer	xs			#U pointer to array of start values
+pointer	xe			#U pointer to array of end values
+int	xlen			#U length of xs/xe arrays
+
+pointer	ps, pe, qs, qe
+pointer	sp, expr, ip, ep
+int	plen, qlen, np, nq, nx
+int	neterms, nchars, maxch
+int	qpex_getattribute(), qpex_parsei(), qp_rlmergei()
+
+begin
+	call smark (sp)
+
+	# Get attribute filter expression.  In the unlikely event that the
+	# expression is too large to fit in our buffer, repeat with a buffer
+	# twice as large until it fits.
+
+	maxch = DEF_SZEXPRBUF
+	nchars = 0
+
+	repeat {
+	    maxch = maxch * 2
+	    call salloc (expr, maxch, TY_CHAR)
+	    nchars = qpex_getattribute (ex, attribute, Memc[expr], maxch)
+	    if (nchars <= 0)
+		break
+	} until (nchars < maxch)
+
+	# Parse expression to produce a range list.  If the expression
+	# contains multiple eterms each is parsed separately and merged
+	# into the final output range list.
+
+	nx = 0
+	neterms = 0
+
+	if (nchars > 0) {
+	    # Get range list storage.
+	    plen = DEF_XLEN
+	    call malloc (ps, plen, TY_INT)
+	    call malloc (pe, plen, TY_INT)
+	    qlen = DEF_XLEN
+	    call malloc (qs, qlen, TY_INT)
+	    call malloc (qe, qlen, TY_INT)
+
+	    # Parse each subexpression and merge into output range list.
+	    for (ip=expr;  Memc[ip] != EOS;  ) {
+		# Get next subexpression.
+		while (IS_WHITE (Memc[ip]))
+		    ip = ip + 1
+		for (ep=ip;  Memc[ip] != EOS;  ip=ip+1)
+		    if (Memc[ip] == ';') {
+			Memc[ip] = EOS
+			ip = ip + 1
+			break
+		    }
+		if (Memc[ep] == EOS)
+		    break
+
+		# Copy output range list to X list temporary.
+		if (max(nx,1) > plen) {
+		    plen = max(xlen,1)
+		    call realloc (ps, plen, TY_INT)
+		    call realloc (pe, plen, TY_INT)
+		}
+		if (neterms <= 0) {
+		    Memi[ps] = LEFTI
+		    Memi[pe] = RIGHTI
+		    np = 1
+		} else {
+		    call amovi (Memi[xs], Memi[ps], nx)
+		    call amovi (Memi[xe], Memi[pe], nx)
+		    np = nx
+		}
+
+		# Parse next eterm into Y list temporary.
+		nq = qpex_parsei (Memc[ep], qs, qe, qlen)
+
+		# Merge the X and Y lists, leaving result in output list.
+		nx = qp_rlmergei (xs,xe,xlen,
+		    Memi[ps], Memi[pe], np, Memi[qs], Memi[qe], nq)
+
+		neterms = neterms + 1
+	    }
+
+	    # Free temporary range list storage.
+	    call mfree (ps, TY_INT);  call mfree (pe, TY_INT)
+	    call mfree (qs, TY_INT);  call mfree (qe, TY_INT)
+
+	    # Convert LEFT/RIGHT magic values to INDEF.
+	    if (nx > 0) {
+		if (IS_LEFTI (Memi[xs]))
+		    Memi[xs] = INDEFI
+		if (IS_RIGHTI (Memi[xe+nx-1]))
+		    Memi[xe+nx-1] = INDEFI
+	    }
+	}
+
+	call sfree (sp)
+	return (nx)
+end
diff --git a/sys/qpoe/gen/qpexattrlr.x b/sys/qpoe/gen/qpexattrlr.x
new file mode 100644
index 00000000..c13a7511
--- /dev/null
+++ b/sys/qpoe/gen/qpexattrlr.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	"../qpex.h"
+
+# QPEX_ATTRL -- Get the good-value range list for the named attribute, as a
+# binary range list of the indicated type.  This range list is a simplified
+# version of the original filter expression, which may have contained
+# multiple fields, some negated or overlapping, in any order, subsequently
+# modified or deleted with qpex_modfilter, etc.  The final resultant range
+# list is ordered and consists of discreet nonoverlapping ranges.
+#
+# Upon input the variables XS and XE should either point to a pair of
+# preallocated buffers of length XLEN, or they should be set to NULL.
+# The routine will reallocate the buffers as necessary to allow for long
+# range lists, updating XLEN so that it always contains the actual length
+# of the arrays (which may not be completely full).  Each list element
+# consists of a pair of values (xs[i],xe[i]) defining the start and end
+# points of the range.  If xs[1] is INDEF the range is open to the left,
+# if xe[nranges] is INDEF the range is open to the right.  The number of
+# ranges output is returned as the function value.
+
+int procedure qpex_attrlr (ex, attribute, xs, xe, xlen)
+
+pointer	ex			#I QPEX descriptor
+char	attribute[ARB]		#I attribute name
+pointer	xs			#U pointer to array of start values
+pointer	xe			#U pointer to array of end values
+int	xlen			#U length of xs/xe arrays
+
+pointer	ps, pe, qs, qe
+pointer	sp, expr, ip, ep
+int	plen, qlen, np, nq, nx
+int	neterms, nchars, maxch
+int	qpex_getattribute(), qpex_parser(), qp_rlmerger()
+
+begin
+	call smark (sp)
+
+	# Get attribute filter expression.  In the unlikely event that the
+	# expression is too large to fit in our buffer, repeat with a buffer
+	# twice as large until it fits.
+
+	maxch = DEF_SZEXPRBUF
+	nchars = 0
+
+	repeat {
+	    maxch = maxch * 2
+	    call salloc (expr, maxch, TY_CHAR)
+	    nchars = qpex_getattribute (ex, attribute, Memc[expr], maxch)
+	    if (nchars <= 0)
+		break
+	} until (nchars < maxch)
+
+	# Parse expression to produce a range list.  If the expression
+	# contains multiple eterms each is parsed separately and merged
+	# into the final output range list.
+
+	nx = 0
+	neterms = 0
+
+	if (nchars > 0) {
+	    # Get range list storage.
+	    plen = DEF_XLEN
+	    call malloc (ps, plen, TY_REAL)
+	    call malloc (pe, plen, TY_REAL)
+	    qlen = DEF_XLEN
+	    call malloc (qs, qlen, TY_REAL)
+	    call malloc (qe, qlen, TY_REAL)
+
+	    # Parse each subexpression and merge into output range list.
+	    for (ip=expr;  Memc[ip] != EOS;  ) {
+		# Get next subexpression.
+		while (IS_WHITE (Memc[ip]))
+		    ip = ip + 1
+		for (ep=ip;  Memc[ip] != EOS;  ip=ip+1)
+		    if (Memc[ip] == ';') {
+			Memc[ip] = EOS
+			ip = ip + 1
+			break
+		    }
+		if (Memc[ep] == EOS)
+		    break
+
+		# Copy output range list to X list temporary.
+		if (max(nx,1) > plen) {
+		    plen = max(xlen,1)
+		    call realloc (ps, plen, TY_REAL)
+		    call realloc (pe, plen, TY_REAL)
+		}
+		if (neterms <= 0) {
+		    Memr[ps] = LEFTR
+		    Memr[pe] = RIGHTR
+		    np = 1
+		} else {
+		    call amovr (Memr[xs], Memr[ps], nx)
+		    call amovr (Memr[xe], Memr[pe], nx)
+		    np = nx
+		}
+
+		# Parse next eterm into Y list temporary.
+		nq = qpex_parser (Memc[ep], qs, qe, qlen)
+
+		# Merge the X and Y lists, leaving result in output list.
+		nx = qp_rlmerger (xs,xe,xlen,
+		    Memr[ps], Memr[pe], np, Memr[qs], Memr[qe], nq)
+
+		neterms = neterms + 1
+	    }
+
+	    # Free temporary range list storage.
+	    call mfree (ps, TY_REAL);  call mfree (pe, TY_REAL)
+	    call mfree (qs, TY_REAL);  call mfree (qe, TY_REAL)
+
+	    # Convert LEFT/RIGHT magic values to INDEF.
+	    if (nx > 0) {
+		if (IS_LEFTR (Memr[xs]))
+		    Memr[xs] = INDEFR
+		if (IS_RIGHTR (Memr[xe+nx-1]))
+		    Memr[xe+nx-1] = INDEFR
+	    }
+	}
+
+	call sfree (sp)
+	return (nx)
+end
diff --git a/sys/qpoe/gen/qpexcoded.x b/sys/qpoe/gen/qpexcoded.x
new file mode 100644
index 00000000..63ec2541
--- /dev/null
+++ b/sys/qpoe/gen/qpexcoded.x
@@ -0,0 +1,370 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QPEX_CODEGEN -- Generate interpreter metacode to evaluate the given
+# expression.  The new code is appended to the current compiled program,
+# adding additional constraints which a data event will have to meet to
+# pass the filter.
+
+int procedure qpex_codegend (ex, atname, assignop, expr, offset, dtype)
+
+pointer ex			#I qpex descriptor
+char	atname[ARB]		#I attribute name (for expr regeneration)
+char	assignop[ARB]		#I "=" or "+=" (for expr regeneration)
+char	expr[ARB]		#I expression to be compiled
+int	offset			#I typed offset of referenced attribute
+int	dtype			#I datatype of referenced attribute
+
+int	nbins, bin, xp
+pointer	lt, lut, lutx, pb
+double	x1, x2, xmin, xmax
+int	xlen, nranges, n_nranges, level, opcode, ip, i
+pointer	pb_save, db_save, xs_buf, xe_buf, xs, xe, n_xs, n_xe, et, prev
+
+double	sv_xs[MAX_LEVELS], sv_xe[MAX_LEVELS]
+pointer	sv_lt[MAX_LEVELS], sv_lut[MAX_LEVELS], sv_lutx[MAX_LEVELS]
+int	sv_xp[MAX_LEVELS], sv_nranges[MAX_LEVELS], sv_bin[MAX_LEVELS]
+int	sv_nbins[MAX_LEVELS]
+
+double	xoffset, xscale
+double	sv_xoffset[MAX_LEVELS], sv_xscale[MAX_LEVELS]
+int	d_x1, d_x2
+int	qpex_refd()
+
+bool	fp_equald()
+
+
+int	qpex_parsed()
+int	stridxs(), btoi(), qpex_sublistd()
+pointer	qpex_dballoc(), qpex_dbpstr(), qpex_pbpos()
+errchk	qpex_dballoc, qpex_pbpin, malloc, calloc, realloc, qpex_parsed
+
+string	qpexwarn "QPEX Warning"
+define	error_ 91
+define	next_  92
+define	null_  93
+define	resume_ 94
+define	bbmask_ 95
+define	continue_ 96
+define	XS Memd[xs+($1)-1]
+define	XE Memd[xe+($1)-1]
+
+begin
+	pb = EX_PB(ex)
+
+	# Save the program state in case we have to abort.
+	call qpex_mark (ex, pb_save, db_save)
+
+	# Allocate and initialize a new expression term descriptor, linking
+	# it onto the tail of the ETTERMs list.
+
+	et = qpex_dballoc (ex, LEN_ETDES, TY_STRUCT)
+
+	ET_ATTTYPE(et)	= dtype
+	ET_ATTOFF(et)	= offset
+	ET_ATNAME(et)	= qpex_dbpstr (ex, atname)
+	ET_ASSIGNOP(et)	= qpex_dbpstr (ex, assignop)
+	ET_EXPRTEXT(et) = qpex_dbpstr (ex, expr)
+	ET_PROGPTR(et)	= qpex_pbpos (ex)
+	ET_DELETED(et)	= NO
+
+	prev = EX_ETTAIL(ex)
+	if (prev != NULL)
+	    ET_NEXT(prev) = et
+	ET_NEXT(et) = NULL
+	EX_ETTAIL(ex) = et
+	if (EX_ETHEAD(ex) == NULL)
+	    EX_ETHEAD(ex) = et
+
+	ip = stridxs ("%", expr)
+	    # Bitmask tests are meaningless for floating point data.
+	    if (ip > 0) {
+		call eprintf ("%s: bitmasks not permitted for floating data\n")
+		    call pargstr (qpexwarn)
+		goto error_
+	    }
+
+	# Compile a general range list expression.  The basic procedure is
+	# to parse the expression to produce an optimized binary range list,
+	# then either compile the range list as an explicit series of
+	# instructions or as a lookup table, depending upon the number of
+	# ranges.
+
+	xlen = DEF_XLEN
+	call malloc (xs_buf, xlen, TY_DOUBLE)
+	call malloc (xe_buf, xlen, TY_DOUBLE)
+
+	# Convert expr to a binary range list and set up the initial context.
+	# Ensure that the range list buffers are large enough to hold any
+	# sublists extracted during compilation.
+
+	nranges = qpex_parsed (expr, xs_buf, xe_buf, xlen)
+	if (xlen < nranges * 2) {
+	    xlen = nranges * 2
+	    call realloc (xs_buf, xlen, TY_DOUBLE)
+	    call realloc (xe_buf, xlen, TY_DOUBLE)
+	}
+
+	xs = xs_buf
+	xe = xe_buf
+	level = 0
+
+	repeat {
+next_
+	    # Compile a new range list (or sublist).
+	    if (nranges <= 0) {
+		# This shouldn't happen.
+null_		call eprintf ("%s: null range list\n")
+		    call pargstr (qpexwarn)
+		call qpex_pbpin (ex, PASS, 0, 0, 0)
+
+	    } else if (nranges == 1) {
+		# Output an instruction to load the data, perform the range
+		# test, and conditionally exit all in a single instruction.
+
+		x1 = XS(1);  x2 = XE(1)
+		    d_x1 = qpex_refd (ex, x1)
+		    d_x2 = qpex_refd (ex, x2)
+
+		if (dtype == TY_SHORT) {
+		    if (IS_LEFTD(x1) && IS_RIGHTD(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTD(x1))
+			call qpex_pbpin (ex, LEQXS, offset, d_x2, 0)
+		    else if (IS_RIGHTD(x2))
+			call qpex_pbpin (ex, GEQXS, offset, d_x1, 0)
+		    else if (fp_equald (x1, x2))
+			call qpex_pbpin (ex, EQLXS, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXS, offset, d_x1, d_x2)
+		} else {
+		    if (IS_LEFTD(x1) && IS_RIGHTD(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTD(x1))
+			call qpex_pbpin (ex, LEQXD, offset, d_x2, 0)
+		    else if (IS_RIGHTD(x2))
+			call qpex_pbpin (ex, GEQXD, offset, d_x1, 0)
+		    else if (fp_equald (x1, x2))
+			call qpex_pbpin (ex, EQLXD, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXD, offset, d_x1, d_x2)
+		}
+
+	    } else if (nranges < EX_LUTMINRANGES(ex)) {
+		# If the number of ranges to be tested for the data is small,
+		# compile explicit code to perform the range tests directly.
+		# Otherwise skip forward and compile a lookup table instead.
+		# In either case, the function of the instructions compiled
+		# is to test the data loaded into the register above, setting
+		# the value of PASS to true if the data lies in any of the
+		# indicated ranges.
+
+		# Check for !X, which is indicated in range list form by a
+		# two element list bracketing the X on each side.
+
+		if (nranges == 2)
+		    if (IS_LEFTD(XS(1)) && IS_RIGHTD(XE(2)))
+			if (fp_equald (XE(1), XS(2))) {
+			    call qpex_pbpin (ex, NEQXD, offset,
+				qpex_refd(ex,XE(1)), 0)
+			    goto resume_
+			}
+
+		# If at level zero, output instruction to load data into
+		# register and initialize PASS to false.  Don't bother if
+		# compiling a subprogram, as these operations will already
+		# have been performed by the caller.
+
+		if (level == 0) {
+			opcode = LDDD
+		    call qpex_pbpin (ex, opcode, offset, 0, 0)
+		}
+
+		# Compile a series of equality or range tests.
+		do i = 1, nranges {
+		    x1 = XS(i);  x2 = XE(i)
+			d_x1 = qpex_refd (ex, x1)
+			d_x2 = qpex_refd (ex, x2)
+
+		    if (IS_LEFTD(x1))
+			call qpex_pbpin (ex, LEQD, d_x2, 0, 0)
+		    else if (IS_RIGHTD(x2))
+			call qpex_pbpin (ex, GEQD, d_x1, 0, 0)
+		    else if (fp_equald (x1, x2))
+			call qpex_pbpin (ex, EQLD, d_x1, d_x2, 0)
+		    else
+			call qpex_pbpin (ex, RNGD, d_x1, d_x2, 0)
+		}
+
+		# Compile a test and exit instruction.
+		call qpex_pbpin (ex, XIFF, 0, 0, 0)
+
+	    } else {
+		# Compile a lookup table test. Lookup tables may be
+		# either compressed or fully resolved.  If compressed
+		# (the resolution of the table is less than that of the
+		# range data, e.g., for floating point lookup tables) a
+		# LUT bin may have as its value, in addition to the
+		# usual 0 or 1, the address of an interpreter subprogram
+		# to be executed to test data values mapping to that bin.
+		# The subprogram pointed to may in turn be another lookup
+		# table, hence in the general case a tree of lookup tables
+		# and little code segments may be compiled to implement
+		# a complex range list test.
+
+		# Get the data range of the lookup table.
+		xmin = XS(1)
+		if (IS_LEFTD(xmin))
+		    xmin = XE(1)
+		xmax = XE(nranges)
+		if (IS_RIGHTD(xmax))
+		    xmax = XS(nranges)
+
+		# Get the lookup table size.  Use a fully resolved table
+		# if the data is integer and the number of bins required
+		# is modest.
+
+		    nbins = min (EX_MAXRRLUTLEN(ex), nranges * EX_LUTSCALE(ex))
+
+		# Determine the mapping from data space to table space.
+		xoffset = xmin
+		    xscale = nbins / (xmax - xmin)
+
+		# Allocate and initialize the lookup table descriptor.
+		lt = qpex_dballoc (ex, LEN_LTDES, TY_STRUCT)
+		call calloc (lut, nbins, TY_SHORT)
+
+		LT_NEXT(lt)	= EX_LTHEAD(ex)
+		EX_LTHEAD(ex)	= lt
+		LT_TYPE(lt)	= TY_DOUBLE
+		LT_LUTP(lt)	= lut
+		LT_NBINS(lt)	= nbins
+		LT_D0(lt)	= xoffset
+		LT_DS(lt)	= xscale
+		LT_LEFT(lt)	= btoi (IS_LEFTD(XS(1)))
+		LT_RIGHT(lt)	= btoi (IS_RIGHTD(XE(nranges)))
+
+		# Compile the LUTX test instruction.  Save a back pointer
+		# to the instruction so that we can edit the jump field in
+		# case a subprogram is compiled after the LUTXt.
+
+		lutx = qpex_pbpos (ex)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, LUTXS, offset, lt, 0)
+		else
+		    call qpex_pbpin (ex, LUTXD, offset, lt, 0)
+
+		xp = 1
+		bin = 1
+continue_
+		n_xs = xs + nranges
+		n_xe = xe + nranges
+
+		# Initialize the lookup table.
+		do i = bin, nbins {
+		    x1 = (i-1) / xscale + xoffset
+			x2 = i / xscale + xoffset
+
+		    # Get sub-rangelist for range x1:x2.
+		    n_nranges = qpex_sublistd (x1, x2,
+			Memd[xs], Memd[xe], nranges, xp,
+			Memd[n_xs], Memd[n_xe])
+
+		    if (n_nranges <= 0) {
+			Mems[lut+i-1] = 0
+
+		    } else if (n_nranges == 1 && IS_LEFTD(Memd[n_xs]) &&
+			IS_RIGHTD(Memd[n_xe])) {
+
+			Mems[lut+i-1] = 1
+
+		    } else {
+			# Compile the sub-rangelist as a subprogram.
+
+			# First set the LUT bin to point to the subprogram.
+			# We cannot use the IP directly here since the LUT
+			# bins are short integer, so store the offset into
+			# the pb instead (guaranteed to be >= 4).
+
+			Mems[lut+i-1] = qpex_pbpos(ex) - pb
+
+			# Push a new context.
+			level = level + 1
+			if (level > MAX_LEVELS) {
+			    call eprintf ("%s: ")
+				call pargstr (qpexwarn)
+			    call eprintf ("Excessive LUT nesting\n")
+			    goto error_
+			}
+
+			# Save current LUT compilation context.
+			sv_xs[level] = xs
+			sv_xe[level] = xe
+			sv_xp[level] = xp
+			sv_xoffset[level] = xoffset
+			sv_xscale[level] = xscale
+			sv_nranges[level] = nranges
+			sv_lt[level] = lt
+			sv_bin[level] = i
+			sv_nbins[level] = nbins
+			sv_lut[level] = lut
+			sv_lutx[level] = lutx
+
+			# Set up context for the new rangelist.
+			xs = n_xs
+			xe = n_xe
+			nranges = n_nranges
+
+			goto next_
+		    }
+		}
+
+		# Compile a test and exit instruction if the LUT calls any
+		# subprograms.
+
+		if (qpex_pbpos(ex) - lutx > LEN_INSTRUCTION)
+		    call qpex_pbpin (ex, XIFF, 0, 0, 0)
+	    }
+resume_
+	    # Resume lookup table compilation if exiting due to LUT-bin
+	    # subprogram compilation.
+
+	    if (level > 0) {
+		# Pop saved context.
+		xs = sv_xs[level]
+		xe = sv_xe[level]
+		xp = sv_xp[level]
+		xoffset = sv_xoffset[level]
+		xscale = sv_xscale[level]
+		nranges = sv_nranges[level]
+		lt = sv_lt[level]
+		bin = sv_bin[level]
+		nbins = sv_nbins[level]
+		lut = sv_lut[level]
+		lutx = sv_lutx[level]
+
+		# Compile a return from subprogram.
+		call qpex_pbpin (ex, RET, 0, 0, 0)
+
+		# Patch up the original LUTX instruction to jump over the
+		# subprogram we have just finished compiling.
+
+		IARG3(lutx) = qpex_pbpos (ex)
+
+		# Resume compilation at the next LUT bin.
+		bin = bin + 1
+		level = level - 1
+		goto continue_
+	    }
+	} until (level <= 0)
+
+	# Finish setting up the eterm descriptor.
+	ET_NINSTR(et) = (qpex_pbpos(ex) - ET_PROGPTR(et)) / LEN_INSTRUCTION
+
+	return (OK)
+error_
+	call qpex_free (ex, pb_save, db_save)
+	return (ERR)
+end
diff --git a/sys/qpoe/gen/qpexcodei.x b/sys/qpoe/gen/qpexcodei.x
new file mode 100644
index 00000000..db8cbc72
--- /dev/null
+++ b/sys/qpoe/gen/qpexcodei.x
@@ -0,0 +1,423 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QPEX_CODEGEN -- Generate interpreter metacode to evaluate the given
+# expression.  The new code is appended to the current compiled program,
+# adding additional constraints which a data event will have to meet to
+# pass the filter.
+
+int procedure qpex_codegeni (ex, atname, assignop, expr, offset, dtype)
+
+pointer ex			#I qpex descriptor
+char	atname[ARB]		#I attribute name (for expr regeneration)
+char	assignop[ARB]		#I "=" or "+=" (for expr regeneration)
+char	expr[ARB]		#I expression to be compiled
+int	offset			#I typed offset of referenced attribute
+int	dtype			#I datatype of referenced attribute
+
+int	nbins, bin, xp
+pointer	lt, lut, lutx, pb
+int	x1, x2, xmin, xmax
+int	xlen, nranges, n_nranges, level, opcode, ip, i
+pointer	pb_save, db_save, xs_buf, xe_buf, xs, xe, n_xs, n_xe, et, prev
+
+int	sv_xs[MAX_LEVELS], sv_xe[MAX_LEVELS]
+pointer	sv_lt[MAX_LEVELS], sv_lut[MAX_LEVELS], sv_lutx[MAX_LEVELS]
+int	sv_xp[MAX_LEVELS], sv_nranges[MAX_LEVELS], sv_bin[MAX_LEVELS]
+int	sv_nbins[MAX_LEVELS]
+
+int	d_x1, d_x2
+real	xoffset, xscale
+real	sv_xoffset[MAX_LEVELS], sv_xscale[MAX_LEVELS]
+
+define	fp_equali($1==$2)
+
+bool	complement
+int	maskval
+int	qp_ctoi()
+
+int	qpex_parsei()
+int	stridxs(), btoi(), qpex_sublisti()
+pointer	qpex_dballoc(), qpex_dbpstr(), qpex_pbpos()
+errchk	qpex_dballoc, qpex_pbpin, malloc, calloc, realloc, qpex_parsei
+
+string	qpexwarn "QPEX Warning"
+define	error_ 91
+define	next_  92
+define	null_  93
+define	resume_ 94
+define	bbmask_ 95
+define	continue_ 96
+define	XS Memi[xs+($1)-1]
+define	XE Memi[xe+($1)-1]
+
+begin
+	pb = EX_PB(ex)
+
+	# Save the program state in case we have to abort.
+	call qpex_mark (ex, pb_save, db_save)
+
+	# Allocate and initialize a new expression term descriptor, linking
+	# it onto the tail of the ETTERMs list.
+
+	et = qpex_dballoc (ex, LEN_ETDES, TY_STRUCT)
+
+	ET_ATTTYPE(et)	= dtype
+	ET_ATTOFF(et)	= offset
+	ET_ATNAME(et)	= qpex_dbpstr (ex, atname)
+	ET_ASSIGNOP(et)	= qpex_dbpstr (ex, assignop)
+	ET_EXPRTEXT(et) = qpex_dbpstr (ex, expr)
+	ET_PROGPTR(et)	= qpex_pbpos (ex)
+	ET_DELETED(et)	= NO
+
+	prev = EX_ETTAIL(ex)
+	if (prev != NULL)
+	    ET_NEXT(prev) = et
+	ET_NEXT(et) = NULL
+	EX_ETTAIL(ex) = et
+	if (EX_ETHEAD(ex) == NULL)
+	    EX_ETHEAD(ex) = et
+
+	ip = stridxs ("%", expr)
+	    # Attempt to compile a bitmask test if `%' is found in the
+	    # expression.  Since bitmasks cannot be mixed with range list
+	    # expressions, this case is handled separately.
+
+	    if (ip > 0) {
+		complement = false
+		level = 0
+
+		# Parse expression (very limited for this case).
+		for (ip=1;  expr[ip] != EOS;  ip=ip+1) {
+		    switch (expr[ip]) {
+		    case '!':
+			complement = !complement
+		    case '(', '[':
+			level = level + 1
+		    case ')', ']':
+			level = level - 1
+		    case '%':
+			ip = ip + 1
+			if (qp_ctoi (expr, ip, maskval) < 0)
+			    goto bbmask_
+			else
+			    ip = ip - 1
+		    default:
+			goto bbmask_
+		    }
+		}
+
+		# Verify paren level, handle errors.
+		if (level != 0) {
+bbmask_		    call eprintf ("%s: bad bitmask expression `%s'\n")
+			call pargstr (qpexwarn)
+			call pargstr (expr)
+			goto error_
+		}
+
+		# Compile the bitmask test.
+		if (complement)
+		    maskval = not(maskval)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, BTTXS, offset, maskval, 0)
+		else
+		    call qpex_pbpin (ex, BTTXI, offset, maskval, 0)
+
+		# Finish setting up the eterm descriptor.
+		ET_NINSTR(et)  = 1
+		return (OK)
+	    }
+
+	# Compile a general range list expression.  The basic procedure is
+	# to parse the expression to produce an optimized binary range list,
+	# then either compile the range list as an explicit series of
+	# instructions or as a lookup table, depending upon the number of
+	# ranges.
+
+	xlen = DEF_XLEN
+	call malloc (xs_buf, xlen, TY_INT)
+	call malloc (xe_buf, xlen, TY_INT)
+
+	# Convert expr to a binary range list and set up the initial context.
+	# Ensure that the range list buffers are large enough to hold any
+	# sublists extracted during compilation.
+
+	nranges = qpex_parsei (expr, xs_buf, xe_buf, xlen)
+	if (xlen < nranges * 2) {
+	    xlen = nranges * 2
+	    call realloc (xs_buf, xlen, TY_INT)
+	    call realloc (xe_buf, xlen, TY_INT)
+	}
+
+	xs = xs_buf
+	xe = xe_buf
+	level = 0
+
+	repeat {
+next_
+	    # Compile a new range list (or sublist).
+	    if (nranges <= 0) {
+		# This shouldn't happen.
+null_		call eprintf ("%s: null range list\n")
+		    call pargstr (qpexwarn)
+		call qpex_pbpin (ex, PASS, 0, 0, 0)
+
+	    } else if (nranges == 1) {
+		# Output an instruction to load the data, perform the range
+		# test, and conditionally exit all in a single instruction.
+
+		x1 = XS(1);  x2 = XE(1)
+		    d_x1 = x1
+		    d_x2 = x2
+
+		if (dtype == TY_SHORT) {
+		    if (IS_LEFTI(x1) && IS_RIGHTI(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTI(x1))
+			call qpex_pbpin (ex, LEQXS, offset, d_x2, 0)
+		    else if (IS_RIGHTI(x2))
+			call qpex_pbpin (ex, GEQXS, offset, d_x1, 0)
+		    else if (fp_equali (x1, x2))
+			call qpex_pbpin (ex, EQLXS, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXS, offset, d_x1, d_x2)
+		} else {
+		    if (IS_LEFTI(x1) && IS_RIGHTI(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTI(x1))
+			call qpex_pbpin (ex, LEQXI, offset, d_x2, 0)
+		    else if (IS_RIGHTI(x2))
+			call qpex_pbpin (ex, GEQXI, offset, d_x1, 0)
+		    else if (fp_equali (x1, x2))
+			call qpex_pbpin (ex, EQLXI, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXI, offset, d_x1, d_x2)
+		}
+
+	    } else if (nranges < EX_LUTMINRANGES(ex)) {
+		# If the number of ranges to be tested for the data is small,
+		# compile explicit code to perform the range tests directly.
+		# Otherwise skip forward and compile a lookup table instead.
+		# In either case, the function of the instructions compiled
+		# is to test the data loaded into the register above, setting
+		# the value of PASS to true if the data lies in any of the
+		# indicated ranges.
+
+		# Check for !X, which is indicated in range list form by a
+		# two element list bracketing the X on each side.
+
+		if (nranges == 2)
+		    if (IS_LEFTI(XS(1)) && IS_RIGHTI(XE(2)))
+			if (XE(1)+1 == XS(2)-1) {
+			    if (dtype == TY_SHORT)
+				opcode = NEQXS
+			    else
+				opcode = NEQXI
+			    call qpex_pbpin (ex, opcode, offset, XE(1)+1, 0)
+			    goto resume_
+			}
+
+		# If at level zero, output instruction to load data into
+		# register and initialize PASS to false.  Don't bother if
+		# compiling a subprogram, as these operations will already
+		# have been performed by the caller.
+
+		if (level == 0) {
+			if (dtype == TY_SHORT)
+			    opcode = LDSI
+			else
+			    opcode = LDII
+		    call qpex_pbpin (ex, opcode, offset, 0, 0)
+		}
+
+		# Compile a series of equality or range tests.
+		do i = 1, nranges {
+		    x1 = XS(i);  x2 = XE(i)
+			d_x1 = x1
+			d_x2 = x2
+
+		    if (IS_LEFTI(x1))
+			call qpex_pbpin (ex, LEQI, d_x2, 0, 0)
+		    else if (IS_RIGHTI(x2))
+			call qpex_pbpin (ex, GEQI, d_x1, 0, 0)
+		    else if (fp_equali (x1, x2))
+			call qpex_pbpin (ex, EQLI, d_x1, d_x2, 0)
+		    else
+			call qpex_pbpin (ex, RNGI, d_x1, d_x2, 0)
+		}
+
+		# Compile a test and exit instruction.
+		call qpex_pbpin (ex, XIFF, 0, 0, 0)
+
+	    } else {
+		# Compile a lookup table test. Lookup tables may be
+		# either compressed or fully resolved.  If compressed
+		# (the resolution of the table is less than that of the
+		# range data, e.g., for floating point lookup tables) a
+		# LUT bin may have as its value, in addition to the
+		# usual 0 or 1, the address of an interpreter subprogram
+		# to be executed to test data values mapping to that bin.
+		# The subprogram pointed to may in turn be another lookup
+		# table, hence in the general case a tree of lookup tables
+		# and little code segments may be compiled to implement
+		# a complex range list test.
+
+		# Get the data range of the lookup table.
+		xmin = XS(1)
+		if (IS_LEFTI(xmin))
+		    xmin = XE(1)
+		xmax = XE(nranges)
+		if (IS_RIGHTI(xmax))
+		    xmax = XS(nranges)
+
+		# Get the lookup table size.  Use a fully resolved table
+		# if the data is integer and the number of bins required
+		# is modest.
+
+		    nbins = xmax - xmin + 1
+		    if (nbins > EX_MAXFRLUTLEN(ex))
+			nbins = min (EX_MAXRRLUTLEN(ex),
+			    nranges * EX_LUTSCALE(ex))
+
+		# Determine the mapping from data space to table space.
+		xoffset = xmin
+		    xscale = nbins / (xmax - xmin + 1)
+
+		# Allocate and initialize the lookup table descriptor.
+		lt = qpex_dballoc (ex, LEN_LTDES, TY_STRUCT)
+		call calloc (lut, nbins, TY_SHORT)
+
+		LT_NEXT(lt)	= EX_LTHEAD(ex)
+		EX_LTHEAD(ex)	= lt
+		LT_TYPE(lt)	= TY_INT
+		LT_LUTP(lt)	= lut
+		LT_NBINS(lt)	= nbins
+		LT_I0(lt)	= xoffset
+		LT_IS(lt)	= xscale
+		LT_LEFT(lt)	= btoi (IS_LEFTI(XS(1)))
+		LT_RIGHT(lt)	= btoi (IS_RIGHTI(XE(nranges)))
+
+		# Compile the LUTX test instruction.  Save a back pointer
+		# to the instruction so that we can edit the jump field in
+		# case a subprogram is compiled after the LUTXt.
+
+		lutx = qpex_pbpos (ex)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, LUTXS, offset, lt, 0)
+		else
+		    call qpex_pbpin (ex, LUTXI, offset, lt, 0)
+
+		xp = 1
+		bin = 1
+continue_
+		n_xs = xs + nranges
+		n_xe = xe + nranges
+
+		# Initialize the lookup table.
+		do i = bin, nbins {
+		    x1 = (i-1) / xscale + xoffset
+			x2 = i / xscale + xoffset - 1
+
+		    # Get sub-rangelist for range x1:x2.
+		    n_nranges = qpex_sublisti (x1, x2,
+			Memi[xs], Memi[xe], nranges, xp,
+			Memi[n_xs], Memi[n_xe])
+
+		    if (n_nranges <= 0) {
+			Mems[lut+i-1] = 0
+
+		    } else if (n_nranges == 1 && IS_LEFTI(Memi[n_xs]) &&
+			IS_RIGHTI(Memi[n_xe])) {
+
+			Mems[lut+i-1] = 1
+
+		    } else {
+			# Compile the sub-rangelist as a subprogram.
+
+			# First set the LUT bin to point to the subprogram.
+			# We cannot use the IP directly here since the LUT
+			# bins are short integer, so store the offset into
+			# the pb instead (guaranteed to be >= 4).
+
+			Mems[lut+i-1] = qpex_pbpos(ex) - pb
+
+			# Push a new context.
+			level = level + 1
+			if (level > MAX_LEVELS) {
+			    call eprintf ("%s: ")
+				call pargstr (qpexwarn)
+			    call eprintf ("Excessive LUT nesting\n")
+			    goto error_
+			}
+
+			# Save current LUT compilation context.
+			sv_xs[level] = xs
+			sv_xe[level] = xe
+			sv_xp[level] = xp
+			sv_xoffset[level] = xoffset
+			sv_xscale[level] = xscale
+			sv_nranges[level] = nranges
+			sv_lt[level] = lt
+			sv_bin[level] = i
+			sv_nbins[level] = nbins
+			sv_lut[level] = lut
+			sv_lutx[level] = lutx
+
+			# Set up context for the new rangelist.
+			xs = n_xs
+			xe = n_xe
+			nranges = n_nranges
+
+			goto next_
+		    }
+		}
+
+		# Compile a test and exit instruction if the LUT calls any
+		# subprograms.
+
+		if (qpex_pbpos(ex) - lutx > LEN_INSTRUCTION)
+		    call qpex_pbpin (ex, XIFF, 0, 0, 0)
+	    }
+resume_
+	    # Resume lookup table compilation if exiting due to LUT-bin
+	    # subprogram compilation.
+
+	    if (level > 0) {
+		# Pop saved context.
+		xs = sv_xs[level]
+		xe = sv_xe[level]
+		xp = sv_xp[level]
+		xoffset = sv_xoffset[level]
+		xscale = sv_xscale[level]
+		nranges = sv_nranges[level]
+		lt = sv_lt[level]
+		bin = sv_bin[level]
+		nbins = sv_nbins[level]
+		lut = sv_lut[level]
+		lutx = sv_lutx[level]
+
+		# Compile a return from subprogram.
+		call qpex_pbpin (ex, RET, 0, 0, 0)
+
+		# Patch up the original LUTX instruction to jump over the
+		# subprogram we have just finished compiling.
+
+		IARG3(lutx) = qpex_pbpos (ex)
+
+		# Resume compilation at the next LUT bin.
+		bin = bin + 1
+		level = level - 1
+		goto continue_
+	    }
+	} until (level <= 0)
+
+	# Finish setting up the eterm descriptor.
+	ET_NINSTR(et) = (qpex_pbpos(ex) - ET_PROGPTR(et)) / LEN_INSTRUCTION
+
+	return (OK)
+error_
+	call qpex_free (ex, pb_save, db_save)
+	return (ERR)
+end
diff --git a/sys/qpoe/gen/qpexcoder.x b/sys/qpoe/gen/qpexcoder.x
new file mode 100644
index 00000000..30e1d85b
--- /dev/null
+++ b/sys/qpoe/gen/qpexcoder.x
@@ -0,0 +1,368 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QPEX_CODEGEN -- Generate interpreter metacode to evaluate the given
+# expression.  The new code is appended to the current compiled program,
+# adding additional constraints which a data event will have to meet to
+# pass the filter.
+
+int procedure qpex_codegenr (ex, atname, assignop, expr, offset, dtype)
+
+pointer ex			#I qpex descriptor
+char	atname[ARB]		#I attribute name (for expr regeneration)
+char	assignop[ARB]		#I "=" or "+=" (for expr regeneration)
+char	expr[ARB]		#I expression to be compiled
+int	offset			#I typed offset of referenced attribute
+int	dtype			#I datatype of referenced attribute
+
+int	nbins, bin, xp
+pointer	lt, lut, lutx, pb
+real	x1, x2, xmin, xmax
+int	xlen, nranges, n_nranges, level, opcode, ip, i
+pointer	pb_save, db_save, xs_buf, xe_buf, xs, xe, n_xs, n_xe, et, prev
+
+real	sv_xs[MAX_LEVELS], sv_xe[MAX_LEVELS]
+pointer	sv_lt[MAX_LEVELS], sv_lut[MAX_LEVELS], sv_lutx[MAX_LEVELS]
+int	sv_xp[MAX_LEVELS], sv_nranges[MAX_LEVELS], sv_bin[MAX_LEVELS]
+int	sv_nbins[MAX_LEVELS]
+
+real	d_x1, d_x2
+real	xoffset, xscale
+real	sv_xoffset[MAX_LEVELS], sv_xscale[MAX_LEVELS]
+
+bool	fp_equalr()
+
+
+int	qpex_parser()
+int	stridxs(), btoi(), qpex_sublistr()
+pointer	qpex_dballoc(), qpex_dbpstr(), qpex_pbpos()
+errchk	qpex_dballoc, qpex_pbpin, malloc, calloc, realloc, qpex_parser
+
+string	qpexwarn "QPEX Warning"
+define	error_ 91
+define	next_  92
+define	null_  93
+define	resume_ 94
+define	bbmask_ 95
+define	continue_ 96
+define	XS Memr[xs+($1)-1]
+define	XE Memr[xe+($1)-1]
+
+begin
+	pb = EX_PB(ex)
+
+	# Save the program state in case we have to abort.
+	call qpex_mark (ex, pb_save, db_save)
+
+	# Allocate and initialize a new expression term descriptor, linking
+	# it onto the tail of the ETTERMs list.
+
+	et = qpex_dballoc (ex, LEN_ETDES, TY_STRUCT)
+
+	ET_ATTTYPE(et)	= dtype
+	ET_ATTOFF(et)	= offset
+	ET_ATNAME(et)	= qpex_dbpstr (ex, atname)
+	ET_ASSIGNOP(et)	= qpex_dbpstr (ex, assignop)
+	ET_EXPRTEXT(et) = qpex_dbpstr (ex, expr)
+	ET_PROGPTR(et)	= qpex_pbpos (ex)
+	ET_DELETED(et)	= NO
+
+	prev = EX_ETTAIL(ex)
+	if (prev != NULL)
+	    ET_NEXT(prev) = et
+	ET_NEXT(et) = NULL
+	EX_ETTAIL(ex) = et
+	if (EX_ETHEAD(ex) == NULL)
+	    EX_ETHEAD(ex) = et
+
+	ip = stridxs ("%", expr)
+	    # Bitmask tests are meaningless for floating point data.
+	    if (ip > 0) {
+		call eprintf ("%s: bitmasks not permitted for floating data\n")
+		    call pargstr (qpexwarn)
+		goto error_
+	    }
+
+	# Compile a general range list expression.  The basic procedure is
+	# to parse the expression to produce an optimized binary range list,
+	# then either compile the range list as an explicit series of
+	# instructions or as a lookup table, depending upon the number of
+	# ranges.
+
+	xlen = DEF_XLEN
+	call malloc (xs_buf, xlen, TY_REAL)
+	call malloc (xe_buf, xlen, TY_REAL)
+
+	# Convert expr to a binary range list and set up the initial context.
+	# Ensure that the range list buffers are large enough to hold any
+	# sublists extracted during compilation.
+
+	nranges = qpex_parser (expr, xs_buf, xe_buf, xlen)
+	if (xlen < nranges * 2) {
+	    xlen = nranges * 2
+	    call realloc (xs_buf, xlen, TY_REAL)
+	    call realloc (xe_buf, xlen, TY_REAL)
+	}
+
+	xs = xs_buf
+	xe = xe_buf
+	level = 0
+
+	repeat {
+next_
+	    # Compile a new range list (or sublist).
+	    if (nranges <= 0) {
+		# This shouldn't happen.
+null_		call eprintf ("%s: null range list\n")
+		    call pargstr (qpexwarn)
+		call qpex_pbpin (ex, PASS, 0, 0, 0)
+
+	    } else if (nranges == 1) {
+		# Output an instruction to load the data, perform the range
+		# test, and conditionally exit all in a single instruction.
+
+		x1 = XS(1);  x2 = XE(1)
+		    d_x1 = x1
+		    d_x2 = x2
+
+		if (dtype == TY_SHORT) {
+		    if (IS_LEFTR(x1) && IS_RIGHTR(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTR(x1))
+			call qpex_pbpin (ex, LEQXS, offset, d_x2, 0)
+		    else if (IS_RIGHTR(x2))
+			call qpex_pbpin (ex, GEQXS, offset, d_x1, 0)
+		    else if (fp_equalr (x1, x2))
+			call qpex_pbpin (ex, EQLXS, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXS, offset, d_x1, d_x2)
+		} else {
+		    if (IS_LEFTR(x1) && IS_RIGHTR(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFTR(x1))
+			call qpex_pbpin (ex, LEQXR, offset, d_x2, 0)
+		    else if (IS_RIGHTR(x2))
+			call qpex_pbpin (ex, GEQXR, offset, d_x1, 0)
+		    else if (fp_equalr (x1, x2))
+			call qpex_pbpin (ex, EQLXR, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXR, offset, d_x1, d_x2)
+		}
+
+	    } else if (nranges < EX_LUTMINRANGES(ex)) {
+		# If the number of ranges to be tested for the data is small,
+		# compile explicit code to perform the range tests directly.
+		# Otherwise skip forward and compile a lookup table instead.
+		# In either case, the function of the instructions compiled
+		# is to test the data loaded into the register above, setting
+		# the value of PASS to true if the data lies in any of the
+		# indicated ranges.
+
+		# Check for !X, which is indicated in range list form by a
+		# two element list bracketing the X on each side.
+
+		if (nranges == 2)
+		    if (IS_LEFTR(XS(1)) && IS_RIGHTR(XE(2)))
+			if (fp_equalr (XE(1), XS(2))) {
+			    call qpex_pbpin (ex, NEQXR, offset, XE(1), 0)
+			    goto resume_
+			}
+
+		# If at level zero, output instruction to load data into
+		# register and initialize PASS to false.  Don't bother if
+		# compiling a subprogram, as these operations will already
+		# have been performed by the caller.
+
+		if (level == 0) {
+			opcode = LDRR
+		    call qpex_pbpin (ex, opcode, offset, 0, 0)
+		}
+
+		# Compile a series of equality or range tests.
+		do i = 1, nranges {
+		    x1 = XS(i);  x2 = XE(i)
+			d_x1 = x1
+			d_x2 = x2
+
+		    if (IS_LEFTR(x1))
+			call qpex_pbpin (ex, LEQR, d_x2, 0, 0)
+		    else if (IS_RIGHTR(x2))
+			call qpex_pbpin (ex, GEQR, d_x1, 0, 0)
+		    else if (fp_equalr (x1, x2))
+			call qpex_pbpin (ex, EQLR, d_x1, d_x2, 0)
+		    else
+			call qpex_pbpin (ex, RNGR, d_x1, d_x2, 0)
+		}
+
+		# Compile a test and exit instruction.
+		call qpex_pbpin (ex, XIFF, 0, 0, 0)
+
+	    } else {
+		# Compile a lookup table test. Lookup tables may be
+		# either compressed or fully resolved.  If compressed
+		# (the resolution of the table is less than that of the
+		# range data, e.g., for floating point lookup tables) a
+		# LUT bin may have as its value, in addition to the
+		# usual 0 or 1, the address of an interpreter subprogram
+		# to be executed to test data values mapping to that bin.
+		# The subprogram pointed to may in turn be another lookup
+		# table, hence in the general case a tree of lookup tables
+		# and little code segments may be compiled to implement
+		# a complex range list test.
+
+		# Get the data range of the lookup table.
+		xmin = XS(1)
+		if (IS_LEFTR(xmin))
+		    xmin = XE(1)
+		xmax = XE(nranges)
+		if (IS_RIGHTR(xmax))
+		    xmax = XS(nranges)
+
+		# Get the lookup table size.  Use a fully resolved table
+		# if the data is integer and the number of bins required
+		# is modest.
+
+		    nbins = min (EX_MAXRRLUTLEN(ex), nranges * EX_LUTSCALE(ex))
+
+		# Determine the mapping from data space to table space.
+		xoffset = xmin
+		    xscale = nbins / (xmax - xmin)
+
+		# Allocate and initialize the lookup table descriptor.
+		lt = qpex_dballoc (ex, LEN_LTDES, TY_STRUCT)
+		call calloc (lut, nbins, TY_SHORT)
+
+		LT_NEXT(lt)	= EX_LTHEAD(ex)
+		EX_LTHEAD(ex)	= lt
+		LT_TYPE(lt)	= TY_REAL
+		LT_LUTP(lt)	= lut
+		LT_NBINS(lt)	= nbins
+		LT_R0(lt)	= xoffset
+		LT_RS(lt)	= xscale
+		LT_LEFT(lt)	= btoi (IS_LEFTR(XS(1)))
+		LT_RIGHT(lt)	= btoi (IS_RIGHTR(XE(nranges)))
+
+		# Compile the LUTX test instruction.  Save a back pointer
+		# to the instruction so that we can edit the jump field in
+		# case a subprogram is compiled after the LUTXt.
+
+		lutx = qpex_pbpos (ex)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, LUTXS, offset, lt, 0)
+		else
+		    call qpex_pbpin (ex, LUTXR, offset, lt, 0)
+
+		xp = 1
+		bin = 1
+continue_
+		n_xs = xs + nranges
+		n_xe = xe + nranges
+
+		# Initialize the lookup table.
+		do i = bin, nbins {
+		    x1 = (i-1) / xscale + xoffset
+			x2 = i / xscale + xoffset
+
+		    # Get sub-rangelist for range x1:x2.
+		    n_nranges = qpex_sublistr (x1, x2,
+			Memr[xs], Memr[xe], nranges, xp,
+			Memr[n_xs], Memr[n_xe])
+
+		    if (n_nranges <= 0) {
+			Mems[lut+i-1] = 0
+
+		    } else if (n_nranges == 1 && IS_LEFTR(Memr[n_xs]) &&
+			IS_RIGHTR(Memr[n_xe])) {
+
+			Mems[lut+i-1] = 1
+
+		    } else {
+			# Compile the sub-rangelist as a subprogram.
+
+			# First set the LUT bin to point to the subprogram.
+			# We cannot use the IP directly here since the LUT
+			# bins are short integer, so store the offset into
+			# the pb instead (guaranteed to be >= 4).
+
+			Mems[lut+i-1] = qpex_pbpos(ex) - pb
+
+			# Push a new context.
+			level = level + 1
+			if (level > MAX_LEVELS) {
+			    call eprintf ("%s: ")
+				call pargstr (qpexwarn)
+			    call eprintf ("Excessive LUT nesting\n")
+			    goto error_
+			}
+
+			# Save current LUT compilation context.
+			sv_xs[level] = xs
+			sv_xe[level] = xe
+			sv_xp[level] = xp
+			sv_xoffset[level] = xoffset
+			sv_xscale[level] = xscale
+			sv_nranges[level] = nranges
+			sv_lt[level] = lt
+			sv_bin[level] = i
+			sv_nbins[level] = nbins
+			sv_lut[level] = lut
+			sv_lutx[level] = lutx
+
+			# Set up context for the new rangelist.
+			xs = n_xs
+			xe = n_xe
+			nranges = n_nranges
+
+			goto next_
+		    }
+		}
+
+		# Compile a test and exit instruction if the LUT calls any
+		# subprograms.
+
+		if (qpex_pbpos(ex) - lutx > LEN_INSTRUCTION)
+		    call qpex_pbpin (ex, XIFF, 0, 0, 0)
+	    }
+resume_
+	    # Resume lookup table compilation if exiting due to LUT-bin
+	    # subprogram compilation.
+
+	    if (level > 0) {
+		# Pop saved context.
+		xs = sv_xs[level]
+		xe = sv_xe[level]
+		xp = sv_xp[level]
+		xoffset = sv_xoffset[level]
+		xscale = sv_xscale[level]
+		nranges = sv_nranges[level]
+		lt = sv_lt[level]
+		bin = sv_bin[level]
+		nbins = sv_nbins[level]
+		lut = sv_lut[level]
+		lutx = sv_lutx[level]
+
+		# Compile a return from subprogram.
+		call qpex_pbpin (ex, RET, 0, 0, 0)
+
+		# Patch up the original LUTX instruction to jump over the
+		# subprogram we have just finished compiling.
+
+		IARG3(lutx) = qpex_pbpos (ex)
+
+		# Resume compilation at the next LUT bin.
+		bin = bin + 1
+		level = level - 1
+		goto continue_
+	    }
+	} until (level <= 0)
+
+	# Finish setting up the eterm descriptor.
+	ET_NINSTR(et) = (qpex_pbpos(ex) - ET_PROGPTR(et)) / LEN_INSTRUCTION
+
+	return (OK)
+error_
+	call qpex_free (ex, pb_save, db_save)
+	return (ERR)
+end
diff --git a/sys/qpoe/gen/qpexparsed.x b/sys/qpoe/gen/qpexparsed.x
new file mode 100644
index 00000000..ec625bd8
--- /dev/null
+++ b/sys/qpoe/gen/qpexparsed.x
@@ -0,0 +1,372 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <mach.h>
+include "../qpex.h"
+
+.help qpexparse
+.nf --------------------------------------------------------------------------
+QPEXPARSE -- Code to parse an event attribute expression, producing a binary
+range list as output.
+
+	nranges = qpex_parse[ird] (expr, xs, xe, xlen)
+
+The calling sequence for the parse routine is shown above.  The arguments XS
+and XE are pointers to dynamically allocated arrays of length XLEN and type
+[IRD].	These arrays should be allocated in the calling program before calling
+the parser, and deallocated when no longer needed.  Reallocation to increase
+the array length is automatic if the arrays fill during parsing.  DTYPE should
+be the same datatype as the attribute with which the list is associated.
+
+The form of an event attribute expression may be a list of values,
+
+	attribute = n
+or
+	attribute = m, n, ...
+
+a list of inclusive or exclusive ranges,
+
+	attribute = m:n, !p:q
+
+including open ranges,
+
+	attribute = :n, p:q
+
+or any combination of the above (excluding combinations of bitmasks and values
+or ranges, which are mutually exclusive):
+
+	attribute = :n, a, b, p:q, !(m, e:f)
+
+Parenthesis may be used for grouping where desired, e.g.,
+
+	attribute = (:n, a, b, p:q, !(m, e:f))
+
+An additional form of the event attribute expression allows use of a bitmask
+to specify the acceptable values, e.g.,
+
+	attribute = %17B
+or
+	attribute = !%17B
+
+however, bitmasks are incompatible with range lists, and should be recognized
+and dealt with elsewhere (bitmasks may not be combined with range lists in
+the same expression term).
+
+We are concerned here only with the attribute value list itself, i.e.,
+everything to the right of the equals sign in the examples above.  This list
+should be extracted and placed into a string containing a single line of
+text before we are called.  Attribute value lists may be any length, but
+backslash continuation, file inclusion (or whatever means is used to form
+the attribute value list) is assumed to be handled at a higher level.
+
+The output of this package is an ordered boolean valued binary range list
+with type integer, real, or double breakpoints (i.e., the breakpoints are the
+same datatype as the attribute itself, but the range values are zero or one).
+The range list defines the initial value, final value, and any interior
+breakpoints where the attribute value changes state.  Expression optimization
+is used to minimize the number of breakpoints (i.e., eliminate redundant
+breakpoints, such as a range within a range).
+
+Output range list format:
+
+	xs[1] xe[1]
+	xs[2] xe[2]
+	    ...
+	xs[N] xe[N]
+
+Where each range is inclusive and only "true" ranges are shown.  If XS[1] is
+LEFT a open-left range (:n) is indicated; if XE[N] is RIGHT an open-right
+range (n:) is indicated.  In an integer range list, isolated points appear
+as a single range with (xe[i]=xs[i]).  In a real or double range list,
+isolated points are represented as finite ranges with a width on the order of
+the machine epsilon.
+.endhelp ---------------------------------------------------------------------
+
+define	DEF_XLEN	256		# default output range list length
+define	INC_XLEN	256		# increment to above
+define	DEF_VLEN	512		# default breakpoint list length
+define	INC_VLEN	512		# increment to above
+define	MAX_NEST	20		# parser stack depth
+
+define	STEP		1		# step at boundary of closed range
+define	ZERO		1000		# step at boundary of open range
+
+define	XV	Memd[xv+($1)-1]	# reference x position values
+define	UV	Memi[uv+($1)-1]		# unique flags for x value pairs
+define	SV	Memi[sv+($1)-1] 	# reference breakpoint step values
+
+
+# QPEX_PARSE -- Convert the given attribute value list into a binary
+# range list, returning the number of ranges as the function value.
+
+int procedure qpex_parsed (expr, xs, xe, xlen)
+
+char	expr[ARB]		#I attribute value list to be parsed
+pointer xs			#U pointer to array of start-range values
+pointer xe			#U pointer to array of	 end-range values
+int	xlen			#U allocated length of XS, XE arrays
+
+bool	range
+pointer xv, uv, sv
+double	xstart, xend, xmin, temp, x, n_xs, n_xe
+int	vlen, nrg, ip, op, ch, ip_start, i, j, jval, r1, r2, y, v, ov, dy
+int	token[MAX_NEST], tokval[MAX_NEST], lev, itemp, umin
+errchk	syserr, malloc, realloc
+define	pop_ 91
+
+double	dtemp
+bool	bval, fp_equald()
+int	qp_ctod()
+
+begin
+	vlen = DEF_VLEN
+	call malloc (xv, vlen, TY_DOUBLE)
+	call malloc (uv, vlen, TY_INT)
+	call malloc (sv, vlen, TY_INT)
+
+	lev = 0
+	nrg = 0
+
+	# Parse the expression string and compile the raw, unoptimized
+	# breakpoint list in the order in which the breakpoints occur in
+	# the string.
+
+	for (ip=1;  expr[ip] != EOS;  ) {
+	    # Skip whitespace.
+	    for (ch=expr[ip];  IS_WHITE(ch) || ch == '\n';  ch=expr[ip])
+		ip = ip + 1
+
+	    # Extract and process token.
+	    switch (ch) {
+	    case EOS:
+		# At end of string.
+		if (lev > 0)
+		    goto pop_
+		else
+		    break
+
+	    case ',':
+		# Comma list token delmiter.
+		ip = ip + 1
+		goto pop_
+
+	    case '!', '(':
+		# Syntactical element - push on stack.
+		ip = ip + 1
+		lev = lev + 1
+		if (lev > MAX_NEST)
+		    call syserr (SYS_QPEXLEVEL)
+		token[lev] = ch
+		tokval[lev] = nrg + 1
+
+	    case ')':
+		# Close parenthesized group and pop parser stack.
+		ip = ip + 1
+		if (lev < 1)
+		    call syserr (SYS_QPEXMLP)
+		else if (token[lev] != '(')
+		    call syserr (SYS_QPEXRPAREN)
+		lev = lev - 1
+		goto pop_
+
+	    default:
+		# Process a range term.
+		ip_start = ip
+
+		# Scan the M in M:N.
+		    if (qp_ctod (expr, ip, dtemp) <= 0)
+			xstart = LEFTD
+		    else
+			xstart = dtemp
+
+		# Scan the : in M:N.  The notation M-N is also accepted,
+		# provided the token - immediately follows the token M.
+
+		while (IS_WHITE(expr[ip]))
+		    ip = ip + 1
+		range = (expr[ip] == ':')
+		if (range)
+		    ip = ip + 1
+		else if (!IS_LEFTD (xstart)) {
+		    range = (expr[ip] == '-')
+		    if (range)
+			ip = ip + 1
+		}
+
+		# Scan the N in M:N.
+		if (range) {
+			if (qp_ctod (expr, ip, dtemp) <= 0)
+			    xend = RIGHTD
+			else
+			    xend = dtemp
+		} else
+		    xend = xstart
+
+		# Fix things if the user entered M:M explicitly.
+		if (range)
+		    if (fp_equald (xstart, xend))
+			range = false
+
+		# Expand a single point into a range.  For an integer list
+		# this produces M:M+1; for a floating list M-eps:M+eps.
+		# Verify ordering and that something recognizable was scanned.
+
+		if (!range) {
+		    if (IS_LEFTD(xstart))
+			call syserr (SYS_QPEXBADRNG)
+		} else {
+		    if (xstart > xend) {
+			temp = xstart;  xstart = xend;  xend = temp
+		    }
+		}
+
+		# Make more space if vectors fill up.
+		if (nrg+4 > vlen) {
+		    vlen = vlen + INC_VLEN
+		    call realloc (xv, vlen, TY_DOUBLE)
+		    call realloc (uv, vlen, TY_INT)
+		    call realloc (sv, vlen, TY_INT)
+		}
+
+		# Save range on intermediate breakpoint list.
+		nrg = nrg + 1
+		XV(nrg) = xstart
+		UV(nrg) = 0
+		SV(nrg) = STEP
+
+		nrg = nrg + 1
+		XV(nrg) = xend
+		UV(nrg) = 1
+		SV(nrg) = -STEP
+pop_
+		# Pop parser stack.
+		if (lev > 0)
+		    if (token[lev] == '!') {
+			# Invert a series of breakpoints.
+			do i = tokval[lev], nrg {
+			    if (SV(i) == STEP)		# invert
+				SV(i) = -ZERO
+			    else if (SV(i) == -STEP)
+				SV(i) = ZERO
+			    else if (SV(i) == ZERO)	# undo
+				SV(i) = -STEP
+			    else if (SV(i) == -ZERO)
+				SV(i) = STEP
+			}
+			lev = lev - 1
+		    }
+	    }
+	}
+
+	# If the first range entered by the user is an exclude range,
+	# e.g., "(!N)" or "(!(expr))" this implies that all other values
+	# are acceptable.  Add the open range ":" to the end of the range
+	# list to indicate this, i.e., convert "!N" to ":,!N".
+
+	if (SV(1) == -ZERO) {
+	    nrg = nrg + 1
+	    XV(nrg) = LEFTD
+	    UV(nrg) = 0
+	    SV(nrg) = STEP
+
+	    nrg = nrg + 1
+	    XV(nrg) = RIGHTD
+	    UV(nrg) = 1
+	    SV(nrg) = -STEP
+	}
+
+	# Sort the breakpoint list.
+	do j = 1, nrg {
+	    xmin = XV(j);  umin = UV(j)
+	    jval = j
+	    do i = j+1, nrg {
+		bval = (XV(i) < xmin)
+		if (!bval)
+		    if (abs (XV(i) - xmin) < 1.0E-5)
+			bval = (fp_equald(XV(i),xmin) && UV(i) < umin)
+		if (bval) {
+		    xmin = XV(i);  umin = UV(i)
+		    jval = i
+		}
+	    }
+	    if (jval != j) {
+		temp  = XV(j);  XV(j) = XV(jval);  XV(jval) = temp
+		itemp = UV(j);  UV(j) = UV(jval);  UV(jval) = itemp
+		itemp = SV(j);  SV(j) = SV(jval);  SV(jval) = itemp
+	    }
+	}
+
+	# Initialize the output arrays if they were passed in as null.
+	if (xlen <= 0) {
+	    xlen = DEF_XLEN
+	    call malloc (xs, xlen, TY_DOUBLE)
+	    call malloc (xe, xlen, TY_DOUBLE)
+	}
+
+	# Collapse sequences of redundant breakpoints into a single
+	# breakpoint, clipping the running sum value to the range 0-1.	
+	# Accumulate and output successive nonzero ranges.
+
+	op = 1
+	ov = 0
+	y  = 0
+
+	for (r1=1;  r1 <= nrg;	r1=r2+1) {
+	    # Get a range of breakpoint entries for a single XV position.
+	    for (r2=r1;  r2 <= nrg;  r2=r2+1) {
+		    bval = (UV(r2) != UV(r1))
+		    if (!bval) {
+			bval = (abs (XV(r2) - XV(r1)) > 1.0E-5)
+			if (!bval)
+			    bval = !fp_equald(XV(r2),XV(r1))
+		    }
+		    if (bval)
+			break
+	    }
+	    r2 = r2 - 1
+
+	    # Collapse into a single breakpoint.
+	    x  = XV(r1)
+	    dy = SV(r1)
+	    do i = r1 + 1, r2
+		dy = dy + SV(i)
+	    y = y + dy
+
+	    # Clip value to the range 0-1.
+	    v = max(0, min(1, y))
+
+	    # Accumulate a range of nonzero value.  This eliminates redundant
+	    # points lying within a range which is already set high.
+
+	    if (v == 1 && ov == 0) {
+		n_xs = x
+		ov = 1
+	    } else if (v == 0 && ov == 1) {
+		    n_xe = x
+		ov = 2
+	    }
+
+	    # Output a range.
+	    if (ov == 2) {
+		if (op > xlen) {
+		    xlen = xlen + INC_XLEN
+		    call realloc (xs, xlen, TY_DOUBLE)
+		    call realloc (xe, xlen, TY_DOUBLE)
+		}
+
+		Memd[xs+op-1] = n_xs
+		Memd[xe+op-1] = n_xe
+		op = op + 1
+
+		ov = 0
+	    }
+	}
+
+	# All done; discard breakpoint buffers.
+	call mfree (xv, TY_DOUBLE)
+	call mfree (uv, TY_INT)
+	call mfree (sv, TY_INT)
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpexparsei.x b/sys/qpoe/gen/qpexparsei.x
new file mode 100644
index 00000000..17d6a569
--- /dev/null
+++ b/sys/qpoe/gen/qpexparsei.x
@@ -0,0 +1,363 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <mach.h>
+include "../qpex.h"
+
+.help qpexparse
+.nf --------------------------------------------------------------------------
+QPEXPARSE -- Code to parse an event attribute expression, producing a binary
+range list as output.
+
+	nranges = qpex_parse[ird] (expr, xs, xe, xlen)
+
+The calling sequence for the parse routine is shown above.  The arguments XS
+and XE are pointers to dynamically allocated arrays of length XLEN and type
+[IRD].	These arrays should be allocated in the calling program before calling
+the parser, and deallocated when no longer needed.  Reallocation to increase
+the array length is automatic if the arrays fill during parsing.  DTYPE should
+be the same datatype as the attribute with which the list is associated.
+
+The form of an event attribute expression may be a list of values,
+
+	attribute = n
+or
+	attribute = m, n, ...
+
+a list of inclusive or exclusive ranges,
+
+	attribute = m:n, !p:q
+
+including open ranges,
+
+	attribute = :n, p:q
+
+or any combination of the above (excluding combinations of bitmasks and values
+or ranges, which are mutually exclusive):
+
+	attribute = :n, a, b, p:q, !(m, e:f)
+
+Parenthesis may be used for grouping where desired, e.g.,
+
+	attribute = (:n, a, b, p:q, !(m, e:f))
+
+An additional form of the event attribute expression allows use of a bitmask
+to specify the acceptable values, e.g.,
+
+	attribute = %17B
+or
+	attribute = !%17B
+
+however, bitmasks are incompatible with range lists, and should be recognized
+and dealt with elsewhere (bitmasks may not be combined with range lists in
+the same expression term).
+
+We are concerned here only with the attribute value list itself, i.e.,
+everything to the right of the equals sign in the examples above.  This list
+should be extracted and placed into a string containing a single line of
+text before we are called.  Attribute value lists may be any length, but
+backslash continuation, file inclusion (or whatever means is used to form
+the attribute value list) is assumed to be handled at a higher level.
+
+The output of this package is an ordered boolean valued binary range list
+with type integer, real, or double breakpoints (i.e., the breakpoints are the
+same datatype as the attribute itself, but the range values are zero or one).
+The range list defines the initial value, final value, and any interior
+breakpoints where the attribute value changes state.  Expression optimization
+is used to minimize the number of breakpoints (i.e., eliminate redundant
+breakpoints, such as a range within a range).
+
+Output range list format:
+
+	xs[1] xe[1]
+	xs[2] xe[2]
+	    ...
+	xs[N] xe[N]
+
+Where each range is inclusive and only "true" ranges are shown.  If XS[1] is
+LEFT a open-left range (:n) is indicated; if XE[N] is RIGHT an open-right
+range (n:) is indicated.  In an integer range list, isolated points appear
+as a single range with (xe[i]=xs[i]).  In a real or double range list,
+isolated points are represented as finite ranges with a width on the order of
+the machine epsilon.
+.endhelp ---------------------------------------------------------------------
+
+define	DEF_XLEN	256		# default output range list length
+define	INC_XLEN	256		# increment to above
+define	DEF_VLEN	512		# default breakpoint list length
+define	INC_VLEN	512		# increment to above
+define	MAX_NEST	20		# parser stack depth
+
+define	STEP		1		# step at boundary of closed range
+define	ZERO		1000		# step at boundary of open range
+
+define	XV	Memi[xv+($1)-1]	# reference x position values
+define	UV	Memi[uv+($1)-1]		# unique flags for x value pairs
+define	SV	Memi[sv+($1)-1] 	# reference breakpoint step values
+
+
+# QPEX_PARSE -- Convert the given attribute value list into a binary
+# range list, returning the number of ranges as the function value.
+
+int procedure qpex_parsei (expr, xs, xe, xlen)
+
+char	expr[ARB]		#I attribute value list to be parsed
+pointer xs			#U pointer to array of start-range values
+pointer xe			#U pointer to array of	 end-range values
+int	xlen			#U allocated length of XS, XE arrays
+
+bool	range
+pointer xv, uv, sv
+int	xstart, xend, xmin, temp, x, n_xs, n_xe
+int	vlen, nrg, ip, op, ch, ip_start, i, j, jval, r1, r2, y, v, ov, dy
+int	token[MAX_NEST], tokval[MAX_NEST], lev, itemp, umin
+errchk	syserr, malloc, realloc
+define	pop_ 91
+
+int	qp_ctoi()
+define	fp_equali($1==$2)
+
+begin
+	vlen = DEF_VLEN
+	call malloc (xv, vlen, TY_INT)
+	call malloc (uv, vlen, TY_INT)
+	call malloc (sv, vlen, TY_INT)
+
+	lev = 0
+	nrg = 0
+
+	# Parse the expression string and compile the raw, unoptimized
+	# breakpoint list in the order in which the breakpoints occur in
+	# the string.
+
+	for (ip=1;  expr[ip] != EOS;  ) {
+	    # Skip whitespace.
+	    for (ch=expr[ip];  IS_WHITE(ch) || ch == '\n';  ch=expr[ip])
+		ip = ip + 1
+
+	    # Extract and process token.
+	    switch (ch) {
+	    case EOS:
+		# At end of string.
+		if (lev > 0)
+		    goto pop_
+		else
+		    break
+
+	    case ',':
+		# Comma list token delmiter.
+		ip = ip + 1
+		goto pop_
+
+	    case '!', '(':
+		# Syntactical element - push on stack.
+		ip = ip + 1
+		lev = lev + 1
+		if (lev > MAX_NEST)
+		    call syserr (SYS_QPEXLEVEL)
+		token[lev] = ch
+		tokval[lev] = nrg + 1
+
+	    case ')':
+		# Close parenthesized group and pop parser stack.
+		ip = ip + 1
+		if (lev < 1)
+		    call syserr (SYS_QPEXMLP)
+		else if (token[lev] != '(')
+		    call syserr (SYS_QPEXRPAREN)
+		lev = lev - 1
+		goto pop_
+
+	    default:
+		# Process a range term.
+		ip_start = ip
+
+		# Scan the M in M:N.
+		    if (qp_ctoi (expr, ip, xstart) <= 0)
+			xstart = LEFTI
+
+		# Scan the : in M:N.  The notation M-N is also accepted,
+		# provided the token - immediately follows the token M.
+
+		while (IS_WHITE(expr[ip]))
+		    ip = ip + 1
+		range = (expr[ip] == ':')
+		if (range)
+		    ip = ip + 1
+		else if (!IS_LEFTI (xstart)) {
+		    range = (expr[ip] == '-')
+		    if (range)
+			ip = ip + 1
+		}
+
+		# Scan the N in M:N.
+		if (range) {
+			if (qp_ctoi (expr, ip, xend) <= 0)
+			    xend = RIGHTI
+		} else
+		    xend = xstart
+
+		# Fix things if the user entered M:M explicitly.
+		if (range)
+		    if (fp_equali (xstart, xend))
+			range = false
+
+		# Expand a single point into a range.  For an integer list
+		# this produces M:M+1; for a floating list M-eps:M+eps.
+		# Verify ordering and that something recognizable was scanned.
+
+		if (!range) {
+		    if (IS_LEFTI(xstart))
+			call syserr (SYS_QPEXBADRNG)
+			xend   = xstart + 1
+		} else {
+		    if (xstart > xend) {
+			temp = xstart;  xstart = xend;  xend = temp
+		    }
+			if (!IS_RIGHTI(xend))
+			    xend = xend + 1
+		}
+
+		# Make more space if vectors fill up.
+		if (nrg+4 > vlen) {
+		    vlen = vlen + INC_VLEN
+		    call realloc (xv, vlen, TY_INT)
+		    call realloc (uv, vlen, TY_INT)
+		    call realloc (sv, vlen, TY_INT)
+		}
+
+		# Save range on intermediate breakpoint list.
+		nrg = nrg + 1
+		XV(nrg) = xstart
+		UV(nrg) = 0
+		SV(nrg) = STEP
+
+		nrg = nrg + 1
+		XV(nrg) = xend
+		UV(nrg) = 1
+		SV(nrg) = -STEP
+pop_
+		# Pop parser stack.
+		if (lev > 0)
+		    if (token[lev] == '!') {
+			# Invert a series of breakpoints.
+			do i = tokval[lev], nrg {
+			    if (SV(i) == STEP)		# invert
+				SV(i) = -ZERO
+			    else if (SV(i) == -STEP)
+				SV(i) = ZERO
+			    else if (SV(i) == ZERO)	# undo
+				SV(i) = -STEP
+			    else if (SV(i) == -ZERO)
+				SV(i) = STEP
+			}
+			lev = lev - 1
+		    }
+	    }
+	}
+
+	# If the first range entered by the user is an exclude range,
+	# e.g., "(!N)" or "(!(expr))" this implies that all other values
+	# are acceptable.  Add the open range ":" to the end of the range
+	# list to indicate this, i.e., convert "!N" to ":,!N".
+
+	if (SV(1) == -ZERO) {
+	    nrg = nrg + 1
+	    XV(nrg) = LEFTI
+	    UV(nrg) = 0
+	    SV(nrg) = STEP
+
+	    nrg = nrg + 1
+	    XV(nrg) = RIGHTI
+	    UV(nrg) = 1
+	    SV(nrg) = -STEP
+	}
+
+	# Sort the breakpoint list.
+	do j = 1, nrg {
+	    xmin = XV(j);  umin = UV(j)
+	    jval = j
+	    do i = j+1, nrg {
+		if (XV(i) < xmin || (XV(i) == xmin && UV(i) < umin)) {
+		    xmin = XV(i);  umin = UV(i)
+		    jval = i
+		}
+	    }
+	    if (jval != j) {
+		temp  = XV(j);  XV(j) = XV(jval);  XV(jval) = temp
+		itemp = UV(j);  UV(j) = UV(jval);  UV(jval) = itemp
+		itemp = SV(j);  SV(j) = SV(jval);  SV(jval) = itemp
+	    }
+	}
+
+	# Initialize the output arrays if they were passed in as null.
+	if (xlen <= 0) {
+	    xlen = DEF_XLEN
+	    call malloc (xs, xlen, TY_INT)
+	    call malloc (xe, xlen, TY_INT)
+	}
+
+	# Collapse sequences of redundant breakpoints into a single
+	# breakpoint, clipping the running sum value to the range 0-1.	
+	# Accumulate and output successive nonzero ranges.
+
+	op = 1
+	ov = 0
+	y  = 0
+
+	for (r1=1;  r1 <= nrg;	r1=r2+1) {
+	    # Get a range of breakpoint entries for a single XV position.
+	    for (r2=r1;  r2 <= nrg;  r2=r2+1) {
+		    if (XV(r2) != XV(r1))
+			break
+	    }
+	    r2 = r2 - 1
+
+	    # Collapse into a single breakpoint.
+	    x  = XV(r1)
+	    dy = SV(r1)
+	    do i = r1 + 1, r2
+		dy = dy + SV(i)
+	    y = y + dy
+
+	    # Clip value to the range 0-1.
+	    v = max(0, min(1, y))
+
+	    # Accumulate a range of nonzero value.  This eliminates redundant
+	    # points lying within a range which is already set high.
+
+	    if (v == 1 && ov == 0) {
+		n_xs = x
+		ov = 1
+	    } else if (v == 0 && ov == 1) {
+		    if (IS_RIGHTI(x))
+			n_xe = x
+		    else
+			n_xe = x - 1
+		ov = 2
+	    }
+
+	    # Output a range.
+	    if (ov == 2) {
+		if (op > xlen) {
+		    xlen = xlen + INC_XLEN
+		    call realloc (xs, xlen, TY_INT)
+		    call realloc (xe, xlen, TY_INT)
+		}
+
+		Memi[xs+op-1] = n_xs
+		Memi[xe+op-1] = n_xe
+		op = op + 1
+
+		ov = 0
+	    }
+	}
+
+	# All done; discard breakpoint buffers.
+	call mfree (xv, TY_INT)
+	call mfree (uv, TY_INT)
+	call mfree (sv, TY_INT)
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpexparser.x b/sys/qpoe/gen/qpexparser.x
new file mode 100644
index 00000000..bf4c849e
--- /dev/null
+++ b/sys/qpoe/gen/qpexparser.x
@@ -0,0 +1,372 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <mach.h>
+include "../qpex.h"
+
+.help qpexparse
+.nf --------------------------------------------------------------------------
+QPEXPARSE -- Code to parse an event attribute expression, producing a binary
+range list as output.
+
+	nranges = qpex_parse[ird] (expr, xs, xe, xlen)
+
+The calling sequence for the parse routine is shown above.  The arguments XS
+and XE are pointers to dynamically allocated arrays of length XLEN and type
+[IRD].	These arrays should be allocated in the calling program before calling
+the parser, and deallocated when no longer needed.  Reallocation to increase
+the array length is automatic if the arrays fill during parsing.  DTYPE should
+be the same datatype as the attribute with which the list is associated.
+
+The form of an event attribute expression may be a list of values,
+
+	attribute = n
+or
+	attribute = m, n, ...
+
+a list of inclusive or exclusive ranges,
+
+	attribute = m:n, !p:q
+
+including open ranges,
+
+	attribute = :n, p:q
+
+or any combination of the above (excluding combinations of bitmasks and values
+or ranges, which are mutually exclusive):
+
+	attribute = :n, a, b, p:q, !(m, e:f)
+
+Parenthesis may be used for grouping where desired, e.g.,
+
+	attribute = (:n, a, b, p:q, !(m, e:f))
+
+An additional form of the event attribute expression allows use of a bitmask
+to specify the acceptable values, e.g.,
+
+	attribute = %17B
+or
+	attribute = !%17B
+
+however, bitmasks are incompatible with range lists, and should be recognized
+and dealt with elsewhere (bitmasks may not be combined with range lists in
+the same expression term).
+
+We are concerned here only with the attribute value list itself, i.e.,
+everything to the right of the equals sign in the examples above.  This list
+should be extracted and placed into a string containing a single line of
+text before we are called.  Attribute value lists may be any length, but
+backslash continuation, file inclusion (or whatever means is used to form
+the attribute value list) is assumed to be handled at a higher level.
+
+The output of this package is an ordered boolean valued binary range list
+with type integer, real, or double breakpoints (i.e., the breakpoints are the
+same datatype as the attribute itself, but the range values are zero or one).
+The range list defines the initial value, final value, and any interior
+breakpoints where the attribute value changes state.  Expression optimization
+is used to minimize the number of breakpoints (i.e., eliminate redundant
+breakpoints, such as a range within a range).
+
+Output range list format:
+
+	xs[1] xe[1]
+	xs[2] xe[2]
+	    ...
+	xs[N] xe[N]
+
+Where each range is inclusive and only "true" ranges are shown.  If XS[1] is
+LEFT a open-left range (:n) is indicated; if XE[N] is RIGHT an open-right
+range (n:) is indicated.  In an integer range list, isolated points appear
+as a single range with (xe[i]=xs[i]).  In a real or double range list,
+isolated points are represented as finite ranges with a width on the order of
+the machine epsilon.
+.endhelp ---------------------------------------------------------------------
+
+define	DEF_XLEN	256		# default output range list length
+define	INC_XLEN	256		# increment to above
+define	DEF_VLEN	512		# default breakpoint list length
+define	INC_VLEN	512		# increment to above
+define	MAX_NEST	20		# parser stack depth
+
+define	STEP		1		# step at boundary of closed range
+define	ZERO		1000		# step at boundary of open range
+
+define	XV	Memr[xv+($1)-1]	# reference x position values
+define	UV	Memi[uv+($1)-1]		# unique flags for x value pairs
+define	SV	Memi[sv+($1)-1] 	# reference breakpoint step values
+
+
+# QPEX_PARSE -- Convert the given attribute value list into a binary
+# range list, returning the number of ranges as the function value.
+
+int procedure qpex_parser (expr, xs, xe, xlen)
+
+char	expr[ARB]		#I attribute value list to be parsed
+pointer xs			#U pointer to array of start-range values
+pointer xe			#U pointer to array of	 end-range values
+int	xlen			#U allocated length of XS, XE arrays
+
+bool	range
+pointer xv, uv, sv
+real	xstart, xend, xmin, temp, x, n_xs, n_xe
+int	vlen, nrg, ip, op, ch, ip_start, i, j, jval, r1, r2, y, v, ov, dy
+int	token[MAX_NEST], tokval[MAX_NEST], lev, itemp, umin
+errchk	syserr, malloc, realloc
+define	pop_ 91
+
+double	dtemp
+bool	bval, fp_equalr()
+int	qp_ctod()
+
+begin
+	vlen = DEF_VLEN
+	call malloc (xv, vlen, TY_REAL)
+	call malloc (uv, vlen, TY_INT)
+	call malloc (sv, vlen, TY_INT)
+
+	lev = 0
+	nrg = 0
+
+	# Parse the expression string and compile the raw, unoptimized
+	# breakpoint list in the order in which the breakpoints occur in
+	# the string.
+
+	for (ip=1;  expr[ip] != EOS;  ) {
+	    # Skip whitespace.
+	    for (ch=expr[ip];  IS_WHITE(ch) || ch == '\n';  ch=expr[ip])
+		ip = ip + 1
+
+	    # Extract and process token.
+	    switch (ch) {
+	    case EOS:
+		# At end of string.
+		if (lev > 0)
+		    goto pop_
+		else
+		    break
+
+	    case ',':
+		# Comma list token delmiter.
+		ip = ip + 1
+		goto pop_
+
+	    case '!', '(':
+		# Syntactical element - push on stack.
+		ip = ip + 1
+		lev = lev + 1
+		if (lev > MAX_NEST)
+		    call syserr (SYS_QPEXLEVEL)
+		token[lev] = ch
+		tokval[lev] = nrg + 1
+
+	    case ')':
+		# Close parenthesized group and pop parser stack.
+		ip = ip + 1
+		if (lev < 1)
+		    call syserr (SYS_QPEXMLP)
+		else if (token[lev] != '(')
+		    call syserr (SYS_QPEXRPAREN)
+		lev = lev - 1
+		goto pop_
+
+	    default:
+		# Process a range term.
+		ip_start = ip
+
+		# Scan the M in M:N.
+		    if (qp_ctod (expr, ip, dtemp) <= 0)
+			xstart = LEFTR
+		    else
+			xstart = dtemp
+
+		# Scan the : in M:N.  The notation M-N is also accepted,
+		# provided the token - immediately follows the token M.
+
+		while (IS_WHITE(expr[ip]))
+		    ip = ip + 1
+		range = (expr[ip] == ':')
+		if (range)
+		    ip = ip + 1
+		else if (!IS_LEFTR (xstart)) {
+		    range = (expr[ip] == '-')
+		    if (range)
+			ip = ip + 1
+		}
+
+		# Scan the N in M:N.
+		if (range) {
+			if (qp_ctod (expr, ip, dtemp) <= 0)
+			    xend = RIGHTR
+			else
+			    xend = dtemp
+		} else
+		    xend = xstart
+
+		# Fix things if the user entered M:M explicitly.
+		if (range)
+		    if (fp_equalr (xstart, xend))
+			range = false
+
+		# Expand a single point into a range.  For an integer list
+		# this produces M:M+1; for a floating list M-eps:M+eps.
+		# Verify ordering and that something recognizable was scanned.
+
+		if (!range) {
+		    if (IS_LEFTR(xstart))
+			call syserr (SYS_QPEXBADRNG)
+		} else {
+		    if (xstart > xend) {
+			temp = xstart;  xstart = xend;  xend = temp
+		    }
+		}
+
+		# Make more space if vectors fill up.
+		if (nrg+4 > vlen) {
+		    vlen = vlen + INC_VLEN
+		    call realloc (xv, vlen, TY_REAL)
+		    call realloc (uv, vlen, TY_INT)
+		    call realloc (sv, vlen, TY_INT)
+		}
+
+		# Save range on intermediate breakpoint list.
+		nrg = nrg + 1
+		XV(nrg) = xstart
+		UV(nrg) = 0
+		SV(nrg) = STEP
+
+		nrg = nrg + 1
+		XV(nrg) = xend
+		UV(nrg) = 1
+		SV(nrg) = -STEP
+pop_
+		# Pop parser stack.
+		if (lev > 0)
+		    if (token[lev] == '!') {
+			# Invert a series of breakpoints.
+			do i = tokval[lev], nrg {
+			    if (SV(i) == STEP)		# invert
+				SV(i) = -ZERO
+			    else if (SV(i) == -STEP)
+				SV(i) = ZERO
+			    else if (SV(i) == ZERO)	# undo
+				SV(i) = -STEP
+			    else if (SV(i) == -ZERO)
+				SV(i) = STEP
+			}
+			lev = lev - 1
+		    }
+	    }
+	}
+
+	# If the first range entered by the user is an exclude range,
+	# e.g., "(!N)" or "(!(expr))" this implies that all other values
+	# are acceptable.  Add the open range ":" to the end of the range
+	# list to indicate this, i.e., convert "!N" to ":,!N".
+
+	if (SV(1) == -ZERO) {
+	    nrg = nrg + 1
+	    XV(nrg) = LEFTR
+	    UV(nrg) = 0
+	    SV(nrg) = STEP
+
+	    nrg = nrg + 1
+	    XV(nrg) = RIGHTR
+	    UV(nrg) = 1
+	    SV(nrg) = -STEP
+	}
+
+	# Sort the breakpoint list.
+	do j = 1, nrg {
+	    xmin = XV(j);  umin = UV(j)
+	    jval = j
+	    do i = j+1, nrg {
+		bval = (XV(i) < xmin)
+		if (!bval)
+		    if (abs (XV(i) - xmin) < 1.0E-5)
+			bval = (fp_equalr(XV(i),xmin) && UV(i) < umin)
+		if (bval) {
+		    xmin = XV(i);  umin = UV(i)
+		    jval = i
+		}
+	    }
+	    if (jval != j) {
+		temp  = XV(j);  XV(j) = XV(jval);  XV(jval) = temp
+		itemp = UV(j);  UV(j) = UV(jval);  UV(jval) = itemp
+		itemp = SV(j);  SV(j) = SV(jval);  SV(jval) = itemp
+	    }
+	}
+
+	# Initialize the output arrays if they were passed in as null.
+	if (xlen <= 0) {
+	    xlen = DEF_XLEN
+	    call malloc (xs, xlen, TY_REAL)
+	    call malloc (xe, xlen, TY_REAL)
+	}
+
+	# Collapse sequences of redundant breakpoints into a single
+	# breakpoint, clipping the running sum value to the range 0-1.	
+	# Accumulate and output successive nonzero ranges.
+
+	op = 1
+	ov = 0
+	y  = 0
+
+	for (r1=1;  r1 <= nrg;	r1=r2+1) {
+	    # Get a range of breakpoint entries for a single XV position.
+	    for (r2=r1;  r2 <= nrg;  r2=r2+1) {
+		    bval = (UV(r2) != UV(r1))
+		    if (!bval) {
+			bval = (abs (XV(r2) - XV(r1)) > 1.0E-5)
+			if (!bval)
+			    bval = !fp_equalr(XV(r2),XV(r1))
+		    }
+		    if (bval)
+			break
+	    }
+	    r2 = r2 - 1
+
+	    # Collapse into a single breakpoint.
+	    x  = XV(r1)
+	    dy = SV(r1)
+	    do i = r1 + 1, r2
+		dy = dy + SV(i)
+	    y = y + dy
+
+	    # Clip value to the range 0-1.
+	    v = max(0, min(1, y))
+
+	    # Accumulate a range of nonzero value.  This eliminates redundant
+	    # points lying within a range which is already set high.
+
+	    if (v == 1 && ov == 0) {
+		n_xs = x
+		ov = 1
+	    } else if (v == 0 && ov == 1) {
+		    n_xe = x
+		ov = 2
+	    }
+
+	    # Output a range.
+	    if (ov == 2) {
+		if (op > xlen) {
+		    xlen = xlen + INC_XLEN
+		    call realloc (xs, xlen, TY_REAL)
+		    call realloc (xe, xlen, TY_REAL)
+		}
+
+		Memr[xs+op-1] = n_xs
+		Memr[xe+op-1] = n_xe
+		op = op + 1
+
+		ov = 0
+	    }
+	}
+
+	# All done; discard breakpoint buffers.
+	call mfree (xv, TY_REAL)
+	call mfree (uv, TY_INT)
+	call mfree (sv, TY_INT)
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpexsubd.x b/sys/qpoe/gen/qpexsubd.x
new file mode 100644
index 00000000..2fab50fd
--- /dev/null
+++ b/sys/qpoe/gen/qpexsubd.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"../qpex.h"
+
+# QPEX_SUBLIST -- Extract a sublist spanning the indicated range from a
+# larger range list.  The number of ranges extracted is returned as the
+# function value.
+
+int procedure qpex_sublistd (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+
+double	x1, x2				#I range to be extracted
+double	xs[nranges],xe[nranges]		#I input range list
+int	nranges				#I nranges in input list
+int	ip				#U start position in input list
+double	o_xs[ARB],o_xe[ARB]		#O output sublist
+
+double	tol
+int	op, i
+
+begin
+	    tol = (EPSILOND * 10.0D0)
+
+	# Determine the range containing or immediately following the
+	# start point of the range of interest.
+
+	while (x1 < xs[ip] && ip > 1)
+	    ip = ip - 1
+	while (x1 >= xs[ip])
+	    if (x1 <= xe[ip] || ip >= nranges)
+		break
+	    else
+		ip = ip + 1
+
+	# Check for an empty output range list.
+	if (xs[ip] > x2)
+	    return (0)
+
+	# At least one input range contributes something to the output region.
+	# Copy a portion of the input range list to the ouput range list.
+
+	op = 1
+	do i = ip, nranges {
+	    if (xs[i] <= x1)
+		o_xs[op] = LEFTD - tol
+	    else
+		o_xs[op] = xs[i]
+
+	    if ((xe[i] - x2) >= tol) {
+		o_xe[op] = RIGHTD + tol
+		op = op + 1
+		break
+	    } else
+		o_xe[op] = xe[i]
+
+	    op = op + 1
+	    if (xs[i+1] > x2)
+		break
+	}
+
+	ip = i
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpexsubi.x b/sys/qpoe/gen/qpexsubi.x
new file mode 100644
index 00000000..62ce5087
--- /dev/null
+++ b/sys/qpoe/gen/qpexsubi.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"../qpex.h"
+
+# QPEX_SUBLIST -- Extract a sublist spanning the indicated range from a
+# larger range list.  The number of ranges extracted is returned as the
+# function value.
+
+int procedure qpex_sublisti (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+
+int	x1, x2				#I range to be extracted
+int	xs[nranges],xe[nranges]		#I input range list
+int	nranges				#I nranges in input list
+int	ip				#U start position in input list
+int	o_xs[ARB],o_xe[ARB]		#O output sublist
+
+int	tol
+int	op, i
+
+begin
+	    tol = 0
+
+	# Determine the range containing or immediately following the
+	# start point of the range of interest.
+
+	while (x1 < xs[ip] && ip > 1)
+	    ip = ip - 1
+	while (x1 >= xs[ip])
+	    if (x1 <= xe[ip] || ip >= nranges)
+		break
+	    else
+		ip = ip + 1
+
+	# Check for an empty output range list.
+	if (xs[ip] > x2)
+	    return (0)
+
+	# At least one input range contributes something to the output region.
+	# Copy a portion of the input range list to the ouput range list.
+
+	op = 1
+	do i = ip, nranges {
+	    if (xs[i] <= x1)
+		o_xs[op] = LEFTI - tol
+	    else
+		o_xs[op] = xs[i]
+
+	    if ((xe[i] - x2) >= tol) {
+		o_xe[op] = RIGHTI + tol
+		op = op + 1
+		break
+	    } else
+		o_xe[op] = xe[i]
+
+	    op = op + 1
+	    if (xs[i+1] > x2)
+		break
+	}
+
+	ip = i
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpexsubr.x b/sys/qpoe/gen/qpexsubr.x
new file mode 100644
index 00000000..147bf14b
--- /dev/null
+++ b/sys/qpoe/gen/qpexsubr.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"../qpex.h"
+
+# QPEX_SUBLIST -- Extract a sublist spanning the indicated range from a
+# larger range list.  The number of ranges extracted is returned as the
+# function value.
+
+int procedure qpex_sublistr (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+
+real	x1, x2				#I range to be extracted
+real	xs[nranges],xe[nranges]		#I input range list
+int	nranges				#I nranges in input list
+int	ip				#U start position in input list
+real	o_xs[ARB],o_xe[ARB]		#O output sublist
+
+real	tol
+int	op, i
+
+begin
+	    tol = (EPSILONR * 10.0)
+
+	# Determine the range containing or immediately following the
+	# start point of the range of interest.
+
+	while (x1 < xs[ip] && ip > 1)
+	    ip = ip - 1
+	while (x1 >= xs[ip])
+	    if (x1 <= xe[ip] || ip >= nranges)
+		break
+	    else
+		ip = ip + 1
+
+	# Check for an empty output range list.
+	if (xs[ip] > x2)
+	    return (0)
+
+	# At least one input range contributes something to the output region.
+	# Copy a portion of the input range list to the ouput range list.
+
+	op = 1
+	do i = ip, nranges {
+	    if (xs[i] <= x1)
+		o_xs[op] = LEFTR - tol
+	    else
+		o_xs[op] = xs[i]
+
+	    if ((xe[i] - x2) >= tol) {
+		o_xe[op] = RIGHTR + tol
+		op = op + 1
+		break
+	    } else
+		o_xe[op] = xe[i]
+
+	    op = op + 1
+	    if (xs[i+1] > x2)
+		break
+	}
+
+	ip = i
+	return (op - 1)
+end
diff --git a/sys/qpoe/gen/qpgetc.x b/sys/qpoe/gen/qpgetc.x
new file mode 100644
index 00000000..1b6ce6fe
--- /dev/null
+++ b/sys/qpoe/gen/qpgetc.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+char procedure qp_getc (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+char	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (NULL)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_CHAR)
+		call pargc (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpgetd.x b/sys/qpoe/gen/qpgetd.x
new file mode 100644
index 00000000..fea90d0f
--- /dev/null
+++ b/sys/qpoe/gen/qpgetd.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+double procedure qp_getd (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+double	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (INDEFD)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_DOUBLE)
+		call pargd (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpgeti.x b/sys/qpoe/gen/qpgeti.x
new file mode 100644
index 00000000..c40d5de6
--- /dev/null
+++ b/sys/qpoe/gen/qpgeti.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+int procedure qp_geti (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+int	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (INDEFI)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_INT)
+		call pargi (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpgetl.x b/sys/qpoe/gen/qpgetl.x
new file mode 100644
index 00000000..804e2def
--- /dev/null
+++ b/sys/qpoe/gen/qpgetl.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+long procedure qp_getl (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+long	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (INDEFL)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_LONG)
+		call pargl (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpgetr.x b/sys/qpoe/gen/qpgetr.x
new file mode 100644
index 00000000..1990a413
--- /dev/null
+++ b/sys/qpoe/gen/qpgetr.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+real procedure qp_getr (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+real	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (INDEFR)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_REAL)
+		call pargr (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpgets.x b/sys/qpoe/gen/qpgets.x
new file mode 100644
index 00000000..3f6500ef
--- /dev/null
+++ b/sys/qpoe/gen/qpgets.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+short procedure qp_gets (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+short	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	    value = (INDEFS)
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_SHORT)
+		call pargs (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/gen/qpiogetev.x b/sys/qpoe/gen/qpiogetev.x
new file mode 100644
index 00000000..7d029a94
--- /dev/null
+++ b/sys/qpoe/gen/qpiogetev.x
@@ -0,0 +1,1968 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	"../qpio.h"
+
+define	RLI_NEXTLINE	9998
+define	RLI_INITIALIZE	9999
+define	SZ_CODE		7
+
+# QPIO_GETEVENTS -- Return a sequence of events sharing the same mask value
+# which satisfy the current event attribute filter.  The returned events will
+# be only those in a rectangular subregion of the image (specified by a prior
+# call to qpio_setrange) which are also visible through the current mask.
+# Sequences of events are returned in storage order until the region is
+# exhausted, at which time EOF is returned.
+#
+# NOTE - If debug statements (printfs) are placed in this code they will cause
+# i/o problems at runtime due to reentrancy, since this routine is called in
+# a low level FIO pseudodevice driver (QPF).  This is also true of any of the
+# routines called by this procedure, and of the related routine QPIO_READPIX.
+
+int procedure qpio_gvtevents (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int	status
+char	code[SZ_CODE]
+int	qpx_gvs(), qpx_gvi(), qpx_gvl(), qpx_gvr(), qpx_gvd()
+errchk	syserrs
+define	err_ 91
+
+begin
+	# The generic routines currently require that X,Y be the same type.
+	# It wouldn't be hard to remove this restriction if necessary, but
+	# it simplifies things and I doubt if a mixed types feature would
+	# be used very often.
+
+	if (IO_EVXTYPE(io) != IO_EVYTYPE(io))
+	    goto err_
+
+	# Get the events.
+	switch (IO_EVXTYPE(io)) {
+	case TY_SHORT:
+	    status = qpx_gvs (io, o_ev, maskval, maxev, o_nev)
+	case TY_INT:
+	    status = qpx_gvi (io, o_ev, maskval, maxev, o_nev)
+	case TY_LONG:
+	    status = qpx_gvl (io, o_ev, maskval, maxev, o_nev)
+	case TY_REAL:
+	    status = qpx_gvr (io, o_ev, maskval, maxev, o_nev)
+	case TY_DOUBLE:
+	    status = qpx_gvd (io, o_ev, maskval, maxev, o_nev)
+	default:
+err_	    call sprintf (code, SZ_CODE, "%d")
+		call pargi (IO_EVXTYPE(io))
+	    call syserrs (SYS_QPINVEVT, code)
+	}
+
+	return (status)
+end
+
+
+
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gvs (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_SHORT + 1
+			xs = Mems[ev_p+ev_xoff]
+			ys = Mems[ev_p+ev_yoff]
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_SHORT + 1
+			xe = Mems[ev_p+ev_xoff]
+			ye = Mems[ev_p+ev_yoff]
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_SHORT + 1
+
+		    x = Mems[ev_p+ev_xoff]
+		    y = Mems[ev_p+ev_yoff]
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_SHORT + 1
+		    x = Mems[ev_p+ev_xoff]
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gvi (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_INT + 1
+			xs = Memi[ev_p+ev_xoff]
+			ys = Memi[ev_p+ev_yoff]
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_INT + 1
+			xe = Memi[ev_p+ev_xoff]
+			ye = Memi[ev_p+ev_yoff]
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_INT + 1
+
+		    x = Memi[ev_p+ev_xoff]
+		    y = Memi[ev_p+ev_yoff]
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_INT + 1
+		    x = Memi[ev_p+ev_xoff]
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gvl (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_LONG + 1
+			xs = Meml[ev_p+ev_xoff]
+			ys = Meml[ev_p+ev_yoff]
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_LONG + 1
+			xe = Meml[ev_p+ev_xoff]
+			ye = Meml[ev_p+ev_yoff]
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_LONG + 1
+
+		    x = Meml[ev_p+ev_xoff]
+		    y = Meml[ev_p+ev_yoff]
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_LONG + 1
+		    x = Meml[ev_p+ev_xoff]
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gvr (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_REAL + 1
+			xs = Memr[ev_p+ev_xoff] + 0.5
+			ys = Memr[ev_p+ev_yoff] + 0.5
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_REAL + 1
+			xe = Memr[ev_p+ev_xoff] + 0.5
+			ye = Memr[ev_p+ev_yoff] + 0.5
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_REAL + 1
+
+		    x = Memr[ev_p+ev_xoff] + 0.5
+		    y = Memr[ev_p+ev_yoff] + 0.5
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_REAL + 1
+		    x = Memr[ev_p+ev_xoff] + 0.5
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gvd (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_DOUBLE + 1
+			xs = Memd[ev_p+ev_xoff] + 0.5
+			ys = Memd[ev_p+ev_yoff] + 0.5
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_DOUBLE + 1
+			xe = Memd[ev_p+ev_xoff] + 0.5
+			ye = Memd[ev_p+ev_yoff] + 0.5
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_DOUBLE + 1
+
+		    x = Memd[ev_p+ev_xoff] + 0.5
+		    y = Memd[ev_p+ev_yoff] + 0.5
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_DOUBLE + 1
+		    x = Memd[ev_p+ev_xoff] + 0.5
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+
diff --git a/sys/qpoe/gen/qpiorpixi.x b/sys/qpoe/gen/qpiorpixi.x
new file mode 100644
index 00000000..c64f0a8a
--- /dev/null
+++ b/sys/qpoe/gen/qpiorpixi.x
@@ -0,0 +1,150 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <syserr.h>
+include	"../qpio.h"
+
+# QPIO_READPIX -- Sample the event list within the indicated rectangular
+# region, using the given blocking factor, to produce a rectangular array
+# of "pixels", where each pixel is a count of the number of events mapping
+# to that location which pass the event attribute filter and region mask.
+#
+# NOTE -- It is left up to the caller to zero the output buffer before
+# we are called.  (We merely increment the counts of the affected pixels).
+
+int procedure qpio_readpixi (io, obuf, vs, ve, ndim, xblock, yblock)
+
+pointer	io			#I QPIO descriptor
+int	obuf[ARB]		#O output pixel buffer
+int	vs[ndim], ve[ndim]	#I vectors defining region to be extracted
+int	ndim			#I should be 2 for QPOE
+real	xblock, yblock		#I blocking factors
+
+double	x, y
+pointer	sp, evl, ev_p
+int	evtype, maxpix, maskval, xoff, yoff, xw, yw, nev, totev, pix, i, j
+errchk	qpio_getevents, qpio_setrange, syserr
+int	qpio_getevents()
+
+begin
+	# Verify arguments.
+	if (xblock <= 0 || xblock > (ve[1] - vs[1] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+	if (yblock <= 0 || yblock > (ve[2] - vs[2] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+
+	# Compute the size of the output matrix in integer pixels.  This
+	# truncates the last partially filled pixel in each axis.
+
+	xw = int ((ve[1] - vs[1] + 1) / xblock + (EPSILOND * 1000))
+	yw = int ((ve[2] - vs[2] + 1) / yblock + (EPSILOND * 1000))
+	if (xw <= 0 || yw <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (evl, SZ_EVLIST, TY_POINTER)
+
+	xoff = IO_EVXOFF(io)
+	yoff = IO_EVYOFF(io)
+	maxpix = xw * yw
+	totev = 0
+
+	evtype = IO_EVXTYPE(io)
+	if (IO_EVXTYPE(io) != IO_EVYTYPE(io))
+	    call syserr (SYS_QPINVEVT)
+
+	# Define the region from which we wish to read events.
+	call qpio_setrange (io, vs, ve, ndim)
+
+	# Read the events.
+	while (qpio_getevents (io, Memi[evl], maskval, SZ_EVLIST, nev) > 0) {
+	    switch (evtype) {
+
+	    case TY_SHORT:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_SHORT + 1
+
+		    x = Mems[ev_p+xoff]  
+		    y = Mems[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_INT:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_INT + 1
+
+		    x = Memi[ev_p+xoff]  
+		    y = Memi[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_LONG:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_LONG + 1
+
+		    x = Meml[ev_p+xoff]  
+		    y = Meml[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_REAL:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_REAL + 1
+
+		    x = Memr[ev_p+xoff]  
+		    y = Memr[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_DOUBLE + 1
+
+		    x = Memd[ev_p+xoff]  
+		    y = Memd[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    }
+
+	    totev = totev + nev
+	}
+
+	call sfree (sp)
+	return (totev)
+end
diff --git a/sys/qpoe/gen/qpiorpixs.x b/sys/qpoe/gen/qpiorpixs.x
new file mode 100644
index 00000000..d97c7c42
--- /dev/null
+++ b/sys/qpoe/gen/qpiorpixs.x
@@ -0,0 +1,150 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <syserr.h>
+include	"../qpio.h"
+
+# QPIO_READPIX -- Sample the event list within the indicated rectangular
+# region, using the given blocking factor, to produce a rectangular array
+# of "pixels", where each pixel is a count of the number of events mapping
+# to that location which pass the event attribute filter and region mask.
+#
+# NOTE -- It is left up to the caller to zero the output buffer before
+# we are called.  (We merely increment the counts of the affected pixels).
+
+int procedure qpio_readpixs (io, obuf, vs, ve, ndim, xblock, yblock)
+
+pointer	io			#I QPIO descriptor
+short	obuf[ARB]		#O output pixel buffer
+int	vs[ndim], ve[ndim]	#I vectors defining region to be extracted
+int	ndim			#I should be 2 for QPOE
+real	xblock, yblock		#I blocking factors
+
+double	x, y
+pointer	sp, evl, ev_p
+int	evtype, maxpix, maskval, xoff, yoff, xw, yw, nev, totev, pix, i, j
+errchk	qpio_getevents, qpio_setrange, syserr
+int	qpio_getevents()
+
+begin
+	# Verify arguments.
+	if (xblock <= 0 || xblock > (ve[1] - vs[1] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+	if (yblock <= 0 || yblock > (ve[2] - vs[2] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+
+	# Compute the size of the output matrix in integer pixels.  This
+	# truncates the last partially filled pixel in each axis.
+
+	xw = int ((ve[1] - vs[1] + 1) / xblock + (EPSILOND * 1000))
+	yw = int ((ve[2] - vs[2] + 1) / yblock + (EPSILOND * 1000))
+	if (xw <= 0 || yw <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (evl, SZ_EVLIST, TY_POINTER)
+
+	xoff = IO_EVXOFF(io)
+	yoff = IO_EVYOFF(io)
+	maxpix = xw * yw
+	totev = 0
+
+	evtype = IO_EVXTYPE(io)
+	if (IO_EVXTYPE(io) != IO_EVYTYPE(io))
+	    call syserr (SYS_QPINVEVT)
+
+	# Define the region from which we wish to read events.
+	call qpio_setrange (io, vs, ve, ndim)
+
+	# Read the events.
+	while (qpio_getevents (io, Memi[evl], maskval, SZ_EVLIST, nev) > 0) {
+	    switch (evtype) {
+
+	    case TY_SHORT:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_SHORT + 1
+
+		    x = Mems[ev_p+xoff]  
+		    y = Mems[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_INT:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_INT + 1
+
+		    x = Memi[ev_p+xoff]  
+		    y = Memi[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_LONG:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_LONG + 1
+
+		    x = Meml[ev_p+xoff]  
+		    y = Meml[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_REAL:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_REAL + 1
+
+		    x = Memr[ev_p+xoff]  
+		    y = Memr[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    case TY_DOUBLE:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_DOUBLE + 1
+
+		    x = Memd[ev_p+xoff]  
+		    y = Memd[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+
+	    }
+
+	    totev = totev + nev
+	}
+
+	call sfree (sp)
+	return (totev)
+end
diff --git a/sys/qpoe/gen/qpputc.x b/sys/qpoe/gen/qpputc.x
new file mode 100644
index 00000000..4415a177
--- /dev/null
+++ b/sys/qpoe/gen/qpputc.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_putc (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_CHAR)
+		call pargi (dtype)
+		call pargc (value)
+	}
+
+	indef = IS_INDEF(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qpputd.x b/sys/qpoe/gen/qpputd.x
new file mode 100644
index 00000000..2c9883e0
--- /dev/null
+++ b/sys/qpoe/gen/qpputd.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_putd (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+double	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_DOUBLE)
+		call pargi (dtype)
+		call pargd (value)
+	}
+
+	indef = IS_INDEFD(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qpputi.x b/sys/qpoe/gen/qpputi.x
new file mode 100644
index 00000000..528e6bc7
--- /dev/null
+++ b/sys/qpoe/gen/qpputi.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_puti (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+int	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_INT)
+		call pargi (dtype)
+		call pargi (value)
+	}
+
+	indef = IS_INDEFI(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qpputl.x b/sys/qpoe/gen/qpputl.x
new file mode 100644
index 00000000..50e6605a
--- /dev/null
+++ b/sys/qpoe/gen/qpputl.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_putl (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+long	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_LONG)
+		call pargi (dtype)
+		call pargl (value)
+	}
+
+	indef = IS_INDEFL(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qpputr.x b/sys/qpoe/gen/qpputr.x
new file mode 100644
index 00000000..10af764b
--- /dev/null
+++ b/sys/qpoe/gen/qpputr.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_putr (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+real	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_REAL)
+		call pargi (dtype)
+		call pargr (value)
+	}
+
+	indef = IS_INDEFR(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qpputs.x b/sys/qpoe/gen/qpputs.x
new file mode 100644
index 00000000..ec58607a
--- /dev/null
+++ b/sys/qpoe/gen/qpputs.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_puts (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+short	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_SHORT)
+		call pargi (dtype)
+		call pargs (value)
+	}
+
+	indef = IS_INDEFS(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/gen/qprlmerged.x b/sys/qpoe/gen/qprlmerged.x
new file mode 100644
index 00000000..d08f4e5f
--- /dev/null
+++ b/sys/qpoe/gen/qprlmerged.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QP_RLMERGE -- Merge (AND) two range lists.  Only ranges which are
+# common to both range lists are output.  The number of ranges in the
+# output range list is returned as the function value.
+
+int procedure qp_rlmerged (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+pointer	os, oe			#U output range list
+int	olen			#U allocated length of OS, OE arrays
+
+double	xs[ARB], xe[ARB]	#I range list to be merged with
+int	nx			#I number of ranges in X list
+double	ys[ARB], ye[ARB]	#I range list to be merged with X
+int	ny			#I number of ranges in Y list
+
+double	o1, o2
+int	nx_out, xi, yi, i
+double	qp_minvald(), qp_maxvald()
+bool	qp_lessthand()
+errchk	realloc
+
+begin
+	nx_out = 0
+	if (nx <= 0 || ny <= 0)
+	    return (0)
+
+	xi = 1
+	yi = 1
+
+	do i = 1, ARB {
+	    # Find a pair of ranges which intersect.
+	    repeat {
+		if (qp_lessthand (xe[xi], ys[yi])) {
+		    if (xi >= nx)
+			return (nx_out)
+		    else
+			xi = xi + 1
+		} else if (qp_lessthand (ye[yi], xs[xi])) {
+		    if (yi >= ny)
+			return (nx_out)
+		    else
+			yi = yi + 1
+		} else
+		    break
+	    }
+
+	    # Compute the intersection.
+	    o1 = qp_maxvald (xs[xi], ys[yi])
+	    o2 = qp_minvald (xe[xi], ye[yi])
+
+	    # Output the range.
+	    if (nx_out + 1 > olen) {
+		olen = max (DEF_XLEN, olen * 2)
+		call realloc (os, olen, TY_DOUBLE)
+		call realloc (oe, olen, TY_DOUBLE)
+	    }
+
+	    Memd[os+nx_out] = o1
+	    Memd[oe+nx_out] = o2
+	    nx_out = nx_out + 1
+
+	    # Advance to the next range.
+	    if (xi < nx && qp_lessthand (xe[xi], ye[yi]))
+		xi = xi + 1
+	    else if (yi < ny)
+		yi = yi + 1
+	    else
+		break
+	}
+
+	return (nx_out)
+end
+
+
+# QP_MINVAL -- Return the lesser of two values, where either value can
+# be an open range.
+
+double procedure qp_minvald (x, y)
+
+double	x			#I first value
+double	y			#I second value
+
+bool	qp_lessthand()
+
+begin
+	if (qp_lessthand (x, y))
+	    return (x)
+	else
+	    return (y)
+end
+
+
+# QP_MAXVAL -- Return the greater of two values, where either value can
+# be an open range.
+
+double procedure qp_maxvald (x, y)
+
+double	x			#I first value
+double	y			#I second value
+
+bool	qp_lessthand()
+
+begin
+	if (qp_lessthand (x, y))
+	    return (y)
+	else
+	    return (x)
+end
+
+
+# QP_LESSTHAN -- Test if X is less than Y, where X and Y can be open
+# range values.
+
+bool procedure qp_lessthand (x, y)
+
+double	x			#I first value
+double	y			#I second value
+
+begin
+	if (IS_LEFTD(x))
+	    return (!IS_LEFTD(y))
+	else if (IS_RIGHTD(x))
+	    return (false)
+	else if (IS_LEFTD(y))
+	    return (false)
+	else if (IS_RIGHTD(y))
+	    return (true)
+	else
+	    return (x < y)
+end
diff --git a/sys/qpoe/gen/qprlmergei.x b/sys/qpoe/gen/qprlmergei.x
new file mode 100644
index 00000000..f8476178
--- /dev/null
+++ b/sys/qpoe/gen/qprlmergei.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QP_RLMERGE -- Merge (AND) two range lists.  Only ranges which are
+# common to both range lists are output.  The number of ranges in the
+# output range list is returned as the function value.
+
+int procedure qp_rlmergei (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+pointer	os, oe			#U output range list
+int	olen			#U allocated length of OS, OE arrays
+
+int	xs[ARB], xe[ARB]	#I range list to be merged with
+int	nx			#I number of ranges in X list
+int	ys[ARB], ye[ARB]	#I range list to be merged with X
+int	ny			#I number of ranges in Y list
+
+int	o1, o2
+int	nx_out, xi, yi, i
+int	qp_minvali(), qp_maxvali()
+bool	qp_lessthani()
+errchk	realloc
+
+begin
+	nx_out = 0
+	if (nx <= 0 || ny <= 0)
+	    return (0)
+
+	xi = 1
+	yi = 1
+
+	do i = 1, ARB {
+	    # Find a pair of ranges which intersect.
+	    repeat {
+		if (qp_lessthani (xe[xi], ys[yi])) {
+		    if (xi >= nx)
+			return (nx_out)
+		    else
+			xi = xi + 1
+		} else if (qp_lessthani (ye[yi], xs[xi])) {
+		    if (yi >= ny)
+			return (nx_out)
+		    else
+			yi = yi + 1
+		} else
+		    break
+	    }
+
+	    # Compute the intersection.
+	    o1 = qp_maxvali (xs[xi], ys[yi])
+	    o2 = qp_minvali (xe[xi], ye[yi])
+
+	    # Output the range.
+	    if (nx_out + 1 > olen) {
+		olen = max (DEF_XLEN, olen * 2)
+		call realloc (os, olen, TY_INT)
+		call realloc (oe, olen, TY_INT)
+	    }
+
+	    Memi[os+nx_out] = o1
+	    Memi[oe+nx_out] = o2
+	    nx_out = nx_out + 1
+
+	    # Advance to the next range.
+	    if (xi < nx && qp_lessthani (xe[xi], ye[yi]))
+		xi = xi + 1
+	    else if (yi < ny)
+		yi = yi + 1
+	    else
+		break
+	}
+
+	return (nx_out)
+end
+
+
+# QP_MINVAL -- Return the lesser of two values, where either value can
+# be an open range.
+
+int procedure qp_minvali (x, y)
+
+int	x			#I first value
+int	y			#I second value
+
+bool	qp_lessthani()
+
+begin
+	if (qp_lessthani (x, y))
+	    return (x)
+	else
+	    return (y)
+end
+
+
+# QP_MAXVAL -- Return the greater of two values, where either value can
+# be an open range.
+
+int procedure qp_maxvali (x, y)
+
+int	x			#I first value
+int	y			#I second value
+
+bool	qp_lessthani()
+
+begin
+	if (qp_lessthani (x, y))
+	    return (y)
+	else
+	    return (x)
+end
+
+
+# QP_LESSTHAN -- Test if X is less than Y, where X and Y can be open
+# range values.
+
+bool procedure qp_lessthani (x, y)
+
+int	x			#I first value
+int	y			#I second value
+
+begin
+	if (IS_LEFTI(x))
+	    return (!IS_LEFTI(y))
+	else if (IS_RIGHTI(x))
+	    return (false)
+	else if (IS_LEFTI(y))
+	    return (false)
+	else if (IS_RIGHTI(y))
+	    return (true)
+	else
+	    return (x < y)
+end
diff --git a/sys/qpoe/gen/qprlmerger.x b/sys/qpoe/gen/qprlmerger.x
new file mode 100644
index 00000000..a776a5db
--- /dev/null
+++ b/sys/qpoe/gen/qprlmerger.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QP_RLMERGE -- Merge (AND) two range lists.  Only ranges which are
+# common to both range lists are output.  The number of ranges in the
+# output range list is returned as the function value.
+
+int procedure qp_rlmerger (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+pointer	os, oe			#U output range list
+int	olen			#U allocated length of OS, OE arrays
+
+real	xs[ARB], xe[ARB]	#I range list to be merged with
+int	nx			#I number of ranges in X list
+real	ys[ARB], ye[ARB]	#I range list to be merged with X
+int	ny			#I number of ranges in Y list
+
+real	o1, o2
+int	nx_out, xi, yi, i
+real	qp_minvalr(), qp_maxvalr()
+bool	qp_lessthanr()
+errchk	realloc
+
+begin
+	nx_out = 0
+	if (nx <= 0 || ny <= 0)
+	    return (0)
+
+	xi = 1
+	yi = 1
+
+	do i = 1, ARB {
+	    # Find a pair of ranges which intersect.
+	    repeat {
+		if (qp_lessthanr (xe[xi], ys[yi])) {
+		    if (xi >= nx)
+			return (nx_out)
+		    else
+			xi = xi + 1
+		} else if (qp_lessthanr (ye[yi], xs[xi])) {
+		    if (yi >= ny)
+			return (nx_out)
+		    else
+			yi = yi + 1
+		} else
+		    break
+	    }
+
+	    # Compute the intersection.
+	    o1 = qp_maxvalr (xs[xi], ys[yi])
+	    o2 = qp_minvalr (xe[xi], ye[yi])
+
+	    # Output the range.
+	    if (nx_out + 1 > olen) {
+		olen = max (DEF_XLEN, olen * 2)
+		call realloc (os, olen, TY_REAL)
+		call realloc (oe, olen, TY_REAL)
+	    }
+
+	    Memr[os+nx_out] = o1
+	    Memr[oe+nx_out] = o2
+	    nx_out = nx_out + 1
+
+	    # Advance to the next range.
+	    if (xi < nx && qp_lessthanr (xe[xi], ye[yi]))
+		xi = xi + 1
+	    else if (yi < ny)
+		yi = yi + 1
+	    else
+		break
+	}
+
+	return (nx_out)
+end
+
+
+# QP_MINVAL -- Return the lesser of two values, where either value can
+# be an open range.
+
+real procedure qp_minvalr (x, y)
+
+real	x			#I first value
+real	y			#I second value
+
+bool	qp_lessthanr()
+
+begin
+	if (qp_lessthanr (x, y))
+	    return (x)
+	else
+	    return (y)
+end
+
+
+# QP_MAXVAL -- Return the greater of two values, where either value can
+# be an open range.
+
+real procedure qp_maxvalr (x, y)
+
+real	x			#I first value
+real	y			#I second value
+
+bool	qp_lessthanr()
+
+begin
+	if (qp_lessthanr (x, y))
+	    return (y)
+	else
+	    return (x)
+end
+
+
+# QP_LESSTHAN -- Test if X is less than Y, where X and Y can be open
+# range values.
+
+bool procedure qp_lessthanr (x, y)
+
+real	x			#I first value
+real	y			#I second value
+
+begin
+	if (IS_LEFTR(x))
+	    return (!IS_LEFTR(y))
+	else if (IS_RIGHTR(x))
+	    return (false)
+	else if (IS_LEFTR(y))
+	    return (false)
+	else if (IS_RIGHTR(y))
+	    return (true)
+	else
+	    return (x < y)
+end
diff --git a/sys/qpoe/mkpkg b/sys/qpoe/mkpkg
new file mode 100644
index 00000000..b7553b0f
--- /dev/null
+++ b/sys/qpoe/mkpkg
@@ -0,0 +1,133 @@
+# Make the QPOE (position ordered event file) library.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+zzdebug:
+zzdebug.e:
+	$checkout libex.a lib$
+	$update   libex.a
+	$checkin  libex.a lib$
+
+	$omake	zzdebug.x <error.h> <ctype.h> <qpset.h> <qpexset.h> "qpoe.h"
+	$link	-z zzdebug.o
+	;
+
+generic:
+	$set GFLAGS = "-k -t  csilrd  -p gen/"
+	$ifolder (gen/qpgeti.x, qpget.gx) $generic $(GFLAGS) qpget.gx $endif
+	$ifolder (gen/qpputi.x, qpput.gx) $generic $(GFLAGS) qpput.gx $endif
+
+	$set GFLAGS = "-k -t bcsilrdx -p gen/"
+	$ifolder (gen/qpaddb.x, qpadd.gx) $generic $(GFLAGS) qpadd.gx $endif
+
+	$set GFLAGS = "-k -t ird -p gen/"
+	$ifolder (gen/qpexattrli.x, qpexattrl.gx)
+	    $generic $(GFLAGS) qpexattrl.gx		$endif
+	$ifolder (gen/qpexcodei.x, qpexcode.gx)
+	    $generic $(GFLAGS) qpexcode.gx		$endif
+	$ifolder (gen/qpexparsei.x, qpexparse.gx)
+	    $generic $(GFLAGS) qpexparse.gx		$endif
+	$ifolder (gen/qpexsubi.x, qpexsub.gx)
+	    $generic $(GFLAGS) qpexsub.gx		$endif
+
+	$ifolder (gen/qprlmergei.x, qprlmerge.gx)
+	    $generic $(GFLAGS) qprlmerge.gx		$endif
+
+	$set GFLAGS = "-k -t si -p gen/"
+	$ifolder (gen/qpiorpixi.x, qpiorpix.gx)
+	    $generic $(GFLAGS) qpiorpix.gx		$endif
+	$ifolder (gen/qpiogetev.x, qpiogetev.gx)
+	    $generic -k -o gen/qpiogetev.x qpiogetev.gx	$endif
+	;
+
+libex.a:
+	# Retranslate any recently modified generic sources.
+	$ifeq (hostid, unix)
+	    $call generic
+	$endif
+
+	@gen		# Update datatype expanded files.
+
+	qpaccess.x	qpoe.h
+	qpaccessf.x	qpoe.h
+	qpaddf.x	qpoe.h <error.h> <qpset.h>
+	qpastr.x	qpoe.h
+	qpbind.x	qpoe.h <fmset.h>
+	qpclose.x	qpoe.h
+	qpcopy.x	qpoe.h
+	qpcopyf.x	qpoe.h <qpset.h>
+	qpctod.x	
+	qpctoi.x	<lexnum.h>
+	qpdelete.x	qpoe.h
+	qpdeletef.x	qpoe.h
+	qpdsym.x	qpoe.h
+	qpdtype.x	qpoe.h <ctype.h>
+	qpelsize.x	
+	qpexclose.x	qpex.h <mach.h>
+	qpexdata.x	qpex.h <mach.h>
+	qpexdebug.x	qpex.h qpoe.h <mach.h> <qpexset.h>
+	qpexdel.x	qpex.h <mach.h>
+	qpexeval.x	qpex.h <mach.h>
+	qpexgetat.x	qpex.h <mach.h>
+	qpexgetfil.x	qpex.h <mach.h>
+	qpexmodfil.x	qpex.h qpoe.h <mach.h>
+	qpexopen.x	qpex.h qpoe.h <mach.h>
+	qpexpand.x	qpoe.h
+	qpgetb.x	qpoe.h
+	qpgettok.x	qpoe.h <ctype.h> <error.h> <fset.h>
+	qpgetx.x	qpoe.h
+	qpgmsym.x	qpoe.h
+	qpgnfn.x	qpoe.h
+	qpgpar.x	qpoe.h <ctype.h>
+	qpgpsym.x	qpoe.h
+	qpgstr.x	qpoe.h
+	qpinherit.x	qpoe.h <error.h>
+	qpioclose.x	qpio.h
+	qpiogetfil.x	qpio.h qpoe.h <mach.h>
+	qpiogetrg.x	qpio.h
+	qpiolmask.x	<plset.h> qpio.h qpoe.h
+	qpiolwcs.x	qpio.h
+	qpiomkidx.x	qpio.h qpoe.h <error.h> <fset.h> <mach.h>
+	qpioopen.x	qpex.h qpio.h qpoe.h <error.h> <fset.h> <mach.h>\
+			<plset.h>
+	qpioparse.x	qpex.h qpio.h qpoe.h <ctype.h> <mach.h>
+	qpioputev.x	qpio.h qpoe.h <mach.h>
+	qpiorb.x	qpio.h
+	qpiosetfil.x	qpex.h qpio.h
+	qpioseti.x	qpio.h <plset.h> <qpioset.h>
+	qpiosetr.x	qpio.h <qpioset.h>
+	qpiosetrg.x	qpio.h
+	qpiostati.x	qpio.h <qpioset.h>
+	qpiostatr.x	qpio.h <qpioset.h>
+	qpiosync.x	qpio.h qpoe.h <fset.h> <mach.h>
+	qpiowb.x	qpio.h qpoe.h <fset.h> <mach.h>
+	qplenf.x	qpoe.h
+	qploadwcs.x	qpoe.h
+	qpmacro.x	qpex.h qpoe.h <ctype.h> <error.h> <finfo.h>
+	qpmkfname.x	qpoe.h
+	qpopen.x	qpio.h qpoe.h <fmset.h>
+	qpparse.x	<ctype.h>
+	qpparsefl.x	qpex.h qpoe.h
+	qppclose.x	<fset.h>
+	qppopen.x	qpoe.h
+	qpppar.x	qpoe.h <ctype.h>
+	qppstr.x	qpoe.h
+	qpputb.x	qpoe.h
+	qpputx.x	qpoe.h
+	qpqueryf.x	qpoe.h <qpset.h>
+	qpread.x	qpoe.h
+	qprebuild.x	qpoe.h
+	qprename.x	qpoe.h
+	qprenamef.x	qpoe.h
+	qpsavewcs.x	qpoe.h
+	qpseti.x	qpoe.h <qpset.h>
+	qpsetr.x	qpoe.h <qpset.h>
+	qpsizeof.x	qpoe.h
+	qpstati.x	qpoe.h <qpset.h>
+	qpstatr.x	qpoe.h <qpset.h>
+	qpsync.x	qpoe.h
+	qpwrite.x	qpoe.h
+	;
diff --git a/sys/qpoe/qpaccess.x b/sys/qpoe/qpaccess.x
new file mode 100644
index 00000000..b8f5079f
--- /dev/null
+++ b/sys/qpoe/qpaccess.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_ACCESS -- Test if the named poefile exists and is accessible with the
+# given mode (mode=0 merely tests for the existence of the poefile).
+
+int procedure qp_access (poefile, mode)
+
+char	poefile[ARB]		#I poefile name
+int	mode			#I access mode
+
+int	status
+pointer	sp, fname
+int	access()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call qp_mkfname (poefile, QPOE_EXTN, Memc[fname], SZ_PATHNAME)
+	status = access (Memc[fname], mode, 0)
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/qpoe/qpaccessf.x b/sys/qpoe/qpaccessf.x
new file mode 100644
index 00000000..4b11d570
--- /dev/null
+++ b/sys/qpoe/qpaccessf.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_ACCESSF -- Test whether the named field (header parameter) exists.
+# Globally aliased parameters are recursively expanded and must resolve to
+# a normal parameter reference.
+
+int procedure qp_accessf (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	qp_gpsym()
+errchk	qp_bind, qp_gpsym
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+	if (qp_gpsym (qp, param) != NULL)
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/qpoe/qpadd.gx b/sys/qpoe/qpadd.gx
new file mode 100644
index 00000000..83f240ae
--- /dev/null
+++ b/sys/qpoe/qpadd.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../qpoe.h"
+
+# QP_ADD -- Set the value of a parameter, creating the parameter if it does
+# not already exist.  This works for the most common case of simple scalar
+# valued header parameters, although any parameter may be written into it it
+# already exists.  Additional control over the parameter attributes is possible
+# if the parameter is explicitly created with qp_addf before being written into.
+
+procedure qp_add$t (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+PIXEL	value			#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+char	datatype[1]
+errchk	qp_accessf, qp_addf
+string	dtypes SPPTYPES
+int	qp_accessf()
+
+begin
+	if (qp_accessf (qp, param) == NO) {
+	    datatype[1] = dtypes[TY_PIXEL]
+	    call qp_addf (qp, param, datatype, 1, comment, 0)
+	}
+	call qp_put$t (qp, param, value)
+end
diff --git a/sys/qpoe/qpaddf.x b/sys/qpoe/qpaddf.x
new file mode 100644
index 00000000..e72c2cc1
--- /dev/null
+++ b/sys/qpoe/qpaddf.x
@@ -0,0 +1,173 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_ADDF -- Add a new field (header parameter) to the datafile.  It is an
+# error if the parameter redefines an existing symbol.  For variable array
+# parameters the initial size is zero, and a new lfile is allocated for the
+# parameter value.  For static parameters storage is initialized to all zeros.
+
+procedure qp_addf (qp, param, datatype, maxelem, comment, flags)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	datatype[ARB]		#I parameter data type
+int	maxelem			#I allocated length of parameter
+char	comment[ARB]		#I comment describing parameter
+int	flags			#I parameter flags
+
+bool	newtype
+pointer	sp, text, st, fm, sym, pval, dsym, dd
+int	fd, sz_elem, type, nchars, dtype, nfields, i
+
+long	note()
+pointer	qp_gpsym(), stenter(), strefstab()
+int	stpstr(), qp_dtype(), qp_parsefl(), gstrcpy
+int	fm_nextlfile(), fm_getfd(), qp_elementsize(), fm_fopen()
+errchk	qp_bind, qp_gpsym, stenter, stpstr, fm_nextlfile, fm_fopen
+errchk	fm_getfd, note, write, syserrs
+define	fixed_ 91
+
+begin
+	call smark (sp)
+	call salloc (text, SZ_TEXTBUF, TY_CHAR)
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	st = QP_ST(qp)
+	fm = QP_FM(qp)
+
+	# Resolve any macro references in the 'datatype' text.
+	# (Disabled - not sure this is a good idea here).
+
+	# nchars = qp_expandtext (qp, datatype, Memc[text], SZ_TEXTBUF)
+	nchars = gstrcpy (datatype, Memc[text], SZ_TEXTBUF)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_addf: `%s' typ=`%s' nel=%d com=`%s' flg=%oB\n")
+		call pargstr (param)
+		call pargstr (Memc[text])
+		call pargi (maxelem)
+		call pargstr (comment)
+		call pargi (flags)
+	}
+
+	# Check for a redefinition.
+	sym = qp_gpsym (qp, param)
+	if (sym != NULL)
+	    call syserrs (SYS_QPREDEF, param)
+
+	# Add the symbol.
+	sym = stenter (st, param, LEN_SYMBOL)
+
+	# Determine symbol type.
+	dtype = qp_dtype (qp, Memc[text], dsym)
+	newtype = (dtype == TY_USER && dsym == NULL)
+	sz_elem = qp_elementsize (qp, Memc[text], INSTANCEOF)
+
+	S_DTYPE(sym) = dtype
+	S_SZELEM(sym) = 0
+	if (dsym != NULL)
+	    S_DSYM(sym) = dsym - strefstab(st,0)
+	else
+	    S_DSYM(sym) = 0
+
+	# If defining a new user datatype (domain), SZELEM is the size of
+	# a structure element in chars, and MAXELEM is the length of the
+	# field list string, which becomes the value of the domain definition
+	# parameter.
+
+	if (newtype) {
+	    S_MAXELEM(sym) = nchars
+	    call salloc (dd, LEN_DDDES, TY_STRUCT)
+	    iferr (nfields = qp_parsefl (qp, Memc[text], dd))
+		call erract (EA_WARN)
+	    else
+		S_SZELEM(sym) = DD_STRUCTLEN(dd) * SZ_STRUCT
+	} else
+	    S_MAXELEM(sym) = maxelem
+
+	# If no flags are specified, set SF_INHERIT for fixed length params.
+	if (flags == 0 && S_MAXELEM(sym) > 0)
+	    S_FLAGS(sym) = SF_INHERIT
+	else if (flags == QPF_NONE)
+	    S_FLAGS(sym) = 0
+	else
+	    S_FLAGS(sym) = flags
+
+	# Comments are stored in the symbol table and cannot be modified.
+	if (comment[1] != EOS)
+	    S_COMMENT(sym) = stpstr (st, comment, 0)
+	else
+	    S_COMMENT(sym) = NULL
+
+	# Initialize data storage for the parameter.
+	if (S_MAXELEM(sym) == 0) {
+	    # A variable length parameter; store in it's own lfile.  The
+	    # initial length is zero, hence initialization is not needed.
+
+	    S_NELEM(sym) = 0
+	    S_OFFSET(sym) = 1
+
+	    # If we run out of lfiles, try to make do by allocating a fixed
+	    # amount of static storage.
+
+	    iferr (S_LFILE(sym) = fm_nextlfile(fm)) {
+		S_MAXELEM(sym) = (QP_FMPAGESIZE(qp) + sz_elem-1) / sz_elem
+		call erract (EA_WARN)
+		goto fixed_
+	    }
+
+	    if (dtype == TY_CHAR)
+		type = TEXT_FILE
+	    else
+		type = BINARY_FILE
+
+	    fd = fm_fopen (fm, S_LFILE(sym), NEW_FILE, type)
+	    call close (fd)
+
+	} else {
+	    # A fixed length parameter; allocate and initialize storage in
+	    # LF_STATICPARS.
+fixed_
+	    fd = fm_getfd (fm, LF_STATICPARS, APPEND, 0)
+
+	    S_NELEM(sym) = 0
+	    S_OFFSET(sym) = note (fd)
+	    S_LFILE(sym) = LF_STATICPARS
+	    nchars = S_MAXELEM(sym) * sz_elem
+
+	    # The param value is the field list (datatype parameter) for a
+	    # domain definition; otherwise we do not have a value yet, so we
+	    # merely allocate the storage and initialize to zero.
+
+	    if (newtype) {
+		call write (fd, Memc[text], nchars)
+		S_NELEM(sym) = S_MAXELEM(sym)
+	    } else {
+		call salloc (pval, nchars, TY_CHAR)
+		call aclrc (Memc[pval], nchars)
+		call write (fd, Memc[pval], nchars)
+	    }
+
+	    call fm_retfd (fm, S_LFILE(sym))
+	}
+
+	if (QP_DEBUG(qp) > 2) {
+	    # Dump symbol.
+	    call eprintf ("%s: FLG=%oB TYP=%d DSY=%xX NEL=%d ")
+		call pargstr (param)
+		do i = 1, 4
+		    call pargi (Memi[sym+i-1])
+	    call eprintf ("MEL=%d SZE=%d COM=%xX LFN=%d OFF=%d\n")
+		do i = 5, 9
+		    call pargi (Memi[sym+i-1])
+	}
+
+	QP_MODIFIED(qp) = YES
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpastr.x b/sys/qpoe/qpastr.x
new file mode 100644
index 00000000..4c856b10
--- /dev/null
+++ b/sys/qpoe/qpastr.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_ASTR -- Set the value of a string parameter, creating the parameter if
+# it does not already exist.  This works for the common case of string
+# parameters allocated a fixed amount of space at create time (any type of
+# string parameter can be written into if it already exists).  Additional
+# control over the parameter attributes is possible if the parameter is
+# explicitly created with qp_addf before being written into.
+
+procedure qp_astr (qp, param, value, comment)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	value[ARB]		#I parameter value
+char	comment[ARB]		#I comment field, if creating parameter
+
+int	nchars
+int	qp_accessf(), strlen()
+errchk	qp_accessf, qp_addf
+
+begin
+	# By default we allocate a somewhat bigger storage area than needed
+	# to store the string, to permit updates of a similar length.	If
+	# more control over the maximum string length is needed, QP_ADDF
+	# should be called explicitly.
+
+	if (qp_accessf (qp, param) == NO) {
+	    nchars = (strlen(value) + INC_STRLEN-1) / INC_STRLEN * INC_STRLEN
+	    call qp_addf (qp, param, "c", nchars, comment, 0)
+	}
+
+	call qp_pstr (qp, param, value)
+end
diff --git a/sys/qpoe/qpbind.x b/sys/qpoe/qpbind.x
new file mode 100644
index 00000000..cd9c9bb6
--- /dev/null
+++ b/sys/qpoe/qpbind.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fmset.h>
+include	"qpoe.h"
+
+# QP_BIND -- Fix the create-time QPOE file parameters.  This is called
+# after the open, when the first datafile access occurs.
+
+procedure qp_bind (qp)
+
+pointer	qp			#I QPOE descriptor
+
+int	fd
+pointer	fm
+pointer	stopen()
+int	fm_fopen()
+errchk	stopen, fm_fopen
+
+begin
+	if (QP_ACTIVE(qp) == NO) {
+	    fm = QP_FM(qp)
+
+	    # Create the initial symbol table. 
+	    QP_ST(qp) = stopen (QPOE_TITLE,
+		QP_STINDEXLEN(qp), QP_STSTABLEN(qp), QP_STSBUFSIZE(qp))
+
+	    # Fix the datafile parameters.
+	    call fm_seti (fm, FM_PAGESIZE, QP_FMPAGESIZE(qp))
+	    call fm_seti (fm, FM_MAXLFILES, QP_FMMAXLFILES(qp))
+	    call fm_seti (fm, FM_MAXPTPAGES, QP_FMMAXPTPAGES(qp))
+	    call fm_seti (fm, FM_FCACHESIZE, QP_FMCACHESIZE(qp))
+
+	    # Create the QPOE header and static storage lfiles.
+	    fd = fm_fopen (fm, LF_QPOE, NEW_FILE, BINARY_FILE)
+	    call close (fd)
+	    fd = fm_fopen (fm, LF_STATICPARS, NEW_FILE, BINARY_FILE)
+	    call close (fd)
+
+	    # Must flag descriptor as active here to prevent reentrant
+	    # calls via the procedures called by qp_inherit.
+
+	    QP_ACTIVE(qp) = YES
+
+	    # Inherit selected data objects from parent if NEW_COPY.
+	    if (QP_MODE(qp) == NEW_COPY)
+		call qp_inherit (qp, QP_OQP(qp), STDERR)
+	}
+end
diff --git a/sys/qpoe/qpclose.x b/sys/qpoe/qpclose.x
new file mode 100644
index 00000000..eb537622
--- /dev/null
+++ b/sys/qpoe/qpclose.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_CLOSE -- Close an open QPOE descriptor and file.
+
+procedure qp_close (qp)
+
+pointer	qp			#I QPOE descriptor
+
+begin
+	# An open/close should produce an empty poefile.
+	if (QP_ACTIVE(qp) == NO) {
+	    QP_MODIFIED(qp) = YES
+	    call qp_bind (qp)
+	}
+
+	# Update the poefile on disk.
+	call qp_flushpar (qp)
+	call qp_sync (qp)
+
+	# Shut everything down.
+	call stclose (QP_ST(qp))
+	call fm_close (QP_FM(qp))
+	call mfree (qp, TY_STRUCT)
+end
diff --git a/sys/qpoe/qpcopy.x b/sys/qpoe/qpcopy.x
new file mode 100644
index 00000000..6d0a597d
--- /dev/null
+++ b/sys/qpoe/qpcopy.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_COPY -- Copy a poefile.  The output version is "rebuilt" in the process,
+# i.e., the datafile is not merely physically copied, but instead is rebuilt to
+# reclaim unused storage and render the file structures logically contiguous.
+
+procedure qp_copy (o_poefile, n_poefile)
+
+char	o_poefile[ARB]		#I old poefile name
+char	n_poefile[ARB]		#I new poefile name
+
+pointer	sp
+pointer	o_fname, n_fname
+string	extn QPOE_EXTN
+
+begin
+	call smark (sp)
+	call salloc (o_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (n_fname, SZ_PATHNAME, TY_CHAR)
+
+	call qp_mkfname (o_poefile, extn, Memc[o_fname], SZ_PATHNAME)
+	call qp_mkfname (n_poefile, extn, Memc[n_fname], SZ_PATHNAME)
+	call fm_copy (Memc[o_fname], Memc[n_fname])
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpcopyf.x b/sys/qpoe/qpcopyf.x
new file mode 100644
index 00000000..ba47ad4f
--- /dev/null
+++ b/sys/qpoe/qpcopyf.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpset.h>
+include	"qpoe.h"
+
+define	MAX_NELEM	8192	# copy unit (chunk) size
+
+# QP_COPYF -- Copy a field (parameter), either within a datafile, or from one
+# datafile to another.
+
+procedure qp_copyf (o_qp, o_param, n_qp, n_param)
+
+pointer	o_qp			#I QPOE descriptor of old (input) datafile
+char	o_param[ARB]		#I input parameter name
+pointer	n_qp			#I QPOE descriptor of new (output) datafile
+char	n_param[ARB]		#I output parameter name
+
+pointer	sp, dp, cp, buf
+int	nelem, elsize, chunk, nleft, first, maxelem, flags
+int	qp_queryf(), qp_accessf(), qp_elementsize(), qp_read()
+errchk	qp_queryf, qp_addf, qp_read, qp_write
+
+begin
+	call smark (sp)
+	call salloc (dp, SZ_DATATYPE, TY_CHAR)
+	call salloc (cp, SZ_COMMENT, TY_CHAR)
+
+	# Get parameter attributes and create new parameter if necessary.
+	nelem = qp_queryf (o_qp, o_param, Memc[dp], maxelem, Memc[cp], flags)
+	if (qp_accessf (n_qp, n_param) == NO)
+	    call qp_addf (n_qp, n_param, Memc[dp], maxelem, Memc[cp], flags)
+
+	# Copy parameter value.
+	if (nelem > 0) {
+	    elsize = qp_elementsize (o_qp, Memc[dp], INSTANCEOF)
+	    chunk = min (MAX_NELEM, nelem)
+	    call salloc (buf, chunk * elsize, TY_CHAR)
+
+	    first = 1
+	    for (nleft=nelem;  nleft > 0;  nleft=nleft-nelem) {
+		nelem = qp_read (o_qp,o_param, Memc[buf], chunk,first, Memc[dp])
+		call   qp_write (n_qp,n_param, Memc[buf], nelem,first, Memc[dp])
+		first = first + nelem
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpctod.x b/sys/qpoe/qpctod.x
new file mode 100644
index 00000000..6487650c
--- /dev/null
+++ b/sys/qpoe/qpctod.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	SZ_NUMBUF	32		# buffer for extracting numbers
+
+# QP_CTOD -- Return as a double the next numeric token from the input stream.
+# This differs from the standard FMTIO procedures only in that colon is not
+# considered a numeric character (as used in sexagesimal numbers).
+
+int procedure qp_ctod (str, ip, dval)
+
+char	str[ARB]			#I input string
+int	ip				#U pointer into input string
+double	dval				#O double value
+
+int	nchars, op, i
+char	numbuf[SZ_NUMBUF]
+int	ctod()
+
+begin
+	i = ip
+	do op = 1, SZ_NUMBUF
+	    if (str[i] != ':' && str[i] != EOS) {
+		numbuf[op] = str[i]
+		i = i + 1
+	    } else
+		break
+	
+	i = 1
+	numbuf[op] = EOS
+	nchars = ctod (numbuf, i, dval)
+	ip = ip + i - 1
+
+	return (nchars)
+end
diff --git a/sys/qpoe/qpctoi.x b/sys/qpoe/qpctoi.x
new file mode 100644
index 00000000..9ac70ddb
--- /dev/null
+++ b/sys/qpoe/qpctoi.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<lexnum.h>
+
+# QP_CTOI -- Decode an integer token from the input string, advancing the
+# input pointer the the first character following the decoded number, and
+# returning the number of numeric characters decoded as the function value.
+# This is equivalent to the standard CTOI except that it calls LEXNUM first
+# to determine the radix of the input number, hence can deals with hex and
+# octal numbers as well as decimal.
+
+int procedure qp_ctoi (str, ip, ival)
+
+char	str[ARB]			#I input string
+int	ip				#U pointer into input string
+int	ival				#O integer value
+
+int	ip_save, base, nchars
+int	gctol(), lexnum()
+
+begin
+	ip_save = ip
+	switch (lexnum (str, ip, nchars)) {
+	case LEX_OCTAL:
+	    base = 8
+	case LEX_HEX:
+	    base = 16
+	default:
+	    base = 10
+	}
+
+	ip = ip_save
+	return (gctol (str, ip, ival, base))
+end
diff --git a/sys/qpoe/qpdelete.x b/sys/qpoe/qpdelete.x
new file mode 100644
index 00000000..16b32161
--- /dev/null
+++ b/sys/qpoe/qpdelete.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_DELETE -- Delete a poefile.
+
+procedure qp_delete (poefile)
+
+char	poefile[ARB]		#I poefile name
+pointer	sp, fname
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call qp_mkfname (poefile, QPOE_EXTN, Memc[fname], SZ_PATHNAME)
+	call delete (Memc[fname])
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpdeletef.x b/sys/qpoe/qpdeletef.x
new file mode 100644
index 00000000..b7c41189
--- /dev/null
+++ b/sys/qpoe/qpdeletef.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_DELETEF -- Delete a header parameter.  It is an error if the named header
+# parameter does not exist.  Deletions are permanent once the datafile is
+# updated.
+
+procedure qp_deletef (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	sym
+pointer	qp_gpsym()
+errchk	qp_gpsym, syserrs
+
+begin
+	# Access the named parameter.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+	else if (and (S_FLAGS(sym), SF_DELETED) != 0)
+	    return
+
+	# If the parameter value is stored in its own lfile, delete it.
+	if (S_LFILE(sym) > LF_STATICPARS)
+	    call fm_lfdelete (QP_FM(qp), S_LFILE(sym))
+
+	# Set the delete bit in the symbol descriptor.
+	S_FLAGS(sym) = or (S_FLAGS(sym), SF_DELETED)
+
+	QP_MODIFIED(qp) = YES
+end
diff --git a/sys/qpoe/qpdsym.x b/sys/qpoe/qpdsym.x
new file mode 100644
index 00000000..d94b54b4
--- /dev/null
+++ b/sys/qpoe/qpdsym.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_DSYM -- Dump the symbol table of a QPOE file.
+
+procedure qp_dsym (qp, out)
+
+pointer	qp			#I QPOE descriptor
+int	out			#I output file
+
+int	nsyms, i
+pointer	sp, st, sym, op, pname, syms
+pointer	sthead(), stnext(), stname()
+
+begin
+	call smark (sp)
+	st = QP_ST(qp)
+
+	# Count the symbols.
+	nsyms = 0
+	for (sym=sthead(st);  sym != NULL;  sym=stnext(st,sym))
+	    nsyms = nsyms + 1
+
+	# Construct a reversed array of symbol pointers.
+	call salloc (syms, nsyms, TY_POINTER) 
+	op = syms + nsyms - 1
+	for (sym=sthead(st);  sym != NULL;  sym=stnext(st,sym)) {
+	    Memi[op] = sym
+	    op = op - 1
+	}
+
+	# Output the symbols.
+	if (nsyms > 0)
+	    call fprintf (out,
+"          SYMBOL FLAGS DTYPE DSYM NELEM MAXELEM SZELEM COMMENT LFILE OFFSET\n")
+
+	do i = 1, nsyms {
+	    sym = Memi[syms+i-1]
+	    pname = stname (st, sym)
+
+	    call fprintf (out, "%16s %5o %5d %4d %5d %7d %6d %7x %5d %6d\n")
+		call pargstr (Memc[pname])
+		call pargi (and (S_FLAGS(sym), 77777B))
+		call pargi (S_DTYPE(sym))
+		call pargi (S_DSYM(sym))
+		call pargi (S_NELEM(sym))
+		call pargi (S_MAXELEM(sym))
+		call pargi (S_SZELEM(sym))
+		call pargi (S_COMMENT(sym))
+		call pargi (S_LFILE(sym))
+		call pargi (S_OFFSET(sym))
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpdtype.x b/sys/qpoe/qpdtype.x
new file mode 100644
index 00000000..ed5b9e89
--- /dev/null
+++ b/sys/qpoe/qpdtype.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"qpoe.h"
+
+# QP_DTYPE -- Translate the given symbolic datatype name into an integer
+# type code.  The possible type codes are most of the standard SPP TY_type
+# codes, plus TY_MACRO, TY_OPAQUE, and TY_USER.  If the symbol type is TY_USER
+# (a user defined data structure or domain)), then a pointer to the symbol
+# table entry for the named domain is returned as an output argument.  The
+# integer type code is returned as the function value.
+
+int procedure qp_dtype (qp, datatype, dsym)
+
+pointer	qp			#I QPOE descriptor
+char	datatype[ARB]		#I symbolic datatype name
+pointer	dsym			#O pointer to domain symbol, if TY_USER
+
+char	junk[1]
+int	dtype, ip
+string	types "|bool|char|short|int|long|real|double|complex|macro|opaque|"
+
+pointer	stfind()
+int	stridx(), strdic()
+
+begin
+	dtype = NULL
+	dsym  = NULL
+	for (ip=1;  IS_WHITE(datatype[ip]);  ip=ip+1)
+	    ;
+
+	# Single character standard dtype code (bcsilrdx)?
+	if (datatype[ip+1] == EOS)
+	    dtype = stridx (datatype[ip], SPPTYPES)
+
+	# Spelled out dtype name.  Check standard names first.
+	if (dtype == NULL) {
+	    dtype = strdic (datatype[ip], junk, 1, types)
+	    if (dtype == 9)
+		dtype = TY_MACRO
+	    else if (dtype == 10)
+		dtype = TY_OPAQUE
+	}
+
+	# Lastly, check the special types.
+	if (dtype == 0) {
+	    if (datatype[ip] == '{')			# field list
+		dtype = TY_USER
+	    else {
+		dsym = stfind (QP_ST(qp), datatype[ip])
+		if (dsym != NULL)
+		    dtype = S_DTYPE(dsym)
+	    }
+	}
+
+	return (dtype)
+end
diff --git a/sys/qpoe/qpelsize.x b/sys/qpoe/qpelsize.x
new file mode 100644
index 00000000..b84e0dfa
--- /dev/null
+++ b/sys/qpoe/qpelsize.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# QP_ELEMENTSIZE -- Determine the size in chars of a QPOE datatype.  This may
+# be one of the special datatypes (user defined record types), or a primitive
+# type.
+
+int procedure qp_elementsize (qp, datatype, reftype)
+
+pointer	qp			#I QPOE descriptor
+char	datatype[ARB]		#I symbolic datatype name
+int	reftype			#I type of reference (immediate or instanceof)
+
+pointer	dsym
+int	dtype
+int	qp_sizeof(), qp_dtype()
+
+begin
+	dtype = qp_dtype (qp, datatype, dsym)
+	return (qp_sizeof (qp, dtype, dsym, reftype))
+end
diff --git a/sys/qpoe/qpex.h b/sys/qpoe/qpex.h
new file mode 100644
index 00000000..45cc3db0
--- /dev/null
+++ b/sys/qpoe/qpex.h
@@ -0,0 +1,164 @@
+# QPEX.H -- QPOE expression evaluator definitions.
+
+# Size limiting definitions.
+define	DEF_PROGBUFLEN		65536	# default program buffer length, ints
+define	DEF_DATABUFLEN		65536	# default data buffer length, chars
+define	DEF_SZEXPRBUF		2048	# default size expression buffer
+define	INC_SZEXPRBUF		2048	# increment if overflow
+define	DEF_XLEN		256	# default (initial) range buffer size
+define	MAX_INSTRUCTIONS	ARB	# arbitrary do-loop index
+define	MAX_LEVELS		32	# max levels of program nesting
+define	DEF_MAXRRLUTLEN		1024	# max RRLUT (reduced resolution) length
+define	DEF_MAXFRLUTLEN		8192	# max FRLUT (full resolution) length
+define	DEF_LUTMINRANGES	5	# use RRLUT if more ranges than this
+define	DEF_LUTSCALE		15	# multiplied by nranges to get rrlutlen
+
+# Magic values used to represent open ranges :N and N:.
+define	LEFTI		-MAX_INT
+define	RIGHTI		 MAX_INT
+define	LEFTR		-MAX_REAL
+define	RIGHTR		 MAX_REAL
+define	LEFTD		-MAX_DOUBLE
+define	RIGHTD		 MAX_DOUBLE
+
+define	IS_LEFTI	(($1) == -MAX_INT)
+define	IS_RIGHTI	(($1) ==  MAX_INT)
+define	IS_LEFTR	(($1) <= -MAX_REAL)
+define	IS_RIGHTR	(($1) >=  MAX_REAL)
+define	IS_LEFTD	(($1) <= -MAX_DOUBLE)
+define	IS_RIGHTD	(($1) >=  MAX_DOUBLE)
+
+# The compiled expression descriptor.  The program buffer holds the compiled
+# expression to be interpreted to test each data event structure.  The data
+# buffer is used to store program data, e.g., lookup table descriptors,
+# TY_DOUBLE constants (these are too large to be stored directly in the
+# compiled program), and the textual expressions compiled to generate the
+# program; the latter are used by QPEX_GETFILTER to regenerate the current
+# expression.  The expression terms (ET) and lookup table (LT) descriptors
+# are maintained on linked lists.  New ET descriptors are linked onto the
+# tail of the ET list; LT descriptors are linked onto the head of the LT list.
+# The program and data buffers are *nonrelocatable* (hence fixed in size)
+# to allow use of absolute pointers to reference structures within the buffers.
+
+define	LEN_EXDES	16
+define	EX_QP		Memi[$1]	# back pointer to QPOE descriptor
+define	EX_DEBUG	Memi[$1+1]	# debug level
+define	EX_START	Memi[$1+2]	# pointer to first instruction
+define	EX_PB		Memi[$1+3]	# pointer to program buffer (int)
+define	EX_PBTOP	Memi[$1+4]	# pointer to top+1 of pb
+define	EX_PBOP		Memi[$1+5]	# pointer to next avail. cell in pb
+define	EX_DB		Memi[$1+6]	# data buffer pointer (char)
+define	EX_DBTOP	Memi[$1+7]	# pointer to top+1 of db
+define	EX_DBOP		Memi[$1+8]	# pointer to next avail. cell in db
+define	EX_MAXFRLUTLEN	Memi[$1+9]	# max full-res lut length
+define	EX_MAXRRLUTLEN	Memi[$1+10]	# max reduced-res lut length
+define	EX_LUTMINRANGES	Memi[$1+11]	# min ranges required for a LUT
+define	EX_LUTSCALE	Memi[$1+12]	# scale nranges to frlutlen
+define	EX_ETHEAD	Memi[$1+13]	# offset of first expr term descriptor
+define	EX_ETTAIL	Memi[$1+14]	# offset of last expr term descriptor
+define	EX_LTHEAD	Memi[$1+15]	# offset of first LUT descriptor
+
+# Expression terms descriptor.  Stored in the data buffer and maintained
+# as a linked list.
+
+define	LEN_ETDES	9
+define	ET_ATTTYPE	Memi[$1]	# datatype of attribute
+define	ET_ATTOFF	Memi[$1+1]	# *typed* offset of attribute
+define	ET_PROGPTR	Memi[$1+2]	# pointer to program segment 
+define	ET_NINSTR	Memi[$1+3]	# program segment size, instructions
+define	ET_DELETED	Memi[$1+4]	# set if term is deleted
+define	ET_ATNAME	Memi[$1+5]	# attribute name used in expr
+define	ET_ASSIGNOP	Memi[$1+6]	# type of assignment ("=", "+=")
+define	ET_EXPRTEXT	Memi[$1+7]	# saved expr text
+define	ET_NEXT		Memi[$1+8]	# databuf offset of next ET struct
+
+# Lookup table descriptor.  Stored in the data buffer and maintained as a
+# linked list.  The table itself is separately allocated.
+
+define	LEN_LTDES	10
+define	LT_NEXT		Memi[$1]	# pointer to next stored LUT
+define	LT_TYPE		Memi[$1+1]	# TY_SHORT pointer to stored LUT
+define	LT_LUTP		Memi[$1+2]	# TY_SHORT pointer to stored LUT
+define	LT_NBINS	Memi[$1+3]	# number of lookup table entries
+define	LT_LEFT		Memi[$1+4]	# lut value if index off left end
+define	LT_RIGHT	Memi[$1+5]	# lut value if index off right end
+define	LT_I0		Memr[P2R($1+6)]	# zero point for integer LUT
+define	LT_IS		Memr[P2R($1+8)]	# scale factor for integer LUT
+define	LT_R0		Memr[P2R($1+6)]	# zero point for real LUT
+define	LT_RS		Memr[P2R($1+8)]	# scale factor for real LUT
+define	LT_D0		Memd[P2D($1+6)]	# zero point for double LUT
+define	LT_DS		Memd[P2D($1+8)]	# scale factor for double LUT
+
+define	LT_LUT		Mems[LT_LUTP($1)+$2-1]		# LT_LUT(lt,i)
+
+# Macros for referencing the fields of an instruction.  TY_DOUBLE arguments
+# are stored in the data buffer, storing an offset in the instruction field.
+
+define	LEN_INSTRUCTION		4	# instruction length, ints
+
+define	OPCODE		Memi[$1]	# instruction opcode.
+define	IARG1		Memi[$1+1]	# first integer argument
+define	IARG2		Memi[$1+2]	# second integer argument
+define	IARG3		Memi[$1+3]	# third integer argument
+define	RARG1		Memr[P2R($1+1)]	# first real argument
+define	RARG2		Memr[P2R($1+2)]	# second real argument
+define	RARG3		Memr[P2R($1+3)]	# third real argument
+define	DARG1		Memd[IARG1($1)]	# first double argument
+define	DARG2		Memd[IARG2($1)]	# second double argument
+define	DARG3		Memd[IARG3($1)]	# third double argument
+
+# Instruction opcodes.
+
+define	PASS		00		# set pass=true and return
+define	RET		01		# return from subprogram
+define	NOP		02		# no-operation
+define	GOTO		03		# goto offset
+define	XIFT		04		# exit if expr-value true
+define	XIFF		05		# exit if expr-value false
+define	LDSI		06		# load short to int
+define	LDII		07		# load int
+define	LDRR		08		# load real
+define	LDRD		09		# load real to double
+define	LDDD		10		# load double
+
+define	BTTI		11		# bit test, int
+define	EQLI		12		# test if equal
+define	EQLR		13
+define	EQLD		14
+define	LEQI		15		# test if less than or equal
+define	LEQR		16
+define	LEQD		17
+define	GEQI		18		# test if greater than or equal
+define	GEQR		19
+define	GEQD		20
+define	RNGI		21		# range test
+define	RNGR		22
+define	RNGD		23
+
+define	BTTXS		24		# bit test direct and exit if false
+define	BTTXI		25
+define	NEQXS		26		# not equals test and exit
+define	NEQXI		27
+define	NEQXR		28
+define	NEQXD		29
+define	EQLXS		30		# equality test direct and exit if false
+define	EQLXI		31
+define	EQLXR		32
+define	EQLXD		33
+define	LEQXS		34		# LEQ test direct and exit if false
+define	LEQXI		35
+define	LEQXR		36
+define	LEQXD		37
+define	GEQXS		38		# GEQ test direct and exit if false
+define	GEQXI		39
+define	GEQXR		40
+define	GEQXD		41
+define	RNGXS		42		# range test direct and exit if false
+define	RNGXI		43
+define	RNGXR		44
+define	RNGXD		45
+
+define	LUTXS		46		# lookup table test
+define	LUTXI		47
+define	LUTXR		48
+define	LUTXD		49
diff --git a/sys/qpoe/qpexattrl.gx b/sys/qpoe/qpexattrl.gx
new file mode 100644
index 00000000..7cd6cd0a
--- /dev/null
+++ b/sys/qpoe/qpexattrl.gx
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	"../qpex.h"
+
+# QPEX_ATTRL -- Get the good-value range list for the named attribute, as a
+# binary range list of the indicated type.  This range list is a simplified
+# version of the original filter expression, which may have contained
+# multiple fields, some negated or overlapping, in any order, subsequently
+# modified or deleted with qpex_modfilter, etc.  The final resultant range
+# list is ordered and consists of discreet nonoverlapping ranges.
+#
+# Upon input the variables XS and XE should either point to a pair of
+# preallocated buffers of length XLEN, or they should be set to NULL.
+# The routine will reallocate the buffers as necessary to allow for long
+# range lists, updating XLEN so that it always contains the actual length
+# of the arrays (which may not be completely full).  Each list element
+# consists of a pair of values (xs[i],xe[i]) defining the start and end
+# points of the range.  If xs[1] is INDEF the range is open to the left,
+# if xe[nranges] is INDEF the range is open to the right.  The number of
+# ranges output is returned as the function value.
+
+int procedure qpex_attrl$t (ex, attribute, xs, xe, xlen)
+
+pointer	ex			#I QPEX descriptor
+char	attribute[ARB]		#I attribute name
+pointer	xs			#U pointer to array of start values
+pointer	xe			#U pointer to array of end values
+int	xlen			#U length of xs/xe arrays
+
+pointer	ps, pe, qs, qe
+pointer	sp, expr, ip, ep
+int	plen, qlen, np, nq, nx
+int	neterms, nchars, maxch
+int	qpex_getattribute(), qpex_parse$t(), qp_rlmerge$t()
+
+begin
+	call smark (sp)
+
+	# Get attribute filter expression.  In the unlikely event that the
+	# expression is too large to fit in our buffer, repeat with a buffer
+	# twice as large until it fits.
+
+	maxch = DEF_SZEXPRBUF
+	nchars = 0
+
+	repeat {
+	    maxch = maxch * 2
+	    call salloc (expr, maxch, TY_CHAR)
+	    nchars = qpex_getattribute (ex, attribute, Memc[expr], maxch)
+	    if (nchars <= 0)
+		break
+	} until (nchars < maxch)
+
+	# Parse expression to produce a range list.  If the expression
+	# contains multiple eterms each is parsed separately and merged
+	# into the final output range list.
+
+	nx = 0
+	neterms = 0
+
+	if (nchars > 0) {
+	    # Get range list storage.
+	    plen = DEF_XLEN
+	    call malloc (ps, plen, TY_PIXEL)
+	    call malloc (pe, plen, TY_PIXEL)
+	    qlen = DEF_XLEN
+	    call malloc (qs, qlen, TY_PIXEL)
+	    call malloc (qe, qlen, TY_PIXEL)
+
+	    # Parse each subexpression and merge into output range list.
+	    for (ip=expr;  Memc[ip] != EOS;  ) {
+		# Get next subexpression.
+		while (IS_WHITE (Memc[ip]))
+		    ip = ip + 1
+		for (ep=ip;  Memc[ip] != EOS;  ip=ip+1)
+		    if (Memc[ip] == ';') {
+			Memc[ip] = EOS
+			ip = ip + 1
+			break
+		    }
+		if (Memc[ep] == EOS)
+		    break
+
+		# Copy output range list to X list temporary.
+		if (max(nx,1) > plen) {
+		    plen = max(xlen,1)
+		    call realloc (ps, plen, TY_PIXEL)
+		    call realloc (pe, plen, TY_PIXEL)
+		}
+		if (neterms <= 0) {
+		    Mem$t[ps] = LEFT$T
+		    Mem$t[pe] = RIGHT$T
+		    np = 1
+		} else {
+		    call amov$t (Mem$t[xs], Mem$t[ps], nx)
+		    call amov$t (Mem$t[xe], Mem$t[pe], nx)
+		    np = nx
+		}
+
+		# Parse next eterm into Y list temporary.
+		nq = qpex_parse$t (Memc[ep], qs, qe, qlen)
+
+		# Merge the X and Y lists, leaving result in output list.
+		nx = qp_rlmerge$t (xs,xe,xlen,
+		    Mem$t[ps], Mem$t[pe], np, Mem$t[qs], Mem$t[qe], nq)
+
+		neterms = neterms + 1
+	    }
+
+	    # Free temporary range list storage.
+	    call mfree (ps, TY_PIXEL);  call mfree (pe, TY_PIXEL)
+	    call mfree (qs, TY_PIXEL);  call mfree (qe, TY_PIXEL)
+
+	    # Convert LEFT/RIGHT magic values to INDEF.
+	    if (nx > 0) {
+		if (IS_LEFT$T (Mem$t[xs]))
+		    Mem$t[xs] = INDEF
+		if (IS_RIGHT$T (Mem$t[xe+nx-1]))
+		    Mem$t[xe+nx-1] = INDEF
+	    }
+	}
+
+	call sfree (sp)
+	return (nx)
+end
diff --git a/sys/qpoe/qpexclose.x b/sys/qpoe/qpexclose.x
new file mode 100644
index 00000000..137884e9
--- /dev/null
+++ b/sys/qpoe/qpexclose.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpex.h"
+
+# QPEX_CLOSE -- Close the QPEX descriptor.
+
+procedure qpex_close (ex)
+
+pointer	ex			#I QPEX descriptor
+
+pointer	lt
+
+begin
+	# Free any LUT buffers.
+	for (lt=EX_LTHEAD(ex);  lt != NULL;  lt=LT_NEXT(lt))
+	    call mfree (LT_LUTP(lt), TY_SHORT)
+
+	# Free the data and program buffers.
+	call mfree (EX_PB(ex), TY_STRUCT)
+	call mfree (EX_DB(ex), TY_CHAR)
+
+	# Free the main descriptor.
+	call mfree (ex, TY_STRUCT)
+end
diff --git a/sys/qpoe/qpexcode.gx b/sys/qpoe/qpexcode.gx
new file mode 100644
index 00000000..e148b499
--- /dev/null
+++ b/sys/qpoe/qpexcode.gx
@@ -0,0 +1,484 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QPEX_CODEGEN -- Generate interpreter metacode to evaluate the given
+# expression.  The new code is appended to the current compiled program,
+# adding additional constraints which a data event will have to meet to
+# pass the filter.
+
+int procedure qpex_codegen$t (ex, atname, assignop, expr, offset, dtype)
+
+pointer ex			#I qpex descriptor
+char	atname[ARB]		#I attribute name (for expr regeneration)
+char	assignop[ARB]		#I "=" or "+=" (for expr regeneration)
+char	expr[ARB]		#I expression to be compiled
+int	offset			#I typed offset of referenced attribute
+int	dtype			#I datatype of referenced attribute
+
+int	nbins, bin, xp
+pointer	lt, lut, lutx, pb
+PIXEL	x1, x2, xmin, xmax
+int	xlen, nranges, n_nranges, level, opcode, ip, i
+pointer	pb_save, db_save, xs_buf, xe_buf, xs, xe, n_xs, n_xe, et, prev
+
+PIXEL	sv_xs[MAX_LEVELS], sv_xe[MAX_LEVELS]
+pointer	sv_lt[MAX_LEVELS], sv_lut[MAX_LEVELS], sv_lutx[MAX_LEVELS]
+int	sv_xp[MAX_LEVELS], sv_nranges[MAX_LEVELS], sv_bin[MAX_LEVELS]
+int	sv_nbins[MAX_LEVELS]
+
+$if (datatype == d)
+double	xoffset, xscale
+double	sv_xoffset[MAX_LEVELS], sv_xscale[MAX_LEVELS]
+int	d_x1, d_x2
+int	qpex_refd()
+$else
+PIXEL	d_x1, d_x2
+real	xoffset, xscale
+real	sv_xoffset[MAX_LEVELS], sv_xscale[MAX_LEVELS]
+$endif
+
+$if (datatype == rd)
+bool	fp_equal$t()
+$else
+define	fp_equal$t($1==$2)
+$endif
+
+$if (datatype == i)
+bool	complement
+int	maskval
+int	qp_ctoi()
+$endif
+
+int	qpex_parse$t()
+int	stridxs(), btoi(), qpex_sublist$t()
+pointer	qpex_dballoc(), qpex_dbpstr(), qpex_pbpos()
+errchk	qpex_dballoc, qpex_pbpin, malloc, calloc, realloc, qpex_parse$t
+
+string	qpexwarn "QPEX Warning"
+define	error_ 91
+define	next_  92
+define	null_  93
+define	resume_ 94
+define	bbmask_ 95
+define	continue_ 96
+define	XS Mem$t[xs+($1)-1]
+define	XE Mem$t[xe+($1)-1]
+
+begin
+	pb = EX_PB(ex)
+
+	# Save the program state in case we have to abort.
+	call qpex_mark (ex, pb_save, db_save)
+
+	# Allocate and initialize a new expression term descriptor, linking
+	# it onto the tail of the ETTERMs list.
+
+	et = qpex_dballoc (ex, LEN_ETDES, TY_STRUCT)
+
+	ET_ATTTYPE(et)	= dtype
+	ET_ATTOFF(et)	= offset
+	ET_ATNAME(et)	= qpex_dbpstr (ex, atname)
+	ET_ASSIGNOP(et)	= qpex_dbpstr (ex, assignop)
+	ET_EXPRTEXT(et) = qpex_dbpstr (ex, expr)
+	ET_PROGPTR(et)	= qpex_pbpos (ex)
+	ET_DELETED(et)	= NO
+
+	prev = EX_ETTAIL(ex)
+	if (prev != NULL)
+	    ET_NEXT(prev) = et
+	ET_NEXT(et) = NULL
+	EX_ETTAIL(ex) = et
+	if (EX_ETHEAD(ex) == NULL)
+	    EX_ETHEAD(ex) = et
+
+	ip = stridxs ("%", expr)
+	$if (datatype == i)
+	    # Attempt to compile a bitmask test if `%' is found in the
+	    # expression.  Since bitmasks cannot be mixed with range list
+	    # expressions, this case is handled separately.
+
+	    if (ip > 0) {
+		complement = false
+		level = 0
+
+		# Parse expression (very limited for this case).
+		for (ip=1;  expr[ip] != EOS;  ip=ip+1) {
+		    switch (expr[ip]) {
+		    case '!':
+			complement = !complement
+		    case '(', '[':
+			level = level + 1
+		    case ')', ']':
+			level = level - 1
+		    case '%':
+			ip = ip + 1
+			if (qp_ctoi (expr, ip, maskval) < 0)
+			    goto bbmask_
+			else
+			    ip = ip - 1
+		    default:
+			goto bbmask_
+		    }
+		}
+
+		# Verify paren level, handle errors.
+		if (level != 0) {
+bbmask_		    call eprintf ("%s: bad bitmask expression `%s'\n")
+			call pargstr (qpexwarn)
+			call pargstr (expr)
+			goto error_
+		}
+
+		# Compile the bitmask test.
+		if (complement)
+		    maskval = not(maskval)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, BTTXS, offset, maskval, 0)
+		else
+		    call qpex_pbpin (ex, BTTXI, offset, maskval, 0)
+
+		# Finish setting up the eterm descriptor.
+		ET_NINSTR(et)  = 1
+		return (OK)
+	    }
+	$else
+	    # Bitmask tests are meaningless for floating point data.
+	    if (ip > 0) {
+		call eprintf ("%s: bitmasks not permitted for floating data\n")
+		    call pargstr (qpexwarn)
+		goto error_
+	    }
+	$endif
+
+	# Compile a general range list expression.  The basic procedure is
+	# to parse the expression to produce an optimized binary range list,
+	# then either compile the range list as an explicit series of
+	# instructions or as a lookup table, depending upon the number of
+	# ranges.
+
+	xlen = DEF_XLEN
+	call malloc (xs_buf, xlen, TY_PIXEL)
+	call malloc (xe_buf, xlen, TY_PIXEL)
+
+	# Convert expr to a binary range list and set up the initial context.
+	# Ensure that the range list buffers are large enough to hold any
+	# sublists extracted during compilation.
+
+	nranges = qpex_parse$t (expr, xs_buf, xe_buf, xlen)
+	if (xlen < nranges * 2) {
+	    xlen = nranges * 2
+	    call realloc (xs_buf, xlen, TY_PIXEL)
+	    call realloc (xe_buf, xlen, TY_PIXEL)
+	}
+
+	xs = xs_buf
+	xe = xe_buf
+	level = 0
+
+	repeat {
+next_
+	    # Compile a new range list (or sublist).
+	    if (nranges <= 0) {
+		# This shouldn't happen.
+null_		call eprintf ("%s: null range list\n")
+		    call pargstr (qpexwarn)
+		call qpex_pbpin (ex, PASS, 0, 0, 0)
+
+	    } else if (nranges == 1) {
+		# Output an instruction to load the data, perform the range
+		# test, and conditionally exit all in a single instruction.
+
+		x1 = XS(1);  x2 = XE(1)
+		$if (datatype == d)
+		    d_x1 = qpex_refd (ex, x1)
+		    d_x2 = qpex_refd (ex, x2)
+		$else
+		    d_x1 = x1
+		    d_x2 = x2
+		$endif
+
+		if (dtype == TY_SHORT) {
+		    if (IS_LEFT$T(x1) && IS_RIGHT$T(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFT$T(x1))
+			call qpex_pbpin (ex, LEQXS, offset, d_x2, 0)
+		    else if (IS_RIGHT$T(x2))
+			call qpex_pbpin (ex, GEQXS, offset, d_x1, 0)
+		    else if (fp_equal$t (x1, x2))
+			call qpex_pbpin (ex, EQLXS, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGXS, offset, d_x1, d_x2)
+		} else {
+		    if (IS_LEFT$T(x1) && IS_RIGHT$T(x2))
+			; # pass everything (no tests)
+		    else if (IS_LEFT$T(x1))
+			call qpex_pbpin (ex, LEQX$T, offset, d_x2, 0)
+		    else if (IS_RIGHT$T(x2))
+			call qpex_pbpin (ex, GEQX$T, offset, d_x1, 0)
+		    else if (fp_equal$t (x1, x2))
+			call qpex_pbpin (ex, EQLX$T, offset, d_x1, d_x2)
+		    else
+			call qpex_pbpin (ex, RNGX$T, offset, d_x1, d_x2)
+		}
+
+	    } else if (nranges < EX_LUTMINRANGES(ex)) {
+		# If the number of ranges to be tested for the data is small,
+		# compile explicit code to perform the range tests directly.
+		# Otherwise skip forward and compile a lookup table instead.
+		# In either case, the function of the instructions compiled
+		# is to test the data loaded into the register above, setting
+		# the value of PASS to true if the data lies in any of the
+		# indicated ranges.
+
+		# Check for !X, which is indicated in range list form by a
+		# two element list bracketing the X on each side.
+
+		if (nranges == 2)
+		    if (IS_LEFT$T(XS(1)) && IS_RIGHT$T(XE(2)))
+		    $if (datatype == si)
+			if (XE(1)+1 == XS(2)-1) {
+			    if (dtype == TY_SHORT)
+				opcode = NEQXS
+			    else
+				opcode = NEQXI
+			    call qpex_pbpin (ex, opcode, offset, XE(1)+1, 0)
+			    goto resume_
+			}
+		    $else $if (datatype == r)
+			if (fp_equal$t (XE(1), XS(2))) {
+			    call qpex_pbpin (ex, NEQX$T, offset, XE(1), 0)
+			    goto resume_
+			}
+		    $else
+			if (fp_equal$t (XE(1), XS(2))) {
+			    call qpex_pbpin (ex, NEQX$T, offset,
+				qpex_refd(ex,XE(1)), 0)
+			    goto resume_
+			}
+		    $endif $endif
+
+		# If at level zero, output instruction to load data into
+		# register and initialize PASS to false.  Don't bother if
+		# compiling a subprogram, as these operations will already
+		# have been performed by the caller.
+
+		if (level == 0) {
+		    $if (datatype == i)
+			if (dtype == TY_SHORT)
+			    opcode = LDSI
+			else
+			    opcode = LDII
+		    $else
+			opcode = LD$T$T
+		    $endif
+		    call qpex_pbpin (ex, opcode, offset, 0, 0)
+		}
+
+		# Compile a series of equality or range tests.
+		do i = 1, nranges {
+		    x1 = XS(i);  x2 = XE(i)
+		    $if (datatype == d)
+			d_x1 = qpex_refd (ex, x1)
+			d_x2 = qpex_refd (ex, x2)
+		    $else
+			d_x1 = x1
+			d_x2 = x2
+		    $endif
+
+		    if (IS_LEFT$T(x1))
+			call qpex_pbpin (ex, LEQ$T, d_x2, 0, 0)
+		    else if (IS_RIGHT$T(x2))
+			call qpex_pbpin (ex, GEQ$T, d_x1, 0, 0)
+		    else if (fp_equal$t (x1, x2))
+			call qpex_pbpin (ex, EQL$T, d_x1, d_x2, 0)
+		    else
+			call qpex_pbpin (ex, RNG$T, d_x1, d_x2, 0)
+		}
+
+		# Compile a test and exit instruction.
+		call qpex_pbpin (ex, XIFF, 0, 0, 0)
+
+	    } else {
+		# Compile a lookup table test. Lookup tables may be
+		# either compressed or fully resolved.  If compressed
+		# (the resolution of the table is less than that of the
+		# range data, e.g., for floating point lookup tables) a
+		# LUT bin may have as its value, in addition to the
+		# usual 0 or 1, the address of an interpreter subprogram
+		# to be executed to test data values mapping to that bin.
+		# The subprogram pointed to may in turn be another lookup
+		# table, hence in the general case a tree of lookup tables
+		# and little code segments may be compiled to implement
+		# a complex range list test.
+
+		# Get the data range of the lookup table.
+		xmin = XS(1)
+		if (IS_LEFT$T(xmin))
+		    xmin = XE(1)
+		xmax = XE(nranges)
+		if (IS_RIGHT$T(xmax))
+		    xmax = XS(nranges)
+
+		# Get the lookup table size.  Use a fully resolved table
+		# if the data is integer and the number of bins required
+		# is modest.
+
+		$if (datatype == i)
+		    nbins = xmax - xmin + 1
+		    if (nbins > EX_MAXFRLUTLEN(ex))
+			nbins = min (EX_MAXRRLUTLEN(ex),
+			    nranges * EX_LUTSCALE(ex))
+		$else
+		    nbins = min (EX_MAXRRLUTLEN(ex), nranges * EX_LUTSCALE(ex))
+		$endif
+
+		# Determine the mapping from data space to table space.
+		xoffset = xmin
+		$if (datatype == i)
+		    xscale = nbins / (xmax - xmin + 1)
+		$else
+		    xscale = nbins / (xmax - xmin)
+		$endif
+
+		# Allocate and initialize the lookup table descriptor.
+		lt = qpex_dballoc (ex, LEN_LTDES, TY_STRUCT)
+		call calloc (lut, nbins, TY_SHORT)
+
+		LT_NEXT(lt)	= EX_LTHEAD(ex)
+		EX_LTHEAD(ex)	= lt
+		LT_TYPE(lt)	= TY_PIXEL
+		LT_LUTP(lt)	= lut
+		LT_NBINS(lt)	= nbins
+		LT_$T0(lt)	= xoffset
+		LT_$TS(lt)	= xscale
+		LT_LEFT(lt)	= btoi (IS_LEFT$T(XS(1)))
+		LT_RIGHT(lt)	= btoi (IS_RIGHT$T(XE(nranges)))
+
+		# Compile the LUTX test instruction.  Save a back pointer
+		# to the instruction so that we can edit the jump field in
+		# case a subprogram is compiled after the LUTXt.
+
+		lutx = qpex_pbpos (ex)
+		if (dtype == TY_SHORT)
+		    call qpex_pbpin (ex, LUTXS, offset, lt, 0)
+		else
+		    call qpex_pbpin (ex, LUTX$T, offset, lt, 0)
+
+		xp = 1
+		bin = 1
+continue_
+		n_xs = xs + nranges
+		n_xe = xe + nranges
+
+		# Initialize the lookup table.
+		do i = bin, nbins {
+		    x1 = (i-1) / xscale + xoffset
+		    $if (datatype == i)
+			x2 = i / xscale + xoffset - 1
+		    $else
+			x2 = i / xscale + xoffset
+		    $endif
+
+		    # Get sub-rangelist for range x1:x2.
+		    n_nranges = qpex_sublist$t (x1, x2,
+			Mem$t[xs], Mem$t[xe], nranges, xp,
+			Mem$t[n_xs], Mem$t[n_xe])
+
+		    if (n_nranges <= 0) {
+			Mems[lut+i-1] = 0
+
+		    } else if (n_nranges == 1 && IS_LEFT$T(Mem$t[n_xs]) &&
+			IS_RIGHT$T(Mem$t[n_xe])) {
+
+			Mems[lut+i-1] = 1
+
+		    } else {
+			# Compile the sub-rangelist as a subprogram.
+
+			# First set the LUT bin to point to the subprogram.
+			# We cannot use the IP directly here since the LUT
+			# bins are short integer, so store the offset into
+			# the pb instead (guaranteed to be >= 4).
+
+			Mems[lut+i-1] = qpex_pbpos(ex) - pb
+
+			# Push a new context.
+			level = level + 1
+			if (level > MAX_LEVELS) {
+			    call eprintf ("%s: ")
+				call pargstr (qpexwarn)
+			    call eprintf ("Excessive LUT nesting\n")
+			    goto error_
+			}
+
+			# Save current LUT compilation context.
+			sv_xs[level] = xs
+			sv_xe[level] = xe
+			sv_xp[level] = xp
+			sv_xoffset[level] = xoffset
+			sv_xscale[level] = xscale
+			sv_nranges[level] = nranges
+			sv_lt[level] = lt
+			sv_bin[level] = i
+			sv_nbins[level] = nbins
+			sv_lut[level] = lut
+			sv_lutx[level] = lutx
+
+			# Set up context for the new rangelist.
+			xs = n_xs
+			xe = n_xe
+			nranges = n_nranges
+
+			goto next_
+		    }
+		}
+
+		# Compile a test and exit instruction if the LUT calls any
+		# subprograms.
+
+		if (qpex_pbpos(ex) - lutx > LEN_INSTRUCTION)
+		    call qpex_pbpin (ex, XIFF, 0, 0, 0)
+	    }
+resume_
+	    # Resume lookup table compilation if exiting due to LUT-bin
+	    # subprogram compilation.
+
+	    if (level > 0) {
+		# Pop saved context.
+		xs = sv_xs[level]
+		xe = sv_xe[level]
+		xp = sv_xp[level]
+		xoffset = sv_xoffset[level]
+		xscale = sv_xscale[level]
+		nranges = sv_nranges[level]
+		lt = sv_lt[level]
+		bin = sv_bin[level]
+		nbins = sv_nbins[level]
+		lut = sv_lut[level]
+		lutx = sv_lutx[level]
+
+		# Compile a return from subprogram.
+		call qpex_pbpin (ex, RET, 0, 0, 0)
+
+		# Patch up the original LUTX instruction to jump over the
+		# subprogram we have just finished compiling.
+
+		IARG3(lutx) = qpex_pbpos (ex)
+
+		# Resume compilation at the next LUT bin.
+		bin = bin + 1
+		level = level - 1
+		goto continue_
+	    }
+	} until (level <= 0)
+
+	# Finish setting up the eterm descriptor.
+	ET_NINSTR(et) = (qpex_pbpos(ex) - ET_PROGPTR(et)) / LEN_INSTRUCTION
+
+	return (OK)
+error_
+	call qpex_free (ex, pb_save, db_save)
+	return (ERR)
+end
diff --git a/sys/qpoe/qpexdata.x b/sys/qpoe/qpexdata.x
new file mode 100644
index 00000000..1cfc7810
--- /dev/null
+++ b/sys/qpoe/qpexdata.x
@@ -0,0 +1,210 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	"qpex.h"
+
+.help qpexdata
+.nf --------------------------------------------------------------------------
+QPEXDATA -- Data management package for QPEX.  The QPEX data structures
+consist of the QPEX descriptor and two main data buffers, the program buffer
+(pb), containing the instructions to be executed (interpreted) to evaluate
+an expression, and the data buffer (db), containing assorted data structures,
+e.g., the linked list of expression term descriptors, the lookup table
+descriptors, storage for DOUBLE data appearing in the compiled expression,
+and so on.  The program and data buffers are dynamically allocated but are
+not relocatable, so to absolute pointers may be used to reference the objects
+therein (hence, runtime overflow is possible).
+
+During expression compilation the following routines are used to add data
+objects to the program and data buffers:
+
+		      qpex_mark (ex, pb_save, db_save)
+		      qpex_free (ex, pb_save, db_save)
+
+	        ip = qpex_pbpos (ex)
+		     qpex_pbpin (ex, opcode, arg1, arg2, arg3)
+
+	      ptr = qpex_dbpstr (ex, strval)
+	     intval = qpex_refd (ex, dval)
+	     ptr = qpex_dballoc (ex, nelem, dtype)
+
+QPEX_MARK and QPEX_FREE are used to mark the current tops of the two buffers
+and subspequently free storage back to that point, e.g., for error recovery
+following detection of a compilation error.  QPEX_PBPOS returns a pointer to
+the location in the program buffer where next instruction will be placed.
+QPEX_PBPIN compiles an instruction at that location.
+
+The main storage allocator for the data buffer is QPEX_DBALLOC, which allocates
+a properly aligned buffer of the indicated type in the data buffer, and returns
+a pointer of the same type as the function value.  QPEX_DBPSTR stores a string
+constant in the data buffer and returns a pointer to the stored string.
+QPEX_REFD stores the given type double constant in the data buffer and returns
+(as an integer) a pointer to the stored value (this is necessary to permit
+only SZ_INT argument fields in instructions).
+.endhelp ---------------------------------------------------------------------
+
+
+# QPEX_MARK -- Mark the top of the program and data buffers.
+
+procedure qpex_mark (ex, pb_save, db_save)
+
+pointer	ex			#I QPEX descriptor
+pointer	pb_save, db_save	#O saved pointers
+
+begin
+	pb_save = EX_PBOP(ex)
+	db_save = EX_DBOP(ex)
+end
+
+
+# QPEX_FREE -- Free storage back to the marked points.
+
+procedure qpex_free (ex, pb_save, db_save)
+
+pointer	ex			#I QPEX descriptor
+pointer	pb_save, db_save	#I saved pointers
+
+pointer	top, prev, lt, et
+pointer	coerce()
+
+begin
+	# Free space in program buffer.
+	call aclri (Memi[pb_save], EX_PBTOP(ex) - pb_save)
+	EX_PBOP(ex) = pb_save
+
+	# Free space in the data buffer.  Prune the LUT and ETERM lists
+	# and then reset the data buffer pointer.
+
+	# The LT list is backward linked from the most recent entry.
+	top = coerce (db_save, TY_CHAR, TY_STRUCT)
+	for (lt=EX_LTHEAD(ex);  lt != NULL;  lt=LT_NEXT(lt))
+	    if (lt >= top) {
+		call mfree (LT_LUTP(lt), TY_SHORT)
+		EX_LTHEAD(ex) = LT_NEXT(lt)
+	    }
+
+	# The ET list is forward linked from the first entry.
+	prev = NULL
+	for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et))
+	    if (et >= top) {
+		if (prev != NULL)
+		    ET_NEXT(prev) = NULL
+		EX_ETTAIL(ex) = prev
+		break
+	    }
+
+	EX_DBOP(ex) = db_save
+end
+
+
+# QPEX_PBPOS -- Return a pointer to the program buffer location where the
+# next instruction to be compiled will be located.
+
+pointer procedure qpex_pbpos (ex)
+
+pointer	ex			#I QPEX descriptor
+
+begin
+	return (EX_PBOP(ex))
+end
+
+
+# QPEX_PBPIN -- Add an insruction at the end of the program buffer.
+
+procedure qpex_pbpin (ex, opcode, arg1, arg2, arg3)
+
+pointer	ex			#I QPEX descriptor
+int	opcode			#I instruction opcode
+int	arg1,arg2,arg3		#I instruction data fields (typeless)
+
+pointer	op
+errchk	syserr
+
+begin
+	op = EX_PBOP(ex)
+	if (op >= EX_PBTOP(ex))
+	    call syserr (SYS_QPEXPBOVFL)
+
+	OPCODE(op) = opcode
+	IARG1(op)  = arg1
+	IARG2(op)  = arg2
+	IARG3(op)  = arg3
+
+	EX_PBOP(ex) = op + LEN_INSTRUCTION
+end
+
+
+# QPEX_DBPSTR -- Store a string constant in the data buffer, returning a
+# pointer to the stored string as the function value.
+
+pointer procedure qpex_dbpstr (ex, strval)
+
+pointer	ex			#I QPEX descriptor
+char	strval[ARB]		#I string to be stored
+
+pointer	op
+int	nchars
+int	strlen()
+errchk	syserr
+
+begin
+	op = EX_DBOP(ex)
+	nchars = strlen (strval) + 1
+
+	if (op + nchars >= EX_DBTOP(ex))
+	    call syserr (SYS_QPEXDBOVFL)
+
+	call strcpy (strval, Memc[op], nchars)
+	EX_DBOP(ex) = op + nchars
+
+	return (op)
+end
+
+
+# QPEX_REFD -- Reference a type DOUBLE datum, returning (as an integer) a
+# pointer to the double value, which is stored in the data buffer.
+
+int procedure qpex_refd (ex, value)
+
+pointer	ex			#I QPEX descriptor
+double	value			#I double value
+
+pointer	dp
+pointer	qpex_dballoc()
+errchk	qpex_dballoc
+
+begin
+	dp = qpex_dballoc (ex, 1, TY_DOUBLE)
+	Memd[dp] = value
+	return (dp)
+end
+
+
+# QPEX_DBALLOC -- Allocate storage of the indicated type in the data
+# buffer, returning a typed pointer to the buffer.  The buffer is fully
+# aligned.
+
+pointer procedure qpex_dballoc (ex, nelem, dtype)
+
+pointer	ex			#I QPEX descriptor
+int	nelem			#I amount of storage desired
+int	dtype			#I datatype of the storage element
+
+pointer	op, top
+pointer	coerce()
+int	sizeof()
+errchk	syserr
+
+begin
+	op = EX_DBOP(ex)
+	while (mod (op-1, SZ_DOUBLE) != 0)
+	    op = op + 1
+
+	top = op + nelem * sizeof(dtype)
+	if (top >= EX_DBTOP(ex))
+	    call syserr (SYS_QPEXDBOVFL)
+
+	EX_DBOP(ex) = top
+	return (coerce (op, TY_CHAR, dtype))
+end
diff --git a/sys/qpoe/qpexdebug.x b/sys/qpoe/qpexdebug.x
new file mode 100644
index 00000000..26f63e8b
--- /dev/null
+++ b/sys/qpoe/qpexdebug.x
@@ -0,0 +1,441 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpexset.h>
+include	<mach.h>
+include	"qpex.h"
+include	"qpoe.h"
+
+define	NLUTPERLINE	15
+define	SZ_TEXT		4
+define	SZ_FILTERBUF	32768
+
+# QPEX_DEBUG -- Output text describing the state and contents of the QPEX
+# descriptor (compiled event attribute filter).
+
+procedure qpex_debug (ex, out, what)
+
+pointer	ex			#I QPEX descriptor
+int	out			#I output stream
+int	what			#I bitflags defining what to print
+
+char	binval[SZ_TEXT]
+pointer	sp, text, label, lutp, et, lt, pb, ip
+int	neterms, lutno, proglen, dest, nout, ch, i
+int	qpex_getfilter()
+define	lut_ 91
+
+begin
+	call smark (sp)
+
+	neterms = 0
+	for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et))
+	    neterms = neterms + 1
+	proglen = (EX_PBOP(ex) - EX_PB(ex)) / LEN_INSTRUCTION
+
+	# Print summary information.
+	if (and (what, QPEXD_SUMMARY) != 0) {
+	    call fprintf (out,
+		"QPEX_DEBUG: ex=%xX, neterms=%d, proglen=%d/%d\n")
+		call pargi (ex)
+		call pargi (neterms)
+		call pargi (proglen)
+		call pargi ((EX_PBTOP(ex) - EX_PB(ex)) / LEN_INSTRUCTION)
+
+	    call fprintf (out, "pb=%xX, pbtop=%xX, pbop=%xX, start=%xX\n")
+		call pargi (EX_PB(ex))
+		call pargi (EX_PBTOP(ex))
+		call pargi (EX_PBOP(ex))
+		call pargi (EX_START(ex))
+
+	    call fprintf (out, "db=%xX, dbtop=%xX, dbop=%xX, datalen=%d/%d\n")
+		call pargi (EX_DB(ex))
+		call pargi (EX_DBTOP(ex))
+		call pargi (EX_DBOP(ex))
+		call pargi (EX_DBOP(ex) - EX_DB(ex))
+		call pargi (EX_DBTOP(ex) - EX_DB(ex))
+
+	    call fprintf (out, "max_frlutlen=%d, max_rrlutlen=%d, ")
+		call pargi (EX_MAXFRLUTLEN(ex))
+		call pargi (EX_MAXRRLUTLEN(ex))
+	    call fprintf (out, "lut_scale=%d, lut_minranges=%d\n")
+		call pargi (EX_LUTSCALE(ex))
+		call pargi (EX_LUTMINRANGES(ex))
+
+	    call fprintf (out, "ethead=%xX, ettail=%xX, lthead=%xX\n")
+		call pargi (EX_ETHEAD(ex))
+		call pargi (EX_ETTAIL(ex))
+		call pargi (EX_LTHEAD(ex))
+	}
+
+	# Regenerate and print the compiled expression.
+	if (and (what, QPEXD_SHOWEXPR) != 0) {
+	    call salloc (text, SZ_FILTERBUF, TY_CHAR)
+	    call fprintf (out,
+		"==================== expr ========================\n")
+	    if (qpex_getfilter (ex, Memc[text], SZ_FILTERBUF) > 0) {
+		call putline (out, Memc[text])
+		call fprintf (out, "\n")
+	    }
+	}
+
+	# Decode the compiled program (print assembled instructions).
+	if (and (what, QPEXD_PROGRAM) != 0) {
+	    pb = EX_PB(ex)
+
+	    call salloc (label, proglen+1, TY_INT)
+	    call aclri (Memi[label], proglen+1)
+
+	    # Flag those instructions which are the destinations of branches.
+	    do i = 1, proglen {
+		ip = pb + (i - 1) * LEN_INSTRUCTION
+		switch (OPCODE(ip)) {
+		case GOTO:
+		    dest = (IARG1(ip) - pb) / LEN_INSTRUCTION
+		    Memi[label+dest] = YES
+		case LUTXS, LUTXI, LUTXR, LUTXD:
+		    if (IARG3(ip) == NULL)
+			dest = i
+		    else
+			dest = (IARG3(ip) - pb) / LEN_INSTRUCTION
+		    Memi[label+dest] = YES
+		}
+	    }
+
+	    # Do the same for code segments pointed to by lookup tables.
+	    for (lt=EX_LTHEAD(ex);  lt != NULL;  lt=LT_NEXT(lt)) {
+		lutp  = LT_LUTP(lt)
+		do i = 0, LT_NBINS(lt) - 1 {
+		    dest = Mems[lutp+i]
+		    if (dest > 1) {
+			dest = dest / LEN_INSTRUCTION
+			Memi[label+dest] = YES
+		    }
+		}
+	    }
+
+	    # Output the program.
+	    call fprintf (out,
+		"==================== program =====================\n")
+
+	    do i = 1, proglen + 1 {
+		ip = pb + (i - 1) * LEN_INSTRUCTION
+
+		# Output instruction label if target of a branch.
+		if (Memi[label+i-1] == YES) {
+		    call fprintf (out, "L%d:\t")
+			call pargi (i)
+		} else
+		    call fprintf (out, "\t")
+
+		# Decode and output the instruction itself.
+		switch (OPCODE(ip)) {
+		case NOP:
+		    call fprintf (out, "nop")
+		case GOTO:
+		    dest = (IARG1(ip) - pb) / LEN_INSTRUCTION + 1
+		    call fprintf (out, "goto L%d")
+			call pargi (dest)
+		case XIFT:
+		    call fprintf (out, "xift")
+		case XIFF:
+		    call fprintf (out, "xiff")
+		case PASS:
+		    call fprintf (out, "pass")
+		case RET:
+		    call fprintf (out, "ret")
+
+		case LDSI:
+		    call fprintf (out, "ldsi\t(%d)")
+			call pargi (IARG1(ip))
+		case LDII:
+		    call fprintf (out, "ldii\t(%d)")
+			call pargi (IARG1(ip))
+		case LDRR:
+		    call fprintf (out, "ldrr\t(%d)")
+			call pargi (IARG1(ip))
+		case LDRD:
+		    call fprintf (out, "ldrd\t(%d)")
+			call pargi (IARG1(ip))
+		case LDDD:
+		    call fprintf (out, "lddd\t(%d)")
+			call pargi (IARG1(ip))
+
+		case BTTI:
+		    call fprintf (out, "btti\t%oB")
+			call pargi (IARG1(ip))
+		case EQLI:
+		    call fprintf (out, "eqli\t%d")
+			call pargi (IARG1(ip))
+		case EQLR:
+		    call fprintf (out, "eqlr\t%g")
+			call pargr (RARG1(ip))
+		case EQLD:
+		    call fprintf (out, "eqld\t%g")
+			call pargd (DARG1(ip))
+		case LEQI:
+		    call fprintf (out, "leqi\t%d")
+			call pargi (IARG1(ip))
+		case LEQR:
+		    call fprintf (out, "leqr\t%g")
+			call pargr (RARG1(ip))
+		case LEQD:
+		    call fprintf (out, "leqd\t%g")
+			call pargd (DARG1(ip))
+		case GEQI:
+		    call fprintf (out, "geqi\t%d")
+			call pargi (IARG1(ip))
+		case GEQR:
+		    call fprintf (out, "geqr\t%g")
+			call pargr (RARG1(ip))
+		case GEQD:
+		    call fprintf (out, "geqd\t%g")
+			call pargd (DARG1(ip))
+
+		case RNGI:
+		    call fprintf (out, "rngi\t%d, %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case RNGR:
+		    call fprintf (out, "rngr\t%g, %g")
+			call pargr (RARG1(ip))
+			call pargr (RARG2(ip))
+		case RNGD:
+		    call fprintf (out, "rngd\t%g, %g")
+			call pargd (DARG1(ip))
+			call pargd (DARG2(ip))
+
+		case BTTXS:
+		    call fprintf (out, "bttxs\t(%d), %oB")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case BTTXI:
+		    call fprintf (out, "bttxi\t(%d), %oB")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+
+		case NEQXS:
+		    call fprintf (out, "neqxs\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case NEQXI:
+		    call fprintf (out, "neqxi\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case NEQXR:
+		    call fprintf (out, "neqxr\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargr (RARG2(ip))
+		case NEQXD:
+		    call fprintf (out, "neqxd\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargd (DARG2(ip))
+
+		case EQLXS:
+		    call fprintf (out, "eqlxs\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case EQLXI:
+		    call fprintf (out, "eqlxi\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case EQLXR:
+		    call fprintf (out, "eqlxr\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargr (RARG2(ip))
+		case EQLXD:
+		    call fprintf (out, "eqlxd\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargd (DARG2(ip))
+
+		case LEQXS:
+		    call fprintf (out, "leqxs\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case LEQXI:
+		    call fprintf (out, "leqxi\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case LEQXR:
+		    call fprintf (out, "leqxr\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargr (RARG2(ip))
+		case LEQXD:
+		    call fprintf (out, "leqxd\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargd (DARG2(ip))
+
+		case GEQXS:
+		    call fprintf (out, "geqxs\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case GEQXI:
+		    call fprintf (out, "geqxi\t(%d), %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+		case GEQXR:
+		    call fprintf (out, "geqxr\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargr (RARG2(ip))
+		case GEQXD:
+		    call fprintf (out, "geqxd\t(%d), %g")
+			call pargi (IARG1(ip))
+			call pargd (DARG2(ip))
+
+		case RNGXS:
+		    call fprintf (out, "rngxs\t(%d), %d, %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+			call pargi (IARG3(ip))
+		case RNGXI:
+		    call fprintf (out, "rngxi\t(%d), %d, %d")
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+			call pargi (IARG3(ip))
+		case RNGXR:
+		    call fprintf (out, "rngxr\t(%d), %g, %g")
+			call pargi (IARG1(ip))
+			call pargr (RARG2(ip))
+			call pargr (RARG3(ip))
+		case RNGXD:
+		    call fprintf (out, "rngxd\t(%d), %g, %g")
+			call pargi (IARG1(ip))
+			call pargd (DARG2(ip))
+			call pargd (DARG3(ip))
+
+		case LUTXS:
+		    ch = 's'
+		    goto lut_
+		case LUTXI:
+		    ch = 'i'
+		    goto lut_
+		case LUTXR:
+		    ch = 'r'
+		    goto lut_
+		case LUTXD:
+		    ch = 'd'
+lut_		    call fprintf (out, "lutx%c\t(%d), %xX, L%d")
+			call pargi (ch)
+			call pargi (IARG1(ip))
+			call pargi (IARG2(ip))
+			if (IARG3(ip) != NULL)
+			    call pargi ((IARG3(ip) - pb) / LEN_INSTRUCTION + 1)
+			else
+			    call pargi (i + 1)
+		}
+
+		call fprintf (out, "\n")
+	    }
+	}
+
+	# Output expression terms list.
+	if (and (what, QPEXD_ETLIST) != 0) {
+	    call fprintf (out,
+		"==================== eterms ======================\n")
+	    if (neterms > 0) {
+		call fprintf (out,
+		    " N TYPE OFF  IP  LEN DEL ATTRIBUTE OP EXPR\n")
+		neterms = 0
+		for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et)) {
+		    neterms = neterms + 1
+		    call fprintf (out,
+			"%2d %4d %3d %3d %4d %3d %9.9s %2s ")
+			call pargi (neterms)
+			call pargi (ET_ATTTYPE(et))
+			call pargi (ET_ATTOFF(et))
+			call pargi ((ET_PROGPTR(et) - pb) / LEN_INSTRUCTION + 1)
+			call pargi (ET_NINSTR(et))
+			call pargi (ET_DELETED(et))
+			call pargstr (Memc[ET_ATNAME(et)])
+			call pargstr (Memc[ET_ASSIGNOP(et)])
+		    call putline (out, Memc[ET_EXPRTEXT(et)])
+		    call putline (out, "\n")
+		}
+	    }
+	}
+
+	# Output lookup table list.
+	if (and (what, QPEXD_LTLIST+QPEXD_SHOWLUTS) != 0) {
+	    if (EX_LTHEAD(ex) != NULL) {
+		call fprintf (out,
+		    "==================== lutlist =====================\n")
+
+		# Output column labels.
+		call fprintf (out,
+		    " N     LT   LUTP TYPE NBINS  L R %*wZERO  SCALE\n")
+		    if (LT_TYPE(EX_LTHEAD(ex)) == TY_DOUBLE)
+			call pargi (NDIGITS_DP - 4)
+		    else
+			call pargi (NDIGITS_RP - 4)
+
+		# Output lookup table descriptors.
+		lutno = 0
+		for (lt=EX_LTHEAD(ex);  lt != NULL;  lt=LT_NEXT(lt)) {
+		    lutno = lutno + 1
+		    call fprintf (out, "%2d %6x %6x %4d %5d  %d %d %*g  %g\n")
+			call pargi (lutno)
+			call pargi (lt)
+			call pargi (LT_LUTP(lt))
+			call pargi (LT_TYPE(lt))
+			call pargi (LT_NBINS(lt))
+			call pargi (LT_LEFT(lt))
+			call pargi (LT_RIGHT(lt))
+
+			switch (LT_TYPE(lt)) {
+			case TY_INT:
+			    call pargi (NDIGITS_RP)
+			    call pargr (LT_I0(lt))
+			    call pargr (LT_IS(lt))
+			case TY_REAL:
+			    call pargi (NDIGITS_RP)
+			    call pargr (LT_R0(lt))
+			    call pargr (LT_RS(lt))
+			case TY_DOUBLE:
+			    call pargi (NDIGITS_DP)
+			    call pargd (LT_D0(lt))
+			    call pargd (LT_DS(lt))
+			}
+		}
+	    }
+
+	    # Dump the lookup table data.
+	    if (and (what, QPEXD_SHOWLUTS) != 0) {
+		lutno = 0
+		for (lt=EX_LTHEAD(ex);  lt != NULL;  lt=LT_NEXT(lt)) {
+		    lutno = lutno + 1
+		    lutp  = LT_LUTP(lt)
+		    call fprintf (out,
+			"================== LUT %d (%x) ==================\n")
+			call pargi (lutno)
+			call pargi (lutp)
+		    nout = 0
+		    do i = 0, LT_NBINS(lt) - 1 {
+			if (i == 0 || nout >= NLUTPERLINE) {
+			    if (i > 0)
+				call fprintf (out, "\n")
+			    call fprintf (out, "%04d")
+				call pargi (i)
+			    nout = 0
+			}
+
+			# Print the bin value as 0, 1, or a statement label.
+			dest = Mems[lutp+i]
+			if (dest <= 1) {
+			    call fprintf (out, " %4d")
+				call pargi (dest)
+			} else {
+			    call sprintf (binval, SZ_TEXT, "L%d")
+				call pargi (dest / LEN_INSTRUCTION + 1)
+			    call fprintf (out, " %4s")
+				call pargstr (binval)
+			}
+
+			nout = nout + 1
+		    }
+		    if (nout > 0)
+			call fprintf (out, "\n")
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpexdel.x b/sys/qpoe/qpexdel.x
new file mode 100644
index 00000000..ce4da432
--- /dev/null
+++ b/sys/qpoe/qpexdel.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpex.h"
+
+# QPEX_DELETE -- Delete any previously compiled expression terms for the
+# event attribute with the given offset and datatype.  Only terms up to and
+# including ET_LAST are affected (allowing deletion while compiling additional
+# terms).
+
+procedure qpex_delete (ex, et_last, offset, dtype)
+
+pointer	ex			#I QPEX descriptor
+pointer	et_last			#I last expression term to be edited
+int	offset			#I typed offset of attribute in event struct
+int	dtype			#I datatype of attribute
+
+pointer	et, ip
+int	ninstr, i
+
+begin
+	if (et_last == NULL)
+	    return
+
+	for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et)) {
+	    # Skip over already deleted terms or terms for other attributes.
+	    if (ET_DELETED(et) == YES)
+		next
+	    else if (ET_ATTOFF(et) != offset || ET_ATTTYPE(et) != dtype)
+		next
+
+	    # Physically and logically delete the term.  Edit the program
+	    # buffer and replace the compiled sequence of instructions by
+	    # a GOTO followed by a series of NO-OPs.
+
+	    ip = ET_PROGPTR(et)
+	    ninstr = ET_NINSTR(et)
+
+	    OPCODE(ip) = GOTO
+	    IARG1(ip)  = ip + ninstr * LEN_INSTRUCTION
+	    IARG2(ip)  = NULL
+	    IARG3(ip)  = NULL
+
+	    do i = 2, ninstr {
+		ip = ET_PROGPTR(et) + (i-1) * LEN_INSTRUCTION
+		OPCODE(ip) = NOP
+		IARG1(ip)  = NULL
+		IARG2(ip)  = NULL
+		IARG3(ip)  = NULL
+	    }
+
+	    # Flag the eterm as deleted.
+	    ET_DELETED(et) = YES
+
+	    if (et == et_last)
+		break
+	}
+end
diff --git a/sys/qpoe/qpexeval.x b/sys/qpoe/qpexeval.x
new file mode 100644
index 00000000..5e120296
--- /dev/null
+++ b/sys/qpoe/qpexeval.x
@@ -0,0 +1,362 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "qpex.h"
+
+define	RTOL	(EPSILONR * 10.0)	# (only useful for normalized numbers)
+define	DTOL	(EPSILOND * 10.0)
+
+# QPEX_EVALUATE -- Evaluate the compiled event-attribute expression for the
+# given seqeuence of event structs.  Expression evaluation for each event
+# terminates as soon as an attribute test fails.  If all attribute tests
+# succeed (i.e., the full expression is evaluated or the evaluate function
+# runs to completion) then the event pointer is put on the output list O_EV,
+# indicating that the event satisfies the given selection expression.
+# The function value is the number of events which passed the filter.
+# The time required to evaluate an expression depends upon the complexity of
+# the expression to be evaluated, and the fraction of events which fail the
+# test (a fail is determined quicker than a pass - attribute tests likely to
+# fail should appear first in the expression).
+
+int procedure qpex_evaluate (ex, i_ev, o_ev, nev)
+
+pointer ex			#I QPEX descriptor (expression)
+pointer i_ev[nev]		#I array of pointers to event structs
+pointer	o_ev[nev]		#O receives the pointers of the passed events
+int	nev			#I number of input events
+
+int	i0			# integer data register
+real	r0			# real data register
+double	d0			# double data register
+bool	pass			# expression value
+int	npass			# number of events which pass expr
+
+real	rbin
+bool	pv_save[MAX_LEVELS]
+pointer ip_save[MAX_LEVELS]
+pointer lt, ev, ev_i, ev_r, ev_d, ip
+int	level, bin, i, j, v
+
+define	lut_ 91
+define	ret_ 92
+define	ev_s ev
+
+begin
+	npass = 0
+
+	do j = 1, nev {
+	    pass = false
+	    ev = i_ev[j]
+
+	    # Get event struct pointers of various types.
+	    ev_d = (ev - 1) * SZ_SHORT / SZ_DOUBLE + 1
+	    ev_i = (ev - 1) * SZ_SHORT / SZ_INT + 1
+	    ev_r = ev_i
+
+	    # Execute each compiled instruction in sequence until the value
+	    # of the compiled attribute-value expression is known.  The call
+	    # stack level is used to keep track of subroutine calls
+	    # (subroutines are used to evaluate the indeterminate cells of
+	    # compressed lookup tables).
+
+	    # Notes on expression evaluation.
+	    # ---------------------------------
+	    # An expression consists of 1 or more expression terms, all of
+	    # which must pass the event for the event to pass the filter.
+	    #
+	    # An expression term consists of a range list giving a list of
+	    # acceptable values or ranges of values.
+	    #
+	    # The compiled expression consists of a sequence of instruction
+	    # blocks, one for each expression term.  If the event fails to
+	    # pass any expression term (instruction block) then the event
+	    # fails and we are done.  Instruction blocks are of three types:
+	    #
+	    #	1)	Multiple instructions consisting of a load register,
+	    #		any number of register tests, then a XIFF or XIFT
+	    #		test at the end of the block.  PASS is set to false
+	    # 		at the beginning of the block and can be set to true
+	    #		by any register test to pass the event to the next
+	    #		expression term.
+	    #
+	    #   2)	In simple cases the above can all be expressed as a
+	    #		single test-and-exit-if-false instruction.  These are
+	    #		the "X" instructions below.
+	    #
+	    #   3)	The lookup table (LUTX) instruction.  LUTX is like
+	    #		case 2) except that it may compile as a sequence of
+	    #		many instructions, using subprograms to evaluate the
+	    #		value of LUT bins.  LUTs may nest.  When lookup table
+	    #		evaluation is complete the instruction branches
+	    #		forward to a closing XIFF which is used to test the
+	    #		value of PASS returned by the executed LUT-bin
+	    #		subprograms.
+	    #
+	    # The blocks of instructions corresponding to successive expression
+	    # terms are executed until the PASS instruction is encountered.
+	    # Execution of PASS terminates evaluation and passes the event.
+
+	    ip = EX_START(ex)
+	    level = 0
+
+	    do i = 1, MAX_INSTRUCTIONS {
+		pragma switch_no_range_check
+		switch (OPCODE(ip)) {
+		case NOP:				# null operation
+		    ;
+		case GOTO:				# go-to prog offset
+		    ip = IARG1(ip)
+		    next
+		case XIFT: 				# exit if true
+		    if (pass) {
+			pass = false
+			goto ret_
+		    }
+		case XIFF:				# exit if false
+		    if (!pass)
+			goto ret_
+		case PASS:
+		    pass = true
+		    break
+		case RET:				# return from subprog
+ret_		    if (level > 0) {
+			pass = (pv_save[level] || pass)
+			ip = ip_save[level]
+			level = level - 1
+			next
+		    } else
+			break
+
+		case LDSI: 				 # load registers
+		    i0 = Mems[ev_s+IARG1(ip)]
+		    pass = false
+		case LDII:
+		    i0 = Memi[ev_i+IARG1(ip)]
+		    pass = false
+		case LDRR:
+		    r0 = Memr[ev_r+IARG1(ip)]
+		    pass = false
+		case LDRD:
+		    d0 = Memr[ev_r+IARG1(ip)]
+		    pass = false
+		case LDDD:
+		    d0 = Memd[ev_d+IARG1(ip)]
+		    pass = false
+
+		case BTTI: 				 # register tests
+		    pass = pass || (and (i0, IARG1(ip)) != 0)
+		case EQLI:
+		    pass = pass || (i0 == IARG1(ip))
+		case EQLR:
+		    pass = pass || (abs(r0 - RARG1(ip)) < RTOL)
+		case EQLD:
+		    pass = pass || (abs(d0 - DARG1(ip)) < DTOL)
+		case LEQI:
+		    pass = pass || (i0 <= IARG1(ip))
+		case LEQR:
+		    pass = pass || (r0 <= RARG1(ip))
+		case LEQD:
+		    pass = pass || (d0 <= DARG1(ip))
+		case GEQI:
+		    pass = pass || (i0 >= IARG1(ip))
+		case GEQR:
+		    pass = pass || (r0 >= RARG1(ip))
+		case GEQD:
+		    pass = pass || (d0 >= DARG1(ip))
+		case RNGI:
+		    pass = pass || (i0 >= IARG1(ip) && i0 <= IARG2(ip))
+		case RNGR:
+		    pass = pass || (r0 >= RARG1(ip) && r0 <= RARG2(ip))
+		case RNGD:
+		    pass = pass || (d0 >= DARG1(ip) && d0 <= DARG2(ip))
+
+		case BTTXS:				# load, test, and
+		    i0 = Mems[ev_s+IARG1(ip)]		# exit if false
+		    pass = (and (i0, IARG2(ip)) != 0)
+		    if (!pass)
+			goto ret_
+		case BTTXI:
+		    pass = (and (Memi[ev_i+IARG1(ip)], IARG2(ip)) != 0)
+		    if (!pass)
+			goto ret_
+
+		case NEQXS:
+		    pass = (Mems[ev_s+IARG1(ip)] != IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case NEQXI:
+		    pass = (Memi[ev_i+IARG1(ip)] != IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case NEQXR:
+		    pass = (abs(Memr[ev_r+IARG1(ip)] - RARG2(ip)) > RTOL)
+		    if (!pass)
+			goto ret_
+		case NEQXD:
+		    pass = (abs(Memd[ev_d+IARG1(ip)] - DARG2(ip)) > DTOL)
+		    if (!pass)
+			goto ret_
+
+		case EQLXS:
+		    pass = (Mems[ev_s+IARG1(ip)] == IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case EQLXI:
+		    pass = (Memi[ev_i+IARG1(ip)] == IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case EQLXR:
+		    pass = (abs(Memr[ev_r+IARG1(ip)] - RARG2(ip)) <= RTOL)
+		    if (!pass)
+			goto ret_
+		case EQLXD:
+		    pass = (abs(Memd[ev_d+IARG1(ip)] - DARG2(ip)) <= DTOL)
+		    if (!pass)
+			goto ret_
+
+		case LEQXS:
+		    pass = (Mems[ev_s+IARG1(ip)] <= IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case LEQXI:
+		    pass = (Memi[ev_i+IARG1(ip)] <= IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case LEQXR:
+		    pass = (Memr[ev_r+IARG1(ip)] <= RARG2(ip))
+		    if (!pass)
+			goto ret_
+		case LEQXD:
+		    pass = (Memd[ev_d+IARG1(ip)] <= DARG2(ip))
+		    if (!pass)
+			goto ret_
+
+		case GEQXS:
+		    pass = (Mems[ev_s+IARG1(ip)] >= IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case GEQXI:
+		    pass = (Memi[ev_i+IARG1(ip)] >= IARG2(ip))
+		    if (!pass)
+			goto ret_
+		case GEQXR:
+		    pass = (Memr[ev_r+IARG1(ip)] >= RARG2(ip))
+		    if (!pass)
+			goto ret_
+		case GEQXD:
+		    pass = (Memd[ev_d+IARG1(ip)] >= DARG2(ip))
+		    if (!pass)
+			goto ret_
+
+		case RNGXS:
+		    i0 = Mems[ev_s+IARG1(ip)]
+		    pass = (i0 >= IARG2(ip) && i0 <= IARG3(ip))
+		    if (!pass)
+			goto ret_
+		case RNGXI:
+		    i0 = Memi[ev_i+IARG1(ip)]
+		    pass = (i0 >= IARG2(ip) && i0 <= IARG3(ip))
+		    if (!pass)
+			goto ret_
+		case RNGXR:
+		    r0 = Memr[ev_r+IARG1(ip)]
+		    pass = (r0 >= RARG2(ip) && r0 <= RARG3(ip))
+		    if (!pass)
+			goto ret_
+		case RNGXD:
+		    d0 = Memd[ev_d+IARG1(ip)]
+		    pass = (d0 >= DARG2(ip) && d0 <= DARG3(ip))
+		    if (!pass)
+			goto ret_
+
+		case LUTXS:				# lookup tables
+		    i0 = Mems[ev_s+IARG1(ip)]
+		    lt = IARG2(ip)
+		    rbin = (i0 - int(LT_I0(lt))) * LT_IS(lt)
+		    goto lut_
+		case LUTXI:
+		    i0 = Memi[ev_i+IARG1(ip)]
+		    lt = IARG2(ip)
+		    rbin = (i0 - int(LT_I0(lt))) * LT_IS(lt)
+		    goto lut_
+		case LUTXR:
+		    r0 = Memr[ev_r+IARG1(ip)]
+		    lt = IARG2(ip)
+		    rbin = (r0 - LT_R0(lt)) * LT_RS(lt)
+		    goto lut_
+		case LUTXD:
+		    d0 = Memd[ev_d+IARG1(ip)]
+		    lt = IARG2(ip)
+		    rbin = (d0 - LT_D0(lt)) * LT_DS(lt)
+lut_
+		    # Common code for any lookup table.
+		    if (rbin <= 0)
+			v = LT_LEFT(lt)
+		    else {
+			bin = int(rbin) + 1
+			if (bin > LT_NBINS(lt))
+			    v = LT_RIGHT(lt)
+			else
+			    v = LT_LUT(lt,bin)
+		    }
+
+		    # Table value may be 0, 1, or indeterminate, i.e., the
+		    # offset of a subprogram to be called to evaluate the
+		    # subrangelist for that bin.
+
+		    if (v == 0) {
+			# Table value is zero, !pass, all done.
+			pass = false
+			goto ret_
+
+		    } else if (v > 1) {
+			# Table value is indeterminate and depends on the
+			# data value.  Call subroutine to evaluate subrange.
+			# At level=0 where we are starting to evaluate an
+			# independent expression term we must initialize pass
+			# to false before entering the subprogram instruction
+			# sequence.
+
+			if (level == 0)
+			    pass = false
+
+			level = level + 1
+			pv_save[level] = pass
+
+			if (IARG3(ip) != NULL)
+			    ip_save[level] = IARG3(ip)
+			else
+			    ip_save[level] = ip + LEN_INSTRUCTION
+
+			pass = false
+			ip = EX_PB(ex) + v
+			next
+
+		    } else if (v == 1) {
+			# Table value is one, value passes this test.
+			pass = true
+		    }
+
+		    # Go to the jump address if set.  The jump is needed
+		    # to skip over any subprograms that may have been compiled
+		    # after the LUTX.
+
+		    if (IARG3(ip) != NULL) {
+			ip = IARG3(ip)
+			next
+		    }
+		}
+
+		# Advance to the next instruction.
+		ip = ip + LEN_INSTRUCTION
+	    }
+
+	    # Output event pointer if event passed the filter.
+	    if (pass) {
+		npass = npass + 1
+		o_ev[npass] = ev
+	    }
+	}
+
+	return (npass)
+end
diff --git a/sys/qpoe/qpexgetat.x b/sys/qpoe/qpexgetat.x
new file mode 100644
index 00000000..9f7b3af2
--- /dev/null
+++ b/sys/qpoe/qpexgetat.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpex.h"
+
+# QPEX_GETATTRIBUTE -- Get the filter expression for the named attribute
+# as a text string.  The length of the string is returned as the function
+# value.  If the referenced QPEX descriptor does not contain any filter
+# terms for the named attribute, zero will be returned.  If the expression
+# contains multiple eterms the successive terms will be delimited by
+# semicolons, e.g., "(a:b,c:d); (e:f,g)".  The lists of ranges within an
+# eterm are OR-ed to produce a filter term; successive eterms are AND-ed
+# to produce the final filter (hence the example above is equivalent to
+# "(a to b OR c to d) AND (e to f OR g)").
+
+int procedure qpex_getattribute (ex, attribute, outstr, maxch)
+
+pointer	ex			#I QPEX descriptor
+char	attribute[ARB]		#I attribute name
+char	outstr[maxch]		#O receives the filter string
+int	maxch			#I max chars out
+
+pointer	sp, atname, et
+int	nchars, op, otop
+int	gstrcpy(), qp_expandtext()
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (atname, SZ_FNAME, TY_CHAR)
+
+	# Translate attribute name, in case it is aliased.
+	nchars = qp_expandtext (EX_QP(ex), attribute, Memc[atname], SZ_FNAME)
+
+	# Construct filter expression for named attribute.
+	op = 1
+	otop = maxch + 1
+	for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et)) {
+	    if (ET_DELETED(et) == YES)
+		next
+
+	    # Skip entry if not for the named attribute.
+	    if (strne (Memc[ET_ATNAME(et)], Memc[atname]))
+		next
+
+	    # Add term delimiter if not first term.
+	    if (op > 1) {
+		outstr[op] = ';';  op = min(otop, op + 1)
+		outstr[op] = ' ';  op = min(otop, op + 1)
+	    }
+
+	    # The expression text (may be very large).
+	    op = min (otop,
+		op + gstrcpy (Memc[ET_EXPRTEXT(et)], outstr[op], otop-op))
+	}
+	outstr[op] = EOS
+
+	# Return the string length, or zero if no filter for named attribute.
+	call sfree (sp)
+	return (op - 1)
+end
diff --git a/sys/qpoe/qpexgetfil.x b/sys/qpoe/qpexgetfil.x
new file mode 100644
index 00000000..3f1d2816
--- /dev/null
+++ b/sys/qpoe/qpexgetfil.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpex.h"
+
+# QPEX_GETFILTER -- Return the currently active filter as a text string,
+# i.e., as a series of "attribute = expr" terms.  The number of chars
+# output is returned as the function value.
+
+int procedure qpex_getfilter (ex, outstr, maxch)
+
+pointer	ex			#I QPEX descriptor
+char	outstr[maxch]		#O receives the filter string
+int	maxch			#I max chars out
+
+pointer	et
+int	op, otop
+int	gstrcpy()
+
+begin
+	op = 1
+	otop = maxch + 1
+	for (et=EX_ETHEAD(ex);  et != NULL;  et=ET_NEXT(et)) {
+	    if (ET_DELETED(et) == YES)
+		next
+
+	    # Add term delimiter if not first term.
+	    if (op > 1) {
+		outstr[op] = ',';  op = min(otop, op + 1)
+		outstr[op] = ' ';  op = min(otop, op + 1)
+	    }
+
+	    # Attribute name.
+	    op = min (otop,
+		op + gstrcpy (Memc[ET_ATNAME(et)], outstr[op], otop-op))
+	    outstr[op] = ' ';  op = min(otop, op + 1)
+
+	    # Assignment operator ("=" or "+=").
+	    op = min (otop,
+		op + gstrcpy (Memc[ET_ASSIGNOP(et)], outstr[op], otop-op))
+	    outstr[op] = ' ';  op = min(otop, op + 1)
+
+	    # The expression text (may be very large).
+	    op = min (otop,
+		op + gstrcpy (Memc[ET_EXPRTEXT(et)], outstr[op], otop-op))
+	}
+	outstr[op] = EOS
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/qpexmodfil.x b/sys/qpoe/qpexmodfil.x
new file mode 100644
index 00000000..7df4b926
--- /dev/null
+++ b/sys/qpoe/qpexmodfil.x
@@ -0,0 +1,247 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "qpoe.h"
+include "qpex.h"
+
+# QPEX_MODFILTER -- Compile an event attribute expression to be used for event
+# attribute filtering, modifying the the current EAF as directed by the expr.
+# An event attribute expression consists of a sequence of independent terms
+# of the form "attribute = expr", e.g.,
+#
+#       pha=%104B, e=100:, t=(:9,11:29,33,42:65,67:99,!(82,87),103), ...
+#
+# 
+# Variants on "attr = expr" are "attr := expr" and "attr += expr".  In the
+# case of :=, any expression terms already entered for the named attribute
+# will be REPLACED by the new expression.  In the case of +=, the given
+# expression denotes an additional condition which the attribute must satisfy
+# to pass the filter, i.e., a new term is added to the existing filter.  The
+# case = is the same as +=, i.e., the default action is to modify rather than
+# replace any existing filter.
+# 
+#
+# Our function is to extract each attribute=expr term and compile it into a
+# series of instructions to be repeatedly executed (interpreted) at runtime
+# to evaluate the expression for a particular event structure.  Terms are
+# compiled and evaluated in the order in which they appear in the expression
+# list (except for replacement terms), allowing the user to manually optimize
+# the filter by giving terms which are most likely to fail first.
+#
+# The expression list may contain references to predefined global or local
+# (datafile) macros, external macro files, or back-quoted CL commands for
+# which the output is to be substituted as for a macro.  In all cases, macro
+# substitution is handled at a lower level in the gettok routine.  In
+# particular, the logical names of the fields of the event structure are
+# implemented as predefined datafile-local macros, hence we are concerned only
+# with physical field names here.  The form of a physical field name is
+# a datatype code [SIRD] followed by the decimal zero-indexed byte offset
+# of the field in the event structure, e.g., S0, S2, R4, etc. (short integer
+# field at offset 0, same at offset 2, Real*4 field at offset 4, etc.).
+#
+# The function value is OK if the expression list compiles without any errors,
+# or ERR if some compilation error occurs.  Compilation errors cause an error
+# message to be output to STDERR and the affected terms to be skipped, but are
+# otherwise ignored.
+
+int procedure qpex_modfilter (ex, exprlist)
+
+pointer ex                      #I qpex descriptor
+char    exprlist[ARB]           #I list of attribute=expr expressions
+
+bool	replace
+int	boffset, offset, max_offset, dtype
+int	status, sz_expr, token, parenlevel, nchars, buflen
+pointer	sp, atname, assignop, tokbuf, expr, qp, ip, op, in, et_tail
+
+pointer	qp_opentext()
+int	qpex_codegeni(), qpex_codegenr(), qpex_codegend()
+int	qp_gettok(), strlen(), gstrcpy(), ctoi(), sizeof()
+errchk	malloc, qp_opentext, qp_gettok, realloc, qpex_delete
+
+string	qpexwarn "QPEX Warning"
+define	eatup_ 91
+define	badatt_ 92
+
+begin
+	call smark (sp)
+	call salloc (atname, SZ_TOKBUF, TY_CHAR)
+	call salloc (assignop, SZ_TOKBUF, TY_CHAR)
+	call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
+
+	status = OK
+	sz_expr = DEF_SZEXPRBUF
+	et_tail = EX_ETTAIL(ex)
+	qp = EX_QP(ex)
+
+	# Allocate a variable size expression buffer.
+	call malloc (expr, sz_expr, TY_CHAR)
+
+	# Open the expression list for token input with macro expansion.
+	in = qp_opentext (qp, exprlist)
+
+	# Accumulate and compile successive attribute=expr terms of the
+	# expression list.
+
+	repeat {
+	    # Get attribute name.
+	    switch (qp_gettok (in, Memc[atname], SZ_TOKBUF)) {
+	    case EOF:
+		break			# input exhausted
+	    case ',', ';':
+		next			# null statement
+	    case TOK_IDENTIFIER:
+		;			# got one
+	    default:
+		call eprintf ("%s: unexpected token `%s'\n")
+		    call pargstr (qpexwarn)
+		    call pargstr (Memc[atname])
+		goto eatup_
+	    }
+
+	    # Get operator.
+	    switch (qp_gettok (in, Memc[assignop], SZ_TOKBUF)) {
+	    case TOK_PLUSEQUALS, '=':
+		replace = false
+	    case TOK_COLONEQUALS:
+		replace = true
+
+	    default:
+		call eprintf ("%s: missing assignment token (`%s')\n")
+		    call pargstr (qpexwarn)
+		    call pargstr (Memc[atname])
+eatup_
+		# A half-hearted attempt to ignore the offending statement...
+		while (qp_gettok (in, Memc[expr], sz_expr) != EOF)
+		    if (Memc[expr] == ',')
+			break
+
+		# The default is to add to any existing filter.
+		replace = false
+	    }
+
+	    parenlevel = 0
+	    token = NULL
+
+	    # Accumulate expression.
+	    for (op=expr;  token != EOF;  ) {
+		# Get next token from input stream.
+		token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+
+		# Process any special tokens.
+		switch (token) {
+		case EOF:
+		    break
+		case '(':
+		    parenlevel = parenlevel + 1
+		case ')':
+		    parenlevel = parenlevel - 1
+		    if (parenlevel < 0) {
+			call eprintf ("%s: missing left parenthesis\n")
+			    call pargstr (qpexwarn)
+			parenlevel = 0
+			status = ERR
+			next
+		    }
+		case ',', ';':
+		    # An unparenthesized comma terminates the expression.
+		    if (parenlevel <= 0)
+			break
+		}
+
+		# Allocate more storage if expr buf fills.
+		nchars = strlen (Memc[tokbuf])
+		buflen = op - expr
+		if (buflen + nchars > sz_expr) {
+		    sz_expr = sz_expr + INC_SZEXPRBUF
+		    call realloc (expr, sz_expr, TY_CHAR)
+		    op = expr + buflen
+		}
+
+		# Concatenate token string to expr.
+		op = op + gstrcpy (Memc[tokbuf], Memc[op], SZ_TOKBUF)
+	    }
+
+	    Memc[op] = EOS
+	    if (parenlevel > 0) {
+		call eprintf ("%s: missing right parenthesis in expression\n")
+		    call pargstr (qpexwarn)
+		status = ERR
+	    }
+
+	    # Parse the attribute name to determine the datatype and offset.
+
+	    # Get byte offset of field.
+	    ip = atname + 1
+	    if (ctoi (Memc, ip, boffset) <= 0)
+		goto badatt_
+
+	    # Get datatype and scaled offset; check field alignment.
+	    switch (Memc[atname]) {
+	    case 'S', 's':
+		dtype = TY_SHORT
+		offset = boffset / (SZ_SHORT * SZB_CHAR)
+		if (offset * SZ_SHORT * SZB_CHAR != boffset)
+		    goto badatt_
+	    case 'I', 'i':
+		dtype = TY_INT
+		offset = boffset / (SZ_INT * SZB_CHAR)
+		if (offset * SZ_INT * SZB_CHAR != boffset)
+		    goto badatt_
+	    case 'R', 'r':
+		dtype = TY_REAL
+		offset = boffset / (SZ_REAL * SZB_CHAR)
+		if (offset * SZ_REAL * SZB_CHAR != boffset)
+		    goto badatt_
+	    case 'D', 'd':
+		dtype = TY_DOUBLE
+		offset = boffset / (SZ_DOUBLE * SZB_CHAR)
+		if (offset * SZ_DOUBLE * SZB_CHAR != boffset)
+		    goto badatt_
+	    default:
+		goto badatt_
+	    }
+	    
+	    # Verify that the field is in range in the event struct.
+	    # (Actually, we don't know the event struct at compile time...)
+
+	    max_offset = (boffset / SZB_CHAR) + sizeof(dtype) - 1
+	    if (boffset < 0 || max_offset > ARB) {
+badatt_		call eprintf ("%s: bad attribute name `%s'\n")
+		    call pargstr (qpexwarn)
+		    call pargstr (Memc[atname])
+		status = ERR
+		next
+	    }
+
+	    # Clobber any old expression for the given attribute if replace
+	    # mode is in effect.  Only previous expression terms are affected,
+	    # hence in single expressions like "pha=x,pha=y", the second entry
+	    # does not clobber the first.
+
+	    if (replace)
+		call qpex_delete (ex, et_tail, offset, dtype)
+
+	    # Compile the expression.
+	    switch (dtype) {
+	    case TY_SHORT, TY_INT:
+		if (qpex_codegeni (ex, Memc[atname], Memc[assignop],
+		    Memc[expr], offset, dtype) == ERR)
+		    status = ERR
+	    case TY_REAL:
+		if (qpex_codegenr (ex, Memc[atname], Memc[assignop],
+		    Memc[expr], offset, dtype) == ERR)
+		    status = ERR
+	    case TY_DOUBLE:
+		if (qpex_codegend (ex, Memc[atname], Memc[assignop],
+		    Memc[expr], offset, dtype) == ERR)
+		    status = ERR
+	    }
+	}
+
+	call qp_closetext (in)
+	call mfree (expr, TY_CHAR)
+	call sfree (sp)
+
+	return (status)
+end
diff --git a/sys/qpoe/qpexopen.x b/sys/qpoe/qpexopen.x
new file mode 100644
index 00000000..833a1461
--- /dev/null
+++ b/sys/qpoe/qpexopen.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	"qpoe.h"
+include	"qpex.h"
+
+# QPEX_OPEN -- Open the expression evaluator.  If an expression is given it
+# is compiled into the descriptor, otherwise a null (pass all) expression
+# is compiled.  The compiled expression may be modified or read out at any
+# time via calls to other routines in the QPEX package (e.g., qpex_modfilter,
+# qpex_getfilter).
+
+pointer procedure qpex_open (qp, expr)
+
+pointer	qp			#I QPOE descriptor
+char	expr[ARB]		#I selection expression (filter) 
+
+pointer	ex, pb, db
+int	pb_len, db_len
+int	qpex_modfilter()
+errchk	calloc
+
+begin
+	# Allocate the main QPEX descriptor.
+	call calloc (ex, LEN_EXDES, TY_STRUCT)
+
+	# Allocate the program buffer.
+	pb_len = QP_EXPBLEN(qp)
+	call calloc (pb, pb_len, TY_INT)
+
+	# Allocate the data buffer.
+	db_len = QP_EXDBLEN(qp)
+	call calloc (db, db_len, TY_CHAR)
+
+	# Initialize the descriptor.
+
+	EX_QP(ex)	= qp
+	EX_DEBUG(ex)	= QP_DEBUG(qp)
+	EX_START(ex)	= pb
+
+	EX_PB(ex)	= pb
+	EX_PBTOP(ex)	= pb + pb_len
+	EX_PBOP(ex)	= pb
+
+	EX_DB(ex)	= db
+	EX_DBTOP(ex)	= db + db_len
+	EX_DBOP(ex)	= db
+
+	EX_MAXFRLUTLEN(ex)  = QP_EXMAXFRLLEN(qp)
+	EX_MAXRRLUTLEN(ex)  = QP_EXMAXRRLLEN(qp)
+	EX_LUTMINRANGES(ex) = QP_EXLMINRANGES(qp)
+	EX_LUTSCALE(ex)     = QP_EXLSCALE(qp)
+
+	if (EX_DEBUG(ex) > 1) {
+	    call eprintf ("QPEX activated, expr = `%s'\n")
+		call pargstr (expr)
+	}
+
+	# If a selection expression was given, compile it into the descriptor.
+	if (qpex_modfilter (ex, expr) == ERR) {
+	    call qpex_close (ex)
+	    call syserrs (SYS_QPEXSYN, QP_DFNAME(qp))
+	}
+
+	return (ex)
+end
diff --git a/sys/qpoe/qpexpand.x b/sys/qpoe/qpexpand.x
new file mode 100644
index 00000000..9be19a36
--- /dev/null
+++ b/sys/qpoe/qpexpand.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_EXPANDTEXT -- Copy a statement to the output, breaking it up into tokens
+# and expanding any macro references in the process.  This is used to resolve
+# macro references which might otherwise be repeatedly expanded, or which it
+# might not be possible to expand if this is left to some future time when
+# the referenced macros are no longer defined.
+
+int procedure qp_expandtext (qp, s1, s2, maxch)
+
+pointer	qp			#I QPOE descriptor
+char	s1[ARB]			#I input string containing macros
+char	s2[maxch]		#O output string buffer
+int	maxch			#I max chars out
+
+pointer	sp, tokbuf, in
+int	token, op, otop
+int	gstrcpy(), qp_gettok()
+pointer	qp_opentext()
+
+begin
+	call smark (sp)
+	call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
+
+	# Open input text for macro expanded token input.
+	in = qp_opentext (qp, s1)
+	otop = maxch + 1
+	op = 1
+
+	# Copy tokens to the output, inserting a space after every token.
+	repeat {
+	    token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+	    if (token != EOF) {
+		if (token == TOK_STRING) {
+		    s2[op] = '"'  
+		    op = min (otop, op + 1)
+		}
+		op = op + gstrcpy (Memc[tokbuf], s2[op], otop-op)
+		if (token == TOK_STRING) {
+		    s2[op] = '"'  
+		    op = min (otop, op + 1)
+		}
+		s2[op] = ' ';  op = min (otop, op + 1)
+		if (op >= otop)
+		    break
+	    }
+	} until (token == EOF)
+
+	# Cancel the trailing blank and add the EOS.
+	if (op > 1 && op < otop)
+	    op = op - 1
+	s2[op] = EOS
+
+	call qp_closetext (in)
+	call sfree (sp)
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/qpexparse.gx b/sys/qpoe/qpexparse.gx
new file mode 100644
index 00000000..c6f40042
--- /dev/null
+++ b/sys/qpoe/qpexparse.gx
@@ -0,0 +1,410 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include <mach.h>
+include "../qpex.h"
+
+.help qpexparse
+.nf --------------------------------------------------------------------------
+QPEXPARSE -- Code to parse an event attribute expression, producing a binary
+range list as output.
+
+	nranges = qpex_parse[ird] (expr, xs, xe, xlen)
+
+The calling sequence for the parse routine is shown above.  The arguments XS
+and XE are pointers to dynamically allocated arrays of length XLEN and type
+[IRD].	These arrays should be allocated in the calling program before calling
+the parser, and deallocated when no longer needed.  Reallocation to increase
+the array length is automatic if the arrays fill during parsing.  DTYPE should
+be the same datatype as the attribute with which the list is associated.
+
+The form of an event attribute expression may be a list of values,
+
+	attribute = n
+or
+	attribute = m, n, ...
+
+a list of inclusive or exclusive ranges,
+
+	attribute = m:n, !p:q
+
+including open ranges,
+
+	attribute = :n, p:q
+
+or any combination of the above (excluding combinations of bitmasks and values
+or ranges, which are mutually exclusive):
+
+	attribute = :n, a, b, p:q, !(m, e:f)
+
+Parenthesis may be used for grouping where desired, e.g.,
+
+	attribute = (:n, a, b, p:q, !(m, e:f))
+
+An additional form of the event attribute expression allows use of a bitmask
+to specify the acceptable values, e.g.,
+
+	attribute = %17B
+or
+	attribute = !%17B
+
+however, bitmasks are incompatible with range lists, and should be recognized
+and dealt with elsewhere (bitmasks may not be combined with range lists in
+the same expression term).
+
+We are concerned here only with the attribute value list itself, i.e.,
+everything to the right of the equals sign in the examples above.  This list
+should be extracted and placed into a string containing a single line of
+text before we are called.  Attribute value lists may be any length, but
+backslash continuation, file inclusion (or whatever means is used to form
+the attribute value list) is assumed to be handled at a higher level.
+
+The output of this package is an ordered boolean valued binary range list
+with type integer, real, or double breakpoints (i.e., the breakpoints are the
+same datatype as the attribute itself, but the range values are zero or one).
+The range list defines the initial value, final value, and any interior
+breakpoints where the attribute value changes state.  Expression optimization
+is used to minimize the number of breakpoints (i.e., eliminate redundant
+breakpoints, such as a range within a range).
+
+Output range list format:
+
+	xs[1] xe[1]
+	xs[2] xe[2]
+	    ...
+	xs[N] xe[N]
+
+Where each range is inclusive and only "true" ranges are shown.  If XS[1] is
+LEFT a open-left range (:n) is indicated; if XE[N] is RIGHT an open-right
+range (n:) is indicated.  In an integer range list, isolated points appear
+as a single range with (xe[i]=xs[i]).  In a real or double range list,
+isolated points are represented as finite ranges with a width on the order of
+the machine epsilon.
+.endhelp ---------------------------------------------------------------------
+
+define	DEF_XLEN	256		# default output range list length
+define	INC_XLEN	256		# increment to above
+define	DEF_VLEN	512		# default breakpoint list length
+define	INC_VLEN	512		# increment to above
+define	MAX_NEST	20		# parser stack depth
+
+define	STEP		1		# step at boundary of closed range
+define	ZERO		1000		# step at boundary of open range
+
+define	XV	Mem$t[xv+($1)-1]	# reference x position values
+define	UV	Memi[uv+($1)-1]		# unique flags for x value pairs
+define	SV	Memi[sv+($1)-1] 	# reference breakpoint step values
+
+
+# QPEX_PARSE -- Convert the given attribute value list into a binary
+# range list, returning the number of ranges as the function value.
+
+int procedure qpex_parse$t (expr, xs, xe, xlen)
+
+char	expr[ARB]		#I attribute value list to be parsed
+pointer xs			#U pointer to array of start-range values
+pointer xe			#U pointer to array of	 end-range values
+int	xlen			#U allocated length of XS, XE arrays
+
+bool	range
+pointer xv, uv, sv
+PIXEL	xstart, xend, xmin, temp, x, n_xs, n_xe
+int	vlen, nrg, ip, op, ch, ip_start, i, j, jval, r1, r2, y, v, ov, dy
+int	token[MAX_NEST], tokval[MAX_NEST], lev, itemp, umin
+errchk	syserr, malloc, realloc
+define	pop_ 91
+
+$if (datatype == si)
+int	qp_ctoi()
+define	fp_equal$t($1==$2)
+$else
+double	dtemp
+bool	bval, fp_equal$t()
+int	qp_ctod()
+$endif
+
+begin
+	vlen = DEF_VLEN
+	call malloc (xv, vlen, TY_PIXEL)
+	call malloc (uv, vlen, TY_INT)
+	call malloc (sv, vlen, TY_INT)
+
+	lev = 0
+	nrg = 0
+
+	# Parse the expression string and compile the raw, unoptimized
+	# breakpoint list in the order in which the breakpoints occur in
+	# the string.
+
+	for (ip=1;  expr[ip] != EOS;  ) {
+	    # Skip whitespace.
+	    for (ch=expr[ip];  IS_WHITE(ch) || ch == '\n';  ch=expr[ip])
+		ip = ip + 1
+
+	    # Extract and process token.
+	    switch (ch) {
+	    case EOS:
+		# At end of string.
+		if (lev > 0)
+		    goto pop_
+		else
+		    break
+
+	    case ',':
+		# Comma list token delmiter.
+		ip = ip + 1
+		goto pop_
+
+	    case '!', '(':
+		# Syntactical element - push on stack.
+		ip = ip + 1
+		lev = lev + 1
+		if (lev > MAX_NEST)
+		    call syserr (SYS_QPEXLEVEL)
+		token[lev] = ch
+		tokval[lev] = nrg + 1
+
+	    case ')':
+		# Close parenthesized group and pop parser stack.
+		ip = ip + 1
+		if (lev < 1)
+		    call syserr (SYS_QPEXMLP)
+		else if (token[lev] != '(')
+		    call syserr (SYS_QPEXRPAREN)
+		lev = lev - 1
+		goto pop_
+
+	    default:
+		# Process a range term.
+		ip_start = ip
+
+		# Scan the M in M:N.
+		$if (datatype == si)
+		    if (qp_ctoi (expr, ip, xstart) <= 0)
+			xstart = LEFT$T
+		$else
+		    if (qp_ctod (expr, ip, dtemp) <= 0)
+			xstart = LEFT$T
+		    else
+			xstart = dtemp
+		$endif
+
+		# Scan the : in M:N.  The notation M-N is also accepted,
+		# provided the token - immediately follows the token M.
+
+		while (IS_WHITE(expr[ip]))
+		    ip = ip + 1
+		range = (expr[ip] == ':')
+		if (range)
+		    ip = ip + 1
+		else if (!IS_LEFT$T (xstart)) {
+		    range = (expr[ip] == '-')
+		    if (range)
+			ip = ip + 1
+		}
+
+		# Scan the N in M:N.
+		if (range) {
+		    $if (datatype == si)
+			if (qp_ctoi (expr, ip, xend) <= 0)
+			    xend = RIGHT$T
+		    $else
+			if (qp_ctod (expr, ip, dtemp) <= 0)
+			    xend = RIGHT$T
+			else
+			    xend = dtemp
+		    $endif
+		} else
+		    xend = xstart
+
+		# Fix things if the user entered M:M explicitly.
+		if (range)
+		    if (fp_equal$t (xstart, xend))
+			range = false
+
+		# Expand a single point into a range.  For an integer list
+		# this produces M:M+1; for a floating list M-eps:M+eps.
+		# Verify ordering and that something recognizable was scanned.
+
+		if (!range) {
+		    if (IS_LEFT$T(xstart))
+			call syserr (SYS_QPEXBADRNG)
+		    $if (datatype == si)
+			xend   = xstart + 1
+		    $endif
+		} else {
+		    if (xstart > xend) {
+			temp = xstart;  xstart = xend;  xend = temp
+		    }
+		    $if (datatype == si)
+			if (!IS_RIGHT$T(xend))
+			    xend = xend + 1
+		    $endif
+		}
+
+		# Make more space if vectors fill up.
+		if (nrg+4 > vlen) {
+		    vlen = vlen + INC_VLEN
+		    call realloc (xv, vlen, TY_PIXEL)
+		    call realloc (uv, vlen, TY_INT)
+		    call realloc (sv, vlen, TY_INT)
+		}
+
+		# Save range on intermediate breakpoint list.
+		nrg = nrg + 1
+		XV(nrg) = xstart
+		UV(nrg) = 0
+		SV(nrg) = STEP
+
+		nrg = nrg + 1
+		XV(nrg) = xend
+		UV(nrg) = 1
+		SV(nrg) = -STEP
+pop_
+		# Pop parser stack.
+		if (lev > 0)
+		    if (token[lev] == '!') {
+			# Invert a series of breakpoints.
+			do i = tokval[lev], nrg {
+			    if (SV(i) == STEP)		# invert
+				SV(i) = -ZERO
+			    else if (SV(i) == -STEP)
+				SV(i) = ZERO
+			    else if (SV(i) == ZERO)	# undo
+				SV(i) = -STEP
+			    else if (SV(i) == -ZERO)
+				SV(i) = STEP
+			}
+			lev = lev - 1
+		    }
+	    }
+	}
+
+	# If the first range entered by the user is an exclude range,
+	# e.g., "(!N)" or "(!(expr))" this implies that all other values
+	# are acceptable.  Add the open range ":" to the end of the range
+	# list to indicate this, i.e., convert "!N" to ":,!N".
+
+	if (SV(1) == -ZERO) {
+	    nrg = nrg + 1
+	    XV(nrg) = LEFT$T
+	    UV(nrg) = 0
+	    SV(nrg) = STEP
+
+	    nrg = nrg + 1
+	    XV(nrg) = RIGHT$T
+	    UV(nrg) = 1
+	    SV(nrg) = -STEP
+	}
+
+	# Sort the breakpoint list.
+	do j = 1, nrg {
+	    xmin = XV(j);  umin = UV(j)
+	    jval = j
+	    do i = j+1, nrg {
+		$if (datatype == rd)
+		bval = (XV(i) < xmin)
+		if (!bval)
+		    if (abs (XV(i) - xmin) < 1.0E-5)
+			bval = (fp_equal$t(XV(i),xmin) && UV(i) < umin)
+		if (bval) {
+		$else
+		if (XV(i) < xmin || (XV(i) == xmin && UV(i) < umin)) {
+		$endif
+		    xmin = XV(i);  umin = UV(i)
+		    jval = i
+		}
+	    }
+	    if (jval != j) {
+		temp  = XV(j);  XV(j) = XV(jval);  XV(jval) = temp
+		itemp = UV(j);  UV(j) = UV(jval);  UV(jval) = itemp
+		itemp = SV(j);  SV(j) = SV(jval);  SV(jval) = itemp
+	    }
+	}
+
+	# Initialize the output arrays if they were passed in as null.
+	if (xlen <= 0) {
+	    xlen = DEF_XLEN
+	    call malloc (xs, xlen, TY_PIXEL)
+	    call malloc (xe, xlen, TY_PIXEL)
+	}
+
+	# Collapse sequences of redundant breakpoints into a single
+	# breakpoint, clipping the running sum value to the range 0-1.	
+	# Accumulate and output successive nonzero ranges.
+
+	op = 1
+	ov = 0
+	y  = 0
+
+	for (r1=1;  r1 <= nrg;	r1=r2+1) {
+	    # Get a range of breakpoint entries for a single XV position.
+	    for (r2=r1;  r2 <= nrg;  r2=r2+1) {
+		$if (datatype == si)
+		    if (XV(r2) != XV(r1))
+			break
+		$else
+		    bval = (UV(r2) != UV(r1))
+		    if (!bval) {
+			bval = (abs (XV(r2) - XV(r1)) > 1.0E-5)
+			if (!bval)
+			    bval = !fp_equal$t(XV(r2),XV(r1))
+		    }
+		    if (bval)
+			break
+		$endif
+	    }
+	    r2 = r2 - 1
+
+	    # Collapse into a single breakpoint.
+	    x  = XV(r1)
+	    dy = SV(r1)
+	    do i = r1 + 1, r2
+		dy = dy + SV(i)
+	    y = y + dy
+
+	    # Clip value to the range 0-1.
+	    v = max(0, min(1, y))
+
+	    # Accumulate a range of nonzero value.  This eliminates redundant
+	    # points lying within a range which is already set high.
+
+	    if (v == 1 && ov == 0) {
+		n_xs = x
+		ov = 1
+	    } else if (v == 0 && ov == 1) {
+		$if (datatype == si)
+		    if (IS_RIGHT$T(x))
+			n_xe = x
+		    else
+			n_xe = x - 1
+		$else
+		    n_xe = x
+		$endif
+		ov = 2
+	    }
+
+	    # Output a range.
+	    if (ov == 2) {
+		if (op > xlen) {
+		    xlen = xlen + INC_XLEN
+		    call realloc (xs, xlen, TY_PIXEL)
+		    call realloc (xe, xlen, TY_PIXEL)
+		}
+
+		Mem$t[xs+op-1] = n_xs
+		Mem$t[xe+op-1] = n_xe
+		op = op + 1
+
+		ov = 0
+	    }
+	}
+
+	# All done; discard breakpoint buffers.
+	call mfree (xv, TY_PIXEL)
+	call mfree (uv, TY_INT)
+	call mfree (sv, TY_INT)
+
+	return (op - 1)
+end
diff --git a/sys/qpoe/qpexsub.gx b/sys/qpoe/qpexsub.gx
new file mode 100644
index 00000000..1fc51821
--- /dev/null
+++ b/sys/qpoe/qpexsub.gx
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"../qpex.h"
+
+# QPEX_SUBLIST -- Extract a sublist spanning the indicated range from a
+# larger range list.  The number of ranges extracted is returned as the
+# function value.
+
+int procedure qpex_sublist$t (x1, x2, xs,xe,nranges,ip, o_xs,o_xe)
+
+PIXEL	x1, x2				#I range to be extracted
+PIXEL	xs[nranges],xe[nranges]		#I input range list
+int	nranges				#I nranges in input list
+int	ip				#U start position in input list
+PIXEL	o_xs[ARB],o_xe[ARB]		#O output sublist
+
+PIXEL	tol
+int	op, i
+
+begin
+	$if (datatype == i)
+	    tol = 0
+	$else
+	    tol = (EPSILON$T * 10$f)
+	$endif
+
+	# Determine the range containing or immediately following the
+	# start point of the range of interest.
+
+	while (x1 < xs[ip] && ip > 1)
+	    ip = ip - 1
+	while (x1 >= xs[ip])
+	    if (x1 <= xe[ip] || ip >= nranges)
+		break
+	    else
+		ip = ip + 1
+
+	# Check for an empty output range list.
+	if (xs[ip] > x2)
+	    return (0)
+
+	# At least one input range contributes something to the output region.
+	# Copy a portion of the input range list to the ouput range list.
+
+	op = 1
+	do i = ip, nranges {
+	    if (xs[i] <= x1)
+		o_xs[op] = LEFT$T - tol
+	    else
+		o_xs[op] = xs[i]
+
+	    if ((xe[i] - x2) >= tol) {
+		o_xe[op] = RIGHT$T + tol
+		op = op + 1
+		break
+	    } else
+		o_xe[op] = xe[i]
+
+	    op = op + 1
+	    if (xs[i+1] > x2)
+		break
+	}
+
+	ip = i
+	return (op - 1)
+end
diff --git a/sys/qpoe/qpget.gx b/sys/qpoe/qpget.gx
new file mode 100644
index 00000000..dfdca1b0
--- /dev/null
+++ b/sys/qpoe/qpget.gx
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_GET -- Return the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# returned by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+PIXEL procedure qp_get$t (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	dtype
+PIXEL	value
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	dtype = qp_getparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Set default value of INDEF or NULL.
+	$if (datatype == c)
+	    value = (NULL)
+	$else
+	    value = (INDEF)
+	$endif
+
+	# Get a valid parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    value = (Memc[pp])
+	case TY_SHORT:
+	    if (!IS_INDEFS(Mems[pp]))
+		value = (Mems[pp])
+	case TY_INT:
+	    if (!IS_INDEFI(Memi[pp]))
+		value = (Memi[pp])
+	case TY_LONG:
+	    if (!IS_INDEFL(Meml[pp]))
+		value = (Meml[pp])
+	case TY_REAL:
+	    if (!IS_INDEFR(Memr[pp]))
+		value = (Memr[pp])
+	case TY_DOUBLE:
+	    if (!IS_INDEFD(Memd[pp]))
+		value = (Memd[pp])
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_get: `%s', TYP=(%d->%d) returns %g\n")
+		call pargstr (param)
+		call pargi (dtype)
+		call pargi (TY_PIXEL)
+		call parg$t (value)
+	}
+
+	return (value)
+end
diff --git a/sys/qpoe/qpgetb.x b/sys/qpoe/qpgetb.x
new file mode 100644
index 00000000..cea5c5be
--- /dev/null
+++ b/sys/qpoe/qpgetb.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_GETB -- Return the boolean value of the named header parameter.  Type
+# conversion is not permitted between boolean and the other datatypes.
+
+bool procedure qp_getb (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	if (qp_getparam (qp, param, pp) != TY_BOOL)
+	    call syserrs (SYS_QPBADCONV, param)
+	else if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	return (Memb[pp])
+end
diff --git a/sys/qpoe/qpgettok.x b/sys/qpoe/qpgettok.x
new file mode 100644
index 00000000..feb8d780
--- /dev/null
+++ b/sys/qpoe/qpgettok.x
@@ -0,0 +1,687 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<ctype.h>
+include	<fset.h>
+include	"qpoe.h"
+
+.help gettok
+.nf --------------------------------------------------------------------------
+GETTOK -- Lexical input routines for QPOE.  Used to return tokens from input
+text; this is where all macro expansion and file expansion takes place.
+
+	       gt = qp_opentext (qp, text)
+	      token = qp_gettok (gt, tokbuf, maxch)
+		    qp_ungettok (gt, tokbuf)
+	      token = qp_rawtok (gt, tokbuf, maxch)
+	     token = qp_nexttok (gt)
+		   qp_closetext (gt)
+
+Access to the package is gained by opening a text string with QP_OPENTEXT.
+This returns a descriptor which is passed to QP_GETTOK to read successive
+tokens, which may come from the input text string or from any macros,
+include files, etc., referenced in the text or in any substituted text.
+QP_UNGETTOK pushes a token back into the QP_GETTOK input stream, to be
+returned in the next QP_GETTOK call (following macro expansion).
+
+QP_RAWTOK returns the next physical token from an input stream (without
+macro expansion), and QP_NEXTTOK returns the type of the next *physical*
+token (no macro expansion) without actually fetching it (for look ahead
+decision making).
+
+The tokens that can be returned are as follows:
+
+	TOK_IDENTIFIER		[a-zA-Z][a-zA-Z0-9_]*
+	TOK_NUMBER		[0-9][0-9a-zA-Z.]*(e|E)?(+|-)?[0-9]*
+	TOK_STRING		if "abc" or 'abc', the abc
+	'c'			other characters, e.g., =+-*/,;:()[] etc
+	EOF			at end of input
+
+Macro replacement syntax:
+
+	macro			push macro with null arglist
+	macro(arg,arg,...)	push macro with argument substitution
+	@file			push contents of file
+	@file(arg,arg,...)	push file with argument substitution
+	`cmd`			substitute output of CL command "cmd"
+
+where
+	macro			is an identifier, the name of a global macro
+				or a datafile local macro (parameter)
+
+In all cases, occurences of $N in the replacement text are replaced by the
+macro arguments if any, and macros are recursively expanded.  Whitespace,
+including newline, equates to a single space, as does EOF (hence always
+delimits tokens).  Comments (# to end of line) are ignored.  All identifiers
+in scanned text are checked to see if they are references to predefined global
+or local (datafile) macros.
+
+A global macro is a symbol defined globally for QPOE, in effect for all poefile
+accesses (see qpmacro.x).  A local macro is a macro defined as a string
+parameter of type TY_MACRO in the poefile header (and hence affecting only
+that one datafile).
+.endhelp ---------------------------------------------------------------------
+
+# General definitions.
+define	MAX_LEVELS	20		# max include file nesting
+define	MAX_ARGS	9		# max arguments to a macro
+define	SZ_CMD		80		# `cmd`
+define	SZ_IBUF		8192		# buffer for macro replacement
+define	SZ_OBUF		8192		# buffer for macro replacement
+define	SZ_ARGBUF	256		# argument list to a macro
+
+# The gettok descriptor.
+define	LEN_GTDES	45
+define	GT_QP		Memi[$1]	# backpointer to QPOE descriptor
+define	GT_FD		Memi[$1+1]	# current input stream
+define	GT_NEXTCH	Memi[$1+2]	# lookahead character
+define	GT_FTEMP	Memi[$1+3]	# file on stream is a temp file
+define	GT_LEVEL	Memi[$1+4]	# current nesting level
+define	GT_SVFD		Memi[$1+5+$2-1]	# stacked file descriptors
+define	GT_SVFTEMP	Memi[$1+25+$2-1]# stacked ftemp flags
+
+
+# QP_OPENTEXT -- Open the QP_GETTOK descriptor.  The descriptor is initially
+# opened on the user supplied string buffer (which is opened as a file and
+# which must remain intact while token input is in progress), but include file
+# processing etc. may cause arbitrary nesting of file descriptors.
+
+pointer procedure qp_opentext (qp, text)
+
+pointer	qp			#I QPOE descriptor
+char	text[ARB]		#I input text to be scanned
+
+pointer	gt
+int	sz_pbbuf
+int	stropen(), strlen()
+errchk	stropen, calloc
+
+begin
+	call calloc (gt, LEN_GTDES, TY_STRUCT)
+
+	GT_QP(gt) = qp
+	GT_FD(gt) = stropen (text, strlen(text), READ_ONLY)
+
+	if (qp == NULL)
+	    sz_pbbuf = DEF_MAXPUSHBACK
+	else
+	    sz_pbbuf = QP_SZPBBUF(qp)
+	call fseti (GT_FD(gt), F_PBBSIZE, sz_pbbuf)
+
+	return (gt)
+end
+
+
+# QP_GETTOK -- Return the next token from the input stream.  The token ID
+# (a predefined integer code or the character value) is returned as the
+# function value.  The text of the token is returned as an output argument.
+# Any macro references, file includes, etc., are performed in the process
+# of scanning the input stream, hence only fully resolved tokens are output.
+
+int procedure qp_gettok (gt, tokbuf, maxch)
+
+pointer	gt			#I gettok descriptor
+char	tokbuf[maxch]		#O receives the text of the token
+int	maxch			#I max chars out
+
+pointer	sp, bp, qp, cmd, ibuf, obuf, argbuf, fname, sym, textp
+int	fd, token, level, nargs, nchars, i_fd, o_fd, ftemp
+
+bool	streq()
+pointer	qp_gmsym()
+int	strmac(), open(), stropen()
+int	qp_rawtok(), qp_nexttok(), qp_arglist()
+errchk	qp_rawtok,close,ungetci,ungetline,qp_arglist,clcmdw,stropen,syserr
+define	pushfile_ 91
+
+
+begin
+	call smark (sp)
+
+	# Allocate some buffer space.
+	nchars = SZ_CMD + SZ_IBUF + SZ_OBUF + SZ_ARGBUF + SZ_FNAME + 5
+	call salloc (bp, nchars, TY_CHAR)
+
+	cmd = bp
+	ibuf = cmd + SZ_CMD + 1
+	obuf = ibuf + SZ_IBUF + 1
+	argbuf = obuf + SZ_OBUF + 1
+	fname = argbuf + SZ_ARGBUF + 1
+
+	qp = GT_QP(gt)
+
+	# Read raw tokens and push back macro or include file text until we
+	# get a fully resolved token.
+
+	repeat {
+	    fd = GT_FD(gt)
+
+	    # Get a raw token.
+	    token = qp_rawtok (gt, tokbuf, maxch)
+
+	    # Process special tokens.
+	    switch (token) {
+	    case EOF:
+		# EOF has been reached on the current stream.
+		level = GT_LEVEL(gt)
+		if (GT_FTEMP(gt) == YES) {
+		    call fstats (fd, F_FILENAME, Memc[fname], SZ_FNAME)
+		    if (level > 0)
+			call close (fd)
+		    iferr (call delete (Memc[fname]))
+			call erract (EA_WARN)
+		} else if (level > 0)
+		    call close (fd)
+
+		if (level > 0) {
+		    # Restore previous stream.
+		    GT_FD(gt)     = GT_SVFD(gt,level)
+		    GT_FTEMP(gt)  = GT_SVFTEMP(gt,level)
+		    GT_LEVEL(gt)  = level - 1
+		    GT_NEXTCH(gt) = NULL
+		} else {
+		    # Return EOF token to caller.
+		    call strcpy ("EOF", tokbuf, maxch)
+		    break
+		}
+
+	    case TOK_IDENTIFIER:
+		# Lookup the identifier in the symbol table.
+		sym = NULL
+		if (qp != NULL)
+		    sym = qp_gmsym (qp, tokbuf, textp)
+
+		# Process a defined macro.
+		if (sym != NULL) {
+		    # If macro does not have any arguments, merely push back
+		    # the replacement text.
+
+		    if (and (S_FLAGS(sym), SF_MACARGS) == 0) {
+			if (GT_NEXTCH(gt) > 0) {
+			    call ungetci (fd, GT_NEXTCH(gt))
+			    GT_NEXTCH(gt) = 0
+			}
+			call ungetline (fd, Memc[textp])
+			next
+		    }
+
+		    # Extract argument list, if any, perform argument
+		    # substitution on the macro, and push back the edited
+		    # text to be rescanned.
+
+		    if (qp_nexttok(gt) == '(') {
+			nargs = qp_arglist (gt, Memc[argbuf], SZ_ARGBUF)
+
+			# Pushback the text of a macro with arg substitution.
+			nchars = strmac (Memc[textp], Memc[argbuf],
+			    Memc[obuf], SZ_OBUF)
+			if (GT_NEXTCH(gt) > 0) {
+			    call ungetci (fd, GT_NEXTCH(gt))
+			    GT_NEXTCH(gt) = 0
+			}
+			call ungetline (fd, Memc[obuf])
+			next
+
+		    } else {
+			call eprintf ("macro `%s' called with no arguments\n")
+			    call pargstr (tokbuf)
+		    }
+		}
+
+		# Check for the builtin symbol $DFN, the datafile name.
+		if (tokbuf[1] == '$') {
+		    if (streq (tokbuf, "$DFN")) {
+			call strcpy (QP_DFNAME(qp), tokbuf, maxch)
+			token = TOK_STRING
+			break
+		    }
+		}
+
+		# Return a regular identifier.
+		break
+
+	    case TOK_COMMAND:
+		# Send a command to the CL and push back the output.
+
+		# Execute the command, spooling the output in a temp file.
+		call mktemp ("tmp$co", Memc[fname], SZ_FNAME)
+		call sprintf (Memc[cmd], SZ_LINE, "%s > %s")
+		    call pargstr (tokbuf)
+		    call pargstr (Memc[fname])
+		call clcmdw (Memc[cmd])
+
+		# Open the output file as input text.
+		call strcpy (Memc[fname], tokbuf, maxch)
+		nargs = 0
+		ftemp = YES
+		goto pushfile_
+
+	    case '@':
+		token = qp_rawtok (gt, tokbuf, maxch)
+		if (token != TOK_IDENTIFIER && token != TOK_STRING) {
+		    call eprintf ("expected a filename after the `@'\n")
+		    next
+		} else {
+		    nargs = 0
+		    if (qp_nexttok(gt) == '(')		# )
+			nargs = qp_arglist (gt, Memc[argbuf], SZ_ARGBUF)
+		    ftemp = NO
+		}
+pushfile_
+		# Attempt to open the file; first try the given name, then
+		# if that doesn't work, try adding the macro file extension.
+
+		iferr (i_fd = open (tokbuf, READ_ONLY, TEXT_FILE)) {
+		    call qp_mkfname (tokbuf,
+			QPOE_MACROEXTN, Memc[fname], SZ_FNAME)
+		    iferr (i_fd = open (Memc[fname],READ_ONLY,TEXT_FILE)) {
+			call eprintf ("cannot open `%s'\n")
+			    call pargstr (tokbuf)
+			next
+		    }
+		}
+
+		if (qp != NULL)
+		    call fseti (i_fd, F_PBBSIZE, QP_SZPBBUF(qp))
+		else
+		    call fseti (i_fd, F_PBBSIZE, DEF_MAXPUSHBACK)
+
+		# Cancel lookahead.
+		if (GT_NEXTCH(gt) > 0) {
+		    call ungetci (fd, GT_NEXTCH(gt))
+		    GT_NEXTCH(gt) = 0
+		}
+
+		# If the macro was called with a nonnull argument list,
+		# attempt to perform argument substitution on the file
+		# contents.  Otherwise merely push the fd.
+
+		if (nargs > 0) {
+		    # Pushback file contents with argument substitution.
+		    o_fd = stropen (Memc[ibuf], SZ_IBUF, NEW_FILE)
+
+		    call fcopyo (i_fd, o_fd)
+		    nchars = strmac (Memc[ibuf],Memc[argbuf],Memc[obuf],SZ_OBUF)
+		    call ungetline (fd, Memc[obuf])
+
+		    call close (o_fd)
+		    call close (i_fd)
+
+		} else {
+		    # Push a new input stream.
+		    level = GT_LEVEL(gt) + 1
+		    if (level > MAX_LEVELS)
+			call syserr (SYS_QPMRECUR)
+
+		    GT_SVFD(gt,level) = GT_FD(gt)
+		    GT_SVFTEMP(gt,level) = GT_FTEMP(gt)
+		    GT_LEVEL(gt) = level
+
+		    fd = i_fd
+		    GT_FD(gt) = fd
+		    GT_FTEMP(gt) = ftemp
+		}
+
+	    default:
+		break
+	    }
+	}
+
+	if (qp != NULL)
+	    if (QP_DEBUG(qp) > 4) {
+		call eprintf ("token=%d(%o), `%s'\n")
+		    call pargi (token)
+		    call pargi (max(0,token))
+		    if (IS_PRINT(tokbuf[1]))
+			call pargstr (tokbuf)
+		    else
+			call pargstr ("")
+	    }
+
+	call sfree (sp)
+	return (token)
+end
+
+
+# QP_UNGETTOK -- Push a token back into the QP_GETTOK input stream, to be
+# returned as the next token by QP_GETTOK.
+
+procedure qp_ungettok (gt, tokbuf)
+
+pointer	gt			#I gettok descriptor
+char	tokbuf[ARB]		#I text of token
+
+int	fd
+pointer	qp
+errchk	ungetci
+
+begin
+	fd = GT_FD(gt)
+	qp = GT_QP(gt)
+
+	if (qp != NULL)
+	    if (QP_DEBUG(qp) > 4) {
+		call eprintf ("unget token `%s'\n")
+		    call pargstr (tokbuf)
+	    }
+
+	# Cancel lookahead.
+	if (GT_NEXTCH(gt) > 0) {
+	    call ungetci (fd, GT_NEXTCH(gt))
+	    GT_NEXTCH(gt) = 0
+	}
+
+	# First push back a space to ensure that the token is recognized
+	# when the input is rescanned.
+
+	call ungetci (fd, ' ')
+
+	# Now push the token text.
+	call ungetline (fd, tokbuf)
+end
+ 
+
+# QP_RAWTOK -- Get a raw token from the input stream, without performing any
+# macro expansion or file inclusion.  The text of the token in returned in
+# tokbuf, and the token type is returened as the function value.
+
+int procedure qp_rawtok (gt, outstr, maxch)
+
+pointer	gt			#I gettok descriptor
+char	outstr[maxch]		#O receives text of token.
+int	maxch			#I max chars out
+
+int	token, delim, fd, ch, op
+define	again_ 91
+int	getci()
+
+begin
+	fd = GT_FD(gt)
+again_
+	# Get lookahead char if we don't already have one.
+	ch = GT_NEXTCH(gt)
+	GT_NEXTCH(gt) = NULL
+	if (ch <= 0 || IS_WHITE(ch) || ch == '\n') {
+	    while (getci (fd, ch) != EOF)
+		if (!(IS_WHITE(ch) || ch == '\n'))
+		    break
+	}
+
+	# Output the first character.
+	op = 1
+	if (ch != EOF && ch != '"' && ch != '\'' && ch != '`') {
+	    outstr[op] = ch
+	    op = op + 1
+	}
+
+	# Accumulate token.  Some of the token recognition logic used here
+	# (especially for numbers) is crude, but it is not clear that rigour
+	# is justified for this application.
+
+	if (ch == EOF) {
+	    call strcpy ("EOF", outstr, maxch)
+	    token = EOF
+
+	} else if (ch == '#') {
+	    # Ignore a comment.
+	    while (getci (fd, ch) != '\n')
+		if (ch == EOF)
+		    break
+	    goto again_
+
+	} else if (IS_ALPHA(ch) || ch == '_' || ch == '$' || ch == '.') {
+	    # Identifier.
+	    token = TOK_IDENTIFIER
+	    while (getci (fd, ch) != EOF)
+		if (IS_ALNUM(ch) || ch == '_' || ch == '$' || ch == '.') {
+		    outstr[op] = ch
+		    op = min (maxch, op+1)
+		} else
+		    break
+
+	} else if (IS_DIGIT(ch)) {
+	    # Number.
+	    token = TOK_NUMBER
+
+	    # Get number.
+	    while (getci (fd, ch) != EOF)
+		if (IS_ALNUM(ch) || ch == '.') {
+		    outstr[op] = ch
+		    op = min (maxch, op+1)
+		} else
+		    break
+
+	    # Get exponent if any.
+	    if (ch == 'E' || ch == 'e') {
+		outstr[op] = ch
+		op = min (maxch, op+1)
+		while (getci (fd, ch) != EOF)
+		    if (IS_DIGIT(ch) || ch == '+' || ch == '-') {
+			outstr[op] = ch
+			op = min (maxch, op+1)
+		    } else
+			break
+	    }
+
+	} else if (ch == '"' || ch == '\'' || ch == '`') {
+	    # Quoted string or command.
+
+	    if (ch == '`')
+		token = TOK_COMMAND
+	    else
+		token = TOK_STRING
+
+	    delim = ch
+	    while (getci (fd, ch) != EOF)
+		if (ch==delim && (op>1 && outstr[op-1] != '\\') || ch == '\n')
+		    break
+		else {
+		    outstr[op] = ch
+		    op = min (maxch, op+1)
+		}
+	    ch = getci (fd, ch)
+
+	} else if (ch == '+') {
+	    # May be the += operator.
+	    if (getci (fd, ch) != EOF)
+		if (ch == '=') {
+		    token = TOK_PLUSEQUALS
+		    outstr[op] = ch
+		    op = op + 1
+		    ch = getci (fd, ch)
+		} else
+		    token = '+'
+
+	} else if (ch == ':') {
+	    # May be the := operator.
+	    if (getci (fd, ch) != EOF)
+		if (ch == '=') {
+		    token = TOK_COLONEQUALS
+		    outstr[op] = ch
+		    op = op + 1
+		    ch = getci (fd, ch)
+		} else
+		    token = ':'
+
+	} else {
+	    # Other characters.
+	    token = ch
+	    ch = getci (fd, ch)
+	}
+
+	# Process the lookahead character.
+	if (IS_WHITE(ch) || ch == '\n') {
+	    repeat {
+		ch = getci (fd, ch)
+	    } until (!(IS_WHITE(ch) || ch == '\n'))
+	}
+
+	if (ch != EOF)
+	    GT_NEXTCH(gt) = ch
+
+	outstr[op] = EOS
+	return (token)
+end
+
+
+# QP_NEXTTOK -- Determine the type of the next raw token in the input stream,
+# without actually fetching the token.  TOK_PLUSEQUALS is not recognized at
+# this level.  Note that this is at the same level as QP_RAWTOK, i.e., no
+# macro expansion is performed, and the lookahead token is that which would
+# be returned by the next qp_rawtok, which is not necessarily what qp_gettok
+# would return after macro replacement.
+
+int procedure qp_nexttok (gt)
+
+pointer	gt			#I gettok descriptor
+
+pointer	qp
+int	token, fd, ch
+int	getci()
+
+begin
+	fd = GT_FD(gt)
+	qp = GT_QP(gt)
+
+	# Get lookahead char if we don't already have one.
+	ch = GT_NEXTCH(gt)
+	if (ch <= 0 || IS_WHITE(ch) || ch == '\n')
+	    while (getci (fd, ch) != EOF)
+		if (!(IS_WHITE(ch) || ch == '\n'))
+		    break
+
+	if (ch == EOF)
+	    token = EOF
+	else if (IS_ALPHA(ch))
+	    token = TOK_IDENTIFIER
+	else if (IS_DIGIT(ch))
+	    token = TOK_NUMBER
+	else if (ch == '"' || ch == '\'') 
+	    token = TOK_STRING
+	else if (ch == '`')
+	    token = TOK_COMMAND
+	else
+	    token = ch
+
+	if (qp != NULL)
+	    if (QP_DEBUG(qp) > 4) {
+		call eprintf ("nexttok=%d(%o) `%c'\n")
+		    call pargi (token)
+		    call pargi (max(0,token))
+		    if (IS_PRINT(ch))
+			call pargi (ch)
+		    else
+			call pargi (0)
+	    }
+
+	return (token)
+end
+
+
+# QP_CLOSETEXT -- Close the gettok descriptor and any files opened thereon.
+
+procedure qp_closetext (gt)
+
+pointer	gt			#I gettok descriptor
+
+int	level, fd
+pointer	sp, fname
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	for (level=GT_LEVEL(gt);  level >= 0;  level=level-1) {
+	    fd = GT_FD(gt)
+	    if (GT_FTEMP(gt) == YES) {
+		call fstats (fd, F_FILENAME, Memc[fname], SZ_FNAME)
+		call close (fd)
+		iferr (call delete (Memc[fname]))
+		    call erract (EA_WARN)
+	    } else
+		call close (fd)
+
+	    if (level > 0) {
+		GT_FD(gt)    = GT_SVFD(gt,level)
+		GT_FTEMP(gt) = GT_SVFTEMP(gt,level)
+	    }
+	}
+
+	call mfree (gt, TY_STRUCT)
+	call sfree (sp)
+end
+
+
+# QP_ARGLIST -- Extract a paren and comma delimited argument list to be used
+# for substitution into a macro replacement string.  Since the result will be
+# pushed back and rescanned, we do not have to perform macro substitution on
+# the argument list at this level.
+
+int procedure qp_arglist (gt, argbuf, maxch)
+
+pointer	gt			#I gettok descriptor
+char	argbuf[maxch]		#O receives parsed arguments
+int	maxch			#I max chars out
+
+int	level, quote, nargs, op, ch, fd
+int	getci()
+
+begin
+	fd = GT_FD(gt)
+
+	# Get lookahead char if we don't already have one.
+	ch = GT_NEXTCH(gt)
+	if (ch <= 0 || IS_WHITE(ch) || ch == '\n')
+	    while (getci (fd, ch) != EOF)
+		if (!(IS_WHITE(ch) || ch == '\n'))
+		    break
+
+	quote = 0
+	level = 1
+	nargs = 0
+	op = 1
+
+	if (ch == '(') {
+	    while (getci (fd, ch) != EOF) {
+		if (ch == '"' || ch == '\'') {
+		    if (quote == 0)
+			quote = ch
+		    else if (quote == ch)
+			quote = 0
+
+		} else if (ch == '(' && quote == 0) {
+		    level = level + 1
+		} else if (ch == ')' && quote == 0) {
+		    level = level - 1
+		    if (level <= 0) {
+			if (op > 1 && argbuf[op-1] != EOS)
+			    nargs = nargs + 1
+			break
+		    }
+
+		} else if (ch == ',' && level == 1 && quote == 0) {
+		    ch = EOS
+		    nargs = nargs + 1
+		} else if (ch == '\n') {
+		    ch = ' '
+		} else if (ch == '\\' && quote == 0) {
+		    ch = getci (fd, ch)
+		    next
+		} else if (ch == '#' && quote == 0) {
+		    while (getci (fd, ch) != EOF)
+			if (ch == '\n')
+			    break
+		    next
+		}
+
+		argbuf[op] = ch
+		op = min (maxch, op + 1)
+	    }
+
+	    GT_NEXTCH(gt) = NULL
+	}
+
+	argbuf[op] = EOS
+	return (nargs)
+end
diff --git a/sys/qpoe/qpgetx.x b/sys/qpoe/qpgetx.x
new file mode 100644
index 00000000..cf9468bb
--- /dev/null
+++ b/sys/qpoe/qpgetx.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_GETX -- Return the complex value of the named header parameter.  Type
+# conversion is not permitted between complex and the other datatypes.
+
+complex procedure qp_getx (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	pp
+int	qp_getparam()
+errchk	qp_getparam, syserrs
+
+begin
+	# Lookup the parameter and it's value.
+	if (qp_getparam (qp, param, pp) != TY_COMPLEX)
+	    call syserrs (SYS_QPBADCONV, param)
+	else if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	return (Memx[pp])
+end
diff --git a/sys/qpoe/qpgmsym.x b/sys/qpoe/qpgmsym.x
new file mode 100644
index 00000000..883f5c22
--- /dev/null
+++ b/sys/qpoe/qpgmsym.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_GMSYM -- Lookup the named macro in the symbol table and return a pointer
+# to the symstruct describing the macro as the function value.  NULL is
+# returned if the macro is not defined, or if the named symbol is not a macro.
+# Local macros take precedence over global macros.  In the case of a local
+# macro whose value is stored in the datafile, we have to allocate an internal
+# buffer to hold the data after we exit; this data must be used promptly,
+# before the routine is again called.
+
+pointer procedure qp_gmsym (qp, macro, textp)
+
+pointer	qp			#I QPOE descriptor
+char	macro[ARB]		#I macro name
+pointer	textp			#O char pointer to macro text
+
+int	sz_textbuf, nchars, fd
+pointer	st, sm, sym, textbuf
+data	textbuf /NULL/, sz_textbuf /NULL/
+
+int	fm_getfd(), read()
+pointer	qm_symtab(), strefsbuf(), stfind()
+errchk	realloc, fm_getfd, seek, read
+
+begin
+	st = QP_ST(qp)
+	sm = qm_symtab (QP_QM(qp))
+
+	# First look in the datafile local symbol table.  Macros are stored
+	# in the datafile symbol table as string macros of type TY_MACRO.
+
+	sym = stfind (st, macro)
+	if (sym != NULL)
+	    if (S_DTYPE(sym) == TY_MACRO)
+		if (and (S_FLAGS(sym), SF_DELETED) == 0) {
+		    if (S_LFILE(sym) > 0) {
+			# Macro value stored as data.
+
+			# Make sure the text buffer is large enough.
+			if (sz_textbuf < S_NELEM(sym)) {
+			    sz_textbuf = S_NELEM(sym)
+			    call realloc (textbuf, sz_textbuf, TY_CHAR)
+			}
+
+			# Read the data.
+			fd = fm_getfd (QP_FM(qp), S_LFILE(sym), READ_ONLY, 0)
+
+			call seek (fd, S_OFFSET(sym))
+			nchars = max (0, read (fd, Memc[textbuf], S_NELEM(sym)))
+			Memc[textbuf+nchars] = EOS
+			textp = textbuf
+
+			call fm_retfd (QP_FM(qp), S_LFILE(sym))
+
+		    } else {
+			# Macro value stored in symbol table.
+			textp = strefsbuf (st, S_OFFSET(sym))
+		    }
+
+		    # Exit if a local symbol was found.
+		    return (sym)
+		}
+
+	# Next look in the global macro symbol table.
+	sym = stfind (sm, macro)
+	if (sym != NULL)
+	    if (and (S_FLAGS(sym), SF_DELETED) == 0)
+		textp = strefsbuf (sm, S_OFFSET(sym))
+	    else
+		sym = NULL
+
+	return (sym)
+end
diff --git a/sys/qpoe/qpgnfn.x b/sys/qpoe/qpgnfn.x
new file mode 100644
index 00000000..c12adc76
--- /dev/null
+++ b/sys/qpoe/qpgnfn.x
@@ -0,0 +1,240 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+.help qp_gnfn
+.nf --------------------------------------------------------------------------
+QP_GNFN -- Access the file header as a parameter list.
+
+	     list = qp_ofnl[su] (qp, template)
+	   nchars|EOF = qp_gnfn (list, outstr, maxch)
+	        len = qp_lenfnl (list)
+		     qp_seekfnl (list, pos)
+			qp_cfnl (list)
+
+These routines are used to determine the names of the fields (parameters) in
+the QPOE file header, e.g., to list out the header.  QP_OFNLS and QP_ONFLU open
+the file header (sorted or unsorted).  QP_GNFN returns the next parameter name,
+returning as the function value the string length of the parameter name or EOF
+when the end of the list is reached.  QP_SFNL seeks on or rewinds the list.
+QP_CFNL closes the list descriptor.
+.endhelp --------------------------------------------------------------------
+
+# Size limiting definitions.
+define	DEF_LENOFFV	128		# initial length of keywd-offset vector
+define	INC_LENOFFV	128		# increment to above
+define	DEF_SZSBUF	1024		# initial size of string buffer
+define	INC_SZSBUF	1024		# increment to above
+
+# List descriptor.
+define	LEN_FL		3
+define	FL_LEN		Memi[$1]	# number of names in list
+define	FL_POS		Memi[$1+1]	# current position
+define	FL_SBUF		Memi[$1+2]	# pointer to string buffer
+define	FL_OFFV		Memi[$1+3]	# pointer to offset vector
+
+
+# QP_OFNLS -- Open a sorted field name list.
+
+pointer procedure qp_ofnls (qp, template)
+
+pointer	qp			#I QPOE descriptor
+char	template[ARB]		#I field name template
+
+pointer	qp_ofnl()
+
+begin
+	return (qp_ofnl (qp, template, true))
+end
+
+
+# QP_OFNLU -- Open an unsorted field name list.
+
+pointer procedure qp_ofnlu (qp, template)
+
+pointer	qp			#I QPOE descriptor
+char	template[ARB]		#I field name template
+
+pointer	qp_ofnl()
+
+begin
+	return (qp_ofnl (qp, template, false))
+end
+
+
+# QP_OFNL -- Open a sorted or unsorted field name list.
+
+pointer procedure qp_ofnl (qp, template, sort)
+
+pointer	qp			#I QPOE descriptor
+char	template[ARB]		#I field name template
+bool	sort			#I sort list of matched names?
+
+pointer	sp, patbuf, pattern, sym, fl, st, offv, sbuf, ip, op
+int	len_offv, sz_sbuf, nsyms, nc, junk, nchars, i, nmatch
+
+pointer	sthead(), stnext(), stname()
+int	patmake(), patmatch(), strlen()
+define	swap {junk=$1;$1=$2;$2=junk}
+errchk	calloc, malloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (pattern, SZ_LINE, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+
+	# Allocate the list descriptor.
+	call calloc (fl, LEN_FL, TY_STRUCT)
+	call malloc (offv, DEF_LENOFFV, TY_INT)
+	call malloc (sbuf, DEF_SZSBUF, TY_CHAR)
+
+	len_offv = DEF_LENOFFV
+	sz_sbuf = DEF_SZSBUF
+	st = QP_ST(qp)
+	nsyms = 0
+	nc = 0
+
+	# Default to match all; map '*' into '?*', which is probably what
+	# the user intends.  Match only at the beginning of line as we want
+	# to match only entire field name strings.
+
+	if (template[1] == EOS)
+	    call strcpy ("?*", Memc[pattern], SZ_LINE)
+	else {
+	    op = pattern
+	    Memc[op] = '^'
+	    op = op + 1
+	    for (ip=1;  template[ip] != EOS && ip < SZ_LINE;  ip=ip+1) {
+		if (template[ip] == '*')
+		    if (ip == 1 || (ip > 1 && template[ip-1] != ']')) {
+			Memc[op] = '?'
+			op = op + 1
+		    }
+		Memc[op] = template[ip]
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	}
+
+	# Compile the pattern matching template.
+	junk = patmake (Memc[pattern], Memc[patbuf], SZ_LINE)
+
+	# Scan the symbol table and generate the unsorted list.
+	for (sym=sthead(st);  sym != NULL;  sym=stnext(st,sym)) {
+	    if (and (S_FLAGS(sym), SF_DELETED) != 0)
+		next
+
+	    # Get the symbol name.
+	    ip = stname (st, sym)
+	    nchars = strlen (Memc[ip])
+
+	    # Save in list if it matches.
+	    nmatch = patmatch (Memc[ip], Memc[patbuf]) - 1
+	    if (nmatch > 0 && nmatch == nchars) {
+		nsyms = nsyms + 1
+
+		# Make room in offset vector?
+		if (nsyms > len_offv) {
+		    len_offv = len_offv + INC_LENOFFV
+		    call realloc (offv, len_offv, TY_INT)
+		}
+
+		# Make room in string buffer?
+		if (nc + nchars + 1 > sz_sbuf) {
+		    sz_sbuf = sz_sbuf + INC_SZSBUF
+		    call realloc (sbuf, sz_sbuf, TY_CHAR)
+		}
+
+		# Add the symbol.
+		Memi[offv+nsyms-1] = nc + 1
+		call strcpy (Memc[ip], Memc[sbuf+nc], nchars)
+		nc = nc + nchars + 1
+	    }
+	}
+
+	# Sort the list if indicated, else reverse the order of the list
+	# to get a time-ordered (FIFO) list.
+
+	if (sort)
+	    call strsrt (Memi[offv], Memc[sbuf], nsyms)
+	else {
+	    do i = 1, nsyms / 2
+		swap (Memi[offv+i-1], Memi[offv+nsyms-i])
+	}
+
+	# Finish setting up the descriptor.
+	FL_LEN(fl)  = nsyms
+	FL_SBUF(fl) = sbuf
+	FL_OFFV(fl) = offv
+
+	call sfree (sp)
+	return (fl)
+end
+
+
+# QP_GNFN -- Return the next element from the field name list.  The string
+# length is returned as the function value, or EOF at the end of the list.
+
+int procedure qp_gnfn (fl, outstr, maxch)
+
+pointer	fl			#I list descriptor
+char	outstr[maxch]		#O output string
+int	maxch			#I max chars out
+
+int	pos, off, nchars 
+int	gstrcpy()
+
+begin
+	pos = FL_POS(fl)
+	if (pos >= FL_LEN(fl))
+	    return (EOF)
+
+	off = Memi[FL_OFFV(fl) + pos]
+	nchars = gstrcpy (Memc[FL_SBUF(fl)+off-1], outstr, maxch)
+
+	FL_POS(fl) = pos + 1
+	return (nchars)
+end
+
+
+# QP_LENFNL -- Return the length of (number of names in) the field name list.
+
+int procedure qp_lenfnl (fl)
+
+pointer	fl			#I list descriptor
+
+begin
+	return (FL_LEN(fl))
+end
+
+
+# QP_SEEKFNL -- Seek on the field name list.
+
+procedure qp_seekfnl (fl, pos)
+
+pointer	fl			#I list descriptor
+int	pos			#I desired list element, BOF, EOF
+
+begin
+	switch (pos) {
+	case BOF:
+	    FL_POS(fl) = 0
+	case EOF:
+	    FL_POS(fl) = FL_LEN(fl)
+	default:
+	    FL_POS(fl) = max(0, min(FL_LEN(fl), pos - 1))
+	}
+end
+
+
+# QP_CFNL -- Close a field name list.
+
+procedure qp_cfnl (fl)
+
+pointer	fl			#I list descriptor
+
+begin
+	call mfree (FL_SBUF(fl), TY_CHAR)
+	call mfree (FL_OFFV(fl), TY_INT)
+	call mfree (fl, TY_STRUCT)
+end
diff --git a/sys/qpoe/qpgpar.x b/sys/qpoe/qpgpar.x
new file mode 100644
index 00000000..f3307043
--- /dev/null
+++ b/sys/qpoe/qpgpar.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <ctype.h>
+include "qpoe.h"
+
+# QP_GETPARAM -- Lookup the named parameter in the symbol table and return
+# a pointer to the scalar parameter value.  A NULL pointer is returned if
+# the parameter exists but does not currently have a value.  The parameter
+# datatype code is returned as the function value.  The pointed to parameter
+# value will be clobbered in the next call, hence should be used promptly.
+# The data element pointed to may be a structure as well as a primitive type.
+
+int procedure qp_getparam (qp, param, o_pp)
+
+pointer qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+pointer o_pp			#O pointer to parameter value
+
+int	loc_pval, loc_Mem, ip, ch, elem, sz_elem, fd
+pointer sp, key, fm, pp, op, sym
+double	pval[LEN_PVAL+1]
+data	pp /NULL/
+
+pointer qp_gpsym()
+int	qp_sizeof(), fm_getfd(), qp_ctoi(), read()
+errchk	qp_bind, qp_gpsym, syserrs, fm_getfd, seek, read
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	fm = QP_FM(qp)
+
+	# Compute pointer (Memc index) to the static pval buffer.
+	# Make sure that the computed pointer is double aligned.
+
+	if (pp == NULL) {
+	    call zlocva (pval, loc_pval)
+	    call zlocva (Memc, loc_Mem)
+	    pp = (loc_pval+SZ_DOUBLE - loc_Mem) / SZ_DOUBLE * SZ_DOUBLE + 1
+	}
+
+	# Extract the primary parameter name, minus any whitespace and
+	# subscript (e.g., "param[elem]").
+
+	op = key
+	do ip = 1, SZ_FNAME {
+	    ch = param[ip]
+	    if (IS_WHITE(ch))
+		next
+	    else if (ch == '[' || ch == EOS)
+		break
+	    Memc[op] = ch
+	    op = op + 1
+	}
+	Memc[op] = EOS
+
+	# Determine the array element (default [1]).
+	elem = 1
+	if (param[ip] == '[') {
+	    ip = ip + 1
+	    if (qp_ctoi (param, ip, elem) <= 0)
+		elem = 1
+	}
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, Memc[key])
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+
+	# Check to make sure the parameter value exists, and fetch the 
+	# value from the lfile where the parameter data is stored, setting
+	# the parameter value pointer to point to the stored value.
+
+	if (elem < 1 || elem > S_NELEM(sym))
+	    o_pp = NULL
+	else {
+	    sz_elem = qp_sizeof (qp, S_DTYPE(sym), sym, INSTANCEOF)
+	    if (sz_elem > LEN_PVAL * SZ_DOUBLE)
+		call syserrs (SYS_QPPVALOVF, QP_DFNAME(qp))
+
+	    fd = fm_getfd (fm, S_LFILE(sym), READ_ONLY, 0)
+
+	    call seek (fd, S_OFFSET(sym) + (elem - 1) * sz_elem)
+	    if (read (fd, Memc[pp], sz_elem) < sz_elem)
+		o_pp = NULL
+	    else if (S_DTYPE(sym) == TY_USER)
+		o_pp = (pp - 1) / SZ_STRUCT + 1
+	    else
+		o_pp = (pp - 1) / sz_elem + 1
+
+	    call fm_retfd (fm, S_LFILE(sym))
+	}
+
+	call sfree (sp)
+	return (S_DTYPE(sym))
+end
diff --git a/sys/qpoe/qpgpsym.x b/sys/qpoe/qpgpsym.x
new file mode 100644
index 00000000..b18199e2
--- /dev/null
+++ b/sys/qpoe/qpgpsym.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_GPSYM -- Lookup the named parameter in the symbol table and return
+# a pointer to the symstruct describing the parameter as the function value.
+# NULL is returned if the parameter is not defined, or if the named symbol is
+# not a parameter.  Global parameter aliases are recursively expanded.
+# Local macros are not expanded at this level, since local macros are stored
+# as parameters themselves.
+
+pointer procedure qp_gpsym (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+int	n
+pointer	sp, pname, sym, st, sm
+pointer	stfind(), strefsbuf(), qm_symtab()
+errchk	syserrs
+
+#pointer	ip
+#int	fd, nchars
+#int	fm_getfd(), read()
+#errchk	fm_getfd, read, seek
+
+begin
+	call smark (sp)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	st = QP_ST(qp)
+	sm = qm_symtab (QP_QM(qp))
+	call strcpy (param, Memc[pname], SZ_FNAME)
+
+	# First expand any aliases in the global macro symbol table.
+	sym = stfind (sm, param)
+	for (n=1;  sym != NULL;  n=n+1) {
+	    if (and (S_FLAGS(sym), SF_DELETED) != 0)
+		break
+	    call strcpy (strefsbuf(sm,S_OFFSET(sym)), Memc[pname], SZ_FNAME)
+	    sym = stfind (sm, Memc[pname])
+	    if (n > MAX_INDIR)
+		call syserrs (SYS_QPMRECUR, param)
+	}
+
+	# Lookup the symbol in the datafile local symbol table.  Datafile
+	# local macros cannot be expanded in parameter references, since
+	# the macros are themselves stored as parameters (if macro parameters
+	# were expanded in parameter references, there would be no simple
+	# way to access the macro parameters themselves).
+
+	sym = stfind (st, Memc[pname])
+
+#	Disable expansion of datafile-local macro defines.
+#	if (sym != NULL) {
+#	    for (n=0;  S_DTYPE(sym) == TY_MACRO;  n=n+1) {
+#		if (and (S_FLAGS(sym), SF_DELETED) != 0) {
+#		    break
+#
+#		} else if (S_LFILE(sym) > 0) {
+#		    # Macro value stored as data.
+#		    fd = fm_getfd (QP_FM(qp), S_LFILE(sym), READ_ONLY, 0)
+#
+#		    call seek (fd, S_OFFSET(sym))
+#		    nchars = max (0, read (fd, Memc[pname], S_NELEM(sym)))
+#		    Memc[pname+nchars] = EOS
+#		    ip = pname
+#
+#		    call fm_retfd (QP_FM(qp), S_LFILE(sym))
+#
+#		} else {
+#		    # Macro value stored in symbol table.
+#		    ip = strefsbuf (st, S_OFFSET(sym))
+#		}
+#
+#		# Macro recursion.
+#		if (n > MAX_INDIR)
+#		    call syserrs (SYS_QPMRECUR, param)
+#	    }
+#	}
+
+	# Don't "find" the symbol if it has been deleted.
+	if (sym != NULL)
+	    if (and (S_FLAGS(sym), SF_DELETED) != 0)
+		sym = NULL
+
+	call sfree (sp)
+	return (sym)
+end
diff --git a/sys/qpoe/qpgstr.x b/sys/qpoe/qpgstr.x
new file mode 100644
index 00000000..91a03a0f
--- /dev/null
+++ b/sys/qpoe/qpgstr.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "qpoe.h"
+
+# QP_GSTR -- Return the string value of the named parameter.
+
+int procedure qp_gstr (qp, param, outstr, maxch)
+
+pointer qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	outstr[maxch]		#O receives string value
+int	maxch			#I max chars out
+
+pointer	sym, fm
+int	nchars, fd
+pointer	qp_gpsym()
+int	fm_getfd(), read()
+errchk	qp_bind, qp_gpsym, syserrs, fm_getfd, seek
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+	fm = QP_FM(qp)
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+	else if (!(S_DTYPE(sym) == TY_CHAR || S_DTYPE(sym) == TY_USER))
+	    call syserrs (SYS_QPBADCONV, param)
+
+	# Fetch the string value from the lfile where the data is stored.
+	fd = fm_getfd (fm, S_LFILE(sym), READ_ONLY, 0)
+	call seek (fd, S_OFFSET(sym))
+
+	nchars = max (0, read (fd, outstr, min(S_NELEM(sym),maxch)))
+	outstr[nchars+1] = EOS
+
+	call fm_retfd (fm, S_LFILE(sym))
+	return (nchars)
+end
diff --git a/sys/qpoe/qpinherit.x b/sys/qpoe/qpinherit.x
new file mode 100644
index 00000000..495966f4
--- /dev/null
+++ b/sys/qpoe/qpinherit.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"qpoe.h"
+
+# QP_INHERIT -- Copy all the inheritable parameters from one datafile to
+# another.
+
+procedure qp_inherit (n_qp, o_qp, out)
+
+pointer	n_qp			#I QPOE descriptor of new datafile
+pointer	o_qp			#I QPOE descriptor of old datafile
+int	out			#I output stream for verbose messages, or NULL
+
+int	nsyms, i
+pointer	sp, n_st, o_st, sym, op, pname, syms
+pointer	sthead(), stnext(), stname()
+int	qp_accessf()
+
+begin
+	call smark (sp)
+
+	n_st = QP_ST(n_qp)
+	o_st = QP_ST(o_qp)
+
+	# Count the symbols to be copied.
+	nsyms = 0
+	for (sym=sthead(o_st);  sym != NULL;  sym=stnext(o_st,sym))
+	    if (and (S_FLAGS(sym), SF_DELETED) == 0)
+		if (and (S_FLAGS(sym), SF_INHERIT) != 0)
+		    nsyms = nsyms + 1
+
+	# Construct a reversed array of symbol pointers.
+	call salloc (syms, nsyms, TY_POINTER) 
+	op = syms + nsyms - 1
+	for (sym=sthead(o_st);  sym != NULL;  sym=stnext(o_st,sym))
+	    if (and (S_FLAGS(sym), SF_DELETED) == 0)
+		if (and (S_FLAGS(sym), SF_INHERIT) != 0) {
+		    Memi[op] = sym
+		    op = op - 1
+		}
+
+	# Copy each symbol.
+	do i = 1, nsyms {
+	    pname = stname (o_st, Memi[syms+i-1])
+	    if (qp_accessf (n_qp, Memc[pname]) == YES) {
+		if (out != NULL) {
+		    call fprintf (out,
+			"parameter `%s' already exists, not copied\n")
+			call pargstr (Memc[pname])
+		}
+	    } else iferr (call qp_copyf (o_qp, Memc[pname], n_qp, Memc[pname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpio.h b/sys/qpoe/qpio.h
new file mode 100644
index 00000000..91b58c73
--- /dev/null
+++ b/sys/qpoe/qpio.h
@@ -0,0 +1,140 @@
+# QPIO.H -- Definitions for the QPOE event i/o subpackage.
+
+# Default parameter and domain names.
+define	DEF_BLOCK	"defblock"	# header param - default block factor
+define	DEF_XBLOCK	"defxblock"	# header param - default X block factor
+define	DEF_YBLOCK	"defyblock"	# header param - default Y block factor
+define	DEF_MASK	"defmask"	# header param - default region mask
+define	DEF_FILTER	"deffilt"	# header param - default event filter
+define	DEF_EVENTTYPE	"event"		# default name of user event datatype
+define	DEF_EVENTPARAM	"events"	# default event-list parameter
+
+# QPIO keywords recognized in expressions (abbreviations permitted).
+define KEYWORDS "|block|xblock|yblock|debug|filter|key|noindex|param|mask|rect|"
+
+define	KW_BLOCK	1		# blocking factor for image matrix
+define	KW_XBLOCK	2		# X blocking factor for image matrix
+define	KW_YBLOCK	3		# Y blocking factor for image matrix
+define	KW_DEBUG	4		# debug level (integer, 0=nodebug)
+define	KW_FILTER	5		# event attribute filter
+define	KW_KEY		6		# event key (Y,X) fields (e.g.(s10,s8))
+define	KW_NOINDEX	7		# don't use index even if present
+define	KW_PARAM	8		# name of event list header parameter
+define	KW_MASK		9		# region mask
+define	KW_RECT		10		# rectangle (bounding box) for i/o
+
+# Size limiting definitions.
+define	SZ_EVLIST	1024		# event list buffer size (arbitrary)
+define	NDIM		2		# all QPOE images are 2-dim
+
+# The main QPIO descriptor.
+define	LEN_IODES	82
+
+# general
+define	IO_QP		Memi[$1]	# backpointer to QPOE descriptor
+define	IO_MODE		Memi[$1+1]	# read_only or new_file
+define	IO_DEBUG	Memi[$1+2]	# debug level
+define	IO_NLINES	Memi[$1+3]	# number of image lines (physical)
+define	IO_NCOLS	Memi[$1+4]	# number of image columns (physical)
+define	IO_XBLOCK	Memr[P2R($1+5)]	# blocking factor for qpio_readpix
+define	IO_YBLOCK	Memr[P2R($1+6)]	# blocking factor for qpio_readpix
+define	IO_OPTBUFSIZE	Memi[$1+7]	# optbufsize for FIO (qpio_readpix)
+define	IO_NOINDEX	Memi[$1+8]	# don't use indexed extraction
+define	IO_NODEFFILT	Memi[$1+9]	# disable use of default filter
+define	IO_NODEFMASK	Memi[$1+10]	# disable use of default mask
+define	IO_PARAM	Memi[$1+11]	# pointer to buffer with param name
+define	IO_PSYM		Memi[$1+12]	# symbol table entry for parameter
+define	IO_MASK		Memi[$1+13]	# pointer to buffer with mask name
+define	IO_MDEPTH	Memi[$1+14]	# mask depth, bits
+define	IO_EXCLOSE	Memi[$1+15]	# qpex was opened by qpio
+define	IO_PLCLOSE	Memi[$1+16]	# mask was opened by qpio
+define	IO_PL		Memi[$1+17]	# PLIO (mask) pointer
+define	IO_EX		Memi[$1+18]	# QPEX (event attribute filter) pointer
+define	IO_FD		Memi[$1+19]	# file descriptor of open lfile
+define	IO_LF		Memi[$1+20]	# lfile where event list is stored
+define	IO_CHAN		Memi[$1+21]	# i/o channel of open lfile
+# events
+define	IO_DD		Memi[$1+22]	# pointer to domain descriptor
+define	IO_EVXOFF	Memi[$1+23]	# offset of X field used for extraction
+define	IO_EVXTYPE	Memi[$1+24]	# datatype of X field
+define	IO_EVYOFF	Memi[$1+25]	# offset of Y field used for extraction
+define	IO_EVYTYPE	Memi[$1+26]	# datatype of Y field
+define	IO_EVENTLEN	Memi[$1+27]	# length of event struct, shorts
+define	IO_MINEVL	Memi[$1+28]	# pointer to min event for full list
+define	IO_MAXEVL	Memi[$1+29]	# pointer to max event for full list
+# buckets
+define	IO_SZBBUCKET	Memi[$1+30]	# event file bucket size, bytes
+define	IO_BUCKETLEN	Memi[$1+31]	# nevents per bucket (excl. min/max)
+define	IO_NEVENTS	Memi[$1+32]	# total data events in event list
+define	IO_FBOFF	Memi[$1+33]	# lfile offset of first bucket
+define	IO_EVMINOFF	Memi[$1+34]	# offset to the MIN event in a bucket
+define	IO_EVMAXOFF	Memi[$1+35]	# offset to the MAX event in a bucket
+# index
+define	IO_INDEXLEN	Memi[$1+38]	# length of index (same as nlines)
+define	IO_IXXOFF	Memi[$1+39]	# offset of X field used in index
+define	IO_IXXTYPE	Memi[$1+40]	# datatype of X field used in index
+define	IO_IXYOFF	Memi[$1+41]	# offset of Y field used in index
+define	IO_IXYTYPE	Memi[$1+42]	# datatype of Y field used in index
+define	IO_YOFFVP	Memi[$1+43]	# pointer to Y-index array (len=nlines)
+define	IO_YLENVP	Memi[$1+44]	# pointer to Y-line length array
+define	IO_YOFFVOFF	Memi[$1+45]	# lfile offset of stored YOFFV
+define	IO_YOFFVLEN	Memi[$1+46]	# length, words, of compressed YOFFV
+define	IO_YLENVOFF	Memi[$1+47]	# lfile offset of stored YLENV
+define	IO_YLENVLEN	Memi[$1+48]	# length, words, of compressed YLENV
+# i/o
+define	IO_ACTIVE	Memi[$1+50]	# set once i/o begins
+define	IO_IOTYPE	Memi[$1+51]	# type of i/o selected for BB
+define	IO_LINEIO	Memi[$1+52]	# flag - BB width is full line width
+define	IO_RMUSED	Memi[$1+53]	# flag - region mask used in this BB
+define	IO_BBUSED	Memi[$1+54]	# flag - bounding box in use
+define	IO_BBMASK	Memi[$1+55]	# BB region mask subras, nonindexed i/o
+define	IO_RL		Memi[$1+56]	# range list pointer
+define	IO_RLI		Memi[$1+57]	# range list index
+define	IO_EVI		Memi[$1+58]	# event index into event list (for i/o)
+define	IO_EV1		Memi[$1+59]	# event index of first event on line
+define	IO_EV2		Memi[$1+60]	# event index of last event on line
+define	IO_BP		Memi[$1+61]	# pointer to bucket buffer
+define	IO_BKNO		Memi[$1+62]	# bucket number
+define	IO_BKFIRSTEV	Memi[$1+63]	# event index of first event in bucket
+define	IO_BKLASTEV	Memi[$1+64]	# event index of last event in bucket
+# (avail)
+define	IO_V		Meml[$1+70+$2-1]# current vector
+define	IO_VS		Meml[$1+72+$2-1]# start vector
+define	IO_VE		Meml[$1+74+$2-1]# end vector
+define	IO_VN		Meml[$1+76+$2-1]# size of section
+define	IO_VSDEF	Meml[$1+78+$2-1]# default start vector
+define	IO_VEDEF	Meml[$1+80+$2-1]# default end vector
+
+# Handy macros.
+define	IO_MINEVB	(IO_BP($1)+IO_EVMINOFF($1))
+define	IO_MAXEVB	(IO_BP($1)+IO_EVMAXOFF($1))
+define	EVI_TO_BUCKET	((($2)-1)/IO_BUCKETLEN($1)+1)
+define	BUCKET_TO_EVI	((($2)-1)*IO_BUCKETLEN($1)+1)
+
+# I/O types (specially optimized code for each case).
+define	NoINDEX_NoRMorBB	0	# nonindexed, no RM no BB
+define	NoINDEX_RMorBB		1	# nonindexed, maybe RM or BB
+define	INDEX_NoRMorBB		2	# indexed, no RM or BB
+define	INDEX_RMorBB		3	# indexed, maybe RM or BB
+define	NoDATA_NoAREA		4	# no events can be returned
+
+# Stored Event List header (one per stored event list).
+define	LEN_EHDES	18
+define	EH_NEVENTS	Memi[$1]	# total data events in event list
+define	EH_EVENTLEN	Memi[$1+1]	# event length, shorts
+define	EH_SZBBUCKET	Memi[$1+2]	# event file bucket size, bytes
+define	EH_BUCKETLEN	Memi[$1+3]	# nevents per bucket (excl. min/max)
+define	EH_FBOFF	Memi[$1+4]	# lfile offset of first bucket
+define	EH_EVMINOFF	Memi[$1+5]	# offset to the MIN event in a bucket
+define	EH_EVMAXOFF	Memi[$1+6]	# offset to the MAX event in a bucket
+define	EH_MINEVLOFF	Memi[$1+7]	# offset of stored MINEVL
+define	EH_MAXEVLOFF	Memi[$1+8]	# offset of stored MAXEVL
+define	EH_INDEXLEN	Memi[$1+9]	# length of index (same as nlines)
+define	EH_YOFFVOFF	Memi[$1+10]	# lfile offset of stored YOFFV
+define	EH_YOFFVLEN	Memi[$1+11]	# length, words, of compressed YOFFV
+define	EH_YLENVOFF	Memi[$1+12]	# lfile offset of stored YLENV
+define	EH_YLENVLEN	Memi[$1+13]	# length, words, of compressed YLENV
+define	EH_IXXOFF	Memi[$1+14]	# event offset of indexed X field
+define	EH_IXYOFF	Memi[$1+15]	# event offset of indexed Y field
+define	EH_IXXTYPE	Memi[$1+16]	# datatype of indexed X field
+define	EH_IXYTYPE	Memi[$1+17]	# datatype of indexed Y field
diff --git a/sys/qpoe/qpioclose.x b/sys/qpoe/qpioclose.x
new file mode 100644
index 00000000..78893487
--- /dev/null
+++ b/sys/qpoe/qpioclose.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpio.h"
+
+# QPIO_CLOSE -- Close the QPIO descriptor.  If writing to the event list,
+# the output bucket is automatically flushed and the event list header updated.
+
+procedure qpio_close (io)
+
+pointer	io			#I QPIO descriptor
+
+begin
+	if (IO_DEBUG(io) > 1) {
+	    call eprintf ("qpio_close (%xX)\n")
+		call pargi (io)
+	}
+
+	call qpio_sync (io)
+
+	if (IO_EX(io) != NULL && IO_EXCLOSE(io) == YES)
+	    call qpex_close (IO_EX(io))
+	if (IO_PL(io) != NULL && IO_PLCLOSE(io) == YES)
+	    call pl_close (IO_PL(io))
+	if (IO_FD(io) != NULL)
+	    call close (IO_FD(io))
+
+	if (IO_BP(io) != NULL)
+	    call mfree (IO_BP(io), TY_SHORT)
+	if (IO_RL(io) != NULL)
+	    call mfree (IO_RL(io), TY_INT)
+	if (IO_MINEVL(io) != NULL)
+	    call mfree (IO_MINEVL(io), TY_SHORT)
+	if (IO_MAXEVL(io) != NULL)
+	    call mfree (IO_MAXEVL(io), TY_SHORT)
+	if (IO_YLENVP(io) != NULL)
+	    call mfree (IO_YLENVP(io), TY_INT)
+	if (IO_YOFFVP(io) != NULL)
+	    call mfree (IO_YOFFVP(io), TY_INT)
+	if (IO_DD(io) != NULL)
+	    call mfree (IO_DD(io), TY_STRUCT)
+	if (IO_BBMASK(io) != NULL)
+	    call plr_close (IO_BBMASK(io))
+	if (IO_PARAM(io) != NULL)
+	    call mfree (IO_PARAM(io), TY_CHAR)
+	if (IO_MASK(io) != NULL)
+	    call mfree (IO_MASK(io), TY_CHAR)
+
+	call mfree (io, TY_STRUCT)
+end
diff --git a/sys/qpoe/qpiogetev.gx b/sys/qpoe/qpiogetev.gx
new file mode 100644
index 00000000..e6fbc612
--- /dev/null
+++ b/sys/qpoe/qpiogetev.gx
@@ -0,0 +1,467 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<pmset.h>
+include	"../qpio.h"
+
+define	RLI_NEXTLINE	9998
+define	RLI_INITIALIZE	9999
+define	SZ_CODE		7
+
+# QPIO_GETEVENTS -- Return a sequence of events sharing the same mask value
+# which satisfy the current event attribute filter.  The returned events will
+# be only those in a rectangular subregion of the image (specified by a prior
+# call to qpio_setrange) which are also visible through the current mask.
+# Sequences of events are returned in storage order until the region is
+# exhausted, at which time EOF is returned.
+#
+# NOTE - If debug statements (printfs) are placed in this code they will cause
+# i/o problems at runtime due to reentrancy, since this routine is called in
+# a low level FIO pseudodevice driver (QPF).  This is also true of any of the
+# routines called by this procedure, and of the related routine QPIO_READPIX.
+
+int procedure qpio_gvtevents (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int	status
+char	code[SZ_CODE]
+int	qpx_gvs(), qpx_gvi(), qpx_gvl(), qpx_gvr(), qpx_gvd()
+errchk	syserrs
+define	err_ 91
+
+begin
+	# The generic routines currently require that X,Y be the same type.
+	# It wouldn't be hard to remove this restriction if necessary, but
+	# it simplifies things and I doubt if a mixed types feature would
+	# be used very often.
+
+	if (IO_EVXTYPE(io) != IO_EVYTYPE(io))
+	    goto err_
+
+	# Get the events.
+	switch (IO_EVXTYPE(io)) {
+	case TY_SHORT:
+	    status = qpx_gvs (io, o_ev, maskval, maxev, o_nev)
+	case TY_INT:
+	    status = qpx_gvi (io, o_ev, maskval, maxev, o_nev)
+	case TY_LONG:
+	    status = qpx_gvl (io, o_ev, maskval, maxev, o_nev)
+	case TY_REAL:
+	    status = qpx_gvr (io, o_ev, maskval, maxev, o_nev)
+	case TY_DOUBLE:
+	    status = qpx_gvd (io, o_ev, maskval, maxev, o_nev)
+	default:
+err_	    call sprintf (code, SZ_CODE, "%d")
+		call pargi (IO_EVXTYPE(io))
+	    call syserrs (SYS_QPINVEVT, code)
+	}
+
+	return (status)
+end
+
+
+$for (silrd)
+
+# QPX_GV -- Internal generic code for qpio_getevents.  There is one copy
+# of this routine for each event coordinate datatype.  The optimization
+# strategy used here assumes that executing qpio_gv is much more expensive
+# than building the call in qpio_getevents.  This will normally be the case
+# for a large event list or a complex expression, otherwise the operation
+# is likely to be fast enough that it doesn't matter anyway.
+
+int procedure qpx_gv$t (io, o_ev, maskval, maxev, o_nev)
+
+pointer	io			#I QPIO descriptor
+pointer	o_ev[maxev]		#O receives the event struct pointers
+int	maskval			#O receives the mask value of the events
+int	maxev			#I max events out
+int	o_nev			#O same as function value (nev_out|EOF)
+
+int     x1, x2, y1, y2, xs, xe, ys, ye, x, y
+pointer pl, rl, rp, bp, ex, ev, ev_p, bbmask, bb_bufp
+bool    useindex, lineio, bbused, rmused, nodata
+int     bb_xsize, bb_ysize, bb_xblock, bb_yblock, ii, jj
+int     v[NDIM], szs_event, mval, nev, evidx, evtop, temp, i
+int     ev_xoff, ev_yoff
+
+pointer	plr_open()
+bool	pl_linenotempty(), pl_sectnotempty()
+int	qpio_rbucket(), qpex_evaluate(), btoi(), plr_getpix()
+
+define	swap {temp=$1;$1=$2;$2=temp}
+define	putevent_  91
+define	again_     92
+define	done_      93
+define	exit_      94
+
+begin
+	pl = IO_PL(io)		# pixel list (region mask) descriptor
+	rl = IO_RL(io)		# range list buffer
+	bp = IO_BP(io)		# bucket buffer (type short)
+	ex = IO_EX(io)		# QPEX (EAF) descriptor
+
+	# The following is executed when the first i/o is performed on a new
+	# region, to select the most efficient type of i/o to be performed,
+	# and initialize the i/o parameters for that case.  The type of i/o
+	# to be performed depends upon whether or not an index can be used,
+	# and whether or not there is a region mask (RM) or bounding box (BB).
+	# The presence or absence of an event attribute filter (EAF) is not
+	# separated out as a special case, as it is quick and easy to test
+	# for the presence of an EAF and apply one it if it exists.
+
+	if (IO_ACTIVE(io) == NO) {
+	    # Check for an index.  We have an index if the event list is
+	    # indexed, and the index is defined on the Y-coordinate we will
+	    # be using for extraction.
+
+	    useindex = (IO_INDEXLEN(io) == IO_NLINES(io) &&
+			IO_EVYOFF(io)   == IO_IXYOFF(io) &&
+			IO_NOINDEX(io)  == NO)
+
+	    # Initialize the V and VN vectors.
+	    do i = 1, NDIM {
+		IO_VN(io,i) = IO_VE(io,i) - IO_VS(io,i) + 1
+		if (IO_VN(io,i) < 0) {
+		    swap (IO_VS(io,i), IO_VE(io,i))
+		    IO_VN(io,i) = -IO_VN(io,i)
+		}
+	    }
+	    call amovi (IO_VS(io,1), IO_V(io,1), NDIM)
+
+	    # Determine if full lines are to be accessed, and if a bounding
+	    # box (subraster of the image) is defined.
+
+	    lineio = (IO_VS(io,1) == 1 && IO_VE(io,1) == IO_NCOLS(io))
+	    bbused = (!lineio || IO_VS(io,2) > 1 || IO_VE(io,2) < IO_NLINES(io))
+
+	    # Determine if region mask data is to be used and if there is any
+	    # data to be read.
+
+	    nodata = (IO_NEVENTS(io) <= 0)
+	    rmused = false
+
+	    if (pl != NULL)
+		if (pl_sectnotempty (pl, IO_VS(io,1), IO_VE(io,1), NDIM))
+		    rmused = true
+		else
+		    nodata = true
+
+	    # Select the optimal type of i/o to be used for extraction.
+	    if (nodata) {
+		IO_IOTYPE(io) = NoDATA_NoAREA
+		useindex = false
+		bbused = false
+
+	    } else if (bbused || rmused) {
+		if (useindex)
+		    IO_IOTYPE(io) = INDEX_RMorBB
+		else
+		    IO_IOTYPE(io) = NoINDEX_RMorBB
+
+	    } else {
+		# If we are reading the entire image (no bounding box) and
+		# we are not using a mask, then there is no point in using
+		# indexed i/o.
+
+		IO_IOTYPE(io) = NoINDEX_NoRMorBB
+		useindex = false
+	    }
+
+	    # Initialize the range list data if it will be used.
+	    if (useindex) {
+		# Dummy range specifying full line segment.
+		RLI_LEN(rl)   = RL_FIRST
+		RLI_AXLEN(rl) = IO_NCOLS(io)
+
+		rp = rl + ((RL_FIRST - 1) * RL_LENELEM)
+		Memi[rp+RL_XOFF] = IO_VS(io,1)
+		Memi[rp+RL_NOFF] = IO_VN(io,1)
+		Memi[rp+RL_VOFF] = 1
+
+		IO_RLI(io) = RLI_INITIALIZE
+	    }
+
+	    # Open the mask for random access if i/o is not indexed and
+	    # a region mask is used.
+
+	    bbmask = IO_BBMASK(io)
+	    if (bbmask != NULL)
+		call plr_close (bbmask)
+
+	    if (IO_IOTYPE(io) == NoINDEX_RMorBB && rmused) {
+		bbmask = plr_open (pl, v, 0)	# (v is never referenced)
+		call plr_setrect (bbmask, IO_VS(io,1),IO_VS(io,2),
+		    IO_VE(io,1),IO_VE(io,2))
+		call plr_getlut (bbmask,
+		    bb_bufp, bb_xsize, bb_ysize, bb_xblock, bb_yblock)
+	    }
+
+	    # Update the QPIO descriptor.
+	    IO_LINEIO(io)   = btoi(lineio)
+	    IO_RMUSED(io)   = btoi(rmused)
+	    IO_BBUSED(io)   = btoi(bbused)
+	    IO_BBMASK(io)   = bbmask
+
+	    IO_EVI(io)      = 1
+	    IO_BKNO(io)     = 0
+	    IO_BKLASTEV(io) = 0
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Initialize event extraction parameters.
+	szs_event = IO_EVENTLEN(io)
+	maskval = 0
+	nev = 0
+
+	ev_xoff = IO_EVXOFF(io)
+	ev_yoff = IO_EVYOFF(io)
+
+	# Extract events using the most efficient type of i/o for the given
+	# selection critera (index, mask, BB, EAF, etc.).
+again_
+	switch (IO_IOTYPE(io)) {
+	case NoDATA_NoAREA:
+	    # We know in advance that there are no events to be returned,
+	    # either because there is no data, or the area of the region
+	    # mask within the bounding box is empty.
+
+	    goto exit_
+
+	case NoINDEX_NoRMorBB:
+	    # This is the simplest case; no index, region mask, or bounding
+	    # box.  Read and output all events in sequence.
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Copy out the event pointers.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (maxev, IO_BKLASTEV(io) - IO_EVI(io) + 1)
+
+	    do i = 1, nev {
+		o_ev[i] = ev
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    maskval = 1
+
+	case NoINDEX_RMorBB:
+	    # Fully general selection, including any combination of bounding
+	    # box, region mask, or EAF, but no index, either because there is
+	    # no index for this event list, or the index is for a different Y
+	    # attribute than the one being used for extraction.
+
+	    bbused = (IO_BBUSED(io) == YES)
+	    x1 = IO_VS(io,1);  x2 = IO_VE(io,1)
+	    y1 = IO_VS(io,2);  y2 = IO_VE(io,2)
+
+	    # Refill the event bucket?
+	    while (IO_EVI(io) > IO_BKLASTEV(io)) {
+		# Get the next bucket.
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+		# Reject buckets that do not contain any events lying
+		# within the specified bounding box, if any.
+
+		if (bbused) {
+		    ev_p = (IO_MINEVB(io) - 1) * SZ_SHORT / SZ_PIXEL + 1
+		    $if (datatype == rd)
+			xs = Mem$t[ev_p+ev_xoff] + 0.5
+			ys = Mem$t[ev_p+ev_yoff] + 0.5
+		    $else
+			xs = Mem$t[ev_p+ev_xoff]
+			ys = Mem$t[ev_p+ev_yoff]
+		    $endif
+
+		    ev_p = (IO_MAXEVB(io) - 1) * SZ_SHORT / SZ_PIXEL + 1
+		    $if (datatype == rd)
+			xe = Mem$t[ev_p+ev_xoff] + 0.5
+			ye = Mem$t[ev_p+ev_yoff] + 0.5
+		    $else
+			xe = Mem$t[ev_p+ev_xoff]
+			ye = Mem$t[ev_p+ev_yoff]
+		    $endif
+
+		    if (xs > x2 || xe < x1 || ys > y2 || ye < y1)
+			IO_EVI(io) = IO_BKLASTEV(io) + 1
+		}
+	    }
+
+	    # Copy out any events which pass the region mask and which share
+	    # the same mask value.  Note that in this case, to speed mask
+	    # value lookup at random mask coordinates, the region mask for
+	    # the bounding box is stored as a populated array in the QPIO
+	    # descriptor.
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io) - 1) * szs_event
+	    bbmask = IO_BBMASK(io)
+	    mval = 0
+
+	    do i = IO_EVI(io), IO_BKLASTEV(io) {
+		# Get event x,y coordinates in whatever coord system.
+		ev = ev + szs_event
+		ev_p = (ev - 1) * SZ_SHORT / SZ_PIXEL + 1
+
+		$if (datatype == rd)
+		    x = Mem$t[ev_p+ev_xoff] + 0.5
+		    y = Mem$t[ev_p+ev_yoff] + 0.5
+		$else
+		    x = Mem$t[ev_p+ev_xoff]
+		    y = Mem$t[ev_p+ev_yoff]
+		$endif
+
+		# Reject events lying outside the bounding box.
+		if (bbused)
+		    if (x < x1 || x > x2 || y < y1 || y > y2)
+			next
+
+		# Take a shortcut if no region mask is in effect for this BB.
+		if (bbmask == NULL)
+		    goto putevent_
+
+		# Get the mask pixel associated with this event.
+		ii = (x - 1) / bb_xblock
+		jj = (y - 1) / bb_yblock
+		mval = Memi[bb_bufp + jj*bb_xsize + ii]
+		if (mval < 0)
+		    mval = plr_getpix (bbmask, x, y)
+
+		# Accumulate points lying in the first nonzero mask range
+		# encountered.
+
+		if (mval != 0) {
+		    if (maskval == 0)
+			maskval = mval
+		    if (mval == maskval) {
+putevent_		if (nev >= maxev)
+			    break
+			nev = nev + 1
+			o_ev[nev] = ev
+		    } else
+			break
+		}
+	    }
+
+	    IO_EVI(io) = i
+
+	case INDEX_NoRMorBB, INDEX_RMorBB:
+	    # General extraction for indexed data.  Process successive ranges
+	    # and range lists until we get at least one event which lies within
+	    # the bounding box, within a range, and which passes the event
+	    # attribute filter, if one is in use.
+
+	    # If the current range list (mask line) has been exhausted, advance
+	    # to the next line which contains both ranges and events.  A range
+	    # list is used to specify the bounding box even if we don't have
+	    # a nonempty region mask within the BB.
+
+	    if (IO_RLI(io) > RLI_LEN(rl)) {
+		repeat {
+		    y = IO_V(io,2)
+		    if (IO_RLI(io) == RLI_INITIALIZE)
+			IO_RLI(io) = RL_FIRST
+		    else
+			y = y + 1
+
+		    if (y > IO_VE(io,2)) {
+			if (nev <= 0) {
+			    o_nev = EOF
+			    return (EOF)
+			} else
+			    goto done_
+		    }
+
+		    IO_V(io,2) = y
+		    evidx = Memi[IO_YOFFVP(io)+y-1]
+
+		    if (evidx > 0) {
+			if (IO_RMUSED(io) == YES) {
+			    if (IO_LINEIO(io) == YES) {
+				if (!pl_linenotempty (pl,IO_V(io,1)))
+				    next
+			    } else {
+				v[1] = IO_VE(io,1);  v[2] = y
+				if (!pl_sectnotempty (pl,IO_V(io,1),v,NDIM))
+				    next
+			    }
+			    call pl_glri (pl, IO_V(io,1), Memi[rl],
+				IO_MDEPTH(io), IO_VN(io,1), PIX_SRC)
+			}
+			IO_RLI(io) = RL_FIRST
+		    }
+		} until (IO_RLI(io) <= RLI_LEN(rl))
+
+		IO_EVI(io) = evidx
+		IO_EV1(io) = evidx
+		IO_EV2(io) = Memi[IO_YLENVP(io)+y-1] + evidx - 1
+	    }
+
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    goto exit_
+
+	    # Compute current range parameters and initialize event pointer.
+	    rp = rl + (IO_RLI(io) - 1) * RL_LENELEM
+	    x1 = Memi[rp+RL_XOFF]
+	    x2 = x1 + Memi[rp+RL_NOFF] - 1
+	    maskval = Memi[rp+RL_VOFF]
+
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    evtop = min (IO_EV2(io), IO_BKLASTEV(io))
+
+	    # Extract events from bucket which lie within the current range
+	    # of the current line.  This is the inner loop of indexed event
+	    # extraction, ignoring event attribute filtering.
+
+	    do i = IO_EVI(io), evtop {
+		ev_p = (ev - 1) * SZ_SHORT / SZ_PIXEL + 1
+		$if (datatype == rd)
+		    x = Mem$t[ev_p+ev_xoff] + 0.5
+		$else
+		    x = Mem$t[ev_p+ev_xoff]
+		$endif
+		if (x >= x1) {
+		    if (x > x2) {
+			IO_RLI(io) = IO_RLI(io) + 1
+			break
+		    } else if (nev >= maxev)
+			break
+		    nev = nev + 1
+		    o_ev[nev] = ev
+		}
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = i
+	    if (i > IO_EV2(io))
+		IO_RLI(io) = RLI_NEXTLINE
+	}
+done_
+	# Apply the event attribute filter if one is defined; repeat
+	# the whole process if we don't end up with any events.
+
+	if (nev > 0)
+	    if (ex != NULL)
+		nev = qpex_evaluate (ex, o_ev, o_ev, nev)
+	if (nev <= 0)
+	    goto again_
+exit_
+	o_nev = nev
+	if (o_nev <= 0)
+	    o_nev = EOF
+
+	return (o_nev)
+end
+
+$endfor
diff --git a/sys/qpoe/qpiogetfil.x b/sys/qpoe/qpiogetfil.x
new file mode 100644
index 00000000..c653f6b5
--- /dev/null
+++ b/sys/qpoe/qpiogetfil.x
@@ -0,0 +1,123 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpoe.h"
+include	"qpio.h"
+
+# QPIO_GETFILTER -- Get the current filtering parameters governing event
+# extraction via QPIO.  These are the QPIO parameters (region mask, blocking
+# factor, coordinate system, etc.) plus the event attribute filter.  We leave
+# it up to QPEX to reconstruct the EAF to allow for any dynamic edits which
+# may have taken place, e.g., via qpio_setfilter.
+
+int procedure qpio_getfilter (io, outstr, maxch)
+
+pointer	io			#I QPIO descriptor
+char	outstr[maxch]		#O where to put the filter text
+int	maxch			#I max chars out
+
+pointer	sp, buf, bp
+int	op, dtype[2], offset[2], i
+int	sizeof(), gstrcpy(), qpex_getfilter()
+define	ovfl_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_TEXTBUF, TY_CHAR)
+
+	op = 1
+
+	# Report on QPIO parameters first.
+
+	# Parameter name.
+	call sprintf (Memc[buf], SZ_TEXTBUF, "param=%s,")
+	    call pargstr (Memc[IO_PARAM(io)])
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	if (op > maxch)
+	    goto ovfl_
+
+	# Coordinate system.
+	dtype[1] = IO_EVXTYPE(io);  dtype[2] = IO_EVYTYPE(io)
+	offset[1] = IO_EVXOFF(io);  offset[2] = IO_EVYOFF(io)
+
+	call sprintf (Memc[buf], SZ_TEXTBUF, "key=(%c%d,%c%d),")
+	do i = 1, 2 {
+	    switch (dtype[i]) {
+	    case TY_SHORT:
+		call pargi ('s')
+	    case TY_INT:
+		call pargi ('i')
+	    case TY_LONG:
+		call pargi ('l')
+	    case TY_REAL:
+		call pargi ('r')
+	    case TY_DOUBLE:
+		call pargi ('d')
+	    default:
+		call pargi ('?')
+	    }
+
+	    call pargi (offset[i] * sizeof(dtype[i]) * SZB_CHAR)
+	}
+
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	if (op > maxch)
+	    goto ovfl_
+
+	# Blocking factor for generating pixels.
+	call sprintf (Memc[buf], SZ_TEXTBUF, "block=%0.4gx%0.4g, ")
+	    call pargr (IO_XBLOCK(io))
+	    call pargr (IO_YBLOCK(io))
+	op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	if (op > maxch)
+	    goto ovfl_
+
+	# Region mask, if any.
+	if (Memc[IO_MASK(io)] != EOS) {
+	    call sprintf (Memc[buf], SZ_TEXTBUF, "mask=%s,")
+		call pargstr (Memc[IO_MASK(io)])
+	    op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	    if (op > maxch)
+		goto ovfl_
+	}
+
+	# Debug level, if debug messages enabled.
+	if (IO_DEBUG(io) > 0) {
+	    call sprintf (Memc[buf], SZ_TEXTBUF, "debug=%d,")
+		call pargi (IO_DEBUG(io))
+	    op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	    if (op > maxch)
+		goto ovfl_
+	}
+
+	# Noindex flag, if enabled.
+	if (IO_NOINDEX(io) > 0) {
+	    call sprintf (Memc[buf], SZ_TEXTBUF, "noindex=%b,")
+		call pargi (IO_NOINDEX(io))
+	    op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	    if (op > maxch)
+		goto ovfl_
+	}
+
+	# Event attribute filter.
+	if (IO_EX(io) != NULL) {
+	    bp = buf + gstrcpy ("filter=(", Memc[buf], SZ_TEXTBUF)
+	    bp = bp + qpex_getfilter (IO_EX(io), Memc[bp], SZ_TEXTBUF-8)
+	    Memc[bp] = ')';  bp = bp + 1
+	    Memc[bp] = EOS
+	    op = op + gstrcpy (Memc[buf], outstr[op], maxch-op+1)
+	    if (op > maxch)
+		goto ovfl_
+	} else if (op > 1) {
+	    # Clobber trailing comma.
+	    op = op - 1
+	    outstr[op] = EOS
+	}
+
+	call sfree (sp)
+	return (op - 1)
+ovfl_
+	call sfree (sp)
+	outstr[maxch+1] = EOS
+	return (maxch)
+end
diff --git a/sys/qpoe/qpiogetrg.x b/sys/qpoe/qpiogetrg.x
new file mode 100644
index 00000000..bc2b0272
--- /dev/null
+++ b/sys/qpoe/qpiogetrg.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpio.h"
+
+# QPIO_GETRANGE -- Get the current range in X and Y within which events will
+# be extracted by qpio_getevents.
+
+int procedure qpio_getrange (io, vs, ve, maxdim)
+
+pointer	io			#I QPIO descriptor
+int	vs[ARB]			#O start vector (lower left corner)
+int	ve[ARB]			#O end vector (upper right corner)
+int	maxdim			#I vector length (ndim=2 at present)
+
+begin
+	call amovi (IO_VS(io,1), vs, maxdim)
+	call amovi (IO_VE(io,1), ve, maxdim)
+	return (NDIM)
+end
diff --git a/sys/qpoe/qpiolmask.x b/sys/qpoe/qpiolmask.x
new file mode 100644
index 00000000..979de478
--- /dev/null
+++ b/sys/qpoe/qpiolmask.x
@@ -0,0 +1,119 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<plset.h>
+include "qpoe.h"
+include "qpio.h"
+
+# QPIO_LOADMASK -- Load the named region mask into the QPIO descriptor.
+# The mask name may be the name of a header parameter containing the mask
+# as the stored array value (TY_OPAQUE parameter), the name of a header
+# parameter containing the name of the mask (TY_CHAR), or the name of a
+# mask storage file (.pl extension).
+
+procedure qpio_loadmask (io, mask, merge)
+
+pointer	io			#I QPIO descriptor
+char	mask[ARB]		#I mask to be loaded
+int	merge			#I merge with old mask?
+
+int	niter
+int	naxes, axlen[PL_MAXDIM], v[PL_MAXDIM]
+pointer	sp, title, mp, sym, plbuf, qp, o_pl, n_pl, b_pl
+
+pointer	pl_open(), qp_gpsym()
+int	strmatch(), qp_accessf(), qp_read(), qp_gstr()
+errchk	pl_open, pl_close, pl_loadf, qp_read, syserrs, qp_gstr, malloc
+define	tryfile_ 91
+
+begin
+	call smark (sp)
+	call salloc (title, SZ_FNAME, TY_CHAR)
+	call salloc (mp, SZ_FNAME, TY_CHAR)
+
+	if (IO_DEBUG(io) > 0) {
+	    call eprintf ("load mask `%s'\n")
+		call pargstr (mask)
+	}
+
+	qp = IO_QP(io)
+	o_pl = IO_PL(io)
+	call strcpy (mask, Memc[mp], SZ_FNAME)
+
+	# Open new mask.
+	for (niter=0;  Memc[mp] != EOS;  niter=niter+1) {
+	    if (strmatch (Memc[mp], ".pl$") > 0) {
+		# Mask is stored in a file.
+tryfile_
+		n_pl = pl_open (NULL)
+		call pl_loadf (n_pl, Memc[mp], Memc[title], SZ_FNAME)
+
+	    } else if (qp_accessf (qp, Memc[mp]) == YES) {
+		# Named parameter contains or points to mask.
+
+		sym = qp_gpsym (qp, Memc[mp])
+		if (S_DTYPE(sym) == TY_OPAQUE) {
+		    # Parameter value is stored mask.
+		    call salloc (plbuf, S_NELEM(sym) / SZ_SHORT, TY_SHORT)
+		    if (qp_read (qp, Memc[mp], Mems[plbuf], S_NELEM(sym), 1,
+			"opaque") < S_NELEM(sym)) {
+			call syserrs (SYS_QPBADVAL, Memc[mp])
+		    } else {
+			n_pl = pl_open (plbuf)	# no deref
+		    }
+
+		} else if (S_DTYPE(sym) == TY_CHAR) {
+		    # Parameter value is pointer to mask.
+		    if (qp_gstr (qp, Memc[mp], Memc[mp], SZ_FNAME) > 0) {
+			if (niter < MAX_INDIR)
+			    next
+			else
+			    call syserrs (SYS_QPMRECUR, Memc[mp])
+		    }
+		} else
+		    goto tryfile_
+	    } else
+		goto tryfile_
+
+	    break
+	}
+
+	# Check that mask and image are the same size, and get mask depth.
+	call pl_gsize (n_pl, naxes, axlen, IO_MDEPTH(io))
+	if (axlen[1] != IO_NCOLS(io) || axlen[2] != IO_NLINES(io))
+	    call syserrs (SYS_QPPLSIZE, Memc[mp])
+
+	# Merge the old and new mask if so indicated.  The result mask is the
+	# same as the new mask, but only those pixels also present (nonzero)
+	# in the old mask are preserved.
+
+	if (merge == YES && o_pl != NULL) {
+	    b_pl = pl_open (NULL)
+	    call amovkl (1, v, PL_MAXDIM)
+	    call pl_ssize (b_pl, naxes, axlen, 1)
+	    call pl_rop (o_pl, v, b_pl, v, axlen, PIX_SRC)
+	    call pl_rop (b_pl, v, n_pl, v, axlen, and(PIX_SRC,PIX_DST))
+	    call pl_close (b_pl)
+	}
+
+	# Close old mask, if any.
+	if (IO_PL(io) != NULL && IO_PLCLOSE(io) == YES)
+	    call pl_close (IO_PL(io))
+
+	# Install new mask.
+	IO_PL(io) = n_pl
+	IO_PLCLOSE(io) = YES
+	call strcpy (Memc[mp], Memc[IO_MASK(io)], SZ_FNAME)
+
+	# Allocate a range list buffer if i/o is indexed.
+	if (IO_INDEXLEN(io) > 0) {
+	    if (IO_RL(io) != NULL)
+		call mfree (IO_RL(io), TY_INT)
+	    if (IO_PL(io) != NULL)
+		call malloc (IO_RL(io), RL_MAXLEN(IO_PL(io)), TY_INT)
+	    else
+		call malloc (IO_RL(io), RL_LENELEM*2, TY_INT)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpiolwcs.x b/sys/qpoe/qpiolwcs.x
new file mode 100644
index 00000000..76c1650f
--- /dev/null
+++ b/sys/qpoe/qpiolwcs.x
@@ -0,0 +1,50 @@
+include	"qpio.h"
+
+# QPIO_LOADWCS -- Load the WCS, if any, from the QPOE file associated with the
+# given QPIO descriptor, into an open MWCS descriptor.  This is equivalent to
+# QP_LOADWCS except that the Lterm is updated to reflect the current blocking
+# factor and rect (if any) used for rasterization.  In the resultant WCS, the
+# logical coordinate system gives the pixel coordinates of the sampled rect.
+
+pointer	procedure qpio_loadwcs (io)
+
+pointer	io				#I QPIO descriptor
+
+pointer	qp, mw
+int	ndim, i, j
+double	ltv_1[NDIM], ltv_2[NDIM], ltm[NDIM,NDIM]
+pointer	qp_loadwcs()
+errchk	qp_loadwcs
+
+begin
+	qp = IO_QP(io)
+	mw = qp_loadwcs (qp)
+	ndim = NDIM
+
+	# Formalize the transformation.
+	ltv_1[1] = IO_VSDEF(io,1) - 1
+	ltv_1[2] = IO_VSDEF(io,2) - 1
+
+	# L(i) :==  LTM=(1 / block) * P(i)  +  Vx
+	# At pixel {P(i) :==  (block + 1) / 2}  L(i) is 1.0.
+	# Solve for Vx :==  1.0 - (1 / block) * ((block + 1) / 2)
+	#	       -->  0.5 - 1 / (2 * block)
+
+	ltv_2[1] = 0.5d0 - 1.0d0 / double (max (1.0, IO_XBLOCK(io))) / 2.0d0
+	ltv_2[2] = 0.5d0 - 1.0d0 / double (max (1.0, IO_YBLOCK(io))) / 2.0d0
+
+	do j = 1, ndim
+	    do i = 1, ndim
+		if (i == j) {
+		    if (i == 1)
+			ltm[i,j] = 1.0D0 / max (1.0, IO_XBLOCK(io))
+		    else
+			ltm[i,j] = 1.0D0 / max (1.0, IO_YBLOCK(io))
+		} else
+		    ltm[i,j] = 0
+
+	# Apply the transformation.
+	call mw_translated (mw, ltv_1, ltm, ltv_2, ndim)
+
+	return (mw)
+end
diff --git a/sys/qpoe/qpiomkidx.x b/sys/qpoe/qpiomkidx.x
new file mode 100644
index 00000000..979b1142
--- /dev/null
+++ b/sys/qpoe/qpiomkidx.x
@@ -0,0 +1,299 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	<fset.h>
+include	"qpoe.h"
+include	"qpio.h"
+
+define	SZ_CODE		7
+
+
+# QPIO_MKINDEX -- Make an index for the event list associated with the QPIO
+# descriptor.  The event list must have been already written out, in sorted
+# order according to the given key.  Once an event list is indexed it cannot
+# be further extended or otherwise modified.  The key fields are specified
+# as, e.g., "s10,s8" or "(s10,s8)" (Y // X), where the field name is the
+# datatype code (silrd for short, int, long, real, or double) followed by the
+# decimal byte offset of the field in the event struct.
+
+procedure qpio_mkindex (io, key)
+
+pointer	io			#I QPIO descriptor
+char	key[ARB]		#I list of key fields
+
+pointer	sp, tokbuf, ip, in, ev, ev_p, ov, lv, oo, bp
+int	ox, line, nevents, szs_event, ncols, nlines, nout, x, y, i, ch
+int	token, offset, xoff, yoff, len_index, nev, fd, sv_evi, firstev
+int	dtype, ntype
+
+long	note()
+pointer	qp_opentext()
+int	qp_gettok(), ctoi(), qpio_rbucket(), pl_p2li(), sizeof()
+errchk	qp_opentext, qpio_rbucket, qpio_sync, write, calloc, syserrs
+define	nosort_ 91
+
+begin
+	call smark (sp)
+	call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
+	call malloc (oo, IO_NLINES(io) * 3 + 32, TY_SHORT)
+
+	ncols  = IO_NCOLS(io)
+	nlines = IO_NLINES(io)
+	sv_evi = IO_EVI(io)
+
+	# Key defaults to sort x/y.
+	xoff = IO_EVXOFF(io)
+	yoff = IO_EVYOFF(io)
+	dtype = IO_EVXTYPE(io)
+
+	# Parse key list (macro references are permitted) to get offsets of
+	# the X and Y coordinate fields to be used as the index key.
+
+	in = qp_opentext (IO_QP(io), key)
+
+	do i = 1, 2 {
+	    # Get next field token.
+	    repeat {
+		token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+	    } until (token == EOF || token == TOK_IDENTIFIER)
+	    if (token == EOF)
+		break
+
+	    # Determine field type.
+	    call strlwr (Memc[tokbuf])
+	    ch = Memc[tokbuf]
+
+	    switch (ch) {
+	    case 's':
+		ntype = TY_SHORT
+	    case 'i':
+		ntype = TY_INT
+	    case 'l':
+		ntype = TY_LONG
+	    case 'r':
+		ntype = TY_REAL
+	    case 'd':
+		ntype = TY_DOUBLE
+	    default:
+		call syserrs (SYS_QPXYFNS, key)
+	    }
+
+	    # Both X and Y must be the same type.
+	    if (i == 1)
+		dtype = ntype
+	    else if (ntype != dtype)
+		call syserrs (SYS_QPINVEVT, key)
+
+	    ip = tokbuf + 1
+	    if (ctoi (Memc, ip, offset) <= 0)
+		call syserrs (SYS_QPBADKEY, key)
+	    else
+		offset = offset / (sizeof(dtype) * SZB_CHAR)
+
+	    if (i == 1)
+		yoff = offset
+	    else
+		xoff = offset
+
+	    while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
+		if (Memc[tokbuf] == ',')
+		    break
+	}
+
+	call qp_closetext (in)
+
+	# Sync the event list to ensure that the bucket is flushed.
+	call qpio_sync (io)
+
+	fd = IO_FD(io)
+	bp = IO_BP(io)
+	len_index = nlines
+	szs_event = IO_EVENTLEN(io)
+
+	if (IO_DEBUG(io) > 1) {
+	    call eprintf ("qpio_mkindex (%xX, `%s')\n")
+		call pargi (io)
+		call pargstr (key)
+	    call eprintf ("nevents=%d, evsize=%d, xkey=%c%d, ykey=%c%d\n")
+		call pargi (IO_NEVENTS(io))
+		call pargi (szs_event)
+		call pargi (ch)
+		call pargi (xoff)
+		call pargi (ch)
+		call pargi (yoff)
+	}
+
+	# Allocate the offset and length vectors (comprising the index).
+	# These are deallocated at qpio_close time.
+
+	call calloc (ov, len_index, TY_INT)
+	call calloc (lv, len_index, TY_INT)
+
+	ox = -1
+	line = 1
+	firstev = 1
+	nevents = 0
+
+	# Rewind the list.
+	i = qpio_rbucket (io, 1)
+
+	# For each event in the event list...
+	for (IO_EVI(io)=1;  IO_EVI(io) <= IO_NEVENTS(io);  ) {
+	    # Refill the event bucket?
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		if (qpio_rbucket (io, IO_EVI(io)) == EOF)
+		    break
+
+	    # Process all events in the bucket.
+	    ev = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    nev = min (IO_NEVENTS(io), IO_BKLASTEV(io)) - IO_EVI(io) + 1
+	    nout = 0
+
+	    do i = 1, nev {
+		ev_p = (ev - 1) * SZ_SHORT / sizeof(dtype) + 1
+
+		switch (dtype) {
+		case TY_SHORT:
+		    x = Mems[ev_p+xoff]
+		    y = Mems[ev_p+yoff]
+		case TY_INT:
+		    x = Memi[ev_p+xoff]
+		    y = Memi[ev_p+yoff]
+		case TY_LONG:
+		    x = Meml[ev_p+xoff]
+		    y = Meml[ev_p+yoff]
+		case TY_REAL:
+		    x = Memr[ev_p+xoff] + 0.5
+		    y = Memr[ev_p+yoff] + 0.5
+		case TY_DOUBLE:
+		    x = Memd[ev_p+xoff] + 0.5
+		    y = Memd[ev_p+yoff] + 0.5
+		}
+
+		x = max(1, min(ncols,  x))
+		y = max(1, min(nlines, y))
+
+		if (IO_DEBUG(io) > 4) {
+		    # Egads!  Dump every photon.
+		    call eprintf ("(%04d,%04d) ")
+			call pargi (x)
+			call pargi (y)
+		    nout = nout + 1
+		    if (nout >= 6) {
+			call eprintf ("\n")
+			nout = 0
+		    }
+		}
+
+		if (y > line) {
+		    # Add index entry.
+		    if (nevents > 0) {
+			Memi[ov+line-1] = firstev
+			Memi[lv+line-1] = nevents
+
+			if (IO_DEBUG(io) > 3 && nevents > 0) {
+			    if (nout > 0) {
+				call eprintf ("\n")
+				nout = 0
+			    }
+			    call eprintf ("%4d: ev=%d, nev=%d\n")
+				call pargi (line)
+				call pargi (firstev)
+				call pargi (nevents)
+			}
+		    }
+
+		    # Set up the new line.
+		    firstev = IO_EVI(io) + i - 1
+		    nevents = 1
+		    line = y
+		    ox = x
+
+		} else if (y == line) {
+		    # Add another event to the current line.
+		    nevents = nevents + 1
+		    if (x < ox)
+			goto nosort_
+		    else
+			ox = x
+		} else
+		    goto nosort_
+
+		ev = ev + szs_event
+	    }
+
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    if (nout > 0) {
+		call eprintf ("\n")
+		nout = 0
+	    }
+	}
+
+	# Output final index entry.
+	if (nevents > 0) {
+	    Memi[ov+line-1] = firstev
+	    Memi[lv+line-1] = nevents
+	}
+
+	# Apply data compression to the index arrays and append to the event
+	# list lfile.
+
+	call fseti (fd, F_BUFSIZE, len_index * SZ_INT)
+	call seek (fd, EOF)
+
+	IO_YOFFVOFF(io) = note (fd)
+	IO_YOFFVLEN(io) = pl_p2li (Memi[ov], 1, Mems[oo], len_index)
+	call write (fd, Mems[oo], IO_YOFFVLEN(io) * SZ_SHORT)
+
+	IO_YLENVOFF(io) = note (fd)
+	IO_YLENVLEN(io) = pl_p2li (Memi[lv], 1, Mems[oo], len_index)
+	call write (fd, Mems[oo], IO_YLENVLEN(io) * SZ_SHORT)
+
+	call flush (fd)
+	call fseti (fd, F_BUFSIZE, 0)
+
+	# Update the remaining index related fields of the QPIO descriptor.
+	IO_INDEXLEN(io) = len_index
+	IO_YOFFVP(io) = ov
+	IO_YLENVP(io) = lv
+
+	IO_IXXOFF(io) = xoff
+	IO_IXYOFF(io) = yoff
+	IO_IXXTYPE(io) = dtype
+	IO_IXYTYPE(io) = dtype
+
+	if (IO_DEBUG(io) > 1) {
+	    call eprintf ("index.offv %d words at offset %d\n")
+		call pargi (IO_YOFFVLEN(io))
+		call pargi (IO_YOFFVOFF(io))
+	    call eprintf ("index.lenv %d words at offset %d\n")
+		call pargi (IO_YLENVLEN(io))
+		call pargi (IO_YLENVOFF(io))
+	}
+
+	# Update the event list header.
+	call qpio_sync (io)
+
+	IO_EVI(io) = sv_evi
+	call sfree (sp)
+	return
+
+nosort_
+	# A nonsorted event list has been detected, hence we cannot build
+	# an index, but we need not abort since nonindexed event lists are
+	# still usable.
+
+	if (nout > 0)
+	    call eprintf ("\n")
+	iferr (call syserrs (SYS_QPEVNSORT, Memc[IO_PARAM(io)]))
+	    call erract (EA_WARN)
+
+	IO_INDEXLEN(io) = 0
+	call mfree (ov, TY_INT)
+	call mfree (lv, TY_INT)
+
+	IO_EVI(io) = sv_evi
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpioopen.x b/sys/qpoe/qpioopen.x
new file mode 100644
index 00000000..4ed8a711
--- /dev/null
+++ b/sys/qpoe/qpioopen.x
@@ -0,0 +1,392 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	<fset.h>
+include	<plset.h>
+include	"qpoe.h"
+include	"qpex.h"
+include	"qpio.h"
+
+# QPIO_OPEN -- Open the named event list parameter for event i/o.  Since event
+# lists can only be read and written sequentially, there are only two useful
+# i/o modes, namely, READ_ONLY and NEW_FILE.  Filtering is permitted only
+# when reading an event list; when writing to a new event list, the events
+# are merely copied out as they are received.
+
+pointer procedure qpio_open (qp, paramex, mode)
+
+pointer	qp			#I QPOE descriptor
+char	paramex[ARB]		#I event-list parameter plus expression list
+int	mode			#I access mode
+
+bool	newlist
+pointer	sp, io, dd, eh, op, oo, flist, deffilt, defmask, maskname
+pointer	param, expr, filter, filter_text, mask, umask, psym, dsym, name
+int	sz_filter, szb_page, nwords, nchars, junk, fd, ip, i, j
+
+pointer	qp_gpsym(), qpex_open(), stname(), strefstab()
+int	qp_popen(), qp_lenf(), read(), pl_l2pi(), fstati()
+int	qp_geti(), qp_gstr(), qp_parsefl(), qpio_parse(), qpex_modfilter()
+
+errchk	qp_bind, qp_geti, qpio_parse, qp_gpsym, qp_addf, qp_gstr
+errchk	qp_parsefl, qp_popen, qpex_open, qpio_loadmask, qpex_modfilter
+errchk	stname, calloc, malloc, realloc, read, syserrs
+string	s_deffilt DEF_FILTER
+string	s_defmask DEF_MASK
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (deffilt, SZ_FNAME, TY_CHAR)
+	call salloc (defmask, SZ_FNAME, TY_CHAR)
+	call salloc (maskname, SZ_FNAME, TY_CHAR)
+	call salloc (umask, SZ_FNAME, TY_CHAR)
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	newlist = (mode == NEW_FILE || mode == APPEND)
+
+	if (QP_DEBUG(qp) > 0) {
+	    call eprintf ("qpio_open (%xX, `%s', %d)\n")
+		call pargi (qp)
+		call pargstr (paramex)
+		call pargi (mode)
+	}
+
+	# Allocate and initialize the QPIO descriptor.
+	call calloc (io, LEN_IODES, TY_STRUCT)
+
+	call calloc (IO_DD(io), LEN_DDDES, TY_STRUCT)
+	call calloc (IO_PARAM(io), SZ_FNAME, TY_CHAR)
+	call calloc (IO_MASK(io), SZ_FNAME, TY_CHAR)
+
+	IO_QP(io) = qp
+	IO_MODE(io) = mode
+	IO_DEBUG(io) = QP_DEBUG(qp)
+	IO_XBLOCK(io) = QP_XBLOCK(qp)
+	IO_YBLOCK(io) = QP_YBLOCK(qp)
+	IO_NODEFFILT(io) = QP_NODEFFILT(qp)
+	IO_NODEFMASK(io) = QP_NODEFMASK(qp)
+	IO_OPTBUFSIZE(io) = QP_OPTBUFSIZE(qp)
+	IO_ACTIVE(io) = NO
+
+	dd 	= IO_DD(io)
+	param 	= IO_PARAM(io)
+	mask 	= IO_MASK(io)
+	filter 	= NULL
+
+iferr {
+	# Get the image dimensions.
+	IO_NCOLS(io)	= qp_geti (qp, "axlen[1]")
+	IO_NLINES(io)	= qp_geti (qp, "axlen[2]")
+
+	# Parse the parameter expression into the parameter name and
+	# expression qualifier fields.  Possible variations on the input
+	# syntax are "" (null string, default everything), "param" (parameter
+	# name only), "param[expr]" (parameter name plus expression), and
+	# "[expr]" or "expr" (expression only), where the parameter name may
+	# be specified as in "[param=value,...]", i.e., as a term in the
+	# expression (allowing it to be input by the user to override the
+	# default).
+
+	op = param
+	for (ip=1;  paramex[ip] != EOS && paramex[ip] != '[';  ip=ip+1) {
+	    Memc[op] = paramex[ip]
+	    op = op + 1
+	}
+	expr = ip
+
+	# Parse the expression qualifier field to set the i/o parameters,
+	# e.g., region mask, event attribute filter, blocking factor,
+	# coordinate system, etc.  All QPIO parameters are removed, returning
+	# the filter expression (if any) to be passed on to QPEX for event
+	# attribute filtering.  The `filter' buffer is passed by pointer so
+	# that it may be reallocated if more space is needed.
+
+	sz_filter = DEF_SZEXPRBUF
+	call malloc (filter, sz_filter, TY_CHAR)
+	if (qpio_parse (io, paramex[expr],
+	    filter, sz_filter, Memc[mask], SZ_FNAME) == ERR)
+	    call eprintf ("QPIO warning: error parsing options expression\n")
+
+	# If no event list parameter was named, use the default.
+	if (Memc[param] == EOS)
+	    call strcpy (DEF_EVENTPARAM, Memc[param], SZ_FNAME)
+
+	# Verify the parameter's type if it already exists, or create a new
+	# parameter of the default type if the mode is newfile or append.
+
+	psym = qp_gpsym (qp, Memc[param])
+	if (psym != NULL) {
+	    if (S_DTYPE(psym) != TY_USER || S_DSYM(psym) == NULL)
+		call syserrs (SYS_QPNEVPAR, Memc[param])
+	    else if (newlist && S_NELEM(psym) > 0)
+		call syserrs (SYS_QPCLOBBER, Memc[param])
+	} else if (mode == READ_ONLY) {
+	    call syserrs (SYS_QPUKNPAR, Memc[param])
+	} else {
+	    call qp_addf (qp, Memc[param], DEF_EVENTTYPE, 0, "", 0)
+	    psym = qp_gpsym (qp, Memc[param])
+	}
+
+	# Get the field list for the user defined event structure.  This
+	# defines the size of an event struct, lists the offset and type
+	# of each field, and indicates which fields are to be used for X
+	# and Y in positional accesses (unless already set in the paramex).
+
+	dsym = strefstab (QP_ST(qp), S_DSYM(psym))
+	nchars = S_NELEM(dsym)
+	name = stname (QP_ST(qp), dsym)
+
+	call salloc (flist, nchars, TY_CHAR)
+	if (qp_gstr (qp, Memc[name], Memc[flist], nchars) < nchars)
+	    call syserrs (SYS_QPBADVAL, Memc[name])
+
+	if (qp_parsefl (qp, Memc[flist], IO_DD(io)) <= 0)
+	    call syserrs (SYS_QPINVDD, Memc[name])
+	else if (IO_EVXOFF(io) == NULL && IO_EVYOFF(io) == NULL) {
+	    i = DD_XFIELD(dd)
+	    j = DD_YFIELD(dd)
+	    if (i == 0 || j == 0)
+		call syserrs (SYS_QPNOXYF, Memc[name])
+
+	    switch (DD_FTYPE(dd,i)) {
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		IO_EVXTYPE(io) = DD_FTYPE(dd,i)
+	    default:
+		call syserrs (SYS_QPXYFNS, Memc[name])
+	    }
+
+	    switch (DD_FTYPE(dd,j)) {
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		IO_EVYTYPE(io) = DD_FTYPE(dd,j)
+	    default:
+		call syserrs (SYS_QPXYFNS, Memc[name])
+	    }
+
+	    IO_EVXOFF(io) = DD_FOFFSET(dd,i)
+	    IO_EVYOFF(io) = DD_FOFFSET(dd,j)
+	}
+
+	IO_EVENTLEN(io) = DD_STRUCTLEN(dd) * SZ_STRUCT / SZ_SHORT
+
+	# Open the lfile used to store the event list.
+	IO_FD(io) = qp_popen (qp, Memc[param], mode, BINARY_FILE)
+	IO_LF(io) = S_LFILE(psym)
+	IO_CHAN(io) = fstati (IO_FD(io), F_CHANNEL)
+	IO_PSYM(io) = psym
+
+	# The rest of the initialization is performed in the first call to
+	# qpio_putev if we are writing a new event list.
+
+	if (newlist) 			# EXIT if new event list
+	    goto done_			# -----------------------
+
+	fd = IO_FD(io)
+	szb_page = QP_FMPAGESIZE(qp)
+	nchars = szb_page / SZB_CHAR
+	call salloc (eh, szb_page / (SZ_STRUCT*SZB_CHAR), TY_STRUCT)
+	call aclri (Memi[eh], szb_page / (SZ_STRUCT*SZB_CHAR))
+
+	# Read event list header.
+	if (read (fd, Memi[eh], nchars) < nchars)
+	    call syserrs (SYS_QPNOEH, Memc[param])
+
+	IO_NEVENTS(io)	= EH_NEVENTS(eh)
+	IO_EVENTLEN(io)	= EH_EVENTLEN(eh)
+	IO_SZBBUCKET(io)= EH_SZBBUCKET(eh)
+	IO_BUCKETLEN(io)= EH_BUCKETLEN(eh)
+	IO_FBOFF(io)	= EH_FBOFF(eh)
+	IO_EVMINOFF(io)	= EH_EVMINOFF(eh)
+	IO_EVMAXOFF(io)	= EH_EVMAXOFF(eh)
+	IO_INDEXLEN(io)	= EH_INDEXLEN(eh)
+	IO_YOFFVOFF(io) = EH_YOFFVOFF(eh)
+	IO_YOFFVLEN(io) = EH_YOFFVLEN(eh)
+	IO_YLENVOFF(io) = EH_YLENVOFF(eh)
+	IO_YLENVLEN(io) = EH_YLENVLEN(eh)
+	IO_IXXOFF(io)	= EH_IXXOFF(eh)
+	IO_IXYOFF(io)	= EH_IXYOFF(eh)
+	IO_IXXTYPE(io)	= EH_IXXTYPE(eh)
+	IO_IXYTYPE(io)	= EH_IXYTYPE(eh)
+
+	# Copy the MINEVL event struct into the QPIO descriptor.
+	nwords = IO_EVENTLEN(io)
+	call malloc (IO_MINEVL(io), nwords, TY_SHORT)
+	call amovs (Memi[eh+EH_MINEVLOFF(eh)], Mems[IO_MINEVL(io)],
+	    IO_EVENTLEN(io))
+
+	# Copy the MAXEVL event struct into the QPIO descriptor.
+	call malloc (IO_MAXEVL(io), nwords, TY_SHORT)
+	call amovs (Memi[eh+EH_MAXEVLOFF(eh)], Mems[IO_MAXEVL(io)],
+	    IO_EVENTLEN(io))
+
+	if (IO_DEBUG(io) > 0) {
+	    call eprintf ("%s: nev=%d, szbk=%d, bklen=%d+2, ixlen=%d\n")
+		call pargstr (Memc[param])
+		call pargi (IO_NEVENTS(io))
+		call pargi (IO_SZBBUCKET(io))
+		call pargi (IO_BUCKETLEN(io))
+		call pargi (IO_INDEXLEN(io))
+	}
+
+	# Get compressed event list index, if any.
+	if (IO_INDEXLEN(io) > 0) {
+	    call salloc (oo, IO_INDEXLEN(io) * 2, TY_SHORT)
+	    call malloc (IO_YOFFVP(io), IO_INDEXLEN(io), TY_INT)
+	    call malloc (IO_YLENVP(io), IO_INDEXLEN(io), TY_INT)
+
+	    nchars = IO_YOFFVLEN(io) * SZ_SHORT
+	    call seek (fd, IO_YOFFVOFF(io))
+	    if (read (fd, Mems[oo], nchars) < nchars)
+		call syserrs (SYS_QPBADIX, Memc[param])
+	    junk = pl_l2pi (Mems[oo], 1, Memi[IO_YOFFVP(io)], IO_INDEXLEN(io))
+
+	    nchars = IO_YLENVLEN(io) * SZ_SHORT
+	    call seek (fd, IO_YLENVOFF(io))
+	    if (read (fd, Mems[oo], nchars) < nchars)
+		call syserrs (SYS_QPBADIX, Memc[param])
+	    junk = pl_l2pi (Mems[oo], 1, Memi[IO_YLENVP(io)], IO_INDEXLEN(io))
+	}
+
+	# We won't need the file buffer any more, so free it.
+	call fseti (fd, F_BUFSIZE, 0)
+
+	# Compile the event attribute filter (EAF).  Always open the default
+	# filter if one is provided with the datafile.  If the user has also
+	# specified a filter, this will modify the default filter.
+
+	if (IO_NODEFFILT(io) != YES) {
+	    # Check for "deffilt.<evl>" first, then "deffilt".
+	    call sprintf (Memc[deffilt], SZ_FNAME, "%s.%s")
+		call pargstr (s_deffilt)
+		call pargstr (Memc[param])
+	    nchars = qp_lenf (qp, Memc[deffilt])
+	    if (nchars <= 0) {
+		call strcpy (s_deffilt, Memc[deffilt], SZ_FNAME)
+		nchars = qp_lenf (qp, Memc[deffilt])
+	    }
+
+	    # Open the default filter if one was found.
+	    if (nchars > 0) {
+		call salloc (filter_text, nchars, TY_CHAR)
+		if (qp_gstr(qp,Memc[deffilt],Memc[filter_text],nchars) < nchars)
+		    call syserrs (SYS_QPBADVAL, Memc[deffilt])
+		IO_EX(io) = qpex_open (qp, Memc[filter_text])
+		IO_EXCLOSE(io) = YES
+	    }
+	}
+
+	# Fold in the user specified filter if one was given.
+	if (Memc[filter] != EOS) {
+	    if (IO_EX(io) != NULL) {
+		if (qpex_modfilter (IO_EX(io), Memc[filter]) == ERR)
+		    call fprintf (STDERR,
+			"Warning: error compiling QPIO filter\n")
+	    } else {
+		IO_EX(io) = qpex_open (qp, Memc[filter])
+		IO_EXCLOSE(io) = YES
+	    }
+
+	    if (IO_DEBUG(io) > 0) {
+		call eprintf ("event attribute filter: %s\n")
+		    call pargstr (Memc[filter])
+	    }
+	}
+
+	# Open the region mask.  This may be specified (named) in the parameter
+	# expression, else we try to open a default mask.  If a mask is named,
+	# the name may be the name of a header parameter containing the mask
+	# as the stored array value (TY_OPAQUE parameter), the name of a header
+	# parameter containing the name of the mask (TY_CHAR), or the name of
+	# a mask storage file (.pl extension).
+
+	# Make a copy of the user mask name, as qpio_loadmask will clobber it.
+	call strcpy (Memc[mask], Memc[umask], SZ_FNAME)
+
+	if (IO_NODEFMASK(io) != YES) {
+	    # Check for "defmask.<evl>" first, then "defmask".
+	    call sprintf (Memc[defmask], SZ_FNAME, "%s.%s")
+		call pargstr (s_defmask)
+		call pargstr (Memc[param])
+	    nchars = qp_lenf (qp, Memc[defmask])
+	    if (nchars <= 0) {
+		call strcpy (s_defmask, Memc[defmask], SZ_FNAME)
+		nchars = qp_lenf (qp, Memc[defmask])
+	    }
+
+	    if (nchars > 0)
+		if (qp_gstr (qp, Memc[defmask], Memc[maskname], SZ_FNAME) > 0)
+		    call qpio_loadmask (io, Memc[maskname], NO)
+	}
+
+	# Load user specified mask.
+	if (Memc[umask] != EOS)
+	    call qpio_loadmask (io, Memc[umask], YES)
+	else if (IO_INDEXLEN(io) > 0)
+	    call malloc (IO_RL(io), RL_LENELEM*2, TY_INT)
+
+	# Allocate the bucket buffer.
+	call malloc (IO_BP(io), IO_SZBBUCKET(io)/SZB_CHAR/SZ_SHORT, TY_SHORT)
+done_
+	# If no default rect was specified, set default bounding box for
+	# reading to be the entire image.
+
+	if (IO_BBUSED(io) == NO) {
+	    IO_VSDEF(io,1) = 1;			IO_VSDEF(io,2) = 1
+	    IO_VEDEF(io,1) = IO_NCOLS(io);	IO_VEDEF(io,2) = IO_NLINES(io)
+	}
+
+	# Initialize the active BB to the default.
+	call amovi (IO_VSDEF(io,1), IO_VS(io,1), NDIM)
+	call amovi (IO_VEDEF(io,1), IO_VE(io,1), NDIM)
+
+} then {
+	# We branch here if any nasty errors occur above.  Cleanup and free
+	# the partially opened descriptor and pass the error on to whoever
+	# called us.
+
+	if (IO_BP(io) != NULL)
+	    call mfree (IO_BP(io), TY_SHORT)
+	if (IO_RL(io) != NULL)
+	    call mfree (IO_RL(io), TY_INT)
+	if (IO_PL(io) != NULL && IO_PLCLOSE(io) == YES)
+	    call pl_close (IO_PL(io))
+	if (IO_EX(io) != NULL)
+	    call qpex_close (IO_EX(io))
+
+	if (IO_YLENVP(io) != NULL)
+	    call mfree (IO_YLENVP(io), TY_INT)
+	if (IO_YOFFVP(io) != NULL)
+	    call mfree (IO_YOFFVP(io), TY_INT)
+	if (IO_MINEVL(io) != NULL)
+	    call mfree (IO_MINEVL(io), TY_SHORT)
+	if (IO_MAXEVL(io) != NULL)
+	    call mfree (IO_MAXEVL(io), TY_SHORT)
+	if (IO_FD(io) != NULL)
+	    call close (IO_FD(io))
+
+	if (IO_MASK(io) != NULL)
+	    call mfree (IO_MASK(io), TY_CHAR)
+	if (IO_PARAM(io) != NULL)
+	    call mfree (IO_PARAM(io), TY_CHAR)
+	if (IO_DD(io) != NULL)
+	    call mfree (IO_DD(io), TY_STRUCT)
+
+	if (filter != NULL)
+	    call mfree (filter, TY_CHAR)
+	if (io != NULL)
+	    call mfree (io, TY_STRUCT)
+
+	call erract (EA_ERROR)
+}
+
+	# The filter can be regenerated, so don't keep the input expr around.
+	call mfree (filter, TY_CHAR)
+
+	# Normal exit for read-only access.
+	call sfree (sp)
+	return (io)
+end
diff --git a/sys/qpoe/qpioparse.x b/sys/qpoe/qpioparse.x
new file mode 100644
index 00000000..40f858ab
--- /dev/null
+++ b/sys/qpoe/qpioparse.x
@@ -0,0 +1,374 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<mach.h>
+include	"qpoe.h"
+include	"qpex.h"
+include	"qpio.h"
+
+# QPIO_PARSE -- Parse the QPIO expression operand input to qpio_open or
+# qpio_setfilter.  This consists of a comma delimited list of keyword=value
+# terms.  We factor out those which are QPIO related and deal with these
+# directly, concatenating the remaining terms to be passed on to QPEX.
+# The output filter buffer is resized as needed to hold the filter expr.
+# ERR is returned as the function value if an error occurs while compiling
+# the expression.
+
+int procedure qpio_parse (io, expr, filter, sz_filter, mask, sz_mask)
+
+pointer	io			#I QPIO descriptor
+char	expr[ARB]		#I expression to be parsed
+pointer	filter			#U filter buffer
+int	sz_filter		#U allocated buffer size
+char	mask[sz_mask]		#O new mask name (not reallocatable)
+int	sz_mask			#I max chars out
+
+real	rval
+pointer	qp, sp, keyword, vp, in
+int	assignop, byte_offset, sz_field
+int	level, zlevel, status, start, value, token, op, kw, tokno
+
+pointer	qp_opentext()
+int	qp_gettok(), gstrcpy(), strlen(), strdic(), ctoi(), ctor()
+errchk	qp_opentext, malloc, realloc, qp_gettok, qp_ungettok, syserrs
+
+define	F Memc[filter+($1)-1]
+define	noval_  91
+define	badval_ 92
+define	badkey_ 93
+
+begin
+	call smark (sp)
+	call salloc (keyword, SZ_FNAME, TY_CHAR)
+
+	qp = IO_QP(io)
+
+	# Open the input expression for macro expanded token input.
+	in = qp_opentext (qp, expr)
+
+	# Extract and process a series of "param[=expr]" terms, where
+	# the expr may be any series of tokens, delimited by an
+	# unparenthesized comma.
+
+	op = 1
+	tokno = 0
+	F(op) = EOS
+	mask[1] = EOS
+	status = OK
+	level = 0
+
+	repeat {
+	    start = op
+
+	    # Advance to the next keyword.
+	    token = qp_gettok (in, F(op), SZ_TOKBUF)
+	    tokno = tokno + 1
+
+	    switch (token) {
+	    case EOF:
+		break
+	    case '(', '[', '{':
+		level = level + 1
+		next
+	    case ')', ']', '}':
+		level = level - 1
+		next
+	    case '!':
+		if (tokno <= 2) {
+		    IO_NODEFFILT(io) = YES
+		    IO_NODEFMASK(io) = YES
+		    tokno = 1
+		}
+		next
+	    case TOK_IDENTIFIER:
+		op = op + strlen (F(op))
+		if (op + SZ_TOKBUF > sz_filter) {
+		    sz_filter = sz_filter + INC_SZEXPRBUF
+		    call realloc (filter, sz_filter, TY_CHAR)
+		}
+		call strcpy (F(start), Memc[keyword], SZ_FNAME)
+		call strlwr (Memc[keyword])
+	    default:
+		if (token != ',') {
+		    call eprintf ("QPIO: unexpected token `%s'\n")
+			call pargstr (F(op))
+		    status = ERR
+		}
+		next
+	    }
+	   
+	    value = NULL
+	    token = qp_gettok (in, F(op), SZ_TOKBUF)
+
+	    if (token == '=' ||
+		token == TOK_PLUSEQUALS || token == TOK_COLONEQUALS) {
+
+		# Accumulate the expression.
+		zlevel = level
+		assignop = token
+		op = op + strlen (F(op))
+		value = op
+
+		repeat {
+		    # Peek at the next token to see if it terminates the
+		    # expression.  An unparenthesized comma or unmatched
+		    # right brace, bracket, or parenthesis is part of the
+		    # next statement and terminates the expression.
+
+		    token = qp_gettok (in, F(op), SZ_TOKBUF)
+		    switch (token) {
+		    case EOF:
+			break
+		    case '(', '[', '{':
+			level = level + 1
+		    case ')', ']', '}':
+			if (level <= zlevel) {
+			    call qp_ungettok (in, F(op))
+			    F(op) = EOS
+			    break
+			} else
+			    level = level - 1
+		    case ',':
+			if (level <= zlevel) {
+			    call qp_ungettok (in, F(op))
+			    F(op) = EOS
+			    break
+			}
+		    }
+
+		    # Accept token as data.
+		    op = op + strlen (F(op))
+		    if (op + SZ_TOKBUF + 1 > sz_filter) {
+			sz_filter = sz_filter + INC_SZEXPRBUF
+			call realloc (filter, sz_filter, TY_CHAR)
+		    }
+
+		    F(op) = ' ';  op = op + 1
+		    F(op) = EOS
+		}
+	    }
+
+	    # Process the keywords known to QPIO and pass anything else on
+	    # to the output filter buffer.
+
+	    kw = strdic (Memc[keyword], Memc[keyword], SZ_FNAME, KEYWORDS)
+	    vp = filter + value - 1
+
+	    switch (kw) {
+	    case KW_BLOCK:
+		# Set the XY blocking factor for pixelation.
+		if (value == NULL)
+		    goto noval_
+		else if (ctor (Memc, vp, rval) <= 0)
+		    goto badval_
+		IO_XBLOCK(io) = rval
+		IO_YBLOCK(io) = rval
+		op = start
+
+	    case KW_XBLOCK:
+		# Set the X blocking factor for pixelation.
+		if (value == NULL)
+		    goto noval_
+		else if (ctor (Memc, vp, rval) <= 0)
+		    goto badval_
+		IO_XBLOCK(io) = rval
+		op = start
+
+	    case KW_YBLOCK:
+		# Set the Y blocking factor for pixelation.
+		if (value == NULL)
+		    goto noval_
+		else if (ctor (Memc, vp, rval) <= 0)
+		    goto badval_
+		IO_YBLOCK(io) = rval
+		op = start
+
+	    case KW_DEBUG:
+		# Set the debug level, default 1 if no argument.
+		if (value == NULL)
+		    IO_DEBUG(io) = 1
+		else if (ctoi (Memc, vp, IO_DEBUG(io)) <= 0) {
+		    IO_DEBUG(io) = QP_DEBUG(qp)
+badval_		    call eprintf ("QPIO: cannot convert `%s' to integer\n")
+			call pargstr (Memc[vp])
+		}
+		op = start
+
+	    case KW_FILTER:
+		# A term such as "filter=(...)".  Keep the (...).
+		if (value == NULL)
+		    goto noval_
+		else {
+		    # Accumulate expression term.
+		    op = start + gstrcpy (Memc[vp], F(start), ARB)
+		    F(op) = ',';  op = op + 1
+		    F(op) = EOS
+		}
+
+	    case KW_KEY:
+		# Set the offsets of the event attribute fields to be used
+		# for the event coordinates during extraction.  The typical
+		# syntax of the key value is, e.g.,  key=(s10,s8).  Fields
+		# used for event coordinate keys must be a numeric type.
+
+		call strlwr (Memc[vp])
+		while (Memc[vp] == ' ' || Memc[vp] == '(')
+		    vp = vp + 1
+
+		# Get the X field offset and type.
+		switch (Memc[vp]) {
+		case 's':
+		    IO_EVXTYPE(io) = TY_SHORT
+		    sz_field = SZ_SHORT
+		case 'i':
+		    IO_EVXTYPE(io) = TY_INT
+		    sz_field = SZ_INT
+		case 'l':
+		    IO_EVXTYPE(io) = TY_LONG
+		    sz_field = SZ_LONG
+		case 'r':
+		    IO_EVXTYPE(io) = TY_REAL
+		    sz_field = SZ_REAL
+		case 'd':
+		    IO_EVXTYPE(io) = TY_DOUBLE
+		    sz_field = SZ_DOUBLE
+		default:
+		    goto badkey_
+		}
+
+		vp = vp + 1
+		if (ctoi (Memc, vp, byte_offset) <= 0)
+		    goto badkey_
+		else
+		    IO_EVXOFF(io) = byte_offset / (sz_field * SZB_CHAR)
+
+		while (Memc[vp] == ' ' || Memc[vp] == ',')
+		    vp = vp + 1
+
+		# Get the Y field offset.
+		switch (Memc[vp]) {
+		case 's':
+		    IO_EVYTYPE(io) = TY_SHORT
+		    sz_field = SZ_SHORT
+		case 'i':
+		    IO_EVYTYPE(io) = TY_INT
+		    sz_field = SZ_INT
+		case 'l':
+		    IO_EVYTYPE(io) = TY_LONG
+		    sz_field = SZ_LONG
+		case 'r':
+		    IO_EVYTYPE(io) = TY_REAL
+		    sz_field = SZ_REAL
+		case 'd':
+		    IO_EVYTYPE(io) = TY_DOUBLE
+		    sz_field = SZ_DOUBLE
+		default:
+		    goto badkey_
+		}
+
+		vp = vp + 1
+		if (ctoi (Memc, vp, byte_offset) <= 0) {
+badkey_			call eprintf ("QPIO: bad key value `%s'\n")
+			call pargstr (F(value))
+		    status = ERR
+		} else
+		    IO_EVYOFF(io) = byte_offset / (sz_field * SZB_CHAR)
+
+		op = start
+
+	    case KW_NOINDEX:
+		# Disable use of the index for extraction (for testing).
+		IO_NOINDEX(io) = YES
+		op = start
+
+	    case KW_PARAM, KW_MASK:
+		# Set a string valued option.
+
+		if (value == NULL) {
+noval_		    call eprintf ("QPIO: kewyord `%s' requires an argument\n")
+			call pargstr (Memc[keyword])
+		    status = ERR
+
+		} else {
+		    # Kill space added at end of token.
+		    op = op - 1
+		    F(op) = EOS
+
+		    # Output the string.
+		    if (kw == KW_PARAM) {
+			# Set the name of the event list parameter.
+			call strcpy (Memc[vp], Memc[IO_PARAM(io)], SZ_FNAME)
+		    } else {
+			# Set the name of the region mask.
+			call strcpy (Memc[vp], mask, sz_mask)
+			if (assignop == TOK_COLONEQUALS)
+			    IO_NODEFMASK(io) = YES
+		    }
+		}
+		op = start
+
+	    case KW_RECT:
+		# Set the source rect or "bounding box" for i/o.  The syntax
+		# is somewhat flexible, i.e., "*", ":N", "N:", "M:N" are
+		# all accepted ways of expressing the range for an axis.
+
+		IO_VSDEF(io,1) = 1;		IO_VSDEF(io,2) = 1
+		IO_VEDEF(io,1) = IO_NCOLS(io);	IO_VEDEF(io,2) = IO_NLINES(io)
+
+		if (Memc[vp] == '[' || Memc[vp] == '(')		# ])
+		    vp = vp + 1
+		while (Memc[vp] == ' ')
+		    vp = vp + 1
+
+		# Get range in X.
+		if (Memc[vp] == '*')
+		    vp = vp + 1
+		else {
+		    if (ctoi (Memc, vp, IO_VSDEF(io,1)) <= 0)
+			IO_VSDEF(io,1) = 1
+		    while (IS_WHITE(Memc[vp]) || Memc[vp] == ':')
+			vp = vp + 1
+		    if (ctoi (Memc, vp, IO_VEDEF(io,1)) <= 0)
+			IO_VEDEF(io,1) = IO_NCOLS(io)
+		}
+
+		while (IS_WHITE(Memc[vp]) || Memc[vp] == ',')
+		    vp = vp + 1
+
+		# Get range in Y.
+		if (Memc[vp] == '*')
+		    vp = vp + 1
+		else {
+		    if (ctoi (Memc, vp, IO_VSDEF(io,2)) <= 0)
+			IO_VSDEF(io,2) = 1
+		    while (IS_WHITE(Memc[vp]) || Memc[vp] == ':')
+			vp = vp + 1
+		    if (ctoi (Memc, vp, IO_VEDEF(io,2)) <= 0)
+			IO_VEDEF(io,2) = IO_NLINES(io)
+		}
+
+		IO_BBUSED(io) = YES
+		op = start
+
+	    default:
+		# Accumulate EAF expression term.
+		F(op) = ',';  op = op + 1
+		F(op) = ' ';  op = op + 1
+		F(op) = EOS
+	    }
+	}
+
+	# Verify that the parens etc. match.
+	if (level != 0)
+	    call syserrs (SYS_QPIOSYN, QP_DFNAME(qp))
+
+	F(op) = EOS
+	sz_filter = op
+	call realloc (filter, sz_filter, TY_CHAR)
+
+	call qp_closetext (in)
+	call sfree (sp)
+
+	return (status)
+end
diff --git a/sys/qpoe/qpioputev.x b/sys/qpoe/qpioputev.x
new file mode 100644
index 00000000..69c6d26d
--- /dev/null
+++ b/sys/qpoe/qpioputev.x
@@ -0,0 +1,104 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"qpoe.h"
+include	"qpio.h"
+
+# QPIO_PUTEVENTS -- Append events to a new event list.  No filtering is
+# performed.  As events are received they are merely copied into the bucket
+# currently being filled, writing each bucket to the output lfile as it fills.
+# No sorting is performed, hence if an indexed list is desired, the caller
+# must output the events in sort order (normally sorted by Y and then by X
+# within each image line).
+
+procedure qpio_putevents (io, i_ev, nevents)
+
+pointer	io			#I QPIO descriptor
+pointer	i_ev[ARB]		#I array of event pointers
+int	nevents			#I number of events
+
+pointer	qp, bp, ev
+int	szs_event, szb_page, nwords, bklen, bksiz, nev, i, j
+errchk	qpio_wbucket, qpio_sync, malloc, calloc
+
+begin
+	szs_event = IO_EVENTLEN(io)
+	bp = IO_BP(io)
+
+	# Fix the event list parameters and write out the event list header
+	# when the first write to a new event list occurs.
+
+	if (IO_ACTIVE(io) == NO) {
+	    qp = IO_QP(io)
+	    szb_page = QP_FMPAGESIZE(qp)
+
+	    IO_FBOFF(io)	= szb_page + 1
+	    IO_EVENTLEN(io)	= DD_STRUCTLEN(IO_DD(io))*SZ_STRUCT/SZ_SHORT
+	    IO_NEVENTS(io)	= 0
+
+	    # Force the bucket size to an integral number of datafile pages,
+	    # and adjust the number of events to fill the bucket, allowing
+	    # 2 extra slots at the end for the min/max event structs.
+
+	    bklen = QP_BUCKETLEN(qp) + 2
+	    bksiz = bklen * (IO_EVENTLEN(io) * SZ_SHORT * SZB_CHAR)
+	    bksiz = (bksiz - 1) / szb_page * szb_page
+	    bklen = bksiz / (IO_EVENTLEN(io) * SZ_SHORT * SZB_CHAR)
+
+	    IO_BUCKETLEN(io)	= bklen - 2
+	    IO_SZBBUCKET(io)	= bksiz
+	    IO_EVMINOFF(io)	= szs_event * (bklen - 2)
+	    IO_EVMAXOFF(io)	= szs_event * (bklen - 1)
+	    IO_EVI(io)		= 1
+	    IO_BKNO(io)		= 1
+	    IO_BKFIRSTEV(io)	= 1
+	    IO_BKLASTEV(io)	= bklen - 2 
+
+	    if (IO_DEBUG(io) > 1) {
+		call eprintf ("%s: assign szbk=%d, bklen=%d+2\n")
+		    call pargstr (Memc[IO_PARAM(io)])
+		    call pargi (bksiz)
+		    call pargi (bklen - 2)
+	    }
+
+	    # Allocate the bucket buffer.
+	    call malloc (IO_BP(io), bksiz / SZB_CHAR / SZ_SHORT, TY_SHORT)
+	    bp = IO_BP(io)
+
+	    # Allocate the MINEVL and MAXEVL event structs, used to keep
+	    # track of the min and max event field values for the entire
+	    # event list.
+
+	    nwords = IO_EVENTLEN(io)
+	    call calloc (IO_MINEVL(io), nwords, TY_SHORT)
+	    call calloc (IO_MAXEVL(io), nwords, TY_SHORT)
+
+	    # Write the event list header.
+	    call qpio_sync (io)
+
+	    IO_ACTIVE(io) = YES
+	}
+
+	# Make sure there is room in the bucket.
+	if (IO_EVI(io) > IO_BKLASTEV(io))
+	    call qpio_wbucket (io, IO_EVI(io))
+
+	# Output the current batch of events.
+	for (j=0;  j < nevents;  j=j+nev) {
+	    # Copy out as many events as will fit in the bucket.
+	    nev = min (nevents-j, (IO_BKLASTEV(io) - IO_EVI(io) + 1))
+	    if (nev <= 0)
+		break
+
+	    ev  = bp + (IO_EVI(io) - IO_BKFIRSTEV(io)) * szs_event
+	    do i = 1, nev {
+		call amovs (Mems[i_ev[i+j]], Mems[ev], szs_event)
+		ev = ev + szs_event
+	    }
+
+	    # Write out the bucket if it fills.
+	    IO_EVI(io) = IO_EVI(io) + nev
+	    if (IO_EVI(io) > IO_BKLASTEV(io))
+		call qpio_wbucket (io, IO_EVI(io))
+	}
+end
diff --git a/sys/qpoe/qpiorb.x b/sys/qpoe/qpiorb.x
new file mode 100644
index 00000000..9d46cc59
--- /dev/null
+++ b/sys/qpoe/qpiorb.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpio.h"
+
+# QPIO_RBUCKET -- Load the bucket containing the specified event into the
+# QPIO descriptor, returning EOF if the numbered event does not exist.
+
+int procedure qpio_rbucket (io, evi)
+
+pointer	io			#I QPIO descriptor
+int	evi			#I bucket number desired
+
+int	ev1, ev2, nb
+int	offset, bkno, status
+
+begin
+	# Event does not exist?
+	if (evi < 1 || evi > IO_NEVENTS(io))
+	    return (EOF)
+
+	# Bucket already loaded?
+	bkno = EVI_TO_BUCKET(io,evi)
+	if (bkno == IO_BKNO(io))
+	    return (bkno)
+
+	# Determine range of events in bucket.
+	ev1 = BUCKET_TO_EVI(io,bkno)
+	ev2 = min (IO_NEVENTS(io), ev1 + IO_BUCKETLEN(io) - 1)
+
+	# Physically read the bucket.
+	nb = IO_SZBBUCKET(io)
+	offset = (bkno - 1) * nb + IO_FBOFF(io)
+	call fm_lfaread (IO_CHAN(io), Mems[IO_BP(io)], nb, offset)
+	call fm_lfawait (IO_CHAN(io), status)
+	if (status < nb)
+	    return (EOF)
+
+	# Update the bucket descriptor.
+	IO_BKNO(io) = bkno
+	IO_BKFIRSTEV(io) = ev1
+	IO_BKLASTEV(io)  = ev2
+
+	return (bkno)
+end
diff --git a/sys/qpoe/qpiorpix.gx b/sys/qpoe/qpiorpix.gx
new file mode 100644
index 00000000..e766749c
--- /dev/null
+++ b/sys/qpoe/qpiorpix.gx
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <syserr.h>
+include	"../qpio.h"
+
+# QPIO_READPIX -- Sample the event list within the indicated rectangular
+# region, using the given blocking factor, to produce a rectangular array
+# of "pixels", where each pixel is a count of the number of events mapping
+# to that location which pass the event attribute filter and region mask.
+#
+# NOTE -- It is left up to the caller to zero the output buffer before
+# we are called.  (We merely increment the counts of the affected pixels).
+
+int procedure qpio_readpix$t (io, obuf, vs, ve, ndim, xblock, yblock)
+
+pointer	io			#I QPIO descriptor
+PIXEL	obuf[ARB]		#O output pixel buffer
+int	vs[ndim], ve[ndim]	#I vectors defining region to be extracted
+int	ndim			#I should be 2 for QPOE
+real	xblock, yblock		#I blocking factors
+
+double	x, y
+pointer	sp, evl, ev_p
+int	evtype, maxpix, maskval, xoff, yoff, xw, yw, nev, totev, pix, i, j
+errchk	qpio_getevents, qpio_setrange, syserr
+int	qpio_getevents()
+
+begin
+	# Verify arguments.
+	if (xblock <= 0 || xblock > (ve[1] - vs[1] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+	if (yblock <= 0 || yblock > (ve[2] - vs[2] + 1))
+	    call syserr (SYS_QPBLOCKOOR)
+
+	# Compute the size of the output matrix in integer pixels.  This
+	# truncates the last partially filled pixel in each axis.
+
+	xw = int ((ve[1] - vs[1] + 1) / xblock + (EPSILOND * 1000))
+	yw = int ((ve[2] - vs[2] + 1) / yblock + (EPSILOND * 1000))
+	if (xw <= 0 || yw <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (evl, SZ_EVLIST, TY_POINTER)
+
+	xoff = IO_EVXOFF(io)
+	yoff = IO_EVYOFF(io)
+	maxpix = xw * yw
+	totev = 0
+
+	evtype = IO_EVXTYPE(io)
+	if (IO_EVXTYPE(io) != IO_EVYTYPE(io))
+	    call syserr (SYS_QPINVEVT)
+
+	# Define the region from which we wish to read events.
+	call qpio_setrange (io, vs, ve, ndim)
+
+	# Read the events.
+	while (qpio_getevents (io, Memi[evl], maskval, SZ_EVLIST, nev) > 0) {
+	    switch (evtype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		# Process a sequence of neighbor events.
+		do i = 1, nev {
+		    ev_p = (Memi[evl+i-1] - 1) * SZ_SHORT / SZ_PIXEL + 1
+
+		    x = Mem$t[ev_p+xoff]  
+		    y = Mem$t[ev_p+yoff]
+
+		    j = int ((y - vs[2]) / yblock + (EPSILOND * 1000))
+		    if (j >= 0 && j < yw) {
+			pix = j * xw + (x - vs[1]) / xblock + 1
+			if (pix > 0 && pix <= maxpix)
+			    obuf[pix] = obuf[pix] + 1
+		    }
+		}
+	    $endfor
+	    }
+
+	    totev = totev + nev
+	}
+
+	call sfree (sp)
+	return (totev)
+end
diff --git a/sys/qpoe/qpiosetfil.x b/sys/qpoe/qpiosetfil.x
new file mode 100644
index 00000000..4f5f9833
--- /dev/null
+++ b/sys/qpoe/qpiosetfil.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpex.h"
+include	"qpio.h"
+
+# QPIO_SETFILTER -- Modify the filter used to reject events during event
+# extraction with qpio_getevents or qpio_readpix.  Possible items to be set
+# here include the event attribute filter, region mask, and various QPIO
+# parameters.  The input expression should be a comma delimited list of
+# param=value terms, where PARAM is `filter', `mask', or the name of a QPIO
+# or QPEX parameter, and where `value' is an expression, e.g., a comma
+# delimited list of range terms enclosed in parenthesis.
+
+procedure qpio_setfilter (io, expr)
+
+pointer	io			#I QPIO descriptor
+char	expr[ARB]		#I option setting expression
+
+int	sz_filter
+pointer	sp, filter, mask
+errchk	qpio_parse, qpex_open, qpex_modfilter
+int	qpex_modfilter(), qpio_parse()
+pointer	qpex_open()
+
+begin
+	call smark (sp)
+	call salloc (mask, SZ_FNAME, TY_CHAR)
+
+	if (IO_DEBUG(io) > 0) {
+	    call eprintf ("qpio_setfilter (%xX, `%s')\n")
+		call pargi (io)
+		call pargstr (expr)
+	}
+
+	# Parse full QPIO oriented filter expression.
+	sz_filter = DEF_SZEXPRBUF
+	call malloc (filter, sz_filter, TY_CHAR)
+	if (qpio_parse (io,expr,filter,sz_filter,Memc[mask],SZ_FNAME) == ERR) {
+	    call eprintf ("QPIO warning: error parsing `%s'\n")
+		call pargstr (expr)
+	}
+
+	# Set event attribute filter.
+	if (IO_EX(io) == NULL)
+	    IO_EX(io) = qpex_open (IO_QP(io), Memc[filter])
+	else if (qpex_modfilter (IO_EX(io), Memc[filter]) == ERR) {
+	    call eprintf ("Warning: errors compiling `%s'\n")
+		call pargstr (expr)
+	}
+
+	# Set region mask.
+	if (Memc[mask] != EOS)
+	    call qpio_loadmask (io, Memc[mask], NO)
+
+	IO_ACTIVE(io) = NO
+
+	call mfree (filter, TY_CHAR)
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpioseti.x b/sys/qpoe/qpioseti.x
new file mode 100644
index 00000000..d5dadceb
--- /dev/null
+++ b/sys/qpoe/qpioseti.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpioset.h>
+include	<syserr.h>
+include	<plset.h>
+include	"qpio.h"
+
+# QPIO_SETI -- Set a QPIO interface integer valued parameter.  This procedure
+# represents the lowest level interface by which an applications program can
+# control QPIO.
+
+procedure qpio_seti (io, param, value)
+
+pointer	io			#I QPIO descriptor
+int	param			#I parameter code
+int	value			#I new parameter value
+
+int	naxes, axlen[PL_MAXDIM], sv_active
+errchk	pl_close, syserr, realloc
+
+begin
+	# Almost everything here cancels any active i/o.
+	sv_active = IO_ACTIVE(io)
+	IO_ACTIVE(io) = NO
+
+	# Set the named parameter.
+	switch (param) {
+	case QPIO_BLOCKFACTOR:
+	    IO_XBLOCK(io) = value
+	    IO_YBLOCK(io) = value
+	case QPIO_XBLOCKFACTOR:
+	    IO_XBLOCK(io) = value
+	case QPIO_YBLOCKFACTOR:
+	    IO_YBLOCK(io) = value
+	case QPIO_EVXOFF:
+	    IO_EVXOFF(io) = value
+	case QPIO_EVYOFF:
+	    IO_EVYOFF(io) = value
+	case QPIO_EVXTYPE:
+	    IO_EVXTYPE(io) = value
+	case QPIO_EVYTYPE:
+	    IO_EVYTYPE(io) = value
+	case QPIO_NOINDEX:
+	    IO_NOINDEX(io) = value
+	case QPIO_NODEFFILT:
+	    IO_NODEFFILT(io) = value
+	case QPIO_NODEFMASK:
+	    IO_NODEFMASK(io) = value
+	case QPIO_OPTBUFSIZE:
+	    IO_OPTBUFSIZE(io) = value
+
+	case QPIO_BUCKETLEN:
+	    # Set the bucket length (new event lists only).
+	    if (IO_MODE(io) != READ_ONLY)
+		IO_BUCKETLEN(io) = value
+
+	case QPIO_DEBUG:
+	    # Set the debug level; don't modify IO_ACTIVE.
+	    IO_ACTIVE(io) = sv_active
+	    IO_DEBUG(io) = value
+
+	case QPIO_EX:
+	    # Set the event attribute filter.
+	    if (IO_EX(io) != NULL && IO_EXCLOSE(io) == YES)
+		call qpex_close (IO_EX(io))
+	    IO_EX(io) = value
+	    IO_EXCLOSE(io) = NO
+
+	case QPIO_PL:
+	    # Set the PLIO region mask.
+	    if (IO_PL(io) != NULL && IO_PLCLOSE(io) == YES)
+		call pl_close (IO_PL(io))
+
+	    IO_PL(io) = value
+	    IO_PLCLOSE(io) = NO
+	    call pl_gsize (IO_PL(io), naxes, axlen, IO_MDEPTH(io))
+	    if (axlen[1] != IO_NCOLS(io) || axlen[2] != IO_NLINES(io))
+		call syserr (SYS_QPPLSIZE)
+
+	    # Allocate a range list buffer if i/o is indexed.
+	    if (IO_INDEXLEN(io) > 0)
+		call realloc (IO_RL(io), RL_MAXLEN(IO_PL(io)), TY_INT)
+
+	    # Update the mask name, such as it is...
+	    if (IO_MASK(io) != NULL) {
+		call sprintf (Memc[IO_MASK(io)], SZ_FNAME, "%xX")
+		    call pargi (value)
+	    }
+	}
+end
diff --git a/sys/qpoe/qpiosetr.x b/sys/qpoe/qpiosetr.x
new file mode 100644
index 00000000..768e1b82
--- /dev/null
+++ b/sys/qpoe/qpiosetr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpioset.h>
+include	"qpio.h"
+
+# QPIO_SETR -- Set a QPIO interface real valued parameter.  This procedure
+# represents the lowest level interface by which an applications program can
+# control QPIO.
+
+procedure qpio_setr (io, param, value)
+
+pointer	io			#I QPIO descriptor
+int	param			#I parameter code
+real	value			#I new parameter value
+
+begin
+	# Almost everything here cancels any active i/o.
+	IO_ACTIVE(io) = NO
+
+	# Set the named parameter.
+	switch (param) {
+	case QPIO_BLOCKFACTOR:
+	    IO_XBLOCK(io) = value
+	    IO_YBLOCK(io) = value
+	case QPIO_XBLOCKFACTOR:
+	    IO_XBLOCK(io) = value
+	case QPIO_YBLOCKFACTOR:
+	    IO_YBLOCK(io) = value
+	}
+end
diff --git a/sys/qpoe/qpiosetrg.x b/sys/qpoe/qpiosetrg.x
new file mode 100644
index 00000000..6a93f11e
--- /dev/null
+++ b/sys/qpoe/qpiosetrg.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpio.h"
+
+# QPIO_SETRANGE -- Set the range in X and Y within which events will be
+# extracted by qpio_getevents.  This defines the "bounding box" for i/o
+# and "rewinds" the getevent i/o pointer.
+
+procedure qpio_setrange (io, vs, ve, ndim)
+
+pointer	io			#I QPIO descriptor
+int	vs[ARB]			#I start vector (lower left corner)
+int	ve[ARB]			#I end vector (upper right corner)
+int	ndim			#I vector length (ndim=2 at present)
+
+int	i
+int	vlim[NDIM]
+
+begin
+	vlim[1] = IO_NCOLS(io)
+	vlim[2] = IO_NLINES(io)
+
+	if (ndim <= 0) {
+	    call amovi (IO_VSDEF(io,1), IO_VS(io,1), NDIM)
+	    call amovi (IO_VEDEF(io,1), IO_VE(io,1), NDIM)
+	} else {
+	    do i = 1, ndim {
+		IO_VS(io,i) = max(1, min(vlim[i], vs[i]))
+		IO_VE(io,i) = max(1, min(vlim[i], ve[i]))
+	    }
+	}
+
+	IO_ACTIVE(io) = NO
+end
diff --git a/sys/qpoe/qpiostati.x b/sys/qpoe/qpiostati.x
new file mode 100644
index 00000000..678ee0bb
--- /dev/null
+++ b/sys/qpoe/qpiostati.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpioset.h>
+include	"qpio.h"
+
+# QPIO_STATI -- Stat a QPIO interface integer valued parameter.
+
+int procedure qpio_stati (io, param)
+
+pointer	io			#I QPIO descriptor
+int	param			#I parameter code
+
+bool	fp_equalr()
+
+begin
+	switch (param) {
+	case QPIO_BLOCKFACTOR:
+	    if (fp_equalr (IO_XBLOCK(io), IO_YBLOCK(io)))
+		return (IO_XBLOCK(io))
+	    else
+		return (ERR)
+	case QPIO_XBLOCKFACTOR:
+	    return (IO_XBLOCK(io))
+	case QPIO_YBLOCKFACTOR:
+	    return (IO_YBLOCK(io))
+	case QPIO_BUCKETLEN:
+	    return (IO_BUCKETLEN(io))
+	case QPIO_DEBUG:
+	    return (IO_DEBUG(io))
+	case QPIO_EVXOFF:
+	    return (IO_EVXOFF(io))
+	case QPIO_EVYOFF:
+	    return (IO_EVYOFF(io))
+	case QPIO_EVXTYPE:
+	    return (IO_EVXTYPE(io))
+	case QPIO_EVYTYPE:
+	    return (IO_EVYTYPE(io))
+	case QPIO_EX:
+	    return (IO_EX(io))
+	case QPIO_NODEFFILT:
+	    return (IO_NODEFFILT(io))
+	case QPIO_NODEFMASK:
+	    return (IO_NODEFMASK(io))
+	case QPIO_NOINDEX:
+	    return (IO_NOINDEX(io))
+	case QPIO_OPTBUFSIZE:
+	    return (IO_OPTBUFSIZE(io))
+	case QPIO_PL:
+	    return (IO_PL(io))
+
+	case QPIO_EVENTLEN:			# length of event struct, shorts
+	    return (IO_EVENTLEN(io))
+	case QPIO_FD:				# FIO fd of event list lfile
+	    return (IO_FD(io))
+	case QPIO_INDEXLEN:			# index length (0=noindex)
+	    return (IO_INDEXLEN(io))
+	case QPIO_IXXOFF:			# offset of X in index
+	    return (IO_IXXOFF(io))
+	case QPIO_IXYOFF:			# offset of Y in index
+	    return (IO_IXYOFF(io))
+	case QPIO_IXXTYPE:			# datatype of X in index
+	    return (IO_IXXTYPE(io))
+	case QPIO_IXYTYPE:			# datatype of Y in index
+	    return (IO_IXYTYPE(io))
+	case QPIO_LF:				# FMIO lfile number
+	    return (IO_LF(io))
+	case QPIO_MASKP:			# PLIO descriptor
+	    return (IO_MASK(io))
+	case QPIO_MAXEVP:			# pointer to short
+	    return (IO_MAXEVL(io))
+	case QPIO_MINEVP:			# pointer to short
+	    return (IO_MINEVL(io))
+	case QPIO_NCOLS:
+	    return (IO_NCOLS(io))
+	case QPIO_NLINES:
+	    return (IO_NLINES(io))
+	case QPIO_PARAMP:			# pointer to char
+	    return (IO_PARAM(io))
+	case QPIO_QP:
+	    return (IO_QP(io))			# QPOE descriptor
+	}
+
+	return (ERR)
+end
diff --git a/sys/qpoe/qpiostatr.x b/sys/qpoe/qpiostatr.x
new file mode 100644
index 00000000..429ea2e9
--- /dev/null
+++ b/sys/qpoe/qpiostatr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpioset.h>
+include	"qpio.h"
+
+# QPIO_STATR -- Stat a QPIO interface real valued parameter.
+
+real procedure qpio_statr (io, param)
+
+pointer	io			#I QPIO descriptor
+int	param			#I parameter code
+
+bool	fp_equalr()
+
+begin
+	switch (param) {
+	case QPIO_BLOCKFACTOR:
+	    if (fp_equalr (IO_XBLOCK(io), IO_YBLOCK(io)))
+		return (IO_XBLOCK(io))
+	    else
+		return (ERR)
+	case QPIO_XBLOCKFACTOR:
+	    return (IO_XBLOCK(io))
+	case QPIO_YBLOCKFACTOR:
+	    return (IO_YBLOCK(io))
+	}
+
+	return (ERR)
+end
diff --git a/sys/qpoe/qpiosync.x b/sys/qpoe/qpiosync.x
new file mode 100644
index 00000000..35492d7d
--- /dev/null
+++ b/sys/qpoe/qpiosync.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<fset.h>
+include	"qpoe.h"
+include	"qpio.h"
+
+# QPIO_SYNC -- Update an event list on disk, i.e., flush the bucket buffer if
+# it has been written into, and update the event list header.  No QPIO state
+# parameters are modified, e.g., the i/o pointer IO_EVI is not affected,
+# nor are the contents of the bucket currently being filled; partially filled
+# buckets can be synced if desired.
+
+procedure qpio_sync (io)
+
+pointer	io			#I QPIO descriptor
+
+pointer	sp, eh
+int	szb_page, off, flen
+int	fstati()
+errchk	qpio_wbucket
+
+begin
+	if (IO_MODE(io) == READ_ONLY)
+	    return
+
+	# Flush the bucket buffer.
+	if (IO_EVI(io) > 1)
+	    call qpio_wbucket (io, IO_EVI(io))
+
+	call smark (sp)
+	szb_page = QP_FMPAGESIZE(IO_QP(io))
+
+	# Update the event list header (stored in a full datafile page).
+	call salloc (eh, szb_page / (SZ_STRUCT*SZB_CHAR), TY_STRUCT)
+	call aclri (Memi[eh], szb_page / (SZ_STRUCT*SZB_CHAR))
+
+	EH_FBOFF(eh)		= szb_page + 1
+	EH_NEVENTS(eh)		= IO_NEVENTS(io)
+	EH_EVENTLEN(eh)		= IO_EVENTLEN(io)
+	EH_SZBBUCKET(eh)	= IO_SZBBUCKET(io)
+	EH_BUCKETLEN(eh)	= IO_BUCKETLEN(io)
+	EH_EVMINOFF(eh)		= IO_EVMINOFF(io)
+	EH_EVMAXOFF(eh)		= IO_EVMAXOFF(io)
+	EH_INDEXLEN(eh)		= IO_INDEXLEN(io)
+	EH_YOFFVOFF(eh)		= IO_YOFFVOFF(io)
+	EH_YOFFVLEN(eh)		= IO_YOFFVLEN(io)
+	EH_YLENVOFF(eh)		= IO_YLENVOFF(io)
+	EH_YLENVLEN(eh)		= IO_YLENVLEN(io)
+	EH_IXXOFF(eh)		= IO_IXXOFF(io)
+	EH_IXYOFF(eh)		= IO_IXYOFF(io)
+	EH_IXXTYPE(eh)		= IO_IXXTYPE(io)
+	EH_IXYTYPE(eh)		= IO_IXYTYPE(io)
+
+	# Output MINEV and MAXEV event structs following the header struct,
+	# but in the header page.
+
+	if (IO_MINEVL(io) != NULL) {
+	    off = LEN_EHDES
+	    call amovs (Mems[IO_MINEVL(io)], Memi[eh+off], IO_EVENTLEN(io))
+	    EH_MINEVLOFF(eh) = off
+	}
+
+	if (IO_MAXEVL(io) != NULL) {
+	    off = LEN_EHDES + (IO_EVENTLEN(io) * SZ_SHORT / SZ_STRUCT)
+	    call amovs (Mems[IO_MAXEVL(io)], Memi[eh+off], IO_EVENTLEN(io))
+	    EH_MAXEVLOFF(eh) = off
+	}
+
+	# Write the header page to the lfile.
+	call fm_lfawrite (IO_CHAN(io), Memi[eh], szb_page, 1)
+	call fm_lfawait (IO_CHAN(io), szb_page)
+	flen = fstati (IO_FD(io), F_FILESIZE)
+	if (szb_page / SZB_CHAR > flen)
+	    call fseti (IO_FD(io), F_FILESIZE, szb_page / SZB_CHAR)
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qpiowb.x b/sys/qpoe/qpiowb.x
new file mode 100644
index 00000000..42f6ccc2
--- /dev/null
+++ b/sys/qpoe/qpiowb.x
@@ -0,0 +1,131 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<fset.h>
+include	"qpoe.h"
+include	"qpio.h"
+
+# QPIO_WBUCKET -- Flush any data currently in the bucket to the datafile,
+# and set up the buffer to receive data for the bucket BKNO.  The min/max
+# event structs are updated whenever a bucket is written to disk. IO_EVI
+# is assumed to point to the event following the last event written into
+# in the buffer.  Data should always be written sequentially.
+
+procedure qpio_wbucket (io, evi)
+
+pointer	io			#I QPIO descriptor
+int	evi			#I evi of next bucket on exit
+
+pointer	min_ev[2], max_ev[2], ev, fp, mp, dd
+int	sz_event, offset, dtype, nb, flen, nchars, i, j, k
+int	fstati()
+
+begin
+	dd = IO_DD(io)
+
+	# Write the current bucket to the datafile if nonempty.
+	if (dd != NULL && IO_EVI(io) > IO_BKFIRSTEV(io)) {
+	    # Scan through the events in the bucket and update the min/max
+	    # event structs for the event list ([1] below) and for the
+	    # bucket ([2] below, stored at the end of the bucket).
+	    # Use CHAR pointers to facilitate pointer conversions.
+
+	    min_ev[1]	= (IO_MINEVL(io) - 1) * SZ_SHORT + 1
+	    min_ev[2]	= (IO_MINEVB(io) - 1) * SZ_SHORT + 1
+	    max_ev[1]	= (IO_MAXEVL(io) - 1) * SZ_SHORT + 1
+	    max_ev[2]	= (IO_MAXEVB(io) - 1) * SZ_SHORT + 1
+	    sz_event	= DD_STRUCTLEN(dd) * SZ_STRUCT
+
+	    do k = 1, 2 {
+		ev = (IO_BP(io) - 1) * SZ_SHORT + 1
+		# If min/max of bucket or first bucket of event list...
+		if (k == 2 || IO_BKNO(io) == 1) {
+		    call amovc (Memc[ev], Memc[min_ev[k]], sz_event)
+		    call amovc (Memc[ev], Memc[max_ev[k]], sz_event)
+		}
+
+		do j = 1, IO_EVI(io) - IO_BKFIRSTEV(io) {
+		    do i = 1, DD_NFIELDS(dd) {
+			# Get the typed offset and datatype of the field.
+			offset = DD_FOFFSET(dd,i)
+			dtype  = DD_FTYPE(dd,i)
+
+			# Update the min/max entries for the field.
+			switch (dtype) {
+			case TY_SHORT:
+			    fp = (ev - 1) / SZ_SHORT + 1 + offset
+			    mp = (min_ev[k] - 1) / SZ_SHORT + 1 + offset
+			    if (Mems[fp] < Mems[mp])
+				Mems[mp] = Mems[fp]
+			    mp = (max_ev[k] - 1) / SZ_SHORT + 1 + offset
+			    if (Mems[fp] > Mems[mp])
+				Mems[mp] = Mems[fp]
+
+			case TY_INT, TY_LONG:
+			    fp = (ev - 1) / SZ_INT + 1 + offset
+			    mp = (min_ev[k] - 1) / SZ_INT + 1 + offset
+			    if (Memi[fp] < Memi[mp])
+				Memi[mp] = Memi[fp]
+			    mp = (max_ev[k] - 1) / SZ_INT + 1 + offset
+			    if (Memi[fp] > Memi[mp])
+				Memi[mp] = Memi[fp]
+
+			case TY_REAL:
+			    fp = (ev - 1) / SZ_REAL + 1 + offset
+			    mp = (min_ev[k] - 1) / SZ_REAL + 1 + offset
+			    if (Memr[fp] < Memr[mp])
+				Memr[mp] = Memr[fp]
+			    mp = (max_ev[k] - 1) / SZ_REAL + 1 + offset
+			    if (Memr[fp] > Memr[mp])
+				Memr[mp] = Memr[fp]
+
+			case TY_DOUBLE:
+			    fp = (ev - 1) / SZ_DOUBLE + 1 + offset
+			    mp = (min_ev[k] - 1) / SZ_DOUBLE + 1 + offset
+			    if (Memd[fp] < Memd[mp])
+				Memd[mp] = Memd[fp]
+			    mp = (max_ev[k] - 1) / SZ_DOUBLE + 1 + offset
+			    if (Memd[fp] > Memd[mp])
+				Memd[mp] = Memd[fp]
+			}
+		    }
+
+		    ev = ev + sz_event
+		}
+	    }
+
+	    # Zero out any remaining events.
+	    while (ev < min_ev[2]) {
+		call aclrc (Memc[ev], sz_event)
+		ev = ev + sz_event
+	    }
+
+	    # Write the bucket.
+	    nb = IO_SZBBUCKET(io)
+	    offset = (IO_BKNO(io) - 1) * nb + IO_FBOFF(io)
+	    call fm_lfawrite (IO_CHAN(io), Mems[IO_BP(io)], nb, offset)
+	    call fm_lfawait (IO_CHAN(io), nb)
+
+	    # Update the file size.
+	    flen = fstati (IO_FD(io), F_FILESIZE)
+	    nchars = (offset + nb) / SZB_CHAR
+	    if (nchars > flen)
+		call fseti (IO_FD(io), F_FILESIZE, nchars)
+
+	    # Increment the total event count.
+	    IO_NEVENTS(io) = max (IO_NEVENTS(io), IO_EVI(io) - 1)
+	    S_NELEM(IO_PSYM(io)) = IO_NEVENTS(io)
+	    QP_MODIFIED(IO_QP(io)) = YES
+	}
+
+	# Set up the buffer for the new bucket.
+	IO_BKNO(io) = EVI_TO_BUCKET(io,evi)
+	IO_BKFIRSTEV(io) = BUCKET_TO_EVI(io,IO_BKNO(io))
+	IO_BKLASTEV(io)  = IO_BKFIRSTEV(io) + IO_BUCKETLEN(io) - 1
+
+	if (IO_DEBUG(io) > 2) {
+	    call eprintf ("wbucket: evi=%d, bkno=%d\n")
+		call pargi(evi)
+		call pargi(IO_BKNO(io))
+	}
+end
diff --git a/sys/qpoe/qplenf.x b/sys/qpoe/qplenf.x
new file mode 100644
index 00000000..c8e4539e
--- /dev/null
+++ b/sys/qpoe/qplenf.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_LENF -- Return the length of the named parameter, i.e., the number of
+# stored elements in the parameter value.  NULL is returned if there is no
+# value, or ERR if the parameter does not exist.
+
+int procedure qp_lenf (qp, param)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+
+pointer	sym
+pointer	qp_gpsym()
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    return (ERR)
+	else
+	    return (S_NELEM(sym))
+end
diff --git a/sys/qpoe/qploadwcs.x b/sys/qpoe/qploadwcs.x
new file mode 100644
index 00000000..b4609ce7
--- /dev/null
+++ b/sys/qpoe/qploadwcs.x
@@ -0,0 +1,38 @@
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_LOADWCS -- Load the default WCS, if there is one, from the QPOE image
+# header.  A QPOE file can contain any number of WCS, but the default WCS
+# should relate the physical coordinate system, e.g., sky coordinates in 
+# the range 1024sq, 8192sq, etc., to world coordinates, e.g., the TAN
+# projection.  Probably we should provide for multiple physical coordinate
+# systems (sky, detector, etc.) each with its own WCS, but at present we
+# assume a single WCS.
+
+pointer procedure qp_loadwcs (qp)
+
+pointer	qp				#I QPOE descriptor
+
+int	wcslen
+pointer	sp, svwcs, mw
+errchk	qp_lenf, syserrs, qp_read, mw_open
+int	qp_lenf(), qp_read()
+pointer	mw_open()
+string	s_qpwcs QPWCS
+
+begin
+	# Determine if there is a WCS, and if so, how big the saved version is.
+	wcslen = qp_lenf (qp, s_qpwcs)
+	if (wcslen <= 0)
+	    call syserrs (SYS_QPNOWCS, QP_DFNAME(qp))
+
+	call smark (sp)
+	call salloc (svwcs, wcslen, TY_CHAR)
+
+	# Retrieved the saved wcs, and load it into an MWCS descriptor.
+	wcslen = qp_read (qp, s_qpwcs, Memc[svwcs], wcslen, 1, "opaque")
+	mw = mw_open (svwcs, 0)
+
+	call sfree (sp)
+	return (mw)
+end
diff --git a/sys/qpoe/qpmacro.x b/sys/qpoe/qpmacro.x
new file mode 100644
index 00000000..984742d2
--- /dev/null
+++ b/sys/qpoe/qpmacro.x
@@ -0,0 +1,832 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <error.h>
+include <finfo.h>
+include <ctype.h>
+include "qpoe.h"
+include "qpex.h"
+
+.help qpmacro
+.nf ---------------------------------------------------------------------------
+QPMACRO -- Macro facility for QPOE.  QPOE permits macro replacement in various
+places, e.g., to alias parameter names, or enter predefined selection
+expressions (selection functions).  While macros may be defined permanently
+in the datafile, they are more commonly defined by the user at runtime, and
+used as a global facility to access any number of datafiles.  Since we do not
+want to store runtime macros in the datafile headers, the compiled definitions
+cannot be entered into the datafile symbol table, but must be entered into a
+separate global symbol table, maintained by QPOE and used to store runtime
+macros to be used in all datafile accesses.
+
+The purpose of the package is to maintain an up to date global macro symbol
+table.	The symbol table itself is directly accessed by the client program,
+rather than via the package interface, so that the standard SYMTAB package
+routines may be used to access the symbol table.
+
+	 qm = qm_access ()
+	 st = qm_symtab (qm)
+	 qm_setdefaults (qm, qp)
+	 qm_upddefaults (qm, qp)
+
+		qm_scan (qm, fname, flags)
+	       qm_scano (qm, fd, flags)
+
+The macro symbol table is accessed with QM_ACCESS, which will compile or
+update the in-core version of the symbol table if necessary.  A call to
+QM_SYMTAB is required to obtain the symbol table descriptor, a pointer,
+which may change any time the symbol table is modified.  QM_ACCESS should
+be called only occasionally (e.g., at datafile open time) since it makes a
+number of system calls to check file dates.  QM_SYMTAB should be called
+once upon entry to every routine which accesses the macro database.
+
+QM_SETDEFAULTS is called when a datafile is opened to set the default values
+of all interface and datafile parameters; the user can control these defaults
+by including SET statements in the macro definition file.  QM_UPDDEFAULTS is
+similar, except that it sets ONLY the values of those parameters that have
+been explicitly set in SET statements in the macro files.
+
+When QM_ACCESS is called it looks for two variables in the user environment.
+
+	QMSAVE		The name of the file (default home$qpoe.msv) in
+			which the compiled macro database is to be saved,
+			or from which it is to be loaded.
+
+	QMFILES		A comma delimited list of macro definition (MD)
+			files to be scanned to compile the macro database.
+			(No default unless one is supplied by the local
+			system administrator).
+
+If the binary symbol table file QMSAVE exists and is newer than any of the MD
+files then the symbol table is reloaded from the binary save file, else the MD
+files are scanned and we attempt to write a new save file when done.  If the
+symbol table is already open and is newer than either the save file or the
+MD files, then the routine exits immediately, returning a pointer to the global
+QPOE macro database (symbol table).  QM_SCAN and QM_SCANO are low level
+routines for reading the contents of a MD file or stream into the symbol table.
+
+Note that at runtime, a completely different facility exists for macro
+replacement; macros may be drawn from either source.  The second mechanism
+takes the name of the macro to be the *name* of a file in the current
+directory containing the value string for the macro.  This is less efficient,
+but allows macros to be independently created and used dynamically at runtime.
+The latter type of macros may be referenced only in QPOE selection expressions
+(rather than as, for example, parameter name aliases).
+.endhelp ----------------------------------------------------------------------
+
+# Size limiting definitions.
+define	QM_MAXFILES	32		# maximum files in QMFILES list
+define	QM_SZCBUF	1024		# char storage for file list
+define	DEF_LENINDEX	50		# symbol table (init hash index)
+define	DEF_LENSTAB	256		# symbol table (init table len)
+define	DEF_SZSBUF	1024		# symbol table (init string buf len)
+define	SZ_MNAME	32		# max size macro name
+define	SZ_MVBUF	8192		# max size macro value
+
+# Defined parameters.
+define	QMFILES		"qmfiles"	# macro define file list
+define	QMSAVE		"qmsave"	# symtab save file
+define	DEF_QMSAVE	"uparm$qpoe.msv" # default macro save file
+define	STTIME		"$STTIME"	# time of last st compile
+define	PSETKW		"$PSETKW"	# param used to store SET values
+define	QMSTNAME	"QPOEMACROS"	# symbol table name
+
+# Flags for QM_SCAN.
+define	QM_FLAGREDEFS	1B		# complain about redefined macros
+
+# The QM descriptor (fixed pointer, while QM_ST is allowed to change).
+define	LEN_QM		1
+define	QM_ST		Memi[$1]	# pointer to macro symbol table
+
+# The parameter set descriptor (for SET statements).
+define	LEN_PSET	32		# allow some extra space
+define	PS_EXPBLEN	Memi[$1]	# QPEX program buffer length
+define	PS_EXDBLEN	Memi[$1+1]	# QPEX data buffer length
+define	PS_EXMAXFRLLEN	Memi[$1+2]	# QPEX max FRLUT length
+define	PS_EXMAXRRLLEN	Memi[$1+3]	# QPEX max RRLUT length
+define	PS_EXLMINRANGES	Memi[$1+4]	# QPEX max ranges before using LUT
+define	PS_EXLSCALE	Memi[$1+5]	# QPEX scale nranges to LUT bins
+define	PS_SZPBBUF	Memi[$1+6]	# size of pushback buffer for macros
+define	PS_BUCKETLEN	Memi[$1+7]	# QPIO event file bucket size
+define	PS_FMMAXLFILES	Memi[$1+8]	# FMIO maxlfiles
+define	PS_FMMAXPTPAGES	Memi[$1+9]	# FMIO maxptpages (page table pages)
+define	PS_FMPAGESIZE	Memi[$1+10]	# FMIO pagesize
+define	PS_FMCACHESIZE	Memi[$1+11]	# FMIO buffer cache size
+define	PS_STINDEXLEN	Memi[$1+12]	# SYMTAB hash index length
+define	PS_STSTABLEN	Memi[$1+13]	# SYMTAB stab len (start)
+define	PS_STSBUFSIZE	Memi[$1+14]	# SYMTAB sbuf size (start)
+define	PS_NODEFFILT	Memi[$1+15]	# Disable use of default filter
+define	PS_NODEFMASK	Memi[$1+16]	# Disable use of default mask
+define	PS_XBLOCK	Memr[P2R($1+17)]# QPIO blocking factor in X
+define	PS_YBLOCK	Memr[P2R($1+18)]# QPIO blocking factor in Y
+define	PS_DEBUG	Memi[$1+19]	# debug level
+define	PS_OPTBUFSIZE	Memi[$1+20]	# QPIO/QPF FIO optimum buffer size 
+
+# Handy macros.
+define	IS_PUNCT	(IS_WHITE($1)||($1)==','||($1)=='\n')
+
+
+# QM_ACCESS -- Access the QPOE macro descriptor.  Once opened, this should
+# remain open for the lifetime of the process.	Since these macros are global,
+# the single descriptor is shared by all open datafiles and all tasks in the
+# process.
+
+pointer procedure qm_access()
+
+int	nfiles, fd, i
+bool	save_file_exists
+pointer	file[QM_MAXFILES]
+long	fi[LEN_FINFO], date[QM_MAXFILES], stdate
+pointer sp, qmfiles, qmsave, cbuf, qm, st, st_start, start, sym, ps, ip, op
+
+long	clktime()
+int	envfind(), finfo(), open()
+pointer stopen(), stenter(), stfind(), strestore()
+errchk	stopen, malloc, syserrs
+string	sttimekw STTIME
+define	uptodate_ 91
+data	qm /NULL/
+
+begin
+	call smark (sp)
+	call salloc (qmfiles, SZ_LINE, TY_CHAR)
+	call salloc (qmsave, SZ_PATHNAME, TY_CHAR)
+	call salloc (cbuf, QM_SZCBUF, TY_CHAR)
+
+	# Open the QM descriptor only once (per process).
+	if (qm == NULL) {
+	    # Allocate descriptor.
+	    call malloc (qm, LEN_QM, TY_STRUCT)
+
+	    # Initialize symbol table.
+	    st = stopen (QMSTNAME, DEF_LENINDEX, DEF_LENSTAB, DEF_SZSBUF)
+	    sym = stenter (st, sttimekw, SZ_LONG);  Meml[sym] = 0
+
+	    # Initialize settable interface/datafile parameters.
+	    ps = stenter (st, PSETKW, LEN_PSET)
+	    call aclri (Memi[ps], LEN_PSET)
+
+	    # Free back to here when rebuilding symbol table.
+	    call stmark (st, st_start)
+	}
+
+	# Get the QMSAVE symtab save file filename.
+	if (envfind (QMSAVE, Memc[qmsave], SZ_PATHNAME) <= 0)
+	    call strcpy (DEF_QMSAVE, Memc[qmsave], SZ_PATHNAME)
+
+	# Get the QMFILES macro define file list.
+	if (envfind (QMFILES, Memc[qmfiles], SZ_LINE) <= 0)
+	    Memc[qmfiles] = EOS
+
+	# Process the QMFILES string into a list of filenames, and get the
+	# modify date of each file.
+
+	nfiles = 0
+	op = cbuf
+	ip = qmfiles
+
+	repeat {
+	    # Get the next comma delimited argument from QMFILES.
+	    while (IS_PUNCT(Memc[ip]))
+		ip = ip + 1
+
+	    start = op
+	    while (Memc[ip] != EOS && !IS_PUNCT(Memc[ip])) {
+		Memc[op] = Memc[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+
+	    Memc[op] = EOS
+	    op = op + 1
+	    if (Memc[start] == EOS)
+		break
+
+	    # Add the file and its modify date to the file list.
+	    if (finfo (Memc[start], fi) == ERR) {
+		call eprintf ("Warning: QPOE macro file %s not found\n")
+		    call pargstr (Memc[start])
+	    } else {
+		nfiles = nfiles + 1
+		if (nfiles > QM_MAXFILES)
+		    call syserrs (SYS_QMNFILES, Memc[qmsave])
+		file[nfiles] = start
+		date[nfiles] = fi[FI_MTIME]
+	    }
+	}
+
+	# Check the dates of the MD files against the in-core symbol table
+	# and exit if the symbol table is up to date.	The date of the symbol
+	# table is stored in the table itself.
+
+	sym = stfind (st, sttimekw)
+	if (nfiles > 0 && sym != NULL) {
+	    stdate = Meml[sym]
+	    for (i=1;  i <= nfiles;  i=i+1)
+		if (date[i] > stdate)
+		    break
+	    if (i > nfiles)
+		goto uptodate_
+	}
+
+	# If a binary symtab save file exists and is up to date, load it
+	# into the descriptor.
+
+	save_file_exists = false
+	if (nfiles > 0)
+	    save_file_exists = (finfo (Memc[qmsave], fi) == OK)
+
+	if (save_file_exists) {
+	    stdate = fi[FI_MTIME]
+	    for (i=1;  i <= nfiles;  i=i+1)
+		if (date[i] > stdate)
+		    break
+	    if (i > nfiles || nfiles == 0) {
+		iferr (fd = open (Memc[qmsave], READ_ONLY, BINARY_FILE)) {
+		    call eprintf ("Warning: cannot open ")
+		    call eprintf ("QPOE macro save file %s\n")
+			call pargstr (Memc[qmsave])
+		} else {
+		    call stclose (st)
+		    st = strestore (fd)
+		    call close (fd)
+		    goto uptodate_
+		}
+	    }
+	}
+
+	# If we get here then we need to scan the MD files and build a new
+	# symbol table.
+
+	# Rebuild the symbol table.
+	call stfree (st, st_start)
+	call stmark (st, st_start)
+	QM_ST(qm) = st
+
+	for (i=1;  i <= nfiles;  i=i+1)
+	    iferr (call qm_scan (qm, Memc[file[i]], 0))
+		call erract (EA_WARN)
+
+	# Set the time of last update.
+	Meml[sym] = clktime (0)
+
+	# Update the save file if we have any defined macros.
+	if (nfiles > 0) {
+	    call intr_disable()
+	    if (save_file_exists)
+		iferr (call delete (Memc[qmsave]))
+		    call erract (EA_WARN)
+	    iferr (fd = open (Memc[qmsave], NEW_FILE, BINARY_FILE))
+		call erract (EA_WARN)
+	    else {
+		iferr (call stsave (st, fd))
+		    call erract (EA_WARN)
+		call close (fd)
+	    }
+	    call intr_enable()
+	}
+
+uptodate_
+	call sfree (sp)
+	QM_ST(qm) = st
+	return (qm)
+end
+
+
+# QM_SYMTAB -- Get a pointer to the symbol table used to store the defined
+# macros for QPOE.  The level of indirection is needed so that the QM pointer
+# can be fixed while the symtab pointer is allowed to change as the symbol
+# table is modified or rebuilt.
+
+pointer procedure qm_symtab (qm)
+
+pointer qm			#I QM descriptor
+
+begin
+	return (QM_ST(qm))
+end
+
+
+# QM_SCAN -- Scan a macro definition (MD) file and add any macros defined
+# therein into the symbol table.
+
+procedure qm_scan (qm, fname, flags)
+
+pointer qm			#I QM descriptor
+char	fname[ARB]		#I MD file name
+int	flags			#I scan flags
+
+int	fd
+int	open()
+errchk	open
+
+begin
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+	call qm_scano (qm, fd, flags)
+	call close (fd)
+end
+
+
+# QM_SCANO -- Scan a stream and parse any macro defines therein, adding the
+# defined macros to the given symbol table, and setting the values of the
+# specified interface or datafile parameters.
+#
+# The syntax of a SET statement, used to set the default values of interface
+# and datafile parameters, is as follows:
+#
+#	set parameter value
+#
+# where the parameter names are as given in <qpset.h> (case not significant).
+# Parameter values set in this way may be overridden by QP_SETI calls after
+# opening a datafile.
+#
+# The syntax of a macro define is as follows:
+#
+#	define name value
+#
+# where NAME is a simple alphanumeric identifier, and the string VALUE may
+# contain references of the form $N, N=0:9, $0 being the macro name, $1:9
+# being replaced by the arguments to the macro when it is called.  Newline
+# may be escaped to enter multiline macro definition statements.  Comments
+# and blank lines are ignored.	During macro expansion, any parenthesized
+# arguments following the macro name will be consumed only if the macro as
+# defined has symbolic arguments.  The value string will be inserted without
+# adding any whitespace at either end, and whitespace within the value string
+# is significant.
+
+procedure qm_scano (qm, fd, flags)
+
+pointer qm			#I QM descriptor
+int	fd			#I input stream
+int	flags			#I scan flags
+
+int	ch
+bool	is_define, is_set
+int	symarg, junk, buflen, i
+pointer	sp, mname, mvbuf, sym, st, op, otop
+
+bool	streq()
+int	qm_getc(), stpstr()
+pointer	stfind(), stenter()
+errchk	qm_getc, qm_setparam, stenter, stpstr, malloc, realloc
+define	next_ 91
+
+begin
+	call smark (sp)
+	call salloc (mname, SZ_MNAME, TY_CHAR)
+	call malloc (mvbuf, SZ_MVBUF, TY_CHAR)
+
+	st = QM_ST(qm)
+	junk = qm_getc (NULL, ch)
+
+	# The following can only be set true in set statements, so we must
+	# initialize the values before processing the file.
+
+	sym = stfind (st, PSETKW)
+	if (sym != NULL) {
+	    PS_NODEFFILT(sym) = NO
+	    PS_NODEFMASK(sym) = NO
+	}
+
+	# Each loop processes one newline delimited statement from the
+	# input stream.  The qm_getc function deals with continuation,
+	# blank lines and comments, etc.
+
+	repeat {
+	    # Get `define' and macro name (or `set' and parameter name).
+next_
+	    do i = 1, 2 {
+		# Get identifier token.
+		op = mname
+		otop = mname + SZ_MNAME - 1
+		while (qm_getc (fd, ch) != EOF) {
+		    if (IS_ALNUM(ch) || ch == '_') {
+			Memc[op] = ch
+			op = min (otop, op + 1)
+		    } else if (ch == '\n') {
+			if (op == mname)
+			    goto next_
+			else {
+			    call ungetci (fd, ch)
+			    break
+			}
+		    } else if (IS_WHITE(ch) && op == mname) {
+			next
+		    } else
+			break
+		}
+		Memc[op] = EOS
+
+		# Process statement type keyword.
+		if (i == 1) {
+		    is_define = (streq (Memc[mname], "define"))
+		    is_set    = (streq (Memc[mname], "set"))
+
+		    # Ignore statements other than SET or DEFINE.
+		    if (!(is_define || is_set)) {
+			while (qm_getc (fd, ch) != EOF)
+			    if (ch == '\n')
+				goto next_
+		    }
+		}
+	    }
+
+	    # Check for EOF.
+	    if (Memc[mname] == EOS)
+		break
+
+	    # Skip optional "=" if SET statement.
+	    if (is_set)
+		while (IS_WHITE(ch)) {
+		    if (qm_getc (fd, ch) == EOF)
+			break
+		    else if (ch == '\n')
+			break
+		    else if (ch == '=')
+			ch = ' '
+		}
+
+	    # Skip to value string; leave first char in ch.
+	    while (IS_WHITE(ch)) {
+		if (qm_getc (fd, ch) == EOF)
+		    break
+		else if (ch == '\n')
+		    break
+	    }
+
+	    # Get value string.  Check for the presence of any symbolic
+	    # arguments of the form $N in the process.
+
+	    symarg = 0
+	    buflen = SZ_MVBUF
+	    op = mvbuf
+
+	    Memc[op] = ch
+	    op = op + 1
+
+	    while (qm_getc (fd, ch) != EOF) {
+		if (ch == '\n')
+		    break
+		else {
+		    Memc[op] = ch
+		    if (IS_DIGIT(ch))
+			if (op > mvbuf)
+			    if (Memc[op-1] == '$')
+				symarg = max (symarg, TO_INTEG(ch))
+		    op = op + 1
+		    if (op - mvbuf == buflen) {
+			call realloc (mvbuf, buflen + SZ_MVBUF, TY_CHAR)
+			op = mvbuf + buflen
+			buflen = buflen + SZ_MVBUF
+		    }
+		}
+	    }
+	    Memc[op] = EOS
+
+	    # Process SET statements.
+	    if (is_set) {
+		call strlwr (Memc[mname])
+		call qm_setparam (qm, Memc[mname], Memc[mvbuf])
+		next
+	    }
+
+	    # Check for a redef.
+	    if (and (flags, QM_FLAGREDEFS) != 0) {
+		sym = stfind (st, Memc[mname])
+		if (sym != NULL) {
+		    call eprintf ("Warning: QPOE macro `%s' redefined\n")
+			call pargstr (Memc[mname])
+		}
+	    }
+
+	    # Enter the macro into the symbol table.
+	    sym = stenter (st, Memc[mname], LEN_SYMBOL)
+	    S_OFFSET(sym) = stpstr (st, Memc[mvbuf], 0)
+	    S_DTYPE(sym) = TY_MACRO
+	    S_FLAGS(sym) = 0
+	    if (symarg > 0)
+		S_FLAGS(sym) = SF_MACARGS
+	    else
+		S_FLAGS(sym) = 0
+	}
+
+	call mfree (mvbuf, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# QM_SETPARAM -- Set the default value of an interface or datafile parameter.
+
+procedure qm_setparam (qm, param, valstr)
+
+pointer	qm			#I QM descriptor
+char	param[ARB]		#I parameter to be set
+char	valstr[ARB]		#I parameter value
+
+pointer	ps
+double	dval
+int	value, ip, pp
+int	qp_ctoi(), qp_ctod(), strncmp()
+pointer	stfind()
+bool	streq()
+errchk	stfind
+define	err_ 91
+
+begin
+	ps = stfind (QM_ST(qm), PSETKW)
+	if (ps == NULL)
+	    return
+
+	# Accept either QP_PARAM or just PARAM.
+	pp = 1
+	if (strncmp (param, "qp_", 3) == 0)
+	    pp = 4
+
+	# Decode the parameter value - mostly integer parameters at present,
+	# except for "nodeffilt" and "nodefmask" which do not have a value,
+	# and the blocking factors, which are floating point.
+
+	ip = 1
+	if (strncmp (param[pp], "nodef", 5) == 0) {
+	    return
+	} else if (strncmp (param[pp], "block", 5) == 0) {
+	    if (qp_ctod (valstr, ip, dval) <= 0)
+		goto err_
+	    PS_XBLOCK(ps) = dval
+	    PS_YBLOCK(ps) = dval
+	    return
+	} else if (strncmp (param[pp], "xblock", 6) == 0) {
+	    if (qp_ctod (valstr, ip, dval) <= 0)
+		goto err_
+	    PS_XBLOCK(ps) = dval
+	    return
+	} else if (strncmp (param[pp], "yblock", 6) == 0) {
+	    if (qp_ctod (valstr, ip, dval) <= 0)
+		goto err_
+	    PS_YBLOCK(ps) = dval
+	    return
+	} else {
+	    if (qp_ctoi (valstr, ip, value) <= 0) {
+err_		call eprintf ("bad value `%s' for QPOE parameter `%s'\n")
+		    call pargstr (valstr)
+		    call pargstr (param)
+		return
+	    }
+	}
+
+	# Set the parameter value in the global QM descriptor.
+	if (     streq (param[pp], "bucketlen"))
+	    PS_BUCKETLEN(ps) = value
+	else if (streq (param[pp], "cachesize"))
+	    PS_FMCACHESIZE(ps) = value
+	else if (streq (param[pp], "indexlen"))
+	    PS_STINDEXLEN(ps) = value
+	else if (streq (param[pp], "maxlfiles"))
+	    PS_FMMAXLFILES(ps) = value
+	else if (streq (param[pp], "maxptpages"))
+	    PS_FMMAXPTPAGES(ps) = value
+	else if (streq (param[pp], "pagesize"))
+	    PS_FMPAGESIZE(ps) = value
+	else if (streq (param[pp], "sbufsize"))
+	    PS_STSBUFSIZE(ps) = value
+	else if (streq (param[pp], "stablen"))
+	    PS_STSTABLEN(ps) = value
+	else if (streq (param[pp], "progbuflen"))
+	    PS_EXPBLEN(ps) = value
+	else if (streq (param[pp], "databuflen"))
+	    PS_EXDBLEN(ps) = value
+	else if (streq (param[pp], "maxfrlutlen"))
+	    PS_EXMAXFRLLEN(ps) = value
+	else if (streq (param[pp], "maxrrlutlen"))
+	    PS_EXMAXRRLLEN(ps) = value
+	else if (streq (param[pp], "lutminranges"))
+	    PS_EXLMINRANGES(ps) = value
+	else if (streq (param[pp], "lutscale"))
+	    PS_EXLSCALE(ps) = value
+	else if (streq (param[pp], "maxpushback"))
+	    PS_SZPBBUF(ps) = value
+	else if (streq (param[pp], "nodeffilt"))
+	    PS_NODEFFILT(ps) = YES
+	else if (streq (param[pp], "nodefmask"))
+	    PS_NODEFMASK(ps) = YES
+	else if (streq (param[pp], "blockfactor"))
+	    { PS_XBLOCK(ps) = value;  PS_YBLOCK(ps) = value }
+	else if (streq (param[pp], "xblockfactor"))
+	    PS_XBLOCK(ps) = value
+	else if (streq (param[pp], "yblockfactor"))
+	    PS_YBLOCK(ps) = value
+	else if (streq (param[pp], "debuglevel"))
+	    PS_DEBUG(ps) = value
+	else if (streq (param[pp], "optbufsize"))
+	    PS_OPTBUFSIZE(ps) = value
+	else {
+	    call eprintf ("unknown QPOE parameter `%s' in SET statement\n")
+		call pargstr (param)
+	}
+end
+
+
+# QM_SETDEFAULTS -- Set the current default values of all interface and
+# datafile parameters in a QPOE descriptor.  Called at datafile open time
+# to get the defaults.
+
+procedure qm_setdefaults (qm, qp)
+
+pointer	qm			#I QM descriptor
+pointer	qp			#I QPOE descriptor
+
+pointer	ps
+pointer	stfind()
+int	qm_spari()
+real	qm_sparr()
+errchk	stfind
+
+begin
+	ps = stfind (QM_ST(qm), PSETKW)
+	if (ps == NULL)
+	    return
+
+	# Interface parameters.
+	QP_EXPBLEN(qp) = qm_spari (PS_EXPBLEN(ps), DEF_PROGBUFLEN)
+	QP_EXDBLEN(qp) = qm_spari (PS_EXDBLEN(ps), DEF_DATABUFLEN)
+	QP_EXMAXFRLLEN(qp) = qm_spari (PS_EXMAXFRLLEN(ps), DEF_MAXFRLUTLEN)
+	QP_EXMAXRRLLEN(qp) = qm_spari (PS_EXMAXRRLLEN(ps), DEF_MAXRRLUTLEN)
+	QP_EXLMINRANGES(qp) = qm_spari (PS_EXLMINRANGES(ps), DEF_LUTMINRANGES)
+	QP_EXLSCALE(qp) = qm_spari (PS_EXLSCALE(ps), DEF_LUTSCALE)
+	QP_SZPBBUF(qp) = qm_spari (PS_SZPBBUF(ps), DEF_MAXPUSHBACK)
+	QP_FMCACHESIZE(qp) = qm_spari (PS_FMCACHESIZE(ps), DEF_FMCACHESIZE)
+
+	# Datafile parameters.
+	QP_BUCKETLEN(qp) = qm_spari (PS_BUCKETLEN(ps), DEF_BUCKETLEN)
+	QP_FMMAXLFILES(qp) = qm_spari (PS_FMMAXLFILES(ps), DEF_FMMAXLFILES)
+	QP_FMMAXPTPAGES(qp) = qm_spari (PS_FMMAXPTPAGES(ps), DEF_FMMAXPTPAGES)
+	QP_FMPAGESIZE(qp) = qm_spari (PS_FMPAGESIZE(ps), DEF_FMPAGESIZE)
+	QP_STINDEXLEN(qp) = qm_spari (PS_STINDEXLEN(ps), DEF_STINDEXLEN)
+	QP_STSTABLEN(qp) = qm_spari (PS_STSTABLEN(ps), DEF_STSTABLEN)
+	QP_STSBUFSIZE(qp) = qm_spari (PS_STSBUFSIZE(ps), DEF_STSBUFSIZE)
+
+	# Other parameters.
+	QP_NODEFFILT(qp) = qm_spari (PS_NODEFFILT(ps), NO)
+	QP_NODEFMASK(qp) = qm_spari (PS_NODEFMASK(ps), NO)
+	QP_XBLOCK(qp) = qm_sparr (PS_XBLOCK(ps), DEF_BLOCKFACTOR)
+	QP_YBLOCK(qp) = qm_sparr (PS_YBLOCK(ps), DEF_BLOCKFACTOR)
+	QP_OPTBUFSIZE(qp) = qm_spari (PS_OPTBUFSIZE(ps), DEF_OPTBUFSIZE)
+	QP_DEBUG(qp) = qm_spari (PS_DEBUG(ps), 0)
+end
+
+
+# QM_SETPAR -- Return the given parameter value, if set in the user's macro
+# files, otherwise return the interface default.
+
+int procedure qm_setpar (userval, defval)
+
+int	userval			#I user specified value, or zero
+int	defval			#I interface default
+int	qm_spari()
+
+begin
+	return (qm_spari (userval, defval))
+end
+
+
+# QM_SPARI -- Return the given int parameter value, if set in the user's macro
+# files, otherwise return the interface default.
+
+int procedure qm_spari (userval, defval)
+
+int	userval			#I user specified value, or zero
+int	defval			#I interface default
+
+begin
+	if (userval != 0)
+	    return (userval)
+	else
+	    return (defval)
+end
+
+
+# QM_SPARR -- Return the given real parameter value, if set in the user's macro
+# files, otherwise return the interface default.
+
+real procedure qm_sparr (userval, defval)
+
+real	userval			#I user specified value, or zero
+real	defval			#I interface default
+
+begin
+	if (userval != 0)
+	    return (userval)
+	else
+	    return (defval)
+end
+
+
+# QM_UPDDEFAULTS -- Update the values in the QPOE descriptor of all interface
+# and datafile parameters set explicitly by a user macro or SET statement.
+# Only those parameters for which values were explicitly specified in the
+# use macro files are affected, allowing the use of global macros or set
+# statements to override the interface or datafile defaults.
+
+procedure qm_upddefaults (qm, qp)
+
+pointer	qm			#I QM descriptor
+pointer	qp			#I QPOE descriptor
+
+pointer	ps
+pointer	stfind()
+errchk	stfind
+
+begin
+	ps = stfind (QM_ST(qm), PSETKW)
+	if (ps == NULL)
+	    return
+
+	# Interface parameters.
+	if (PS_EXPBLEN(ps) != 0)	QP_EXPBLEN(qp) = PS_EXPBLEN(ps)
+	if (PS_EXDBLEN(ps) != 0)	QP_EXDBLEN(qp) = PS_EXDBLEN(ps)
+	if (PS_EXMAXFRLLEN(ps) != 0)	QP_EXMAXFRLLEN(qp) = PS_EXMAXFRLLEN(ps)
+	if (PS_EXMAXRRLLEN(ps) != 0)	QP_EXMAXRRLLEN(qp) = PS_EXMAXRRLLEN(ps)
+	if (PS_EXLMINRANGES(ps) != 0)	QP_EXLMINRANGES(qp)= PS_EXLMINRANGES(ps)
+	if (PS_EXLSCALE(ps) != 0)	QP_EXLSCALE(qp) = PS_EXLSCALE(ps)
+	if (PS_SZPBBUF(ps) != 0)	QP_SZPBBUF(qp) = PS_SZPBBUF(ps)
+	if (PS_FMCACHESIZE(ps) != 0)	QP_FMCACHESIZE(qp) = PS_FMCACHESIZE(ps)
+
+	# Datafile parameters.
+	if (PS_BUCKETLEN(ps) != 0)	QP_BUCKETLEN(qp) = PS_BUCKETLEN(ps)
+	if (PS_FMMAXLFILES(ps) != 0)	QP_FMMAXLFILES(qp) = PS_FMMAXLFILES(ps)
+	if (PS_FMMAXPTPAGES(ps) != 0)	QP_FMMAXPTPAGES(qp)= PS_FMMAXPTPAGES(ps)
+	if (PS_FMPAGESIZE(ps) != 0)	QP_FMPAGESIZE(qp) = PS_FMPAGESIZE(ps)
+	if (PS_STINDEXLEN(ps) != 0)	QP_STINDEXLEN(qp) = PS_STINDEXLEN(ps)
+	if (PS_STSTABLEN(ps) != 0)	QP_STSTABLEN(qp) = PS_STSTABLEN(ps)
+	if (PS_STSBUFSIZE(ps) != 0)	QP_STSBUFSIZE(qp) = PS_STSBUFSIZE(ps)
+
+	# Other parameters.
+	if (PS_NODEFFILT(ps) != 0)	QP_NODEFFILT(qp) = PS_NODEFFILT(ps)
+	if (PS_NODEFMASK(ps) != 0)	QP_NODEFMASK(qp) = PS_NODEFMASK(ps)
+	if (PS_XBLOCK(ps) != 0)		QP_XBLOCK(qp) = PS_XBLOCK(ps)
+	if (PS_YBLOCK(ps) != 0)		QP_YBLOCK(qp) = PS_YBLOCK(ps)
+	if (PS_OPTBUFSIZE(ps) != 0)	QP_OPTBUFSIZE(qp) = PS_OPTBUFSIZE(ps)
+	if (PS_DEBUG(ps) != 0)		QP_DEBUG(qp) = PS_DEBUG(ps)
+end
+
+
+# QM_GETC -- Return the next character from the input stream, ignoring
+# comments and joining continued lines.  The character value or EOF is
+# returned as the function value.  A call with FD=0 will initialize i/o
+# for a new file.
+
+int procedure qm_getc (fd, ch)
+
+int	fd			#I input file
+int	ch			#O returned character
+
+int	quote
+int	getci()
+errchk	getci
+define	again_ 91
+
+begin
+	# Initialization.
+	if (fd <= 0) {
+	    quote = 0
+	    return (0)
+	}
+
+	# Handle the most common cases first.
+again_
+	if (getci (fd, ch) == EOF) {
+	    quote = 0
+	    return (EOF)
+	} else if (IS_ALNUM(ch))
+	    return (ch)
+
+	# Handle the special cases - comments, escapes, quoted strings.
+	if (ch == '#' && quote == 0) {
+	    # Skip a comment.
+	    while (getci (fd, ch) != EOF)
+		if (ch == '\n')
+		    goto again_
+	} else if (ch == '\'' || ch == '"') {
+	    # Toggle quoted string flag.
+	    if (quote == 0)
+		quote = ch
+	    else if (quote == ch)
+		quote = 0
+	} else if (ch == '\\') {
+	    # Process escapes.
+	    if (getci (fd, ch) == '\n')
+		goto again_
+	    else if (quote == 0 && (ch == '\'' || ch == '"' || ch == '#'))
+		;
+	    else {
+		call ungetci (fd, ch)
+		ch = '\\'
+	    }
+	}
+
+	# Init context at end of every logical line.
+	if (ch == '\n')
+	    quote = 0
+
+	return (ch)
+end
diff --git a/sys/qpoe/qpmkfname.x b/sys/qpoe/qpmkfname.x
new file mode 100644
index 00000000..3721f6f4
--- /dev/null
+++ b/sys/qpoe/qpmkfname.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_MKFNAME -- Construct the poefile filename, i.e., eliminate any whitespace
+# and add the given extension if omitted.
+
+procedure qp_mkfname (poefile, extn, fname, maxch)
+
+char	poefile[ARB]		#I raw poefile name
+char	extn[ARB]		#I extension to be added if absent
+char	fname[maxch]		#O output filename
+int	maxch			#I max chars out
+
+int	n
+bool	strne()
+int	nowhite()
+
+begin
+	n = nowhite (poefile, fname, maxch)
+	if (n <= 3 || strne (fname[n-2], extn))
+	    call strcpy (extn, fname[n+1], maxch-n)
+end
diff --git a/sys/qpoe/qpoe.h b/sys/qpoe/qpoe.h
new file mode 100644
index 00000000..41d07059
--- /dev/null
+++ b/sys/qpoe/qpoe.h
@@ -0,0 +1,115 @@
+# QPOE.H -- QPOE data definitions (private to the package).
+
+# Size limiting definitions.
+define	DEF_BLOCKFACTOR	1.0		# default block factor for image matrix
+define	DEF_BUCKETLEN	1024		# def nevents per bucket
+define	DEF_FMMAXLFILES 128		# def maxlfile per datafile
+define	DEF_FMMAXPTPAGES 256		# def maxptpages per datafile
+define	DEF_FMPAGESIZE	512		# def datafile page size
+define	DEF_FMCACHESIZE 8		# def buffer cache size
+define	DEF_STINDEXLEN	100		# def symtab hash index len
+define	DEF_STSTABLEN	2048		# initial symbol table len
+define	DEF_STSBUFSIZE	2048		# initial string buf size
+define	DEF_MAXPUSHBACK	8192		# max pushed back chars (macros)
+define	DEF_OPTBUFSIZE	(512*512*2)	# default buffer size for IMIO/QPF/FIO
+define	MAX_INDIR	20		# max macro indirection
+define	MAX_REDEF	20		# max entries for a symbol
+define	MAX_FIELDS	50		# max fields in a user structure
+define	INC_STRLEN	32		# unit of storage for strings
+define	LEN_PVAL	64		# max TY_USER struct size (in doubles)
+define	SZ_QPDFNAME	255		# max size QPOE filename
+define	SZ_TEXTBUF	2048		# handy text buffer for macro expansion
+define	SZ_TOKBUF	256		# token buffer size
+
+# Magic numbers.
+define	LF_QPOE 	1		# QPOE file header and symbol table
+define	LF_STATICPARS	2		# static (fixed size) params
+define	QPOE_MAGIC	121120B		# QPOE magic code (descriptor type)
+define	QPOE_VERSION	101		# QPOE interface version number
+define	QPOE_TITLE	"QPOE-V1.2"	# title string, for symbol table
+define	QPOE_EXTN	".qp"		# QPOE file extension
+define	QPOE_MACROEXTN	".qpm"		# QPOE macro definitions file extension
+define	QPWCS		"qpwcs"		# header parameter for default WCS
+define	IMMEDIATE	0		# for qp_sizeof
+define	INSTANCEOF	1		# for qp_sizeof
+
+# The main QPOE descriptor.
+define	LEN_QPDES	160
+define	QP_MAGIC	Memi[$1]	# descriptor type code
+define	QP_VERSION	Memi[$1+1]	# QPOE version number
+define	QP_ACTIVE	Memi[$1+2]	# descriptor fully activated
+define	QP_FM		Memi[$1+3]	# datafile handle
+define	QP_ST		Memi[$1+4]	# datafile symbol table handle
+define	QP_QM		Memi[$1+5]	# global QPOE symbol table handle
+define	QP_MODE		Memi[$1+6]	# datafile access mode
+define	QP_OQP		Memi[$1+7]	# o_qp, if new copy file
+define	QP_EXPBLEN	Memi[$1+8]	# QPEX program buffer length
+define	QP_EXDBLEN	Memi[$1+9]	# QPEX data buffer length
+define	QP_EXMAXFRLLEN	Memi[$1+10]	# QPEX max FRLUT length
+define	QP_EXMAXRRLLEN	Memi[$1+11]	# QPEX max RRLUT length
+define	QP_EXLMINRANGES	Memi[$1+12]	# QPEX min ranges before using LUT
+define	QP_EXLSCALE	Memi[$1+13]	# QPEX scale nranges to LUT bins
+define	QP_SZPBBUF	Memi[$1+14]	# size of pushback buffer for macros
+define	QP_BUCKETLEN	Memi[$1+15]	# QPIO event file bucket size
+define	QP_FMMAXLFILES	Memi[$1+16]	# FMIO maxlfiles
+define	QP_FMMAXPTPAGES	Memi[$1+17]	# FMIO maxptpages
+define	QP_FMPAGESIZE	Memi[$1+18]	# FMIO pagesize
+define	QP_FMCACHESIZE	Memi[$1+19]	# FMIO buffer cache size
+define	QP_STINDEXLEN	Memi[$1+20]	# SYMTAB hash index length
+define	QP_STSTABLEN	Memi[$1+21]	# SYMTAB stab len (start)
+define	QP_STSBUFSIZE	Memi[$1+22]	# SYMTAB sbuf size (start)
+define	QP_STOFFSET	Memi[$1+23]	# lfile offset of stored symbol table
+define	QP_MODIFIED	Memi[$1+24]	# QPOE descriptor has been modified
+define	QP_DEBUG	Memi[$1+25]	# global debug level (debug messages)
+define	QP_XBLOCK	Memr[P2R($1+26)]# default X blocking factor for QPIO
+define	QP_YBLOCK	Memr[P2R($1+27)]# default Y blocking factor for QPIO
+define	QP_OPTBUFSIZE	Memi[$1+28]	# optimum buffer size for IMIO/QPF/FIO
+define	QP_NODEFFILT	Memi[$1+29]	# disable use of default filter
+define	QP_NODEFMASK	Memi[$1+30]	# disable use of default mask
+define	QP_DFNAME	Memc[P2C($1+31)] # QPOE filename (for messages)
+
+# Symbol descriptor.
+define	LEN_SYMBOL	9
+define	S_FLAGS 	Memi[$1]	# integer flag word
+define	S_DTYPE 	Memi[$1+1]	# datatype code
+define	S_DSYM		Memi[$1+2]	# offset of domain symbol if TY_USER
+define	S_NELEM 	Memi[$1+3]	# number of elements of dtype
+define	S_MAXELEM	Memi[$1+4]	# allocated length
+define	S_SZELEM	Memi[$1+5]	# elsize, chars (primary domains only)
+define	S_COMMENT	Memi[$1+6]	# pointer to comment string in sbuf
+define	S_LFILE 	Memi[$1+7]	# lfile where value is stored
+define	S_OFFSET	Memi[$1+8]	# char offset of value in lfile
+
+# Symbol flags.
+define	SF_DELETED	0001B		# symbol has been deleted
+define	SF_INHERIT	0002B		# inherit in NEW_COPY mode
+define	SF_MACARGS	0004B		# macro symbol has symbolic arguments
+
+# QPOE special datatypes.
+define	SPPTYPES	"bcsilrdx"	# index is SPP TY_xxx type code
+define	TY_MACRO	15		# datafile local macro define
+define	TY_OPAQUE	16		# opaque (typeless) binary type
+define	TY_USER		17		# some user defined type
+
+# Lexical tokens.
+define	TOK_IDENTIFIER	(-99)
+define	TOK_NUMBER	(-98)
+define	TOK_STRING	(-97)
+define	TOK_COMMAND	(-96)
+define	TOK_PLUSEQUALS	(-95)
+define	TOK_COLONEQUALS	(-94)
+
+# QPOE header as stored in datafile.
+define	LEN_QPH		32
+define	QPH_MAGIC	Memi[$1]
+define	QPH_VERSION	Memi[$1+1]
+define	QPH_STOFFSET	Memi[$1+2]
+
+# Domain descriptor structure.
+define	LEN_DDDES	110
+define	DD_STRUCTLEN	Memi[$1]	# structure length, su
+define	DD_NFIELDS	Memi[$1+1]	# number of fields in user structure
+define	DD_XFIELD	Memi[$1+2]	# field assigned to coordinate "x"
+define	DD_YFIELD	Memi[$1+3]	# field assigned to coordinate "y"
+define	DD_FOFFSET	Memi[$1+10+$2-1]# array of field offsets
+define	DD_FTYPE	Memi[$1+60+$2-1]# array of field datatypes
diff --git a/sys/qpoe/qpopen.x b/sys/qpoe/qpopen.x
new file mode 100644
index 00000000..d2b7e0b4
--- /dev/null
+++ b/sys/qpoe/qpopen.x
@@ -0,0 +1,132 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <fmset.h>
+include "qpoe.h"
+include "qpio.h"
+
+# QP_OPEN -- Open or create a QPOE datafile.  This routine must be called
+# before the poefile can be accessed.  In the case of a create, the file
+# parameters are not fixed until the first i/o or header access occurs,
+# allowing one to use QP_SET calls to modify the file parameters after the
+# open.
+
+pointer procedure qp_open (poefile, mode, o_qp)
+
+char	poefile[ARB]		#I QPOE file to be opened
+int	mode			#I file access mode
+pointer o_qp			#I reference file, if NEW_COPY
+
+int	fmmode, fd, n
+pointer sp, qph, qp, fname, fm
+
+real	qp_getr()
+pointer fm_open(), strestore(), qm_access()
+int	fm_fopen(), read(), fm_stati(), qp_accessf()
+errchk	fm_open, strestore, fm_fopen, seek, read
+errchk	calloc, syserrs, qm_access
+
+string	s_defblock DEF_BLOCK
+string	s_defxblock DEF_XBLOCK
+string	s_defyblock DEF_YBLOCK
+
+begin
+	call smark (sp)
+	call salloc (qph, LEN_QPH, TY_STRUCT)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Construct the filename (with extension .qp) of the poefile.
+	call qp_mkfname (poefile, QPOE_EXTN, Memc[fname], SZ_PATHNAME)
+
+	# Open or create the poefile via the file manager.
+	fmmode = mode
+	if (mode == NEW_COPY)
+	    fmmode = NEW_FILE
+	fm = fm_open (Memc[fname], fmmode)
+
+	# Allocate the QPOE descriptor.
+	call calloc (qp, LEN_QPDES, TY_STRUCT)
+	call strcpy (Memc[fname], QP_DFNAME(qp), SZ_QPDFNAME)
+
+	# Access the global macro database, and set the default values of
+	# all interface and datafile parameters.
+
+	QP_QM(qp) = qm_access()
+	call qm_setdefaults (QP_QM(qp), qp)
+
+	QP_MODE(qp) = mode
+	QP_OQP(qp) = o_qp
+	QP_FM(qp) = fm
+
+	if (mode == NEW_FILE || mode == NEW_COPY) {
+	    # Initialize the descriptor for a new poefile.  The file
+	    # attributes are not fixed until the file is accessed, to
+	    # allow time to change the defaults with qp_seti.
+
+	    QP_MAGIC(qp) = QPOE_MAGIC
+	    QP_VERSION(qp) = QPOE_VERSION
+
+	    if (mode == NEW_COPY) {
+		# Inherit datafile defaults from parent file.
+		QP_BUCKETLEN(qp)	= QP_BUCKETLEN(o_qp)
+		QP_FMMAXLFILES(qp)	= QP_FMMAXLFILES(o_qp)
+		QP_FMMAXPTPAGES(qp)	= QP_FMMAXPTPAGES(o_qp)
+		QP_FMPAGESIZE(qp)	= QP_FMPAGESIZE(o_qp)
+		QP_FMCACHESIZE(qp)	= QP_FMCACHESIZE(o_qp)
+		QP_STINDEXLEN(qp)	= QP_STINDEXLEN(o_qp)
+		QP_STSTABLEN(qp)	= QP_STSTABLEN(o_qp)
+		QP_STSBUFSIZE(qp)	= QP_STSBUFSIZE(o_qp)
+	    }
+
+	    QP_ACTIVE(qp) = NO
+
+	} else {
+	    # Open an existing poefile.  The encoded QPOE header and
+	    # symbol table are stored in a binary lfile in the datafile.
+
+	    fd = fm_fopen (fm, LF_QPOE, READ_ONLY, BINARY_FILE)
+
+	    # Read the QPOE file header.
+	    n = LEN_QPH * SZ_STRUCT
+	    call aclri (Memi[qph], LEN_QPH)
+	    if (read (fd, Memi[qph], n) < n)
+		call syserrs (SYS_QPBADFILE, QP_DFNAME(qp))
+	    call miiupk32 (Memi[qph], Memi[qph], LEN_QPH, TY_STRUCT)
+
+	    QP_MAGIC(qp)	= QPH_MAGIC(qph)
+	    QP_VERSION(qp)	= QPH_VERSION(qph)
+	    QP_STOFFSET(qp)	= QPH_STOFFSET(qph)
+
+	    if (QP_MAGIC(qp) != QPOE_MAGIC)
+		call syserrs (SYS_QPBADFILE, QP_DFNAME(qp))
+
+	    # Read the stored symbol table.
+	    call seek (fd, QP_STOFFSET(qp))
+	    QP_ST(qp) = strestore (fd)
+
+	    # Initialize any remaining QP descriptor parameters.
+	    QP_FMPAGESIZE(qp) = fm_stati (fm, FM_PAGESIZE)
+	    call fm_seti (fm, FM_FCACHESIZE, DEF_FMCACHESIZE)
+	    QP_ACTIVE(qp) = YES
+
+	    # See if the default block factor is set in the datafile header.
+	    if (qp_accessf (qp, s_defblock) == YES) {
+		QP_XBLOCK(qp) = qp_getr (qp, s_defblock)
+		QP_YBLOCK(qp) = QP_XBLOCK(qp)
+	    }
+	    if (qp_accessf (qp, s_defxblock) == YES)
+		QP_XBLOCK(qp) = qp_getr (qp, s_defxblock)
+	    if (qp_accessf (qp, s_defyblock) == YES)
+		QP_YBLOCK(qp) = qp_getr (qp, s_defyblock)
+
+	    call close (fd)
+	}
+
+	# Allow any interface parameters set explicitly in global macro SET
+	# statements to override the inherited or datafile values set above.
+
+	call qm_upddefaults (QP_QM(qp), qp)
+
+	call sfree (sp)
+	return (qp)
+end
diff --git a/sys/qpoe/qpparse.x b/sys/qpoe/qpparse.x
new file mode 100644
index 00000000..2bbd5cea
--- /dev/null
+++ b/sys/qpoe/qpparse.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# QP_PARSE -- Parse a QPOE/QPIO specification into the root (poefile) name
+# and event list filter expression fields.
+#
+#	Syntax:		root[filter]
+#
+# where the filter spec is optional.
+
+procedure qp_parse (qpspec, root, sz_root, filter, sz_filter)
+
+char	qpspec[ARB]		#I full event list specification
+char	root[sz_root]		#O receives root name
+int	sz_root			#I max chars in root name
+char	filter[sz_filter]	#O receives filter
+int	sz_filter		#I max chars in filter name
+
+int	level, ip, op, ch
+
+begin
+	ip = 1
+	op = 1
+
+	# Extract root name.  The first (unescaped) [ marks the start of
+	# the filter field.
+
+	for (ch=qpspec[ip];  ch != EOS && ch != '[';  ch=qpspec[ip]) {
+	    if (ch == '\\' && qpspec[ip+1] == '[') {
+		root[op] = '\\'
+		op = op + 1
+		root[op] = '['  
+		ip = ip + 1
+	    } else
+		root[op] = ch
+
+	    op = min (sz_root, op + 1)
+	    ip = ip + 1
+	}
+
+	root[op] = EOS
+	level = 0
+	op = 1
+
+	# Extract the [] bracketed filter expression, allowing for nested
+	# brackets.
+
+	for (ch=qpspec[ip];  ch != EOS;  ch=qpspec[ip]) {
+	    if (ch == '[')
+		level = level + 1
+	    else if (ch == ']')
+		level = level - 1
+		    
+	    filter[op] = ch
+	    op = min (sz_filter, op + 1)
+
+	    ip = ip + 1
+	    if (level <= 0)
+		break
+	}
+
+	# Add closing brace if the user left it off.
+	if (op > 1 && ch != ']') {
+	    filter[op] = ']'
+	    op = min (sz_filter, op + 1)
+	}
+
+	filter[op] = EOS
+end
diff --git a/sys/qpoe/qpparsefl.x b/sys/qpoe/qpparsefl.x
new file mode 100644
index 00000000..566274fb
--- /dev/null
+++ b/sys/qpoe/qpparsefl.x
@@ -0,0 +1,149 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+include	"qpex.h"
+
+# QP_PARSEFL -- Parse the field list, or declarations string for a user
+# defined datatype (structure or domain).
+#
+# Syntax:	{ type1, type2, ..., typeN }
+#
+# e.g.,		{d,s:x,s:y,s,s,s,s}	(Rosat/PROS event structure)
+#
+# where the TYPEi are primitive types, e.g., "r" or "real", "i" or "int",
+# etc.  Selected fields may have ":x" or ":y" appended to indicate that these
+# are the default coordinate fields to be used for position based extraction.
+# Fields will be automatically aligned as necessary, and the computed structure
+# size will be forced to be an integral multiple of the largest datatype
+# within the structure, to ensure proper alignment in arrays of the structures.
+
+int procedure qp_parsefl (qp, fieldlist, dd)
+
+pointer	qp			#I QPOE descriptor
+char	fieldlist[ARB]		#I field list defining new datatype (domain)
+pointer	dd			#U pointer to domain descriptor
+
+pointer	sp, tokbuf, dsym, in
+int	nfields, offset, maxsize, xfield, yfield, token, dtype, fsize
+
+pointer	qp_opentext()
+int	qp_gettok(), qp_nexttok(), sizeof(), qp_dtype()
+errchk	qp_gettok, qp_opentext, qp_nexttok
+string	qperr "QPOE structdef"
+define	nextfield_ 91
+
+begin
+	call smark (sp)
+	call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
+
+	# Open declarations string for non macro expanded token input.
+	in = qp_opentext (NULL, fieldlist)
+
+	# Advance to structure terms list.
+	while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
+	    if (Memc[tokbuf] == '{')
+		break
+
+	nfields = 0
+	offset  = 0
+	maxsize = 0
+	xfield  = 0
+	yfield  = 0
+
+	# Process the structure terms list.
+	repeat {
+	    token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+
+	    switch (token) {		# {
+	    case EOF, '}':
+		break
+
+	    case TOK_IDENTIFIER:
+		# Get field datatype and size.
+		dtype = qp_dtype (qp, Memc[tokbuf], dsym)
+		if (dtype < TY_BOOL || dtype > TY_COMPLEX) {
+		    call eprintf ("%s: bad field type `%s'\n")
+			call pargstr (qperr)
+			call pargstr (Memc[tokbuf])
+		    goto nextfield_
+		} else
+		    fsize = sizeof (dtype)
+
+		# Output field descriptor.
+		nfields = nfields + 1
+		if (nfields > MAX_FIELDS) {
+		    call eprintf ("%s: too many fields `%s'\n")
+			call pargstr (qperr)
+			call pargstr (Memc[tokbuf])
+		    break
+		}
+		DD_FOFFSET(dd,nfields) = (offset + fsize-1) / fsize
+		DD_FTYPE(dd,nfields)   = dtype
+
+		# Update structure size parameters.
+		offset = (DD_FOFFSET(dd,nfields) * fsize) + fsize
+		maxsize = max (maxsize, fsize)
+
+		# Process any :[XY] field modifiers.
+		if (qp_nexttok(in) == ':') {
+		    repeat {
+			token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+			switch (Memc[tokbuf]) {
+			case ':':
+			    next
+			case 'x':
+			    if (xfield != 0) {
+				call eprintf ("%s: duplicate X field `%s'\n")
+				    call pargstr (qperr)
+				    call pargstr (Memc[tokbuf])
+			    }
+			    xfield = nfields
+			    break
+			case 'y':
+			    if (yfield != 0) {
+				call eprintf ("%s: duplicate Y field `%s'\n")
+				    call pargstr (qperr)
+				    call pargstr (Memc[tokbuf])
+			    }
+			    yfield = nfields
+			    break
+			default:
+			    call eprintf ("%s: unknown : field modifier `%s'\n")
+				call pargstr (qperr)
+				call pargstr (Memc[tokbuf])
+			}
+		    }
+		    goto nextfield_
+		}
+	    case ',':
+		next
+	    default:
+		call eprintf ("%s: unexpected token `%s'\n")
+		    call pargstr (qperr)
+		    call pargstr (Memc[tokbuf])
+	    }
+
+nextfield_
+	    # Read and discard tokens until we get to the next field.
+	    while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
+		if (Memc[tokbuf] == ',')
+		    break
+	}
+
+	# Complete the domain descriptor initialization.
+	DD_NFIELDS(dd) = nfields
+	DD_XFIELD(dd)  = xfield
+	DD_YFIELD(dd)  = yfield
+
+	# Pad the struct size to an integral multiple of the max field size.
+	if (nfields > 0) {
+	    maxsize = max (SZ_STRUCT, maxsize)
+	    DD_STRUCTLEN(dd) = (offset+maxsize-1)/maxsize*maxsize / SZ_STRUCT
+	} else
+	    DD_STRUCTLEN(dd) = 0
+
+	call qp_closetext (in)
+	call sfree (sp)
+
+	return (nfields)
+end
diff --git a/sys/qpoe/qppclose.x b/sys/qpoe/qppclose.x
new file mode 100644
index 00000000..7a0bc9ab
--- /dev/null
+++ b/sys/qpoe/qppclose.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+
+# QP_PCLOSE -- Close a parameter opened as a file with QP_POPEN.  This
+# differs from a simple call to fio.close in that the lfile used to store
+# the parameter data is unlocked, as well as closing the file under FIO.
+
+procedure qp_pclose (fd)
+
+int	fd		#I file descriptor of QP_POPEN-ed parameter
+
+int	lfile, type
+pointer	sp, lfname, fm
+int	fm_lfparse()
+
+begin
+	call smark (sp)
+	call salloc (lfname, SZ_FNAME, TY_CHAR)
+
+	call fstats (fd, F_FILENAME, Memc[lfname], SZ_FNAME)
+	if (fm_lfparse (Memc[lfname], fm, lfile, type) != ERR)
+	    call fm_unlock (fm, lfile)
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qppopen.x b/sys/qpoe/qppopen.x
new file mode 100644
index 00000000..4b0e2191
--- /dev/null
+++ b/sys/qpoe/qppopen.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_POPEN -- Open a variable-array type parameter as a file.  A call to
+# fio.close is used to close the file.  Note that the varlen parameter, which
+# is stored in its own lfile in the datafile, is opened directly as a file
+# independently of the FMIO file buffer cache.  Most QPOE parameter i/o is
+# via the cache, hence mixing QP_POPEN calls with ordinary QPOE i/o on the
+# same parameter at the same time could lead to loss of data integrity due
+# to the same lfile being opened simultaneously on two different file
+# descriptors.  We ensure that the lfile is not in the file cache at qp_popen
+# time, but no checks are made once the file has been opened.  A FIO file
+# descriptor is returned as the function value; CLOSE should be called to
+# close the file descriptor when it is no longer needed.
+
+int procedure qp_popen (qp, param, mode, type)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+int	mode			#I file(param) access mode
+int	type			#I file type, text or binary
+
+pointer	sym
+int	fm_fopen()
+pointer	qp_gpsym()
+errchk	qp_gpsym, qp_addf(), fm_lockout, syserrs
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	# Lookup the parameter; make sure it is a varlen parameter.
+	# Create a new parameter if none exists and the mode is NEW_FILE.
+
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL) {
+	    if (mode != NEW_FILE)
+		call syserrs (SYS_QPUKNPAR, param)
+	    else {
+		# Create a new parameter.
+		if (type == TEXT_FILE)
+		    call qp_addf (qp, param, "c", 0, "", 0)
+		else
+		    call qp_addf (qp, param, "opaque", 0, "", 0)
+		sym = qp_gpsym (qp, param)
+		if (sym == NULL)
+		    call syserrs (SYS_QPUKNPAR, param)
+	    }
+	} else if (S_MAXELEM(sym) != 0)
+	    call syserrs (SYS_QPPOPEN, param)
+
+	# Place a lock on the file and then remove it, to cause an error
+	# if the lfile is already active in the file cache.
+
+	call fm_lockout (QP_FM(qp), S_LFILE(sym))
+	call fm_unlock  (QP_FM(qp), S_LFILE(sym))
+
+	# Open the assigned lfile and return the file descriptor.
+	return (fm_fopen (QP_FM(qp), S_LFILE(sym), mode, type))
+end
diff --git a/sys/qpoe/qpppar.x b/sys/qpoe/qpppar.x
new file mode 100644
index 00000000..17d9496d
--- /dev/null
+++ b/sys/qpoe/qpppar.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"qpoe.h"
+
+# QP_PUTPARAM -- Lookup the named parameter in the symbol table and return
+# a pointer to a buffer into which the scalar parameter value is to be
+# placed.  A subsequent call to QPOE_FLUSHPAR updates the parameter value
+# in the datafile.  A NULL pointer is returned if the parameter exists but
+# does not currently have a value.  The parameter datatype code is returned
+# as the function value.
+
+int procedure qp_putparam (qp, param, o_pp)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+pointer	o_pp			#O pointer to parameter value
+
+bool	first_time
+pointer	sp, key, fm, op
+int	loc_pval, loc_Mem, ip, ch, sz_elem
+data	first_time /true/
+
+int	elem
+pointer	pp, sym
+bool	put_value
+double	pval[LEN_PVAL+1]
+common	/qppval/ pval, sym, elem, pp, put_value
+
+pointer	qp_gpsym()
+int	ctoi(), qp_sizeof()
+errchk	qp_bind, syserrs
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	fm = QP_FM(qp)
+
+        # Compute pointer (Memc index) to the static pval buffer.
+	# Make sure that the computed pointer is double aligned.
+
+	if (first_time) {
+	    call zlocva (pval, loc_pval)
+	    call zlocva (Memc, loc_Mem)
+	    pp = (loc_pval+SZ_DOUBLE - loc_Mem) / SZ_DOUBLE * SZ_DOUBLE + 1
+	    put_value = false
+	    first_time = false
+	} else if (put_value)
+	    call qp_flushpar (qp)
+
+	# Extract the primary parameter name, minus any whitespace and
+	# subscript (e.g., "param[elem]").
+
+	op = key
+	do ip = 1, SZ_FNAME {
+	    ch = param[ip]
+	    if (IS_WHITE(ch))
+		next
+	    else if (ch == '[')
+		break
+	    Memc[op] = ch
+	    op = op + 1
+	}
+	Memc[op] = EOS
+
+	# Determine the array element (default [1]).
+	elem = 1
+	if (param[ip] == '[') {
+	    ip = ip + 1
+	    if (ctoi (param, ip, elem) <= 0)
+		elem = 1
+	}
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, Memc[key])
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+
+	# Check to make sure storage for the parameter value exists, and
+	# set the parameter buffer pointer for the indicated datatype.
+
+	sz_elem = qp_sizeof (qp, S_DTYPE(sym), sym, INSTANCEOF)
+	if (sz_elem > LEN_PVAL * SZ_DOUBLE)
+	    call syserrs (SYS_QPPVALOVF, QP_DFNAME(qp))
+
+	if (elem < 1 || elem > S_MAXELEM(sym))
+	    o_pp = NULL
+	else if (S_DTYPE(sym) == TY_USER)
+	    o_pp = (pp - 1) / SZ_STRUCT + 1
+	else
+	    o_pp = (pp - 1) / sz_elem + 1
+
+	# Set a flag to flush the value after the user has entered it.
+	put_value = true
+
+	call sfree (sp)
+	return (S_DTYPE(sym))
+end
+
+
+# QP_FLUSHPAR -- Update the saved parameter value in the indicated lfile.
+# Repeated calls are harmless.
+
+procedure qp_flushpar (qp)
+
+pointer	qp			#I QPOE descriptor
+
+int	sz_elem, fd
+int	qp_sizeof(), fm_getfd()
+errchk	fm_getfd, seek, write
+
+int	elem
+pointer	pp, sym
+bool	put_value
+double	pval[LEN_PVAL+1]
+common	/qppval/ pval, sym, elem, pp, put_value
+
+begin
+	if (put_value) {
+	    sz_elem = qp_sizeof (qp, S_DTYPE(sym), S_DSYM(sym), INSTANCEOF)
+	    fd = fm_getfd (QP_FM(qp), S_LFILE(sym), READ_WRITE, 0)
+
+	    call seek (fd, S_OFFSET(sym) + (elem - 1) * sz_elem)
+	    call write (fd, Memc[pp], sz_elem)
+	    S_NELEM(sym) = max (S_NELEM(sym), elem)
+	    QP_MODIFIED(qp) = YES
+
+	    call fm_retfd (QP_FM(qp), S_LFILE(sym))
+	    put_value = false
+	}
+end
diff --git a/sys/qpoe/qppstr.x b/sys/qpoe/qppstr.x
new file mode 100644
index 00000000..9ab2b402
--- /dev/null
+++ b/sys/qpoe/qppstr.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "qpoe.h"
+
+# QP_PSTR -- Update the string value of the named parameter.
+
+procedure qp_pstr (qp, param, strval)
+
+pointer qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	strval[ARB]		#I new string value
+
+pointer	fm, sym
+int	fd, nchars
+
+pointer	qp_gpsym()
+int	fm_getfd(), strlen()
+errchk	qp_bind, qp_gpsym, syserrs, fm_getfd, seek
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	fm = QP_FM(qp)
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+	else if (S_DTYPE(sym) != TY_CHAR)
+	    call syserrs (SYS_QPBADCONV, param)
+
+	# Update the value of the parameter in the datafile.
+	fd = fm_getfd (fm, S_LFILE(sym), READ_WRITE, 0)
+	call seek (fd, S_OFFSET(sym))
+
+	nchars = strlen (strval)
+	if (S_MAXELEM(sym) > 0)
+	    nchars = min (S_MAXELEM(sym), nchars)
+
+	call write (fd, strval, nchars)
+	S_NELEM(sym) = nchars
+	QP_MODIFIED(qp) = YES
+
+	call fm_retfd (fm, S_LFILE(sym))
+end
diff --git a/sys/qpoe/qpput.gx b/sys/qpoe/qpput.gx
new file mode 100644
index 00000000..871b2943
--- /dev/null
+++ b/sys/qpoe/qpput.gx
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"../qpoe.h"
+
+# QP_PUT -- Set the value of the named header parameter.  Automatic type
+# conversion is performed where possible.  While only scalar values can be
+# set by this function, the scalar may be an element of a one-dimensional
+# array, e.g., "param[N]".
+
+procedure qp_put$t (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+PIXEL	value			#I scalar parameter value
+
+pointer	pp
+bool	indef
+int	dtype
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	dtype = qp_putparam (qp, param, pp)
+	if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	if (QP_DEBUG(qp) > 1) {
+	    call eprintf ("qp_put: `%s', TYP=(%d->%d), new value %g\n")
+		call pargstr (param)
+		call pargi (TY_PIXEL)
+		call pargi (dtype)
+		call parg$t (value)
+	}
+
+	indef = IS_INDEF(value)
+
+	# Set the parameter value.
+	switch (dtype) {
+	case TY_CHAR:
+	    Memc[pp] = value
+	case TY_SHORT:
+	    if (indef)
+		Mems[pp] = INDEFS
+	    else
+		Mems[pp] = value
+	case TY_INT:
+	    if (indef)
+		Memi[pp] = INDEFI
+	    else
+		Memi[pp] = value
+	case TY_LONG:
+	    if (indef)
+		Meml[pp] = INDEFL
+	    else
+		Meml[pp] = value
+	case TY_REAL:
+	    if (indef)
+		Memr[pp] = INDEFR
+	    else
+		Memr[pp] = value
+	case TY_DOUBLE:
+	    if (indef)
+		Memd[pp] = INDEFD
+	    else
+		Memd[pp] = value
+	default:
+	    call syserrs (SYS_QPBADCONV, param)
+	}
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/qpputb.x b/sys/qpoe/qpputb.x
new file mode 100644
index 00000000..da7f7ba8
--- /dev/null
+++ b/sys/qpoe/qpputb.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_PUTB -- Set the boolean value of the named header parameter.  Type
+# conversion is not permitted between boolean and the other data types.
+
+procedure qp_putb (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+bool	value			#I scalar parameter value
+
+pointer	pp
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	if (qp_putparam (qp, param, pp) != TY_BOOL)
+	    call syserrs (SYS_QPBADCONV, param)
+	else if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Pass the new value.
+	Memb[pp] = value
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/qpputx.x b/sys/qpoe/qpputx.x
new file mode 100644
index 00000000..0ed73b35
--- /dev/null
+++ b/sys/qpoe/qpputx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_PUTX -- Set the complex value of the named header parameter.  Type
+# conversion is not permitted between complex and the other data types.
+
+procedure qp_putx (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+complex	value			#I scalar parameter value
+
+pointer	pp
+int	qp_putparam()
+errchk	qp_putparam, syserrs
+
+begin
+	# Lookup the parameter and get a pointer to the value buffer.
+	if (qp_putparam (qp, param, pp) != TY_COMPLEX)
+	    call syserrs (SYS_QPBADCONV, param)
+	else if (pp == NULL)
+	    call syserrs (SYS_QPNOVAL, param)
+
+	# Pass the new value.
+	Memx[pp] = value
+
+	# Update the parameter in the datafile.
+	call qp_flushpar (qp)
+end
diff --git a/sys/qpoe/qpqueryf.x b/sys/qpoe/qpqueryf.x
new file mode 100644
index 00000000..c8de988a
--- /dev/null
+++ b/sys/qpoe/qpqueryf.x
@@ -0,0 +1,91 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_QUERYF -- Get information describing the named parameter.  The current
+# vector length of the parameter is returned as the function value, or ERR
+# if the parameter does not exist.
+
+int procedure qp_queryf (qp, param, datatype, maxelem, comment, flags)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	datatype[SZ_DATATYPE]	#O parameter data type
+int	maxelem			#O allocated length of parameter
+char	comment[SZ_COMMENT]	#O comment describing parameter
+int	flags			#O parameter flag word
+
+int	junk
+pointer	sym, dsym, ip, st
+
+int	qp_gstr()
+pointer	qp_gpsym(), stname(), strefstab(), strefsbuf()
+errchk	qp_gpsym, stname, syserrs
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	st = QP_ST(qp)
+
+	# Locate the symbol.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    return (ERR)
+
+	flags   = S_FLAGS(sym)
+	maxelem = S_MAXELEM(sym)
+
+	# Output the symbolic datatype.
+	datatype[2] = EOS
+	switch (S_DTYPE(sym)) {
+	case TY_BOOL:
+	    datatype[1] = 'b'
+	case TY_CHAR:
+	    datatype[1] = 'c'
+	case TY_SHORT:
+	    datatype[1] = 's'
+	case TY_INT:
+	    datatype[1] = 'i'
+	case TY_LONG:
+	    datatype[1] = 'l'
+	case TY_REAL:
+	    datatype[1] = 'r'
+	case TY_DOUBLE:
+	    datatype[1] = 'd'
+	case TY_COMPLEX:
+	    datatype[1] = 'x'
+
+	case TY_MACRO:
+	    call strcpy ("macro", datatype, SZ_DATATYPE)
+	case TY_OPAQUE:
+	    call strcpy ("opaque", datatype, SZ_DATATYPE)
+
+	case TY_USER:
+	    # User defined type: if S_DSYM is NULL, this is the domain entry
+	    # itself, else the domain name is the datatype of the parameter.
+	    # If this is a primary domain entry, the field list defining the
+	    # structure is stored as the string value of the parameter.
+
+	    if (S_DSYM(sym) == NULL)
+		junk = qp_gstr (qp, param, datatype, SZ_DATATYPE)
+	    else {
+		dsym = strefstab (st, S_DSYM(sym))
+		call strcpy (Memc[stname(st,dsym)], datatype, SZ_DATATYPE)
+	    }
+
+	default:
+	    call strcpy ("<unknown>", datatype, SZ_DATATYPE)
+	}
+
+	# Output the comment field.
+	if (S_COMMENT(sym) != NULL) {
+	    ip = strefsbuf (st, S_COMMENT(sym))
+	    call strcpy (Memc[ip], comment, SZ_COMMENT)
+	} else
+	    comment[1] = EOS
+
+	return (S_NELEM(sym))
+end
diff --git a/sys/qpoe/qpread.x b/sys/qpoe/qpread.x
new file mode 100644
index 00000000..c25fe506
--- /dev/null
+++ b/sys/qpoe/qpread.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "qpoe.h"
+
+# QP_READ -- Read a range of elements from a parameter.  Works for any
+# parameter, including scalar parameters and both static and variable
+# length array valued parameters.  Automatic datatype conversion is
+# performed for the primitive types.
+
+int procedure qp_read (qp, param, buf, maxelem, first, datatype)
+
+pointer qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	buf[ARB]		#O user data buffer to receive data
+int	maxelem			#I max number of data elements to read
+int	first			#I first data element to read
+char	datatype[ARB]		#I datatype to be returned
+
+pointer	sp, fm, sym, tbuf, isym, osym
+int	fd, sz_itype, sz_otype, nelem, itype, otype
+
+pointer	qp_gpsym()
+int	fm_getfd(), qp_sizeof(), read(), qp_dtype()
+errchk	qp_bind, qp_gpsym, fm_getfd, seek, read, syserrs
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	fm = QP_FM(qp)
+	otype = qp_dtype (qp, datatype, osym)
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+	else {
+	    itype = S_DTYPE(sym)
+	    isym  = sym
+	}
+
+	# Determine the number of inbounds elements.
+	nelem = max(0, min(maxelem, S_NELEM(sym) - first + 1))
+	if (first <= 0)
+	    call syserrs (SYS_QPINDXOOR, param)
+
+	# Verify that any type conversion is legal.
+	if (otype != itype)
+	    if (min(otype,itype) < TY_CHAR || max(otype,itype) > TY_DOUBLE)
+		call syserrs (SYS_QPBADCONV, param)
+
+	# Open the lfile and read the data segment.
+	fd = fm_getfd (fm, S_LFILE(sym), READ_ONLY, 0)
+
+	if (nelem > 0) {
+	    sz_itype = qp_sizeof (qp, itype, isym, IMMEDIATE)
+	    sz_otype = qp_sizeof (qp, otype, osym, INSTANCEOF)
+
+	    # Read and output the data.
+	    call seek (fd, S_OFFSET(sym) + (first - 1) * sz_itype)
+	    if (sz_itype <= sz_otype) {
+		# Read the data directly into the user's buffer.
+		nelem = read (fd, buf, nelem * sz_itype) / sz_itype
+		if (nelem > 0 && otype != itype)
+		    call acht (buf, buf, nelem, itype, otype)
+	    } else {
+		# Read the data into a temporary buffer.
+		call smark (sp)
+		call salloc (tbuf, nelem * sz_itype, TY_CHAR)
+		nelem = read (fd, Memc[tbuf], nelem * sz_itype) / sz_itype
+		if (nelem > 0)
+		    call acht (Memc[tbuf], buf, nelem, itype, otype)
+		call sfree (sp)
+	    }
+	}
+
+	call fm_retfd (fm, S_LFILE(sym))
+	return (nelem)
+end
diff --git a/sys/qpoe/qprebuild.x b/sys/qpoe/qprebuild.x
new file mode 100644
index 00000000..369eba1e
--- /dev/null
+++ b/sys/qpoe/qprebuild.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_REBUILD -- Rebuild a poefile to reclaim unused space, and render storage
+# elements logically contiguous to improve file access efficiency.
+
+procedure qp_rebuild (poefile)
+
+char	poefile[ARB]		#I poefile name
+pointer	sp, fname
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call qp_mkfname (poefile, QPOE_EXTN, Memc[fname], SZ_PATHNAME)
+	call fm_rebuild (Memc[fname])
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qprename.x b/sys/qpoe/qprename.x
new file mode 100644
index 00000000..2287b0fd
--- /dev/null
+++ b/sys/qpoe/qprename.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_RENAME -- Rename a poefile.
+
+procedure qp_rename (o_poefile, n_poefile)
+
+char	o_poefile[ARB]		#I old poefile name
+char	n_poefile[ARB]		#I new poefile name
+
+pointer	sp, o_fname, n_fname
+string	extn QPOE_EXTN
+
+begin
+	call smark (sp)
+	call salloc (o_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (n_fname, SZ_PATHNAME, TY_CHAR)
+
+	call qp_mkfname (o_poefile, extn, Memc[o_fname], SZ_PATHNAME)
+	call qp_mkfname (n_poefile, extn, Memc[n_fname], SZ_PATHNAME)
+	call fm_rename (Memc[o_fname], Memc[n_fname])
+
+	call sfree (sp)
+end
diff --git a/sys/qpoe/qprenamef.x b/sys/qpoe/qprenamef.x
new file mode 100644
index 00000000..39abb915
--- /dev/null
+++ b/sys/qpoe/qprenamef.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"qpoe.h"
+
+# QP_RENAMEF -- Rename a header parameter.  It is an error if the named header
+# parameter does not exist, or if the new name would redefine another symbol.
+
+procedure qp_renamef (qp, param, newname)
+
+pointer	qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	newname[ARB]		#I new parameter name
+
+pointer	sym, nsym, st
+pointer	qp_gpsym(), stenter()
+errchk	qp_gpsym, syserrs, stenter
+
+begin
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	st = QP_ST(qp)
+
+	# Access the named parameter.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+
+	# Check for a parameter redefinition.
+	nsym = qp_gpsym (qp, newname)
+	if (nsym != NULL)
+	    call syserrs (SYS_QPREDEF, newname)
+
+	# Rename the symbol.  We cannot just edit the name, as the hash
+	# function would not be able to find it.  We must create a new
+	# symstruct and replace the old one by it.  The stenter can cause
+	# reallocation of the symbol table, so we need to recompute the
+	# symbol pointer.
+
+	nsym = stenter (st, newname, LEN_SYMBOL)
+	sym = qp_gpsym (qp, param)
+
+	call amovi (Memi[sym], Memi[nsym], LEN_SYMBOL)
+	S_FLAGS(sym) = or (S_FLAGS(sym), SF_DELETED)
+
+	QP_MODIFIED(qp) = YES
+end
diff --git a/sys/qpoe/qprlmerge.gx b/sys/qpoe/qprlmerge.gx
new file mode 100644
index 00000000..410bb952
--- /dev/null
+++ b/sys/qpoe/qprlmerge.gx
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QP_RLMERGE -- Merge (AND) two range lists.  Only ranges which are
+# common to both range lists are output.  The number of ranges in the
+# output range list is returned as the function value.
+
+int procedure qp_rlmerge$t (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+pointer	os, oe			#U output range list
+int	olen			#U allocated length of OS, OE arrays
+
+PIXEL	xs[ARB], xe[ARB]	#I range list to be merged with
+int	nx			#I number of ranges in X list
+PIXEL	ys[ARB], ye[ARB]	#I range list to be merged with X
+int	ny			#I number of ranges in Y list
+
+PIXEL	o1, o2
+int	nx_out, xi, yi, i
+PIXEL	qp_minval$t(), qp_maxval$t()
+bool	qp_lessthan$t()
+errchk	realloc
+
+begin
+	nx_out = 0
+	if (nx <= 0 || ny <= 0)
+	    return (0)
+
+	xi = 1
+	yi = 1
+
+	do i = 1, ARB {
+	    # Find a pair of ranges which intersect.
+	    repeat {
+		if (qp_lessthan$t (xe[xi], ys[yi])) {
+		    if (xi >= nx)
+			return (nx_out)
+		    else
+			xi = xi + 1
+		} else if (qp_lessthan$t (ye[yi], xs[xi])) {
+		    if (yi >= ny)
+			return (nx_out)
+		    else
+			yi = yi + 1
+		} else
+		    break
+	    }
+
+	    # Compute the intersection.
+	    o1 = qp_maxval$t (xs[xi], ys[yi])
+	    o2 = qp_minval$t (xe[xi], ye[yi])
+
+	    # Output the range.
+	    if (nx_out + 1 > olen) {
+		olen = max (DEF_XLEN, olen * 2)
+		call realloc (os, olen, TY_PIXEL)
+		call realloc (oe, olen, TY_PIXEL)
+	    }
+
+	    Mem$t[os+nx_out] = o1
+	    Mem$t[oe+nx_out] = o2
+	    nx_out = nx_out + 1
+
+	    # Advance to the next range.
+	    if (xi < nx && qp_lessthan$t (xe[xi], ye[yi]))
+		xi = xi + 1
+	    else if (yi < ny)
+		yi = yi + 1
+	    else
+		break
+	}
+
+	return (nx_out)
+end
+
+
+# QP_MINVAL -- Return the lesser of two values, where either value can
+# be an open range.
+
+PIXEL procedure qp_minval$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+bool	qp_lessthan$t()
+
+begin
+	if (qp_lessthan$t (x, y))
+	    return (x)
+	else
+	    return (y)
+end
+
+
+# QP_MAXVAL -- Return the greater of two values, where either value can
+# be an open range.
+
+PIXEL procedure qp_maxval$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+bool	qp_lessthan$t()
+
+begin
+	if (qp_lessthan$t (x, y))
+	    return (y)
+	else
+	    return (x)
+end
+
+
+# QP_LESSTHAN -- Test if X is less than Y, where X and Y can be open
+# range values.
+
+bool procedure qp_lessthan$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+begin
+	if (IS_LEFT$T(x))
+	    return (!IS_LEFT$T(y))
+	else if (IS_RIGHT$T(x))
+	    return (false)
+	else if (IS_LEFT$T(y))
+	    return (false)
+	else if (IS_RIGHT$T(y))
+	    return (true)
+	else
+	    return (x < y)
+end
diff --git a/sys/qpoe/qpsavewcs.x b/sys/qpoe/qpsavewcs.x
new file mode 100644
index 00000000..35293d62
--- /dev/null
+++ b/sys/qpoe/qpsavewcs.x
@@ -0,0 +1,35 @@
+include	"qpoe.h"
+
+# QP_SAVEWCS -- Save the given WCS in the QPOE header, as a variable length
+# binary array (machine independent) in the default WCS parameter QPWCS.
+
+procedure qp_savewcs (qp, mw)
+
+pointer	qp				#I QPOE descriptor
+pointer	mw				#I MWCS descriptor
+
+pointer	bp
+int	buflen, nchars
+int	mw_save(), qp_accessf()
+errchk	mw_save, qp_accessf, qp_addf, qp_write
+string	s_opaque "opaque"
+string	s_qpwcs QPWCS
+
+begin
+	bp = NULL
+	buflen = 0
+
+	# Encode the WCS as a machine independent binary array.
+	nchars = mw_save (mw, bp, buflen)
+
+	# Save it in the QPOE header.
+	if (nchars > 0) {
+	    if (qp_accessf (qp, s_qpwcs) == NO)
+		call qp_addf (qp, s_qpwcs,
+		    s_opaque, 0, "World coordinate system", SF_INHERIT)
+	    call qp_write (qp, s_qpwcs, Memc[bp], nchars, 1, s_opaque)
+	}
+
+	if (bp != NULL)
+	    call mfree (bp, TY_CHAR)
+end
diff --git a/sys/qpoe/qpseti.x b/sys/qpoe/qpseti.x
new file mode 100644
index 00000000..3a18c35e
--- /dev/null
+++ b/sys/qpoe/qpseti.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_SETI -- Set an QPOE integer parameter.
+
+procedure qp_seti (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+int	param			#I parameter to be set
+int	value			#I new value for parameter
+
+begin
+	switch (param) {
+	case QPOE_BLOCKFACTOR:
+	    QP_XBLOCK(qp) = value
+	    QP_YBLOCK(qp) = value
+	case QPOE_XBLOCKFACTOR:
+	    QP_XBLOCK(qp) = value
+	case QPOE_YBLOCKFACTOR:
+	    QP_YBLOCK(qp) = value
+	case QPOE_BUCKETLEN:
+	    QP_BUCKETLEN(qp) = value
+	case QPOE_CACHESIZE:
+	    QP_FMCACHESIZE(qp) = value
+	case QPOE_DATABUFLEN:
+	    QP_EXDBLEN(qp) = value
+	case QPOE_DEBUGLEVEL:
+	    QP_DEBUG(qp) = value
+	case QPOE_INDEXLEN:
+	    QP_STINDEXLEN(qp) = value
+	case QPOE_LUTMINRANGES:
+	    QP_EXLMINRANGES(qp) = value
+	case QPOE_LUTSCALE:
+	    QP_EXLSCALE(qp) = value
+	case QPOE_MAXFRLUTLEN:
+	    QP_EXMAXFRLLEN(qp) = value
+	case QPOE_MAXLFILES:
+	    QP_FMMAXLFILES(qp) = value
+	case QPOE_MAXPTPAGES:
+	    QP_FMMAXPTPAGES(qp) = value
+	case QPOE_MAXRRLUTLEN:
+	    QP_EXMAXRRLLEN(qp) = value
+	case QPOE_MAXPUSHBACK:
+	    QP_SZPBBUF(qp) = value
+	case QPOE_NODEFFILT:
+	    QP_NODEFFILT(qp) = value
+	case QPOE_NODEFMASK:
+	    QP_NODEFMASK(qp) = value
+	case QPOE_OPTBUFSIZE:
+	    QP_OPTBUFSIZE(qp) = value
+	case QPOE_PAGESIZE:
+	    QP_FMPAGESIZE(qp) = value
+	case QPOE_PROGBUFLEN:
+	    QP_EXPBLEN(qp) = value
+	case QPOE_SBUFSIZE:
+	    QP_STSBUFSIZE(qp) = value
+	case QPOE_STABLEN:
+	    QP_STSTABLEN(qp) = value
+	}
+end
diff --git a/sys/qpoe/qpsetr.x b/sys/qpoe/qpsetr.x
new file mode 100644
index 00000000..9378912f
--- /dev/null
+++ b/sys/qpoe/qpsetr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_SETR -- Set an QPOE real valued parameter.
+
+procedure qp_setr (qp, param, value)
+
+pointer	qp			#I QPOE descriptor
+int	param			#I parameter to be set
+real	value			#I new value for parameter
+
+begin
+	switch (param) {
+	case QPOE_BLOCKFACTOR:
+	    QP_XBLOCK(qp) = value
+	    QP_YBLOCK(qp) = value
+	case QPOE_XBLOCKFACTOR:
+	    QP_XBLOCK(qp) = value
+	case QPOE_YBLOCKFACTOR:
+	    QP_YBLOCK(qp) = value
+	}
+end
diff --git a/sys/qpoe/qpsizeof.x b/sys/qpoe/qpsizeof.x
new file mode 100644
index 00000000..bfa1698f
--- /dev/null
+++ b/sys/qpoe/qpsizeof.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_SIZEOF -- Determine the size in chars of a QPOE datatype.  This may
+# be one of the special datatypes (user defined record types), or a primitive
+# type.  In the case of a special type, the REFTYPE flag specifies whether
+# the size of the value of the type variable itself (always SZ_CHAR) is to be
+# returned, or the size of an *instance* of the special type.
+
+int procedure qp_sizeof (qp, dtype, dsym, reftype)
+
+pointer	qp			#I QPOE descriptor
+int	dtype			#I datatype code
+pointer	dsym			#I domain descriptor, if type TY_USER
+int	reftype			#I IMMEDIATE (domain itself) or INSTANCEOF
+
+pointer	sym
+int	sizeof()
+pointer	strefstab()
+
+begin
+	switch (dtype) {
+	case TY_MACRO, TY_OPAQUE:
+	    return (SZ_CHAR)
+
+	case TY_USER:
+	    # Size of a user defined structure (or the element size of the
+	    # struct definition entry itself).
+
+	    if (dsym == NULL) {			# {...}
+		return (SZ_CHAR)
+	    } else if (S_DSYM(dsym) == NULL) {	# reference is to
+		if (reftype == IMMEDIATE)	# primary domain entry
+		    return (SZ_CHAR)
+		else
+		    return (S_SZELEM(dsym))
+	    } else {				# instance of domain
+		sym = strefstab (QP_ST(qp), S_DSYM(dsym))
+		return (S_SZELEM(sym))
+	    }
+
+	default:
+	    return (sizeof (dtype))
+	}
+end
diff --git a/sys/qpoe/qpstati.x b/sys/qpoe/qpstati.x
new file mode 100644
index 00000000..df8d176c
--- /dev/null
+++ b/sys/qpoe/qpstati.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_STATI -- Get the value of an QPOE integer parameter.
+
+int procedure qp_stati (qp, param)
+
+pointer	qp			#I QPOE descriptor
+int	param			#I parameter to be queried
+
+bool	fp_equalr()
+
+begin
+	switch (param) {
+	case QPOE_BLOCKFACTOR:			# standard params
+	    if (fp_equalr (QP_XBLOCK(qp), QP_YBLOCK(qp)))
+		return (QP_XBLOCK(qp))
+	    else
+		return (ERR)
+	case QPOE_XBLOCKFACTOR:
+	    return (QP_XBLOCK(qp))
+	case QPOE_YBLOCKFACTOR:
+	    return (QP_YBLOCK(qp))
+	case QPOE_BUCKETLEN:
+	    return (QP_BUCKETLEN(qp))
+	case QPOE_CACHESIZE:
+	    return (QP_FMCACHESIZE(qp))
+	case QPOE_DATABUFLEN:
+	    return (QP_EXDBLEN(qp))
+	case QPOE_DEBUGLEVEL:
+	    return (QP_DEBUG(qp))
+	case QPOE_INDEXLEN:
+	    return (QP_STINDEXLEN(qp))
+	case QPOE_MAXLFILES:
+	    return (QP_FMMAXLFILES(qp))
+	case QPOE_MAXPTPAGES:
+	    return (QP_FMMAXPTPAGES(qp))
+	case QPOE_MAXFRLUTLEN:
+	    return (QP_EXMAXFRLLEN(qp))
+	case QPOE_MAXRRLUTLEN:
+	    return (QP_EXMAXRRLLEN(qp))
+	case QPOE_LUTMINRANGES:
+	    return (QP_EXLMINRANGES(qp))
+	case QPOE_LUTSCALE:
+	    return (QP_EXLSCALE(qp))
+	case QPOE_MAXPUSHBACK:
+	    return (QP_SZPBBUF(qp))
+	case QPOE_NODEFFILT:
+	    return (QP_NODEFFILT(qp))
+	case QPOE_NODEFMASK:
+	    return (QP_NODEFMASK(qp))
+	case QPOE_OPTBUFSIZE:
+	    return (QP_OPTBUFSIZE(qp))
+	case QPOE_PAGESIZE:
+	    return (QP_FMPAGESIZE(qp))
+	case QPOE_PROGBUFLEN:
+	    return (QP_EXPBLEN(qp))
+	case QPOE_SBUFSIZE:
+	    return (QP_STSBUFSIZE(qp))
+	case QPOE_STABLEN:
+	    return (QP_STSTABLEN(qp))
+
+	case QPOE_FM:				# read-only params
+	    return (QP_FM(qp))
+	case QPOE_MODE:
+	    return (QP_MODE(qp))
+	case QPOE_ST:
+	    return (QP_ST(qp))
+	case QPOE_VERSION:
+	    return (QP_VERSION(qp))
+	}
+
+	return (ERR)
+end
diff --git a/sys/qpoe/qpstatr.x b/sys/qpoe/qpstatr.x
new file mode 100644
index 00000000..0b3aec99
--- /dev/null
+++ b/sys/qpoe/qpstatr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<qpset.h>
+include	"qpoe.h"
+
+# QP_STATR -- Get the value of an QPOE real parameter.
+
+real procedure qp_statr (qp, param)
+
+pointer	qp			#I QPOE descriptor
+int	param			#I parameter to be queried
+
+bool	fp_equalr()
+
+begin
+	switch (param) {
+	case QPOE_BLOCKFACTOR:			# standard params
+	    if (fp_equalr (QP_XBLOCK(qp), QP_YBLOCK(qp)))
+		return (QP_XBLOCK(qp))
+	    else
+		return (ERR)
+	case QPOE_XBLOCKFACTOR:
+	    return (QP_XBLOCK(qp))
+	case QPOE_YBLOCKFACTOR:
+	    return (QP_YBLOCK(qp))
+	}
+
+	return (ERR)
+end
diff --git a/sys/qpoe/qpsync.x b/sys/qpoe/qpsync.x
new file mode 100644
index 00000000..692136d6
--- /dev/null
+++ b/sys/qpoe/qpsync.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+
+# QP_SYNC -- Update the poefile on disk.
+
+procedure qp_sync (qp)
+
+pointer	qp			#I QPOE descriptor
+
+int	n, fd
+pointer	sp, qph
+int	fm_fopen()
+errchk	qp_flushpar, fm_fopen, write, stsave
+
+begin
+	# Flush the put-parameter buffer.
+	call qp_flushpar (qp)
+
+	# Update the QPOE descriptor and symbol table in the datafile.
+	if (QP_MODIFIED(qp) != NO) {
+	    call smark (sp)
+	    call salloc (qph, LEN_QPH, TY_STRUCT)
+	    call aclri (Memi[qph], LEN_QPH)
+
+	    QPH_MAGIC(qph)	= QP_MAGIC(qp)
+	    QPH_VERSION(qph)	= QPOE_VERSION
+	    QPH_STOFFSET(qph)	= LEN_QPH * SZ_STRUCT + 1
+
+	    # The encoded QPOE header and symbol table are stored in a
+	    # binary lfile in the datafile.
+
+	    fd = fm_fopen (QP_FM(qp), LF_QPOE, NEW_FILE, BINARY_FILE)
+
+	    # Update the QPOE file header.
+	    n = LEN_QPH * SZ_STRUCT
+	    call miipak32 (Memi[qph], Memi[qph], LEN_QPH, TY_STRUCT)
+	    call write (fd, Memi[qph], n)
+
+	    # Update the symbol table.
+	    call stsqueeze (QP_ST(qp))
+	    call stsave (QP_ST(qp), fd)
+
+	    QP_MODIFIED(qp) = NO
+	    call close (fd)
+	    call sfree (sp)
+	}
+
+	# Update the datafile itself.
+	call fm_fcsync (QP_FM(qp))
+end
diff --git a/sys/qpoe/qpwrite.x b/sys/qpoe/qpwrite.x
new file mode 100644
index 00000000..dc5d4dab
--- /dev/null
+++ b/sys/qpoe/qpwrite.x
@@ -0,0 +1,79 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include "qpoe.h"
+
+# QP_WRITE -- Write to a range of elements in a parameter.  Works for any
+# parameter, including scalar parameters and both static and variable
+# length array valued parameters.  Automatic datatype conversion is
+# performed for the primitive types.
+
+procedure qp_write (qp, param, buf, nelem, first, datatype)
+
+pointer qp			#I QPOE descriptor
+char	param[ARB]		#I parameter name
+char	buf[ARB]		#I user data buffer containing data
+int	nelem			#I number of data elements to write
+int	first			#I first data element to write to
+char	datatype[ARB]		#I datatype of input data
+
+pointer	sp, fm, sym, tbuf, isym, osym
+int	fd, sz_itype, sz_otype, last, otype, itype
+errchk	qp_bind, qp_gpsym, fm_getfd, seek, syserrs
+int	fm_getfd(), qp_sizeof(), qp_dtype()
+pointer	qp_gpsym()
+
+begin
+	if (nelem <= 0)
+	    return
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	itype = qp_dtype (qp, datatype, isym)
+	fm = QP_FM(qp)
+
+	# Lookup the symbol in the symbol table.
+	sym = qp_gpsym (qp, param)
+	if (sym == NULL)
+	    call syserrs (SYS_QPUKNPAR, param)
+	else {
+	    otype = S_DTYPE(sym)
+	    osym  = sym
+	}
+
+	sz_itype = qp_sizeof (qp, itype, isym, INSTANCEOF)
+	sz_otype = qp_sizeof (qp, otype, osym, IMMEDIATE)
+	last = first + nelem - 1
+
+	# Check that the write is inbounds.
+	if (first <= 0 || (S_MAXELEM(sym) > 0 && last > S_MAXELEM(sym)))
+	    call syserrs (SYS_QPINDXOOR, param)
+
+	# Verify that any type conversion is legal.
+	if (otype != itype)
+	    if (min(otype,itype) < TY_CHAR || max(otype,itype) > TY_DOUBLE)
+		call syserrs (SYS_QPBADCONV, param)
+
+	# Open the lfile and update the data segment.
+	fd = fm_getfd (fm, S_LFILE(sym), READ_WRITE, 0)
+	call seek (fd, S_OFFSET(sym) + (first - 1) * sz_otype)
+
+	# Output the data.
+	if (otype != itype) {
+	    call smark (sp)
+	    call salloc (tbuf, nelem * sz_otype, TY_CHAR)
+	    call acht (buf, Memc[tbuf], nelem, itype, otype)
+	    call write (fd, Memc[tbuf], nelem * sz_otype)
+	    call sfree (sp)
+	} else
+	    call write (fd, buf, nelem * sz_otype)
+
+	# Update the array size if it got bigger.
+	if (last > S_NELEM(sym)) {
+	    S_NELEM(sym) = last
+	    QP_MODIFIED(qp) = YES
+	}
+
+	call fm_retfd (fm, S_LFILE(sym))
+end
diff --git a/sys/qpoe/zzdebug.x b/sys/qpoe/zzdebug.x
new file mode 100644
index 00000000..5ca2de42
--- /dev/null
+++ b/sys/qpoe/zzdebug.x
@@ -0,0 +1,1696 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<qpexset.h>
+include	<qpioset.h>
+include	<qpset.h>
+include	<gset.h>
+include	"qpoe.h"
+include	"qpex.h"
+include	"qpio.h"
+
+# ZZDEBUG -- Debug routines for the QPOE package.
+
+task	parsei		= t_parsei,	# parse integer range list
+	parser		= t_parser,	# parse floating range list
+	qpparse		= t_qpparse,	# test qp_parse
+	tokens		= t_tokens,	# test get token, macro replacement
+	comp		= t_comp,	# test QPEX compile
+	expand		= t_expand,	# perform macro expansion on text
+	recio		= t_recio,	# test general record i/o
+	newcopy		= t_newcopy,	# test inheritance
+	syms		= t_syms,	# dump symbol table
+	hlist		= t_hlist,	# list file header
+	dumpevl		= t_dumpevl,	# dump event list descriptor
+	mkpoe		= t_mkpoe,	# convert CFA poefile to QPOE poefile
+	testpoe		= t_testpoe,	# make a test QPOE file
+	countpoe	= t_countpoe,	# count photons in regions
+	tfilter		= t_tfilter,	# verify time filtering
+	plotpoe		= t_plotpoe,	# read and plot photons
+	sum		= t_sum,	# sum counts in an image section
+	setwcs		= t_setwcs,	# store a wcs in a qpoe file
+	setmask		= t_setmask,	# set the default mask
+	mergei		= t_mergei,	# test merging of range lists
+	clear		= t_clear	# clear the screen
+
+define	SZ_EXPR		256
+define	SZ_OBUF		128000
+define	SZ_TBUF		8
+define	MAX_EVENTS	8192
+define	SZ_RLBUF	512
+
+
+# PARSEI -- Test integer range list decoding and expression optimization.
+
+procedure t_parsei()
+
+pointer	xs, xe
+char	lbuf[SZ_LINE], left[SZ_TBUF], right[SZ_TBUF]
+int	nranges, xlen, i1, i2, i
+
+int	getline(), qpex_parsei()
+bool	streq()
+
+begin
+	xlen = 0
+
+	repeat {
+	    # Get next expression.
+	    call printf ("parse> ")
+	    call flush (STDOUT)
+	    if (getline (STDIN, lbuf) == EOF)
+		break
+	    else if (streq (lbuf, "bye\n"))
+		break
+
+	    # Parse the expression.
+	    nranges = qpex_parsei (lbuf, xs, xe, xlen)
+
+	    # List the ranges.
+	    do i = 1, nranges {
+		i1 = Memi[xs+i-1]
+		i2 = Memi[xe+i-1]
+
+		if (IS_LEFTI(i1))
+		    call strcpy ("LEFT", left, SZ_TBUF)
+		else {
+		    call sprintf (left, SZ_TBUF, "%d")
+			call pargi (i1)
+		}
+
+		if (IS_RIGHTI(i2))
+		    call strcpy ("RIGHT", right, SZ_TBUF)
+		else {
+		    call sprintf (right, SZ_TBUF, "%d")
+			call pargi (i2)
+		}
+
+		call printf ("%2d: %8s %8s\n")
+		    call pargi (i)
+		    call pargstr (left)
+		    call pargstr (right)
+	    }
+
+	    call flush (STDOUT)
+	}
+
+	call mfree (xs, TY_INT)
+	call mfree (xe, TY_INT)
+end
+
+
+# PARSER -- Test real range list decoding and expression optimization.
+
+procedure t_parser()
+
+pointer	xs, xe
+char	lbuf[SZ_LINE]
+int	nranges, xlen, i
+
+int	getline(), qpex_parser()
+bool	streq()
+
+begin
+	xlen = 0
+
+	repeat {
+	    # Get next expression.
+	    call printf ("parse> ")
+	    call flush (STDOUT)
+	    if (getline (STDIN, lbuf) == EOF)
+		break
+	    else if (streq (lbuf, "bye\n"))
+		break
+
+	    # Parse the expression.
+	    nranges = qpex_parser (lbuf, xs, xe, xlen)
+	    do i = 1, nranges {
+		call printf ("%2d: %7g %7g\n")
+		    call pargi (i)
+		    call pargr (Memr[xs+i-1])
+		    call pargr (Memr[xe+i-1])
+	    }
+	    call flush (STDOUT)
+	}
+
+	call mfree (xs, TY_REAL)
+	call mfree (xe, TY_REAL)
+end
+
+
+# QPPARSE -- Test qp_parse.
+
+procedure t_qpparse()
+
+char	expr[SZ_LINE]
+char	root[SZ_FNAME]
+char	filter[SZ_FNAME]
+
+begin
+	call clgstr ("expr", expr, SZ_LINE)
+	call qp_parse (expr, root, SZ_FNAME, filter, SZ_FNAME)
+
+	call printf ("root=`%s', filter=`%s'\n")
+	    call pargstr (root)
+	    call pargstr (filter)
+end
+
+
+# TOKENS -- Translate an input character stream into a stream of QPOE tokens.
+# Macro replacement is performed on the input text.
+
+procedure t_tokens()
+
+char	input[SZ_FNAME], refpoe[SZ_FNAME]
+char	tokbuf[SZ_FNAME], num[SZ_FNAME]
+
+pointer	qp, in
+int	token, junk
+int	qp_gettok(), gltoc()
+pointer	qp_open, qp_opentext()
+
+begin
+	input[1] = '@'
+	call clgstr ("input", input[2], SZ_FNAME-1)
+	call clgstr ("refpoe", refpoe, SZ_FNAME)
+
+	if (refpoe[1] != EOS)
+	    qp = qp_open (refpoe, READ_ONLY, NULL)
+	else
+	    qp = NULL
+	in = qp_opentext (qp, input)
+
+	repeat {
+	    token = qp_gettok (in, tokbuf, SZ_FNAME)
+	    if (token != EOF) {
+		call printf ("%10s: %s\n")
+		switch (token) {
+		case TOK_IDENTIFIER:
+		    call pargstr ("IDENT")
+		case TOK_NUMBER:
+		    call pargstr ("NUMBER")
+		case TOK_STRING:
+		    call pargstr ("STRING")
+		case TOK_COMMAND:
+		    call pargstr ("COMMAND")
+		case TOK_PLUSEQUALS:
+		    call pargstr ("PLUSEQ")
+		case TOK_COLONEQUALS:
+		    call pargstr ("COLONEQ")
+		default:
+		    junk = gltoc (token, num, SZ_FNAME, 8)
+		    call pargstr (num)
+		}
+		if (IS_PRINT(tokbuf[1]))
+		    call pargstr (tokbuf)
+		else
+		    call pargstr ("")
+	    }
+	} until (token == EOF)
+
+	call printf ("EOF\n")
+	call flush (STDOUT)
+
+	call qp_closetext (in)
+	if (qp != NULL)
+	    call qp_close (qp)
+end
+
+
+# COMP -- Compile an expression with QPEX and print out the contents of
+# the resultant descriptor, including the assembler translation of the
+# expression.
+
+procedure t_comp()
+
+int	out
+pointer	qp, ex
+char	text[SZ_LINE]
+char	output[SZ_FNAME]
+
+int	open()
+bool	streq()
+pointer	qp_open(), qpex_open()
+
+begin
+	call clgstr ("poefile", text, SZ_LINE)
+	qp = qp_open (text, READ_ONLY, 0)
+
+	call clgstr ("output", output, SZ_FNAME)
+	if (output[1] != EOS)
+	    out = open (output, APPEND, TEXT_FILE)
+	else
+	    out = NULL
+
+	repeat {
+	    call clgstr ("expr", text, SZ_LINE)
+	    if (streq (text, "bye"))
+		break
+	    else if (text[1] != EOS) {
+		ex = qpex_open (qp, text)
+		call qpex_debug (ex, STDOUT, QPEXD_SHOWALL)
+		if (out != NULL) {
+		    call fprintf (out, "\f")
+		    call qpex_debug (ex, out, QPEXD_SHOWALL)
+		}
+		call qpex_close (ex)
+		call flush (STDOUT)
+	    }
+	}
+
+	call close (out)
+	call qp_close (qp)
+end
+
+
+# EXPAND -- Perform macro expansion on text input by the user.
+
+procedure t_expand()
+
+pointer	qp, sp, ip, text, obuf
+int	getline(), qp_expandtext(), strncmp(), clgeti()
+pointer	qp_open()
+
+begin
+	call smark (sp)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (obuf, SZ_OBUF, TY_CHAR)
+
+	call clgstr ("poefile", Memc[text], SZ_LINE)
+	qp = qp_open (Memc[text], READ_ONLY, 0)
+	call qp_seti (qp, QPOE_DEBUGLEVEL, clgeti("debug"))
+
+	call printf ("Q> ")
+	call flush (STDOUT)
+
+	while (getline (STDIN, Memc[text]) != EOF) {
+	    for (ip=text;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    if (strncmp (Memc[ip], "bye", 3) == 0)
+		break
+	    else if (Memc[ip] != '\n') {
+		call write (STDOUT, Memc[obuf],
+		    qp_expandtext (qp, Memc[text], Memc[obuf], SZ_OBUF))
+		call printf ("\n")
+	    }
+
+	    call printf ("Q> ")
+	    call flush (STDOUT)
+	}
+
+	call qp_close (qp)
+	call sfree (sp)
+end
+
+
+# RECIO -- Test general record i/o.
+
+procedure t_recio()
+
+int	i, n, nrec
+pointer	sp, qp, rp, poefile, data
+int	qp_read(), qp_accessf(), clgeti()
+pointer	qp_open()
+
+begin
+	call smark (sp)
+	call salloc (poefile, SZ_FNAME, TY_CHAR)
+	call salloc (data, 4096 * 3, TY_STRUCT)
+
+	call clgstr ("poefile", Memc[poefile], SZ_FNAME)
+	qp = qp_open (Memc[poefile], READ_WRITE, 0)
+	call qp_seti (qp, QPOE_DEBUGLEVEL, clgeti("debug"))
+	nrec = clgeti ("nrec")
+
+	# Initialize the data array.
+	do i = 1, nrec {
+	    rp = data + (i-1) * 3
+	    Memr[rp] = i
+	    Memi[rp+1] = i
+	    Mems[P2S(rp)+4] = i*10+1
+	    Mems[P2S(rp)+5] = i*10+2
+	}
+
+	if (qp_accessf (qp, "urec") == NO)
+	    call qp_addf (qp, "urec", "{r,i,s,s}", 0, "User record type", 0)
+	if (qp_accessf (qp, "data") == NO)
+	    call qp_addf (qp, "data", "urec", nrec, "User records", 0)
+
+	# Initialize the parameter.
+	call qp_write (qp, "data", Memi[data], nrec, 1, "urec")
+
+	call eprintf ("---------------- Full array read test:")
+	call aclri (Memi[data], nrec * 3)
+	n = qp_read (qp, "data", Memi[data], nrec, 1, "urec")
+	call eprintf (" n=%d\n");  call pargi(n)
+	do i = 1, nrec {
+	    rp = data + (i-1) * 3
+	    call eprintf ("%8.1f %4d %4d %4d\n")
+	        call pargr (Memr[rp])
+	        call pargi (Memi[rp+1])
+	        call pargs (Mems[P2S(rp)+4])
+	        call pargs (Mems[P2S(rp)+5])
+	}
+
+	call eprintf ("---------------- Array element read test:\n")
+	call aclri (Memi[data], nrec * 3)
+	do i = 1, nrec {
+	    rp = data + (i-1) * 3
+	    n = qp_read (qp, "data", Memi[rp], 1, i, "urec")
+	    call eprintf ("%4d %8.1f %4d %4d %4d\n")
+		call pargi (i)
+		call pargr (Memr[rp])
+		call pargi (Memi[rp+1])
+		call pargs (Mems[P2S(rp)+4])
+		call pargs (Mems[P2S(rp)+5])
+	}
+
+	call eprintf ("---------------- Array element read test (reversed):\n")
+	call aclri (Memi[data], nrec * 3)
+	do i = nrec, 1, -1 {
+	    rp = data + (i-1) * 3
+	    n = qp_read (qp, "data", Memi[rp], 1, i, "urec")
+	    call eprintf ("%4d %8.1f %4d %4d %4d\n")
+		call pargi (i)
+		call pargr (Memr[rp])
+		call pargi (Memi[rp+1])
+		call pargs (Mems[P2S(rp)+4])
+		call pargs (Mems[P2S(rp)+5])
+	}
+
+	call qp_close (qp)
+	call sfree (sp)
+end
+
+
+# NEWCOPY -- Test inheritance occurring during a new-copy open.
+
+procedure t_newcopy()
+
+char	iname[SZ_FNAME]		# input name
+char	oname[SZ_FNAME]		# output name
+
+pointer iqp, oqp
+pointer	qp_open()
+
+begin
+	call clgstr ("input", iname, SZ_FNAME)
+	call clgstr ("output", oname, SZ_FNAME)
+
+	iqp = qp_open (iname, READ_ONLY, NULL)
+	oqp = qp_open (oname, NEW_COPY, iqp)
+
+	call printf ("iqp=%x; oqp=%x\n")
+	    call pargi (iqp)
+	    call pargi (oqp)
+
+	call qp_close (oqp)
+	call qp_close (iqp)
+end
+
+
+# SYMS -- Dump the symbol table of a QPOE datafile.
+
+procedure t_syms()
+
+char	fname[SZ_FNAME]
+pointer	qp, qp_open()
+
+begin
+	call clgstr ("fname", fname, SZ_FNAME)
+	qp = qp_open (fname, READ_ONLY, 0)
+	call qp_dsym (qp, STDOUT)
+	call qp_close (qp)
+end
+
+
+# HLIST -- List selected header parameters.
+
+procedure t_hlist()
+
+pointer	qp, list, sym
+int	nelem, maxelem, flags
+char	datatype[SZ_DATATYPE], comment[SZ_COMMENT]
+char	fname[SZ_FNAME], param[SZ_FNAME], pattern[SZ_FNAME]
+pointer	qp_open(), qp_ofnlu(), qp_ofnls(), qp_gpsym()
+int	qp_queryf(), qp_gnfn()
+bool	clgetb()
+
+begin
+	call clgstr ("fname", fname, SZ_FNAME)
+	call clgstr ("pattern", pattern, SZ_FNAME)
+	
+	qp = qp_open (fname, READ_ONLY, 0)
+	if (clgetb ("sort"))
+	    list = qp_ofnls (qp, pattern)
+	else
+	    list = qp_ofnlu (qp, pattern)
+
+	call printf ("          PARAM  DTYPE NELEM MAXEL LF OFF FLG COMMENT\n")
+	while (qp_gnfn (list, param, SZ_FNAME) != EOF) {
+	    nelem = qp_queryf (qp, param, datatype, maxelem, comment, flags)
+	    sym = qp_gpsym (qp, param)
+
+	    call printf ("%15s %6s %5d %5d %2d%4d %3o %s\n")
+		call pargstr (param)
+		call pargstr (datatype)
+		call pargi (nelem)
+		call pargi (maxelem)
+		if (sym != NULL) {
+		    call pargi (S_LFILE(sym))
+		    call pargi (S_OFFSET(sym))
+		    call pargi (and (flags, 777B))
+		    call pargstr (comment)
+		} else {
+		    call pargi (0)
+		    call pargi (0)
+		    call pargi (0)
+		    call pargstr ("[could not find symbol (macro?)]")
+		}
+	}
+
+	call qp_cfnl (list)
+	call qp_close (qp)
+end
+
+
+# DUMPEVL -- Dump an event list descriptor.
+
+procedure t_dumpevl()
+
+pointer	qp, io, dd, ev
+char	poefile[SZ_FNAME], param[SZ_FNAME]
+char	datatype[SZ_DATATYPE], comment[SZ_COMMENT]
+int	offset, dtype, size, nelem, maxelem, flags, i, j
+pointer	qp_open(), qpio_open(), qpio_stati(), coerce()
+int	qp_queryf(), sizeof()
+
+begin
+	call clgstr ("poefile", poefile, SZ_FNAME)
+	qp = qp_open (poefile, READ_ONLY, NULL)
+
+	call clgstr ("eventlist", param, SZ_FNAME)
+	if (param[1] == EOS)
+	    call strcpy ("events", param, SZ_FNAME)
+	io = qpio_open (qp, param, READ_ONLY)
+
+	call printf ("%s.%s:\n")
+	    call pargstr (poefile)
+	    call pargstr (param)
+
+	nelem = qp_queryf (qp, param, datatype, maxelem, comment, flags)
+	call printf ("dtype=%s nelem=%d maxel=%d flg=%o comment=%s\n")
+	    call pargstr (datatype)
+	    call pargi (nelem)
+	    call pargi (maxelem)
+	    call pargi (and (flags, 777B))
+	    call pargstr (comment)
+
+	call printf ("%s=%dx%d ")
+	    call pargstr ("blockfactor")
+	    call pargi (qpio_stati(io, QPIO_XBLOCKFACTOR))
+	    call pargi (qpio_stati(io, QPIO_YBLOCKFACTOR))
+	call printf ("%s=%d ")
+	    call pargstr ("bucketlen")
+	    call pargi (qpio_stati(io, QPIO_BUCKETLEN))
+	call printf ("%s=%d ")
+	    call pargstr ("debug")
+	    call pargi (qpio_stati(io, QPIO_DEBUG))
+	call printf ("%s=%d ")
+	    call pargstr ("evxoff")
+	    call pargi (qpio_stati(io, QPIO_EVXOFF))
+	call printf ("%s=%d ")
+	    call pargstr ("evxtype")
+	    call pargi (qpio_stati(io, QPIO_EVXTYPE))
+	call printf ("%s=%d ")
+	    call pargstr ("evyoff")
+	    call pargi (qpio_stati(io, QPIO_EVYOFF))
+	call printf ("%s=%d ")
+	    call pargstr ("evytype")
+	    call pargi (qpio_stati(io, QPIO_EVYTYPE))
+	call printf ("\n")
+
+	call printf ("%s=%xX ")
+	    call pargstr ("ex")
+	    call pargi (qpio_stati(io, QPIO_EX))
+	call printf ("%s=%d ")
+	    call pargstr ("noindex")
+	    call pargi (qpio_stati(io, QPIO_NOINDEX))
+	call printf ("%s=%d ")
+	    call pargstr ("optbufsize")
+	    call pargi (qpio_stati(io, QPIO_OPTBUFSIZE))
+	call printf ("%s=%xX ")
+	    call pargstr ("pl")
+	    call pargi (qpio_stati(io, QPIO_PL))
+	call printf ("%s=%d ")
+	    call pargstr ("eventlen")
+	    call pargi (qpio_stati(io, QPIO_EVENTLEN))
+	call printf ("%s=%d ")
+	    call pargstr ("fd")
+	    call pargi (qpio_stati(io, QPIO_FD))
+	call printf ("\n")
+
+	call printf ("%s=%d ")
+	    call pargstr ("indexlen")
+	    call pargi (qpio_stati(io, QPIO_INDEXLEN))
+	call printf ("%s=%d ")
+	    call pargstr ("ixxoff")
+	    call pargi (qpio_stati(io, QPIO_IXXOFF))
+	call printf ("%s=%d ")
+	    call pargstr ("ixxtype")
+	    call pargi (qpio_stati(io, QPIO_IXXTYPE))
+	call printf ("%s=%d ")
+	    call pargstr ("ixyoff")
+	    call pargi (qpio_stati(io, QPIO_IXYOFF))
+	call printf ("%s=%d ")
+	    call pargstr ("ixytype")
+	    call pargi (qpio_stati(io, QPIO_IXYTYPE))
+	call printf ("%s=%d ")
+	    call pargstr ("lf")
+	    call pargi (qpio_stati(io, QPIO_LF))
+	call printf ("%s=%xX ")
+	    call pargstr ("maskp")
+	    call pargi (qpio_stati(io, QPIO_MASKP))
+	call printf ("\n")
+
+	call printf ("%s=%xX ")
+	    call pargstr ("maxevp")
+	    call pargi (qpio_stati(io, QPIO_MAXEVP))
+	call printf ("%s=%xX ")
+	    call pargstr ("minevp")
+	    call pargi (qpio_stati(io, QPIO_MINEVP))
+	call printf ("%s=%d ")
+	    call pargstr ("ncols")
+	    call pargi (qpio_stati(io, QPIO_NCOLS))
+	call printf ("%s=%d ")
+	    call pargstr ("nlines")
+	    call pargi (qpio_stati(io, QPIO_NLINES))
+	call printf ("%s=%xX ")
+	    call pargstr ("paramp")
+	    call pargi (qpio_stati(io, QPIO_PARAMP))
+	call printf ("%s=%xX ")
+	    call pargstr ("qp")
+	    call pargi (qpio_stati(io, QPIO_QP))
+	call printf ("\n")
+
+	# Print domain attributes.
+	dd = IO_DD(io)
+	call printf ("Domain `%s': len=%d nfields=%d xfield=%d yfield=%d\n")
+	    call pargstr (datatype)
+	    call pargi (DD_STRUCTLEN(dd))
+	    call pargi (DD_NFIELDS(dd))
+	    call pargi (DD_XFIELD(dd))
+	    call pargi (DD_YFIELD(dd))
+
+	# Print min/max evl records.
+	do j = 1, 2 {
+	    if (j == 1) {
+		call printf ("minevl: ")
+		ev = qpio_stati (io, QPIO_MINEVP)
+	    } else {
+		call printf ("maxevl: ")
+		ev = qpio_stati (io, QPIO_MAXEVP)
+	    }
+
+	    do i = 1, DD_NFIELDS(dd) {
+		offset = DD_FOFFSET(dd,i)
+		dtype  = DD_FTYPE(dd,i)
+		size   = sizeof(dtype)
+
+		switch (dtype) {
+		case TY_SHORT:
+		    call printf (" s%d=%d")
+			call pargi (offset * size * SZB_CHAR)
+		    call pargs (Mems[coerce(ev,TY_SHORT,dtype) + offset])
+		case TY_INT:
+		    call printf (" i%d=%d")
+			call pargi (offset * size * SZB_CHAR)
+		    call pargi (Memi[coerce(ev,TY_SHORT,dtype) + offset])
+		case TY_LONG:
+		    call printf (" l%d=%d")
+			call pargi (offset * size * SZB_CHAR)
+		    call pargl (Meml[coerce(ev,TY_SHORT,dtype) + offset])
+		case TY_REAL:
+		    call printf (" r%d=%0.5g")
+			call pargi (offset * size * SZB_CHAR)
+		    call pargr (Memr[coerce(ev,TY_SHORT,dtype) + offset])
+		case TY_DOUBLE:
+		    call printf (" d%d=%0.8g")
+			call pargi (offset * size * SZB_CHAR)
+		    call pargd (Memd[coerce(ev,TY_SHORT,dtype) + offset])
+		default:
+		    call printf (" type=%d")
+			call pargi (dtype)
+		}
+	    }
+
+	    call printf ("\n")
+	}
+end
+
+
+# MKPOE -- Convert CFA poefile to QPOE poefile.
+# -------------------------
+
+# Size limiting defintions.
+define	LEN_EVBUF	512		# size of output event buffer
+define	LEN_CVBUF	1000		# max number of mask regions
+define	SZ_KEY		20
+
+# CFA Poefile definitions.
+define	SZ_EVENT	SZ_OEVENT
+define	SZ_IEVENT	10		# size of input event struct, chars
+define	SZ_OEVENT	12		# size of output event struct, chars
+define	SZ_FILEHEADER	256		# size of file header, chars
+
+# File header fields of interest.
+define	O_MISSION	1		# byte offset of "mission" field
+define	T_MISSION	TY_SHORT	# datatype of mission field
+define	O_INSTRUMENT	1		# byte offset of "instrument" field
+define	T_INSTRUMENT	TY_SHORT	# datatype of instrument field
+define	O_XDIM		129		# byte offset of Xdim field
+define	T_XDIM		TY_SHORT	# datatype of Xdim field
+define	O_YDIM		131		# byte offset of Ydim field
+define	T_YDIM		TY_SHORT	# datatype of Ydim field
+define	O_PSTART	505		# byte offset of PhotonStart field
+define	T_PSTART	TY_LONG		# datatype of PhotonStart field
+define	O_PSTOP		509		# byte offset of PhotonStop field
+define	T_PSTOP		TY_LONG		# datatype of PhotonStop field
+
+# Input event struct fields of interest.
+define	O_X		1		# sky coordinates
+define	T_X		TY_SHORT
+define	O_Y		3
+define	T_Y		TY_SHORT
+define	O_TIME		5		# arrival time
+define	T_TIME		TY_DOUBLE
+define	O_PHA		13		# pulse height
+define	T_PHA		TY_SHORT
+define	O_PI		15		# energy
+define	T_PI		TY_SHORT
+define	O_DX		17		# detector coordinates
+define	T_DX		TY_SHORT
+define	O_DY		19
+define	T_DY		TY_SHORT
+
+# The event struct to be stored in the QPOE file.
+define	EVTYPE		"event"
+define	FIELDLIST	"{s:x,s:y,s,s,d,s,s}"
+
+define	EV_X		Mems[$1]
+define	EV_Y		Mems[$1+1]
+define	EV_PHA		Mems[$1+2]
+define	EV_PI		Mems[$1+3]
+define	EV_TIME		Memd[($1+4-1)/SZ_DOUBLE+1]
+define	EV_DX		Mems[$1+8]
+define	EV_DY		Mems[$1+9]
+
+# Define an event structure with short coordinates
+define	S_FIELDLIST	"{s:x,s:y,s,s,d,s,s}"
+define	S_SZ_EVENT	10
+define	S_EV_X		Mems[$1]
+define	S_EV_Y		Mems[$1+1]
+define	S_EV_PHA	Mems[$1+2]
+define	S_EV_PI		Mems[$1+3]
+define	S_EV_TIME	Memd[($1+4-1)/SZ_DOUBLE+1]
+define	S_EV_DX		Mems[$1+8]
+define	S_EV_DY		Mems[$1+9]
+
+# Define an event structure with integer coordinates
+define	I_FIELDLIST	"{d,i:x,i:y,i,i,s,s}"
+define	I_SZ_EVENT	14
+define	I_EV_TIME	Memd[($1-1)/SZ_DOUBLE+1]
+define	I_EV_X		Memi[($1+4-1)/SZ_INT+1]
+define	I_EV_Y		Memi[($1+6-1)/SZ_INT+1]
+define	I_EV_DX		Memi[($1+8-1)/SZ_INT+1]
+define	I_EV_DY		Memi[($1+10-1)/SZ_INT+1]
+define	I_EV_PHA	Mems[$1+12]
+define	I_EV_PI		Mems[$1+13]
+
+# Define an event structure with real coordinates
+define	R_FIELDLIST	"{d,r:x,r:y,r,r,s,s}"
+define	R_SZ_EVENT	14
+define	R_EV_TIME	Memd[($1-1)/SZ_DOUBLE+1]
+define	R_EV_X		Memr[($1+4-1)/SZ_REAL+1]
+define	R_EV_Y		Memr[($1+6-1)/SZ_REAL+1]
+define	R_EV_DX		Memr[($1+8-1)/SZ_REAL+1]
+define	R_EV_DY		Memr[($1+10-1)/SZ_REAL+1]
+define	R_EV_PHA	Mems[$1+12]
+define	R_EV_PI		Mems[$1+13]
+
+# Define an event structure with double coordinates
+define	D_FIELDLIST	"{d,d:x,d:y,d,d,s,s}"
+define	D_SZ_EVENT	22
+define	D_EV_TIME	Memd[($1-1)/SZ_DOUBLE+1]
+define	D_EV_X		Memd[($1+4-1)/SZ_DOUBLE+1]
+define	D_EV_Y		Memd[($1+8-1)/SZ_DOUBLE+1]
+define	D_EV_DX		Memd[($1+12-1)/SZ_DOUBLE+1]
+define	D_EV_DY		Memd[($1+16-1)/SZ_DOUBLE+1]
+define	D_EV_PHA	Mems[$1+20]
+define	D_EV_PI		Mems[$1+21]
+
+
+# MKPOE -- Write out a new POEFILE, taking a CFA POE file as input.
+# The input file uses big-endian format for integers, and IEEE for floats.
+# The input file must be sorted in order for the output file to be indexed.
+
+procedure t_mkpoe()
+
+char	infile[SZ_FNAME]		# input CFA-format poefile
+char	outfile[SZ_FNAME]		# output QPOE-format poefile
+
+char	key[SZ_KEY]
+pointer	sp, hdr, obuf, optr, ph, ev, qp, io
+int	datastart, dataend, mission, instrument, now
+int	debug, nphotons, naxes, axlen[2], dmin[8], dmax[8], in, op, i
+
+bool	clgetb()
+double	mp_getd()
+pointer	qp_open(), qpio_open()
+int	open(), read(), mp_geti(), clgeti(), clktime()
+
+begin
+	call smark (sp)
+	call salloc (hdr, SZ_FILEHEADER, TY_CHAR)
+	call salloc (obuf, LEN_EVBUF * SZ_OEVENT / SZ_SHORT, TY_SHORT)
+	call salloc (optr, LEN_EVBUF, TY_POINTER)
+	call salloc (ph, SZ_IEVENT, TY_CHAR)
+
+	call clgstr ("infile", infile, SZ_FNAME)
+	call clgstr ("outfile", outfile, SZ_FNAME)
+
+	# Open the input and output files.  Clobber the output file if
+	# it already exists.
+
+	in = open (infile, READ_ONLY, BINARY_FILE)
+	iferr (call qp_delete (outfile))
+	    ;
+	qp = qp_open (outfile, NEW_FILE, NULL)
+
+	# Set the datafile page size.
+	call qp_seti (qp, QPOE_PAGESIZE, clgeti("pagesize"))
+
+	# Set the bucket length in units of number of events.
+	call qp_seti (qp, QPOE_BUCKETLEN, clgeti("bucketlen"))
+
+	# Set the debug level.
+	debug = clgeti ("debug")
+	call qp_seti (qp, QPOE_DEBUGLEVEL, debug)
+
+	# Read and decode the input file header.
+	if (read (in, Memc[hdr], SZ_FILEHEADER) < SZ_FILEHEADER)
+	    call error (1, "cannot read input file header")
+
+	naxes      = 2
+	axlen[1]   = mp_geti (Memc[hdr], O_XDIM, T_XDIM)
+	axlen[2]   = mp_geti (Memc[hdr], O_YDIM, T_YDIM)
+	datastart  = mp_geti (Memc[hdr], O_PSTART, T_PSTART)
+	dataend    = mp_geti (Memc[hdr], O_PSTOP, T_PSTOP)
+	nphotons   = (dataend - datastart + 1) / (SZ_IEVENT * SZB_CHAR)
+
+	mission    = mp_geti (Memc[hdr], O_MISSION, T_MISSION)
+	instrument = mp_geti (Memc[hdr], O_INSTRUMENT, T_INSTRUMENT)
+
+	call eprintf ("xdim=%d, ydim=%d, datastart=%d, nphotons=%d\n")
+	    call pargi (axlen[1])
+	    call pargi (axlen[2])
+	    call pargi (datastart)
+	    call pargi (nphotons)
+
+	# Setup the QPOE file header.
+	call qp_addf (qp, "naxes", "i", 1, "number of image axes", 0)
+	call qp_puti (qp, "naxes", naxes)
+	call qp_addf (qp, "axlen", "i", 2, "length of each axis", 0)
+	call qp_write (qp, "axlen", axlen, 2, 1, "i")
+
+	now = clktime(0)
+	call qp_addf (qp, "cretime", "i", 1, "image creation time", 0)
+	call qp_puti (qp, "cretime", now)
+	call qp_addf (qp, "modtime", "i", 1, "image modify time", 0)
+	call qp_puti (qp, "modtime", now)
+	call qp_addf (qp, "limtime", "i", 1, "data min/max update time", 0)
+	call qp_puti (qp, "limtime", now)
+
+	# Invent some data min/max values for now.
+	do i = 1, 8 {
+	    dmin[i] = 0
+	    dmax[i] = 64
+	}
+	call qp_addf (qp, "datamin", "i", 8, "minimum pixel value", 0)
+	call qp_write (qp, "datamin", dmin, 8, 1, "i")
+	call qp_addf (qp, "datamax", "i", 8, "maximum pixel value", 0)
+	call qp_write (qp, "datamax", dmax, 8, 1, "i")
+
+	# Throw in a few miscellaneous params for testing purposes.
+	call qp_addf (qp, "mission", "s", 1, "mission type code", 0)
+	call qp_puti (qp, "mission", mission)
+	call qp_addf (qp, "instrument", "s", 1, "instrument type code", 0)
+	call qp_puti (qp, "instrument", instrument)
+
+	# Define the event structure for the QPOE output file.
+	call qp_addf (qp, EVTYPE, FIELDLIST, 1, "event record type", 0)
+
+	# Copy the event (photon) list.
+	call qp_addf (qp, "events", "event", 0, "main event list", 0)
+	io = qpio_open (qp, "events", NEW_FILE)
+	call seek (in, datastart / SZB_CHAR + 1)
+	op = 0
+
+	do i = 1, nphotons {
+	    # Read next event.
+	    if (read (in, Memc[ph], SZ_IEVENT) < SZ_IEVENT)
+		call error (2, "photon event list truncated")
+
+	    # Copy/transform event struct (not very efficient, but this
+	    # is only debug code).
+
+	    ev = obuf + (op * SZ_OEVENT / SZ_SHORT)
+	    Memi[optr+op] = ev
+
+	    EV_TIME(ev) = mp_getd (Memc[ph], O_TIME, T_TIME)
+	    EV_X(ev)    = mp_geti (Memc[ph], O_X, T_X)
+	    EV_Y(ev)    = mp_geti (Memc[ph], O_Y, T_Y)
+	    EV_PHA(ev)  = mp_geti (Memc[ph], O_PHA, T_PHA)
+	    EV_PI(ev)   = mp_geti (Memc[ph], O_PI, T_PI)
+	    EV_DX(ev)   = mp_geti (Memc[ph], O_DX, T_DX)
+	    EV_DY(ev)   = mp_geti (Memc[ph], O_DY, T_DY)
+
+	    if (debug > 4) {
+		call eprintf ("%4d %4d %4d %4d %7d %7d %g\n")
+		    call pargs (EV_X(ev))
+		    call pargs (EV_Y(ev))
+		    call pargs (EV_DX(ev))
+		    call pargs (EV_DY(ev))
+		    call pargs (EV_PHA(ev))
+		    call pargs (EV_PI(ev))
+		    call pargd (EV_TIME(ev))
+	    }
+
+	    # Bump output pointer and flush output buffer when it fills.
+	    op = op + 1
+	    if (op >= LEN_EVBUF) {
+		call qpio_putevents (io, Memi[optr], op)
+		op = 0
+	    }
+	}
+
+	# Flush any remaining buffered data.
+	if (op > 0)
+	    call qpio_putevents (io, Memi[optr], op)
+
+	# Construct index.
+	if (clgetb ("mkindex")) {
+	    call clgstr ("key", key, SZ_KEY)
+	    call qpio_mkindex (io, key)
+	}
+
+	# Clean up.
+	call qpio_close (io)
+	call qp_close (qp)
+	call close (in)
+
+	call sfree (sp)
+end
+
+
+# MP_GETI -- Get an integer field from the raw input data.
+
+int procedure mp_geti (buf, boffset, dtype)
+
+char	buf[ARB]		# byte-stream data buffer
+int	boffset			# byte offset of desired field
+int	dtype			# datatype of stored field
+
+short	sval
+int	nbytes, ival
+int	sizeof()
+
+begin
+	nbytes = sizeof(dtype) * SZB_CHAR
+
+	switch (dtype) {
+	case TY_SHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (buf, boffset, sval, 1, nbytes)
+	    else
+		call bytmov (buf, boffset, sval, 1, nbytes)
+	    return (sval)
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (buf, boffset, ival, 1, nbytes)
+	    else
+		call bytmov (buf, boffset, ival, 1, nbytes)
+	    return (ival)
+	default:
+	    call error (3, "bad dtype switch in mp_geti")
+	}
+end
+
+
+# MP_GETD -- Get a double field from the raw input data.  We assume that both
+# the input and output are IEEE floating, hence all we are really doing here
+# is providing for arbitrarily aligned fields, and providing type conversion.
+
+double procedure mp_getd (buf, boffset, dtype)
+
+char	buf[ARB]		# byte-stream data buffer
+int	boffset			# byte offset of desired field
+int	dtype			# datatype of stored field
+
+double	dval
+real	rval
+int	nbytes, half
+int	sizeof()
+
+begin
+	nbytes = sizeof(dtype) * SZB_CHAR
+	half   = nbytes / 2
+
+	switch (dtype) {
+	case TY_REAL:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (buf, boffset, rval, 1, nbytes)
+	    else
+		call bytmov (buf, boffset, rval, 1, nbytes)
+	    return (rval)
+	case TY_DOUBLE:
+	    if (BYTE_SWAP4 == YES) {
+		call bswap4 (buf, boffset, dval, 1+half, half)
+		call bswap4 (buf, boffset+half, dval, 1, half)
+	    } else
+		call bytmov (buf, boffset, dval, 1, nbytes)
+	    return (dval)
+	default:
+	    call error (3, "bad dtype switch in mp_getd")
+	}
+end
+
+
+# TESTPOE -- Make a test QPOE file, generating an artificial sequence of
+# events (for testing special cases).  The event list is not sorted or
+# indexed.
+
+procedure t_testpoe()
+
+char	outfile[SZ_FNAME]		# output QPOE-format poefile
+
+pointer	sp, ev, qp, io, evl[1]
+int	nevents, naxes, axlen[2], i, datatype
+pointer	qp_open(), qpio_open()
+int	clgeti()
+char	clgetc()
+
+begin
+	# Open the output file.
+	call clgstr ("outfile", outfile, SZ_FNAME)
+	iferr (call qp_delete (outfile))
+	    ;
+	qp = qp_open (outfile, NEW_FILE, NULL)
+
+	naxes = 2
+	axlen[1] = clgeti ("ncols")
+	axlen[2] = clgeti ("nlines")
+	datatype = clgetc ("datatype")
+
+	# Setup the QPOE file header.
+	call qp_addf (qp, "naxes", "i", 1, "number of image axes", 0)
+	call qp_puti (qp, "naxes", naxes)
+	call qp_addf (qp, "axlen", "i", 2, "length of each axis", 0)
+	call qp_write (qp, "axlen", axlen, 2, 1, "i")
+
+	# Define the event structure for the QPOE output file.
+	call smark (sp)
+	switch (datatype) {
+	case 's':
+	    call salloc (ev, S_SZ_EVENT / SZ_SHORT, TY_SHORT)
+	    call qp_addf (qp, EVTYPE, S_FIELDLIST, 1, "event record type", 0)
+	case 'i':
+	    call salloc (ev, I_SZ_EVENT / SZ_SHORT, TY_SHORT)
+	    call qp_addf (qp, EVTYPE, I_FIELDLIST, 1, "event record type", 0)
+	case 'r':
+	    call salloc (ev, R_SZ_EVENT / SZ_SHORT, TY_SHORT)
+	    call qp_addf (qp, EVTYPE, R_FIELDLIST, 1, "event record type", 0)
+	case 'd':
+	    call salloc (ev, D_SZ_EVENT / SZ_SHORT, TY_SHORT)
+	    call qp_addf (qp, EVTYPE, D_FIELDLIST, 1, "event record type", 0)
+	}
+
+
+	# Copy the event (photon) list.
+	call qp_addf (qp, "events", "event", 0, "main event list", 0)
+	io = qpio_open (qp, "events", NEW_FILE)
+
+	# Generate some dummy events.
+	nevents = clgeti ("nevents")
+	evl[1] = ev
+
+	# Hack this to generate different types of test files.
+	do i = 1, nevents {
+	    switch (datatype) {
+
+	    case 's':
+	        S_EV_TIME(ev) = 1.0D0 + double(i) / 10.0D0
+	        if (mod(i,2) == 0) {
+		    S_EV_X(ev) = (i - 1) * 10 + 1
+		    S_EV_Y(ev) = (i - 1) * 10 + 1
+	        } else {
+		    S_EV_X(ev) = axlen[1] - ((i - 1) * 10 + 1)
+		    S_EV_Y(ev) = axlen[2] - ((i - 1) * 10 + 1)
+	        }
+	        S_EV_PHA(ev)  = mod (nint(i * 11.1111), 20)
+	        S_EV_PI(ev)   = i / 2
+	        S_EV_DX(ev)   = nevents - i + 1
+	        S_EV_DY(ev)   = nevents - i + 1
+
+	    case 'i':
+	        I_EV_TIME(ev) = 1.0D0 + double(i) / 10.0D0
+	        if (mod(i,2) == 0) {
+		    I_EV_X(ev) = (i - 1) * 10 + 1
+		    I_EV_Y(ev) = (i - 1) * 10 + 1
+	        } else {
+		    I_EV_X(ev) = axlen[1] - ((i - 1) * 10 + 1)
+		    I_EV_Y(ev) = axlen[2] - ((i - 1) * 10 + 1)
+	        }
+	        I_EV_PHA(ev)  = mod (nint(i * 11.1111), 20)
+	        I_EV_PI(ev)   = i / 2
+	        I_EV_DX(ev)   = nevents - i + 1
+	        I_EV_DY(ev)   = nevents - i + 1
+
+	    case 'r':
+	        R_EV_TIME(ev) = 1.0D0 + double(i) / 10.0D0
+	        if (mod(i,2) == 0) {
+		    R_EV_X(ev) = (i - 1) * 10 + 1
+		    R_EV_Y(ev) = (i - 1) * 10 + 1
+	        } else {
+		    R_EV_X(ev) = axlen[1] - ((i - 1) * 10 + 1)
+		    R_EV_Y(ev) = axlen[2] - ((i - 1) * 10 + 1)
+	        }
+	        R_EV_PHA(ev)  = mod (nint(i * 11.1111), 20)
+	        R_EV_PI(ev)   = i / 2
+	        R_EV_DX(ev)   = nevents - i + 1
+	        R_EV_DY(ev)   = nevents - i + 1
+
+	    case 'd':
+	        D_EV_TIME(ev) = 1.0D0 + double(i) / 10.0D0
+	        if (mod(i,2) == 0) {
+		    D_EV_X(ev) = (i - 1) * 10 + 1
+		    D_EV_Y(ev) = (i - 1) * 10 + 1
+	        } else {
+		    D_EV_X(ev) = axlen[1] - ((i - 1) * 10 + 1)
+		    D_EV_Y(ev) = axlen[2] - ((i - 1) * 10 + 1)
+	        }
+	        D_EV_PHA(ev)  = mod (nint(i * 11.1111), 20)
+	        D_EV_PI(ev)   = i / 2
+	        D_EV_DX(ev)   = nevents - i + 1
+	        D_EV_DY(ev)   = nevents - i + 1
+
+	    }
+
+	    call qpio_putevents (io, evl, 1)
+	}
+
+	# Clean up.
+	call qpio_close (io)
+	call qp_close (qp)
+	call sfree (sp)
+end
+
+
+# COUNTPOE -- Count photons in regions.  Whether or not there are any regions
+# depends upon whether the user specifies a region mask, or upon whether the
+# image has a default mask.   If there is no mask the entire image is counted.
+# If the user specifies a filter then event attribute filtering will be
+# performed as well.  Mask region values should be restricted to the range
+# 0-999.
+
+procedure t_countpoe()
+
+bool	list_events
+int	debug, nev, mval, m, i
+pointer	sp, qp, poefile, evlist, evl, cv, ev, io
+
+bool	clgetb()
+pointer	qp_open(), qpio_open()
+int	qpio_getevents(), clgeti()
+
+begin
+	call smark (sp)
+	call salloc (poefile, SZ_FNAME, TY_CHAR)
+	call salloc (evlist, SZ_EXPR, TY_CHAR)
+	call salloc (evl, LEN_EVBUF, TY_POINTER)
+	call salloc (cv,  LEN_CVBUF, TY_INT)
+
+	call clgstr ("poefile", Memc[poefile], SZ_FNAME)
+	qp = qp_open (Memc[poefile], READ_ONLY, NULL)
+
+	debug = clgeti ("debug")
+	call qp_seti (qp, QPOE_DEBUGLEVEL, debug)
+
+	call clgstr ("eventlist", Memc[evlist], SZ_EXPR)
+	io = qpio_open (qp, Memc[evlist], READ_ONLY)
+
+	list_events = clgetb ("list_events")
+	if (list_events)
+	    call printf ("  EV    X    Y   DX   DY     PHA      PI   TIME\n")
+
+	call aclri (Memi[cv], LEN_CVBUF)
+
+	# Scan the event list.
+	while (qpio_getevents (io, Memi[evl], mval, LEN_EVBUF, nev) != EOF) {
+	    if (list_events) {
+		do i = 1, nev {
+		    ev = Memi[evl+i-1]
+		    call printf ("%4d %4d %4d %4d %4d %7d %7d   %g\n")
+			call pargi (i)
+			call pargs (EV_X(ev))
+			call pargs (EV_Y(ev))
+			call pargs (EV_DX(ev))
+			call pargs (EV_DY(ev))
+			call pargs (EV_PHA(ev))
+			call pargs (EV_PI(ev))
+			call pargd (EV_TIME(ev))
+		}
+	    }
+
+	    m = min (LEN_CVBUF, mval)
+	    Memi[cv+m] = Memi[cv+m] + nev
+	}
+
+	call qpio_close (io)
+
+	# Print the count of the number of photons in each region.
+	if (list_events)
+	    call printf ("\n")
+
+	call printf ("REGION: ")
+	do i = 0, LEN_CVBUF-1
+	    if (Memi[cv+i] > 0) {
+		call printf (" %6oB")
+		    call pargi (i)
+	    }
+	call printf ("\n")
+
+	call printf ("COUNTS: ")
+	do i = 0, LEN_CVBUF-1
+	    if (Memi[cv+i] > 0) {
+		call printf (" %7d")
+		    call pargi (Memi[cv+i])
+	    }
+	call printf ("\n")
+
+	call qp_close (qp)
+	call sfree (sp)
+end
+
+
+# TFILTER -- Perform a brute force time filtering operation upon an event
+# list, and compare against the results of a standard QPEX time filter.
+# This is used to verify the operation of the optimized QPEX time filter.
+
+procedure t_tfilter()
+
+bool	open_left, open_right, pass
+int	nev1, nev2, totev, mval, nev, xlen, nranges, fd1, fd2, i, j
+pointer	sp, poefile, filter, output, fname, evl, x1, y1, t1, x2, y2, t2
+pointer	qp, io, ex, ev, xs, xe
+double	t
+
+bool	clgetb()
+int	qpio_getevents(), qpex_attrld(), open()
+pointer	qp_open(), qpio_open(), qpex_open()
+
+begin
+	call smark (sp)
+	call salloc (poefile, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (filter, SZ_EXPR, TY_CHAR)
+	call salloc (evl, LEN_EVBUF, TY_POINTER)
+
+	call salloc (x1, MAX_EVENTS, TY_SHORT)
+	call salloc (y1, MAX_EVENTS, TY_SHORT)
+	call salloc (t1, MAX_EVENTS, TY_DOUBLE)
+	call salloc (x2, MAX_EVENTS, TY_SHORT)
+	call salloc (y2, MAX_EVENTS, TY_SHORT)
+	call salloc (t2, MAX_EVENTS, TY_DOUBLE)
+
+	nev1 = 0
+	nev2 = 0
+	totev = 0
+
+	call clgstr ("poefile", Memc[poefile], SZ_FNAME)
+	qp = qp_open (Memc[poefile], READ_ONLY, NULL)
+	io = qpio_open (qp, "", READ_ONLY)
+
+	call clgstr ("filter", Memc[filter], SZ_EXPR)
+	ex = qpex_open (qp, Memc[filter])
+
+	call clgstr ("output", Memc[output], SZ_FNAME)
+
+	if (clgetb ("showfilter")) {
+	    call qpex_debug (ex, STDOUT, QPEXD_SHOWALL)
+	    call flush (STDOUT)
+	}
+
+	# Scan the event list using the given filter.
+	call printf ("scan event list using optimized filter: ")
+	call flush (STDOUT)
+
+	call qpio_seti (io, QPIO_EX, ex)
+	while (qpio_getevents (io, Memi[evl], mval, LEN_EVBUF, nev) != EOF) {
+	    do i = 1, nev {
+		ev = Memi[evl+i-1]
+		Mems[x1+nev1] = EV_X(ev)
+		Mems[y1+nev1] = EV_Y(ev)
+		Memd[t1+nev1] = EV_TIME(ev)
+		nev1 = min (MAX_EVENTS, nev1 + 1)
+	    }
+	}
+
+	call printf ("%d events\n")
+	    call pargi (nev1)
+	xlen = 128
+	call malloc (xs, TY_DOUBLE, xlen)
+	call malloc (xe, TY_DOUBLE, xlen)
+
+	# Get the time filter as a list of ranges.
+	xs = NULL;  xe = NULL;  xlen = 0
+	nranges = qpex_attrld (ex, "time", xs, xe, xlen)
+	if (nranges > 0) {
+	    open_left = IS_INDEF(Memd[xs])
+	    open_right = IS_INDEF(Memd[xe+nranges-1])
+	} else {
+	    open_left = false
+	    open_right = false
+	}
+
+	# Scan the event list, applying a brute force time filter.
+	call qpio_seti (io, QPIO_EX, NULL)
+	call printf ("scan event list using brute force filter: ")
+	call flush (STDOUT)
+
+	while (qpio_getevents (io, Memi[evl], mval, LEN_EVBUF, nev) != EOF) {
+	    do i = 1, nev {
+		ev = Memi[evl+i-1]
+		t = EV_TIME(ev)
+
+		# Apply the time filter.
+		if (open_left && open_right && nranges == 1)
+		    pass = true
+		else {
+		    pass = false
+		    do j = 1, nranges {
+			if (j == 1 && open_left) {
+			    if (t <= Memd[xe]) {
+				pass = true
+				break
+			    }
+			} else if (j == nranges && open_right) {
+			    if (t >= Memd[xs+nranges-1]) {
+				pass = true
+				break
+			    }
+			} else if (t >= Memd[xs+j-1] && t <= Memd[xe+j-1]) {
+			    pass = true
+			    break
+			}
+		    }
+		}
+
+		if (pass) {
+		    Mems[x2+nev2] = EV_X(ev)
+		    Mems[y2+nev2] = EV_Y(ev)
+		    Memd[t2+nev2] = EV_TIME(ev)
+		    nev2 = min (MAX_EVENTS, nev2 + 1)
+		}
+	    }
+
+	    totev = totev + nev
+	}
+
+	call printf ("%d events\n")
+	    call pargi (nev2)
+	call printf ("out of a total of %d events\n")
+	    call pargi (totev)
+	call flush (STDOUT)
+
+	# Dump the two event lists if an output root filename was given.
+	if (Memc[output] != EOS) {
+	    call sprintf (Memc[fname], SZ_FNAME, "%s.1")
+		call pargstr (Memc[output])
+	    iferr (call delete (Memc[fname]))
+		;
+	    fd1 = open (Memc[fname], NEW_FILE, TEXT_FILE)
+
+	    call sprintf (Memc[fname], SZ_FNAME, "%s.2")
+		call pargstr (Memc[output])
+	    iferr (call delete (Memc[fname]))
+		;
+	    fd2 = open (Memc[fname], NEW_FILE, TEXT_FILE)
+
+	    do i = 1, max (nev1, nev2) {
+		if (i <= nev1) {
+		    call fprintf (fd1, "%d %d %g\n")
+			call pargs (Mems[x1+i-1])
+			call pargs (Mems[y1+i-1])
+			call pargd (Memd[t1+i-1])
+		}
+		if (i <= nev2) {
+		    call fprintf (fd2, "%d %d %g\n")
+			call pargs (Mems[x2+i-1])
+			call pargs (Mems[y2+i-1])
+			call pargd (Memd[t2+i-1])
+		}
+	    }
+
+	    call close (fd1)
+	    call close (fd2)
+	}
+
+	# Compare the results of the two filters for equality.
+	pass = true
+	do i = 1, min (nev1, nev2) {
+	    if (Mems[x1+i-1] != Mems[x2+i-1] || Mems[y1+i-1] != Mems[y2+i-1]) {
+		call printf ("bad compare at event %d: ")
+		    call pargi (i)
+		call printf ("[%d,%d,%0.4f] != [%d,%d,%0.4f]\n")
+		    call pargs (Mems[x1+i-1])
+		    call pargs (Mems[y1+i-1])
+		    call pargd (Memd[t1+i-1])
+		    call pargs (Mems[x2+i-1])
+		    call pargs (Mems[y2+i-1])
+		    call pargd (Memd[t2+i-1])
+		pass = false
+		break
+	    }
+	}
+
+	if (pass) {
+	    call printf ("first %d events are identical\n")
+		call pargi (min (nev1, nev2))
+	}
+
+	call mfree (xs, TY_DOUBLE)
+	call mfree (xe, TY_DOUBLE)
+	call qpex_close (ex)
+	call qpio_close (io)
+	call qp_close (qp)
+
+	call sfree (sp)
+end
+
+
+# PLOTPOE -- Read and plot photons, showing the position of each photon
+# in the image matrix, according to the current coordinate system.
+
+procedure t_plotpoe()
+
+int	ncols, nlines, xblock, yblock, mval, nev, i
+pointer	sp, poefile, evlist, evl, xv, yv, qp, io, ev, gp
+pointer	qp_open(), gopen(), qpio_open
+int	clgeti(), qp_stati(), qp_geti(), qpio_getevents()
+
+begin
+	call smark (sp)
+	call salloc (poefile, SZ_FNAME, TY_CHAR)
+	call salloc (evlist, SZ_EXPR, TY_CHAR)
+	call salloc (evl, LEN_EVBUF, TY_POINTER)
+	call salloc (xv, LEN_EVBUF, TY_REAL)
+	call salloc (yv, LEN_EVBUF, TY_REAL)
+
+	call clgstr ("poefile", Memc[poefile], SZ_FNAME)
+	qp = qp_open (Memc[poefile], READ_ONLY, NULL)
+
+	call qp_seti (qp, QPOE_DEBUGLEVEL, clgeti ("debug"))
+	call qp_seti (qp, QPOE_XBLOCKFACTOR, clgeti ("xblock"))
+	call qp_seti (qp, QPOE_YBLOCKFACTOR, clgeti ("yblock"))
+
+	xblock = qp_stati (qp, QPOE_XBLOCKFACTOR)
+	yblock = qp_stati (qp, QPOE_YBLOCKFACTOR)
+	ncols  = qp_geti (qp, "axlen[1]") / xblock
+	nlines = qp_geti (qp, "axlen[2]") / yblock
+
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	call gswind (gp, 1., real(ncols), 1., real(nlines))
+	call gsetr (gp, G_ASPECT, 1.0)
+
+	call clgstr ("eventlist", Memc[evlist], SZ_EXPR)
+	io = qpio_open (qp, Memc[evlist], READ_ONLY)
+
+	if (Memc[evlist] == EOS)
+	    call glabax (gp, "events", "X", "Y")
+	else
+	    call glabax (gp, Memc[evlist], "X", "Y")
+
+	# Scan the event list.
+	while (qpio_getevents (io, Memi[evl], mval, LEN_EVBUF, nev) != EOF) {
+	    do i = 1, nev {
+		ev = Memi[evl+i-1]
+		Memr[xv+i-1] = EV_X(ev) / xblock + 1.0
+		Memr[yv+i-1] = EV_Y(ev) / yblock + 1.0
+	    }
+	    call gpmark (gp, Memr[xv], Memr[yv], nev, GM_POINT, 0.0, 0.0)
+	    call gflush (gp)
+	}
+
+	call qpio_close (io)
+	call gclose (gp)
+
+	call qp_close (qp)
+	call sfree (sp)
+end
+
+
+# SUM -- Sum the counts in an image section.
+
+procedure t_sum()
+
+double	sum
+char	image[SZ_LINE]
+int	ncols, nlines, i
+pointer	im, immap(), imgl2i()
+real	asumi()
+
+begin
+	call clgstr ("image", image, SZ_LINE)
+	im = immap (image, READ_ONLY, 0)
+
+	ncols  = IM_LEN(im,1)
+	nlines = IM_LEN(im,2)
+
+	call printf ("ncols=%d, nlines=%d, pixtype=%d\n")
+	    call pargi (ncols)
+	    call pargi (nlines)
+	    call pargi (IM_PIXTYPE(im))
+	call flush (STDOUT)
+
+	sum = 0
+	do i = 1, nlines
+	    sum = sum + asumi (Memi[imgl2i(im,i)], ncols)
+
+	call printf ("total pixels = %d, counts = %14.0f\n")
+	    call pargi (ncols * nlines)
+	    call pargd (sum)
+
+	call imunmap (im)
+end
+
+
+# SETWCS -- Store a wcs in a QPOE file.
+
+procedure t_setwcs()
+
+pointer	qp, mw
+char	text[SZ_LINE]
+pointer	qp_open, mw_open
+
+begin
+	call clgstr ("poefile", text, SZ_LINE)
+	qp = qp_open (text, READ_WRITE, 0)
+	
+	mw = mw_open (NULL, 2)
+	call qp_savewcs (qp, mw)
+
+	call mw_close (mw)
+	call qp_close (qp)
+end
+
+
+# SETFILT -- Set the default filter in a QPOE file.
+
+procedure t_setfilt()
+
+pointer	qp
+char	poefile[SZ_FNAME]
+char	filter[SZ_LINE]
+pointer	qp_open()
+
+begin
+	call clgstr ("poefile", poefile, SZ_FNAME)
+	qp = qp_open (poefile, READ_WRITE, 0)
+
+	call clgstr ("deffilt", filter, SZ_LINE)
+	call qp_astr (qp, "deffilt", filter, "default filter")
+
+	call qp_close (qp)
+end
+
+
+# SETMASK -- Set the default mask in a QPOE file.
+
+procedure t_setmask()
+
+pointer	qp
+char	poefile[SZ_FNAME]
+char	mask[SZ_LINE]
+pointer	qp_open()
+
+begin
+	call clgstr ("poefile", poefile, SZ_FNAME)
+	qp = qp_open (poefile, READ_WRITE, 0)
+
+	call clgstr ("defmask", mask, SZ_LINE)
+	call qp_astr (qp, "defmask", mask, "default mask")
+
+	call qp_close (qp)
+end
+
+
+# MERGEI -- Test the merge range list routine (integer version).
+# The lists may be specified either as strings, or as @file-name.
+
+procedure t_mergei()
+
+int	p1, p2
+char	list1[SZ_LINE], list2[SZ_LINE]
+pointer	sp, rl1, rl2, op, xs, xe, ys, ye, os, oe
+int	fd, ch, xlen, ylen, olen, nx, ny, nout, i
+int	open(), getci(), qpex_parsei(), qp_rlmergei()
+
+begin
+	call smark (sp)
+	call salloc (rl1, SZ_RLBUF, TY_CHAR)
+	call salloc (rl2, SZ_RLBUF, TY_CHAR)
+
+	# Get the first range list.
+	call clgstr ("list1", list1, SZ_LINE)
+	if (list1[1] == '@') {
+	    fd = open (list1[2], READ_ONLY, TEXT_FILE)
+	    op = rl1
+	    while (getci (fd, ch) != EOF) {
+		if (ch == '\n')
+		    ch = ' '
+		Memc[op] = ch
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	} else
+	    call strcpy (list1, Memc[rl1], SZ_RLBUF)
+
+	# Get the second range list.
+	call clgstr ("list2", list2, SZ_LINE)
+	if (list2[1] == '@') {
+	    fd = open (list2[2], READ_ONLY, TEXT_FILE)
+	    op = rl2
+	    while (getci (fd, ch) != EOF) {
+		if (ch == '\n')
+		    ch = ' '
+		Memc[op] = ch
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	} else
+	    call strcpy (list2, Memc[rl2], SZ_RLBUF)
+
+	# Parse the lists.
+	xlen = 100
+	call malloc (xs, xlen, TY_INT)
+	call malloc (xe, xlen, TY_INT)
+	nx = qpex_parsei (Memc[rl1], xs, xe, xlen)
+
+	ylen = 100
+	call malloc (ys, ylen, TY_INT)
+	call malloc (ye, ylen, TY_INT)
+	ny = qpex_parsei (Memc[rl2], ys, ye, ylen)
+
+	# Merge the lists.
+	olen = 100
+	call malloc (os, olen, TY_INT)
+	call malloc (oe, olen, TY_INT)
+	nout = qp_rlmergei (os,oe,olen,
+	    Memi[xs],Memi[xe],nx, Memi[ys],Memi[ye],ny)
+
+	# Print results:
+	call printf ("---- list 1 -----\n")
+	do i = 1, nx {
+	    p1 = Memi[xs+i-1]
+	    p2 = Memi[xe+i-1]
+	    call printf ("%8d  %8s : %8s\n")
+		call pargi (i)
+		if (IS_LEFTI(p1))
+		    call pargstr ("left")
+		else
+		    call pargi (p1)
+		if (IS_RIGHTI(p2))
+		    call pargstr ("right")
+		else
+		    call pargi (p2)
+	}
+
+	call printf ("---- list 2 -----\n")
+	do i = 1, ny {
+	    p1 = Memi[ys+i-1]
+	    p2 = Memi[ye+i-1]
+	    call printf ("%8d  %8s : %8s\n")
+		call pargi (i)
+		if (IS_LEFTI(p1))
+		    call pargstr ("left")
+		else
+		    call pargi (p1)
+		if (IS_RIGHTI(p2))
+		    call pargstr ("right")
+		else
+		    call pargi (p2)
+	}
+
+	call printf ("---- merged -----\n")
+	do i = 1, nout {
+	    p1 = Memi[os+i-1]
+	    p2 = Memi[oe+i-1]
+	    call printf ("%8d  %8s : %8s\n")
+		call pargi (i)
+		if (IS_LEFTI(p1))
+		    call pargstr ("left")
+		else
+		    call pargi (p1)
+		if (IS_RIGHTI(p2))
+		    call pargstr ("right")
+		else
+		    call pargi (p2)
+	}
+
+	# Free list storage.
+	call mfree (xs, TY_INT);  call mfree (xe, TY_INT)
+	call mfree (ys, TY_INT);  call mfree (ye, TY_INT)
+	call mfree (os, TY_INT);  call mfree (oe, TY_INT)
+
+	call sfree (sp)
+end
+
+
+# CLEAR -- Clear the terminal screen.
+
+procedure t_clear()
+
+pointer	tty
+pointer	ttyodes()
+errchk	ttyodes
+
+begin
+	# Clear the screen.
+	tty = ttyodes ("terminal")
+	call ttyclear (STDOUT, tty)
+	call ttycdes (tty)
+end
diff --git a/sys/symtab/README b/sys/symtab/README
new file mode 100644
index 00000000..2fb705a0
--- /dev/null
+++ b/sys/symtab/README
@@ -0,0 +1,126 @@
+SYMTAB -- General package for managing symbol tables.  The logical view of a 
+symbol table is a collection of symbol structures.  The contents of a symbol
+description structure are user defined, but the size of the structure is fixed.
+The symbol name is a character string of arbitrary size, all characters of
+which are significant.  The storage semantics of the symbol table are those
+of a lifo stack, i.e., those symbols most recently defined must be the first
+deleted.  There is no fixed limit on the size of a symbol table; additional
+space will be dynamically allocated at run time if necessary.
+
+
+       stp =     stopen (name, len_index, len_stab, sz_sbuf)
+                stclose (stp)
+                 stmark (stp, marker)           # mark storage
+                 stfree (stp, marker)           # free to marked state
+      nsym = stnsymbols (stp, marker)		# number of symbols in table
+                 stinfo (stp, outfd)            # print info about symbol table
+
+       sym =    stenter (stp, key, symlen)      # enter new symbol in table
+       sym =     stfind (stp, key)              # search table for symbol
+      nsym =  stfindall (stp, key, sym, maxsym) # find all occurrences of symbol
+       sym =     sthead (stp)                   # last symbol entered into table
+       sym =     stnext (stp, sym)              # next symbol on global list
+     charp =     stname (stp, sym)              # access key name string
+
+    offset =     stpstr (stp, str, minchars)    # put string in string buffer
+    offset =    stalloc (stp, nints)            # alloc space in STAB
+     charp =  strefsbuf (stp, offset)           # convert sbuf offset into charp
+      intp =  strefstab (stp, offset)           # convert stab offset into intp
+
+                 stsave (stp, fd)               # save symbol table in a file
+       stp =  strestore (fd)                    # restore symbol table from file
+              stsqueeze (stp)                   # return unused storage
+     chars =     stsize (stp)			# chars req'd to store table
+
+
+The symbol table is maintained as a multi-threaded linked list.  This provides
+the efficiency of a hash table plus stack like semantics for redefinitions and
+for freeing blocks of variables.  There are three primary data structures
+internally, an array of pointers to the heads of the threads (the index),
+a buffer containing the list elements (the symbol table), and a string buffer.
+These data structures are dynamically allocated and will be automatically
+reallocated at runtime if overflow occurs.  The number of threads is fixed at
+table open time and determines the efficiency of table lookup.  The expected
+running time is O(1) for well conditioned tables, i.e., tables with a sparse
+index.  The worst case running time is O(N), i.e., the same as a linear search,
+but of course the worst case is very unlikely to occur.  Symbol entry and
+storage reclamation are especially efficient due to the use of a stack rather
+than a heap for symbol storage.
+
+	symtab descriptor
+		index (integer array, size fixed at open time)
+		sbuf  (char array, dynamic)
+		stab  (list of symstructs, dynamic)
+
+Each symbol consists of a variable size structure (symstruct) in STAB containing
+references to one or more associated strings in SBUF.  A symstruct consists of
+a fixed size SYMTAB header followed by a user defined structure, the size of
+which is fixed at STENTER time.  Each symstruct is linked on two lists,
+a global list and a hash list.  All symstructs are linked on the global list
+which is ordered with the most recently entered symbol at the head of the list.
+For a well conditioned table each hash list will typically contain zero or one
+symbols, more when there are redefinitions or when identifiers happen to hash
+to the same thread.  Often it is useful to store different types of entries
+in the same symbol table; since symstructs may vary in size this may be done
+efficiently.
+
+The STOPEN procedure is used to create a new symbol table.  The 'name' argument
+may be any string and is used for documentation purposes only.  The index
+length argument sets the size of the hash index which is fixed for the
+lifetime of the table.  The remaining two arguments specify the amount of
+symbol table space and string storage space to be initially allocated for the
+table.  The actual table may grow larger at runtime, but reallocation can be
+expensive hence it is desirable to preallocate a large space if it is known
+that the table will be large.
+
+The STMARK and STFREE procedures mark and free storage on the symbol table
+stack.  All symbols defined or redefined after a call to STMARK will be deleted
+and storage freed by a call to STFREE.  If a redef is freed the next most
+recent definition becomes current.  STFREE returns as its function value the
+number of redefined variables uncovered by the free operation.  The calling
+program must mark and free in the correct order or the symbol table may be
+trashed.  The argument to STMARK is a magic integer which currently references
+a marker record in the STAB containing the information necessary to mark and
+free storage (an integer is not large enough to hold all of the necessary
+information).
+
+STENTER is used to enter a new symbol into the symbol table.  If the named
+symbol is already present the new entry will nondestructively supercede the
+old, which may be recovered by a subsequent STFREE (this is especially useful
+for defining local contexts, e.g., when parsing a block structured language).
+STENTER returns a pointer to the newly allocated symbol structure.  This pointer
+may be invalidated if the symbol table buffer has to be reallocated in a
+subsequent call to STENTER.  STFIND searches the symbol table for the named
+key (symbol), returning a pointer to the most recently defined entry or NULL.
+Once again, this pointer may be invalidated by a subsquent call which adds
+to or removes symbols from the table.  STFINDALL finds all occurrences (or
+some maximum number of occurrences), returning an array of symstruct pointers
+ordered with the most recently defined symbols at the left.  STHEAD and STNEXT
+are used to scan symbols in the reverse of the order in which they were
+entered, e.g., for unkeyed symbol table searches.
+
+The symbol table uses an associated string buffer for string storage.  Keys
+(symbol names) are automatically added to the string buffer by STENTER.
+The string buffer is maintained as a stack, with STMARK and STFREE marking
+and freeing storage in the string buffer as well as in the symbol table buffer.
+The user may store data in either the string buffer or the symbol table
+provided the stack semantics are observed when marking and freeing storage.
+To permit dynamic reallocation, storage is referenced by offset rather than
+by pointer.  Only offsets into SBUF or STAB should be stored in symbol table
+entries.  String storage is allocated in SBUF with STPSTR (which also deposits
+the string).  Integer aligned storage is allocated in STAB with STALLOC.
+The offset of a string stored in SBUF may be converted to a char pointer
+with STREFSBUF.  The offset of a storage area in STAB may be converted into
+an integer pointer with STREFSTAB.  Pointer conversions such as these should
+not be done in the calling program since doing so requires knowledge of the
+internal SYMTAB data structures (in particular, that symbol table storage
+is contiguous).
+
+A symbol table may be saved in a binary file using STSAVE.  The space which
+will be required to store the symbol table may be queried in advance with
+STSIZE.  The internal SYMTAB data structures are simply appended to the file.
+The symbol table itself is not affected.  A saved symbol table may be restored
+to memory with STRESTORE, which is used in place of STOPEN.  The file must be
+opened and positioned to the correct offset before STRESTORE is called.
+It may be desirable to call STSQUEEZE before calling STSAVE or STSIZE,
+to minimize the file storage required to store the symbol table.
diff --git a/sys/symtab/mkpkg b/sys/symtab/mkpkg
new file mode 100644
index 00000000..7ce7d3bc
--- /dev/null
+++ b/sys/symtab/mkpkg
@@ -0,0 +1,30 @@
+# Make the SYMTAB general symbol table package.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	stalloc.x	symtab.h
+	stclose.x	symtab.h
+	stenter.x	symtab.h
+	stfind.x	symtab.h
+	stfindall.x	symtab.h
+	stfree.x	symtab.h
+	sthash.x	
+	sthead.x	symtab.h
+	stinfo.x	symtab.h
+	stmark.x	symtab.h
+	stname.x	symtab.h
+	stnext.x	symtab.h
+	stnsym.x	symtab.h
+	stopen.x	symtab.h
+	stpstr.x	symtab.h
+	strefsbuf.x	symtab.h
+	strefstab.x	symtab.h
+	strestore.x	symtab.h
+	stsave.x	symtab.h
+	stsize.x	symtab.h <mii.h>
+	stsqueeze.x	symtab.h
+	;
diff --git a/sys/symtab/stalloc.x b/sys/symtab/stalloc.x
new file mode 100644
index 00000000..1300953b
--- /dev/null
+++ b/sys/symtab/stalloc.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STALLOC -- Allocate a block of double aligned storage in the symbol table.
+# Increase the size of STAB if overflow occurs.
+
+int procedure stalloc (stp, blklen)
+
+pointer	stp			# symtab descriptor
+int	blklen			# number of integer units of storage
+int	offset, buflen
+
+begin
+	offset = (ST_STABOP(stp) + 1) / 2 * 2
+	buflen = ST_STABLEN(stp)
+
+	if (offset + blklen > buflen) {
+	    # Overflow has occurred.  Allocate a larger buffer; if overflow
+	    # continues to occur the increments grow successively larger to
+	    # minimize reallocation.
+
+	    buflen = buflen + max (blklen, ST_STABINC(stp))
+	    ST_STABINC(stp) = min (MAX_INCREMENT, ST_STABINC(stp) * INC_GROW)
+	    ST_STABLEN(stp) = buflen
+	    ST_STABNGROW(stp) = ST_STABNGROW(stp) + 1
+
+	    call realloc (ST_STABP(stp), buflen, TY_STRUCT)
+	}
+
+	ST_STABOP(stp) = offset + ((blklen + 1) / 2 * 2)
+	return (offset)
+end
diff --git a/sys/symtab/stclose.x b/sys/symtab/stclose.x
new file mode 100644
index 00000000..dc0991ed
--- /dev/null
+++ b/sys/symtab/stclose.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STCLOSE -- Return all storage used by a symbol table.
+
+procedure stclose (stp)
+
+pointer	stp			# symbol table descriptor
+
+begin
+	call mfree (ST_STABP(stp), TY_STRUCT)
+	call mfree (ST_SBUFP(stp), TY_CHAR)
+	call mfree (ST_INDEX(stp), TY_INT)
+	call mfree (stp, TY_STRUCT)
+end
diff --git a/sys/symtab/stenter.x b/sys/symtab/stenter.x
new file mode 100644
index 00000000..04294c97
--- /dev/null
+++ b/sys/symtab/stenter.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STENTER -- Add a symbol to the symbol table.  If the named symbol is already
+# present in the table it will be redefined until STFREE is called to return
+# the storage allocated for the current symbol.  A pointer to the user part
+# of the symstruct is returned as the function value.
+
+pointer	procedure stenter (stp, key, u_symlen)
+
+pointer	stp			# symbol table descriptor
+char	key[ARB]		# symbol name
+int	u_symlen		# length of user part of symstruct (su)
+
+long	sum
+pointer	el, tp
+int	symlen, new_symbol, thread, ip
+int	stpstr(), stalloc()
+errchk	stalloc, stpstr
+
+begin
+	if (key[1] == EOS)
+	    call error (1, "stenter: null key string")
+
+	# Hash the key onto a thread in the index.
+	sum = 0
+	do ip = 1, MAX_HASHCHARS {
+	    if (key[ip] == EOS)
+		break
+	    sum = sum + (sum + key[ip])
+	}
+
+	thread = mod (sum, ST_INDEXLEN(stp))
+	tp = ST_INDEX(stp) + thread
+
+	# Allocate space in STAB.
+	symlen = LEN_SYMSTRUCT + u_symlen
+	new_symbol = stalloc (stp, symlen)
+
+	# Initialize symstruct.
+	el = ST_STABP(stp) + new_symbol
+	E_NEXTHASH(el)	= Memi[tp]
+	E_NEXTGLOB(el)	= ST_LASTSYMBOL(stp)
+	E_THREAD(el)    = thread
+	E_KEY(el)	= stpstr (stp, key, 0)
+
+	# Set the head of thread list and the head of the global list to
+	# point to the new symbol.  Flag the first key character (used to
+	# quickly determine that a key beginning with a certain character
+	# is not present in the table).
+
+	Memi[tp] = new_symbol
+	ST_LASTSYMBOL(stp) = new_symbol
+	ST_NSYMBOLS(stp) = ST_NSYMBOLS(stp) + 1
+	ST_ASCII(stp,key[1]) = 1
+
+	return (E_USERFIELDS(el))
+end
diff --git a/sys/symtab/stfind.x b/sys/symtab/stfind.x
new file mode 100644
index 00000000..5ea75f77
--- /dev/null
+++ b/sys/symtab/stfind.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STFIND -- Search the symbol table for the named key and return a pointer to
+# the symstruct or NULL.  This is the main table lookup procedure.  If the
+# thread is empty NULL is returned after only a hash function call.  If there
+# is only one element on a thread (common for well conditioned symbol tables)
+# the expense is essentialy two traversals of the key string plus procedure
+# overhead (pointer calculations, etc.).
+
+pointer procedure stfind (stp, key)
+
+pointer	stp			# symbol table descriptor
+char	key[ARB]		# symbol name
+
+long	sum
+char	first_char
+int	head, ip, thread
+pointer	el, cp, stab, sbuf
+
+begin
+	# When a symbol is entered in the table a flag is set in the ST_ASCII
+	# array to flag that the symbol table contains at least one key
+	# beginning with that character.  If the flag is not set we can thus
+	# determine very quickly that the symbol is not present.  This is
+	# important for applications such as mapping identifiers for macro
+	# expansion, where most macros have upper case keys but most program
+	# identifiers have lower case keys.  (Subtle note: since the first
+	# element of ST_ASCII is for ascii value 0=EOS, the following also
+	# serves to detect null keys).
+
+	if (ST_ASCII(stp,key[1]) == 0)
+	    return (NULL)
+
+	# Hash the key onto a thread in the index.
+	sum = 0
+	do ip = 1, MAX_HASHCHARS {
+	    if (key[ip] == EOS)
+		break
+	    sum = sum + (sum + key[ip])
+	}
+
+	thread = mod (sum, ST_INDEXLEN(stp))
+	head = Memi[ST_INDEX(stp)+thread]
+
+	# If thread is not empty search down it for the named key and return
+	# the symbol pointer if found.  Note that the value of the E_NEXTHASH
+	# pointer is given as an integer offset to facilitate reallocation
+	# upon overflow.
+
+	if (head != NULL) {
+	    first_char = key[1]
+	    sbuf = ST_SBUFP(stp)
+	    stab = ST_STABP(stp)
+
+	    for (el=stab+head;  el > stab;  el=stab+E_NEXTHASH(el)) {
+		cp = sbuf + E_KEY(el)
+		if (Memc[cp] != first_char)
+		    next
+
+		# Compare target key to symbol key.
+		do ip = 1, MAX_SZKEY {
+		    if (key[ip] != Memc[cp])
+			break
+		    if (key[ip] == EOS)
+			return (E_USERFIELDS(el))	# found key
+		    cp = cp + 1
+		}
+	    }
+	}
+
+	return (NULL)
+end
diff --git a/sys/symtab/stfindall.x b/sys/symtab/stfindall.x
new file mode 100644
index 00000000..d0477c5a
--- /dev/null
+++ b/sys/symtab/stfindall.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STFINDALL -- Search the symbol table for the named key and return an array
+# of symstruct pointers to all symbols with the given key.  The array is
+# ordered with the most recently entered symbols at the beginning.  The number
+# of symbols found is returned as the function value.
+
+int procedure stfindall (stp, key, symbols, max_symbols)
+
+pointer	stp			# symbol table descriptor
+char	key[ARB]		# symbol name
+pointer	symbols[max_symbols]	# pointers to the symstructs
+int	max_symbols
+
+long	sum
+char	first_char
+int	head, ip, nsym, thread
+pointer	el, cp, stab, sbuf
+
+begin
+	# When a symbol is entered in the table a flag is set in the ST_ASCII
+	# array to flag that the symbol table contains at least one key
+	# beginning with that character.  If the flag is not set we can thus
+	# determine very quickly that the symbol is not present.  This is
+	# important for applications such as mapping identifiers for macro
+	# expansion, where most macros have upper case keys but most program
+	# identifiers have lower case keys.  (Subtle note: since the first
+	# element of ST_ASCII is for ascii value 0=EOS, the following also
+	# serves to detect null keys).
+
+	if (ST_ASCII(stp,key[1]) == 0)
+	    return (NULL)
+
+	# Hash the key onto a thread in the index.
+	sum = 0
+	do ip = 1, MAX_HASHCHARS {
+	    if (key[ip] == EOS)
+		break
+	    sum = sum + (sum + key[ip])
+	}
+
+	thread = mod (sum, ST_INDEXLEN(stp))
+	head = Memi[ST_INDEX(stp)+thread]
+
+	# If thread is not empty search down it for the named key and return
+	# pointers to all occurrences of the symbol.
+
+	nsym = 0
+
+	if (head != NULL && max_symbols > 0) {
+	    first_char = key[1]
+	    sbuf = ST_SBUFP(stp)
+	    stab = ST_STABP(stp)
+
+	    for (el=stab+head;  el > stab;  el=stab+E_NEXTHASH(el)) {
+		cp = sbuf + E_KEY(el)
+		if (Memc[cp] != first_char)
+		    next
+
+		# If the first character of the key matches compare the full
+		# string and output a symstruct pointer if we have a match.
+
+		do ip = 1, MAX_SZKEY {
+		    if (key[ip] != Memc[cp])
+			break
+		    if (key[ip] == EOS) {
+			nsym = nsym + 1
+			symbols[nsym] = E_USERFIELDS(el)
+			if (nsym >= max_symbols)
+			    return (max_symbols)
+			break
+		    }
+		    cp = cp + 1
+		}
+	    }
+	}
+
+	return (nsym)
+end
diff --git a/sys/symtab/stfree.x b/sys/symtab/stfree.x
new file mode 100644
index 00000000..1a960fe5
--- /dev/null
+++ b/sys/symtab/stfree.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STFREE -- Free storage back to the last marker.  No storage is actually
+# returned to the system, rather the storage is made available for reuse
+# by SYMTAB (the stacks are pruned).
+
+procedure stfree (stp, marker)
+
+pointer	stp			# symtab descriptor
+int	marker			# magic marker
+
+int	el
+pointer	index, stab, ep, mp
+
+begin
+	index = ST_INDEX(stp)
+	stab  = ST_STABP(stp)
+	mp    = stab + marker
+	ep    = NULL
+
+	# Ignore requests with out of range markers.
+	if (marker <= 0 || marker >= ST_STABOP(stp))
+	    return
+
+	# Descend the global (time ordered) list, unlinking each symbol until
+	# the marker position is reached.
+
+	for (el = ST_LASTSYMBOL(stp);  el > marker;  el = E_NEXTGLOB(ep)) {
+	    ep = stab + el
+	    Memi[index+E_THREAD(ep)] = E_NEXTHASH(ep)
+	}
+
+	# Reset the stack pointers and set the head of the global list to
+	# point to the symbol immediately preceding the marker.
+
+	ST_NSYMBOLS(stp) = M_NSYMBOLS(mp)
+	ST_SBUFOP(stp)   = M_SBUFOP(mp)
+	ST_STABOP(stp)   = marker
+
+	if (ep != NULL)
+	    ST_LASTSYMBOL(stp) = E_NEXTGLOB(ep)
+end
diff --git a/sys/symtab/sthash.x b/sys/symtab/sthash.x
new file mode 100644
index 00000000..c9cd00b9
--- /dev/null
+++ b/sys/symtab/sthash.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	MAX_HASHCHARS	18
+
+# STHASH -- Compute the hash index of a key, i.e., the index of a thread in
+# the symbol table index.  Multiple keys may hash to the same thread.  The
+# ideal hash function will uniformly map keys into index space, both when the
+# keys are selected randomly and when the keys form patterns, e.g., when keys
+# share a common prefix.  The SYMTAB package uses a simple hash function which
+# is computed inline.  The STHASH function is NOT used at present, but is
+# included in the library anyway for use in other packages and because this
+# is a slightly better (more uniform) hashing function than the simple inline
+# version used in SYMTAB.
+
+int procedure sthash (key, modulus)
+
+char	key[ARB]		# character string serving as a key
+int	modulus			# number of possible output values
+
+int	i
+long	sum
+int	primes[MAX_HASHCHARS]
+data	(primes(i),i=1,9)	/101,103,107,109,113,127,131,137,139/
+data	(primes(i),i=10,18)	/149,151,157,163,167,173,179,181,191/
+
+begin
+	sum = 0
+
+	# Hash up to len(primes)=18 characters from the key.
+	do i = 1, MAX_HASHCHARS {
+	    if (key[i] == EOS)
+		break
+	    sum = sum + (key[i] * primes[i])
+	}
+
+	return (mod (sum, modulus) + 1)
+end
diff --git a/sys/symtab/sthead.x b/sys/symtab/sthead.x
new file mode 100644
index 00000000..f341c934
--- /dev/null
+++ b/sys/symtab/sthead.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STHEAD -- Return a symstruct pointer to the last symbol entered into the
+# table.  The NULL pointer is returned when the symbol table is empty.
+
+pointer procedure sthead (stp)
+
+pointer	stp			# symtab descriptor
+
+begin
+	if (ST_LASTSYMBOL(stp) == NULL)
+	    return (NULL)
+	else
+	    return (E_USERFIELDS (ST_STABP(stp) + ST_LASTSYMBOL(stp)))
+end
diff --git a/sys/symtab/stinfo.x b/sys/symtab/stinfo.x
new file mode 100644
index 00000000..cbc2f441
--- /dev/null
+++ b/sys/symtab/stinfo.x
@@ -0,0 +1,142 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STINFO -- Print interesting information on the inner workings and contents
+# of the symbol table.
+
+procedure stinfo (stp, fd, verbose)
+
+pointer	stp			# symtab descriptor
+int	fd			# output file
+int	verbose			# if YES, trace each thread
+
+pointer	index, stab, sbuf, ep
+int	keylen, min_keylen, max_keylen, nsymbols, el, i, head
+int	nthreads, max_threadlen, nonnull_threads, nsym
+real	sum, mean_hash_index, avg_keylen, avg_threadlen
+int	strlen()
+
+begin
+	index = ST_INDEX(stp)
+	stab  = ST_STABP(stp)
+	sbuf  = ST_SBUFP(stp)
+
+	# Print the symbol table name.
+	ep = sbuf + ST_NAME(stp)
+	call fprintf (fd, "name: %s\n")
+	    if (Memc[ep] == EOS)
+		call pargstr ("(none given)")
+	    else
+		call pargstr (Memc[ep])
+
+	# Print information on memory usage.
+	call fprintf (fd,
+	    "index=(%x,%d), stab=(%x,%d,%d%%), sbuf=(%x,%d,%d%%)\n")
+	    call pargi (index)
+	    call pargi (ST_INDEXLEN(stp))
+	    call pargi (stab)
+	    call pargi (ST_STABLEN(stp))
+	    call pargr (ST_STABOP(stp) * 100.0 / ST_STABLEN(stp))
+	    call pargi (sbuf)
+	    call pargi (ST_SBUFLEN(stp))
+	    call pargr (ST_SBUFOP(stp) * 100.0 / ST_SBUFLEN(stp))
+
+	call fprintf (fd,
+	    "sbuf reallocated %d times, stab reallocated %d times\n")
+	    call pargi (ST_SBUFNGROW(stp))
+	    call pargi (ST_STABNGROW(stp))
+
+	# Scan the symbols and compute the min, max, and mean key lengths.
+	# Count the number of symbols.
+
+	min_keylen = MAX_SZKEY
+	max_keylen = 0
+	avg_keylen = 0
+	nsymbols   = 0
+	sum	   = 0
+
+	for (el = ST_LASTSYMBOL(stp);  el != NULL;  el = E_NEXTGLOB(ep)) {
+	    nsymbols = nsymbols + 1
+	    ep = stab + el
+
+	    keylen = strlen (Memc[sbuf+E_KEY(ep)])
+	    min_keylen = min (min_keylen, keylen)
+	    max_keylen = max (max_keylen, keylen)
+	    sum = sum + keylen
+	}
+
+	if (nsymbols > 0)
+	    avg_keylen = sum / nsymbols
+	else
+	    min_keylen = 0
+
+	call fprintf (fd,
+	    "nsymbols=%d, minkeylen=%d, maxkeylen=%d, avgkeylen=%.1f\n")
+	    call pargi (nsymbols)
+	    call pargi (min_keylen)
+	    call pargi (max_keylen)
+	    call pargr (avg_keylen)
+
+	# Scan the index and compute the number of nonnull threads, the
+	# mean and max thread lengths, and the mean hash index, which should
+	# be near the center of the index.
+
+	nthreads = ST_INDEXLEN(stp)
+	mean_hash_index = 0
+	nonnull_threads = 0
+	max_threadlen = 0
+	avg_threadlen = 0
+	sum = 0
+
+	if (verbose == YES)
+	    call fprintf (fd, "----------- threads ----------\n")
+
+	do i = 1, nthreads {
+	    if (verbose == YES) {
+		call fprintf (fd, "[%4d] ")
+		    call pargi (i)
+	    }
+
+	    head = Memi[index+i-1]
+	    if (head != NULL) {
+		nonnull_threads = nonnull_threads + 1
+
+		# Count the number of symbols on the thread.
+		nsym = 0
+		for (el=head;  el != NULL;  el=E_NEXTHASH(ep)) {
+		    nsym = nsym + 1
+		    ep = stab + el
+
+		    if (verbose == YES) {
+			call fprintf (fd, "%s ")
+			    call pargstr (Memc[sbuf+E_KEY(ep)])
+		    }
+		}
+
+
+		max_threadlen = max (max_threadlen, nsym)
+		sum = sum + (nsym * i)
+	    }
+
+	    if (verbose == YES)
+		call fprintf (fd, "\n")
+	}
+
+	if (nonnull_threads > 0) {
+	    avg_threadlen = real(nsymbols) / nonnull_threads
+	    mean_hash_index = sum / nsymbols
+	}
+
+	if (verbose == YES)
+	    call fprintf (fd, "---------------------\n")
+
+	call fprintf (fd,
+	    "nthreads=%d, maxlen=%d, avglen=%.1f, meanindex=%.1f\n")
+	    call pargi (nonnull_threads)
+	    call pargi (max_threadlen)
+	    call pargr (avg_threadlen)
+	    call pargr (mean_hash_index)
+	
+	call flush (fd)
+end
diff --git a/sys/symtab/stmark.x b/sys/symtab/stmark.x
new file mode 100644
index 00000000..1caeecb0
--- /dev/null
+++ b/sys/symtab/stmark.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STMARK -- Mark the top of the STAB and SBUF stacks so that storage may
+# later be returned with STFREE.  Since two integers of storage are required
+# for the mark, the extra information is saved at the current position in STAB.
+# The location of this entry in STAB marks the position to which STAB is later
+# to be restored.
+
+procedure stmark (stp, marker)
+
+pointer	stp			# symtab descriptor
+int	marker			# magic marker
+
+pointer	mp
+int	stalloc()
+
+begin
+	marker = stalloc (stp, LEN_MARKER)
+	mp = ST_STABP(stp) + marker
+
+	M_SBUFOP(mp)	= ST_SBUFOP(stp)
+	M_NSYMBOLS(mp)	= ST_NSYMBOLS(stp)
+end
diff --git a/sys/symtab/stname.x b/sys/symtab/stname.x
new file mode 100644
index 00000000..9e10617e
--- /dev/null
+++ b/sys/symtab/stname.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STNAME -- Return a char pointer to the key string (symbol name) of a symbol
+# table entry, given a pointer to the symbol structure.
+
+pointer procedure stname (stp, sym)
+
+pointer	stp			# symtab descriptor
+pointer	sym			# pointer to 'current' symstruct
+
+begin
+	return (ST_SBUFP(stp) + E_KEY(E_BASE(sym)))
+end
diff --git a/sys/symtab/stnext.x b/sys/symtab/stnext.x
new file mode 100644
index 00000000..2304f00c
--- /dev/null
+++ b/sys/symtab/stnext.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STNEXT -- Return a symstruct pointer to the next most recently entered
+# symbol in the table, given a pointer to some symbol.  Use to walk down
+# the global symbol table list in the reverse of the order in which symbols
+# were entered.
+
+pointer procedure stnext (stp, sym)
+
+pointer	stp			# symtab descriptor
+pointer	sym			# pointer to 'current' symstruct
+int	el
+
+begin
+	if (sym == NULL)
+	    return (NULL)
+	else {
+	    el = E_NEXTGLOB (E_BASE(sym))
+	    if (el == NULL)
+		return (NULL)
+	    else
+		return (E_USERFIELDS (ST_STABP(stp) + el))
+	}
+end
diff --git a/sys/symtab/stnsym.x b/sys/symtab/stnsym.x
new file mode 100644
index 00000000..f3d0f8e1
--- /dev/null
+++ b/sys/symtab/stnsym.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STNSYMBOLS -- Return the number of symbols in the symbol table or in a
+# marked segment, i.e., the number of symbols added to the table since the
+# mark was made.
+
+int procedure stnsymbols (stp, marker)
+
+pointer	stp			# symbol table pointer
+int	marker			# stmark marker or 0 for entire table
+
+pointer	mp
+
+begin
+	if (marker <= 0)
+	    return (ST_NSYMBOLS(stp))
+	else {
+	    mp = ST_STABP(stp) + marker
+	    return (ST_NSYMBOLS(stp) - M_NSYMBOLS(mp))
+	}
+end
diff --git a/sys/symtab/stopen.x b/sys/symtab/stopen.x
new file mode 100644
index 00000000..ede4f727
--- /dev/null
+++ b/sys/symtab/stopen.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STOPEN -- Create and initialize a new symbol table.  The size of the table
+# and the size of the hash index are user defined.  Any number of symbol
+# tables may be open simultaneously.  LEN_SYMBTAB is the initial length of
+# the symbol table in struct units.  LEN_INDEX is the number of hash threads;
+# a good choice for this value is twice the expected number of symbols in the
+# table, but good performance can be expected even if the number of symbols
+# is several times the size of the index.  The index consumes SZ_INT chars per
+# index element.
+
+pointer	procedure stopen (name, len_index, len_stab, sz_sbuf)
+
+char	name[ARB]		# symbol table name (optional)
+int	len_index		# number of hash threads in index
+int	len_stab		# initial length of STAB
+int	sz_sbuf			# initial size of string buffer
+
+pointer	stp
+int	stpstr()
+
+begin
+	# Allocate symtab descriptor.
+	call calloc (stp, LEN_SYMTAB, TY_STRUCT)
+	ST_MAGIC(stp) = MAGIC
+
+	# Allocate index.
+	call calloc (ST_INDEX(stp), len_index, TY_INT)
+	ST_INDEXLEN(stp) = len_index
+
+	# Allocate string buffer.  The first char of storage, at offset 0,
+	# is set to EOS so that offset 0 may be used to reference the null
+	# string.
+
+	call malloc (ST_SBUFP(stp), sz_sbuf, TY_CHAR)
+	ST_SBUFINC(stp) = max (1, nint (sz_sbuf * INC_START))
+	ST_SBUFLEN(stp) = sz_sbuf
+	ST_SBUFOP(stp)  = 1
+	ST_SBUFNGROW(stp) = 0
+	Memc[ST_SBUFP(stp)] = EOS
+
+	# Allocate symbol table.  The initial STABOP (offset into STAB) is set
+	# to 1 rather than 0 since 0 as an STAB offset is used to mark the end
+	# of a list.
+
+	call malloc (ST_STABP(stp), len_stab, TY_STRUCT)
+	ST_STABINC(stp) = max (1, nint (len_stab * INC_START))
+	ST_STABLEN(stp) = len_stab
+	ST_STABOP(stp)  = 1
+	ST_STABNGROW(stp) = 0
+
+	# Save the symbol table name in the string buffer.  This name is
+	# for documentation purposes only (it is printed by STINFO).
+
+	ST_NAME(stp) = stpstr (stp, name, 0)
+
+	return (stp)
+end
diff --git a/sys/symtab/stpstr.x b/sys/symtab/stpstr.x
new file mode 100644
index 00000000..2de04a60
--- /dev/null
+++ b/sys/symtab/stpstr.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STPSTR -- Append a string to the string buffer.  The offset of the string
+# in the string buffer is returned as the function value.  More storage is
+# allocated if we run out of room in the buffer.  The number of chars of
+# storage allocated (excluding space for the EOS) is strlen(str) or MINCHARS,
+# whichever is larger.  To allocate but not initialize space STR may be passed
+# as the null string.  To allocate precisely the amount of space required to
+# store a string constant MINCHARS should be set to zero.
+
+int procedure stpstr (stp, str, minchars)
+
+pointer	stp			# symtab descriptor
+char	str[ARB]		# string to be moved into storage
+int	minchars		# minimum number of chars to reserve
+
+int	offset, buflen, blklen
+int	strlen()
+errchk	realloc
+
+begin
+	offset = ST_SBUFOP(stp)
+	buflen = ST_SBUFLEN(stp)
+	blklen = max (strlen(str), minchars) + 1
+
+	if (offset + blklen > buflen) {
+	    # Overflow has occurred.  Allocate a larger buffer; if overflow
+	    # continues to occur the increments grow successively larger to
+	    # minimize reallocation.
+
+	    buflen = buflen + max (blklen, ST_SBUFINC(stp))
+	    ST_SBUFINC(stp) = min (MAX_INCREMENT, ST_SBUFINC(stp) * INC_GROW)
+	    ST_SBUFLEN(stp) = buflen
+	    ST_SBUFNGROW(stp) = ST_SBUFNGROW(stp) + 1
+
+	    call realloc (ST_SBUFP(stp), buflen, TY_CHAR)
+	}
+
+	ST_SBUFOP(stp) = ST_SBUFOP(stp) + blklen
+	call strcpy (str, Memc[ST_SBUFP(stp)+offset], blklen)
+
+	return (offset)
+end
diff --git a/sys/symtab/strefsbuf.x b/sys/symtab/strefsbuf.x
new file mode 100644
index 00000000..d0be6437
--- /dev/null
+++ b/sys/symtab/strefsbuf.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STREFSBUF -- Convert an offset into SBUF into a pointer to char.
+
+pointer procedure strefsbuf (stp, offset)
+
+pointer	stp			# symtab descriptor
+int	offset			# offset into SBUF
+
+begin
+	return (ST_SBUFP(stp) + offset)
+end
diff --git a/sys/symtab/strefstab.x b/sys/symtab/strefstab.x
new file mode 100644
index 00000000..c55473af
--- /dev/null
+++ b/sys/symtab/strefstab.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STREFSTAB -- Convert an offset into STAB into a pointer to int.
+
+pointer procedure strefstab (stp, offset)
+
+pointer	stp			# symtab descriptor
+int	offset			# offset into STAB
+
+begin
+	return (ST_STABP(stp) + offset)
+end
diff --git a/sys/symtab/strestore.x b/sys/symtab/strestore.x
new file mode 100644
index 00000000..b3989d2b
--- /dev/null
+++ b/sys/symtab/strestore.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STRESTORE -- Restore to memory a symbol table previously saved in a file
+# with STSAVE.  The file must be positioned to the correct offset before
+# we are called.  STRESTORE is called in place of STOPEN and returns a
+# symtab descriptor pointer as the function value.  The symbol table is
+# restored to exactly the state it was in when STSAVE was called.  Note
+# that since SYMTAB symbol tables use only relative offsets internally,
+# the data structures may be relocated anywhere in memory when they are
+# read back from the file.  The symbol table is stored externally in a
+# machine independent binary file.
+
+pointer procedure strestore (fd)
+
+int	fd			# file from which symbol table is to be read
+
+int	nelem
+pointer	stp, stab, sbuf, index
+int	miireadc(), miireadi()
+errchk	miireadc, miireadi
+define	readerr_ 91
+
+begin
+	index = NULL
+	stab  = NULL
+	sbuf  = NULL
+
+	# Read symbol table descriptor.
+	call malloc (stp, LEN_SYMTAB, TY_STRUCT)
+	if (miireadi (fd, Memi[stp], LEN_SYMTAB) < LEN_SYMTAB)
+	    goto readerr_
+
+	if (ST_MAGIC(stp) != MAGIC)
+	    call error (1, "strestore: bad magic in save file")
+
+	# Read the hash table index.
+	nelem = ST_INDEXLEN(stp)
+	call malloc (index, nelem, TY_INT)
+	if (miireadi (fd, Memi[index], nelem) < nelem)
+	    goto readerr_
+
+	# Read the symbol table data.
+	nelem = ST_STABLEN(stp)
+	call malloc (stab, nelem, TY_STRUCT)
+	if (miireadi (fd, Memi[stab], nelem) < nelem)
+	    goto readerr_
+
+	# Read the string buffer.
+	nelem = ST_SBUFLEN(stp)
+	call malloc (sbuf, nelem, TY_CHAR)
+	if (miireadc (fd, Memc[sbuf], nelem) < nelem)
+	    goto readerr_
+
+	ST_INDEX(stp) = index
+	ST_SBUFP(stp) = sbuf
+	ST_STABP(stp) = stab
+
+	return (stp)
+
+readerr_
+	call mfree (sbuf,  TY_CHAR)
+	call mfree (stab,  TY_STRUCT)
+	call mfree (index, TY_INT)
+	call mfree (stp,   TY_STRUCT)
+
+	call error (2, "strestore: unexpected EOF")
+end
diff --git a/sys/symtab/stsave.x b/sys/symtab/stsave.x
new file mode 100644
index 00000000..a77d710f
--- /dev/null
+++ b/sys/symtab/stsave.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+define	SZ_BLOCK	2048
+
+
+# STSAVE -- Save the symbol table in an external binary file in a machine
+# independent format.  This works provided only integer and character data
+# is stored in the symbol table.
+
+procedure stsave (stp, fd)
+
+pointer	stp			# symtab descriptor
+int	fd			# output file
+
+int	nelem
+int	ip, itop
+errchk	miiwritei, miiwritec
+
+begin
+	call miiwritei (fd, Memi[stp], LEN_SYMTAB)
+	call miiwritei (fd, Memi[ST_INDEX(stp)], ST_INDEXLEN(stp))
+
+	# Since the symbol table can be very large, write it out in chunks
+	# of a reasonable size to avoid allocating large buffers.
+
+	itop = ST_STABP(stp) + ST_STABLEN(stp)
+	for (ip=ST_STABP(stp);  ip < itop;  ip=ip+nelem) {
+	    nelem = min (SZ_BLOCK, itop - ip)
+	    call miiwritei (fd, Memi[ip], nelem)
+	}
+
+	# Ditto for the string buffer.
+
+	itop = ST_SBUFP(stp) + ST_SBUFLEN(stp)
+	for (ip=ST_SBUFP(stp);  ip < itop;  ip=ip+nelem) {
+	    nelem = min (SZ_BLOCK, itop - ip)
+	    call miiwritec (fd, Memc[ip], nelem)
+	}
+end
diff --git a/sys/symtab/stsize.x b/sys/symtab/stsize.x
new file mode 100644
index 00000000..3ccc6d0d
--- /dev/null
+++ b/sys/symtab/stsize.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mii.h>
+include	"symtab.h"
+
+# STSIZE -- Compute the file storage space in chars required to store the
+# symbol table, e.g., in a subsequent call to STSAVE.
+
+int procedure stsize (stp)
+
+pointer	stp			# symbol table descriptor
+
+int	size
+int	miipksize()
+
+begin
+	size = miipksize (LEN_SYMTAB + ST_INDEXLEN(stp) + ST_STABLEN(stp),
+	    MII_LONG) + miipksize (ST_SBUFLEN(stp), MII_BYTE)
+
+	return (size)
+end
diff --git a/sys/symtab/stsqueeze.x b/sys/symtab/stsqueeze.x
new file mode 100644
index 00000000..47f7b227
--- /dev/null
+++ b/sys/symtab/stsqueeze.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"symtab.h"
+
+# STSQUEEZE -- Return any unused storage in a symbol table.  This is useful
+# when it is known that no more symbols will be entered in a table, or before
+# saving a symbol table in a save file.
+
+procedure stsqueeze (stp)
+
+pointer	stp			# symtab descriptor
+
+begin
+	if (ST_STABLEN(stp) > ST_STABOP(stp)) {
+	    ST_STABLEN(stp) = ST_STABOP(stp)
+	    ST_STABINC(stp) = min (MAX_INCREMENT, ST_STABLEN(stp))
+	    call realloc (ST_STABP(stp), ST_STABLEN(stp), TY_STRUCT)
+	}
+
+	if (ST_SBUFLEN(stp) > ST_SBUFOP(stp)) {
+	    ST_SBUFLEN(stp) = ST_SBUFOP(stp)
+	    ST_SBUFINC(stp) = min (MAX_INCREMENT, ST_SBUFLEN(stp))
+	    call realloc (ST_SBUFP(stp), ST_SBUFLEN(stp), TY_CHAR)
+	}
+end
diff --git a/sys/symtab/symtab.h b/sys/symtab/symtab.h
new file mode 100644
index 00000000..25f30ace
--- /dev/null
+++ b/sys/symtab/symtab.h
@@ -0,0 +1,54 @@
+# SYMTAB definitions.
+
+define	MAX_HASHCHARS	18		# max characters used in hash function
+define	SZ_ASCII	128		# max possible character values
+define	INC_START	0.50		# used in overflow algorithm
+define	INC_GROW	2		# growing factor for increment
+define	MAX_INCREMENT	32768		# max sbuf or stab increment
+define	MAX_SZKEY	256		# arbitrarily large number
+
+# Symbol table descriptor.
+
+define	LEN_SYMTAB	256
+define	MAGIC		0123124B
+
+define	ST_MAGIC	Memi[$1]	# for error checking
+define	ST_NAME		Memi[$1+1]	# optional name for symbol table
+define	ST_LASTSYMBOL	Memi[$1+2]	# last element entered
+define	ST_NSYMBOLS	Memi[$1+3]	# number of symbols in table
+			# (extra space)
+define	ST_INDEX	Memi[$1+5]	# pointer to buffer of thread indices
+define	ST_INDEXLEN	Memi[$1+6]	# length of index
+			# (extra space)
+define	ST_SBUFP	Memi[$1+10]	# string buffer
+define	ST_SBUFLEN	Memi[$1+11]	# current size of string buffer
+define	ST_SBUFOP	Memi[$1+12]	# next location in string buffer
+define	ST_SBUFINC	Memi[$1+13]	# increment if overflow occurs
+define	ST_SBUFNGROW	Memi[$1+14]	# number of reallocs of sbuf
+			# (extra space)
+define	ST_STABP	Memi[$1+20]	# symbol table
+define	ST_STABLEN	Memi[$1+21]	# symbol table length
+define	ST_STABOP	Memi[$1+22]	# next location in symbol table
+define	ST_STABINC	Memi[$1+23]	# increment if overflow occurs
+define	ST_STABNGROW	Memi[$1+24]	# number of reallocs of stab
+			# (extra space)
+define	ST_ASCII	Memi[($1+30)+$2]
+
+# Symstruct.  STAB contains an array of these, each of which is linked both
+# on a thread and on the global lifo list.
+
+define	LEN_SYMSTRUCT	4
+
+define	E_NEXTHASH	Memi[$1]	# next element on thread
+define	E_NEXTGLOB	Memi[$1+1]	# next element on global list
+define	E_THREAD	Memi[$1+2]	# index of thread in INDEX array
+define	E_KEY		Memi[$1+3]	# index of key name
+
+define	E_USERFIELDS	($1+LEN_SYMSTRUCT)
+define	E_BASE		($1-LEN_SYMSTRUCT)
+
+# Magic marker structure (for mark/free).
+
+define	LEN_MARKER	2
+define	M_SBUFOP	Memi[$1]	# saved string buffer offset
+define	M_NSYMBOLS	Memi[$1+1]	# nsymbols in table below marker
diff --git a/sys/symtab/zzdebug.x b/sys/symtab/zzdebug.x
new file mode 100644
index 00000000..a113a4e9
--- /dev/null
+++ b/sys/symtab/zzdebug.x
@@ -0,0 +1,283 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctotok.h>
+include	<error.h>
+include	<ctype.h>
+
+task	sym	= t_sym
+
+define	LOOKUP		1
+define	ENTER		2
+define	MARK		3
+define	FREE		4
+define	LISTALL		5
+define	SQUEEZE		6
+define	SAVE		7
+define	RESTORE		8
+define	INFO		9
+define	SCANFILE	10
+define	HELP		11
+
+
+# SYM -- Test symbol entry and retrieval using the SYMTAB package.
+
+procedure t_sym()
+
+bool	timeit
+pointer	stp, sym
+long	svtime[2]
+char	lbuf[SZ_LINE], key[SZ_FNAME]
+int	ip, lp, stmt, marker, fd, indexlen, stablen, sbuflen, junk
+
+bool	clgetb()
+int	ctowrd(), strlen(), getline(), strmatch()
+int	stpstr(), sthead(), stnext(), open(), clgeti()
+pointer	stopen(), stfind(), stenter(), strestore()
+
+begin
+	indexlen = clgeti ("indexlen")
+	stablen  = clgeti ("stablen")
+	sbuflen  = clgeti ("sbuflen")
+	timeit   = clgetb ("timeit")
+
+	stp = stopen ("symtab.zzdebug test symbol table",
+	    indexlen, stablen, sbuflen)
+
+	repeat {
+	    call printf ("* ")
+	    call flush (STDOUT)
+	    if (getline (STDIN, lbuf) == EOF) {
+		call printf ("\n")
+		break
+	    } else if (strmatch (lbuf, "^bye") > 0)
+		break
+
+	    for (ip=1;  IS_WHITE(lbuf[ip]);  ip=ip+1)
+		;
+
+	    # Determine type of statement.
+	    switch (lbuf[ip]) {
+	    case '\n':
+		next
+	    case '=':
+		ip = ip + 1
+		stmt = LOOKUP
+	    default:
+		if (strmatch (lbuf[ip], "^.mark") > 0) {
+		    stmt = MARK
+		} else if (strmatch (lbuf[ip], "^.free") > 0) {
+		    stmt = FREE
+		} else if (strmatch (lbuf[ip], "^.list") > 0) {
+		    stmt = LISTALL
+		} else if (strmatch (lbuf[ip], "^.squeeze") > 0) {
+		    stmt = SQUEEZE
+		} else if (strmatch (lbuf[ip], "^.save") > 0) {
+		    stmt = SAVE
+		    ip = ip + 5
+		} else if (strmatch (lbuf[ip], "^.restore") > 0) {
+		    stmt = RESTORE
+		    ip = ip + 8
+		} else if (strmatch (lbuf[ip], "^.info") > 0) {
+		    stmt = INFO
+		    ip = ip + 5
+		} else if (strmatch (lbuf[ip], "^.scanfile") > 0) {
+		    stmt = SCANFILE
+		    ip = ip + 9
+		} else if (strmatch (lbuf[ip], "^.help") > 0) {
+		    stmt = HELP
+		    ip = ip + 5
+		} else
+		    stmt = ENTER
+	    }
+
+	    # Extract key name (or filename).
+	    junk = ctowrd (lbuf, ip, key, SZ_FNAME)
+
+	    if (timeit)
+		call sys_mtime (svtime)
+
+	    switch (stmt) {
+	    case LOOKUP:
+		# Lookup symbol in table.
+		sym = stfind (stp, key)
+
+		if (sym == NULL) {
+		    call eprintf ("`%s' not found\n")
+			call pargstr (key)
+		    next
+		}
+
+		# Print keyword = value.
+		call psym (stp, sym)
+
+	    case ENTER:
+		# Enter symbol in table.
+		sym = stenter (stp, key, 1)
+
+		# Get offset of value string.
+		ip = strmatch (lbuf, "=")
+		if (ip == 0)
+		    ip = strlen(lbuf) + 1
+		else {
+		    while (IS_WHITE (lbuf[ip]))
+			ip = ip + 1
+		}
+
+		# Step on the newline.
+		for (lp=ip;  lbuf[lp] != EOS;  lp=lp+1)
+		    if (lbuf[lp] == '\n') {
+			lbuf[lp] = EOS
+			break
+		    }
+
+		# Deposit value string in symbol table string buffer and save
+		# offset in symstruct.
+
+		Memi[sym] = -stpstr (stp, lbuf[ip], 0)
+
+	    case MARK:
+		call stmark (stp, marker)
+
+	    case FREE:
+		call stfree (stp, marker)
+
+	    case LISTALL:
+		for (sym=sthead(stp);  sym != NULL;  sym=stnext(stp,sym))
+		    call psym (stp, sym)
+
+	    case SQUEEZE:
+		call stsqueeze (stp)
+
+	    case SAVE:
+		# In this case 'key' contains the savefile filename.
+		iferr (call delete (key))
+		    ;
+		iferr (fd = open (key, NEW_FILE, BINARY_FILE)) {
+		    call erract (EA_WARN)
+		    next
+		}
+
+		call stsave (stp, fd)
+		call close (fd)
+		
+	    case RESTORE:
+		# In this case 'key' contains the savefile filename.
+
+		iferr (fd = open (key, READ_ONLY, BINARY_FILE)) {
+		    call erract (EA_WARN)
+		    next
+		}
+
+		call stclose (stp)
+		stp = strestore (fd)
+		call close (fd)
+
+	    case INFO:
+		if (key[1] == 'v')
+		    call stinfo (stp, STDOUT, YES)
+		else
+		    call stinfo (stp, STDOUT, NO)
+
+	    case SCANFILE:
+		call scanfile (key, stp)
+
+	    case HELP:
+		call zz_help (STDOUT)
+	    default:
+		call eprintf ("syntax error\n")
+	    }
+
+	    if (timeit)
+		call sys_ptime (STDOUT, key, svtime)
+	}
+
+	call stclose (stp)
+end
+
+
+# SCANFILE -- Scan a text file, breaking the input up into a series of tokens.
+# Place each new integer token in the symbol table.  If the token is already
+# present in the table, increment its count field.
+
+procedure scanfile (fname, stp)
+
+char	fname[ARB]		# file to be scanned
+pointer	stp			# symtab descriptor
+
+char	lbuf[SZ_LINE], tokbuf[SZ_FNAME]
+int	fd, ip, token
+pointer	sym
+int	open(), getline(), ctotok()
+pointer	stenter(), stfind()
+errchk	open, stenter
+
+begin
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	while (getline (fd, lbuf) != EOF) {
+	    ip = 1
+	    repeat {
+		token = ctotok (lbuf, ip, tokbuf, SZ_FNAME)
+		if (token == TOK_IDENTIFIER) {
+		    sym = stfind (stp, tokbuf)
+		    if (sym == NULL) {
+			sym = stenter (stp, tokbuf, 1)
+			Memi[sym] = 1
+		    } else
+			Memi[sym] = Memi[sym] + 1
+		}
+	    } until (token == TOK_NEWLINE || token == TOK_EOS)
+	}
+
+	call close (fd)
+end
+
+
+# PSYM -- Print the name and value of a symbol in the form "key = value".
+# There are two types of values, string and count.  A string operand is
+# flagged as negative.
+
+procedure psym (stp, sym)
+
+pointer	stp			# symtab descriptor
+pointer	sym			# pointer to symbol
+
+int	val
+pointer	vp
+pointer	strefsbuf(), stname()
+
+begin
+	val = Memi[sym]
+	if (val < 0) {
+	    vp = strefsbuf (stp, -val)
+	    call printf ("%s = %s\n")
+		call pargstr (Memc[stname(stp,sym)])
+		call pargstr (Memc[vp])
+	} else {
+	    call printf ("%s = %d\n")
+		call pargstr (Memc[stname(stp,sym)])
+		call pargi (val)
+	}
+end
+
+
+# ZZ_HELP -- Print command dictionary for interpreter.
+
+procedure zz_help (fd)
+
+int 	fd
+
+begin
+	call fprintf (fd, ".mark                mark top of symbol table\n")
+	call fprintf (fd, ".free                free back to last mark\n")
+	call fprintf (fd, ".list                list all symbols in table\n")
+	call fprintf (fd, ".squeeze             minimize storage\n")
+	call fprintf (fd, ".save <fname>        save table in a file\n")
+	call fprintf (fd, ".restore <fname>     restore table from a file\n")
+	call fprintf (fd, ".info                print info on table\n")
+	call fprintf (fd, ".scanfile <fname>    enter symbols from file\n")
+	call fprintf (fd, "keyword = value      enter a symbol in table\n")
+	call fprintf (fd, "= keyword            print value of named symbol\n")
+	call fprintf (fd, "bye                  exit\n")
+	call flush (fd)
+end
diff --git a/sys/sys.hd b/sys/sys.hd
new file mode 100644
index 00000000..26d6002c
--- /dev/null
+++ b/sys/sys.hd
@@ -0,0 +1,60 @@
+# Help directory for the IRAF system libraries.
+
+$clio		= "./clio/doc/"
+$dbio		= "./dbio/doc/"
+$debug		= "./debug/doc/"
+$fio		= "./fio/doc/"
+$fmtio		= "./fmtio/doc/"
+$gio		= "./gio/doc/"
+$imio		= "./imio/doc/"
+$imfort		= "./imfort/doc/"
+$memio		= "./memio/doc/"
+$mtio		= "./mtio/doc/"
+$os		= "host$os/doc/"
+$etc		= "./etc/doc/"
+$tty		= "./tty/doc/"
+$vops		= "./vops/doc/"
+
+Sysgen		hlp = Sysgen.hlp,		sys = ..
+
+clio		hlp = clio$clio.men,		sys = clio$clio.hlp,
+		pkg = clio$clio.hd
+
+dbio		hlp = dbio$dbio.men,		sys = dbio$dbio.hlp,
+		pkg = dbio$dbio.hd
+
+debug		hlp = debug$debug.men,		sys = debug$debug.hlp,
+		pkg = debug$debug.hd
+
+fio		hlp = fio$fio.men,		sys = fio$fio.hlp,
+		pkg = fio$fio.hd
+
+fmtio		hlp = fmtio$fmtio.men,		sys = fmtio$fmtio.hlp,
+		pkg = fmtio$fmtio.hd
+
+gio		hlp = gio$gio.men,		sys = gio$gio.hlp,
+		pkg = gio$gio.hd
+
+imio		hlp = imio$imio.men,		sys = imio$imio.hlp,
+		pkg = imio$imio.hd
+
+imfort		hlp = imfort$imfort.men,	sys = imfort$imfort.hlp,
+		pkg = imfort$imfort.hd
+
+memio		hlp = memio$memio.men,		sys = memio$memio.hlp,
+		pkg = memio$memio.hd
+
+mtio		hlp = mtio$mtio.men,		sys = mtio$mtio.hlp,
+		pkg = mtio$mtio.hd
+
+os		hlp = os$os.men,		sys = os$os.hlp,
+		pkg = os$os.hd
+
+etc		hlp = etc$etc.men,		sys = etc$etc.hlp,
+		pkg = etc$etc.hd
+
+tty		hlp = tty$tty.men,		sys = tty$tty.hlp,
+		pkg = tty$tty.hd
+
+vops		hlp = vops$vops.men,		sys = vops$vops.hlp,
+		pkg = vops$vops.hd
diff --git a/sys/sys.men b/sys/sys.men
new file mode 100644
index 00000000..a3585ba1
--- /dev/null
+++ b/sys/sys.men
@@ -0,0 +1,14 @@
+	  mkpkg - Rebuild the system libraries
+	   clio - Command Language i/o
+	   dbio - Database i/o
+	    etc - Miscellaneous system procedures
+	    fio - File i/o
+	  fmtio - Formatted i/o
+	    gio - Graphics i/o
+	   imio - Image i/o (bulk data arrays)
+	     ki - Kernel interface (networking)
+	  memio - Memory i/o (dynamic memory allocation)
+	   mtio - Magtape i/o
+	    osb - Bit and byte primitives
+	    tty - Device independent terminal control
+	   vops - Vector operators
diff --git a/sys/tty/README b/sys/tty/README
new file mode 100644
index 00000000..2ab27b7e
--- /dev/null
+++ b/sys/tty/README
@@ -0,0 +1,29 @@
+This directory contains the source for the TTY interface, a device independent
+interface used to control terminals.  We interface to the widely used
+TERMCAP terminal database, thereby gaining the data required to control many
+diverse terminals.  (Written Jan84 dct).
+
+Mar84	Added TTYGDES and the "graphcap" file, used to describe graphics
+	devices.
+
+Jly84	Added capability to compile selected termcap entries to speedup
+	TTYODES.  Added TTYCOMPILE, TTYLOAD, TTYOPEN, TTYCLOSE.  Modified
+	the existing routines TTYODES and TTYGDES.  The new open and close
+	routines are useful for any type of database maintained in termcap
+	format.
+
+Jly84	Entry point TTYCLINE changed to TTYCLEARLN to avoid name conflict
+	with TTYCLOSE.
+
+Jly84	Task MKTTYDATA is used to compile selected entries from TERMCAP
+	files.  The include files "cache_?.dat" are the output of this
+	program.  To tailor the cache of pre-compiled termcap device
+	entries for a site, compile MKTTYDATA and run it to generate
+	the files "cache_t.dat" for "dev$termcap" (default MKTTYDATA params)
+	and "cache_g.dat" for "dev$graphcap", then do a Sysgen to recompile
+	the libraries.  All programs which use the TTY interface, e.g.,
+	the SYSTEM package, must then be relinked to make use of the new
+	cache.
+
+Jun85	Changed filenames to make them more machine independent.
+	Installed MKTTYDATA as a task in the SOFTOOLS package.
diff --git a/sys/tty/doc/tty.hlp b/sys/tty/doc/tty.hlp
new file mode 100644
index 00000000..62924590
--- /dev/null
+++ b/sys/tty/doc/tty.hlp
@@ -0,0 +1,485 @@
+.help tty Dec83 "Terminal Control Interface"
+.nh
+Introduction
+
+    The TTY interface is a table driven, device independent interface for
+controlling terminal and printer devices.  Devices are described either by
+environment definitions, or by an entry in the TTY database file.  The TTY
+database file is the standard Berkeley UNIX termcap terminal capability
+database file (a text file), to which we have added entries for our printer
+devices.  Accessing the UNIX termcap file directly without modification
+is sometimes awkward, but the benefits of accessing a widely used, standard
+database more than compensate for any clumsiness.
+
+When the CL starts up, the following environment variables are defined to
+describe the default terminal and printer devices.  The user may subsequently
+change the values of these variables with the SET statement or with the STTY
+program.
+
+
+.ks
+.nf
+	printer		default printer (i.e., "versatec")
+	terminal	default terminal (i.e., "vt100", "tek4012")
+	termcap		terminal/printer database filename
+	ttybaud		baud rate, default 9600
+	ttyncols	number of characters per line
+	ttynlines	number of lines per screen
+.fi
+.ke
+
+
+The variables defining the names of the default terminal and printer
+devices will normally correspond to the names of device entries in the
+termcap file.  The name of a file containing a single termcap entry
+for the device may optionally be given; the file name must contain a
+VFN or OSFN directory prefix to be recognized as a filename.  The default
+termcap file is dev$termcap.  Terminal initialization files (used to
+set tabstops) are files of the form dev$tty.tbi, where "tty" is the last
+field of the UNIX pathname in the "if" termcap entry.  If the first
+character of the "if" filename string is not a /, an IRAF VFN should
+be given.
+
+The value strings for the environment variables TTYNCOLS and TTYNLINES,
+defining the screen dimensions, are extracted from the termcap file by the
+STTY program during startup.  The screen dimensions are defined in the
+environment for two reasons: (1) efficiency (the TTY package is not needed
+to learn the screen dimensions), and (2) if a window is used, the logical
+screen dimensions may be less than the physical screen dimensions.
+Most applications programs should therefore use ENVGETI rather than TTYGETI
+to get the screen dimensions.  TTYGETI returns the physical screen dimensions
+as given in the termcap file.
+
+.nh
+Library Procedures
+
+    Before any TTY control sequences can be output, the TTY device descriptor
+must be read from the termcap file into a buffer for efficient access.
+TYODES is used to "open" the TTY descriptor; TTYCDES should be called when
+done to close the descriptor, returning all buffer space used.  If "ttyname"
+is "terminal" or "printer", the descriptor for the default terminal or printer
+is accessed.
+
+
+.ks
+.nf
+Open/Close descriptor:
+
+	tty =	ttyodes (ttyname)		# pointer ttyodes()
+		ttycdes (tty)
+.fi
+.ke
+
+
+.ks
+.nf
+Low level database access, tty control:
+
+	  int = ttygeti (tty, cap)
+	 real = ttygetr (tty, cap)
+	 bool = ttygetb (tty, cap)
+       nchars = ttygets (tty, cap, outstr, maxch)
+		ttyputs (fd, tty, ctrlstr, afflncnt)
+		ttysubi (ctrlstr, outstr, maxch, arg1, arg2)
+.fi
+.ke
+
+
+.ks
+.nf
+High level control
+
+       OK|ERR = ttyctrl (fd, tty, cap, afflncnt)
+
+		  ttyso (fd, tty, YES|NO)	# turn standout mode on|off
+		ttygoto (fd, tty, col, line)	# move cursor absolute
+NI		ttyhorz (fd, tty, from, to)	# move cursor on line
+NI		ttyvert (fd, tty, from, to)	# move cursor on column
+		ttyinit (fd, tty)		# send :is & :if, if defined
+	       ttyclear (fd, tty)		# clear screen
+	     ttyclearln (fd, tty)		# clear the current line
+	     ttyputline (fd, tty, textline, map_cc)	# put text line
+.fi
+.ke
+
+
+The TTYGET procedures are used to get capabilities from the database entry.
+If the named capability is not found, TTYGETI returns zero, TTYGETB returns
+false, and TTYGETS returns the null string.  TTYSUBI performs argument
+substitution on a control sequence containing at most two integer arguments
+(such as a cursor motion control sequence), generating an output sequence
+suitable for input to TTYPUTS.  TTYPUTS puts the control sequence to the
+output file, padding as required given the number of affected lines.
+The baud rate and pad character, used to generate padding, are evaluated at
+TTYODES time and are conveyed to TTYPUTS in the tty descriptor.
+
+TTYSO turns standout mode on or off.
+TTYCNTRL calls TTYGETS and TTYPUTS to process and output a control sequence
+(slightly less efficiently than if the control string is buffered by
+the user code).  TTYGOTO moves the cursor to the
+desired column and line.  TTYHORZ and TTYVERT move the cursor on a line
+or column, using knowledge of the terminal's capabilities to generate the
+most efficient sequence.
+
+TTYPUTLINE is like the FIO PUTLINE, except that it processes any form feeds,
+standout mode directives, and other control characters (including tabs)
+embedded in the text.  Lines longer than TTYNCOLS are broken into several
+output lines.  TTYPUTLINE is used by the help, page, type, and lprint utilities 
+to map tabs and standout mode directives for a particular output device.
+Standout mode is mapped as reverse video on most VDT's, and as underscore
+on most printers and on overstrike terminals such as the tek4012.
+
+.nh
+Implementation Notes
+
+    Of the low level routines, only TTYODES and TTYSUBI are at all complex.
+The high level routines can be fairly complex due to the logic required to
+perform a function on devices which may vary greatly in capabilities.
+
+.nh 2
+Structure
+
+.ks
+.nf
+open descriptor:
+
+	ttyodes
+	    envget[si]
+	    calloc			[alloc tty descriptor]
+	    open,close,seek		[read termcap file]
+	    tty_fetch_entry		[fetch entry from file]
+		getline,getc
+		realloc
+	    realloc
+	    tty_index_caplist		[encode, sort caplist]
+	    ttygeti			[set padchar]
+.fi
+.ke
+
+
+.ks
+.nf
+close descriptor:
+
+	ttycdes
+	    ttyctrl			[sometimes needed]
+	    mfree			[free tty descriptor]
+.fi
+.ke
+
+
+.ks
+.nf
+get integer capability:
+
+	ttygeti
+	    tty_find_capability		[binary search of caplist]
+	    ctoi
+.fi
+.ke
+
+
+.ks
+.nf
+get string capability:
+
+	ttygets
+	    tty_find_capability		[binary search caplist]
+	    tty_map_escapes		[get control string]
+.fi
+.ke
+
+
+.ks
+.nf
+perform argument substitution on control string:
+
+	ttysubi
+	    gltoc
+.fi
+.ke
+
+
+.ks
+.nf
+output control string:
+	ttyputs
+	    putc
+.fi
+.ke
+
+.nh 2
+Data Structures
+
+    The tty descriptor contains several parameters describing the most basic
+features of the device, the raw termcap entry, an encoded index into the
+termcap entry used to speed up searches, and any status variables for the
+device.  Since a fixed length array is used to index capabilities, there is
+an upper limit on the number of capabilities, but there is no limit on the
+length of a termcap entry.
+
+
+.ks
+.nf
+	struct tty_descriptor {
+		int	t_len		# length of descriptor
+		int	t_op		# offset into caplist
+		int	t_padchar	# pad character
+		int	t_baud		# baud rate, bits/sec
+		int	t_nlines	# lines per screen
+		int	t_ncols		# chars per line
+		int	t_ncaps		# number of capabilities
+		int	t_capcode	# sorted, encoded caplist
+		int	t_capindex	# indices of cap strings
+		char	caplist[ARB]	# termcap entry
+	}
+.fi
+.ke
+
+
+TTYODES "opens" the tty descriptor, i.e., allocates a descriptor,
+scans the termcap file and reads the terminal entry into the descriptor,
+expanding any tc references, and then sets the baud and padchar fields.
+There is no limit on the size of a termcap entry, unlike the UNIX
+implementation which uses a fixed size, 1024 character caplist buffer.
+
+
+.tp 10
+.nf
+procedure ttyodes (ttyname)
+
+begin
+	# Get device name or file name.
+	if (ttyname equals "terminal")
+	    ttysource = fetch environment variable "terminal"
+	else if (ttyname equals "printer")
+	    ttysource = fetch environment variable "printer"
+	else
+	    ttysource = ttyname
+
+	# Get device name AND file name.
+	if (ttysource is a filename) {
+	    file = ttysource
+	    entry = "" (first entry)
+	} else {
+	    file = fetch termcap filename from environment
+	    entry = ttysource
+	}
+
+	allocate tty descriptor structure "tty"
+	tty.len = default length of descriptor
+	tty.op = pointer to first char of caplist string
+
+	# Fetch termcap entry into tty descriptor, expanding any "tc"
+	# references to other records by rescanning the file.
+
+	fd = open (termcap file)
+	repeat {
+	    tty_fetch_entry (fd, entry, tty)
+	    if (last field of entry is a "tc") {
+		entry = value of "tc" field
+		set tty.op to overwrite tc field
+		rewind (fd)
+	    } else
+		break
+	} 
+	close (fd)
+
+	# Get pad character and baud rate and store explicitly in the
+	# descriptor, since these values are used in every TTYPUTS call.
+
+	call realloc to return unused space in tty descriptor
+	call tty_index_caplist to index the caplist for efficient
+	    searches
+	tty.baud = fetch "baud" from environment
+	tty.padchar = ttygeti (tty, "pc")
+
+	return (tty)
+end
+.fi
+
+
+Scan the termcap file until the desired entry is found.  Copy the entry
+into the caplist field of the tty descriptor.  If the caplist buffer
+overflows, reallocate a larger buffer.
+
+.nf
+procedure tty_fetch_entry (fd, entry, tty)
+
+begin
+	# Locate entry.
+	repeat {
+	    advance to next record
+	    if (at eof)
+		error: termcap entry not found
+	} until (positioned to the entry we are looking for)
+
+	# Fetch entry.
+	while (getc (fd, ch) != EOF) {
+	    if (ch equals \ and next ch is newline) {
+		throw both out
+	    } else if (ch equals newline) {
+		deposit EOS
+		return
+	    } else
+		deposit ch
+
+	    bump output pointer
+	    if (buffer is full)
+		allocate more space
+	}
+
+	error: EOF encountered while reading termcap entry
+end
+.fi
+
+
+Prepare the caplist index.  Each two-character capability name maps into
+an unique integer code.  We prepare an list of capcodes and an associated
+list of indices into the caplist, then sort the capcode list.  At runtime
+we will perform a binary search of the capcode list to find the desired
+capcode.
+
+.nf
+procedure tty_index_caplist (caplist, capcode_list, capindex_list)
+
+begin
+	for (each entry in caplist) {
+	    compute capcode
+	    if (capcode is not already in capcode_list) {
+		bump list pointer
+		if (list overflows)
+		    error: too many capabilities in termcap entry
+
+		# Termcap flags capabilities that are not available 
+		# with the char '@'.
+		if (first char of entry is '@')
+		    index = 0
+		save capcode, index in lists
+	    }
+	}
+
+	if (two or more elements in list)
+	    sort list
+end
+.fi
+
+
+Process a capability string containing arguments.  Examples of such capability
+strings are cursor motion to [x,y], and set scrolling region to [l1,l2].
+Note that arguments in the termcap database are zero-indexed by default,
+while the TTYSUBI arguments are one-indexed.  The control string given as
+input has already been processed to reduce all escape sequences to single
+characters.
+
+.nf
+procedure ttysubi (ctrlstr, outstr, maxch, arg1, arg2)
+
+ctrlstr:	device control string
+outstr:		receives processed string
+arg1,arg2:	on input, the arguments to be expanded in the control
+		    string.  on output, the difference between the
+		    input arg values and the values actually used
+		    to produce outstr; these may differ if necessary
+		    to avoid special control chars in outstr.
+
+begin
+	# Make a local copy of the arguments to make reversal easy.  Also
+	# switch to zero-indexing internally, since the termcap entry is
+	# zero-indexed.
+
+	arg[1] = arg1 - 1
+	arg1 = 0
+	arg[2] = arg2 - 1
+	arg2 = 0
+	argnum = 1
+
+	op = 1
+	for (ip=1;  ctrlstr[ip] != EOS;  ip=ip+1) {
+	    ch = ctrlstr[ip]
+	    if (ch != '%') {
+		put char in outstr, bump op
+		next
+	    }
+
+	    switch (ch)
+	    case 'd', '2', '3', '+':
+		format coord and concat to outstr
+		increment argnum
+
+	    case '.':
+		# Binary output format.  Coordinate output in binary is a
+		# problem because the OS driver may see a tab, newline, or
+		# whatever and map it into something else.  If the value of
+		# arg[argnum] corresponds to a special control character,
+		# we increment it until we have an acceptable value, leaving
+		# it up to our caller to do the rest.
+
+		while (arg[argnum] is a special control character) {
+		    increment arg[argnum]
+		    increment arg1 or arg2
+		}
+		put binary value of arg[argnum] to outstr
+		increment argnum
+
+	    case '>':
+		conditionally modify arg[argnum]
+	    case 'r':
+		swap arg[1] and arg[2]
+	    case 'i':
+		increment arg[1] and arg[2]
+	    case '%':
+		put % to outstr, bump op
+	    case 'B':
+		BCD encode next arg
+	    case 'D':
+		backwards BCD encode next arg (ugh)
+	    }
+	}
+
+	deposit EOS
+end
+.fi
+
+
+The technique used for cursor addressing depends on the characteristics
+of the terminal.  If the terminal has no cursor motion capability, we
+try to position the cursor using primitive motion commands.  Otherwise
+we use TTYSUBI to generate the cursor motion sequence.  If TTYSUBI returns
+a residual, we use primitive motion commands (up line and backspace) to go
+the rest of the way in.
+
+
+.nf
+procedure ttygoto (fd, tty, col, line)
+
+begin
+	if (tty has no cursor addressing capability) {
+	    # If possible, the calling program should keep track of the
+	    # cursor position and use primitive motion commands for
+	    # positioning when possible.  We do the best we can without
+	    # knowledge of the current position.
+
+	    # First get to a known position.
+	    goto home or lower-left, depending on which is closest to
+		desired position and on capabilities of terminal.
+
+	    # Now move to the desired position.
+	    step to desired line using ttyvert
+	    advance to desired column using ttyhorz
+
+	} else {
+	    get cursor motion control string
+	    call ttysubi to substitute in desired coordinates
+	    call ttyputs to put control string to file
+
+	    # In certain cases, ttysubi cannot get us all the way there,
+	    # and we have to step in the rest of the way.
+
+	    if (line residual)
+		call ttyhorz to adjust position within line
+	    if (col residual)
+		call ttyvert to adjust vertical position
+	}
+end
+.fi
diff --git a/sys/tty/gttyload.x b/sys/tty/gttyload.x
new file mode 100644
index 00000000..066c1582
--- /dev/null
+++ b/sys/tty/gttyload.x
@@ -0,0 +1,38 @@
+# G_TTYLOAD -- Version of the TTYLOAD procedure for accessing compiled entries
+# from the GRAPHCAP database file.  Search the database of compiled GRAPHCAP
+# entries for the named device, and if found, return the CAPLIST string (list
+# of device capabilities) in the output string.  The number of characters output
+# is returned as the function value.  The compiled database is defined by the
+# include file "cacheg.dat", which serves as a cache for the GRAPHCAP
+# entries of heavily used devices (see TTYLOAD, TTYCOMPILE).
+
+int procedure g_ttyload (fname, device, outstr, maxch)
+
+char	fname[ARB]		# name of termcap file being referenced
+char	device[ARB]		# device name as in TERMCAP entry
+char	outstr[maxch]		# output string to receive caplist
+int	maxch
+
+int	dev
+bool	streq(), strne()
+int	gstrcpy()
+
+include	"dev$cacheg.dat"
+
+begin
+	# If the name of the file being referenced is not the same as the
+	# name of the file used to build the cache, then the cache is
+	# invalidated.
+
+	if (strne (fname, sbuf[termcap_filename]))
+	    return (0)
+
+	# NDEVICES, DEVNAME, DEVCAPS, and SBUF are defined and initialized
+	# in the include file.
+
+	do dev = 1, ndevices
+	    if (streq (sbuf[devname[dev]], device))
+		return (gstrcpy (sbuf[devcaps[dev]], outstr, maxch))
+
+	return (0)
+end
diff --git a/sys/tty/mkpkg b/sys/tty/mkpkg
new file mode 100644
index 00000000..35e97a8a
--- /dev/null
+++ b/sys/tty/mkpkg
@@ -0,0 +1,52 @@
+# Make the TTY interface portion of the LIBSYS library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$omake	x_mkttydata.x <error.h> tty.h
+	$link	x_mkttydata.o
+	;
+
+install:
+	$move	x_mkttydata.e bin$
+	;
+
+libsys.a:
+	gttyload.x
+	ttycaps.x	tty.h
+	ttycdes.x	
+	ttyclear.x	tty.h <chars.h>
+	ttyclln.x	tty.h <chars.h>
+	ttyclose.x	
+	ttyctrl.x	tty.h <chars.h>
+	ttydelay.x	tty.h
+	ttydevnm.x	<ctype.h>
+	ttygdes.x	dev$cacheg.dat tty.h <chars.h> <ctype.h> <error.h>
+	ttygetb.x	
+	ttygeti.x	
+	ttygetr.x	<mach.h>
+	ttygets.x	<chars.h>
+	ttygoto.x	tty.h <chars.h>
+	ttygsize.x	<fset.h> <ttset.h> <ttyset.h>
+	ttyindex.x	tty.h <chars.h>
+	ttyinit.x	tty.h <chars.h> <error.h> <fset.h>
+	ttyload.x	dev$cachet.dat
+	ttyodes.x	tty.h <chars.h> <ctype.h> <error.h>
+	ttyopen.x	tty.h <chars.h> <ctype.h> <error.h>
+	ttyputl.x	tty.h <chars.h> <ctype.h>
+	ttyputs.x	
+	ttyread.x	<chars.h> <fset.h>
+	ttyseti.x	tty.h <chars.h> <ttyset.h>
+	ttyso.x	
+	ttystati.x	tty.h <chars.h> <ttyset.h>
+	ttysubi.x	tty.h <chars.h> <ctype.h>
+	ttywrite.x	tty.h <chars.h> <ctype.h>
+	;
diff --git a/sys/tty/tty.h b/sys/tty/tty.h
new file mode 100644
index 00000000..6e0e58e0
--- /dev/null
+++ b/sys/tty/tty.h
@@ -0,0 +1,51 @@
+# TTY package definitions.  Requires <chars.h>.
+
+define	TABSIZE		8
+define	MAX_TC_NESTING	5		# max nesting of tc=term references
+
+# Include here all special control characters (mapped by driver) which should
+# not be used as binary cursor coordinates.  The list must be terminated by
+# an EOS; do not count the EOS in NDCHARS.  Note that NUL cannot be included
+# in the list because it is the same as EOS.
+
+define	NDCHARS		3
+define	DRIVER_CHARS	EOT,HT,LF,EOS
+
+# Mapping function used to map capcodes ("cm", etc.) into unique integers.
+define	ENCODE		($1[1]*128+$1[2])
+
+# Types of standout modes defined for terminals.
+
+define	SOSE		1		# use so,se or us,ue capabilities
+define	BSOS		2		# backspace and overstrike with _
+define	CROS		3		# CR and overstrike with full line
+define	TOUP		4		# map standout chars to upper case
+
+# TTY descriptor structure.  Full termcap entry is the 'caplist' string.
+# The caplist is indexed at open time to permit a binary search for
+# capabilities at run time.
+
+define	T_MEMINCR	512		# increment if overflow occurs
+define	T_OFFCAP	215		# struct offset to caplist field
+define	MAX_CAPS	100		# maximum capabilities
+define	MAX_COORDS	7		# maximum coords for ttysubi
+define	SZ_CTRLSTR	50		# buffer size for control strings
+define	LEN_DEFTTY	(256+1024)	# initial length of tty structure
+
+define	T_LEN		Memi[$1]	# length of tty structure
+define	T_OP		Memi[$1+1]	# offset into caplist
+define	T_PADCHAR	Memi[$1+2]	# pad character for delays
+define	T_TABCHAR	Memi[$1+3]	# tab character, if HW tabs ok
+define	T_BSOK		Memi[$1+4]	# terminal backspaces with BS
+define	T_HTOK		Memi[$1+5]	# term has HT (horiz tab) in hardware
+define	T_AM		Memi[$1+6]	# term has automargin advance
+define	T_SOTYPE	Memi[$1+7]	# type of standout mode (ttyputline)
+define	T_BAUD		Memi[$1+8]	# baud rate for delays
+define	T_NLINES	Memi[$1+9]	# nlines on terminal at open
+define	T_NCOLS		Memi[$1+10]	# ncols on terminal at open
+define	T_NCAPS		Memi[$1+11]	# number of capabilities
+define	T_CAPLEN	Memi[$1+12]	# length of caplist, chars
+			# (extra space)
+define	T_CAPCODE	Memi[$1+15]	# cap code array: c1*128+c2
+define	T_CAPINDEX	Memi[$1+115]	# cap index array
+define	T_CAPLIST	Memc[($1+215-1)*SZ_STRUCT+1]	# termcap entry
diff --git a/sys/tty/ttycaps.x b/sys/tty/ttycaps.x
new file mode 100644
index 00000000..e6fcbcf0
--- /dev/null
+++ b/sys/tty/ttycaps.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"tty.h"
+
+# TTYCAPS -- Return a pointer to the caplist field of an open TTY descriptor.
+
+pointer procedure ttycaps (tty)
+
+pointer	tty			# tty descriptor
+
+begin
+	return (P2C (tty + T_OFFCAP))
+end
diff --git a/sys/tty/ttycdes.x b/sys/tty/ttycdes.x
new file mode 100644
index 00000000..0b778a51
--- /dev/null
+++ b/sys/tty/ttycdes.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYCDES -- Close a terminal opened with TTYODES or TTYGDES.
+
+procedure ttycdes (tty)
+
+pointer	tty
+
+begin
+	call ttyclose (tty)
+end
diff --git a/sys/tty/ttyclear.x b/sys/tty/ttyclear.x
new file mode 100644
index 00000000..86dac6ff
--- /dev/null
+++ b/sys/tty/ttyclear.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"tty.h"
+
+# TTYCLEAR -- Clear the terminal screen.
+
+procedure ttyclear (fd, tty)
+
+int	fd
+pointer	tty
+
+int	status
+bool	ttygetb()
+int	ttyctrl()
+errchk	ttygetb, ttyctrl
+
+begin
+	# If hardcopy terminal, output formfeed instead of clear.
+	if (ttygetb (tty, "ht"))
+	    status = ttyctrl (fd, tty, "ff", T_NLINES(tty))
+	else
+	    status = ERR
+	if (status == ERR)
+	    status = ttyctrl (fd, tty, "cl", T_NLINES(tty))
+
+	# If ff or cl capability not found, the best we can do is output
+	# a newline.
+	if (status == ERR)
+	    call putline (fd, "\n")
+end
diff --git a/sys/tty/ttyclln.x b/sys/tty/ttyclln.x
new file mode 100644
index 00000000..34e57328
--- /dev/null
+++ b/sys/tty/ttyclln.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"tty.h"
+
+# TTYCLEARLN -- Clear the current line.  The cursor is left positioned at the
+# left margin.  If the clear has to be performed by overwriting the line with
+# blanks, the final column is not cleared.
+
+procedure ttyclearln (fd, tty)
+
+int	fd
+pointer	tty
+pointer	sp, buf
+int	nchars, ttygets()
+errchk	salloc, ttygets, putc, ttywrite, fprintf, pargi
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_CTRLSTR, TY_CHAR)
+
+	nchars = ttygets (tty, "ce", Memc[buf], SZ_CTRLSTR)
+	if (nchars > 0) {
+	    call putci (fd, '\r')
+	    call ttywrite (fd, tty, Memc[buf], nchars, 1)
+	} else {
+	    call fprintf (fd, "\r%*w\r")
+		call pargi (T_NCOLS(tty) - 1)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/tty/ttyclose.x b/sys/tty/ttyclose.x
new file mode 100644
index 00000000..f30644dd
--- /dev/null
+++ b/sys/tty/ttyclose.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYCLOSE -- Close the tty terminal descriptor opened with TTYOPEN.
+
+procedure ttyclose (tty)
+
+pointer	tty
+
+begin
+	call mfree (tty, TY_STRUCT)
+end
diff --git a/sys/tty/ttyctrl.x b/sys/tty/ttyctrl.x
new file mode 100644
index 00000000..3a66e961
--- /dev/null
+++ b/sys/tty/ttyctrl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"tty.h"
+
+# TTYCTRL -- Output a control sequence to the terminal.
+
+int procedure ttyctrl (fd, tty, cap, afflncnt)
+
+int	fd, afflncnt
+char	cap[ARB]
+pointer	tty
+
+pointer	sp, buf
+int	status, nchars, ttygets()
+errchk	ttygets, ttywrite
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_CTRLSTR, TY_CHAR)
+
+	nchars = ttygets (tty, cap, Memc[buf], SZ_CTRLSTR)
+	if (nchars > 0) {
+	    call ttywrite (fd, tty, Memc[buf], nchars, afflncnt)
+	    status = OK
+	} else
+	    status = ERR
+
+	call sfree (sp)
+	return (status)
+end
diff --git a/sys/tty/ttydelay.x b/sys/tty/ttydelay.x
new file mode 100644
index 00000000..7fc6b3d4
--- /dev/null
+++ b/sys/tty/ttydelay.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "tty.h"
+
+# TTYDELAY -- Output a sequence of pad characters to create a delay, giving
+# the terminal time to complete some operation before being passed the next
+# request.
+
+procedure ttydelay (fd, tty, delay)
+
+int	fd			# output file
+pointer	tty			# tty descriptor
+int	delay			# desired milliseconds of delay
+
+int	padchar, npadchars
+real	msec_per_char
+int	and()
+
+begin
+	# Add padding if needed to generate delay.  (8 = nbits per char,
+	# baud is in units of bits per second).
+
+	if (delay > 0 && T_BAUD(tty) > 0) {
+	    padchar = and (T_PADCHAR(tty), 177B)
+	    msec_per_char = real(8 * 1000) / real(T_BAUD(tty)) 
+	    npadchars = int (delay / msec_per_char + 0.5)
+
+	    for (;  npadchars > 0;  npadchars = npadchars - 1)
+		call putci (fd, padchar)
+	}
+end
diff --git a/sys/tty/ttydevnm.x b/sys/tty/ttydevnm.x
new file mode 100644
index 00000000..76996d69
--- /dev/null
+++ b/sys/tty/ttydevnm.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# TTYDEVNAME -- Extract the logical device name from a full device specification
+# of the form  "node ! logical_device ? physical_device".  The node prefix, if
+# given, specifies the node from which the device is to be accessed (via the
+# network), and the physical device field contains particulars about the
+# physical device to be accessed.  Only the logical device field, used to index
+# the termcap file, is of any interest to TTY.  The logical device name
+# consists of chars chosen from the set [a-zA-Z0-9_+-].
+
+procedure ttydevname (device, ldevice, maxch)
+
+char	device[ARB]		# full device specification
+char	ldevice[maxch]		# logical device name
+int	maxch
+
+pointer	sp, nodename
+int	ip, op, ch
+int	ki_extnode()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_FNAME, TY_CHAR)
+
+	ip = ki_extnode (device, Memc[nodename], maxch, op) + 1
+
+	for (op=1;  device[ip] != EOS;  ip=ip+1) {
+	    ch = device[ip]
+	    if (!(IS_ALNUM(ch) || ch == '_' || ch == '+' || ch == '-')) {
+		ldevice[op] = EOS
+		break
+	    } else {
+		ldevice[op] = ch
+		op = op + 1
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/tty/ttygdes.x b/sys/tty/ttygdes.x
new file mode 100644
index 00000000..8eff579a
--- /dev/null
+++ b/sys/tty/ttygdes.x
@@ -0,0 +1,148 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<chars.h>
+include	"tty.h"
+
+define	DEF_BAUDRATE	9600
+
+# TTYGDES -- Open a TTY graphics stdgraph descriptor.  If ttyname is
+# "stdgraph" or "stdplot", get the name of the physical graphics device
+# from the environment.  The name of the graphcap file is fetched from the
+# environment and the graphcap file is searched for an entry corresponding
+# to the named device.
+# 
+# The descriptor is then allocated, and the graphcap entry read in.  Graphcap
+# permits an entry to be defined in terms of another entry with the "tc"
+# field; we must expand such references by rescanning the file once for each
+# such reference.  Finally, the graphcap entry is indexed for efficient access.
+# The form of a graphcap entry is identical to that for a termcap entry.
+
+pointer procedure ttygdes (ttyname)
+
+char	ttyname[ARB]
+
+int	nchars
+pointer	sp, ttysource, device, devname, fname, tty
+pointer	ttyopen()
+extern	g_ttyload()
+bool	streq(), ttygetb()
+int	fnldir(), ttygeti(), ttygets()
+int	envgets(), envgeti()
+errchk	envgets, envgeti, ttyopen, ttygets, syserrs
+errchk	tty_index_caps, ttygeti, envindir
+
+string	stdgraph "stdgraph"
+string	stdimage "stdimage"
+string	stdplot  "stdplot"
+string	graphcap "graphcap"
+
+begin
+	call smark (sp)
+	call salloc (ttysource, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Resolve any indirection in the device name.
+	call envindir (ttyname, Memc[devname], SZ_FNAME)
+
+	# Get device name or graphcap file name.
+	if (streq (Memc[devname], stdgraph)) {
+	    if (envgets (stdgraph, Memc[ttysource], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, stdgraph)
+	} else if (streq (Memc[devname], stdimage)) {
+	    if (envgets (stdimage, Memc[ttysource], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, stdimage)
+	} else if (streq (Memc[devname], stdplot)) {
+	    if (envgets (stdplot, Memc[ttysource], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, stdplot)
+	} else
+	    call strcpy (Memc[devname], Memc[ttysource], SZ_FNAME)
+
+	# If ttysource is a filename, we assume that it is the name of
+	# a graphcap format file, the first entry of which (matched by the
+	# null device name) is the entry for the device.  Otherwise,
+	# ttysource is the name of the desired graphcap entry in the regular
+	# graphcap file.
+
+	if (fnldir (Memc[ttysource], Memc[fname], SZ_FNAME) > 0) {
+	    call strcpy (Memc[ttysource], Memc[fname], SZ_FNAME)
+	    Memc[device] = EOS
+	} else {
+	    if (envgets (graphcap, Memc[fname], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, graphcap)
+	    call strcpy (Memc[ttysource], Memc[device], SZ_FNAME)
+	}
+
+	# Truncate the device name if device fields are appended.
+	call ttydevname (Memc[device], Memc[device], SZ_FNAME)
+
+	# Allocate and initialize the tty descriptor structure.  Fetch graphcap
+	# entry from graphcap file into descriptor.  The G_TTYLOAD procedure,
+	# passed as an argument to TTYOPEN, is searched for cached termcap
+	# entries before accessing the actual file.
+
+	tty = ttyopen (Memc[fname], Memc[device], g_ttyload)
+
+	# Prepare index of fields in the descriptor, so that we can more
+	# efficiently search for fields later.
+
+	call tty_index_caps (tty, T_CAPCODE(tty), T_CAPINDEX(tty), T_NCAPS(tty))
+
+	# Determine whether or not the stdgraph device can backspace with BS.
+	if (ttygetb (tty, "bs"))
+	    T_BSOK(tty) = YES
+	else
+	    T_BSOK(tty) = NO
+
+	# Determine whether or not the stdgraph device can expand tabs.
+	# If it can but it requires some long string, don't bother.
+
+	T_HTOK(tty) = NO
+	T_TABCHAR(tty) = 0
+	if (ttygetb (tty, "pt")) {
+	    nchars = ttygets (tty, "ta", Memc[fname], SZ_FNAME)
+	    if (nchars <= 0) {
+		T_HTOK(tty) = YES
+		T_TABCHAR(tty) = '\t'
+	    } else if (nchars == 1) {
+		T_HTOK(tty) = YES
+		T_TABCHAR(tty) = Memc[fname]
+	    }
+	}
+
+	# Determine the optimimum mode for handling standout mode control,
+	# and save in the descriptor.
+
+	if (ttygetb (tty, "so")) {
+	    T_SOTYPE(tty) = SOSE		# use so, se
+	} else if (ttygetb (tty, "os")) {
+	    if (T_BSOK(tty) == YES || ttygetb (tty, "bc"))
+		T_SOTYPE(tty) = BSOS		# backspace, ostrike
+	    else
+		T_SOTYPE(tty) = CROS		# ostrike whole line
+	} else
+	    T_SOTYPE(tty) = TOUP		# to upper case
+
+	# Get pad char and baud rate (used by ttyputs to generate delays)
+	# and put in descriptor for efficient access.  Also get tty screen
+	# dimensions since they are fundamental and will probably prove
+	# useful later.
+
+	T_PADCHAR(tty) = ttygeti (tty, "pc")	# returns 0 if field not found
+	T_NLINES(tty)  = ttygeti (tty, "li")
+	T_NCOLS(tty)   = ttygeti (tty, "co")
+
+	# Baud rate may not be right if device is attached to the host, and
+	# and user is working remotely.  Nonetheless it is safer to pick up
+	# the value from the environment than to assume a default.
+
+	iferr (T_BAUD(tty) = envgeti ("ttybaud"))
+	    T_BAUD(tty) = DEF_BAUDRATE
+
+	call sfree (sp)
+	return (tty)
+end
diff --git a/sys/tty/ttygetb.x b/sys/tty/ttygetb.x
new file mode 100644
index 00000000..8c6fdbd4
--- /dev/null
+++ b/sys/tty/ttygetb.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYGETB -- Determine whether or not a capability exists for a device.
+# If there is any entry at all, the capability exists.
+
+bool procedure ttygetb (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+pointer	ip
+int	tty_find_capability()
+
+begin
+	return (tty_find_capability (tty, cap, ip) == YES)
+end
diff --git a/sys/tty/ttygeti.x b/sys/tty/ttygeti.x
new file mode 100644
index 00000000..95384df3
--- /dev/null
+++ b/sys/tty/ttygeti.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYGETI -- Get an integer valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as an integer, zero is
+# returned.  Integer capabilities have the format ":xx#dd:".
+
+int procedure ttygeti (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+int	ival
+pointer	ip
+int	tty_find_capability(), ctoi()
+
+begin
+	if (tty_find_capability (tty, cap, ip) == NO)
+	    return (0)
+	else if (Memc[ip] != '#')
+	    return (0)
+	else {
+	    ip = ip + 1				# skip the '#'
+	    if (ctoi (Memc, ip, ival) == 0)
+		return (0)
+	    else
+		return (ival)
+	}
+end
diff --git a/sys/tty/ttygetr.x b/sys/tty/ttygetr.x
new file mode 100644
index 00000000..f4e2a8a8
--- /dev/null
+++ b/sys/tty/ttygetr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# TTYGETR -- Get a real valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as a number, zero is
+# returned.  Real valued capabilities have the format ":xx#num:".
+
+real procedure ttygetr (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+
+char	numstr[MAX_DIGITS]
+int	np, op
+pointer	ip
+double	dval
+int	tty_find_capability(), ctod()
+
+begin
+	if (tty_find_capability (tty, cap, ip) == NO)
+	    return (0.0)
+	else if (Memc[ip] != '#')
+	    return (0.0)
+	else {
+	    # Extract the number into numstr.  Cannot convert in place in
+	    # the table because the ":" delimiter will by interpreted by
+	    # ctod as for a sexagesimal number.
+	    op = 1
+	    for (ip=ip+1;  op <= MAX_DIGITS && Memc[ip] != ':';  ip=ip+1) {
+		numstr[op] = Memc[ip]
+		op = op + 1
+	    }
+	    numstr[op] = EOS
+	    np = 1
+	    if (ctod (numstr, np, dval) == 0)
+		return (0.0)
+	    else
+		return (dval)
+	}
+end
diff --git a/sys/tty/ttygets.x b/sys/tty/ttygets.x
new file mode 100644
index 00000000..23da69e1
--- /dev/null
+++ b/sys/tty/ttygets.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+
+.help ttygets
+.nf ___________________________________________________________________________
+TTYGETS -- Get the string value of a capability.  Process all termcap escapes.
+These are:
+
+	\E		ascii esc (escape)
+	^X		control-X (i.e., ^C=03B, ^Z=032B, etc.)
+	\[nrtbf]	newline, return, tab, backspace, formfeed
+	\ddd		octal value of character
+	\^		the character ^
+	\\		the character \
+
+The character ':' may not be placed directly in a capability string; it
+should be given as \072 instead.  The null character is represented as \200;
+all characters are masked to 7 bits upon output by TTYPUTS, hence \200
+is sent to the terminal as NUL.
+.endhelp ______________________________________________________________________
+
+int procedure ttygets (tty, cap, outstr, maxch)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+char	outstr[ARB]		# receives cap string
+int	maxch			# size of outstr
+
+char	ch
+pointer	ip
+int	op, junk, temp
+int	tty_find_capability(), cctoc()
+
+begin
+	op = 1
+
+	if (tty_find_capability (tty, cap, ip) == YES) {
+	    # Skip the '=' which follows the two character capability name.
+	    if (Memc[ip] == '=')
+		ip = ip + 1
+
+	    # Extract the string, processing all escapes.
+	    for (ch=Memc[ip];  ch != ':';  ch=Memc[ip]) {
+		if (ch == '^') {
+		    ip = ip + 1
+		    temp = Memc[ip]
+		    ch = mod (temp, 40B)
+		} else if (ch == '\\') {
+		    switch (Memc[ip+1]) {
+		    case 'E':
+			ip = ip + 1
+			ch = ESC
+		    case '^', ':', '\\':
+			ip = ip + 1
+			ch = Memc[ip]
+		    default:
+			junk = cctoc (Memc, ip, ch)
+			ip = ip - 1
+		    }
+		}
+
+		outstr[op] = ch
+		op = op + 1
+		ip = ip + 1
+		if (op >= maxch)
+		    break
+	    }
+	}
+
+	outstr[op] = EOS
+	return (op-1)
+end
diff --git a/sys/tty/ttygoto.x b/sys/tty/ttygoto.x
new file mode 100644
index 00000000..d8896125
--- /dev/null
+++ b/sys/tty/ttygoto.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	"tty.h"
+
+# TTYGOTO -- Position the cursor to the given absolute screen coordinates.
+# We do not require any knowledge of the current screen position; many programs
+# will wish to do cursor positioning at a lower level to take advantage of
+# knowledge of the current position.
+
+procedure ttygoto (fd, tty, col, line)
+
+int	fd			# output stream
+pointer	tty			# termcap descriptor
+int	col			# destination column
+int	line			# destination line
+
+pointer	sp, cm_in, cm_out
+int	coords[2], nchars, i
+int	ttygets(), ttysubi()
+errchk	salloc, ttygets, ttyputs, ttywrite
+
+begin
+	call smark (sp)
+	call salloc (cm_in, SZ_CTRLSTR, TY_CHAR)
+	call salloc (cm_out, SZ_LINE, TY_CHAR)
+
+	# Use the cursor motion control string to position cursor, if the
+	# terminal has such a capability.  Otherwise try to use primitive
+	# motion commands.
+
+	if (ttygets (tty, "cm", Memc[cm_in], SZ_CTRLSTR) > 0) {
+	    # Coordinates are ordered line,col in the termcap entry,
+	    # whereas our args are ordered col,line (e.g., x,y).  Store
+	    # in "coords" in the termcap order.
+
+	    coords[1] = line
+	    coords[2] = col
+	    nchars = ttysubi (Memc[cm_in], Memc[cm_out], SZ_LINE, coords, 2)
+
+	    # Output cursor motion control string to file.
+	    call ttywrite (fd, tty, Memc[cm_out], nchars, 1)
+
+	    # If unable to position to the exact coordinates, use primitive
+	    # motion commands to step the rest of the way in.  Do not abort
+	    # if unable to do so.
+
+	    if (coords[2] > 0) {
+		# Presumably we do not have to step in very often, so we do
+		# nothing special to buffer the backspace control sequence.
+		# Most terminals recognize BS in any case.
+
+		if (T_BSOK(tty) == YES) {
+		    Memc[cm_out] = BS
+		    Memc[cm_out+1] = EOS
+		} else if (ttygets (tty, "bc", Memc[cm_out], SZ_CTRLSTR) == 0)
+		    Memc[cm_out] = EOS
+
+		for (i=coords[2];  i > 0;  i=i-1)
+		    call ttyputs (fd, tty, Memc[cm_out], 1)
+	    }
+
+	    # Now adjust vertical position if necessary.
+	    if (coords[1] > 0) {
+		if (ttygets (tty, "up", Memc[cm_out], SZ_CTRLSTR) > 0)
+		    for (i=coords[1];  i > 0;  i=i-1)
+			call ttyputs (fd, tty, Memc[cm_out], 1)
+	    }
+
+	} else {
+	    # Terminal has no nifty cursor addressing capability; add code here
+	    # to position cursor by generating a sequence of more primitive
+	    # codes.  Not going to bother with this for now.
+	    ;
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/tty/ttygsize.x b/sys/tty/ttygsize.x
new file mode 100644
index 00000000..e4ccfa1a
--- /dev/null
+++ b/sys/tty/ttygsize.x
@@ -0,0 +1,115 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<ttset.h>
+include	<fset.h>
+
+define	TIMEOUT  2000		# timeout interval, msec, for size query
+
+
+# TTYGSIZE -- Get the width and height of the terminal screen in characters.
+# For a conventional terminal these values are given as constants in the
+# termcap entry for the device.  If the terminal has a screen which can vary
+# in size at runtime (e.g., a window on a workstation), then the screen size
+# is queried at runtime.
+
+procedure ttygsize (in, out, tty, width, height)
+
+int	in, out			# input and output streams
+pointer	tty			# terminal descriptor
+int	width			# ncols on screen (out)
+int	height			# nlines on screen (out)
+
+pointer	sp, patbuf, buf, qs, wh, ip, op
+int	index, len_qs, len_wh, w_index, h_index, sv_iomode, nchars, junk
+
+int	patmake(), patindex(), gstrcpy(), ctoi()
+int	ttygets(), ttyread(), ttystati(), ttstati(), fstati()
+define	noquery_ 91
+errchk	ttyread
+
+begin
+	call smark (sp)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (qs, SZ_FNAME, TY_CHAR)
+	call salloc (wh, SZ_FNAME, TY_CHAR)
+
+	width = 0
+	height = 0
+	index = 0
+
+	# Just use the termcap values if in stty playback or record mode.
+	if (ttstati(in,TT_LOGIN) == YES || ttstati(in,TT_PLAYBACK) == YES)
+	    goto noquery_
+
+	len_qs = ttygets (tty, "qs", Memc[qs], SZ_FNAME)
+	len_wh = ttygets (tty, "wh", Memc[wh], SZ_FNAME)
+
+	# Process the string DS (decode size string) to map the %W %H fields
+	# into the pattern strings "%[0-9]*", noting the index positions of
+	# the W and H fields.
+
+	if (len_wh > 0) {
+	    op = buf
+	    for (ip=wh;  Memc[ip] != EOS;  ip=ip+1) {
+		if ((Memc[ip] == '%') && ip > wh && Memc[ip-1] != '\\' &&
+		    (Memc[ip+1] == 'W' || Memc[ip+1] == 'H')) {
+
+		    index = index + 1
+		    op = op + gstrcpy ("%[0-9]*", Memc[op], ARB)
+		    ip = ip + 1
+
+		    if (Memc[ip] == 'W')
+			w_index = index
+		    else
+			h_index = index
+		} else {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+	    }
+	    Memc[op] = EOS
+	    junk = patmake (Memc[buf], Memc[patbuf], SZ_LINE)
+	}
+
+	# Query the terminal for the screen size, read back and decode the
+	# encoded screen size string.
+
+	if (len_qs > 0 && len_wh > 0) {
+	    sv_iomode = fstati (in, F_IOMODE)
+	    if (sv_iomode != IO_RAW)
+		call fseti (in, F_IOMODE, IO_RAW)
+
+	    call ttywrite (out, tty, Memc[qs], len_qs, 0)
+	    call flush (out)
+
+	    nchars = ttyread (in, tty, Memc[buf],SZ_LINE,Memc[patbuf], TIMEOUT)
+	    if (nchars > 0) {
+		if (ctoi (Memc[buf],patindex(Memc[patbuf],w_index),width) <= 0)
+		    width = 0
+		if (ctoi (Memc[buf],patindex(Memc[patbuf],h_index),height) <= 0)
+		    height = 0
+	    }
+
+	    if (sv_iomode != IO_RAW)
+		call fseti (in, F_IOMODE, sv_iomode)
+
+	    if (width == 0 && nchars == 0) {
+		call eprintf ("timeout - terminal type set wrong? ")
+		call eprintf ("(`stty termtype' to reset)\n")
+	    }
+	}
+
+noquery_
+	# If we still do not know the screen width or height, use the values
+	# given in the user environment, else in the termcap entry for the
+	# device.
+
+	if (width <= 0)
+	    width = ttystati (tty, TTY_NCOLS)
+	if (height <= 0)
+	    height = ttystati (tty, TTY_NLINES)
+
+	call sfree (sp)
+end
diff --git a/sys/tty/ttyindex.x b/sys/tty/ttyindex.x
new file mode 100644
index 00000000..6d9ae222
--- /dev/null
+++ b/sys/tty/ttyindex.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<chars.h>
+include	"tty.h"
+
+.help index caplist
+.nf _________________________________________________________________________
+TTY_INDEX_CAPS -- Prepare an index into the caplist string, stored in
+the tty descriptor.  Each two character capability name maps into a unique
+integer code, called the capcode.  We prepare a list of capcodes, keeping
+only the first such code encountered in the case of multiple entries.
+The offset of the capability in the caplist string is associated with each
+capcode.  When these lists have been prepared, they are sorted to permit
+a binary search for capabilities at runtime.
+.endhelp ____________________________________________________________________
+
+procedure tty_index_caps (tty, t_capcode, t_capindex, ncaps)
+
+pointer	tty
+int	t_capcode[ARB], t_capindex[ARB]
+int	ncaps
+
+pointer	ip, caplist
+int	i, swap, capcode, temp
+int	tty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	ip = caplist
+
+	# Scan the caplist and prepare the capcode and capindex lists.
+	for (ncaps=0;  ncaps <= MAX_CAPS;  ) {
+	    # Advance to the next capability field.  Normal exit occurs
+	    # when ':' is followed immediately by EOS.
+
+	    while (Memc[ip] != ':' && Memc[ip] != EOS)
+		ip = ip + 1
+	    if (Memc[ip+1] == EOS || Memc[ip] == EOS)
+		break
+
+	    ip = ip + 1					# skip the ':'
+	    capcode = tty_encode_capability (Memc[ip])
+
+	    # Is the capcode already in the list?  If not found, add it to
+	    # the list.
+	    for (i=1;  i <= ncaps && t_capcode[i] != capcode;  i=i+1)
+		;
+	    if (i > ncaps) {				# not found
+		ncaps = ncaps + 1
+		t_capcode[ncaps] = capcode
+		t_capindex[ncaps] = ip - caplist + 1
+	    }
+	}
+
+	if (ncaps > MAX_CAPS)
+	    call syserr (SYS_TTYOVFL)
+
+	# A simple interchange sort is sufficient here, even though it would
+	# not be hard to interface to qsort.  The longest termcap entries are
+	# about 50 caps, and the time req'd to sort such a short list is
+	# negligible compared to the time spent searching the termcap file.
+
+	if (ncaps > 1)
+	    repeat {
+		swap = 0
+		do i = 1, ncaps-1
+		    if (t_capcode[i] > t_capcode[i+1]) {
+			temp = t_capcode[i]
+			t_capcode[i] = t_capcode[i+1]
+			t_capcode[i+1] = temp
+			temp = t_capindex[i]
+			t_capindex[i] = t_capindex[i+1]
+			t_capindex[i+1] = temp
+			swap = 1
+		    }
+	    } until (swap == 0)
+end
+
+
+# TTY_FIND_CAPABILITY -- Search the caplist for the named capability.
+# If found, return the char pointer IP to the first char of the value field,
+# and YES as the function value.  If the first char in the capability string
+# is '@', the capability "is not present".
+
+int procedure tty_find_capability (tty, cap, ip)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character name of capability
+pointer	ip			# pointer to capability string
+
+int	capcode, capnum
+int	tty_binsearch(), tty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	if (tty == NULL)
+	    call syserr (SYS_TTYINVDES)
+
+	capcode = tty_encode_capability (cap)
+	capnum = tty_binsearch (capcode, T_CAPCODE(tty), T_NCAPS(tty))
+
+	if (capnum > 0) {
+	    # Add 2 to skip the two capname chars.
+	    ip = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR) +
+		T_CAPINDEX(tty+capnum-1) - 1 + 2
+	    if (Memc[ip] != '@')
+		return (YES)
+	}
+
+	return (NO)
+end
+
+
+# TTY_BINSEARCH -- Perform a binary search of the capcode array for the
+# indicated capability.  Return the array index of the capability if found,
+# else zero.
+
+int procedure tty_binsearch (capcode, t_capcode, ncaps)
+
+int	capcode
+int	t_capcode[ARB], ncaps
+int	low, high, pos, ntrips
+
+begin
+	low = 1
+	high = ncaps
+	pos = 0
+
+	# Cut range of search in half until code is found, or until range
+	# vanishes (high - low <= 1).  If neither high or low is the one,
+	# code is not found in the list.
+
+	do ntrips = 1, ncaps {
+	    pos = (high - low) / 2 + low
+	    if (t_capcode[low] == capcode)
+		return (low)
+	    else if (t_capcode[high] == capcode)
+		return (high)
+	    else if (pos == low)			# (high-low)/2 == 0
+		return (0)				# not found
+	    else if (t_capcode[pos] < capcode)
+		low = pos
+	    else
+		high = pos
+	} 
+
+	# Search cannot fail to converge unless there is a bug in the software
+	# somewhere.
+
+	call syserr (SYS_TTYBINSRCH)
+end
+
+
+# TTY_ENCODE_CAPABILITY -- Encode the two character capability string
+# as a unique integer value.
+
+int procedure tty_encode_capability (cap)
+
+char	cap[ARB]
+
+begin
+	return (ENCODE(cap))
+end
diff --git a/sys/tty/ttyinit.x b/sys/tty/ttyinit.x
new file mode 100644
index 00000000..9aeff341
--- /dev/null
+++ b/sys/tty/ttyinit.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<chars.h>
+include	<fset.h>
+include	"tty.h"
+
+# TTYINIT -- Initialize the terminal.  The termcap entry potentially contains
+# two initialization entries.  The first, "is" is an initialization string
+# which is sent to the terminal.  The second, "if", is the name of a file
+# containing the initialization string.  If both are given, "if" is sent
+# followed by "is", however, there seems no reason to have an "is" string
+# if there is already an initialization file.  The names of initialization
+# files may be either IRAF virtual filenames or host system pathnames.
+
+procedure ttyinit (fd, tty)
+
+int	fd			# file descriptor of terminal
+pointer	tty			# tty descriptor
+
+pointer	sp, fname
+int	in, junk, rawmode
+int	ttyctrl(), ttygets(), open(), fstati()
+errchk	ttygets, fcopyo
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Output contents of initialization file, if any.
+	if (ttygets (tty, "if", Memc[fname], SZ_PATHNAME) > 0)
+	    iferr (in = open (Memc[fname], READ_ONLY, TEXT_FILE))
+		call erract (EA_WARN)
+	    else {
+		rawmode = fstati (fd, F_RAW)
+		call fseti (fd, F_RAW, YES)
+		call fcopyo (in, fd)
+		call fseti (fd, F_RAW, rawmode)
+		call close (in)
+	    }
+
+	# Output initialization string.
+	junk = ttyctrl (fd, tty, "is", 1)
+
+	call sfree (sp)
+end
diff --git a/sys/tty/ttyload.x b/sys/tty/ttyload.x
new file mode 100644
index 00000000..117575b8
--- /dev/null
+++ b/sys/tty/ttyload.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYLOAD -- Search the database of compiled TERMCAP entries for the named
+# device, and if found, return the CAPLIST string (list of device capabilities)
+# in the output string.  The number of characters output is returned as the
+# function value.  The compiled database is defined by the include file
+# "cachet.dat", which serves as a cache for the TERMCAP entries of heavily
+# used devices (see TTYCOMPILE).
+# 
+# N.B.: This file can serve as a template for generating TTYLOAD procedures
+# for devices other than the terminal.  Change the name TTYLOAD to something
+# else, change the name of the include file, generate a different include file
+# with TTYCOMPILE, and you are in business.
+
+int procedure ttyload (fname, device, outstr, maxch)
+
+char	fname[ARB]		# name of termcap file being referenced
+char	device[ARB]		# device name as in TERMCAP entry
+char	outstr[maxch]		# output string to receive caplist
+int	maxch
+
+int	dev
+bool	streq(), strne()
+int	gstrcpy()
+
+include	"dev$cachet.dat"
+
+begin
+	# If the name of the file being referenced is not the same as the
+	# name of the file used to build the cache, then the cache is
+	# invalidated.
+
+	if (strne (fname, sbuf[termcap_filename]))
+	    return (0)
+
+	# NDEVICES, DEVNAME, DEVCAPS, and SBUF are defined and initialized
+	# in the include file.
+
+	do dev = 1, ndevices
+	    if (streq (sbuf[devname[dev]], device))
+		return (gstrcpy (sbuf[devcaps[dev]], outstr, maxch))
+
+	return (0)
+end
diff --git a/sys/tty/ttyodes.x b/sys/tty/ttyodes.x
new file mode 100644
index 00000000..a01ffdca
--- /dev/null
+++ b/sys/tty/ttyodes.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<chars.h>
+include	"tty.h"
+
+define	DEF_BAUDRATE	9600
+define	DEF_TTYNLINES	24
+define	DEF_TTYNCOLS	80
+
+# TTYODES -- Open a TTY terminal descriptor.  If ttyname is "terminal" or
+# "printer", get the name of the default terminal or printer from the
+# environment.  If the "name" of the terminal is a filename, the first termcap
+# entry in the name file is read.  Otherwise, the termcap file is searched for
+# an entry corresponding to the named device.
+# 
+# The descriptor is then allocated, and the termcap entry read in.  Termcap
+# permits an entry to be defined in terms of another entry with the "tc"
+# field; we must expand such references by rescanning the file once for each
+# such reference.  Finally, the termcap entry is indexed for efficient access.
+# 
+# The form of a termcap entry is one logical line (usually extending over
+# several physical lines using newline escapes), consisting of several alternate
+# names for the device, followed by a list of ':' delimited capabilities:
+# 
+# 	name1 '|' name2 [ '|' namen... ] ':' cap ':' [ cap ':' ... ]
+# 
+# If the final cap in an entry is of the form ":tc=name:", the capability
+# is replaced by the capability list of the named entry.
+
+pointer procedure ttyodes (ttyname)
+
+char	ttyname[ARB]
+
+bool	istty
+int	nchars
+pointer	sp, ttysource, device, devname, fname, tty
+
+pointer	ttyopen()
+extern	ttyload()
+bool	streq(), ttygetb()
+int	envgets(), envgeti(), btoi()
+int	fnldir(), ttygeti(), ttygets()
+errchk	syserrs, tty_index_caps, ttygeti, ttyopen, ttygets
+errchk	envgets, envgeti, envindir
+
+string	terminal "terminal"	# terminal named in environment
+string	printer  "printer"	# printer named in environment
+string	termcap  "termcap"	# name of termcap file stored in env. too
+
+begin
+	call smark (sp)
+	call salloc (ttysource, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Resolve any indirection in the device name.
+	call envindir (ttyname, Memc[devname], SZ_FNAME)
+
+	# Get device name or termcap file name.
+	if (streq (Memc[devname], terminal)) {
+	    if (envgets (terminal, Memc[ttysource], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, terminal)
+	} else if (streq (Memc[devname], printer)) {
+	    if (envgets (printer, Memc[ttysource], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, printer)
+	} else
+	    call strcpy (Memc[devname], Memc[ttysource], SZ_FNAME)
+
+	# If ttysource is a filename, we assume that it is the name of
+	# a termcap format file, the first entry of which (matched by the
+	# null device name) is the entry for the device.  Otherwise,
+	# ttysource is the name of the desired termcap entry in the regular
+	# termcap file.
+
+	if (fnldir (Memc[ttysource], Memc[fname], SZ_FNAME) > 0) {
+	    call strcpy (Memc[ttysource], Memc[fname], SZ_FNAME)
+	    Memc[device] = EOS
+	} else {
+	    if (envgets (termcap, Memc[fname], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, termcap)
+	    call strcpy (Memc[ttysource], Memc[device], SZ_FNAME)
+	}
+
+	# Truncate the device name if device fields are appended.
+	call ttydevname (Memc[device], Memc[device], SZ_FNAME)
+
+	# Allocate and initialize the tty descriptor structure and fetch
+	# termcap entry from termcap file.  The TTYLOAD procedure, passed
+	# as an argument to TTYOPEN, is searched for cached termcap entries
+	# before accessing the actual file.
+
+	tty = ttyopen (Memc[fname], Memc[device], ttyload)
+
+	# Prepare index of fields in the descriptor, so that we can more
+	# efficiently search for fields later.
+
+	call tty_index_caps (tty, T_CAPCODE(tty), T_CAPINDEX(tty),
+	    T_NCAPS(tty))
+
+	# Determine whether or not the terminal can backspace with BS.
+	if (ttygetb (tty, "bs"))
+	    T_BSOK(tty) = YES
+	else
+	    T_BSOK(tty) = NO
+
+	# Determine whether or not the stdgraph device can expand tabs.
+	# If it can but it requires some long string, don't bother.
+
+	T_HTOK(tty) = NO
+	T_TABCHAR(tty) = 0
+	if (ttygetb (tty, "pt")) {
+	    nchars = ttygets (tty, "ta", Memc[fname], SZ_FNAME)
+	    if (nchars <= 0) {
+		T_HTOK(tty) = YES
+		T_TABCHAR(tty) = '\t'
+	    } else if (nchars == 1) {
+		T_HTOK(tty) = YES
+		T_TABCHAR(tty) = Memc[fname]
+	    }
+	}
+
+	# Does the terminal autoadvance at the right margin?
+	T_AM(tty) = btoi (ttygetb (tty, "am"))
+
+	# Determine the optimimum mode for handling standout mode control,
+	# and save in the descriptor.
+
+	if (ttygetb (tty, "so")) {
+	    T_SOTYPE(tty) = SOSE		# use so, se
+	} else if (ttygetb (tty, "os")) {
+	    if (T_BSOK(tty) == YES || ttygetb (tty, "bc"))
+		T_SOTYPE(tty) = BSOS		# backspace, ostrike
+	    else
+		T_SOTYPE(tty) = CROS		# ostrike whole line
+	} else
+	    T_SOTYPE(tty) = TOUP		# to upper case
+
+	# Get pad char and baud rate (used by ttyputs to generate delays)
+	# and put in descriptor for efficient access.  Also get tty screen
+	# dimensions since they are fundamental and will probably prove
+	# useful later.
+
+	T_PADCHAR(tty) = ttygeti (tty, "pc")	# returns 0 if field not found
+
+	# Allow environment variables to override physical screen dimensions
+	# if device is the standard terminal.
+
+	istty = (streq (Memc[devname], terminal))
+
+	# Get nlines.
+	if (istty)
+	    iferr (T_NLINES(tty) = envgeti ("ttynlines"))
+		T_NLINES(tty) = 0
+	if (T_NLINES(tty) <= 0)
+	    iferr (T_NLINES(tty) = ttygeti (tty, "li"))
+		T_NLINES(tty) = 0
+	if (T_NLINES(tty) <= 0)
+	    T_NLINES(tty) = DEF_TTYNLINES
+
+	# Get ncols.
+	if (istty)
+	    iferr (T_NCOLS(tty) = envgeti ("ttyncols"))
+		T_NCOLS(tty) = 0
+	if (T_NCOLS(tty) <= 0)
+	    iferr (T_NCOLS(tty) = ttygeti (tty, "co"))
+		T_NCOLS(tty) = 0
+	if (T_NCOLS(tty) <= 0)
+	    T_NCOLS(tty) = DEF_TTYNCOLS
+
+	# Baud rate may not be right if device is a printer attached to the
+	# host, and user is working remotely.  Nonetheless it is safer to pick
+	# up the value from the environment than to assume a default.
+
+	iferr (T_BAUD(tty) = envgeti ("ttybaud"))
+	    T_BAUD(tty) = DEF_BAUDRATE
+
+	call sfree (sp)
+	return (tty)
+end
diff --git a/sys/tty/ttyopen.x b/sys/tty/ttyopen.x
new file mode 100644
index 00000000..07577821
--- /dev/null
+++ b/sys/tty/ttyopen.x
@@ -0,0 +1,299 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<chars.h>
+include	"tty.h"
+
+# TTYOPEN -- Scan the named TERMCAP style file for the entry for the named
+# device, and if found allocate a TTY descriptor structure, leaving the
+# termcap entry for the device in the descriptor.
+
+pointer procedure ttyopen (termcap_file, device, ttyload)
+
+char	termcap_file[ARB]	# termcap file to be scanned
+char	device[ARB]		# name of device to be scanned for
+extern	ttyload()		# fetches pre-compiled entries from a cache
+int	ttyload()
+
+int	maxch, nchars
+pointer	tty, sp, devname
+errchk	ttyload, calloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Truncate the device name if device fields are appended.
+	call strcpy (device, Memc[devname], SZ_FNAME)
+	call ttydevname (Memc[devname], Memc[devname], SZ_FNAME)
+
+	# Allocate and initialize the tty descriptor structure.
+	call calloc (tty, LEN_DEFTTY, TY_STRUCT)
+
+	T_LEN(tty) = LEN_DEFTTY
+	T_OP(tty) = 1
+
+	# Call the TTYLOAD procedure to see if the TERMCAP entry for the device
+	# is in the cache of pre-compiled device entries.  If not in cache,
+	# we must scan the actual termcap file.
+
+	maxch = (T_LEN(tty) - T_OFFCAP) * SZ_STRUCT
+	nchars = ttyload (termcap_file, Memc[devname], T_CAPLIST(tty), maxch)
+
+	if (nchars > 0) {
+	    # Found device in cache.
+	    T_OP(tty) = nchars + 1
+	    T_CAPLEN(tty) = T_OP(tty)
+	} else {
+	    # Must scan the source file.
+	    iferr (call tty_scan_termcap_file (tty, termcap_file,
+		Memc[devname])) {
+		call mfree (tty, TY_STRUCT)
+		call erract (EA_ERROR)
+	    }
+	}
+
+	# Call realloc to return any unused space in the descriptor.
+	T_LEN(tty) = T_OFFCAP + (T_OP(tty) + SZ_STRUCT-1) / SZ_STRUCT
+	call realloc (tty, T_LEN(tty), TY_STRUCT)
+
+	call sfree (sp)
+	return (tty)
+end
+
+
+# TTY_SCAN_TERMCAP_FILE -- Open and scan the named TERMCAP format database
+# file for the named device.  Fetch termcap entry, expanding any and all
+# "tc" references by repeatedly rescanning file.
+
+procedure tty_scan_termcap_file (tty, termcap_file, devname)
+
+pointer	tty			# tty descriptor structure
+char	termcap_file[ARB]	# termcap format file to be scanned
+char	devname[ARB]		# termcap entry to be scanned for
+
+int	fd, ntc
+pointer	sp, device, ip, op, caplist
+int	open(), strlen(), strncmp()
+pointer	coerce()
+errchk	open, syserrs
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+
+	fd = open (termcap_file, READ_ONLY, TEXT_FILE)
+	call strcpy (devname, Memc[device], SZ_FNAME)
+
+	ntc = 0
+	repeat {
+	    iferr (call tty_fetch_entry (fd, Memc[device], tty)) {
+		call close (fd)
+		call erract (EA_ERROR)
+	    }
+
+	    # Back up to start of last field in entry.
+	    caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	    ip = caplist + T_OP(tty)-1 - 2
+	    while (ip > caplist && Memc[ip] != ':')
+		ip = ip - 1
+
+	    # If last field is "tc", backup op so that the tc field gets
+	    # overwritten with the referenced entry.
+
+	    if (strncmp (Memc[ip+1], "tc", 2) == 0) {
+		# Check for recursive tc reference.
+		ntc = ntc + 1
+		if (ntc > MAX_TC_NESTING) {
+		    call close (fd)
+		    call syserrs (SYS_TTYTC, Memc[device])
+		}
+
+		# Set op to point to the ":" in ":tc=file".
+		T_OP(tty) = ip - caplist + 1
+
+		# Get device name from tc field, and loop again to fetch new
+		# entry.
+		ip = ip + strlen (":tc=")
+		for (op=device;  Memc[ip] != EOS && Memc[ip] != ':';  ip=ip+1) {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+		call seek (fd, BOFL)
+	    } else
+		break
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# TTY_FETCH_ENTRY -- Search the termcap file for the named entry, then read
+# the colon delimited capabilities list into the caplist field of the tty
+# descriptor.  If the caplist field fills up, allocate more space.
+
+procedure tty_fetch_entry (fd, device, tty)
+
+int	fd
+char	device[ARB]
+pointer	tty
+
+char	ch, lastch
+pointer	sp, ip, op, otop, lbuf, alias, caplist
+bool	device_found, streq()
+char	getc()
+int	getline(), tty_extract_alias()
+pointer	coerce()
+errchk	getline, getc, realloc, salloc
+define	errtn_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf,  SZ_LINE,  TY_CHAR)
+	call salloc (alias, SZ_FNAME, TY_CHAR)
+
+	# Locate entry.  First line of each termcap entry contains a list
+	# of aliases for the device.  Only first lines and comment lines
+	# are left justified.
+
+	repeat {
+	    # Skip comment and continuation lines and blank lines.
+	    device_found = false
+
+	    if (getc (fd, ch) == EOF)
+		goto errtn_
+
+	    if (ch == '\n') {
+		# Skip a blank line.
+		next
+	    } else if (ch == '#' || IS_WHITE (ch)) {
+		# Discard the rest of the line and continue.
+		if (getline (fd, Memc[lbuf]) == EOF)
+		    goto errtn_
+		next
+	    }
+
+	    # Extract list of aliases.  The first occurrence of ':' marks
+	    # the end of the alias list and the beginning of the caplist.
+
+	    Memc[lbuf] = ch
+	    op = lbuf + 1
+
+	    for (;  getc(fd,ch) != ':';  op=op+1) {
+		Memc[op] = ch
+		if (ch == EOF || ch == '\n' || op-lbuf >= SZ_LINE) {
+		    goto errtn_
+		}
+	    }
+	    Memc[op] = EOS
+
+	    ip = lbuf
+	    while (tty_extract_alias (Memc, ip, Memc[alias], SZ_FNAME) > 0) {
+		if (device[1] == EOS || streq (Memc[alias], device)) {
+		    device_found = true
+		    break
+		} else if (Memc[ip] == '|')
+		    ip = ip + 1				# skip delimiter
+	    }
+
+	    # Skip rest of line if no match.
+	    if (!device_found) {
+		if (getline (fd, Memc[lbuf]) == EOF) {
+		    goto errtn_
+		}
+	    }
+	} until (device_found)
+
+	# Caplist begins at first ':'.  Each line has some whitespace at the
+	# beginning which should be skipped.  Escaped newline implies
+	# continuation.
+
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	op = caplist + T_OP(tty) - 1
+	otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR) - 1
+
+	# We are already positioned to the start of the caplist.
+	Memc[op] = ':'
+	op = op + 1
+	lastch = ':'
+
+	# Extract newline terminated caplist string.
+	while (getc (fd, ch) != EOF) {
+	    if (ch == '\\') {				# escaped newline?
+		if (getc (fd, ch) == '\n') {
+		    while (getc (fd, ch) != EOF)
+			if (!IS_WHITE(ch))
+			    break
+		    if (ch == EOF || ch == '\n')
+			goto errtn_
+		    # Avoid null entries ("::").
+		    if (ch == ':' && lastch == ':')
+			next
+		    else
+			Memc[op] = ch
+		} else {				# no, keep both chars
+		    Memc[op] = '\\'
+		    op = op + 1
+		    Memc[op] = ch
+		}
+	    } else if (ch == '\n') {			# normal exit
+		Memc[op] = EOS
+		T_OP(tty) = op - caplist + 1
+		T_CAPLEN(tty) = T_OP(tty)
+		call sfree (sp)
+		return
+	    } else
+		Memc[op] = ch
+
+	    # Increase size of buffer if necessary.  Note that realloc may 
+	    # move the buffer, so we must recalculate op and otop.
+
+	    lastch = ch
+	    op = op + 1
+	    if (op >= otop) {
+		T_OP(tty) = op - caplist + 1
+		T_LEN(tty) = T_LEN(tty) + T_MEMINCR
+		call realloc (tty, T_LEN(tty), TY_STRUCT)
+		op = caplist + T_OP(tty) - 1
+		otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR) - 1
+	    }
+	}
+
+errtn_
+ 	call sfree (sp)
+	call syserrs (SYS_TTYDEVNF, device)
+end
+
+
+# TTY_EXTRACT_ALIAS -- Extract a device alias string from the header of
+# a termcap entry.  The alias string is terminated by '|' or ':'.  Leave
+# ip pointing at the delimiter.  Return number of chars in alias string.
+
+int procedure tty_extract_alias (str, ip, outstr, maxch)
+
+char	str[ARB]		# first line of termcap entry
+int	ip			# on input, first char of alias
+char	outstr[ARB]
+int	maxch
+
+char	ch
+int	op
+
+begin
+	op = 1
+	for (ch=str[ip];  ch != '|' && ch != ':' && ch != EOS;  ch=str[ip]) {
+	    outstr[op] = ch
+	    op = min (maxch, op) + 1
+	    ip = ip + 1
+	}
+	outstr[op] = EOS
+
+	if (ch == EOS)
+	    return (0)
+	else
+	    return (op-1)
+end
diff --git a/sys/tty/ttyputl.x b/sys/tty/ttyputl.x
new file mode 100644
index 00000000..1510168c
--- /dev/null
+++ b/sys/tty/ttyputl.x
@@ -0,0 +1,322 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	"tty.h"
+
+.help ttyputline
+.nf ___________________________________________________________________________
+TTYPUTLINE -- Put a line to a tty device, processing any special control codes
+therein.  We are concerned with formfeeds, tabs, and standout mode.  Formfeeds
+are dealt with by sending the ff capability, if defined for the device (FF is
+sent if there is no ff entry).  Tabs are expanded if the device does not have
+hardware tabs; if tabs are not expanded, the ta capability is sent to the device
+for each tab (HT is sent if there is no ta string).
+
+Standout mode is more complex.  We distinguish between four types of devices
+for standout mode control (presented in order of desirability):
+
+    (1)	[SOSE] Device has so/se.  Map SO, SE chars in input stream into so/se
+	sequences.
+
+    (2)	[BSOS] Device can backspace and overstrike.  Backspace each printable
+	char in standout mode and overstrike with the underscore character.
+
+    (3) [CROS] Device cannot backspace, but can overstrike.  Follow the output
+	line with a CR and then a line consisting only of spaces and
+	underscores.
+
+    (4) [TOUP] No conventional way to generate standout mode for device.
+	Map alpha chars to upper case to make them standout.
+
+Long lines are automatically broken at the right margin.
+.endhelp ______________________________________________________________________
+
+
+procedure ttyputline (fd, tty, text, map_cc)
+
+int	fd			# output file
+pointer	tty			# TTY descriptor
+char	text[ARB]		# line of text to be output
+int	map_cc			# enable mapping of SO, SE control chars
+
+char	obuf[SZ_LINE]
+int	ip, op, pos, col, maxcols, tabstop, tabchar, ch
+errchk	write
+define	hardcase_ 91
+
+begin
+	maxcols = min (SZ_LINE, T_NCOLS(tty))
+	tabchar = T_TABCHAR(tty)
+	pos	= 1
+	col	= 1
+	op	= 1
+
+	# Optimize the special case of a line less than the maximum length
+	# which contains no special control characters.  As long as this is
+	# handled efficiently, the rest doesn't matter.
+
+	for (pos=1;  text[pos] != EOS;  pos=pos+1) {
+	    do ip = pos, ARB {
+		ch = text[ip]
+
+		if (ch >= ' ') {
+		    # Ordinary printable character; the most common case.
+		    obuf[op] = ch
+		    op  = op + 1
+		    col = col + 1
+
+		    # If col > maxcols then we have completely filled the
+		    # output line.  If there is more text to come we must
+		    # break the line.  If the next character is newline we
+		    # may also break the line and discard the newline.
+
+		    if (col > maxcols && text[ip+1] != EOS) {
+			if (T_AM(tty) == NO) {
+			    obuf[op] = '\n'
+			    op = op + 1
+			}
+			pos = ip
+			if (text[ip+1] == '\n')
+			    pos = pos + 1
+			break
+		    }
+
+		} else if (ch == '\n') {
+		    # End of line.
+		    obuf[op] = ch
+		    op  = op + 1
+		    pos = ip
+		    break
+
+		} else if (ch == '\t') {
+		    # Tab.
+		    tabstop = min (maxcols, ((col-1) / 8 + 1) * 8 + 1)
+		    if (tabchar != 0) {
+			obuf[op] = tabchar
+			op  = op + 1
+			col = tabstop
+		    } else {
+			while (col < tabstop) {
+			    obuf[op] = ' '
+			    op  = op + 1
+			    col = col + 1
+			}
+		    }
+
+		} else if (ch == EOS) {
+		    pos = ip - 1
+		    break
+
+		} else
+		    goto hardcase_
+	    }
+
+	    if (op > 1)
+		call write (fd, obuf, op - 1)
+
+	    op  = 1
+	    col = 1
+	}
+
+	return
+
+hardcase_
+	# Special processsing is needed.
+	call ttygputline (fd, tty, text, map_cc)
+end
+
+
+# TTYGPUTLINE -- This is the original ttypuline.  The code is not very
+# efficient, but it handles formfeeds, standout mode, etc. in a generalized
+# fashion.
+
+procedure ttygputline (fd, tty, text, map_cc)
+
+int	fd			# output file
+pointer	tty			# TTY descriptor
+char	text[ARB]		# line of text to be output
+int	map_cc			# enable mapping of SO, SE control chars
+
+pointer	sp, ostrike, op
+bool	so_seen, so_mode_in_effect
+int	ip, so_type, ocol, junk, ch, tabchar
+int	ttyctrl()
+errchk	tty_break_line, putci, ttyctrl, ttyso
+
+begin
+	call smark (sp)
+	call salloc (ostrike, SZ_LINE, TY_CHAR)
+
+	so_mode_in_effect = false
+	so_type = T_SOTYPE(tty)
+	tabchar = T_TABCHAR(tty)
+	so_seen = false
+	ocol	= 1
+	op	= ostrike
+
+	# Process the input line, mapping all known sequences.  Other control
+	# chars are passed on without modification.  The input line should be
+	# an entire line, or CROS mode will not work correctly.  Lines longer
+	# than T_NCOLS are broken at the right margin.
+
+	for (ip=1;  text[ip] != EOS;  ip=ip+1) {
+	    ch = text[ip]
+
+	    # Break line if newline seen or at right margin.
+	    if (ch == '\n' || ocol > T_NCOLS(tty)) {
+		call tty_break_line (fd, tty, ostrike, op, so_type, so_seen)
+		so_mode_in_effect = false
+		ocol = 1
+
+		# Output a newline if short line or the terminal does not
+		# have automargins.
+
+		if (ocol < T_NCOLS(tty) || T_AM(tty) == NO)
+		    call putci (fd, '\n')
+
+		# Fall through and output ch if ch was not newline.
+		if (ch == '\n')
+		    next
+	    }
+
+	    # Deal with common printable characters.  If standout mode is
+	    # in effect, we must take special actions to make the char
+	    # stand out if the terminal does not have the so/se capability.
+	    # Note that blanks may be made to standout; if this is not
+	    # desired, the high level code must turn standout mode on and off.
+
+	    if (ch >= BLANK) {
+		if (so_type != SOSE)
+		    switch (so_type) {
+		    case BSOS:
+			if (so_mode_in_effect) {
+			    call putci (fd, '_')
+			    if (T_BSOK(tty) == YES)
+				call putci (fd, BS)
+			    else
+				junk = ttyctrl (fd, tty, "bc", 1)
+			}
+		    case CROS:
+			if (so_mode_in_effect)
+			    Memc[op] = '_'
+			else
+			    Memc[op] = BLANK
+			op = op + 1
+		    case TOUP:
+			if (so_mode_in_effect && IS_LOWER(ch))
+			    ch = TO_UPPER (ch)
+		    }
+
+		call putci (fd, ch)
+		ocol = ocol + 1
+		next
+	    }
+
+	    # We get here only if the character is a control character.
+
+	    if (ch == '\t') {
+		# If hardware tab expansion is enabled, use that, otherwise
+		# wait and put out blanks in next block of code.
+
+		if (T_HTOK(tty) == YES) {
+		    call putci (fd, tabchar)
+		    if (so_type == CROS) {
+			Memc[op] = '\t'
+			op = op + 1
+		    }
+		}
+
+		# Keep track of virtual output column, also output blanks to
+		# expand tab if hardware expansion is disabled.
+
+		repeat {
+		    if (T_HTOK(tty) != YES) {
+			call putci (fd, BLANK)
+			if (so_type == CROS) {
+			    Memc[op] = BLANK
+			    op = op + 1
+			}
+		    }
+		    ocol = ocol + 1
+		} until (mod (ocol+TABSIZE-1, TABSIZE) == 0)
+
+	    } else if (ch == FF) {
+		# Formfeed breaks the output line if not at beginning of a
+		# line.
+
+		if (ocol > 1) {
+		    call tty_break_line (fd, tty, ostrike, op, so_type, so_seen)
+		    if (ocol < T_NCOLS(tty) || T_AM(tty) == NO)
+			call putci (fd, '\n')
+		}
+		if (ttyctrl (fd, tty, "ff", T_NLINES(tty)) == ERR)
+		    call putci (fd, FF)
+		ocol = 1
+		so_mode_in_effect = false
+
+	    } else if (ch == SO_ON) {
+		# Begin standout mode.
+		if (so_type == SOSE)
+		    call ttyso (fd, tty, YES)
+		so_mode_in_effect = true
+		so_seen = true
+
+	    } else if (ch == SO_OFF) {
+		# End standout mode.
+		if (so_type == SOSE)
+		    call ttyso (fd, tty, NO)
+		so_mode_in_effect = false
+
+	    } else {
+		# Unknown control character.  Do not increment ocol.
+		if (map_cc == YES) {
+		    call putci (fd, '^')
+		    call putci (fd, ch + 'A' - 1)
+		} else
+		    call putci (fd, ch)
+	    }
+	}
+
+	# If EOS is seen, but not newline, do not issue a newline, but do
+	# ignore contents of overstrike buffer.  Thus, we can be used to output
+	# portions of a line on non-CROS terminals.
+
+	call sfree (sp)
+end
+
+
+# TTY_BREAK_LINE -- Break the output line.  If overstrike is selected,
+# overstrike output line with the ostrike line.  We assume that OP is
+# valid only if so_type is CROS.  Note that OP and SO_SEEN are reset.
+
+procedure tty_break_line (fd, tty, ostrike, op, so_type, so_seen)
+
+int	fd
+pointer	tty, ostrike, op
+int	so_type
+bool	so_seen
+
+int	ch
+pointer	ip
+
+begin
+	# If carriage return, overstrike is enabled and the line had a standout
+	# mode directive, output the overstrike line.
+
+	if (so_type == CROS && so_seen) {
+	    call putci (fd, '\r')
+	    Memc[op] = EOS
+
+	    # Output overstrike line.
+	    for (ip=ostrike;  Memc[ip] != EOS;  ip=ip+1) {
+		ch = Memc[ip]
+		if (ch == '\t')
+		    ch = T_TABCHAR(tty)
+		call putci (fd, ch)
+	    }
+	}
+
+	op = ostrike
+	so_seen = false
+end
diff --git a/sys/tty/ttyputs.x b/sys/tty/ttyputs.x
new file mode 100644
index 00000000..aeec99ef
--- /dev/null
+++ b/sys/tty/ttyputs.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYPUTS -- Put an EOS delimited  control string to the output file.
+
+procedure ttyputs (fd, tty, ctrlstr, afflncnt)
+
+int	fd			# output file
+pointer	tty			# terminal descriptor
+char	ctrlstr[ARB]		# control sequence to be output
+int	afflncnt		# number of lines affected
+int	strlen()
+
+begin
+	call ttywrite (fd, tty, ctrlstr, strlen(ctrlstr), afflncnt)
+end
diff --git a/sys/tty/ttyread.x b/sys/tty/ttyread.x
new file mode 100644
index 00000000..7ead64a3
--- /dev/null
+++ b/sys/tty/ttyread.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	<fset.h>
+
+define	PAUSE		20	# pause if no data, msec
+
+
+# TTYREAD -- Read from the terminal in raw mode until sufficient data is
+# accumulated to match the given encoded pattern.  Any additional data read
+# prior to the matched pattern (normally due to type-ahead) is pushed back
+# into the input stream.  If timeout > 0 nonblocking reads are used, and
+# the operation will time out if the pattern is not matched within the given
+# interval in milliseconds.  A valid read returns nchars > 0 indicating the
+# length of the matched pattern; 0 is returned for a timeout and ERR for a
+# garbled read.
+
+int procedure ttyread (fd, tty, outbuf, maxch, patbuf, timeout)
+
+int	fd			# output file
+pointer	tty			# terminal descriptor
+char	outbuf[maxch]		# output data buffer
+int	maxch			# max chars out
+char	patbuf[ARB]		# encoded pattern
+int	timeout			# timeout interval, msec (0 for no timeout)
+
+bool	match
+pointer	sp, ip, op, buf
+int	sv_iomode, iomode, delay, first, last, nchars, ch
+int	fstati(), patmatch(), gpatmatch(), getci(), gstrcpy()
+errchk	getci, unread
+define	abort_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Save raw mode state and set up for nonblocking raw mode reads
+	# if a timeout interval was specified.
+
+	iomode = IO_RAW
+	if (timeout > 0)
+	    iomode = iomode + IO_NDELAY
+
+	sv_iomode = fstati (fd, F_IOMODE)
+	if (sv_iomode != iomode)
+	    call fseti (fd, F_IOMODE, iomode)
+
+	outbuf[1] = EOS
+	match = false
+	nchars = 0
+	delay = 0
+	op = buf
+
+	# Accumulate input characters in nonblocking raw mode until either
+	# the given pattern is matched, or we timeout.
+
+	repeat {
+	    # Read characters until the full sequence has been input or no
+	    # more data is available.
+
+	    while (!match && (op-buf < SZ_LINE) && getci(fd, ch) != EOF) {
+		if (ch==INTCHAR || ch==EOFCHAR || ch == '\r' || ch == '\n') {
+		    nchars = ERR
+		    goto abort_
+		}
+
+		Memc[op] = ch;  op = op + 1
+		Memc[op] = EOS
+		match = (gpatmatch (Memc[buf], patbuf, first, last) > 0)
+
+		if (match) {
+		    ip = buf + first - 1
+		    if (first > 1) {
+			# Put back any input typed before our data block.
+			call unread (fd, Memc[buf], first-1)
+
+			# Redo the match to correct index marks for string
+			# offset.
+			match = (patmatch (Memc[ip], patbuf) > 0)
+		    }
+		    nchars = gstrcpy (Memc[ip], outbuf, maxch)
+		}
+	    }
+
+	    # If the nonblocking read returns EOF, indicating no input was
+	    # queued, wait a bit and try again.
+
+	    if (!match && ch == EOF) {
+		call zwmsec (PAUSE)
+		delay = delay + PAUSE
+	    }
+	} until (match || delay > timeout)
+
+abort_
+	# Restore previous raw mode state.
+	if (sv_iomode != iomode)
+	    call fseti (fd, F_IOMODE, sv_iomode)
+
+	call sfree (sp)
+	return (nchars)
+end
diff --git a/sys/tty/ttyseti.x b/sys/tty/ttyseti.x
new file mode 100644
index 00000000..18493766
--- /dev/null
+++ b/sys/tty/ttyseti.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<chars.h>
+include	<ttyset.h>
+include	"tty.h"
+
+# TTYSETI -- Set a TTY parameter.  Can be used after a ttyodes to override
+# termcap and environment parameters affecting terminal control.
+
+procedure ttyseti (tty, parameter, value)
+
+pointer	tty
+int	parameter, value
+char	parnum[3]
+int	junk, itoc()
+
+begin
+	switch (parameter) {
+	case TTY_PADCHAR:
+	    T_PADCHAR(tty) = value
+	case TTY_TABS:
+	    T_HTOK(tty) = value
+	case TTY_SOTYPE:
+	    T_SOTYPE(tty) = value
+	case TTY_BAUD:
+	    T_BAUD(tty) = value
+	case TTY_NLINES:
+	    T_NLINES(tty) = value
+	case TTY_NCOLS:
+	    T_NCOLS(tty) = value
+	default:
+	    junk = itoc (parameter, parnum, 3)
+	    call syserrs (SYS_TTYSET, parnum)
+	}
+end
diff --git a/sys/tty/ttyso.x b/sys/tty/ttyso.x
new file mode 100644
index 00000000..e03de838
--- /dev/null
+++ b/sys/tty/ttyso.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# TTYSO -- Turn "standout" mode on or off.
+
+procedure ttyso (fd, tty, onflag)
+
+int	fd, onflag
+pointer	tty
+
+char	cap[2]
+bool	ttygetb()
+int	junk, ttyctrl()
+errchk	ttygetb
+
+begin
+	# Select name of capability (so, se, us, ue).  Use so/se if it is
+	# available for the terminal, otherwise try us/ue.
+	if (ttygetb (tty, "so")) {
+	    cap[1] = 's'
+	    cap[2] = 'o'
+	} else {
+	    cap[1] = 'u'
+	    cap[2] = 's'
+	}
+	if (onflag == NO)
+	    cap[2] = 'e'
+	cap[3] = EOS
+
+	# Output the control sequence.  If cap is not available for the
+	# terminal, nothing will be output.
+	junk = ttyctrl (fd, tty, cap, 1)
+end
diff --git a/sys/tty/ttystati.x b/sys/tty/ttystati.x
new file mode 100644
index 00000000..52578fba
--- /dev/null
+++ b/sys/tty/ttystati.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<chars.h>
+include	<ttyset.h>
+include	"tty.h"
+
+# TTYSTATI -- Fetch a TTY parameter.
+
+int procedure ttystati (tty, parameter)
+
+pointer	tty
+int	parameter
+char	parnum[3]
+int	value, junk, itoc()
+
+begin
+	switch (parameter) {
+	case TTY_PADCHAR:
+	    value = T_PADCHAR(tty)
+	case TTY_TABS:
+	    value = T_HTOK(tty)
+	case TTY_SOTYPE:
+	    value = T_SOTYPE(tty)
+	case TTY_BAUD:
+	    value = T_BAUD(tty)
+	case TTY_NLINES:
+	    value = T_NLINES(tty)
+	case TTY_NCOLS:
+	    value = T_NCOLS(tty)
+	default:
+	    junk = itoc (parameter, parnum, 3)
+	    call syserrs (SYS_TTYSTAT, parnum)
+	}
+
+	return (value)
+end
diff --git a/sys/tty/ttysubi.x b/sys/tty/ttysubi.x
new file mode 100644
index 00000000..870dce59
--- /dev/null
+++ b/sys/tty/ttysubi.x
@@ -0,0 +1,194 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+include	<ctype.h>
+include	"tty.h"
+
+.help ttysubi
+.nf ___________________________________________________________________________
+TTYSUBI -- Argument substitution on a control string.
+
+    Process a capability string containing arguments.  Examples of such
+capability strings are cursor motion to [x,y], and set scrolling region to
+[line1,line2].  Note that arguments in the termcap database are zero-indexed
+by default, while the TTYSUBI arguments are one-indexed.  The control string
+given as input has already been processed to reduce all escape sequences to
+single characters.
+
+Various output formats are supported (some of these are completely off the
+wall, very special case, but that's how termcap does it):
+
+	%d	print decimal integer, zero origin.
+	%2	like %2d.
+	%3	like %3d.
+	%.	put binary value of x,y arg as a character
+	%+x	like %., but add value of char X first
+	%%	print a single %.
+
+The following format codes affect the arguments, but do not directly cause
+any output:
+
+	%>xy	if next arg value > char x add char y.
+	%r	reverses order of arguments.
+	%i	increments arg values by one, for 1 origin.
+	%n	exlusive-or args with 0140B. (DM2500)
+	%B	BCD next arg, (16*(x/10))+(mod(x,10).
+	%D	Reverse coding (x-2*(mod(x,16))). (Delta Data)
+
+We have generalized the termcap formats somewhat to permit a greater range
+of %n formats (%1-%4), as well as %o and %x formats, in case a terminal
+comes along which likes octal or hex numbers.
+
+The %. format causes special problems.  If the terminal requires coordinates
+in binary in the range zero or one to 40B, we can expect problems trying to
+push such chars through the OS driver and any other software (networks, etc.),
+since system software likes to map control characters on output.  To get around
+this we have defined a set of reserved codes which are not to be generated.
+This set is defined in tty.h, and includes newline, tab, etc.  When asked to
+output one of these chars, we output a char with a somewhat larger value
+and return the delta to our caller, which does whatever is appropriate to
+complete the function.
+.endhelp ______________________________________________________________________
+
+int procedure ttysubi (ctrlstr, outstr, maxch, coords, ncoords)
+
+char	ctrlstr[ARB]		# control string containing % formats
+char	outstr[ARB]		# receives processed string
+int	maxch
+int	coords[ncoords]		# on input, coords; on output, deltas
+int	ncoords
+
+bool	reverse			# reverse deltas on output
+int	revstart		# first arg/coord reversed
+int	args[MAX_COORDS]	# processed values of arguments
+int	argnum			# arg being processed
+int	nargs			# number of args (min(MAX_COORDS,ncoords))
+char	driver_chars[NDCHARS]
+char	ch, format_char
+int	i, ip, op, field_width, left, right, temp
+int	stridx(), strlen(), xor()
+data	driver_chars /DRIVER_CHARS/
+errchk	sprintf, pargi
+
+begin
+	# Make a local copy of the arguments to make reversal etc. easy.
+	# Also switch to zero-indexing internally, since the termcap entry
+	# is zero-indexed.
+
+	nargs = min (MAX_COORDS, ncoords)
+	do i = 1, nargs {
+	    args[i] = coords[i] - 1		# make zero-indexed
+	    coords[i] = 0			# init delta
+	}
+	argnum = 1				# output x first by default
+	reverse = false
+
+	op = 1
+	for (ip=1;  ctrlstr[ip] != EOS && op <= maxch;  ip=ip+1) {
+	    ch = ctrlstr[ip]
+
+	    # If normal char, we do not get past this if statement.
+	    if (ch != '%') {
+		outstr[op] = ch
+		op = op + 1
+		next
+	    } else {
+		ip = ip + 1			# fetch format-type char
+		ch = ctrlstr[ip]
+	    }
+
+	    # Get here only if processing a %x format specification.
+	    switch (ch) {
+	    case '%':				# %% --> %
+		outstr[op] = ch
+		op = op + 1
+
+	    case 'd', 'o', 'x', '1', '2', '3', '4':
+		# Output next argument according to the format given.
+		if (IS_DIGIT(ch)) {
+		    field_width = TO_INTEG(ch)
+		    format_char = 'd'
+		} else {
+		    field_width = 0
+		    format_char = ch
+		}
+
+		call sprintf (outstr[op], maxch-op+1, "%0*.0*")
+		    call pargi (field_width)
+		    call pargc (format_char)
+		    call pargi (args[argnum])
+
+		argnum = min (nargs, argnum + 1)
+		op = op + strlen (outstr[op])
+
+	    case '.', '+':
+		# Binary output format.  Coordinate output in binary is a
+		# problem because the OS driver may see a tab, newline, or
+		# whatever and map it into something else.  If the value of
+		# args[argnum] corresponds to a special control character,
+		# we increment it until we have an acceptable value, leaving
+		# it up to our caller to do the rest.
+
+		if (ch == '+') {
+		    ip = ip + 1
+		    args[argnum] = args[argnum] + ctrlstr[ip]
+		}
+
+		repeat {
+		    ch = char (args[argnum])
+		    if (stridx (ch, driver_chars) > 0) {
+			args[argnum] = args[argnum] + 1
+			coords[argnum] = coords[argnum] + 1
+		    } else
+			break
+		}
+
+		outstr[op] = args[argnum]
+		op = op + 1
+		argnum = min (nargs, argnum + 1)
+
+	    # The remaining cases are used to change the values of the
+	    # remaining arguments, and do not cause any output.
+
+	    case '>':					# %>xy
+		if (args[argnum] > ctrlstr[ip+1])
+		    args[argnum] = args[argnum] + ctrlstr[ip+2]
+		ip = ip + 2
+	    case 'r':					# swap remaining args
+		do left = argnum, (nargs - argnum + 1) / 2 {
+		    right = nargs - (left - argnum)
+		    temp = args[left]
+		    args[left] = args[right]
+		    args[right] = temp
+		}
+		reverse = !reverse
+		revstart = argnum
+	    case 'i':					# increment by one
+		do i = argnum, nargs
+		    args[i] = args[i] + 1
+	    case 'n':					# exclusive or with 140B
+		do i = argnum, nargs
+		    args[i] = xor (args[i], 140B)
+	    case 'B':					# BCD encode next arg
+		temp = args[argnum]
+		args[argnum] = 16 * (temp / 10) + mod (temp, 10)
+	    case 'D':					# Reverse code next arg
+		temp = args[argnum]
+		args[argnum] = temp - 2 * mod (temp, 16)
+	    }
+	}
+
+	# If the input coordinates were reversed, we must reverse the
+	# correction deltas, too.
+
+	if (reverse)
+	    do left = revstart, (nargs - revstart + 1) / 2 {
+		right = nargs - (left - revstart)
+		temp = coords[left]
+		coords[left] = coords[right]
+		coords[right] = temp
+	    }
+
+	outstr[op] = EOS
+	return (op - 1)
+end
diff --git a/sys/tty/ttywrite.x b/sys/tty/ttywrite.x
new file mode 100644
index 00000000..3a581523
--- /dev/null
+++ b/sys/tty/ttywrite.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	"tty.h"
+
+# TTYWRITE -- Put a counted control string to the output file.  The control
+# string consists of an optional prefix specifying the delay required, followed
+# by the chars to be sent to the terminal.  If the delay is given as a simple
+# integer number (i.e., ":cl=50\E"), it specifies the delay in milliseconds.
+# If the delay number is followed by an asterisk (i.e., ":cd=3.5*\E^C:") it
+# specifies the delay in milliseconds per line affected by the operation.
+# In the latter case, the AFFLNCNT argument is used to compute the total
+# delay.  Delays are generated by writing a sequence of pad characters
+# (usually NUL); the number of pad chars sent to achieve a particular delay
+# depends on the baud rate.
+
+procedure ttywrite (fd, tty, ctrlstr, nchars, afflncnt)
+
+int	fd			# output file
+pointer	tty			# terminal descriptor
+char	ctrlstr[ARB]		# control sequence to be output
+int	nchars			# nchars in control string
+int	afflncnt		# number of lines affected
+
+double	dval
+int	ip, delay, junk, ch
+int	ctod(), and()
+errchk	putci
+
+begin
+	# Determine number of milliseconds of delay req'd, and position ip
+	# to start of control string.  Do not use CTOD to test whether or not
+	# the string begins with a number, because it is not permissable to
+	# skip whitespace (blank and tab are legal output chars).
+
+	ip = 1
+	if (IS_DIGIT (ctrlstr[ip])) {
+	    junk = ctod (ctrlstr, ip, dval)
+	    if (ctrlstr[ip] == '*') {
+		delay = dval * afflncnt + 0.5
+		ip = ip + 1
+	    } else
+		delay = dval
+	} else
+	    delay = 0
+
+	# Output the control sequence, passing only the first seven bits of
+	# each character.  This is where the \200 escapes get turned into NULs.
+	# Do not use MOD to do the masking because 200B is a negative integer
+	# if CHAR is implemented as 8 bits.
+
+	for (;  ip <= nchars;  ip=ip+1) {
+	    ch = ctrlstr[ip]
+	    call putci (fd, and (ch, 177B))
+	}
+
+	# Add padding if needed to generate delay.
+	call ttydelay (fd, tty, delay)
+end
diff --git a/sys/tty/x_mkttydata.x b/sys/tty/x_mkttydata.x
new file mode 100644
index 00000000..a48cbca8
--- /dev/null
+++ b/sys/tty/x_mkttydata.x
@@ -0,0 +1,367 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	"tty.h"
+
+task	mkttydata = t_mkttydata
+
+.help mkttydata
+.nf -------------------------------------------------------------------------
+MKTTYDATA -- System Manager's program to compile the TERMCAP entries for a
+list of terminals.  Output is an SPP format include file to be used in TTYLOAD
+to statically declare and initialize the TERMCAP entries for the named
+devices, eliminating the need to scan the TERMCAP file for those devices.
+
+Compilation of selected termcap entries to speed up accesses to the
+termcap database for frequently referenced terminals.  We read and preprocess
+the entries for the named terminals from the termcap file, producing the source
+code for the TTYLOAD procedure as output.  The termcap entry for each device
+is included in the source for TTYLOAD as a static data structure.  TTYLOAD is
+subsequently compiled and placed in the library with the other TTY routines.
+At run time, TTYODES first tries to load the termcap database entry using
+TTYLOAD, and if that fails it goes and reads the termcap file.
+
+N.B.: The TTY interface may be used for any termcap format file, regardless
+of whether or not the database describes terminals.
+.endhelp ---------------------------------------------------------------------
+
+# Tunable parameters.
+
+define	MAX_DEVICES	25		# initial max termcap entries
+define	INC_DEVICES	25		# increment if overflow occurs
+define	SZ_SBUF		4096		# initial size of string buffer
+define	INC_SZSBUF	2048		# increment if overflow occurs
+define	NI_PERLINE	5		# number of datastmt ints per line
+define	NC_PERLINE	8		# number of datastmt chars per line
+
+# Device descriptor structure (contains the extracted termcap entries).
+# There are no upper limits on the number of devices or upon the sizes of
+# any of the substructures.
+
+define	LEN_TCSTRUCT	8
+
+define	TC_NDEVICES	Memi[$1]	# number of termcap entries
+define	TC_MAXDEVICES	Memi[$1+1]	# initial max termcap entries
+define	TC_DEVNAME_P	Memi[$1+2]	# pointer to devname index array
+define	TC_CAPLIST_P	Memi[$1+3]	# pointer to caplist index array
+define	TC_SBUF		Memi[$1+4]	# pointer to string buffer
+define	TC_SZSBUF	Memi[$1+5]	# current size of string buffer
+define	TC_NEXTCH	Memi[$1+6]	# offset of next avail char in sbuf
+define	TC_TCFNAME	Memi[$1+7]	# name of termcap file
+
+define	TC_DEVNAME	Memi[TC_DEVNAME_P($1)+$2-1]
+define	TC_CAPLIST	Memi[TC_CAPLIST_P($1)+$2-1]
+
+# MKTTYDATA -- Given the name of a termcap format file and a list of device
+# names, call TTYOPEN to fetch the termcap entry of the device.
+# Move the entry for the device into the dev structure and continue until
+# the entries for all devices have been read.  Write out the source code for
+# the data structures of these devices.  This output file is "included"
+# when TTYLOAD is later compiled, cacheing the termcap entries for the
+# named devices in memory.
+
+procedure t_mkttydata()
+
+bool	verbose
+int	devlist, fd, ndev, buflen
+pointer	sp, termcap_file, output_file, devname, tc, tty
+bool	clgetb()
+int	clpopnu(), clgfil(), tc_putstr(), open(), tc_dummy_ttyload()
+pointer	ttyopen()
+extern	tc_dummy_ttyload()
+errchk	open, tc_write_data_declarations, clgfil, tc_putstr, malloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (termcap_file, SZ_FNAME, TY_CHAR)
+	call salloc (output_file, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (tc, LEN_TCSTRUCT, TY_STRUCT)
+
+	# Open the list of devices to be compiled into the cache.  CLGFIL is
+	# useful for reading the list even though the list elements are not
+	# filenames, because it can expand comma a delimited list passed as
+	# a string as well as read from a list file.  The list is not sorted
+	# so that the caller can order the devices in the order in which they
+	# will most frequently be referenced (though really it matters little).
+	# Get the names of the input and output files.
+
+	devlist = clpopnu ("devlist")
+	call clgstr ("termcap_file", Memc[termcap_file], SZ_FNAME)
+	call clgstr ("output_file",  Memc[output_file],  SZ_FNAME)
+	verbose = clgetb ("verbose")
+
+	# Initialize the TC descriptor structure. Allocate the variable sized
+	# buffers.
+
+	ndev   = 0
+	buflen = MAX_DEVICES
+
+	TC_NDEVICES(tc)   = 0
+	TC_MAXDEVICES(tc) = MAX_DEVICES
+	TC_SZSBUF(tc)     = SZ_SBUF
+	TC_NEXTCH(tc)     = 0
+
+	iferr {
+	    call malloc (TC_DEVNAME_P(tc), buflen, TY_INT)
+	    call malloc (TC_CAPLIST_P(tc), buflen, TY_INT)
+	    call malloc (TC_SBUF(tc), SZ_SBUF, TY_CHAR)
+	} then
+	    call erract (EA_FATAL)
+
+	# Store the name of the termcap file in the descriptor.  The descriptor
+	# is only valid if TTYLOAD is called with the exact same filename.
+
+	TC_TCFNAME(tc) = tc_putstr (tc, Memc[termcap_file])
+
+	# Fetch the termcap entry for each device in the list.  This is not
+	# done very efficiently, but it does not matter since this program
+	# is infrequently run.  Accumulate the entries in the TC structure.
+
+	while (clgfil (devlist, Memc[devname], SZ_FNAME) != EOF) {
+	    # Fetch entry from termcap file.
+
+	    iferr (tty = ttyopen (Memc[termcap_file], Memc[devname],
+		tc_dummy_ttyload)) {
+
+		call erract (EA_WARN)
+		next
+
+	    } else if (verbose) {
+		call eprintf ("%4d %s: %d chars\n")
+		    call pargi (ndev + 1)
+		    call pargstr (Memc[devname])
+		    call pargi (T_CAPLEN(tty))
+	    }
+
+	    ndev = ndev + 1
+	    TC_NDEVICES(tc) = ndev
+
+	    # Make room for more devices if necessary.
+	    if (ndev > TC_MAXDEVICES(tc)) {
+		TC_MAXDEVICES(tc) = TC_MAXDEVICES(tc) + INC_DEVICES
+		buflen = TC_MAXDEVICES(tc)
+		iferr {
+		    call realloc (TC_DEVNAME_P(tc), buflen, TY_INT)
+		    call realloc (TC_CAPLIST_P(tc), buflen, TY_INT)
+		} then
+		    call erract (EA_FATAL)
+	    }
+
+	    # Add entry to descriptor.
+	    TC_DEVNAME(tc,ndev) = tc_putstr (tc, Memc[devname])
+	    TC_CAPLIST(tc,ndev) = tc_putstr (tc, T_CAPLIST(tty))
+
+	    call ttyclose (tty)
+	}
+
+	call clpcls (devlist)
+
+	# Write the output file (an SPP "include" file) containing data
+	# declarations for the data structures in the TC structure.
+
+	iferr (call delete (Memc[output_file]))
+	    ;
+	fd = open (Memc[output_file], NEW_FILE, TEXT_FILE)
+	call tc_write_data_declarations (fd, tc, Memc[termcap_file])
+	call close (fd)
+
+	call mfree (TC_DEVNAME_P(tc), TY_INT)
+	call mfree (TC_CAPLIST_P(tc), TY_INT)
+	call mfree (TC_SBUF(tc), TY_CHAR)
+	call sfree (sp)
+end
+
+
+# TC_PUTSTR -- Put a string (incl EOS) in the string buffer at nextch.
+# If there is not enough space in the buffer, reallocate a larger buffer.
+# Return the index of the string in the string buffer.
+
+int procedure tc_putstr (tc, str)
+
+pointer	tc
+char	str[ARB]
+int	nextch, nchars, strlen()
+errchk	realloc
+
+begin
+	# Null strings are not stored and cause a null index to be returned.
+	nchars = strlen (str)
+	if (nchars == 0)
+	    return (0)
+
+	nextch = TC_NEXTCH(tc)
+	if (nextch + nchars + 1 > TC_SZSBUF(tc)) {
+	    TC_SZSBUF(tc) = TC_SZSBUF(tc) + INC_SZSBUF
+	    call realloc (TC_SBUF(tc), TC_SZSBUF(tc), TY_CHAR)
+	}
+
+	call strcpy (str, Memc[TC_SBUF(tc) + nextch], ARB)
+	TC_NEXTCH(tc) = nextch + nchars + 1
+
+	return (nextch)
+end
+
+
+# TC_WRITE_DATA_DECLARATIONS -- Write the SPP data declarations required to
+# declare and initialize the following data structures:
+#
+#	int	ndevices	# number of devices in cache
+#	int	devname[]	# 0-indexed offset into sbuf of device name
+#	int	devcaps[]	# 0-indexed offset into sbuf of termcap entry
+#	char	sbuf[]		# string buffer
+
+procedure tc_write_data_declarations (fd, tc, termcap_file)
+
+int	fd			# output file
+pointer	tc			# TC descriptor
+char	termcap_file[ARB]	# name of source file
+
+int	ndevices, dev
+pointer	sbuf
+int	strlen()
+
+begin
+	ndevices = TC_NDEVICES(tc)
+	sbuf = TC_SBUF(tc)
+
+	# Write a comments section naming the devices represented by the
+	# data declarations which follow.
+
+	call fprintf (fd,
+	    "# TERMCAP data declarations for %d devices from '%s'\n")
+	    call pargi (TC_NDEVICES(tc))
+	    call pargstr (termcap_file)
+
+	do dev = 1, ndevices {
+	    call fprintf (fd, "#%15s (size %d+1 chars)\n")
+		call pargstr (Memc[sbuf+TC_DEVNAME(tc,dev)])
+		call pargi (strlen (Memc[sbuf+TC_CAPLIST(tc,dev)]))
+	}
+
+	# Output the object declarations.
+
+	call fprintf (fd, "\n")
+	call fprintf (fd, "int\ttermcap_filename, ndevices, i\n")
+	call fprintf (fd, "int\tdevname[%d], devcaps[%d]\n")
+	    call pargi (ndevices)
+	    call pargi (ndevices)
+	
+	# Do not add 1 char for the EOS; SPP compiler automatically does so.
+	call fprintf (fd, "char\tsbuf[%d]\n")
+	    call pargi (TC_NEXTCH(tc))
+
+	# Output the data initialization declarations.
+
+	call fprintf (fd, "\n")
+	call fprintf (fd, "data\tndevices /%d/\n")
+	    call pargi (ndevices)
+	call fprintf (fd, "data\ttermcap_filename /%d/\n")
+	    call pargi (TC_TCFNAME(tc) + 1)
+
+	call tc_init_datai (fd, "devname", Memi[TC_DEVNAME_P(tc)], ndevices)
+	call tc_init_datai (fd, "devcaps", Memi[TC_CAPLIST_P(tc)], ndevices)
+	call fprintf (fd, "\n")
+	call tc_init_datac (fd, "sbuf",    Memc[TC_SBUF(tc)], TC_NEXTCH(tc)+1)
+end
+
+
+# TC_INIT_DATAI -- Write a series of data statements to initialize an
+# integer array.  A single large statement is not used due to variation
+# in the permissible number of continuation statements permitted by
+# different compilers.
+
+procedure tc_init_datai (fd, varname, array, npix)
+
+int	fd		# output file
+char	varname[ARB]	# name of variable to be initialized
+int	array[npix]	# array values
+int	npix
+
+int	i, j, i1, i2
+
+begin
+	for (j=1;  j <= npix;  j = j + NI_PERLINE) {
+	    i1 = j
+	    i2 = min (j + NI_PERLINE - 1, npix)
+
+	    # Begin new data statement.
+	    call fprintf (fd, "data\t(%s(i),i=%2d,%2d)\t/")
+		call pargstr (varname)
+		call pargi (i1)
+		call pargi (i2)
+
+	    # Output data values.  NOTE: the TC_SBUF offsets are zero-indexed
+	    # offsets into Mem, but the SBUF array in the include file is a
+	    # static Fortran array which requires 1-indexed offsets, so we
+	    # add one before writing out the offsets.
+
+	    for (i=i1;  i <= i2;  i=i+1) {
+		if (i > i1)
+		    call fprintf (fd, ", ")
+		call fprintf (fd, "%d")
+		    call pargi (array[i] + 1)
+	    }
+
+	    # Terminate statement.
+	    call fprintf (fd, "/\n")
+	}
+end
+
+
+# TC_INIT_DATAC -- Write a series of data statements to initialize a
+# char array.  A single large statement is not used due to variation
+# in the permissible number of continuation statements permitted by
+# different compilers.
+
+procedure tc_init_datac (fd, varname, str, nchars)
+
+int	fd			# output file
+char	varname[ARB]		# name of variable to be initialized
+char	str[nchars]		# array values
+int	nchars
+
+int	i, j, i1, i2
+
+begin
+	for (j=1;  j <= nchars;  j = j + NC_PERLINE) {
+	    i1 = j
+	    i2 = min (j + NC_PERLINE - 1, nchars)
+
+	    # Begin new data statement.
+	    call fprintf (fd, "data\t(%s(i),i=%2d,%2d)\t/")
+		call pargstr (varname)
+		call pargi (i1)
+		call pargi (i2)
+
+	    # Output data values.
+	    for (i=i1;  i <= i2;  i=i+1) {
+		if (i > i1)
+		    call fprintf (fd, ", ")
+		call fprintf (fd, "%3d")
+		    call pargc (str[i])
+	    }
+
+	    # Terminate statement.
+	    call fprintf (fd, "/\n")
+	}
+end
+
+
+# TC_DUMMY_TTYLOAD -- Since we are rebuilding a TTYLOAD, we cannot pass
+# a real one to TTYOPEN.  This dummy procedure returns 0 to TTYOPEN for
+# all devices, forcing TTYOPEN to open and scan the termcap file to fetch
+# the termcap entry for a device.
+
+int procedure tc_dummy_ttyload (termcap_file, devname, outstr, maxch)
+
+char	termcap_file[ARB]
+char	devname[ARB]
+char	outstr[maxch]
+int	maxch
+
+begin
+	outstr[1] = EOS
+	return (0)
+end
diff --git a/sys/tty/zzdebug.x b/sys/tty/zzdebug.x
new file mode 100644
index 00000000..f28b1714
--- /dev/null
+++ b/sys/tty/zzdebug.x
@@ -0,0 +1,184 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<ttyset.h>
+include	"tty.h"
+
+# Debug TTY package.
+
+task	find=t_find, cap=t_cap, init=t_init
+
+define	SZ_CAPSTR	30
+define	FAKE_PADCHAR	177B
+
+
+# FIND -- Find an entry in the termcap database, and print out the caplist
+# string.
+
+procedure t_find()
+
+char	ttyname[SZ_FNAME]
+pointer	tty, ttygdes()
+
+begin
+	call clgstr ("ttyname", ttyname, SZ_FNAME)
+	tty = ttygdes (ttyname)
+
+	call printf ("Termcap entry for '%s', %d capabilities\n")
+	    call pargstr (ttyname)
+	    call pargi (T_NCAPS(tty))
+	call printf ("    pc=%oB, bsok=%b, htok=%b, %d by %d, %d baud\n")
+	    call pargi (T_PADCHAR(tty))
+	    call pargi (T_BSOK(tty))
+	    call pargi (T_HTOK(tty))
+	    call pargi (T_NCOLS(tty))
+	    call pargi (T_NLINES(tty))
+	    call pargi (T_BAUD(tty))
+
+	call putline (STDOUT, T_CAPLIST(tty))
+	call putci (STDOUT, '\n')
+	call ttycdes (tty)
+end
+
+
+# CAP -- Open descriptor, then sit in a get/put capability loop.  Capabilities
+# are put to the stdout in a readable form.
+
+procedure t_cap()
+
+char	ttyname[SZ_FNAME], capstr[SZ_CAPSTR]
+char	ctrlstr[SZ_CTRLSTR], tempstr[SZ_CTRLSTR], obuf[SZ_LINE]
+int	fd, args[MAX_COORDS], nargs, nchars
+
+int	stropen(), ttygets(), ttysubi(), clglstr(), strlen(), nscan()
+pointer	tty, ttygdes()
+
+begin
+	call clgstr ("ttyname", ttyname, SZ_FNAME)
+	tty = ttygdes (ttyname)
+	call ttyseti (tty, TTY_PADCHAR, FAKE_PADCHAR)
+
+	call printf ("Termcap entry for '%s', %d capabilities\n")
+	    call pargstr (ttyname)
+	    call pargi (T_NCAPS(tty))
+	call printf ("    pc=%oB, bsok=%b, htok=%b, %d by %d, %d baud\n")
+	    call pargi (T_PADCHAR(tty))
+	    call pargi (T_BSOK(tty))
+	    call pargi (T_HTOK(tty))
+	    call pargi (T_NCOLS(tty))
+	    call pargi (T_NLINES(tty))
+	    call pargi (T_BAUD(tty))
+
+	while (clglstr ("cap", capstr, SZ_CAPSTR) != EOF)
+	    if (ttygets (tty, capstr, ctrlstr, SZ_CTRLSTR) == 0) {
+		call printf ("capability '%s' not found\n")
+		    call pargstr (capstr)
+	    } else {
+		fd = stropen (obuf, SZ_LINE, NEW_FILE)
+
+		# Expand args? (as in "cap: cm 11 4")
+		if (strlen (capstr) > 2) {
+		    call sscan (capstr[3])
+		    for (nargs=0;  nscan() == nargs;  nargs=nargs+1)
+			call gargi (args[nargs+1])
+		    nargs = nargs - 1
+		    call strcpy (ctrlstr, tempstr, SZ_CTRLSTR)
+		    nchars = ttysubi (tempstr, ctrlstr,SZ_CTRLSTR, args,nargs)
+		} else
+		    nargs = 0
+
+		call ttyputs (fd, tty, ctrlstr, 1)
+		if (nargs > 0 && args[1] != 0 || args[2] != 0) {
+		    call fprintf (fd, " residual x=%d, y=%d")
+			call pargi (args[1])
+			call pargi (args[2])
+		}
+		call close (fd)
+		call dump_chars (STDOUT, obuf)
+	    }
+	call putci (STDOUT, '\n')
+		
+	call ttycdes (tty)
+end
+
+
+# INIT -- Output initialization string in human readable form on the standard
+# output.
+
+define	SZ_OBUF		1024
+
+
+procedure t_init()
+
+char	ttyname[SZ_FNAME]
+char	obuf[SZ_OBUF]
+int	fd
+int	stropen()
+pointer	tty, ttygdes()
+
+begin
+	call clgstr ("ttyname", ttyname, SZ_FNAME)
+	tty = ttygdes (ttyname)
+	call ttyseti (tty, TTY_PADCHAR, FAKE_PADCHAR)
+
+	# Print header identifying basic terminal capabilities.
+	call printf ("Termcap entry for '%s', %d capabilities\n")
+	    call pargstr (ttyname)
+	    call pargi (T_NCAPS(tty))
+	call printf ("    pc=%oB, bsok=%b, htok=%b, %d by %d, %d baud\n")
+	    call pargi (T_PADCHAR(tty))
+	    call pargi (T_BSOK(tty))
+	    call pargi (T_HTOK(tty))
+	    call pargi (T_NCOLS(tty))
+	    call pargi (T_NLINES(tty))
+	    call pargi (T_BAUD(tty))
+
+	# Dump initialization string into buffer, print buffer in readable
+	# form on STDOUT.
+
+	fd = stropen (obuf, SZ_OBUF, NEW_FILE)
+	call ttyinit (fd, tty)
+	call close (fd)
+	call dump_chars (STDOUT, obuf)
+	call putci (STDOUT, '\n')
+		
+	call ttycdes (tty)
+end
+
+
+# DUMP_CHARS -- Print out a sequence of normal and control chars in a nice
+# readable form.
+
+procedure dump_chars (fd, str)
+
+int	fd
+char	str[ARB]
+char	ch
+int	ip, iptop
+int	stridx()
+errchk	putci, putline
+
+begin
+	for (ip=1;  str[ip] != EOS;  ) {
+	    if (ip > 1)
+		call putci (fd, '\n')
+	    call putline (fd, "    ")
+	    for (iptop=ip+50;  ip < iptop && str[ip] != EOS;  ip=ip+1) {
+		ch = str[ip]
+		if (IS_CNTRL(ch)) {
+		    if (stridx (ch, "\b\f\t\r\n") > 0)
+			call putcc (fd, ch)
+		    else {
+			call putci (fd, '^')
+			call putci (fd, ch + 'A' - 1)
+		    }
+		} else if (ch == FAKE_PADCHAR) {
+		    call putci (fd, '.')
+		} else
+		    call putc  (fd, ch)
+	    }
+	}
+
+	if (ip < iptop)
+	    call putci (fd, '\n')
+end
diff --git a/sys/vops/README b/sys/vops/README
new file mode 100644
index 00000000..1e4c2cd0
--- /dev/null
+++ b/sys/vops/README
@@ -0,0 +1,10 @@
+VOPS -- Vector OPerators
+
+This directory contains the (generic) source for the vector operators (VOPS).
+These generic procedures are expanded into a set of type specific procedures
+by the GENERIC preprocessor, before compilation by XC.  Documentation for
+the vector operators and for the GENERIC preprocessor is in Vops.hlp.
+
+The subdirectory "achtgen" contains code for generalized datatype conversion
+of vectors.  The highest level routine, "acht" implements a full 9 by 9
+type conversion matrix (BUcsilrdx) (the BU are in OSB).
diff --git a/sys/vops/aabs.gx b/sys/vops/aabs.gx
new file mode 100644
index 00000000..54cbe197
--- /dev/null
+++ b/sys/vops/aabs.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabs$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/aadd.gx b/sys/vops/aadd.gx
new file mode 100644
index 00000000..361afd6c
--- /dev/null
+++ b/sys/vops/aadd.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aadd$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/aaddk.gx b/sys/vops/aaddk.gx
new file mode 100644
index 00000000..bd45782b
--- /dev/null
+++ b/sys/vops/aaddk.gx
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/aand.gx b/sys/vops/aand.gx
new file mode 100644
index 00000000..e42d2d87
--- /dev/null
+++ b/sys/vops/aand.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAND -- Compute the bitwise boolean 'and' of two vectors (generic).
+
+procedure aand$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+$if (datatype == i)
+int	and()
+$else
+PIXEL	and$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = and (a[i], b[i])
+	    $else
+		c[i] = and$t (a[i], b[i])
+	    $endif
+	}
+end
diff --git a/sys/vops/aandk.gx b/sys/vops/aandk.gx
new file mode 100644
index 00000000..bbb3b3b6
--- /dev/null
+++ b/sys/vops/aandk.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AANDK -- Compute the bitwise boolean 'and' of a vector and a constant
+# (generic)
+
+procedure aandk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+$if (datatype == i)
+int	and()
+$else
+PIXEL	and$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = and (a[i], b)
+	    $else
+		c[i] = and$t (a[i], b)
+	    $endif
+	}
+end
diff --git a/sys/vops/aavg.gx b/sys/vops/aavg.gx
new file mode 100644
index 00000000..8f90126d
--- /dev/null
+++ b/sys/vops/aavg.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavg$t (a, npix, mean, sigma)
+
+PIXEL	a[ARB]
+int	npix
+$if (datatype == dl)
+double	mean, sigma, lcut, hcut
+$else
+real	mean, sigma, lcut, hcut
+$endif
+int	junk, awvg$t()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvg$t (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/abav.gx b/sys/vops/abav.gx
new file mode 100644
index 00000000..0f519216
--- /dev/null
+++ b/sys/vops/abav.gx
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abav$t (a, b, nblocks, npix_per_block)
+
+PIXEL	a[ARB]			# input vector
+PIXEL	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+$if (datatype == cs)
+long	sum, width
+$else $if (datatype == il)
+real	sum, width
+$else
+PIXEL	sum, width
+$endif $endif
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	$if (datatype != x)
+	    width = block_length
+	$else
+	    width = complex (block_length, block_length)
+	$endif
+
+	if (block_length <= 1)
+	    call amov$t (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/abeq.gx b/sys/vops/abeq.gx
new file mode 100644
index 00000000..35324f6a
--- /dev/null
+++ b/sys/vops/abeq.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeq$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/abeqk.gx b/sys/vops/abeqk.gx
new file mode 100644
index 00000000..8f7a84aa
--- /dev/null
+++ b/sys/vops/abeqk.gx
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    do i = 1, npix
+		if (a[i] == 0$f)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/abge.gx b/sys/vops/abge.gx
new file mode 100644
index 00000000..76f842dc
--- /dev/null
+++ b/sys/vops/abge.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abge$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) >= abs (b[i]))
+	    $else
+	    if (a[i] >= b[i])
+	    $endif
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/abgek.gx b/sys/vops/abgek.gx
new file mode 100644
index 00000000..a9ad9340
--- /dev/null
+++ b/sys/vops/abgek.gx
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgek$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    $if (datatype == x)
+	    call amovki (1, c, npix)
+	    $else
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	    $endif
+	} else {
+	    $if (datatype == x)
+	    abs_b = abs (b)
+	    $endif
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) >= abs_b)
+		$else
+		if (a[i] >= b)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/abgt.gx b/sys/vops/abgt.gx
new file mode 100644
index 00000000..80d7e81a
--- /dev/null
+++ b/sys/vops/abgt.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgt$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) > abs (b[i]))
+	    $else
+	    if (a[i] > b[i])
+	    $endif
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/abgtk.gx b/sys/vops/abgtk.gx
new file mode 100644
index 00000000..93be1524
--- /dev/null
+++ b/sys/vops/abgtk.gx
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) > 0)
+		$else
+		if (a[i] > 0)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    $if (datatype == x)
+	    abs_b = abs (b)
+	    $endif
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) > abs_b)
+		$else
+		if (a[i] > b)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/able.gx b/sys/vops/able.gx
new file mode 100644
index 00000000..27553959
--- /dev/null
+++ b/sys/vops/able.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure able$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) <= abs (b[i]))
+	    $else
+	    if (a[i] <= b[i])
+	    $endif
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ablek.gx b/sys/vops/ablek.gx
new file mode 100644
index 00000000..16a10d27
--- /dev/null
+++ b/sys/vops/ablek.gx
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablek$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) == 0)
+		$else
+		if (a[i] <= 0)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    $if (datatype == x)
+	    abs_b = abs (b)
+	    $endif
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) <= abs_b)
+		$else
+		if (a[i] <= b)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ablt.gx b/sys/vops/ablt.gx
new file mode 100644
index 00000000..212c891e
--- /dev/null
+++ b/sys/vops/ablt.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure ablt$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) < abs (b[i]))
+	    $else
+	    if (a[i] < b[i])
+	    $endif
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/abltk.gx b/sys/vops/abltk.gx
new file mode 100644
index 00000000..8d11cb09
--- /dev/null
+++ b/sys/vops/abltk.gx
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    $if (datatype == x)
+	    call aclri (c, npix)
+	    $else
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	    $endif
+	} else {
+	    $if (datatype == x)
+	    abs_b = abs (b)
+	    $endif
+	    do i = 1, npix
+		$if (datatype == x)
+		if (abs (a[i]) < abs_b)
+		$else
+		if (a[i] < b)
+		$endif
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/abne.gx b/sys/vops/abne.gx
new file mode 100644
index 00000000..6cc4513e
--- /dev/null
+++ b/sys/vops/abne.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abne$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/abnek.gx b/sys/vops/abnek.gx
new file mode 100644
index 00000000..4643cd89
--- /dev/null
+++ b/sys/vops/abnek.gx
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnek$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0$f) {
+	    do i = 1, npix
+		if (a[i] != 0$f)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/abor.gx b/sys/vops/abor.gx
new file mode 100644
index 00000000..6dcea5d9
--- /dev/null
+++ b/sys/vops/abor.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABOR -- Compute the bitwise boolean 'or' of two vectors (generic).
+
+procedure abor$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+$if (datatype == i)
+int	or()
+$else
+PIXEL	or$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = or (a[i], b[i])
+	    $else
+		c[i] = or$t (a[i], b[i])
+	    $endif
+	}
+end
diff --git a/sys/vops/abork.gx b/sys/vops/abork.gx
new file mode 100644
index 00000000..0c1e5416
--- /dev/null
+++ b/sys/vops/abork.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABORK -- Compute the bitwise boolean or of a vector and a constant
+# (generic).
+
+procedure abork$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+$if (datatype == i)
+int	or()
+$else
+PIXEL	or$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = or (a[i], b)
+	    $else
+		c[i] = or$t (a[i], b)
+	    $endif
+	}
+end
diff --git a/sys/vops/absu.gx b/sys/vops/absu.gx
new file mode 100644
index 00000000..6601daae
--- /dev/null
+++ b/sys/vops/absu.gx
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absu$t (a, b, nblocks, npix_per_block)
+
+PIXEL	a[ARB]			# input vector
+PIXEL	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+$if (datatype == cs)
+long	sum
+$else $if (datatype == il)
+real	sum
+$else
+PIXEL	sum
+$endif $endif
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amov$t (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/acht.gx b/sys/vops/acht.gx
new file mode 100644
index 00000000..e1ad83f4
--- /dev/null
+++ b/sys/vops/acht.gx
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure acht$t$$t (a, b, npix)
+
+PIXEL	a[ARB]
+$PIXEL	b[ARB]
+int	npix
+$$if (datatype != $t)
+int	i
+$$endif
+
+begin
+	$$if (datatype == $t)
+	call amov$t (a, b, npix)
+	$$else
+	    $$if (sizeof(t) <= sizeof($t))
+		do i = 1, npix
+		    $$if (datatype == x)
+			b[i] = complex(real(a[i]),0.0)
+		    $$else
+			b[i] = a[i]
+		    $$endif
+	    $$else
+		do i = npix, 1, -1
+		    $$if (datatype == x)
+			b[i] = complex(real(a[i]),0.0)
+		    $$else
+			b[i] = a[i]
+		    $$endif
+	    $$endif
+	$$endif
+end
diff --git a/sys/vops/achtgen/acht.x b/sys/vops/achtgen/acht.x
new file mode 100644
index 00000000..ae67ceae
--- /dev/null
+++ b/sys/vops/achtgen/acht.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT -- General data type conversion based on the generic routines
+# The data types are BUcsilrdx.
+
+procedure acht (a, b, nelem, ty_a, ty_b)
+
+char	a[ARB], b[ARB]
+int	ty_a, ty_b, nelem
+
+begin
+ 	switch (ty_a) {
+	case TY_UBYTE:
+	    call achtb (a, b, nelem, ty_b)
+	case TY_USHORT:
+	    call achtu (a, b, nelem, ty_b)
+	case TY_CHAR:
+	    call achtc (a, b, nelem, ty_b)
+	case TY_SHORT:
+	    call achts (a, b, nelem, ty_b)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achti (a, b, nelem, ty_b)
+	case TY_LONG:
+	    call achtl (a, b, nelem, ty_b)
+	case TY_REAL:
+	    call achtr (a, b, nelem, ty_b)
+	case TY_DOUBLE:
+	    call achtd (a, b, nelem, ty_b)
+	case TY_COMPLEX:
+	    call achtx (a, b, nelem, ty_b)
+	}
+end
diff --git a/sys/vops/achtgen/achtb.x b/sys/vops/achtgen/achtb.x
new file mode 100644
index 00000000..0d8cb8a7
--- /dev/null
+++ b/sys/vops/achtgen/achtb.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtb (a, b, nelem, ty_b)
+
+char	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtbb (a, b, nelem)
+	case TY_USHORT:
+	    call achtbu (a, b, nelem)
+	case TY_CHAR:
+	    call achtbc (a, b, nelem)
+	case TY_SHORT:
+	    call achtbs (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtbi (a, b, nelem)
+	case TY_LONG:
+	    call achtbl (a, b, nelem)
+	case TY_REAL:
+	    call achtbr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtbd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtbx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtc.x b/sys/vops/achtgen/achtc.x
new file mode 100644
index 00000000..370a0174
--- /dev/null
+++ b/sys/vops/achtgen/achtc.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtc (a, b, nelem, ty_b)
+
+char	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtcb (a, b, nelem)
+	case TY_USHORT:
+	    call achtcu (a, b, nelem)
+	case TY_CHAR:
+	    call achtcc (a, b, nelem)
+	case TY_SHORT:
+	    call achtcs (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtci (a, b, nelem)
+	case TY_LONG:
+	    call achtcl (a, b, nelem)
+	case TY_REAL:
+	    call achtcr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtcd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtcx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtd.x b/sys/vops/achtgen/achtd.x
new file mode 100644
index 00000000..6f784749
--- /dev/null
+++ b/sys/vops/achtgen/achtd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtd (a, b, nelem, ty_b)
+
+double	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtdb (a, b, nelem)
+	case TY_USHORT:
+	    call achtdu (a, b, nelem)
+	case TY_CHAR:
+	    call achtdc (a, b, nelem)
+	case TY_SHORT:
+	    call achtds (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtdi (a, b, nelem)
+	case TY_LONG:
+	    call achtdl (a, b, nelem)
+	case TY_REAL:
+	    call achtdr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtdd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtdx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achti.x b/sys/vops/achtgen/achti.x
new file mode 100644
index 00000000..49df790e
--- /dev/null
+++ b/sys/vops/achtgen/achti.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achti (a, b, nelem, ty_b)
+
+int	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtib (a, b, nelem)
+	case TY_USHORT:
+	    call achtiu (a, b, nelem)
+	case TY_CHAR:
+	    call achtic (a, b, nelem)
+	case TY_SHORT:
+	    call achtis (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtii (a, b, nelem)
+	case TY_LONG:
+	    call achtil (a, b, nelem)
+	case TY_REAL:
+	    call achtir (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtid (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtix (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtl.x b/sys/vops/achtgen/achtl.x
new file mode 100644
index 00000000..bf9cc0fa
--- /dev/null
+++ b/sys/vops/achtgen/achtl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtl (a, b, nelem, ty_b)
+
+long	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtlb (a, b, nelem)
+	case TY_USHORT:
+	    call achtlu (a, b, nelem)
+	case TY_CHAR:
+	    call achtlc (a, b, nelem)
+	case TY_SHORT:
+	    call achtls (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtli (a, b, nelem)
+	case TY_LONG:
+	    call achtll (a, b, nelem)
+	case TY_REAL:
+	    call achtlr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtld (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtlx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtr.x b/sys/vops/achtgen/achtr.x
new file mode 100644
index 00000000..add1fdf4
--- /dev/null
+++ b/sys/vops/achtgen/achtr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtr (a, b, nelem, ty_b)
+
+real	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtrb (a, b, nelem)
+	case TY_USHORT:
+	    call achtru (a, b, nelem)
+	case TY_CHAR:
+	    call achtrc (a, b, nelem)
+	case TY_SHORT:
+	    call achtrs (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtri (a, b, nelem)
+	case TY_LONG:
+	    call achtrl (a, b, nelem)
+	case TY_REAL:
+	    call achtrr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtrd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtrx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achts.x b/sys/vops/achtgen/achts.x
new file mode 100644
index 00000000..c0aa0026
--- /dev/null
+++ b/sys/vops/achtgen/achts.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achts (a, b, nelem, ty_b)
+
+short	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtsb (a, b, nelem)
+	case TY_USHORT:
+	    call achtsu (a, b, nelem)
+	case TY_CHAR:
+	    call achtsc (a, b, nelem)
+	case TY_SHORT:
+	    call achtss (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtsi (a, b, nelem)
+	case TY_LONG:
+	    call achtsl (a, b, nelem)
+	case TY_REAL:
+	    call achtsr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtsd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtsx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtu.x b/sys/vops/achtgen/achtu.x
new file mode 100644
index 00000000..5edffe96
--- /dev/null
+++ b/sys/vops/achtgen/achtu.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtu (a, b, nelem, ty_b)
+
+short	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtub (a, b, nelem)
+	case TY_USHORT:
+	    call achtuu (a, b, nelem)
+	case TY_CHAR:
+	    call achtuc (a, b, nelem)
+	case TY_SHORT:
+	    call achtus (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtui (a, b, nelem)
+	case TY_LONG:
+	    call achtul (a, b, nelem)
+	case TY_REAL:
+	    call achtur (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtud (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtux (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/achtx.x b/sys/vops/achtgen/achtx.x
new file mode 100644
index 00000000..c0d8e04d
--- /dev/null
+++ b/sys/vops/achtgen/achtx.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHT_ -- Convert an array of type _ to some other datatype.
+# Data types are BUcsilrdx.
+
+procedure achtx (a, b, nelem, ty_b)
+
+complex	a[ARB]
+char	b[ARB]
+int	nelem
+int	ty_b
+
+begin
+	switch (ty_b) {
+	case TY_UBYTE:
+	    call achtxb (a, b, nelem)
+	case TY_USHORT:
+	    call achtxu (a, b, nelem)
+	case TY_CHAR:
+	    call achtxc (a, b, nelem)
+	case TY_SHORT:
+	    call achtxs (a, b, nelem)
+	case TY_INT, TY_POINTER, TY_STRUCT:
+	    call achtxi (a, b, nelem)
+	case TY_LONG:
+	    call achtxl (a, b, nelem)
+	case TY_REAL:
+	    call achtxr (a, b, nelem)
+	case TY_DOUBLE:
+	    call achtxd (a, b, nelem)
+	case TY_COMPLEX:
+	    call achtxx (a, b, nelem)
+	}
+end
diff --git a/sys/vops/achtgen/mkpkg b/sys/vops/achtgen/mkpkg
new file mode 100644
index 00000000..48b7c157
--- /dev/null
+++ b/sys/vops/achtgen/mkpkg
@@ -0,0 +1,25 @@
+# The files in this directory are the higher level type conversion routines.
+# The most general routine is ACHT, which can convert an array of any of the
+# nine datatypes UBcsilrdx to any of the other types (it will cause 100
+# additional subroutines to be linked).  One level down in the structure tree
+# are the ACHTx routines, which will convert an array of type X to any other
+# type.  At the bottom are the ACHTxy routines, which convert from type X
+# to type Y; these procedures are in vops$ak and osb$.
+
+$checkout libvops.a lib$
+$update   libvops.a
+$checkin  libvops.a lib$
+$exit
+
+libvops.a:
+	acht.x
+	achtb.x
+	achtc.x
+	achtd.x
+	achti.x
+	achtl.x
+	achtr.x
+	achts.x
+	achtu.x
+	achtx.x
+	;
diff --git a/sys/vops/acjgx.x b/sys/vops/acjgx.x
new file mode 100644
index 00000000..1fc9f944
--- /dev/null
+++ b/sys/vops/acjgx.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACJGX -- Complex conjugate of a complex vector.
+
+procedure acjgx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    b[i] = conjg (a[i])
+end
diff --git a/sys/vops/aclr.gx b/sys/vops/aclr.gx
new file mode 100644
index 00000000..f3415353
--- /dev/null
+++ b/sys/vops/aclr.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclr$t (a, npix)
+
+PIXEL	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0$f
+end
diff --git a/sys/vops/acnv.gx b/sys/vops/acnv.gx
new file mode 100644
index 00000000..4d729126
--- /dev/null
+++ b/sys/vops/acnv.gx
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnv$t (in, out, npix, kernel, knpix)
+
+PIXEL	in[npix+knpix-1]	# input vector, including boundary pixels
+PIXEL	out[ARB]		# output vector
+int	npix			# length of output vector
+PIXEL	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+PIXEL	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/acnvr.gx b/sys/vops/acnvr.gx
new file mode 100644
index 00000000..753b3de2
--- /dev/null
+++ b/sys/vops/acnvr.gx
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvr$t (in, out, npix, kernel, knpix)
+
+PIXEL	in[npix+knpix-1]	# input vector, including boundary pixels
+PIXEL	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/adiv.gx b/sys/vops/adiv.gx
new file mode 100644
index 00000000..6b8b4cae
--- /dev/null
+++ b/sys/vops/adiv.gx
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adiv$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/adivk.gx b/sys/vops/adivk.gx
new file mode 100644
index 00000000..a16d0cac
--- /dev/null
+++ b/sys/vops/adivk.gx
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/adot.gx b/sys/vops/adot.gx
new file mode 100644
index 00000000..baadd952
--- /dev/null
+++ b/sys/vops/adot.gx
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+$if (datatype == ld)
+double procedure adot$t (a, b, npix)
+$else
+real procedure adot$t (a, b, npix)
+$endif
+
+PIXEL	a[ARB], b[ARB]
+
+$if (datatype == ld)
+double	sum
+$else
+real	sum
+$endif
+
+int	npix, i
+
+begin
+	sum = 0$f
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/advz.gx b/sys/vops/advz.gx
new file mode 100644
index 00000000..b4bffd80
--- /dev/null
+++ b/sys/vops/advz.gx
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advz$t (a, b, c, npix, errfcn)
+
+PIXEL	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+PIXEL	errfcn()		# user function, called on divide by zero
+
+int	i
+PIXEL	divisor
+$if (datatype == rd)
+PIXEL	tol
+$endif
+extern	errfcn()
+errchk	errfcn
+
+begin
+	$if (datatype == r)
+	    tol = 1.0E-20
+	$else $if (datatype == d)
+	    tol = 1.0D-20
+	$endif $endif
+
+	do i = 1, npix {
+	    divisor = b[i]
+	    $if (datatype == rd)
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a[i])
+			next
+		    }
+		c[i] = a[i] / divisor
+
+	    $else
+		if (divisor == 0$f)
+		    c[i] = errfcn (a[i])
+		else
+		    c[i] = a[i] / divisor
+	    $endif
+	}
+end
diff --git a/sys/vops/aexp.gx b/sys/vops/aexp.gx
new file mode 100644
index 00000000..f631e7df
--- /dev/null
+++ b/sys/vops/aexp.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexp$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/aexpk.gx b/sys/vops/aexpk.gx
new file mode 100644
index 00000000..9bd5a58c
--- /dev/null
+++ b/sys/vops/aexpk.gx
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/afftrr.x b/sys/vops/afftrr.x
new file mode 100644
index 00000000..024f4456
--- /dev/null
+++ b/sys/vops/afftrr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTRR -- Forward fourier transform (real transform, real output arrays).
+# The forward transform of the real array SR length NPIX is computed and
+# returned in the real arrays FR and FI of length NPIX/2+1.  Since the real
+# transform is being performed the array SI is ignored and may be omitted.
+# The transformation may be performed in place if desired.  NPIX must be a
+# power of 2.
+
+procedure afftrr (sr, si, fr, fi, npix)
+
+real	sr[ARB], si[ARB]	# spatial data (input).  SI NOT USED.
+real	fr[ARB], fi[ARB]	# real and imag parts of transform (output)
+int	npix
+int	ier
+pointer	sp, work
+
+begin
+	call smark (sp)
+	call salloc (work, npix + 2, TY_REAL)
+
+	# Copy the real data vector into the work array.
+	call amovr (sr, Memr[work], npix)
+
+	# Compute the forward transform.
+	call ffa (Memr[work], npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrr: npix not a power of 2")
+
+	# Unpack the real and imaginary parts into the output arrays.
+	call aupxr (Memr[work], fr, fi, npix / 2 + 1)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/afftrx.x b/sys/vops/afftrx.x
new file mode 100644
index 00000000..ec43b16a
--- /dev/null
+++ b/sys/vops/afftrx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTRX -- Forward fourier transform (real transform, complex output).
+# The fourier transform of the real array A of length NPIX pixels is computed
+# and the NPIX/2+1 complex transform coefficients are returned in the complex
+# array B.  The first element of array B upon output contains the dc term at
+# zero frequency, and the remaining elements contain the real and imaginary
+# components of the harmonics.  The transformation may be performed in place
+# if desired.  NPIX must be a power of 2.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# B to be a type COMPLEX array in the calling program, but FFA expects a
+# REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure afftrx (a, b, npix)
+
+real	a[ARB]		# data (input)
+complex	b[ARB]		# transform (output).  Dim npix/2+1
+int	npix
+int	ier
+
+begin
+	# The following is a no-op if A and B are the same array.
+	call amovr (a, b, npix)
+
+	# Compute the forward real transform.
+	call ffa (b, npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrx: npix not a power of 2")
+end
diff --git a/sys/vops/afftxr.x b/sys/vops/afftxr.x
new file mode 100644
index 00000000..b09ae0f5
--- /dev/null
+++ b/sys/vops/afftxr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTXR -- Forward fourier transform (complex transform, real arrays).
+# The fourier transform of the real arrays SR and SI containing complex data
+# pairs is computed and the complex transform coefficients are returned in
+# the real arrays FR and FI.  The transformation may be performed in place if
+# desired.  NPIX must be a power of 2.
+
+procedure afftxr (sr, si, fr, fi, npix)
+
+real	sr[ARB], si[ARB]	# data, spatial domain (input)
+real	fr[ARB], fi[ARB]	# transform, frequency domain (output)
+int	npix
+int	ier
+
+begin
+	# The following are no-ops if the transform is being performed
+	# in place.
+
+	call amovr (sr, fr, npix)
+	call amovr (si, fi, npix)
+
+	# Compute the forward transform.
+	call fft842 (0, npix, fr, fi, ier)
+	if (ier == 1)
+	    call fatal (1, "afftxr: npix not a power of 2")
+end
diff --git a/sys/vops/afftxx.x b/sys/vops/afftxx.x
new file mode 100644
index 00000000..34eedbf9
--- /dev/null
+++ b/sys/vops/afftxx.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTXX -- Forward fourier transform (complex transform, complex data).
+# The fourier transform of the complex array A of length NPIX pixels is
+# computed and the NPIX complex transform coefficients are returned in the
+# complex array B.  The transformation may be performed in place if desired.
+# NPIX must be a power of 2.
+
+procedure afftxx (a, b, npix)
+
+complex	a[ARB]			# data (input)
+complex	b[ARB]			# transform (output)
+int	npix
+
+int	ier
+pointer	sp, xr, xi
+
+begin
+	call smark (sp)
+	call salloc (xr, npix, TY_REAL)
+	call salloc (xi, npix, TY_REAL)
+
+	# Rearrange the elements of the A array as required by FFT842.
+	# Convert the array A of complex values into an array of reals
+	# and an array of imaginaries.
+
+	call aupxr (a, Memr[xr], Memr[xi], npix)
+
+	# Compute the forward transform.
+	call fft842 (0, npix, Memr[xr], Memr[xi], ier)
+	if (ier == 1)
+	    call fatal (1, "afftxx: npix not a power of 2")
+
+	# Repack the real and imaginary arrays to form the complex output
+	# array.
+	call apkxr (Memr[xr], Memr[xi], b, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/aglt.gx b/sys/vops/aglt.gx
new file mode 100644
index 00000000..54f6ee2f
--- /dev/null
+++ b/sys/vops/aglt.gx
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure aglt$t (a, b, npix, low, high, kmul, kadd, nrange)
+
+PIXEL	a[ARB], b[ARB], pixval
+int	npix, i
+PIXEL	low[nrange], high[nrange]	# range limits
+$if (datatype == dl)
+double	kmul[nrange], kadd[nrange]	# linear transformation
+$else
+real	kmul[nrange], kadd[nrange]
+$endif
+$if (datatype == x)
+real	abs_pixval
+$endif
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    $if (datatype == x)
+		abs_pixval = abs (pixval)
+	    $endif
+	    do nr = 1, nrange
+	    $if (datatype == x)
+		if (abs_pixval >= abs (low[nr]) &&
+		abs_pixval <= abs (high[nr])) {
+	    $else
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+	    $endif
+		    $if (datatype == dl)
+			if (kmul[nr] == 0.0D0)
+		    $else
+			if (kmul[nr] == 0.0)
+		    $endif
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ahgm.gx b/sys/vops/ahgm.gx
new file mode 100644
index 00000000..02e21c07
--- /dev/null
+++ b/sys/vops/ahgm.gx
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgm$t (data, npix, hgm, nbins, z1, z2)
+
+PIXEL 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+PIXEL	z1, z2			# greyscale values of first and last bins
+
+PIXEL	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ahiv.gx b/sys/vops/ahiv.gx
new file mode 100644
index 00000000..ba6d487a
--- /dev/null
+++ b/sys/vops/ahiv.gx
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+PIXEL procedure ahiv$t (a, npix)
+
+PIXEL	a[ARB]
+int	npix
+PIXEL	high, pixval
+$if (datatype == x)
+real	abs_high
+$endif
+int	i
+
+begin
+	high = a[1]
+	$if (datatype == x)
+	abs_high = abs (high)
+	$endif
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    $if (datatype == x)
+	    if (abs (pixval) > abs_high) {
+		high = pixval
+		abs_high = abs (high)
+	    }
+	    $else
+	    if (pixval > high)
+		high = pixval
+	    $endif
+	}
+
+	return (high)
+end
diff --git a/sys/vops/aiftrr.x b/sys/vops/aiftrr.x
new file mode 100644
index 00000000..96789581
--- /dev/null
+++ b/sys/vops/aiftrr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTRR -- Inverse fourier transform (real transform, real output arrays).
+# The inverse transform of the real arrays FR and FI of length NPIX/2+1 is
+# returned in the real array SR of length NPIX.  Since the real inverse
+# transform is being performed the array SI is ignored and may be omitted.
+# The transformation may be performed in place if desired.  NPIX must be a
+# power of 2.
+
+procedure aiftrr (fr, fi, sr, si, npix)
+
+real	fr[ARB], fi[ARB]	# real and imag parts of transform (input)
+real	sr[ARB], si[ARB]	# spatial data (output).  SI NOT USED.
+int	npix
+int	ier
+pointer	sp, work
+
+begin
+	call smark (sp)
+	call salloc (work, npix + 2, TY_REAL)
+
+	# Pack the real and imaginary parts into a complex array as required
+	# by FFS.
+	call apkxr (fr, fi, Memr[work], npix / 2 + 1)
+
+	# Compute the inverse transform.
+	call ffs (Memr[work], npix, ier)
+	if (ier == 1)
+	    call fatal (1, "aiftrr: npix not a power of 2")
+
+	# The work array now contains the real part of the transform; merely
+	# copy it to the output array.
+	call amovr (Memr[work], sr, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/aiftrx.x b/sys/vops/aiftrx.x
new file mode 100644
index 00000000..63a9d53d
--- /dev/null
+++ b/sys/vops/aiftrx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTRX -- Inverse discreet fourier transform (real transform, complex data
+# array in).  The input array A of length NPIX/2+1 contains the DC term and
+# the NPIX/2 (real,imag) pairs for each of the NPIX/2 harmonics of the real
+# transform.  Upon output array B contains the NPIX real data pixels from the
+# inverse transform.  The transform may be performed in place if desired.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# B to be a type COMPLEX array in the calling program, but FFS expects a
+# REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure aiftrx (a, b, npix)
+
+complex	a[ARB]			# transform, npix/2+1 elements
+real	b[ARB]			# output data array
+int	npix
+int	ier
+
+begin
+	# The following is a no-op if A and B are the same array.
+	call amovx (a, b, npix / 2 + 1)
+
+	# Compute the inverse real transform.
+	call ffs (b, npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrx: npix not a power of 2")
+end
diff --git a/sys/vops/aiftxr.x b/sys/vops/aiftxr.x
new file mode 100644
index 00000000..a9647e7c
--- /dev/null
+++ b/sys/vops/aiftxr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTXR -- Inverse fourier transform (complex transform, real arrays).
+# The inverse transform of the real arrays FR and FI containing complex data
+# pairs is computed and the complex spatial data coefficients are returned in
+# the real arrays SR and SI.  The transformation may be performed in place if
+# desired.  NPIX must be a power of 2.
+
+procedure aiftxr (fr, fi, sr, si, npix)
+
+real	fr[ARB], fi[ARB]	# transform, frequency domain (input)
+real	sr[ARB], si[ARB]	# data, spatial domain (output)
+int	npix
+int	ier
+
+begin
+	# The following are no-ops if the transform is being performed
+	# in place.
+
+	call amovr (fr, sr, npix)
+	call amovr (fi, si, npix)
+
+	# Compute the inverse transform.
+	call fft842 (1, npix, sr, si, ier)
+	if (ier == 1)
+	    call fatal (1, "afftxr: npix not a power of 2")
+end
diff --git a/sys/vops/aiftxx.x b/sys/vops/aiftxx.x
new file mode 100644
index 00000000..2871590f
--- /dev/null
+++ b/sys/vops/aiftxx.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTXX -- Inverse fourier transform (complex transform, complex array).
+# The fourier transform of the complex array A of length NPIX pixels is
+# computed and the NPIX complex data points are returned in the complex array
+# B.  The transformation may be performed in place if desired.  NPIX must be
+# a power of 2.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# A and B to be type COMPLEX arrays in the calling program, but FFT842 expects
+# a REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure aiftxx (a, b, npix)
+
+complex	a[ARB]			# transform (input)
+complex	b[ARB]			# data (output)
+int	npix
+int	ier
+pointer	sp, xr, xi
+
+begin
+	call smark (sp)
+	call salloc (xr, npix, TY_REAL)
+	call salloc (xi, npix, TY_REAL)
+
+	# Rearrange the elements of the A array as required by FFT842.
+	# Convert the array A of complex values into an array of reals
+	# and an array of imaginaries.
+
+	call aupxr (a, Memr[xr], Memr[xi], npix)
+
+	# Compute the inverse transform.
+	call fft842 (1, npix, Memr[xr], Memr[xi], ier)
+	if (ier == 1)
+	    call fatal (1, "afftxx: npix not a power of 2")
+
+	# Repack the real and imaginary arrays to form the complex output
+	# array.
+	call apkxr (Memr[xr], Memr[xi], b, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/aimg.gx b/sys/vops/aimg.gx
new file mode 100644
index 00000000..3ba682fe
--- /dev/null
+++ b/sys/vops/aimg.gx
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimg$t (a, b, npix)
+
+complex	a[ARB]
+PIXEL	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/aabsd.x b/sys/vops/ak/aabsd.x
new file mode 100644
index 00000000..d9a85b4a
--- /dev/null
+++ b/sys/vops/ak/aabsd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabsd (a, b, npix)
+
+double	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aabsi.x b/sys/vops/ak/aabsi.x
new file mode 100644
index 00000000..b1c677aa
--- /dev/null
+++ b/sys/vops/ak/aabsi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabsi (a, b, npix)
+
+int	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aabsl.x b/sys/vops/ak/aabsl.x
new file mode 100644
index 00000000..27543118
--- /dev/null
+++ b/sys/vops/ak/aabsl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabsl (a, b, npix)
+
+long	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aabsr.x b/sys/vops/ak/aabsr.x
new file mode 100644
index 00000000..824e77d5
--- /dev/null
+++ b/sys/vops/ak/aabsr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabsr (a, b, npix)
+
+real	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aabss.x b/sys/vops/ak/aabss.x
new file mode 100644
index 00000000..2084a7cc
--- /dev/null
+++ b/sys/vops/ak/aabss.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabss (a, b, npix)
+
+short	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aabsx.x b/sys/vops/ak/aabsx.x
new file mode 100644
index 00000000..287e22cf
--- /dev/null
+++ b/sys/vops/ak/aabsx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AABS -- Compute the absolute value of a vector (generic).
+
+procedure aabsx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = abs(a[i])
+end
diff --git a/sys/vops/ak/aaddd.x b/sys/vops/ak/aaddd.x
new file mode 100644
index 00000000..50716bbc
--- /dev/null
+++ b/sys/vops/ak/aaddd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aaddd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aaddi.x b/sys/vops/ak/aaddi.x
new file mode 100644
index 00000000..cfaf200c
--- /dev/null
+++ b/sys/vops/ak/aaddi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aaddi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aaddkd.x b/sys/vops/ak/aaddkd.x
new file mode 100644
index 00000000..e98dfb57
--- /dev/null
+++ b/sys/vops/ak/aaddkd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddki.x b/sys/vops/ak/aaddki.x
new file mode 100644
index 00000000..f71b5654
--- /dev/null
+++ b/sys/vops/ak/aaddki.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddkl.x b/sys/vops/ak/aaddkl.x
new file mode 100644
index 00000000..9d16f93d
--- /dev/null
+++ b/sys/vops/ak/aaddkl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddkr.x b/sys/vops/ak/aaddkr.x
new file mode 100644
index 00000000..07b92d8e
--- /dev/null
+++ b/sys/vops/ak/aaddkr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddks.x b/sys/vops/ak/aaddks.x
new file mode 100644
index 00000000..d8256585
--- /dev/null
+++ b/sys/vops/ak/aaddks.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddkx.x b/sys/vops/ak/aaddkx.x
new file mode 100644
index 00000000..ea47e214
--- /dev/null
+++ b/sys/vops/ak/aaddkx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADDK -- Add a constant to a vector (generic).
+
+procedure aaddkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b
+end
diff --git a/sys/vops/ak/aaddl.x b/sys/vops/ak/aaddl.x
new file mode 100644
index 00000000..3684265f
--- /dev/null
+++ b/sys/vops/ak/aaddl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aaddl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aaddr.x b/sys/vops/ak/aaddr.x
new file mode 100644
index 00000000..ba35b513
--- /dev/null
+++ b/sys/vops/ak/aaddr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aaddr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aadds.x b/sys/vops/ak/aadds.x
new file mode 100644
index 00000000..bd53ed59
--- /dev/null
+++ b/sys/vops/ak/aadds.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aadds (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aaddx.x b/sys/vops/ak/aaddx.x
new file mode 100644
index 00000000..23239203
--- /dev/null
+++ b/sys/vops/ak/aaddx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AADD -- Add two vectors (generic).
+
+procedure aaddx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] + b[i]
+end
diff --git a/sys/vops/ak/aandi.x b/sys/vops/ak/aandi.x
new file mode 100644
index 00000000..86d6aadc
--- /dev/null
+++ b/sys/vops/ak/aandi.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAND -- Compute the bitwise boolean 'and' of two vectors (generic).
+
+procedure aandi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+int	and()
+
+begin
+	do i = 1, npix {
+		c[i] = and (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/aandki.x b/sys/vops/ak/aandki.x
new file mode 100644
index 00000000..792b491e
--- /dev/null
+++ b/sys/vops/ak/aandki.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AANDK -- Compute the bitwise boolean 'and' of a vector and a constant
+# (generic)
+
+procedure aandki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+int	and()
+
+begin
+	do i = 1, npix {
+		c[i] = and (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aandkl.x b/sys/vops/ak/aandkl.x
new file mode 100644
index 00000000..c178aa21
--- /dev/null
+++ b/sys/vops/ak/aandkl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AANDK -- Compute the bitwise boolean 'and' of a vector and a constant
+# (generic)
+
+procedure aandkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+long	andl()
+
+begin
+	do i = 1, npix {
+		c[i] = andl (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aandks.x b/sys/vops/ak/aandks.x
new file mode 100644
index 00000000..03a64dcb
--- /dev/null
+++ b/sys/vops/ak/aandks.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AANDK -- Compute the bitwise boolean 'and' of a vector and a constant
+# (generic)
+
+procedure aandks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+short	ands()
+
+begin
+	do i = 1, npix {
+		c[i] = ands (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aandl.x b/sys/vops/ak/aandl.x
new file mode 100644
index 00000000..95990efc
--- /dev/null
+++ b/sys/vops/ak/aandl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAND -- Compute the bitwise boolean 'and' of two vectors (generic).
+
+procedure aandl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+long	andl()
+
+begin
+	do i = 1, npix {
+		c[i] = andl (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/aands.x b/sys/vops/ak/aands.x
new file mode 100644
index 00000000..fe174b83
--- /dev/null
+++ b/sys/vops/ak/aands.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAND -- Compute the bitwise boolean 'and' of two vectors (generic).
+
+procedure aands (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+short	ands()
+
+begin
+	do i = 1, npix {
+		c[i] = ands (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/aavgd.x b/sys/vops/ak/aavgd.x
new file mode 100644
index 00000000..04c68bf2
--- /dev/null
+++ b/sys/vops/ak/aavgd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgd (a, npix, mean, sigma)
+
+double	a[ARB]
+int	npix
+double	mean, sigma, lcut, hcut
+int	junk, awvgd()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgd (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/aavgi.x b/sys/vops/ak/aavgi.x
new file mode 100644
index 00000000..45c8a64e
--- /dev/null
+++ b/sys/vops/ak/aavgi.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgi (a, npix, mean, sigma)
+
+int	a[ARB]
+int	npix
+real	mean, sigma, lcut, hcut
+int	junk, awvgi()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgi (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/aavgl.x b/sys/vops/ak/aavgl.x
new file mode 100644
index 00000000..3c015246
--- /dev/null
+++ b/sys/vops/ak/aavgl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgl (a, npix, mean, sigma)
+
+long	a[ARB]
+int	npix
+double	mean, sigma, lcut, hcut
+int	junk, awvgl()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgl (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/aavgr.x b/sys/vops/ak/aavgr.x
new file mode 100644
index 00000000..c4aaa051
--- /dev/null
+++ b/sys/vops/ak/aavgr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgr (a, npix, mean, sigma)
+
+real	a[ARB]
+int	npix
+real	mean, sigma, lcut, hcut
+int	junk, awvgr()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgr (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/aavgs.x b/sys/vops/ak/aavgs.x
new file mode 100644
index 00000000..2793e2e8
--- /dev/null
+++ b/sys/vops/ak/aavgs.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgs (a, npix, mean, sigma)
+
+short	a[ARB]
+int	npix
+real	mean, sigma, lcut, hcut
+int	junk, awvgs()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgs (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/aavgx.x b/sys/vops/ak/aavgx.x
new file mode 100644
index 00000000..07949efc
--- /dev/null
+++ b/sys/vops/ak/aavgx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AAVG -- Compute the mean and standard deviation (sigma) of a sample.
+# All pixels are used.
+
+procedure aavgx (a, npix, mean, sigma)
+
+complex	a[ARB]
+int	npix
+real	mean, sigma, lcut, hcut
+int	junk, awvgx()
+data	lcut /0./, hcut /0./
+
+begin
+	junk = awvgx (a, npix, mean, sigma, lcut, hcut)
+end
diff --git a/sys/vops/ak/abavd.x b/sys/vops/ak/abavd.x
new file mode 100644
index 00000000..0e76e230
--- /dev/null
+++ b/sys/vops/ak/abavd.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavd (a, b, nblocks, npix_per_block)
+
+double	a[ARB]			# input vector
+double	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+double	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = block_length
+
+	if (block_length <= 1)
+	    call amovd (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abavi.x b/sys/vops/ak/abavi.x
new file mode 100644
index 00000000..9ca5b267
--- /dev/null
+++ b/sys/vops/ak/abavi.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavi (a, b, nblocks, npix_per_block)
+
+int	a[ARB]			# input vector
+int	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = block_length
+
+	if (block_length <= 1)
+	    call amovi (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abavl.x b/sys/vops/ak/abavl.x
new file mode 100644
index 00000000..29332022
--- /dev/null
+++ b/sys/vops/ak/abavl.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavl (a, b, nblocks, npix_per_block)
+
+long	a[ARB]			# input vector
+long	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = block_length
+
+	if (block_length <= 1)
+	    call amovl (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abavr.x b/sys/vops/ak/abavr.x
new file mode 100644
index 00000000..3e442d8e
--- /dev/null
+++ b/sys/vops/ak/abavr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavr (a, b, nblocks, npix_per_block)
+
+real	a[ARB]			# input vector
+real	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = block_length
+
+	if (block_length <= 1)
+	    call amovr (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abavs.x b/sys/vops/ak/abavs.x
new file mode 100644
index 00000000..f3e42dc4
--- /dev/null
+++ b/sys/vops/ak/abavs.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavs (a, b, nblocks, npix_per_block)
+
+short	a[ARB]			# input vector
+short	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+long	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = block_length
+
+	if (block_length <= 1)
+	    call amovs (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abavx.x b/sys/vops/ak/abavx.x
new file mode 100644
index 00000000..7b33c2a3
--- /dev/null
+++ b/sys/vops/ak/abavx.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABAV -- Vector block average.  Each pixel in the output vector is the
+# average of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure abavx (a, b, nblocks, npix_per_block)
+
+complex	a[ARB]			# input vector
+complex	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+complex	sum, width
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+	    width = complex (block_length, block_length)
+
+	if (block_length <= 1)
+	    call amovx (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum / width
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/abeqc.x b/sys/vops/ak/abeqc.x
new file mode 100644
index 00000000..cbd97363
--- /dev/null
+++ b/sys/vops/ak/abeqc.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqc (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqd.x b/sys/vops/ak/abeqd.x
new file mode 100644
index 00000000..d71d2ad8
--- /dev/null
+++ b/sys/vops/ak/abeqd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqd (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqi.x b/sys/vops/ak/abeqi.x
new file mode 100644
index 00000000..a70fad30
--- /dev/null
+++ b/sys/vops/ak/abeqi.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqi (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqkc.x b/sys/vops/ak/abeqkc.x
new file mode 100644
index 00000000..10757e50
--- /dev/null
+++ b/sys/vops/ak/abeqkc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqkc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] == 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqkd.x b/sys/vops/ak/abeqkd.x
new file mode 100644
index 00000000..f4b0950a
--- /dev/null
+++ b/sys/vops/ak/abeqkd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] == 0.0D0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqki.x b/sys/vops/ak/abeqki.x
new file mode 100644
index 00000000..c0a8d33c
--- /dev/null
+++ b/sys/vops/ak/abeqki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] == 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqkl.x b/sys/vops/ak/abeqkl.x
new file mode 100644
index 00000000..35491d1e
--- /dev/null
+++ b/sys/vops/ak/abeqkl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] == 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqkr.x b/sys/vops/ak/abeqkr.x
new file mode 100644
index 00000000..5f6625ab
--- /dev/null
+++ b/sys/vops/ak/abeqkr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] == 0.0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqks.x b/sys/vops/ak/abeqks.x
new file mode 100644
index 00000000..f699cdf6
--- /dev/null
+++ b/sys/vops/ak/abeqks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] == 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeqkx.x b/sys/vops/ak/abeqkx.x
new file mode 100644
index 00000000..c2767408
--- /dev/null
+++ b/sys/vops/ak/abeqkx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQK -- Vector boolean equals constant.  C[i], type INT, is set to 1 if
+# A[i] equals B, else C[i] is set to zero.
+
+procedure abeqkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    do i = 1, npix
+		if (a[i] == (0.0,0.0))
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] == b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abeql.x b/sys/vops/ak/abeql.x
new file mode 100644
index 00000000..36d1d195
--- /dev/null
+++ b/sys/vops/ak/abeql.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeql (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqr.x b/sys/vops/ak/abeqr.x
new file mode 100644
index 00000000..263246b8
--- /dev/null
+++ b/sys/vops/ak/abeqr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqr (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqs.x b/sys/vops/ak/abeqs.x
new file mode 100644
index 00000000..d133181b
--- /dev/null
+++ b/sys/vops/ak/abeqs.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqs (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abeqx.x b/sys/vops/ak/abeqx.x
new file mode 100644
index 00000000..858142fb
--- /dev/null
+++ b/sys/vops/ak/abeqx.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABEQ -- Vector boolean equals.  C[i], type INT, is set to 1 if A[i] equals
+# B[i], else C[i] is set to zero.
+
+procedure abeqx (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] == b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgec.x b/sys/vops/ak/abgec.x
new file mode 100644
index 00000000..5f1f03af
--- /dev/null
+++ b/sys/vops/ak/abgec.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgec (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abged.x b/sys/vops/ak/abged.x
new file mode 100644
index 00000000..36565fd6
--- /dev/null
+++ b/sys/vops/ak/abged.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abged (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgei.x b/sys/vops/ak/abgei.x
new file mode 100644
index 00000000..76b9aca1
--- /dev/null
+++ b/sys/vops/ak/abgei.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgei (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgekc.x b/sys/vops/ak/abgekc.x
new file mode 100644
index 00000000..dcb495e6
--- /dev/null
+++ b/sys/vops/ak/abgekc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgekc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgekd.x b/sys/vops/ak/abgekd.x
new file mode 100644
index 00000000..4443230e
--- /dev/null
+++ b/sys/vops/ak/abgekd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgekd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgeki.x b/sys/vops/ak/abgeki.x
new file mode 100644
index 00000000..d819f2e9
--- /dev/null
+++ b/sys/vops/ak/abgeki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgeki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgekl.x b/sys/vops/ak/abgekl.x
new file mode 100644
index 00000000..f599ffff
--- /dev/null
+++ b/sys/vops/ak/abgekl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgekl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgekr.x b/sys/vops/ak/abgekr.x
new file mode 100644
index 00000000..35141e4c
--- /dev/null
+++ b/sys/vops/ak/abgekr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgekr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgeks.x b/sys/vops/ak/abgeks.x
new file mode 100644
index 00000000..04486504
--- /dev/null
+++ b/sys/vops/ak/abgeks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgeks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] >= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] >= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgekx.x b/sys/vops/ak/abgekx.x
new file mode 100644
index 00000000..f8f43b77
--- /dev/null
+++ b/sys/vops/ak/abgekx.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGEK -- Vector boolean greater than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is greater than or equal to B, else C[i] is set to zero.
+
+procedure abgekx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+real	abs_b
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    call amovki (1, c, npix)
+	} else {
+	    abs_b = abs (b)
+	    do i = 1, npix
+		if (abs (a[i]) >= abs_b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgel.x b/sys/vops/ak/abgel.x
new file mode 100644
index 00000000..385082d7
--- /dev/null
+++ b/sys/vops/ak/abgel.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgel (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abger.x b/sys/vops/ak/abger.x
new file mode 100644
index 00000000..f13f1065
--- /dev/null
+++ b/sys/vops/ak/abger.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abger (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abges.x b/sys/vops/ak/abges.x
new file mode 100644
index 00000000..c0bed06c
--- /dev/null
+++ b/sys/vops/ak/abges.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abges (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] >= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgex.x b/sys/vops/ak/abgex.x
new file mode 100644
index 00000000..bf8affff
--- /dev/null
+++ b/sys/vops/ak/abgex.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGE -- Vector boolean greater than or equals.  C[i], type INT, is set to 1
+# if A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgex (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (abs (a[i]) >= abs (b[i]))
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgtc.x b/sys/vops/ak/abgtc.x
new file mode 100644
index 00000000..85eb410e
--- /dev/null
+++ b/sys/vops/ak/abgtc.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgtc (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgtd.x b/sys/vops/ak/abgtd.x
new file mode 100644
index 00000000..7a5b668d
--- /dev/null
+++ b/sys/vops/ak/abgtd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgtd (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgti.x b/sys/vops/ak/abgti.x
new file mode 100644
index 00000000..356e66e9
--- /dev/null
+++ b/sys/vops/ak/abgti.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgti (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgtkc.x b/sys/vops/ak/abgtkc.x
new file mode 100644
index 00000000..425db27b
--- /dev/null
+++ b/sys/vops/ak/abgtkc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtkc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtkd.x b/sys/vops/ak/abgtkd.x
new file mode 100644
index 00000000..239caf24
--- /dev/null
+++ b/sys/vops/ak/abgtkd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtki.x b/sys/vops/ak/abgtki.x
new file mode 100644
index 00000000..17d67d74
--- /dev/null
+++ b/sys/vops/ak/abgtki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtkl.x b/sys/vops/ak/abgtkl.x
new file mode 100644
index 00000000..1ee43a43
--- /dev/null
+++ b/sys/vops/ak/abgtkl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtkr.x b/sys/vops/ak/abgtkr.x
new file mode 100644
index 00000000..11673299
--- /dev/null
+++ b/sys/vops/ak/abgtkr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtks.x b/sys/vops/ak/abgtks.x
new file mode 100644
index 00000000..2c27023a
--- /dev/null
+++ b/sys/vops/ak/abgtks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] > b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtkx.x b/sys/vops/ak/abgtkx.x
new file mode 100644
index 00000000..f7b2a992
--- /dev/null
+++ b/sys/vops/ak/abgtkx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGTK -- Vector boolean greater than constant.  C[i], type INT, is set to 1
+# if A[i] is greater than B, else C[i] is set to zero.
+
+procedure abgtkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+real	abs_b
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    do i = 1, npix
+		if (abs (a[i]) > 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    abs_b = abs (b)
+	    do i = 1, npix
+		if (abs (a[i]) > abs_b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abgtl.x b/sys/vops/ak/abgtl.x
new file mode 100644
index 00000000..3b5304b9
--- /dev/null
+++ b/sys/vops/ak/abgtl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgtl (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgtr.x b/sys/vops/ak/abgtr.x
new file mode 100644
index 00000000..4d900166
--- /dev/null
+++ b/sys/vops/ak/abgtr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgtr (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgts.x b/sys/vops/ak/abgts.x
new file mode 100644
index 00000000..8bb92613
--- /dev/null
+++ b/sys/vops/ak/abgts.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgts (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] > b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abgtx.x b/sys/vops/ak/abgtx.x
new file mode 100644
index 00000000..c82aef59
--- /dev/null
+++ b/sys/vops/ak/abgtx.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABGT -- Vector boolean greater than.  C[i], type INT, is set to 1 if
+# A[i] is greater than B[i], else C[i] is set to zero.
+
+procedure abgtx (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (abs (a[i]) > abs (b[i]))
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablec.x b/sys/vops/ak/ablec.x
new file mode 100644
index 00000000..76806def
--- /dev/null
+++ b/sys/vops/ak/ablec.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure ablec (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abled.x b/sys/vops/ak/abled.x
new file mode 100644
index 00000000..e1288c98
--- /dev/null
+++ b/sys/vops/ak/abled.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure abled (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablei.x b/sys/vops/ak/ablei.x
new file mode 100644
index 00000000..d69d184f
--- /dev/null
+++ b/sys/vops/ak/ablei.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure ablei (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablekc.x b/sys/vops/ak/ablekc.x
new file mode 100644
index 00000000..5a9f776f
--- /dev/null
+++ b/sys/vops/ak/ablekc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablekc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ablekd.x b/sys/vops/ak/ablekd.x
new file mode 100644
index 00000000..f18548da
--- /dev/null
+++ b/sys/vops/ak/ablekd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablekd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ableki.x b/sys/vops/ak/ableki.x
new file mode 100644
index 00000000..4ee983f7
--- /dev/null
+++ b/sys/vops/ak/ableki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ableki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ablekl.x b/sys/vops/ak/ablekl.x
new file mode 100644
index 00000000..5e480c5b
--- /dev/null
+++ b/sys/vops/ak/ablekl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablekl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ablekr.x b/sys/vops/ak/ablekr.x
new file mode 100644
index 00000000..3e61beae
--- /dev/null
+++ b/sys/vops/ak/ablekr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablekr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ableks.x b/sys/vops/ak/ableks.x
new file mode 100644
index 00000000..b8e855da
--- /dev/null
+++ b/sys/vops/ak/ableks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ableks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] <= 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] <= b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ablekx.x b/sys/vops/ak/ablekx.x
new file mode 100644
index 00000000..f29abb93
--- /dev/null
+++ b/sys/vops/ak/ablekx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLEK -- Vector boolean less than or equals constant.  C[i], type INT,
+# is set to 1 if A[i] is less than or equal to B, else C[i] is set to zero.
+
+procedure ablekx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+real	abs_b
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    do i = 1, npix
+		if (abs (a[i]) == 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    abs_b = abs (b)
+	    do i = 1, npix
+		if (abs (a[i]) <= abs_b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/ablel.x b/sys/vops/ak/ablel.x
new file mode 100644
index 00000000..b218784b
--- /dev/null
+++ b/sys/vops/ak/ablel.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure ablel (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abler.x b/sys/vops/ak/abler.x
new file mode 100644
index 00000000..88121ab3
--- /dev/null
+++ b/sys/vops/ak/abler.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure abler (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ables.x b/sys/vops/ak/ables.x
new file mode 100644
index 00000000..3165c0eb
--- /dev/null
+++ b/sys/vops/ak/ables.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure ables (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] <= b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablex.x b/sys/vops/ak/ablex.x
new file mode 100644
index 00000000..98b68857
--- /dev/null
+++ b/sys/vops/ak/ablex.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLE -- Vector boolean less than or equals.  C[i], type INT, is set to 1 if
+# A[i] is less than or equal to B[i], else C[i] is set to zero.
+
+procedure ablex (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (abs (a[i]) <= abs (b[i]))
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abltc.x b/sys/vops/ak/abltc.x
new file mode 100644
index 00000000..46c4c86c
--- /dev/null
+++ b/sys/vops/ak/abltc.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure abltc (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abltd.x b/sys/vops/ak/abltd.x
new file mode 100644
index 00000000..9b392c1f
--- /dev/null
+++ b/sys/vops/ak/abltd.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure abltd (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablti.x b/sys/vops/ak/ablti.x
new file mode 100644
index 00000000..b567b589
--- /dev/null
+++ b/sys/vops/ak/ablti.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure ablti (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abltkc.x b/sys/vops/ak/abltkc.x
new file mode 100644
index 00000000..6917a40b
--- /dev/null
+++ b/sys/vops/ak/abltkc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltkc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltkd.x b/sys/vops/ak/abltkd.x
new file mode 100644
index 00000000..354c9bfb
--- /dev/null
+++ b/sys/vops/ak/abltkd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltki.x b/sys/vops/ak/abltki.x
new file mode 100644
index 00000000..f20f6455
--- /dev/null
+++ b/sys/vops/ak/abltki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltkl.x b/sys/vops/ak/abltkl.x
new file mode 100644
index 00000000..dc02c284
--- /dev/null
+++ b/sys/vops/ak/abltkl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltkr.x b/sys/vops/ak/abltkr.x
new file mode 100644
index 00000000..02531a40
--- /dev/null
+++ b/sys/vops/ak/abltkr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltks.x b/sys/vops/ak/abltks.x
new file mode 100644
index 00000000..3cdb07c5
--- /dev/null
+++ b/sys/vops/ak/abltks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] < 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] < b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltkx.x b/sys/vops/ak/abltkx.x
new file mode 100644
index 00000000..04527b7f
--- /dev/null
+++ b/sys/vops/ak/abltkx.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLTK -- Vector boolean less than constant.  C[i], type INT, is set to 1 if
+# A[i] is less than B, else C[i] is set to zero.
+
+procedure abltkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+real	abs_b
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    call aclri (c, npix)
+	} else {
+	    abs_b = abs (b)
+	    do i = 1, npix
+		if (abs (a[i]) < abs_b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abltl.x b/sys/vops/ak/abltl.x
new file mode 100644
index 00000000..526a8ba3
--- /dev/null
+++ b/sys/vops/ak/abltl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure abltl (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abltr.x b/sys/vops/ak/abltr.x
new file mode 100644
index 00000000..bdaf39eb
--- /dev/null
+++ b/sys/vops/ak/abltr.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure abltr (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/ablts.x b/sys/vops/ak/ablts.x
new file mode 100644
index 00000000..a0a9bded
--- /dev/null
+++ b/sys/vops/ak/ablts.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure ablts (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abltx.x b/sys/vops/ak/abltx.x
new file mode 100644
index 00000000..354238b3
--- /dev/null
+++ b/sys/vops/ak/abltx.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABLT -- Vector boolean less than.  C[i], type INT, is set to 1 if
+# A[i] is less than B[i], else C[i] is set to zero.
+
+procedure abltx (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (abs (a[i]) < abs (b[i]))
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abnec.x b/sys/vops/ak/abnec.x
new file mode 100644
index 00000000..7634ce5d
--- /dev/null
+++ b/sys/vops/ak/abnec.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abnec (a, b, c, npix)
+
+char	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abned.x b/sys/vops/ak/abned.x
new file mode 100644
index 00000000..74da7d12
--- /dev/null
+++ b/sys/vops/ak/abned.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abned (a, b, c, npix)
+
+double	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abnei.x b/sys/vops/ak/abnei.x
new file mode 100644
index 00000000..57ce41c1
--- /dev/null
+++ b/sys/vops/ak/abnei.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abnei (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abnekc.x b/sys/vops/ak/abnekc.x
new file mode 100644
index 00000000..082d2ac9
--- /dev/null
+++ b/sys/vops/ak/abnekc.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnekc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] != 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abnekd.x b/sys/vops/ak/abnekd.x
new file mode 100644
index 00000000..7f95e855
--- /dev/null
+++ b/sys/vops/ak/abnekd.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnekd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0D0) {
+	    do i = 1, npix
+		if (a[i] != 0.0D0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abneki.x b/sys/vops/ak/abneki.x
new file mode 100644
index 00000000..c8e497c8
--- /dev/null
+++ b/sys/vops/ak/abneki.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abneki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] != 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abnekl.x b/sys/vops/ak/abnekl.x
new file mode 100644
index 00000000..4e8537c2
--- /dev/null
+++ b/sys/vops/ak/abnekl.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnekl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] != 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abnekr.x b/sys/vops/ak/abnekr.x
new file mode 100644
index 00000000..effd0fc7
--- /dev/null
+++ b/sys/vops/ak/abnekr.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnekr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0.0) {
+	    do i = 1, npix
+		if (a[i] != 0.0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abneks.x b/sys/vops/ak/abneks.x
new file mode 100644
index 00000000..e587ed1f
--- /dev/null
+++ b/sys/vops/ak/abneks.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abneks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == 0) {
+	    do i = 1, npix
+		if (a[i] != 0)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abnekx.x b/sys/vops/ak/abnekx.x
new file mode 100644
index 00000000..8ddaca07
--- /dev/null
+++ b/sys/vops/ak/abnekx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNEK -- Vector boolean not equals constant.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B, else C[i] is set to zero.
+
+procedure abnekx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	# The case b==0 is perhaps worth optimizing.  On many machines this
+	# will save a memory fetch.
+
+	if (b == (0.0,0.0)) {
+	    do i = 1, npix
+		if (a[i] != (0.0,0.0))
+		    c[i] = 1
+		else
+		    c[i] = 0
+	} else {
+	    do i = 1, npix
+		if (a[i] != b)
+		    c[i] = 1
+		else
+		    c[i] = 0
+	}
+end
diff --git a/sys/vops/ak/abnel.x b/sys/vops/ak/abnel.x
new file mode 100644
index 00000000..3f57b4cb
--- /dev/null
+++ b/sys/vops/ak/abnel.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abnel (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abner.x b/sys/vops/ak/abner.x
new file mode 100644
index 00000000..a5409272
--- /dev/null
+++ b/sys/vops/ak/abner.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abner (a, b, c, npix)
+
+real	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abnes.x b/sys/vops/ak/abnes.x
new file mode 100644
index 00000000..75c23939
--- /dev/null
+++ b/sys/vops/ak/abnes.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abnes (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abnex.x b/sys/vops/ak/abnex.x
new file mode 100644
index 00000000..bc914339
--- /dev/null
+++ b/sys/vops/ak/abnex.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABNE -- Vector boolean not equals.  C[i], type INT, is set to 1 if
+# A[i] is not equal to B[i], else C[i] is set to zero.
+
+procedure abnex (a, b, c, npix)
+
+complex	a[ARB], b[ARB]
+int	c[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		c[i] = 1
+	    else
+		c[i] = 0
+end
diff --git a/sys/vops/ak/abori.x b/sys/vops/ak/abori.x
new file mode 100644
index 00000000..e0ecf2fc
--- /dev/null
+++ b/sys/vops/ak/abori.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABOR -- Compute the bitwise boolean 'or' of two vectors (generic).
+
+procedure abori (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+int	or()
+
+begin
+	do i = 1, npix {
+		c[i] = or (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/aborki.x b/sys/vops/ak/aborki.x
new file mode 100644
index 00000000..760debcc
--- /dev/null
+++ b/sys/vops/ak/aborki.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABORK -- Compute the bitwise boolean or of a vector and a constant
+# (generic).
+
+procedure aborki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+int	or()
+
+begin
+	do i = 1, npix {
+		c[i] = or (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aborkl.x b/sys/vops/ak/aborkl.x
new file mode 100644
index 00000000..262c113e
--- /dev/null
+++ b/sys/vops/ak/aborkl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABORK -- Compute the bitwise boolean or of a vector and a constant
+# (generic).
+
+procedure aborkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+long	orl()
+
+begin
+	do i = 1, npix {
+		c[i] = orl (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aborks.x b/sys/vops/ak/aborks.x
new file mode 100644
index 00000000..a8de717a
--- /dev/null
+++ b/sys/vops/ak/aborks.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABORK -- Compute the bitwise boolean or of a vector and a constant
+# (generic).
+
+procedure aborks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+short	ors()
+
+begin
+	do i = 1, npix {
+		c[i] = ors (a[i], b)
+	}
+end
diff --git a/sys/vops/ak/aborl.x b/sys/vops/ak/aborl.x
new file mode 100644
index 00000000..995b3c3b
--- /dev/null
+++ b/sys/vops/ak/aborl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABOR -- Compute the bitwise boolean 'or' of two vectors (generic).
+
+procedure aborl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+long	orl()
+
+begin
+	do i = 1, npix {
+		c[i] = orl (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/abors.x b/sys/vops/ak/abors.x
new file mode 100644
index 00000000..6ae42d4f
--- /dev/null
+++ b/sys/vops/ak/abors.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABOR -- Compute the bitwise boolean 'or' of two vectors (generic).
+
+procedure abors (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+short	ors()
+
+begin
+	do i = 1, npix {
+		c[i] = ors (a[i], b[i])
+	}
+end
diff --git a/sys/vops/ak/absud.x b/sys/vops/ak/absud.x
new file mode 100644
index 00000000..06a7ae90
--- /dev/null
+++ b/sys/vops/ak/absud.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absud (a, b, nblocks, npix_per_block)
+
+double	a[ARB]			# input vector
+double	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+double	sum
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amovd (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/absui.x b/sys/vops/ak/absui.x
new file mode 100644
index 00000000..ae785103
--- /dev/null
+++ b/sys/vops/ak/absui.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absui (a, b, nblocks, npix_per_block)
+
+int	a[ARB]			# input vector
+int	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amovi (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/absul.x b/sys/vops/ak/absul.x
new file mode 100644
index 00000000..ff803cc6
--- /dev/null
+++ b/sys/vops/ak/absul.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absul (a, b, nblocks, npix_per_block)
+
+long	a[ARB]			# input vector
+long	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amovl (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/absur.x b/sys/vops/ak/absur.x
new file mode 100644
index 00000000..8aaca446
--- /dev/null
+++ b/sys/vops/ak/absur.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absur (a, b, nblocks, npix_per_block)
+
+real	a[ARB]			# input vector
+real	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+real	sum
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amovr (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/absus.x b/sys/vops/ak/absus.x
new file mode 100644
index 00000000..9161ed24
--- /dev/null
+++ b/sys/vops/ak/absus.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ABSU -- Vector block sum.  Each pixel in the output vector is the
+# sum of the input vector over a block of pixels.  The input vector must
+# be at least (nblocks * npix_per_block) pixels in length.
+
+procedure absus (a, b, nblocks, npix_per_block)
+
+short	a[ARB]			# input vector
+short	b[nblocks]		# output vector
+int	nblocks			# number of blocks (pixels in output vector)
+int	npix_per_block		# number of input pixels per block
+
+long	sum
+
+int	i, j
+int	block_offset, next_block, block_length
+
+begin
+	block_offset = 1
+	block_length = npix_per_block
+
+	if (block_length <= 1)
+	    call amovs (a[block_offset], b, nblocks)
+	else {
+	    do j = 1, nblocks {
+		next_block = block_offset + block_length
+		sum = 0
+		do i = block_offset, next_block - 1
+		    sum = sum + a[i]
+		b[j] = sum
+		block_offset = next_block
+	    }
+	}
+end
diff --git a/sys/vops/ak/achtcc.x b/sys/vops/ak/achtcc.x
new file mode 100644
index 00000000..b531ea80
--- /dev/null
+++ b/sys/vops/ak/achtcc.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcc (a, b, npix)
+
+char	a[ARB]
+char	b[ARB]
+int	npix
+
+begin
+	call amovc (a, b, npix)
+end
diff --git a/sys/vops/ak/achtcd.x b/sys/vops/ak/achtcd.x
new file mode 100644
index 00000000..6b0ea760
--- /dev/null
+++ b/sys/vops/ak/achtcd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcd (a, b, npix)
+
+char	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtci.x b/sys/vops/ak/achtci.x
new file mode 100644
index 00000000..3aef94ee
--- /dev/null
+++ b/sys/vops/ak/achtci.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtci (a, b, npix)
+
+char	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtcl.x b/sys/vops/ak/achtcl.x
new file mode 100644
index 00000000..8b01968d
--- /dev/null
+++ b/sys/vops/ak/achtcl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcl (a, b, npix)
+
+char	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtcr.x b/sys/vops/ak/achtcr.x
new file mode 100644
index 00000000..d95534a8
--- /dev/null
+++ b/sys/vops/ak/achtcr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcr (a, b, npix)
+
+char	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtcs.x b/sys/vops/ak/achtcs.x
new file mode 100644
index 00000000..35e5266d
--- /dev/null
+++ b/sys/vops/ak/achtcs.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcs (a, b, npix)
+
+char	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtcx.x b/sys/vops/ak/achtcx.x
new file mode 100644
index 00000000..1c8e1dc6
--- /dev/null
+++ b/sys/vops/ak/achtcx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtcx (a, b, npix)
+
+char	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtdc.x b/sys/vops/ak/achtdc.x
new file mode 100644
index 00000000..309ce09b
--- /dev/null
+++ b/sys/vops/ak/achtdc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdc (a, b, npix)
+
+double	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtdd.x b/sys/vops/ak/achtdd.x
new file mode 100644
index 00000000..76520e5a
--- /dev/null
+++ b/sys/vops/ak/achtdd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdd (a, b, npix)
+
+double	a[ARB]
+double	b[ARB]
+int	npix
+
+begin
+	call amovd (a, b, npix)
+end
diff --git a/sys/vops/ak/achtdi.x b/sys/vops/ak/achtdi.x
new file mode 100644
index 00000000..7647c94f
--- /dev/null
+++ b/sys/vops/ak/achtdi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdi (a, b, npix)
+
+double	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtdl.x b/sys/vops/ak/achtdl.x
new file mode 100644
index 00000000..303d6e7c
--- /dev/null
+++ b/sys/vops/ak/achtdl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdl (a, b, npix)
+
+double	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtdr.x b/sys/vops/ak/achtdr.x
new file mode 100644
index 00000000..f047d66b
--- /dev/null
+++ b/sys/vops/ak/achtdr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdr (a, b, npix)
+
+double	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtds.x b/sys/vops/ak/achtds.x
new file mode 100644
index 00000000..08585d68
--- /dev/null
+++ b/sys/vops/ak/achtds.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtds (a, b, npix)
+
+double	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtdx.x b/sys/vops/ak/achtdx.x
new file mode 100644
index 00000000..0e253f4f
--- /dev/null
+++ b/sys/vops/ak/achtdx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtdx (a, b, npix)
+
+double	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtic.x b/sys/vops/ak/achtic.x
new file mode 100644
index 00000000..17812f52
--- /dev/null
+++ b/sys/vops/ak/achtic.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtic (a, b, npix)
+
+int	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtid.x b/sys/vops/ak/achtid.x
new file mode 100644
index 00000000..d030ef99
--- /dev/null
+++ b/sys/vops/ak/achtid.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtid (a, b, npix)
+
+int	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtii.x b/sys/vops/ak/achtii.x
new file mode 100644
index 00000000..2bda8301
--- /dev/null
+++ b/sys/vops/ak/achtii.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtii (a, b, npix)
+
+int	a[ARB]
+int	b[ARB]
+int	npix
+
+begin
+	call amovi (a, b, npix)
+end
diff --git a/sys/vops/ak/achtil.x b/sys/vops/ak/achtil.x
new file mode 100644
index 00000000..5397d121
--- /dev/null
+++ b/sys/vops/ak/achtil.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtil (a, b, npix)
+
+int	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtir.x b/sys/vops/ak/achtir.x
new file mode 100644
index 00000000..4e17ce9a
--- /dev/null
+++ b/sys/vops/ak/achtir.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtir (a, b, npix)
+
+int	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtis.x b/sys/vops/ak/achtis.x
new file mode 100644
index 00000000..3f6df01c
--- /dev/null
+++ b/sys/vops/ak/achtis.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtis (a, b, npix)
+
+int	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtix.x b/sys/vops/ak/achtix.x
new file mode 100644
index 00000000..7413c08a
--- /dev/null
+++ b/sys/vops/ak/achtix.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtix (a, b, npix)
+
+int	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtlc.x b/sys/vops/ak/achtlc.x
new file mode 100644
index 00000000..67aded51
--- /dev/null
+++ b/sys/vops/ak/achtlc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtlc (a, b, npix)
+
+long	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtld.x b/sys/vops/ak/achtld.x
new file mode 100644
index 00000000..a67a5a42
--- /dev/null
+++ b/sys/vops/ak/achtld.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtld (a, b, npix)
+
+long	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtli.x b/sys/vops/ak/achtli.x
new file mode 100644
index 00000000..0c06f8ba
--- /dev/null
+++ b/sys/vops/ak/achtli.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtli (a, b, npix)
+
+long	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtll.x b/sys/vops/ak/achtll.x
new file mode 100644
index 00000000..ca9a5d05
--- /dev/null
+++ b/sys/vops/ak/achtll.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtll (a, b, npix)
+
+long	a[ARB]
+long	b[ARB]
+int	npix
+
+begin
+	call amovl (a, b, npix)
+end
diff --git a/sys/vops/ak/achtlr.x b/sys/vops/ak/achtlr.x
new file mode 100644
index 00000000..a842c431
--- /dev/null
+++ b/sys/vops/ak/achtlr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtlr (a, b, npix)
+
+long	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtls.x b/sys/vops/ak/achtls.x
new file mode 100644
index 00000000..8e71fc40
--- /dev/null
+++ b/sys/vops/ak/achtls.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtls (a, b, npix)
+
+long	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtlx.x b/sys/vops/ak/achtlx.x
new file mode 100644
index 00000000..ecfc2f68
--- /dev/null
+++ b/sys/vops/ak/achtlx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtlx (a, b, npix)
+
+long	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtrc.x b/sys/vops/ak/achtrc.x
new file mode 100644
index 00000000..0c16881a
--- /dev/null
+++ b/sys/vops/ak/achtrc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrc (a, b, npix)
+
+real	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtrd.x b/sys/vops/ak/achtrd.x
new file mode 100644
index 00000000..ef25741d
--- /dev/null
+++ b/sys/vops/ak/achtrd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrd (a, b, npix)
+
+real	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtri.x b/sys/vops/ak/achtri.x
new file mode 100644
index 00000000..38b137bf
--- /dev/null
+++ b/sys/vops/ak/achtri.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtri (a, b, npix)
+
+real	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtrl.x b/sys/vops/ak/achtrl.x
new file mode 100644
index 00000000..fa30f59c
--- /dev/null
+++ b/sys/vops/ak/achtrl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrl (a, b, npix)
+
+real	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtrr.x b/sys/vops/ak/achtrr.x
new file mode 100644
index 00000000..9825cc95
--- /dev/null
+++ b/sys/vops/ak/achtrr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrr (a, b, npix)
+
+real	a[ARB]
+real	b[ARB]
+int	npix
+
+begin
+	call amovr (a, b, npix)
+end
diff --git a/sys/vops/ak/achtrs.x b/sys/vops/ak/achtrs.x
new file mode 100644
index 00000000..f3bcb1f9
--- /dev/null
+++ b/sys/vops/ak/achtrs.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrs (a, b, npix)
+
+real	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtrx.x b/sys/vops/ak/achtrx.x
new file mode 100644
index 00000000..047fdad5
--- /dev/null
+++ b/sys/vops/ak/achtrx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtrx (a, b, npix)
+
+real	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtsc.x b/sys/vops/ak/achtsc.x
new file mode 100644
index 00000000..b8a951bf
--- /dev/null
+++ b/sys/vops/ak/achtsc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsc (a, b, npix)
+
+short	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtsd.x b/sys/vops/ak/achtsd.x
new file mode 100644
index 00000000..a2b5d3af
--- /dev/null
+++ b/sys/vops/ak/achtsd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsd (a, b, npix)
+
+short	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtsi.x b/sys/vops/ak/achtsi.x
new file mode 100644
index 00000000..666530bf
--- /dev/null
+++ b/sys/vops/ak/achtsi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsi (a, b, npix)
+
+short	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtsl.x b/sys/vops/ak/achtsl.x
new file mode 100644
index 00000000..867e3f25
--- /dev/null
+++ b/sys/vops/ak/achtsl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsl (a, b, npix)
+
+short	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtsr.x b/sys/vops/ak/achtsr.x
new file mode 100644
index 00000000..7f16c424
--- /dev/null
+++ b/sys/vops/ak/achtsr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsr (a, b, npix)
+
+short	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtss.x b/sys/vops/ak/achtss.x
new file mode 100644
index 00000000..2d8be27b
--- /dev/null
+++ b/sys/vops/ak/achtss.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtss (a, b, npix)
+
+short	a[ARB]
+short	b[ARB]
+int	npix
+
+begin
+	call amovs (a, b, npix)
+end
diff --git a/sys/vops/ak/achtsx.x b/sys/vops/ak/achtsx.x
new file mode 100644
index 00000000..f059d135
--- /dev/null
+++ b/sys/vops/ak/achtsx.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtsx (a, b, npix)
+
+short	a[ARB]
+complex	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = npix, 1, -1
+			b[i] = complex(real(a[i]),0.0)
+end
diff --git a/sys/vops/ak/achtxc.x b/sys/vops/ak/achtxc.x
new file mode 100644
index 00000000..06625215
--- /dev/null
+++ b/sys/vops/ak/achtxc.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxc (a, b, npix)
+
+complex	a[ARB]
+char	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxd.x b/sys/vops/ak/achtxd.x
new file mode 100644
index 00000000..3548ee23
--- /dev/null
+++ b/sys/vops/ak/achtxd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxd (a, b, npix)
+
+complex	a[ARB]
+double	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxi.x b/sys/vops/ak/achtxi.x
new file mode 100644
index 00000000..403be396
--- /dev/null
+++ b/sys/vops/ak/achtxi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxi (a, b, npix)
+
+complex	a[ARB]
+int	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxl.x b/sys/vops/ak/achtxl.x
new file mode 100644
index 00000000..eef669dd
--- /dev/null
+++ b/sys/vops/ak/achtxl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxl (a, b, npix)
+
+complex	a[ARB]
+long	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxr.x b/sys/vops/ak/achtxr.x
new file mode 100644
index 00000000..35352510
--- /dev/null
+++ b/sys/vops/ak/achtxr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxr (a, b, npix)
+
+complex	a[ARB]
+real	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxs.x b/sys/vops/ak/achtxs.x
new file mode 100644
index 00000000..d4e36256
--- /dev/null
+++ b/sys/vops/ak/achtxs.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxs (a, b, npix)
+
+complex	a[ARB]
+short	b[ARB]
+int	npix
+int	i
+
+begin
+		do i = 1, npix
+			b[i] = a[i]
+end
diff --git a/sys/vops/ak/achtxx.x b/sys/vops/ak/achtxx.x
new file mode 100644
index 00000000..fe5072db
--- /dev/null
+++ b/sys/vops/ak/achtxx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACHTxy -- Change datatype of vector from "x" to "y" (doubly generic).
+# The operation is performed in such a way that the output vector can be
+# the same as the input vector without overwriting data.
+
+procedure achtxx (a, b, npix)
+
+complex	a[ARB]
+complex	b[ARB]
+int	npix
+
+begin
+	call amovx (a, b, npix)
+end
diff --git a/sys/vops/ak/acjgx.x b/sys/vops/ak/acjgx.x
new file mode 100644
index 00000000..1fc9f944
--- /dev/null
+++ b/sys/vops/ak/acjgx.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACJGX -- Complex conjugate of a complex vector.
+
+procedure acjgx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    b[i] = conjg (a[i])
+end
diff --git a/sys/vops/ak/aclrc.x b/sys/vops/ak/aclrc.x
new file mode 100644
index 00000000..03a82c86
--- /dev/null
+++ b/sys/vops/ak/aclrc.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrc (a, npix)
+
+char	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0
+end
diff --git a/sys/vops/ak/aclrd.x b/sys/vops/ak/aclrd.x
new file mode 100644
index 00000000..791eb7c0
--- /dev/null
+++ b/sys/vops/ak/aclrd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrd (a, npix)
+
+double	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0.0D0
+end
diff --git a/sys/vops/ak/aclri.x b/sys/vops/ak/aclri.x
new file mode 100644
index 00000000..0b022bb3
--- /dev/null
+++ b/sys/vops/ak/aclri.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclri (a, npix)
+
+int	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0
+end
diff --git a/sys/vops/ak/aclrl.x b/sys/vops/ak/aclrl.x
new file mode 100644
index 00000000..c56fb5b3
--- /dev/null
+++ b/sys/vops/ak/aclrl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrl (a, npix)
+
+long	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0
+end
diff --git a/sys/vops/ak/aclrr.x b/sys/vops/ak/aclrr.x
new file mode 100644
index 00000000..9102ce7c
--- /dev/null
+++ b/sys/vops/ak/aclrr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrr (a, npix)
+
+real	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0.0
+end
diff --git a/sys/vops/ak/aclrs.x b/sys/vops/ak/aclrs.x
new file mode 100644
index 00000000..a42a6b00
--- /dev/null
+++ b/sys/vops/ak/aclrs.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrs (a, npix)
+
+short	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = 0
+end
diff --git a/sys/vops/ak/aclrx.x b/sys/vops/ak/aclrx.x
new file mode 100644
index 00000000..a27e555f
--- /dev/null
+++ b/sys/vops/ak/aclrx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACLR -- Zero a vector (generic).
+
+procedure aclrx (a, npix)
+
+complex	a[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    a[i] = (0.0,0.0)
+end
diff --git a/sys/vops/ak/acnvd.x b/sys/vops/ak/acnvd.x
new file mode 100644
index 00000000..7871ac93
--- /dev/null
+++ b/sys/vops/ak/acnvd.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnvd (in, out, npix, kernel, knpix)
+
+double	in[npix+knpix-1]	# input vector, including boundary pixels
+double	out[ARB]		# output vector
+int	npix			# length of output vector
+double	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+double	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvi.x b/sys/vops/ak/acnvi.x
new file mode 100644
index 00000000..70a236f8
--- /dev/null
+++ b/sys/vops/ak/acnvi.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnvi (in, out, npix, kernel, knpix)
+
+int	in[npix+knpix-1]	# input vector, including boundary pixels
+int	out[ARB]		# output vector
+int	npix			# length of output vector
+int	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+int	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvl.x b/sys/vops/ak/acnvl.x
new file mode 100644
index 00000000..98fc18f0
--- /dev/null
+++ b/sys/vops/ak/acnvl.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnvl (in, out, npix, kernel, knpix)
+
+long	in[npix+knpix-1]	# input vector, including boundary pixels
+long	out[ARB]		# output vector
+int	npix			# length of output vector
+long	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+long	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvr.x b/sys/vops/ak/acnvr.x
new file mode 100644
index 00000000..b1119c29
--- /dev/null
+++ b/sys/vops/ak/acnvr.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnvr (in, out, npix, kernel, knpix)
+
+real	in[npix+knpix-1]	# input vector, including boundary pixels
+real	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvrd.x b/sys/vops/ak/acnvrd.x
new file mode 100644
index 00000000..c6b3fb2f
--- /dev/null
+++ b/sys/vops/ak/acnvrd.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvrd (in, out, npix, kernel, knpix)
+
+double	in[npix+knpix-1]	# input vector, including boundary pixels
+double	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvri.x b/sys/vops/ak/acnvri.x
new file mode 100644
index 00000000..290c093b
--- /dev/null
+++ b/sys/vops/ak/acnvri.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvri (in, out, npix, kernel, knpix)
+
+int	in[npix+knpix-1]	# input vector, including boundary pixels
+int	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvrl.x b/sys/vops/ak/acnvrl.x
new file mode 100644
index 00000000..44df6dad
--- /dev/null
+++ b/sys/vops/ak/acnvrl.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvrl (in, out, npix, kernel, knpix)
+
+long	in[npix+knpix-1]	# input vector, including boundary pixels
+long	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvrr.x b/sys/vops/ak/acnvrr.x
new file mode 100644
index 00000000..83f4143c
--- /dev/null
+++ b/sys/vops/ak/acnvrr.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvrr (in, out, npix, kernel, knpix)
+
+real	in[npix+knpix-1]	# input vector, including boundary pixels
+real	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvrs.x b/sys/vops/ak/acnvrs.x
new file mode 100644
index 00000000..b00d4a92
--- /dev/null
+++ b/sys/vops/ak/acnvrs.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNVR -- Vector convolution with a real kernel.  The output vector is equal
+# to the sum of its initial value and the convolution of the input vector with
+# the kernel.  This routine assumes boundary extension on the input vector has
+# been provided.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+#
+# See also acnv_, if the kernel is the same datatype as the data vectors.
+
+procedure acnvrs (in, out, npix, kernel, knpix)
+
+short	in[npix+knpix-1]	# input vector, including boundary pixels
+short	out[ARB]		# output vector
+int	npix			# length of output vector
+real	kernel[knpix]		# convolution kernel, always type real
+int	knpix			# size of convolution kernel
+
+int	i, j
+real	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/acnvs.x b/sys/vops/ak/acnvs.x
new file mode 100644
index 00000000..9a11eda9
--- /dev/null
+++ b/sys/vops/ak/acnvs.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ACNV -- Vector convolution.  The output vector is equal to the sum of its
+# initial value and the convolution of the input vector with the kernel.
+# This routine assumes boundary extension on the input vector has been provided.
+# For short kernels, we unroll the inner do loop into a single statement to
+# reduce loop overhead.
+#
+# Example: npix=10, kpix=5, 2 pixels out of bounds on either end.
+# in[1] corresponds to x = -1
+#
+#	-1  0  1  2  3  4  5  6  7  8  9 10 11 12	(x coord)
+#	 1  2  3  4  5
+#	    1  2  3  4  5
+#			...
+#				    1  2  3  4  5
+
+procedure acnvs (in, out, npix, kernel, knpix)
+
+short	in[npix+knpix-1]	# input vector, including boundary pixels
+short	out[ARB]		# output vector
+int	npix			# length of output vector
+short	kernel[knpix]		# convolution kernel
+int	knpix			# size of convolution kernel
+
+int	i, j
+short	sum, k1, k2, k3, k4, k5
+
+begin
+	switch (knpix) {
+	case 3:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2]
+	case 5:
+	    k1 = kernel[1]
+	    k2 = kernel[2]
+	    k3 = kernel[3]
+	    k4 = kernel[4]
+	    k5 = kernel[5]
+	    do i = 1, npix
+	        out[i] = out[i] + k1 * in[i] + k2 * in[i+1] + k3 * in[i+2] +
+		    k4 * in[i+3] + k5 * in[i+4]
+	default:
+	    do i = 1, npix {
+	        sum = out[i]
+	        do j = 1, knpix
+		    sum = sum + (kernel[j] * in[i+j-1])
+	        out[i] = sum
+	    }
+	}
+end
diff --git a/sys/vops/ak/adivd.x b/sys/vops/ak/adivd.x
new file mode 100644
index 00000000..73f43925
--- /dev/null
+++ b/sys/vops/ak/adivd.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adivi.x b/sys/vops/ak/adivi.x
new file mode 100644
index 00000000..2237363b
--- /dev/null
+++ b/sys/vops/ak/adivi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adivkd.x b/sys/vops/ak/adivkd.x
new file mode 100644
index 00000000..3758ab33
--- /dev/null
+++ b/sys/vops/ak/adivkd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivki.x b/sys/vops/ak/adivki.x
new file mode 100644
index 00000000..ef4a3949
--- /dev/null
+++ b/sys/vops/ak/adivki.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivkl.x b/sys/vops/ak/adivkl.x
new file mode 100644
index 00000000..cb1ae2e4
--- /dev/null
+++ b/sys/vops/ak/adivkl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivkr.x b/sys/vops/ak/adivkr.x
new file mode 100644
index 00000000..5f47c21e
--- /dev/null
+++ b/sys/vops/ak/adivkr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivks.x b/sys/vops/ak/adivks.x
new file mode 100644
index 00000000..cb821d21
--- /dev/null
+++ b/sys/vops/ak/adivks.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivkx.x b/sys/vops/ak/adivkx.x
new file mode 100644
index 00000000..c11a4bfd
--- /dev/null
+++ b/sys/vops/ak/adivkx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIVK -- Divide a vector by a constant (generic).  No divide by zero checking
+# is performed.
+
+procedure adivkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b
+end
diff --git a/sys/vops/ak/adivl.x b/sys/vops/ak/adivl.x
new file mode 100644
index 00000000..b449bd31
--- /dev/null
+++ b/sys/vops/ak/adivl.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adivr.x b/sys/vops/ak/adivr.x
new file mode 100644
index 00000000..323d6e55
--- /dev/null
+++ b/sys/vops/ak/adivr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adivs.x b/sys/vops/ak/adivs.x
new file mode 100644
index 00000000..ed8785bb
--- /dev/null
+++ b/sys/vops/ak/adivs.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivs (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adivx.x b/sys/vops/ak/adivx.x
new file mode 100644
index 00000000..1aa3013c
--- /dev/null
+++ b/sys/vops/ak/adivx.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADIV -- Divide two vectors (generic).  No divide by zero checking is
+# performed.  If this is desired, advz should be used instead.
+
+procedure adivx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] / b[i]
+end
diff --git a/sys/vops/ak/adotd.x b/sys/vops/ak/adotd.x
new file mode 100644
index 00000000..167a82b8
--- /dev/null
+++ b/sys/vops/ak/adotd.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+double procedure adotd (a, b, npix)
+
+double	a[ARB], b[ARB]
+
+double	sum
+
+int	npix, i
+
+begin
+	sum = 0.0D0
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/adoti.x b/sys/vops/ak/adoti.x
new file mode 100644
index 00000000..7bb6bf29
--- /dev/null
+++ b/sys/vops/ak/adoti.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+real procedure adoti (a, b, npix)
+
+int	a[ARB], b[ARB]
+
+real	sum
+
+int	npix, i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/adotl.x b/sys/vops/ak/adotl.x
new file mode 100644
index 00000000..0df6d038
--- /dev/null
+++ b/sys/vops/ak/adotl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+double procedure adotl (a, b, npix)
+
+long	a[ARB], b[ARB]
+
+double	sum
+
+int	npix, i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/adotr.x b/sys/vops/ak/adotr.x
new file mode 100644
index 00000000..309c4f83
--- /dev/null
+++ b/sys/vops/ak/adotr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+real procedure adotr (a, b, npix)
+
+real	a[ARB], b[ARB]
+
+real	sum
+
+int	npix, i
+
+begin
+	sum = 0.0
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/adots.x b/sys/vops/ak/adots.x
new file mode 100644
index 00000000..391fb7ca
--- /dev/null
+++ b/sys/vops/ak/adots.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+real procedure adots (a, b, npix)
+
+short	a[ARB], b[ARB]
+
+real	sum
+
+int	npix, i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/adotx.x b/sys/vops/ak/adotx.x
new file mode 100644
index 00000000..42006e3d
--- /dev/null
+++ b/sys/vops/ak/adotx.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADOT -- Vector inner or dot product.  The function value is the sum of the
+# products of each pair of elements of the input vectors.
+
+real procedure adotx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+
+real	sum
+
+int	npix, i
+
+begin
+	sum = (0.0,0.0)
+	do i = 1, npix
+	    sum = sum + a[i] * b[i]
+
+	return (sum)
+end
diff --git a/sys/vops/ak/advzd.x b/sys/vops/ak/advzd.x
new file mode 100644
index 00000000..ca5bb0da
--- /dev/null
+++ b/sys/vops/ak/advzd.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzd (a, b, c, npix, errfcn)
+
+double	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+double	errfcn()		# user function, called on divide by zero
+
+int	i
+double	divisor
+double	tol
+extern	errfcn()
+errchk	errfcn
+
+begin
+	    tol = 1.0D-20
+
+	do i = 1, npix {
+	    divisor = b[i]
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a[i])
+			next
+		    }
+		c[i] = a[i] / divisor
+
+	}
+end
diff --git a/sys/vops/ak/advzi.x b/sys/vops/ak/advzi.x
new file mode 100644
index 00000000..5aa0810e
--- /dev/null
+++ b/sys/vops/ak/advzi.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzi (a, b, c, npix, errfcn)
+
+int	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+int	errfcn()		# user function, called on divide by zero
+
+int	i
+int	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a[i])
+		else
+		    c[i] = a[i] / divisor
+	}
+end
diff --git a/sys/vops/ak/advzl.x b/sys/vops/ak/advzl.x
new file mode 100644
index 00000000..22f1a278
--- /dev/null
+++ b/sys/vops/ak/advzl.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzl (a, b, c, npix, errfcn)
+
+long	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+long	errfcn()		# user function, called on divide by zero
+
+int	i
+long	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a[i])
+		else
+		    c[i] = a[i] / divisor
+	}
+end
diff --git a/sys/vops/ak/advzr.x b/sys/vops/ak/advzr.x
new file mode 100644
index 00000000..deb36e3c
--- /dev/null
+++ b/sys/vops/ak/advzr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzr (a, b, c, npix, errfcn)
+
+real	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+real	errfcn()		# user function, called on divide by zero
+
+int	i
+real	divisor
+real	tol
+extern	errfcn()
+errchk	errfcn
+
+begin
+	    tol = 1.0E-20
+
+	do i = 1, npix {
+	    divisor = b[i]
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a[i])
+			next
+		    }
+		c[i] = a[i] / divisor
+
+	}
+end
diff --git a/sys/vops/ak/advzs.x b/sys/vops/ak/advzs.x
new file mode 100644
index 00000000..98a9603f
--- /dev/null
+++ b/sys/vops/ak/advzs.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzs (a, b, c, npix, errfcn)
+
+short	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+short	errfcn()		# user function, called on divide by zero
+
+int	i
+short	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a[i])
+		else
+		    c[i] = a[i] / divisor
+	}
+end
diff --git a/sys/vops/ak/advzx.x b/sys/vops/ak/advzx.x
new file mode 100644
index 00000000..e6089049
--- /dev/null
+++ b/sys/vops/ak/advzx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ADVZ -- Vector divide with checking for zero divisors.  If the result of a
+# divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure advzx (a, b, c, npix, errfcn)
+
+complex	a[ARB], b[ARB], c[ARB]	# numerator, divisor, and output arrays
+int	npix			# number of pixels
+complex	errfcn()		# user function, called on divide by zero
+
+int	i
+complex	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == (0.0,0.0))
+		    c[i] = errfcn (a[i])
+		else
+		    c[i] = a[i] / divisor
+	}
+end
diff --git a/sys/vops/ak/aexpd.x b/sys/vops/ak/aexpd.x
new file mode 100644
index 00000000..f0278777
--- /dev/null
+++ b/sys/vops/ak/aexpd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexpd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/aexpi.x b/sys/vops/ak/aexpi.x
new file mode 100644
index 00000000..0e332a9a
--- /dev/null
+++ b/sys/vops/ak/aexpi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexpi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/aexpkd.x b/sys/vops/ak/aexpkd.x
new file mode 100644
index 00000000..7c6f58b9
--- /dev/null
+++ b/sys/vops/ak/aexpkd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpki.x b/sys/vops/ak/aexpki.x
new file mode 100644
index 00000000..609b73c1
--- /dev/null
+++ b/sys/vops/ak/aexpki.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpkl.x b/sys/vops/ak/aexpkl.x
new file mode 100644
index 00000000..941dade0
--- /dev/null
+++ b/sys/vops/ak/aexpkl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpkr.x b/sys/vops/ak/aexpkr.x
new file mode 100644
index 00000000..ee083471
--- /dev/null
+++ b/sys/vops/ak/aexpkr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpks.x b/sys/vops/ak/aexpks.x
new file mode 100644
index 00000000..cfcd1218
--- /dev/null
+++ b/sys/vops/ak/aexpks.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpkx.x b/sys/vops/ak/aexpkx.x
new file mode 100644
index 00000000..4251fca2
--- /dev/null
+++ b/sys/vops/ak/aexpkx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXPK -- Compute a ** b, where b is a constant of type PIXEL (generic).
+
+procedure aexpkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b
+end
diff --git a/sys/vops/ak/aexpl.x b/sys/vops/ak/aexpl.x
new file mode 100644
index 00000000..493f7bfa
--- /dev/null
+++ b/sys/vops/ak/aexpl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexpl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/aexpr.x b/sys/vops/ak/aexpr.x
new file mode 100644
index 00000000..3e0877ff
--- /dev/null
+++ b/sys/vops/ak/aexpr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexpr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/aexps.x b/sys/vops/ak/aexps.x
new file mode 100644
index 00000000..e0c47207
--- /dev/null
+++ b/sys/vops/ak/aexps.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexps (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/aexpx.x b/sys/vops/ak/aexpx.x
new file mode 100644
index 00000000..84d1e4c6
--- /dev/null
+++ b/sys/vops/ak/aexpx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AEXP -- Compute a ** b, where b is of type PIXEL (generic).
+
+procedure aexpx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/ak/afftrr.x b/sys/vops/ak/afftrr.x
new file mode 100644
index 00000000..024f4456
--- /dev/null
+++ b/sys/vops/ak/afftrr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTRR -- Forward fourier transform (real transform, real output arrays).
+# The forward transform of the real array SR length NPIX is computed and
+# returned in the real arrays FR and FI of length NPIX/2+1.  Since the real
+# transform is being performed the array SI is ignored and may be omitted.
+# The transformation may be performed in place if desired.  NPIX must be a
+# power of 2.
+
+procedure afftrr (sr, si, fr, fi, npix)
+
+real	sr[ARB], si[ARB]	# spatial data (input).  SI NOT USED.
+real	fr[ARB], fi[ARB]	# real and imag parts of transform (output)
+int	npix
+int	ier
+pointer	sp, work
+
+begin
+	call smark (sp)
+	call salloc (work, npix + 2, TY_REAL)
+
+	# Copy the real data vector into the work array.
+	call amovr (sr, Memr[work], npix)
+
+	# Compute the forward transform.
+	call ffa (Memr[work], npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrr: npix not a power of 2")
+
+	# Unpack the real and imaginary parts into the output arrays.
+	call aupxr (Memr[work], fr, fi, npix / 2 + 1)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/ak/afftrx.x b/sys/vops/ak/afftrx.x
new file mode 100644
index 00000000..ec43b16a
--- /dev/null
+++ b/sys/vops/ak/afftrx.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTRX -- Forward fourier transform (real transform, complex output).
+# The fourier transform of the real array A of length NPIX pixels is computed
+# and the NPIX/2+1 complex transform coefficients are returned in the complex
+# array B.  The first element of array B upon output contains the dc term at
+# zero frequency, and the remaining elements contain the real and imaginary
+# components of the harmonics.  The transformation may be performed in place
+# if desired.  NPIX must be a power of 2.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# B to be a type COMPLEX array in the calling program, but FFA expects a
+# REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure afftrx (a, b, npix)
+
+real	a[ARB]		# data (input)
+complex	b[ARB]		# transform (output).  Dim npix/2+1
+int	npix
+int	ier
+
+begin
+	# The following is a no-op if A and B are the same array.
+	call amovr (a, b, npix)
+
+	# Compute the forward real transform.
+	call ffa (b, npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrx: npix not a power of 2")
+end
diff --git a/sys/vops/ak/afftxr.x b/sys/vops/ak/afftxr.x
new file mode 100644
index 00000000..b09ae0f5
--- /dev/null
+++ b/sys/vops/ak/afftxr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTXR -- Forward fourier transform (complex transform, real arrays).
+# The fourier transform of the real arrays SR and SI containing complex data
+# pairs is computed and the complex transform coefficients are returned in
+# the real arrays FR and FI.  The transformation may be performed in place if
+# desired.  NPIX must be a power of 2.
+
+procedure afftxr (sr, si, fr, fi, npix)
+
+real	sr[ARB], si[ARB]	# data, spatial domain (input)
+real	fr[ARB], fi[ARB]	# transform, frequency domain (output)
+int	npix
+int	ier
+
+begin
+	# The following are no-ops if the transform is being performed
+	# in place.
+
+	call amovr (sr, fr, npix)
+	call amovr (si, fi, npix)
+
+	# Compute the forward transform.
+	call fft842 (0, npix, fr, fi, ier)
+	if (ier == 1)
+	    call fatal (1, "afftxr: npix not a power of 2")
+end
diff --git a/sys/vops/ak/afftxx.x b/sys/vops/ak/afftxx.x
new file mode 100644
index 00000000..34eedbf9
--- /dev/null
+++ b/sys/vops/ak/afftxx.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AFFTXX -- Forward fourier transform (complex transform, complex data).
+# The fourier transform of the complex array A of length NPIX pixels is
+# computed and the NPIX complex transform coefficients are returned in the
+# complex array B.  The transformation may be performed in place if desired.
+# NPIX must be a power of 2.
+
+procedure afftxx (a, b, npix)
+
+complex	a[ARB]			# data (input)
+complex	b[ARB]			# transform (output)
+int	npix
+
+int	ier
+pointer	sp, xr, xi
+
+begin
+	call smark (sp)
+	call salloc (xr, npix, TY_REAL)
+	call salloc (xi, npix, TY_REAL)
+
+	# Rearrange the elements of the A array as required by FFT842.
+	# Convert the array A of complex values into an array of reals
+	# and an array of imaginaries.
+
+	call aupxr (a, Memr[xr], Memr[xi], npix)
+
+	# Compute the forward transform.
+	call fft842 (0, npix, Memr[xr], Memr[xi], ier)
+	if (ier == 1)
+	    call fatal (1, "afftxx: npix not a power of 2")
+
+	# Repack the real and imaginary arrays to form the complex output
+	# array.
+	call apkxr (Memr[xr], Memr[xi], b, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/ak/agltc.x b/sys/vops/ak/agltc.x
new file mode 100644
index 00000000..4f87a8fc
--- /dev/null
+++ b/sys/vops/ak/agltc.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure agltc (a, b, npix, low, high, kmul, kadd, nrange)
+
+char	a[ARB], b[ARB], pixval
+int	npix, i
+char	low[nrange], high[nrange]	# range limits
+real	kmul[nrange], kadd[nrange]
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/agltd.x b/sys/vops/ak/agltd.x
new file mode 100644
index 00000000..c307fe7d
--- /dev/null
+++ b/sys/vops/ak/agltd.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure agltd (a, b, npix, low, high, kmul, kadd, nrange)
+
+double	a[ARB], b[ARB], pixval
+int	npix, i
+double	low[nrange], high[nrange]	# range limits
+double	kmul[nrange], kadd[nrange]	# linear transformation
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0D0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/aglti.x b/sys/vops/ak/aglti.x
new file mode 100644
index 00000000..c37a650e
--- /dev/null
+++ b/sys/vops/ak/aglti.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure aglti (a, b, npix, low, high, kmul, kadd, nrange)
+
+int	a[ARB], b[ARB], pixval
+int	npix, i
+int	low[nrange], high[nrange]	# range limits
+real	kmul[nrange], kadd[nrange]
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/agltl.x b/sys/vops/ak/agltl.x
new file mode 100644
index 00000000..3a416d37
--- /dev/null
+++ b/sys/vops/ak/agltl.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure agltl (a, b, npix, low, high, kmul, kadd, nrange)
+
+long	a[ARB], b[ARB], pixval
+int	npix, i
+long	low[nrange], high[nrange]	# range limits
+double	kmul[nrange], kadd[nrange]	# linear transformation
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0D0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/agltr.x b/sys/vops/ak/agltr.x
new file mode 100644
index 00000000..974344a4
--- /dev/null
+++ b/sys/vops/ak/agltr.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure agltr (a, b, npix, low, high, kmul, kadd, nrange)
+
+real	a[ARB], b[ARB], pixval
+int	npix, i
+real	low[nrange], high[nrange]	# range limits
+real	kmul[nrange], kadd[nrange]
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/aglts.x b/sys/vops/ak/aglts.x
new file mode 100644
index 00000000..ba18d1ac
--- /dev/null
+++ b/sys/vops/ak/aglts.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure aglts (a, b, npix, low, high, kmul, kadd, nrange)
+
+short	a[ARB], b[ARB], pixval
+int	npix, i
+short	low[nrange], high[nrange]	# range limits
+real	kmul[nrange], kadd[nrange]
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+	    do nr = 1, nrange
+		if (pixval >= low[nr] && pixval <= high[nr]) {
+			if (kmul[nr] == 0.0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/agltx.x b/sys/vops/ak/agltx.x
new file mode 100644
index 00000000..c50cfccf
--- /dev/null
+++ b/sys/vops/ak/agltx.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AGLT -- Given a list of ranges, replace the value of each input pixel
+# which falls within a given range by applying the corresponding linear
+# transformation (b = a * kmul + kadd).  If KMUL is identically zero,
+# B is replaced by the constant KADD.
+
+procedure agltx (a, b, npix, low, high, kmul, kadd, nrange)
+
+complex	a[ARB], b[ARB], pixval
+int	npix, i
+complex	low[nrange], high[nrange]	# range limits
+real	kmul[nrange], kadd[nrange]
+real	abs_pixval
+int	nrange, nr
+
+begin
+	do i = 1, npix {
+	    pixval = a[i]
+	    b[i] = pixval
+		abs_pixval = abs (pixval)
+	    do nr = 1, nrange
+		if (abs_pixval >= abs (low[nr]) &&
+		abs_pixval <= abs (high[nr])) {
+			if (kmul[nr] == 0.0)
+			    b[i] = kadd[nr]
+			else
+			    b[i] = (pixval * kmul[nr]) + kadd[nr]
+			break
+		}
+	}
+end
diff --git a/sys/vops/ak/ahgmc.x b/sys/vops/ak/ahgmc.x
new file mode 100644
index 00000000..b0917e8f
--- /dev/null
+++ b/sys/vops/ak/ahgmc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgmc (data, npix, hgm, nbins, z1, z2)
+
+char 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+char	z1, z2			# greyscale values of first and last bins
+
+char	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahgmd.x b/sys/vops/ak/ahgmd.x
new file mode 100644
index 00000000..cd75445f
--- /dev/null
+++ b/sys/vops/ak/ahgmd.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgmd (data, npix, hgm, nbins, z1, z2)
+
+double 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+double	z1, z2			# greyscale values of first and last bins
+
+double	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahgmi.x b/sys/vops/ak/ahgmi.x
new file mode 100644
index 00000000..36c11db8
--- /dev/null
+++ b/sys/vops/ak/ahgmi.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgmi (data, npix, hgm, nbins, z1, z2)
+
+int 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+int	z1, z2			# greyscale values of first and last bins
+
+int	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahgml.x b/sys/vops/ak/ahgml.x
new file mode 100644
index 00000000..f515a2e4
--- /dev/null
+++ b/sys/vops/ak/ahgml.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgml (data, npix, hgm, nbins, z1, z2)
+
+long 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+long	z1, z2			# greyscale values of first and last bins
+
+long	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahgmr.x b/sys/vops/ak/ahgmr.x
new file mode 100644
index 00000000..a1f90d67
--- /dev/null
+++ b/sys/vops/ak/ahgmr.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgmr (data, npix, hgm, nbins, z1, z2)
+
+real 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+real	z1, z2			# greyscale values of first and last bins
+
+real	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahgms.x b/sys/vops/ak/ahgms.x
new file mode 100644
index 00000000..fb656c02
--- /dev/null
+++ b/sys/vops/ak/ahgms.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# AHGM -- Accumulate the histogram of the input vector.  The output vector
+# HGM (the histogram) should be cleared prior to the first call.
+
+procedure ahgms (data, npix, hgm, nbins, z1, z2)
+
+short 	data[ARB]		# data vector
+int	npix			# number of pixels
+int	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+short	z1, z2			# greyscale values of first and last bins
+
+short	z
+real	dz
+int	bin, i
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int (z - z1) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+		if (z >= z1 && z <= z2) {
+		    bin = int ((z - z1) * dz) + 1
+		    hgm[bin] = hgm[bin] + 1
+		}
+	    }
+	}
+end
diff --git a/sys/vops/ak/ahivc.x b/sys/vops/ak/ahivc.x
new file mode 100644
index 00000000..93a39259
--- /dev/null
+++ b/sys/vops/ak/ahivc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+char procedure ahivc (a, npix)
+
+char	a[ARB]
+int	npix
+char	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivd.x b/sys/vops/ak/ahivd.x
new file mode 100644
index 00000000..fb851f95
--- /dev/null
+++ b/sys/vops/ak/ahivd.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+double procedure ahivd (a, npix)
+
+double	a[ARB]
+int	npix
+double	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivi.x b/sys/vops/ak/ahivi.x
new file mode 100644
index 00000000..41effe58
--- /dev/null
+++ b/sys/vops/ak/ahivi.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+int procedure ahivi (a, npix)
+
+int	a[ARB]
+int	npix
+int	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivl.x b/sys/vops/ak/ahivl.x
new file mode 100644
index 00000000..a6edb516
--- /dev/null
+++ b/sys/vops/ak/ahivl.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+long procedure ahivl (a, npix)
+
+long	a[ARB]
+int	npix
+long	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivr.x b/sys/vops/ak/ahivr.x
new file mode 100644
index 00000000..0485e6bf
--- /dev/null
+++ b/sys/vops/ak/ahivr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+real procedure ahivr (a, npix)
+
+real	a[ARB]
+int	npix
+real	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivs.x b/sys/vops/ak/ahivs.x
new file mode 100644
index 00000000..2613473f
--- /dev/null
+++ b/sys/vops/ak/ahivs.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+short procedure ahivs (a, npix)
+
+short	a[ARB]
+int	npix
+short	high, pixval
+int	i
+
+begin
+	high = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval > high)
+		high = pixval
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/ahivx.x b/sys/vops/ak/ahivx.x
new file mode 100644
index 00000000..b487aa8d
--- /dev/null
+++ b/sys/vops/ak/ahivx.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AHIV -- Compute the high value (maximum) of a vector.
+
+complex procedure ahivx (a, npix)
+
+complex	a[ARB]
+int	npix
+complex	high, pixval
+real	abs_high
+int	i
+
+begin
+	high = a[1]
+	abs_high = abs (high)
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (abs (pixval) > abs_high) {
+		high = pixval
+		abs_high = abs (high)
+	    }
+	}
+
+	return (high)
+end
diff --git a/sys/vops/ak/aiftrr.x b/sys/vops/ak/aiftrr.x
new file mode 100644
index 00000000..96789581
--- /dev/null
+++ b/sys/vops/ak/aiftrr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTRR -- Inverse fourier transform (real transform, real output arrays).
+# The inverse transform of the real arrays FR and FI of length NPIX/2+1 is
+# returned in the real array SR of length NPIX.  Since the real inverse
+# transform is being performed the array SI is ignored and may be omitted.
+# The transformation may be performed in place if desired.  NPIX must be a
+# power of 2.
+
+procedure aiftrr (fr, fi, sr, si, npix)
+
+real	fr[ARB], fi[ARB]	# real and imag parts of transform (input)
+real	sr[ARB], si[ARB]	# spatial data (output).  SI NOT USED.
+int	npix
+int	ier
+pointer	sp, work
+
+begin
+	call smark (sp)
+	call salloc (work, npix + 2, TY_REAL)
+
+	# Pack the real and imaginary parts into a complex array as required
+	# by FFS.
+	call apkxr (fr, fi, Memr[work], npix / 2 + 1)
+
+	# Compute the inverse transform.
+	call ffs (Memr[work], npix, ier)
+	if (ier == 1)
+	    call fatal (1, "aiftrr: npix not a power of 2")
+
+	# The work array now contains the real part of the transform; merely
+	# copy it to the output array.
+	call amovr (Memr[work], sr, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/ak/aiftrx.x b/sys/vops/ak/aiftrx.x
new file mode 100644
index 00000000..63a9d53d
--- /dev/null
+++ b/sys/vops/ak/aiftrx.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTRX -- Inverse discreet fourier transform (real transform, complex data
+# array in).  The input array A of length NPIX/2+1 contains the DC term and
+# the NPIX/2 (real,imag) pairs for each of the NPIX/2 harmonics of the real
+# transform.  Upon output array B contains the NPIX real data pixels from the
+# inverse transform.  The transform may be performed in place if desired.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# B to be a type COMPLEX array in the calling program, but FFS expects a
+# REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure aiftrx (a, b, npix)
+
+complex	a[ARB]			# transform, npix/2+1 elements
+real	b[ARB]			# output data array
+int	npix
+int	ier
+
+begin
+	# The following is a no-op if A and B are the same array.
+	call amovx (a, b, npix / 2 + 1)
+
+	# Compute the inverse real transform.
+	call ffs (b, npix, ier)
+	if (ier == 1)
+	    call fatal (1, "afftrx: npix not a power of 2")
+end
diff --git a/sys/vops/ak/aiftxr.x b/sys/vops/ak/aiftxr.x
new file mode 100644
index 00000000..a9647e7c
--- /dev/null
+++ b/sys/vops/ak/aiftxr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTXR -- Inverse fourier transform (complex transform, real arrays).
+# The inverse transform of the real arrays FR and FI containing complex data
+# pairs is computed and the complex spatial data coefficients are returned in
+# the real arrays SR and SI.  The transformation may be performed in place if
+# desired.  NPIX must be a power of 2.
+
+procedure aiftxr (fr, fi, sr, si, npix)
+
+real	fr[ARB], fi[ARB]	# transform, frequency domain (input)
+real	sr[ARB], si[ARB]	# data, spatial domain (output)
+int	npix
+int	ier
+
+begin
+	# The following are no-ops if the transform is being performed
+	# in place.
+
+	call amovr (fr, sr, npix)
+	call amovr (fi, si, npix)
+
+	# Compute the inverse transform.
+	call fft842 (1, npix, sr, si, ier)
+	if (ier == 1)
+	    call fatal (1, "afftxr: npix not a power of 2")
+end
diff --git a/sys/vops/ak/aiftxx.x b/sys/vops/ak/aiftxx.x
new file mode 100644
index 00000000..2871590f
--- /dev/null
+++ b/sys/vops/ak/aiftxx.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIFTXX -- Inverse fourier transform (complex transform, complex array).
+# The fourier transform of the complex array A of length NPIX pixels is
+# computed and the NPIX complex data points are returned in the complex array
+# B.  The transformation may be performed in place if desired.  NPIX must be
+# a power of 2.
+#
+# N.B.: The Fortran 77 standard guarantees that a complex datum is represented
+# as two reals, and that the first real in storage order is the real part of
+# the complex datum and the second real the imaginary part.  We have defined
+# A and B to be type COMPLEX arrays in the calling program, but FFT842 expects
+# a REAL array containing (real,imag) pairs.  The Fortran standard appears to
+# guarantee that this will work.
+
+procedure aiftxx (a, b, npix)
+
+complex	a[ARB]			# transform (input)
+complex	b[ARB]			# data (output)
+int	npix
+int	ier
+pointer	sp, xr, xi
+
+begin
+	call smark (sp)
+	call salloc (xr, npix, TY_REAL)
+	call salloc (xi, npix, TY_REAL)
+
+	# Rearrange the elements of the A array as required by FFT842.
+	# Convert the array A of complex values into an array of reals
+	# and an array of imaginaries.
+
+	call aupxr (a, Memr[xr], Memr[xi], npix)
+
+	# Compute the inverse transform.
+	call fft842 (1, npix, Memr[xr], Memr[xi], ier)
+	if (ier == 1)
+	    call fatal (1, "afftxx: npix not a power of 2")
+
+	# Repack the real and imaginary arrays to form the complex output
+	# array.
+	call apkxr (Memr[xr], Memr[xi], b, npix)
+
+	call sfree (sp)
+end
diff --git a/sys/vops/ak/aimgd.x b/sys/vops/ak/aimgd.x
new file mode 100644
index 00000000..b99b6aa3
--- /dev/null
+++ b/sys/vops/ak/aimgd.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimgd (a, b, npix)
+
+complex	a[ARB]
+double	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/aimgi.x b/sys/vops/ak/aimgi.x
new file mode 100644
index 00000000..7632f2d0
--- /dev/null
+++ b/sys/vops/ak/aimgi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimgi (a, b, npix)
+
+complex	a[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/aimgl.x b/sys/vops/ak/aimgl.x
new file mode 100644
index 00000000..34958a6a
--- /dev/null
+++ b/sys/vops/ak/aimgl.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimgl (a, b, npix)
+
+complex	a[ARB]
+long	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/aimgr.x b/sys/vops/ak/aimgr.x
new file mode 100644
index 00000000..a6e0e910
--- /dev/null
+++ b/sys/vops/ak/aimgr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimgr (a, b, npix)
+
+complex	a[ARB]
+real	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/aimgs.x b/sys/vops/ak/aimgs.x
new file mode 100644
index 00000000..71dbbe67
--- /dev/null
+++ b/sys/vops/ak/aimgs.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AIMG -- Return the imaginary part of a COMPLEX vector.
+
+procedure aimgs (a, b, npix)
+
+complex	a[ARB]
+short	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = aimag (a[i])
+end
diff --git a/sys/vops/ak/mkpkg b/sys/vops/ak/mkpkg
new file mode 100644
index 00000000..9841f019
--- /dev/null
+++ b/sys/vops/ak/mkpkg
@@ -0,0 +1,276 @@
+# Make the VOPS vector operators library, procedures a[a-k]*.x.
+
+$checkout libvops.a lib$
+$update   libvops.a
+$checkin  libvops.a lib$
+$exit
+
+libvops.a:
+	aabsd.x	
+	aabsi.x	
+	aabsl.x	
+	aabsr.x	
+	aabss.x	
+	aabsx.x	
+	aaddd.x	
+	aaddi.x	
+	aaddkd.x	
+	aaddki.x	
+	aaddkl.x	
+	aaddkr.x	
+	aaddks.x	
+	aaddkx.x	
+	aaddl.x	
+	aaddr.x	
+	aadds.x	
+	aaddx.x	
+	aandi.x	
+	aandki.x	
+	aandkl.x	
+	aandks.x	
+	aandl.x	
+	aands.x	
+	aavgd.x	
+	aavgi.x	
+	aavgl.x	
+	aavgr.x	
+	aavgs.x	
+	aavgx.x	
+	abavd.x	
+	abavi.x	
+	abavl.x	
+	abavr.x	
+	abavs.x	
+	abavx.x	
+	abeqc.x	
+	abeqd.x	
+	abeqi.x	
+	abeqkc.x	
+	abeqkd.x	
+	abeqki.x	
+	abeqkl.x	
+	abeqkr.x	
+	abeqks.x	
+	abeqkx.x	
+	abeql.x	
+	abeqr.x	
+	abeqs.x	
+	abeqx.x	
+	abgec.x	
+	abged.x	
+	abgei.x	
+	abgekc.x	
+	abgekd.x	
+	abgeki.x	
+	abgekl.x	
+	abgekr.x	
+	abgeks.x	
+	abgekx.x	
+	abgel.x	
+	abger.x	
+	abges.x	
+	abgex.x	
+	abgtc.x	
+	abgtd.x	
+	abgti.x	
+	abgtkc.x	
+	abgtkd.x	
+	abgtki.x	
+	abgtkl.x	
+	abgtkr.x	
+	abgtks.x	
+	abgtkx.x	
+	abgtl.x	
+	abgtr.x	
+	abgts.x	
+	abgtx.x	
+	ablec.x	
+	abled.x	
+	ablei.x	
+	ablekc.x	
+	ablekd.x	
+	ableki.x	
+	ablekl.x	
+	ablekr.x	
+	ableks.x	
+	ablekx.x	
+	ablel.x	
+	abler.x	
+	ables.x	
+	ablex.x	
+	abltc.x	
+	abltd.x	
+	ablti.x	
+	abltkc.x	
+	abltkd.x	
+	abltki.x	
+	abltkl.x	
+	abltkr.x	
+	abltks.x	
+	abltkx.x	
+	abltl.x	
+	abltr.x	
+	ablts.x	
+	abltx.x	
+	abnec.x	
+	abned.x	
+	abnei.x	
+	abnekc.x	
+	abnekd.x	
+	abneki.x	
+	abnekl.x	
+	abnekr.x	
+	abneks.x	
+	abnekx.x	
+	abnel.x	
+	abner.x	
+	abnes.x	
+	abnex.x	
+	abori.x	
+	aborki.x	
+	aborkl.x	
+	aborks.x	
+	aborl.x	
+	abors.x	
+	absud.x	
+	absui.x	
+	absul.x	
+	absur.x	
+	absus.x	
+	achtcc.x	
+	achtcd.x	
+	achtci.x	
+	achtcl.x	
+	achtcr.x	
+	achtcs.x	
+	achtcx.x	
+	achtdc.x	
+	achtdd.x	
+	achtdi.x	
+	achtdl.x	
+	achtdr.x	
+	achtds.x	
+	achtdx.x	
+	achtic.x	
+	achtid.x	
+	achtii.x	
+	achtil.x	
+	achtir.x	
+	achtis.x	
+	achtix.x	
+	achtlc.x	
+	achtld.x	
+	achtli.x	
+	achtll.x	
+	achtlr.x	
+	achtls.x	
+	achtlx.x	
+	achtrc.x	
+	achtrd.x	
+	achtri.x	
+	achtrl.x	
+	achtrr.x	
+	achtrs.x	
+	achtrx.x	
+	achtsc.x	
+	achtsd.x	
+	achtsi.x	
+	achtsl.x	
+	achtsr.x	
+	achtss.x	
+	achtsx.x	
+	achtxc.x	
+	achtxd.x	
+	achtxi.x	
+	achtxl.x	
+	achtxr.x	
+	achtxs.x	
+	achtxx.x	
+	acjgx.x	
+	aclrc.x	
+	aclrd.x	
+	aclri.x	
+	aclrl.x	
+	aclrr.x	
+	aclrs.x	
+	aclrx.x	
+	acnvd.x	
+	acnvi.x	
+	acnvl.x	
+	acnvr.x	
+	acnvrd.x	
+	acnvri.x	
+	acnvrl.x	
+	acnvrr.x	
+	acnvrs.x	
+	acnvs.x	
+	adivd.x	
+	adivi.x	
+	adivkd.x	
+	adivki.x	
+	adivkl.x	
+	adivkr.x	
+	adivks.x	
+	adivkx.x	
+	adivl.x	
+	adivr.x	
+	adivs.x	
+	adivx.x	
+	adotd.x	
+	adoti.x	
+	adotl.x	
+	adotr.x	
+	adots.x	
+	adotx.x	
+	advzd.x	
+	advzi.x	
+	advzl.x	
+	advzr.x	
+	advzs.x	
+	advzx.x	
+	aexpd.x	
+	aexpi.x	
+	aexpkd.x	
+	aexpki.x	
+	aexpkl.x	
+	aexpkr.x	
+	aexpks.x	
+	aexpkx.x	
+	aexpl.x	
+	aexpr.x	
+	aexps.x	
+	aexpx.x	
+	afftrr.x	
+	afftrx.x	
+	afftxr.x	
+	afftxx.x	
+	agltc.x	
+	agltd.x	
+	aglti.x	
+	agltl.x	
+	agltr.x	
+	aglts.x	
+	agltx.x	
+	ahgmc.x	<mach.h>
+	ahgmd.x	<mach.h>
+	ahgmi.x	<mach.h>
+	ahgml.x	<mach.h>
+	ahgmr.x	<mach.h>
+	ahgms.x	<mach.h>
+	ahivc.x	
+	ahivd.x	
+	ahivi.x	
+	ahivl.x	
+	ahivr.x	
+	ahivs.x	
+	ahivx.x	
+	aiftrr.x	
+	aiftrx.x	
+	aiftxr.x	
+	aiftxx.x	
+	aimgd.x	
+	aimgi.x	
+	aimgl.x	
+	aimgr.x	
+	aimgs.x	
+	;
diff --git a/sys/vops/alan.gx b/sys/vops/alan.gx
new file mode 100644
index 00000000..43b21069
--- /dev/null
+++ b/sys/vops/alan.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALAN -- Compute the logical AND of two vectors (generic).  The logical
+# output value is returned as an int.
+
+procedure alan$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/alank.gx b/sys/vops/alank.gx
new file mode 100644
index 00000000..a8e3c1b1
--- /dev/null
+++ b/sys/vops/alank.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALANK -- Compute the logical AND of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alank$t (a, b, c, npix)
+
+PIXEL	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/alim.gx b/sys/vops/alim.gx
new file mode 100644
index 00000000..2e9cbf56
--- /dev/null
+++ b/sys/vops/alim.gx
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+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
diff --git a/sys/vops/alln.gx b/sys/vops/alln.gx
new file mode 100644
index 00000000..7d6ed921
--- /dev/null
+++ b/sys/vops/alln.gx
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure alln$t (a, b, npix, errfcn)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+PIXEL	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+	    $if (datatype == x)
+		if (a[i] == 0$f)
+	    $else
+		if (a[i] <= 0$f)
+	    $endif
+		    b[i] = errfcn (a[i])
+		else {
+		    $if (datatype == si)
+			b[i] = log (real (a[i]))
+		    $else $if (datatype == l)
+			b[i] = log (double (a[i]))
+		    $else
+			b[i] = log (a[i])
+		    $endif $endif
+		}
+	}
+end
diff --git a/sys/vops/alog.gx b/sys/vops/alog.gx
new file mode 100644
index 00000000..033f9514
--- /dev/null
+++ b/sys/vops/alog.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alog$t (a, b, npix, errfcn)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+PIXEL	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+	    $if (datatype == x)
+		if (a[i] == 0$f)
+	    $else
+		if (a[i] <= 0$f)
+	    $endif
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+		    $if (datatype == xsi)
+			b[i] = log10 (real (a[i]))
+		    $else $if (datatype == l)
+			b[i] = log10 (double (a[i]))
+		    $else
+			b[i] = log10 (a[i])
+		    $endif $endif
+		}
+	}
+end
diff --git a/sys/vops/alor.gx b/sys/vops/alor.gx
new file mode 100644
index 00000000..e1f7bd67
--- /dev/null
+++ b/sys/vops/alor.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOR -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alor$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/alork.gx b/sys/vops/alork.gx
new file mode 100644
index 00000000..ddcd108d
--- /dev/null
+++ b/sys/vops/alork.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALORK -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alork$t (a, b, c, npix)
+
+PIXEL	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/alov.gx b/sys/vops/alov.gx
new file mode 100644
index 00000000..27a81128
--- /dev/null
+++ b/sys/vops/alov.gx
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+PIXEL procedure alov$t (a, npix)
+
+PIXEL	a[ARB]
+int	npix
+PIXEL	low, pixval
+$if (datatype == x)
+real	abs_low
+$endif
+int	i
+
+begin
+	low = a[1]
+	$if (datatype == x)
+	abs_low = abs (low)
+	$endif
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    $if (datatype == x)
+	    if (abs (pixval) < abs_low) {
+		low = pixval
+		abs_low = abs (low)
+	    }
+	    $else
+	    if (pixval < low)
+		low = pixval
+	    $endif
+	}
+
+	return (low)
+end
diff --git a/sys/vops/alta.gx b/sys/vops/alta.gx
new file mode 100644
index 00000000..c09bd38f
--- /dev/null
+++ b/sys/vops/alta.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure alta$t (a, b, npix, k1, k2)
+
+PIXEL	a[ARB], b[ARB]
+$if (datatype == ld)
+double	k1, k2
+$else
+real	k1, k2
+$endif
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/altm.gx b/sys/vops/altm.gx
new file mode 100644
index 00000000..d0f00f94
--- /dev/null
+++ b/sys/vops/altm.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altm$t (a, b, npix, k1, k2)
+
+PIXEL	a[ARB], b[ARB]
+$if (datatype == ld)
+double	k1, k2
+$else
+real	k1, k2
+$endif
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/altr.gx b/sys/vops/altr.gx
new file mode 100644
index 00000000..866c9e03
--- /dev/null
+++ b/sys/vops/altr.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altr$t (a, b, npix, k1, k2, k3)
+
+PIXEL	a[ARB], b[ARB]
+$if (datatype == ld)
+double	k1, k2, k3
+$else
+real	k1, k2, k3
+$endif
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/alui.gx b/sys/vops/alui.gx
new file mode 100644
index 00000000..535dee9c
--- /dev/null
+++ b/sys/vops/alui.gx
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure alui$t (a, b, x, npix)
+
+PIXEL	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/alut.gx b/sys/vops/alut.gx
new file mode 100644
index 00000000..f4e01fb3
--- /dev/null
+++ b/sys/vops/alut.gx
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure alut$t (a, b, npix, lut)
+
+$if (datatype == rd)
+int	a[ARB]				# input array of indices
+$else
+PIXEL	a[ARB]
+$endif
+
+PIXEL	b[ARB]				# output data array
+PIXEL	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/amag.gx b/sys/vops/amag.gx
new file mode 100644
index 00000000..397a7c25
--- /dev/null
+++ b/sys/vops/amag.gx
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amag$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    $if (datatype == sir)
+		c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2))
+	    $else $if (datatype == dl)
+		c[i] = sqrt (double(a[i] ** 2) + double(b[i] ** 2))
+	    $else
+		c[i] = sqrt (a[i] ** 2 + b[i] ** 2)
+	    $endif $endif
+end
diff --git a/sys/vops/amap.gx b/sys/vops/amap.gx
new file mode 100644
index 00000000..9006b221
--- /dev/null
+++ b/sys/vops/amap.gx
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amap$t (a, b, npix, a1, a2, b1, b2)
+
+PIXEL	a[ARB], b[ARB]
+PIXEL	a1, a2, b1, b2
+
+$if (datatype == sil)
+long	minout, maxout, aoff, boff, pixval
+$else
+PIXEL	minout, maxout, aoff, boff, pixval
+$endif
+
+$if (datatype == ld)
+double	scalar
+$else
+real	scalar
+$endif
+
+int	npix, i
+
+begin
+	$if (datatype == ld)
+	    scalar = (double (b2) - double (b1)) / (double (a2) - double (a1))
+	$else
+	    scalar = (real (b2) - real (b1)) / (real (a2) - real (a1))
+	$endif
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/amax.gx b/sys/vops/amax.gx
new file mode 100644
index 00000000..ce61b558
--- /dev/null
+++ b/sys/vops/amax.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amax$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+		if (abs(a[i]) >= abs(b[i]))
+		    c[i] = a[i]
+		else
+		    c[i] = b[i]
+	    $else
+		c[i] = max (a[i], b[i])
+	    $endif
+end
diff --git a/sys/vops/amaxk.gx b/sys/vops/amaxk.gx
new file mode 100644
index 00000000..f45bca09
--- /dev/null
+++ b/sys/vops/amaxk.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	$if (datatype == x)
+	abs_b = abs (b)
+	$endif
+
+	do i = 1, npix
+	    $if (datatype == x)
+		if (abs(a[i]) >= abs_b)
+		    c[i] = a[i]
+		else
+		    c[i] = b
+	    $else
+		c[i] = max (a[i], b)
+	    $endif
+end
diff --git a/sys/vops/amed.gx b/sys/vops/amed.gx
new file mode 100644
index 00000000..21a31724
--- /dev/null
+++ b/sys/vops/amed.gx
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+PIXEL procedure amed$t (a, npix)
+
+PIXEL	a[ARB]
+int	npix
+
+pointer	sp, aa
+PIXEL	median
+PIXEL	asok$t()		# select the Kth smallest element from A
+$if (datatype == x)
+real	a1, a2, a3
+$endif
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+	    $if (datatype == x)
+		a1 = abs (a[1])
+		a2 = abs (a[2])
+		a3 = abs (a[3])
+		if (a1 < a2) {
+		    if (a2 < a3)
+			return (a[2])
+		    else if (a1 < a3)
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a2 > a3)
+			return (a[2])
+		    else if (a1 < a3)
+			return (a[1])
+		    else
+			return (a[3])
+		}
+	    $else
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+	    $endif
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_PIXEL)
+	    call amov$t (a, Mem$t[aa], npix)
+	    median = asok$t (Mem$t[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/amed3.gx b/sys/vops/amed3.gx
new file mode 100644
index 00000000..37452cb5
--- /dev/null
+++ b/sys/vops/amed3.gx
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3$t (a, b, c, m, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]	# input vectors
+PIXEL	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/amed4.gx b/sys/vops/amed4.gx
new file mode 100644
index 00000000..fb5fab5e
--- /dev/null
+++ b/sys/vops/amed4.gx
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4$t (a, b, c, d, m, npix)
+
+PIXEL	a[ARB], b[ARB]		# input vectors
+PIXEL	c[ARB], d[ARB]		# input vectors
+PIXEL	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+PIXEL	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/amed5.gx b/sys/vops/amed5.gx
new file mode 100644
index 00000000..9d81d243
--- /dev/null
+++ b/sys/vops/amed5.gx
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5$t (a, b, c, d, e, m, npix)
+
+PIXEL	a[ARB], b[ARB]		# input vectors
+PIXEL	c[ARB], d[ARB], e[ARB]	# input vectors
+PIXEL	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+PIXEL	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/amgs.gx b/sys/vops/amgs.gx
new file mode 100644
index 00000000..eb7b3124
--- /dev/null
+++ b/sys/vops/amgs.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgs$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/amin.gx b/sys/vops/amin.gx
new file mode 100644
index 00000000..4d5ad6ea
--- /dev/null
+++ b/sys/vops/amin.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure amin$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+		if (abs(a[i]) <= abs(b[i]))
+		    c[i] = a[i]
+		else
+		    c[i] = b[i]
+	    $else
+		c[i] = min (a[i], b[i])
+	    $endif
+end
diff --git a/sys/vops/amink.gx b/sys/vops/amink.gx
new file mode 100644
index 00000000..f2775252
--- /dev/null
+++ b/sys/vops/amink.gx
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure amink$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+$if (datatype == x)
+real	abs_b
+$endif
+
+begin
+	$if (datatype == x)
+	abs_b = abs (b)
+	$endif
+
+	do i = 1, npix
+	    $if (datatype == x)
+		if (abs(a[i]) <= abs_b)
+		    c[i] = a[i]
+		else
+		    c[i] = b
+	    $else
+		c[i] = min (a[i], b)
+	    $endif
+end
diff --git a/sys/vops/amod.gx b/sys/vops/amod.gx
new file mode 100644
index 00000000..563b3b2a
--- /dev/null
+++ b/sys/vops/amod.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amod$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/amodk.gx b/sys/vops/amodk.gx
new file mode 100644
index 00000000..918eed75
--- /dev/null
+++ b/sys/vops/amodk.gx
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/amov.gx b/sys/vops/amov.gx
new file mode 100644
index 00000000..e500856f
--- /dev/null
+++ b/sys/vops/amov.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amov$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/amovk.gx b/sys/vops/amovk.gx
new file mode 100644
index 00000000..94dfb176
--- /dev/null
+++ b/sys/vops/amovk.gx
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovk$t (a, b, npix)
+
+PIXEL	a
+PIXEL	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/amul.gx b/sys/vops/amul.gx
new file mode 100644
index 00000000..714454d8
--- /dev/null
+++ b/sys/vops/amul.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amul$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/amulk.gx b/sys/vops/amulk.gx
new file mode 100644
index 00000000..276daa90
--- /dev/null
+++ b/sys/vops/amulk.gx
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/aneg.gx b/sys/vops/aneg.gx
new file mode 100644
index 00000000..6b18e520
--- /dev/null
+++ b/sys/vops/aneg.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure aneg$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/anot.gx b/sys/vops/anot.gx
new file mode 100644
index 00000000..08f95a47
--- /dev/null
+++ b/sys/vops/anot.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANOT -- Compute the bitwise boolean complement of a vector (generic).
+
+procedure anot$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+$if (datatype == i)
+int	not()
+$else
+PIXEL	not$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		b[i] = not (a[i])
+	    $else
+		b[i] = not$t (a[i])
+	    $endif
+	}
+end
diff --git a/sys/vops/apkx.gx b/sys/vops/apkx.gx
new file mode 100644
index 00000000..904e38d6
--- /dev/null
+++ b/sys/vops/apkx.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkx$t (a, b, c, npix)
+
+PIXEL	a[ARB]			# real component
+PIXEL	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+	    $if (datatype == x)
+		c[i] = complex (real(a[i]), aimag(b[i]))
+	    $else
+		c[i] = complex (real(a[i]), real(b[i]))
+	    $endif
+end
diff --git a/sys/vops/apol.gx b/sys/vops/apol.gx
new file mode 100644
index 00000000..04d162c5
--- /dev/null
+++ b/sys/vops/apol.gx
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOL -- Evaluate a polynomial at X, given the coefficients of the polynomial
+# in COEFF and returning the computed value as the function value.
+
+PIXEL procedure apol$t (x, coeff, ncoeff)
+
+PIXEL	x		# point at which the polynomial is to be evaluated
+PIXEL	coeff[ncoeff]	# coefficients of the polynomial, lower orders first
+int	ncoeff
+
+int	i
+PIXEL	pow, sum
+
+begin
+	sum = coeff[1]
+	pow = x
+
+	do i = 2, ncoeff {
+	    sum = sum + pow * coeff[i]
+	    pow = pow * x
+	}
+
+	return (sum)
+end
diff --git a/sys/vops/apow.gx b/sys/vops/apow.gx
new file mode 100644
index 00000000..c8fca670
--- /dev/null
+++ b/sys/vops/apow.gx
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apow$t (a, b, c, npix)
+
+PIXEL	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/apowk.gx b/sys/vops/apowk.gx
new file mode 100644
index 00000000..68e83599
--- /dev/null
+++ b/sys/vops/apowk.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowk$t (a, b, c, npix)
+
+PIXEL	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovk$t (1$f, c, npix)
+	case 1:
+	    call amov$t (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/arav.gx b/sys/vops/arav.gx
new file mode 100644
index 00000000..abc965dd
--- /dev/null
+++ b/sys/vops/arav.gx
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure arav$t (a, npix, mean, sigma, ksig)
+
+PIXEL	a[ARB]			# input data array
+$if (datatype == dl)
+double	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+$else
+real	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+$endif
+int	npix, ngpix, old_ngpix, awvg$t()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvg$t (a, npix, mean, sigma, lcut, hcut)
+	    $if (datatype == dl)
+		if (ngpix <= 1 || sigma <= EPSILOND)
+	    $else
+		if (ngpix <= 1 || sigma <= EPSILONR)
+	    $endif
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/arcp.gx b/sys/vops/arcp.gx
new file mode 100644
index 00000000..6c7f9dc4
--- /dev/null
+++ b/sys/vops/arcp.gx
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcp$t (a, b, c, npix)
+
+PIXEL	a		# constant numerator
+PIXEL	b[ARB]		# vector denominator
+PIXEL	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0$f) {
+	    call aclr$t (c, npix)
+	} else if (a == 1$f) {
+	    do i = 1, npix
+		c[i] = 1$f / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/arcz.gx b/sys/vops/arcz.gx
new file mode 100644
index 00000000..ff8e30e0
--- /dev/null
+++ b/sys/vops/arcz.gx
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arcz$t (a, b, c, npix, errfcn)
+
+PIXEL	a			# numerator
+PIXEL	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+PIXEL	errfcn()		# user function, called on divide by zero
+
+int	i
+PIXEL	divisor
+$if (datatype == rd)
+PIXEL	tol
+$endif
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0$f) {
+	    call aclr$t (c, npix)
+	    return
+	}
+
+	$if (datatype == r)
+	    tol = 1.0E-20
+	$else $if (datatype == d)
+	    tol = 1.0D-20
+	$endif $endif
+
+	do i = 1, npix {
+	    divisor = b[i]
+	    $if (datatype == rd)
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a)
+			next
+		    }
+		c[i] = a / divisor
+
+	    $else
+		if (divisor == 0$f)
+		    c[i] = errfcn (a)
+		else
+		    c[i] = a / divisor
+	    $endif
+	}
+end
diff --git a/sys/vops/argt.gx b/sys/vops/argt.gx
new file mode 100644
index 00000000..3ac2fbc4
--- /dev/null
+++ b/sys/vops/argt.gx
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argt$t (a, npix, ceil, newval)
+
+PIXEL	a[ARB]
+int	npix
+PIXEL	ceil, newval
+int	i
+$if (datatype == x)
+real	abs_ceil
+$endif
+
+begin
+	$if (datatype == x)
+	abs_ceil = abs (ceil)
+	$endif
+
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) > abs_ceil)
+	    $else
+	    if (a[i] > ceil)
+	    $endif
+		a[i] = newval
+end
diff --git a/sys/vops/arlt.gx b/sys/vops/arlt.gx
new file mode 100644
index 00000000..8edce34a
--- /dev/null
+++ b/sys/vops/arlt.gx
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arlt$t (a, npix, floor, newval)
+
+PIXEL	a[ARB]
+int	npix
+PIXEL	floor, newval
+int	i
+$if (datatype == x)
+real	abs_floor
+$endif
+
+begin
+	$if (datatype == x)
+	abs_floor = abs (floor)
+	$endif
+
+	do i = 1, npix
+	    $if (datatype == x)
+	    if (abs (a[i]) < abs_floor)
+	    $else
+	    if (a[i] < floor)
+	    $endif
+		a[i] = newval
+end
diff --git a/sys/vops/asel.gx b/sys/vops/asel.gx
new file mode 100644
index 00000000..ef978d46
--- /dev/null
+++ b/sys/vops/asel.gx
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure asel$t (a, b, c, sel, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/aselk.gx b/sys/vops/aselk.gx
new file mode 100644
index 00000000..2d7c54d3
--- /dev/null
+++ b/sys/vops/aselk.gx
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselk$t (a, b, c, sel, npix)
+
+PIXEL	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/asok.gx b/sys/vops/asok.gx
new file mode 100644
index 00000000..b508d4ff
--- /dev/null
+++ b/sys/vops/asok.gx
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+PIXEL procedure asok$t (a, npix, ksel)
+
+PIXEL	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+PIXEL	temp, wtemp
+$if (datatype == x)
+real	abs_temp
+$endif
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+	    $if (datatype == x)
+	    abs_temp = abs (temp)
+	    $endif
+
+	    repeat {
+	        $if (datatype == x)
+		while (abs (a[i]) < abs_temp)
+		$else
+		while (a[i] < temp)
+		$endif
+		    i = i + 1
+	        $if (datatype == x)
+		while (abs_temp < abs (a[j]))
+		$else
+		while (temp < a[j])
+		$endif
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/asqr.gx b/sys/vops/asqr.gx
new file mode 100644
index 00000000..1a584853
--- /dev/null
+++ b/sys/vops/asqr.gx
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqr$t (a, b, npix, errfcn)
+
+PIXEL	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+PIXEL	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+	    $if (datatype != x)
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+	    $endif
+		{
+		    $if (datatype == rdx)
+			b[i] = sqrt (a[i])
+		    $else $if (datatype == l)
+			b[i] = sqrt (double (a[i]))
+		    $else
+			b[i] = sqrt (real (a[i]))
+		    $endif $endif
+		}
+	}
+end
diff --git a/sys/vops/asrt.gx b/sys/vops/asrt.gx
new file mode 100644
index 00000000..ff639b2a
--- /dev/null
+++ b/sys/vops/asrt.gx
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrt$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+PIXEL	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amov$t (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+		    $if (datatype == x)
+			for (i=i+1;  abs(b[i]) < abs(pivot);  i=i+1)
+		    $else
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+		    $endif
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+		    $if (datatype == x)
+			    if (abs(b[j]) <= abs(pivot))
+		    $else
+			    if (b[j] <= pivot)
+		    $endif
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/assq.gx b/sys/vops/assq.gx
new file mode 100644
index 00000000..0189e01e
--- /dev/null
+++ b/sys/vops/assq.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+$if (datatype == csir)
+real procedure assq$t (a, npix)
+real	sum
+$else $if (datatype == ld)
+double procedure assq$t (a, npix)
+double	sum
+$else
+PIXEL procedure assq$t (a, npix)
+PIXEL	sum
+$endif $endif
+
+PIXEL	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0$f
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/asub.gx b/sys/vops/asub.gx
new file mode 100644
index 00000000..547ee29c
--- /dev/null
+++ b/sys/vops/asub.gx
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asub$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/asubk.gx b/sys/vops/asubk.gx
new file mode 100644
index 00000000..2f77e007
--- /dev/null
+++ b/sys/vops/asubk.gx
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubk$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/asum.gx b/sys/vops/asum.gx
new file mode 100644
index 00000000..716d2b53
--- /dev/null
+++ b/sys/vops/asum.gx
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+$if (datatype == csir)
+real procedure asum$t (a, npix)
+$else $if (datatype == ld)
+double procedure asum$t (a, npix)
+$else
+PIXEL procedure asum$t (a, npix)
+$endif $endif
+
+PIXEL	a[ARB]
+int	npix
+int	i
+
+$if (datatype == csir)
+real	sum
+$else $if (datatype == ld)
+double	sum
+$else
+PIXEL	sum
+$endif $endif
+
+begin
+	sum = 0$f
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/aupx.gx b/sys/vops/aupx.gx
new file mode 100644
index 00000000..c6a4a66b
--- /dev/null
+++ b/sys/vops/aupx.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupx$t (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+PIXEL	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+	    $if (datatype == x)
+		b[i] = complex (real(a[i]), 0.0)
+		c[i] = complex (0.0, aimag(a[i]))
+	    $else
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	    $endif
+	}
+end
diff --git a/sys/vops/aveq.gx b/sys/vops/aveq.gx
new file mode 100644
index 00000000..1967102a
--- /dev/null
+++ b/sys/vops/aveq.gx
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveq$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/awsu.gx b/sys/vops/awsu.gx
new file mode 100644
index 00000000..ffa5446d
--- /dev/null
+++ b/sys/vops/awsu.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsu$t (a, b, c, npix, k1, k2)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+$if (datatype == x)
+complex	k1, k2
+$else $if (datatype == d)
+double	k1, k2
+$else
+real	k1, k2
+$endif $endif
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/awvg.gx b/sys/vops/awvg.gx
new file mode 100644
index 00000000..7c221bf3
--- /dev/null
+++ b/sys/vops/awvg.gx
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvg$t (a, npix, mean, sigma, lcut, hcut)
+
+PIXEL	a[ARB]
+$if (datatype == dl)
+double	mean, sigma, lcut, hcut
+$else
+real	mean, sigma, lcut, hcut
+$endif
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		$if (datatype == x)
+		    value = abs (a[i])
+		$else
+		    value = a[i]
+		$endif
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		$if (datatype == x)
+		    value = abs (a[i])
+		$else
+		    value = a[i]
+		$endif
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+$if (datatype == dl)
+	    mean = $INDEFD
+	    sigma = $INDEFD
+$else
+	    mean = $INDEFR
+	    sigma = $INDEFR
+$endif
+	case 1:
+	    mean = sum
+$if (datatype == dl)
+	    sigma = $INDEFD
+$else
+	    sigma = $INDEFR
+$endif
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/axor.gx b/sys/vops/axor.gx
new file mode 100644
index 00000000..18fd07fd
--- /dev/null
+++ b/sys/vops/axor.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXOR -- Compute the exclusive or of two vectors (generic).
+
+procedure axor$t (a, b, c, npix)
+
+PIXEL	a[ARB], b[ARB], c[ARB]
+int	npix, i
+$if (datatype == i)
+int	xor()
+$else
+PIXEL	xor$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = xor (a[i], b[i])
+	    $else
+		c[i] = xor$t (a[i], b[i])
+	    $endif
+	}
+end
diff --git a/sys/vops/axork.gx b/sys/vops/axork.gx
new file mode 100644
index 00000000..eeb3694c
--- /dev/null
+++ b/sys/vops/axork.gx
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXORK -- Compute the boolean or of a vector and a constant (generic).
+
+procedure axork$t (a, b, c, npix)
+
+PIXEL	a[ARB]
+PIXEL	b
+PIXEL	c[ARB]
+int	npix, i
+$if (datatype == i)
+int	xor()
+$else
+PIXEL	xor$t()
+$endif
+
+begin
+	do i = 1, npix {
+	    $if (datatype == i)
+		c[i] = xor (a[i], b)
+	    $else
+		c[i] = xor$t (a[i], b)
+	    $endif
+	}
+end
diff --git a/sys/vops/doc/vops.hlp b/sys/vops/doc/vops.hlp
new file mode 100644
index 00000000..dc415afa
--- /dev/null
+++ b/sys/vops/doc/vops.hlp
@@ -0,0 +1,260 @@
+
+.help VOPS Feb83 "Vector Primitives"
+.sh
+Introduction
+
+    The vector primitives are abstract machine instructions which
+operate on vectors.  The "a" prefixed operators are for one dimensional
+arrays, and the "m" prefixed operators are for two dimensional
+arrays (matrices).  Each generic instruction is implemented as a
+set of operators, one for each data type.
+
+There are no vector primitives for the type BOOL.  If a "b" suffix is given,
+the vector primitive is understood to operate on unsigned machine bytes.
+The "u" suffix is used for the special type unsigned short integer.
+
+The binary operators ("c = a op b") come in two forms.  If the regular
+three character instruction mnemonic is used, the B operand must be vector.
+If the letter "k" is added to the mnemonic, the B operand must be a constant.
+These dual mode operators are flagged (with "(k)") in the table below.
+
+
+.nf
+     Instruction	    Operation		          Data Types
+
+	cht__		b = a (change datatype)		  UBcsilrdx
+	clr_		fill a with zeros		    csilrdx
+	mov_	(k)	b = a (copy vector)		    csilrdx
+
+	abs_		b = abs(a)			     silrdx
+	log_		b = log10(a)			     silrdx
+	lln_		b = natural_log(a)		     silrdx
+	sqr_		b = sqrt(a)			     silrdx
+	srt_		b = sort(a)			    csilrdx
+	neg_		b = -a				     silrdx
+	map_		b = (a + k1) * k2		     silrdx
+	map_B		b = (a + k1) * k2		     silrdx
+	lut_		b = lut[a] (lookup table)	    csil
+	lui_		b = interp (a, x)		     silrd
+	rep_		a = newval if (low<=a<=high)	    csilrdx
+
+	add_	(k)	c = a + b			     silrdx
+	sub_	(k)	c = a - b			     silrdx
+	mul_	(k)	c = a * b			     silrdx
+	div_	(k)	c = a / b			     silrdx
+	min_	(k)	c = min(a,b)			     silrd
+	max_	(k)	c = max(a,b)			     silrd
+	mod_	(k)	c = mod(a,b)			     silrd
+	pow_	(k)	c = a ** int_pwr 		     silrdx
+	exp_	(k)	c = a ** real_pwr		     silrdx
+
+	not_		b = !a				     sil
+	and_	(k)	c = and(a,b)			     sil
+	bor_	(k)	c = or(a,b)			     sil
+	xor_	(k)	c = xor(a,b)			     sil
+
+
+.tp 4
+other vector primitives:
+
+	lim_	ngpix =	 lim_ (a, npix; minval, maxval)	     silrdx
+	win_	nrej =	 win_ (a, npix, lcut, hcut)	     silrdx
+	avg_	ngpix =	 avg_ (a, npix; mean, sigma)	     silrdx
+	rav_	ngpix =	 rav_ (a, npix; mean, sigma; ksig)   silrdx
+?	med_	ngpix =	 med_ (a, ia, npix; median) 	     silrd
+.fi
+
+
+For example, "aaddr(a,b,c,npix)" would add the two REAL vectors A and B,
+of length NPIX, placing the sum in the vector C.  To add a constant K to
+the vector A, "aaddkr(a,k,c,npix)" would be used.
+The sequence "aclrb(a,nbytes)" would zero NBYTES machine bytes,
+starting at location A.
+
+.sh
+Preprocessing Generic Operators
+
+    A preprocessor is provided to convert a generic operator into a set
+of type specific operators.  By coding only generic operators, the programmer
+only has to maintain a single piece of code, reducing the possibility of
+an error, and greatly reducing the amount of work.
+
+The GENERIC preprocessor takes as input files written in either the IRAF
+preprocessor language or C (or any other language which provides macro
+definitions), with embedded preprocessor directives and keywords.
+.sh
+Usage
+
+    The calling sequence for the preprocessor (on the UNIX system)
+is as follows:
+
+	generic [-t types] [-p prefix] [-o outfile] file [file...]
+
+Any number of files may be processed.
+.sh
+Flags
+
+    The following (optional) flags are provided to control the types
+and names of the generated files:
+.ls 8
+.ls 8 -t
+Used to specify the datatypes of the files to be produced.  The default
+value is "silrdx", meaning types SHORT through COMPLEX.  Other possible
+types are "BU", i.e., unsigned byte and unsigned short.  The generic
+preprocessor does not support type boolean.
+.le
+.ls -p
+An optional prefix string to be added to each file name generated.  Provided
+to make it convenient to place all generated files in a subdirectory.
+If the name of the file(s) being preprocessed is "aadd.x", and the prefix
+is "d/", the names of the generated files will be "d/aadds.x", "d/aaddi.x",
+"d/aaddl.x", and so on.
+.le
+.ls -o
+If an output filename is specified with the -o flag, only a single input file
+may be processed.  Any "$t" sequences embedded in the output file name
+will be replaced by the type "suffix" character to generate the filenames
+of the type specific files in the generic family.  If no $t sequence is given,
+the type suffix is appended to the filename.  If no -o output filename is
+given, the names of the output files are formed by concatenating the type
+suffix to the root of the input filename.
+.le
+.le
+.sh
+Directives
+
+    The action of the preprocessor is directed by placing "$xxx" directives
+in the text to be processed.  The identifiers INDEF and PIXEL are also
+known to the preprocessor, and will be replaced by their type specific
+equivalents (INDEF --> INDEFS, INDEFI, etc., PIXEL --> short, int, real, etc.)
+in the generated text.  Comments (#... and /* ... */), quoted strings (".."),
+and escaped lines (^%) are passed on unchanged.  
+
+.ls 4
+.ls 20 $/text/
+The text enclosed by the matching slashes is passed through unchanged.
+.le
+.ls $t
+The lowercase value of the current type suffix character (one of [bucsilrdx]).
+.le
+.ls $T
+The uppercase value of the current type suffix character (one of [BUCSILRDX]).
+.le
+.ls digits$f
+Replaced by "digits.0" if the current type is REAL, by "digits.0D0" if the
+current type is DOUBLE, by "(digits,digits)" if the type is complex, or by
+"digits" for all other datatypes.
+.le
+.ls $if
+Conditional compilation.  Two forms of the $if statment are implemented:
+
+.nf
+	$if (datatype == <chars>)
+	$if (datatype != <chars>)
+
+or
+	$if (sizeof(<t1>) <relop> sizeof(<t2>))
+.fi
+
+where <chars>, <t1>, and <t2> are type suffix characters ("silrd", etc.),
+and where <relop> is one of the relational operators
+
+	==  !=  <=  <   >=  >
+
+Nesting is permitted.  Conditional statements need not be left justified,
+i.e., whitespace may be placed between BOL and a $xx preprocessor directive.
+.le
+.ls $$if
+Replaced by "$if".  Not evaluated until the second time the file is
+processed.
+.le
+.ls $else, $$else
+Begins a section of code which gets processed if the $if condition was
+false.
+.le
+.ls $endif, $$endif
+Terminates a $if or $else construct.
+.le
+.ls TY_PIXEL
+Replaced by TY_INT, TY_REAL, and so on.
+.le
+.ls SZ_PIXEL
+Replaced by SZ_INT, SZ_REAL, and so on.
+.le
+.ls PIXEL
+Replaced by the datatype keyword of the file currently being generated
+(int, real, etc.).
+.le
+.ls XPIXEL
+Replaced by the defined type (XCHAR, XINT, ect.).  Used in generic C
+programs which will be called from the subset preprocessor, and which
+must manipulate the subset pp datatypes.
+.le
+.ls $PIXEL
+Replaced by the string "PIXEL" (used to postpone substitution until the
+next pass).
+.le
+.ls INDEF
+Replaced by the INDEF parameter for the current datatype (INDEFS, INDEFI,
+INDEFL, INDEF, or INDEFX).
+.le
+.ls $INDEF
+Replaced by the string "INDEF".
+.le
+.le
+
+.sh
+Example
+
+    The following generic operator computes the square root of a vector.
+The members of the generic family would be called "asqrs", "asqri",
+and so on.
+
+.ks
+.nf
+	# ASQR -- Compute the square root of a vector (generic)
+
+	procedure asqr$t (a, b, npix)
+
+	PIXEL	a[npix], b[npix]
+	int	npix, i
+
+	begin
+		do i = 1, npix {
+		    if (a[i] < 0$f || a[i] == INDEF)
+			b[i] = INDEF
+		    else {
+			$if (datatype != rdx)
+			    b[i] = sqrt(double(a[i]))
+			$else
+			    b[i] = sqrt(a[i])
+			$endif
+		    }
+		}
+	end
+.fi
+.ke
+
+.sh
+Doubly Generic Operators
+
+    The preprocessor can also be used to generate doubly generic operators
+(operators which have two type suffixes).  A good example is the type
+conversion operator ACHTxy, which converts a vector of type X to a vector
+of type Y.  If there are seven datatypes (csilrdx), this generic family will
+consist of 49 members.
+
+Doubly generic programs are preprocessed once to expand the first suffix,
+then each file generated by the first pass is processed to expand the
+second suffix.  On the UNIX sytstem, this might be done by a command
+such as
+
+.nf
+	generic acht.x; generic -p dir/ acht[silrd].x
+	rm acht[silrd].x
+.fi
+
+This would expand "acht" in the current directory (generating 5 files),
+then expand each of the "acht$t" files in the subdirectory "dir/",
+creating a total of 25 files in the subdirectory.  The final command
+removes the 5 intermediate files.
diff --git a/sys/vops/fftr.f b/sys/vops/fftr.f
new file mode 100644
index 00000000..a6885972
--- /dev/null
+++ b/sys/vops/fftr.f
@@ -0,0 +1,689 @@
+c
+c-----------------------------------------------------------------------
+c subroutine:  ffa
+c fast fourier analysis subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine ffa (b, nfft, ier)
+c
+c this subroutine replaces the real vector b(k),  (k=1,2,...,n),
+c with its finite discrete fourier transform.  the dc term is
+c returned in location b(1) with b(2) set to 0.  thereafter, the
+c jth harmonic is returned as a complex number stored as
+c b(2*j+1) + i b(2*j+2).  note that the n/2 harmonic is returned
+c in b(n+1) with b(n+2) set to 0.  hence, b must be dimensioned
+c to size n+2.
+c subroutine is called as ffa (b,n) where n=2**m and b is an
+c n term real array.  a real-valued, radix 8  algorithm is used
+c with in-place reordering and the trig functions are computed as
+c needed.
+c
+      dimension b(2)
+      common /con/ pii, p7, p7two, c22, s22, pi2
+c
+c iw is a machine dependent write device number
+c
+c+noao
+c      iw = i1mach(2)
+      ier = 0
+c-noao
+c
+      pii = 4.*atan(1.)
+      pi8 = pii/8.
+      p7 = 1./sqrt(2.)
+      p7two = 2.*p7
+      c22 = cos(pi8)
+      s22 = sin(pi8)
+      pi2 = 2.*pii
+      n = 1
+      do 10 i=1,31
+        m = i
+        n = n*2
+        if (n.eq.nfft) go to 20
+  10  continue
+c+noao
+c      write (iw,9999)
+c9999  format (30h nfft not a power of 2 for ffa)
+c      stop
+       ier = 1
+       return
+c-noao
+  20  continue
+      n8pow = m/3
+c
+c do a radix 2 or radix 4 iteration first if one is required
+c
+      if (m-n8pow*3-1) 50, 40, 30
+  30  nn = 4
+      int = n/nn
+      call r4tr(int, b(1), b(int+1), b(2*int+1), b(3*int+1))
+      go to 60
+  40  nn = 2
+      int = n/nn
+      call r2tr(int, b(1), b(int+1))
+      go to 60
+  50  nn = 1
+c
+c perform radix 8 iterations
+c
+  60  if (n8pow) 90, 90, 70
+  70  do 80 it=1,n8pow
+        nn = nn*8
+        int = n/nn
+        call r8tr(int, nn, b(1), b(int+1), b(2*int+1), b(3*int+1),
+     *      b(4*int+1), b(5*int+1), b(6*int+1), b(7*int+1), b(1),
+     *      b(int+1), b(2*int+1), b(3*int+1), b(4*int+1), b(5*int+1),
+     *      b(6*int+1), b(7*int+1))
+  80  continue
+c
+c perform in-place reordering
+c
+  90  call ord1(m, b)
+      call ord2(m, b)
+      t = b(2)
+      b(2) = 0.
+      b(nfft+1) = t
+      b(nfft+2) = 0.
+      do 100 i=4,nfft,2
+        b(i) = -b(i)
+ 100  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  ffs
+c fast fourier synthesis subroutine
+c radix 8-4-2
+c-----------------------------------------------------------------------
+c
+      subroutine ffs (b, nfft, ier)
+c
+c this subroutine synthesizes the real vector b(k), where
+c k=1,2,...,n. the initial fourier coefficients are placed in
+c the b array of size n+2.  the dc term is in b(1) with
+c b(2) equal to 0.
+c the jth harmonic is stored as b(2*j+1) + i b(2*j+2).
+c the n/2 harmonic is in b(n+1) with b(n+2) equal to 0.
+c the subroutine is called as ffs(b,n) where n=2**m and
+c b is the n term real array discussed above.
+c
+      dimension b(2)
+      common /con1/ pii, p7, p7two, c22, s22, pi2
+c
+c iw is a machine dependent write device number
+c
+c+noao
+c      iw = i1mach(2)
+      ier = 0
+c-noao
+c
+      pii = 4.*atan(1.)
+      pi8 = pii/8.
+      p7 = 1./sqrt(2.)
+      p7two = 2.*p7
+      c22 = cos(pi8)
+      s22 = sin(pi8)
+      pi2 = 2.*pii
+      n = 1
+      do 10 i=1,31
+        m = i
+        n = n*2
+        if (n.eq.nfft) go to 20
+  10  continue
+c+noao
+c      write (iw,9999)
+c9999  format (30h nfft not a power of 2 for ffs)
+c      stop
+      ier = 1
+      return
+c-noao
+  20  continue
+      b(2) = b(nfft+1)
+      do 30 i=1,nfft
+        b(i) = b(i)/float(nfft)
+  30  continue
+      do 40 i=4,nfft,2
+        b(i) = -b(i)
+  40  continue
+      n8pow = m/3
+c
+c reorder the input fourier coefficients
+c
+      call ord2(m, b)
+      call ord1(m, b)
+c
+      if (n8pow.eq.0) go to 60
+c
+c perform the radix 8 iterations
+c
+      nn = n
+      do 50 it=1,n8pow
+        int = n/nn
+        call r8syn(int, nn, b, b(int+1), b(2*int+1), b(3*int+1),
+     *      b(4*int+1), b(5*int+1), b(6*int+1), b(7*int+1), b(1),
+     *      b(int+1), b(2*int+1), b(3*int+1), b(4*int+1), b(5*int+1),
+     *      b(6*int+1), b(7*int+1))
+        nn = nn/8
+  50  continue
+c
+c do a radix 2 or radix 4 iteration if one is required
+c
+  60  if (m-n8pow*3-1) 90, 80, 70
+  70  int = n/4
+      call r4syn(int, b(1), b(int+1), b(2*int+1), b(3*int+1))
+      go to 90
+  80  int = n/2
+      call r2tr(int, b(1), b(int+1))
+  90  return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r2tr
+c radix 2 iteration subroutine
+c-----------------------------------------------------------------------
+c
+c
+      subroutine r2tr(int, b0, b1)
+      dimension b0(2), b1(2)
+      do 10 k=1,int
+        t = b0(k) + b1(k)
+        b1(k) = b0(k) - b1(k)
+        b0(k) = t
+  10  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r4tr
+c radix 4 iteration subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r4tr(int, b0, b1, b2, b3)
+      dimension b0(2), b1(2), b2(2), b3(2)
+      do 10 k=1,int
+        r0 = b0(k) + b2(k)
+        r1 = b1(k) + b3(k)
+        b2(k) = b0(k) - b2(k)
+        b3(k) = b1(k) - b3(k)
+        b0(k) = r0 + r1
+        b1(k) = r0 - r1
+  10  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine: r8tr
+c radix 8 iteration subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r8tr(int, nn, br0, br1, br2, br3, br4, br5, br6, br7,
+     *    bi0, bi1, bi2, bi3, bi4, bi5, bi6, bi7)
+      dimension l(15), br0(2), br1(2), br2(2), br3(2), br4(2), br5(2),
+     *    br6(2), br7(2), bi0(2), bi1(2), bi2(2), bi3(2), bi4(2),
+     *    bi5(2), bi6(2), bi7(2)
+      common /con/ pii, p7, p7two, c22, s22, pi2
+      equivalence (l15,l(1)), (l14,l(2)), (l13,l(3)), (l12,l(4)),
+     *    (l11,l(5)), (l10,l(6)), (l9,l(7)), (l8,l(8)), (l7,l(9)),
+     *    (l6,l(10)), (l5,l(11)), (l4,l(12)), (l3,l(13)), (l2,l(14)),
+     *    (l1,l(15))
+c
+c set up counters such that jthet steps through the arguments
+c of w, jr steps through starting locations for the real part of the
+c intermediate results and ji steps through starting locations
+c of the imaginary part of the intermediate results.
+c
+      l(1) = nn/8
+      do 40 k=2,15
+        if (l(k-1)-2) 10, 20, 30
+  10    l(k-1) = 2
+  20    l(k) = 2
+        go to 40
+  30    l(k) = l(k-1)/2
+  40  continue
+      piovn = pii/float(nn)
+      ji = 3
+      jl = 2
+      jr = 2
+      do 120 j1=2,l1,2
+      do 120 j2=j1,l2,l1
+      do 120 j3=j2,l3,l2
+      do 120 j4=j3,l4,l3
+      do 120 j5=j4,l5,l4
+      do 120 j6=j5,l6,l5
+      do 120 j7=j6,l7,l6
+      do 120 j8=j7,l8,l7
+      do 120 j9=j8,l9,l8
+      do 120 j10=j9,l10,l9
+      do 120 j11=j10,l11,l10
+      do 120 j12=j11,l12,l11
+      do 120 j13=j12,l13,l12
+      do 120 j14=j13,l14,l13
+      do 120 jthet=j14,l15,l14
+        th2 = jthet - 2
+        if (th2) 50, 50, 90
+  50    do 60 k=1,int
+          t0 = br0(k) + br4(k)
+          t1 = br1(k) + br5(k)
+          t2 = br2(k) + br6(k)
+          t3 = br3(k) + br7(k)
+          t4 = br0(k) - br4(k)
+          t5 = br1(k) - br5(k)
+          t6 = br2(k) - br6(k)
+          t7 = br3(k) - br7(k)
+          br2(k) = t0 - t2
+          br3(k) = t1 - t3
+          t0 = t0 + t2
+          t1 = t1 + t3
+          br0(k) = t0 + t1
+          br1(k) = t0 - t1
+          pr = p7*(t5-t7)
+          pi = p7*(t5+t7)
+          br4(k) = t4 + pr
+          br7(k) = t6 + pi
+          br6(k) = t4 - pr
+          br5(k) = pi - t6
+  60    continue
+        if (nn-8) 120, 120, 70
+  70    k0 = int*8 + 1
+        kl = k0 + int - 1
+        do 80 k=k0,kl
+          pr = p7*(bi2(k)-bi6(k))
+          pi = p7*(bi2(k)+bi6(k))
+          tr0 = bi0(k) + pr
+          ti0 = bi4(k) + pi
+          tr2 = bi0(k) - pr
+          ti2 = bi4(k) - pi
+          pr = p7*(bi3(k)-bi7(k))
+          pi = p7*(bi3(k)+bi7(k))
+          tr1 = bi1(k) + pr
+          ti1 = bi5(k) + pi
+          tr3 = bi1(k) - pr
+          ti3 = bi5(k) - pi
+          pr = tr1*c22 - ti1*s22
+          pi = ti1*c22 + tr1*s22
+          bi0(k) = tr0 + pr
+          bi6(k) = tr0 - pr
+          bi7(k) = ti0 + pi
+          bi1(k) = pi - ti0
+          pr = -tr3*s22 - ti3*c22
+          pi = tr3*c22 - ti3*s22
+          bi2(k) = tr2 + pr
+          bi4(k) = tr2 - pr
+          bi5(k) = ti2 + pi
+          bi3(k) = pi - ti2
+  80    continue
+        go to 120
+  90    arg = th2*piovn
+        c1 = cos(arg)
+        s1 = sin(arg)
+        c2 = c1**2 - s1**2
+        s2 = c1*s1 + c1*s1
+        c3 = c1*c2 - s1*s2
+        s3 = c2*s1 + s2*c1
+        c4 = c2**2 - s2**2
+        s4 = c2*s2 + c2*s2
+        c5 = c2*c3 - s2*s3
+        s5 = c3*s2 + s3*c2
+        c6 = c3**2 - s3**2
+        s6 = c3*s3 + c3*s3
+        c7 = c3*c4 - s3*s4
+        s7 = c4*s3 + s4*c3
+        int8 = int*8
+        j0 = jr*int8 + 1
+        k0 = ji*int8 + 1
+        jlast = j0 + int - 1
+        do 100 j=j0,jlast
+          k = k0 + j - j0
+          tr1 = br1(j)*c1 - bi1(k)*s1
+          ti1 = br1(j)*s1 + bi1(k)*c1
+          tr2 = br2(j)*c2 - bi2(k)*s2
+          ti2 = br2(j)*s2 + bi2(k)*c2
+          tr3 = br3(j)*c3 - bi3(k)*s3
+          ti3 = br3(j)*s3 + bi3(k)*c3
+          tr4 = br4(j)*c4 - bi4(k)*s4
+          ti4 = br4(j)*s4 + bi4(k)*c4
+          tr5 = br5(j)*c5 - bi5(k)*s5
+          ti5 = br5(j)*s5 + bi5(k)*c5
+          tr6 = br6(j)*c6 - bi6(k)*s6
+          ti6 = br6(j)*s6 + bi6(k)*c6
+          tr7 = br7(j)*c7 - bi7(k)*s7
+          ti7 = br7(j)*s7 + bi7(k)*c7
+c
+          t0 = br0(j) + tr4
+          t1 = bi0(k) + ti4
+          tr4 = br0(j) - tr4
+          ti4 = bi0(k) - ti4
+          t2 = tr1 + tr5
+          t3 = ti1 + ti5
+          tr5 = tr1 - tr5
+          ti5 = ti1 - ti5
+          t4 = tr2 + tr6
+          t5 = ti2 + ti6
+          tr6 = tr2 - tr6
+          ti6 = ti2 - ti6
+          t6 = tr3 + tr7
+          t7 = ti3 + ti7
+          tr7 = tr3 - tr7
+          ti7 = ti3 - ti7
+c
+          tr0 = t0 + t4
+          ti0 = t1 + t5
+          tr2 = t0 - t4
+          ti2 = t1 - t5
+          tr1 = t2 + t6
+          ti1 = t3 + t7
+          tr3 = t2 - t6
+          ti3 = t3 - t7
+          t0 = tr4 - ti6
+          t1 = ti4 + tr6
+          t4 = tr4 + ti6
+          t5 = ti4 - tr6
+          t2 = tr5 - ti7
+          t3 = ti5 + tr7
+          t6 = tr5 + ti7
+          t7 = ti5 - tr7
+          br0(j) = tr0 + tr1
+          bi7(k) = ti0 + ti1
+          bi6(k) = tr0 - tr1
+          br1(j) = ti1 - ti0
+          br2(j) = tr2 - ti3
+          bi5(k) = ti2 + tr3
+          bi4(k) = tr2 + ti3
+          br3(j) = tr3 - ti2
+          pr = p7*(t2-t3)
+          pi = p7*(t2+t3)
+          br4(j) = t0 + pr
+          bi3(k) = t1 + pi
+          bi2(k) = t0 - pr
+          br5(j) = pi - t1
+          pr = -p7*(t6+t7)
+          pi = p7*(t6-t7)
+          br6(j) = t4 + pr
+          bi1(k) = t5 + pi
+          bi0(k) = t4 - pr
+          br7(j) = pi - t5
+ 100    continue
+        jr = jr + 2
+        ji = ji - 2
+        if (ji-jl) 110, 110, 120
+ 110    ji = 2*jr - 1
+        jl = jr
+ 120  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r4syn
+c radix 4 synthesis
+c-----------------------------------------------------------------------
+c
+      subroutine r4syn(int, b0, b1, b2, b3)
+      dimension b0(2), b1(2), b2(2), b3(2)
+      do 10 k=1,int
+        t0 = b0(k) + b1(k)
+        t1 = b0(k) - b1(k)
+        t2 = b2(k) + b2(k)
+        t3 = b3(k) + b3(k)
+        b0(k) = t0 + t2
+        b2(k) = t0 - t2
+        b1(k) = t1 + t3
+        b3(k) = t1 - t3
+  10  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r8syn
+c radix 8 synthesis subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r8syn(int, nn, br0, br1, br2, br3, br4, br5, br6, br7,
+     *    bi0, bi1, bi2, bi3, bi4, bi5, bi6, bi7)
+      dimension l(15), br0(2), br1(2), br2(2), br3(2), br4(2), br5(2),
+     *    br6(2), br7(2), bi0(2), bi1(2), bi2(2), bi3(2), bi4(2),
+     *    bi5(2), bi6(2), bi7(2)
+      common /con1/ pii, p7, p7two, c22, s22, pi2
+      equivalence (l15,l(1)), (l14,l(2)), (l13,l(3)), (l12,l(4)),
+     *    (l11,l(5)), (l10,l(6)), (l9,l(7)), (l8,l(8)), (l7,l(9)),
+     *    (l6,l(10)), (l5,l(11)), (l4,l(12)), (l3,l(13)), (l2,l(14)),
+     *    (l1,l(15))
+      l(1) = nn/8
+      do 40 k=2,15
+        if (l(k-1)-2) 10, 20, 30
+  10    l(k-1) = 2
+  20    l(k) = 2
+        go to 40
+  30    l(k) = l(k-1)/2
+  40  continue
+      piovn = pii/float(nn)
+      ji = 3
+      jl = 2
+      jr = 2
+c
+      do 120 j1=2,l1,2
+      do 120 j2=j1,l2,l1
+      do 120 j3=j2,l3,l2
+      do 120 j4=j3,l4,l3
+      do 120 j5=j4,l5,l4
+      do 120 j6=j5,l6,l5
+      do 120 j7=j6,l7,l6
+      do 120 j8=j7,l8,l7
+      do 120 j9=j8,l9,l8
+      do 120 j10=j9,l10,l9
+      do 120 j11=j10,l11,l10
+      do 120 j12=j11,l12,l11
+      do 120 j13=j12,l13,l12
+      do 120 j14=j13,l14,l13
+      do 120 jthet=j14,l15,l14
+        th2 = jthet - 2
+        if (th2) 50, 50, 90
+  50    do 60 k=1,int
+          t0 = br0(k) + br1(k)
+          t1 = br0(k) - br1(k)
+          t2 = br2(k) + br2(k)
+          t3 = br3(k) + br3(k)
+          t4 = br4(k) + br6(k)
+          t6 = br7(k) - br5(k)
+          t5 = br4(k) - br6(k)
+          t7 = br7(k) + br5(k)
+          pr = p7*(t7+t5)
+          pi = p7*(t7-t5)
+          tt0 = t0 + t2
+          tt1 = t1 + t3
+          t2 = t0 - t2
+          t3 = t1 - t3
+          t4 = t4 + t4
+          t5 = pr + pr
+          t6 = t6 + t6
+          t7 = pi + pi
+          br0(k) = tt0 + t4
+          br1(k) = tt1 + t5
+          br2(k) = t2 + t6
+          br3(k) = t3 + t7
+          br4(k) = tt0 - t4
+          br5(k) = tt1 - t5
+          br6(k) = t2 - t6
+          br7(k) = t3 - t7
+  60    continue
+        if (nn-8) 120, 120, 70
+  70    k0 = int*8 + 1
+        kl = k0 + int - 1
+        do 80 k=k0,kl
+          t1 = bi0(k) + bi6(k)
+          t2 = bi7(k) - bi1(k)
+          t3 = bi0(k) - bi6(k)
+          t4 = bi7(k) + bi1(k)
+          pr = t3*c22 + t4*s22
+          pi = t4*c22 - t3*s22
+          t5 = bi2(k) + bi4(k)
+          t6 = bi5(k) - bi3(k)
+          t7 = bi2(k) - bi4(k)
+          t8 = bi5(k) + bi3(k)
+          rr = t8*c22 - t7*s22
+          ri = -t8*s22 - t7*c22
+          bi0(k) = (t1+t5) + (t1+t5)
+          bi4(k) = (t2+t6) + (t2+t6)
+          bi1(k) = (pr+rr) + (pr+rr)
+          bi5(k) = (pi+ri) + (pi+ri)
+          t5 = t1 - t5
+          t6 = t2 - t6
+          bi2(k) = p7two*(t6+t5)
+          bi6(k) = p7two*(t6-t5)
+          rr = pr - rr
+          ri = pi - ri
+          bi3(k) = p7two*(ri+rr)
+          bi7(k) = p7two*(ri-rr)
+  80    continue
+        go to 120
+  90    arg = th2*piovn
+        c1 = cos(arg)
+        s1 = -sin(arg)
+        c2 = c1**2 - s1**2
+        s2 = c1*s1 + c1*s1
+        c3 = c1*c2 - s1*s2
+        s3 = c2*s1 + s2*c1
+        c4 = c2**2 - s2**2
+        s4 = c2*s2 + c2*s2
+        c5 = c2*c3 - s2*s3
+        s5 = c3*s2 + s3*c2
+        c6 = c3**2 - s3**2
+        s6 = c3*s3 + c3*s3
+        c7 = c3*c4 - s3*s4
+        s7 = c4*s3 + s4*c3
+        int8 = int*8
+        j0 = jr*int8 + 1
+        k0 = ji*int8 + 1
+        jlast = j0 + int - 1
+        do 100 j=j0,jlast
+          k = k0 + j - j0
+          tr0 = br0(j) + bi6(k)
+          ti0 = bi7(k) - br1(j)
+          tr1 = br0(j) - bi6(k)
+          ti1 = bi7(k) + br1(j)
+          tr2 = br2(j) + bi4(k)
+          ti2 = bi5(k) - br3(j)
+          tr3 = bi5(k) + br3(j)
+          ti3 = bi4(k) - br2(j)
+          tr4 = br4(j) + bi2(k)
+          ti4 = bi3(k) - br5(j)
+          t0 = br4(j) - bi2(k)
+          t1 = bi3(k) + br5(j)
+          tr5 = p7*(t0+t1)
+          ti5 = p7*(t1-t0)
+          tr6 = br6(j) + bi0(k)
+          ti6 = bi1(k) - br7(j)
+          t0 = br6(j) - bi0(k)
+          t1 = bi1(k) + br7(j)
+          tr7 = -p7*(t0-t1)
+          ti7 = -p7*(t1+t0)
+          t0 = tr0 + tr2
+          t1 = ti0 + ti2
+          t2 = tr1 + tr3
+          t3 = ti1 + ti3
+          tr2 = tr0 - tr2
+          ti2 = ti0 - ti2
+          tr3 = tr1 - tr3
+          ti3 = ti1 - ti3
+          t4 = tr4 + tr6
+          t5 = ti4 + ti6
+          t6 = tr5 + tr7
+          t7 = ti5 + ti7
+          ttr6 = ti4 - ti6
+          ti6 = tr6 - tr4
+          ttr7 = ti5 - ti7
+          ti7 = tr7 - tr5
+          br0(j) = t0 + t4
+          bi0(k) = t1 + t5
+          br1(j) = c1*(t2+t6) - s1*(t3+t7)
+          bi1(k) = c1*(t3+t7) + s1*(t2+t6)
+          br2(j) = c2*(tr2+ttr6) - s2*(ti2+ti6)
+          bi2(k) = c2*(ti2+ti6) + s2*(tr2+ttr6)
+          br3(j) = c3*(tr3+ttr7) - s3*(ti3+ti7)
+          bi3(k) = c3*(ti3+ti7) + s3*(tr3+ttr7)
+          br4(j) = c4*(t0-t4) - s4*(t1-t5)
+          bi4(k) = c4*(t1-t5) + s4*(t0-t4)
+          br5(j) = c5*(t2-t6) - s5*(t3-t7)
+          bi5(k) = c5*(t3-t7) + s5*(t2-t6)
+          br6(j) = c6*(tr2-ttr6) - s6*(ti2-ti6)
+          bi6(k) = c6*(ti2-ti6) + s6*(tr2-ttr6)
+          br7(j) = c7*(tr3-ttr7) - s7*(ti3-ti7)
+          bi7(k) = c7*(ti3-ti7) + s7*(tr3-ttr7)
+ 100    continue
+        jr = jr + 2
+        ji = ji - 2
+        if (ji-jl) 110, 110, 120
+ 110    ji = 2*jr - 1
+        jl = jr
+ 120  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  ord1
+c in-place reordering subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine ord1(m, b)
+      dimension b(2)
+c
+      k = 4
+      kl = 2
+      n = 2**m
+      do 40 j=4,n,2
+        if (k-j) 20, 20, 10
+  10    t = b(j)
+        b(j) = b(k)
+        b(k) = t
+  20    k = k - 2
+        if (k-kl) 30, 30, 40
+  30    k = 2*j
+        kl = j
+  40  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  ord2
+c in-place reordering subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine ord2(m, b)
+      dimension l(15), b(2)
+      equivalence (l15,l(1)), (l14,l(2)), (l13,l(3)), (l12,l(4)),
+     *    (l11,l(5)), (l10,l(6)), (l9,l(7)), (l8,l(8)), (l7,l(9)),
+     *    (l6,l(10)), (l5,l(11)), (l4,l(12)), (l3,l(13)), (l2,l(14)),
+     *    (l1,l(15))
+      n = 2**m
+      l(1) = n
+      do 10 k=2,m
+        l(k) = l(k-1)/2
+  10  continue
+      do 20 k=m,14
+        l(k+1) = 2
+  20  continue
+      ij = 2
+      do 40 j1=2,l1,2
+      do 40 j2=j1,l2,l1
+      do 40 j3=j2,l3,l2
+      do 40 j4=j3,l4,l3
+      do 40 j5=j4,l5,l4
+      do 40 j6=j5,l6,l5
+      do 40 j7=j6,l7,l6
+      do 40 j8=j7,l8,l7
+      do 40 j9=j8,l9,l8
+      do 40 j10=j9,l10,l9
+      do 40 j11=j10,l11,l10
+      do 40 j12=j11,l12,l11
+      do 40 j13=j12,l13,l12
+      do 40 j14=j13,l14,l13
+      do 40 ji=j14,l15,l14
+        if (ij-ji) 30, 40, 40
+  30    t = b(ij-1)
+        b(ij-1) = b(ji-1)
+        b(ji-1) = t
+        t = b(ij)
+        b(ij) = b(ji)
+        b(ji) = t
+  40    ij = ij + 2
+      return
+      end
diff --git a/sys/vops/fftx.f b/sys/vops/fftx.f
new file mode 100644
index 00000000..2e8a5620
--- /dev/null
+++ b/sys/vops/fftx.f
@@ -0,0 +1,277 @@
+c
+c-----------------------------------------------------------------------
+c subroutine:  fft842
+c fast fourier transform for n=2**m
+c complex input
+c-----------------------------------------------------------------------
+c
+      subroutine fft842 (in, n, x, y, ier)
+c
+c this program replaces the vector z=x+iy by its  finite
+c discrete, complex fourier transform if in=0.  the inverse transform
+c is calculated for in=1.  it performs as many base
+c 8 iterations as possible and then finishes with a base 4 iteration
+c or a base 2 iteration if needed.
+c
+c the subroutine is called as subroutine fft842 (in,n,x,y).
+c the integer n (a power of 2), the n real location array x, and
+c the n real location array y must be supplied to the subroutine.
+c
+      dimension x(*), y(*), l(15)
+      common /con2/ pi2, p7
+      equivalence (l15,l(1)), (l14,l(2)), (l13,l(3)), (l12,l(4)),
+     *    (l11,l(5)), (l10,l(6)), (l9,l(7)), (l8,l(8)), (l7,l(9)),
+     *    (l6,l(10)), (l5,l(11)), (l4,l(12)), (l3,l(13)), (l2,l(14)),
+     *    (l1,l(15))
+c
+c
+c iw is a machine dependent write device number
+c
+c+noao
+c      iw = i1mach(2)
+      ier = 0
+c-noao
+c
+      pi2 = 8.*atan(1.)
+      p7 = 1./sqrt(2.)
+      do 10 i=1,31
+        m = i
+        nt = 2**i
+        if (n.eq.nt) go to 20
+  10  continue
+c+noao
+c      write (iw,9999)
+c9999  format (35h n is not a power of two for fft842)
+c      stop
+      ier = 1
+      return
+c-noao
+  20  n2pow = m
+      nthpo = n
+      fn = nthpo
+      if (in.eq.1) go to 40
+      do 30 i=1,nthpo
+        y(i) = -y(i)
+  30  continue
+  40  n8pow = n2pow/3
+      if (n8pow.eq.0) go to 60
+c
+c radix 8 passes,if any.
+c
+      do 50 ipass=1,n8pow
+        nxtlt = 2**(n2pow-3*ipass)
+        lengt = 8*nxtlt
+        call r8tx(nxtlt, nthpo, lengt, x(1), x(nxtlt+1), x(2*nxtlt+1),
+     *      x(3*nxtlt+1), x(4*nxtlt+1), x(5*nxtlt+1), x(6*nxtlt+1),
+     *      x(7*nxtlt+1), y(1), y(nxtlt+1), y(2*nxtlt+1), y(3*nxtlt+1),
+     *      y(4*nxtlt+1), y(5*nxtlt+1), y(6*nxtlt+1), y(7*nxtlt+1))
+  50  continue
+c
+c is there a four factor left
+c
+  60  if (n2pow-3*n8pow-1) 90, 70, 80
+c
+c go through the base 2 iteration
+c
+c
+  70  call r2tx(nthpo, x(1), x(2), y(1), y(2))
+      go to 90
+c
+c go through the base 4 iteration
+c
+  80  call r4tx(nthpo, x(1), x(2), x(3), x(4), y(1), y(2), y(3), y(4))
+c
+  90  do 110 j=1,31
+        l(j) = 1
+        if (j-n2pow) 100, 100, 110
+ 100    l(j) = 2**(n2pow+1-j)
+ 110  continue
+      ij = 1
+      do 130 j1=1,l1
+      do 130 j2=j1,l2,l1
+      do 130 j3=j2,l3,l2
+      do 130 j4=j3,l4,l3
+      do 130 j5=j4,l5,l4
+      do 130 j6=j5,l6,l5
+      do 130 j7=j6,l7,l6
+      do 130 j8=j7,l8,l7
+      do 130 j9=j8,l9,l8
+      do 130 j10=j9,l10,l9
+      do 130 j11=j10,l11,l10
+      do 130 j12=j11,l12,l11
+      do 130 j13=j12,l13,l12
+      do 130 j14=j13,l14,l13
+      do 130 ji=j14,l15,l14
+        if (ij-ji) 120, 130, 130
+ 120    r = x(ij)
+        x(ij) = x(ji)
+        x(ji) = r
+        fi = y(ij)
+        y(ij) = y(ji)
+        y(ji) = fi
+ 130    ij = ij + 1
+      if (in.eq.1) go to 150
+      do 140 i=1,nthpo
+        y(i) = -y(i)
+ 140  continue
+      go to 170
+ 150  do 160 i=1,nthpo
+        x(i) = x(i)/fn
+        y(i) = y(i)/fn
+ 160  continue
+ 170  return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r2tx
+c radix 2 iteration subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r2tx(nthpo, cr0, cr1, ci0, ci1)
+      dimension cr0(2), cr1(2), ci0(2), ci1(2)
+      do 10 k=1,nthpo,2
+        r1 = cr0(k) + cr1(k)
+        cr1(k) = cr0(k) - cr1(k)
+        cr0(k) = r1
+        fi1 = ci0(k) + ci1(k)
+        ci1(k) = ci0(k) - ci1(k)
+        ci0(k) = fi1
+  10  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r4tx
+c radix 4 iteration subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r4tx(nthpo, cr0, cr1, cr2, cr3, ci0, ci1, ci2, ci3)
+      dimension cr0(2), cr1(2), cr2(2), cr3(2), ci0(2), ci1(2), ci2(2),
+     *    ci3(2)
+      do 10 k=1,nthpo,4
+        r1 = cr0(k) + cr2(k)
+        r2 = cr0(k) - cr2(k)
+        r3 = cr1(k) + cr3(k)
+        r4 = cr1(k) - cr3(k)
+        fi1 = ci0(k) + ci2(k)
+        fi2 = ci0(k) - ci2(k)
+        fi3 = ci1(k) + ci3(k)
+        fi4 = ci1(k) - ci3(k)
+        cr0(k) = r1 + r3
+        ci0(k) = fi1 + fi3
+        cr1(k) = r1 - r3
+        ci1(k) = fi1 - fi3
+        cr2(k) = r2 - fi4
+        ci2(k) = fi2 + r4
+        cr3(k) = r2 + fi4
+        ci3(k) = fi2 - r4
+  10  continue
+      return
+      end
+c
+c-----------------------------------------------------------------------
+c subroutine:  r8tx
+c radix 8 iteration subroutine
+c-----------------------------------------------------------------------
+c
+      subroutine r8tx(nxtlt, nthpo, lengt, cr0, cr1, cr2, cr3, cr4,
+     *    cr5, cr6, cr7, ci0, ci1, ci2, ci3, ci4, ci5, ci6, ci7)
+      dimension cr0(2), cr1(2), cr2(2), cr3(2), cr4(2), cr5(2), cr6(2),
+     *    cr7(2), ci1(2), ci2(2), ci3(2), ci4(2), ci5(2), ci6(2),
+     *    ci7(2), ci0(2)
+      common /con2/ pi2, p7
+c
+      scale = pi2/float(lengt)
+      do 30 j=1,nxtlt
+        arg = float(j-1)*scale
+        c1 = cos(arg)
+        s1 = sin(arg)
+        c2 = c1**2 - s1**2
+        s2 = c1*s1 + c1*s1
+        c3 = c1*c2 - s1*s2
+        s3 = c2*s1 + s2*c1
+        c4 = c2**2 - s2**2
+        s4 = c2*s2 + c2*s2
+        c5 = c2*c3 - s2*s3
+        s5 = c3*s2 + s3*c2
+        c6 = c3**2 - s3**2
+        s6 = c3*s3 + c3*s3
+        c7 = c3*c4 - s3*s4
+        s7 = c4*s3 + s4*c3
+        do 20 k=j,nthpo,lengt
+          ar0 = cr0(k) + cr4(k)
+          ar1 = cr1(k) + cr5(k)
+          ar2 = cr2(k) + cr6(k)
+          ar3 = cr3(k) + cr7(k)
+          ar4 = cr0(k) - cr4(k)
+          ar5 = cr1(k) - cr5(k)
+          ar6 = cr2(k) - cr6(k)
+          ar7 = cr3(k) - cr7(k)
+          ai0 = ci0(k) + ci4(k)
+          ai1 = ci1(k) + ci5(k)
+          ai2 = ci2(k) + ci6(k)
+          ai3 = ci3(k) + ci7(k)
+          ai4 = ci0(k) - ci4(k)
+          ai5 = ci1(k) - ci5(k)
+          ai6 = ci2(k) - ci6(k)
+          ai7 = ci3(k) - ci7(k)
+          br0 = ar0 + ar2
+          br1 = ar1 + ar3
+          br2 = ar0 - ar2
+          br3 = ar1 - ar3
+          br4 = ar4 - ai6
+          br5 = ar5 - ai7
+          br6 = ar4 + ai6
+          br7 = ar5 + ai7
+          bi0 = ai0 + ai2
+          bi1 = ai1 + ai3
+          bi2 = ai0 - ai2
+          bi3 = ai1 - ai3
+          bi4 = ai4 + ar6
+          bi5 = ai5 + ar7
+          bi6 = ai4 - ar6
+          bi7 = ai5 - ar7
+          cr0(k) = br0 + br1
+          ci0(k) = bi0 + bi1
+          if (j.le.1) go to 10
+          cr1(k) = c4*(br0-br1) - s4*(bi0-bi1)
+          ci1(k) = c4*(bi0-bi1) + s4*(br0-br1)
+          cr2(k) = c2*(br2-bi3) - s2*(bi2+br3)
+          ci2(k) = c2*(bi2+br3) + s2*(br2-bi3)
+          cr3(k) = c6*(br2+bi3) - s6*(bi2-br3)
+          ci3(k) = c6*(bi2-br3) + s6*(br2+bi3)
+          tr = p7*(br5-bi5)
+          ti = p7*(br5+bi5)
+          cr4(k) = c1*(br4+tr) - s1*(bi4+ti)
+          ci4(k) = c1*(bi4+ti) + s1*(br4+tr)
+          cr5(k) = c5*(br4-tr) - s5*(bi4-ti)
+          ci5(k) = c5*(bi4-ti) + s5*(br4-tr)
+          tr = -p7*(br7+bi7)
+          ti = p7*(br7-bi7)
+          cr6(k) = c3*(br6+tr) - s3*(bi6+ti)
+          ci6(k) = c3*(bi6+ti) + s3*(br6+tr)
+          cr7(k) = c7*(br6-tr) - s7*(bi6-ti)
+          ci7(k) = c7*(bi6-ti) + s7*(br6-tr)
+          go to 20
+  10      cr1(k) = br0 - br1
+          ci1(k) = bi0 - bi1
+          cr2(k) = br2 - bi3
+          ci2(k) = bi2 + br3
+          cr3(k) = br2 + bi3
+          ci3(k) = bi2 - br3
+          tr = p7*(br5-bi5)
+          ti = p7*(br5+bi5)
+          cr4(k) = br4 + tr
+          ci4(k) = bi4 + ti
+          cr5(k) = br4 - tr
+          ci5(k) = bi4 - ti
+          tr = -p7*(br7+bi7)
+          ti = p7*(br7-bi7)
+          cr6(k) = br6 + tr
+          ci6(k) = bi6 + ti
+          cr7(k) = br6 - tr
+          ci7(k) = bi6 - ti
+  20    continue
+  30  continue
+      return
+      end
diff --git a/sys/vops/lz/alani.x b/sys/vops/lz/alani.x
new file mode 100644
index 00000000..28fb324e
--- /dev/null
+++ b/sys/vops/lz/alani.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALAN -- Compute the logical AND of two vectors (generic).  The logical
+# output value is returned as an int.
+
+procedure alani (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alanki.x b/sys/vops/lz/alanki.x
new file mode 100644
index 00000000..a5523400
--- /dev/null
+++ b/sys/vops/lz/alanki.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALANK -- Compute the logical AND of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alanki (a, b, c, npix)
+
+int	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alankl.x b/sys/vops/lz/alankl.x
new file mode 100644
index 00000000..b223303c
--- /dev/null
+++ b/sys/vops/lz/alankl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALANK -- Compute the logical AND of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alankl (a, b, c, npix)
+
+long	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alanks.x b/sys/vops/lz/alanks.x
new file mode 100644
index 00000000..f63e0371
--- /dev/null
+++ b/sys/vops/lz/alanks.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALANK -- Compute the logical AND of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alanks (a, b, c, npix)
+
+short	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alanl.x b/sys/vops/lz/alanl.x
new file mode 100644
index 00000000..b06304bd
--- /dev/null
+++ b/sys/vops/lz/alanl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALAN -- Compute the logical AND of two vectors (generic).  The logical
+# output value is returned as an int.
+
+procedure alanl (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alans.x b/sys/vops/lz/alans.x
new file mode 100644
index 00000000..b2ff25c5
--- /dev/null
+++ b/sys/vops/lz/alans.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALAN -- Compute the logical AND of two vectors (generic).  The logical
+# output value is returned as an int.
+
+procedure alans (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 && b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alimc.x b/sys/vops/lz/alimc.x
new file mode 100644
index 00000000..6f05be93
--- /dev/null
+++ b/sys/vops/lz/alimc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alimc (a, npix, minval, maxval)
+
+char	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/alimd.x b/sys/vops/lz/alimd.x
new file mode 100644
index 00000000..2e56673d
--- /dev/null
+++ b/sys/vops/lz/alimd.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alimd (a, npix, minval, maxval)
+
+double	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/alimi.x b/sys/vops/lz/alimi.x
new file mode 100644
index 00000000..0a043976
--- /dev/null
+++ b/sys/vops/lz/alimi.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alimi (a, npix, minval, maxval)
+
+int	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/aliml.x b/sys/vops/lz/aliml.x
new file mode 100644
index 00000000..abbad1c5
--- /dev/null
+++ b/sys/vops/lz/aliml.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure aliml (a, npix, minval, maxval)
+
+long	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/alimr.x b/sys/vops/lz/alimr.x
new file mode 100644
index 00000000..6845f36c
--- /dev/null
+++ b/sys/vops/lz/alimr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alimr (a, npix, minval, maxval)
+
+real	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/alims.x b/sys/vops/lz/alims.x
new file mode 100644
index 00000000..71d5c498
--- /dev/null
+++ b/sys/vops/lz/alims.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alims (a, npix, minval, maxval)
+
+short	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/alimx.x b/sys/vops/lz/alimx.x
new file mode 100644
index 00000000..93a7fe61
--- /dev/null
+++ b/sys/vops/lz/alimx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+
+procedure alimx (a, npix, minval, maxval)
+
+complex	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+		if (abs(value) < abs(minval))
+		    minval = value
+		else if (abs(value) > abs(maxval))
+		    maxval = value
+	}
+end
diff --git a/sys/vops/lz/allnd.x b/sys/vops/lz/allnd.x
new file mode 100644
index 00000000..82ae72bd
--- /dev/null
+++ b/sys/vops/lz/allnd.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allnd (a, b, npix, errfcn)
+
+double	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+double	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0.0D0)
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/allni.x b/sys/vops/lz/allni.x
new file mode 100644
index 00000000..9dc1bf4a
--- /dev/null
+++ b/sys/vops/lz/allni.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allni (a, b, npix, errfcn)
+
+int	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+int	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/allnl.x b/sys/vops/lz/allnl.x
new file mode 100644
index 00000000..afc1a62e
--- /dev/null
+++ b/sys/vops/lz/allnl.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allnl (a, b, npix, errfcn)
+
+long	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+long	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (double (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/allnr.x b/sys/vops/lz/allnr.x
new file mode 100644
index 00000000..469ce448
--- /dev/null
+++ b/sys/vops/lz/allnr.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allnr (a, b, npix, errfcn)
+
+real	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+real	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0.0)
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/allns.x b/sys/vops/lz/allns.x
new file mode 100644
index 00000000..3d968186
--- /dev/null
+++ b/sys/vops/lz/allns.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allns (a, b, npix, errfcn)
+
+short	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+short	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/allnx.x b/sys/vops/lz/allnx.x
new file mode 100644
index 00000000..b4527117
--- /dev/null
+++ b/sys/vops/lz/allnx.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALLN -- Compute the natural logarithm of a vector (generic).  If the natural
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the pixel value to be returned.
+
+procedure allnx (a, b, npix, errfcn)
+
+complex	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+complex	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] == (0.0,0.0))
+		    b[i] = errfcn (a[i])
+		else {
+			b[i] = log (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/alogd.x b/sys/vops/lz/alogd.x
new file mode 100644
index 00000000..b5f7b78f
--- /dev/null
+++ b/sys/vops/lz/alogd.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogd (a, b, npix, errfcn)
+
+double	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+double	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0.0D0)
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/alogi.x b/sys/vops/lz/alogi.x
new file mode 100644
index 00000000..294289c5
--- /dev/null
+++ b/sys/vops/lz/alogi.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogi (a, b, npix, errfcn)
+
+int	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+int	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/alogl.x b/sys/vops/lz/alogl.x
new file mode 100644
index 00000000..1af0e2f5
--- /dev/null
+++ b/sys/vops/lz/alogl.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogl (a, b, npix, errfcn)
+
+long	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+long	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (double (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/alogr.x b/sys/vops/lz/alogr.x
new file mode 100644
index 00000000..049f7cc7
--- /dev/null
+++ b/sys/vops/lz/alogr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogr (a, b, npix, errfcn)
+
+real	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+real	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0.0)
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/alogs.x b/sys/vops/lz/alogs.x
new file mode 100644
index 00000000..861185a5
--- /dev/null
+++ b/sys/vops/lz/alogs.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogs (a, b, npix, errfcn)
+
+short	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+short	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] <= 0)
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/alogx.x b/sys/vops/lz/alogx.x
new file mode 100644
index 00000000..adb78cc6
--- /dev/null
+++ b/sys/vops/lz/alogx.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOG -- Compute the logarithm to the base 10 of a vector (generic).  If the
+# logarithm is undefined (x <= 0) a user supplied function is called to get
+# the function value.
+
+procedure alogx (a, b, npix, errfcn)
+
+complex	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+complex	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] == (0.0,0.0))
+		    b[i] = errfcn (a[i])
+		else {
+		    # Note Fortran standard forbids log10(cplx).
+			b[i] = log10 (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/alori.x b/sys/vops/lz/alori.x
new file mode 100644
index 00000000..07fefc59
--- /dev/null
+++ b/sys/vops/lz/alori.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOR -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alori (a, b, c, npix)
+
+int	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alorki.x b/sys/vops/lz/alorki.x
new file mode 100644
index 00000000..1fa2089e
--- /dev/null
+++ b/sys/vops/lz/alorki.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALORK -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alorki (a, b, c, npix)
+
+int	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alorkl.x b/sys/vops/lz/alorkl.x
new file mode 100644
index 00000000..eedcb247
--- /dev/null
+++ b/sys/vops/lz/alorkl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALORK -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alorkl (a, b, c, npix)
+
+long	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alorks.x b/sys/vops/lz/alorks.x
new file mode 100644
index 00000000..a38924c9
--- /dev/null
+++ b/sys/vops/lz/alorks.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALORK -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alorks (a, b, c, npix)
+
+short	a[ARB], b
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alorl.x b/sys/vops/lz/alorl.x
new file mode 100644
index 00000000..bd23bcb1
--- /dev/null
+++ b/sys/vops/lz/alorl.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOR -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alorl (a, b, c, npix)
+
+long	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alors.x b/sys/vops/lz/alors.x
new file mode 100644
index 00000000..a87c5915
--- /dev/null
+++ b/sys/vops/lz/alors.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOR -- Compute the logical OR of a vector and a constant (generic).
+# The logical output value is returned as an int.
+
+procedure alors (a, b, c, npix)
+
+short	a[ARB], b[ARB]
+int	c[ARB]
+
+int	npix, i
+
+begin
+	do i = 1, npix
+	    if (a[i] != 0 || b[i] != 0)
+		c[i] = YES
+	    else
+		c[i] = NO
+end
diff --git a/sys/vops/lz/alovc.x b/sys/vops/lz/alovc.x
new file mode 100644
index 00000000..39b5ff34
--- /dev/null
+++ b/sys/vops/lz/alovc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+char procedure alovc (a, npix)
+
+char	a[ARB]
+int	npix
+char	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovd.x b/sys/vops/lz/alovd.x
new file mode 100644
index 00000000..e5de175b
--- /dev/null
+++ b/sys/vops/lz/alovd.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+double procedure alovd (a, npix)
+
+double	a[ARB]
+int	npix
+double	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovi.x b/sys/vops/lz/alovi.x
new file mode 100644
index 00000000..f2045c11
--- /dev/null
+++ b/sys/vops/lz/alovi.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+int procedure alovi (a, npix)
+
+int	a[ARB]
+int	npix
+int	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovl.x b/sys/vops/lz/alovl.x
new file mode 100644
index 00000000..9fcf4f6d
--- /dev/null
+++ b/sys/vops/lz/alovl.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+long procedure alovl (a, npix)
+
+long	a[ARB]
+int	npix
+long	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovr.x b/sys/vops/lz/alovr.x
new file mode 100644
index 00000000..87e08917
--- /dev/null
+++ b/sys/vops/lz/alovr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+real procedure alovr (a, npix)
+
+real	a[ARB]
+int	npix
+real	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovs.x b/sys/vops/lz/alovs.x
new file mode 100644
index 00000000..30a83bed
--- /dev/null
+++ b/sys/vops/lz/alovs.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+short procedure alovs (a, npix)
+
+short	a[ARB]
+int	npix
+short	low, pixval
+int	i
+
+begin
+	low = a[1]
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (pixval < low)
+		low = pixval
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/alovx.x b/sys/vops/lz/alovx.x
new file mode 100644
index 00000000..c0d17deb
--- /dev/null
+++ b/sys/vops/lz/alovx.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALOV -- Compute the low value (minimum) of a vector.
+
+complex procedure alovx (a, npix)
+
+complex	a[ARB]
+int	npix
+complex	low, pixval
+real	abs_low
+int	i
+
+begin
+	low = a[1]
+	abs_low = abs (low)
+
+	do i = 1, npix {
+	    pixval = a[i]
+	    if (abs (pixval) < abs_low) {
+		low = pixval
+		abs_low = abs (low)
+	    }
+	}
+
+	return (low)
+end
diff --git a/sys/vops/lz/altad.x b/sys/vops/lz/altad.x
new file mode 100644
index 00000000..05fca620
--- /dev/null
+++ b/sys/vops/lz/altad.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altad (a, b, npix, k1, k2)
+
+double	a[ARB], b[ARB]
+double	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altai.x b/sys/vops/lz/altai.x
new file mode 100644
index 00000000..62576263
--- /dev/null
+++ b/sys/vops/lz/altai.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altai (a, b, npix, k1, k2)
+
+int	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altal.x b/sys/vops/lz/altal.x
new file mode 100644
index 00000000..d95ca1f4
--- /dev/null
+++ b/sys/vops/lz/altal.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altal (a, b, npix, k1, k2)
+
+long	a[ARB], b[ARB]
+double	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altar.x b/sys/vops/lz/altar.x
new file mode 100644
index 00000000..031be04d
--- /dev/null
+++ b/sys/vops/lz/altar.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altar (a, b, npix, k1, k2)
+
+real	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altas.x b/sys/vops/lz/altas.x
new file mode 100644
index 00000000..7b59d86b
--- /dev/null
+++ b/sys/vops/lz/altas.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altas (a, b, npix, k1, k2)
+
+short	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altax.x b/sys/vops/lz/altax.x
new file mode 100644
index 00000000..7d71e97d
--- /dev/null
+++ b/sys/vops/lz/altax.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTA -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] + k1) * k2
+
+procedure altax (a, b, npix, k1, k2)
+
+complex	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2
+end
diff --git a/sys/vops/lz/altmd.x b/sys/vops/lz/altmd.x
new file mode 100644
index 00000000..c8a7296b
--- /dev/null
+++ b/sys/vops/lz/altmd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altmd (a, b, npix, k1, k2)
+
+double	a[ARB], b[ARB]
+double	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altmi.x b/sys/vops/lz/altmi.x
new file mode 100644
index 00000000..64cb93c4
--- /dev/null
+++ b/sys/vops/lz/altmi.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altmi (a, b, npix, k1, k2)
+
+int	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altml.x b/sys/vops/lz/altml.x
new file mode 100644
index 00000000..a9727472
--- /dev/null
+++ b/sys/vops/lz/altml.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altml (a, b, npix, k1, k2)
+
+long	a[ARB], b[ARB]
+double	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altmr.x b/sys/vops/lz/altmr.x
new file mode 100644
index 00000000..a088b75d
--- /dev/null
+++ b/sys/vops/lz/altmr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altmr (a, b, npix, k1, k2)
+
+real	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altms.x b/sys/vops/lz/altms.x
new file mode 100644
index 00000000..292db9dc
--- /dev/null
+++ b/sys/vops/lz/altms.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altms (a, b, npix, k1, k2)
+
+short	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altmx.x b/sys/vops/lz/altmx.x
new file mode 100644
index 00000000..fca0e274
--- /dev/null
+++ b/sys/vops/lz/altmx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTM -- Linearly map a vector into another vector of the same datatype.
+#	b[i] = (a[i] * k1) + k2
+
+procedure altmx (a, b, npix, k1, k2)
+
+complex	a[ARB], b[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] * k1) + k2
+end
diff --git a/sys/vops/lz/altrd.x b/sys/vops/lz/altrd.x
new file mode 100644
index 00000000..57e877b0
--- /dev/null
+++ b/sys/vops/lz/altrd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altrd (a, b, npix, k1, k2, k3)
+
+double	a[ARB], b[ARB]
+double	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/altri.x b/sys/vops/lz/altri.x
new file mode 100644
index 00000000..5ef70e85
--- /dev/null
+++ b/sys/vops/lz/altri.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altri (a, b, npix, k1, k2, k3)
+
+int	a[ARB], b[ARB]
+real	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/altrl.x b/sys/vops/lz/altrl.x
new file mode 100644
index 00000000..7c3d48b8
--- /dev/null
+++ b/sys/vops/lz/altrl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altrl (a, b, npix, k1, k2, k3)
+
+long	a[ARB], b[ARB]
+double	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/altrr.x b/sys/vops/lz/altrr.x
new file mode 100644
index 00000000..f78522f5
--- /dev/null
+++ b/sys/vops/lz/altrr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altrr (a, b, npix, k1, k2, k3)
+
+real	a[ARB], b[ARB]
+real	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/altrs.x b/sys/vops/lz/altrs.x
new file mode 100644
index 00000000..50458a82
--- /dev/null
+++ b/sys/vops/lz/altrs.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altrs (a, b, npix, k1, k2, k3)
+
+short	a[ARB], b[ARB]
+real	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/altrx.x b/sys/vops/lz/altrx.x
new file mode 100644
index 00000000..d23ad236
--- /dev/null
+++ b/sys/vops/lz/altrx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALTR -- Linearly map a vector into another vector of the same datatype.
+# This is the most general form.  See also ALTA and ALTM.
+#	b[i] = (a[i] + k1) * k2 + k3
+
+procedure altrx (a, b, npix, k1, k2, k3)
+
+complex	a[ARB], b[ARB]
+real	k1, k2, k3
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = (a[i] + k1) * k2 + k3
+end
diff --git a/sys/vops/lz/aluid.x b/sys/vops/lz/aluid.x
new file mode 100644
index 00000000..d529ba77
--- /dev/null
+++ b/sys/vops/lz/aluid.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure aluid (a, b, x, npix)
+
+double	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/lz/aluii.x b/sys/vops/lz/aluii.x
new file mode 100644
index 00000000..67d63575
--- /dev/null
+++ b/sys/vops/lz/aluii.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure aluii (a, b, x, npix)
+
+int	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/lz/aluil.x b/sys/vops/lz/aluil.x
new file mode 100644
index 00000000..177fb4e6
--- /dev/null
+++ b/sys/vops/lz/aluil.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure aluil (a, b, x, npix)
+
+long	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/lz/aluir.x b/sys/vops/lz/aluir.x
new file mode 100644
index 00000000..33ef1e4b
--- /dev/null
+++ b/sys/vops/lz/aluir.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure aluir (a, b, x, npix)
+
+real	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/lz/aluis.x b/sys/vops/lz/aluis.x
new file mode 100644
index 00000000..d64dfa1a
--- /dev/null
+++ b/sys/vops/lz/aluis.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ALUI -- Vector lookup and interpolate (linear).  B[i] = A(X[i]).
+# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional
+# part) is recognized and will not cause a reference off the right end of the
+# array.  This is done in a way which will also cause execution to be faster
+# when the sample points are integral, i.e., fall exactly on data points in
+# the input array.
+
+procedure aluis (a, b, x, npix)
+
+short	a[ARB], b[ARB]
+real	x[ARB], fraction, tol
+int	npix, i, left_pixel
+
+begin
+	tol = EPSILONR * 5.0
+
+	do i = 1, npix {
+	    left_pixel = int (x[i])
+	    fraction = x[i] - real(left_pixel)
+	    if (fraction < tol)
+		b[i] = a[left_pixel]
+	    else
+		b[i] = a[left_pixel] * (1.0 - fraction) +
+		       a[left_pixel+1] * fraction
+	}
+end
diff --git a/sys/vops/lz/alutc.x b/sys/vops/lz/alutc.x
new file mode 100644
index 00000000..06d753fe
--- /dev/null
+++ b/sys/vops/lz/alutc.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure alutc (a, b, npix, lut)
+
+char	a[ARB]
+
+char	b[ARB]				# output data array
+char	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/alutd.x b/sys/vops/lz/alutd.x
new file mode 100644
index 00000000..d1e22aea
--- /dev/null
+++ b/sys/vops/lz/alutd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure alutd (a, b, npix, lut)
+
+int	a[ARB]				# input array of indices
+
+double	b[ARB]				# output data array
+double	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/aluti.x b/sys/vops/lz/aluti.x
new file mode 100644
index 00000000..ba3099b3
--- /dev/null
+++ b/sys/vops/lz/aluti.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure aluti (a, b, npix, lut)
+
+int	a[ARB]
+
+int	b[ARB]				# output data array
+int	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/alutl.x b/sys/vops/lz/alutl.x
new file mode 100644
index 00000000..ccc95ab5
--- /dev/null
+++ b/sys/vops/lz/alutl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure alutl (a, b, npix, lut)
+
+long	a[ARB]
+
+long	b[ARB]				# output data array
+long	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/alutr.x b/sys/vops/lz/alutr.x
new file mode 100644
index 00000000..a72cc11f
--- /dev/null
+++ b/sys/vops/lz/alutr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure alutr (a, b, npix, lut)
+
+int	a[ARB]				# input array of indices
+
+real	b[ARB]				# output data array
+real	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/aluts.x b/sys/vops/lz/aluts.x
new file mode 100644
index 00000000..8af08735
--- /dev/null
+++ b/sys/vops/lz/aluts.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ALUT -- Map an array using table lookup.  Note that an input value of zero
+# indexes the first element of the lookup table.  No bounds checking is
+# performed.
+
+procedure aluts (a, b, npix, lut)
+
+short	a[ARB]
+
+short	b[ARB]				# output data array
+short	lut[ARB]			# lookup table
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = lut[a[i]+1]
+end
diff --git a/sys/vops/lz/amagd.x b/sys/vops/lz/amagd.x
new file mode 100644
index 00000000..d4238cfd
--- /dev/null
+++ b/sys/vops/lz/amagd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amagd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (double(a[i] ** 2) + double(b[i] ** 2))
+end
diff --git a/sys/vops/lz/amagi.x b/sys/vops/lz/amagi.x
new file mode 100644
index 00000000..9bddef17
--- /dev/null
+++ b/sys/vops/lz/amagi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amagi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2))
+end
diff --git a/sys/vops/lz/amagl.x b/sys/vops/lz/amagl.x
new file mode 100644
index 00000000..31fd69a0
--- /dev/null
+++ b/sys/vops/lz/amagl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amagl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (double(a[i] ** 2) + double(b[i] ** 2))
+end
diff --git a/sys/vops/lz/amagr.x b/sys/vops/lz/amagr.x
new file mode 100644
index 00000000..2db3c085
--- /dev/null
+++ b/sys/vops/lz/amagr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amagr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2))
+end
diff --git a/sys/vops/lz/amags.x b/sys/vops/lz/amags.x
new file mode 100644
index 00000000..7f86bc75
--- /dev/null
+++ b/sys/vops/lz/amags.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amags (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2))
+end
diff --git a/sys/vops/lz/amagx.x b/sys/vops/lz/amagx.x
new file mode 100644
index 00000000..2319394d
--- /dev/null
+++ b/sys/vops/lz/amagx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAG -- Return the magnitude of two vectors.
+
+procedure amagx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = sqrt (a[i] ** 2 + b[i] ** 2)
+end
diff --git a/sys/vops/lz/amapd.x b/sys/vops/lz/amapd.x
new file mode 100644
index 00000000..8f766793
--- /dev/null
+++ b/sys/vops/lz/amapd.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amapd (a, b, npix, a1, a2, b1, b2)
+
+double	a[ARB], b[ARB]
+double	a1, a2, b1, b2
+
+double	minout, maxout, aoff, boff, pixval
+
+double	scalar
+
+int	npix, i
+
+begin
+	    scalar = (double (b2) - double (b1)) / (double (a2) - double (a1))
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/lz/amapi.x b/sys/vops/lz/amapi.x
new file mode 100644
index 00000000..d559a130
--- /dev/null
+++ b/sys/vops/lz/amapi.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amapi (a, b, npix, a1, a2, b1, b2)
+
+int	a[ARB], b[ARB]
+int	a1, a2, b1, b2
+
+long	minout, maxout, aoff, boff, pixval
+
+real	scalar
+
+int	npix, i
+
+begin
+	    scalar = (real (b2) - real (b1)) / (real (a2) - real (a1))
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/lz/amapl.x b/sys/vops/lz/amapl.x
new file mode 100644
index 00000000..c9d350bd
--- /dev/null
+++ b/sys/vops/lz/amapl.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amapl (a, b, npix, a1, a2, b1, b2)
+
+long	a[ARB], b[ARB]
+long	a1, a2, b1, b2
+
+long	minout, maxout, aoff, boff, pixval
+
+double	scalar
+
+int	npix, i
+
+begin
+	    scalar = (double (b2) - double (b1)) / (double (a2) - double (a1))
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/lz/amapr.x b/sys/vops/lz/amapr.x
new file mode 100644
index 00000000..d23c44b6
--- /dev/null
+++ b/sys/vops/lz/amapr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amapr (a, b, npix, a1, a2, b1, b2)
+
+real	a[ARB], b[ARB]
+real	a1, a2, b1, b2
+
+real	minout, maxout, aoff, boff, pixval
+
+real	scalar
+
+int	npix, i
+
+begin
+	    scalar = (real (b2) - real (b1)) / (real (a2) - real (a1))
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/lz/amaps.x b/sys/vops/lz/amaps.x
new file mode 100644
index 00000000..fd3b8fe0
--- /dev/null
+++ b/sys/vops/lz/amaps.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAP -- Vector linear transformation.  Map the range of pixel values
+# a1,a2 from a into the range b1,b2 in b.  It is assumed that a1 < a2
+# and b1 < b2.
+
+procedure amaps (a, b, npix, a1, a2, b1, b2)
+
+short	a[ARB], b[ARB]
+short	a1, a2, b1, b2
+
+long	minout, maxout, aoff, boff, pixval
+
+real	scalar
+
+int	npix, i
+
+begin
+	    scalar = (real (b2) - real (b1)) / (real (a2) - real (a1))
+
+	minout = min (b1, b2)
+	maxout = max (b1, b2)
+	aoff = a1
+	boff = b1
+
+	do i = 1, npix {
+	    pixval = (a[i] - aoff) * scalar
+	    b[i] = max(minout, min(maxout, pixval + boff))
+	}
+end
diff --git a/sys/vops/lz/amaxc.x b/sys/vops/lz/amaxc.x
new file mode 100644
index 00000000..89c5808b
--- /dev/null
+++ b/sys/vops/lz/amaxc.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxc (a, b, c, npix)
+
+char	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxd.x b/sys/vops/lz/amaxd.x
new file mode 100644
index 00000000..0cd8253b
--- /dev/null
+++ b/sys/vops/lz/amaxd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxi.x b/sys/vops/lz/amaxi.x
new file mode 100644
index 00000000..0b2f4330
--- /dev/null
+++ b/sys/vops/lz/amaxi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxkc.x b/sys/vops/lz/amaxkc.x
new file mode 100644
index 00000000..1b5d250b
--- /dev/null
+++ b/sys/vops/lz/amaxkc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxkc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+char	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxkd.x b/sys/vops/lz/amaxkd.x
new file mode 100644
index 00000000..afe6e45e
--- /dev/null
+++ b/sys/vops/lz/amaxkd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxki.x b/sys/vops/lz/amaxki.x
new file mode 100644
index 00000000..6c74ab6e
--- /dev/null
+++ b/sys/vops/lz/amaxki.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxkl.x b/sys/vops/lz/amaxkl.x
new file mode 100644
index 00000000..bfede4ea
--- /dev/null
+++ b/sys/vops/lz/amaxkl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxkr.x b/sys/vops/lz/amaxkr.x
new file mode 100644
index 00000000..766c12e5
--- /dev/null
+++ b/sys/vops/lz/amaxkr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxks.x b/sys/vops/lz/amaxks.x
new file mode 100644
index 00000000..31aeb0b0
--- /dev/null
+++ b/sys/vops/lz/amaxks.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = max (a[i], b)
+end
diff --git a/sys/vops/lz/amaxkx.x b/sys/vops/lz/amaxkx.x
new file mode 100644
index 00000000..9c3212eb
--- /dev/null
+++ b/sys/vops/lz/amaxkx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAXK -- Compute the maximum of a constant and a vector (generic).
+
+procedure amaxkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+real	abs_b
+
+begin
+	abs_b = abs (b)
+
+	do i = 1, npix
+		if (abs(a[i]) >= abs_b)
+		    c[i] = a[i]
+		else
+		    c[i] = b
+end
diff --git a/sys/vops/lz/amaxl.x b/sys/vops/lz/amaxl.x
new file mode 100644
index 00000000..5f12ba92
--- /dev/null
+++ b/sys/vops/lz/amaxl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxr.x b/sys/vops/lz/amaxr.x
new file mode 100644
index 00000000..c6789d5f
--- /dev/null
+++ b/sys/vops/lz/amaxr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxs.x b/sys/vops/lz/amaxs.x
new file mode 100644
index 00000000..83adb3dc
--- /dev/null
+++ b/sys/vops/lz/amaxs.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxs (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = max (a[i], b[i])
+end
diff --git a/sys/vops/lz/amaxx.x b/sys/vops/lz/amaxx.x
new file mode 100644
index 00000000..7f9b58bb
--- /dev/null
+++ b/sys/vops/lz/amaxx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMAX -- Compute the maximum of two vectors (generic).
+
+procedure amaxx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		if (abs(a[i]) >= abs(b[i]))
+		    c[i] = a[i]
+		else
+		    c[i] = b[i]
+end
diff --git a/sys/vops/lz/amed3c.x b/sys/vops/lz/amed3c.x
new file mode 100644
index 00000000..f40f6dc1
--- /dev/null
+++ b/sys/vops/lz/amed3c.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3c (a, b, c, m, npix)
+
+char	a[ARB], b[ARB], c[ARB]	# input vectors
+char	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed3d.x b/sys/vops/lz/amed3d.x
new file mode 100644
index 00000000..74fba3c4
--- /dev/null
+++ b/sys/vops/lz/amed3d.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3d (a, b, c, m, npix)
+
+double	a[ARB], b[ARB], c[ARB]	# input vectors
+double	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed3i.x b/sys/vops/lz/amed3i.x
new file mode 100644
index 00000000..2be5fb15
--- /dev/null
+++ b/sys/vops/lz/amed3i.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3i (a, b, c, m, npix)
+
+int	a[ARB], b[ARB], c[ARB]	# input vectors
+int	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed3l.x b/sys/vops/lz/amed3l.x
new file mode 100644
index 00000000..480d3b05
--- /dev/null
+++ b/sys/vops/lz/amed3l.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3l (a, b, c, m, npix)
+
+long	a[ARB], b[ARB], c[ARB]	# input vectors
+long	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed3r.x b/sys/vops/lz/amed3r.x
new file mode 100644
index 00000000..276efd03
--- /dev/null
+++ b/sys/vops/lz/amed3r.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3r (a, b, c, m, npix)
+
+real	a[ARB], b[ARB], c[ARB]	# input vectors
+real	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed3s.x b/sys/vops/lz/amed3s.x
new file mode 100644
index 00000000..8de5ff45
--- /dev/null
+++ b/sys/vops/lz/amed3s.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED3 -- Median of three vectors.  Each output point M[i] is the median value
+# of the three input points A[i],B[i],C[i].
+
+procedure amed3s (a, b, c, m, npix)
+
+short	a[ARB], b[ARB], c[ARB]	# input vectors
+short	m[ARB]				# output vector (median)
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] < b[i]) {
+		if (b[i] < c[i])		# abc
+		    m[i] = b[i]
+		else if (a[i] < c[i])		# acb
+		    m[i] = c[i]
+		else				# cab
+		    m[i] = a[i]
+	    } else {
+		if (b[i] > c[i])		# cba
+		    m[i] = b[i]
+		else if (a[i] > c[i])		# bca
+		    m[i] = c[i]
+		else				# bac
+		    m[i] = a[i]
+	    }
+end
diff --git a/sys/vops/lz/amed4c.x b/sys/vops/lz/amed4c.x
new file mode 100644
index 00000000..34228107
--- /dev/null
+++ b/sys/vops/lz/amed4c.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4c (a, b, c, d, m, npix)
+
+char	a[ARB], b[ARB]		# input vectors
+char	c[ARB], d[ARB]		# input vectors
+char	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+char	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed4d.x b/sys/vops/lz/amed4d.x
new file mode 100644
index 00000000..aec95abd
--- /dev/null
+++ b/sys/vops/lz/amed4d.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4d (a, b, c, d, m, npix)
+
+double	a[ARB], b[ARB]		# input vectors
+double	c[ARB], d[ARB]		# input vectors
+double	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+double	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed4i.x b/sys/vops/lz/amed4i.x
new file mode 100644
index 00000000..f39d01b6
--- /dev/null
+++ b/sys/vops/lz/amed4i.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4i (a, b, c, d, m, npix)
+
+int	a[ARB], b[ARB]		# input vectors
+int	c[ARB], d[ARB]		# input vectors
+int	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+int	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed4l.x b/sys/vops/lz/amed4l.x
new file mode 100644
index 00000000..367124ef
--- /dev/null
+++ b/sys/vops/lz/amed4l.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4l (a, b, c, d, m, npix)
+
+long	a[ARB], b[ARB]		# input vectors
+long	c[ARB], d[ARB]		# input vectors
+long	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+long	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed4r.x b/sys/vops/lz/amed4r.x
new file mode 100644
index 00000000..386ca7a5
--- /dev/null
+++ b/sys/vops/lz/amed4r.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4r (a, b, c, d, m, npix)
+
+real	a[ARB], b[ARB]		# input vectors
+real	c[ARB], d[ARB]		# input vectors
+real	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+real	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed4s.x b/sys/vops/lz/amed4s.x
new file mode 100644
index 00000000..3ed8fe1d
--- /dev/null
+++ b/sys/vops/lz/amed4s.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED4 -- Median of four vectors.  Each output point M[i] is the median of the
+# four input points A[i],B[i],C[i],D[i].  The vector min and max are also
+# computed and returned in the A and D vectors.  The input vectors are modifed
+# in place.
+
+procedure amed4s (a, b, c, d, m, npix)
+
+short	a[ARB], b[ARB]		# input vectors
+short	c[ARB], d[ARB]		# input vectors
+short	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+short	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+
+	    # Move the maximum value to D[i].
+	    if (b[i] > d[i])
+		swap (b[i], d[i])
+	    if (c[i] > d[i])
+		swap (c[i], d[i])
+
+	    # Return the median value.
+	    if (b[i] < c[i])
+		m[i] = b[i]
+	    else
+		m[i] = c[i]
+	}
+end
diff --git a/sys/vops/lz/amed5c.x b/sys/vops/lz/amed5c.x
new file mode 100644
index 00000000..8302e080
--- /dev/null
+++ b/sys/vops/lz/amed5c.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5c (a, b, c, d, e, m, npix)
+
+char	a[ARB], b[ARB]		# input vectors
+char	c[ARB], d[ARB], e[ARB]	# input vectors
+char	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+char	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amed5d.x b/sys/vops/lz/amed5d.x
new file mode 100644
index 00000000..a813f82f
--- /dev/null
+++ b/sys/vops/lz/amed5d.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5d (a, b, c, d, e, m, npix)
+
+double	a[ARB], b[ARB]		# input vectors
+double	c[ARB], d[ARB], e[ARB]	# input vectors
+double	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+double	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amed5i.x b/sys/vops/lz/amed5i.x
new file mode 100644
index 00000000..9738be6a
--- /dev/null
+++ b/sys/vops/lz/amed5i.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5i (a, b, c, d, e, m, npix)
+
+int	a[ARB], b[ARB]		# input vectors
+int	c[ARB], d[ARB], e[ARB]	# input vectors
+int	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+int	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amed5l.x b/sys/vops/lz/amed5l.x
new file mode 100644
index 00000000..33bd869d
--- /dev/null
+++ b/sys/vops/lz/amed5l.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5l (a, b, c, d, e, m, npix)
+
+long	a[ARB], b[ARB]		# input vectors
+long	c[ARB], d[ARB], e[ARB]	# input vectors
+long	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+long	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amed5r.x b/sys/vops/lz/amed5r.x
new file mode 100644
index 00000000..9bce0597
--- /dev/null
+++ b/sys/vops/lz/amed5r.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5r (a, b, c, d, e, m, npix)
+
+real	a[ARB], b[ARB]		# input vectors
+real	c[ARB], d[ARB], e[ARB]	# input vectors
+real	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+real	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amed5s.x b/sys/vops/lz/amed5s.x
new file mode 100644
index 00000000..31f34696
--- /dev/null
+++ b/sys/vops/lz/amed5s.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED5 -- Median of five vectors.  Each output point M[i] is the median of the
+# five input points A[i],B[i],C[i],D[i],E[i].  The vector min and max are also
+# computed and returned in the A and E vectors.  The input vectors are modifed.
+
+procedure amed5s (a, b, c, d, e, m, npix)
+
+short	a[ARB], b[ARB]		# input vectors
+short	c[ARB], d[ARB], e[ARB]	# input vectors
+short	m[ARB]				# output vector (median)
+int	npix
+
+int	i
+short	temp
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	do i = 1, npix {
+	    # Move the minimum value to A[i].
+	    if (b[i] < a[i])
+		swap (b[i], a[i])
+	    if (c[i] < a[i])
+		swap (c[i], a[i])
+	    if (d[i] < a[i])
+		swap (d[i], a[i])
+	    if (e[i] < a[i])
+		swap (e[i], a[i])
+
+	    # Move the maximum value to E[i].
+	    if (b[i] > e[i])
+		swap (b[i], e[i])
+	    if (c[i] > e[i])
+		swap (c[i], e[i])
+	    if (d[i] > e[i])
+		swap (d[i], e[i])
+
+	    # Return the median value of the central three points.
+	    if (b[i] < c[i]) {
+		if (c[i] < d[i])		# bcd
+		    m[i] = c[i]
+		else if (b[i] < d[i])		# bdc
+		    m[i] = d[i]
+		else				# dbc
+		    m[i] = b[i]
+	    } else {
+		if (c[i] > d[i])		# dcb
+		    m[i] = c[i]
+		else if (b[i] > d[i])		# cdb
+		    m[i] = d[i]
+		else				# cbd
+		    m[i] = b[i]
+	    }
+	}
+end
diff --git a/sys/vops/lz/amedc.x b/sys/vops/lz/amedc.x
new file mode 100644
index 00000000..09dcf10c
--- /dev/null
+++ b/sys/vops/lz/amedc.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+char procedure amedc (a, npix)
+
+char	a[ARB]
+int	npix
+
+pointer	sp, aa
+char	median
+char	asokc()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_CHAR)
+	    call amovc (a, Memc[aa], npix)
+	    median = asokc (Memc[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amedd.x b/sys/vops/lz/amedd.x
new file mode 100644
index 00000000..c3fbc3aa
--- /dev/null
+++ b/sys/vops/lz/amedd.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+double procedure amedd (a, npix)
+
+double	a[ARB]
+int	npix
+
+pointer	sp, aa
+double	median
+double	asokd()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_DOUBLE)
+	    call amovd (a, Memd[aa], npix)
+	    median = asokd (Memd[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amedi.x b/sys/vops/lz/amedi.x
new file mode 100644
index 00000000..69c1ce77
--- /dev/null
+++ b/sys/vops/lz/amedi.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+int procedure amedi (a, npix)
+
+int	a[ARB]
+int	npix
+
+pointer	sp, aa
+int	median
+int	asoki()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_INT)
+	    call amovi (a, Memi[aa], npix)
+	    median = asoki (Memi[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amedl.x b/sys/vops/lz/amedl.x
new file mode 100644
index 00000000..8a993fd2
--- /dev/null
+++ b/sys/vops/lz/amedl.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+long procedure amedl (a, npix)
+
+long	a[ARB]
+int	npix
+
+pointer	sp, aa
+long	median
+long	asokl()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_LONG)
+	    call amovl (a, Meml[aa], npix)
+	    median = asokl (Meml[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amedr.x b/sys/vops/lz/amedr.x
new file mode 100644
index 00000000..e459b22a
--- /dev/null
+++ b/sys/vops/lz/amedr.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+real procedure amedr (a, npix)
+
+real	a[ARB]
+int	npix
+
+pointer	sp, aa
+real	median
+real	asokr()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_REAL)
+	    call amovr (a, Memr[aa], npix)
+	    median = asokr (Memr[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/ameds.x b/sys/vops/lz/ameds.x
new file mode 100644
index 00000000..5d4d28db
--- /dev/null
+++ b/sys/vops/lz/ameds.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+short procedure ameds (a, npix)
+
+short	a[ARB]
+int	npix
+
+pointer	sp, aa
+short	median
+short	asoks()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_SHORT)
+	    call amovs (a, Mems[aa], npix)
+	    median = asoks (Mems[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amedx.x b/sys/vops/lz/amedx.x
new file mode 100644
index 00000000..ca2b75dc
--- /dev/null
+++ b/sys/vops/lz/amedx.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+complex procedure amedx (a, npix)
+
+complex	a[ARB]
+int	npix
+
+pointer	sp, aa
+complex	median
+complex	asokx()		# select the Kth smallest element from A
+real	a1, a2, a3
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		a1 = abs (a[1])
+		a2 = abs (a[2])
+		a3 = abs (a[3])
+		if (a1 < a2) {
+		    if (a2 < a3)
+			return (a[2])
+		    else if (a1 < a3)
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a2 > a3)
+			return (a[2])
+		    else if (a1 < a3)
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_COMPLEX)
+	    call amovx (a, Memx[aa], npix)
+	    median = asokx (Memx[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
diff --git a/sys/vops/lz/amgsd.x b/sys/vops/lz/amgsd.x
new file mode 100644
index 00000000..36efe58e
--- /dev/null
+++ b/sys/vops/lz/amgsd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgsd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/amgsi.x b/sys/vops/lz/amgsi.x
new file mode 100644
index 00000000..e45a8c70
--- /dev/null
+++ b/sys/vops/lz/amgsi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgsi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/amgsl.x b/sys/vops/lz/amgsl.x
new file mode 100644
index 00000000..6ae850e9
--- /dev/null
+++ b/sys/vops/lz/amgsl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgsl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/amgsr.x b/sys/vops/lz/amgsr.x
new file mode 100644
index 00000000..fbfbb880
--- /dev/null
+++ b/sys/vops/lz/amgsr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgsr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/amgss.x b/sys/vops/lz/amgss.x
new file mode 100644
index 00000000..592d520c
--- /dev/null
+++ b/sys/vops/lz/amgss.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgss (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/amgsx.x b/sys/vops/lz/amgsx.x
new file mode 100644
index 00000000..c40834f4
--- /dev/null
+++ b/sys/vops/lz/amgsx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMGS -- Return the square of the magnitude of two vectors.
+
+procedure amgsx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** 2 + b[i] ** 2
+end
diff --git a/sys/vops/lz/aminc.x b/sys/vops/lz/aminc.x
new file mode 100644
index 00000000..a319819e
--- /dev/null
+++ b/sys/vops/lz/aminc.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure aminc (a, b, c, npix)
+
+char	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/amind.x b/sys/vops/lz/amind.x
new file mode 100644
index 00000000..e1574051
--- /dev/null
+++ b/sys/vops/lz/amind.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure amind (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/amini.x b/sys/vops/lz/amini.x
new file mode 100644
index 00000000..c7a76820
--- /dev/null
+++ b/sys/vops/lz/amini.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure amini (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/aminkc.x b/sys/vops/lz/aminkc.x
new file mode 100644
index 00000000..a9b91e0e
--- /dev/null
+++ b/sys/vops/lz/aminkc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminkc (a, b, c, npix)
+
+char	a[ARB]
+char	b
+char	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminkd.x b/sys/vops/lz/aminkd.x
new file mode 100644
index 00000000..6b8a0506
--- /dev/null
+++ b/sys/vops/lz/aminkd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminki.x b/sys/vops/lz/aminki.x
new file mode 100644
index 00000000..b2793c71
--- /dev/null
+++ b/sys/vops/lz/aminki.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminkl.x b/sys/vops/lz/aminkl.x
new file mode 100644
index 00000000..530b326f
--- /dev/null
+++ b/sys/vops/lz/aminkl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminkr.x b/sys/vops/lz/aminkr.x
new file mode 100644
index 00000000..76000fb7
--- /dev/null
+++ b/sys/vops/lz/aminkr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminks.x b/sys/vops/lz/aminks.x
new file mode 100644
index 00000000..28d1b358
--- /dev/null
+++ b/sys/vops/lz/aminks.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+
+	do i = 1, npix
+		c[i] = min (a[i], b)
+end
diff --git a/sys/vops/lz/aminkx.x b/sys/vops/lz/aminkx.x
new file mode 100644
index 00000000..5f0f852d
--- /dev/null
+++ b/sys/vops/lz/aminkx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMINK -- Compute the minimum of a constant and a vector (generic).
+
+procedure aminkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+real	abs_b
+
+begin
+	abs_b = abs (b)
+
+	do i = 1, npix
+		if (abs(a[i]) <= abs_b)
+		    c[i] = a[i]
+		else
+		    c[i] = b
+end
diff --git a/sys/vops/lz/aminl.x b/sys/vops/lz/aminl.x
new file mode 100644
index 00000000..d4ae3c7e
--- /dev/null
+++ b/sys/vops/lz/aminl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure aminl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/aminr.x b/sys/vops/lz/aminr.x
new file mode 100644
index 00000000..1fafcb35
--- /dev/null
+++ b/sys/vops/lz/aminr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure aminr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/amins.x b/sys/vops/lz/amins.x
new file mode 100644
index 00000000..5d89f139
--- /dev/null
+++ b/sys/vops/lz/amins.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure amins (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = min (a[i], b[i])
+end
diff --git a/sys/vops/lz/aminx.x b/sys/vops/lz/aminx.x
new file mode 100644
index 00000000..591b23e4
--- /dev/null
+++ b/sys/vops/lz/aminx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMIN -- Compute the minimum of two vectors (generic).
+
+procedure aminx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+		if (abs(a[i]) <= abs(b[i]))
+		    c[i] = a[i]
+		else
+		    c[i] = b[i]
+end
diff --git a/sys/vops/lz/amodd.x b/sys/vops/lz/amodd.x
new file mode 100644
index 00000000..fce124b6
--- /dev/null
+++ b/sys/vops/lz/amodd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amodd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/lz/amodi.x b/sys/vops/lz/amodi.x
new file mode 100644
index 00000000..f1f5a584
--- /dev/null
+++ b/sys/vops/lz/amodi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amodi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/lz/amodkd.x b/sys/vops/lz/amodkd.x
new file mode 100644
index 00000000..24db964d
--- /dev/null
+++ b/sys/vops/lz/amodkd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/lz/amodki.x b/sys/vops/lz/amodki.x
new file mode 100644
index 00000000..d2b71438
--- /dev/null
+++ b/sys/vops/lz/amodki.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/lz/amodkl.x b/sys/vops/lz/amodkl.x
new file mode 100644
index 00000000..ef9ec8b3
--- /dev/null
+++ b/sys/vops/lz/amodkl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/lz/amodkr.x b/sys/vops/lz/amodkr.x
new file mode 100644
index 00000000..9aa1bd49
--- /dev/null
+++ b/sys/vops/lz/amodkr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/lz/amodks.x b/sys/vops/lz/amodks.x
new file mode 100644
index 00000000..be5b719c
--- /dev/null
+++ b/sys/vops/lz/amodks.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMODK -- Compute the modulus of a vector by a constant (generic).
+
+procedure amodks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b)
+end
diff --git a/sys/vops/lz/amodl.x b/sys/vops/lz/amodl.x
new file mode 100644
index 00000000..5dd47d53
--- /dev/null
+++ b/sys/vops/lz/amodl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amodl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/lz/amodr.x b/sys/vops/lz/amodr.x
new file mode 100644
index 00000000..772a1e9c
--- /dev/null
+++ b/sys/vops/lz/amodr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amodr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/lz/amods.x b/sys/vops/lz/amods.x
new file mode 100644
index 00000000..490d8ec5
--- /dev/null
+++ b/sys/vops/lz/amods.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOD -- Compute the modulus of two vectors (generic).
+
+procedure amods (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = mod (a[i], b[i])
+end
diff --git a/sys/vops/lz/amovc.x b/sys/vops/lz/amovc.x
new file mode 100644
index 00000000..096d1444
--- /dev/null
+++ b/sys/vops/lz/amovc.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovc (a, b, npix)
+
+char	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovd.x b/sys/vops/lz/amovd.x
new file mode 100644
index 00000000..3924f141
--- /dev/null
+++ b/sys/vops/lz/amovd.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovd (a, b, npix)
+
+double	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovi.x b/sys/vops/lz/amovi.x
new file mode 100644
index 00000000..e97794c7
--- /dev/null
+++ b/sys/vops/lz/amovi.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovi (a, b, npix)
+
+int	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovkc.x b/sys/vops/lz/amovkc.x
new file mode 100644
index 00000000..9be3a496
--- /dev/null
+++ b/sys/vops/lz/amovkc.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovkc (a, b, npix)
+
+char	a
+char	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovkd.x b/sys/vops/lz/amovkd.x
new file mode 100644
index 00000000..4d8eaecd
--- /dev/null
+++ b/sys/vops/lz/amovkd.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovkd (a, b, npix)
+
+double	a
+double	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovki.x b/sys/vops/lz/amovki.x
new file mode 100644
index 00000000..67556a23
--- /dev/null
+++ b/sys/vops/lz/amovki.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovki (a, b, npix)
+
+int	a
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovkl.x b/sys/vops/lz/amovkl.x
new file mode 100644
index 00000000..62c96668
--- /dev/null
+++ b/sys/vops/lz/amovkl.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovkl (a, b, npix)
+
+long	a
+long	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovkr.x b/sys/vops/lz/amovkr.x
new file mode 100644
index 00000000..feb34a5c
--- /dev/null
+++ b/sys/vops/lz/amovkr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovkr (a, b, npix)
+
+real	a
+real	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovks.x b/sys/vops/lz/amovks.x
new file mode 100644
index 00000000..3beff9af
--- /dev/null
+++ b/sys/vops/lz/amovks.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovks (a, b, npix)
+
+short	a
+short	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovkx.x b/sys/vops/lz/amovkx.x
new file mode 100644
index 00000000..acf90c91
--- /dev/null
+++ b/sys/vops/lz/amovkx.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOVK -- Copy a constant into a vector (generic).
+
+procedure amovkx (a, b, npix)
+
+complex	a
+complex	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = a
+end
diff --git a/sys/vops/lz/amovl.x b/sys/vops/lz/amovl.x
new file mode 100644
index 00000000..4cec6bbd
--- /dev/null
+++ b/sys/vops/lz/amovl.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovl (a, b, npix)
+
+long	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovr.x b/sys/vops/lz/amovr.x
new file mode 100644
index 00000000..9d6aa8cb
--- /dev/null
+++ b/sys/vops/lz/amovr.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovr (a, b, npix)
+
+real	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovs.x b/sys/vops/lz/amovs.x
new file mode 100644
index 00000000..9feaf94a
--- /dev/null
+++ b/sys/vops/lz/amovs.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovs (a, b, npix)
+
+short	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amovx.x b/sys/vops/lz/amovx.x
new file mode 100644
index 00000000..04d4fdf2
--- /dev/null
+++ b/sys/vops/lz/amovx.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMOV -- Copy a vector (generic).  The operation is carried out in such
+# a way that the result is the same whether or not the output vector
+# overlaps the input vector.
+
+procedure amovx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+int	npix, i, a_first, b_first
+
+begin
+	call zlocva (a, a_first)
+	call zlocva (b, b_first)
+
+	if (a_first == b_first)
+	    return
+
+	if (a_first < b_first) {
+	    do i = npix, 1, -1
+		b[i] = a[i]
+	} else {
+	    do i = 1, npix
+		b[i] = a[i]
+	}
+end
diff --git a/sys/vops/lz/amuld.x b/sys/vops/lz/amuld.x
new file mode 100644
index 00000000..b9a5c13b
--- /dev/null
+++ b/sys/vops/lz/amuld.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amuld (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/amuli.x b/sys/vops/lz/amuli.x
new file mode 100644
index 00000000..bf2ff538
--- /dev/null
+++ b/sys/vops/lz/amuli.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amuli (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/amulkd.x b/sys/vops/lz/amulkd.x
new file mode 100644
index 00000000..69f28a9a
--- /dev/null
+++ b/sys/vops/lz/amulkd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amulki.x b/sys/vops/lz/amulki.x
new file mode 100644
index 00000000..773a9a12
--- /dev/null
+++ b/sys/vops/lz/amulki.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amulkl.x b/sys/vops/lz/amulkl.x
new file mode 100644
index 00000000..69cef4c0
--- /dev/null
+++ b/sys/vops/lz/amulkl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amulkr.x b/sys/vops/lz/amulkr.x
new file mode 100644
index 00000000..71cac10c
--- /dev/null
+++ b/sys/vops/lz/amulkr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amulks.x b/sys/vops/lz/amulks.x
new file mode 100644
index 00000000..28f6d4ec
--- /dev/null
+++ b/sys/vops/lz/amulks.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amulkx.x b/sys/vops/lz/amulkx.x
new file mode 100644
index 00000000..c3fe3a36
--- /dev/null
+++ b/sys/vops/lz/amulkx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMULK -- Multiply a constant times a vector (generic).
+
+procedure amulkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b
+end
diff --git a/sys/vops/lz/amull.x b/sys/vops/lz/amull.x
new file mode 100644
index 00000000..bb913fe2
--- /dev/null
+++ b/sys/vops/lz/amull.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amull (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/amulr.x b/sys/vops/lz/amulr.x
new file mode 100644
index 00000000..fe7b204b
--- /dev/null
+++ b/sys/vops/lz/amulr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amulr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/amuls.x b/sys/vops/lz/amuls.x
new file mode 100644
index 00000000..ceb5854e
--- /dev/null
+++ b/sys/vops/lz/amuls.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amuls (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/amulx.x b/sys/vops/lz/amulx.x
new file mode 100644
index 00000000..1b9aa3dc
--- /dev/null
+++ b/sys/vops/lz/amulx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMUL -- Multiply two vectors (generic).
+
+procedure amulx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * b[i]
+end
diff --git a/sys/vops/lz/anegd.x b/sys/vops/lz/anegd.x
new file mode 100644
index 00000000..d681464e
--- /dev/null
+++ b/sys/vops/lz/anegd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegd (a, b, npix)
+
+double	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anegi.x b/sys/vops/lz/anegi.x
new file mode 100644
index 00000000..d1221376
--- /dev/null
+++ b/sys/vops/lz/anegi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegi (a, b, npix)
+
+int	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anegl.x b/sys/vops/lz/anegl.x
new file mode 100644
index 00000000..e3ab64f4
--- /dev/null
+++ b/sys/vops/lz/anegl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegl (a, b, npix)
+
+long	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anegr.x b/sys/vops/lz/anegr.x
new file mode 100644
index 00000000..449da1b0
--- /dev/null
+++ b/sys/vops/lz/anegr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegr (a, b, npix)
+
+real	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anegs.x b/sys/vops/lz/anegs.x
new file mode 100644
index 00000000..7b8f320e
--- /dev/null
+++ b/sys/vops/lz/anegs.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegs (a, b, npix)
+
+short	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anegx.x b/sys/vops/lz/anegx.x
new file mode 100644
index 00000000..8f958084
--- /dev/null
+++ b/sys/vops/lz/anegx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANEG -- Compute the arithmetic negation of a vector (generic).
+
+procedure anegx (a, b, npix)
+
+complex	a[ARB], b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    b[i] = -a[i]
+end
diff --git a/sys/vops/lz/anoti.x b/sys/vops/lz/anoti.x
new file mode 100644
index 00000000..867a8c92
--- /dev/null
+++ b/sys/vops/lz/anoti.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANOT -- Compute the bitwise boolean complement of a vector (generic).
+
+procedure anoti (a, b, npix)
+
+int	a[ARB], b[ARB]
+int	npix, i
+int	not()
+
+begin
+	do i = 1, npix {
+		b[i] = not (a[i])
+	}
+end
diff --git a/sys/vops/lz/anotl.x b/sys/vops/lz/anotl.x
new file mode 100644
index 00000000..3ecb0fce
--- /dev/null
+++ b/sys/vops/lz/anotl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANOT -- Compute the bitwise boolean complement of a vector (generic).
+
+procedure anotl (a, b, npix)
+
+long	a[ARB], b[ARB]
+int	npix, i
+long	notl()
+
+begin
+	do i = 1, npix {
+		b[i] = notl (a[i])
+	}
+end
diff --git a/sys/vops/lz/anots.x b/sys/vops/lz/anots.x
new file mode 100644
index 00000000..4c952636
--- /dev/null
+++ b/sys/vops/lz/anots.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ANOT -- Compute the bitwise boolean complement of a vector (generic).
+
+procedure anots (a, b, npix)
+
+short	a[ARB], b[ARB]
+int	npix, i
+short	nots()
+
+begin
+	do i = 1, npix {
+		b[i] = nots (a[i])
+	}
+end
diff --git a/sys/vops/lz/apkxd.x b/sys/vops/lz/apkxd.x
new file mode 100644
index 00000000..7c489491
--- /dev/null
+++ b/sys/vops/lz/apkxd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxd (a, b, c, npix)
+
+double	a[ARB]			# real component
+double	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), real(b[i]))
+end
diff --git a/sys/vops/lz/apkxi.x b/sys/vops/lz/apkxi.x
new file mode 100644
index 00000000..c03a0883
--- /dev/null
+++ b/sys/vops/lz/apkxi.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxi (a, b, c, npix)
+
+int	a[ARB]			# real component
+int	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), real(b[i]))
+end
diff --git a/sys/vops/lz/apkxl.x b/sys/vops/lz/apkxl.x
new file mode 100644
index 00000000..5af1f9e0
--- /dev/null
+++ b/sys/vops/lz/apkxl.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxl (a, b, c, npix)
+
+long	a[ARB]			# real component
+long	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), real(b[i]))
+end
diff --git a/sys/vops/lz/apkxr.x b/sys/vops/lz/apkxr.x
new file mode 100644
index 00000000..aba0261a
--- /dev/null
+++ b/sys/vops/lz/apkxr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxr (a, b, c, npix)
+
+real	a[ARB]			# real component
+real	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), real(b[i]))
+end
diff --git a/sys/vops/lz/apkxs.x b/sys/vops/lz/apkxs.x
new file mode 100644
index 00000000..178683a9
--- /dev/null
+++ b/sys/vops/lz/apkxs.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxs (a, b, c, npix)
+
+short	a[ARB]			# real component
+short	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), real(b[i]))
+end
diff --git a/sys/vops/lz/apkxx.x b/sys/vops/lz/apkxx.x
new file mode 100644
index 00000000..9baef047
--- /dev/null
+++ b/sys/vops/lz/apkxx.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APKX -- Generate a type COMPLEX output vector given the real and imaginary
+# components as input vectors.
+
+procedure apkxx (a, b, c, npix)
+
+complex	a[ARB]			# real component
+complex	b[ARB]			# imaginary component
+complex	c[ARB]			# output vector
+int	npix, i
+
+begin
+	do i = 1, npix
+		c[i] = complex (real(a[i]), aimag(b[i]))
+end
diff --git a/sys/vops/lz/apold.x b/sys/vops/lz/apold.x
new file mode 100644
index 00000000..885ed4fe
--- /dev/null
+++ b/sys/vops/lz/apold.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOL -- Evaluate a polynomial at X, given the coefficients of the polynomial
+# in COEFF and returning the computed value as the function value.
+
+double procedure apold (x, coeff, ncoeff)
+
+double	x		# point at which the polynomial is to be evaluated
+double	coeff[ncoeff]	# coefficients of the polynomial, lower orders first
+int	ncoeff
+
+int	i
+double	pow, sum
+
+begin
+	sum = coeff[1]
+	pow = x
+
+	do i = 2, ncoeff {
+	    sum = sum + pow * coeff[i]
+	    pow = pow * x
+	}
+
+	return (sum)
+end
diff --git a/sys/vops/lz/apolr.x b/sys/vops/lz/apolr.x
new file mode 100644
index 00000000..22912021
--- /dev/null
+++ b/sys/vops/lz/apolr.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOL -- Evaluate a polynomial at X, given the coefficients of the polynomial
+# in COEFF and returning the computed value as the function value.
+
+real procedure apolr (x, coeff, ncoeff)
+
+real	x		# point at which the polynomial is to be evaluated
+real	coeff[ncoeff]	# coefficients of the polynomial, lower orders first
+int	ncoeff
+
+int	i
+real	pow, sum
+
+begin
+	sum = coeff[1]
+	pow = x
+
+	do i = 2, ncoeff {
+	    sum = sum + pow * coeff[i]
+	    pow = pow * x
+	}
+
+	return (sum)
+end
diff --git a/sys/vops/lz/apowd.x b/sys/vops/lz/apowd.x
new file mode 100644
index 00000000..2f277935
--- /dev/null
+++ b/sys/vops/lz/apowd.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apowd (a, b, c, npix)
+
+double	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/apowi.x b/sys/vops/lz/apowi.x
new file mode 100644
index 00000000..27d587f9
--- /dev/null
+++ b/sys/vops/lz/apowi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apowi (a, b, c, npix)
+
+int	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/apowkd.x b/sys/vops/lz/apowkd.x
new file mode 100644
index 00000000..8aee1a87
--- /dev/null
+++ b/sys/vops/lz/apowkd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowkd (a, b, c, npix)
+
+double	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovkd (1.0D0, c, npix)
+	case 1:
+	    call amovd (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowki.x b/sys/vops/lz/apowki.x
new file mode 100644
index 00000000..1b756bca
--- /dev/null
+++ b/sys/vops/lz/apowki.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowki (a, b, c, npix)
+
+int	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovki (1, c, npix)
+	case 1:
+	    call amovi (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowkl.x b/sys/vops/lz/apowkl.x
new file mode 100644
index 00000000..c7247f3e
--- /dev/null
+++ b/sys/vops/lz/apowkl.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowkl (a, b, c, npix)
+
+long	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovkl (1, c, npix)
+	case 1:
+	    call amovl (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowkr.x b/sys/vops/lz/apowkr.x
new file mode 100644
index 00000000..b22be6b7
--- /dev/null
+++ b/sys/vops/lz/apowkr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowkr (a, b, c, npix)
+
+real	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovkr (1.0, c, npix)
+	case 1:
+	    call amovr (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowks.x b/sys/vops/lz/apowks.x
new file mode 100644
index 00000000..f656115a
--- /dev/null
+++ b/sys/vops/lz/apowks.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowks (a, b, c, npix)
+
+short	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovks (1, c, npix)
+	case 1:
+	    call amovs (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowkx.x b/sys/vops/lz/apowkx.x
new file mode 100644
index 00000000..461353be
--- /dev/null
+++ b/sys/vops/lz/apowkx.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOWK -- Compute a ** b, where b is a constant of type INT (generic).
+
+procedure apowkx (a, b, c, npix)
+
+complex	a[ARB], c[ARB]
+int	b
+int	npix, i
+
+begin
+	# Optimize the code for the various special cases.  We assume that the
+	# compiler is intelligent enough to recognize the special cases if the
+	# power is expressed as an integer constant.
+
+	switch (b) {
+	case 0:
+	    call amovkx ((1,1), c, npix)
+	case 1:
+	    call amovx (a, c, npix)
+	case 2:
+	    do i = 1, npix
+		c[i] = a[i] ** 2
+	case 3:
+	    do i = 1, npix
+		c[i] = a[i] ** 3
+	case 4:
+	    do i = 1, npix
+		c[i] = a[i] ** 4
+	default:
+	    do i = 1, npix
+		c[i] = a[i] ** b
+	}
+end
diff --git a/sys/vops/lz/apowl.x b/sys/vops/lz/apowl.x
new file mode 100644
index 00000000..28cd171f
--- /dev/null
+++ b/sys/vops/lz/apowl.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apowl (a, b, c, npix)
+
+long	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/apowr.x b/sys/vops/lz/apowr.x
new file mode 100644
index 00000000..7d80443f
--- /dev/null
+++ b/sys/vops/lz/apowr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apowr (a, b, c, npix)
+
+real	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/apows.x b/sys/vops/lz/apows.x
new file mode 100644
index 00000000..de128595
--- /dev/null
+++ b/sys/vops/lz/apows.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apows (a, b, c, npix)
+
+short	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/apowx.x b/sys/vops/lz/apowx.x
new file mode 100644
index 00000000..77f7814d
--- /dev/null
+++ b/sys/vops/lz/apowx.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# APOW -- Compute a ** b, where b is of type INT (generic).
+
+procedure apowx (a, b, c, npix)
+
+complex	a[ARB], c[ARB]
+int	b[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] ** b[i]
+end
diff --git a/sys/vops/lz/aravd.x b/sys/vops/lz/aravd.x
new file mode 100644
index 00000000..7b454fd3
--- /dev/null
+++ b/sys/vops/lz/aravd.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravd (a, npix, mean, sigma, ksig)
+
+double	a[ARB]			# input data array
+double	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgd()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgd (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILOND)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/aravi.x b/sys/vops/lz/aravi.x
new file mode 100644
index 00000000..865e4ecb
--- /dev/null
+++ b/sys/vops/lz/aravi.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravi (a, npix, mean, sigma, ksig)
+
+int	a[ARB]			# input data array
+real	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgi()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgi (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILONR)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/aravl.x b/sys/vops/lz/aravl.x
new file mode 100644
index 00000000..519cd1c8
--- /dev/null
+++ b/sys/vops/lz/aravl.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravl (a, npix, mean, sigma, ksig)
+
+long	a[ARB]			# input data array
+double	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgl()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgl (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILOND)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/aravr.x b/sys/vops/lz/aravr.x
new file mode 100644
index 00000000..c3f0fb8f
--- /dev/null
+++ b/sys/vops/lz/aravr.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravr (a, npix, mean, sigma, ksig)
+
+real	a[ARB]			# input data array
+real	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgr()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgr (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILONR)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/aravs.x b/sys/vops/lz/aravs.x
new file mode 100644
index 00000000..6c734aed
--- /dev/null
+++ b/sys/vops/lz/aravs.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravs (a, npix, mean, sigma, ksig)
+
+short	a[ARB]			# input data array
+real	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgs()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgs (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILONR)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/aravx.x b/sys/vops/lz/aravx.x
new file mode 100644
index 00000000..92f7328c
--- /dev/null
+++ b/sys/vops/lz/aravx.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ARAV -- Compute the mean and standard deviation of a sample array by
+# iteratively rejecting points further than KSIG from the mean.  If the
+# value of KSIG is given as 0.0, a cutoff value will be automatically
+# calculated from the standard deviation and number of points in the sample.
+# The number of pixels remaining in the sample upon termination is returned
+# as the function value.
+
+int procedure aravx (a, npix, mean, sigma, ksig)
+
+complex	a[ARB]			# input data array
+real	mean, sigma, ksig, deviation, lcut, hcut, lgpx
+int	npix, ngpix, old_ngpix, awvgx()
+
+begin
+	lcut = -MAX_REAL				# no rejection to start
+	hcut =  MAX_REAL
+	ngpix = MAX_INT
+
+	# Iteratively compute mean, sigma and reject outliers until no
+	# more pixels are rejected, or until there are no more pixels.
+
+	repeat {
+	    old_ngpix = ngpix
+	    ngpix = awvgx (a, npix, mean, sigma, lcut, hcut)
+		if (ngpix <= 1 || sigma <= EPSILONR)
+		    break
+
+	    if (ksig == 0.0) {				# Chauvenet's relation
+		lgpx = log10 (real(ngpix))
+		deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma
+	    } else
+		deviation = sigma * abs(ksig)
+
+	    lcut = mean - deviation			# compute window
+	    hcut = mean + deviation
+
+	} until (ngpix >= old_ngpix)
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/arcpd.x b/sys/vops/lz/arcpd.x
new file mode 100644
index 00000000..095d50d3
--- /dev/null
+++ b/sys/vops/lz/arcpd.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcpd (a, b, c, npix)
+
+double	a		# constant numerator
+double	b[ARB]		# vector denominator
+double	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0.0D0) {
+	    call aclrd (c, npix)
+	} else if (a == 1.0D0) {
+	    do i = 1, npix
+		c[i] = 1.0D0 / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arcpi.x b/sys/vops/lz/arcpi.x
new file mode 100644
index 00000000..193f35e1
--- /dev/null
+++ b/sys/vops/lz/arcpi.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcpi (a, b, c, npix)
+
+int	a		# constant numerator
+int	b[ARB]		# vector denominator
+int	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0) {
+	    call aclri (c, npix)
+	} else if (a == 1) {
+	    do i = 1, npix
+		c[i] = 1 / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arcpl.x b/sys/vops/lz/arcpl.x
new file mode 100644
index 00000000..3f3c5b39
--- /dev/null
+++ b/sys/vops/lz/arcpl.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcpl (a, b, c, npix)
+
+long	a		# constant numerator
+long	b[ARB]		# vector denominator
+long	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0) {
+	    call aclrl (c, npix)
+	} else if (a == 1) {
+	    do i = 1, npix
+		c[i] = 1 / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arcpr.x b/sys/vops/lz/arcpr.x
new file mode 100644
index 00000000..f52a1651
--- /dev/null
+++ b/sys/vops/lz/arcpr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcpr (a, b, c, npix)
+
+real	a		# constant numerator
+real	b[ARB]		# vector denominator
+real	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0.0) {
+	    call aclrr (c, npix)
+	} else if (a == 1.0) {
+	    do i = 1, npix
+		c[i] = 1.0 / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arcps.x b/sys/vops/lz/arcps.x
new file mode 100644
index 00000000..0e0f8056
--- /dev/null
+++ b/sys/vops/lz/arcps.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcps (a, b, c, npix)
+
+short	a		# constant numerator
+short	b[ARB]		# vector denominator
+short	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == 0) {
+	    call aclrs (c, npix)
+	} else if (a == 1) {
+	    do i = 1, npix
+		c[i] = 1 / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arcpx.x b/sys/vops/lz/arcpx.x
new file mode 100644
index 00000000..626eb6a1
--- /dev/null
+++ b/sys/vops/lz/arcpx.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCP -- Reciprocal of a constant divided by a vector.  No divide by zero
+# checking is performed.
+
+procedure arcpx (a, b, c, npix)
+
+complex	a		# constant numerator
+complex	b[ARB]		# vector denominator
+complex	c[ARB]		# output vector
+int	npix
+int	i
+
+begin
+	if (a == (0.0,0.0)) {
+	    call aclrx (c, npix)
+	} else if (a == (1.0,1.0)) {
+	    do i = 1, npix
+		c[i] = (1.0,1.0) / b[i]
+	} else {
+	    do i = 1, npix
+		c[i] = a / b[i]
+	}
+end
diff --git a/sys/vops/lz/arczd.x b/sys/vops/lz/arczd.x
new file mode 100644
index 00000000..4f5ad6f2
--- /dev/null
+++ b/sys/vops/lz/arczd.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczd (a, b, c, npix, errfcn)
+
+double	a			# numerator
+double	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+double	errfcn()		# user function, called on divide by zero
+
+int	i
+double	divisor
+double	tol
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0.0D0) {
+	    call aclrd (c, npix)
+	    return
+	}
+
+	    tol = 1.0D-20
+
+	do i = 1, npix {
+	    divisor = b[i]
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a)
+			next
+		    }
+		c[i] = a / divisor
+
+	}
+end
diff --git a/sys/vops/lz/arczi.x b/sys/vops/lz/arczi.x
new file mode 100644
index 00000000..ce679742
--- /dev/null
+++ b/sys/vops/lz/arczi.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczi (a, b, c, npix, errfcn)
+
+int	a			# numerator
+int	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+int	errfcn()		# user function, called on divide by zero
+
+int	i
+int	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0) {
+	    call aclri (c, npix)
+	    return
+	}
+
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a)
+		else
+		    c[i] = a / divisor
+	}
+end
diff --git a/sys/vops/lz/arczl.x b/sys/vops/lz/arczl.x
new file mode 100644
index 00000000..b89e2cbe
--- /dev/null
+++ b/sys/vops/lz/arczl.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczl (a, b, c, npix, errfcn)
+
+long	a			# numerator
+long	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+long	errfcn()		# user function, called on divide by zero
+
+int	i
+long	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0) {
+	    call aclrl (c, npix)
+	    return
+	}
+
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a)
+		else
+		    c[i] = a / divisor
+	}
+end
diff --git a/sys/vops/lz/arczr.x b/sys/vops/lz/arczr.x
new file mode 100644
index 00000000..7c2e9fe2
--- /dev/null
+++ b/sys/vops/lz/arczr.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczr (a, b, c, npix, errfcn)
+
+real	a			# numerator
+real	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+real	errfcn()		# user function, called on divide by zero
+
+int	i
+real	divisor
+real	tol
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0.0) {
+	    call aclrr (c, npix)
+	    return
+	}
+
+	    tol = 1.0E-20
+
+	do i = 1, npix {
+	    divisor = b[i]
+		# The following is most efficient when the data tends to be
+		# positive.
+
+		if (divisor < tol)
+		    if (divisor > -tol) {
+			c[i] = errfcn (a)
+			next
+		    }
+		c[i] = a / divisor
+
+	}
+end
diff --git a/sys/vops/lz/arczs.x b/sys/vops/lz/arczs.x
new file mode 100644
index 00000000..4216d38d
--- /dev/null
+++ b/sys/vops/lz/arczs.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczs (a, b, c, npix, errfcn)
+
+short	a			# numerator
+short	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+short	errfcn()		# user function, called on divide by zero
+
+int	i
+short	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == 0) {
+	    call aclrs (c, npix)
+	    return
+	}
+
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == 0)
+		    c[i] = errfcn (a)
+		else
+		    c[i] = a / divisor
+	}
+end
diff --git a/sys/vops/lz/arczx.x b/sys/vops/lz/arczx.x
new file mode 100644
index 00000000..ec23595e
--- /dev/null
+++ b/sys/vops/lz/arczx.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARCZ -- Vector reciprocal with checking for zero divisors.  If the result
+# of a divide would be undefined a user supplied function is called to get the
+# output pixel value.
+#
+# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used
+# to check for an undefined divide, i.e., a divide by zero or a divide by a
+# number small enough to cause floating point overflow.  A better way to do
+# this would be to provide a machine dependent version of this operator in
+# host$as which catches the hardware exception rather than using a comparison.
+
+procedure arczx (a, b, c, npix, errfcn)
+
+complex	a			# numerator
+complex	b[ARB], c[ARB]		# divisor, and output arrays
+int	npix			# number of pixels
+complex	errfcn()		# user function, called on divide by zero
+
+int	i
+complex	divisor
+extern	errfcn()
+errchk	errfcn
+
+begin
+	if (a == (0.0,0.0)) {
+	    call aclrx (c, npix)
+	    return
+	}
+
+
+	do i = 1, npix {
+	    divisor = b[i]
+		if (divisor == (0.0,0.0))
+		    c[i] = errfcn (a)
+		else
+		    c[i] = a / divisor
+	}
+end
diff --git a/sys/vops/lz/argtd.x b/sys/vops/lz/argtd.x
new file mode 100644
index 00000000..bf12e17c
--- /dev/null
+++ b/sys/vops/lz/argtd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argtd (a, npix, ceil, newval)
+
+double	a[ARB]
+int	npix
+double	ceil, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] > ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/argti.x b/sys/vops/lz/argti.x
new file mode 100644
index 00000000..dffdce17
--- /dev/null
+++ b/sys/vops/lz/argti.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argti (a, npix, ceil, newval)
+
+int	a[ARB]
+int	npix
+int	ceil, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] > ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/argtl.x b/sys/vops/lz/argtl.x
new file mode 100644
index 00000000..e776573c
--- /dev/null
+++ b/sys/vops/lz/argtl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argtl (a, npix, ceil, newval)
+
+long	a[ARB]
+int	npix
+long	ceil, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] > ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/argtr.x b/sys/vops/lz/argtr.x
new file mode 100644
index 00000000..5ab107f7
--- /dev/null
+++ b/sys/vops/lz/argtr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argtr (a, npix, ceil, newval)
+
+real	a[ARB]
+int	npix
+real	ceil, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] > ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/argts.x b/sys/vops/lz/argts.x
new file mode 100644
index 00000000..815f753f
--- /dev/null
+++ b/sys/vops/lz/argts.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argts (a, npix, ceil, newval)
+
+short	a[ARB]
+int	npix
+short	ceil, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] > ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/argtx.x b/sys/vops/lz/argtx.x
new file mode 100644
index 00000000..53253e01
--- /dev/null
+++ b/sys/vops/lz/argtx.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARGT -- Replace if greater than.  If A[i] is greater than CEIL replace by
+# NEWVAL.
+
+procedure argtx (a, npix, ceil, newval)
+
+complex	a[ARB]
+int	npix
+complex	ceil, newval
+int	i
+real	abs_ceil
+
+begin
+	abs_ceil = abs (ceil)
+
+	do i = 1, npix
+	    if (abs (a[i]) > abs_ceil)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arltd.x b/sys/vops/lz/arltd.x
new file mode 100644
index 00000000..62693331
--- /dev/null
+++ b/sys/vops/lz/arltd.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arltd (a, npix, floor, newval)
+
+double	a[ARB]
+int	npix
+double	floor, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] < floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arlti.x b/sys/vops/lz/arlti.x
new file mode 100644
index 00000000..6b8ae086
--- /dev/null
+++ b/sys/vops/lz/arlti.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arlti (a, npix, floor, newval)
+
+int	a[ARB]
+int	npix
+int	floor, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] < floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arltl.x b/sys/vops/lz/arltl.x
new file mode 100644
index 00000000..4bda96c3
--- /dev/null
+++ b/sys/vops/lz/arltl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arltl (a, npix, floor, newval)
+
+long	a[ARB]
+int	npix
+long	floor, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] < floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arltr.x b/sys/vops/lz/arltr.x
new file mode 100644
index 00000000..3b419556
--- /dev/null
+++ b/sys/vops/lz/arltr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arltr (a, npix, floor, newval)
+
+real	a[ARB]
+int	npix
+real	floor, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] < floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arlts.x b/sys/vops/lz/arlts.x
new file mode 100644
index 00000000..ca4e0582
--- /dev/null
+++ b/sys/vops/lz/arlts.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arlts (a, npix, floor, newval)
+
+short	a[ARB]
+int	npix
+short	floor, newval
+int	i
+
+begin
+
+	do i = 1, npix
+	    if (a[i] < floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/arltx.x b/sys/vops/lz/arltx.x
new file mode 100644
index 00000000..8ea55d5f
--- /dev/null
+++ b/sys/vops/lz/arltx.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ARLT -- Replace if less than.  If A[i] is less than FLOOR replace by NEWVAL.
+
+procedure arltx (a, npix, floor, newval)
+
+complex	a[ARB]
+int	npix
+complex	floor, newval
+int	i
+real	abs_floor
+
+begin
+	abs_floor = abs (floor)
+
+	do i = 1, npix
+	    if (abs (a[i]) < abs_floor)
+		a[i] = newval
+end
diff --git a/sys/vops/lz/aselc.x b/sys/vops/lz/aselc.x
new file mode 100644
index 00000000..eeed8930
--- /dev/null
+++ b/sys/vops/lz/aselc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure aselc (a, b, c, sel, npix)
+
+char	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/aseld.x b/sys/vops/lz/aseld.x
new file mode 100644
index 00000000..79758363
--- /dev/null
+++ b/sys/vops/lz/aseld.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure aseld (a, b, c, sel, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/aseli.x b/sys/vops/lz/aseli.x
new file mode 100644
index 00000000..c4a8a211
--- /dev/null
+++ b/sys/vops/lz/aseli.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure aseli (a, b, c, sel, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/aselkc.x b/sys/vops/lz/aselkc.x
new file mode 100644
index 00000000..28b5d4a2
--- /dev/null
+++ b/sys/vops/lz/aselkc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselkc (a, b, c, sel, npix)
+
+char	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselkd.x b/sys/vops/lz/aselkd.x
new file mode 100644
index 00000000..f0ad7dae
--- /dev/null
+++ b/sys/vops/lz/aselkd.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselkd (a, b, c, sel, npix)
+
+double	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselki.x b/sys/vops/lz/aselki.x
new file mode 100644
index 00000000..a56737ab
--- /dev/null
+++ b/sys/vops/lz/aselki.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselki (a, b, c, sel, npix)
+
+int	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselkl.x b/sys/vops/lz/aselkl.x
new file mode 100644
index 00000000..2fbf6b23
--- /dev/null
+++ b/sys/vops/lz/aselkl.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselkl (a, b, c, sel, npix)
+
+long	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselkr.x b/sys/vops/lz/aselkr.x
new file mode 100644
index 00000000..702000b3
--- /dev/null
+++ b/sys/vops/lz/aselkr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselkr (a, b, c, sel, npix)
+
+real	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselks.x b/sys/vops/lz/aselks.x
new file mode 100644
index 00000000..59891f15
--- /dev/null
+++ b/sys/vops/lz/aselks.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselks (a, b, c, sel, npix)
+
+short	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/aselkx.x b/sys/vops/lz/aselkx.x
new file mode 100644
index 00000000..4a4de962
--- /dev/null
+++ b/sys/vops/lz/aselkx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASELK -- Vector/constant select element.  The output vector is formed by
+# taking successive pixels from either of the input vector or a constant, based
+# on the value of the integer (boolean) selection vectors.  Used to implement
+# vector conditional expressions.
+
+procedure aselkx (a, b, c, sel, npix)
+
+complex	a[ARB], b, c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b
+end
diff --git a/sys/vops/lz/asell.x b/sys/vops/lz/asell.x
new file mode 100644
index 00000000..5b7e08a7
--- /dev/null
+++ b/sys/vops/lz/asell.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure asell (a, b, c, sel, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/aselr.x b/sys/vops/lz/aselr.x
new file mode 100644
index 00000000..3a5f7f1b
--- /dev/null
+++ b/sys/vops/lz/aselr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure aselr (a, b, c, sel, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/asels.x b/sys/vops/lz/asels.x
new file mode 100644
index 00000000..b2118ba8
--- /dev/null
+++ b/sys/vops/lz/asels.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure asels (a, b, c, sel, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/aselx.x b/sys/vops/lz/aselx.x
new file mode 100644
index 00000000..1bd02e9a
--- /dev/null
+++ b/sys/vops/lz/aselx.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASEL -- Vector select element.  The output vector is formed by taking
+# successive pixels from either of the two input vectors, based on the value
+# of the integer (boolean) selection vectors.  Used to implement vector
+# conditional expressions.
+
+procedure aselx (a, b, c, sel, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	sel[ARB]			# IF sel[i] THEN a[i] ELSE b[i]
+int	npix
+int	i
+
+begin
+	do i = 1, npix
+	    if (sel[i] != 0)
+		c[i] = a[i]
+	    else
+		c[i] = b[i]
+end
diff --git a/sys/vops/lz/asokc.x b/sys/vops/lz/asokc.x
new file mode 100644
index 00000000..794252f2
--- /dev/null
+++ b/sys/vops/lz/asokc.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+char procedure asokc (a, npix, ksel)
+
+char	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+char	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asokd.x b/sys/vops/lz/asokd.x
new file mode 100644
index 00000000..54627469
--- /dev/null
+++ b/sys/vops/lz/asokd.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+double procedure asokd (a, npix, ksel)
+
+double	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+double	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asoki.x b/sys/vops/lz/asoki.x
new file mode 100644
index 00000000..dd579ac2
--- /dev/null
+++ b/sys/vops/lz/asoki.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+int procedure asoki (a, npix, ksel)
+
+int	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+int	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asokl.x b/sys/vops/lz/asokl.x
new file mode 100644
index 00000000..37adff9c
--- /dev/null
+++ b/sys/vops/lz/asokl.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+long procedure asokl (a, npix, ksel)
+
+long	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+long	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asokr.x b/sys/vops/lz/asokr.x
new file mode 100644
index 00000000..420eaf65
--- /dev/null
+++ b/sys/vops/lz/asokr.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+real procedure asokr (a, npix, ksel)
+
+real	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+real	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asoks.x b/sys/vops/lz/asoks.x
new file mode 100644
index 00000000..a92f4015
--- /dev/null
+++ b/sys/vops/lz/asoks.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+short procedure asoks (a, npix, ksel)
+
+short	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+short	temp, wtemp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+
+	    repeat {
+		while (a[i] < temp)
+		    i = i + 1
+		while (temp < a[j])
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asokx.x b/sys/vops/lz/asokx.x
new file mode 100644
index 00000000..7528714a
--- /dev/null
+++ b/sys/vops/lz/asokx.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# ASOK -- Select the Kth smallest element from a vector.  The algorithm used
+# is selection by tail recursion (Gonnet 1984).  In each iteration a pivot key
+# is selected (somewhat arbitrarily) from the array.  The array is then split
+# into two subarrays, those with key values less than or equal to the pivot key
+# and those with values greater than the pivot.  The size of the two subarrays
+# determines which contains the median value, and the process is repeated
+# on that subarray, and so on until all of the elements of the subarray
+# are equal, e.g., there is only one element left in the subarray.  For a
+# randomly ordered array the expected running time is O(3.38N).  The selection
+# is carried out in place, leaving the array in a partially ordered state.
+#
+# N.B.: Behaviour is O(N) if the input array is sorted.
+# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and
+# maximum values, are more efficiently handled by ALIM which is O(2N).
+#
+# Jul99 - The above algorithm was found to be pathologically slow in cases
+# where many or all elements of the array are equal.  The version of the
+# algorithm below, from Wirth, appears to avoid this problem.
+
+complex procedure asokx (a, npix, ksel)
+
+complex	a[ARB]			# input array
+int	npix			# number of pixels
+int	ksel			# element to be selected
+
+int	lo, up, i, j, k, dummy
+complex	temp, wtemp
+real	abs_temp
+
+begin
+	lo = 1
+	up = npix
+	k  = max (lo, min (up, ksel))
+
+	# while (lo < up)
+	do dummy = 1, MAX_INT {
+	    if (! (lo < up))
+		break
+
+	    temp = a[k];  i = lo;  j = up
+	    abs_temp = abs (temp)
+
+	    repeat {
+		while (abs (a[i]) < abs_temp)
+		    i = i + 1
+		while (abs_temp < abs (a[j]))
+		    j = j - 1
+		if (i <= j) {
+		    wtemp = a[i];  a[i] = a[j];  a[j] = wtemp
+		    i = i + 1;  j = j - 1
+		}
+	    } until (i > j)
+
+	    if (j < k)
+		lo = i
+	    if (k < i)
+		up = j
+	}
+
+	return (a[k])
+end
diff --git a/sys/vops/lz/asqrd.x b/sys/vops/lz/asqrd.x
new file mode 100644
index 00000000..e6cf3f70
--- /dev/null
+++ b/sys/vops/lz/asqrd.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqrd (a, b, npix, errfcn)
+
+double	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+double	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+		{
+			b[i] = sqrt (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/asqri.x b/sys/vops/lz/asqri.x
new file mode 100644
index 00000000..c68c64f4
--- /dev/null
+++ b/sys/vops/lz/asqri.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqri (a, b, npix, errfcn)
+
+int	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+int	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+		{
+			b[i] = sqrt (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/asqrl.x b/sys/vops/lz/asqrl.x
new file mode 100644
index 00000000..3b0d23f0
--- /dev/null
+++ b/sys/vops/lz/asqrl.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqrl (a, b, npix, errfcn)
+
+long	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+long	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+		{
+			b[i] = sqrt (double (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/asqrr.x b/sys/vops/lz/asqrr.x
new file mode 100644
index 00000000..a18b21d2
--- /dev/null
+++ b/sys/vops/lz/asqrr.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqrr (a, b, npix, errfcn)
+
+real	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+real	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+		{
+			b[i] = sqrt (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/asqrs.x b/sys/vops/lz/asqrs.x
new file mode 100644
index 00000000..5a1d6532
--- /dev/null
+++ b/sys/vops/lz/asqrs.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqrs (a, b, npix, errfcn)
+
+short	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+short	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		if (a[i] < 0)
+		    b[i] = errfcn (a[i])
+		else
+		{
+			b[i] = sqrt (real (a[i]))
+		}
+	}
+end
diff --git a/sys/vops/lz/asqrx.x b/sys/vops/lz/asqrx.x
new file mode 100644
index 00000000..a529811c
--- /dev/null
+++ b/sys/vops/lz/asqrx.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASQR -- Compute the square root of a vector (generic).  If the square root
+# is undefined (x < 0) a user supplied function is called to compute the value.
+
+procedure asqrx (a, b, npix, errfcn)
+
+complex	a[ARB], b[ARB]
+int	npix, i
+extern	errfcn()
+complex	errfcn()
+errchk	errfcn
+
+begin
+	do i = 1, npix {
+		{
+			b[i] = sqrt (a[i])
+		}
+	}
+end
diff --git a/sys/vops/lz/asrtc.x b/sys/vops/lz/asrtc.x
new file mode 100644
index 00000000..f4de2d71
--- /dev/null
+++ b/sys/vops/lz/asrtc.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrtc (a, b, npix)
+
+char	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+char	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovc (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrtd.x b/sys/vops/lz/asrtd.x
new file mode 100644
index 00000000..64d52880
--- /dev/null
+++ b/sys/vops/lz/asrtd.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrtd (a, b, npix)
+
+double	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+double	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovd (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrti.x b/sys/vops/lz/asrti.x
new file mode 100644
index 00000000..e956a8bd
--- /dev/null
+++ b/sys/vops/lz/asrti.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrti (a, b, npix)
+
+int	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+int	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovi (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrtl.x b/sys/vops/lz/asrtl.x
new file mode 100644
index 00000000..ddc1c59b
--- /dev/null
+++ b/sys/vops/lz/asrtl.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrtl (a, b, npix)
+
+long	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+long	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovl (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrtr.x b/sys/vops/lz/asrtr.x
new file mode 100644
index 00000000..a4be1ed2
--- /dev/null
+++ b/sys/vops/lz/asrtr.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrtr (a, b, npix)
+
+real	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+real	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovr (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrts.x b/sys/vops/lz/asrts.x
new file mode 100644
index 00000000..b0bff6e6
--- /dev/null
+++ b/sys/vops/lz/asrts.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrts (a, b, npix)
+
+short	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+short	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovs (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (b[j] <= pivot)
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/asrtx.x b/sys/vops/lz/asrtx.x
new file mode 100644
index 00000000..7e0c421b
--- /dev/null
+++ b/sys/vops/lz/asrtx.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrtx (a, b, npix)
+
+complex	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+complex	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amovx (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+			for (i=i+1;  abs(b[i]) < abs(pivot);  i=i+1)
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+			    if (abs(b[j]) <= abs(pivot))
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
diff --git a/sys/vops/lz/assqd.x b/sys/vops/lz/assqd.x
new file mode 100644
index 00000000..ec8d4190
--- /dev/null
+++ b/sys/vops/lz/assqd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+double procedure assqd (a, npix)
+double	sum
+
+double	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0.0D0
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/assqi.x b/sys/vops/lz/assqi.x
new file mode 100644
index 00000000..73091f16
--- /dev/null
+++ b/sys/vops/lz/assqi.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+real procedure assqi (a, npix)
+real	sum
+
+int	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/assql.x b/sys/vops/lz/assql.x
new file mode 100644
index 00000000..096f9a76
--- /dev/null
+++ b/sys/vops/lz/assql.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+double procedure assql (a, npix)
+double	sum
+
+long	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/assqr.x b/sys/vops/lz/assqr.x
new file mode 100644
index 00000000..ffb83e57
--- /dev/null
+++ b/sys/vops/lz/assqr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+real procedure assqr (a, npix)
+real	sum
+
+real	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0.0
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/assqs.x b/sys/vops/lz/assqs.x
new file mode 100644
index 00000000..094f9285
--- /dev/null
+++ b/sys/vops/lz/assqs.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+real procedure assqs (a, npix)
+real	sum
+
+short	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/assqx.x b/sys/vops/lz/assqx.x
new file mode 100644
index 00000000..adf4edb0
--- /dev/null
+++ b/sys/vops/lz/assqx.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASSQ -- Vector sum of squares.
+
+complex procedure assqx (a, npix)
+complex	sum
+
+complex	a[ARB]
+int	npix
+int	i
+
+begin
+	sum = (0.0,0.0)
+	do i = 1, npix
+	    sum = sum + (a[i] ** 2)
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asubd.x b/sys/vops/lz/asubd.x
new file mode 100644
index 00000000..faa1943a
--- /dev/null
+++ b/sys/vops/lz/asubd.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubd (a, b, c, npix)
+
+double	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asubi.x b/sys/vops/lz/asubi.x
new file mode 100644
index 00000000..6cecbfe9
--- /dev/null
+++ b/sys/vops/lz/asubi.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubi (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asubkd.x b/sys/vops/lz/asubkd.x
new file mode 100644
index 00000000..9eed4999
--- /dev/null
+++ b/sys/vops/lz/asubkd.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubkd (a, b, c, npix)
+
+double	a[ARB]
+double	b
+double	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubki.x b/sys/vops/lz/asubki.x
new file mode 100644
index 00000000..944e4af0
--- /dev/null
+++ b/sys/vops/lz/asubki.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubkl.x b/sys/vops/lz/asubkl.x
new file mode 100644
index 00000000..7d6a7ce9
--- /dev/null
+++ b/sys/vops/lz/asubkl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubkr.x b/sys/vops/lz/asubkr.x
new file mode 100644
index 00000000..c9a303ff
--- /dev/null
+++ b/sys/vops/lz/asubkr.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubkr (a, b, c, npix)
+
+real	a[ARB]
+real	b
+real	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubks.x b/sys/vops/lz/asubks.x
new file mode 100644
index 00000000..e0eb9d66
--- /dev/null
+++ b/sys/vops/lz/asubks.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubkx.x b/sys/vops/lz/asubkx.x
new file mode 100644
index 00000000..4c9f5280
--- /dev/null
+++ b/sys/vops/lz/asubkx.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUBK -- Subtract a constant from a vector (generic).
+
+procedure asubkx (a, b, c, npix)
+
+complex	a[ARB]
+complex	b
+complex	c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b
+end
diff --git a/sys/vops/lz/asubl.x b/sys/vops/lz/asubl.x
new file mode 100644
index 00000000..851f988b
--- /dev/null
+++ b/sys/vops/lz/asubl.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asubr.x b/sys/vops/lz/asubr.x
new file mode 100644
index 00000000..6ad54ba4
--- /dev/null
+++ b/sys/vops/lz/asubr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubr (a, b, c, npix)
+
+real	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asubs.x b/sys/vops/lz/asubs.x
new file mode 100644
index 00000000..6a2a5ddb
--- /dev/null
+++ b/sys/vops/lz/asubs.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubs (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asubx.x b/sys/vops/lz/asubx.x
new file mode 100644
index 00000000..7694aa7c
--- /dev/null
+++ b/sys/vops/lz/asubx.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUB -- Subtract two vectors (generic).
+
+procedure asubx (a, b, c, npix)
+
+complex	a[ARB], b[ARB], c[ARB]
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] - b[i]
+end
diff --git a/sys/vops/lz/asumd.x b/sys/vops/lz/asumd.x
new file mode 100644
index 00000000..24e4e7a9
--- /dev/null
+++ b/sys/vops/lz/asumd.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+double procedure asumd (a, npix)
+
+double	a[ARB]
+int	npix
+int	i
+
+double	sum
+
+begin
+	sum = 0.0D0
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asumi.x b/sys/vops/lz/asumi.x
new file mode 100644
index 00000000..314b100f
--- /dev/null
+++ b/sys/vops/lz/asumi.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+real procedure asumi (a, npix)
+
+int	a[ARB]
+int	npix
+int	i
+
+real	sum
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asuml.x b/sys/vops/lz/asuml.x
new file mode 100644
index 00000000..4a2f9ec1
--- /dev/null
+++ b/sys/vops/lz/asuml.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+double procedure asuml (a, npix)
+
+long	a[ARB]
+int	npix
+int	i
+
+double	sum
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asumr.x b/sys/vops/lz/asumr.x
new file mode 100644
index 00000000..962be9cc
--- /dev/null
+++ b/sys/vops/lz/asumr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+real procedure asumr (a, npix)
+
+real	a[ARB]
+int	npix
+int	i
+
+real	sum
+
+begin
+	sum = 0.0
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asums.x b/sys/vops/lz/asums.x
new file mode 100644
index 00000000..663dab08
--- /dev/null
+++ b/sys/vops/lz/asums.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+real procedure asums (a, npix)
+
+short	a[ARB]
+int	npix
+int	i
+
+real	sum
+
+begin
+	sum = 0
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/asumx.x b/sys/vops/lz/asumx.x
new file mode 100644
index 00000000..936cdaf3
--- /dev/null
+++ b/sys/vops/lz/asumx.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ASUM -- Vector sum.  Take care to prevent integer overflow by returning
+# a floating point sum.
+
+complex procedure asumx (a, npix)
+
+complex	a[ARB]
+int	npix
+int	i
+
+complex	sum
+
+begin
+	sum = (0.0,0.0)
+	do i = 1, npix
+	    sum = sum + a[i]
+	
+	return (sum)
+end
diff --git a/sys/vops/lz/aupxd.x b/sys/vops/lz/aupxd.x
new file mode 100644
index 00000000..38e9fa53
--- /dev/null
+++ b/sys/vops/lz/aupxd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxd (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+double	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	}
+end
diff --git a/sys/vops/lz/aupxi.x b/sys/vops/lz/aupxi.x
new file mode 100644
index 00000000..59e76ced
--- /dev/null
+++ b/sys/vops/lz/aupxi.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxi (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+int	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	}
+end
diff --git a/sys/vops/lz/aupxl.x b/sys/vops/lz/aupxl.x
new file mode 100644
index 00000000..96147678
--- /dev/null
+++ b/sys/vops/lz/aupxl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxl (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+long	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	}
+end
diff --git a/sys/vops/lz/aupxr.x b/sys/vops/lz/aupxr.x
new file mode 100644
index 00000000..135683fe
--- /dev/null
+++ b/sys/vops/lz/aupxr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxr (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+real	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	}
+end
diff --git a/sys/vops/lz/aupxs.x b/sys/vops/lz/aupxs.x
new file mode 100644
index 00000000..82996096
--- /dev/null
+++ b/sys/vops/lz/aupxs.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxs (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+short	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = real  (a[i])
+		c[i] = aimag (a[i])
+	}
+end
diff --git a/sys/vops/lz/aupxx.x b/sys/vops/lz/aupxx.x
new file mode 100644
index 00000000..109bdc01
--- /dev/null
+++ b/sys/vops/lz/aupxx.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AUPX -- Unpack the real and imaginary components of a complex vector into
+# two output vectors of some other type.
+
+procedure aupxx (a, b, c, npix)
+
+complex	a[ARB]			# input vector
+complex	b[ARB], c[ARB]	# output vectors
+int	npix
+int	i
+
+begin
+	do i = 1, npix {
+		b[i] = complex (real(a[i]), 0.0)
+		c[i] = complex (0.0, aimag(a[i]))
+	}
+end
diff --git a/sys/vops/lz/aveqc.x b/sys/vops/lz/aveqc.x
new file mode 100644
index 00000000..e8d07db1
--- /dev/null
+++ b/sys/vops/lz/aveqc.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqc (a, b, npix)
+
+char	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveqd.x b/sys/vops/lz/aveqd.x
new file mode 100644
index 00000000..d67daeb8
--- /dev/null
+++ b/sys/vops/lz/aveqd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqd (a, b, npix)
+
+double	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveqi.x b/sys/vops/lz/aveqi.x
new file mode 100644
index 00000000..913224b4
--- /dev/null
+++ b/sys/vops/lz/aveqi.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqi (a, b, npix)
+
+int	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveql.x b/sys/vops/lz/aveql.x
new file mode 100644
index 00000000..ce05898e
--- /dev/null
+++ b/sys/vops/lz/aveql.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveql (a, b, npix)
+
+long	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveqr.x b/sys/vops/lz/aveqr.x
new file mode 100644
index 00000000..01faffe2
--- /dev/null
+++ b/sys/vops/lz/aveqr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqr (a, b, npix)
+
+real	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveqs.x b/sys/vops/lz/aveqs.x
new file mode 100644
index 00000000..92680633
--- /dev/null
+++ b/sys/vops/lz/aveqs.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqs (a, b, npix)
+
+short	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/aveqx.x b/sys/vops/lz/aveqx.x
new file mode 100644
index 00000000..2d616b1a
--- /dev/null
+++ b/sys/vops/lz/aveqx.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AVEQ -- Compare two vectors for equality.
+
+bool procedure aveqx (a, b, npix)
+
+complex	a[ARB], b[ARB]		#I vectors to be compared
+int	npix			#I number of pixels to be compared
+
+int	i
+
+begin
+	do i = 1, npix
+	    if (a[i] != b[i])
+		return (false)
+
+	return (true)
+end
diff --git a/sys/vops/lz/awsud.x b/sys/vops/lz/awsud.x
new file mode 100644
index 00000000..f2e5e02e
--- /dev/null
+++ b/sys/vops/lz/awsud.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsud (a, b, c, npix, k1, k2)
+
+double	a[ARB], b[ARB], c[ARB]
+double	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awsui.x b/sys/vops/lz/awsui.x
new file mode 100644
index 00000000..0e75feed
--- /dev/null
+++ b/sys/vops/lz/awsui.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsui (a, b, c, npix, k1, k2)
+
+int	a[ARB], b[ARB], c[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awsul.x b/sys/vops/lz/awsul.x
new file mode 100644
index 00000000..1a8dd058
--- /dev/null
+++ b/sys/vops/lz/awsul.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsul (a, b, c, npix, k1, k2)
+
+long	a[ARB], b[ARB], c[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awsur.x b/sys/vops/lz/awsur.x
new file mode 100644
index 00000000..4efd8909
--- /dev/null
+++ b/sys/vops/lz/awsur.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsur (a, b, c, npix, k1, k2)
+
+real	a[ARB], b[ARB], c[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awsus.x b/sys/vops/lz/awsus.x
new file mode 100644
index 00000000..78ee5bbf
--- /dev/null
+++ b/sys/vops/lz/awsus.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsus (a, b, c, npix, k1, k2)
+
+short	a[ARB], b[ARB], c[ARB]
+real	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awsux.x b/sys/vops/lz/awsux.x
new file mode 100644
index 00000000..7516bd8b
--- /dev/null
+++ b/sys/vops/lz/awsux.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWSU -- Vector weighted sum.  C = A * k1 + B * k2
+
+procedure awsux (a, b, c, npix, k1, k2)
+
+complex	a[ARB], b[ARB], c[ARB]
+complex	k1, k2
+int	npix, i
+
+begin
+	do i = 1, npix
+	    c[i] = a[i] * k1 + b[i] * k2
+end
diff --git a/sys/vops/lz/awvgd.x b/sys/vops/lz/awvgd.x
new file mode 100644
index 00000000..58b1d87b
--- /dev/null
+++ b/sys/vops/lz/awvgd.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgd (a, npix, mean, sigma, lcut, hcut)
+
+double	a[ARB]
+double	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = a[i]
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = a[i]
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFD
+	    sigma = INDEFD
+	case 1:
+	    mean = sum
+	    sigma = INDEFD
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/awvgi.x b/sys/vops/lz/awvgi.x
new file mode 100644
index 00000000..b1e78ebe
--- /dev/null
+++ b/sys/vops/lz/awvgi.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgi (a, npix, mean, sigma, lcut, hcut)
+
+int	a[ARB]
+real	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = a[i]
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = a[i]
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFR
+	    sigma = INDEFR
+	case 1:
+	    mean = sum
+	    sigma = INDEFR
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/awvgl.x b/sys/vops/lz/awvgl.x
new file mode 100644
index 00000000..d56d0a8a
--- /dev/null
+++ b/sys/vops/lz/awvgl.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgl (a, npix, mean, sigma, lcut, hcut)
+
+long	a[ARB]
+double	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = a[i]
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = a[i]
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFD
+	    sigma = INDEFD
+	case 1:
+	    mean = sum
+	    sigma = INDEFD
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/awvgr.x b/sys/vops/lz/awvgr.x
new file mode 100644
index 00000000..fab5efe7
--- /dev/null
+++ b/sys/vops/lz/awvgr.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgr (a, npix, mean, sigma, lcut, hcut)
+
+real	a[ARB]
+real	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = a[i]
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = a[i]
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFR
+	    sigma = INDEFR
+	case 1:
+	    mean = sum
+	    sigma = INDEFR
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/awvgs.x b/sys/vops/lz/awvgs.x
new file mode 100644
index 00000000..8237be56
--- /dev/null
+++ b/sys/vops/lz/awvgs.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgs (a, npix, mean, sigma, lcut, hcut)
+
+short	a[ARB]
+real	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = a[i]
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = a[i]
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFR
+	    sigma = INDEFR
+	case 1:
+	    mean = sum
+	    sigma = INDEFR
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/awvgx.x b/sys/vops/lz/awvgx.x
new file mode 100644
index 00000000..82fe4192
--- /dev/null
+++ b/sys/vops/lz/awvgx.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AWVG -- Compute the mean and standard deviation (sigma) of a sample.  Pixels
+# whose value lies outside the specified lower and upper limits are not used.
+# If the upper and lower limits have the same value (e.g., zero), no limit
+# checking is performed.  The number of pixels in the sample is returned as the
+# function value.
+
+int procedure awvgx (a, npix, mean, sigma, lcut, hcut)
+
+complex	a[ARB]
+real	mean, sigma, lcut, hcut
+double	sum, sumsq, value, temp
+int	npix, i, ngpix
+
+begin
+	sum = 0.0
+	sumsq = 0.0
+	ngpix = 0
+
+	# Accumulate sum, sum of squares.  The test to disable limit checking
+	# requires numerical equality of two floating point numbers; this should
+	# be ok since they are used as flags not as numbers (they are not used
+	# in computations).
+
+	if (hcut == lcut) {
+	    do i = 1, npix {
+		    value = abs (a[i])
+		sum = sum + value
+		sumsq = sumsq + value ** 2
+	    }
+	    ngpix = npix
+
+	} else {
+	    do i = 1, npix {
+		    value = abs (a[i])
+		if (value >= lcut && value <= hcut) {
+		    ngpix = ngpix + 1
+		    sum = sum + value
+		    sumsq = sumsq + value ** 2
+		}
+	    }
+	}
+
+	switch (ngpix) {		# compute mean and sigma
+	case 0:
+	    mean = INDEFR
+	    sigma = INDEFR
+	case 1:
+	    mean = sum
+	    sigma = INDEFR
+	default:
+	    mean = sum / ngpix
+	    temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1)
+	    if (temp < 0)		# possible with roundoff error
+		sigma = 0.0
+	    else
+		sigma = sqrt (temp)
+	}
+
+	return (ngpix)
+end
diff --git a/sys/vops/lz/axori.x b/sys/vops/lz/axori.x
new file mode 100644
index 00000000..e6df0010
--- /dev/null
+++ b/sys/vops/lz/axori.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXOR -- Compute the exclusive or of two vectors (generic).
+
+procedure axori (a, b, c, npix)
+
+int	a[ARB], b[ARB], c[ARB]
+int	npix, i
+int	xor()
+
+begin
+	do i = 1, npix {
+		c[i] = xor (a[i], b[i])
+	}
+end
diff --git a/sys/vops/lz/axorki.x b/sys/vops/lz/axorki.x
new file mode 100644
index 00000000..5e08a769
--- /dev/null
+++ b/sys/vops/lz/axorki.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXORK -- Compute the boolean or of a vector and a constant (generic).
+
+procedure axorki (a, b, c, npix)
+
+int	a[ARB]
+int	b
+int	c[ARB]
+int	npix, i
+int	xor()
+
+begin
+	do i = 1, npix {
+		c[i] = xor (a[i], b)
+	}
+end
diff --git a/sys/vops/lz/axorkl.x b/sys/vops/lz/axorkl.x
new file mode 100644
index 00000000..df4f074f
--- /dev/null
+++ b/sys/vops/lz/axorkl.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXORK -- Compute the boolean or of a vector and a constant (generic).
+
+procedure axorkl (a, b, c, npix)
+
+long	a[ARB]
+long	b
+long	c[ARB]
+int	npix, i
+long	xorl()
+
+begin
+	do i = 1, npix {
+		c[i] = xorl (a[i], b)
+	}
+end
diff --git a/sys/vops/lz/axorks.x b/sys/vops/lz/axorks.x
new file mode 100644
index 00000000..d85e283d
--- /dev/null
+++ b/sys/vops/lz/axorks.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXORK -- Compute the boolean or of a vector and a constant (generic).
+
+procedure axorks (a, b, c, npix)
+
+short	a[ARB]
+short	b
+short	c[ARB]
+int	npix, i
+short	xors()
+
+begin
+	do i = 1, npix {
+		c[i] = xors (a[i], b)
+	}
+end
diff --git a/sys/vops/lz/axorl.x b/sys/vops/lz/axorl.x
new file mode 100644
index 00000000..d4087fd3
--- /dev/null
+++ b/sys/vops/lz/axorl.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXOR -- Compute the exclusive or of two vectors (generic).
+
+procedure axorl (a, b, c, npix)
+
+long	a[ARB], b[ARB], c[ARB]
+int	npix, i
+long	xorl()
+
+begin
+	do i = 1, npix {
+		c[i] = xorl (a[i], b[i])
+	}
+end
diff --git a/sys/vops/lz/axors.x b/sys/vops/lz/axors.x
new file mode 100644
index 00000000..ab3c073d
--- /dev/null
+++ b/sys/vops/lz/axors.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AXOR -- Compute the exclusive or of two vectors (generic).
+
+procedure axors (a, b, c, npix)
+
+short	a[ARB], b[ARB], c[ARB]
+int	npix, i
+short	xors()
+
+begin
+	do i = 1, npix {
+		c[i] = xors (a[i], b[i])
+	}
+end
diff --git a/sys/vops/lz/mkpkg b/sys/vops/lz/mkpkg
new file mode 100644
index 00000000..046aa2b7
--- /dev/null
+++ b/sys/vops/lz/mkpkg
@@ -0,0 +1,330 @@
+# Make the VOPS vector operators library, procedures a[l-z]*.*.
+
+$checkout libvops.a lib$
+$update   libvops.a
+$checkin  libvops.a lib$
+$exit
+
+libvops.a:
+	alans.x
+	alani.x
+	alanl.x
+	alanks.x
+	alanki.x
+	alankl.x
+	alimc.x	
+	alimd.x	
+	alimi.x	
+	aliml.x	
+	alimr.x	
+	alims.x	
+	alimx.x	
+	allnd.x	
+	allni.x	
+	allnl.x	
+	allnr.x	
+	allns.x	
+	allnx.x	
+	alogd.x	
+	alogi.x	
+	alogl.x	
+	alogr.x	
+	alogs.x	
+	alogx.x	
+	alors.x
+	alori.x
+	alorl.x
+	alorks.x
+	alorki.x
+	alorkl.x
+	alovc.x	
+	alovd.x	
+	alovi.x	
+	alovl.x	
+	alovr.x	
+	alovs.x	
+	alovx.x	
+	altad.x	
+	altai.x	
+	altal.x	
+	altar.x	
+	altas.x	
+	altax.x	
+	altmd.x	
+	altmi.x	
+	altml.x	
+	altmr.x	
+	altms.x	
+	altmx.x	
+	altrd.x	
+	altri.x	
+	altrl.x	
+	altrr.x	
+	altrs.x	
+	altrx.x	
+	aluid.x		<mach.h>
+	aluii.x		<mach.h>
+	aluil.x		<mach.h>
+	aluir.x		<mach.h>
+	aluis.x		<mach.h>
+	alutc.x	
+	alutd.x	
+	aluti.x	
+	alutl.x	
+	alutr.x	
+	aluts.x	
+	amagd.x	
+	amagi.x	
+	amagl.x	
+	amagr.x	
+	amags.x	
+	amagx.x	
+	amapd.x	
+	amapi.x	
+	amapl.x	
+	amapr.x	
+	amaps.x	
+	amaxc.x	
+	amaxd.x	
+	amaxi.x	
+	amaxkc.x	
+	amaxkd.x	
+	amaxki.x	
+	amaxkl.x	
+	amaxkr.x	
+	amaxks.x	
+	amaxkx.x	
+	amaxl.x	
+	amaxr.x	
+	amaxs.x	
+	amaxx.x	
+	amed3c.x	
+	amed3d.x	
+	amed3i.x	
+	amed3l.x	
+	amed3r.x	
+	amed3s.x	
+	amed4c.x	
+	amed4d.x	
+	amed4i.x	
+	amed4l.x	
+	amed4r.x	
+	amed4s.x	
+	amed5c.x	
+	amed5d.x	
+	amed5i.x	
+	amed5l.x	
+	amed5r.x	
+	amed5s.x	
+	amedc.x	
+	amedd.x	
+	amedi.x	
+	amedl.x	
+	amedr.x	
+	ameds.x	
+	amedx.x	
+	amgsd.x	
+	amgsi.x	
+	amgsl.x	
+	amgsr.x	
+	amgss.x	
+	amgsx.x	
+	aminc.x	
+	amind.x	
+	amini.x	
+	aminkc.x	
+	aminkd.x	
+	aminki.x	
+	aminkl.x	
+	aminkr.x	
+	aminks.x	
+	aminkx.x	
+	aminl.x	
+	aminr.x	
+	amins.x	
+	aminx.x	
+	amodd.x	
+	amodi.x	
+	amodkd.x	
+	amodki.x	
+	amodkl.x	
+	amodkr.x	
+	amodks.x	
+	amodl.x	
+	amodr.x	
+	amods.x	
+	amovc.x	
+	amovd.x	
+	amovi.x	
+	amovkc.x	
+	amovkd.x	
+	amovki.x	
+	amovkl.x	
+	amovkr.x	
+	amovks.x	
+	amovkx.x	
+	amovl.x	
+	amovr.x	
+	amovs.x	
+	amovx.x	
+	amuld.x	
+	amuli.x	
+	amulkd.x	
+	amulki.x	
+	amulkl.x	
+	amulkr.x	
+	amulks.x	
+	amulkx.x	
+	amull.x	
+	amulr.x	
+	amuls.x	
+	amulx.x	
+	anegd.x	
+	anegi.x	
+	anegl.x	
+	anegr.x	
+	anegs.x	
+	anegx.x	
+	anoti.x	
+	anotl.x	
+	anots.x	
+	apkxd.x	
+	apkxi.x	
+	apkxl.x	
+	apkxr.x	
+	apkxs.x	
+	apkxx.x	
+	apold.x	
+	apolr.x	
+	apowd.x	
+	apowi.x	
+	apowkd.x	
+	apowki.x	
+	apowkl.x	
+	apowkr.x	
+	apowks.x	
+	apowkx.x	
+	apowl.x	
+	apowr.x	
+	apows.x	
+	apowx.x	
+	aravd.x	<mach.h>
+	aravi.x	<mach.h>
+	aravl.x	<mach.h>
+	aravr.x	<mach.h>
+	aravs.x	<mach.h>
+	aravx.x	<mach.h>
+	arcpd.x	
+	arcpi.x	
+	arcpl.x	
+	arcpr.x	
+	arcps.x	
+	arcpx.x	
+	arczd.x	
+	arczi.x	
+	arczl.x	
+	arczr.x	
+	arczs.x	
+	arczx.x	
+	argtd.x	
+	argti.x	
+	argtl.x	
+	argtr.x	
+	argts.x	
+	argtx.x	
+	arltd.x	
+	arlti.x	
+	arltl.x	
+	arltr.x	
+	arlts.x	
+	arltx.x	
+	aselc.x	
+	aseld.x	
+	aseli.x	
+	asell.x	
+	aselr.x	
+	asels.x	
+	aselx.x	
+	aselkc.x	
+	aselkd.x	
+	aselki.x	
+	aselkl.x	
+	aselkr.x	
+	aselks.x	
+	aselkx.x	
+	asokc.x		<mach.h>
+	asokd.x		<mach.h>
+	asoki.x		<mach.h>
+	asokl.x		<mach.h>
+	asokr.x		<mach.h>
+	asoks.x		<mach.h>
+	asokx.x		<mach.h>
+	asqrd.x	
+	asqri.x	
+	asqrl.x	
+	asqrr.x	
+	asqrs.x	
+	asqrx.x	
+	asrtc.x	
+	asrtd.x	
+	asrti.x	
+	asrtl.x	
+	asrtr.x	
+	asrts.x	
+	asrtx.x	
+	assqd.x	
+	assqi.x	
+	assql.x	
+	assqr.x	
+	assqs.x	
+	assqx.x	
+	asubd.x	
+	asubi.x	
+	asubkd.x	
+	asubki.x	
+	asubkl.x	
+	asubkr.x	
+	asubks.x	
+	asubkx.x	
+	asubl.x	
+	asubr.x	
+	asubs.x	
+	asubx.x	
+	asumd.x	
+	asumi.x	
+	asuml.x	
+	asumr.x	
+	asums.x	
+	asumx.x	
+	aupxd.x	
+	aupxi.x	
+	aupxl.x	
+	aupxr.x	
+	aupxs.x	
+	aupxx.x	
+	aveqc.x
+	aveqd.x
+	aveqi.x
+	aveql.x
+	aveqr.x
+	aveqs.x
+	aveqx.x
+	awsud.x	
+	awsui.x	
+	awsul.x	
+	awsur.x	
+	awsus.x	
+	awsux.x	
+	awvgd.x	
+	awvgi.x	
+	awvgl.x	
+	awvgr.x	
+	awvgs.x	
+	awvgx.x	
+	axori.x	
+	axorki.x	
+	axorkl.x	
+	axorks.x	
+	axorl.x	
+	axors.x	
+	;
diff --git a/sys/vops/mkpkg b/sys/vops/mkpkg
new file mode 100644
index 00000000..f44f2b16
--- /dev/null
+++ b/sys/vops/mkpkg
@@ -0,0 +1,150 @@
+# Make the VOPS vector operators library.
+
+$checkout libvops.a lib$
+$update   libvops.a
+$checkin  libvops.a lib$
+$exit
+
+# Since all of the VOPS procedures in this directory are generic, no actual
+# compilation occurs here (except for the two fft routines, which are type
+# real only).  The generic preprocessor is called to generate the type
+# specific family of operators for each generic procedure, placing the output
+# files in the subdirectories ak and lz.  Since the preprocessed sources are
+# permanently kept in the subdirectories, the generic preprocessor is only
+# required on the UNIX development system, although it may be available on
+# any other system as well.
+ 
+tfiles:
+	$set	GA   = "$$generic -k -p ak/"
+	$set	GL   = "$$generic -k -p lz/"
+	$set	ACHT = "achtc.x achts.x achti.x achtl.x achtr.x achtd.x achtx.x"
+
+	# The acht (change type) procedures are doubly generic and must be
+	# expanded twice, producing 7*7=49 files as output.
+	#
+	# We force this to be regenerated on each platform since there are
+	# differences in the generated code between 32 and 64-bit platforms.
+
+	$generic -k        -t csilrdx acht.gx
+	$generic -k -p ak/ -t csilrdx $(ACHT)
+	$delete $(ACHT)
+
+
+	# The following files are not generic hence are merely copied to the
+	# type specific directory.
+
+	$ifolder (ak/acjgx.x,  acjgx.x )   $copy acjgx.x  ak/acjgx.x	$endif
+	$ifolder (ak/afftrr.x, afftrr.x)   $copy afftrr.x ak/afftrr.x	$endif
+	$ifolder (ak/afftrx.x, afftrx.x)   $copy afftrx.x ak/afftrx.x	$endif
+	$ifolder (ak/afftxr.x, afftxr.x)   $copy afftxr.x ak/afftxr.x	$endif
+	$ifolder (ak/afftxx.x, afftxx.x)   $copy afftxx.x ak/afftxx.x	$endif
+	$ifolder (ak/aiftrr.x, aiftrr.x)   $copy aiftrr.x ak/aiftrr.x	$endif
+	$ifolder (ak/aiftrx.x, aiftrx.x)   $copy aiftrx.x ak/aiftrx.x	$endif
+	$ifolder (ak/aiftxr.x, aiftxr.x)   $copy aiftxr.x ak/aiftxr.x	$endif
+	$ifolder (ak/aiftxx.x, aiftxx.x)   $copy aiftxx.x ak/aiftxx.x	$endif
+
+	# Each of the following generic files is expanded for each of the
+	# datatypes listed in the -t flag.
+
+	$ifolder (ak/aabsi.x,  aabs.gx )    $(GA) -t  silrdx aabs.gx	$endif
+	$ifolder (ak/aaddi.x,  aadd.gx )    $(GA) -t  silrdx aadd.gx	$endif
+	$ifolder (ak/aaddki.x, aaddk.gx)    $(GA) -t  silrdx aaddk.gx	$endif
+	$ifolder (ak/aandi.x,  aand.gx )    $(GA) -t  sil    aand.gx	$endif
+	$ifolder (ak/aandki.x, aandk.gx)    $(GA) -t  sil    aandk.gx	$endif
+	$ifolder (ak/aavgi.x,  aavg.gx )    $(GA) -t  silrdx aavg.gx	$endif
+	$ifolder (ak/abavi.x,  abav.gx )    $(GA) -t  silrdx abav.gx	$endif
+	$ifolder (ak/absui.x,  absu.gx )    $(GA) -t  silrd  absu.gx	$endif
+	$ifolder (ak/abeqi.x,  abeq.gx )    $(GA) -t csilrdx abeq.gx	$endif
+	$ifolder (ak/abeqki.x, abeqk.gx)    $(GA) -t csilrdx abeqk.gx	$endif
+	$ifolder (ak/abgei.x,  abge.gx )    $(GA) -t csilrdx abge.gx	$endif
+	$ifolder (ak/abgeki.x, abgek.gx)    $(GA) -t csilrdx abgek.gx	$endif
+	$ifolder (ak/abgti.x,  abgt.gx )    $(GA) -t csilrdx abgt.gx	$endif
+	$ifolder (ak/abgtki.x, abgtk.gx)    $(GA) -t csilrdx abgtk.gx	$endif
+	$ifolder (ak/ablei.x,  able.gx )    $(GA) -t csilrdx able.gx	$endif
+	$ifolder (ak/ableki.x, ablek.gx)    $(GA) -t csilrdx ablek.gx	$endif
+	$ifolder (ak/ablti.x,  ablt.gx )    $(GA) -t csilrdx ablt.gx	$endif
+	$ifolder (ak/abltki.x, abltk.gx)    $(GA) -t csilrdx abltk.gx	$endif
+	$ifolder (ak/abnei.x,  abne.gx )    $(GA) -t csilrdx abne.gx	$endif
+	$ifolder (ak/abneki.x, abnek.gx)    $(GA) -t csilrdx abnek.gx	$endif
+	$ifolder (ak/abori.x,  abor.gx )    $(GA) -t  sil    abor.gx	$endif
+	$ifolder (ak/aborki.x, abork.gx)    $(GA) -t  sil    abork.gx	$endif
+	$ifolder (ak/aclri.x,  aclr.gx )    $(GA) -t csilrdx aclr.gx	$endif
+	$ifolder (ak/acnvi.x,  acnv.gx )    $(GA) -t  silrd  acnv.gx	$endif
+	$ifolder (ak/acnvri.x, acnvr.gx)    $(GA) -t  silrd  acnvr.gx	$endif
+	$ifolder (ak/adivi.x,  adiv.gx )    $(GA) -t  silrdx adiv.gx	$endif
+	$ifolder (ak/adivki.x, adivk.gx)    $(GA) -t  silrdx adivk.gx	$endif
+	$ifolder (ak/adoti.x,  adot.gx )    $(GA) -t  silrdx adot.gx	$endif
+	$ifolder (ak/advzi.x,  advz.gx )    $(GA) -t  silrdx advz.gx	$endif
+	$ifolder (ak/aexpi.x,  aexp.gx )    $(GA) -t  silrdx aexp.gx	$endif
+	$ifolder (ak/aexpki.x, aexpk.gx)    $(GA) -t  silrdx aexpk.gx	$endif
+	$ifolder (ak/aglti.x,  aglt.gx )    $(GA) -t csilrdx aglt.gx	$endif
+	$ifolder (ak/ahgmi.x,  ahgm.gx )    $(GA) -t csilrd  ahgm.gx	$endif
+	$ifolder (ak/ahivi.x,  ahiv.gx )    $(GA) -t csilrdx ahiv.gx	$endif
+	$ifolder (ak/aimgi.x,  aimg.gx )    $(GA) -t  silrd  aimg.gx	$endif
+	$ifolder (lz/alani.x,  alan.gx )    $(GL) -t  sil    alan.gx	$endif
+	$ifolder (lz/alanki.x, alank.gx)    $(GL) -t  sil    alank.gx	$endif
+	$ifolder (lz/alimi.x,  alim.gx )    $(GL) -t csilrdx alim.gx	$endif
+	$ifolder (lz/allni.x,  alln.gx )    $(GL) -t  silrdx alln.gx	$endif
+	$ifolder (lz/alogi.x,  alog.gx )    $(GL) -t  silrdx alog.gx	$endif
+	$ifolder (lz/alori.x,  alor.gx )    $(GL) -t  sil    alor.gx	$endif
+	$ifolder (lz/alorki.x, alork.gx)    $(GL) -t  sil    alork.gx	$endif
+	$ifolder (lz/alovi.x,  alov.gx )    $(GL) -t csilrdx alov.gx	$endif
+	$ifolder (lz/altai.x,  alta.gx )    $(GL) -t  silrdx alta.gx	$endif
+	$ifolder (lz/altmi.x,  altm.gx )    $(GL) -t  silrdx altm.gx	$endif
+	$ifolder (lz/altri.x,  altr.gx )    $(GL) -t  silrdx altr.gx	$endif
+	$ifolder (lz/aluii.x,  alui.gx )    $(GL) -t  silrd  alui.gx	$endif
+	$ifolder (lz/aluti.x,  alut.gx )    $(GL) -t csilrd  alut.gx	$endif
+	$ifolder (lz/amagi.x,  amag.gx )    $(GL) -t  silrdx amag.gx	$endif
+	$ifolder (lz/amapi.x,  amap.gx )    $(GL) -t  silrd  amap.gx	$endif
+	$ifolder (lz/amaxi.x,  amax.gx )    $(GL) -t csilrdx amax.gx	$endif
+	$ifolder (lz/amaxki.x, amaxk.gx)    $(GL) -t csilrdx amaxk.gx	$endif
+	$ifolder (lz/amedi.x,  amed.gx )    $(GL) -t csilrdx amed.gx	$endif
+	$ifolder (lz/amed3i.x, amed3.gx)    $(GL) -t csilrd  amed3.gx	$endif
+	$ifolder (lz/amed4i.x, amed4.gx)    $(GL) -t csilrd  amed4.gx	$endif
+	$ifolder (lz/amed5i.x, amed5.gx)    $(GL) -t csilrd  amed5.gx	$endif
+	$ifolder (lz/amgsi.x,  amgs.gx )    $(GL) -t silrdx  amgs.gx	$endif
+	$ifolder (lz/amini.x,  amin.gx )    $(GL) -t csilrdx amin.gx	$endif
+	$ifolder (lz/aminki.x, amink.gx)    $(GL) -t csilrdx amink.gx	$endif
+	$ifolder (lz/amodi.x,  amod.gx )    $(GL) -t  silrd  amod.gx	$endif
+	$ifolder (lz/amodki.x, amodk.gx)    $(GL) -t  silrd  amodk.gx	$endif
+	$ifolder (lz/amovi.x,  amov.gx )    $(GL) -t csilrdx amov.gx	$endif
+	$ifolder (lz/amovki.x, amovk.gx)    $(GL) -t csilrdx amovk.gx	$endif
+	$ifolder (lz/amuli.x,  amul.gx )    $(GL) -t  silrdx amul.gx	$endif
+	$ifolder (lz/amulki.x, amulk.gx)    $(GL) -t  silrdx amulk.gx	$endif
+	$ifolder (lz/anegi.x,  aneg.gx )    $(GL) -t  silrdx aneg.gx	$endif
+	$ifolder (lz/anoti.x,  anot.gx )    $(GL) -t  sil    anot.gx	$endif
+	$ifolder (lz/apkxi.x,  apkx.gx )    $(GL) -t  silrdx apkx.gx	$endif
+	$ifolder (lz/apolr.x,  apol.gx )    $(GL) -t     rd  apol.gx	$endif
+	$ifolder (lz/apowi.x,  apow.gx )    $(GL) -t  silrdx apow.gx	$endif
+	$ifolder (lz/apowki.x, apowk.gx)    $(GL) -t  silrdx apowk.gx	$endif
+	$ifolder (lz/aravi.x,  arav.gx )    $(GL) -t  silrdx arav.gx	$endif
+	$ifolder (lz/arcpi.x,  arcp.gx )    $(GL) -t  silrdx arcp.gx	$endif
+	$ifolder (lz/arczi.x,  arcz.gx )    $(GL) -t  silrdx arcz.gx	$endif
+	$ifolder (lz/argti.x,  argt.gx )    $(GL) -t  silrdx argt.gx	$endif
+	$ifolder (lz/arlti.x,  arlt.gx )    $(GL) -t  silrdx arlt.gx	$endif
+	$ifolder (lz/aseli.x,  asel.gx )    $(GL) -t csilrdx asel.gx	$endif
+	$ifolder (lz/aselki.x, aselk.gx)    $(GL) -t csilrdx aselk.gx	$endif
+	$ifolder (lz/asoki.x,  asok.gx )    $(GL) -t csilrdx asok.gx	$endif
+	$ifolder (lz/asqri.x,  asqr.gx )    $(GL) -t  silrdx asqr.gx	$endif
+	$ifolder (lz/asrti.x,  asrt.gx )    $(GL) -t csilrdx asrt.gx	$endif
+	$ifolder (lz/assqi.x,  assq.gx )    $(GL) -t  silrdx assq.gx	$endif
+	$ifolder (lz/asubi.x,  asub.gx )    $(GL) -t  silrdx asub.gx	$endif
+	$ifolder (lz/asubki.x, asubk.gx)    $(GL) -t  silrdx asubk.gx	$endif
+	$ifolder (lz/asumi.x,  asum.gx )    $(GL) -t  silrdx asum.gx	$endif
+	$ifolder (lz/aupxi.x,  aupx.gx )    $(GL) -t  silrdx aupx.gx	$endif
+	$ifolder (lz/aveqi.x,  aveq.gx )    $(GL) -t csilrdx aveq.gx	$endif
+	$ifolder (lz/awsui.x,  awsu.gx )    $(GL) -t  silrdx awsu.gx	$endif
+	$ifolder (lz/awvgi.x,  awvg.gx )    $(GL) -t  silrdx awvg.gx	$endif
+	$ifolder (lz/axori.x,  axor.gx )    $(GL) -t  sil    axor.gx	$endif
+	$ifolder (lz/axorki.x, axork.gx)    $(GL) -t  sil    axork.gx	$endif
+	;
+
+libvops.a:
+	$ifeq (USE_GENERIC, yes) $call tfiles $endif
+	$set XFLAGS = "$(XVFLAGS)"
+	@ak
+	@lz
+	@achtgen			# acht conversion matrix
+	fftr.f
+	fftx.f
+	;
diff --git a/sys/vops/vops.calls b/sys/vops/vops.calls
new file mode 100644
index 00000000..9798b80b
--- /dev/null
+++ b/sys/vops/vops.calls
@@ -0,0 +1,106 @@
+aabs        3 aabs.gx      procedure aabs$t (a, b, npix)
+aadd        3 aadd.gx      procedure aadd$t (a, b, c, npix)
+aaddk       3 aaddk.gx     procedure aaddk$t (a, b, c, npix)
+aand        3 aand.gx      procedure aand$t (a, b, c, npix)
+aandk       4 aandk.gx     procedure aandk$t (a, b, c, npix)
+aavg        4 aavg.gx      procedure aavg$t (a, npix, mean, sigma)
+abav        5 abav.gx      procedure abav$t (a, b, nblocks, npix_per_block)
+abeq        4 abeq.gx      procedure abeq$t (a, b, c, npix)
+abeqk       4 abeqk.gx     procedure abeqk$t (a, b, c, npix)
+abge        4 abge.gx      procedure abge$t (a, b, c, npix)
+abgek       4 abgek.gx     procedure abgek$t (a, b, c, npix)
+abgt        4 abgt.gx      procedure abgt$t (a, b, c, npix)
+abgtk       4 abgtk.gx     procedure abgtk$t (a, b, c, npix)
+able        4 able.gx      procedure able$t (a, b, c, npix)
+ablek       4 ablek.gx     procedure ablek$t (a, b, c, npix)
+ablt        4 ablt.gx      procedure ablt$t (a, b, c, npix)
+abltk       4 abltk.gx     procedure abltk$t (a, b, c, npix)
+abne        4 abne.gx      procedure abne$t (a, b, c, npix)
+abnek       4 abnek.gx     procedure abnek$t (a, b, c, npix)
+abor        3 abor.gx      procedure abor$t (a, b, c, npix)
+abork       4 abork.gx     procedure abork$t (a, b, c, npix)
+absu        5 absu.gx      procedure absu$t (a, b, nblocks, npix_per_block)
+acht        5 acht.gx      procedure acht$t$$t (a, b, npix)
+acjgx       3 acjgx.x      procedure acjgx (a, b, npix)
+aclr        3 aclr.gx      procedure aclr$t (a, npix)
+acnv       16 acnv.gx      procedure acnv$t (in, out, npix, kernel, knpix)
+acnvr      17 acnvr.gx     procedure acnvr$t (in, out, npix, kernel, knpix)
+adiv        4 adiv.gx      procedure adiv$t (a, b, c, npix)
+adivk       4 adivk.gx     procedure adivk$t (a, b, c, npix)
+adot        7 adot.gx      real procedure adot$t (a, b, npix)
+adot        5 adot.gx      double procedure adot$t (a, b, npix)
+advz       11 advz.gx      procedure advz$t (a, b, c, npix, errfcn)
+aexp        3 aexp.gx      procedure aexp$t (a, b, c, npix)
+aexpk       3 aexpk.gx     procedure aexpk$t (a, b, c, npix)
+afftrr      8 afftrr.x     procedure afftrr (sr, si, fr, fi, npix)
+afftrx     16 afftrx.x     procedure afftrx (a, b, npix)
+afftxr      7 afftxr.x     procedure afftxr (sr, si, fr, fi, npix)
+afftxx      7 afftxx.x     procedure afftxx (a, b, npix)
+aglt        6 aglt.gx      procedure aglt$t (a,b,npix,low,high,kmul,kadd,nrange)
+ahgm        6 ahgm.gx      procedure ahgm$t (data, npix, hgm, nbins, z1, z2)
+ahiv        3 ahiv.gx      PIXEL procedure ahiv$t (a, npix)
+aiftrr      8 aiftrr.x     procedure aiftrr (fr, fi, sr, si, npix)
+aiftrx     14 aiftrx.x     procedure aiftrx (a, b, npix)
+aiftxr      7 aiftxr.x     procedure aiftxr (fr, fi, sr, si, npix)
+aiftxx     14 aiftxx.x     procedure aiftxx (a, b, npix)
+aimg        3 aimg.gx      procedure aimg$t (a, b, npix)
+alan        3 alan.gx      procedure alan$t (a, b, c, npix)
+alank       3 alank.gx     procedure alank$t (a, b, c, npix)
+alor        3 alor.gx      procedure alor$t (a, b, c, npix)
+alork       3 alork.gx     procedure alork$t (a, b, c, npix)
+alim        3 alim.gx      procedure alim$t (a, npix, minval, maxval)
+alln        5 alln.gx      procedure alln$t (a, b, npix, errfcn)
+alog        5 alog.gx      procedure alog$t (a, b, npix, errfcn)
+alov        3 alov.gx      PIXEL procedure alov$t (a, npix)
+alta        4 alta.gx      procedure alta$t (a, b, npix, k1, k2)
+altm        4 altm.gx      procedure altm$t (a, b, npix, k1, k2)
+altr        5 altr.gx      procedure altr$t (a, b, npix, k1, k2, k3)
+alui       10 alui.gx      procedure alui$t (a, b, x, npix)
+alut        5 alut.gx      procedure alut$t (a, b, npix, lut)
+amag        3 amag.gx      procedure amag$t (a, b, c, npix)
+amap        5 amap.gx      procedure amap$t (a, b, npix, a1, a2, b1, b2)
+amax        3 amax.gx      procedure amax$t (a, b, c, npix)
+amaxk       3 amaxk.gx     procedure amaxk$t (a, b, c, npix)
+amed        6 amed.gx      PIXEL procedure amed$t (a, npix)
+amed3       4 amed3.gx     procedure amed3$t (a, b, c, m, npix)
+amed4       6 amed4.gx     procedure amed4$t (a, b, c, d, m, npix)
+amed5       5 amed5.gx     procedure amed5$t (a, b, c, d, e, m, npix)
+amgs        3 amgs.gx      procedure amgs$t (a, b, c, npix)
+amin        3 amin.gx      procedure amin$t (a, b, c, npix)
+amink       3 amink.gx     procedure amink$t (a, b, c, npix)
+amod        3 amod.gx      procedure amod$t (a, b, c, npix)
+amodk       3 amodk.gx     procedure amodk$t (a, b, c, npix)
+amov        5 amov.gx      procedure amov$t (a, b, npix)
+amovk       3 amovk.gx     procedure amovk$t (a, b, npix)
+amul        3 amul.gx      procedure amul$t (a, b, c, npix)
+amulk       3 amulk.gx     procedure amulk$t (a, b, c, npix)
+aneg        3 aneg.gx      procedure aneg$t (a, b, npix)
+anot        3 anot.gx      procedure anot$t (a, b, npix)
+apkx        4 apkx.gx      procedure apkx$t (a, b, c, npix)
+apol        4 apol.gx      PIXEL procedure apol$t (x, coeff, ncoeff)
+apow        3 apow.gx      procedure apow$t (a, b, c, npix)
+apowk       3 apowk.gx     procedure apowk$t (a, b, c, npix)
+arav       10 arav.gx      int procedure arav$t (a, npix, mean, sigma, ksig)
+arcp        4 arcp.gx      procedure arcp$t (a, b, c, npix)
+arcz       11 arcz.gx      procedure arcz$t (a, b, c, npix, errfcn)
+argt        4 argt.gx      procedure argt$t (a, npix, ceil, newval)
+arlt        3 arlt.gx      procedure arlt$t (a, npix, floor, newval)
+asel        6 asel.gx      procedure asel$t (a, b, c, sel, npix)
+aselk       6 aselk.gx     procedure aselk$t (a, b, c, sel, npix)
+asok       16 asok.gx      PIXEL procedure asok$t (a, npix, ksel)
+asqr        4 asqr.gx      procedure asqr$t (a, b, npix, errfcn)
+asrt        6 asrt.gx      procedure asrt$t (a, b, npix)
+assq       10 assq.gx      PIXEL procedure assq$t (a, npix)
+assq        4 assq.gx      real procedure assq$t (a, npix)
+assq        7 assq.gx      double procedure assq$t (a, npix)
+asub        3 asub.gx      procedure asub$t (a, b, c, npix)
+asubk       3 asubk.gx     procedure asubk$t (a, b, c, npix)
+asum        5 asum.gx      real procedure asum$t (a, npix)
+asum        7 asum.gx      double procedure asum$t (a, npix)
+asum        9 asum.gx      PIXEL procedure asum$t (a, npix)
+aupx        4 aupx.gx      procedure aupx$t (a, b, c, npix)
+aveq        3 aveq.gx      bool procedure aveq$t (a, b, npix)
+awsu        3 awsu.gx      procedure awsu$t (a, b, c, npix, k1, k2)
+awvg        7 awvg.gx      int procedure awvg$t (a,npix,mean,sigma,lcut,hcut)
+axor        3 axor.gx      procedure axor$t (a, b, c, npix)
+axork       3 axork.gx     procedure axork$t (a, b, c, npix)
diff --git a/sys/vops/vops.men b/sys/vops/vops.men
new file mode 100644
index 00000000..2d75d60f
--- /dev/null
+++ b/sys/vops/vops.men
@@ -0,0 +1,94 @@
+	   aabs - Absolute value of a vector
+	   aadd - Add two vectors
+	  aaddk - Add a vector and a scalar
+	   aand - Bitwise boolean AND of two vectors
+	  aandk - Bitwise boolean AND of a vector and a scalar
+	   aavg - Compute the mean and standard deviation of a vector
+	   abav - Block average a vector
+	   abeq - Vector equals vector
+	  abeqk - Vector equals scalar
+	   abge - Vector greater than or equal to vector
+	  abgek - Vector greater than or equal to scalar
+	   abgt - Vector greater than vector
+	  abgtk - Vector greater than scalar
+	   able - Vector less than or equal to vector
+	  ablek - Vector less than or equal to scalar
+	   ablt - Vector less than vector
+	  abltk - Vector less than scalar
+	   abne - Vector not equal to vector
+	  abnek - Vector not equal to scalar
+	   abor - Bitwise boolean OR of two vectors
+	  abork - Bitwise boolean OR of a vector and a scalar
+	   absu - Block sum a vector
+	   acht - Change datatype of a vector
+	  acjgx - Complex conjugate of a complex vector
+	   aclr - Clear (zero) a vector
+	   acnv - Convolve two vectors
+	  acnvr - Convolve a vector with a real kernel
+	   adiv - Divide two vectors
+	  adivk - Divide a vector by a scalar
+	   adot - Dot product of two vectors
+	   advz - Vector divide with divide by zero detection
+	   aexp - Vector to a real vector exponent
+	  aexpk - Vector to a real scalar exponent
+	  afftr - Forward real discrete fourier transform
+	  afftx - Forward complex discrete fourier transform
+	   aglt - General piecewise linear transformation
+	   ahgm - Accumulate the histogram of a series of vectors
+	   ahiv - Compute the high (maximum) value of a vector
+	  aiftr - Inverse real discrete fourier transform
+	  aiftx - Inverse complex discrete fourier transform
+	   aimg - Imaginary part of a complex vector
+	   alan - Logical AND of two vectors
+	  alank - Logical AND of a vector and a constant
+	   alim - Compute the limits (minimum and maximum values) of a vector
+	   alln - Natural logarithm of a vector
+	   alog - Logarithm of a vector
+	   alor - Logical OR of two vectors
+	  alork - Logical OR of a vector and a constant
+	   alov - Compute the low (minimum) value of a vector
+	   altr - Linear transformation of a vector
+	   alui - Vector lookup and interpolate (linear)
+	   alut - Vector transform via lookup table
+	   amag - Magnitude of two vectors (sqrt of sum of squares)
+	   amap - Linear mapping of a vector with clipping
+	   amax - Vector maximum of two vectors
+	  amaxk - Vector maximum of a vector and a scalar
+	   amed - Median value of a vector
+	  amed3 - Vector median of three vectors
+	  amed4 - Vector median of four vectors
+	  amed5 - Vector median of five vectors
+	   amgs - Magnitude squared of two vectors (sum of squares)
+	   amin - Vector minimum of two vectors
+	  amink - Vector minimum of a vector and a scalar
+	   amod - Modulus of two vectors
+	  amodk - Modulus of a vector and a scalar
+	   amov - Move (copy or shift) a vector
+	  amovk - Move a scalar into a vector
+	   amul - Multiply two vectors
+	  amulk - Multiply a vector and a scalar
+	   aneg - Negate a vector (change the sign of each pixel)
+	   anot - Bitwise boolean NOT of a vector
+	   apkx - Pack a complex vector given the real and imaginary parts
+	   apol - Polynomial evaluation
+	   apow - Vector to an integer vector power
+	  apowk - Vector to an integer scalar power
+	   arav - Mean and standard deviation of a vector with pixel rejection
+	   arcp - Reciprocal of a scalar and a vector
+	   arcz - Reciprocal with detection of divide by zero
+	   arlt - Vector replace pixel if less than scalar
+	   argt - Vector replace pixel if greater than scalar
+	   asel - Vector select from two vectors based on boolean flag vector
+	  aselk - Vector select from vector/scalar based on boolean flag vector
+	   asok - Selection of the Kth smallest element of a vector
+	   asqr - Square root of a vector
+	   asrt - Sort a vector in order of increasing pixel value
+	   assq - Sum of squares of a vector
+	   asub - Subtract two vectors
+	  asubk - Subtract a scalar from a vector
+	   asum - Sum of a vector
+	   aupx - Unpack the real and imaginary parts of a complex vector
+	   awsu - Weighted sum of two vectors
+	   awvg - Mean and standard deviation of a windowed vector
+	   axor - Bitwise boolean XOR (exclusive or) of two vectors
+	  axork -  Bitwise boolean XOR (exclusive or) of a vector and a scalar
diff --git a/sys/vops/vops.syn b/sys/vops/vops.syn
new file mode 100644
index 00000000..e54a3b5d
--- /dev/null
+++ b/sys/vops/vops.syn
@@ -0,0 +1,96 @@
+	  aabs[_silrdx] (a, b, npix)
+	  aadd[_silrdx] (a, b, c, npix)
+	 aaddk[_silrdx] (a, b, c, npix)
+	  aand[_sil___] (a, b, c, npix)
+	 aandk[_sil___] (a, b, c, npix)
+	  aavg[_silrdx] (a, npix, mean, sigma)
+	  abav[_silrdx] (a, b, nblocks, npix_per_block)
+	  abeq[csilrdx] (a, b, c, npix)
+	 abeqk[csilrdx] (a, b, c, npix)
+	  abge[csilrdx] (a, b, c, npix)
+	 abgek[csilrdx] (a, b, c, npix)
+	  abgt[csilrdx] (a, b, c, npix)
+	 abgtk[csilrdx] (a, b, c, npix)
+	  able[csilrdx] (a, b, c, npix)
+	 ablek[csilrdx] (a, b, c, npix)
+	  ablt[csilrdx] (a, b, c, npix)
+	 abltk[csilrdx] (a, b, c, npix)
+	  abne[csilrdx] (a, b, c, npix)
+	 abnek[csilrdx] (a, b, c, npix)
+	  abor[_sil___] (a, b, c, npix)
+	 abork[_sil___] (a, b, c, npix)
+	  absu[_silrd_] (a, b, nblocks, npix_per_block)
+    acht[UBcsilrdx][..] (a, b, npix)
+	  acjg[______x] (a, b, npix)
+	 aclr[Bcsilrdx] (a, npix)
+	  acnv[_silrd_] (a, b, npix, kernel, kpix)
+	 acnvr[_silrd_] (a, b, npix, kernel, kpix)
+	  adiv[_silrdx] (a, b, c, npix)
+	 adivk[_silrdx] (a, b, c, npix)
+    dot = adot[_silrdx] (a, b, npix)
+	  advz[_silrdx] (a, b, c, npix, errfcn)
+	  aexp[_silrdx] (a, b, c, npix)
+	 aexpk[_silrdx] (a, b, c, npix)
+	      afft[rx]x (s, f, npix)
+	      afft[rx]r (sr, si, fr, fi, npix)
+	  aglt[csilrdx] (a, b, npix, low, high, kmul, kadd, nrange)
+	  ahgm[csilrd_] (a, npix, hgm, nbins, z1, z2)
+  hival = ahiv[csilrdx] (a, npix)
+	      aift[rx]r (fr, fi, sr, si, npix)
+	      aift[rx]x (f, s, npix)
+	  aimg[_silrd_] (a, b, npix)
+	  alan[_sil___] (a, b, c, npix)
+	 alank[_sil___] (a, b, c, npix)
+	  alim[csilrdx] (a, npix, minval, maxval)
+	  alln[_silrdx] (a, b, npix, errfcn)
+	  alog[_silrdx] (a, b, npix, errfcn)
+	  alor[_sil___] (a, b, c, npix)
+	 alork[_sil___] (a, b, c, npix)
+  loval = alov[csilrdx] (a, npix)
+	  altr[_silrdx] (a, b, npix, k1, k2, k3)
+	  alta[_silrdx] (a, b, npix, k1, k2)
+	  altm[_silrdx] (a, b, npix, k1, k2)
+	  alui[_silrd_] (a, b, x, npix)
+	  alut[csil___] (a, b, nchar, lut)
+	  amag[_silrdx] (a, b, c, npix)
+	  amap[_silrd_] (a, b, npix, a1, a2, b1, b2)
+	  amax[csilrdx] (a, b, c, npix)
+	 amaxk[csilrdx] (a, b, c, npix)
+    med = amed[csilrdx] (a, npix)
+	 amed3[csilrd_] (a, b, c, med, npix)
+	 amed4[csilrd_] (a, b, c, d, med, npix)
+	 amed5[csilrd_] (a, b, c, d, e, med, npix)
+	  amgs[_silrdx] (a, b, c, npix)
+	  amin[csilrdx] (a, b, c, npix)
+	 amink[csilrdx] (a, b, c, npix)
+	  amod[_silrd_] (a, b, c, npix)
+	 amodk[_silrd_] (a, b, c, npix)
+	  amov[csilrdx] (a, b, npix)
+	 amovk[csilrdx] (a, b, npix)
+	  amul[_silrdx] (a, b, c, npix)
+	 amulk[_silrdx] (a, b, c, npix)
+	  aneg[_silrdx] (a, b, npix)
+	  anot[_sil___] (a, b, npix)
+	  apkx[_silrdx] (a, b, c, npix)
+   y(x) = apol[____rd_] (x, coeff, ncoeff)
+	  apow[_silrdx] (a, b, c, npix)
+	 apowk[_silrdx] (a, b, c, npix)
+  ngpix = arav[_silrdx] (a, npix, mean, sigma, ksig)
+	  arcp[_silrdx] (a, b, c, npix)
+	  arcz[_silrdx] (a, b, c, npix, errfcn)
+	  arlt[_silrdx] (a, npix, floor, newval)
+	  argt[_silrdx] (a, npix, ceil, newval)
+	  asel[csilrdx] (a, b, c, sel, npix)
+	 aselk[csilrdx] (a, b, c, sel, npix)
+	  asok[csilrdx] (a, npix, ksel)
+	  asqr[_silrdx] (a, b, npix, errfcn)
+	  asrt[csilrdx] (a, b, npix)
+  ssqrs = assq[_silrdx] (a, npix)
+	  asub[_silrdx] (a, b, c, npix)
+	 asubk[_silrdx] (a, b, c, npix)
+    sum = asum[_silrdx] (a, npix)
+	  aupx[_silrdx] (a, b, c, npix)
+	  awsu[_silrdx] (a, b, c, npix, k1, k2)
+  ngpix = awvg[_silrdx] (a, npix, mean, sigma, lcut, hcut)
+	  axor[_sil___] (a, b, c, npix)
+	 axork[_sil___] (a, b, c, npix)
diff --git a/sys/vops/zzdebug.x b/sys/vops/zzdebug.x
new file mode 100644
index 00000000..cdbc5757
--- /dev/null
+++ b/sys/vops/zzdebug.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	xft
+
+define	MAXPIX		4096
+
+# XFT -- Test complex transform routines.
+
+procedure xft
+
+complex	x[MAXPIX]
+int	npix, ntrip
+long	seed
+int	i, clgeti()
+real	urand()
+
+begin
+	npix  = max(1, min(MAXPIX, clgeti ("npix")))
+	ntrip = clgeti ("ntrip")
+	seed = 1
+
+	do i = 1, NPIX
+	    x[i] = complex (urand(seed), urand(seed))
+
+	do i = 1, ntrip {
+	    call afftx (x, x, NPIX)
+	    call aiftx (x, x, NPIX)
+	}
+end